From 03b997b889102abaa98595c43603334bb4a5722b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Apr 2021 18:03:09 -0400 Subject: [PATCH] +Enhanced support for novel axes in MOM_io Added support for new IO capabilities that are needed by SIS2 to use the MOM6 framework and infrastructure code, but should also be useful within MOM6 itself. These new capabilities include writing global attributes to files, using create_file named axes that are not derived from a MOM6 grid type, and new options and elements in the vardesc type to support a wider array of axes and to provide the position of the grid staggering via an integer position variable instead of the short character strings that had been used. As a part of this commit, there are the new opaques type axis_info and attribute_info, and the new routines set_axis_info, delete_axis_info, set_attribute_info and delete_attribute_info to facilitate these new capabilities, as well as the publicly visible function position_from_horgrid to translate the vardesc%hor_grid character strings into the integer position flag used elsewhere in the MOM6 and FMS codes. Within the MOM_io_infra, there is a new variant of the overloaded interface write_meta to handle writing global attributes. There are also two new optional arguments to create_file and reopen_file, and two new optional arguments to var_desc, modify_vardesc, and query_vardesc. All answers and output are bitwise identical. --- config_src/infra/FMS1/MOM_io_infra.F90 | 11 +- config_src/infra/FMS2/MOM_io_infra.F90 | 20 +- src/framework/MOM_io.F90 | 409 ++++++++++++++++++++----- 3 files changed, 366 insertions(+), 74 deletions(-) diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index 0d4cc0deb5..14e0732c8a 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -78,7 +78,7 @@ module MOM_io_infra !> Write metadata about a variable or axis to a file and store it for later reuse interface write_metadata - module procedure write_metadata_axis, write_metadata_field + module procedure write_metadata_axis, write_metadata_field, write_metadata_global end interface write_metadata !> Close a file (or fileset). If the file handle does not point to an open file, @@ -793,4 +793,13 @@ subroutine write_metadata_field(IO_handle, field, axes, name, units, longname, & end subroutine write_metadata_field +!> Write a global text attribute to a file. +subroutine write_metadata_global(IO_handle, name, attribute) + type(file_type), intent(in) :: IO_handle !< Handle for a file that is open for writing + character(len=*), intent(in) :: name !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute !< The value of this attribute + + call mpp_write_meta(IO_handle%unit, name, cval=attribute) +end subroutine write_metadata_global + end module MOM_io_infra diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index df9d6dc7ca..4833c37e3a 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -12,7 +12,7 @@ module MOM_io_infra use fms2_io_mod, only : FmsNetcdfDomainFile_t, FmsNetcdfFile_t, fms2_read_data => read_data use fms2_io_mod, only : get_unlimited_dimension_name, get_num_dimensions, get_num_variables use fms2_io_mod, only : get_variable_names, variable_exists, get_variable_size, get_variable_units -use fms2_io_mod, only : register_field, write_data, register_variable_attribute +use fms2_io_mod, only : register_field, write_data, register_variable_attribute, register_global_attribute use fms2_io_mod, only : variable_att_exists, get_variable_attribute, get_variable_num_dimensions use fms2_io_mod, only : get_variable_dimension_names, is_dimension_registered, get_dimension_size use fms2_io_mod, only : is_dimension_unlimited, register_axis, unlimited @@ -90,7 +90,7 @@ module MOM_io_infra !> Write metadata about a variable or axis to a file and store it for later reuse interface write_metadata - module procedure write_metadata_axis, write_metadata_field + module procedure write_metadata_axis, write_metadata_field, write_metadata_global end interface write_metadata !> Close a file (or fileset). If the file handle does not point to an open file, @@ -1779,7 +1779,7 @@ subroutine write_metadata_axis(IO_handle, axis, name, units, longname, cartesian endif axis%name = trim(name) - if (present(data) .and. allocated(axis%ax_data)) call MOM_error(FATAL, & + if (present(data) .and. allocated(axis%ax_data)) call MOM_error(FATAL, & "Data is already allocated in a call to write_metadata_axis for axis "//& trim(name)//" in file "//trim(IO_handle%filename)) @@ -1920,4 +1920,18 @@ subroutine write_metadata_field(IO_handle, field, axes, name, units, longname, & end subroutine write_metadata_field +!> Write a global text attribute to a file. +subroutine write_metadata_global(IO_handle, name, attribute) + type(file_type), intent(in) :: IO_handle !< Handle for a file that is open for writing + character(len=*), intent(in) :: name !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute !< The value of this attribute + + if (IO_handle%FMS2_file) then + call register_global_attribute(IO_handle%fileobj, name, attribute, len_trim(attribute)) + else + call mpp_write_meta(IO_handle%unit, name, cval=attribute) + endif + +end subroutine write_metadata_global + end module MOM_io_infra diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 247a0a9678..fb1c6b74f1 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -35,7 +35,7 @@ module MOM_io ! These interfaces are actually implemented in this file. public :: create_file, reopen_file, cmor_long_std, ensembler, MOM_io_init -public :: MOM_write_field, var_desc, modify_vardesc, query_vardesc +public :: MOM_write_field, var_desc, modify_vardesc, query_vardesc, position_from_horgrid public :: open_namelist_file, check_namelist_error, check_nml_error public :: get_var_sizes, verify_variable_units, num_timelevels, read_variable, read_attribute public :: open_file_to_read, close_file_to_read @@ -47,6 +47,10 @@ module MOM_io public :: MOM_read_data, MOM_read_vector, read_field_chksum public :: slasher, write_field, write_version_number public :: io_infra_init, io_infra_end +! This is used to set up information descibing non-domain-decomposed axes. +public :: axis_info, set_axis_info, delete_axis_info +! This is used to set up global file attributes +public :: attribute_info, set_attribute_info, delete_attribute_info ! This API is here just to support potential use by non-FMS drivers, and should not persist. public :: read_data !> These encoding constants are used to indicate the file format @@ -94,8 +98,32 @@ module MOM_io character(len=240) :: cmor_longname !< CMOR long name of the variable real :: conversion !< for unit conversions, such as needed to !! convert from intensive to extensive + character(len=32) :: dim_names(5) !< The names in the file of the axes for this variable + integer :: position = -1 !< An integer encoding the horizontal position, it may + !! CENTER, CORNER, EAST_FACE, NORTH_FACE, or 0. end type vardesc +!> Type that stores information that can be used to create a non-decomposed axis. +type :: axis_info ; private + character(len=32) :: name = "" !< The name of this axis for use in files + character(len=256) :: longname = "" !< A longer name describing this axis + character(len=48) :: units = "" !< The units of the axis labels + character(len=8) :: cartesian = "N" !< A variable indicating which direction + !! this axis corresponds with. Valid values + !! include 'X', 'Y', 'Z', 'T', and 'N' for none. + integer :: sense = 0 !< This is 1 for axes whose values increase upward, or -1 + !! if they increase downward. The default, 0, is ignored. + integer :: ax_size = 0 !< The number of elements in this axis + real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis. +end type axis_info + +!> Type that stores for a global file attribute +type :: attribute_info ; private + character(len=:), allocatable :: name !< The name of this attribute + character(len=:), allocatable :: att_val !< The values of this attribute +end type attribute_info + + integer, public :: stdout = stdout_iso !< standard output unit integer, public :: stderr = stderr_iso !< standard output unit @@ -104,8 +132,9 @@ module MOM_io !> Routine creates a new NetCDF file. It also sets up fieldtype !! structures that describe this file and variables that will !! later be written to this file. -subroutine create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, G, dG, GV, checksums) - type(file_type), intent(inout) :: IO_handle !< Handle for a file or fileset that is to be +subroutine create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & + G, dG, GV, checksums, extra_axes, global_atts) + type(file_type), intent(inout) :: IO_handle !< Handle for a files or fileset that is to be !! opened or reopened for writing character(len=*), intent(in) :: filename !< full path to the file to create type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename @@ -123,31 +152,47 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim type(verticalGrid_type), optional, intent(in) :: GV !< ocean vertical grid structure, which is !! required if the new file uses any !! vertical grid axes. - integer(kind=int64), optional, intent(in) :: checksums(:,:) !< checksums of vars + integer(kind=int64), optional, intent(in) :: checksums(:,:) !< checksums of vars + type(axis_info), optional, intent(in) :: extra_axes(:) !< Types with information about + !! some axes that might be used in this file + type(attribute_info), optional, intent(in) :: global_atts(:) !< Global attributes to + !! write to this file logical :: use_lath, use_lonh, use_latq, use_lonq, use_time logical :: use_layer, use_int, use_periodic - logical :: one_file, domain_set + logical :: one_file, domain_set, dim_found + logical, dimension(:), allocatable :: use_extra_axis type(axistype) :: axis_lath, axis_latq, axis_lonh, axis_lonq type(axistype) :: axis_layer, axis_int, axis_time, axis_periodic - type(axistype) :: axes(4) + type(axistype), dimension(:), allocatable :: more_axes ! Axes generated from extra_axes + type(axistype) :: axes(5) ! The axes of a variable type(MOM_domain_type), pointer :: Domain => NULL() type(domain1d) :: x_domain, y_domain - integer :: numaxes, pack, thread, k + integer :: position, numaxes, pack, thread, k, n, m + integer :: num_extra_dims ! The number of extra possible dimensions from extra_axes integer :: isg, ieg, jsg, jeg, IsgB, IegB, JsgB, JegB integer :: var_periods, num_periods=0 - real, dimension(:), allocatable :: period_val + real, dimension(:), allocatable :: axis_val real, pointer, dimension(:) :: & gridLatT => NULL(), & ! The latitude or longitude of T or B points for gridLatB => NULL(), & ! the purpose of labeling the output axes. gridLonT => NULL(), gridLonB => NULL() character(len=40) :: time_units, x_axis_units, y_axis_units character(len=8) :: t_grid, t_grid_read + character(len=64) :: ax_name(5) ! The axis names of a variable use_lath = .false. ; use_lonh = .false. use_latq = .false. ; use_lonq = .false. use_time = .false. ; use_periodic = .false. use_layer = .false. ; use_int = .false. + num_extra_dims = 0 + if (present(extra_axes)) then + num_extra_dims = size(extra_axes) + if (num_extra_dims > 0) then + allocate(use_extra_axis(num_extra_dims)) ; use_extra_axis = .false. + allocate(more_axes(num_extra_dims)) + endif + endif thread = SINGLE_FILE if (PRESENT(threading)) thread = threading @@ -180,19 +225,16 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim ! Define the coordinates. do k=1,novars - select case (vars(k)%hor_grid) - case ('h') ; use_lath = .true. ; use_lonh = .true. - case ('q') ; use_latq = .true. ; use_lonq = .true. - case ('u') ; use_lath = .true. ; use_lonq = .true. - case ('v') ; use_latq = .true. ; use_lonh = .true. - case ('T') ; use_lath = .true. ; use_lonh = .true. - case ('Bu') ; use_latq = .true. ; use_lonq = .true. - case ('Cu') ; use_lath = .true. ; use_lonq = .true. - case ('Cv') ; use_latq = .true. ; use_lonh = .true. - case ('1') ! Do nothing. + position = vars(k)%position + if (position == -1) position = position_from_horgrid(vars(k)%hor_grid) + select case (position) + case (CENTER) ; use_lath = .true. ; use_lonh = .true. + case (CORNER) ; use_latq = .true. ; use_lonq = .true. + case (EAST_FACE) ; use_lath = .true. ; use_lonq = .true. + case (NORTH_FACE) ; use_latq = .true. ; use_lonh = .true. + case (0) ! Do nothing. case default - call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//& - " has unrecognized hor_grid "//trim(vars(k)%hor_grid)) + call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//" has an unrecognized value of postion") end select select case (vars(k)%z_grid) case ('L') ; use_layer = .true. @@ -233,6 +275,19 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//& " has unrecognized t_grid "//trim(vars(k)%t_grid)) end select + + do n=1,5 ; if (len_trim(vars(k)%dim_names(n)) > 0) then + dim_found = .false. + do m=1,num_extra_dims + if (lowercase(trim(vars(k)%dim_names(n))) == lowercase(trim(extra_axes(m)%name))) then + use_extra_axis(m) = .true. + dim_found = .true. + exit + endif + enddo + if (.not.dim_found) call MOM_error(FATAL, "Unable to find a match for dimension "//& + trim(vars(k)%dim_names(n))//" for variable "//trim(vars(k)%name)//" in file "//trim(filename)) + endif ; enddo enddo if ((use_lath .or. use_lonh .or. use_latq .or. use_lonq)) then @@ -288,44 +343,82 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim call write_metadata(IO_handle, axis_time, name="Time", units=time_units, longname="Time", cartesian='T') else - call write_metadata(IO_handle, axis_time, name="Time", units="days", longname="Time", cartesian= 'T') + call write_metadata(IO_handle, axis_time, name="Time", units="days", longname="Time", cartesian='T') endif ; endif if (use_periodic) then if (num_periods <= 1) call MOM_error(FATAL, "MOM_io create_file: "//& "num_periods for file "//trim(filename)//" must be at least 1.") ! Define a periodic axis with unit labels. - allocate(period_val(num_periods)) - do k=1,num_periods ; period_val(k) = real(k) ; enddo + allocate(axis_val(num_periods)) + do k=1,num_periods ; axis_val(k) = real(k) ; enddo call write_metadata(IO_handle, axis_periodic, name="Period", units="nondimensional", & - longname="Periods for cyclical varaiables", cartesian='T', data=period_val) - deallocate(period_val) + longname="Periods for cyclical variables", cartesian='T', data=axis_val) + deallocate(axis_val) endif + do m=1,num_extra_dims ; if (use_extra_axis(m)) then + if (allocated(extra_axes(m)%ax_data)) then + call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, & + sense=extra_axes(m)%sense, data=extra_axes(m)%ax_data) + elseif (trim(extra_axes(m)%cartesian) == "T") then + call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian) + else + ! FMS requires that non-time axes have variables that label their values, even if they are trivial. + allocate (axis_val(extra_axes(m)%ax_size)) + do k=1,extra_axes(m)%ax_size ; axis_val(k) = real(k) ; enddo + call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, & + sense=extra_axes(m)%sense, data=axis_val) + deallocate(axis_val) + endif + endif ; enddo + do k=1,novars numaxes = 0 - select case (vars(k)%hor_grid) - case ('h') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_lath - case ('q') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_latq - case ('u') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_lath - case ('v') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_latq - case ('T') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_lath - case ('Bu') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_latq - case ('Cu') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_lath - case ('Cv') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_latq - case ('1') ! Do nothing. + position = vars(k)%position + if (position == -1) position = position_from_horgrid(vars(k)%hor_grid) + select case (position) + case (CENTER) + numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_lath ; ax_name(1) = "lonh" ; ax_name(2) = "lath" + case (CORNER) + numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_latq ; ax_name(1) = "lonq" ; ax_name(2) = "latq" + case (EAST_FACE) + numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_lath ; ax_name(1) = "lonq" ; ax_name(2) = "lath" + case (NORTH_FACE) + numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_latq ; ax_name(1) = "lonh" ; ax_name(2) = "latq" + case (0) ! Do nothing. case default call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//& - " has unrecognized hor_grid "//trim(vars(k)%hor_grid)) + " has unrecognized position, hor_grid = "//trim(vars(k)%hor_grid)) end select select case (vars(k)%z_grid) - case ('L') ; numaxes = numaxes+1 ; axes(numaxes) = axis_layer - case ('i') ; numaxes = numaxes+1 ; axes(numaxes) = axis_int + case ('L') ; numaxes = numaxes+1 ; axes(numaxes) = axis_layer ; ax_name(numaxes) = "Layer" + case ('i') ; numaxes = numaxes+1 ; axes(numaxes) = axis_int ; ax_name(numaxes) = "Interface" case ('1') ! Do nothing. case default call MOM_error(FATAL, "MOM_io create_file: "//trim(vars(k)%name)//& " has unrecognized z_grid "//trim(vars(k)%z_grid)) end select + + do n=1,numaxes + if ( (len_trim(vars(k)%dim_names(n)) > 0) .and. (trim(ax_name(n)) /= trim(vars(k)%dim_names(n))) ) & + call MOM_error(WARNING, "MOM_io create_file: dimension "//trim(ax_name(n))//& + " of variable "//trim(vars(k)%name)//" in "//trim(filename)//& + " is being set inconsistently as "//trim(vars(k)%dim_names(n))) + enddo + do n=numaxes+1,5 ; if (len_trim(vars(k)%dim_names(n)) > 0) then + dim_found = .false. + do m=1,num_extra_dims + if (lowercase(trim(vars(k)%dim_names(n))) == lowercase(trim(extra_axes(m)%name))) then + numaxes = numaxes+1 ; axes(numaxes) = more_axes(m) + exit + endif + enddo + endif ; enddo + t_grid = adjustl(vars(k)%t_grid) select case (t_grid(1:1)) case ('s', 'a', 'm') ; numaxes = numaxes+1 ; axes(numaxes) = axis_time @@ -346,6 +439,14 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim endif enddo + if (present(global_atts)) then + do n=1,size(global_atts) + if (allocated(global_atts(n)%name) .and. allocated(global_atts(n)%att_val)) & + call write_metadata(IO_handle, global_atts(n)%name, global_atts(n)%att_val) + enddo + endif + + ! Now actualy write the variables with the axis label values if (use_lath) call write_field(IO_handle, axis_lath) if (use_latq) call write_field(IO_handle, axis_latq) if (use_lonh) call write_field(IO_handle, axis_lonh) @@ -353,6 +454,13 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim if (use_layer) call write_field(IO_handle, axis_layer) if (use_int) call write_field(IO_handle, axis_int) if (use_periodic) call write_field(IO_handle, axis_periodic) + do m=1,num_extra_dims ; if (use_extra_axis(m)) then + call write_field(IO_handle, more_axes(m)) + endif ; enddo + + if (num_extra_dims > 0) then + deallocate(use_extra_axis, more_axes) + endif end subroutine create_file @@ -361,7 +469,8 @@ end subroutine create_file !! does not find the file, a new file is created. It also sets up !! structures that describe this file and the variables that will !! later be written to this file. -subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, timeunit, G, dG, GV) +subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & + G, dG, GV, extra_axes, global_atts) type(file_type), intent(inout) :: IO_handle !< Handle for a file or fileset that is to be !! opened or reopened for writing character(len=*), intent(in) :: filename !< full path to the file to create @@ -380,6 +489,10 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim type(verticalGrid_type), optional, intent(in) :: GV !< ocean vertical grid structure, which is !! required if a new file uses any !! vertical grid axes. + type(axis_info), optional, intent(in) :: extra_axes(:) !< Types with information about + !! some axes that might be used in this file + type(attribute_info), optional, intent(in) :: global_atts(:) !< Global attributes to + !! write to this file type(MOM_domain_type), pointer :: Domain => NULL() character(len=200) :: check_name, mesg @@ -398,7 +511,7 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim if (.not.exists) then call create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G=G, dG=dG, GV=GV) + G=G, dG=dG, GV=GV, extra_axes=extra_axes, global_atts=global_atts) else domain_set = .false. @@ -424,7 +537,8 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim write (mesg,*) "Reopening file ",trim(filename)," apparently had ",nvar,& " variables. Clobbering and creating file with ",novars," instead." call MOM_error(WARNING,"MOM_io: "//mesg) - call create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, G=G, GV=GV) + call create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & + G=G, dG=dG, GV=GV, extra_axes=extra_axes, global_atts=global_atts) elseif (nvar /= novars) then write (mesg,*) "Reopening file ",trim(filename)," with ",novars,& " variables instead of ",nvar,"." @@ -1197,21 +1311,29 @@ end subroutine verify_variable_units !! fields. The argument name is required, while the others are optional and !! have default values that are empty strings or are appropriate for a 3-d !! tracer field at the tracer cell centers. -function var_desc(name, units, longname, hor_grid, z_grid, t_grid, & - cmor_field_name, cmor_units, cmor_longname, conversion, caller) result(vd) - character(len=*), intent(in) :: name !< variable name - character(len=*), optional, intent(in) :: units !< variable units - character(len=*), optional, intent(in) :: longname !< variable long name - character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering - character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering - character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 - character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name - character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable - character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name - real , optional, intent(in) :: conversion !< for unit conversions, such as needed to - !! convert from intensive to extensive - character(len=*), optional, intent(in) :: caller !< calling routine? - type(vardesc) :: vd !< vardesc type that is created +function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, & + cmor_units, cmor_longname, conversion, caller, position, dim_names, fixed) result(vd) + character(len=*), intent(in) :: name !< variable name + character(len=*), optional, intent(in) :: units !< variable units + character(len=*), optional, intent(in) :: longname !< variable long name + character(len=*), optional, intent(in) :: hor_grid !< A character string indicating the horizontal + !! position of this variable + character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering + character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 + character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name + character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable + character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name + real , optional, intent(in) :: conversion !< for unit conversions, such as needed to + !! convert from intensive to extensive + character(len=*), optional, intent(in) :: caller !< The calling routine for error messages + integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position + !! of this variable if it has such dimensions. + !! Valid values include CORNER, CENTER, EAST_FACE + !! NORTH_FACE, and 0 for no horizontal dimensions. + character(len=*), dimension(:), & + optional, intent(in) :: dim_names !< The names of the dimensions of this variable + logical, optional, intent(in) :: fixed !< If true, this does not evolve with time + type(vardesc) :: vd !< vardesc type that is created character(len=120) :: cllr cllr = "var_desc" @@ -1220,15 +1342,18 @@ function var_desc(name, units, longname, hor_grid, z_grid, t_grid, & call safe_string_copy(name, vd%name, "vd%name", cllr) vd%longname = "" ; vd%units = "" - vd%hor_grid = 'h' ; vd%z_grid = 'L' ; vd%t_grid = 's' + vd%hor_grid = 'h' ; vd%position = CENTER ; vd%z_grid = 'L' ; vd%t_grid = 's' + if (present(dim_names)) vd%z_grid = '1' ! In this case the names are used to set the non-horizontal axes + if (present(fixed)) then ; if (fixed) vd%t_grid = '1' ; endif vd%cmor_field_name = "" vd%cmor_units = "" vd%cmor_longname = "" vd%conversion = 1.0 + vd%dim_names(:) = "" call modify_vardesc(vd, units=units, longname=longname, hor_grid=hor_grid, & - z_grid=z_grid, t_grid=t_grid, & + z_grid=z_grid, t_grid=t_grid, position=position, dim_names=dim_names, & cmor_field_name=cmor_field_name, cmor_units=cmor_units, & cmor_longname=cmor_longname, conversion=conversion, caller=cllr) @@ -1238,7 +1363,7 @@ end function var_desc !> This routine modifies the named elements of a vardesc type. !! All arguments are optional, except the vardesc type to be modified. subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & - cmor_field_name, cmor_units, cmor_longname, conversion, caller) + cmor_field_name, cmor_units, cmor_longname, conversion, caller, position, dim_names) type(vardesc), intent(inout) :: vd !< vardesc type that is modified character(len=*), optional, intent(in) :: name !< name of variable character(len=*), optional, intent(in) :: units !< units of variable @@ -1249,13 +1374,21 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name - real , optional, intent(in) :: conversion !< for unit conversions, such as needed - !! to convert from intensive to extensive - character(len=*), optional, intent(in) :: caller !< calling routine? + real , optional, intent(in) :: conversion !< A multiplicative factor for unit conversions, + !! such as needed to convert from intensive to + !! extensive or dimensional consistency testing + character(len=*), optional, intent(in) :: caller !< The calling routine for error messages + integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position + !! of this variable if it has such dimensions. + !! Valid values include CORNER, CENTER, EAST_FACE + !! NORTH_FACE, and 0 for no horizontal dimensions. + character(len=*), dimension(:), & + optional, intent(in) :: dim_names !< The names of the dimensions of this variable character(len=120) :: cllr - cllr = "mod_vardesc" - if (present(caller)) cllr = trim(caller) + integer :: n + + cllr = "mod_vardesc" ; if (present(caller)) cllr = trim(caller) if (present(name)) call safe_string_copy(name, vd%name, "vd%name", cllr) @@ -1263,8 +1396,28 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & "vd%longname of "//trim(vd%name), cllr) if (present(units)) call safe_string_copy(units, vd%units, & "vd%units of "//trim(vd%name), cllr) - if (present(hor_grid)) call safe_string_copy(hor_grid, vd%hor_grid, & - "vd%hor_grid of "//trim(vd%name), cllr) + if (present(position)) then + vd%position = position + select case (position) + case (CENTER) ; vd%hor_grid = 'T' + case (CORNER) ; vd%hor_grid = 'Bu' + case (EAST_FACE) ; vd%hor_grid = 'Cu' + case (NORTH_FACE) ; vd%hor_grid = 'Cv' + case (0) ; vd%hor_grid = '1' + case default + call MOM_error(FATAL, "modify_vardesc: "//trim(vd%name)//" has unrecognized position argument") + end select + endif + if (present(hor_grid)) then + call safe_string_copy(hor_grid, vd%hor_grid, "vd%hor_grid of "//trim(vd%name), cllr) + vd%position = position_from_horgrid(vd%hor_grid) + if (present(caller) .and. (vd%position == -1)) then + call MOM_error(FATAL, "modify_vardesc called by "//trim(caller)//": "//trim(vd%name)//& + " has an unrecognized hor_grid argument "//trim(vd%hor_grid)) + elseif (vd%position == -1) then + call MOM_error(FATAL, "modify_vardesc called with bad hor_grid argument "//trim(vd%hor_grid)) + endif + endif if (present(z_grid)) call safe_string_copy(z_grid, vd%z_grid, & "vd%z_grid of "//trim(vd%name), cllr) if (present(t_grid)) call safe_string_copy(t_grid, vd%t_grid, & @@ -1277,8 +1430,110 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & if (present(cmor_longname)) call safe_string_copy(cmor_longname, vd%cmor_longname, & "vd%cmor_longname of "//trim(vd%name), cllr) + if (present(dim_names)) then + do n=1,min(5,size(dim_names)) ; if (len_trim(dim_names(n)) > 0) then + call safe_string_copy(dim_names(n), vd%dim_names(n), "vd%dim_names of "//trim(vd%name), cllr) + endif ; enddo + endif + end subroutine modify_vardesc +integer function position_from_horgrid(hor_grid) + character(len=*), intent(in) :: hor_grid !< horizontal staggering of variable + + select case (trim(hor_grid)) + case ('h') ; position_from_horgrid = CENTER + case ('q') ; position_from_horgrid = CORNER + case ('u') ; position_from_horgrid = EAST_FACE + case ('v') ; position_from_horgrid = NORTH_FACE + case ('T') ; position_from_horgrid = CENTER + case ('Bu') ; position_from_horgrid = CORNER + case ('Cu') ; position_from_horgrid = EAST_FACE + case ('Cv') ; position_from_horgrid = NORTH_FACE + case ('1') ; position_from_horgrid = 0 + case default ; position_from_horgrid = -1 ! This is a bad-value flag. + end select +end function position_from_horgrid + +!> Store information that can be used to create an axis in a subsequent call to create_file. +subroutine set_axis_info(axis, name, units, longname, ax_size, ax_data, cartesian, sense) + type(axis_info), intent(inout) :: axis !< A type with information about a named axis + character(len=*), intent(in) :: name !< The name of this axis for use in files + character(len=*), optional, intent(in) :: units !< The units of the axis labels + character(len=*), optional, intent(in) :: longname !< Long name of the axis variable + integer, optional, intent(in) :: ax_size !< The number of elements in this axis + real, dimension(:), optional, intent(in) :: ax_data !< The values of the data on the axis + character(len=*), optional, intent(in) :: cartesian !< A variable indicating which direction this axis + !! axis corresponds with. Valid values + !! include 'X', 'Y', 'Z', 'T', and 'N' (the default) for none. + integer, optional, intent(in) :: sense !< This is 1 for axes whose values increase upward, or -1 + !! if they increase downward. The default, 0, is ignored. + + call safe_string_copy(name, axis%name, "axis%name of "//trim(name), "set_axis_info") + ! Set the default values. + axis%longname = trim(axis%name) ; axis%units = "" ; axis%cartesian = "N" ; axis%sense = 0 + + if (present(longname)) call safe_string_copy(longname, axis%longname, & + "axis%longname of "//trim(name), "set_axis_info") + if (present(units)) call safe_string_copy(units, axis%units, & + "axis%units of "//trim(name), "set_axis_info") + if (present(cartesian)) call safe_string_copy(cartesian, axis%cartesian, & + "axis%cartesian of "//trim(name), "set_axis_info") + if (present(sense)) axis%sense = sense + + if (.not.(present(ax_size) .or. present(ax_data)) ) then + call MOM_error(FATAL, "set_axis_info called for "//trim(name)//& + "without either an ax_size or an ax_data argument.") + elseif (present(ax_size) .and. present(ax_data)) then + if (size(ax_data) /= ax_size) call MOM_error(FATAL, "set_axis_info called for "//trim(name)//& + "with an inconsistent value of ax_size and size of ax_data.") + endif + + if (present(ax_size)) then + axis%ax_size = ax_size + else + axis%ax_size = size(ax_data) + endif + if (present(ax_data)) then + allocate(axis%ax_data(axis%ax_size)) ; axis%ax_data(:) = ax_data(:) + endif + +end subroutine set_axis_info + +!> Delete the information in an array of axis_info types and deallocate memory in them. +subroutine delete_axis_info(axes) + type(axis_info), dimension(:), intent(inout) :: axes !< An array with information about named axes + + integer :: n + do n=1,size(axes) + axes(n)%name = "" ; axes(n)%longname = "" ; axes(n)%units = "" ; axes(n)%cartesian = "N" + axes(n)%sense = 0 ; axes(n)%ax_size = 0 + if (allocated(axes(n)%ax_data)) deallocate(axes(n)%ax_data) + enddo +end subroutine delete_axis_info + +!> Store information that can be used to create an attribute in a subsequent call to create_file. +subroutine set_attribute_info(attribute, name, str_value) + type(attribute_info), intent(inout) :: attribute !< A type with information about a named attribute + character(len=*), intent(in) :: name !< The name of this attribute for use in files + character(len=*), intent(in) :: str_value !< The value of this attribute + + attribute%name = trim(name) + attribute%att_val = trim(str_value) +end subroutine set_attribute_info + +!> Delete the information in an array of attribute_info types and deallocate memory in them. +subroutine delete_attribute_info(atts) + type(attribute_info), dimension(:), intent(inout) :: atts !< An array of global attributes + + integer :: n + do n=1,size(atts) + if (allocated(atts(n)%name)) deallocate(atts(n)%name) + if (allocated(atts(n)%att_val)) deallocate(atts(n)%att_val) + enddo +end subroutine delete_attribute_info + + !> This function returns the CMOR standard name given a CMOR longname, based on !! the standard pattern of character conversions. function cmor_long_std(longname) result(std_name) @@ -1297,7 +1552,8 @@ end function cmor_long_std !> This routine queries vardesc subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & - cmor_field_name, cmor_units, cmor_longname, conversion, caller) + cmor_field_name, cmor_units, cmor_longname, conversion, caller, & + position, dim_names) type(vardesc), intent(in) :: vd !< vardesc type that is queried character(len=*), optional, intent(out) :: name !< name of variable character(len=*), optional, intent(out) :: units !< units of variable @@ -1311,8 +1567,14 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & real , optional, intent(out) :: conversion !< for unit conversions, such as needed to !! convert from intensive to extensive character(len=*), optional, intent(in) :: caller !< calling routine? + integer, optional, intent(out) :: position !< A coded integer indicating the horizontal position + !! of this variable if it has such dimensions. + !! Valid values include CORNER, CENTER, EAST_FACE + !! NORTH_FACE, and 0 for no horizontal dimensions. + character(len=*), dimension(:), & + optional, intent(out) :: dim_names !< The names of the dimensions of this variable - + integer :: n character(len=120) :: cllr cllr = "mod_vardesc" if (present(caller)) cllr = trim(caller) @@ -1336,6 +1598,15 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & "vd%cmor_units of "//trim(vd%name), cllr) if (present(cmor_longname)) call safe_string_copy(vd%cmor_longname, cmor_longname, & "vd%cmor_longname of "//trim(vd%name), cllr) + if (present(position)) then + position = vd%position + if (position == -1) position = position_from_horgrid(vd%hor_grid) + endif + if (present(dim_names)) then + do n=1,min(5,size(dim_names)) + call safe_string_copy(vd%dim_names(n), dim_names(n), "vd%dim_names of "//trim(vd%name), cllr) + enddo + endif end subroutine query_vardesc @@ -1672,6 +1943,4 @@ end subroutine MOM_io_init !! !! * handle_error: write an error code and quit. - - end module MOM_io