ocean_state_restart_write_drop_field Subroutine

private subroutine ocean_state_restart_write_drop_field(state, grid, decomp, filename, t, step, drop_tag, ierr)

Test-only sibling of ocean_state_restart_write: identical, except the ONE registered entry whose tag matches drop_tag is written under a mangled tag instead of its real one, so a subsequent ocean_state_restart_read/ocean_restart_read_local – which looks up variables by their REAL tag – finds nothing and takes exactly the “optional field absent” path it takes for a genuinely older checkpoint. error stops if drop_tag does not match any registered entry (a typo here must not silently test nothing).

Arguments

Type IntentOptional Attributes Name
type(ocean_state_t), intent(inout), target :: state
type(hgrid_t), intent(in) :: grid
type(decomp_t), intent(in) :: decomp
character(len=*), intent(in) :: filename
real(kind=wp), intent(in) :: t
integer, intent(in) :: step
character(len=*), intent(in) :: drop_tag
integer, intent(out), optional :: ierr

Calls

proc~~ocean_state_restart_write_drop_field~~CallsGraph proc~ocean_state_restart_write_drop_field ocean_state_restart_write_drop_field proc~ocean_restart_write_local ocean_restart_write_local proc~ocean_state_restart_write_drop_field->proc~ocean_restart_write_local proc~ocean_state_build_restart_registry ocean_state_build_restart_registry proc~ocean_state_restart_write_drop_field->proc~ocean_state_build_restart_registry proc~ocean_state_fill_restart_metadata ocean_state_fill_restart_metadata proc~ocean_state_restart_write_drop_field->proc~ocean_state_fill_restart_metadata 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 proc~register_full_3d register_full_3d proc~ocean_state_build_restart_registry->proc~register_full_3d proc~register_full_3d_opt register_full_3d_opt proc~ocean_state_build_restart_registry->proc~register_full_3d_opt proc~registry_clear restart_registry_t%registry_clear proc~ocean_state_build_restart_registry->proc~registry_clear proc~registry_register_2d restart_registry_t%registry_register_2d proc~ocean_state_build_restart_registry->proc~registry_register_2d proc~registry_register_3d restart_registry_t%registry_register_3d proc~ocean_state_build_restart_registry->proc~registry_register_3d proc~registry_register_scalar restart_registry_t%registry_register_scalar proc~ocean_state_build_restart_registry->proc~registry_register_scalar proc~ocean_state_build_restart_registry->to_string proc~vcoord_type_name vcoord_type_name proc~ocean_state_fill_restart_metadata->proc~vcoord_type_name 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~register_full_3d->proc~registry_register_3d proc~register_full_3d_opt->proc~registry_register_3d proc~registry_register_2d->error proc~registry_register_2d->to_string proc~registry_register_3d->error proc~registry_register_3d->to_string proc~registry_register_scalar->error proc~registry_register_scalar->to_string proc~restart_io_ok->proc~nc_close proc~vcoord_type_name->to_string proc~fail->error proc~fail->proc~error_ring_push

Variables

Type Visibility Attributes Name Initial
integer, private :: e
logical, private :: found
type(ocean_restart_metadata_t), private :: meta
type(restart_registry_t), private :: reg

Source Code

   subroutine ocean_state_restart_write_drop_field(state, grid, decomp, filename, t, step, &
                                                   drop_tag, ierr)
      !! Test-only sibling of `ocean_state_restart_write`: identical,
      !! except the ONE registered entry whose tag matches `drop_tag` is
      !! written under a mangled tag instead of its real one, so a
      !! subsequent `ocean_state_restart_read`/`ocean_restart_read_local`
      !! -- which looks up variables by their REAL tag -- finds nothing
      !! and takes exactly the "optional field absent" path it takes for
      !! a genuinely older checkpoint.  `error stop`s if `drop_tag` does
      !! not match any registered entry (a typo here must not silently
      !! test nothing).
      type(ocean_state_t), intent(inout), target :: state
      type(hgrid_t), intent(in) :: grid
      type(decomp_t), intent(in) :: decomp
      character(len=*), intent(in) :: filename
      real(wp), intent(in) :: t
      integer, intent(in) :: step
      character(len=*), intent(in) :: drop_tag
      integer, intent(out), optional :: ierr
#ifndef RDB_NO_NETCDF
      type(restart_registry_t) :: reg
      type(ocean_restart_metadata_t) :: meta
      integer :: e
      logical :: found

      if (present(ierr)) ierr = OCEAN_STATUS_OK

      call ocean_state_build_restart_registry(state, grid, reg)
      call ocean_state_fill_restart_metadata(state, grid, meta)

      found = .false.
      do e = 1, reg%n
         associate (en => reg%entries(e))
            ! Device sync (same as ocean_state_restart_write): no `cycle`
            ! here, unlike that routine, because the tag check below must
            ! still run for every entry including host-only ones.
            if (en%device_mapped) then
               if (en%rank == 2) then
                  !$acc update self(en%p2)
               else if (en%rank == 3) then
                  !$acc update self(en%p3)
               end if
            end if
            if (trim(en%tag) == trim(drop_tag)) then
               en%tag = trim(drop_tag)//"_DROPPED_FOR_TEST"
               found = .true.
            end if
         end associate
      end do
      if (.not. found) then
         error stop "ocean_state_restart_write_drop_field: drop_tag not registered"
      end if

      call ocean_restart_write_local(filename, reg, decomp, meta, t, step, &
                                     state%dyn%outer_step_count, ierr=ierr)
#else
      call fail("ocean_state_restart_write_drop_field: built without NetCDF "// &
                "(RDB_ENABLE_NETCDF=ON required)", ierr, OCEAN_STATUS_ERR_IO)
#endif
   end subroutine ocean_state_restart_write_drop_field