27 #ifndef MAX_NUM_RESTART_VARS_
28 #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
128 integer,
public :: id
129 integer,
public,
allocatable :: offloading_pes(:)
130 integer,
public,
allocatable :: model_pes(:)
131 logical :: is_model_pe
140 character(len=FMS_PATH_LEN) :: path
141 logical :: is_readonly
143 character(len=256) :: nc_format
144 logical :: is_netcdf4
145 integer,
dimension(:),
allocatable :: pelist
150 logical :: is_restart
152 logical :: mode_is_append
153 logical,
allocatable :: is_open
156 integer :: num_restart_vars
158 integer :: num_compressed_dims
159 logical :: is_diskless
160 character (len=20) :: time_name
164 logical :: use_collective = .false.
169 logical :: use_netcdf_mpi = .false.
185 logical :: has_missing
186 real(kind=r8_kind) :: fill_val
187 real(kind=r8_kind) :: min_val
188 real(kind=r8_kind) :: max_val
189 real(kind=r8_kind) :: missing_val
253 public :: get_variable_sense
254 public :: get_variable_missing
255 public :: get_variable_units
256 public :: get_time_calendar
261 public :: set_fileobj_time_name
363 subroutine netcdf_io_init (chksz, header_buffer_val, netcdf_default_format, deflate_level, shuffle)
364 integer,
intent(in) :: chksz
365 character (len = 10),
intent(in) :: netcdf_default_format
366 integer,
intent(in) :: header_buffer_val
367 integer,
intent(in) :: deflate_level
369 logical,
intent(in) :: shuffle
379 elseif (
string_compare(netcdf_default_format,
"classic", .true.))
then
382 elseif (
string_compare(netcdf_default_format,
"netcdf4", .true.))
then
387 call error(
"unrecognized netcdf file format "//trim(netcdf_default_format)// &
388 '. The acceptable values are "64bit", "classic", "netcdf4". Check fms2_io_nml: netcdf_default_format')
397 integer,
intent(in) :: err
398 character(len=*),
intent(in) :: msg
400 character(len=80) :: buf
402 if (err .ne. nf90_noerr)
then
403 buf = nf90_strerror(err)
404 call error(trim(buf)//
": "//trim(msg))
413 integer,
intent(in) :: ncid
414 integer,
intent(in) :: mode
418 if (mode .eq. define_mode)
then
419 err = nf90_redef(ncid)
420 if (err .eq. nf90_eindefine .or. err .eq. nf90_eperm)
then
423 elseif (mode .eq. data_mode)
then
424 if (
fms2_header_buffer_val == -1)
call error(
"set_netcdf_mode: fms2_header_buffer_val not set, call fms2_io_init")
426 if (err .eq. nf90_enotindefine .or. err .eq. nf90_eperm)
then
430 call error(
"mode must be either define_mode or data_mode.")
442 integer,
intent(in) :: ncid
443 character(len=*),
intent(in) :: dimension_name
444 character(len=*),
intent(in) :: msg
445 logical,
intent(in),
optional :: allow_failure
453 err = nf90_inq_dimid(ncid, trim(dimension_name), dimid)
454 if (
present(allow_failure))
then
455 if (allow_failure .and. err .eq. nf90_ebaddim)
then
456 dimid = dimension_missing
470 integer,
intent(in) :: ncid
471 character(len=*),
intent(in) :: variable_name
472 character(len=*),
intent(in) :: msg
473 logical,
intent(in),
optional :: allow_failure
481 err = nf90_inq_varid(ncid, trim(variable_name), varid)
482 if (
present(allow_failure))
then
483 if (allow_failure .and. err .eq. nf90_enotvar)
then
484 varid = variable_missing
498 integer,
intent(in) :: ncid
499 integer,
intent(in) :: varid
500 character(len=*),
intent(in) :: attribute_name
501 character(len=*),
intent(in),
optional :: msg
503 logical :: att_exists
507 err = nf90_inquire_attribute(ncid, varid, trim(attribute_name))
508 if (err .eq. nf90_enotatt)
then
523 integer,
intent(in) :: ncid
524 integer,
intent(in) :: varid
525 character(len=*),
intent(in) :: attname
526 character(len=*),
intent(in),
optional :: msg
532 err = nf90_inquire_attribute(ncid, varid, attname, xtype=xtype)
543 integer,
intent(in) :: ncid
544 integer,
intent(in) :: varid
545 character(len=*),
intent(in),
optional :: msg
551 err = nf90_inquire_variable(ncid, varid, xtype=xtype)
558 function netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename, &
559 tile_comm, use_collective)
result(success)
562 character(len=*),
intent(in) :: path
563 character(len=*),
intent(in) :: mode
566 character(len=*),
intent(in),
optional :: nc_format
574 integer,
dimension(:),
intent(in),
optional :: pelist
579 logical,
intent(in),
optional :: is_restart
582 logical,
intent(in),
optional :: dont_add_res_to_filename
584 integer,
intent(in),
optional :: tile_comm
586 logical,
intent(in),
optional :: use_collective
590 integer :: nc_format_param
594 character(len=FMS_PATH_LEN) :: full_path
596 logical :: dont_add_res
601 call error(
"netcdf_file_open :: fms2_io has not been initialized")
604 if (
allocated(fileobj%is_open))
then
605 if (fileobj%is_open)
return
608 fileobj%use_netcdf_mpi = .false.
611 call mpp_error(note,
"netcdf_file_open :: Setting fileobj%tile_comm is deprecated. &
612 Please use open_file(..., tile_comm=...) instead.")
613 fileobj%use_netcdf_mpi = .true.
614 elseif (
present(tile_comm))
then
615 fileobj%use_netcdf_mpi = .true.
616 fileobj%tile_comm = tile_comm
619 if (fileobj%use_collective)
then
620 fileobj%use_netcdf_mpi = .true.
621 call mpp_error(note,
"Setting fileobj%use_collective to enable collective reads is deprecated. &
622 Please use open_file(..., use_collective=.true.) instead.")
624 fileobj%use_collective = .false.
625 if (
present(use_collective)) fileobj%use_collective = use_collective
631 if (
present(is_restart))
then
634 fileobj%is_restart = is_res
636 dont_add_res = .false.
637 if (
present(dont_add_res_to_filename))
then
638 dont_add_res = dont_add_res_to_filename
641 if (is_res .and. .not. dont_add_res)
then
644 call string_copy(full_path, trim(path))
651 call string_copy(fileobj%path, trim(full_path))
657 if (.not.success)
return
660 if (
present(pelist))
then
661 allocate(fileobj%pelist(
size(pelist)))
662 fileobj%pelist(:) = pelist(:)
664 allocate(fileobj%pelist(1))
665 fileobj%pelist(1) =
mpp_pe()
667 fileobj%io_root = fileobj%pelist(1)
668 fileobj%is_root =
mpp_pe().eq.fileobj%io_root
670 fileobj%is_netcdf4 = .false.
672 if (
present(nc_format))
then
674 nc_format_param = nf90_64bit_offset
676 nc_format_param = nf90_classic_model
678 fileobj%is_netcdf4 = .true.
679 nc_format_param = nf90_netcdf4
681 call error(
"unrecognized netcdf file format: '"//trim(nc_format)//
"' for file:"//trim(fileobj%path)//&
682 &
"Check your open_file call, the acceptable values are 64bit, classic, netcdf4")
684 call string_copy(fileobj%nc_format, nc_format)
691 if (fileobj%use_netcdf_mpi)
then
692 #ifdef NO_NC_PARALLEL4
693 call error(
"NetCDF was not built with HDF5 parallel I/O features, so use_netcdf_mpi cannot be used. &
694 &Please turn use_netcdf_mpi off for the file: " // trim(path))
696 nc_format_param = ior(nc_format_param, nf90_mpiio)
699 if (fileobj%use_netcdf_mpi)
then
702 err = nf90_open(trim(fileobj%path), ior(nf90_nowrite, nf90_mpiio), fileobj%ncid, &
705 err = nf90_open(trim(fileobj%path), ior(nf90_write, nf90_mpiio), fileobj%ncid, &
708 err = nf90_create(trim(fileobj%path), ior(nf90_noclobber, nc_format_param), fileobj%ncid, &
711 err = nf90_create(trim(fileobj%path), ior(nf90_clobber, nc_format_param), fileobj%ncid, &
714 call error(
"unrecognized file mode: '"//trim(mode)//
"' for file:"//trim(fileobj%path)//&
715 &
"Check your open_file call, the acceptable values are read, append, write, overwrite")
717 call check_netcdf_code(err,
"netcdf_file_open (using netcdf mpi): "//trim(fileobj%path))
718 elseif (fileobj%is_root)
then
721 err = nf90_open(trim(fileobj%path), nf90_nowrite, fileobj%ncid, chunksize=
fms2_ncchksz)
723 err = nf90_open(trim(fileobj%path), nf90_write, fileobj%ncid, chunksize=
fms2_ncchksz)
725 err = nf90_create(trim(fileobj%path), ior(nf90_noclobber, nc_format_param), fileobj%ncid, chunksize=
fms2_ncchksz)
727 err = nf90_create(trim(fileobj%path), ior(nf90_clobber, nc_format_param), fileobj%ncid, chunksize=
fms2_ncchksz)
729 call error(
"unrecognized file mode: '"//trim(mode)//
"' for file:"//trim(fileobj%path)//&
730 &
"Check your open_file call, the acceptable values are read, append, write, overwrite")
734 fileobj%ncid = missing_ncid
737 fileobj%is_diskless = .false.
740 if (fileobj%is_restart)
then
741 allocate(fileobj%restart_vars(max_num_restart_vars))
742 fileobj%num_restart_vars = 0
747 allocate(fileobj%compressed_dims(max_num_compressed_dims))
748 fileobj%num_compressed_dims = 0
750 if (.not.
allocated(fileobj%is_open))
allocate(fileobj%is_open)
751 fileobj%is_open = .true.
753 fileobj%bc_dimensions%xlen = 0
754 fileobj%bc_dimensions%ylen = 0
755 fileobj%bc_dimensions%zlen = 0
756 fileobj%bc_dimensions%cur_dim_len = 0
769 if (fileobj%is_root)
then
770 err = nf90_close(fileobj%ncid)
773 if (
allocated(fileobj%is_open)) fileobj%is_open = .false.
774 fileobj%path = missing_path
775 fileobj%ncid = missing_ncid
776 if (
allocated(fileobj%pelist))
then
777 deallocate(fileobj%pelist)
779 fileobj%io_root = missing_rank
780 fileobj%is_root = .false.
781 if (
allocated(fileobj%restart_vars))
then
782 deallocate(fileobj%restart_vars)
784 fileobj%is_restart = .false.
785 fileobj%num_restart_vars = 0
786 do i = 1, fileobj%num_compressed_dims
787 if (
allocated(fileobj%compressed_dims(i)%npes_corner))
then
788 deallocate(fileobj%compressed_dims(i)%npes_corner)
790 if (
allocated(fileobj%compressed_dims(i)%npes_nelems))
then
791 deallocate(fileobj%compressed_dims(i)%npes_nelems)
794 if (
allocated(fileobj%compressed_dims))
then
795 deallocate(fileobj%compressed_dims)
807 character(len=*),
intent(in) :: dim_name
812 dindex = dimension_not_found
813 do i = 1, fileobj%num_compressed_dims
814 if (
string_compare(fileobj%compressed_dims(i)%dimname, dim_name))
then
828 character(len=*),
intent(in) :: dim_name
829 integer,
dimension(:),
intent(in) :: npes_corner
831 integer,
dimension(:),
intent(in) :: npes_nelems
838 call error(
"dimension "//trim(dim_name)//
" already registered" &
839 //
" to file "//trim(fileobj%path)//
".")
841 fileobj%num_compressed_dims = fileobj%num_compressed_dims + 1
842 n = fileobj%num_compressed_dims
843 if (n .gt. max_num_compressed_dims)
then
844 call error(
"number of compressed dimensions exceeds limit.")
846 call string_copy(fileobj%compressed_dims(n)%dimname, dim_name)
847 if (
size(npes_corner) .ne.
size(fileobj%pelist) .or. &
848 size(npes_nelems) .ne.
size(fileobj%pelist))
then
849 call error(
"incorrect size for input npes_corner or npes_nelems arrays.")
851 allocate(fileobj%compressed_dims(n)%npes_corner(
size(fileobj%pelist)))
852 fileobj%compressed_dims(n)%npes_corner(:) = npes_corner(:)
853 allocate(fileobj%compressed_dims(n)%npes_nelems(
size(fileobj%pelist)))
854 fileobj%compressed_dims(n)%npes_nelems(:) = npes_nelems(:)
855 fileobj%compressed_dims(n)%nelems = sum(fileobj%compressed_dims(n)%npes_nelems)
863 character(len=*),
intent(in) :: dimension_name
864 integer,
intent(in) :: dimension_length
866 integer,
dimension(:),
allocatable :: npes_start
867 integer,
dimension(:),
allocatable :: npes_count
873 allocate(npes_start(
size(fileobj%pelist)))
874 allocate(npes_count(
size(fileobj%pelist)))
876 call mpp_gather((/dimension_length/),npes_count,pelist=fileobj%pelist)
879 do i = 1,
size(fileobj%pelist)-1
880 npes_start(i+1) = npes_start(i) + npes_count(i)
885 if (fileobj%is_root .and. .not. fileobj%is_readonly)
then
887 err = nf90_def_dim(fileobj%ncid, trim(dimension_name), unlimited, dimid)
888 call check_netcdf_code(err,
"Netcdf_add_dimension: file:"//trim(fileobj%path)//
" dimension name:"// &
889 & trim(dimension_name))
898 character(len=*),
intent(in) :: dimension_name
899 integer,
intent(in) :: dimension_length
900 logical,
intent(in),
optional :: is_compressed
906 integer,
dimension(:),
allocatable :: npes_start
907 integer,
dimension(:),
allocatable :: npes_count
912 dim_len = dimension_length
913 if (
present(is_compressed))
then
914 if (is_compressed)
then
916 allocate(npes_start(
size(fileobj%pelist)))
917 allocate(npes_count(
size(fileobj%pelist)))
918 do i = 1,
size(fileobj%pelist)
919 if (fileobj%pelist(i) .eq.
mpp_pe())
then
920 npes_count(i) = dim_len
922 call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
923 call mpp_send(dim_len, fileobj%pelist(i))
929 do i = 1,
size(fileobj%pelist)-1
930 npes_start(i+1) = npes_start(i) + npes_count(i)
934 dim_len = sum(npes_count)
937 if ((fileobj%is_root) .and. .not. fileobj%is_readonly)
then
939 err = nf90_def_dim(fileobj%ncid, trim(dimension_name), dim_len, dimid)
940 call check_netcdf_code(err,
"Netcdf_add_dimension: file:"//trim(fileobj%path)//
" dimension name:"// &
941 & trim(dimension_name))
948 npes_corner, npes_nelems)
951 character(len=*),
intent(in) :: dimension_name
952 integer,
dimension(:),
intent(in) :: npes_corner
954 integer,
dimension(:),
intent(in) :: npes_nelems
962 dsize = sum(npes_nelems)
963 if (fileobj%is_readonly)
then
965 if (fdim_size .ne. dsize)
then
966 call error(
"dimension "//trim(dimension_name)//
" does not match" &
967 //
" the size of the associated compressed axis.")
979 character(len=*),
intent(in) :: variable_name
980 character(len=*),
intent(in) :: variable_type
983 character(len=*),
dimension(:),
intent(in),
optional :: dimensions
984 integer,
optional,
intent(in) :: chunksizes(:)
988 integer,
dimension(:),
allocatable :: dimids
992 character(len=200) :: append_error_msg
994 append_error_msg =
"netcdf_add_variable: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)
996 if (fileobj%is_root)
then
1001 if ( .not. fileobj%is_netcdf4)
call error(trim(fileobj%path)//&
1002 &
": 64 bit integers are only supported with 'netcdf4' file format"//&
1003 &
". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
1004 &
"add nc_format='netcdf4' to your open_file call")
1012 if (.not.
present(dimensions))
then
1013 call error(
"String variables require a string length dimension:"//trim(append_error_msg))
1016 call error(
"Unsupported variable type:"//trim(append_error_msg))
1018 if (
present(dimensions))
then
1019 allocate(dimids(
size(dimensions)))
1020 do i = 1,
size(dimids)
1021 dimids(i) =
get_dimension_id(fileobj%ncid, trim(dimensions(i)),msg=append_error_msg)
1023 if (fileobj%is_netcdf4)
then
1024 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid, &
1028 &
call mpp_error(note,
"Not able to use deflate_level or chunksizes if not using netcdf4"// &
1030 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, dimids, varid)
1034 err = nf90_def_var(fileobj%ncid, trim(variable_name), vtype, varid)
1039 if (fileobj%use_netcdf_mpi.and.fileobj%use_collective)
then
1040 err = nf90_var_par_access(fileobj%ncid, varid, nf90_collective)
1050 result(compressed_dimension_index)
1053 character(len=*),
intent(in) :: variable_name
1054 logical,
intent(in),
optional :: broadcast
1060 integer,
dimension(2) :: compressed_dimension_index
1063 character(len=nf90_max_name),
dimension(:),
allocatable :: dim_names
1067 compressed_dimension_index = dimension_not_found
1068 if (fileobj%is_root)
then
1070 if (ndims .gt. 0)
then
1071 allocate(dim_names(ndims))
1073 do i = 1,
size(dim_names)
1075 if (j .ne. dimension_not_found)
then
1076 compressed_dimension_index(1) = i
1077 compressed_dimension_index(2) = j
1081 deallocate(dim_names)
1084 if (
present(broadcast))
then
1085 if (.not. broadcast)
then
1089 call mpp_broadcast(compressed_dimension_index(1), fileobj%io_root, pelist=fileobj%pelist)
1090 call mpp_broadcast(compressed_dimension_index(2), fileobj%io_root, pelist=fileobj%pelist)
1099 character(len=*),
intent(in) :: variable_name
1103 if (.not. fileobj%is_restart)
then
1104 call error(
"file "//trim(fileobj%path)//
" is not a restart file.")
1106 do i = 1, fileobj%num_restart_vars
1107 if (
string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.))
then
1108 call error(
"variable "//trim(variable_name)//
" has already" &
1109 //
" been added to restart file "//trim(fileobj%path)//
".")
1112 fileobj%num_restart_vars = fileobj%num_restart_vars + 1
1113 if (fileobj%num_restart_vars .gt. max_num_restart_vars)
then
1114 call error(
"Number of restart variables exceeds limit.")
1116 call string_copy(fileobj%restart_vars(fileobj%num_restart_vars)%varname, &
1126 integer,
intent(in),
optional :: unlim_dim_level
1131 if (.not. fileobj%is_restart)
then
1132 call error(
"write_restart:: file "//trim(fileobj%path)//
" is not a restart file. &
1133 &Be sure the file was opened with is_restart=.true.")
1135 do i = 1, fileobj%num_restart_vars
1136 if (
associated(fileobj%restart_vars(i)%data0d))
then
1138 fileobj%restart_vars(i)%data0d, &
1139 unlim_dim_level=unlim_dim_level)
1140 elseif (
associated(fileobj%restart_vars(i)%data1d))
then
1142 fileobj%restart_vars(i)%data1d, &
1143 unlim_dim_level=unlim_dim_level)
1144 elseif (
associated(fileobj%restart_vars(i)%data2d))
then
1146 fileobj%restart_vars(i)%data2d, &
1147 unlim_dim_level=unlim_dim_level)
1148 elseif (
associated(fileobj%restart_vars(i)%data3d))
then
1150 fileobj%restart_vars(i)%data3d, &
1151 unlim_dim_level=unlim_dim_level)
1152 elseif (
associated(fileobj%restart_vars(i)%data4d))
then
1154 fileobj%restart_vars(i)%data4d, &
1155 unlim_dim_level=unlim_dim_level)
1157 call error(
"this branch should not be reached.")
1168 integer,
intent(in),
optional :: unlim_dim_level
1173 if (.not. fileobj%is_restart)
then
1174 call error(
"read_restart:: file "//trim(fileobj%path)//
" is not a restart file. &
1175 &Be sure the file was opened with is_restart=.true.")
1177 do i = 1, fileobj%num_restart_vars
1178 if (
associated(fileobj%restart_vars(i)%data0d))
then
1180 fileobj%restart_vars(i)%data0d, &
1181 unlim_dim_level=unlim_dim_level, &
1183 elseif (
associated(fileobj%restart_vars(i)%data1d))
then
1185 fileobj%restart_vars(i)%data1d, &
1186 unlim_dim_level=unlim_dim_level, &
1188 elseif (
associated(fileobj%restart_vars(i)%data2d))
then
1190 fileobj%restart_vars(i)%data2d, &
1191 unlim_dim_level=unlim_dim_level, &
1193 elseif (
associated(fileobj%restart_vars(i)%data3d))
then
1195 fileobj%restart_vars(i)%data3d, &
1196 unlim_dim_level=unlim_dim_level, &
1198 elseif (
associated(fileobj%restart_vars(i)%data4d))
then
1200 fileobj%restart_vars(i)%data4d, &
1201 unlim_dim_level=unlim_dim_level, &
1204 call error(
"this branch should not be reached.")
1216 character(len=*),
intent(in) :: attribute_name
1217 logical,
intent(in),
optional :: broadcast
1223 logical :: att_exists
1225 if (fileobj%is_root)
then
1226 att_exists =
attribute_exists(fileobj%ncid, nf90_global, trim(attribute_name), &
1227 & msg=
"global_att_exists: file:"//trim(fileobj%path)//
" attribute name:"//trim(attribute_name))
1229 if (
present(broadcast))
then
1230 if (.not. broadcast)
then
1234 call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1245 character(len=*),
intent(in) :: variable_name
1246 character(len=*),
intent(in) :: attribute_name
1247 logical,
intent(in),
optional :: broadcast
1253 logical :: att_exists
1257 att_exists = .false.
1258 if (fileobj%is_root)
then
1260 & msg=
"variable_att_exists: file:"//trim(fileobj%path)//
"- variable:"//&
1261 &trim(variable_name))
1263 &msg=
"variable_att_exists: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)//&
1264 &
" attribute name:"//trim(attribute_name))
1266 if (
present(broadcast))
then
1267 if (.not. broadcast)
then
1271 call mpp_broadcast(att_exists, fileobj%io_root, pelist=fileobj%pelist)
1281 logical,
intent(in),
optional :: broadcast
1291 if (fileobj%is_root)
then
1292 err = nf90_inquire(fileobj%ncid, ndimensions=ndims)
1295 if (
present(broadcast))
then
1296 if (.not. broadcast)
then
1300 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1308 character(len=*),
dimension(:),
intent(inout) :: names
1310 logical,
intent(in),
optional :: broadcast
1321 if (fileobj%is_root)
then
1323 if (ndims .gt. 0)
then
1324 if (
size(names) .ne. ndims)
then
1325 call error(
"'names' has to be the same size of the number of dimensions. &
1326 &Check your get_dimension_names call for file "//trim(fileobj%path))
1329 call error(
"get_dimension_names: the file "//trim(fileobj%path)//
" does not have any dimensions")
1333 err = nf90_inquire_dimension(fileobj%ncid, i, name=names(i))
1337 if (
present(broadcast))
then
1338 if (.not. broadcast)
then
1342 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1343 if (.not. fileobj%is_root)
then
1344 if (ndims .gt. 0)
then
1345 if (
size(names) .ne. ndims)
then
1346 call error(
"'names' has to be the same size of the number of dimensions. &
1347 &Check your get_dimension_names call for file "//trim(fileobj%path))
1350 call error(
"get_dimension_names: the file "//trim(fileobj%path)//
" does not have any dimensions")
1354 call mpp_broadcast(names, len(names(ndims)), fileobj%io_root, &
1355 pelist=fileobj%pelist)
1365 character(len=*),
intent(in) :: dimension_name
1366 logical,
intent(in),
optional :: broadcast
1372 logical :: dim_exists
1376 if (fileobj%is_root)
then
1378 msg=
"dimension_exists: file:"//trim(fileobj%path)//
" dimension:"//trim(dimension_name), &
1379 allow_failure=.true.)
1380 if (dimid .eq. dimension_missing)
then
1381 dim_exists = .false.
1386 if (
present(broadcast))
then
1387 if (.not. broadcast)
then
1391 call mpp_broadcast(dim_exists, fileobj%io_root, pelist=fileobj%pelist)
1398 result(is_unlimited)
1401 character(len=*),
intent(in) :: dimension_name
1402 logical,
intent(in),
optional :: broadcast
1408 logical :: is_unlimited
1410 character(len=200) :: append_error_msg
1413 integer :: ulim_dimid
1415 if (fileobj%is_root)
then
1416 append_error_msg=
"is_dimension_unlimited: file:"//trim(fileobj%path)//&
1417 &
" dimension_name:"//trim(dimension_name)
1418 dimid =
get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1419 err = nf90_inquire(fileobj%ncid, unlimiteddimid=ulim_dimid)
1421 is_unlimited = dimid .eq. ulim_dimid
1423 if (
present(broadcast))
then
1424 if (.not. broadcast)
then
1428 call mpp_broadcast(is_unlimited, fileobj%io_root, pelist=fileobj%pelist)
1436 character(len=*),
intent(out) :: dimension_name
1437 logical,
intent(in),
optional :: broadcast
1446 character(len=nf90_max_name),
dimension(1) :: buffer
1449 if (fileobj%is_root)
then
1450 err = nf90_inquire(fileobj%ncid, unlimiteddimid=dimid)
1451 call check_netcdf_code(err,
"get_unlimited_dimension_name: file:"//trim(fileobj%path))
1452 err = nf90_inquire_dimension(fileobj%ncid, dimid, dimension_name)
1453 call check_netcdf_code(err,
"get_unlimited_dimension_name: file:"//trim(fileobj%path))
1454 call string_copy(buffer(1), dimension_name)
1456 if (
present(broadcast))
then
1457 if (.not. broadcast)
then
1461 call mpp_broadcast(buffer, nf90_max_name, fileobj%io_root, &
1462 pelist=fileobj%pelist)
1463 call string_copy(dimension_name, buffer(1))
1471 character(len=*),
intent(in) :: dimension_name
1472 integer,
intent(inout) :: dim_size
1473 logical,
intent(in),
optional :: broadcast
1482 character(len=200) :: append_error_msg
1484 if (fileobj%is_root)
then
1485 append_error_msg =
"get_dimension_size: file:"//trim(fileobj%path)//
" dimension_name: "//trim(dimension_name)
1486 dimid =
get_dimension_id(fileobj%ncid, trim(dimension_name), msg=append_error_msg)
1487 err = nf90_inquire_dimension(fileobj%ncid, dimid, len=dim_size)
1490 if (
present(broadcast))
then
1491 if (.not. broadcast)
then
1495 call mpp_broadcast(dim_size, fileobj%io_root, pelist=fileobj%pelist)
1505 logical,
intent(in),
optional :: broadcast
1515 if (fileobj%is_root)
then
1516 err = nf90_inquire(fileobj%ncid, nvariables=nvars)
1519 if (
present(broadcast))
then
1520 if (.not. broadcast)
then
1524 call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1532 character(len=*),
dimension(:),
intent(inout) :: names
1534 logical,
intent(in),
optional :: broadcast
1545 if (fileobj%is_root)
then
1547 if (nvars .gt. 0)
then
1548 if (
size(names) .ne. nvars)
then
1549 call error(
"'names' has to be the same size of the number of variables. &
1550 &Check your get_variable_names call for file "//trim(fileobj%path))
1553 call error(
"get_variable_names: the file "//trim(fileobj%path)//
" does not have any variables")
1557 err = nf90_inquire_variable(fileobj%ncid, i, name=names(i))
1561 if (
present(broadcast))
then
1562 if (.not. broadcast)
then
1566 call mpp_broadcast(nvars, fileobj%io_root, pelist=fileobj%pelist)
1567 if (.not. fileobj%is_root)
then
1568 if (nvars .gt. 0)
then
1569 if (
size(names) .ne. nvars)
then
1570 call error(
"'names' has to be the same size of the number of variables. &
1571 &Check your get_variable_names call for file "//trim(fileobj%path))
1574 call error(
"get_variable_names: the file "//trim(fileobj%path)//
" does not have any variables")
1578 call mpp_broadcast(names, len(names(nvars)), fileobj%io_root, &
1579 pelist=fileobj%pelist)
1589 character(len=*),
intent(in) :: variable_name
1590 logical,
intent(in),
optional :: broadcast
1596 logical :: var_exists
1600 if (fileobj%is_root)
then
1602 msg=
"variable_exists: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name), &
1603 allow_failure=.true.)
1604 var_exists = varid .ne. variable_missing
1606 if (
present(broadcast))
then
1607 if (.not. broadcast)
then
1611 call mpp_broadcast(var_exists, fileobj%io_root, pelist=fileobj%pelist)
1621 character(len=*),
intent(in) :: variable_name
1622 logical,
intent(in),
optional :: broadcast
1632 character(len=200) :: append_error_msg
1635 if (fileobj%is_root)
then
1636 append_error_msg =
"get_variable_num_dimension: file:"//trim(fileobj%path)//
" variable: "//trim(variable_name)
1637 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1638 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims)
1641 if (
present(broadcast))
then
1642 if (.not. broadcast)
then
1646 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1655 character(len=*),
intent(in) :: variable_name
1656 character(len=*),
dimension(:),
intent(inout) :: dim_names
1659 logical,
intent(in),
optional :: broadcast
1669 integer,
dimension(nf90_max_var_dims) :: dimids
1671 character(len=200) :: append_error_msg
1674 if (fileobj%is_root)
then
1675 append_error_msg =
"get_variable_dimension_names: file:"//trim(fileobj%path)//
" variable: "//trim(variable_name)
1677 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1678 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, &
1681 if (ndims .gt. 0)
then
1682 if (
size(dim_names) .ne. ndims)
then
1683 call error(
"'names' has to be the same size of the number of dimensions for the variable. &
1684 &Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1685 " and variable:"//trim(variable_name))
1688 call error(
"get_variable_dimension_names: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)&
1689 & //
" does not any dimensions. ")
1693 err = nf90_inquire_dimension(fileobj%ncid, dimids(i), name=dim_names(i))
1697 if (
present(broadcast))
then
1698 if (.not. broadcast)
then
1702 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1703 if (.not. fileobj%is_root)
then
1704 if (ndims .gt. 0)
then
1705 if (
size(dim_names) .ne. ndims)
then
1706 call error(
"'names' has to be the same size of the number of dimensions for the variable. &
1707 & Check your get_variable_dimension_names call for file "//trim(fileobj%path)// &
1708 " and variable:"//trim(variable_name))
1711 call error(
"get_variable_dimension_names: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)&
1712 & //
" does not any dimensions. ")
1716 call mpp_broadcast(dim_names, len(dim_names(ndims)), fileobj%io_root, &
1717 pelist=fileobj%pelist)
1725 character(len=*),
intent(in) :: variable_name
1726 integer,
dimension(:),
intent(inout) :: dim_sizes
1728 logical,
intent(in),
optional :: broadcast
1738 integer,
dimension(nf90_max_var_dims) :: dimids
1740 character(len=200) :: append_error_msg
1742 if (fileobj%is_root)
then
1743 append_error_msg =
"get_variable_size: file:"//trim(fileobj%path)//
" variable:"//trim(variable_name)
1744 varid =
get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
1745 err = nf90_inquire_variable(fileobj%ncid, varid, ndims=ndims, dimids=dimids)
1747 if (ndims .gt. 0)
then
1748 if (
size(dim_sizes) .ne. ndims)
then
1749 call error(
"'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1750 &Check your get_variable_size call for file "//trim(fileobj%path)// &
1751 " and variable:"//trim(variable_name))
1754 call error(
"get_variable_size: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)//&
1755 &
" does not any dimensions. ")
1758 err = nf90_inquire_dimension(fileobj%ncid, dimids(i), len=dim_sizes(i))
1762 if (
present(broadcast))
then
1763 if (.not. broadcast)
then
1767 call mpp_broadcast(ndims, fileobj%io_root, pelist=fileobj%pelist)
1768 if (.not. fileobj%is_root)
then
1769 if (ndims .gt. 0)
then
1770 if (
size(dim_sizes) .ne. ndims)
then
1771 call error(
"'dim_sizes' has to be the same size of the number of dimensions for the variable. &
1772 &Check your get_variable_size call for file "//trim(fileobj%path)// &
1773 " and variable:"//trim(variable_name))
1776 call error(
"get_variable_size: the variable: "//trim(variable_name)//
" in file: "//trim(fileobj%path)//&
1777 &
" does not any dimensions. ")
1780 call mpp_broadcast(dim_sizes, ndims, fileobj%io_root, pelist=fileobj%pelist)
1789 result(unlim_dim_index)
1792 character(len=*),
intent(in) :: variable_name
1793 logical,
intent(in),
optional :: broadcast
1799 integer :: unlim_dim_index
1802 character(len=nf90_max_name),
dimension(:),
allocatable :: dim_names
1805 unlim_dim_index = no_unlimited_dimension
1806 if (fileobj%is_root)
then
1808 allocate(dim_names(ndims))
1811 do i = 1,
size(dim_names)
1817 deallocate(dim_names)
1819 if (
present(broadcast))
then
1820 if (.not. broadcast)
then
1824 call mpp_broadcast(unlim_dim_index, fileobj%io_root, pelist=fileobj%pelist)
1835 character(len=*),
intent(in) :: variable_name
1839 real(kind=r8_kind) :: scale_factor
1840 real(kind=r8_kind) :: add_offset
1841 real(kind=r8_kind),
dimension(2) :: buffer
1843 character(len=200) :: append_error_msg
1845 append_error_msg =
"get_valid: file:"//trim(fileobj%path)
1846 if (fileobj%is_root)
then
1847 varid =
get_variable_id(fileobj%ncid, variable_name, msg=append_error_msg)
1848 valid%has_max = .false.
1849 valid%has_min = .false.
1850 valid%has_fill = .false.
1851 valid%has_missing = .false.
1852 valid%has_range = .false.
1856 if (
attribute_exists(fileobj%ncid, varid,
"scale_factor", msg=append_error_msg))
then
1860 scale_factor = 1._r8_kind
1862 if (
attribute_exists(fileobj%ncid, varid,
"add_offset", msg=append_error_msg))
then
1866 add_offset = 0._r8_kind
1873 if (
attribute_exists(fileobj%ncid, varid,
"valid_range", msg=append_error_msg))
then
1876 valid%max_val = buffer(2)*scale_factor + add_offset
1877 valid%has_max = .true.
1878 valid%min_val = buffer(1)*scale_factor + add_offset
1879 valid%has_min = .true.
1881 if (
attribute_exists(fileobj%ncid, varid,
"valid_max", msg=append_error_msg))
then
1884 valid%max_val = buffer(1)*scale_factor + add_offset
1885 valid%has_max = .true.
1887 if (
attribute_exists(fileobj%ncid, varid,
"valid_min", msg=append_error_msg))
then
1890 valid%min_val = buffer(1)*scale_factor + add_offset
1891 valid%has_min = .true.
1894 valid%has_range = valid%has_min .or. valid%has_max
1898 if (
attribute_exists(fileobj%ncid, varid,
"missing_value", msg=append_error_msg))
then
1901 valid%missing_val = buffer(1)*scale_factor + add_offset
1902 valid%has_missing = .true.
1913 if (
attribute_exists(fileobj%ncid, varid,
"_FillValue", msg=append_error_msg))
then
1916 valid%fill_val = buffer(1)*scale_factor + add_offset
1917 valid%has_fill = .true.
1920 if (.not. valid%has_range)
then
1921 if (xtype .eq. nf90_short .or. xtype .eq. nf90_int)
then
1922 if (buffer(1) .gt. 0)
then
1923 valid%max_val = (buffer(1) - 1._r8_kind)*scale_factor + add_offset
1924 valid%has_max = .true.
1926 valid%min_val = (buffer(1) + 1._r8_kind)*scale_factor + add_offset
1927 valid%has_min = .true.
1929 elseif (xtype .eq. nf90_float .or. xtype .eq. nf90_double)
then
1930 if (buffer(1) .gt. 0)
then
1931 valid%max_val = (nearest(nearest(buffer(1), -1._r8_kind), -1._r8_kind)) &
1932 *scale_factor + add_offset
1933 valid%has_max = .true.
1935 valid%min_val = (nearest(nearest(buffer(1), 1._r8_kind), 1._r8_kind)) &
1936 *scale_factor + add_offset
1937 valid%has_min = .true.
1940 call error(
"Unsupported variable type:"//trim(append_error_msg))
1942 valid%has_range = .true.
1948 call mpp_broadcast(valid%has_min, fileobj%io_root, pelist=fileobj%pelist)
1949 if (valid%has_min)
then
1950 call mpp_broadcast(valid%min_val, fileobj%io_root, pelist=fileobj%pelist)
1952 call mpp_broadcast(valid%has_max, fileobj%io_root, pelist=fileobj%pelist)
1953 if (valid%has_max)
then
1954 call mpp_broadcast(valid%max_val, fileobj%io_root, pelist=fileobj%pelist)
1956 call mpp_broadcast(valid%has_range, fileobj%io_root, pelist=fileobj%pelist)
1958 call mpp_broadcast(valid%has_fill, fileobj%io_root, pelist=fileobj%pelist)
1959 if (valid%has_fill)
then
1960 call mpp_broadcast(valid%fill_val, fileobj%io_root, pelist=fileobj%pelist)
1963 call mpp_broadcast(valid%has_missing, fileobj%io_root, pelist=fileobj%pelist)
1964 if (valid%has_missing)
then
1965 call mpp_broadcast(valid%missing_val, fileobj%io_root, pelist=fileobj%pelist)
1975 real(kind=r8_kind),
intent(in) :: datum
1976 type(
valid_t),
intent(in) :: validobj
1977 logical :: valid_data
1988 real(kind=r4_kind),
intent(in) :: datum
1989 type(
valid_t),
intent(in) :: validobj
1990 logical :: valid_data
1992 real(kind=r8_kind) :: rdatum
1995 rdatum = real(datum, kind=r8_kind)
2005 real(kind=r8_kind),
intent(in) :: rdatum
2006 type(
valid_t),
intent(in) :: validobj
2007 logical :: valid_data
2012 if (validobj%has_range)
then
2013 if (validobj%has_min .and. .not. validobj%has_max)
then
2014 valid_data = rdatum .ge. validobj%min_val
2015 elseif (validobj%has_max .and. .not. validobj%has_min)
then
2016 valid_data = rdatum .le. validobj%max_val
2018 valid_data = .not. (rdatum .lt. validobj%min_val .or. rdatum .gt. validobj%max_val)
2023 if (validobj%has_fill .or. validobj%has_missing)
then
2024 if (validobj%has_fill .and. .not. validobj%has_missing)
then
2025 valid_data = rdatum .ne. validobj%fill_val
2026 elseif (validobj%has_missing .and. .not. validobj%has_fill)
then
2027 valid_data = rdatum .ne. validobj%missing_val
2029 valid_data = .not. (rdatum .eq. validobj%missing_val .or. rdatum .eq. validobj%fill_val)
2039 integer,
intent(in) :: nelems
2040 integer,
dimension(:),
allocatable,
intent(out) :: npes_start
2041 integer,
dimension(:),
allocatable,
intent(out) :: npes_count
2046 allocate(npes_start(
size(fileobj%pelist)))
2047 allocate(npes_count(
size(fileobj%pelist)))
2048 do i = 1,
size(fileobj%pelist)
2049 if (fileobj%pelist(i) .eq.
mpp_pe())
then
2050 npes_count(i) = nelems
2052 call mpp_recv(npes_count(i), fileobj%pelist(i), block=.false.)
2053 call mpp_send(nelems, fileobj%pelist(i))
2059 do i = 1,
size(fileobj%pelist)-1
2060 npes_start(i+1) = npes_start(i) + npes_count(i)
2065 include
"netcdf_add_restart_variable.inc"
2066 include
"netcdf_read_data.inc"
2067 include
"netcdf_write_data.inc"
2068 include
"register_global_attribute.inc"
2069 include
"register_variable_attribute.inc"
2070 include
"get_global_attribute.inc"
2071 include
"get_variable_attribute.inc"
2072 include
"compressed_write.inc"
2073 include
"compressed_read.inc"
2074 include
"scatter_data_bc.inc"
2075 include
"gather_data_bc.inc"
2076 include
"unpack_data.inc"
2080 dont_add_res_to_filename)
result(success)
2083 character(len=*),
intent(in) :: path
2084 character(len=*),
intent(in) :: mode
2087 character(len=*),
intent(in),
optional :: nc_format
2093 integer,
dimension(:),
intent(in),
optional :: pelist
2098 logical,
intent(in),
optional :: is_restart
2101 logical,
intent(in),
optional :: dont_add_res_to_filename
2105 success =
netcdf_file_open(fileobj, path, mode, nc_format, pelist, is_restart, dont_add_res_to_filename)
2122 character(len=*),
intent(in) :: variable_name
2123 character(len=*),
intent(in) :: variable_type
2126 character(len=*),
dimension(:),
intent(in),
optional :: dimensions
2127 integer,
intent(in),
optional :: chunksizes(:)
2136 integer,
intent(in),
optional :: unlim_dim_level
2149 character(len=*),
intent(in) :: variable_name
2150 class(*),
intent(out) :: fill_value
2151 logical,
intent(in),
optional :: broadcast
2157 logical :: fill_exists
2159 character(len=32),
dimension(2) :: attribute_names
2163 fill_exists = .false.
2164 call string_copy(attribute_names(1),
"_FillValue")
2165 call string_copy(attribute_names(2),
"missing_value")
2166 if (
present(broadcast))
then
2171 do i = 1,
size(attribute_names)
2174 if (fill_exists)
then
2176 fill_value, broadcast=bcast)
2183 function get_variable_sense(fileobj, variable_name) &
2184 result(variable_sense)
2187 character(len=*),
intent(in) :: variable_name
2188 integer :: variable_sense
2190 character(len=256) :: buf
2201 end function get_variable_sense
2204 function get_variable_missing(fileobj, variable_name) &
2205 result(variable_missing)
2208 character(len=*),
intent(in) :: variable_name
2209 real(kind=r8_kind) :: variable_missing
2211 real(kind=r8_kind) :: variable_missing_1d(1)
2220 variable_missing_1d = mpp_fill_double
2223 variable_missing = variable_missing_1d(1)
2225 end function get_variable_missing
2228 subroutine get_variable_units(fileobj, variable_name, units)
2231 character(len=*),
intent(in) :: variable_name
2232 character(len=*),
intent(out) :: units
2239 end subroutine get_variable_units
2242 subroutine get_time_calendar(fileobj, time_name, calendar_type)
2245 character(len=*),
intent(in) :: time_name
2246 character(len=*),
intent(out) :: calendar_type
2253 calendar_type =
"unspecified"
2255 end subroutine get_time_calendar
2261 result(is_registered)
2264 character(len=*),
intent(in) :: variable_name
2265 logical :: is_registered
2269 if (.not. fileobj%is_restart)
then
2270 call error(
"file "//trim(fileobj%path)//
" is not a restart file. &
2271 &Add is_restart=.true. to your open_file call")
2273 is_registered = .false.
2274 do i = 1, fileobj%num_restart_vars
2275 if (
string_compare(fileobj%restart_vars(i)%varname, variable_name, .true.))
then
2276 is_registered = .true.
2286 character(len=*),
intent(in),
optional :: fname
2289 if (
allocated(fileobj%is_open))
then
2290 is_open = fileobj%is_open
2295 if (
present(fname))
then
2298 if (is_open .AND. trim(fname) .ne. trim(fileobj%path)) is_open = .false.
2302 subroutine set_fileobj_time_name (fileobj,time_name)
2304 character(*),
intent(in) :: time_name
2305 integer :: len_of_name
2306 len_of_name = len(trim(time_name))
2307 fileobj%time_name =
' '
2308 fileobj%time_name = time_name(1:len_of_name)
2315 end subroutine set_fileobj_time_name
2321 integer,
intent(in),
optional :: unlim_dim_level
2323 logical,
intent(in),
optional :: ignore_checksum
2327 if (.not. fileobj%is_restart)
then
2328 call error(
"file "//trim(fileobj%path)//
" is not a restart file.")
2331 do i = 1, fileobj%num_restart_vars
2333 if (.not.any(
mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2336 if (
associated(fileobj%restart_vars(i)%data2d))
then
2338 fileobj%restart_vars(i)%data2d, &
2339 fileobj%restart_vars(i)%bc_info, &
2340 unlim_dim_level = unlim_dim_level, &
2341 ignore_checksum=ignore_checksum)
2342 else if (
associated(fileobj%restart_vars(i)%data3d))
then
2344 fileobj%restart_vars(i)%data3d, &
2345 fileobj%restart_vars(i)%bc_info, &
2346 unlim_dim_level = unlim_dim_level, &
2347 ignore_checksum=ignore_checksum)
2358 integer,
intent(in),
optional :: unlim_dim_level
2362 if (.not. fileobj%is_restart)
then
2363 call error(
"file "//trim(fileobj%path)//
" is not a restart file. &
2364 &Add is_restart=.true. to your open_file call")
2372 do i = 1, fileobj%num_restart_vars
2374 if (.not.any(
mpp_pe().eq.fileobj%restart_vars(i)%bc_info%pelist(:))) cycle
2377 if (.not. fileobj%restart_vars(i)%is_bc_variable) cycle
2380 if (
associated(fileobj%restart_vars(i)%data2d))
then
2381 call gather_data_bc(fileobj, fileobj%restart_vars(i)%data2d, fileobj%restart_vars(i)%bc_info)
2383 fileobj%restart_vars(i)%bc_info%chksum(1:len(fileobj%restart_vars(i)%bc_info%chksum)),&
2384 str_len=len(fileobj%restart_vars(i)%bc_info%chksum))
2385 else if (
associated(fileobj%restart_vars(i)%data3d))
then
2386 call gather_data_bc(fileobj, fileobj%restart_vars(i)%data3d, 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))
2394 do i = 1, fileobj%num_restart_vars
2395 if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r8 ))
then
2397 fileobj%restart_vars(i)%bc_info%globaldata2d_r8 , &
2398 unlim_dim_level=unlim_dim_level)
2399 deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r8)
2400 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata2d_r4 ))
then
2402 fileobj%restart_vars(i)%bc_info%globaldata2d_r4 , &
2403 unlim_dim_level=unlim_dim_level)
2404 deallocate(fileobj%restart_vars(i)%bc_info%globaldata2d_r4)
2405 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r8 ))
then
2407 fileobj%restart_vars(i)%bc_info%globaldata3d_r8 , &
2408 unlim_dim_level=unlim_dim_level)
2409 deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r8)
2410 else if (
allocated(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 ))
then
2412 fileobj%restart_vars(i)%bc_info%globaldata3d_r4 , &
2413 unlim_dim_level=unlim_dim_level)
2414 deallocate(fileobj%restart_vars(i)%bc_info%globaldata3d_r4 )
2427 if (fileobj%is_root)
then
2428 err = nf90_sync(fileobj%ncid)
2434 subroutine init(this, offloading_obj_id, offloading_pes, model_pes, domain)
2436 integer,
intent(in) :: offloading_obj_id
2437 integer,
intent(in) :: offloading_pes(:)
2438 integer,
intent(in) :: model_pes(:)
2441 this%id = offloading_obj_id
2442 allocate(this%offloading_pes(
size(offloading_pes)))
2443 this%offloading_pes = offloading_pes
2444 allocate(this%model_pes(
size(model_pes)))
2445 this%model_pes = model_pes
2447 this%is_model_pe = .false.
2448 if (any(model_pes .eq.
mpp_pe())) &
2449 this%is_model_pe = .true.
2450 this%domain_in = domain
2459 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 ...
Range type for a netcdf variable.