add unit comparison

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
 

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