33 #ifndef MAX_NUM_RESTART_VARS_
34 #define MAX_NUM_RESTART_VARS_ 250
46 integer,
parameter,
public :: default_deflate_level = 0
47 integer,
parameter :: variable_missing = -1
48 integer,
parameter :: dimension_missing = -1
49 integer,
parameter,
public :: no_unlimited_dimension = -1
50 character(len=1),
parameter :: missing_path =
""
51 integer,
parameter :: missing_ncid = -1
52 integer,
parameter :: missing_rank = -1
53 integer,
parameter,
public :: define_mode = 0
54 integer,
parameter,
public :: data_mode = 1
55 integer,
parameter,
public :: max_num_restart_vars = max_num_restart_vars_
56 integer,
parameter,
public :: unlimited = nf90_unlimited
57 integer,
parameter :: dimension_not_found = 0
58 integer,
parameter,
public :: max_num_compressed_dims = 10
74 integer,
dimension(:),
allocatable :: indices
76 integer,
dimension(:),
allocatable :: global_size
77 integer,
dimension(:),
allocatable :: pelist
83 real(kind=r4_kind),
dimension(:,:),
allocatable :: globaldata2d_r4
84 real(kind=r4_kind),
dimension(:,:,:),
allocatable :: globaldata3d_r4
85 real(kind=r8_kind),
dimension(:,:),
allocatable :: globaldata2d_r8
86 real(kind=r8_kind),
dimension(:,:,:),
allocatable :: globaldata3d_r8
87 character(len=32) :: chksum
88 logical :: data_on_file_root
95 character(len=256) :: varname
96 class(*),
pointer :: data0d => null()
97 class(*),
dimension(:),
pointer :: data1d => null()
98 class(*),
dimension(:,:),
pointer :: data2d => null()
99 class(*),
dimension(:,:,:),
pointer :: data3d => null()
100 class(*),
dimension(:,:,:,:),
pointer :: data4d => null()
101 class(*),
dimension(:,:,:,:,:),
pointer :: data5d => null()
104 logical :: is_bc_variable
111 character(len=256) :: dimname
112 integer,
dimension(:),
allocatable :: npes_corner
114 integer,
dimension(:),
allocatable :: npes_nelems
123 integer,
dimension(5) :: xlen
124 integer,
dimension(5) :: ylen
125 integer,
dimension(5) :: zlen
126 integer,
dimension(3) :: cur_dim_len
134 integer,
public :: id
135 integer,
public,
allocatable :: offloading_pes(:)
136 integer,
public,
allocatable :: model_pes(:)
137 logical :: is_model_pe
148 character(len=FMS_PATH_LEN) :: path
149 logical :: is_readonly
151 character(len=256) :: nc_format
152 logical :: is_netcdf4
153 integer,
dimension(:),
allocatable :: pelist
158 logical :: is_restart
160 logical :: mode_is_append
161 logical,
allocatable :: is_open
164 integer :: num_restart_vars
166 integer :: num_compressed_dims
167 logical :: is_diskless
168 character (len=20) :: time_name
172 logical :: use_collective = .false.
174 logical :: use_netcdf_mpi = .false.
190 logical :: has_missing
191 real(kind=r8_kind) :: fill_val
192 real(kind=r8_kind) :: min_val
193 real(kind=r8_kind) :: max_val
194 real(kind=r8_kind) :: missing_val
258 public :: get_variable_sense
259 public :: get_variable_missing
260 public :: get_variable_units
261 public :: get_time_calendar
266 public :: set_fileobj_time_name
368 subroutine netcdf_io_init (chksz, header_buffer_val, netcdf_default_format, deflate_level, shuffle)
369 integer,
intent(in) :: chksz
370 character (len = 10),
intent(in) :: netcdf_default_format
371 integer,
intent(in) :: header_buffer_val
372 integer,
intent(in) :: deflate_level
374 logical,
intent(in) :: shuffle
384 elseif (
string_compare(netcdf_default_format,
"classic", .true.))
then
387 elseif (
string_compare(netcdf_default_format,
"netcdf4", .true.))
then
392 call error(
"unrecognized netcdf file format "//trim(netcdf_default_format)// &
393 '. The acceptable values are "64bit", "classic", "netcdf4". Check fms2_io_nml: netcdf_default_format')
402 integer,
intent(in) :: err
403 character(len=*),
intent(in) :: msg
405 character(len=80) :: buf
407 if (err .ne. nf90_noerr)
then
408 buf = nf90_strerror(err)
409 call error(trim(buf)//
": "//trim(msg))
418 integer,
intent(in) :: ncid
419 integer,
intent(in) :: mode
423 if (mode .eq. define_mode)
then
424 err = nf90_redef(ncid)
425 if (err .eq. nf90_eindefine .or. err .eq. nf90_eperm)
then
428 elseif (mode .eq. data_mode)
then
429 if (
fms2_header_buffer_val == -1)
call error(
"set_netcdf_mode: fms2_header_buffer_val not set, call fms2_io_init")
431 if (err .eq. nf90_enotindefine .or. err .eq. nf90_eperm)
then
435 call error(
"mode must be either define_mode or data_mode.")
447 integer,
intent(in) :: ncid
448 character(len=*),
intent(in) :: dimension_name
449 character(len=*),
intent(in) :: msg
450 logical,
intent(in),
optional :: allow_failure
458 err = nf90_inq_dimid(ncid, trim(dimension_name), dimid)
459 if (
present(allow_failure))
then
460 if (allow_failure .and. err .eq. nf90_ebaddim)
then
461 dimid = dimension_missing
475 integer,
intent(in) :: ncid
476 character(len=*),
intent(in) :: variable_name
477 character(len=*),
intent(in) :: msg
478 logical,
intent(in),
optional :: allow_failure
486 err = nf90_inq_varid(ncid, trim(variable_name), varid)
487 if (
present(allow_failure))
then
488 if (allow_failure .and. err .eq. nf90_enotvar)
then
489 varid = variable_missing
503 integer,
intent(in) :: ncid
504 integer,
intent(in) :: varid
505 character(len=*),
intent(in) :: attribute_name
506 character(len=*),
intent(in),
optional :: msg
508 logical :: att_exists
512 err = nf90_inquire_attribute(ncid, varid, trim(attribute_name))
513 if (err .eq. nf90_enotatt)
then
528 integer,
intent(in) :: ncid
529 integer,
intent(in) :: varid
530 character(len=*),
intent(in) :: attname
531 character(len=*),
intent(in),
optional :: msg
537 err = nf90_inquire_attribute(ncid, varid, attname, xtype=xtype)
548 integer,
intent(in) :: ncid
549 integer,
intent(in) :: varid
550 character(len=*),
intent(in),
optional :: msg
556 err = nf90_inquire_variable(ncid, varid, xtype=xtype)
563 function netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename, &
564 tile_comm, use_collective)
result(success)
567 character(len=*),
intent(in) :: path
568 character(len=*),
intent(in) :: mode
571 character(len=*),
intent(in),
optional :: nc_format
579 integer,
dimension(:),
intent(in),
optional :: pelist
584 logical,
intent(in),
optional :: is_restart
587 logical,
intent(in),
optional :: dont_add_res_to_filename
589 integer,
intent(in),
optional :: tile_comm
591 logical,
intent(in),
optional :: use_collective
595 integer :: nc_format_param
599 character(len=FMS_PATH_LEN) :: full_path
601 logical :: dont_add_res
606 call error(
"netcdf_file_open :: fms2_io has not been initialized")
609 if (
allocated(fileobj%is_open))
then
610 if (fileobj%is_open)
return
613 fileobj%use_netcdf_mpi = .false.
616 call mpp_error(note,
"netcdf_file_open :: Setting fileobj%tile_comm is deprecated. &
617 Please use open_file(..., tile_comm=...) instead.")
618 fileobj%use_netcdf_mpi = .true.
619 elseif (
present(tile_comm))
then
620 fileobj%use_netcdf_mpi = .true.
621 fileobj%tile_comm = tile_comm
624 if (fileobj%use_collective)
then
625 fileobj%use_netcdf_mpi = .true.
626 call mpp_error(note,
"Setting fileobj%use_collective to enable collective reads is deprecated. &
627 Please use open_file(..., use_collective=.true.) instead.")
629 fileobj%use_collective = .false.
630 if (
present(use_collective)) fileobj%use_collective = use_collective
636 if (
present(is_restart))
then
639 fileobj%is_restart = is_res
641 dont_add_res = .false.
642 if (
present(dont_add_res_to_filename))
then
643 dont_add_res = dont_add_res_to_filename
646 if (is_res .and. .not. dont_add_res)
then
649 call string_copy(full_path, trim(path))
656 call string_copy(fileobj%path, trim(full_path))
662 if (.not.success)
return
665 if (
present(pelist))
then
666 allocate(fileobj%pelist(
size(pelist)))
667 fileobj%pelist(:) = pelist(:)
669 allocate(fileobj%pelist(1))
670 fileobj%pelist(1) =
mpp_pe()
672 fileobj%io_root = fileobj%pelist(1)
673 fileobj%is_root =
mpp_pe().eq.fileobj%io_root
675 fileobj%is_netcdf4 = .false.
677 if (
present(nc_format))
then
679 nc_format_param = nf90_64bit_offset
681 nc_format_param = nf90_classic_model
683 fileobj%is_netcdf4 = .true.
684 nc_format_param = nf90_netcdf4
686 call error(
"unrecognized netcdf file format: '"//trim(nc_format)//
"' for file:"//trim(fileobj%path)//&
687 &
"Check your open_file call, the acceptable values are 64bit, classic, netcdf4")
689 call string_copy(fileobj%nc_format, nc_format)
696 if (fileobj%use_netcdf_mpi)
then
697 #ifdef NO_NC_PARALLEL4
698 call error(
"NetCDF was not built with HDF5 parallel I/O features, so use_netcdf_mpi cannot be used. &
699 &Please turn use_netcdf_mpi off for the file: " // trim(path))
701 nc_format_param = ior(nc_format_param, nf90_mpiio)
704 if (fileobj%use_netcdf_mpi)
then
707 err = nf90_open(trim(fileobj%path), ior(nf90_nowrite, nf90_mpiio), fileobj%ncid, &
710 err = nf90_open(trim(fileobj%path), ior(nf90_write, nf90_mpiio), fileobj%ncid, &
713 err = nf90_create(trim(fileobj%path), ior(nf90_noclobber, nc_format_param), fileobj%ncid, &
716 err = nf90_create(trim(fileobj%path), ior(nf90_clobber, nc_format_param), fileobj%ncid, &
719 call error(
"unrecognized file mode: '"//trim(mode)//
"' for file:"//trim(fileobj%path)//&
720 &
"Check your open_file call, the acceptable values are read, append, write, overwrite")
722 call check_netcdf_code(err,
"netcdf_file_open (using netcdf mpi): "//trim(fileobj%path))
723 elseif (fileobj%is_root)
then
726 err = nf90_open(trim(fileobj%path), nf90_nowrite, fileobj%ncid, chunksize=
fms2_ncchksz)
728 err = nf90_open(trim(fileobj%path), nf90_write, fileobj%ncid, chunksize=
fms2_ncchksz)
730 err = nf90_create(trim(fileobj%path), ior(nf90_noclobber, nc_format_param), fileobj%ncid, chunksize=
fms2_ncchksz)
732 err = nf90_create(trim(fileobj%path), ior(nf90_clobber, nc_format_param), fileobj%ncid, chunksize=
fms2_ncchksz)
734 call error(
"unrecognized file mode: '"//trim(mode)//
"' for file:"//trim(fileobj%path)//&
735 &
"Check your open_file call, the acceptable values are read, append, write, overwrite")
739 fileobj%ncid = missing_ncid
742 fileobj%is_diskless = .false.
745 if (fileobj%is_restart)
then
746 allocate(fileobj%restart_vars(max_num_restart_vars))
747 fileobj%num_restart_vars = 0
752 allocate(fileobj%compressed_dims(max_num_compressed_dims))
753 fileobj%num_compressed_dims = 0
755 if (.not.
allocated(fileobj%is_open))
allocate(fileobj%is_open)
756 fileobj%is_open = .true.
758 fileobj%bc_dimensions%xlen = 0
759 fileobj%bc_dimensions%ylen = 0
760 fileobj%bc_dimensions%zlen = 0
761 fileobj%bc_dimensions%cur_dim_len = 0
774 if (fileobj%is_root)
then
775 err = nf90_close(fileobj%ncid)
778 if (
allocated(fileobj%is_open)) fileobj%is_open = .false.
779 fileobj%path = missing_path
780 fileobj%ncid = missing_ncid
781 if (
allocated(fileobj%pelist))
then
782 deallocate(fileobj%pelist)
784 fileobj%io_root = missing_rank
785 fileobj%is_root = .false.
786 if (
allocated(fileobj%restart_vars))
then
787 deallocate(fileobj%restart_vars)
789 fileobj%is_restart = .false.
790 fileobj%num_restart_vars = 0
791 do i = 1, fileobj%num_compressed_dims
792 if (
allocated(fileobj%compressed_dims(i)%npes_corner))
then
793 deallocate(fileobj%compressed_dims(i)%npes_corner)
795 if (
allocated(fileobj%compressed_dims(i)%npes_nelems))
then
796 deallocate(fileobj%compressed_dims(i)%npes_nelems)
799 if (
allocated(fileobj%compressed_dims))
then
800 deallocate(fileobj%compressed_dims)
812 character(len=*),
intent(in) :: dim_name
817 dindex = dimension_not_found
818 do i = 1, fileobj%num_compressed_dims
819 if (
string_compare(fileobj%compressed_dims(i)%dimname, dim_name))
then
833 character(len=*),
intent(in) :: dim_name
834 integer,
dimension(:),
intent(in) :: npes_corner
836 integer,
dimension(:),
intent(in) :: npes_nelems
843 call error(
"dimension "//trim(dim_name)//
" already registered" &
844 //
" to file "//trim(fileobj%path)//
".")
846 fileobj%num_compressed_dims = fileobj%num_compressed_dims + 1
847 n = fileobj%num_compressed_dims
848 if (n .gt. max_num_compressed_dims)
then
849 call error(
"number of compressed dimensions exceeds limit.")
851 call string_copy(fileobj%compressed_dims(n)%dimname, dim_name)
852 if (
size(npes_corner) .ne.
size(fileobj%pelist) .or. &
853 size(npes_nelems) .ne.
size(fileobj%pelist))
then
854 call error(
"incorrect size for input npes_corner or npes_nelems arrays.")
856 allocate(fileobj%compressed_dims(n)%npes_corner(
size(fileobj%pelist)))
857 fileobj%compressed_dims(n)%npes_corner(:) = npes_corner(:)
858 allocate(fileobj%compressed_dims(n)%npes_nelems(
size(fileobj%pelist)))
859 fileobj%compressed_dims(n)%npes_nelems(:) = npes_nelems(:)
860 fileobj%compressed_dims(n)%nelems = sum(fileobj%compressed_dims(n)%npes_nelems)
868 character(len=*),
intent(in) :: dimension_name
869 integer,
intent(in) :: dimension_length
871 integer,
dimension(:),
allocatable :: npes_start
872 integer,
dimension(:),
allocatable :: npes_count
878 allocate(npes_start(
size(fileobj%pelist)))
879 allocate(npes_count(
size(fileobj%pelist)))
881 call mpp_gather((/dimension_length/),npes_count,pelist=fileobj%pelist)
884 do i = 1,
size(fileobj%pelist)-1
885 npes_start(i+1) = npes_start(i) + npes_count(i)
890 if (fileobj%is_root .and. .not. fileobj%is_readonly)
then
892 err = nf90_def_dim(fileobj%ncid, trim(dimension_name), unlimited, dimid)
893 call check_netcdf_code(err,
"Netcdf_add_dimension: file:"//trim(fileobj%path)//
" dimension name:"// &
894 & trim(dimension_name))
903 character(len=*),
intent(in) :: dimension_name
904 integer,
intent(in) :: dimension_length
905 logical,
intent(in),
optional :: is_compressed
911 integer,
dimension(:),
allocatable :: npes_start
912 integer,
dimension(:),
allocatable :: npes_count
917 dim_len = dimension_length
918 if (
present(is_compressed))
then
919 if (is_compressed)
then
921 allocate(npes_start(
size(fileobj%pelist)))
922 allocate(npes_count(
size(fileobj%pelist)))
923 do i = 1,
size(fileobj%pelist)
924 if (fileobj%pelist(i) .eq.
mpp_pe())
then
925 npes_count(i) = dim_len
927 call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
928 call mpp_send(dim_len, fileobj%pelist(i))
934 do i = 1,
size(fileobj%pelist)-1
935 npes_start(i+1) = npes_start(i) + npes_count(i)
939 dim_len = sum(npes_count)
942 if ((fileobj%is_root) .and. .not. fileobj%is_readonly)
then
944 err = nf90_def_dim(fileobj%ncid, trim(dimension_name), dim_len, dimid)
945 call check_netcdf_code(err,
"Netcdf_add_dimension: file:"//trim(fileobj%path)//
" dimension name:"// &
946 & trim(dimension_name))
953 npes_corner, npes_nelems)
956 character(len=*),
intent(in) :: dimension_name
957 integer,
dimension(:),
intent(in) :: npes_corner
959 integer,
dimension(:),
intent(in) :: npes_nelems
967 dsize = sum(npes_nelems)
968 if (fileobj%is_readonly)
then
970 if (fdim_size .ne. dsize)
then
971 call error(
"dimension "//trim(dimension_name)//
" does not match" &
972 //
" the size of the associated compressed axis.")
984 character(len=*),
intent(in) :: variable_name
985 character(len=*),
intent(in) :: variable_type
988 character(len=*),
dimension(:),
intent(in),
optional :: dimensions
989 integer,
optional,
intent(in) :: chunksizes(:)
993 integer,
dimension(:),
allocatable :: dimids
997 character(len=200) :: append_error_msg
999 append_error_msg =
"netcdf_add_variable: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)
1001 if (fileobj%is_root)
then
1006 if ( .not. fileobj%is_netcdf4)
call error(trim(fileobj%path)//&
1007 &
": 64 bit integers are only supported with 'netcdf4' file format"//&
1008 &
". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
1009 &
"add nc_format='netcdf4' to your open_file call")
1017 if (.not.
present(dimensions))
then
1018 call error(
"String variables require a string length dimension:"//trim(append_error_msg))
1021 call error(
"Unsupported variable type:"//trim(append_error_msg))
1023 if (
present(dimensions))
then
1024 allocate(dimids(
size(dimensions)))
1025 do i = 1,
size(dimids)
1026 dimids(i) =
get_dimension_id(fileobj%ncid, trim(dimensions(i)),msg=append_error_msg)
1028 if (fileobj%is_netcdf4)
then
1029 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid, &
1033 &
call mpp_error(note,
"Not able to use deflate_level or chunksizes if not using netcdf4"// &
1035 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid)
1039 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, varid)
1044 if (fileobj%use_netcdf_mpi.and.fileobj%use_collective)
then
1045 err = nf90_var_par_access(fileobj%ncid, varid, nf90_collective)
1055 result(compressed_dimension_index)
1058 character(len=*),
intent(in) :: variable_name
1059 logical,
intent(in),
optional :: broadcast
1065 integer,
dimension(2) :: compressed_dimension_index
1068 character(len=nf90_max_name),
dimension(:),
allocatable :: dim_names
1072 compressed_dimension_index = dimension_not_found
1073 if (fileobj%is_root)
then
1075 if (ndims .gt. 0)
then
1076 allocate(dim_names(ndims))
1078 do i = 1,
size(dim_names)
1080 if (j .ne. dimension_not_found)
then
1081 compressed_dimension_index(1) = i
1082 compressed_dimension_index(2) = j
1086 deallocate(dim_names)
1089 if (
present(broadcast))
then
1090 if (.not. broadcast)
then
1094 call mpp_broadcast(compressed_dimension_index(1), fileobj%io_root, pelist=fileobj%pelist)
1095 call mpp_broadcast(compressed_dimension_index(2), fileobj%io_root, pelist=fileobj%pelist)
1104 character(len=*),
intent(in) :: variable_name
1108 if (.not. fileobj%is_restart)
then
1109 call error(
"file "//trim(fileobj%path)//
" is not a restart file.")
1111 do i = 1, fileobj%num_restart_vars
1112 if (
string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.))
then
1113 call error(
"variable "//trim(variable_name)//
" has already" &
1114 //
" been added to restart file "//trim(fileobj%path)//
".")
1117 fileobj%num_restart_vars = fileobj%num_restart_vars + 1
1118 if (fileobj%num_restart_vars .gt. max_num_restart_vars)
then
1119 call error(
"Number of restart variables exceeds limit.")
1121 call string_copy(fileobj%restart_vars(fileobj%num_restart_vars)%varname, &
1131 integer,
intent(in),
optional :: unlim_dim_level
1136 if (.not. fileobj%is_restart)
then
1137 call error(
"write_restart:: file "//trim(fileobj%path)//
" is not a restart file. &
1138 &Be sure the file was opened with is_restart=.true.")
1140 do i = 1, fileobj%num_restart_vars
1141 if (
associated(fileobj%restart_vars(i)%data0d))
then
1143 fileobj%restart_vars(i)%data0d, &
1144 unlim_dim_level=unlim_dim_level)
1145 elseif (
associated(fileobj%restart_vars(i)%data1d))
then
1147 fileobj%restart_vars(i)%data1d, &
1148 unlim_dim_level=unlim_dim_level)
1149 elseif (
associated(fileobj%restart_vars(i)%data2d))
then
1151 fileobj%restart_vars(i)%data2d, &
1152 unlim_dim_level=unlim_dim_level)
1153 elseif (
associated(fileobj%restart_vars(i)%data3d))
then
1155 fileobj%restart_vars(i)%data3d, &
1156 unlim_dim_level=unlim_dim_level)
1157 elseif (
associated(fileobj%restart_vars(i)%data4d))
then
1159 fileobj%restart_vars(i)%data4d, &
1160 unlim_dim_level=unlim_dim_level)
1162 call error(
"this branch should not be reached.")
1173 integer,
intent(in),
optional :: unlim_dim_level
1178 if (.not. fileobj%is_restart)
then
1179 call error(
"read_restart:: file "//trim(fileobj%path)//
" is not a restart file. &
1180 &Be sure the file was opened with is_restart=.true.")
1182 do i = 1, fileobj%num_restart_vars
1183 if (
associated(fileobj%restart_vars(i)%data0d))
then
1185 fileobj%restart_vars(i)%data0d, &
1186 unlim_dim_level=unlim_dim_level, &
1188 elseif (
associated(fileobj%restart_vars(i)%data1d))
then
1190 fileobj%restart_vars(i)%data1d, &
1191 unlim_dim_level=unlim_dim_level, &
1193 elseif (
associated(fileobj%restart_vars(i)%data2d))
then
1195 fileobj%restart_vars(i)%data2d, &
1196 unlim_dim_level=unlim_dim_level, &
1198 elseif (
associated(fileobj%restart_vars(i)%data3d))
then
1200 fileobj%restart_vars(i)%data3d, &
1201 unlim_dim_level=unlim_dim_level, &
1203 elseif (
associated(fileobj%restart_vars(i)%data4d))
then
1205 fileobj%restart_vars(i)%data4d, &
1206 unlim_dim_level=unlim_dim_level, &
1209 call error(
"this branch should not be reached.")
1221 character(len=*),
intent(in) :: attribute_name
1222 logical,
intent(in),
optional :: broadcast
1228 logical :: att_exists
1230 if (fileobj%is_root)
then
1231 att_exists =
attribute_exists(fileobj%ncid, nf90_global, trim(attribute_name), &
1232 & msg=
"global_att_exists: file:"//trim(fileobj%path)//
" attribute name:"//trim(attribute_name))
1234 if (
present(broadcast))
then
1235 if (.not. broadcast)
then
1239 call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1250 character(len=*),
intent(in) :: variable_name
1251 character(len=*),
intent(in) :: attribute_name
1252 logical,
intent(in),
optional :: broadcast
1258 logical :: att_exists
1262 att_exists = .false.
1263 if (fileobj%is_root)
then
1265 & msg=
"variable_att_exists: file:"//trim(fileobj%path)//
"- variable:"//&
1266 &trim(variable_name))
1268 &msg=
"variable_att_exists: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)//&
1269 &
" attribute name:"//trim(attribute_name))
1271 if (
present(broadcast))
then
1272 if (.not. broadcast)
then
1276 call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1286 logical,
intent(in),
optional :: broadcast
1296 if (fileobj%is_root)
then
1297 err = nf90_inquire(fileobj%ncid, ndimensions=ndims)
1300 if (
present(broadcast))
then
1301 if (.not. broadcast)
then
1305 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1313 character(len=*),
dimension(:),
intent(inout) :: names
1315 logical,
intent(in),
optional :: broadcast
1326 if (fileobj%is_root)
then
1328 if (ndims .gt. 0)
then
1329 if (
size(names) .ne. ndims)
then
1330 call error(
"'names' has to be the same size of the number of dimensions. &
1331 &Check your get_dimension_names call for file "//trim(fileobj%path))
1334 call error(
"get_dimension_names: the file "//trim(fileobj%path)//
" does not have any dimensions")
1338 err = nf90_inquire_dimension(fileobj%ncid, i, name=names(i))
1342 if (
present(broadcast))
then
1343 if (.not. broadcast)
then
1347 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1348 if (.not. fileobj%is_root)
then
1349 if (ndims .gt. 0)
then
1350 if (
size(names) .ne. ndims)
then
1351 call error(
"'names' has to be the same size of the number of dimensions. &
1352 &Check your get_dimension_names call for file "//trim(fileobj%path))
1355 call error(
"get_dimension_names: the file "//trim(fileobj%path)//
" does not have any dimensions")
1359 call mpp_broadcast(names, len(names(ndims)), fileobj%io_root, &
1360 pelist=fileobj%pelist)
1370 character(len=*),
intent(in) :: dimension_name
1371 logical,
intent(in),
optional :: broadcast
1377 logical :: dim_exists
1381 if (fileobj%is_root)
then
1383 msg=
"dimension_exists: file:"//trim(fileobj%path)//
" dimension:"//trim(dimension_name), &
1384 allow_failure=.true.)
1385 if (dimid .eq. dimension_missing)
then
1386 dim_exists = .false.
1391 if (
present(broadcast))
then
1392 if (.not. broadcast)
then
1396 call mpp_broadcast(dim_exists, fileobj%io_root, pelist=fileobj%pelist)
1403 result(is_unlimited)
1406 character(len=*),
intent(in) :: dimension_name
1407 logical,
intent(in),
optional :: broadcast
1413 logical :: is_unlimited
1415 character(len=200) :: append_error_msg
1418 integer :: ulim_dimid
1420 if (fileobj%is_root)
then
1421 append_error_msg=
"is_dimension_unlimited: file:"//trim(fileobj%path)//&
1422 &
" dimension_name:"//trim(dimension_name)
1423 dimid =
get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1424 err = nf90_inquire(fileobj%ncid, unlimiteddimid=ulim_dimid)
1426 is_unlimited = dimid .eq. ulim_dimid
1428 if (
present(broadcast))
then
1429 if (.not. broadcast)
then
1433 call mpp_broadcast(is_unlimited, fileobj%io_root, pelist=fileobj%pelist)
1441 character(len=*),
intent(out) :: dimension_name
1442 logical,
intent(in),
optional :: broadcast
1451 character(len=nf90_max_name),
dimension(1) :: buffer
1454 if (fileobj%is_root)
then
1455 err = nf90_inquire(fileobj%ncid, unlimiteddimid=dimid)
1456 call check_netcdf_code(err,
"get_unlimited_dimension_name: file:"//trim(fileobj%path))
1457 err = nf90_inquire_dimension(fileobj%ncid, dimid, dimension_name)
1458 call check_netcdf_code(err,
"get_unlimited_dimension_name: file:"//trim(fileobj%path))
1459 call string_copy(buffer(1), dimension_name)
1461 if (
present(broadcast))
then
1462 if (.not. broadcast)
then
1466 call mpp_broadcast(buffer, nf90_max_name, fileobj%io_root, &
1467 pelist=fileobj%pelist)
1468 call string_copy(dimension_name, buffer(1))
1476 character(len=*),
intent(in) :: dimension_name
1477 integer,
intent(inout) :: dim_size
1478 logical,
intent(in),
optional :: broadcast
1487 character(len=200) :: append_error_msg
1489 if (fileobj%is_root)
then
1490 append_error_msg =
"get_dimension_size: file:"//trim(fileobj%path)//
" dimension_name: "//trim(dimension_name)
1491 dimid =
get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1492 err = nf90_inquire_dimension(fileobj%ncid, dimid, len=dim_size)
1495 if (
present(broadcast))
then
1496 if (.not. broadcast)
then
1500 call mpp_broadcast(dim_size, fileobj%io_root, pelist=fileobj%pelist)
1510 logical,
intent(in),
optional :: broadcast
1520 if (fileobj%is_root)
then
1521 err = nf90_inquire(fileobj%ncid, nvariables=nvars)
1524 if (
present(broadcast))
then
1525 if (.not. broadcast)
then
1529 call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1537 character(len=*),
dimension(:),
intent(inout) :: names
1539 logical,
intent(in),
optional :: broadcast
1550 if (fileobj%is_root)
then
1552 if (nvars .gt. 0)
then
1553 if (
size(names) .ne. nvars)
then
1554 call error(
"'names' has to be the same size of the number of variables. &
1555 &Check your get_variable_names call for file "//trim(fileobj%path))
1558 call error(
"get_variable_names: the file "//trim(fileobj%path)//
" does not have any variables")
1562 err = nf90_inquire_variable(fileobj%ncid, i, name=names(i))
1566 if (
present(broadcast))
then
1567 if (.not. broadcast)
then
1571 call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1572 if (.not. fileobj%is_root)
then
1573 if (nvars .gt. 0)
then
1574 if (
size(names) .ne. nvars)
then
1575 call error(
"'names' has to be the same size of the number of variables. &
1576 &Check your get_variable_names call for file "//trim(fileobj%path))
1579 call error(
"get_variable_names: the file "//trim(fileobj%path)//
" does not have any variables")
1583 call mpp_broadcast(names, len(names(nvars)), fileobj%io_root, &
1584 pelist=fileobj%pelist)
1594 character(len=*),
intent(in) :: variable_name
1595 logical,
intent(in),
optional :: broadcast
1601 logical :: var_exists
1605 if (fileobj%is_root)
then
1607 msg=
"variable_exists: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name), &
1608 allow_failure=.true.)
1609 var_exists = varid .ne. variable_missing
1611 if (
present(broadcast))
then
1612 if (.not. broadcast)
then
1616 call mpp_broadcast(var_exists, fileobj%io_root, pelist=fileobj%pelist)
1626 character(len=*),
intent(in) :: variable_name
1627 logical,
intent(in),
optional :: broadcast
1637 character(len=200) :: append_error_msg
1640 if (fileobj%is_root)
then
1641 append_error_msg =
"get_variable_num_dimension: file:"//trim(fileobj%path)//
" variable: "//trim(variable_name)
1642 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1643 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims)
1646 if (
present(broadcast))
then
1647 if (.not. broadcast)
then
1651 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1660 character(len=*),
intent(in) :: variable_name
1661 character(len=*),
dimension(:),
intent(inout) :: dim_names
1664 logical,
intent(in),
optional :: broadcast
1674 integer,
dimension(nf90_max_var_dims) :: dimids
1676 character(len=200) :: append_error_msg
1679 if (fileobj%is_root)
then
1680 append_error_msg =
"get_variable_dimension_names: file:"//trim(fileobj%path)//
" variable: "//trim(variable_name)
1682 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1683 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, &
1686 if (ndims .gt. 0)
then
1687 if (
size(dim_names) .ne. ndims)
then
1688 call error(
"'names' has to be the same size of the number of dimensions for the variable. &
1689 &Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1690 " and variable:"//trim(variable_name))
1693 call error(
"get_variable_dimension_names: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)&
1694 & //
" does not any dimensions. ")
1698 err = nf90_inquire_dimension(fileobj%ncid, dimids(i), name=dim_names(i))
1702 if (
present(broadcast))
then
1703 if (.not. broadcast)
then
1707 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1708 if (.not. fileobj%is_root)
then
1709 if (ndims .gt. 0)
then
1710 if (
size(dim_names) .ne. ndims)
then
1711 call error(
"'names' has to be the same size of the number of dimensions for the variable. &
1712 & Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1713 " and variable:"//trim(variable_name))
1716 call error(
"get_variable_dimension_names: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)&
1717 & //
" does not any dimensions. ")
1721 call mpp_broadcast(dim_names, len(dim_names(ndims)), fileobj%io_root, &
1722 pelist=fileobj%pelist)
1730 character(len=*),
intent(in) :: variable_name
1731 integer,
dimension(:),
intent(inout) :: dim_sizes
1733 logical,
intent(in),
optional :: broadcast
1743 integer,
dimension(nf90_max_var_dims) :: dimids
1745 character(len=200) :: append_error_msg
1747 if (fileobj%is_root)
then
1748 append_error_msg =
"get_variable_size: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)
1749 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1750 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, dimids=dimids)
1752 if (ndims .gt. 0)
then
1753 if (
size(dim_sizes) .ne. ndims)
then
1754 call error(
"'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1755 &Check your get_variable_size call for file "//trim(fileobj%path)// &
1756 " and variable:"//trim(variable_name))
1759 call error(
"get_variable_size: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)//&
1760 &
" does not any dimensions. ")
1763 err = nf90_inquire_dimension(fileobj%ncid, dimids(i), len=dim_sizes(i))
1767 if (
present(broadcast))
then
1768 if (.not. broadcast)
then
1772 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1773 if (.not. fileobj%is_root)
then
1774 if (ndims .gt. 0)
then
1775 if (
size(dim_sizes) .ne. ndims)
then
1776 call error(
"'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1777 &Check your get_variable_size call for file "//trim(fileobj%path)// &
1778 " and variable:"//trim(variable_name))
1781 call error(
"get_variable_size: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)//&
1782 &
" does not any dimensions. ")
1785 call mpp_broadcast(dim_sizes, ndims, fileobj%io_root, pelist=fileobj%pelist)
1794 result(unlim_dim_index)
1797 character(len=*),
intent(in) :: variable_name
1798 logical,
intent(in),
optional :: broadcast
1804 integer :: unlim_dim_index
1807 character(len=nf90_max_name),
dimension(:),
allocatable :: dim_names
1810 unlim_dim_index = no_unlimited_dimension
1811 if (fileobj%is_root)
then
1813 allocate(dim_names(ndims))
1816 do i = 1,
size(dim_names)
1822 deallocate(dim_names)
1824 if (
present(broadcast))
then
1825 if (.not. broadcast)
then
1829 call mpp_broadcast(unlim_dim_index, fileobj%io_root, pelist=fileobj%pelist)
1840 character(len=*),
intent(in) :: variable_name
1844 real(kind=r8_kind) :: scale_factor
1845 real(kind=r8_kind) :: add_offset
1846 real(kind=r8_kind),
dimension(2) :: buffer
1848 character(len=200) :: append_error_msg
1850 append_error_msg =
"get_valid: file:"//trim(fileobj%path)
1851 if (fileobj%is_root)
then
1852 varid =
get_variable_id(fileobj%ncid, variable_name, msg=append_error_msg)
1853 valid%has_max = .false.
1854 valid%has_min = .false.
1855 valid%has_fill = .false.
1856 valid%has_missing = .false.
1857 valid%has_range = .false.
1861 if (
attribute_exists(fileobj%ncid, varid,
"scale_factor", msg=append_error_msg))
then
1865 scale_factor = 1._r8_kind
1867 if (
attribute_exists(fileobj%ncid, varid,
"add_offset", msg=append_error_msg))
then
1871 add_offset = 0._r8_kind
1878 if (
attribute_exists(fileobj%ncid, varid,
"valid_range", msg=append_error_msg))
then
1881 valid%max_val = buffer(2)*scale_factor + add_offset
1882 valid%has_max = .true.
1883 valid%min_val = buffer(1)*scale_factor + add_offset
1884 valid%has_min = .true.
1886 if (
attribute_exists(fileobj%ncid, varid,
"valid_max", msg=append_error_msg))
then
1889 valid%max_val = buffer(1)*scale_factor + add_offset
1890 valid%has_max = .true.
1892 if (
attribute_exists(fileobj%ncid, varid,
"valid_min", msg=append_error_msg))
then
1895 valid%min_val = buffer(1)*scale_factor + add_offset
1896 valid%has_min = .true.
1899 valid%has_range = valid%has_min .or. valid%has_max
1903 if (
attribute_exists(fileobj%ncid, varid,
"missing_value", msg=append_error_msg))
then
1906 valid%missing_val = buffer(1)*scale_factor + add_offset
1907 valid%has_missing = .true.
1918 if (
attribute_exists(fileobj%ncid, varid,
"_FillValue", msg=append_error_msg))
then
1921 valid%fill_val = buffer(1)*scale_factor + add_offset
1922 valid%has_fill = .true.
1925 if (.not. valid%has_range)
then
1926 if (xtype .eq. nf90_short .or. xtype .eq. nf90_int)
then
1927 if (buffer(1) .gt. 0)
then
1928 valid%max_val = (buffer(1) - 1._r8_kind)*scale_factor + add_offset
1929 valid%has_max = .true.
1931 valid%min_val = (buffer(1) + 1._r8_kind)*scale_factor + add_offset
1932 valid%has_min = .true.
1934 elseif (xtype .eq. nf90_float .or. xtype .eq. nf90_double)
then
1935 if (buffer(1) .gt. 0)
then
1936 valid%max_val = (nearest(nearest(buffer(1), -1._r8_kind), -1._r8_kind)) &
1937 *scale_factor + add_offset
1938 valid%has_max = .true.
1940 valid%min_val = (nearest(nearest(buffer(1), 1._r8_kind), 1._r8_kind)) &
1941 *scale_factor + add_offset
1942 valid%has_min = .true.
1945 call error(
"Unsupported variable type:"//trim(append_error_msg))
1947 valid%has_range = .true.
1953 call mpp_broadcast(valid%has_min, fileobj%io_root, pelist=fileobj%pelist)
1954 if (valid%has_min)
then
1955 call mpp_broadcast(valid%min_val, fileobj%io_root, pelist=fileobj%pelist)
1957 call mpp_broadcast(valid%has_max, fileobj%io_root, pelist=fileobj%pelist)
1958 if (valid%has_max)
then
1959 call mpp_broadcast(valid%max_val, fileobj%io_root, pelist=fileobj%pelist)
1961 call mpp_broadcast(valid%has_range, fileobj%io_root, pelist=fileobj%pelist)
1963 call mpp_broadcast(valid%has_fill, fileobj%io_root, pelist=fileobj%pelist)
1964 if (valid%has_fill)
then
1965 call mpp_broadcast(valid%fill_val, fileobj%io_root, pelist=fileobj%pelist)
1968 call mpp_broadcast(valid%has_missing, fileobj%io_root, pelist=fileobj%pelist)
1969 if (valid%has_missing)
then
1970 call mpp_broadcast(valid%missing_val, fileobj%io_root, pelist=fileobj%pelist)
1980 real(kind=r8_kind),
intent(in) :: datum
1981 type(
valid_t),
intent(in) :: validobj
1982 logical :: valid_data
1993 real(kind=r4_kind),
intent(in) :: datum
1994 type(
valid_t),
intent(in) :: validobj
1995 logical :: valid_data
1997 real(kind=r8_kind) :: rdatum
2000 rdatum = real(datum, kind=r8_kind)
2010 real(kind=r8_kind),
intent(in) :: rdatum
2011 type(
valid_t),
intent(in) :: validobj
2012 logical :: valid_data
2017 if (validobj%has_range)
then
2018 if (validobj%has_min .and. .not. validobj%has_max)
then
2019 valid_data = rdatum .ge. validobj%min_val
2020 elseif (validobj%has_max .and. .not. validobj%has_min)
then
2021 valid_data = rdatum .le. validobj%max_val
2023 valid_data = .not. (rdatum .lt. validobj%min_val .or. rdatum .gt. validobj%max_val)
2028 if (validobj%has_fill .or. validobj%has_missing)
then
2029 if (validobj%has_fill .and. .not. validobj%has_missing)
then
2030 valid_data = rdatum .ne. validobj%fill_val
2031 elseif (validobj%has_missing .and. .not. validobj%has_fill)
then
2032 valid_data = rdatum .ne. validobj%missing_val
2034 valid_data = .not. (rdatum .eq. validobj%missing_val .or. rdatum .eq. validobj%fill_val)
2044 integer,
intent(in) :: nelems
2045 integer,
dimension(:),
allocatable,
intent(out) :: npes_start
2046 integer,
dimension(:),
allocatable,
intent(out) :: npes_count
2051 allocate(npes_start(
size(fileobj%pelist)))
2052 allocate(npes_count(
size(fileobj%pelist)))
2053 do i = 1,
size(fileobj%pelist)
2054 if (fileobj%pelist(i) .eq.
mpp_pe())
then
2055 npes_count(i) = nelems
2057 call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
2058 call mpp_send(nelems, fileobj%pelist(i))
2064 do i = 1,
size(fileobj%pelist)-1
2065 npes_start(i+1) = npes_start(i) + npes_count(i)
2070 include
"netcdf_add_restart_variable.inc"
2071 include
"netcdf_read_data.inc"
2072 include
"netcdf_write_data.inc"
2073 include
"register_global_attribute.inc"
2074 include
"register_variable_attribute.inc"
2075 include
"get_global_attribute.inc"
2076 include
"get_variable_attribute.inc"
2077 include
"compressed_write.inc"
2078 include
"compressed_read.inc"
2079 include
"scatter_data_bc.inc"
2080 include
"gather_data_bc.inc"
2081 include
"unpack_data.inc"
2085 dont_add_res_to_filename)
result(success)
2088 character(len=*),
intent(in) :: path
2089 character(len=*),
intent(in) :: mode
2092 character(len=*),
intent(in),
optional :: nc_format
2098 integer,
dimension(:),
intent(in),
optional :: pelist
2103 logical,
intent(in),
optional :: is_restart
2106 logical,
intent(in),
optional :: dont_add_res_to_filename
2110 success =
netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
2127 character(len=*),
intent(in) :: variable_name
2128 character(len=*),
intent(in) :: variable_type
2131 character(len=*),
dimension(:),
intent(in),
optional :: dimensions
2132 integer,
intent(in),
optional :: chunksizes(:)
2141 integer,
intent(in),
optional :: unlim_dim_level
2154 character(len=*),
intent(in) :: variable_name
2155 class(*),
intent(out) :: fill_value
2156 logical,
intent(in),
optional :: broadcast
2162 logical :: fill_exists
2164 character(len=32),
dimension(2) :: attribute_names
2168 fill_exists = .false.
2169 call string_copy(attribute_names(1),
"_FillValue")
2170 call string_copy(attribute_names(2),
"missing_value")
2171 if (
present(broadcast))
then
2176 do i = 1,
size(attribute_names)
2179 if (fill_exists)
then
2181 fill_value, broadcast=bcast)
2188 function get_variable_sense(fileobj, variable_name) &
2189 result(variable_sense)
2192 character(len=*),
intent(in) :: variable_name
2193 integer :: variable_sense
2195 character(len=256) :: buf
2206 end function get_variable_sense
2209 function get_variable_missing(fileobj, variable_name) &
2210 result(variable_missing)
2213 character(len=*),
intent(in) :: variable_name
2214 real(kind=r8_kind) :: variable_missing
2216 real(kind=r8_kind) :: variable_missing_1d(1)
2225 variable_missing_1d = mpp_fill_double
2228 variable_missing = variable_missing_1d(1)
2230 end function get_variable_missing
2233 subroutine get_variable_units(fileobj, variable_name, units)
2236 character(len=*),
intent(in) :: variable_name
2237 character(len=*),
intent(out) :: units
2244 end subroutine get_variable_units
2247 subroutine get_time_calendar(fileobj, time_name, calendar_type)
2250 character(len=*),
intent(in) :: time_name
2251 character(len=*),
intent(out) :: calendar_type
2258 calendar_type =
"unspecified"
2260 end subroutine get_time_calendar
2266 result(is_registered)
2269 character(len=*),
intent(in) :: variable_name
2270 logical :: is_registered
2274 if (.not. fileobj%is_restart)
then
2275 call error(
"file "//trim(fileobj%path)//
" is not a restart file. &
2276 &Add is_restart=.true. to your open_file call")
2278 is_registered = .false.
2279 do i = 1, fileobj%num_restart_vars
2280 if (
string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.))
then
2281 is_registered = .true.
2291 character(len=*),
intent(in),
optional :: fname
2294 if (
allocated(fileobj%is_open))
then
2295 is_open = fileobj%is_open
2300 if (
present(fname))
then
2303 if (is_open .AND. trim(fname) .ne. trim(fileobj%path)) is_open = .false.
2307 subroutine set_fileobj_time_name (fileobj,time_name)
2309 character(*),
intent(in) :: time_name
2310 integer :: len_of_name
2311 len_of_name = len(trim(time_name))
2312 fileobj%time_name =
' '
2313 fileobj%time_name = time_name(1:len_of_name)
2320 end subroutine set_fileobj_time_name
2326 integer,
intent(in),
optional :: unlim_dim_level
2328 logical,
intent(in),
optional :: ignore_checksum
2332 if (.not. fileobj%is_restart)
then
2333 call error(
"file "//trim(fileobj%path)//
" is not a restart file.")
2336 do i = 1, fileobj%num_restart_vars
2338 if (.not.any(
mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2341 if (
associated(fileobj%restart_vars(i)%data2d))
then
2343 fileobj%restart_vars(i)%data2d, &
2344 fileobj%restart_vars(i)%bc_info, &
2345 unlim_dim_level = unlim_dim_level, &
2346 ignore_checksum=ignore_checksum)
2347 else if (
associated(fileobj%restart_vars(i)%data3d))
then
2349 fileobj%restart_vars(i)%data3d, &
2350 fileobj%restart_vars(i)%bc_info, &
2351 unlim_dim_level = unlim_dim_level, &
2352 ignore_checksum=ignore_checksum)
2363 integer,
intent(in),
optional :: unlim_dim_level
2367 if (.not. fileobj%is_restart)
then
2368 call error(
"file "//trim(fileobj%path)//
" is not a restart file. &
2369 &Add is_restart=.true. to your open_file call")
2377 do i = 1, fileobj%num_restart_vars
2379 if (.not.any(
mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2382 if (.not. fileobj%restart_vars(i)%is_bc_variable) cycle
2385 if (
associated(fileobj%restart_vars(i)%data2d))
then
2386 call gather_data_bc(fileobj, fileobj%restart_vars(i)%data2d, fileobj%restart_vars(i)%bc_info)
2388 fileobj%restart_vars(i)%bc_info%chksum(1:len(fileobj%restart_vars(i)%bc_info%chksum)),&
2389 str_len=len(fileobj%restart_vars(i)%bc_info%chksum))
2390 else if (
associated(fileobj%restart_vars(i)%data3d))
then
2391 call gather_data_bc(fileobj, fileobj%restart_vars(i)%data3d, fileobj%restart_vars(i)%bc_info)
2393 fileobj%restart_vars(i)%bc_info%chksum(1:len(fileobj%restart_vars(i)%bc_info%chksum)),&
2394 str_len=len(fileobj%restart_vars(i)%bc_info%chksum))
2399 do i = 1, fileobj%num_restart_vars
2400 if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r8 ))
then
2402 fileobj%restart_vars(i)%bc_info%globaldata2d_r8 , &
2403 unlim_dim_level=unlim_dim_level)
2404 deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r8)
2405 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r4 ))
then
2407 fileobj%restart_vars(i)%bc_info%globaldata2d_r4 , &
2408 unlim_dim_level=unlim_dim_level)
2409 deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r4)
2410 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r8 ))
then
2412 fileobj%restart_vars(i)%bc_info%globaldata3d_r8 , &
2413 unlim_dim_level=unlim_dim_level)
2414 deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r8)
2415 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 ))
then
2417 fileobj%restart_vars(i)%bc_info%globaldata3d_r4 , &
2418 unlim_dim_level=unlim_dim_level)
2419 deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 )
2432 if (fileobj%is_root)
then
2433 err = nf90_sync(fileobj%ncid)
2439 subroutine init(this, offloading_obj_id, offloading_pes, model_pes, domain)
2441 integer,
intent(in) :: offloading_obj_id
2442 integer,
intent(in) :: offloading_pes(:)
2443 integer,
intent(in) :: model_pes(:)
2446 this%id = offloading_obj_id
2447 allocate(this%offloading_pes(
size(offloading_pes)))
2448 this%offloading_pes = offloading_pes
2449 allocate(this%model_pes(
size(model_pes)))
2450 this%model_pes = model_pes
2452 this%is_model_pe = .false.
2453 if (any(model_pes .eq.
mpp_pe())) &
2454 this%is_model_pe = .true.
2455 this%domain_in = domain
2464 end module netcdf_io_mod
subroutine compressed_write_1d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine register_variable_attribute_1d(fileobj, variable_name, attribute_name, attribute_value, str_len)
Add an attribute to a variable.
subroutine compressed_write_3d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_write_5d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine compressed_write_0d(fileobj, variable_name, cdata, unlim_dim_level, corner)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_read_0d(fileobj, variable_name, cdata, unlim_dim_level, corner)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_5d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_read_5d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_read_3d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_0d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner)
Wrapper to distinguish interfaces.
subroutine compressed_read_1d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_read_2d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_4d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_write_2d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine compressed_write_1d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine compressed_write_4d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine compressed_read_4d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
I/O domain reads in data from the netcdf file and broadcasts the data to the rest of the ranks....
subroutine compressed_write_2d(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
For variables without a compressed dimension, this routine simply wraps netcdf_write data....
subroutine register_variable_attribute_0d(fileobj, variable_name, attribute_name, attribute_value, str_len)
Add an attribute to a variable.
subroutine compressed_write_3d_wrap(fileobj, variable_name, cdata, unlim_dim_level, corner, edge_lengths)
Wrapper to distinguish interfaces.
subroutine, public get_instance_filename(name_in, name_out)
Adds the filename_appendix to name_in and sets it as name_out.
subroutine, public restart_filepath_mangle(dest, source)
Add ".res" to an input file path.
logical function, public file_exists(path)
Determine if a file exists.
logical function, public string_compare(string1, string2, ignore_case)
Compare strings.
The domain2D type contains all the necessary information to define the global, compute and data domai...
subroutine mpp_sync_self(pelist, check, request, msg_size, msg_type)
This is to check if current PE's outstanding puts are complete but we can't use shmem_fence because w...
integer, parameter, public mpp_comm_null
MPP_COMM_NULL acts as an analagous mpp-macro for MPI_COMM_NULL to share with fms2_io NetCDF4 mpi-io....
integer, parameter, public mpp_info_null
MPP_INFO_NULL acts as an analagous mpp-macro for MPI_INFO_NULL to share with fms2_io NetCDF4 mpi-io....
integer function mpp_pe()
Returns processor ID.
Perform parallel broadcasts.
Gather data sent from pelist onto the root pe Wrapper for MPI_gather, can be used with and without in...
Receive data from another PE.
Send data to a receiving PE.
integer, private fms2_ncchksz
Chunksize (bytes) used in nc_open and nc_create.
subroutine, public netcdf_restore_state(fileobj, unlim_dim_level)
Loop through registered restart variables and read them from a netcdf file.
subroutine append_compressed_dimension(fileobj, dim_name, npes_corner, npes_nelems)
Add a compressed dimension to a file object.
subroutine, public netcdf_file_close(fileobj)
Close a netcdf file.
subroutine netcdf_add_restart_variable_4d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
integer function, dimension(2) get_variable_compressed_dimension_index(fileobj, variable_name, broadcast)
Given a compressed variable, get the index of the compressed dimension.
elemental logical function is_valid_r8(datum, validobj)
Determine if a piece of (r4) data is "valid" (in the correct range.)
logical function attribute_exists(ncid, varid, attribute_name, msg)
Determine if an attribute exists.
subroutine, public get_variable_size(fileobj, variable_name, dim_sizes, broadcast)
Get the size of a variable's dimensions.
subroutine, public netcdf_add_dimension(fileobj, dimension_name, dimension_length, is_compressed)
Add a dimension to a file.
subroutine netcdf_add_restart_variable_0d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
type(valid_t) function, public get_valid(fileobj, variable_name)
Store the valid range for a variable.
subroutine, public read_restart_bc(fileobj, unlim_dim_level, ignore_checksum)
Loop through the registered restart variables (including regional variables) and read them from the n...
logical function, public is_dimension_unlimited(fileobj, dimension_name, broadcast)
Determine where or not the dimension is unlimited.
character(len=10), private fms2_nc_format
Netcdf format type used in netcdf_file_open.
integer function, public get_variable_unlimited_dimension_index(fileobj, variable_name, broadcast)
Get the index of a variable's unlimited dimensions.
logical function, public netcdf_file_open_wrap(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
Wrapper to distinguish interfaces.
integer function get_compressed_dimension_index(fileobj, dim_name)
Get the index of a compressed dimension in a file object.
subroutine, public compressed_start_and_count(fileobj, nelems, npes_start, npes_count)
Gathers a compressed arrays size and offset for each pe.
subroutine scatter_data_bc_2d(fileobj, varname, vdata, bc_info, unlim_dim_level, ignore_checksum)
integer, private fms2_header_buffer_val
value used in NF__ENDDEF
integer, private fms2_nc_format_param
Netcdf format type param used in nc_create.
elemental logical function is_valid_r4(datum, validobj)
Determine if a piece of (r8) data is "valid" (in the correct range.)
integer function, public get_variable_num_dimensions(fileobj, variable_name, broadcast)
Get the number of dimensions a variable depends on.
subroutine, public get_dimension_size(fileobj, dimension_name, dim_size, broadcast)
Get the length of a dimension.
subroutine netcdf_add_restart_variable_3d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine netcdf_write_data_4d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine netcdf_read_data_1d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
subroutine netcdf_add_restart_variable_5d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
elemental logical function check_if_valid(rdatum, validobj)
Determine if a piece of data is "valid" (in the correct range.)
subroutine netcdf_add_restart_variable_1d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
logical function, public global_att_exists(fileobj, attribute_name, broadcast)
Determine if a global attribute exists.
subroutine, public set_netcdf_mode(ncid, mode)
Switch to the correct netcdf mode.
subroutine init(this, offloading_obj_id, offloading_pes, model_pes, domain)
Initialization routine for fmsOffloadingIn_type.
subroutine netcdf_write_data_0d(fileobj, variable_name, variable_data, unlim_dim_level, corner)
Write data to a variable in a netcdf file.
subroutine register_global_attribute_0d(fileobj, attribute_name, attribute_value, str_len)
Add a global attribute.
subroutine get_variable_attribute_1d(fileobj, variable_name, attribute_name, attribute_value, broadcast)
Get the value of a variable's attribute.
subroutine netcdf_add_restart_variable_0d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
logical, private fms2_shuffle
Flag indicating whether to use the netcdf shuffle filter.
subroutine get_global_attribute_1d(fileobj, attribute_name, attribute_value, broadcast)
Get the value of a global attribute.
subroutine netcdf_add_restart_variable_3d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
subroutine netcdf_add_restart_variable_1d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine get_variable_attribute_0d(fileobj, variable_name, attribute_name, attribute_value, broadcast, reproduce_null_char_bug_flag)
Get the value of a variable's attribute.
subroutine register_restart_region_3d(fileobj, variable_name, vdata, indices, global_size, pelist, is_root_pe, x_halo, y_halo, jshift, ishift, is_optional)
Registers a regional 3D variable and stores the information needed.
subroutine register_global_attribute_1d(fileobj, attribute_name, attribute_value, str_len)
Add a global attribute.
logical function, public dimension_exists(fileobj, dimension_name, broadcast)
Determine if a dimension exists.
logical function, public is_registered_to_restart(fileobj, variable_name)
Determine if a variable has been registered to a restart file..
integer function get_dimension_id(ncid, dimension_name, msg, allow_failure)
Get the id of a dimension from its name.
subroutine, public register_compressed_dimension(fileobj, dimension_name, npes_corner, npes_nelems)
Add a compressed dimension.
logical function, public variable_att_exists(fileobj, variable_name, attribute_name, broadcast)
Determine if a variable's attribute exists.
integer, private fms2_deflate_level
Netcdf deflate level to use in nf90_def_var (integer between 1 to 9)
subroutine netcdf_read_data_5d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
subroutine netcdf_add_restart_variable_2d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine netcdf_write_data_3d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
logical function, public get_fill_value(fileobj, variable_name, fill_value, broadcast)
Returns a variable's fill value if it exists in the file.
subroutine gather_data_bc_3d(fileobj, vdata, bc_info)
gathers the 2d vdata from all of the relevant pes into the root_pe and saves it to a buffer.
subroutine, public get_variable_dimension_names(fileobj, variable_name, dim_names, broadcast)
Get the name of a variable's dimensions.
subroutine, public check_netcdf_code(err, msg)
Check for errors returned by netcdf.
subroutine netcdf_write_data_1d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine, public flush_file(fileobj)
flushes the netcdf file into disk
subroutine netcdf_add_restart_variable_4d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
subroutine get_global_attribute_0d(fileobj, attribute_name, attribute_value, broadcast)
Get the value of a global attribute.
subroutine netcdf_add_restart_variable_5d(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Add a restart variable to a netcdf file.
subroutine, public register_unlimited_compressed_axis(fileobj, dimension_name, dimension_length)
Add a "compressed" unlimited dimension to a netcdf file.
subroutine, public netcdf_save_restart(fileobj, unlim_dim_level)
Loop through registered restart variables and write them to a netcdf file.
subroutine netcdf_read_data_3d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
integer function, public get_variable_id(ncid, variable_name, msg, allow_failure)
Get the id of a variable from its name.
subroutine, public netcdf_add_variable_wrap(fileobj, variable_name, variable_type, dimensions, chunksizes)
Wrapper to distinguish interfaces.
subroutine netcdf_write_data_2d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine, public write_restart_bc(fileobj, unlim_dim_level)
Loop through the registered restart variables (including regional variables) and write them to the ne...
integer function get_variable_type(ncid, varid, msg)
Get the type of a netcdf variable.
logical, private fms2_is_netcdf4
Flag indicating whether the default netcdf file format is netcdf4.
subroutine, public netcdf_save_restart_wrap(fileobj, unlim_dim_level)
Wrapper to distinguish interfaces.
subroutine, public get_variable_names(fileobj, names, broadcast)
Get the names of the variables in a file.
subroutine netcdf_read_data_2d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
subroutine netcdf_add_restart_variable_2d_wrap(fileobj, variable_name, vdata, dimensions, is_optional, chunksizes)
Wrapper to distinguish interfaces.
subroutine, public get_dimension_names(fileobj, names, broadcast)
Get the names of the dimensions in a file.
subroutine gather_data_bc_2d(fileobj, vdata, bc_info)
gathers the 2d vdata from all of the relevant pes into the root_pe and saves it to a buffer.
logical function, public check_if_open(fileobj, fname)
subroutine, public netcdf_io_init(chksz, header_buffer_val, netcdf_default_format, deflate_level, shuffle)
Accepts the namelist fms2_io_nml variables relevant to netcdf_io_mod.
integer function, public get_num_variables(fileobj, broadcast)
Determine the number of variables in a file.
subroutine, public get_unlimited_dimension_name(fileobj, dimension_name, broadcast)
Get the name of the unlimited dimension.
integer function get_attribute_type(ncid, varid, attname, msg)
Get the type of a netcdf attribute.
pure logical function is_file_using_netcdf_mpi(this)
Getter for use_netcdf_mpi.
subroutine, public netcdf_add_variable(fileobj, variable_name, variable_type, dimensions, chunksizes)
Add a variable to a file.
subroutine scatter_data_bc_3d(fileobj, varname, vdata, bc_info, unlim_dim_level, ignore_checksum)
subroutine netcdf_write_data_5d(fileobj, variable_name, variable_data, unlim_dim_level, corner, edge_lengths)
Write data to a variable in a netcdf file.
subroutine register_restart_region_2d(fileobj, variable_name, vdata, indices, global_size, pelist, is_root_pe, x_halo, y_halo, jshift, ishift, is_optional)
Registers a regional 2D variable and stores the information needed.
logical function, public netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename, tile_comm, use_collective)
Open a netcdf file.
subroutine, public netcdf_file_close_wrap(fileobj)
Wrapper to distinguish interfaces.
subroutine netcdf_read_data_0d(fileobj, variable_name, buf, unlim_dim_level, corner, broadcast)
Read in data from a variable in a netcdf file.
logical function, public variable_exists(fileobj, variable_name, broadcast)
Determine if a variable exists.
subroutine add_restart_var_to_array(fileobj, variable_name)
Add a restart variable to a FmsNetcdfFile_t type.
integer function, public get_num_dimensions(fileobj, broadcast)
Determine the number of dimensions in a file.
subroutine netcdf_read_data_4d(fileobj, variable_name, buf, unlim_dim_level, corner, edge_lengths, broadcast)
Read in data from a variable in a netcdf file.
The interface is needed to accomodate pgi because it can't handle class * and there was no other way ...
Type to represent a netCDF file. Can be used with multiple cores but only the root pe will perform an...
Range type for a netcdf variable.