Skip to content

Commit

Permalink
Merge tag 'sci.1.3.0_api.2.0.0'
Browse files Browse the repository at this point in the history
  • Loading branch information
@ekluzek
ekluzek committed Nov 22, 2017
2 parents 139e264 + 0115fbc commit 05bc0de
Show file tree
Hide file tree
Showing 26 changed files with 1,876 additions and 1,392 deletions.
243 changes: 158 additions & 85 deletions biogeochem/EDCanopyStructureMod.F90
View file

Large diffs are not rendered by default.

45 changes: 22 additions & 23 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,9 +10,9 @@ module EDCohortDynamicsMod
use FatesInterfaceMod , only : bc_in_type
use FatesConstantsMod , only : r8 => fates_r8
use FatesConstantsMod , only : fates_unset_int
use FatesConstantsMod , only : itrue
use FatesInterfaceMod , only : hlm_days_per_year
use EDPftvarcon , only : EDPftvarcon_inst
use EDEcophysContype , only : EDecophyscon
use EDGrowthFunctionsMod , only : c_area, tree_lai
use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type
use EDTypesMod , only : nclmax
Expand All @@ -21,7 +21,7 @@ module EDCohortDynamicsMod
use EDTypesMod , only : sclass_ed,nlevsclass_ed,AREA
use EDTypesMod , only : min_npm2, min_nppatch
use EDTypesMod , only : min_n_safemath
use EDTypesMod , only : use_fates_plant_hydro
use FatesInterfaceMod , only : hlm_use_planthydro
use FatesPlantHydraulicsMod, only : FuseCohortHydraulics
use FatesPlantHydraulicsMod, only : CopyCohortHydraulics
use FatesPlantHydraulicsMod, only : updateSizeDepTreeHydProps
Expand Down Expand Up @@ -172,7 +172,7 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, &
! growth, disturbance and mortality.
new_cohort%isnew = .true.

if( use_fates_plant_hydro ) then
if( hlm_use_planthydro.eq.itrue ) then
call InitHydrCohort(new_cohort)
call updateSizeDepTreeHydProps(new_cohort, bc_in)
call initTreeHydStates(new_cohort, bc_in)
Expand Down Expand Up @@ -216,7 +216,7 @@ subroutine allocate_live_biomass(cc_p,mode)

currentCohort => cc_p
ft = currentcohort%pft
leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + EDPftvarcon_inst%froot_leaf(ft))
leaf_frac = 1.0_r8/(1.0_r8 + EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite + EDPftvarcon_inst%allom_l2fr(ft))

!currentcohort%bl = currentcohort%balive*leaf_frac
!for deciduous trees, there are no leaves
Expand All @@ -228,8 +228,8 @@ subroutine allocate_live_biomass(cc_p,mode)

! iagnore the root and stem biomass from the functional balance hypothesis. This is used when the leaves are
!fully on.
!currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac
!currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + &
!currentcohort%br = EDPftvarcon_inst%allom_l2fr(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac
!currentcohort%bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite *(currentcohort%balive + &
! currentcohort%laimemory)*leaf_frac

leaves_off_switch = 0
Expand All @@ -245,9 +245,9 @@ subroutine allocate_live_biomass(cc_p,mode)

new_bl = currentcohort%balive*leaf_frac

new_br = EDpftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac
new_br = EDpftvarcon_inst%allom_l2fr(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac

new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + &
new_bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite *(currentcohort%balive + &
currentcohort%laimemory)*leaf_frac

!diagnose the root and stem biomass from the functional balance hypothesis. This is used when the leaves are
Expand Down Expand Up @@ -279,13 +279,13 @@ subroutine allocate_live_biomass(cc_p,mode)
!not have enough live biomass to support the hypothesized root mass
!thus, we use 'ratio_balive' to adjust br and bsw. Apologies that this is so complicated! RF

ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%froot_leaf(ft) + &
currentcohort%laimemory* EDecophyscon%sapwood_ratio(ft) * currentcohort%hite
ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%allom_l2fr(ft) + &
currentcohort%laimemory* EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite
ratio_balive = currentcohort%balive / ideal_balive

new_br = EDpftvarcon_inst%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * &
new_br = EDpftvarcon_inst%allom_l2fr(ft) * (ideal_balive + currentcohort%laimemory) * &
leaf_frac * ratio_balive
new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite * &
new_bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite * &
(ideal_balive + currentcohort%laimemory) * leaf_frac * ratio_balive

! Diagnostics
Expand Down Expand Up @@ -505,7 +505,6 @@ subroutine terminate_cohorts( currentSite, patchptr, level )
! terminates cohorts when they get too small
!
! !USES:
use EDParamsMod, only : ED_val_ag_biomass
use SFParamsMod, only : SF_val_CWD_frac
!
! !ARGUMENTS
Expand Down Expand Up @@ -618,10 +617,10 @@ subroutine terminate_cohorts( currentSite, patchptr, level )

currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) / &
currentPatch%area &
* SF_val_CWD_frac(c) * ED_val_ag_biomass
* SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)
currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) / &
currentPatch%area &
* SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass)
* SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft))
enddo

currentPatch%leaf_litter(currentCohort%pft) = currentPatch%leaf_litter(currentCohort%pft) + currentCohort%n* &
Expand All @@ -633,10 +632,10 @@ subroutine terminate_cohorts( currentSite, patchptr, level )
do c=1,ncwd
currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) &
+ currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * &
SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA
SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * hlm_days_per_year / AREA
currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) &
+ currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * &
SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA
SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * hlm_days_per_year / AREA
enddo

currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = &
Expand All @@ -646,7 +645,7 @@ subroutine terminate_cohorts( currentSite, patchptr, level )
currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + &
currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA

if (use_fates_plant_hydro) call DeallocateHydrCohort(currentCohort)
if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort)

deallocate(currentCohort)
endif
Expand Down Expand Up @@ -676,8 +675,8 @@ subroutine fuse_cohorts(patchptr, bc_in)
type (ed_cohort_type) , pointer :: currentCohort, nextc, nextnextc
integer :: i
integer :: fusion_took_place
integer :: maxcohorts !maximum total no of cohorts. Needs to be >numpft_edx2
integer :: iterate !do we need to keep fusing to get below maxcohorts?
integer :: maxcohorts ! maximum total no of cohorts.
integer :: iterate ! do we need to keep fusing to get below maxcohorts?
integer :: nocohorts
real(r8) :: newn
real(r8) :: diff
Expand Down Expand Up @@ -799,7 +798,7 @@ subroutine fuse_cohorts(patchptr, bc_in)
call sizetype_class_index(currentCohort%dbh,currentCohort%pft, &
currentCohort%size_class,currentCohort%size_by_pft_class)

if(use_fates_plant_hydro) call FuseCohortHydraulics(currentCohort,nextc,bc_in,newn)
if(hlm_use_planthydro.eq.itrue) call FuseCohortHydraulics(currentCohort,nextc,bc_in,newn)

! recent canopy history
currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + &
Expand Down Expand Up @@ -897,7 +896,7 @@ subroutine fuse_cohorts(patchptr, bc_in)
endif

if (associated(nextc)) then
if(use_fates_plant_hydro) call DeallocateHydrCohort(nextc)
if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nextc)
deallocate(nextc)
endif

Expand Down Expand Up @@ -1255,7 +1254,7 @@ subroutine copy_cohort( currentCohort,copyc )

! Plant Hydraulics

if( use_fates_plant_hydro ) call CopyCohortHydraulics(n,o)
if( hlm_use_planthydro.eq.itrue ) call CopyCohortHydraulics(n,o)

! indices for binning
n%size_class = o%size_class
Expand Down
79 changes: 43 additions & 36 deletions biogeochem/EDGrowthFunctionsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,11 +44,11 @@ real(r8) function Dbh( cohort_in )
type(ed_cohort_type), intent(in) :: cohort_in

!FIX(SPM,040214) - move to param file
real(r8) :: m !parameter of allometric equation (needs to not be hardwired...
real(r8) :: c !parameter of allometric equation (needs to not be hardwired...
real(r8) :: m ! parameter of allometric equation
real(r8) :: c ! parameter of allometric equation

m = EDPftvarcon_inst%dbh2h_m(cohort_in%pft)
c = EDPftvarcon_inst%dbh2h_c(cohort_in%pft)
m = EDPftvarcon_inst%allom_d2h1(cohort_in%pft)
c = EDPftvarcon_inst%allom_d2h2(cohort_in%pft)

dbh = (10.0_r8**((log10(cohort_in%hite) - c)/m))

Expand All @@ -71,8 +71,8 @@ real(r8) function Hite( cohort_in )
real(r8) :: c
real(r8) :: h

m = EDPftvarcon_inst%dbh2h_m(cohort_in%pft)
c = EDPftvarcon_inst%dbh2h_c(cohort_in%pft)
m = EDPftvarcon_inst%allom_d2h1(cohort_in%pft)
c = EDPftvarcon_inst%allom_d2h2(cohort_in%pft)

if(cohort_in%dbh <= 0._r8)then
write(fates_log(),*) 'ED: dbh less than zero problem!'
Expand Down Expand Up @@ -107,11 +107,11 @@ real(r8) function Bleaf( cohort_in )
real(r8) :: dbh2bl_b
real(r8) :: dbh2bl_c
real(r8) :: slascaler ! changes the target biomass according to the SLA
dbh2bl_a = EDPftvarcon_inst%dbh2bl_a(cohort_in%pft)
dbh2bl_b = EDPftvarcon_inst%dbh2bl_b(cohort_in%pft)
dbh2bl_c = EDPftvarcon_inst%dbh2bl_c(cohort_in%pft)
slascaler = EDPftvarcon_inst%dbh2bl_slascaler(cohort_in%pft)/EDPftvarcon_inst%slatop(cohort_in%pft)

dbh2bl_a = EDPftvarcon_inst%allom_d2bl1(cohort_in%pft)
dbh2bl_b = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft)
dbh2bl_c = EDPftvarcon_inst%allom_d2bl3(cohort_in%pft)
slascaler = EDPftvarcon_inst%allom_d2bl_slascaler(cohort_in%pft)/EDPftvarcon_inst%slatop(cohort_in%pft)

if(cohort_in%dbh < 0._r8.or.cohort_in%pft == 0.or.cohort_in%dbh > 1000.0_r8)then
write(fates_log(),*) 'problems in bleaf',cohort_in%dbh,cohort_in%pft
Expand Down Expand Up @@ -191,7 +191,7 @@ real(r8) function tree_sai( cohort_in )
real(r8) :: bdead_per_unitarea ! KgC of leaf per m2 area of ground.
real(r8) :: sai_scaler

sai_scaler = EDPftvarcon_inst%sai_scaler(cohort_in%pft)
sai_scaler = EDPftvarcon_inst%allom_sai_scaler(cohort_in%pft)

if( cohort_in%bdead < 0._r8 .or. cohort_in%pft == 0 ) then
write(fates_log(),*) 'problem in treesai',cohort_in%bdead,cohort_in%pft
Expand Down Expand Up @@ -234,10 +234,10 @@ real(r8) function c_area( cohort_in )
integer :: can_layer_index

! default is to use the same exponent as the dbh to bleaf exponent so that per-plant canopy depth remains invariant during growth,
! but allowed to vary via the dbh2bl_dbh2carea_expnt_diff term (which has default value of zero)
crown_area_to_dbh_exponent = EDPftvarcon_inst%dbh2bl_b(cohort_in%pft) + &
EDPftvarcon_inst%dbh2bl_dbh2carea_expnt_diff(cohort_in%pft)

! but allowed to vary via the allom_blca_expnt_diff term (which has default value of zero)
crown_area_to_dbh_exponent = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft) + &
EDPftvarcon_inst%allom_blca_expnt_diff(cohort_in%pft)
if (DEBUG_growth) then
write(fates_log(),*) 'z_area 1',cohort_in%dbh,cohort_in%pft
write(fates_log(),*) 'z_area 2',EDPftvarcon_inst%max_dbh
Expand All @@ -247,7 +247,7 @@ real(r8) function c_area( cohort_in )
write(fates_log(),*) 'z_area 6',cohort_in%canopy_layer
write(fates_log(),*) 'z_area 7',ED_val_grass_spread
end if

dbh = min(cohort_in%dbh,EDPftvarcon_inst%max_dbh(cohort_in%pft))

! ----------------------------------------------------------------------------------
Expand Down Expand Up @@ -278,7 +278,12 @@ real(r8) function Bdead( cohort_in )
! ============================================================================
! Calculate stem biomass from height(m) dbh(cm) and wood density(g/cm3)
! default params using allometry of J.G. Saldarriaga et al 1988 - Rio Negro
! Journal of Ecology vol 76 p938-958
! Journal of Ecology vol 76 p938-958
!
! NOTE (RGK 07-2017) Various other biomass allometries calculate above ground
! biomass, and it appear Saldariagga may be an outlier that calculates total
! biomass (these parameters will have to be a placeholder for both)
!
! ============================================================================

type(ed_cohort_type), intent(in) :: cohort_in
Expand All @@ -288,10 +293,10 @@ real(r8) function Bdead( cohort_in )
real(r8) :: dbh2bd_c
real(r8) :: dbh2bd_d

dbh2bd_a = EDPftvarcon_inst%dbh2bd_a(cohort_in%pft)
dbh2bd_b = EDPftvarcon_inst%dbh2bd_b(cohort_in%pft)
dbh2bd_c = EDPftvarcon_inst%dbh2bd_c(cohort_in%pft)
dbh2bd_d = EDPftvarcon_inst%dbh2bd_d(cohort_in%pft)
dbh2bd_a = EDPftvarcon_inst%allom_agb1(cohort_in%pft)
dbh2bd_b = EDPftvarcon_inst%allom_agb2(cohort_in%pft)
dbh2bd_c = EDPftvarcon_inst%allom_agb3(cohort_in%pft)
dbh2bd_d = EDPftvarcon_inst%allom_agb4(cohort_in%pft)

bdead = dbh2bd_a*(cohort_in%hite**dbh2bd_b)*(cohort_in%dbh**dbh2bd_c)* &
(EDPftvarcon_inst%wood_density(cohort_in%pft)** dbh2bd_d)
Expand All @@ -315,10 +320,10 @@ real(r8) function dHdBd( cohort_in )
real(r8) :: dbh2bd_c
real(r8) :: dbh2bd_d

dbh2bd_a = EDPftvarcon_inst%dbh2bd_a(cohort_in%pft)
dbh2bd_b = EDPftvarcon_inst%dbh2bd_b(cohort_in%pft)
dbh2bd_c = EDPftvarcon_inst%dbh2bd_c(cohort_in%pft)
dbh2bd_d = EDPftvarcon_inst%dbh2bd_d(cohort_in%pft)
dbh2bd_a = EDPftvarcon_inst%allom_agb1(cohort_in%pft)
dbh2bd_b = EDPftvarcon_inst%allom_agb2(cohort_in%pft)
dbh2bd_c = EDPftvarcon_inst%allom_agb3(cohort_in%pft)
dbh2bd_d = EDPftvarcon_inst%allom_agb4(cohort_in%pft)

dbddh = dbh2bd_a*dbh2bd_b*(cohort_in%hite**(dbh2bd_b-1.0_r8))*(cohort_in%dbh**dbh2bd_c)* &
(EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bd_d)
Expand Down Expand Up @@ -347,14 +352,14 @@ real(r8) function dDbhdBd( cohort_in )
real(r8) :: dbh2bd_b
real(r8) :: dbh2bd_c
real(r8) :: dbh2bd_d

m = EDPftvarcon_inst%allom_d2h1(cohort_in%pft)
c = EDPftvarcon_inst%allom_d2h2(cohort_in%pft)

m = EDPftvarcon_inst%dbh2h_m(cohort_in%pft)
c = EDPftvarcon_inst%dbh2h_c(cohort_in%pft)

dbh2bd_a = EDPftvarcon_inst%dbh2bd_a(cohort_in%pft)
dbh2bd_b = EDPftvarcon_inst%dbh2bd_b(cohort_in%pft)
dbh2bd_c = EDPftvarcon_inst%dbh2bd_c(cohort_in%pft)
dbh2bd_d = EDPftvarcon_inst%dbh2bd_d(cohort_in%pft)
dbh2bd_a = EDPftvarcon_inst%allom_agb1(cohort_in%pft)
dbh2bd_b = EDPftvarcon_inst%allom_agb2(cohort_in%pft)
dbh2bd_c = EDPftvarcon_inst%allom_agb3(cohort_in%pft)
dbh2bd_d = EDPftvarcon_inst%allom_agb4(cohort_in%pft)

dBD_dDBH = dbh2bd_c*dbh2bd_a*(cohort_in%hite**dbh2bd_b)*(cohort_in%dbh**(dbh2bd_c-1.0_r8))* &
(EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bd_d)
Expand Down Expand Up @@ -387,9 +392,11 @@ real(r8) function dDbhdBl( cohort_in )
real(r8) :: dbh2bl_b
real(r8) :: dbh2bl_c

dbh2bl_a = EDPftvarcon_inst%dbh2bl_a(cohort_in%pft)
dbh2bl_b = EDPftvarcon_inst%dbh2bl_b(cohort_in%pft)
dbh2bl_c = EDPftvarcon_inst%dbh2bl_c(cohort_in%pft)
dbh2bl_a = EDPftvarcon_inst%allom_d2bl1(cohort_in%pft)
dbh2bl_b = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft)
dbh2bl_c = EDPftvarcon_inst%allom_d2bl3(cohort_in%pft)


dblddbh = dbh2bl_b*dbh2bl_a*(cohort_in%dbh**dbh2bl_b)*(EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bl_c)
dblddbh = dblddbh*cohort_in%canopy_trim

Expand Down
Loading

0 comments on commit 05bc0de

Please sign in to comment.