Skip to content

Commit

Permalink
Add more clean routines at the end so can do a different test that sh…
Browse files Browse the repository at this point in the history 
…ows increasing wind has more dust emission
  • Loading branch information
@ekluzek
ekluzek committed May 22, 2024
1 parent eedbadf commit ae5dbea
Show file tree
Hide file tree
Showing 2 changed files with 121 additions and 24 deletions.
51 changes: 45 additions & 6 deletions src/biogeochem/DUSTMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,8 @@ module DUSTMod
procedure , public :: DustDryDep ! Turbulent dry deposition for dust
procedure , public :: WritePatchToLog ! Write information on the given patch to the log file
procedure , public :: GetPatchVars ! Get important variables on a given patch
procedure , public :: GetConstVars ! Get important constant variables
procedure , public :: Clean ! Deallocate data
procedure , private :: InitAllocate
procedure , private :: InitHistory
procedure , private :: InitCold
Expand Down Expand Up @@ -94,6 +96,32 @@ subroutine Init(this, bounds, NLFilename)

end subroutine Init



!------------------------------------------------------------------------
subroutine Clean(this)
!
! !ARGUMENTS:
class (dust_type) :: this
!
! !LOCAL VARIABLES:
!------------------------------------------------------------------------

deallocate(this%flx_mss_vrt_dst_patch)
deallocate(this%flx_mss_vrt_dst_tot_patch)
deallocate(this%vlc_trb_patch)
deallocate(this%vlc_trb_1_patch)
deallocate(this%vlc_trb_2_patch)
deallocate(this%vlc_trb_3_patch)
deallocate(this%vlc_trb_4_patch)
deallocate(this%mbl_bsn_fct_col)

deallocate (ovr_src_snk_mss)
deallocate (dmt_vwr)
deallocate (stk_crc)

end subroutine Clean

!------------------------------------------------------------------------
subroutine InitAllocate(this, bounds)
!
Expand Down Expand Up @@ -221,19 +249,17 @@ subroutine WritePatchToLog(this, p)
class(dust_type), intent(in) :: this
integer , intent(in) :: p ! Patch to display

write(iulog,*) 'flx_mss_vrt_dst', this%flx_mss_vrt_dst_patch(p,:)
write(iulog,*) 'flx_mss_vrt_dst_tot', this%flx_mss_vrt_dst_tot_patch(p)
write(iulog,*) 'vlc_trb_1', this%vlc_trb_1_patch(p)
write(iulog,*) 'vlc_trb_2', this%vlc_trb_2_patch(p)
write(iulog,*) 'vlc_trb_3', this%vlc_trb_3_patch(p)
write(iulog,*) 'vlc_trb_4', this%vlc_trb_4_patch(p)
write(iulog,*) 'mbl_bsn_fct', this%mbl_bsn_fct_col(p)
end subroutine WritePatchToLog
end subroutine WritePatchToLog

!-----------------------------------------------------------------------

subroutine GetPatchVars(this, p, flx_mss_vrt_dst, flx_mss_vrt_dst_tot, vlc_trb, vlc_trb_1, &
vlc_trb_2, vlc_trb_3, vlc_trb_4)
subroutine GetPatchVars(this, p, flx_mss_vrt_dst, flx_mss_vrt_dst_tot, vlc_trb, vlc_trb_1, &
vlc_trb_2, vlc_trb_3, vlc_trb_4)
!
! !DESCRIPTION:
! Get important variables on the given patch
Expand All @@ -255,7 +281,20 @@ subroutine GetPatchVars(this, p, flx_mss_vrt_dst, flx_mss_vrt_dst_tot, vlc_trb,
if ( present(vlc_trb_2) ) vlc_trb_2 = this%vlc_trb_2_patch(p)
if ( present(vlc_trb_3) ) vlc_trb_3 = this%vlc_trb_3_patch(p)
if ( present(vlc_trb_4) ) vlc_trb_4 = this%vlc_trb_4_patch(p)
end subroutine GetPatchVars
end subroutine GetPatchVars

!-----------------------------------------------------------------------

subroutine GetConstVars(this, SaltationFactor )
!
! !DESCRIPTION:
! Get important constant variables
! !ARGUMENTS:
class(dust_type) , intent(in) :: this
real(r8) , intent(out) :: SaltationFactor

SaltationFactor = tmp1
end subroutine GetConstVars

!------------------------------------------------------------------------
subroutine DustEmission (this, bounds, &
Expand Down
94 changes: 76 additions & 18 deletions src/biogeochem/test/DustEmis_test/test_DustEmis.pf
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,15 +8,15 @@ module test_DustEmis
use clm_varpar, only : nlevsoi, nlevgrnd, nlevsno, clm_varpar_init, ndst
use clm_varctl, only : soil_layerstruct_predefined, create_crop_landunit, use_crop, create_crop_landunit
use clm_varcon, only : clm_varcon_init, clm_varcon_clean
use SnowHydrologyMod, only : InitSnowLayers, SnowHydrologySetControlForTesting
use SnowHydrologyMod, only : InitSnowLayers, SnowHydrologySetControlForTesting, SnowHydrologyClean
use DUSTMod
use shr_kind_mod , only : r8 => shr_kind_r8
use unittestFilterBuilderMod, only : filter_from_range
use atm2lndType, only : atm2lnd_type, atm2lnd_params_type
use SoilStateType, only : soilstate_type
use CanopyStateType, only : canopystate_type
use TemperatureType, only : temperature_type
use WaterType, only : water_type
use WaterType, only : water_type
use FrictionVelocityMod, only : frictionvel_type
use unittestWaterTypeFactory, only : unittest_water_type_factory_type
use abortutils, only : endrun
Expand All @@ -43,7 +43,7 @@ module test_DustEmis
procedure :: setupEnvironment
procedure :: create_atm2lnd
procedure :: create_fv
procedure :: print_patch
procedure :: print_values
procedure :: validate_patch
end type TestDustEmis

Expand Down Expand Up @@ -116,7 +116,9 @@ contains
subroutine tearDown(this)
class(TestDustEmis), intent(inout) :: this

call this%dust_emis%Clean()
call this%water_factory%teardown(this%water_inst)
call SnowHydrologyClean()
call unittest_subgrid_teardown()
call this%atm2lnd_inst%Clean()
call clm_varcon_clean()
Expand Down Expand Up @@ -163,7 +165,7 @@ contains
grc%londeg(:) = 0.0_r8

grc%area(:) = 10.0_r8

end subroutine setupEnvironment

!-----------------------------------------------------------------------
Expand Down Expand Up @@ -207,54 +209,66 @@ contains
! Initializes some fields needed for dust emissions in this%frictionvel_inst, and sets
! fields based on inputs. Excluded inputs are given a default value
class(TestDustEmis), intent(inout) :: this
real(r8), intent(in), optional :: fv(:)
real(r8), intent(in), optional :: u10(:)
real(r8), intent(in), optional :: ram1(:)
real(r8), intent(in), optional :: fv
real(r8), intent(in), optional :: u10
real(r8), intent(in), optional :: ram1

real(r8), parameter :: fv_default = 0.2_r8
real(r8), parameter :: fv_default = 2.0_r8
real(r8), parameter :: u10_default = 4._r8
real(r8), parameter :: ram1_default = 200._r8
! ------------------------------------------------------------------------

if (present(fv)) then
this%frictionvel_inst%fv_patch(bounds%begp:bounds%endp) = fv(:)
this%frictionvel_inst%fv_patch(bounds%begp:bounds%endp) = fv
else
this%frictionvel_inst%fv_patch(bounds%begp:bounds%endp) = fv_default
end if

if (present(u10)) then
this%frictionvel_inst%u10_patch(bounds%begp:bounds%endp) = u10(:)
this%frictionvel_inst%u10_patch(bounds%begp:bounds%endp) = u10
else
this%frictionvel_inst%u10_patch(bounds%begp:bounds%endp) = u10_default
end if

if (present(ram1)) then
this%frictionvel_inst%ram1_patch(bounds%begp:bounds%endp) = ram1(:)
this%frictionvel_inst%ram1_patch(bounds%begp:bounds%endp) = ram1
else
this%frictionvel_inst%ram1_patch(bounds%begp:bounds%endp) = ram1_default
end if

end subroutine create_fv

subroutine print_patch(this)
subroutine print_values(this)
use LandunitType, only : lun
use PatchType, only : patch
class(TestDustEmis), intent(inout) :: this
real(r8) :: SaltationFactor
integer :: p, c, l

call this%dust_emis%GetConstVars( SaltationFactor )
do l = bounds%begl, bounds%endl
print *, 'landunit type= ', lun%itype(l)
end do
do c = bounds%begc, bounds%endc
print *, 'watsat = ', this%soilstate_inst%watsat_col(c,1)
print *, 'h2osoi_vol = ', this%water_inst%waterstatebulk_inst%h2osoi_vol_col(c,1)
print *, 'frac_sno = ', this%water_inst%waterdiagnosticbulk_inst%frac_sno_col(c)
print *, 'mss_frac_clay_vld = ', this%soilstate_inst%mss_frc_cly_vld_col(c)
print *, 'saltation per rho = ', (SaltationFactor / this%atm2lnd_inst%forc_rho_downscaled_col(c))
end do
do p = bounds%begp, bounds%endp
print *, 'patch type= ', patch%itype(p)
print *, 'patch weight= ', patch%wtgcell(p)
print *, 'patch active= ', patch%active(p)
print *, 'tlai = ', this%canopystate_inst%tlai_patch(p)
print *, 'tsai = ', this%canopystate_inst%tsai_patch(p)
c = patch%column(p)
print *, 'Wind threshold fraction = ', (SaltationFactor / this%atm2lnd_inst%forc_rho_downscaled_col(c)) &
/ this%frictionvel_inst%fv_patch(p)
call this%dust_emis%WritePatchToLog( p )
end do
call endrun( "exit early")
end subroutine print_patch
end subroutine print_values

!-----------------------------------------------------------------------
subroutine validate_patch(this, p)
Expand Down Expand Up @@ -284,6 +298,7 @@ contains

@Test
subroutine check_dust_emis(this)
! Check dust emissions for default values
class(TestDustEmis), intent(inout) :: this
integer :: p
real(r8) :: flx_mss_vrt_dst_tot
Expand All @@ -303,15 +318,58 @@ contains
call this%dust_emis%GetPatchVars( p, flx_mss_vrt_dst_tot=flx_mss_vrt_dst_tot, &
vlc_trb_1=vlc_trb_1, vlc_trb_2=vlc_trb_2, vlc_trb_3=vlc_trb_3, &
vlc_trb_4=vlc_trb_4)
@assertEqual( 0.0_r8, flx_mss_vrt_dst_tot )
@assertEqual( 3.319559266672431d-5, vlc_trb_1, tolerance=tol )
@assertEqual( 1.699714729099379d-5, vlc_trb_2, tolerance=tol )
@assertEqual( 9.163854318535118d-6, vlc_trb_3, tolerance=tol )
@assertEqual( 3.614237762488103d-5, vlc_trb_4, tolerance=tol )
@assertEqual( flx_mss_vrt_dst_tot, 2.239779135859605d-5, tolerance=tol )
@assertEqual( vlc_trb_1, 3.407721147709135d-003, tolerance=tol )
@assertEqual( vlc_trb_2, 4.961153753164878d-003, tolerance=tol )
@assertEqual( vlc_trb_3, 4.980100969983446d-003, tolerance=tol )
@assertEqual( vlc_trb_4, 4.977071672163210d-003, tolerance=tol )
end do

end subroutine check_dust_emis

@Test
subroutine check_dust_emis_increasing_wind(this)
! Check dust emissions with increasing wind
class(TestDustEmis), intent(inout) :: this
integer :: p, c
real(r8) :: flx_mss_vrt_dst_tot
real(r8) :: vlc_trb_1
real(r8) :: vlc_trb_2
real(r8) :: vlc_trb_3
real(r8) :: vlc_trb_4
real(r8) :: fv = 4.0_r8
real(r8) :: u10 = 10._r8
real(r8) :: total_dust0, total_dust_higher

! Run baseline u10
call this%create_atm2lnd()
call this%create_fv( u10=u10, fv=fv )
call this%dust_emis%DustEmission(bounds, this%num_nolakep, this%filter_nolakep, this%atm2lnd_inst, &
this%soilstate_inst, this%canopystate_inst, this%water_inst%waterstatebulk_inst, &
this%water_inst%waterdiagnosticbulk_inst, this%frictionvel_inst)
call this%dust_emis%DustDryDep(bounds, this%atm2lnd_inst, this%frictionvel_inst)
do p = bounds%begp, bounds%endp
call this%validate_patch(p)
call this%dust_emis%GetPatchVars( p, flx_mss_vrt_dst_tot=flx_mss_vrt_dst_tot )
total_dust0 = flx_mss_vrt_dst_tot
@assertEqual( flx_mss_vrt_dst_tot, 1.971366884000767d-4, tolerance=tol )
end do
! Double u10 and show result is higher
call this%create_fv( u10=u10*2.0_r8, fv=fv)
call this%dust_emis%DustEmission(bounds, this%num_nolakep, this%filter_nolakep, this%atm2lnd_inst, &
this%soilstate_inst, this%canopystate_inst, this%water_inst%waterstatebulk_inst, &
this%water_inst%waterdiagnosticbulk_inst, this%frictionvel_inst)
call this%dust_emis%DustDryDep(bounds, this%atm2lnd_inst, this%frictionvel_inst)
do p = bounds%begp, bounds%endp
call this%validate_patch(p)
call this%dust_emis%GetPatchVars( p, flx_mss_vrt_dst_tot=flx_mss_vrt_dst_tot )
total_dust_higher = flx_mss_vrt_dst_tot
@assertEqual( flx_mss_vrt_dst_tot, 3.288208220877217d-4, tolerance=tol )
end do
@assertGreaterThan( total_dust_higher, total_dust0 )

end subroutine check_dust_emis_increasing_wind

!-----------------------------------------------------------------------

end module test_DustEmis

0 comments on commit ae5dbea

Please sign in to comment.