29 use fms_netcdf_domain_io_mod
30 use fms_netcdf_unstructured_domain_io_mod
32 use,
intrinsic :: iso_fortran_env, only: error_unit
37 integer,
private :: fms2_ncchksz = -1
53 integer,
intent(in) :: chksz
62 character(len=*),
intent(in) :: path
63 character(len=*),
intent(out) :: new_path
64 character(len=*),
intent(in),
optional :: directory
65 character(len=*),
intent(in),
optional :: timestamp
66 character(len=*),
intent(in),
optional :: new_name
68 character(len=FMS_PATH_LEN) :: dir
69 character(len=FMS_FILE_LEN) :: tstamp
70 character(len=FMS_PATH_LEN) :: nname
73 if (
present(directory))
then
74 call string_copy(dir, trim(directory)//
"/")
77 if (
present(timestamp))
then
78 call string_copy(tstamp, trim(timestamp)//
".")
80 call string_copy(nname, trim(path))
81 if (
present(new_name))
then
82 call string_copy(nname, trim(new_name))
84 call string_copy(new_path, trim(dir)//trim(tstamp)//trim(nname))
92 character(len=*),
intent(out) :: filename
98 call random_number(numr)
99 numi = transfer(numr, numi)
100 numi = iand(numi, z
'FFFFFF')
101 write(filename,
'(a,z6.6)')
"tmp", numi
117 integer,
dimension(:),
intent(in),
optional :: pelist
122 character(len=*),
intent(in),
optional :: path
128 if (
present(path))
then
129 call string_copy(fileobj%path, path)
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(:)
139 allocate(fileobj%pelist(1))
140 fileobj%pelist(1) =
mpp_pe()
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)
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
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
179 integer,
dimension(nf90_max_var_dims) :: dimids
180 integer,
dimension(nf90_max_var_dims) :: d
181 integer :: ulim_dimid
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
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
196 err = nf90_inquire(fileobj%ncid, nattributes=natt)
199 err = nf90_inq_attname(fileobj%ncid, nf90_global, i, n)
201 err = nf90_copy_att(fileobj%ncid, nf90_global, n, new_fileobj%ncid, nf90_global)
206 err = nf90_inquire(fileobj%ncid, ndimensions=ndim)
208 err = nf90_inquire(fileobj%ncid, unlimiteddimid=ulim_dimid)
211 err = nf90_inquire_dimension(fileobj%ncid, i, dimnames(i), dimlens(i))
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)
217 err = nf90_def_dim(new_fileobj%ncid, dimnames(i), dimlens(i), dimids(i))
223 err = nf90_inquire(fileobj%ncid, nvariables=nvar)
226 err = nf90_inquire_variable(fileobj%ncid, i, varname, xtype, varndim, d, natt)
231 err = nf90_inquire_dimension(fileobj%ncid, d(j), n)
242 err = nf90_def_var(new_fileobj%ncid, varname, xtype, d(1:varndim), varid)
246 if (varndim .eq. 1 .and. d(1) .ne. ulim_dimid)
then
251 if (xtype .eq. nf90_int)
then
252 allocate(buf_int(dimlens(k)))
253 err = nf90_get_var(fileobj%ncid, i, buf_int)
255 err = nf90_put_var(new_fileobj%ncid, varid, 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)
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)
267 err = nf90_put_var(new_fileobj%ncid, varid, buf_double)
268 deallocate(buf_double)
270 call error(append_error_msg//
" "//trim(varname)//
" has an unsupported type, "&
271 //
"only nf90_int, nf90_float, and nf90_double are currently supported")
284 err = nf90_inq_attname(fileobj%ncid, i, j, n)
286 err = nf90_copy_att(fileobj%ncid, i, n, new_fileobj%ncid, varid)
292 if (new_fileobj%is_restart)
then
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
307 call error(
"this branch should not be reached.")
310 new_fileobj%num_restart_vars = fileobj%num_restart_vars
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))
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)
323 new_fileobj%compressed_dims(i)%nelems = fileobj%compressed_dims(i)%nelems
325 new_fileobj%num_compressed_dims = fileobj%num_compressed_dims
334 character(len=*),
intent(in) :: path
335 character(len=*),
intent(in) :: mode
339 character(len=*),
intent(in),
optional :: nc_format
350 fileobj%pelist, fileobj%is_restart)
351 if (.not. success)
then
352 call error(
"error opening file "//trim(path)//
".")
365 integer,
dimension(:),
intent(in),
optional :: pelist
370 character(len=*),
intent(in),
optional :: path
382 integer,
intent(in),
optional :: unlim_dim_level
384 character(len=*),
intent(in),
optional :: directory
385 character(len=*),
intent(in),
optional :: timestamp
386 character(len=*),
intent(in),
optional :: filename
387 character(len=*),
intent(in),
optional :: nc_format
394 character(len=FMS_PATH_LEN) :: new_name
397 logical :: close_new_file
399 call get_new_filename(fileobj%path, new_name, directory, timestamp, filename)
402 close_new_file = .false.
404 call new_netcdf_file(fileobj, new_name,
"write", new_fileobj, nc_format)
406 close_new_file = .true.
409 if (close_new_file)
then
421 integer,
intent(in),
optional :: unlim_dim_level
423 character(len=*),
intent(in),
optional :: directory
424 character(len=*),
intent(in),
optional :: timestamp
425 character(len=*),
intent(in),
optional :: filename
427 character(len=FMS_PATH_LEN) :: new_name
430 logical :: close_new_file
432 call get_new_filename(fileobj%path, new_name, directory, timestamp, filename)
435 close_new_file = .false.
439 close_new_file = .true.
442 if (close_new_file)
then
455 type(
domain2d),
intent(in) :: domain
456 character(len=*),
intent(in),
optional :: path
459 type(
domain2d),
pointer :: io_domain
460 integer :: pelist_size
461 integer,
dimension(:),
allocatable :: pelist
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.")
468 allocate(pelist(pelist_size))
472 fileobj%domain = domain
473 allocate(fileobj%xdims(max_num_domain_decomposed_dims))
475 allocate(fileobj%ydims(max_num_domain_decomposed_dims))
477 call string_copy(fileobj%non_mangled_path, fileobj%path)
486 character(len=*),
intent(in) :: path
487 character(len=*),
intent(in) :: mode
490 character(len=*),
intent(in),
optional :: nc_format
500 success =
open_domain_file(new_fileobj, path, mode, fileobj%domain, nc_format, &
502 if (.not. success)
then
503 call error(
"error opening file "//trim(path)//
".")
507 call string_copy(new_fileobj%xdims(i)%varname, fileobj%xdims(i)%varname)
508 new_fileobj%xdims(i)%pos = fileobj%xdims(i)%pos
510 new_fileobj%nx = fileobj%nx
512 call string_copy(new_fileobj%ydims(i)%varname, fileobj%ydims(i)%varname)
513 new_fileobj%ydims(i)%pos = fileobj%ydims(i)%pos
515 new_fileobj%ny = fileobj%ny
525 integer,
intent(in),
optional :: unlim_dim_level
526 character(len=*),
intent(in),
optional :: directory
527 character(len=*),
intent(in),
optional :: timestamp
528 character(len=*),
intent(in),
optional :: filename
529 character(len=*),
intent(in),
optional :: nc_format
536 character(len=FMS_PATH_LEN) :: new_name
539 logical :: close_new_file
541 call get_new_filename(fileobj%non_mangled_path, new_name, directory, timestamp, filename)
544 close_new_file = .false.
546 call new_domain_file(fileobj, new_name,
"write", new_fileobj, nc_format)
548 close_new_file = .true.
551 if (close_new_file)
then
560 filename, ignore_checksum)
563 integer,
intent(in),
optional :: unlim_dim_level
564 character(len=*),
intent(in),
optional :: directory
565 character(len=*),
intent(in),
optional :: timestamp
566 character(len=*),
intent(in),
optional :: filename
567 logical,
intent(in),
optional :: ignore_checksum
569 character(len=FMS_PATH_LEN) :: new_name
572 logical :: close_new_file
574 call get_new_filename(fileobj%non_mangled_path, new_name, directory, timestamp, filename)
577 close_new_file = .false.
581 close_new_file = .true.
584 if (close_new_file)
then
597 type(
domainug),
intent(in) :: domain
598 character(len=*),
intent(in),
optional :: path
601 type(
domainug),
pointer :: io_domain
602 integer :: pelist_size
603 integer,
dimension(:),
allocatable :: pelist
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.")
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)
614 fileobj%domain = domain
615 call string_copy(fileobj%non_mangled_path, fileobj%path)
624 character(len=*),
intent(in) :: path
625 character(len=*),
intent(in) :: mode
628 character(len=*),
intent(in),
optional :: nc_format
638 nc_format, fileobj%is_restart)
639 if (.not. success)
then
640 call error(
"error while opening file "//trim(path)//
".")
651 integer,
intent(in),
optional :: unlim_dim_level
652 character(len=*),
intent(in),
optional :: directory
653 character(len=*),
intent(in),
optional :: timestamp
654 character(len=*),
intent(in),
optional :: filename
655 character(len=*),
intent(in),
optional :: nc_format
662 character(len=256) :: new_name
665 call get_new_filename(fileobj%non_mangled_path, new_name, directory, timestamp, filename)
676 end module blackboxio
logical function, public create_diskless_netcdf_file_wrap(fileobj, pelist, path)
Wrapper to distinguish interfaces.
subroutine new_netcdf_file(fileobj, path, mode, new_fileobj, nc_format)
Make a copy of a file's metadata to support "intermediate restarts".
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...
subroutine, public unstructured_write_restart_wrap(fileobj, unlim_dim_level, directory, timestamp, filename, nc_format)
Wrapper to distinguish interfaces.
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.
subroutine tempfile(filename)
Create a unique filename (poor man's version of mktemp).
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...
subroutine new_unstructured_domain_file(fileobj, path, mode, new_fileobj, nc_format)
Make a copy of a file's metadata to support "intermediate restarts".
subroutine get_new_filename(path, new_path, directory, timestamp, new_name)
Create a new file path.
subroutine new_domain_file(fileobj, path, mode, new_fileobj, nc_format)
Make a copy of a file's metadata to support "intermediate restarts".
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.
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.
subroutine copy_metadata(fileobj, new_fileobj)
Copy metadata from one file object to another.
subroutine, public blackboxio_init(chksz)
Accepts the namelist fms2_io_nml variables relevant to blackboxio.
subroutine, public netcdf_save_restart_wrap2(fileobj, unlim_dim_level, directory, timestamp, filename, nc_format)
Support for writing new restarts from a diskless file.
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...
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.
netcdf unstructured domain file type.
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.
subroutine, public netcdf_restore_state(fileobj, unlim_dim_level)
Loop through registered restart variables and read them from a netcdf file.
subroutine, public netcdf_file_close(fileobj)
Close a netcdf file.
logical function, public netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
Open a netcdf file.
subroutine, public set_netcdf_mode(ncid, mode)
Switch to the correct netcdf mode.
subroutine, public check_netcdf_code(err, msg)
Check for errors returned by netcdf.
subroutine, public netcdf_save_restart(fileobj, unlim_dim_level)
Loop through registered restart variables and write them to a netcdf file.