28 #ifndef MAX_NUM_RESTART_VARS_
29 #define MAX_NUM_RESTART_VARS_ 250
40 integer,
parameter,
public :: default_deflate_level = 0
41 integer,
parameter :: variable_missing = -1
42 integer,
parameter :: dimension_missing = -1
43 integer,
parameter,
public :: no_unlimited_dimension = -1
44 character(len=1),
parameter :: missing_path =
""
45 integer,
parameter :: missing_ncid = -1
46 integer,
parameter :: missing_rank = -1
47 integer,
parameter,
public :: define_mode = 0
48 integer,
parameter,
public :: data_mode = 1
49 integer,
parameter,
public :: max_num_restart_vars = max_num_restart_vars_
50 integer,
parameter,
public :: unlimited = nf90_unlimited
51 integer,
parameter :: dimension_not_found = 0
52 integer,
parameter,
public :: max_num_compressed_dims = 10
68 integer,
dimension(:),
allocatable :: indices
70 integer,
dimension(:),
allocatable :: global_size
71 integer,
dimension(:),
allocatable :: pelist
77 real(kind=r4_kind),
dimension(:,:),
allocatable :: globaldata2d_r4
78 real(kind=r4_kind),
dimension(:,:,:),
allocatable :: globaldata3d_r4
79 real(kind=r8_kind),
dimension(:,:),
allocatable :: globaldata2d_r8
80 real(kind=r8_kind),
dimension(:,:,:),
allocatable :: globaldata3d_r8
81 character(len=32) :: chksum
82 logical :: data_on_file_root
89 character(len=256) :: varname
90 class(*),
pointer :: data0d => null()
91 class(*),
dimension(:),
pointer :: data1d => null()
92 class(*),
dimension(:,:),
pointer :: data2d => null()
93 class(*),
dimension(:,:,:),
pointer :: data3d => null()
94 class(*),
dimension(:,:,:,:),
pointer :: data4d => null()
95 class(*),
dimension(:,:,:,:,:),
pointer :: data5d => null()
98 logical :: is_bc_variable
105 character(len=256) :: dimname
106 integer,
dimension(:),
allocatable :: npes_corner
108 integer,
dimension(:),
allocatable :: npes_nelems
117 integer,
dimension(5) :: xlen
118 integer,
dimension(5) :: ylen
119 integer,
dimension(5) :: zlen
120 integer,
dimension(3) :: cur_dim_len
129 character(len=FMS_PATH_LEN) :: path
130 logical :: is_readonly
132 character(len=256) :: nc_format
133 logical :: is_netcdf4
134 integer,
dimension(:),
allocatable :: pelist
139 logical :: is_restart
141 logical :: mode_is_append
142 logical,
allocatable :: is_open
145 integer :: num_restart_vars
147 integer :: num_compressed_dims
148 logical :: is_diskless
149 character (len=20) :: time_name
152 logical :: use_collective = .false.
168 logical :: has_missing
169 real(kind=r8_kind) :: fill_val
170 real(kind=r8_kind) :: min_val
171 real(kind=r8_kind) :: max_val
172 real(kind=r8_kind) :: missing_val
236 public :: get_variable_sense
237 public :: get_variable_missing
238 public :: get_variable_units
239 public :: get_time_calendar
244 public :: set_fileobj_time_name
345 subroutine netcdf_io_init (chksz, header_buffer_val, netcdf_default_format, deflate_level, shuffle)
346 integer,
intent(in) :: chksz
347 character (len = 10),
intent(in) :: netcdf_default_format
348 integer,
intent(in) :: header_buffer_val
349 integer,
intent(in) :: deflate_level
351 logical,
intent(in) :: shuffle
361 elseif (
string_compare(netcdf_default_format,
"classic", .true.))
then
364 elseif (
string_compare(netcdf_default_format,
"netcdf4", .true.))
then
369 call error(
"unrecognized netcdf file format "//trim(netcdf_default_format)// &
370 '. The acceptable values are "64bit", "classic", "netcdf4". Check fms2_io_nml: netcdf_default_format')
379 integer,
intent(in) :: err
380 character(len=*),
intent(in) :: msg
382 character(len=80) :: buf
384 if (err .ne. nf90_noerr)
then
385 buf = nf90_strerror(err)
386 call error(trim(buf)//
": "//trim(msg))
395 integer,
intent(in) :: ncid
396 integer,
intent(in) :: mode
400 if (mode .eq. define_mode)
then
401 err = nf90_redef(ncid)
402 if (err .eq. nf90_eindefine .or. err .eq. nf90_eperm)
then
405 elseif (mode .eq. data_mode)
then
406 if (
fms2_header_buffer_val == -1)
call error(
"set_netcdf_mode: fms2_header_buffer_val not set, call fms2_io_init")
408 if (err .eq. nf90_enotindefine .or. err .eq. nf90_eperm)
then
412 call error(
"mode must be either define_mode or data_mode.")
424 integer,
intent(in) :: ncid
425 character(len=*),
intent(in) :: dimension_name
426 character(len=*),
intent(in) :: msg
427 logical,
intent(in),
optional :: allow_failure
435 err = nf90_inq_dimid(ncid, trim(dimension_name), dimid)
436 if (
present(allow_failure))
then
437 if (allow_failure .and. err .eq. nf90_ebaddim)
then
438 dimid = dimension_missing
452 integer,
intent(in) :: ncid
453 character(len=*),
intent(in) :: variable_name
454 character(len=*),
intent(in) :: msg
455 logical,
intent(in),
optional :: allow_failure
463 err = nf90_inq_varid(ncid, trim(variable_name), varid)
464 if (
present(allow_failure))
then
465 if (allow_failure .and. err .eq. nf90_enotvar)
then
466 varid = variable_missing
480 integer,
intent(in) :: ncid
481 integer,
intent(in) :: varid
482 character(len=*),
intent(in) :: attribute_name
483 character(len=*),
intent(in),
optional :: msg
485 logical :: att_exists
489 err = nf90_inquire_attribute(ncid, varid, trim(attribute_name))
490 if (err .eq. nf90_enotatt)
then
505 integer,
intent(in) :: ncid
506 integer,
intent(in) :: varid
507 character(len=*),
intent(in) :: attname
508 character(len=*),
intent(in),
optional :: msg
514 err = nf90_inquire_attribute(ncid, varid, attname, xtype=xtype)
525 integer,
intent(in) :: ncid
526 integer,
intent(in) :: varid
527 character(len=*),
intent(in),
optional :: msg
533 err = nf90_inquire_variable(ncid, varid, xtype=xtype)
540 function netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename) &
544 character(len=*),
intent(in) :: path
545 character(len=*),
intent(in) :: mode
548 character(len=*),
intent(in),
optional :: nc_format
556 integer,
dimension(:),
intent(in),
optional :: pelist
561 logical,
intent(in),
optional :: is_restart
564 logical,
intent(in),
optional :: dont_add_res_to_filename
568 integer :: nc_format_param
572 character(len=FMS_PATH_LEN) :: buf
573 character(len=FMS_PATH_LEN) :: buf2
575 logical :: dont_add_res
577 if (
allocated(fileobj%is_open))
then
578 if (fileobj%is_open)
then
586 if (
present(is_restart))
then
589 dont_add_res = .false.
590 if (
present(dont_add_res_to_filename))
then
591 dont_add_res = dont_add_res_to_filename
594 if (is_res .and. .not. dont_add_res)
then
597 call string_copy(buf, trim(path))
604 call string_copy(buf2, trim(buf))
611 if (.not. success)
then
617 call string_copy(fileobj%path, trim(buf2))
618 if (
present(pelist))
then
619 allocate(fileobj%pelist(
size(pelist)))
620 fileobj%pelist(:) = pelist(:)
622 allocate(fileobj%pelist(1))
623 fileobj%pelist(1) =
mpp_pe()
625 fileobj%io_root = fileobj%pelist(1)
626 fileobj%is_root =
mpp_pe() .eq. fileobj%io_root
628 fileobj%is_netcdf4 = .false.
629 if (
fms2_ncchksz == -1)
call error(
"netcdf_file_open:: fms2_ncchksz not set, call fms2_io_init")
630 if (
fms2_nc_format_param == -1)
call error(
"netcdf_file_open:: fms2_nc_format_param not set, call fms2_io_init")
632 if (
present(nc_format))
then
634 nc_format_param = nf90_64bit_offset
636 nc_format_param = nf90_classic_model
638 fileobj%is_netcdf4 = .true.
639 nc_format_param = nf90_netcdf4
641 call error(
"unrecognized netcdf file format: '"//trim(nc_format)//
"' for file:"//trim(fileobj%path)//&
642 &
"Check your open_file call, the acceptable values are 64bit, classic, netcdf4")
644 call string_copy(fileobj%nc_format, nc_format)
652 if (fileobj%is_root .and. .not.(fileobj%use_collective))
then
654 err = nf90_open(trim(fileobj%path), nf90_nowrite, fileobj%ncid, chunksize=
fms2_ncchksz)
656 err = nf90_open(trim(fileobj%path), nf90_write, fileobj%ncid, chunksize=
fms2_ncchksz)
658 err = nf90_create(trim(fileobj%path), ior(nf90_noclobber, nc_format_param), fileobj%ncid, chunksize=
fms2_ncchksz)
660 err = nf90_create(trim(fileobj%path), ior(nf90_clobber, nc_format_param), fileobj%ncid, chunksize=
fms2_ncchksz)
662 call error(
"unrecognized file mode: '"//trim(mode)//
"' for file:"//trim(fileobj%path)//&
663 &
"Check your open_file call, the acceptable values are read, append, write, overwrite")
666 elseif(fileobj%use_collective .and. (fileobj%tile_comm /=
mpp_comm_null))
then
671 err = nf90_open(trim(fileobj%path), ior(nf90_nowrite, nf90_mpiio), fileobj%ncid, &
673 if(err /= nf90_noerr)
then
674 err = nf90_open(trim(fileobj%path), nf90_nowrite, fileobj%ncid)
675 err = nf90_get_att(fileobj%ncid, nf90_global,
"_IsNetcdf4", netcdf4)
676 err = nf90_close(fileobj%ncid)
677 if(netcdf4 /= 1)
then
678 call mpp_error(note,
"netcdf_file_open: Open for collective read failed because the file is not &
679 netCDF-4 format."// &
680 " Falling back to parallel independent for file "// trim(fileobj%path))
681 fileobj%use_collective = .false.
684 #ifdef NO_NC_PARALLEL4
685 call mpp_error(fatal,
"netCDF was not build with HDF5 parallel I/O features, "//&
686 "so collective netcdf io is not allowed. Please turn collective read off for file "//&
690 err = nf90_open(trim(fileobj%path), nf90_nowrite, fileobj%ncid, chunksize=
fms2_ncchksz)
693 call mpp_error(fatal,
"netcdf_file_open: Attempt to create a file for collective write"// &
694 " This feature is not implemented"// trim(fileobj%path))
698 call mpp_error(fatal,
"netcdf_file_open: Attempt to create a file for collective overwrite"// &
699 " This feature is not implemented"// trim(fileobj%path))
703 call error(
"unrecognized file mode: '"//trim(mode)//
"' for file:"//trim(fileobj%path)//&
704 &
"Check your open_file call, the acceptable values are read, append, write, overwrite")
708 fileobj%ncid = missing_ncid
711 fileobj%is_diskless = .false.
714 fileobj%is_restart = is_res
715 if (fileobj%is_restart)
then
716 allocate(fileobj%restart_vars(max_num_restart_vars))
717 fileobj%num_restart_vars = 0
721 allocate(fileobj%compressed_dims(max_num_compressed_dims))
722 fileobj%num_compressed_dims = 0
724 if (.not.
allocated(fileobj%is_open))
allocate(fileobj%is_open)
725 fileobj%is_open = .true.
727 fileobj%bc_dimensions%xlen = 0
728 fileobj%bc_dimensions%ylen = 0
729 fileobj%bc_dimensions%zlen = 0
730 fileobj%bc_dimensions%cur_dim_len = 0
743 if (fileobj%is_root)
then
744 err = nf90_close(fileobj%ncid)
747 if (
allocated(fileobj%is_open)) fileobj%is_open = .false.
748 fileobj%path = missing_path
749 fileobj%ncid = missing_ncid
750 if (
allocated(fileobj%pelist))
then
751 deallocate(fileobj%pelist)
753 fileobj%io_root = missing_rank
754 fileobj%is_root = .false.
755 if (
allocated(fileobj%restart_vars))
then
756 deallocate(fileobj%restart_vars)
758 fileobj%is_restart = .false.
759 fileobj%num_restart_vars = 0
760 do i = 1, fileobj%num_compressed_dims
761 if (
allocated(fileobj%compressed_dims(i)%npes_corner))
then
762 deallocate(fileobj%compressed_dims(i)%npes_corner)
764 if (
allocated(fileobj%compressed_dims(i)%npes_nelems))
then
765 deallocate(fileobj%compressed_dims(i)%npes_nelems)
768 if (
allocated(fileobj%compressed_dims))
then
769 deallocate(fileobj%compressed_dims)
781 character(len=*),
intent(in) :: dim_name
786 dindex = dimension_not_found
787 do i = 1, fileobj%num_compressed_dims
788 if (
string_compare(fileobj%compressed_dims(i)%dimname, dim_name))
then
802 character(len=*),
intent(in) :: dim_name
803 integer,
dimension(:),
intent(in) :: npes_corner
805 integer,
dimension(:),
intent(in) :: npes_nelems
812 call error(
"dimension "//trim(dim_name)//
" already registered" &
813 //
" to file "//trim(fileobj%path)//
".")
815 fileobj%num_compressed_dims = fileobj%num_compressed_dims + 1
816 n = fileobj%num_compressed_dims
817 if (n .gt. max_num_compressed_dims)
then
818 call error(
"number of compressed dimensions exceeds limit.")
820 call string_copy(fileobj%compressed_dims(n)%dimname, dim_name)
821 if (
size(npes_corner) .ne.
size(fileobj%pelist) .or. &
822 size(npes_nelems) .ne.
size(fileobj%pelist))
then
823 call error(
"incorrect size for input npes_corner or npes_nelems arrays.")
825 allocate(fileobj%compressed_dims(n)%npes_corner(
size(fileobj%pelist)))
826 fileobj%compressed_dims(n)%npes_corner(:) = npes_corner(:)
827 allocate(fileobj%compressed_dims(n)%npes_nelems(
size(fileobj%pelist)))
828 fileobj%compressed_dims(n)%npes_nelems(:) = npes_nelems(:)
829 fileobj%compressed_dims(n)%nelems = sum(fileobj%compressed_dims(n)%npes_nelems)
837 character(len=*),
intent(in) :: dimension_name
838 integer,
intent(in) :: dimension_length
840 integer,
dimension(:),
allocatable :: npes_start
841 integer,
dimension(:),
allocatable :: npes_count
847 allocate(npes_start(
size(fileobj%pelist)))
848 allocate(npes_count(
size(fileobj%pelist)))
850 call mpp_gather((/dimension_length/),npes_count,pelist=fileobj%pelist)
853 do i = 1,
size(fileobj%pelist)-1
854 npes_start(i+1) = npes_start(i) + npes_count(i)
859 if (fileobj%is_root .and. .not. fileobj%is_readonly)
then
861 err = nf90_def_dim(fileobj%ncid, trim(dimension_name), unlimited, dimid)
862 call check_netcdf_code(err,
"Netcdf_add_dimension: file:"//trim(fileobj%path)//
" dimension name:"// &
863 & trim(dimension_name))
872 character(len=*),
intent(in) :: dimension_name
873 integer,
intent(in) :: dimension_length
874 logical,
intent(in),
optional :: is_compressed
880 integer,
dimension(:),
allocatable :: npes_start
881 integer,
dimension(:),
allocatable :: npes_count
886 dim_len = dimension_length
887 if (
present(is_compressed))
then
888 if (is_compressed)
then
890 allocate(npes_start(
size(fileobj%pelist)))
891 allocate(npes_count(
size(fileobj%pelist)))
892 do i = 1,
size(fileobj%pelist)
893 if (fileobj%pelist(i) .eq.
mpp_pe())
then
894 npes_count(i) = dim_len
896 call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
897 call mpp_send(dim_len, fileobj%pelist(i))
903 do i = 1,
size(fileobj%pelist)-1
904 npes_start(i+1) = npes_start(i) + npes_count(i)
908 dim_len = sum(npes_count)
911 if (fileobj%is_root .and. .not. fileobj%is_readonly)
then
913 err = nf90_def_dim(fileobj%ncid, trim(dimension_name), dim_len, dimid)
914 call check_netcdf_code(err,
"Netcdf_add_dimension: file:"//trim(fileobj%path)//
" dimension name:"// &
915 & trim(dimension_name))
922 npes_corner, npes_nelems)
925 character(len=*),
intent(in) :: dimension_name
926 integer,
dimension(:),
intent(in) :: npes_corner
928 integer,
dimension(:),
intent(in) :: npes_nelems
936 dsize = sum(npes_nelems)
937 if (fileobj%is_readonly)
then
939 if (fdim_size .ne. dsize)
then
940 call error(
"dimension "//trim(dimension_name)//
" does not match" &
941 //
" the size of the associated compressed axis.")
953 character(len=*),
intent(in) :: variable_name
954 character(len=*),
intent(in) :: variable_type
957 character(len=*),
dimension(:),
intent(in),
optional :: dimensions
958 integer,
optional,
intent(in) :: chunksizes(:)
962 integer,
dimension(:),
allocatable :: dimids
966 character(len=200) :: append_error_msg
968 append_error_msg =
"netcdf_add_variable: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)
970 if (fileobj%is_root)
then
975 if ( .not. fileobj%is_netcdf4)
call error(trim(fileobj%path)//&
976 &
": 64 bit integers are only supported with 'netcdf4' file format"//&
977 &
". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
978 &
"add nc_format='netcdf4' to your open_file call")
986 if (.not.
present(dimensions))
then
987 call error(
"String variables require a string length dimension:"//trim(append_error_msg))
990 call error(
"Unsupported variable type:"//trim(append_error_msg))
992 if (
present(dimensions))
then
993 allocate(dimids(
size(dimensions)))
994 do i = 1,
size(dimids)
995 dimids(i) =
get_dimension_id(fileobj%ncid, trim(dimensions(i)),msg=append_error_msg)
997 if (fileobj%is_netcdf4)
then
998 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid, &
1002 &
call mpp_error(note,
"Not able to use deflate_level or chunksizes if not using netcdf4"// &
1004 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid)
1008 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, varid)
1019 result(compressed_dimension_index)
1022 character(len=*),
intent(in) :: variable_name
1023 logical,
intent(in),
optional :: broadcast
1029 integer,
dimension(2) :: compressed_dimension_index
1032 character(len=nf90_max_name),
dimension(:),
allocatable :: dim_names
1036 compressed_dimension_index = dimension_not_found
1037 if (fileobj%is_root)
then
1039 if (ndims .gt. 0)
then
1040 allocate(dim_names(ndims))
1042 do i = 1,
size(dim_names)
1044 if (j .ne. dimension_not_found)
then
1045 compressed_dimension_index(1) = i
1046 compressed_dimension_index(2) = j
1050 deallocate(dim_names)
1053 if (
present(broadcast))
then
1054 if (.not. broadcast)
then
1058 call mpp_broadcast(compressed_dimension_index(1), fileobj%io_root, pelist=fileobj%pelist)
1059 call mpp_broadcast(compressed_dimension_index(2), fileobj%io_root, pelist=fileobj%pelist)
1068 character(len=*),
intent(in) :: variable_name
1072 if (.not. fileobj%is_restart)
then
1073 call error(
"file "//trim(fileobj%path)//
" is not a restart file.")
1075 do i = 1, fileobj%num_restart_vars
1076 if (
string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.))
then
1077 call error(
"variable "//trim(variable_name)//
" has already" &
1078 //
" been added to restart file "//trim(fileobj%path)//
".")
1081 fileobj%num_restart_vars = fileobj%num_restart_vars + 1
1082 if (fileobj%num_restart_vars .gt. max_num_restart_vars)
then
1083 call error(
"Number of restart variables exceeds limit.")
1085 call string_copy(fileobj%restart_vars(fileobj%num_restart_vars)%varname, &
1095 integer,
intent(in),
optional :: unlim_dim_level
1100 if (.not. fileobj%is_restart)
then
1101 call error(
"write_restart:: file "//trim(fileobj%path)//
" is not a restart file. &
1102 &Be sure the file was opened with is_restart=.true.")
1104 do i = 1, fileobj%num_restart_vars
1105 if (
associated(fileobj%restart_vars(i)%data0d))
then
1107 fileobj%restart_vars(i)%data0d, &
1108 unlim_dim_level=unlim_dim_level)
1109 elseif (
associated(fileobj%restart_vars(i)%data1d))
then
1111 fileobj%restart_vars(i)%data1d, &
1112 unlim_dim_level=unlim_dim_level)
1113 elseif (
associated(fileobj%restart_vars(i)%data2d))
then
1115 fileobj%restart_vars(i)%data2d, &
1116 unlim_dim_level=unlim_dim_level)
1117 elseif (
associated(fileobj%restart_vars(i)%data3d))
then
1119 fileobj%restart_vars(i)%data3d, &
1120 unlim_dim_level=unlim_dim_level)
1121 elseif (
associated(fileobj%restart_vars(i)%data4d))
then
1123 fileobj%restart_vars(i)%data4d, &
1124 unlim_dim_level=unlim_dim_level)
1126 call error(
"this branch should not be reached.")
1137 integer,
intent(in),
optional :: unlim_dim_level
1142 if (.not. fileobj%is_restart)
then
1143 call error(
"read_restart:: file "//trim(fileobj%path)//
" is not a restart file. &
1144 &Be sure the file was opened with is_restart=.true.")
1146 do i = 1, fileobj%num_restart_vars
1147 if (
associated(fileobj%restart_vars(i)%data0d))
then
1149 fileobj%restart_vars(i)%data0d, &
1150 unlim_dim_level=unlim_dim_level, &
1152 elseif (
associated(fileobj%restart_vars(i)%data1d))
then
1154 fileobj%restart_vars(i)%data1d, &
1155 unlim_dim_level=unlim_dim_level, &
1157 elseif (
associated(fileobj%restart_vars(i)%data2d))
then
1159 fileobj%restart_vars(i)%data2d, &
1160 unlim_dim_level=unlim_dim_level, &
1162 elseif (
associated(fileobj%restart_vars(i)%data3d))
then
1164 fileobj%restart_vars(i)%data3d, &
1165 unlim_dim_level=unlim_dim_level, &
1167 elseif (
associated(fileobj%restart_vars(i)%data4d))
then
1169 fileobj%restart_vars(i)%data4d, &
1170 unlim_dim_level=unlim_dim_level, &
1173 call error(
"this branch should not be reached.")
1185 character(len=*),
intent(in) :: attribute_name
1186 logical,
intent(in),
optional :: broadcast
1192 logical :: att_exists
1194 if (fileobj%is_root)
then
1195 att_exists =
attribute_exists(fileobj%ncid, nf90_global, trim(attribute_name), &
1196 & msg=
"global_att_exists: file:"//trim(fileobj%path)//
" attribute name:"//trim(attribute_name))
1198 if (
present(broadcast))
then
1199 if (.not. broadcast)
then
1203 call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1214 character(len=*),
intent(in) :: variable_name
1215 character(len=*),
intent(in) :: attribute_name
1216 logical,
intent(in),
optional :: broadcast
1222 logical :: att_exists
1226 att_exists = .false.
1227 if (fileobj%is_root)
then
1229 & msg=
"variable_att_exists: file:"//trim(fileobj%path)//
"- variable:"//&
1230 &trim(variable_name))
1232 &msg=
"variable_att_exists: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)//&
1233 &
" attribute name:"//trim(attribute_name))
1235 if (
present(broadcast))
then
1236 if (.not. broadcast)
then
1240 call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1250 logical,
intent(in),
optional :: broadcast
1260 if (fileobj%is_root)
then
1261 err = nf90_inquire(fileobj%ncid, ndimensions=ndims)
1264 if (
present(broadcast))
then
1265 if (.not. broadcast)
then
1269 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1277 character(len=*),
dimension(:),
intent(inout) :: names
1279 logical,
intent(in),
optional :: broadcast
1290 if (fileobj%is_root)
then
1292 if (ndims .gt. 0)
then
1293 if (
size(names) .ne. ndims)
then
1294 call error(
"'names' has to be the same size of the number of dimensions. &
1295 &Check your get_dimension_names call for file "//trim(fileobj%path))
1298 call error(
"get_dimension_names: the file "//trim(fileobj%path)//
" does not have any dimensions")
1302 err = nf90_inquire_dimension(fileobj%ncid, i, name=names(i))
1306 if (
present(broadcast))
then
1307 if (.not. broadcast)
then
1311 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1312 if (.not. fileobj%is_root)
then
1313 if (ndims .gt. 0)
then
1314 if (
size(names) .ne. ndims)
then
1315 call error(
"'names' has to be the same size of the number of dimensions. &
1316 &Check your get_dimension_names call for file "//trim(fileobj%path))
1319 call error(
"get_dimension_names: the file "//trim(fileobj%path)//
" does not have any dimensions")
1323 call mpp_broadcast(names, len(names(ndims)), fileobj%io_root, &
1324 pelist=fileobj%pelist)
1334 character(len=*),
intent(in) :: dimension_name
1335 logical,
intent(in),
optional :: broadcast
1341 logical :: dim_exists
1345 if (fileobj%is_root)
then
1347 msg=
"dimension_exists: file:"//trim(fileobj%path)//
" dimension:"//trim(dimension_name), &
1348 allow_failure=.true.)
1349 if (dimid .eq. dimension_missing)
then
1350 dim_exists = .false.
1355 if (
present(broadcast))
then
1356 if (.not. broadcast)
then
1360 call mpp_broadcast(dim_exists, fileobj%io_root, pelist=fileobj%pelist)
1367 result(is_unlimited)
1370 character(len=*),
intent(in) :: dimension_name
1371 logical,
intent(in),
optional :: broadcast
1377 logical :: is_unlimited
1379 character(len=200) :: append_error_msg
1382 integer :: ulim_dimid
1384 if (fileobj%is_root)
then
1385 append_error_msg=
"is_dimension_unlimited: file:"//trim(fileobj%path)//&
1386 &
" dimension_name:"//trim(dimension_name)
1387 dimid =
get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1388 err = nf90_inquire(fileobj%ncid, unlimiteddimid=ulim_dimid)
1390 is_unlimited = dimid .eq. ulim_dimid
1392 if (
present(broadcast))
then
1393 if (.not. broadcast)
then
1397 call mpp_broadcast(is_unlimited, fileobj%io_root, pelist=fileobj%pelist)
1405 character(len=*),
intent(out) :: dimension_name
1406 logical,
intent(in),
optional :: broadcast
1415 character(len=nf90_max_name),
dimension(1) :: buffer
1418 if (fileobj%is_root)
then
1419 err = nf90_inquire(fileobj%ncid, unlimiteddimid=dimid)
1420 call check_netcdf_code(err,
"get_unlimited_dimension_name: file:"//trim(fileobj%path))
1421 err = nf90_inquire_dimension(fileobj%ncid, dimid, dimension_name)
1422 call check_netcdf_code(err,
"get_unlimited_dimension_name: file:"//trim(fileobj%path))
1423 call string_copy(buffer(1), dimension_name)
1425 if (
present(broadcast))
then
1426 if (.not. broadcast)
then
1430 call mpp_broadcast(buffer, nf90_max_name, fileobj%io_root, &
1431 pelist=fileobj%pelist)
1432 call string_copy(dimension_name, buffer(1))
1440 character(len=*),
intent(in) :: dimension_name
1441 integer,
intent(inout) :: dim_size
1442 logical,
intent(in),
optional :: broadcast
1451 character(len=200) :: append_error_msg
1453 if (fileobj%is_root)
then
1454 append_error_msg =
"get_dimension_size: file:"//trim(fileobj%path)//
" dimension_name: "//trim(dimension_name)
1455 dimid =
get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1456 err = nf90_inquire_dimension(fileobj%ncid, dimid, len=dim_size)
1459 if (
present(broadcast))
then
1460 if (.not. broadcast)
then
1464 call mpp_broadcast(dim_size, fileobj%io_root, pelist=fileobj%pelist)
1474 logical,
intent(in),
optional :: broadcast
1484 if (fileobj%is_root)
then
1485 err = nf90_inquire(fileobj%ncid, nvariables=nvars)
1488 if (
present(broadcast))
then
1489 if (.not. broadcast)
then
1493 call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1501 character(len=*),
dimension(:),
intent(inout) :: names
1503 logical,
intent(in),
optional :: broadcast
1514 if (fileobj%is_root)
then
1516 if (nvars .gt. 0)
then
1517 if (
size(names) .ne. nvars)
then
1518 call error(
"'names' has to be the same size of the number of variables. &
1519 &Check your get_variable_names call for file "//trim(fileobj%path))
1522 call error(
"get_variable_names: the file "//trim(fileobj%path)//
" does not have any variables")
1526 err = nf90_inquire_variable(fileobj%ncid, i, name=names(i))
1530 if (
present(broadcast))
then
1531 if (.not. broadcast)
then
1535 call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1536 if (.not. fileobj%is_root)
then
1537 if (nvars .gt. 0)
then
1538 if (
size(names) .ne. nvars)
then
1539 call error(
"'names' has to be the same size of the number of variables. &
1540 &Check your get_variable_names call for file "//trim(fileobj%path))
1543 call error(
"get_variable_names: the file "//trim(fileobj%path)//
" does not have any variables")
1547 call mpp_broadcast(names, len(names(nvars)), fileobj%io_root, &
1548 pelist=fileobj%pelist)
1558 character(len=*),
intent(in) :: variable_name
1559 logical,
intent(in),
optional :: broadcast
1565 logical :: var_exists
1569 if (fileobj%is_root)
then
1571 msg=
"variable_exists: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name), &
1572 allow_failure=.true.)
1573 var_exists = varid .ne. variable_missing
1575 if (
present(broadcast))
then
1576 if (.not. broadcast)
then
1580 call mpp_broadcast(var_exists, fileobj%io_root, pelist=fileobj%pelist)
1590 character(len=*),
intent(in) :: variable_name
1591 logical,
intent(in),
optional :: broadcast
1601 character(len=200) :: append_error_msg
1604 if (fileobj%is_root)
then
1605 append_error_msg =
"get_variable_num_dimension: file:"//trim(fileobj%path)//
" variable: "//trim(variable_name)
1606 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1607 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims)
1610 if (
present(broadcast))
then
1611 if (.not. broadcast)
then
1615 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1624 character(len=*),
intent(in) :: variable_name
1625 character(len=*),
dimension(:),
intent(inout) :: dim_names
1628 logical,
intent(in),
optional :: broadcast
1638 integer,
dimension(nf90_max_var_dims) :: dimids
1640 character(len=200) :: append_error_msg
1643 if (fileobj%is_root)
then
1644 append_error_msg =
"get_variable_dimension_names: file:"//trim(fileobj%path)//
" variable: "//trim(variable_name)
1646 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1647 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, &
1650 if (ndims .gt. 0)
then
1651 if (
size(dim_names) .ne. ndims)
then
1652 call error(
"'names' has to be the same size of the number of dimensions for the variable. &
1653 &Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1654 " and variable:"//trim(variable_name))
1657 call error(
"get_variable_dimension_names: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)&
1658 & //
" does not any dimensions. ")
1662 err = nf90_inquire_dimension(fileobj%ncid, dimids(i), name=dim_names(i))
1666 if (
present(broadcast))
then
1667 if (.not. broadcast)
then
1671 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1672 if (.not. fileobj%is_root)
then
1673 if (ndims .gt. 0)
then
1674 if (
size(dim_names) .ne. ndims)
then
1675 call error(
"'names' has to be the same size of the number of dimensions for the variable. &
1676 & Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1677 " and variable:"//trim(variable_name))
1680 call error(
"get_variable_dimension_names: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)&
1681 & //
" does not any dimensions. ")
1685 call mpp_broadcast(dim_names, len(dim_names(ndims)), fileobj%io_root, &
1686 pelist=fileobj%pelist)
1694 character(len=*),
intent(in) :: variable_name
1695 integer,
dimension(:),
intent(inout) :: dim_sizes
1697 logical,
intent(in),
optional :: broadcast
1707 integer,
dimension(nf90_max_var_dims) :: dimids
1709 character(len=200) :: append_error_msg
1711 if (fileobj%is_root)
then
1712 append_error_msg =
"get_variable_size: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)
1713 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1714 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, dimids=dimids)
1716 if (ndims .gt. 0)
then
1717 if (
size(dim_sizes) .ne. ndims)
then
1718 call error(
"'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1719 &Check your get_variable_size call for file "//trim(fileobj%path)// &
1720 " and variable:"//trim(variable_name))
1723 call error(
"get_variable_size: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)//&
1724 &
" does not any dimensions. ")
1727 err = nf90_inquire_dimension(fileobj%ncid, dimids(i), len=dim_sizes(i))
1731 if (
present(broadcast))
then
1732 if (.not. broadcast)
then
1736 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1737 if (.not. fileobj%is_root)
then
1738 if (ndims .gt. 0)
then
1739 if (
size(dim_sizes) .ne. ndims)
then
1740 call error(
"'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1741 &Check your get_variable_size call for file "//trim(fileobj%path)// &
1742 " and variable:"//trim(variable_name))
1745 call error(
"get_variable_size: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)//&
1746 &
" does not any dimensions. ")
1749 call mpp_broadcast(dim_sizes, ndims, fileobj%io_root, pelist=fileobj%pelist)
1758 result(unlim_dim_index)
1761 character(len=*),
intent(in) :: variable_name
1762 logical,
intent(in),
optional :: broadcast
1768 integer :: unlim_dim_index
1771 character(len=nf90_max_name),
dimension(:),
allocatable :: dim_names
1774 unlim_dim_index = no_unlimited_dimension
1775 if (fileobj%is_root)
then
1777 allocate(dim_names(ndims))
1780 do i = 1,
size(dim_names)
1786 deallocate(dim_names)
1788 if (
present(broadcast))
then
1789 if (.not. broadcast)
then
1793 call mpp_broadcast(unlim_dim_index, fileobj%io_root, pelist=fileobj%pelist)
1804 character(len=*),
intent(in) :: variable_name
1808 real(kind=r8_kind) :: scale_factor
1809 real(kind=r8_kind) :: add_offset
1810 real(kind=r8_kind),
dimension(2) :: buffer
1812 character(len=200) :: append_error_msg
1814 append_error_msg =
"get_valid: file:"//trim(fileobj%path)
1815 if (fileobj%is_root)
then
1816 varid =
get_variable_id(fileobj%ncid, variable_name, msg=append_error_msg)
1817 valid%has_max = .false.
1818 valid%has_min = .false.
1819 valid%has_fill = .false.
1820 valid%has_missing = .false.
1821 valid%has_range = .false.
1825 if (
attribute_exists(fileobj%ncid, varid,
"scale_factor", msg=append_error_msg))
then
1829 scale_factor = 1._r8_kind
1831 if (
attribute_exists(fileobj%ncid, varid,
"add_offset", msg=append_error_msg))
then
1835 add_offset = 0._r8_kind
1842 if (
attribute_exists(fileobj%ncid, varid,
"valid_range", msg=append_error_msg))
then
1845 valid%max_val = buffer(2)*scale_factor + add_offset
1846 valid%has_max = .true.
1847 valid%min_val = buffer(1)*scale_factor + add_offset
1848 valid%has_min = .true.
1850 if (
attribute_exists(fileobj%ncid, varid,
"valid_max", msg=append_error_msg))
then
1853 valid%max_val = buffer(1)*scale_factor + add_offset
1854 valid%has_max = .true.
1856 if (
attribute_exists(fileobj%ncid, varid,
"valid_min", msg=append_error_msg))
then
1859 valid%min_val = buffer(1)*scale_factor + add_offset
1860 valid%has_min = .true.
1863 valid%has_range = valid%has_min .or. valid%has_max
1867 if (
attribute_exists(fileobj%ncid, varid,
"missing_value", msg=append_error_msg))
then
1870 valid%missing_val = buffer(1)*scale_factor + add_offset
1871 valid%has_missing = .true.
1882 if (
attribute_exists(fileobj%ncid, varid,
"_FillValue", msg=append_error_msg))
then
1885 valid%fill_val = buffer(1)*scale_factor + add_offset
1886 valid%has_fill = .true.
1889 if (.not. valid%has_range)
then
1890 if (xtype .eq. nf90_short .or. xtype .eq. nf90_int)
then
1891 if (buffer(1) .gt. 0)
then
1892 valid%max_val = (buffer(1) - 1._r8_kind)*scale_factor + add_offset
1893 valid%has_max = .true.
1895 valid%min_val = (buffer(1) + 1._r8_kind)*scale_factor + add_offset
1896 valid%has_min = .true.
1898 elseif (xtype .eq. nf90_float .or. xtype .eq. nf90_double)
then
1899 if (buffer(1) .gt. 0)
then
1900 valid%max_val = (nearest(nearest(buffer(1), -1._r8_kind), -1._r8_kind)) &
1901 *scale_factor + add_offset
1902 valid%has_max = .true.
1904 valid%min_val = (nearest(nearest(buffer(1), 1._r8_kind), 1._r8_kind)) &
1905 *scale_factor + add_offset
1906 valid%has_min = .true.
1909 call error(
"Unsupported variable type:"//trim(append_error_msg))
1911 valid%has_range = .true.
1917 call mpp_broadcast(valid%has_min, fileobj%io_root, pelist=fileobj%pelist)
1918 if (valid%has_min)
then
1919 call mpp_broadcast(valid%min_val, fileobj%io_root, pelist=fileobj%pelist)
1921 call mpp_broadcast(valid%has_max, fileobj%io_root, pelist=fileobj%pelist)
1922 if (valid%has_max)
then
1923 call mpp_broadcast(valid%max_val, fileobj%io_root, pelist=fileobj%pelist)
1925 call mpp_broadcast(valid%has_range, fileobj%io_root, pelist=fileobj%pelist)
1927 call mpp_broadcast(valid%has_fill, fileobj%io_root, pelist=fileobj%pelist)
1928 if (valid%has_fill)
then
1929 call mpp_broadcast(valid%fill_val, fileobj%io_root, pelist=fileobj%pelist)
1932 call mpp_broadcast(valid%has_missing, fileobj%io_root, pelist=fileobj%pelist)
1933 if (valid%has_missing)
then
1934 call mpp_broadcast(valid%missing_val, fileobj%io_root, pelist=fileobj%pelist)
1944 real(kind=r8_kind),
intent(in) :: datum
1945 type(
valid_t),
intent(in) :: validobj
1946 logical :: valid_data
1957 real(kind=r4_kind),
intent(in) :: datum
1958 type(
valid_t),
intent(in) :: validobj
1959 logical :: valid_data
1961 real(kind=r8_kind) :: rdatum
1964 rdatum = real(datum, kind=r8_kind)
1974 real(kind=r8_kind),
intent(in) :: rdatum
1975 type(
valid_t),
intent(in) :: validobj
1976 logical :: valid_data
1981 if (validobj%has_range)
then
1982 if (validobj%has_min .and. .not. validobj%has_max)
then
1983 valid_data = rdatum .ge. validobj%min_val
1984 elseif (validobj%has_max .and. .not. validobj%has_min)
then
1985 valid_data = rdatum .le. validobj%max_val
1987 valid_data = .not. (rdatum .lt. validobj%min_val .or. rdatum .gt. validobj%max_val)
1992 if (validobj%has_fill .or. validobj%has_missing)
then
1993 if (validobj%has_fill .and. .not. validobj%has_missing)
then
1994 valid_data = rdatum .ne. validobj%fill_val
1995 elseif (validobj%has_missing .and. .not. validobj%has_fill)
then
1996 valid_data = rdatum .ne. validobj%missing_val
1998 valid_data = .not. (rdatum .eq. validobj%missing_val .or. rdatum .eq. validobj%fill_val)
2008 integer,
intent(in) :: nelems
2009 integer,
dimension(:),
allocatable,
intent(out) :: npes_start
2010 integer,
dimension(:),
allocatable,
intent(out) :: npes_count
2015 allocate(npes_start(
size(fileobj%pelist)))
2016 allocate(npes_count(
size(fileobj%pelist)))
2017 do i = 1,
size(fileobj%pelist)
2018 if (fileobj%pelist(i) .eq.
mpp_pe())
then
2019 npes_count(i) = nelems
2021 call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
2022 call mpp_send(nelems, fileobj%pelist(i))
2028 do i = 1,
size(fileobj%pelist)-1
2029 npes_start(i+1) = npes_start(i) + npes_count(i)
2034 include
"netcdf_add_restart_variable.inc"
2035 include
"netcdf_read_data.inc"
2036 include
"netcdf_write_data.inc"
2037 include
"register_global_attribute.inc"
2038 include
"register_variable_attribute.inc"
2039 include
"get_global_attribute.inc"
2040 include
"get_variable_attribute.inc"
2041 include
"compressed_write.inc"
2042 include
"compressed_read.inc"
2043 include
"scatter_data_bc.inc"
2044 include
"gather_data_bc.inc"
2045 include
"unpack_data.inc"
2052 character(len=*),
intent(in) :: path
2053 character(len=*),
intent(in) :: mode
2056 character(len=*),
intent(in),
optional :: nc_format
2062 integer,
dimension(:),
intent(in),
optional :: pelist
2067 logical,
intent(in),
optional :: is_restart
2070 logical,
intent(in),
optional :: dont_add_res_to_filename
2074 success =
netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
2091 character(len=*),
intent(in) :: variable_name
2092 character(len=*),
intent(in) :: variable_type
2095 character(len=*),
dimension(:),
intent(in),
optional :: dimensions
2096 integer,
intent(in),
optional :: chunksizes(:)
2105 integer,
intent(in),
optional :: unlim_dim_level
2118 character(len=*),
intent(in) :: variable_name
2119 class(*),
intent(out) :: fill_value
2120 logical,
intent(in),
optional :: broadcast
2126 logical :: fill_exists
2128 character(len=32),
dimension(2) :: attribute_names
2132 fill_exists = .false.
2133 call string_copy(attribute_names(1),
"_FillValue")
2134 call string_copy(attribute_names(2),
"missing_value")
2135 if (
present(broadcast))
then
2140 do i = 1,
size(attribute_names)
2143 if (fill_exists)
then
2145 fill_value, broadcast=bcast)
2152 function get_variable_sense(fileobj, variable_name) &
2153 result(variable_sense)
2156 character(len=*),
intent(in) :: variable_name
2157 integer :: variable_sense
2159 character(len=256) :: buf
2170 end function get_variable_sense
2173 function get_variable_missing(fileobj, variable_name) &
2174 result(variable_missing)
2177 character(len=*),
intent(in) :: variable_name
2178 real(kind=r8_kind) :: variable_missing
2180 real(kind=r8_kind) :: variable_missing_1d(1)
2189 variable_missing_1d = mpp_fill_double
2192 variable_missing = variable_missing_1d(1)
2194 end function get_variable_missing
2197 subroutine get_variable_units(fileobj, variable_name, units)
2200 character(len=*),
intent(in) :: variable_name
2201 character(len=*),
intent(out) :: units
2208 end subroutine get_variable_units
2211 subroutine get_time_calendar(fileobj, time_name, calendar_type)
2214 character(len=*),
intent(in) :: time_name
2215 character(len=*),
intent(out) :: calendar_type
2222 calendar_type =
"unspecified"
2224 end subroutine get_time_calendar
2230 result(is_registered)
2233 character(len=*),
intent(in) :: variable_name
2234 logical :: is_registered
2238 if (.not. fileobj%is_restart)
then
2239 call error(
"file "//trim(fileobj%path)//
" is not a restart file. &
2240 &Add is_restart=.true. to your open_file call")
2242 is_registered = .false.
2243 do i = 1, fileobj%num_restart_vars
2244 if (
string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.))
then
2245 is_registered = .true.
2255 character(len=*),
intent(in),
optional :: fname
2258 if (
allocated(fileobj%is_open))
then
2259 is_open = fileobj%is_open
2264 if (
present(fname))
then
2267 if (is_open .AND. trim(fname) .ne. trim(fileobj%path)) is_open = .false.
2271 subroutine set_fileobj_time_name (fileobj,time_name)
2273 character(*),
intent(in) :: time_name
2274 integer :: len_of_name
2275 len_of_name = len(trim(time_name))
2276 fileobj%time_name =
' '
2277 fileobj%time_name = time_name(1:len_of_name)
2284 end subroutine set_fileobj_time_name
2290 integer,
intent(in),
optional :: unlim_dim_level
2292 logical,
intent(in),
optional :: ignore_checksum
2296 if (.not. fileobj%is_restart)
then
2297 call error(
"file "//trim(fileobj%path)//
" is not a restart file.")
2300 do i = 1, fileobj%num_restart_vars
2302 if (.not.any(
mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2305 if (
associated(fileobj%restart_vars(i)%data2d))
then
2307 fileobj%restart_vars(i)%data2d, &
2308 fileobj%restart_vars(i)%bc_info, &
2309 unlim_dim_level = unlim_dim_level, &
2310 ignore_checksum=ignore_checksum)
2311 else if (
associated(fileobj%restart_vars(i)%data3d))
then
2313 fileobj%restart_vars(i)%data3d, &
2314 fileobj%restart_vars(i)%bc_info, &
2315 unlim_dim_level = unlim_dim_level, &
2316 ignore_checksum=ignore_checksum)
2327 integer,
intent(in),
optional :: unlim_dim_level
2331 if (.not. fileobj%is_restart)
then
2332 call error(
"file "//trim(fileobj%path)//
" is not a restart file. &
2333 &Add is_restart=.true. to your open_file call")
2341 do i = 1, fileobj%num_restart_vars
2343 if (.not.any(
mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2346 if (.not. fileobj%restart_vars(i)%is_bc_variable) cycle
2349 if (
associated(fileobj%restart_vars(i)%data2d))
then
2350 call gather_data_bc(fileobj, fileobj%restart_vars(i)%data2d, fileobj%restart_vars(i)%bc_info)
2352 fileobj%restart_vars(i)%bc_info%chksum(1:len(fileobj%restart_vars(i)%bc_info%chksum)),&
2353 str_len=len(fileobj%restart_vars(i)%bc_info%chksum))
2354 else if (
associated(fileobj%restart_vars(i)%data3d))
then
2355 call gather_data_bc(fileobj, fileobj%restart_vars(i)%data3d, fileobj%restart_vars(i)%bc_info)
2357 fileobj%restart_vars(i)%bc_info%chksum(1:len(fileobj%restart_vars(i)%bc_info%chksum)),&
2358 str_len=len(fileobj%restart_vars(i)%bc_info%chksum))
2363 do i = 1, fileobj%num_restart_vars
2364 if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r8 ))
then
2366 fileobj%restart_vars(i)%bc_info%globaldata2d_r8 , &
2367 unlim_dim_level=unlim_dim_level)
2368 deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r8)
2369 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r4 ))
then
2371 fileobj%restart_vars(i)%bc_info%globaldata2d_r4 , &
2372 unlim_dim_level=unlim_dim_level)
2373 deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r4)
2374 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r8 ))
then
2376 fileobj%restart_vars(i)%bc_info%globaldata3d_r8 , &
2377 unlim_dim_level=unlim_dim_level)
2378 deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r8)
2379 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 ))
then
2381 fileobj%restart_vars(i)%bc_info%globaldata3d_r4 , &
2382 unlim_dim_level=unlim_dim_level)
2383 deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 )
2396 if (fileobj%is_root)
then
2397 err = nf90_sync(fileobj%ncid)
2402 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.
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.
logical function, public netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
Open a netcdf file.
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 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.
integer function get_variable_id(ncid, variable_name, msg, allow_failure)
Get the id of a variable from its name.
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.
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.
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.
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 ...
Range type for a netcdf variable.