13 use mom_io,
only : get_file_info, get_file_atts, get_file_fields, get_file_times
15 use mom_io,
only : multiple, netcdf_file, readonly_file, single_file
16 use mom_io,
only : center, corner, north_face, east_face
20 use mpp_mod,
only: mpp_chksum,mpp_pe
21 use mpp_io_mod,
only: mpp_attribute_exist, mpp_get_atts
23 implicit none ;
private
32 real,
dimension(:,:,:,:),
pointer :: p => null()
37 real,
dimension(:,:,:),
pointer :: p => null()
42 real,
dimension(:,:),
pointer :: p => null()
47 real,
dimension(:),
pointer :: p => null()
52 real,
pointer :: p => null()
61 logical :: initialized
62 character(len=32) :: var_name
67 character(len=32) :: field_name
68 character(len=32) :: replacement_name
76 integer :: num_obsolete_vars = 0
77 logical :: parallel_restartfiles
79 logical :: large_file_support
83 logical :: new_run_set = .false.
84 logical :: checksum_required
88 character(len=240) :: restartfile
97 type(
p0d),
pointer :: var_ptr0d(:) => null()
98 type(
p1d),
pointer :: var_ptr1d(:) => null()
99 type(
p2d),
pointer :: var_ptr2d(:) => null()
100 type(
p3d),
pointer :: var_ptr3d(:) => null()
101 type(
p4d),
pointer :: var_ptr4d(:) => null()
103 integer :: max_fields
128 character(*),
intent(in) :: field_name
129 character(*),
intent(in) :: replacement_name
132 cs%num_obsolete_vars = cs%num_obsolete_vars+1
133 cs%restart_obsolete(cs%num_obsolete_vars)%field_name = field_name
134 cs%restart_obsolete(cs%num_obsolete_vars)%replacement_name = replacement_name
139 real,
dimension(:,:,:), &
140 target,
intent(in) :: f_ptr
141 type(
vardesc),
intent(in) :: var_desc
142 logical,
intent(in) :: mandatory
146 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
147 "register_restart_field: Module must be initialized before it is used.")
149 cs%novars = cs%novars+1
150 if (cs%novars > cs%max_fields)
return
153 cs%restart_field(cs%novars)%vars = var_desc
154 cs%restart_field(cs%novars)%mand_var = mandatory
155 cs%restart_field(cs%novars)%initialized = .false.
156 call query_vardesc(cs%restart_field(cs%novars)%vars, &
157 name=cs%restart_field(cs%novars)%var_name, &
158 caller=
"register_restart_field_ptr3d")
160 cs%var_ptr3d(cs%novars)%p => f_ptr
161 cs%var_ptr4d(cs%novars)%p => null()
162 cs%var_ptr2d(cs%novars)%p => null()
163 cs%var_ptr1d(cs%novars)%p => null()
164 cs%var_ptr0d(cs%novars)%p => null()
170 real,
dimension(:,:,:,:), &
171 target,
intent(in) :: f_ptr
172 type(
vardesc),
intent(in) :: var_desc
173 logical,
intent(in) :: mandatory
177 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
178 "register_restart_field: Module must be initialized before it is used.")
180 cs%novars = cs%novars+1
181 if (cs%novars > cs%max_fields)
return
184 cs%restart_field(cs%novars)%vars = var_desc
185 cs%restart_field(cs%novars)%mand_var = mandatory
186 cs%restart_field(cs%novars)%initialized = .false.
187 call query_vardesc(cs%restart_field(cs%novars)%vars, &
188 name=cs%restart_field(cs%novars)%var_name, &
189 caller=
"register_restart_field_ptr4d")
191 cs%var_ptr4d(cs%novars)%p => f_ptr
192 cs%var_ptr3d(cs%novars)%p => null()
193 cs%var_ptr2d(cs%novars)%p => null()
194 cs%var_ptr1d(cs%novars)%p => null()
195 cs%var_ptr0d(cs%novars)%p => null()
201 real,
dimension(:,:), &
202 target,
intent(in) :: f_ptr
203 type(
vardesc),
intent(in) :: var_desc
204 logical,
intent(in) :: mandatory
208 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
209 "register_restart_field: Module must be initialized before it is used.")
211 cs%novars = cs%novars+1
212 if (cs%novars > cs%max_fields)
return
215 cs%restart_field(cs%novars)%vars = var_desc
216 cs%restart_field(cs%novars)%mand_var = mandatory
217 cs%restart_field(cs%novars)%initialized = .false.
218 call query_vardesc(cs%restart_field(cs%novars)%vars, &
219 name=cs%restart_field(cs%novars)%var_name, &
220 caller=
"register_restart_field_ptr2d")
222 cs%var_ptr2d(cs%novars)%p => f_ptr
223 cs%var_ptr4d(cs%novars)%p => null()
224 cs%var_ptr3d(cs%novars)%p => null()
225 cs%var_ptr1d(cs%novars)%p => null()
226 cs%var_ptr0d(cs%novars)%p => null()
232 real,
dimension(:),
target,
intent(in) :: f_ptr
233 type(
vardesc),
intent(in) :: var_desc
234 logical,
intent(in) :: mandatory
238 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
239 "register_restart_field: Module must be initialized before it is used.")
241 cs%novars = cs%novars+1
242 if (cs%novars > cs%max_fields)
return
245 cs%restart_field(cs%novars)%vars = var_desc
246 cs%restart_field(cs%novars)%mand_var = mandatory
247 cs%restart_field(cs%novars)%initialized = .false.
248 call query_vardesc(cs%restart_field(cs%novars)%vars, &
249 name=cs%restart_field(cs%novars)%var_name, &
250 caller=
"register_restart_field_ptr1d")
252 cs%var_ptr1d(cs%novars)%p => f_ptr
253 cs%var_ptr4d(cs%novars)%p => null()
254 cs%var_ptr3d(cs%novars)%p => null()
255 cs%var_ptr2d(cs%novars)%p => null()
256 cs%var_ptr0d(cs%novars)%p => null()
262 real,
target,
intent(in) :: f_ptr
263 type(
vardesc),
intent(in) :: var_desc
264 logical,
intent(in) :: mandatory
268 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
269 "register_restart_field: Module must be initialized before it is used.")
271 cs%novars = cs%novars+1
272 if (cs%novars > cs%max_fields)
return
275 cs%restart_field(cs%novars)%vars = var_desc
276 cs%restart_field(cs%novars)%mand_var = mandatory
277 cs%restart_field(cs%novars)%initialized = .false.
278 call query_vardesc(cs%restart_field(cs%novars)%vars, &
279 name=cs%restart_field(cs%novars)%var_name, &
280 caller=
"register_restart_field_ptr0d")
282 cs%var_ptr0d(cs%novars)%p => f_ptr
283 cs%var_ptr4d(cs%novars)%p => null()
284 cs%var_ptr3d(cs%novars)%p => null()
285 cs%var_ptr2d(cs%novars)%p => null()
286 cs%var_ptr1d(cs%novars)%p => null()
294 hor_grid, z_grid, t_grid)
295 real,
dimension(:,:,:,:), &
296 target,
intent(in) :: f_ptr
297 character(len=*),
intent(in) :: name
298 logical,
intent(in) :: mandatory
301 character(len=*),
optional,
intent(in) :: longname
302 character(len=*),
optional,
intent(in) :: units
303 character(len=*),
optional,
intent(in) :: hor_grid
304 character(len=*),
optional,
intent(in) :: z_grid
305 character(len=*),
optional,
intent(in) :: t_grid
309 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart: " // &
310 "register_restart_field_4d: Module must be initialized before "//&
311 "it is used to register "//trim(name))
312 vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
313 z_grid=z_grid, t_grid=t_grid)
321 hor_grid, z_grid, t_grid)
322 real,
dimension(:,:,:), &
323 target,
intent(in) :: f_ptr
324 character(len=*),
intent(in) :: name
325 logical,
intent(in) :: mandatory
328 character(len=*),
optional,
intent(in) :: longname
329 character(len=*),
optional,
intent(in) :: units
330 character(len=*),
optional,
intent(in) :: hor_grid
331 character(len=*),
optional,
intent(in) :: z_grid
332 character(len=*),
optional,
intent(in) :: t_grid
336 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart: " // &
337 "register_restart_field_3d: Module must be initialized before "//&
338 "it is used to register "//trim(name))
339 vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
340 z_grid=z_grid, t_grid=t_grid)
348 hor_grid, z_grid, t_grid)
349 real,
dimension(:,:), &
350 target,
intent(in) :: f_ptr
351 character(len=*),
intent(in) :: name
352 logical,
intent(in) :: mandatory
355 character(len=*),
optional,
intent(in) :: longname
356 character(len=*),
optional,
intent(in) :: units
357 character(len=*),
optional,
intent(in) :: hor_grid
358 character(len=*),
optional,
intent(in) :: z_grid
359 character(len=*),
optional,
intent(in) :: t_grid
362 character(len=8) :: Zgrid
364 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart: " // &
365 "register_restart_field_2d: Module must be initialized before "//&
366 "it is used to register "//trim(name))
367 zgrid =
'1' ;
if (
present(z_grid)) zgrid = z_grid
368 vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
369 z_grid=zgrid, t_grid=t_grid)
377 hor_grid, z_grid, t_grid)
378 real,
dimension(:),
target,
intent(in) :: f_ptr
379 character(len=*),
intent(in) :: name
380 logical,
intent(in) :: mandatory
383 character(len=*),
optional,
intent(in) :: longname
384 character(len=*),
optional,
intent(in) :: units
385 character(len=*),
optional,
intent(in) :: hor_grid
386 character(len=*),
optional,
intent(in) :: z_grid
387 character(len=*),
optional,
intent(in) :: t_grid
390 character(len=8) :: hgrid
392 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart: " // &
393 "register_restart_field_3d: Module must be initialized before "//&
394 "it is used to register "//trim(name))
395 hgrid =
'1' ;
if (
present(hor_grid)) hgrid = hor_grid
396 vd = var_desc(name, units=units, longname=longname, hor_grid=hgrid, &
397 z_grid=z_grid, t_grid=t_grid)
406 real,
target,
intent(in) :: f_ptr
407 character(len=*),
intent(in) :: name
408 logical,
intent(in) :: mandatory
411 character(len=*),
optional,
intent(in) :: longname
412 character(len=*),
optional,
intent(in) :: units
413 character(len=*),
optional,
intent(in) :: t_grid
416 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart: " // &
417 "register_restart_field_0d: Module must be initialized before "//&
418 "it is used to register "//trim(name))
419 vd = var_desc(name, units=units, longname=longname, hor_grid=
'1', &
420 z_grid=
'1', t_grid=t_grid)
430 character(len=*),
intent(in) :: name
437 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
438 "query_initialized: Module must be initialized before it is used.")
444 if (trim(name) == cs%restart_field(m)%var_name)
then
451 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
453 call mom_error(note,
"MOM_restart: Unknown restart variable "//name// &
454 " queried for initialization.")
457 call mom_error(note,
"MOM_restart: "//name// &
458 " initialization confirmed by name.")
464 real,
target,
intent(in) :: f_ptr
471 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
472 "query_initialized: Module must be initialized before it is used.")
478 if (
associated(cs%var_ptr0d(m)%p,f_ptr))
then
485 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
491 real,
dimension(:),
target,
intent(in) :: f_ptr
498 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
499 "query_initialized: Module must be initialized before it is used.")
505 if (
associated(cs%var_ptr1d(m)%p,f_ptr))
then
512 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
518 real,
dimension(:,:), &
519 target,
intent(in) :: f_ptr
526 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
527 "query_initialized: Module must be initialized before it is used.")
533 if (
associated(cs%var_ptr2d(m)%p,f_ptr))
then
540 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
546 real,
dimension(:,:,:), &
547 target,
intent(in) :: f_ptr
554 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
555 "query_initialized: Module must be initialized before it is used.")
561 if (
associated(cs%var_ptr3d(m)%p,f_ptr))
then
568 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
574 real,
dimension(:,:,:,:), &
575 target,
intent(in) :: f_ptr
582 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
583 "query_initialized: Module must be initialized before it is used.")
589 if (
associated(cs%var_ptr4d(m)%p,f_ptr))
then
596 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
603 real,
target,
intent(in) :: f_ptr
604 character(len=*),
intent(in) :: name
611 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
612 "query_initialized: Module must be initialized before it is used.")
618 if (
associated(cs%var_ptr0d(m)%p,f_ptr))
then
625 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
626 if (n==cs%novars+1)
then
628 call mom_error(note,
"MOM_restart: Unable to find "//name//
" queried by pointer, "//&
629 "probably because of the suspect comparison of pointers by ASSOCIATED.")
638 real,
dimension(:), &
639 target,
intent(in) :: f_ptr
640 character(len=*),
intent(in) :: name
647 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
648 "query_initialized: Module must be initialized before it is used.")
654 if (
associated(cs%var_ptr1d(m)%p,f_ptr))
then
661 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
662 if (n==cs%novars+1)
then
664 call mom_error(note,
"MOM_restart: Unable to find "//name//
" queried by pointer, "//&
665 "probably because of the suspect comparison of pointers by ASSOCIATED.")
674 real,
dimension(:,:), &
675 target,
intent(in) :: f_ptr
676 character(len=*),
intent(in) :: name
683 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
684 "query_initialized: Module must be initialized before it is used.")
690 if (
associated(cs%var_ptr2d(m)%p,f_ptr))
then
697 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
698 if (n==cs%novars+1)
then
700 call mom_error(note,
"MOM_restart: Unable to find "//name//
" queried by pointer, "//&
701 "probably because of the suspect comparison of pointers by ASSOCIATED.")
710 real,
dimension(:,:,:), &
711 target,
intent(in) :: f_ptr
712 character(len=*),
intent(in) :: name
719 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
720 "query_initialized: Module must be initialized before it is used.")
726 if (
associated(cs%var_ptr3d(m)%p,f_ptr))
then
733 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
734 if (n==cs%novars+1)
then
736 call mom_error(note,
"MOM_restart: Unable to find "//name//
" queried by pointer, "//&
737 "possibly because of the suspect comparison of pointers by ASSOCIATED.")
746 real,
dimension(:,:,:,:), &
747 target,
intent(in) :: f_ptr
748 character(len=*),
intent(in) :: name
755 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
756 "query_initialized: Module must be initialized before it is used.")
762 if (
associated(cs%var_ptr4d(m)%p,f_ptr))
then
769 if (n<=cs%novars) cs%restart_field(n)%initialized = .true.
770 if (n==cs%novars+1)
then
772 call mom_error(note,
"MOM_restart: Unable to find "//name//
" queried by pointer, "//&
773 "possibly because of the suspect comparison of pointers by ASSOCIATED.")
780 subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV)
781 character(len=*),
intent(in) :: directory
783 type(time_type),
intent(in) :: time
787 logical,
optional,
intent(in) :: time_stamped
789 character(len=*),
optional,
intent(in) :: filename
793 type(
vardesc) :: vars(cs%max_fields)
795 type(fieldtype) :: fields(cs%max_fields)
796 character(len=512) :: restartpath
797 character(len=256) :: restartname
798 character(len=8) :: suffix
800 integer(kind=8) :: var_sz, size_in_file
802 integer(kind=8) :: max_file_size = 2147483647_8
805 integer :: start_var, next_var
808 integer :: m, nz, num_files, var_periods
809 integer :: seconds, days, year, month, hour, minute
810 character(len=8) :: hor_grid, z_grid, t_grid
811 character(len=8) :: t_grid_read
812 character(len=64) :: var_name
814 character(len=32) :: filename_appendix =
''
816 integer(kind=8) :: check_val(cs%max_fields,1)
817 integer :: isl, iel, jsl, jel, pos
819 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
820 "save_restart: Module must be initialized before it is used.")
826 if (cs%large_file_support) max_file_size = 4294967292_8
830 nz = 1 ;
if (
present(gv)) nz = gv%ke
832 restart_time = time_type_to_real(time) / 86400.0
834 restartname = trim(cs%restartfile)
835 if (
present(filename)) restartname = trim(filename)
836 if (
PRESENT(time_stamped))
then ;
if (time_stamped)
then
837 call get_date(time,year,month,days,hour,minute,seconds)
840 days = days + days_in_month(set_date(year,m,2,0,0,0))
842 seconds = seconds + 60*minute + 3600*hour
843 if (year <= 9999)
then
844 write(restartname,
'("_Y",I4.4,"_D",I3.3,"_S",I5.5)') year, days, seconds
845 elseif (year <= 99999)
then
846 write(restartname,
'("_Y",I5.5,"_D",I3.3,"_S",I5.5)') year, days, seconds
848 write(restartname,
'("_Y",I10.10,"_D",I3.3,"_S",I5.5)') year, days, seconds
850 restartname = trim(cs%restartfile)//trim(restartname)
854 do while (next_var <= cs%novars )
856 size_in_file = 8*(2*g%Domain%niglobal+2*g%Domain%njglobal+2*nz+1000)
858 do m=start_var,cs%novars
859 call query_vardesc(cs%restart_field(m)%vars, hor_grid=hor_grid, &
860 z_grid=z_grid, t_grid=t_grid, caller=
"save_restart")
861 if (hor_grid ==
'1')
then
864 var_sz = 8*(g%Domain%niglobal+1)*(g%Domain%njglobal+1)
867 case (
'L') ; var_sz = var_sz * nz
868 case (
'i') ; var_sz = var_sz * (nz+1)
870 t_grid = adjustl(t_grid)
871 if (t_grid(1:1) ==
'p')
then
872 if (len_trim(t_grid(2:8)) > 0)
then
874 t_grid_read = adjustl(t_grid(2:8))
875 read(t_grid_read,*) var_periods
876 if (var_periods > 1) var_sz = var_sz * var_periods
880 if ((m==start_var) .OR. (size_in_file < max_file_size-var_sz))
then
881 size_in_file = size_in_file + var_sz
889 call get_filename_appendix(filename_appendix)
890 if (len_trim(filename_appendix) > 0)
then
891 length = len_trim(restartname)
892 if (restartname(length-2:length) ==
'.nc')
then
893 restartname = restartname(1:length-3)//
'.'//trim(filename_appendix)//
'.nc'
895 restartname = restartname(1:length) //
'.'//trim(filename_appendix)
899 restartpath = trim(directory)// trim(restartname)
901 if (num_files < 10)
then
902 write(suffix,
'("_",I1)') num_files
904 write(suffix,
'("_",I2)') num_files
907 if (num_files > 0) restartpath = trim(restartpath) // trim(suffix)
909 do m=start_var,next_var-1
910 vars(m-start_var+1) = cs%restart_field(m)%vars
912 call query_vardesc(vars(1), t_grid=t_grid, hor_grid=hor_grid, caller=
"save_restart")
913 t_grid = adjustl(t_grid)
914 if (t_grid(1:1) /=
'p') &
915 call modify_vardesc(vars(1), t_grid=
's', caller=
"save_restart")
916 select case (hor_grid)
917 case (
'q') ; pos = corner
918 case (
'h') ; pos = center
919 case (
'u') ; pos = east_face
920 case (
'v') ; pos = north_face
921 case (
'Bu') ; pos = corner
922 case (
'T') ; pos = center
923 case (
'Cu') ; pos = east_face
924 case (
'Cv') ; pos = north_face
926 case default ; pos = 0
931 do m=start_var,next_var-1
932 if (
associated(cs%var_ptr3d(m)%p))
then
933 check_val(m-start_var+1,1) = mpp_chksum(cs%var_ptr3d(m)%p(isl:iel,jsl:jel,:))
934 elseif (
associated(cs%var_ptr2d(m)%p))
then
935 check_val(m-start_var+1,1) = mpp_chksum(cs%var_ptr2d(m)%p(isl:iel,jsl:jel))
936 elseif (
associated(cs%var_ptr4d(m)%p))
then
937 check_val(m-start_var+1,1) = mpp_chksum(cs%var_ptr4d(m)%p(isl:iel,jsl:jel,:,:))
938 elseif (
associated(cs%var_ptr1d(m)%p))
then
939 check_val(m-start_var+1,1) = mpp_chksum(cs%var_ptr1d(m)%p)
940 elseif (
associated(cs%var_ptr0d(m)%p))
then
941 check_val(m-start_var+1,1) = mpp_chksum(cs%var_ptr0d(m)%p,pelist=(/mpp_pe()/))
945 if (cs%parallel_restartfiles)
then
946 call create_file(unit, trim(restartpath), vars, (next_var-start_var), &
947 fields, multiple, g=g, gv=gv, checksums=check_val)
949 call create_file(unit, trim(restartpath), vars, (next_var-start_var), &
950 fields, single_file, g=g, gv=gv, checksums=check_val)
953 do m=start_var,next_var-1
955 if (
associated(cs%var_ptr3d(m)%p))
then
956 call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
957 cs%var_ptr3d(m)%p, restart_time)
958 elseif (
associated(cs%var_ptr2d(m)%p))
then
959 call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
960 cs%var_ptr2d(m)%p, restart_time)
961 elseif (
associated(cs%var_ptr4d(m)%p))
then
962 call write_field(unit,fields(m-start_var+1), g%Domain%mpp_domain, &
963 cs%var_ptr4d(m)%p, restart_time)
964 elseif (
associated(cs%var_ptr1d(m)%p))
then
965 call write_field(unit, fields(m-start_var+1), cs%var_ptr1d(m)%p, &
967 elseif (
associated(cs%var_ptr0d(m)%p))
then
968 call write_field(unit, fields(m-start_var+1), cs%var_ptr0d(m)%p, &
973 call close_file(unit)
975 num_files = num_files+1
984 character(len=*),
intent(in) :: filename
986 character(len=*),
intent(in) :: directory
987 type(time_type),
intent(out) :: day
997 character(len=200) :: filepath
998 character(len=80) :: fname
999 character(len=8) :: suffix
1001 character(len=512) :: mesg
1002 character(len=80) :: varname
1005 integer :: i, n, m, missing_fields
1006 integer :: isl, iel, jsl, jel, is0, js0
1008 integer :: ndim, nvar, natt, ntime, pos
1010 integer :: unit(cs%max_fields)
1011 character(len=200) :: unit_path(cs%max_fields)
1012 logical :: unit_is_global(cs%max_fields)
1014 character(len=8) :: hor_grid
1016 real,
allocatable :: time_vals(:)
1017 type(fieldtype),
allocatable :: fields(:)
1018 logical :: check_exist, is_there_a_checksum
1019 integer(kind=8),
dimension(3) :: checksum_file
1020 integer(kind=8) :: checksum_data
1022 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
1023 "restore_state: Module must be initialized before it is used.")
1027 if ((len_trim(filename) == 1) .and. (filename(1:1) ==
'F'))
then
1029 file_paths=unit_path, global_files=unit_is_global)
1032 file_paths=unit_path, global_files=unit_is_global)
1035 if (num_file == 0)
then
1036 write(mesg,
'("Unable to find any restart files specified by ",A," in directory ",A,".")') &
1037 trim(filename), trim(directory)
1038 call mom_error(fatal,
"MOM_restart: "//mesg)
1043 call get_file_info(unit(n), ndim, nvar, natt, ntime)
1044 if (ntime < 1) cycle
1046 allocate(time_vals(ntime))
1047 call get_file_times(unit(n), time_vals)
1049 deallocate(time_vals)
1051 day = real_to_time(t1*86400.0)
1055 if (n>num_file)
call mom_error(warning,
"MOM_restart: " // &
1056 "No times found in restart files.")
1062 call get_file_info(unit(n), ndim, nvar, natt, ntime)
1063 if (ntime < 1) cycle
1065 allocate(time_vals(ntime))
1066 call get_file_times(unit(n), time_vals)
1068 deallocate(time_vals)
1071 write(mesg,
'("WARNING: Restart file ",I2," has time ",F10.4,"whereas &
1072 &simulation is restarted at ",F10.4," (differing by ",F10.4,").")')&
1074 call mom_error(warning,
"MOM_restart: "//mesg)
1081 call get_file_info(unit(n), ndim, nvar, natt, ntime)
1083 allocate(fields(nvar))
1084 call get_file_fields(unit(n),fields(1:nvar))
1087 call get_file_atts(fields(m),name=varname)
1088 do i=1,cs%num_obsolete_vars
1089 if (adjustl(
lowercase(trim(varname))) == adjustl(
lowercase(trim(cs%restart_obsolete(i)%field_name))))
then
1090 call mom_error(fatal,
"MOM_restart restore_state: Attempting to use obsolete restart field "//&
1091 trim(varname)//
" - the new corresponding restart field is "//&
1092 trim(cs%restart_obsolete(i)%replacement_name))
1100 if (cs%restart_field(m)%initialized) cycle
1101 call query_vardesc(cs%restart_field(m)%vars, hor_grid=hor_grid, &
1102 caller=
"restore_state")
1103 select case (hor_grid)
1104 case (
'q') ; pos = corner
1105 case (
'h') ; pos = center
1106 case (
'u') ; pos = east_face
1107 case (
'v') ; pos = north_face
1108 case (
'Bu') ; pos = corner
1109 case (
'T') ; pos = center
1110 case (
'Cu') ; pos = east_face
1111 case (
'Cv') ; pos = north_face
1112 case (
'1') ; pos = 0
1113 case default ; pos = 0
1118 call get_file_atts(fields(i),name=varname)
1120 check_exist = mpp_attribute_exist(fields(i),
"checksum")
1121 checksum_file(:) = -1
1123 is_there_a_checksum = .false.
1124 if ( check_exist )
then
1125 call mpp_get_atts(fields(i),checksum=checksum_file)
1126 is_there_a_checksum = .true.
1128 if (.NOT. cs%checksum_required) is_there_a_checksum = .false.
1130 if (
associated(cs%var_ptr1d(m)%p))
then
1132 call read_data(unit_path(n), varname, cs%var_ptr1d(m)%p, &
1133 g%Domain%mpp_domain, timelevel=1)
1134 if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr1d(m)%p)
1135 elseif (
associated(cs%var_ptr0d(m)%p))
then
1136 call read_data(unit_path(n), varname, cs%var_ptr0d(m)%p, &
1137 g%Domain%mpp_domain, timelevel=1)
1138 if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr0d(m)%p,pelist=(/mpp_pe()/))
1139 elseif (
associated(cs%var_ptr2d(m)%p))
then
1141 call mom_read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1142 g%Domain, timelevel=1, position=pos)
1144 call read_data(unit_path(n), varname, cs%var_ptr2d(m)%p, &
1145 no_domain=.true., timelevel=1)
1147 if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr2d(m)%p(isl:iel,jsl:jel))
1148 elseif (
associated(cs%var_ptr3d(m)%p))
then
1150 call mom_read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1151 g%Domain, timelevel=1, position=pos)
1153 call read_data(unit_path(n), varname, cs%var_ptr3d(m)%p, &
1154 no_domain=.true., timelevel=1)
1156 if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr3d(m)%p(isl:iel,jsl:jel,:))
1157 elseif (
associated(cs%var_ptr4d(m)%p))
then
1159 call mom_read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1160 g%Domain, timelevel=1, position=pos)
1162 call read_data(unit_path(n), varname, cs%var_ptr4d(m)%p, &
1163 no_domain=.true., timelevel=1)
1165 if (is_there_a_checksum) checksum_data = mpp_chksum(cs%var_ptr4d(m)%p(isl:iel,jsl:jel,:,:))
1167 call mom_error(fatal,
"MOM_restart restore_state: No pointers set for "//trim(varname))
1170 if (
is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data))
then
1171 write (mesg,
'(a,Z16,a,Z16,a)')
"Checksum of input field "// trim(varname)//
" ",checksum_data,&
1172 " does not match value ", checksum_file(1), &
1173 " stored in "//trim(unit_path(n)//
"." )
1174 call mom_error(fatal,
"MOM_restart(restore_state): "//trim(mesg) )
1177 cs%restart_field(m)%initialized = .true.
1181 if (i>nvar) missing_fields = missing_fields+1
1185 if (missing_fields == 0)
exit
1189 call close_file(unit(n))
1195 if (.not.(cs%restart_field(m)%initialized))
then
1196 cs%restart = .false.
1197 if (cs%restart_field(m)%mand_var)
then
1198 call mom_error(fatal,
"MOM_restart: Unable to find mandatory variable " &
1199 //trim(cs%restart_field(m)%var_name)//
" in restart files.")
1208 character(len=*),
intent(in) :: filename
1210 character(len=*),
intent(in) :: directory
1217 integer :: num_files
1219 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
1220 "restart_files_exist: Module must be initialized before it is used.")
1222 if ((len_trim(filename) == 1) .and. (filename(1:1) ==
'F'))
then
1235 character(len=*),
intent(in) :: filename
1237 character(len=*),
intent(in) :: directory
1245 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
1246 "determine_is_new_run: Module must be initialized before it is used.")
1247 if (len_trim(filename) > 1)
then
1248 cs%new_run = .false.
1249 elseif (len_trim(filename) == 0)
then
1251 elseif (filename(1:1) ==
'n')
then
1253 elseif (filename(1:1) ==
'F')
then
1256 cs%new_run = .false.
1259 cs%new_run_set = .true.
1272 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
1273 "is_new_run: Module must be initialized before it is used.")
1274 if (.not.cs%new_run_set)
call mom_error(fatal,
"MOM_restart " // &
1275 "determine_is_new_run must be called for a restart file before is_new_run.")
1283 global_files)
result(num_files)
1284 character(len=*),
intent(in) :: filename
1286 character(len=*),
intent(in) :: directory
1290 integer,
dimension(:), &
1291 optional,
intent(out) :: units
1292 character(len=*),
dimension(:), &
1293 optional,
intent(out) :: file_paths
1294 logical,
dimension(:), &
1295 optional,
intent(out) :: global_files
1297 integer :: num_files
1305 character(len=256) :: filepath
1306 character(len=256) :: fname
1307 character(len=8) :: suffix
1310 integer :: num_restart
1312 integer :: start_char
1314 integer :: n, m, err, length
1318 character(len=32) :: filename_appendix =
''
1319 character(len=80) :: restartname
1321 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_restart " // &
1322 "open_restart_units: Module must be initialized before it is used.")
1325 num_restart = 0 ; n = 1 ; start_char = 1
1326 do while (start_char <= len_trim(filename) )
1327 do m=start_char,len_trim(filename)
1328 if (filename(m:m) ==
' ')
exit
1330 fname = filename(start_char:m-1)
1332 do while (start_char <= len_trim(filename))
1333 if (filename(start_char:start_char) ==
' ')
then
1334 start_char = start_char + 1
1340 if ((fname(1:1)==
'r') .and. ( len_trim(fname) == 1))
then
1342 if (num_restart > 0) err = 1
1344 restartname = trim(cs%restartfile)
1347 call get_filename_appendix(filename_appendix)
1348 if (len_trim(filename_appendix) > 0)
then
1349 length = len_trim(restartname)
1350 if (restartname(length-2:length) ==
'.nc')
then
1351 restartname = restartname(1:length-3)//
'.'//trim(filename_appendix)//
'.nc'
1353 restartname = restartname(1:length) //
'.'//trim(filename_appendix)
1356 filepath = trim(directory) // trim(restartname)
1358 if (num_restart < 10)
then
1359 write(suffix,
'("_",I1)') num_restart
1361 write(suffix,
'("_",I2)') num_restart
1363 if (num_restart > 0) filepath = trim(filepath) // suffix
1366 filepath = trim(filepath)//
".nc"
1368 num_restart = num_restart + 1
1369 inquire(file=filepath, exist=fexists)
1371 if (
present(units)) &
1372 call open_file(units(n), trim(filepath), readonly_file, netcdf_file, &
1373 threading = multiple, fileset = single_file)
1374 if (
present(global_files)) global_files(n) = .true.
1375 elseif (cs%parallel_restartfiles)
then
1378 if (fexists .and. (
present(units))) &
1379 call open_file(units(n), trim(filepath), readonly_file, netcdf_file, &
1380 domain=g%Domain%mpp_domain)
1381 if (fexists .and.
present(global_files)) global_files(n) = .false.
1385 if (
present(file_paths)) file_paths(n) = filepath
1388 call mom_error(note,
"MOM_restart: MOM run restarted using : "//trim(filepath))
1394 filepath = trim(directory)//trim(fname)
1395 inquire(file=filepath, exist=fexists)
1396 if (.not. fexists) filepath = trim(filepath)//
".nc"
1398 inquire(file=filepath, exist=fexists)
1400 if (
present(units)) &
1401 call open_file(units(n), trim(filepath), readonly_file, netcdf_file, &
1402 threading = multiple, fileset = single_file)
1403 if (
present(global_files)) global_files(n) = .true.
1404 if (
present(file_paths)) file_paths(n) = filepath
1407 call mom_error(note,
"MOM_restart: MOM run restarted using : "//trim(filepath))
1409 if (
present(units)) &
1410 call mom_error(warning,
"MOM_restart: Unable to find restart file : "//trim(filepath))
1423 character(len=*),
optional, &
1424 intent(in) :: restart_root
1429 #include "version_variable.h"
1430 character(len=40) :: mdl =
"MOM_restart"
1432 if (
associated(cs))
then
1433 call mom_error(warning,
"restart_init called with an associated control structure.")
1440 call get_param(param_file, mdl,
"PARALLEL_RESTARTFILES", &
1441 cs%parallel_restartfiles, &
1442 "If true, each processor writes its own restart file, "//&
1443 "otherwise a single restart file is generated", &
1446 if (
present(restart_root))
then
1447 cs%restartfile = restart_root
1448 call log_param(param_file, mdl,
"RESTARTFILE from argument", cs%restartfile)
1450 call get_param(param_file, mdl,
"RESTARTFILE", cs%restartfile, &
1451 "The name-root of the restart file.", default=
"MOM.res")
1453 call get_param(param_file, mdl,
"LARGE_FILE_SUPPORT", cs%large_file_support, &
1454 "If true, use the file-size limits with NetCDF large "//&
1455 "file support (4Gb), otherwise the limit is 2Gb.", &
1457 call get_param(param_file, mdl,
"MAX_FIELDS", cs%max_fields, &
1458 "The maximum number of restart fields that can be used.", &
1460 call get_param(param_file, mdl,
"RESTART_CHECKSUMS_REQUIRED", cs%checksum_required, &
1461 "If true, require the restart checksums to match and error out otherwise. "//&
1462 "Users may want to avoid this comparison if for example the restarts are "//&
1463 "made from a run with a different mask_table than the current run, "//&
1464 "in which case the checksums will not match and cause crash.",&
1467 allocate(cs%restart_field(cs%max_fields))
1468 allocate(cs%restart_obsolete(cs%max_fields))
1469 allocate(cs%var_ptr0d(cs%max_fields))
1470 allocate(cs%var_ptr1d(cs%max_fields))
1471 allocate(cs%var_ptr2d(cs%max_fields))
1472 allocate(cs%var_ptr3d(cs%max_fields))
1473 allocate(cs%var_ptr4d(cs%max_fields))
1481 if (
associated(cs))
then
1491 if (
associated(cs%restart_field))
deallocate(cs%restart_field)
1492 if (
associated(cs%restart_obsolete))
deallocate(cs%restart_obsolete)
1493 if (
associated(cs%var_ptr0d))
deallocate(cs%var_ptr0d)
1494 if (
associated(cs%var_ptr1d))
deallocate(cs%var_ptr1d)
1495 if (
associated(cs%var_ptr2d))
deallocate(cs%var_ptr2d)
1496 if (
associated(cs%var_ptr3d))
deallocate(cs%var_ptr3d)
1497 if (
associated(cs%var_ptr4d))
deallocate(cs%var_ptr4d)
1505 character(len=16) :: num
1507 if (cs%novars > cs%max_fields)
then
1508 write(num,
'(I0)') cs%novars
1509 call mom_error(fatal,
"MOM_restart: Too many fields registered for " // &
1510 "restart. Set MAX_FIELDS to be at least " // &
1511 trim(adjustl(num)) //
" in the MOM input file.")
1513 call mom_error(fatal,
"MOM_restart: Unspecified fatal error.")
1520 integer,
intent(in) :: pos
1521 integer,
intent(out) :: isL
1522 integer,
intent(out) :: ieL
1523 integer,
intent(out) :: jsL
1524 integer,
intent(out) :: jeL
1533 if (g%symmetric)
then
1534 if ((pos == east_face) .or. (pos == corner))
then
1535 if (g%idg_offset == 0) isl = isl - 1
1537 if ((pos == north_face) .or. (pos == corner))
then
1538 if (g%jdg_offset == 0) jsl = jsl - 1