From 2a2312454362706719dce4126b4a53b8ddbfd014 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Sat, 27 Apr 2024 21:17:57 -0600 Subject: [PATCH] add unit comparison --- src/ccpp_constituent_prop_mod.F90 | 61 ++++++++++++++++++++++++++++--- test/advection_test/test_host.F90 | 8 ++-- 2 files changed, 60 insertions(+), 9 deletions(-) diff --git a/src/ccpp_constituent_prop_mod.F90 b/src/ccpp_constituent_prop_mod.F90 index 159ca814..a60e3c95 100644 --- a/src/ccpp_constituent_prop_mod.F90 +++ b/src/ccpp_constituent_prop_mod.F90 @@ -57,6 +57,7 @@ module ccpp_constituent_prop_mod procedure :: is_instantiated => ccp_is_instantiated procedure :: standard_name => ccp_get_standard_name procedure :: long_name => ccp_get_long_name + procedure :: units => ccp_get_units procedure :: is_layer_var => ccp_is_layer_var procedure :: is_interface_var => ccp_is_interface_var procedure :: is_2d_var => ccp_is_2d_var @@ -99,6 +100,7 @@ module ccpp_constituent_prop_mod ! Informational methods procedure :: standard_name => ccpt_get_standard_name procedure :: long_name => ccpt_get_long_name + procedure :: units => ccpt_get_units procedure :: is_layer_var => ccpt_is_layer_var procedure :: is_interface_var => ccpt_is_interface_var procedure :: is_2d_var => ccpt_is_2d_var @@ -501,6 +503,25 @@ end subroutine ccp_get_long_name !####################################################################### + subroutine ccp_get_units(this, units, errcode, errmsg) + ! Return this constituent's units + + ! Dummy arguments + class(ccpp_constituent_properties_t), intent(in) :: this + character(len=*), intent(out) :: units + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + if (this%is_instantiated(errcode, errmsg)) then + units = this%var_units + else + units = '' + end if + + end subroutine ccp_get_units + + !####################################################################### + subroutine ccp_get_vertical_dimension(this, vert_dim, errcode, errmsg) ! Return the standard name of this constituent's vertical dimension @@ -956,29 +977,36 @@ logical function ccp_is_match(this, comp_props) result(is_match) type(ccpp_constituent_properties_t), intent(in) :: comp_props ! Local variable logical :: val, comp_val + character(len=stdname_len) :: char_val, char_comp_val logical :: check ! By default, every constituent is a match is_match = .true. - ! Check: advected, thermo_active, water_species - ! peverwhee: also check min_value, molar_mass, default_value? + ! Check: advected, thermo_active, water_species, units call this%is_advected(val) call comp_props%is_advected(comp_val) - if (val /= comp_val) then + if (val .neqv. comp_val) then is_match = .false. return end if call this%is_thermo_active(val) call comp_props%is_thermo_active(comp_val) - if (val /= comp_val) then + if (val .neqv. comp_val) then is_match = .false. return end if call this%is_water_species(val) call comp_props%is_water_species(comp_val) - if (val /= comp_val) then + if (val .neqv. comp_val) then + is_match = .false. + return + end if + + call this%units(char_val) + call comp_props%units(char_comp_val) + if (trim(char_val) /= trim(char_comp_val)) then is_match = .false. return end if @@ -1921,6 +1949,29 @@ end subroutine ccpt_get_long_name !####################################################################### + subroutine ccpt_get_units(this, units, errcode, errmsg) + ! Return this constituent's units + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(in) :: this + character(len=*), intent(out) :: units + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + ! Local variable + character(len=*), parameter :: subname = 'ccpt_get_units' + + if (associated(this%prop)) then + call this%prop%units(units, errcode, errmsg) + else + units = '' + call append_errvars(1, ": invalid constituent pointer", & + subname, errcode=errcode, errmsg=errmsg) + end if + + end subroutine ccpt_get_units + + !####################################################################### + subroutine ccpt_get_vertical_dimension(this, vert_dim, errcode, errmsg) ! Return the standard name of this constituent's vertical dimension diff --git a/test/advection_test/test_host.F90 b/test/advection_test/test_host.F90 index 2196416b..6b91aac4 100644 --- a/test/advection_test/test_host.F90 +++ b/test/advection_test/test_host.F90 @@ -334,12 +334,12 @@ subroutine test_host(retval, test_suites) call host_constituents(1)%instantiate(std_name="specific_humidity", & long_name="Specific humidity", units="kg kg-1", & vertical_dim="vertical_layer_dimension", advected=.true., & - min_value=1000._kind_phys, molar_mass=2000._kind_phys, & + min_value=1000._kind_phys, molar_mass=2000._kind_phys, & errcode=errflg, errmsg=errmsg) call host_constituents(2)%instantiate(std_name="specific_humidity", & - long_name="Specific humidity", units="kg kg-1", & - vertical_dim="vertical_layer_dimension", advected=.false., & - min_value=1000._kind_phys, molar_mass=2000._kind_phys, & + long_name="Specific humidity", units="kg kg", & + vertical_dim="vertical_layer_dimension", advected=.true., & + min_value=1000._kind_phys, molar_mass=2000._kind_phys, & errcode=errflg, errmsg=errmsg) call check_errflg(subname//'.initialize', errflg, errmsg, errflg_final) if (errflg == 0) then