From e48faa553c0b360ec6bd16cf7aa11f72e3a79d52 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 12 Feb 2024 17:54:19 -0700 Subject: [PATCH] expand testing --- test/advection_test/cld_ice.F90 | 4 +- test/advection_test/cld_liq.F90 | 2 +- test/advection_test/test_host.F90 | 105 ++++++++++++++++++++++---- test/advection_test/test_host_mod.F90 | 4 +- 4 files changed, 95 insertions(+), 20 deletions(-) diff --git a/test/advection_test/cld_ice.F90 b/test/advection_test/cld_ice.F90 index a588138b..0a1e13ee 100644 --- a/test/advection_test/cld_ice.F90 +++ b/test/advection_test/cld_ice.F90 @@ -108,11 +108,11 @@ subroutine cld_ice_dynamic_constituents(dyn_const, errcode, errmsg) call dyn_const(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., & - errcode=errcode, errmsg=errmsg) + min_value=1000._kind_phys, errcode=errcode, errmsg=errmsg) if (errcode /= 0) then return end if - call dyn_const(2)%instantiate(std_name='dyn_const2', long_name='dyn const2', & + call dyn_const(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) diff --git a/test/advection_test/cld_liq.F90 b/test/advection_test/cld_liq.F90 index 4fda40e3..63148c52 100644 --- a/test/advection_test/cld_liq.F90 +++ b/test/advection_test/cld_liq.F90 @@ -88,7 +88,7 @@ subroutine cld_liq_dynamic_constituents(dyn_const, errcode, errmsg) errmsg = 'Error allocating dyn_const in cld_liq_dynamic_constituents' end if call dyn_const(1)%instantiate(std_name="dyn_const3", long_name='dyn const3', & - units='kg kg-1', default_value=0._kind_phys, & + units='kg kg-1', default_value=1._kind_phys, & vertical_dim='vertical_layer_dimension', advected=.true., & errcode=errcode, errmsg=errmsg) diff --git a/test/advection_test/test_host.F90 b/test/advection_test/test_host.F90 index 8fc52178..2a151751 100644 --- a/test/advection_test/test_host.F90 +++ b/test/advection_test/test_host.F90 @@ -245,7 +245,8 @@ subroutine test_host(retval, test_suites) logical :: check integer :: col_start, col_end integer :: index, sind - integer :: index_liq, index_ice, index_dyn + integer :: index_liq, index_ice + integer :: index_dyn1, index_dyn2, index_dyn3 integer :: time_step integer :: num_suites integer :: num_advected ! Num advected species @@ -380,13 +381,13 @@ subroutine test_host(retval, test_suites) errflg_final) ! Check if the dynamic constituents indices can be found - call test_host_const_get_index('dyn_const1', index_dyn, errflg, errmsg) + call test_host_const_get_index('dyn_const1', index_dyn1, errflg, errmsg) call check_errflg(subname//".index_dyn_const1", errflg, errmsg, & errflg_final) - call test_host_const_get_index('dyn_const2', index_dyn, errflg, errmsg) + 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_dyn, errflg, errmsg) + call test_host_const_get_index('dyn_const3', index_dyn3, errflg, errmsg) call check_errflg(subname//".index_dyn_const3", errflg, errmsg, & errflg_final) @@ -398,7 +399,7 @@ subroutine test_host(retval, test_suites) return end if - call init_data(const_ptr, index, index_liq, index_ice) + call init_data(const_ptr, index, index_liq, index_ice, index_dyn3) ! Check some constituent properties !++++++++++++++++++++++++++++++++++ @@ -423,6 +424,25 @@ subroutine test_host(retval, test_suites) !Reset error flag to continue testing other properties: errflg = 0 end if + !Check standard name for a dynamic constituent + call const_props(index_dyn2)%standard_name(const_str, errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to get standard_name for dyn_const2, index = ", & + index_dyn2, trim(errmsg) + errflg_final = -1 !Notify test script that a failure occured + end if + if (errflg == 0) then + if (trim(const_str) /= 'dyn_const2_wrt_moist_air') then + write(6, *) "ERROR: standard name, '", trim(const_str), & + "' should be 'dyn_const2_wrt_moist_air'" + 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 + !Long name: call const_props(index_liq)%long_name(const_str, errflg, errmsg) @@ -442,7 +462,24 @@ subroutine test_host(retval, test_suites) !Reset error flag to continue testing other properties: errflg = 0 end if - + !Check long name for a dynamic constituent + call const_props(index_dyn1)%long_name(const_str, errflg, errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to get long_name for dyn_const1 index = ", & + index_dyn1, trim(errmsg) + errflg_final = -1 !Notify test script that a failure occured + end if + if (errflg == 0) then + if (trim(const_str) /= 'dyn const1') then + write(6, *) "ERROR: long name, '", trim(const_str), & + "' should be 'dyn const1'" + 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 !Mass mixing ratio: call const_props(index_ice)%is_mass_mixing_ratio(const_log, errflg, & errmsg) @@ -461,6 +498,24 @@ subroutine test_host(retval, test_suites) !Reset error flag to continue testing other properties: errflg = 0 end if + !Check mass mixing ratio for a dynamic constituent + call const_props(index_dyn2)%is_mass_mixing_ratio(const_log, errflg, & + errmsg) + if (errflg /= 0) then + write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & + "to get mass mixing ratio prop for dyn_const2 index = ", & + index_dyn2, trim(errmsg) + errflg_final = -1 !Notify test script that a failure occured + end if + if (errflg == 0) then + if (.not. const_log) then + write(6, *) "ERROR: dyn_const2 is not a mass mixing_ratio" + 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 !Dry mixing ratio: call const_props(index_ice)%is_dry(const_log, errflg, errmsg) @@ -478,16 +533,34 @@ 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 + 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 ", & + "to get dry prop for dyn_const2 index = ", index_dyn2, 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_const2 is dry" + errflg_final = -1 + end if + else + !Reset error flag to continue testing other properties: + errflg = 0 + end if + + !------------------- !------------------- !minimum value tests: !------------------- !Check that a constituent's minimum value defaults to zero: - call const_props(index_ice)%minimum(check_value, errflg, errmsg) + call const_props(index_dyn2)%minimum(check_value, errflg, errmsg) if (errflg /= 0) then write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & - "to get minimum value for cld_ice index = ", index_ice, & + "to get minimum value for dyn_const2 index = ", index_dyn2, & trim(errmsg) errflg_final = -1 !Notify test script that a failure occurred end if @@ -504,17 +577,17 @@ subroutine test_host(retval, test_suites) !Check that a constituent instantiated with a specified minimum value !actually contains that minimum value property: - call const_props(index)%minimum(check_value, errflg, errmsg) + call const_props(index_dyn1)%minimum(check_value, errflg, errmsg) if (errflg /= 0) then write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & - "to get minimum value for specific humidity index = ", index, & + "to get minimum value 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 (check_value /= 1000._kind_phys) then !Should be 1000 write(6, *) "ERROR: 'minimum' should give a value of 1000 ", & - "for specific humidity, as was set during instantiation." + "for dyn_const1, as was set during instantiation." errflg_final = -1 !Notify test script that a failure occured end if else @@ -524,19 +597,19 @@ subroutine test_host(retval, test_suites) !Check that setting a constituent's minimum value works !as expected: - call const_props(index_ice)%set_minimum(1._kind_phys, errflg, errmsg) + call const_props(index_dyn1)%set_minimum(1._kind_phys, errflg, errmsg) if (errflg /= 0) then write(6, '(a,i0,a,a,i0,/,a)') "ERROR: Error, ", errflg, " trying ", & - "to set minimum value for cld_ice index = ", index_ice, & + "to set minimum value for dyn_const1 index = ", index_dyn1, & trim(errmsg) errflg_final = -1 !Notify test script that a failure occurred end if if (errflg == 0) then - call const_props(index_ice)%minimum(check_value, errflg, errmsg) + call const_props(index_dyn1)%minimum(check_value, errflg, errmsg) if (errflg /= 0) then write(6, '(a,i0,a,i0,/,a)') "ERROR: Error, ", errflg, & - " trying to get minimum value for cld_ice index = ", & - index_ice, trim(errmsg) + " trying to get minimum value for dyn_const1 index = ", & + index_dyn1, trim(errmsg) errflg_final = -1 !Notify test script that a failure occurred end if end if diff --git a/test/advection_test/test_host_mod.F90 b/test/advection_test/test_host_mod.F90 index 560b7619..0ae75b3d 100644 --- a/test/advection_test/test_host_mod.F90 +++ b/test/advection_test/test_host_mod.F90 @@ -34,13 +34,14 @@ module test_host_mod contains - subroutine init_data(constituent_array, index_qv_use, index_liq, index_ice) + subroutine init_data(constituent_array, index_qv_use, index_liq, index_ice, index_dyn) ! Dummy arguments real(kind_phys), pointer :: constituent_array(:,:,:) ! From host & suites integer, intent(in) :: index_qv_use integer, intent(in) :: index_liq integer, intent(in) :: index_ice + integer, intent(in) :: index_dyn ! Local variables integer :: col @@ -60,6 +61,7 @@ subroutine init_data(constituent_array, index_qv_use, index_liq, index_ice) ind_ice = index_ice allocate(check_vals(ncols, pver, ncnst)) check_vals(:,:,:) = 0.0_kind_phys + check_vals(:,:,index_dyn) = 1.0_kind_phys do lev = 1, pver phys_state%temp(:, lev) = tfreeze + (10.0_kind_phys * (lev - 3)) qmax = real(lev, kind_phys)