ocean_restart_write_local Subroutine

public subroutine ocean_restart_write_local(filename, reg, decomp, meta, t, step, outer_step_count, ierr)

Write a per-rank ocean restart file from the registry durably (to <filename>.tmp then POSIX-rename). Device sync (!$acc update self) on the device-mapped arrays must already have been done by the caller — this is pure host NetCDF I/O.

ierr (P7, same treatment as rdb_ocean_diag_netcdf’s open_stream): every internal nc_* call, plus the final atomic rename, used to error stop unconditionally. When ierr is present, any failure closes/discards the partial .tmp file, sets ierr = OCEAN_STATUS_ERR_IO, and returns rather than aborting. Absent ierr preserves the legacy abort behaviour byte-for-byte.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: filename
type(restart_registry_t), intent(in) :: reg
type(decomp_t), intent(in) :: decomp
type(ocean_restart_metadata_t), intent(in) :: meta
real(kind=wp), intent(in) :: t
integer, intent(in) :: step
integer, intent(in) :: outer_step_count
integer, intent(out), optional :: ierr

Non-zero (OCEAN_STATUS_ERR_IO) on any NetCDF or rename failure when present; absent behaves as today (error stop).

Calls

proc~~ocean_restart_write_local~~CallsGraph proc~ocean_restart_write_local ocean_restart_write_local error error proc~ocean_restart_write_local->error info info proc~ocean_restart_write_local->info nf90_def_var nf90_def_var proc~ocean_restart_write_local->nf90_def_var nf90_put_var nf90_put_var proc~ocean_restart_write_local->nf90_put_var proc~error_ring_push error_ring_push proc~ocean_restart_write_local->proc~error_ring_push proc~nc_check nc_check proc~ocean_restart_write_local->proc~nc_check proc~nc_close nc_close proc~ocean_restart_write_local->proc~nc_close proc~nc_create_file nc_create_file proc~ocean_restart_write_local->proc~nc_create_file proc~nc_def_dim nc_def_dim proc~ocean_restart_write_local->proc~nc_def_dim proc~nc_enddef nc_enddef proc~ocean_restart_write_local->proc~nc_enddef proc~nc_put_att_global nc_put_att_global proc~ocean_restart_write_local->proc~nc_put_att_global proc~nc_put_att_global_int nc_put_att_global_int proc~ocean_restart_write_local->proc~nc_put_att_global_int proc~posix_rename posix_rename proc~ocean_restart_write_local->proc~posix_rename proc~restart_io_ok restart_io_ok proc~ocean_restart_write_local->proc~restart_io_ok to_string to_string proc~ocean_restart_write_local->to_string nf90_strerror nf90_strerror proc~nc_check->nf90_strerror proc~fail fail proc~nc_check->proc~fail proc~nc_close->proc~nc_check nf90_close nf90_close proc~nc_close->nf90_close proc~nc_create_file->proc~nc_check nf90_create nf90_create proc~nc_create_file->nf90_create proc~nc_def_dim->proc~nc_check nf90_def_dim nf90_def_dim proc~nc_def_dim->nf90_def_dim proc~nc_enddef->proc~nc_check nf90_enddef nf90_enddef proc~nc_enddef->nf90_enddef proc~nc_put_att_global->proc~nc_check nf90_put_att nf90_put_att proc~nc_put_att_global->nf90_put_att proc~nc_put_att_global_int->proc~nc_check proc~nc_put_att_global_int->nf90_put_att none~c_rename c_rename proc~posix_rename->none~c_rename proc~string_to_c string_to_c proc~posix_rename->proc~string_to_c proc~restart_io_ok->proc~nc_close proc~fail->error proc~fail->proc~error_ring_push

Called by

proc~~ocean_restart_write_local~~CalledByGraph proc~ocean_restart_write_local ocean_restart_write_local proc~ocean_state_restart_write ocean_state_restart_write proc~ocean_state_restart_write->proc~ocean_restart_write_local proc~ocean_state_restart_write_drop_field ocean_state_restart_write_drop_field proc~ocean_state_restart_write_drop_field->proc~ocean_restart_write_local proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~ocean_state_restart_write proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
integer, private :: dimids2(2)
integer, private :: dimids3(3)
character(len=32), private :: dimname_x
character(len=32), private :: dimname_y
character(len=32), private :: dimname_z
integer, private :: dx_id
integer, private :: dy_id
integer, private :: dz_id
integer, private :: e
integer, private :: local_ierr
character(len=:), private, allocatable :: msg
integer, private :: ncid
integer, private :: osc_varid
integer, private :: rc
integer, private :: step_varid
integer, private :: time_varid
character(len=:), private, allocatable :: tmpname
integer, private, allocatable :: varids(:)

Source Code

   subroutine ocean_restart_write_local(filename, reg, decomp, meta, t, step, &
                                        outer_step_count, ierr)
      !! Write a per-rank ocean restart file from the registry durably
      !! (to `<filename>.tmp` then POSIX-rename).  Device sync
      !! (`!$acc update self`) on the device-mapped arrays must already
      !! have been done by the caller — this is pure host NetCDF I/O.
      !!
      !! `ierr` (P7, same treatment as `rdb_ocean_diag_netcdf`'s
      !! `open_stream`): every internal `nc_*` call, plus the final
      !! atomic rename, used to `error stop` unconditionally. When
      !! `ierr` is present, any failure closes/discards the partial
      !! `.tmp` file, sets `ierr = OCEAN_STATUS_ERR_IO`, and returns
      !! rather than aborting. Absent `ierr` preserves the legacy abort
      !! behaviour byte-for-byte.
      character(len=*), intent(in) :: filename
      type(restart_registry_t), intent(in) :: reg
      type(decomp_t), intent(in) :: decomp
      type(ocean_restart_metadata_t), intent(in) :: meta
      real(wp), intent(in) :: t
      integer, intent(in) :: step
      integer, intent(in) :: outer_step_count
      integer, intent(out), optional :: ierr
         !! Non-zero (`OCEAN_STATUS_ERR_IO`) on any NetCDF or rename
         !! failure when present; absent behaves as today (`error stop`).

      character(len=:), allocatable :: tmpname
      integer :: ncid, e
      integer :: time_varid, step_varid, osc_varid
      integer, allocatable :: varids(:)
      character(len=32) :: dimname_x, dimname_y, dimname_z
      integer :: dx_id, dy_id, dz_id
      integer :: dimids2(2), dimids3(3)
      integer :: rc, local_ierr
      character(len=:), allocatable :: msg

      if (present(ierr)) ierr = OCEAN_STATUS_OK

      tmpname = trim(filename)//".tmp"
      call logger%info("Writing ocean restart file: "//trim(filename)// &
                       " ("//to_string(reg%n)//" fields)")

      call nc_create_file(tmpname, ncid, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr)) return
      allocate (varids(reg%n))

      ! One x/y/z dim trio per entry index.  The registry mixes layer
      ! (nk=nz) and interface (nk=nz+1) fields; per-entry dims are simple
      ! and the file is tiny so the duplication costs nothing.
      do e = 1, reg%n
         if (reg%entries(e)%rank == 0) cycle  ! host scalars: no dims
         write (dimname_x, "(A,I0)") "x", e
         write (dimname_y, "(A,I0)") "y", e
         call nc_def_dim(ncid, trim(dimname_x), reg%entries(e)%nx_phys, dx_id, ierr=local_ierr)
         if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
         call nc_def_dim(ncid, trim(dimname_y), reg%entries(e)%ny_phys, dy_id, ierr=local_ierr)
         if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
         if (reg%entries(e)%rank == 2) then
            dimids2 = [dx_id, dy_id]
            call nc_check(nf90_def_var(ncid, trim(reg%entries(e)%tag), NC_WP, &
                                       dimids2, varids(e)), &
                          "defining restart var "//trim(reg%entries(e)%tag), local_ierr)
            if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
         else
            write (dimname_z, "(A,I0)") "z", e
            call nc_def_dim(ncid, trim(dimname_z), reg%entries(e)%nk, dz_id, ierr=local_ierr)
            if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
            dimids3 = [dx_id, dy_id, dz_id]
            call nc_check(nf90_def_var(ncid, trim(reg%entries(e)%tag), NC_WP, &
                                       dimids3, varids(e)), &
                          "defining restart var "//trim(reg%entries(e)%tag), local_ierr)
            if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
         end if
      end do

      ! Host scalars (rank-0 persistent state) as NetCDF scalar vars.
      do e = 1, reg%n
         if (reg%entries(e)%rank /= 0) cycle
         call nc_check(nf90_def_var(ncid, trim(reg%entries(e)%tag), nf90_double, &
                                    varids(e)), &
                       "defining restart scalar "//trim(reg%entries(e)%tag), local_ierr)
         if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      end do

      ! Scalar metadata (rank-0 globals).
      call nc_check(nf90_def_var(ncid, "time", nf90_double, time_varid), &
                    "defining restart time", local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_check(nf90_def_var(ncid, "n_steps", nf90_int, step_varid), &
                    "defining restart n_steps", local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_check(nf90_def_var(ncid, "outer_step_count", nf90_int, osc_varid), &
                    "defining restart outer_step_count", local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return

      ! Decomposition + schema metadata (validated on read).
      call nc_put_att_global_int(ncid, "schema_version", RESTART_SCHEMA_VERSION, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "px", decomp%px, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "py", decomp%py, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "i_start", decomp%i_start, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "j_start", decomp%j_start, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "nx_global", decomp%nx_global, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "ny_global", decomp%ny_global, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "nx_local", decomp%nx_local, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "ny_local", decomp%ny_local, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return

      ! Grid / vcoord / tracer metadata (validated on read — review #7).
      call nc_put_att_global_int(ncid, "nz_ml", meta%nz_ml, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "nghost", meta%nghost, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "vcoord_type", meta%vcoord_type, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global(ncid, "vcoord_name", trim(meta%vcoord_name), ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "n_tracers", meta%n_tracers, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "idx_salinity", meta%idx_salinity, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_put_att_global_int(ncid, "idx_temperature", meta%idx_temperature, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return

      call nc_enddef(ncid, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return

      ! Write each FULL local array (interior + ghosts) / scalar.
      do e = 1, reg%n
         associate (en => reg%entries(e))
            select case (en%rank)
            case (0)
               call nc_check(nf90_put_var(ncid, varids(e), en%p0), &
                             "writing restart scalar "//trim(en%tag), local_ierr)
            case (2)
               call nc_check(nf90_put_var(ncid, varids(e), &
                                          en%p2(en%ng + 1:en%ng + en%nx_phys, en%ng + 1:en%ng + en%ny_phys)), &
                             "writing restart "//trim(en%tag), local_ierr)
            case default
               call nc_check(nf90_put_var(ncid, varids(e), &
                                          en%p3(en%ng + 1:en%ng + en%nx_phys, en%ng + 1:en%ng + en%ny_phys, 1:en%nk)), &
                             "writing restart "//trim(en%tag), local_ierr)
            end select
         end associate
         if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      end do

      call nc_check(nf90_put_var(ncid, time_varid, t), "writing restart time", local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_check(nf90_put_var(ncid, step_varid, step), "writing restart n_steps", local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return
      call nc_check(nf90_put_var(ncid, osc_varid, outer_step_count), &
                    "writing restart outer_step_count", local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr, ncid)) return

      call nc_close(ncid, ierr=local_ierr)
      if (.not. restart_io_ok(local_ierr, ierr)) return
      deallocate (varids)

      ! Atomic swap: rename the complete tmp file over the target.  A
      ! crash before this point leaves the previous checkpoint untouched.
      rc = posix_rename(tmpname, trim(filename))
      if (rc /= 0) then
         msg = "Failed to rename restart "//trim(tmpname)//" -> "// &
               trim(filename)//" (rc="//to_string(rc)//")"
         call error_ring_push(msg)
         call logger%error(msg)
         if (present(ierr)) then
            ierr = OCEAN_STATUS_ERR_IO
            return
         end if
         error stop "ocean_restart_write_local: rename failed"
      end if
      call logger%info("Ocean restart written at t = "//to_string(t)//" s")
   end subroutine ocean_restart_write_local