From bcc3abaa4878e95b00f1b577c150cef7482bb506 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 5 Nov 2024 11:16:52 -0700 Subject: [PATCH] Constituent bugfixes (#608) Fixes a couple of small bugs in the constituents object 1. Add missing units field to equivalence check and constituent copy 2. Add missing fields to instantiate call 3. Parse mixing ratio type from standard name correctly (if "mixing_ratio_type" not provided to instantiate) 4. Add check of errflg in register to return before allocating if there's an error User interface changes?: No Fixes #587 Testing: test removed: N/A unit tests: All pass system tests: All pass; modified advection test to check new instantiate fields manual testing: Run w/ register phase in CAM-SIMA --------- Co-authored-by: Courtney Peverley --- scripts/host_cap.py | 3 + src/ccpp_constituent_prop_mod.F90 | 41 +++++++++--- test/advection_test/cld_ice.F90 | 5 +- test/advection_test/cld_liq.F90 | 6 +- test/advection_test/test_host.F90 | 86 +++++++++++++++++++++++++- test/advection_test/test_host_data.F90 | 1 + 6 files changed, 126 insertions(+), 16 deletions(-) diff --git a/scripts/host_cap.py b/scripts/host_cap.py index 3412e2cd..2c772d4b 100644 --- a/scripts/host_cap.py +++ b/scripts/host_cap.py @@ -696,6 +696,9 @@ def write_host_cap(host_model, api, module_name, output_dir, run_env): call_str = suite_part_call_list(host_model, const_dict, spart, False, dyn_const=True) cap.write(f"call {suite.name}_{stage}({call_str})", 3) + cap.write("if (errflg /= 0) then", 3) + cap.write("return", 4) + cap.write("end if", 3) # Allocate the suite's dynamic constituents array size_string = "0+" for var in host_local_vars.variable_list(): diff --git a/src/ccpp_constituent_prop_mod.F90 b/src/ccpp_constituent_prop_mod.F90 index c4086099..fde83d08 100644 --- a/src/ccpp_constituent_prop_mod.F90 +++ b/src/ccpp_constituent_prop_mod.F90 @@ -228,6 +228,8 @@ subroutine copyConstituent(outConst, inConst) outConst%molar_mass_val = inConst%molar_mass_val outConst%thermo_active = inConst%thermo_active outConst%water_species = inConst%water_species + outConst%var_units = inConst%var_units + outConst%const_water = inConst%const_water end subroutine copyConstituent !####################################################################### @@ -371,7 +373,8 @@ end function ccp_is_instantiated !####################################################################### subroutine ccp_instantiate(this, std_name, long_name, units, vertical_dim, & - advected, default_value, min_value, molar_mass, errcode, errmsg) + advected, default_value, min_value, molar_mass, water_species, & + mixing_ratio_type, errcode, errmsg) ! Initialize all fields in ! Dummy arguments @@ -384,6 +387,8 @@ subroutine ccp_instantiate(this, std_name, long_name, units, vertical_dim, & real(kind_phys), optional, intent(in) :: default_value real(kind_phys), optional, intent(in) :: min_value real(kind_phys), optional, intent(in) :: molar_mass + logical, optional, intent(in) :: water_species + character(len=*), optional, intent(in) :: mixing_ratio_type integer, intent(out) :: errcode character(len=*), intent(out) :: errmsg @@ -414,6 +419,9 @@ subroutine ccp_instantiate(this, std_name, long_name, units, vertical_dim, & if (present(molar_mass)) then this%molar_mass_val = molar_mass end if + if (present(water_species)) then + this%water_species = water_species + end if end if if (errcode == 0) then if (index(this%var_std_name, "volume_mixing_ratio") > 0) then @@ -426,14 +434,29 @@ subroutine ccp_instantiate(this, std_name, long_name, units, vertical_dim, & end if if (errcode == 0) then ! Determine if this mixing ratio is dry, moist, or "wet". - if (index(this%var_std_name, "wrt_moist_air") > 0) then - this%const_water = moist_mixing_ratio - else if (this%var_std_name == "specific_humidity") then - this%const_water = moist_mixing_ratio - else if (this%var_std_name == "wrt_total_mass") then - this%const_water = wet_mixing_ratio + ! If a type was provided, use that (if it's valid) + if (present(mixing_ratio_type)) then + if (trim(mixing_ratio_type) == 'wet') then + this%const_water = wet_mixing_ratio + else if (trim(mixing_ratio_type) == 'moist') then + this%const_water = moist_mixing_ratio + else if (trim(mixing_ratio_type) == 'dry') then + this%const_water = dry_mixing_ratio + else + errcode = 1 + write(errmsg, *) 'ccp_instantiate: invalid mixing ratio type. ', & + 'Must be one of: "wet", "moist", or "dry". Got: "', & + trim(mixing_ratio_type), '"' + end if else - this%const_water = dry_mixing_ratio + ! Otherwise, parse it from the standard name + if (index(this%var_std_name, "wrt_moist_air_and_condensed_water") > 0) then + this%const_water = wet_mixing_ratio + else if (index(this%var_std_name, "wrt_moist_air") > 0) then + this%const_water = moist_mixing_ratio + else + this%const_water = dry_mixing_ratio + end if end if end if if (errcode /= 0) then @@ -740,11 +763,13 @@ subroutine ccp_is_equivalent(this, oconst, equiv, errcode, errmsg) 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. & + (trim(this%var_units) == trim(oconst%var_units)) .and. & (this%advected .eqv. oconst%advected) .and. & (this%const_default_value == oconst%const_default_value) .and. & (this%min_val == oconst%min_val) .and. & (this%molar_mass_val == oconst%molar_mass_val) .and. & (this%thermo_active .eqv. oconst%thermo_active) .and. & + (this%const_water == oconst%const_water) .and. & (this%water_species .eqv. oconst%water_species) else equiv = .false. diff --git a/test/advection_test/cld_ice.F90 b/test/advection_test/cld_ice.F90 index ee53529d..759bcab1 100644 --- a/test/advection_test/cld_ice.F90 +++ b/test/advection_test/cld_ice.F90 @@ -36,11 +36,12 @@ subroutine cld_ice_register(dyn_const_ice, errmsg, errcode) call dyn_const_ice(1)%instantiate(std_name='dyn_const1', long_name='dyn const1', & units='kg kg-1', default_value=0._kind_phys, & vertical_dim='vertical_layer_dimension', advected=.true., & - min_value=1000._kind_phys, errcode=errcode, errmsg=errmsg) + min_value=1000._kind_phys, water_species=.true., mixing_ratio_type='wet', & + errcode=errcode, errmsg=errmsg) call dyn_const_ice(2)%instantiate(std_name='dyn_const2_wrt_moist_air', long_name='dyn const2', & units='kg kg-1', default_value=0._kind_phys, & vertical_dim='vertical_layer_dimension', advected=.true., & - errcode=errcode, errmsg=errmsg) + water_species=.false., errcode=errcode, errmsg=errmsg) end subroutine cld_ice_register diff --git a/test/advection_test/cld_liq.F90 b/test/advection_test/cld_liq.F90 index ec19cb17..ab40820f 100644 --- a/test/advection_test/cld_liq.F90 +++ b/test/advection_test/cld_liq.F90 @@ -23,8 +23,6 @@ subroutine cld_liq_register(dyn_const, errmsg, errflg) character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg - character(len=256) :: stdname - errmsg = '' errflg = 0 allocate(dyn_const(1), stat=errflg) @@ -32,11 +30,11 @@ subroutine cld_liq_register(dyn_const, errmsg, errflg) errmsg = 'Error allocating dyn_const in cld_liq_register' return end if - call dyn_const(1)%instantiate(std_name="dyn_const3", long_name='dyn const3', & + call dyn_const(1)%instantiate(std_name="dyn_const3_wrt_moist_air_and_condensed_water", long_name='dyn const3', & units='kg kg-1', default_value=1._kind_phys, & vertical_dim='vertical_layer_dimension', advected=.true., & + water_species=.true., mixing_ratio_type='dry', & errcode=errflg, errmsg=errmsg) - call dyn_const(1)%standard_name(stdname, errcode=errflg, errmsg=errmsg) end subroutine cld_liq_register diff --git a/test/advection_test/test_host.F90 b/test/advection_test/test_host.F90 index 5146097b..74a9af90 100644 --- a/test/advection_test/test_host.F90 +++ b/test/advection_test/test_host.F90 @@ -456,7 +456,7 @@ subroutine test_host(retval, test_suites) call test_host_const_get_index('dyn_const2_wrt_moist_air', index_dyn2, errflg, errmsg) call check_errflg(subname//".index_dyn_const2", errflg, errmsg, & errflg_final) - call test_host_const_get_index('dyn_const3', index_dyn3, errflg, errmsg) + call test_host_const_get_index('dyn_const3_wrt_moist_air_and_condensed_water', index_dyn3, errflg, errmsg) call check_errflg(subname//".index_dyn_const3", errflg, errmsg, & errflg_final) @@ -602,7 +602,38 @@ subroutine test_host(retval, test_suites) ! Reset error flag to continue testing other properties: errflg = 0 end if - ! Check moist mixing ratio for a dynamic constituent + ! Check wet mixing ratio for dynamic constituent 1 + call const_props(index_dyn1)%is_dry(const_log, errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to get dry prop for dyn_const1 index = ", index_dyn1, trim(errmsg) + errflg_final = -1 ! Notify test script that a failure occurred + end if + if (errflg == 0) then + if (const_log) then + write(6, *) "ERROR: dyn_const1 is dry and should be wet" + errflg_final = -1 + end if + else + ! Reset error flag to continue testing other properties: + errflg = 0 + end if + call const_props(index_dyn1)%is_wet(const_log, errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to get wet prop for dyn_const1 index = ", index_dyn1, trim(errmsg) + errflg_final = -1 ! Notify test script that a failure occurred + end if + if (errflg == 0) then + if (.not. const_log) then + write(6, *) "ERROR: dyn_const1 is not wet but should be" + errflg_final = -1 + end if + else + ! Reset error flag to continue testing other properties: + errflg = 0 + end if + ! Check moist mixing ratio for dynamic constituent 2 call const_props(index_dyn2)%is_dry(const_log, errflg, errmsg) if (errflg /= 0) then write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & @@ -633,6 +664,22 @@ subroutine test_host(retval, test_suites) ! Reset error flag to continue testing other properties: errflg = 0 end if + ! Check dry mixing ratio for dynamic constituent 3 + call const_props(index_dyn3)%is_dry(const_log, errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to get dry prop for dyn_const3 index = ", index_dyn3, trim(errmsg) + errflg_final = -1 ! Notify test script that a failure occurred + end if + if (errflg == 0) then + if (.not. const_log) then + write(6, *) "ERROR: dyn_const3 is not dry and should be" + errflg_final = -1 + end if + else + ! Reset error flag to continue testing other properties: + errflg = 0 + end if ! ------------------- @@ -866,6 +913,41 @@ subroutine test_host(retval, test_suites) ! Reset error flag to continue testing other properties: errflg = 0 end if + + ! Check that setting a constituent to be a water species via the + ! instantiate call works as expected + call const_props(index_dyn1)%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 dyn_const1 index = ", & + index_dyn1, trim(errmsg) + end if + if (errflg == 0) then + if (.not. check) then ! Should now be True + write(6,*) "ERROR: 'water_species=.true. 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 + call const_props(index_dyn2)%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 dyn_const2 index = ", & + index_dyn2, trim(errmsg) + end if + if (errflg == 0) then + if (check) then ! Should now be False + write(6,*) "ERROR: 'water_species=.false. 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 diff --git a/test/advection_test/test_host_data.F90 b/test/advection_test/test_host_data.F90 index c2d99798..ee33b66a 100644 --- a/test/advection_test/test_host_data.F90 +++ b/test/advection_test/test_host_data.F90 @@ -24,6 +24,7 @@ subroutine allocate_physics_state(cols, levels, constituents, state) deallocate(state%ps) end if allocate(state%ps(cols)) + state%ps = 0.0_kind_phys if (allocated(state%temp)) then deallocate(state%temp) end if