Skip to content

Commit

Permalink
Merge pull request #1151 from ekluzek/btran2incnfire
Browse files Browse the repository at this point in the history
Have a copy of btran2 that's just inside CNFire
  • Loading branch information
ekluzek authored Sep 23, 2020
2 parents 9ff7810 + a1526b8 commit 942ec57
Show file tree
Hide file tree
Showing 11 changed files with 207 additions and 44 deletions.
127 changes: 123 additions & 4 deletions src/biogeochem/CNFireBaseMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -74,14 +74,19 @@ module CNFireBaseMod
type, abstract, extends(fire_base_type) :: cnfire_base_type
private
! !PRIVATE MEMBER DATA:
! !PUBLIC MEMBER DATA (used by extensions of the base class):
real(r8), public, pointer :: btran2_patch (:) ! patch root zone soil wetness factor (0 to 1)

contains
!
! !PUBLIC MEMBER FUNCTIONS:
procedure, public :: FireReadNML ! Read in namelist for CNFire
procedure, public :: CNFireReadParams ! Read in constant parameters from the paramsfile
procedure, public :: CNFireArea ! Calculate fire area
procedure, public :: CNFireFluxes ! Calculate fire fluxes
procedure, public :: FireInit => CNFireInit ! Initialization of Fire
procedure, public :: FireReadNML ! Read in namelist for CNFire
procedure, public :: CNFireRestart ! Restart for CNFire
procedure, public :: CNFireReadParams ! Read in constant parameters from the paramsfile
procedure, public :: CNFireArea ! Calculate fire area
procedure, public :: CNFireFluxes ! Calculate fire fluxes
procedure, public :: CNFire_calc_fire_root_wetness ! Calcualte CN-fire specific root wetness
!
end type cnfire_base_type
!-----------------------------------------------------------------------
Expand Down Expand Up @@ -112,6 +117,120 @@ end function need_lightning_and_popdens_interface
contains

!-----------------------------------------------------------------------
subroutine CNFireInit( this, bounds, NLFilename )
!
! !DESCRIPTION:
! Initialize CN Fire module
! !USES:
use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
use clm_varcon , only : spval
use histFileMod , only : hist_addfld1d
!
! !ARGUMENTS:
class(cnfire_base_type) :: this
type(bounds_type), intent(in) :: bounds
character(len=*), intent(in) :: NLFilename
!-----------------------------------------------------------------------
integer :: begp, endp
!------------------------------------------------------------------------
! Call the base-class Initialization method
call this%BaseFireInit( bounds, NLFilename )

begp = bounds%begp; endp= bounds%endp

! Allocate memory
allocate(this%btran2_patch (begp:endp)) ; this%btran2_patch (:) = nan
! History file
this%btran2_patch(begp:endp) = spval
call hist_addfld1d(fname='BTRAN2', units='unitless', &
avgflag='A', long_name='root zone soil wetness factor', &
ptr_patch=this%btran2_patch, l2g_scale_type='veg')
end subroutine CNFireInit

!----------------------------------------------------------------------
subroutine CNFireRestart( this, bounds, ncid, flag )
use ncdio_pio , only : ncd_double, file_desc_t
use restUtilMod , only : restartvar
implicit none
!
! !ARGUMENTS:
class(cnfire_base_type) :: this
type(bounds_type), intent(in) :: bounds
type(file_desc_t), intent(inout) :: ncid
character(len=*) , intent(in) :: flag

logical :: readvar

call restartvar(ncid=ncid, flag=flag, varname='btran2', xtype=ncd_double, &
dim1name='pft', &
long_name='', units='', &
interpinic_flag='interp', readvar=readvar, data=this%btran2_patch)
end subroutine CNFireRestart

!----------------------------------------------------------------------
subroutine CNFire_calc_fire_root_wetness( this, bounds, nlevgrnd, num_exposedvegp, filter_exposedvegp, &
waterstatebulk_inst, soilstate_inst, soil_water_retention_curve )
!
! Calculate the root wetness term that will be used by the fire model
!
use pftconMod , only : pftcon
use PatchType , only : patch
use WaterStateBulkType , only : waterstatebulk_type
use SoilStateType , only : soilstate_type
use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type
class(cnfire_base_type) :: this
type(bounds_type) , intent(in) :: bounds !bounds
integer , intent(in) :: nlevgrnd !number of vertical layers
integer , intent(in) :: num_exposedvegp !number of filters
integer , intent(in) :: filter_exposedvegp(:) !filter array
type(waterstatebulk_type), intent(in) :: waterstatebulk_inst
type(soilstate_type) , intent(in) :: soilstate_inst
class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve
! !LOCAL VARIABLES:
real(r8), parameter :: btran0 = 0.0_r8 ! initial value
real(r8) :: smp_node, s_node !temporary variables
real(r8) :: smp_node_lf !temporary variable
integer :: p, f, j, c, l !indices
!-----------------------------------------------------------------------

SHR_ASSERT_ALL_FL((ubound(filter_exposedvegp) >= (/num_exposedvegp/)), sourcefile, __LINE__)

associate( &
smpso => pftcon%smpso , & ! Input: soil water potential at full stomatal opening (mm)
smpsc => pftcon%smpsc , & ! Input: soil water potential at full stomatal closure (mm)
watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation
btran2 => this%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square
rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer
h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (porosity) (constant)
)

SHR_ASSERT_ALL_FL((ubound(watsat) == (/bounds%endc,nlevgrnd/)), sourcefile, __LINE__)
SHR_ASSERT_ALL_FL((ubound(h2osoi_vol) == (/bounds%endc,nlevgrnd/)), sourcefile, __LINE__)
SHR_ASSERT_ALL_FL((ubound(rootfr) == (/bounds%endp,nlevgrnd/)), sourcefile, __LINE__)
SHR_ASSERT_ALL_FL((ubound(btran2) == (/bounds%endp/)), sourcefile, __LINE__)
do f = 1, num_exposedvegp
p = filter_exposedvegp(f)
btran2(p) = btran0
end do
do j = 1,nlevgrnd
do f = 1, num_exposedvegp
p = filter_exposedvegp(f)
c = patch%column(p)
l = patch%landunit(p)
s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8)

call soil_water_retention_curve%soil_suction(c, j, s_node, soilstate_inst, smp_node_lf)

smp_node_lf = max(smpsc(patch%itype(p)), smp_node_lf)
btran2(p) = btran2(p) +rootfr(p,j)*max(0._r8,min((smp_node_lf - smpsc(patch%itype(p))) / &
(smpso(patch%itype(p)) - smpsc(patch%itype(p))), 1._r8))
end do
end do
end associate

end subroutine CNFire_calc_fire_root_wetness

!----------------------------------------------------------------------
subroutine FireReadNML( this, NLFilename )
!
! !DESCRIPTION:
Expand Down
2 changes: 1 addition & 1 deletion src/biogeochem/CNFireLi2014Mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -160,7 +160,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_
fsr_pft => pftcon%fsr_pft , & ! Input:
fd_pft => pftcon%fd_pft , & ! Input:

btran2 => energyflux_inst%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness
btran2 => this%cnfire_base_type%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness
fsat => saturated_excess_runoff_inst%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface
wf => waterdiagnosticbulk_inst%wf_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.05 m
wf2 => waterdiagnosticbulk_inst%wf2_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m
Expand Down
2 changes: 1 addition & 1 deletion src/biogeochem/CNFireLi2016Mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -170,7 +170,7 @@ subroutine CNFireArea (this, bounds, num_soilc, filter_soilc, num_soilp, filter_
fsr_pft => pftcon%fsr_pft , & ! Input:
fd_pft => pftcon%fd_pft , & ! Input:

btran2 => energyflux_inst%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness
btran2 => this%cnfire_base_type%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness
fsat => saturated_excess_runoff_inst%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface
wf2 => waterdiagnosticbulk_inst%wf2_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m

Expand Down
2 changes: 2 additions & 0 deletions src/biogeochem/CNVegetationFacade.F90
Original file line number Diff line number Diff line change
Expand Up @@ -506,6 +506,8 @@ subroutine Restart(this, bounds, ncid, flag)
end if
call this%n_products_inst%restart(bounds, ncid, flag)

call this%cnfire_method%CNFireRestart(bounds, ncid, flag)

end if

if (use_cndv) then
Expand Down
11 changes: 6 additions & 5 deletions src/biogeophys/CanopyFluxesMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -190,7 +190,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp,
waterdiagnosticbulk_inst, wateratm2lndbulk_inst, ch4_inst, ozone_inst, &
photosyns_inst, &
humanindex_inst, soil_water_retention_curve, &
downreg_patch, leafn_patch, froot_carbon, croot_carbon)
downreg_patch, leafn_patch, froot_carbon, croot_carbon, &
bgc_vegetation_inst)
!
! !DESCRIPTION:
! 1. Calculates the leaf temperature:
Expand Down Expand Up @@ -233,6 +234,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp,
swbgt, hmdex, dis_coi, dis_coiS, THIndex, &
SwampCoolEff, KtoC, VaporPres
use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type
use CNVegetationFacade , only : cn_vegetation_type
!
! !ARGUMENTS:
type(bounds_type) , intent(in) :: bounds
Expand Down Expand Up @@ -262,6 +264,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp,
real(r8), intent(in) :: leafn_patch(bounds%begp:) ! leaf N (gN/m2)
real(r8), intent(inout) :: froot_carbon(bounds%begp:) ! fine root biomass (gC/m2)
real(r8), intent(inout) :: croot_carbon(bounds%begp:) ! live coarse root biomass (gC/m2)
type(cn_vegetation_type) , intent(inout) :: bgc_vegetation_inst
!
! !LOCAL VARIABLES:
real(r8), pointer :: bsun(:) ! sunlit canopy transpiration wetness factor (0 to 1)
Expand Down Expand Up @@ -537,7 +540,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp,
grnd_ch4_cond => ch4_inst%grnd_ch4_cond_patch , & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s]

htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) [J/kg] (constant)
btran2 => energyflux_inst%btran2_patch , & ! Output: [real(r8) (:) ] F. Li and S. Levis
btran => energyflux_inst%btran_patch , & ! Output: [real(r8) (:) ] transpiration wetness factor (0 to 1)
rresis => energyflux_inst%rresis_patch , & ! Output: [real(r8) (:,:) ] root resistance by layer (0-1) (nlevgrnd)
taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2)
Expand Down Expand Up @@ -630,7 +632,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp,
wtaq0(p) = 0._r8
obuold(p) = 0._r8
btran(p) = btran0
btran2(p) = btran0
end do

! calculate daylength control for Vcmax
Expand Down Expand Up @@ -706,8 +707,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp,
temperature_inst=temperature_inst, &
waterstatebulk_inst=waterstatebulk_inst, &
waterdiagnosticbulk_inst=waterdiagnosticbulk_inst, &
soil_water_retention_curve=soil_water_retention_curve)

soil_water_retention_curve=soil_water_retention_curve, &
bgc_vegetation_inst=bgc_vegetation_inst)

end if

Expand Down
12 changes: 0 additions & 12 deletions src/biogeophys/EnergyFluxType.F90
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,6 @@ module EnergyFluxType
real(r8), pointer :: bsha_patch (:) ! patch shaded canopy transpiration wetness factor (0 to 1)

! Roots
real(r8), pointer :: btran2_patch (:) ! patch root zone soil wetness factor (0 to 1)
real(r8), pointer :: rresis_patch (:,:) ! patch root resistance by layer (0-1) (nlevgrnd)

! Latent heat
Expand Down Expand Up @@ -250,7 +249,6 @@ subroutine InitAllocate(this, bounds)
allocate(this%btran_patch (begp:endp)) ; this%btran_patch (:) = nan
allocate(this%btran_min_patch (begp:endp)) ; this%btran_min_patch (:) = nan
allocate(this%btran_min_inst_patch (begp:endp)) ; this%btran_min_inst_patch (:) = nan
allocate(this%btran2_patch (begp:endp)) ; this%btran2_patch (:) = nan
allocate( this%bsun_patch (begp:endp)) ; this%bsun_patch (:) = nan
allocate( this%bsha_patch (begp:endp)) ; this%bsha_patch (:) = nan
allocate( this%errsoi_patch (begp:endp)) ; this%errsoi_patch (:) = nan
Expand Down Expand Up @@ -640,11 +638,6 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp)
avgflag='A', long_name='daily minimum of transpiration beta factor', &
ptr_patch=this%btran_min_patch, l2g_scale_type='veg')

this%btran2_patch(begp:endp) = spval
call hist_addfld1d (fname='BTRAN2', units='unitless', &
avgflag='A', long_name='root zone soil wetness factor', &
ptr_patch=this%btran2_patch, l2g_scale_type='veg')

if (use_cn) then
this%rresis_patch(begp:endp,:) = spval
call hist_addfld2d (fname='RRESIS', units='proportion', type2d='levgrnd', &
Expand Down Expand Up @@ -861,11 +854,6 @@ subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildt
interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_heat_col)
end if

call restartvar(ncid=ncid, flag=flag, varname='btran2', xtype=ncd_double, &
dim1name='pft', &
long_name='', units='', &
interpinic_flag='interp', readvar=readvar, data=this%btran2_patch)

call restartvar(ncid=ncid, flag=flag, varname='BTRAN_MIN', xtype=ncd_double, &
dim1name='pft', &
long_name='daily minimum of transpiration wetness factor', units='', &
Expand Down
Loading

0 comments on commit 942ec57

Please sign in to comment.