Skip to content

Commit

Permalink
Merge pull request #2 from rgknox/parprof
Browse files Browse the repository at this point in the history 
Syntax updates and merge resolution
  • Loading branch information
@ckoven
ckoven authored Apr 17, 2018
2 parents edbc92c + d7520d5 commit d55d039
Show file tree
Hide file tree
Showing 15 changed files with 2,556 additions and 247 deletions.
29 changes: 8 additions & 21 deletions biogeochem/EDCanopyStructureMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -148,20 +148,6 @@ subroutine canopy_structure( currentSite , bc_in )
enddo


! ------------------------------------------------------------------------------
! Check patch area to prevent numerical weirdness
! ------------------------------------------------------------------------------

if (currentPatch%area .lt. min_patch_area) then

write(fates_log(),*) 'An incredibly small patch exists that should'
write(fates_log(),*) 'had been fused or culled already'
write(fates_log(),*) 'currentPatch%area: ',currentPatch%area
write(fates_log(),*) 'min_patch_area: ',min_patch_area
call endrun(msg=errMsg(sourcefile, __LINE__))

end if

! Does any layer have excess area in it? Keep going until it does not...
patch_area_counter = 0
area_not_balanced = .true.
Expand Down Expand Up @@ -1099,6 +1085,13 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
currentPatch%canopy_area_profile(:,:,:) = 0._r8
currentPatch%canopy_mask(:,:) = 0

! ------------------------------------------------------------------------------
! It is remotely possible that in deserts we will not have any canopy
! area, ie not plants at all...
! ------------------------------------------------------------------------------

if (currentPatch%total_canopy_area > tiny(currentPatch%total_canopy_area)) then

currentCohort => currentPatch%shortest
do while(associated(currentCohort))

Expand Down Expand Up @@ -1230,12 +1223,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
! and canopy area to the accumulators.
! -----------------------------------------------------------------------------

! ------------------------------------------------------------------------------
! It is remotely possible that in deserts we will not have any canopy
! area, ie not plants at all...
! ------------------------------------------------------------------------------

if (currentPatch%total_canopy_area > tiny(currentPatch%total_canopy_area)) then

currentCohort => currentPatch%shortest
do while(associated(currentCohort))
Expand Down Expand Up @@ -1393,7 +1380,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
do cl = 1,currentPatch%NCL_p
do iv = 1,currentPatch%ncan(cl,ft)

if( sum(currentPatch%canopy_area_profile(cl,:,iv)) > 1.0001_r8 ) then
if( DEBUG .and. sum(currentPatch%canopy_area_profile(cl,:,iv)) > 1.0001_r8 ) then

write(fates_log(), *) 'FATES: A canopy_area_profile exceeded 1.0'
write(fates_log(), *) 'cl: ',cl
Expand Down
2 changes: 1 addition & 1 deletion biogeochem/EDLoggingMortalityMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@ module EDLoggingMortalityMod
use EDParamsMod , only : logging_direct_frac
use EDParamsMod , only : logging_mechanical_frac
use EDParamsMod , only : logging_coll_under_frac
use EDParamsMod , only : logging_dbhmax_infra
use FatesInterfaceMod , only : hlm_current_year
use FatesInterfaceMod , only : hlm_current_month
use FatesInterfaceMod , only : hlm_current_day
Expand Down Expand Up @@ -154,7 +155,6 @@ subroutine LoggingMortality_frac( pft_i, dbh, lmort_direct,lmort_collateral,lmor

! Parameters
real(r8), parameter :: adjustment = 1.0 ! adjustment for mortality rates
real(r8), parameter :: logging_dbhmax_infra = 35 !(cm), based on Feldpaush et al. (2005) and Ferry et al. (2010)

if (logging_time) then
if(EDPftvarcon_inst%woody(pft_i) == 1)then ! only set logging rates for trees
Expand Down
9 changes: 4 additions & 5 deletions biogeochem/EDMortalityFunctionsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,6 @@ module EDMortalityFunctionsMod
use EDTypesMod , only : ed_patch_type
use FatesConstantsMod , only : itrue,ifalse
use FatesAllometryMod , only : bleaf
use EDParamsMod , only : ED_val_stress_mort
use FatesInterfaceMod , only : bc_in_type
use FatesInterfaceMod , only : hlm_use_ed_prescribed_phys
use FatesInterfaceMod , only : hlm_freq_day
Expand Down Expand Up @@ -62,7 +61,6 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort )
real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold
real(r8) :: temp_dep ! Temp. function (freezing mortality)
real(r8) :: temp_in_C ! Daily averaged temperature in Celcius
real(r8),parameter :: frost_mort_scaler = 3.0_r8 ! Scaling factor for freezing mortality
real(r8),parameter :: frost_mort_buffer = 5.0_r8 ! 5deg buffer for freezing mortality

logical, parameter :: test_zero_mortality = .false. ! Developer test which
Expand All @@ -79,7 +77,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort )
hf_sm_threshold = EDPftvarcon_inst%hf_sm_threshold(cohort_in%pft)

if(cohort_in%patchptr%btran_ft(cohort_in%pft) <= hf_sm_threshold)then
hmort = ED_val_stress_mort
hmort = EDPftvarcon_inst%mort_scalar_hydrfailure(cohort_in%pft)
else
hmort = 0.0_r8
endif
Expand All @@ -89,7 +87,8 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort )
call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,b_leaf)
if( b_leaf > 0._r8 .and. cohort_in%bstore <= b_leaf )then
frac = cohort_in%bstore/ b_leaf
cmort = max(0.0_r8,ED_val_stress_mort*(1.0_r8 - frac))
cmort = max(0.0_r8,EDPftvarcon_inst%mort_scalar_cstarvation(cohort_in%pft) * &
(1.0_r8 - frac))
else
cmort = 0.0_r8
endif
Expand All @@ -109,7 +108,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort )
temp_in_C = bc_in%t_veg24_si - tfrz
temp_dep = max(0.0,min(1.0,1.0 - (temp_in_C - &
EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) )
frmort = frost_mort_scaler * temp_dep
frmort = EDPftvarcon_inst%mort_scalar_coldstress(cohort_in%pft) * temp_dep


!mortality_rates = bmort + hmort + cmort
Expand Down
65 changes: 21 additions & 44 deletions biogeochem/EDPhysiologyMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,9 +196,12 @@ subroutine trim_canopy( currentSite )
endif

call bleaf(currentcohort%dbh,ipft,currentcohort%canopy_trim,tar_bl)
call bfineroot(currentcohort%dbh,ipft,currentcohort%canopy_trim,tar_bfr)

bfr_per_bleaf = tar_bfr/tar_bl
if ( int(EDPftvarcon_inst%allom_fmode(ipft)) .eq. 1 ) then
! only query fine root biomass if using a fine root allometric model that takes leaf trim into account
call bfineroot(currentcohort%dbh,ipft,currentcohort%canopy_trim,tar_bfr)
bfr_per_bleaf = tar_bfr/tar_bl
endif

!Leaf cost vs netuptake for each leaf layer.
do z = 1,nlevleaf
Expand All @@ -210,18 +213,27 @@ subroutine trim_canopy( currentSite )


currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8)
currentCohort%leaf_cost = currentCohort%leaf_cost + &
1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * &
bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft)

if ( int(EDPftvarcon_inst%allom_fmode(ipft)) .eq. 1 ) then
! if using trimmed leaf for fine root biomass allometry, add the cost of the root increment
! to the leaf increment; otherwise do not.
currentCohort%leaf_cost = currentCohort%leaf_cost + &
1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * &
bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft)
endif

currentCohort%leaf_cost = currentCohort%leaf_cost * &
(EDPftvarcon_inst%grperc(ipft) + 1._r8)
else !evergreen costs
currentCohort%leaf_cost = 1.0_r8/(EDPftvarcon_inst%slatop(ipft)* &
EDPftvarcon_inst%leaf_long(ipft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1
currentCohort%leaf_cost = currentCohort%leaf_cost + &
1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * &
bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft)
if ( int(EDPftvarcon_inst%allom_fmode(ipft)) .eq. 1 ) then
! if using trimmed leaf for fine root biomass allometry, add the cost of the root increment
! to the leaf increment; otherwise do not.
currentCohort%leaf_cost = currentCohort%leaf_cost + &
1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * &
bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft)
endif
currentCohort%leaf_cost = currentCohort%leaf_cost * &
(EDPftvarcon_inst%grperc(ipft) + 1._r8)
endif
Expand Down Expand Up @@ -875,15 +887,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in )
integer , parameter :: max_substeps = 300
real(r8), parameter :: max_trunc_error = 1.0_r8
integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler
real(r8), parameter :: global_branch_turnover = 0.0_r8 ! Temporary branch turnover setting
! Branch-turnover control will be
! introduced in a later PR


ipft = currentCohort%pft

EDPftvarcon_inst%branch_turnover(ipft) = global_branch_turnover

! Initialize seed production
currentCohort%seed_prod = 0.0_r8

Expand Down Expand Up @@ -976,35 +982,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in )
currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite )
end if

! -----------------------------------------------------------------------------------
! III(a). Calculate the maintenance turnover demands
! Pre-check, make sure phenology is mutually exclusive and at least one chosen
! (MOVE THIS TO THE PARAMETER READ-IN SECTION)
! -----------------------------------------------------------------------------------

if (EDPftvarcon_inst%evergreen(ipft) == 1) then
if (EDPftvarcon_inst%season_decid(ipft) == 1)then
write(fates_log(),*) 'PFT # ',ipft,' was specified as being both evergreen'
write(fates_log(),*) ' and seasonally deciduous, impossible, aborting'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
if (EDPftvarcon_inst%stress_decid(ipft) == 1)then
write(fates_log(),*) 'PFT # ',ipft,' was specified as being both evergreen'
write(fates_log(),*) ' and stress deciduous, impossible, aborting'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
end if
if (EDPftvarcon_inst%stress_decid(ipft) /= 1 .and. &
EDPftvarcon_inst%season_decid(ipft) /= 1 .and. &
EDPftvarcon_inst%evergreen(ipft) /= 1) then
write(fates_log(),*) 'PFT # ',ipft,' must be defined as having one of three'
write(fates_log(),*) 'phenology habits, ie == 1'
write(fates_log(),*) 'stress_decid: ',EDPftvarcon_inst%stress_decid(ipft)
write(fates_log(),*) 'season_decid: ',EDPftvarcon_inst%season_decid(ipft)
write(fates_log(),*) 'evergreen: ',EDPftvarcon_inst%evergreen(ipft)
call endrun(msg=errMsg(sourcefile, __LINE__))
endif


! -----------------------------------------------------------------------------------
! III(b). Calculate the maintenance turnover demands
Expand Down Expand Up @@ -1463,7 +1440,7 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx)
if (dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass
repro_fraction = EDPftvarcon_inst%seed_alloc(ipft)
else
repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft)
repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%seed_alloc_mature(ipft)
end if

dCdx = 0.0_r8
Expand Down
29 changes: 16 additions & 13 deletions biogeochem/FatesAllometryMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,9 @@ module FatesAllometryMod
use EDPFTvarcon , only : EDPftvarcon_inst
use FatesConstantsMod, only : r8 => fates_r8
use FatesConstantsMod, only : i4 => fates_int
use FatesConstantsMod, only : g_per_kg
use FatesConstantsMod, only : cm2_per_m2
use FatesConstantsMod, only : kg_per_Megag
use shr_log_mod , only : errMsg => shr_log_errMsg
use FatesGlobals , only : fates_log
use FatesGlobals , only : endrun => fates_endrun
Expand All @@ -110,11 +113,9 @@ module FatesAllometryMod
public :: StructureResetOfDH ! Method to set DBH to sync with structure biomass
public :: CheckIntegratedAllometries


logical , parameter :: verbose_logging = .false.
character(len=*), parameter :: sourcefile = __FILE__


! If testing b4b with older versions, do not remove sapwood
! Our old methods with saldarriaga did not remove sapwood from the
! bdead pool. But newer allometries are providing total agb
Expand Down Expand Up @@ -520,7 +521,7 @@ real(r8) function tree_lai( bl, status_coh, pft, c_area, n )
write(fates_log(),*) 'problem in treelai',bl,pft
endif

slat = 1000.0_r8 * EDPftvarcon_inst%slatop(pft) ! m2/g to m2/kg
slat = g_per_kg * EDPftvarcon_inst%slatop(pft) ! m2/g to m2/kg
leafc_per_unitarea = bl/(c_area/n) !KgC/m2
if(leafc_per_unitarea > 0.0_r8)then
tree_lai = leafc_per_unitarea * slat !kg/m2 * m2/kg = unitless LAI
Expand Down Expand Up @@ -560,7 +561,7 @@ real(r8) function tree_sai( dbh, pft, canopy_trim, c_area, n )
real(r8) :: sai_scaler
real(r8) :: b_leaf

sai_scaler = 1000. * EDPftvarcon_inst%allom_sai_scaler(pft) ! m2/g to m2/kg
sai_scaler = g_per_kg * EDPftvarcon_inst%allom_sai_scaler(pft) ! m2/g to m2/kg

call bleaf(dbh,pft,canopy_trim,b_leaf)

Expand Down Expand Up @@ -705,14 +706,23 @@ subroutine bfineroot(d,ipft,canopy_trim,bfr,dbfrdd)
real(r8) :: slascaler

select case(int(EDPftvarcon_inst%allom_fmode(ipft)))
case(1) ! "constant proportionality with bleaf"
case(1) ! "constant proportionality with TRIMMED target bleaf"

call blmax_allom(d,ipft,blmax,dblmaxdd)
call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd)
bfr = bfrmax * canopy_trim
if(present(dbfrdd))then
dbfrdd = dbfrmaxdd * canopy_trim
end if
case(2) ! "constant proportionality with UNTRIMMED target bleaf"

call blmax_allom(d,ipft,blmax,dblmaxdd)
call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd)
bfr = bfrmax
if(present(dbfrdd))then
dbfrdd = dbfrmaxdd
end if

case DEFAULT
write(fates_log(),*) 'An undefined fine root allometry was specified: ', &
EDPftvarcon_inst%allom_fmode(ipft)
Expand Down Expand Up @@ -881,9 +891,7 @@ end subroutine bbgw_const

subroutine bsap_deprecated(d,h,dhdd,bleaf,dbleafdd,ipft,bsap,dbsapdd)

use FatesConstantsMod, only : g_per_kg
use FatesConstantsMod, only : cm2_per_m2
use FatesConstantsMod, only : kg_per_Megag


! -------------------------------------------------------------------------
! -------------------------------------------------------------------------
Expand Down Expand Up @@ -930,10 +938,6 @@ end subroutine bsap_deprecated

subroutine bsap_dlinear(d,h,dhdd,bleaf,dbleafdd,ipft,bsap,dbsapdd)

use FatesConstantsMod, only : g_per_kg
use FatesConstantsMod, only : cm2_per_m2
use FatesConstantsMod, only : kg_per_Megag

! -------------------------------------------------------------------------
! Calculate sapwood biomass based on leaf area to sapwood area
! proportionality. In this function, the leaftosapwood area is a function
Expand Down Expand Up @@ -1762,7 +1766,6 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h )
! T
! ============================================================================


use FatesConstantsMod , only : calloc_abs_error
! Arguments

Expand Down
Loading

0 comments on commit d55d039

Please sign in to comment.