diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 3ea201235a..22548218d1 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -7,6 +7,10 @@ module MOM_io_infra use MOM_domain_infra, only : domain2d, domain1d, CENTER, CORNER, NORTH_FACE, EAST_FACE use MOM_error_infra, only : MOM_error=>MOM_err, NOTE, FATAL, WARNING +use MOM_read_data_fms2, only : prepare_to_read_var +use fms2_io_mod, only : fms2_open_file => open_file, fms2_close_file => close_file +use fms2_io_mod, only : FmsNetcdfDomainFile_t, fms2_read_data => read_data, check_if_open + use fms_mod, only : write_version_number, open_namelist_file, check_nml_error use fms_io_mod, only : file_exist, field_exist, field_size, read_data use fms_io_mod, only : fms_io_exit, get_filename_appendix @@ -46,7 +50,7 @@ module MOM_io_infra module procedure MOM_file_exists end interface -!> Open a file (or fileset) for parallel or single-file I/). +!> Open a file (or fileset) for parallel or single-file I/O. interface open_file module procedure open_file_type, open_file_unit end interface open_file @@ -100,6 +104,9 @@ module MOM_io_infra logical :: open_to_write = .false. !< If true, this file or fileset can be written to end type file_type +!> For now, this is hard-coded to exercise the new FMS2 interfaces. +logical :: FMS2_reads = .true. + contains !> Reads the checksum value for a field that was recorded in a file, along with a flag indicating @@ -425,7 +432,31 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom type(MOM_domain_type), & optional, intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition - if (present(MOM_Domain)) then + ! Local variables + type(FmsNetcdfDomainFile_t) :: fileobj ! A handle to a domain-decomposed file object + logical :: has_time_dim ! True if the variable has an unlimited time axis. + character(len=96) :: var_to_read ! Name of variable to read from the netcdf file + logical :: success ! True if the file was successfully opened + + if (present(MOM_Domain) .and. FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, MOM_domain, "MOM_read_data_1d: ", filename, & + var_to_read, has_time_dim, timelevel) + + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + elseif (present(MOM_Domain)) then ! Read the variable using the FMS-1 interface. call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, timelevel=timelevel) else call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) @@ -449,7 +480,31 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom type(MOM_domain_type), & optional, intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition - if (present(MOM_Domain)) then + ! Local variables + type(FmsNetcdfDomainFile_t) :: fileobj ! A handle to a domain-decomposed file object + logical :: has_time_dim ! True if the variable has an unlimited time axis. + character(len=96) :: var_to_read ! Name of variable to read from the netcdf file + logical :: success ! True if the file was successfully opened + + if (present(MOM_Domain) .and. FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, MOM_domain, "MOM_read_data_1d: ", filename, & + var_to_read, has_time_dim, timelevel) + + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + elseif (present(MOM_Domain)) then ! Read the variable using the FMS-1 interface. call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, timelevel=timelevel) else call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) @@ -476,8 +531,34 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied !! by before it is returned. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=position) + ! Local variables + type(FmsNetcdfDomainFile_t) :: fileobj ! A handle to a domain-decomposed file object + logical :: has_time_dim ! True if the variable has an unlimited time axis. + character(len=96) :: var_to_read ! Name of variable to read from the netcdf file + logical :: success ! True if the file was successfully opened + + if (FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, MOM_domain, "MOM_read_data_2d: ", filename, & + var_to_read, has_time_dim, timelevel, position) + + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + else ! Read the variable using the FMS-1 interface. + call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & + timelevel=timelevel, position=position) + endif if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) @@ -506,6 +587,8 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied !! by before it is returned. + ! This subroutine does not have an FMS-2 variant yet. + if (present(MOM_Domain)) then call read_data(filename, fieldname, data, start, nread, domain=MOM_Domain%mpp_domain, & no_domain=no_domain) @@ -539,8 +622,34 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied !! by before it is returned. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=position) + ! Local variables + type(FmsNetcdfDomainFile_t) :: fileobj ! A handle to a domain-decomposed file object + logical :: has_time_dim ! True if the variable has an unlimited time axis. + character(len=96) :: var_to_read ! Name of variable to read from the netcdf file + logical :: success ! True if the file was successfully opened + + if (FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, MOM_domain, "MOM_read_data_3d: ", filename, & + var_to_read, has_time_dim, timelevel, position) + + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + else ! Read the variable using the FMS-1 interface. + call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & + timelevel=timelevel, position=position) + endif if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) @@ -563,8 +672,35 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied !! by before it is returned. - call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=position) + + ! Local variables + type(FmsNetcdfDomainFile_t) :: fileobj ! A handle to a domain-decomposed file object + logical :: has_time_dim ! True if the variable has an unlimited time axis. + character(len=96) :: var_to_read ! Name of variable to read from the netcdf file + logical :: success ! True if the file was successfully opened + + if (FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive variable name in the file and prepare to read it. + call prepare_to_read_var(fileobj, fieldname, MOM_domain, "MOM_read_data_4d: ", filename, & + var_to_read, has_time_dim, timelevel, position) + + ! Read the data. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, var_to_read, data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, var_to_read, data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + else ! Read the variable using the FMS-1 interface. + call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & + timelevel=timelevel, position=position) + endif if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) @@ -615,7 +751,12 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied !! by before they are returned. - integer :: u_pos, v_pos + ! Local variables + type(FmsNetcdfDomainFile_t) :: fileobj ! A handle to a domain-decomposed file object + logical :: has_time_dim ! True if the variables have an unlimited time axis. + character(len=96) :: u_var, v_var ! Name of u and v variables to read from the netcdf file + logical :: success ! True if the file was successfully opened + integer :: u_pos, v_pos ! Flags indicating the positions of the u- and v- components. u_pos = EAST_FACE ; v_pos = NORTH_FACE if (present(stagger)) then @@ -624,10 +765,35 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data elseif (stagger == AGRID) then ; u_pos = CENTER ; v_pos = CENTER ; endif endif - call read_data(filename, u_fieldname, u_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=u_pos) - call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=v_pos) + if (FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. + call prepare_to_read_var(fileobj, u_fieldname, MOM_domain, "MOM_read_vector_2d: ", filename, & + u_var, has_time_dim, timelevel, position=u_pos) + call prepare_to_read_var(fileobj, v_fieldname, MOM_domain, "MOM_read_vector_2d: ", filename, & + v_var, has_time_dim, timelevel, position=v_pos) + + ! Read the u-data and v-data. There would already been an error message for one + ! of the variables if they are inconsistent in having an unlimited dimension. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, u_var, u_data, unlim_dim_level=timelevel) + call fms2_read_data(fileobj, v_var, v_data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, u_var, u_data) + call fms2_read_data(fileobj, v_var, v_data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + else ! Read the variable using the FMS-1 interface. + call read_data(filename, u_fieldname, u_data, MOM_Domain%mpp_domain, & + timelevel=timelevel, position=u_pos) + call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & + timelevel=timelevel, position=v_pos) + endif if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, u_data, scale) @@ -651,11 +817,16 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read. real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied !! by before they are returned. - integer :: u_pos, v_pos + ! Local variables + type(FmsNetcdfDomainFile_t) :: fileobj ! A handle to a domain-decomposed file object + logical :: has_time_dim ! True if the variables have an unlimited time axis. + character(len=96) :: u_var, v_var ! Name of u and v variables to read from the netcdf file + logical :: success ! True if the file was successfully opened + integer :: u_pos, v_pos ! Flags indicating the positions of the u- and v- components. u_pos = EAST_FACE ; v_pos = NORTH_FACE if (present(stagger)) then @@ -664,10 +835,35 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data elseif (stagger == AGRID) then ; u_pos = CENTER ; v_pos = CENTER ; endif endif - call read_data(filename, u_fieldname, u_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=u_pos) - call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & - timelevel=timelevel, position=v_pos) + if (FMS2_reads) then + ! Open the FMS2 file-set. + success = fms2_open_file(fileobj, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) + if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) + + ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. + call prepare_to_read_var(fileobj, u_fieldname, MOM_domain, "MOM_read_vector_3d: ", filename, & + u_var, has_time_dim, timelevel, position=u_pos) + call prepare_to_read_var(fileobj, v_fieldname, MOM_domain, "MOM_read_vector_3d: ", filename, & + v_var, has_time_dim, timelevel, position=v_pos) + + ! Read the u-data and v-data, dangerously assuming either both or neither have time dimensions. + ! There would already been an error message for one of the variables if they are inconsistent. + if (present(timelevel) .and. has_time_dim) then + call fms2_read_data(fileobj, u_var, u_data, unlim_dim_level=timelevel) + call fms2_read_data(fileobj, v_var, v_data, unlim_dim_level=timelevel) + else + call fms2_read_data(fileobj, u_var, u_data) + call fms2_read_data(fileobj, v_var, v_data) + endif + + ! Close the file-set. + if (check_if_open(fileobj)) call fms2_close_file(fileobj) + else ! Read the variable using the FMS-1 interface. + call read_data(filename, u_fieldname, u_data, MOM_Domain%mpp_domain, & + timelevel=timelevel, position=u_pos) + call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & + timelevel=timelevel, position=v_pos) + endif if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, u_data, scale) diff --git a/config_src/infra/FMS2/MOM_read_data_fms2.F90 b/config_src/infra/FMS2/MOM_read_data_fms2.F90 index 72e2d5e1d2..83a10e7e30 100644 --- a/config_src/infra/FMS2/MOM_read_data_fms2.F90 +++ b/config_src/infra/FMS2/MOM_read_data_fms2.F90 @@ -2,316 +2,314 @@ module MOM_read_data_fms2 ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_axis, only : MOM_register_variable_axes -use MOM_error_infra, only : MOM_error=>MOM_err, NOTE, FATAL, WARNING +use MOM_error_infra, only : MOM_error=>MOM_err, NOTE, FATAL, WARNING, is_root_PE use MOM_domain_infra, only : MOM_domain_type, AGRID, BGRID_NE, CGRID_NE use MOM_domain_infra, only : domain2d, CENTER, CORNER, NORTH_FACE, EAST_FACE -use MOM_domain_infra, only : rescale_comp_data use MOM_string_functions, only : lowercase -use fms2_io_mod, only : read_data, attribute_exists => variable_att_exists, variable_exists -use fms2_io_mod, only : register_field, register_variable_attribute, fms2_open_file => open_file -use fms2_io_mod, only : fms2_close_file => close_file, write_data, get_variable_dimension_names -use fms2_io_mod, only : check_if_open, get_dimension_names, get_dimension_size -use fms2_io_mod, only : is_dimension_registered, register_axis, get_variable_size -use fms2_io_mod, only : FmsNetcdfDomainFile_t, FmsNetcdfFile_t, unlimited, get_variable_names -use fms2_io_mod, only : get_variable_num_dimensions, get_variable_units, is_dimension_unlimited -use fms2_io_mod, only : get_num_variables +use fms2_io_mod, only : FmsNetcdfDomainFile_t, FmsNetcdfFile_t +use fms2_io_mod, only : fms2_open_file => open_file, fms2_close_file => close_file +use fms2_io_mod, only : get_num_variables, get_variable_names, check_if_open +use fms2_io_mod, only : read_data, variable_exists, get_variable_size, get_variable_units +use fms2_io_mod, only : get_variable_attribute, attribute_exists => variable_att_exists +use fms2_io_mod, only : get_variable_num_dimensions, get_variable_dimension_names +use fms2_io_mod, only : is_dimension_unlimited, get_dimension_size +use fms2_io_mod, only : is_dimension_registered, register_axis implicit none ; private -public MOM_read_data_scalar, MOM_read_vector_2d_fms2, MOM_read_vector_3d_fms2 -public MOM_read_data_2d_noDD, MOM_read_data_1d_noDD -public MOM_read_data_4d_DD, MOM_read_data_3d_DD, MOM_read_data_2d_DD, MOM_read_data_1d_DD - -! CAUTION: The following variables are saved by default, and are only necessary for consecutive calls to -! MOM_read_data with the same file name. The user should ensure that fms2_close_file on -! the fileobj_read structures are called at every requisite time step at after the last -! variable is written to the file by omitting the optional leave_file_open argument, or setting it to .false. - -!> netCDF domain-decomposed file object returned by call to -!! open_file in MOM_read_data_DD calls -type(FmsNetcdfDomainFile_t), private :: fileobj_read_dd - -!> netCDF domain-decomposed file object returned by call to -!! open_file in MOM_read_data_noDD calls -type(FmsNetcdfFile_t), private :: fileobj_read - -!> Type with variable metadata for a netCDF file opened to read -type var_meta_read_file - integer :: nvars = 0!< number of variables in a netCDF file opened to read domain-decomposed data - character(len=96), allocatable, dimension(:) :: var_names !< array for names of variables in a netCDF - !! file opened to read -end type var_meta_read_file - -!> type to hold metadata for variables in a domain-decomposed file -type (var_meta_read_file), private :: file_var_meta_DD - -!> type to hold metadata for variables in a non-domain-decomposed file -type (var_meta_read_file), private :: file_var_meta_noDD - -! Note the convention for decomposed arrays that: -! edge_lengths(1) = iec - isc + 1 ; edge_lengths(2) = jec - jsc + 1 -! start_index(1) = isc - isg + 1 ; start_index(2) = jsc - jsg + 1 - +public prepare_to_read_var +! public MOM_read_data_scalar, MOM_read_data_2d_noDD, MOM_read_data_1d_noDD contains -!> This routine calls the fms_io read_data subroutine to read 1-D domain-decomposed data field named "fieldname" -!! from file "filename". The routine multiplies the data by "scale" if the optional argument is included in the call. -subroutine MOM_read_data_1d_DD(filename, fieldname, data, domain, start_index, edge_lengths, & - timelevel, scale, leave_file_open) - character(len=*), intent(in) :: filename !< The name of the file to read - character(len=*), intent(in) :: fieldname !< The variable name of the data in the file - real, dimension(:), intent(inout) :: data !< The 1-dimensional data array to pass to read_data - type(MOM_domain_type), intent(in) :: domain !< MOM domain attribute with the mpp_domain decomposition - integer, dimension(1), optional, intent(in) :: start_index !< starting index of data buffer. Default is 1 - integer, dimension(1), optional, intent(in) :: edge_lengths !< number of data values to read in - !! Default is the variable size - integer, optional, intent(in) :: timelevel !< time level to read - real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by - logical, optional, intent(in) :: leave_file_open !< if .true., leave file open +!> Find the case-insensitive name match with a variable in a domain-decomposed file-set +!! opening the file(s) as necessary, prepare FMS2 to read this variable, and return some +!! information needed to call read_data correctly for this variable and file. +subroutine prepare_to_read_var(fileobj, fieldname, domain, err_header, filename, var_to_read, & + has_time_dim, timelevel, position) + type(FmsNetcdfDomainFile_t), intent(inout) :: fileobj !< A handle to an FMS2 file object, that + !! will be opened if necessary + character(len=*), intent(in) :: fieldname !< The variable name to seek in the file + type(MOM_domain_type), intent(in) :: domain !< MOM domain attribute with the mpp_domain decomposition + character(len=*), intent(in) :: err_header !< A descriptive prefix for error messages + character(len=*), intent(in) :: filename !< The name of the file to read + character(len=*), intent(out) :: var_to_read !< The variable name to read from the file + logical, optional, intent(out) :: has_time_dim !< Indicates whether fieldname has a time dimension + integer, optional, intent(in) :: timelevel !< A time level to read + integer, optional, intent(in) :: position !< A flag indicating where this variable is discretized ! Local variables - logical :: close_the_file ! indicates whether to close the file after write_data is called; default is .true. - integer :: time_dim ! The dimension position of a variables unlimited time axis, or -1 if it has none. - integer, parameter :: ndim = 1 ! The dimensionality of the array being read - integer, dimension(ndim) :: start, nread ! indices for first data value and number of values to read - integer :: num_var_dims ! The number of dimensions in the file. - character(len=96) :: var_to_read ! variable to read from the netcdf file + logical :: file_open_success !.true. if call to open_file is successful + logical :: variable_found ! Is a case-insensitive version of the variable found in the netCDF file? + character(len=96), allocatable, dimension(:) :: var_names !< array for names of variables in a netCDF + !! file opened to read character(len=96), allocatable :: dim_names(:) ! variable dimension names - character(len=48) :: err_header ! A preamble for error messages + integer :: nvars ! The number of variables in the file. + integer :: i, dim_unlim_size, num_var_dims, time_dim - err_header = "MOM_read_data_fms2:MOM_read_data_1d_DD: " + ! Open the file if necessary + if (.not.(check_if_open(fileobj))) then + file_open_success = fms2_open_file(fileobj, filename, "read", domain%mpp_domain, is_restart=.false.) + if (.not.file_open_success) call MOM_error(FATAL, trim(err_header)//" failed to open "//trim(filename)) + endif - ! Find the matching variable name in the file, opening it and reading metadata if necessary. - call find_varname_in_DD_file(fileobj_read_dd, file_var_meta_DD, fieldname, domain, err_header, & - filename, var_to_read) + ! Search for the variable in the file, looking for the case-sensitive name first. + if (variable_exists(fileobj, trim(fieldname))) then + var_to_read = trim(fieldname) + variable_found = .true. + else ! Look for case-insensitive variable name matches. + var_to_read = "" + variable_found = .false. + + nvars = get_num_variables(fileobj) + if (nvars < 1) call MOM_error(FATAL, "nvars is less than 1 for file "//trim(filename)) + allocate(var_names(nvars)) + call get_variable_names(fileobj, var_names) + + do i=1,nvars + if (lowercase(trim(var_names(i))) == lowercase(trim(fieldname))) then + variable_found = .true. + var_to_read = trim(var_names(i)) + exit + endif + enddo + if (.not.(variable_found)) & + call MOM_error(FATAL, trim(err_header)//trim(fieldname)//" not found in "//trim(filename)) + deallocate(var_names) + endif - ! Registering the variable axes essentially just specifies the discrete position of this variable. - call MOM_register_variable_axes(fileobj_read_dd, var_to_read) + ! FMS2 can not handle a timelevel argument if the variable does not have one in the file, + ! so some error checking and logic are required. + if (present(has_time_dim) .or. present(timelevel)) then + time_dim = -1 - ! set the start and nread values that will be passed as the read_data corner and edge_lengths arguments - start(:) = 1 ; if (present(start_index)) start(:) = start_index(:) - if (present(edge_lengths)) then - nread(:) = edge_lengths(:) - else - num_var_dims = get_variable_num_dimensions(fileobj_read, trim(var_to_read)) + num_var_dims = get_variable_num_dimensions(fileobj, trim(var_to_read)) allocate(dim_names(num_var_dims)) ; dim_names(:) = "" - call get_variable_dimension_names(fileobj_read, trim(var_to_read), dim_names) - call get_dimension_size(fileobj_read_dd, trim(dim_names(1)), nread(1)) + call get_variable_dimension_names(fileobj, trim(var_to_read), dim_names) + + do i=1,num_var_dims + if (is_dimension_unlimited(fileobj, dim_names(i))) then + time_dim = i + if (present(timelevel)) then + call get_dimension_size(fileobj, dim_names(i), dim_unlim_size) + if ((timelevel > dim_unlim_size) .and. is_root_PE()) call MOM_error(FATAL, & + trim(err_header)//"Attempting to read a time level of "//trim(var_to_read)//& + " that exceeds the size of the time dimension in "//trim(filename)) + endif + exit + endif + enddo deallocate(dim_names) - endif - - time_dim = -1 - if (present(timelevel)) then - time_dim = get_time_dim_num_DD(fileobj_read_dd, var_to_read, err_header, filename, timelevel) - if (time_dim == ndim) then ; nread(ndim) = 1 ; start(ndim) = timelevel ; endif - endif - ! read the data - if (time_dim > 0) then - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread, & - unlim_dim_level=timelevel) - else - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread) + if (present(timelevel) .and. (time_dim < 0) .and. is_root_PE()) & + call MOM_error(WARNING, trim(err_header)//"time level specified, but the variable "//& + trim(var_to_read)//" does not have an unlimited dimension in "//trim(filename)) + if ((.not.present(timelevel)) .and. (time_dim > 0) .and. is_root_PE()) & + call MOM_error(WARNING, trim(err_header)//"The variable "//trim(var_to_read)//& + " has an unlimited dimension in "//trim(filename)//" but no time level is specified.") + if (present(has_time_dim)) has_time_dim = (time_dim > 0) endif - ! Close the file, if necesssary - close_the_file = .true. ; if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - if (close_the_file) call close_file_read_DD(fileobj_read_dd, file_var_meta_DD) - - ! Rescale the data that was read if necessary. - if (present(scale)) then ; if (scale /= 1.0) then - data(:) = scale*data(:) - endif ; endif - -end subroutine MOM_read_data_1d_DD - -!> This routine calls the fms_io read_data subroutine to read 2-D domain-decomposed data field named "fieldname" -!! from file "filename". The routine multiplies the data by "scale" if the optional argument is included in the call. -subroutine MOM_read_data_2d_DD(filename, fieldname, data, domain, start_index, edge_lengths, & - timelevel, position, scale, leave_file_open) - character(len=*), intent(in) :: filename !< The name of the file to read - character(len=*), intent(in) :: fieldname !< The variable name of the data in the file - real, dimension(:,:), intent(inout) :: data !< The 2-dimensional data array to pass to read_data - type(MOM_domain_type), intent(in) :: domain !< MOM domain attribute with the mpp_domain decomposition - integer, dimension(2), optional, intent(in) :: start_index !< starting indices of data buffer. Default is 1 - integer, dimension(2), optional, intent(in) :: edge_lengths !< number of data values to read in. - !! Default values are the variable dimension sizes - integer, optional, intent(in) :: timelevel !< time level to read - integer, optional, intent(in) :: position !< A flag indicating where this data is located - real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by - logical, optional, intent(in) :: leave_file_open !< if .true., leave file open - - ! Local variables - logical :: close_the_file ! indicates whether to close the file after write_data is called; default is .true. - integer :: time_dim ! The dimension position of a variables unlimited time axis, or -1 if it has none. - integer, parameter :: ndim = 2 ! The dimensionality of the array being read - integer, dimension(ndim) :: start, nread ! indices for first data value and number of values to read - character(len=96) :: var_to_read ! variable to read from the netcdf file - character(len=48) :: err_header ! A preamble for error messages - - err_header = "MOM_read_data_fms2:MOM_read_data_2d_DD: " - - ! Find the matching variable name in the file, opening it and reading metadata if necessary. - call find_varname_in_DD_file(fileobj_read_dd, file_var_meta_DD, fieldname, domain, err_header, & - filename, var_to_read) - ! Registering the variable axes essentially just specifies the discrete position of this variable. - call MOM_register_variable_axes(fileobj_read_dd, var_to_read, position) - - ! set the start and nread values that will be passed as the read_data corner and edge_lengths arguments - start(:) = 1 ; if (present(start_index)) start(:) = start_index(:) - nread(:) = shape(data) ; if (present(edge_lengths)) nread(:) = edge_lengths(:) - - time_dim = -1 - if (present(timelevel)) then - time_dim = get_time_dim_num_DD(fileobj_read_dd, var_to_read, err_header, filename, timelevel) - if (time_dim == ndim) then ; nread(ndim) = 1 ; start(ndim) = timelevel ; endif - endif + call MOM_register_variable_axes(fileobj, var_to_read, filename, position) - ! read the data - if (time_dim > 0) then - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread, & - unlim_dim_level=timelevel) - else - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread) - endif - - ! Close the file, if necessary - close_the_file = .true. ; if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - if (close_the_file) call close_file_read_DD(fileobj_read_dd, file_var_meta_DD) - - ! Rescale the data that was read if necessary. - if (present(scale)) then ; if (scale /= 1.0) then - call rescale_comp_data(domain, data, scale) - endif ; endif - -end subroutine MOM_read_data_2d_DD +end subroutine prepare_to_read_var -!> This routine calls the fms_io read_data subroutine to read 3-D domain-decomposed data field named "fieldname" -!! from file "filename". The routine multiplies the data by "scale" if the optional argument is included in the call. -subroutine MOM_read_data_3d_DD(filename, fieldname, data, domain, start_index, edge_lengths, & - timelevel, position, scale, leave_file_open) - character(len=*), intent(in) :: filename !< The name of the file to read - character(len=*), intent(in) :: fieldname !< The variable name of the data in the file - real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional data array to pass to read_data - type(MOM_domain_type), intent(in) :: domain !< MOM domain attribute with the mpp_domain decomposition - integer, dimension(3), optional, intent(in) :: start_index !< starting indices of data buffer. Default is 1 - integer, dimension(3), optional, intent(in) :: edge_lengths !< number of data values to read in. - !! Default values are the variable dimension sizes - integer, optional, intent(in) :: timelevel !< time level to read - integer, optional, intent(in) :: position !< A flag indicating where this data is discretized - real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by - logical, optional, intent(in) :: leave_file_open !< if .true., leave file open +!> register axes associated with a variable from a domain-decomposed netCDF file +!> @note The user must specify units for variables with longitude/x-axis and/or latitude/y-axis axes +!! to obtain the correct domain decomposition for the data buffer. +subroutine MOM_register_variable_axes(fileObj, variableName, filename, position) + type(FmsNetcdfDomainFile_t), intent(inout) :: fileObj !< Handle to an open FMS2 netCDF file object + character(len=*), intent(in) :: variableName !< name of the variable + character(len=*), intent(in) :: filename !< The name of the file to read + integer, optional, intent(in) :: position !< A flag indicating where this data is discretized ! Local variables - logical :: close_the_file ! indicates whether to close the file after write_data is called; default is .true. - integer :: time_dim ! The dimension position of a variables unlimited time axis, or -1 if it has none. - integer, parameter :: ndim = 3 ! The dimensionality of the array being read - integer, dimension(ndim) :: start, nread ! indices for first data value and number of values to read - character(len=96) :: var_to_read ! variable to read from the netcdf file - character(len=48) :: err_header ! A preamble for error messages - - err_header = "MOM_read_data_fms2:MOM_read_data_3d_DD: " - - ! Find the matching variable name in the file, opening it and reading metadata if necessary. - call find_varname_in_DD_file(fileobj_read_dd, file_var_meta_DD, fieldname, domain, err_header, & - filename, var_to_read) - - ! Registering the variable axes essentially just specifies the discrete position of this variable. - call MOM_register_variable_axes(fileobj_read_dd, var_to_read, position) - - ! set the start and nread values that will be passed as the read_data corner and edge_lengths arguments - start(:) = 1 ; if (present(start_index)) start(:) = start_index(:) - nread(:) = shape(data) ; if (present(edge_lengths)) nread(:) = edge_lengths(:) - - time_dim = -1 - if (present(timelevel)) then - time_dim = get_time_dim_num_DD(fileobj_read_dd, var_to_read, err_header, filename, timelevel) - if (time_dim == ndim) then ; nread(ndim) = 1 ; start(ndim) = timelevel ; endif - endif - - ! read the data - if (time_dim > 0) then - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread, & - unlim_dim_level=timelevel) - else - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread) + character(len=40) :: units ! units corresponding to a specific variable dimension + character(len=40), allocatable, dimension(:) :: dim_names ! variable dimension names + integer, allocatable, dimension(:) :: dimSizes ! variable dimension sizes + logical, allocatable, dimension(:) :: is_x ! Is this a (likely domain-decomposed) x-axis + logical, allocatable, dimension(:) :: is_y ! Is this a (likely domain-decomposed) y-axis + logical, allocatable, dimension(:) :: is_t ! Is this a time axis or another unlimited axis + integer :: ndims ! number of dimensions + integer :: i + integer :: xPos, yPos ! domain positions for x and y axes. Default is CENTER + + if (.not. check_if_open(fileObj)) call MOM_error(FATAL,"MOM_axis:register_variable_axes: The fileObj has "// & + "not been opened. Call fms2_open_file(fileObj,...) before "// & + "passing the fileObj argument to this function.") + xPos = CENTER ; yPos = CENTER + if (present(position)) then + if ((position == CORNER) .or. (position == EAST_FACE)) xPos = EAST_FACE + if ((position == CORNER) .or. (position == NORTH_FACE)) yPos = NORTH_FACE endif - ! Close the file, if necessary - close_the_file = .true. ; if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - if (close_the_file) call close_file_read_DD(fileobj_read_dd, file_var_meta_DD) - - ! Rescale the data that was read if necessary. - if (present(scale)) then ; if (scale /= 1.0) then - call rescale_comp_data(domain, data, scale) - endif ; endif - -end subroutine MOM_read_data_3d_DD - -!> This routine calls the fms_io read_data subroutine to read 4-D domain-decomposed data field named "fieldname" -!! from file "filename". The routine multiplies the data by "scale" if the optional argument is included in the call. -subroutine MOM_read_data_4d_DD(filename, fieldname, data, domain, start_index, edge_lengths, & - timelevel, position, scale, leave_file_open) - character(len=*), intent(in) :: filename !< The name of the file to read - character(len=*), intent(in) :: fieldname !< The variable name of the data in the file - real, dimension(:,:,:,:), intent(inout) :: data !< The 4-dimensional data array to pass to read_data - type(MOM_domain_type), intent(in) :: domain !< MOM domain attribute with the mpp_domain decomposition - integer, dimension(4), optional, intent(in) :: start_index !< starting indices of data buffer. Default is 1 - integer, dimension(4), optional, intent(in) :: edge_lengths !< number of data values to read in. - !! Default values are the variable dimension sizes - integer, optional, intent(in) :: timelevel !< time level to read - integer, optional, intent(in) :: position !< A flag indicating where this data is located - real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by - logical, optional, intent(in) :: leave_file_open !< if .true., leave file open - - ! Local variables - logical :: close_the_file ! indicates whether to close the file after write_data is called; default is .true. - integer :: time_dim ! The dimension position of a variables unlimited time axis, or -1 if it has none. - integer, parameter :: ndim = 4 ! The dimensionality of the array being read - integer, dimension(ndim) :: start, nread ! indices for first data value and number of values to read - character(len=96) :: var_to_read ! variable to read from the netcdf file - character(len=48) :: err_header ! A preamble for error messages - - err_header = "MOM_read_data_fms2:MOM_read_data_4d_DD: " + ! get variable dimension names and lengths + ndims = get_variable_num_dimensions(fileObj, trim(variableName)) + allocate(dimSizes(ndims)) + allocate(dim_names(ndims)) + allocate(is_x(ndims)) ; is_x(:) = .false. + allocate(is_y(ndims)) ; is_y(:) = .false. + allocate(is_t(ndims)) ; is_t(:) = .false. + call get_variable_size(fileObj, trim(variableName), dimSizes) + call get_variable_dimension_names(fileObj, trim(variableName), dim_names) + call categorize_axes(fileObj, filename, ndims, dim_names, is_x, is_y, is_t) + + ! register the axes + do i=1,ndims + if ( .not.is_dimension_registered(fileobj, trim(dim_names(i))) ) then + if (is_x(i)) then + call register_axis(fileObj, trim(dim_names(i)), "x", domain_position=xPos) + elseif (is_y(i)) then + call register_axis(fileObj, trim(dim_names(i)), "y", domain_position=yPos) + else + call register_axis(fileObj, trim(dim_names(i)), dimSizes(i)) + endif + endif + enddo - ! Find the matching variable name in the file, opening it and reading metadata if necessary. - call find_varname_in_DD_file(fileobj_read_dd, file_var_meta_DD, fieldname, domain, err_header, & - filename, var_to_read) + deallocate(dimSizes) + deallocate(dim_names) + deallocate(is_x, is_y, is_t) +end subroutine MOM_register_variable_axes + +!> Determine whether a variable's axes are associated with x-, y- or time-dimensions. Other +!! unlimited dimensions are also labeled as time axes for these purposes. +subroutine categorize_axes(fileObj, filename, ndims, dim_names, is_x, is_y, is_t) + type(FmsNetcdfDomainFile_t), intent(in) :: fileObj !< Handle to an open FMS2 netCDF file object + character(len=*), intent(in) :: filename !< The name of the file to read + integer, intent(in) :: ndims !< The number of dimensions associated with a variable + character(len=*), dimension(ndims), intent(in) :: dim_names !< Names of the dimensions associated with a variable + logical, dimension(ndims), intent(out) :: is_x !< Indicates if each dimension a (likely decomposed) x-axis + logical, dimension(ndims), intent(out) :: is_y !< Indicates if each dimension a (likely decomposed) y-axis + logical, dimension(ndims), intent(out) :: is_t !< Indicates if each dimension unlimited (usually time) axis - ! Registering the variable axes essentially just specifies the discrete position of this variable. - call MOM_register_variable_axes(fileobj_read_dd, var_to_read, position) + integer :: i + character(len=256) :: cartesian ! A flag indicating a Cartesian direction - usually a single character. + character(len=512) :: dim_list ! A concatenated list of dimension names. + character(len=40) :: units ! units corresponding to a specific variable dimension + logical :: x_found, y_found ! Indicate whether an x- or y- dimension have been found. - ! set the start and nread values that will be passed as the read_data corner and edge_lengths arguments - start(:) = 1 ; if (present(start_index)) start(:) = start_index(:) - nread(:) = shape(data) ; if (present(edge_lengths)) nread(:) = edge_lengths(:) + x_found = .false. ; y_found = .false. + is_x(:) = .false. ; is_y(:) = .false. + do i=1,ndims + is_t(i) = is_dimension_unlimited(fileObj, trim(dim_names(i))) + ! First look for indicative variable attributes + if (.not.is_t(i)) then + if (variable_exists(fileobj, trim(dim_names(i)))) then + if (attribute_exists(fileobj, trim(dim_names(i)), "cartesian_axis")) then + call get_variable_attribute(fileobj, trim(dim_names(i)), "cartesian_axis", cartesian) + cartesian = adjustl(cartesian) + if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. + if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. + if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. + ! if (is_root_pe() .and. is_x(i)) & + ! call MOM_error(NOTE, "X-dimension determined from cartesian_axis for "//trim(dim_names(i))) + ! if (is_root_pe() .and. is_y(i)) & + ! call MOM_error(NOTE, "Y-dimension determined from cartesian_axis for "//trim(dim_names(i))) + endif + endif + endif + if (is_x(i)) x_found = .true. + if (is_y(i)) y_found = .true. + enddo - time_dim = -1 - if (present(timelevel)) then - time_dim = get_time_dim_num_DD(fileobj_read_dd, var_to_read, err_header, filename, timelevel) - if (time_dim == ndim) then ; nread(ndim) = 1 ; start(ndim) = timelevel ; endif + if (.not.(x_found .and. y_found)) then + ! Next look for hints from axis names for uncharacterized axes + do i=1,ndims ; if (.not.(is_x(i) .or. is_y(i) .or. is_t(i))) then + call categorize_axis_from_name(dim_names(i), is_x(i), is_y(i)) + if (is_x(i)) x_found = .true. + if (is_y(i)) y_found = .true. + endif ; enddo endif - ! read the data - if (time_dim > 0) then - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread, & - unlim_dim_level=timelevel) - else - call read_data(fileobj_read_dd, trim(var_to_read), data, corner=start, edge_lengths=nread) + if (.not.(x_found .and. y_found)) then + ! Look for hints from CF-compliant axis units for uncharacterized axes + do i=1,ndims ; if (.not.(is_x(i) .or. is_y(i) .or. is_t(i))) then + call get_variable_units(fileobj, trim(dim_names(i)), units) + call categorize_axis_from_units(units, is_x(i), is_y(i)) + if (is_x(i)) x_found = .true. + if (is_y(i)) y_found = .true. + endif ; enddo endif - ! Close the file, if necessary - close_the_file = .true. ; if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - if (close_the_file) call close_file_read_DD(fileobj_read_dd, file_var_meta_DD) - - ! Rescale the data that was read if necessary. - if (present(scale)) then ; if (scale /= 1.0) then - call rescale_comp_data(domain, data, scale) - endif ; endif + if (.not.(x_found .and. y_found) .and. (ndims>2) .or. ((ndims==2) .and. .not.is_t(ndims))) then + ! This is a case where one would expect to find x-and y-dimensions, but none have been found. + if (is_root_pe()) then + dim_list = trim(dim_names(1))//", "//trim(dim_names(2)) + do i=3,ndims ; dim_list = trim(dim_list)//", "//trim(dim_names(i)) ; enddo + call MOM_error(WARNING, "categorize_axes: Failed to identify x- and y- axes in the axis list ("//& + trim(dim_list)//") of a variable being read from "//trim(filename)) + endif + endif -end subroutine MOM_read_data_4d_DD +end subroutine categorize_axes + +!> Determine whether an axis is associated with the x- or y-directions based on a comparison of +!! its units with CF-compliant variants of latitude or longitude units. +subroutine categorize_axis_from_units(unit_string, is_x, is_y) + character(len=*), intent(in) :: unit_string !< string of units + logical, intent(out) :: is_x !< Indicates if the axis units are associated with an x-direction axis + logical, intent(out) :: is_y !< Indicates if the axis units are associated with an y-direction axis + + is_x = .false. ; is_y = .false. + select case (lowercase(trim(unit_string))) + case ("degrees_north"); is_y = .true. + case ("degree_north") ; is_y = .true. + case ("degrees_n") ; is_y = .true. + case ("degree_n") ; is_y = .true. + case ("degreen") ; is_y = .true. + case ("degreesn") ; is_y = .true. + case ("degrees_east") ; is_x = .true. + case ("degree_east") ; is_x = .true. + case ("degreese") ; is_x = .true. + case ("degreee") ; is_x = .true. + case ("degree_e") ; is_x = .true. + case ("degrees_e") ; is_x = .true. + case default ; is_x = .false. ; is_y = .false. + end select + +end subroutine categorize_axis_from_units + +!> Tries to determine whether the axis name is commonly associated with an x- or y- axis. This +!! approach is fragile and unreliable, but it a backup to reading a CARTESIAN file attribute. +subroutine categorize_axis_from_name(dimname, is_x, is_y) + character(len=*), intent(in) :: dimname !< A dimension name + logical, intent(out) :: is_x !< Indicates if the axis name is associated with an x-direction axis + logical, intent(out) :: is_y !< Indicates if the axis name is associated with an y-direction axis + + is_x = .false. ; is_y = .false. + select case(trim(lowercase(dimname))) + case ("grid_x_t") ; is_x = .true. + case ("nx") ; is_x = .true. + case ("nxp") ; is_x = .true. + case ("longitude") ; is_x = .true. + case ("long") ; is_x = .true. + case ("lon") ; is_x = .true. + case ("lonh") ; is_x = .true. + case ("lonq") ; is_x = .true. + case ("xh") ; is_x = .true. + case ("xq") ; is_x = .true. + case ("i") ; is_x = .true. + + case ("grid_y_t") ; is_y = .true. + case ("ny") ; is_y = .true. + case ("nyp") ; is_y = .true. + case ("latitude") ; is_y = .true. + case ("lat") ; is_y = .true. + case ("lath") ; is_y = .true. + case ("latq") ; is_y = .true. + case ("yh") ; is_y = .true. + case ("yq") ; is_y = .true. + case ("j") ; is_y = .true. + + case default ; is_x = .false. ; is_y = .false. + end select + +end subroutine categorize_axis_from_name + +!===== Everything below this pertains to reading non-decomposed variables ===! +!===== using FMS2 interfaces will probably be discarded eventually. =========! !!> This routine calls the fms_io read_data subroutine to read a scalar (0-D) field named "fieldname" !! from file "filename". @@ -324,25 +322,26 @@ subroutine MOM_read_data_scalar(filename, fieldname, data, timelevel, scale, lea logical, optional, intent(in) :: leave_file_open !< if .true., leave file open ! Local variables - logical :: close_the_file ! indicates whether to close the file after write_data is called; default is .true. + type(FmsNetcdfFile_t) :: fileobj ! A handle to a simple netCDF file + logical :: close_the_file ! indicates whether to close the file after read_data is called. character(len=96) :: var_to_read ! variable to read from the netcdf file character(len=48) :: err_header ! A preamble for error messages err_header = "MOM_read_data_fms2:MOM_read_data_scalar: " ! Find the matching variable name in the file, opening it and reading metadata if necessary. - call find_varname_in_noDD_file(fileobj_read, file_var_meta_noDD, fieldname, err_header, filename, var_to_read) + call find_varname_in_file(fileobj, fieldname, err_header, filename, var_to_read) ! read the data if (present(timelevel)) then - call read_data(fileobj_read, trim(var_to_read), data, unlim_dim_level=timelevel) + call read_data(fileobj, trim(var_to_read), data, unlim_dim_level=timelevel) else - call read_data(fileobj_read, trim(var_to_read), data) + call read_data(fileobj, trim(var_to_read), data) endif ! Close the file, if necessary close_the_file = .true. ; if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - if (close_the_file) call close_file_read_noDD(fileobj_read, file_var_meta_noDD) + if (close_the_file .and. check_if_open(fileobj)) call fms2_close_file(fileobj) ! Rescale the data that was read if necessary. if (present(scale)) then ; if (scale /= 1.0) then @@ -366,7 +365,8 @@ subroutine MOM_read_data_1d_noDD(filename, fieldname, data, start_index, & logical, optional, intent(in) :: leave_file_open !< if .true., leave file open ! Local variables - logical :: close_the_file ! indicates whether to close the file after write_data is called; default is .true. + type(FmsNetcdfFile_t) :: fileobj ! A handle to a simple netCDF file + logical :: close_the_file ! indicates whether to close the file after read_data is called. integer :: time_dim ! The dimension position of a variables unlimited time axis, or -1 if it has none. integer, parameter :: ndim = 1 ! The dimensionality of the array being read integer, dimension(ndim) :: start, nread ! indices for first data value and number of values to read @@ -375,8 +375,8 @@ subroutine MOM_read_data_1d_noDD(filename, fieldname, data, start_index, & err_header = "MOM_read_data_fms2:MOM_read_data_1d_noDD: " - ! Find the matching variable name in the file, opening it and reading metadata if necessary. - call find_varname_in_noDD_file(fileobj_read, file_var_meta_noDD, fieldname, err_header, filename, var_to_read) + ! Find the matching case-insensitive variable name in the file, opening the file if necessary. + call find_varname_in_file(fileobj, fieldname, err_header, filename, var_to_read) ! set the start and nread values that will be passed as the read_data corner and edge_lengths arguments start(:) = 1 ; if (present(start_index)) start(:) = start_index(:) @@ -384,21 +384,21 @@ subroutine MOM_read_data_1d_noDD(filename, fieldname, data, start_index, & time_dim = -1 if (present(timelevel)) then - time_dim = get_time_dim_num_noDD(fileobj_read, var_to_read, err_header, filename, timelevel) + time_dim = get_time_dim(fileobj, var_to_read, err_header, filename, timelevel) if (time_dim == ndim) then ; nread(ndim) = 1 ; start(ndim) = timelevel ; endif endif ! read the data if (time_dim > 0) then - call read_data(fileobj_read, trim(var_to_read), data, corner=start, edge_lengths=nread, & + call read_data(fileobj, trim(var_to_read), data, corner=start, edge_lengths=nread, & unlim_dim_level=timelevel) else - call read_data(fileobj_read, trim(var_to_read), data, corner=start, edge_lengths=nread) + call read_data(fileobj, trim(var_to_read), data, corner=start, edge_lengths=nread) endif ! Close the file, if necessary close_the_file = .true. ; if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - if (close_the_file) call close_file_read_noDD(fileobj_read, file_var_meta_noDD) + if (close_the_file .and. check_if_open(fileobj)) call fms2_close_file(fileobj) ! Rescale the data that was read if necessary. if (present(scale)) then ; if (scale /= 1.0) then @@ -423,7 +423,8 @@ subroutine MOM_read_data_2d_noDD(filename, fieldname, data, start_index, & logical, optional, intent(in) :: leave_file_open !< if .true., leave file open ! Local variables - logical :: close_the_file ! indicates whether to close the file after write_data is called; default is .true. + type(FmsNetcdfFile_t) :: fileobj ! A handle to a simple netCDF file + logical :: close_the_file ! indicates whether to close the file after read_data is called. integer :: time_dim ! The dimension position of a variables unlimited time axis, or -1 if it has none. integer, parameter :: ndim = 2 ! The dimensionality of the array being read integer, dimension(ndim) :: start, nread ! indices for first data value and number of values to read @@ -432,11 +433,8 @@ subroutine MOM_read_data_2d_noDD(filename, fieldname, data, start_index, & err_header = "MOM_read_data_fms2:MOM_read_data_2d_DD: " - ! Find the matching variable name in the file, opening it and reading metadata if necessary. - call find_varname_in_noDD_file(fileobj_read, file_var_meta_noDD, fieldname, err_header, filename, var_to_read) - -! ! Registering the variable axes essentially just specifies the discrete position of this variable. -! call MOM_register_variable_axes(fileobj_read, var_to_read, position) + ! Find the matching case-insensitive variable name in the file, opening the file if necessary. + call find_varname_in_file(fileobj, fieldname, err_header, filename, var_to_read) ! set the start and nread values that will be passed as the read_data corner and edge_lengths arguments start(:) = 1 ; if (present(start_index)) start(:) = start_index(:) @@ -444,21 +442,21 @@ subroutine MOM_read_data_2d_noDD(filename, fieldname, data, start_index, & time_dim = -1 if (present(timelevel)) then - time_dim = get_time_dim_num_noDD(fileobj_read, var_to_read, err_header, filename, timelevel) + time_dim = get_time_dim(fileobj, var_to_read, err_header, filename, timelevel) if (time_dim == ndim) then ; nread(ndim) = 1 ; start(ndim) = timelevel ; endif endif ! read the data if (time_dim > 0) then - call read_data(fileobj_read, trim(var_to_read), data, corner=start, edge_lengths=nread, & + call read_data(fileobj, trim(var_to_read), data, corner=start, edge_lengths=nread, & unlim_dim_level=timelevel) else - call read_data(fileobj_read, trim(var_to_read), data, corner=start, edge_lengths=nread) + call read_data(fileobj, trim(var_to_read), data, corner=start, edge_lengths=nread) endif ! Close the file, if necessary close_the_file = .true. ; if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - if (close_the_file) call close_file_read_noDD(fileobj_read, file_var_meta_noDD) + if (close_the_file .and. check_if_open(fileobj)) call fms2_close_file(fileobj) ! Rescale the data that was read if necessary. if (present(scale)) then ; if (scale /= 1.0) then @@ -467,265 +465,12 @@ subroutine MOM_read_data_2d_noDD(filename, fieldname, data, start_index, & end subroutine MOM_read_data_2d_noDD -!> This routine uses the fms2_io read_data interface to read a pair of distributed -!! 2-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for -!! "stagger" include CGRID_NE, BGRID_NE, and AGRID. -subroutine MOM_read_vector_2d_fms2(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scale, leave_file_open) - character(len=*), intent(in) :: filename !< name of the netcdf file to read - character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file - character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file - real, dimension(:,:), intent(inout) :: u_data !< The 2 dimensional array into which the - !! u-component of the data should be read - real, dimension(:,:), intent(inout) :: v_data !< The 2 dimensional array into which the - !! v-component of the data should be read - type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition - integer, optional, intent(in) :: timelevel !< The time level in the file to read - integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied - !! by before they are returned. - logical, optional, intent(in) :: leave_file_open !< if .true., leave file open - ! local - integer :: is, ie, js, je, i, ndims, dim_unlim_index - integer :: u_pos, v_pos - integer, allocatable :: dim_sizes_u(:), dim_sizes_v(:) - character(len=32), allocatable :: dim_names_u(:), dim_names_v(:), units_u(:), units_v(:) - character(len=1) :: x_or_y ! orientation of cartesian coordinate axis - logical :: is_valid - logical :: file_open_success ! .true. if open file is successful - logical :: close_the_file ! indicates whether to close the file after MOM_read_vector is called; default is .true. - - close_the_file = .true. - if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - - ! open the file - if (.not.(check_if_open(fileobj_read_dd))) & - file_open_success = fms2_open_file(fileobj_read_dd, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) - if (.not. file_open_success) call MOM_error(FATAL, "MOM_read_vector_2d_fms2: netcdf file "//& - trim(filename)//" not opened.") - - u_pos = EAST_FACE ; v_pos = NORTH_FACE - if (present(stagger)) then - if (stagger == CGRID_NE .or. stagger == BGRID_NE ) then ; u_pos = EAST_FACE ; v_pos = NORTH_FACE - elseif (stagger == AGRID) then ; u_pos = CENTER ; v_pos = CENTER ; endif - endif - - ndims = get_variable_num_dimensions(fileobj_read_dd, u_fieldname) - allocate(dim_sizes_u(ndims)) - allocate(dim_sizes_v(ndims)) - allocate(dim_names_u(ndims)) - allocate(dim_names_v(ndims)) - allocate(units_u(ndims)) - allocate(units_v(ndims)) - - units_u(:) = "" - units_v(:) = "" - dim_names_u(:) = "" - dim_names_v(:) = "" - dim_sizes_u(:) = 0 - dim_sizes_v(:) = 0 - - call get_variable_size(fileobj_read_dd, u_fieldname, dim_sizes_u) - call get_variable_size(fileobj_read_dd, v_fieldname, dim_sizes_v) - call get_variable_dimension_names(fileobj_read_dd, u_fieldname, dim_names_u) - call get_variable_dimension_names(fileobj_read_dd, v_fieldname, dim_names_v) - do i=1,ndims - ! register the u axes - if (.not.(is_dimension_registered(fileobj_read_dd, dim_names_u(i)))) then - call get_variable_units(fileobj_read_dd, dim_names_u(i), units_u(i)) - call validate_lat_lon_units(units_u(i), x_or_y, is_valid) - if (is_valid) then - call register_axis(fileobj_read_dd, dim_names_u(i), x_or_y, domain_position=u_pos) - else - call register_axis(fileobj_read_dd, dim_names_u(i), dim_sizes_u(i)) - endif - endif - ! Register the v axes if they differ from the u axes - if (trim(lowercase(dim_names_v(i))) .ne. trim(lowercase(dim_names_u(i)))) then - if (.not.(is_dimension_registered(fileobj_read_dd, dim_names_v(i)))) then - call get_variable_units(fileobj_read_dd, dim_names_v(i), units_v(i)) - call validate_lat_lon_units(units_v(i), x_or_y, is_valid) - if (is_valid) then - call register_axis(fileobj_read_dd, dim_names_v(i), x_or_y, domain_position=v_pos) - else - call register_axis(fileobj_read_dd, dim_names_v(i), dim_sizes_v(i)) - endif - endif - endif - enddo - ! read the data - dim_unlim_index = 0 - if (present(timelevel)) then - do i=1,ndims - if (is_dimension_unlimited(fileobj_read_dd, dim_names_u(i))) then - dim_unlim_index = i - exit - endif - enddo - if (dim_unlim_index .gt. 0) then - call read_data(fileobj_read_dd, u_fieldname,u_data, unlim_dim_level=timelevel) - call read_data(fileobj_read_dd, v_fieldname, v_data, unlim_dim_level=timelevel) - else - call read_data(fileobj_read_dd, u_fieldname, u_data) - call read_data(fileobj_read_dd, v_fieldname, v_data) - endif - else - call read_data(fileobj_read_dd, u_fieldname, u_data) - call read_data(fileobj_read_dd, v_fieldname, v_data) - endif - ! close the file - if (close_the_file) then - if (check_if_open(fileobj_read_dd)) call fms2_close_file(fileobj_read_dd) - endif - if (allocated(dim_names_u)) deallocate(dim_names_u) - if (allocated(dim_names_v)) deallocate(dim_names_v) - if (allocated(dim_sizes_u)) deallocate(dim_sizes_u) - if (allocated(dim_sizes_v)) deallocate(dim_sizes_v) - if (allocated(units_u)) deallocate(units_u) - if (allocated(units_v)) deallocate(units_v) - - ! Rescale the data that was read if necessary. - if (present(scale)) then ; if (scale /= 1.0) then - call rescale_comp_data(MOM_Domain, u_data, scale) - call rescale_comp_data(MOM_Domain, v_data, scale) - endif ; endif - -end subroutine MOM_read_vector_2d_fms2 - -!> This routine uses the fms2_io read_data interface to read a pair of distributed -!! 3-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for -!! "stagger" include CGRID_NE, BGRID_NE, and AGRID. -subroutine MOM_read_vector_3d_fms2(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scale, leave_file_open) - character(len=*), intent(in) :: filename !< name of the netcdf file to read - character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file - character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file - real, dimension(:,:,:), intent(inout) :: u_data !< The 3 dimensional array into which the - !! u-component of the data should be read - real, dimension(:,:,:), intent(inout) :: v_data !< The 3 dimensional array into which the - !! v-component of the data should be read - type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition - integer, optional, intent(in) :: timelevel !< The time level in the file to read - integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied - !! by before they are returned. - logical, optional, intent(in) :: leave_file_open !< if .true., leave file open - ! local - integer :: is, ie, js, je, i, dim_unlim, ndims - integer :: u_pos, v_pos - integer, allocatable :: dim_sizes_u(:), dim_sizes_v(:) - character(len=32), allocatable :: dim_names_u(:), dim_names_v(:), units_u(:), units_v(:) - character(len=1) :: x_or_y - logical :: is_valid - logical :: file_open_success ! .true. if open file is successful - logical :: close_the_file ! indicates whether to close the file after MOM_read_vector is called; default is .true. - - close_the_file = .true. - if (present(leave_file_open)) close_the_file = .not.(leave_file_open) - - ! open the file - if (.not.(check_if_open(fileobj_read_dd))) then - file_open_success = fms2_open_file(fileobj_read_dd, filename, "read", MOM_domain%mpp_domain, is_restart=.false.) - if (.not. file_open_success) & - call MOM_error(FATAL, "MOM_read_vector_3d_fms2: netcdf file "//trim(filename)//" not opened.") - endif - - u_pos = EAST_FACE ; v_pos = NORTH_FACE - if (present(stagger)) then - if (stagger == CGRID_NE) then ; u_pos = EAST_FACE ; v_pos = NORTH_FACE - elseif (stagger == BGRID_NE) then ; u_pos = CORNER ; v_pos = CORNER - elseif (stagger == AGRID) then ; u_pos = CENTER ; v_pos = CENTER ; endif - endif - - ndims = get_variable_num_dimensions(fileobj_read_dd, u_fieldname) - allocate(dim_sizes_u(ndims)) - allocate(dim_sizes_v(ndims)) - allocate(dim_names_u(ndims)) - allocate(dim_names_v(ndims)) - allocate(units_u(ndims)) - allocate(units_v(ndims)) - - units_u(:) = "" - units_v(:) = "" - dim_names_u(:) = "" - dim_names_v(:) = "" - - call get_variable_size(fileobj_read_dd, u_fieldname, dim_sizes_u, broadcast=.true.) - call get_variable_size(fileobj_read_dd, v_fieldname, dim_sizes_v, broadcast=.true.) - call get_variable_dimension_names(fileobj_read_dd, u_fieldname, dim_names_u, broadcast=.true.) - call get_variable_dimension_names(fileobj_read_dd, v_fieldname, dim_names_v, broadcast=.true.) - - do i=1,ndims - ! register the u axes - if (.not.(is_dimension_registered(fileobj_read_dd, dim_names_u(i)))) then - call get_variable_units(fileobj_read_dd, dim_names_u(i), units_u(i)) - call validate_lat_lon_units(units_u(i), x_or_y, is_valid) - if (is_valid) then - call register_axis(fileobj_read_dd, dim_names_u(i), x_or_y, domain_position=u_pos) - else - call register_axis(fileobj_read_dd, dim_names_u(i), dim_sizes_u(i)) - endif - endif - ! Register the v axes if they differ from the u axes - if (trim(lowercase(dim_names_v(i))) .ne. trim(lowercase(dim_names_u(i)))) then - if (.not.(is_dimension_registered(fileobj_read_dd, dim_names_v(i)))) then - call get_variable_units(fileobj_read_dd, dim_names_v(i), units_v(i)) - call validate_lat_lon_units(units_v(i), x_or_y, is_valid) - if (is_valid) then - call register_axis(fileobj_read_dd, dim_names_v(i), x_or_y, domain_position=v_pos) - else - call register_axis(fileobj_read_dd, dim_names_v(i), dim_sizes_v(i)) - endif - endif - endif - enddo - ! read the data - dim_unlim = 0 - if (present(timelevel)) then - do i=1,ndims - if (is_dimension_unlimited(fileobj_read_dd, dim_names_u(i))) then - dim_unlim = i - exit - endif - enddo - if (dim_unlim .gt. 0) then - call read_data(fileobj_read_dd, u_fieldname, u_data, unlim_dim_level=timelevel) - call read_data(fileobj_read_dd, v_fieldname, v_data, unlim_dim_level=timelevel) - else - call read_data(fileobj_read_dd, u_fieldname, u_data, edge_lengths=dim_sizes_u) - call read_data(fileobj_read_dd, v_fieldname, v_data, edge_lengths=dim_sizes_v) - endif - else - call read_data(fileobj_read_dd, u_fieldname, u_data, edge_lengths=dim_sizes_u) - call read_data(fileobj_read_dd, v_fieldname, v_data, edge_lengths=dim_sizes_v) - endif - ! close the file - if (close_the_file) then - if (check_if_open(fileobj_read_dd)) call fms2_close_file(fileobj_read_dd) - endif - if (allocated(dim_names_u)) deallocate(dim_names_u) - if (allocated(dim_names_v)) deallocate(dim_names_v) - if (allocated(dim_sizes_u)) deallocate(dim_sizes_u) - if (allocated(dim_sizes_v)) deallocate(dim_sizes_v) - if (allocated(units_u)) deallocate(units_u) - if (allocated(units_v)) deallocate(units_v) - - ! Rescale the data that was read if necessary. - if (present(scale)) then ; if (scale /= 1.0) then - call rescale_comp_data(MOM_Domain, u_data, scale) - call rescale_comp_data(MOM_Domain, v_data, scale) - endif ; endif - -end subroutine MOM_read_vector_3d_fms2 - -!> Find the case-sensitive name of the variable in a domain-decomposed file-set with a case-insensitive name match. -subroutine find_varname_in_DD_file(fileobj_read, file_meta, fieldname, domain, err_header, filename, var_to_read) - type(FmsNetcdfDomainFile_t), intent(inout) :: fileobj_read !< A handle to a file object, that +!> Find the case-sensitive name of the variable in a netCDF file with a case-insensitive name match. +subroutine find_varname_in_file(fileobj, fieldname, err_header, filename, var_to_read) + type(FmsNetcdfFile_t), intent(inout) :: fileobj !< A handle to a file object, that !! will be opened if necessary - type(var_meta_read_file), intent(inout) :: file_meta !< A type with metadata about variables in a file. character(len=*), intent(in) :: fieldname !< The variable name to seek in the file - type(MOM_domain_type), intent(in) :: domain !< MOM domain attribute with the mpp_domain decomposition character(len=*), intent(in) :: err_header !< A descriptive prefix for error messages character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(out) :: var_to_read !< The variable name to read from the file @@ -733,136 +478,47 @@ subroutine find_varname_in_DD_file(fileobj_read, file_meta, fieldname, domain, e ! Local variables logical :: file_open_success !.true. if call to open_file is successful logical :: variable_found ! Is a case-insensitive version of the variable found in the netCDF file? + character(len=96), allocatable, dimension(:) :: var_names !< array for names of variables in a netCDF + !! file opened to read + integer :: nvars ! The number of variables in the file. integer :: i - ! Open the file if necessary - if (.not.(check_if_open(fileobj_read))) then - file_open_success = fms2_open_file(fileobj_read, filename, "read", domain%mpp_domain, is_restart=.false.) - file_meta%nvars = get_num_variables(fileobj_read) - if (file_meta%nvars < 1) call MOM_error(FATAL, "nvars is less than 1 for file "//trim(filename)) - if (.not.(allocated(file_meta%var_names))) allocate(file_meta%var_names(file_meta%nvars)) - call get_variable_names(fileobj_read, file_meta%var_names) - endif - - ! search for the variable in the file var_to_read = "" - variable_found = .false. - do i=1,file_meta%nvars - if (lowercase(trim(file_meta%var_names(i))) == lowercase(trim(fieldname))) then - variable_found = .true. - var_to_read = trim(file_meta%var_names(i)) - exit - endif - enddo - if (.not.(variable_found)) & - call MOM_error(FATAL, trim(err_header)//trim(fieldname)//" not found in "//trim(filename)) - -end subroutine find_varname_in_DD_file - -!> Find the case-sensitive name of the variable in a domain-decomposed file-set with a case-insensitive name match. -subroutine find_varname_in_noDD_file(fileobj_read, file_meta, fieldname, err_header, filename, var_to_read) - type(FmsNetcdfFile_t), intent(inout) :: fileobj_read !< A handle to a file object, that - !! will be opened if necessary - type(var_meta_read_file), intent(inout) :: file_meta !< A type with metadata about variables in a file. - character(len=*), intent(in) :: fieldname !< The variable name to seek in the file - character(len=*), intent(in) :: err_header !< A descriptive prefix for error messages - character(len=*), intent(in) :: filename !< The name of the file to read - character(len=*), intent(out) :: var_to_read !< The variable name to read from the file - - ! Local variables - logical :: file_open_success !.true. if call to open_file is successful - logical :: variable_found ! Is a case-insensitive version of the variable found in the netCDF file? - integer :: i ! Open the file if necessary - if (.not.(check_if_open(fileobj_read))) then - file_open_success = fms2_open_file(fileobj_read, filename, "read", is_restart=.false.) - file_meta%nvars = get_num_variables(fileobj_read) - if (file_meta%nvars < 1) call MOM_error(FATAL, "nvars is less than 1 for file "//trim(filename)) - if (.not.(allocated(file_meta%var_names))) allocate(file_meta%var_names(file_meta%nvars)) - call get_variable_names(fileobj_read, file_meta%var_names) + if (.not.(check_if_open(fileobj))) then + file_open_success = fms2_open_file(fileobj, filename, "read", is_restart=.false.) + if (.not.file_open_success) call MOM_error(FATAL, trim(err_header)//" failed to open "//trim(filename)) endif - ! search for the variable in the file - var_to_read = "" - variable_found = .false. - do i=1,file_meta%nvars - if (lowercase(trim(file_meta%var_names(i))) == lowercase(trim(fieldname))) then - variable_found = .true. - var_to_read = trim(file_meta%var_names(i)) - exit - endif - enddo - if (.not.(variable_found)) & - call MOM_error(FATAL, trim(err_header)//trim(fieldname)//" not found in "//trim(filename)) - -end subroutine find_varname_in_noDD_file - - -!> Close a file that had been open for domain-decomposed reading based on its handle. -subroutine close_file_read_DD(fileobj_read, file_meta) - type(FmsNetcdfDomainFile_t), intent(inout) :: fileobj_read !< A handle to a file object that will be closed - type(var_meta_read_file), intent(inout) :: file_meta !< A type with metadata about variables - !! in a file opened to read. - - if (check_if_open(fileobj_read)) call fms2_close_file(fileobj_read) - if (allocated(file_meta%var_names)) deallocate(file_meta%var_names) - file_meta%nvars = 0 -end subroutine close_file_read_DD - -!> Close a file that had been open for non-domain-decomposed reading based on its handle. -subroutine close_file_read_noDD(fileobj_read, file_meta) - type(FmsNetcdfFile_t), intent(inout) :: fileobj_read !< A handle to a file object that will be closed - type(var_meta_read_file), intent(inout) :: file_meta !< A type with metadata about variables - !! in a file opened to read. - - if (check_if_open(fileobj_read)) call fms2_close_file(fileobj_read) - if (allocated(file_meta%var_names)) deallocate(file_meta%var_names) - file_meta%nvars = 0 -end subroutine close_file_read_noDD - - -!> Return the number of the time dimesion for a variable in an open domain-decomposed file set, -!! or -1 if it has no time (or other unlimited) dimension. -integer function get_time_dim_num_DD(fileobj_read, var_to_read, err_header, filename, timelevel) - type(FmsNetcdfDomainFile_t), intent(in) :: fileobj_read !< A handle to an open file object - character(len=*), intent(in) :: var_to_read !< The variable name to read from the file - character(len=*), intent(in) :: err_header !< A descriptive prefix for error messages - character(len=*), intent(in) :: filename !< The name of the file to read - integer, optional, intent(in) :: timelevel !< A time level to read - - ! Local variables - integer :: i, dim_unlim_size, num_var_dims - character(len=96), allocatable :: dim_names(:) ! variable dimension names - - num_var_dims = get_variable_num_dimensions(fileobj_read, trim(var_to_read)) - allocate(dim_names(num_var_dims)) ; dim_names(:) = "" - call get_variable_dimension_names(fileobj_read, trim(var_to_read), dim_names) - - get_time_dim_num_DD = -1 - do i=1,num_var_dims - if (is_dimension_unlimited(fileobj_read, dim_names(i))) then - get_time_dim_num_DD = i - if (present(timelevel)) then - call get_dimension_size(fileobj_read, dim_names(i), dim_unlim_size) - if (timelevel > dim_unlim_size) call MOM_error(FATAL, trim(err_header)//& - "Attempting to read a time level of "//trim(var_to_read)//& - " that exceeds the size of "//trim(filename)) + if (variable_exists(fileobj, fieldname)) then + var_to_read = fieldname + else + variable_found = .false. + nvars = get_num_variables(fileobj) + if (nvars < 1) call MOM_error(FATAL, "nvars is less than 1 for file "//trim(filename)) + allocate(var_names(nvars)) + call get_variable_names(fileobj, var_names) + + ! search for the variable in the file + do i=1,nvars + if (lowercase(trim(var_names(i))) == lowercase(trim(fieldname))) then + variable_found = .true. + var_to_read = trim(var_names(i)) + exit endif - exit - endif - enddo - if (get_time_dim_num_DD < 0) & - call MOM_error(WARNING, trim(err_header)//"time level specified, but the variable "//& - trim(var_to_read)//" does not have an unlimited dimension in "//trim(filename)) - deallocate(dim_names) + enddo + if (.not.(variable_found)) & + call MOM_error(FATAL, trim(err_header)//trim(fieldname)//" not found in "//trim(filename)) + deallocate(var_names) + endif -end function get_time_dim_num_DD +end subroutine find_varname_in_file -!> Return the number of the time dimesion for a variable in an open non-domain-decomposed file, +!> Return the number of the time dimension for a variable in an open non-domain-decomposed file, !! or -1 if it has no time (or other unlimited) dimension. -integer function get_time_dim_num_noDD(fileobj_read, var_to_read, err_header, filename, timelevel) - type(FmsNetcdfFile_t), intent(in) :: fileobj_read !< A handle to an open file object +integer function get_time_dim(fileobj, var_to_read, err_header, filename, timelevel) + type(FmsNetcdfFile_t), intent(in) :: fileobj !< A handle to an open file object character(len=*), intent(in) :: var_to_read !< The variable name to read from the file character(len=*), intent(in) :: err_header !< A descriptive prefix for error messages character(len=*), intent(in) :: filename !< The name of the file to read @@ -872,16 +528,16 @@ integer function get_time_dim_num_noDD(fileobj_read, var_to_read, err_header, fi integer :: i, dim_unlim_size, num_var_dims character(len=96), allocatable :: dim_names(:) ! variable dimension names - num_var_dims = get_variable_num_dimensions(fileobj_read, trim(var_to_read)) + num_var_dims = get_variable_num_dimensions(fileobj, trim(var_to_read)) allocate(dim_names(num_var_dims)) ; dim_names(:) = "" - call get_variable_dimension_names(fileobj_read, trim(var_to_read), dim_names) + call get_variable_dimension_names(fileobj, trim(var_to_read), dim_names) - get_time_dim_num_noDD = -1 + get_time_dim = -1 do i=1,num_var_dims - if (is_dimension_unlimited(fileobj_read, dim_names(i))) then - get_time_dim_num_noDD = i + if (is_dimension_unlimited(fileobj, dim_names(i))) then + get_time_dim = i if (present(timelevel)) then - call get_dimension_size(fileobj_read, dim_names(i), dim_unlim_size) + call get_dimension_size(fileobj, dim_names(i), dim_unlim_size) if (timelevel > dim_unlim_size) call MOM_error(FATAL, trim(err_header)//& "Attempting to read a time level of "//trim(var_to_read)//& " that exceeds the size of "//trim(filename)) @@ -889,36 +545,11 @@ integer function get_time_dim_num_noDD(fileobj_read, var_to_read, err_header, fi exit endif enddo - if (get_time_dim_num_noDD < 0) & + if (get_time_dim < 0) & call MOM_error(WARNING, trim(err_header)//"time level specified, but the variable "//& trim(var_to_read)//" does not have an unlimited dimension in "//trim(filename)) deallocate(dim_names) -end function get_time_dim_num_noDD - -!> check that latitude or longitude units are valid CF-compliant values -!! return true or false and x_or_y character value corresponding to the axis direction -subroutine validate_lat_lon_units(unit_string, x_or_y, units_are_valid) -character(len=*), intent(in) :: unit_string !< string of units -character(len=1), intent(out) :: x_or_y !< "x" for longitude or "y" latitude -logical, intent(out) :: units_are_valid !< .true. if units match acceptable values; default is .false. - -select case (lowercase(trim(unit_string))) - case ("degrees_north"); units_are_valid = .true.; x_or_y = "y" - case ("degree_north"); units_are_valid = .true.; x_or_y = "y" - case ("degrees_n"); units_are_valid = .true.; x_or_y = "y" - case ("degree_n"); units_are_valid = .true.; x_or_y = "y" - case ("degreen"); units_are_valid = .true.; x_or_y = "y" - case ("degreesn"); units_are_valid = .true.; x_or_y = "y" - case ("degrees_east"); units_are_valid = .true.; x_or_y = "x" - case ("degree_east"); units_are_valid = .true.;x_or_y = "x" - case ("degreese"); units_are_valid = .true.; x_or_y = "x" - case ("degreee"); units_are_valid = .true.; x_or_y = "x" - case ("degree_e"); units_are_valid = .true.; x_or_y = "x" - case ("degrees_e"); units_are_valid = .true.; x_or_y = "x" - case default; units_are_valid = .false.; x_or_y = "" -end select - -end subroutine validate_lat_lon_units +end function get_time_dim end module MOM_read_data_fms2