From f9d31a5fe073e83d3ffc06ee1e41bb19baca84fb Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Wed, 27 Sep 2023 14:03:28 -0600 Subject: [PATCH 1/4] Add new 'water_species' property and associated methods. --- src/ccpp_constituent_prop_mod.F90 | 125 +++++++++++++++++++++++++++--- 1 file changed, 116 insertions(+), 9 deletions(-) diff --git a/src/ccpp_constituent_prop_mod.F90 b/src/ccpp_constituent_prop_mod.F90 index d096970d..25ec5e6c 100644 --- a/src/ccpp_constituent_prop_mod.F90 +++ b/src/ccpp_constituent_prop_mod.F90 @@ -36,6 +36,7 @@ module ccpp_constituent_prop_mod integer, private :: const_ind = int_unassigned logical, private :: advected = .false. logical, private :: thermo_active = .false. + logical, private :: water_species = .false. ! While the quantities below can be derived from the standard name, ! this implementation avoids string searching in parameterizations ! const_type distinguishes mass, volume, and number conc. mixing ratios @@ -63,6 +64,7 @@ module ccpp_constituent_prop_mod procedure :: const_index => ccp_const_index procedure :: is_advected => ccp_is_advected procedure :: is_thermo_active => ccp_is_thermo_active + procedure :: is_water_species => ccp_is_water_species procedure :: equivalent => ccp_is_equivalent procedure :: is_mass_mixing_ratio => ccp_is_mass_mixing_ratio procedure :: is_volume_mixing_ratio => ccp_is_volume_mixing_ratio @@ -82,6 +84,7 @@ module ccpp_constituent_prop_mod procedure :: deallocate => ccp_deallocate procedure :: set_const_index => ccp_set_const_index procedure :: set_thermo_active => ccp_set_thermo_active + procedure :: set_water_species => ccp_set_water_species procedure :: set_minimum => ccp_set_min_val end type ccpp_constituent_properties_t @@ -101,6 +104,7 @@ module ccpp_constituent_prop_mod procedure :: const_index => ccpt_const_index procedure :: is_advected => ccpt_is_advected procedure :: is_thermo_active => ccpt_is_thermo_active + procedure :: is_water_species => ccpt_is_water_species procedure :: is_mass_mixing_ratio => ccpt_is_mass_mixing_ratio procedure :: is_volume_mixing_ratio => ccpt_is_volume_mixing_ratio procedure :: is_number_concentration => ccpt_is_number_concentration @@ -117,6 +121,7 @@ module ccpp_constituent_prop_mod procedure :: deallocate => ccpt_deallocate procedure :: set_const_index => ccpt_set_const_index procedure :: set_thermo_active => ccpt_set_thermo_active + procedure :: set_water_species => ccpt_set_water_species procedure :: set_minimum => ccpt_set_min_val end type ccpp_constituent_prop_ptr_t @@ -623,6 +628,26 @@ end subroutine ccp_set_thermo_active !####################################################################### + subroutine ccp_set_water_species(this, water_flag, errcode, errmsg) + ! Set whether this constituent is a water species, which means + ! that this constituent represents a particular phase or type + ! of water in the atmosphere. + + ! Dummy arguments + class(ccpp_constituent_properties_t), intent(inout) :: this + logical, intent(in) :: water_flag + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + !Set thermodynamically active flag for this constituent: + if (this%is_instantiated(errcode, errmsg)) then + this%water_species = water_flag + end if + + end subroutine ccp_set_water_species + + !####################################################################### + subroutine ccp_is_thermo_active(this, val_out, errcode, errmsg) ! Dummy arguments @@ -642,6 +667,25 @@ end subroutine ccp_is_thermo_active !####################################################################### + subroutine ccp_is_water_species(this, val_out, errcode, errmsg) + + ! Dummy arguments + class(ccpp_constituent_properties_t), intent(in) :: this + logical, intent(out) :: val_out + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + + !If instantiated then check if constituent is + !thermodynamically active, otherwise return false: + if (this%is_instantiated(errcode, errmsg)) then + val_out = this%water_species + else + val_out = .false. + end if + end subroutine ccp_is_water_species + + !####################################################################### + subroutine ccp_is_advected(this, val_out, errcode, errmsg) ! Dummy arguments @@ -668,14 +712,15 @@ subroutine ccp_is_equivalent(this, oconst, equiv, errcode, errmsg) integer, optional, intent(out) :: errcode character(len=*), optional, intent(out) :: errmsg - if (this%is_instantiated(errcode, errmsg) .and. & + if (this%is_instantiated(errcode, errmsg) .and. & oconst%is_instantiated(errcode, errmsg)) then equiv = (trim(this%var_std_name) == trim(oconst%var_std_name)) .and. & (trim(this%var_long_name) == trim(oconst%var_long_name)) .and. & (trim(this%vert_dim) == trim(oconst%vert_dim)) .and. & (this%advected .eqv. oconst%advected) .and. & (this%const_default_value == oconst%const_default_value) .and. & - (this%thermo_active .eqv. oconst%thermo_active) + (this%thermo_active .eqv. oconst%thermo_active) .and. & + (this%water_species .eqv. oconst%water_species) else equiv = .false. end if @@ -1413,7 +1458,7 @@ end subroutine ccp_model_const_reset !######################################################################## logical function ccp_model_const_is_match(this, index, advected, & - thermo_active) result(is_match) + thermo_active, water_species) result(is_match) ! Return .true. iff the constituent at matches a pattern ! Each (optional) property which is present represents something ! which is required as part of a match. @@ -1425,6 +1470,7 @@ logical function ccp_model_const_is_match(this, index, advected, & integer, intent(in) :: index logical, optional, intent(in) :: advected logical, optional, intent(in) :: thermo_active + logical, optional, intent(in) :: water_species ! Local variable logical :: check @@ -1444,13 +1490,20 @@ logical function ccp_model_const_is_match(this, index, advected, & end if end if + if (present(water_species)) then + call this%const_metadata(index)%is_water_species(check) + if (water_species .neqv. check) then + is_match = .false. + end if + end if + end function ccp_model_const_is_match !######################################################################## subroutine ccp_model_const_num_match(this, nmatch, advected, thermo_active, & - errcode, errmsg) + water_species, errcode, errmsg) ! Query number of constituents matching pattern ! Each (optional) property which is present represents something ! which is required as part of a match. @@ -1461,6 +1514,7 @@ subroutine ccp_model_const_num_match(this, nmatch, advected, thermo_active, & integer, intent(out) :: nmatch logical, optional, intent(in) :: advected logical, optional, intent(in) :: thermo_active + logical, optional, intent(in) :: water_species integer, optional, intent(out) :: errcode character(len=*), optional, intent(out) :: errmsg ! Local variables @@ -1470,7 +1524,8 @@ subroutine ccp_model_const_num_match(this, nmatch, advected, thermo_active, & nmatch = 0 if (this%const_props_locked(errcode=errcode, errmsg=errmsg, warn_func=subname)) then do index = 1, SIZE(this%const_metadata) - if (this%is_match(index, advected=advected, thermo_active=thermo_active)) then + if (this%is_match(index, advected=advected, thermo_active=thermo_active, & + water_species=water_species)) then nmatch = nmatch + 1 end if end do @@ -1536,7 +1591,7 @@ end subroutine ccp_model_const_metadata !######################################################################## subroutine ccp_model_const_copy_in_3d(this, const_array, advected, & - thermo_active, errcode, errmsg) + thermo_active, water_species, errcode, errmsg) ! Gather constituent fields matching pattern ! Each (optional) property which is present represents something ! which is required as part of a match. @@ -1547,6 +1602,7 @@ subroutine ccp_model_const_copy_in_3d(this, const_array, advected, & real(kind_phys), intent(out) :: const_array(:,:,:) logical, optional, intent(in) :: advected logical, optional, intent(in) :: thermo_active + logical, optional, intent(in) :: water_species integer, optional, intent(out) :: errcode character(len=*), optional, intent(out) :: errmsg ! Local variables @@ -1564,7 +1620,8 @@ subroutine ccp_model_const_copy_in_3d(this, const_array, advected, & num_levels = SIZE(const_array, 2) do index = 1, SIZE(this%const_metadata) if (this%is_match(index, advected=advected, & - thermo_active=thermo_active)) then + thermo_active=thermo_active, & + water_species=water_species)) then ! See if we have room for another constituent cindex = cindex + 1 if (cindex > max_cind) then @@ -1613,7 +1670,7 @@ end subroutine ccp_model_const_copy_in_3d !######################################################################## subroutine ccp_model_const_copy_out_3d(this, const_array, advected, & - thermo_active, errcode, errmsg) + thermo_active, water_species, errcode, errmsg) ! Update constituent fields matching pattern ! Each (optional) property which is present represents something ! which is required as part of a match. @@ -1624,6 +1681,7 @@ subroutine ccp_model_const_copy_out_3d(this, const_array, advected, & real(kind_phys), intent(in) :: const_array(:,:,:) logical, optional, intent(in) :: advected logical, optional, intent(in) :: thermo_active + logical, optional, intent(in) :: water_species integer, optional, intent(out) :: errcode character(len=*), optional, intent(out) :: errmsg ! Local variables @@ -1641,7 +1699,8 @@ subroutine ccp_model_const_copy_out_3d(this, const_array, advected, & num_levels = SIZE(const_array, 2) do index = 1, SIZE(this%const_metadata) if (this%is_match(index, advected=advected, & - thermo_active=thermo_active)) then + thermo_active=thermo_active, & + water_species=water_species)) then ! See if we have room for another constituent cindex = cindex + 1 if (cindex > max_cind) then @@ -1938,6 +1997,28 @@ end subroutine ccpt_is_thermo_active !####################################################################### + subroutine ccpt_is_water_species(this, val_out, errcode, errmsg) + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(in) :: this + logical, intent(out) :: val_out + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + ! Local variable + character(len=*), parameter :: subname = 'ccpt_is_thermo_active' + + if (associated(this%prop)) then + call this%prop%is_water_species(val_out, errcode, errmsg) + else + val_out = .false. + call set_errvars(1, subname//": invalid constituent pointer", & + errcode=errcode, errmsg=errmsg) + end if + + end subroutine ccpt_is_water_species + + !####################################################################### + subroutine ccpt_is_advected(this, val_out, errcode, errmsg) ! Dummy arguments @@ -2307,4 +2388,30 @@ subroutine ccpt_set_thermo_active(this, thermo_flag, errcode, errmsg) end subroutine ccpt_set_thermo_active + !####################################################################### + + subroutine ccpt_set_water_species(this, water_flag, errcode, errmsg) + ! Set whether this constituent is a water species, which means + ! that this constituent represents a particular phase or type + ! of water in the atmosphere. + + ! Dummy arguments + class(ccpp_constituent_prop_ptr_t), intent(inout) :: this + logical, intent(in) :: water_flag + integer, optional, intent(out) :: errcode + character(len=*), optional, intent(out) :: errmsg + ! Local variable + character(len=*), parameter :: subname = 'ccpt_set_water_species' + + if (associated(this%prop)) then + if (this%prop%is_instantiated(errcode, errmsg)) then + this%prop%water_species = water_flag + end if + else + call set_errvars(1, subname//": invalid constituent pointer", & + errcode=errcode, errmsg=errmsg) + end if + + end subroutine ccpt_set_water_species + end module ccpp_constituent_prop_mod From 456741000ba56a52848163ce4bcd839fe1468153 Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Fri, 29 Sep 2023 09:10:42 -0600 Subject: [PATCH 2/4] Add 'water_species' property unit tests. --- test/advection_test/test_host.F90 | 53 +++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/test/advection_test/test_host.F90 b/test/advection_test/test_host.F90 index bdc1068f..9a86b1b3 100644 --- a/test/advection_test/test_host.F90 +++ b/test/advection_test/test_host.F90 @@ -569,6 +569,59 @@ subroutine test_host(retval, test_suites) end if !------------------- + !------------------- + !water-species tests: + !------------------- + + !Check that being thermodynamically active defaults to False: + call const_props(index_liq)%is_water_species(check, errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to get water_species prop for cld_liq index = ", index_liq, & + trim(errmsg) + errflg_final = -1 !Notify test script that a failure occurred + end if + if (errflg == 0) then + if (check) then !Should be False + write(6, *) "ERROR: 'is_water_species' should default to False ", & + "for all constituents unless set by host model." + errflg_final = -1 !Notify test script that a failure occured + end if + else + !Reset error flag to continue testing other properties: + errflg = 0 + end if + + !Check that setting a constituent to be a water species works + !as expected: + call const_props(index_liq)%set_water_species(.true., errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to set water_species prop for cld_liq index = ", index_liq, & + trim(errmsg) + errflg_final = -1 !Notify test script that a failure occurred + end if + if (errflg == 0) then + call const_props(index_liq)%is_water_species(check, errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,i0,/,a)') "ERROR: Error, ", errflg, & + " trying to get water_species prop for cld_liq index = ", & + index_liq, trim(errmsg) + errflg_final = -1 !Notify test script that a failure occurred + end if + end if + if (errflg == 0) then + if (.not.check) then !Should now be True + write(6, *) "ERROR: 'set_water_species' did not set", & + " water_species constituent property correctly." + errflg_final = -1 !Notify test script that a failure occurred + end if + else + !Reset error flag to continue testing other properties: + errflg = 0 + end if + !------------------- + !Check that setting a constituent's default value works as expected call const_props(index_liq)%has_default(has_default, errflg, errmsg) if (errflg /= 0) then From 900b4fcd4636dd8770f0e030033d1ef7799aecc5 Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Tue, 3 Oct 2023 09:17:37 -0600 Subject: [PATCH 3/4] Fix comments in water species routines. --- src/ccpp_constituent_prop_mod.F90 | 4 ++-- test/advection_test/test_host.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ccpp_constituent_prop_mod.F90 b/src/ccpp_constituent_prop_mod.F90 index 25ec5e6c..60eab202 100644 --- a/src/ccpp_constituent_prop_mod.F90 +++ b/src/ccpp_constituent_prop_mod.F90 @@ -639,7 +639,7 @@ subroutine ccp_set_water_species(this, water_flag, errcode, errmsg) integer, optional, intent(out) :: errcode character(len=*), optional, intent(out) :: errmsg - !Set thermodynamically active flag for this constituent: + !Set water species flag for this constituent: if (this%is_instantiated(errcode, errmsg)) then this%water_species = water_flag end if @@ -676,7 +676,7 @@ subroutine ccp_is_water_species(this, val_out, errcode, errmsg) character(len=*), optional, intent(out) :: errmsg !If instantiated then check if constituent is - !thermodynamically active, otherwise return false: + !a water species, otherwise return false: if (this%is_instantiated(errcode, errmsg)) then val_out = this%water_species else diff --git a/test/advection_test/test_host.F90 b/test/advection_test/test_host.F90 index 9a86b1b3..b8b7e3a9 100644 --- a/test/advection_test/test_host.F90 +++ b/test/advection_test/test_host.F90 @@ -573,7 +573,7 @@ subroutine test_host(retval, test_suites) !water-species tests: !------------------- - !Check that being thermodynamically active defaults to False: + !Check that being a water species defaults to False: call const_props(index_liq)%is_water_species(check, errflg, errmsg) if (errflg /= 0) then write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & From 8b0d1f6b00f072b19a1da8a3647bfa8e087ee387 Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Tue, 10 Oct 2023 16:01:42 -0600 Subject: [PATCH 4/4] Add space between '.not.' and logical to improve readability. --- test/advection_test/test_host.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/advection_test/test_host.F90 b/test/advection_test/test_host.F90 index b8b7e3a9..7ec3f24e 100644 --- a/test/advection_test/test_host.F90 +++ b/test/advection_test/test_host.F90 @@ -558,7 +558,7 @@ subroutine test_host(retval, test_suites) end if end if if (errflg == 0) then - if (.not.check) then !Should now be True + if (.not. check) then !Should now be True write(6, *) "ERROR: 'set_thermo_active' did not set", & " thermo_active constituent property correctly." errflg_final = -1 !Notify test script that a failure occurred @@ -611,7 +611,7 @@ subroutine test_host(retval, test_suites) end if end if if (errflg == 0) then - if (.not.check) then !Should now be True + if (.not. check) then !Should now be True write(6, *) "ERROR: 'set_water_species' did not set", & " water_species constituent property correctly." errflg_final = -1 !Notify test script that a failure occurred