FMS  2025.04
Flexible Modeling System
blackboxio.F90
1 !***********************************************************************
2 !* Apache License 2.0
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* Licensed under the Apache License, Version 2.0 (the "License");
7 !* you may not use this file except in compliance with the License.
8 !* You may obtain a copy of the License at
9 !*
10 !* http://www.apache.org/licenses/LICENSE-2.0
11 !*
12 !* FMS is distributed in the hope that it will be useful, but WITHOUT
13 !* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
14 !* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
15 !* PARTICULAR PURPOSE. See the License for the specific language
16 !* governing permissions and limitations under the License.
17 !***********************************************************************
18 !> @defgroup blackboxio blackboxio
19 !> @ingroup fms2_io
20 !> @brief File utility functions for use within @ref fms2_io
21 
22 !> @addtogroup blackboxio
23 !> @{
24 module blackboxio
25 use netcdf
26 use mpp_domains_mod
27 use fms_io_utils_mod
28 use netcdf_io_mod
29 use fms_netcdf_domain_io_mod
30 use fms_netcdf_unstructured_domain_io_mod
31 use mpp_mod, only: mpp_pe
32 use, intrinsic :: iso_fortran_env, only: error_unit
33 use platform_mod
34 implicit none
35 private
36 
37 integer, private :: fms2_ncchksz = -1 !< Chunksize (bytes) used in nc_open and nc_create
38 
39 public :: blackboxio_init
48 
49 
50 contains
51 !> @brief Accepts the namelist fms2_io_nml variables relevant to blackboxio
52 subroutine blackboxio_init (chksz)
53 integer, intent(in) :: chksz
54  fms2_ncchksz = chksz
55 end subroutine blackboxio_init
56 
57 
58 !> @brief Create a new file path.
59 !! @internal
60 subroutine get_new_filename(path, new_path, directory, timestamp, new_name)
61 
62  character(len=*), intent(in) :: path !< File path.
63  character(len=*), intent(out) :: new_path !< New file path.
64  character(len=*), intent(in), optional :: directory !< Directory
65  character(len=*), intent(in), optional :: timestamp !< Time.
66  character(len=*), intent(in), optional :: new_name !< New file basename.
67 
68  character(len=FMS_PATH_LEN) :: dir
69  character(len=FMS_FILE_LEN) :: tstamp
70  character(len=FMS_PATH_LEN) :: nname
71 
72  dir = ""
73  if (present(directory)) then
74  call string_copy(dir, trim(directory)//"/")
75  endif
76  tstamp = ""
77  if (present(timestamp)) then
78  call string_copy(tstamp, trim(timestamp)//".")
79  endif
80  call string_copy(nname, trim(path))
81  if (present(new_name)) then
82  call string_copy(nname, trim(new_name))
83  endif
84  call string_copy(new_path, trim(dir)//trim(tstamp)//trim(nname))
85 end subroutine get_new_filename
86 
87 
88 !> @brief Create a unique filename (poor man's version of mktemp).
89 !! @internal
90 subroutine tempfile(filename)
91 
92  character(len=*), intent(out) :: filename !< New unique filename.
93 
94  real :: numr
95  integer :: numi
96 
97  do while(.true.)
98  call random_number(numr)
99  numi = transfer(numr, numi)
100  numi = iand(numi, z'FFFFFF')
101  write(filename, '(a,z6.6)') "tmp", numi
102  if (.not. file_exists(filename)) then
103  exit
104  endif
105  enddo
106 end subroutine tempfile
107 
108 
109 !> @brief Create a "diskless" netcdf file to act as a buffer to support our "register
110 !! data to a file without knowing its name" legacy restart I/O workflow.
111 !! @return Flag telling whether the creation of the buffer was successful.
112 !! @internal
113 function create_diskless_netcdf_file(fileobj, pelist, path) &
114  result(success)
115 
116  class(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
117  integer, dimension(:), intent(in), optional :: pelist !< List of ranks associated
118  !! with this file. If not
119  !! provided, only the current
120  !! rank will be able to
121  !! act on the file.
122  character(len=*), intent(in), optional :: path !< File path.
123  logical :: success
124 
125  integer :: cmode
126  integer :: err
127 
128  if (present(path)) then
129  call string_copy(fileobj%path, path)
130  else
131  call tempfile(fileobj%path)
132  endif
133  fileobj%nc_format = "classic"
134  fileobj%is_readonly = .false.
135  if (present(pelist)) then
136  allocate(fileobj%pelist(size(pelist)))
137  fileobj%pelist(:) = pelist(:)
138  else
139  allocate(fileobj%pelist(1))
140  fileobj%pelist(1) = mpp_pe()
141  endif
142  fileobj%io_root = fileobj%pelist(1)
143  fileobj%is_root = mpp_pe() .eq. fileobj%io_root
144  fileobj%is_restart = .true.
145  fileobj%is_diskless = .true.
146  cmode = ior(nf90_noclobber, nf90_classic_model)
147  cmode = ior(cmode, nf90_diskless)
148  if (fms2_ncchksz == -1) call error("create_diskless_netcdf_file :: fms2_ncchksz not set. Call fms2_io init first")
149  err = nf90_create(trim(fileobj%path), cmode, fileobj%ncid, chunksize=fms2_ncchksz)
150  success = err .eq. nf90_noerr
151  if (.not. success) then
152  deallocate(fileobj%pelist)
153  return
154  endif
155  allocate(fileobj%restart_vars(max_num_restart_vars))
156  fileobj%num_restart_vars = 0
157  allocate(fileobj%compressed_dims(max_num_compressed_dims))
158  fileobj%num_compressed_dims = 0
159 end function create_diskless_netcdf_file
160 
161 
162 !> @brief Copy metadata from one file object to another.
163 !! @internal
164 subroutine copy_metadata(fileobj, new_fileobj)
165 
166  class(fmsnetcdffile_t), intent(in), target :: fileobj !< File object.
167  class(fmsnetcdffile_t), intent(inout) :: new_fileobj !< New file object.
168 
169  integer :: err
170  integer :: natt
171  integer :: ndim
172  integer :: varndim
173  integer :: nvar
174  character(len=nf90_max_name) :: n
175  character(len=nf90_max_name) :: varname
176  character(len=nf90_max_name), dimension(nf90_max_dims) :: dimnames
177  integer, dimension(nf90_max_dims) :: dimlens
178  integer :: xtype
179  integer, dimension(nf90_max_var_dims) :: dimids
180  integer, dimension(nf90_max_var_dims) :: d
181  integer :: ulim_dimid
182  integer :: varid
183  integer :: i
184  integer :: j
185  integer :: k
186  integer(kind=i4_kind), dimension(:), allocatable :: buf_int
187  real(kind=r4_kind), dimension(:), allocatable :: buf_float
188  real(kind=r8_kind), dimension(:), allocatable :: buf_double
189  character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
190 
191  append_error_msg = "copy_metadata: original file:"//trim(fileobj%path)//" new file:"//trim(new_fileobj%path)
192  if (fileobj%is_root .and. .not. new_fileobj%is_readonly) then
193  !Copy global attributes to the new file.
194  call set_netcdf_mode(fileobj%ncid, define_mode)
195  call set_netcdf_mode(new_fileobj%ncid, define_mode)
196  err = nf90_inquire(fileobj%ncid, nattributes=natt)
197  call check_netcdf_code(err, append_error_msg)
198  do i = 1, natt
199  err = nf90_inq_attname(fileobj%ncid, nf90_global, i, n)
200  call check_netcdf_code(err, append_error_msg)
201  err = nf90_copy_att(fileobj%ncid, nf90_global, n, new_fileobj%ncid, nf90_global)
202  call check_netcdf_code(err, append_error_msg)
203  enddo
204 
205  !Copy the dimensions to the new file.
206  err = nf90_inquire(fileobj%ncid, ndimensions=ndim)
207  call check_netcdf_code(err, append_error_msg)
208  err = nf90_inquire(fileobj%ncid, unlimiteddimid=ulim_dimid)
209  call check_netcdf_code(err, append_error_msg)
210  do i = 1, ndim
211  err = nf90_inquire_dimension(fileobj%ncid, i, dimnames(i), dimlens(i))
212  call check_netcdf_code(err, append_error_msg)
213  if (i .eq. ulim_dimid) then
214  err = nf90_def_dim(new_fileobj%ncid, dimnames(i), nf90_unlimited, dimids(i))
215  ulim_dimid = dimids(i)
216  else
217  err = nf90_def_dim(new_fileobj%ncid, dimnames(i), dimlens(i), dimids(i))
218  endif
219  call check_netcdf_code(err, append_error_msg)
220  enddo
221 
222  !Copy the variables to the new file.
223  err = nf90_inquire(fileobj%ncid, nvariables=nvar)
224  call check_netcdf_code(err, append_error_msg)
225  do i = 1, nvar
226  err = nf90_inquire_variable(fileobj%ncid, i, varname, xtype, varndim, d, natt)
227  call check_netcdf_code(err, append_error_msg)
228 
229  !Map to new dimension ids.
230  do j = 1, varndim
231  err = nf90_inquire_dimension(fileobj%ncid, d(j), n)
232  call check_netcdf_code(err, append_error_msg)
233  do k = 1, ndim
234  if (string_compare(n, dimnames(k))) then
235  d(j) = dimids(k)
236  exit
237  endif
238  enddo
239  enddo
240 
241  !Define variable in new file.
242  err = nf90_def_var(new_fileobj%ncid, varname, xtype, d(1:varndim), varid)
243  call check_netcdf_code(err, append_error_msg)
244 
245  !If the variable is an "axis", copy its data to the new file.
246  if (varndim .eq. 1 .and. d(1) .ne. ulim_dimid) then
247  do k = 1, ndim
248  if (string_compare(varname, dimnames(k))) then
249  call set_netcdf_mode(fileobj%ncid, data_mode)
250  call set_netcdf_mode(new_fileobj%ncid, data_mode)
251  if (xtype .eq. nf90_int) then
252  allocate(buf_int(dimlens(k)))
253  err = nf90_get_var(fileobj%ncid, i, buf_int)
254  call check_netcdf_code(err, append_error_msg)
255  err = nf90_put_var(new_fileobj%ncid, varid, buf_int)
256  deallocate(buf_int)
257  elseif (xtype .eq. nf90_float) then
258  allocate(buf_float(dimlens(k)))
259  err = nf90_get_var(fileobj%ncid, i, buf_float)
260  call check_netcdf_code(err, append_error_msg)
261  err = nf90_put_var(new_fileobj%ncid, varid, buf_float)
262  deallocate(buf_float)
263  elseif (xtype .eq. nf90_double) then
264  allocate(buf_double(dimlens(k)))
265  err = nf90_get_var(fileobj%ncid, i, buf_double)
266  call check_netcdf_code(err, append_error_msg)
267  err = nf90_put_var(new_fileobj%ncid, varid, buf_double)
268  deallocate(buf_double)
269  else
270  call error(append_error_msg//" "//trim(varname)//" has an unsupported type, "&
271  //"only nf90_int, nf90_float, and nf90_double are currently supported")
272 
273  endif
274  call check_netcdf_code(err, append_error_msg)
275  call set_netcdf_mode(fileobj%ncid, define_mode)
276  call set_netcdf_mode(new_fileobj%ncid, define_mode)
277  exit
278  endif
279  enddo
280  endif
281 
282  !Copy variable attributes to the new file.
283  do j = 1, natt
284  err = nf90_inq_attname(fileobj%ncid, i, j, n)
285  call check_netcdf_code(err, append_error_msg)
286  err = nf90_copy_att(fileobj%ncid, i, n, new_fileobj%ncid, varid)
287  call check_netcdf_code(err, append_error_msg)
288  enddo
289  enddo
290  endif
291 
292  if (new_fileobj%is_restart) then
293  !Copy pointers to buffers (this is aliasing!).
294  do i = 1, fileobj%num_restart_vars
295  new_fileobj%restart_vars(i)%varname = fileobj%restart_vars(i)%varname
296  if (associated(fileobj%restart_vars(i)%data0d)) then
297  new_fileobj%restart_vars(i)%data0d => fileobj%restart_vars(i)%data0d
298  elseif (associated(fileobj%restart_vars(i)%data1d)) then
299  new_fileobj%restart_vars(i)%data1d => fileobj%restart_vars(i)%data1d
300  elseif (associated(fileobj%restart_vars(i)%data2d)) then
301  new_fileobj%restart_vars(i)%data2d => fileobj%restart_vars(i)%data2d
302  elseif (associated(fileobj%restart_vars(i)%data3d)) then
303  new_fileobj%restart_vars(i)%data3d => fileobj%restart_vars(i)%data3d
304  elseif (associated(fileobj%restart_vars(i)%data4d)) then
305  new_fileobj%restart_vars(i)%data4d => fileobj%restart_vars(i)%data4d
306  else
307  call error("this branch should not be reached.")
308  endif
309  enddo
310  new_fileobj%num_restart_vars = fileobj%num_restart_vars
311  endif
312 
313  !Copy compressed dimension metadata.
314  do i = 1, fileobj%num_compressed_dims
315  new_fileobj%compressed_dims(i)%dimname = fileobj%compressed_dims(i)%dimname
316  k = size(fileobj%compressed_dims(i)%npes_corner)
317  allocate(new_fileobj%compressed_dims(i)%npes_corner(k))
318  allocate(new_fileobj%compressed_dims(i)%npes_nelems(k))
319  do j = 1, k
320  new_fileobj%compressed_dims(i)%npes_corner(j) = fileobj%compressed_dims(i)%npes_corner(j)
321  new_fileobj%compressed_dims(i)%npes_nelems(j) = fileobj%compressed_dims(i)%npes_nelems(j)
322  enddo
323  new_fileobj%compressed_dims(i)%nelems = fileobj%compressed_dims(i)%nelems
324  enddo
325  new_fileobj%num_compressed_dims = fileobj%num_compressed_dims
326 end subroutine copy_metadata
327 
328 
329 !> @brief Make a copy of a file's metadata to support "intermediate restarts".
330 !! @internal
331 subroutine new_netcdf_file(fileobj, path, mode, new_fileobj, nc_format)
332 
333  class(fmsnetcdffile_t), intent(in), target :: fileobj !< File object.
334  character(len=*), intent(in) :: path !< Name of new file.
335  character(len=*), intent(in) :: mode !< File mode. Allowed values are:
336  !! "read", "append", "write", or
337  !! "overwrite".
338  class(fmsnetcdffile_t), intent(out) :: new_fileobj !< New file object.
339  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
340  !! new files are written
341  !! as. Allowed values
342  !! are: "64bit", "classic",
343  !! or "netcdf4". Defaults to
344  !! "64bit".
345 
346  logical :: success
347 
348  !Open the new file.
349  success = netcdf_file_open(new_fileobj, path, mode, nc_format, &
350  fileobj%pelist, fileobj%is_restart)
351  if (.not. success) then
352  call error("error opening file "//trim(path)//".")
353  endif
354  call copy_metadata(fileobj, new_fileobj)
355 end subroutine new_netcdf_file
356 
357 
358 !> @brief Wrapper to distinguish interfaces.
359 !!
360 !> @return Flag telling whether the creation of the buffer was successful.
361 function create_diskless_netcdf_file_wrap(fileobj, pelist, path) &
362  result(success)
363 
364  type(fmsnetcdffile_t), intent(inout) :: fileobj !< File object.
365  integer, dimension(:), intent(in), optional :: pelist !< List of ranks associated
366  !! with this file. If not
367  !! provided, only the current
368  !! rank will be able to
369  !! act on the file.
370  character(len=*), intent(in), optional :: path !< File path.
371  logical :: success
372 
373  success = create_diskless_netcdf_file(fileobj, pelist, path)
375 
376 
377 !> @brief Support for writing new restarts from a diskless file.
378 subroutine netcdf_save_restart_wrap2(fileobj, unlim_dim_level, directory, timestamp, &
379  filename, nc_format)
380 
381  type(fmsnetcdffile_t), intent(in), target :: fileobj !< File object.
382  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension
383  !! level.
384  character(len=*), intent(in), optional :: directory !< Directory to write restart file to.
385  character(len=*), intent(in), optional :: timestamp !< Model time.
386  character(len=*), intent(in), optional :: filename !< New name for the file.
387  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
388  !! new files are written
389  !! as. Allowed values
390  !! are: "64bit", "classic",
391  !! or "netcdf4". Defaults to
392  !! "64bit".
393 
394  character(len=FMS_PATH_LEN) :: new_name
395  type(fmsnetcdffile_t), target :: new_fileobj
396  type(fmsnetcdffile_t), pointer :: p
397  logical :: close_new_file
398 
399  call get_new_filename(fileobj%path, new_name, directory, timestamp, filename)
400  if (string_compare(fileobj%path, new_name)) then
401  p => fileobj
402  close_new_file = .false.
403  else
404  call new_netcdf_file(fileobj, new_name, "write", new_fileobj, nc_format)
405  p => new_fileobj
406  close_new_file = .true.
407  endif
408  call netcdf_save_restart(p, unlim_dim_level)
409  if (close_new_file) then
410  call netcdf_file_close(p)
411  endif
412 end subroutine netcdf_save_restart_wrap2
413 
414 
415 !> @brief Loop through registered restart variables and read them from
416 !! a netcdf file.
417 subroutine netcdf_restore_state_wrap(fileobj, unlim_dim_level, directory, timestamp, &
418  filename)
419 
420  type(fmsnetcdffile_t), intent(inout), target :: fileobj !< File object.
421  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension
422  !! level.
423  character(len=*), intent(in), optional :: directory !< Directory to write restart file to.
424  character(len=*), intent(in), optional :: timestamp !< Model time.
425  character(len=*), intent(in), optional :: filename !< New name for the file.
426 
427  character(len=FMS_PATH_LEN) :: new_name
428  type(fmsnetcdffile_t), target :: new_fileobj
429  type(fmsnetcdffile_t), pointer :: p
430  logical :: close_new_file
431 
432  call get_new_filename(fileobj%path, new_name, directory, timestamp, filename)
433  if (string_compare(fileobj%path, new_name)) then
434  p => fileobj
435  close_new_file = .false.
436  else
437  call new_netcdf_file(fileobj, new_name, "read", new_fileobj)
438  p => new_fileobj
439  close_new_file = .true.
440  endif
441  call netcdf_restore_state(p, unlim_dim_level)
442  if (close_new_file) then
443  call netcdf_file_close(p)
444  endif
445 end subroutine netcdf_restore_state_wrap
446 
447 
448 !> @brief Create a "diskless" netcdf file to act as a buffer to support our "register
449 !! data to a file without knowing its name" legacy restart I/O workflow.
450 !! @return Flag telling whether the creation of the buffer was successful.
451 function create_diskless_domain_file(fileobj, domain, path) &
452  result(success)
453 
454  type(fmsnetcdfdomainfile_t), intent(inout) :: fileobj !< File object.
455  type(domain2d), intent(in) :: domain !< Two-dimensional domain.
456  character(len=*), intent(in), optional :: path !< File path.
457  logical :: success
458 
459  type(domain2d), pointer :: io_domain
460  integer :: pelist_size
461  integer, dimension(:), allocatable :: pelist
462 
463  io_domain => mpp_get_io_domain(domain)
464  if (.not. associated(io_domain)) then
465  call error("The domain associated with the file: "//trim(fileobj%path)//" does not have an io_domain.")
466  endif
467  pelist_size = mpp_get_domain_npes(io_domain)
468  allocate(pelist(pelist_size))
469  call mpp_get_pelist(io_domain, pelist)
470  success = create_diskless_netcdf_file(fileobj, pelist, path)
471  deallocate(pelist)
472  fileobj%domain = domain
473  allocate(fileobj%xdims(max_num_domain_decomposed_dims))
474  fileobj%nx = 0
475  allocate(fileobj%ydims(max_num_domain_decomposed_dims))
476  fileobj%ny = 0
477  call string_copy(fileobj%non_mangled_path, fileobj%path)
478 end function create_diskless_domain_file
479 
480 
481 !> @brief Make a copy of a file's metadata to support "intermediate restarts".
482 !! @internal
483 subroutine new_domain_file(fileobj, path, mode, new_fileobj, nc_format)
484 
485  type(fmsnetcdfdomainfile_t), intent(in) :: fileobj !< File object.
486  character(len=*), intent(in) :: path !< Name of new file.
487  character(len=*), intent(in) :: mode !< File mode. Allowed values are:
488  !! "read", "append", "write", or "overwrite".
489  type(fmsnetcdfdomainfile_t), intent(out) :: new_fileobj !< File object.
490  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
491  !! new files are written
492  !! as. Allowed values
493  !! are: "64bit", "classic",
494  !! or "netcdf4". Defaults to
495  !! "64bit".
496 
497  logical :: success
498  integer :: i
499 
500  success = open_domain_file(new_fileobj, path, mode, fileobj%domain, nc_format, &
501  fileobj%is_restart)
502  if (.not. success) then
503  call error("error opening file "//trim(path)//".")
504  endif
505  call copy_metadata(fileobj, new_fileobj)
506  do i = 1, fileobj%nx
507  call string_copy(new_fileobj%xdims(i)%varname, fileobj%xdims(i)%varname)
508  new_fileobj%xdims(i)%pos = fileobj%xdims(i)%pos
509  enddo
510  new_fileobj%nx = fileobj%nx
511  do i = 1, fileobj%ny
512  call string_copy(new_fileobj%ydims(i)%varname, fileobj%ydims(i)%varname)
513  new_fileobj%ydims(i)%pos = fileobj%ydims(i)%pos
514  enddo
515  new_fileobj%ny = fileobj%ny
516 end subroutine new_domain_file
517 
518 
519 !> @brief Loop through registered restart variables and write them to
520 !! a netcdf file.
521 subroutine save_domain_restart_wrap(fileobj, unlim_dim_level, directory, timestamp, &
522  filename, nc_format)
523 
524  type(fmsnetcdfdomainfile_t), intent(in), target :: fileobj !< File object.
525  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension level.
526  character(len=*), intent(in), optional :: directory !< Directory to write restart file to.
527  character(len=*), intent(in), optional :: timestamp !< Model time.
528  character(len=*), intent(in), optional :: filename !< New name for the file.
529  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
530  !! new files are written
531  !! as. Allowed values
532  !! are: "64bit", "classic",
533  !! or "netcdf4". Defaults to
534  !! "64bit".
535 
536  character(len=FMS_PATH_LEN) :: new_name
537  type(fmsnetcdfdomainfile_t), target :: new_fileobj
538  type(fmsnetcdfdomainfile_t), pointer :: p
539  logical :: close_new_file
540 
541  call get_new_filename(fileobj%non_mangled_path, new_name, directory, timestamp, filename)
542  if (string_compare(fileobj%non_mangled_path, new_name)) then
543  p => fileobj
544  close_new_file = .false.
545  else
546  call new_domain_file(fileobj, new_name, "write", new_fileobj, nc_format)
547  p => new_fileobj
548  close_new_file = .true.
549  endif
550  call save_domain_restart(p, unlim_dim_level)
551  if (close_new_file) then
552  call close_domain_file(p)
553  endif
554 end subroutine save_domain_restart_wrap
555 
556 
557 !> @brief Loop through registered restart variables and read them from
558 !! a netcdf file.
559 subroutine restore_domain_state_wrap(fileobj, unlim_dim_level, directory, timestamp, &
560  filename, ignore_checksum)
561 
562  type(fmsnetcdfdomainfile_t), intent(in), target :: fileobj !< File object.
563  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension level.
564  character(len=*), intent(in), optional :: directory !< Directory to write restart file to.
565  character(len=*), intent(in), optional :: timestamp !< Model time.
566  character(len=*), intent(in), optional :: filename !< New name for the file.
567  logical, intent(in), optional :: ignore_checksum !< Checksum data integrity flag.
568 
569  character(len=FMS_PATH_LEN) :: new_name
570  type(fmsnetcdfdomainfile_t), target :: new_fileobj
571  type(fmsnetcdfdomainfile_t), pointer :: p
572  logical :: close_new_file
573 
574  call get_new_filename(fileobj%non_mangled_path, new_name, directory, timestamp, filename)
575  if (string_compare(fileobj%non_mangled_path, new_name)) then
576  p => fileobj
577  close_new_file = .false.
578  else
579  call new_domain_file(fileobj, new_name, "read", new_fileobj)
580  p => new_fileobj
581  close_new_file = .true.
582  endif
583  call restore_domain_state(p, unlim_dim_level, ignore_checksum=ignore_checksum)
584  if (close_new_file) then
585  call close_domain_file(p)
586  endif
587 end subroutine restore_domain_state_wrap
588 
589 
590 !> @brief Create a "diskless" netcdf file to act as a buffer to support our "register
591 !! data to a file without knowing its name" legacy restart I/O workflow.
592 !! @return Flag telling whether the creation of the buffer was successful.
593 function create_diskless_unstructured_domain_file(fileobj, domain, path) &
594  result(success)
595 
596  type(fmsnetcdfunstructureddomainfile_t), intent(inout) :: fileobj !< File object.
597  type(domainug), intent(in) :: domain !< Two-dimensional domain.
598  character(len=*), intent(in), optional :: path !< File path.
599  logical :: success
600 
601  type(domainug), pointer :: io_domain
602  integer :: pelist_size
603  integer, dimension(:), allocatable :: pelist
604 
605  io_domain => mpp_get_ug_io_domain(domain)
606  if (.not. associated(io_domain)) then
607  call error("The domain associated with the file: "//trim(fileobj%path)//" does have an io_domain.")
608  endif
609  pelist_size = mpp_get_ug_domain_npes(io_domain)
610  allocate(pelist(pelist_size))
611  call mpp_get_ug_domain_pelist(io_domain, pelist)
612  success = create_diskless_netcdf_file(fileobj, pelist, path)
613  deallocate(pelist)
614  fileobj%domain = domain
615  call string_copy(fileobj%non_mangled_path, fileobj%path)
617 
618 
619 !> @brief Make a copy of a file's metadata to support "intermediate restarts".
620 !! @internal
621 subroutine new_unstructured_domain_file(fileobj, path, mode, new_fileobj, nc_format)
622 
623  type(fmsnetcdfunstructureddomainfile_t), intent(in) :: fileobj !< File object.
624  character(len=*), intent(in) :: path !< Name of new file.
625  character(len=*), intent(in) :: mode !< File mode. Allowed values are:
626  !! "read", "append", "write", or "overwrite."
627  type(fmsnetcdfunstructureddomainfile_t), intent(out) :: new_fileobj !< New file object.
628  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
629  !! new files are written
630  !! as. Allowed values
631  !! are: "64bit", "classic",
632  !! or "netcdf4". Defaults to
633  !! "64bit".
634 
635  logical :: success
636 
637  success = open_unstructured_domain_file(new_fileobj, path, mode, fileobj%domain, &
638  nc_format, fileobj%is_restart)
639  if (.not. success) then
640  call error("error while opening file "//trim(path)//".")
641  endif
642  call copy_metadata(fileobj, new_fileobj)
643 end subroutine new_unstructured_domain_file
644 
645 
646 !> @brief Wrapper to distinguish interfaces.
647 subroutine unstructured_write_restart_wrap(fileobj, unlim_dim_level, directory, timestamp, &
648  filename, nc_format)
649 
650  type(fmsnetcdfunstructureddomainfile_t), intent(in) :: fileobj !< File object.
651  integer, intent(in), optional :: unlim_dim_level !< Unlimited dimension level.
652  character(len=*), intent(in), optional :: directory !< Directory to write restart file to.
653  character(len=*), intent(in), optional :: timestamp !< Model time.
654  character(len=*), intent(in), optional :: filename !< New name for the file.
655  character(len=*), intent(in), optional :: nc_format !< Netcdf format that
656  !! new files are written
657  !! as. Allowed values
658  !! are: "64bit", "classic",
659  !! or "netcdf4". Defaults to
660  !! "64bit".
661 
662  character(len=256) :: new_name
663  type(fmsnetcdfunstructureddomainfile_t) :: new_fileobj
664 
665  call get_new_filename(fileobj%non_mangled_path, new_name, directory, timestamp, filename)
666  if (string_compare(fileobj%non_mangled_path, new_name)) then
667  call netcdf_save_restart(fileobj, unlim_dim_level)
668  else
669  call new_unstructured_domain_file(fileobj, new_name, "write", new_fileobj, nc_format)
670  call netcdf_save_restart(new_fileobj, unlim_dim_level)
671  call close_unstructured_domain_file(new_fileobj)
672  endif
673 end subroutine unstructured_write_restart_wrap
674 
675 
676 end module blackboxio
677 !> @}
678 ! close documentation grouping
logical function, public create_diskless_netcdf_file_wrap(fileobj, pelist, path)
Wrapper to distinguish interfaces.
Definition: blackboxio.F90:363
subroutine new_netcdf_file(fileobj, path, mode, new_fileobj, nc_format)
Make a copy of a file's metadata to support "intermediate restarts".
Definition: blackboxio.F90:332
logical function, public create_diskless_unstructured_domain_file(fileobj, domain, path)
Create a "diskless" netcdf file to act as a buffer to support our "register data to a file wi...
Definition: blackboxio.F90:595
subroutine, public unstructured_write_restart_wrap(fileobj, unlim_dim_level, directory, timestamp, filename, nc_format)
Wrapper to distinguish interfaces.
Definition: blackboxio.F90:649
subroutine, public save_domain_restart_wrap(fileobj, unlim_dim_level, directory, timestamp, filename, nc_format)
Loop through registered restart variables and write them to a netcdf file.
Definition: blackboxio.F90:523
subroutine tempfile(filename)
Create a unique filename (poor man's version of mktemp).
Definition: blackboxio.F90:91
logical function, public create_diskless_domain_file(fileobj, domain, path)
Create a "diskless" netcdf file to act as a buffer to support our "register data to a file wi...
Definition: blackboxio.F90:453
subroutine new_unstructured_domain_file(fileobj, path, mode, new_fileobj, nc_format)
Make a copy of a file's metadata to support "intermediate restarts".
Definition: blackboxio.F90:622
subroutine get_new_filename(path, new_path, directory, timestamp, new_name)
Create a new file path.
Definition: blackboxio.F90:61
subroutine new_domain_file(fileobj, path, mode, new_fileobj, nc_format)
Make a copy of a file's metadata to support "intermediate restarts".
Definition: blackboxio.F90:484
subroutine, public restore_domain_state_wrap(fileobj, unlim_dim_level, directory, timestamp, filename, ignore_checksum)
Loop through registered restart variables and read them from a netcdf file.
Definition: blackboxio.F90:561
subroutine, public netcdf_restore_state_wrap(fileobj, unlim_dim_level, directory, timestamp, filename)
Loop through registered restart variables and read them from a netcdf file.
Definition: blackboxio.F90:419
subroutine copy_metadata(fileobj, new_fileobj)
Copy metadata from one file object to another.
Definition: blackboxio.F90:165
subroutine, public blackboxio_init(chksz)
Accepts the namelist fms2_io_nml variables relevant to blackboxio.
Definition: blackboxio.F90:53
subroutine, public netcdf_save_restart_wrap2(fileobj, unlim_dim_level, directory, timestamp, filename, nc_format)
Support for writing new restarts from a diskless file.
Definition: blackboxio.F90:380
logical function create_diskless_netcdf_file(fileobj, pelist, path)
Create a "diskless" netcdf file to act as a buffer to support our "register data to a file wi...
Definition: blackboxio.F90:115
logical function, public file_exists(path)
Determine if a file exists.
subroutine, public error(mesg)
Print a message to stderr, then stop the program.
logical function, public string_compare(string1, string2, ignore_case)
Compare strings.
subroutine, public save_domain_restart(fileobj, unlim_dim_level)
Loop through registered restart variables and write them to a netcdf file.
logical function, public open_domain_file(fileobj, path, mode, domain, nc_format, is_restart, dont_add_res_to_filename, use_netcdf_mpi)
Open a domain netcdf file.
subroutine, public close_domain_file(fileobj)
Close a domain netcdf file.
subroutine, public restore_domain_state(fileobj, unlim_dim_level, ignore_checksum)
Loop through registered restart variables and read them from a netcdf file.
logical function, public open_unstructured_domain_file(fileobj, path, mode, domain, nc_format, is_restart, dont_add_res_to_filename)
Open a netcdf file that is associated with an unstructured domain.
subroutine, public close_unstructured_domain_file(fileobj)
Wrapper to distinguish interfaces.
integer function mpp_get_domain_npes(domain)
Set user stack size.
type(domain2d) function, pointer mpp_get_io_domain(domain)
Set user stack size.
Retrieve list of PEs associated with a domain decomposition. The 1D version of this call returns an a...
The domain2D type contains all the necessary information to define the global, compute and data domai...
Domain information for managing data on unstructured grids.
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:406
subroutine, public netcdf_restore_state(fileobj, unlim_dim_level)
Loop through registered restart variables and read them from a netcdf file.
Definition: netcdf_io.F90:1145
subroutine, public netcdf_file_close(fileobj)
Close a netcdf file.
Definition: netcdf_io.F90:742
logical function, public netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
Open a netcdf file.
Definition: netcdf_io.F90:547
subroutine, public set_netcdf_mode(ncid, mode)
Switch to the correct netcdf mode.
Definition: netcdf_io.F90:399
subroutine, public check_netcdf_code(err, msg)
Check for errors returned by netcdf.
Definition: netcdf_io.F90:383
subroutine, public netcdf_save_restart(fileobj, unlim_dim_level)
Loop through registered restart variables and write them to a netcdf file.
Definition: netcdf_io.F90:1103