Skip to content

Commit

Permalink
Merge pull request #8 from nusbaume/qmin_setter
Browse files Browse the repository at this point in the history 
Add minimum value setter method.
  • Loading branch information
@nusbaume
nusbaume authored Sep 25, 2023
2 parents 3a970eb + f635213 commit 627e78f
Show file tree
Hide file tree
Showing 2 changed files with 113 additions and 2 deletions.
55 changes: 54 additions & 1 deletion src/ccpp_constituent_prop_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,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_minimum => ccp_set_min_val
end type ccpp_constituent_properties_t

!! \section arg_table_ccpp_constituent_prop_ptr_t
Expand Down Expand Up @@ -116,6 +117,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_minimum => ccpt_set_min_val
end type ccpp_constituent_prop_ptr_t

!! \section arg_table_ccpp_model_constituents_t
Expand Down Expand Up @@ -805,6 +807,26 @@ end subroutine ccp_min_val

!########################################################################

subroutine ccp_set_min_val(this, min_value, errcode, errmsg)
! Set the minimum value of this particular constituent.
! If this subroutine is never used then the minimum
! value defaults to zero.

! Dummy arguments
class(ccpp_constituent_properties_t), intent(inout) :: this
real(kind_phys), intent(in) :: min_value
integer, optional, intent(out) :: errcode
character(len=*), optional, intent(out) :: errmsg

!Set minimum allowed value for this constituent:
if (this%is_instantiated(errcode, errmsg)) then
this%min_val = min_value
end if

end subroutine ccp_set_min_val

!########################################################################

subroutine ccp_molec_weight(this, val_out, errcode, errmsg)

! Dummy arguments
Expand Down Expand Up @@ -1299,6 +1321,7 @@ subroutine ccp_model_const_data_lock(this, ncols, num_layers, errcode, errmsg)
! Local variables
integer :: astat, index
real(kind=kind_phys) :: default_value
real(kind=kind_phys) :: minvalue
character(len=*), parameter :: subname = 'ccp_model_const_data_lock'

if (this%const_data_locked(errcode=errcode, errmsg=errmsg, warn_func=subname)) then
Expand All @@ -1323,11 +1346,16 @@ subroutine ccp_model_const_data_lock(this, ncols, num_layers, errcode, errmsg)
if (astat == 0) then
this%num_layers = num_layers
do index = 1, this%hash_table%num_values()
!Set all constituents to their default values:
call this%const_metadata(index)%default_value(default_value, &
errcode, errmsg)
this%vars_layer(:,:,index) = default_value

!Also set the minimum allowed value array:
call this%const_metadata(index)%minimum(minvalue, errcode, &
errmsg)
this%vars_minvalue(index) = minvalue
end do
this%vars_minvalue = 0.0_kind_phys
end if
if (present(errcode)) then
if (errcode /= 0) then
Expand Down Expand Up @@ -2086,6 +2114,31 @@ end subroutine ccpt_min_val

!########################################################################

subroutine ccpt_set_min_val(this, min_value, errcode, errmsg)
! Set the minimum value of this particular constituent.
! If this subroutine is never used then the minimum
! value defaults to zero.

! Dummy arguments
class(ccpp_constituent_prop_ptr_t), intent(inout) :: this
real(kind_phys), intent(in) :: min_value
integer, optional, intent(out) :: errcode
character(len=*), optional, intent(out) :: errmsg
! Local variable
character(len=*), parameter :: subname = 'ccpt_set_min_val'

!Set minimum value for this constituent:
if (associated(this%prop)) then
call this%prop%set_minimum(min_value, errcode, errmsg)
else
call set_errvars(1, subname//": invalid constituent pointer", &
errcode=errcode, errmsg=errmsg)
end if

end subroutine ccpt_set_min_val

!########################################################################

subroutine ccpt_molec_weight(this, val_out, errcode, errmsg)

! Dummy arguments
Expand Down
60 changes: 59 additions & 1 deletion test/advection_test/test_host.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -259,6 +259,7 @@ subroutine test_host(retval, test_suites)
integer :: errflg_final ! Used to notify testing script of test failure
real(kind_phys), pointer :: const_ptr(:,:,:)
real(kind_phys) :: default_value
real(kind_phys) :: check_value
type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:)
character(len=*), parameter :: subname = 'test_host'

Expand Down Expand Up @@ -463,6 +464,62 @@ subroutine test_host(retval, test_suites)
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)
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, &
trim(errmsg)
errflg_final = -1 !Notify test script that a failure occurred
end if
if (errflg == 0) then
if (check_value /= 0._kind_phys) then !Should be zero
write(6, *) "ERROR: 'minimum' should default to zero for all ", &
"constituents unless set by host model or scheme metadata."
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's minimum value works
!as expected:
call const_props(index_ice)%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, &
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)
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)
errflg_final = -1 !Notify test script that a failure occurred
end if
end if
if (errflg == 0) then
if (check_value /= 1._kind_phys) then !Should now be one
write(6, *) "ERROR: 'set_minimum' did not set constituent", &
" minimum value 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

!-------------------
!thermo-active tests:
!-------------------

!Check that being thermodynamically active defaults to False:
call const_props(index_ice)%is_thermo_active(check, errflg, errmsg)
if (errflg /= 0) then
Expand Down Expand Up @@ -495,7 +552,7 @@ subroutine test_host(retval, test_suites)
call const_props(index_ice)%is_thermo_active(check, errflg, errmsg)
if (errflg /= 0) then
write(6, '(a,i0,a,i0,/,a)') "ERROR: Error, ", errflg, &
" tryingto get thermo_active prop for cld_ice index = ", &
" trying to get thermo_active prop for cld_ice index = ", &
index_ice, trim(errmsg)
errflg_final = -1 !Notify test script that a failure occurred
end if
Expand All @@ -510,6 +567,7 @@ subroutine test_host(retval, test_suites)
!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)
Expand Down

0 comments on commit 627e78f

Please sign in to comment.