Skip to content

Commit

Permalink
expand testing
Browse files Browse the repository at this point in the history
  • Loading branch information
Courtney Peverley committed Feb 13, 2024
1 parent bd0ae2e commit e48faa5
Show file tree
Hide file tree
Showing 4 changed files with 95 additions and 20 deletions.
4 changes: 2 additions & 2 deletions test/advection_test/cld_ice.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion test/advection_test/cld_liq.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
105 changes: 89 additions & 16 deletions test/advection_test/test_host.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)

Expand All @@ -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
!++++++++++++++++++++++++++++++++++
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
4 changes: 3 additions & 1 deletion test/advection_test/test_host_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down

0 comments on commit e48faa5

Please sign in to comment.