From d350c36a41c9a35281ce9d1670829a06e4c2f09d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 29 Sep 2017 16:55:34 -0700 Subject: [PATCH 01/63] allometry module: cleaning functions, changing arguments. --- biogeochem/FatesAllometryMod.F90 | 1419 ++++++++++++++++++++++++++++++ main/EDPftvarcon.F90 | 22 +- main/FatesConstantsMod.F90 | 7 + 3 files changed, 1446 insertions(+), 2 deletions(-) create mode 100644 biogeochem/FatesAllometryMod.F90 diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 new file mode 100644 index 0000000000..0c6d891d70 --- /dev/null +++ b/biogeochem/FatesAllometryMod.F90 @@ -0,0 +1,1419 @@ +!=============================================================================== +! +! FatesAllometryMod.F90 +! +! A library of functions that calculate plant allometry and their +! derivatives. Most relationships are related to diameter [cm]. All +! derivatives with respect to change in diameter have same units. +! In some cases multiple areguments will be provided, yet +! those arguments in those cases are trivially determined from diameter. +! +! Each function presented in this library is written to also return the +! derivative with respect to diameter using a logical switch "dswitch" +! (derivative-switch). With one exception, the h2d function returns the +! change in diameter with respect to height. +! +! The name convention of the functions follows the form d2... Which +! indicates "diameter to ...". Allometries for the following variables are +! calculated: +! h: height [m] +! bag: biomass above ground [kgC] (aka AGB) +! blmax: biomass in leaves when leaves are "on allometry" +! this also is the "pre-trimmed" value, which is the maximum +! or potential leaf mass a tree may have [kgC] +! bcr: biomass in coarse roots [kgC] (belowground sap+dead wood, no fines) +! bfrmax: biomass in fine roots when "on allometry" [kgC] +! bsap: biomass in sapwood (above and below) [kgC] +! bdead: biomass (above and below) in the structural pool [kgC] +! +! "on allometry" assumes the plant has leaves flushed, and has had +! sufficient carbon to meet maintenance turnover. +! +! The following traits are used: +! allom_hmode, integer, height allometry function type +! allom_lmode, integer, maximum leaf allometry function type +! allom_rmode, integer, maximum root allometry function type +! allom_amode, integer, AGB allometry function type +! allom_cmode, integer, coarse root allometry function type +! allom_smode, integer, sapwood allometry function type +! wood_density, real, mean stem wood specific gravity (heart,sap,bark) +! allom_latosa_int, real, leaf area to sap area ratio, intercept [m2/cm2] +! allom_latosa_slp, real, leaf area to sap area ratio, slope on diameter +! [m2/cm2/cm] +! c2b, real, carbon to biomass ratio (~2.0) +! allom_l2fr, real, fine root biomass per leaf biomass ratio [kgC/kgC] +! allom_agb_fraction, real, the fraction of stem above ground [-] +! allom_d2h1, real, parameter 1 for d2h allometry (intercept) +! allom_d2h2, real, parameter 2 for d2h allometry (slope) +! allom_d2h3, real, parameter 3 for d2h allometry (optional) +! eclim influence parameter for d2h allometry (potentially not a parameter) +! allom_d2bl1, real, parameter 1 for d2bl allometry (intercept) +! allom_d2bl2, real, parameter 2 for d2bl allometry (slope) +! allom_d2bl3, real, parameter 3 for d2bl allometry (optional) +! allom_agb1 +! allom_agb2 +! allom_agb3 +! +! h_max, real, maximum height of a functional type/group +! h_min, real, the height associated with newly recruited plant [m] +! dbh_min, real, the dbh associated with a newly recruited plant [cm] +! dbh_max, real, the diameter associated with maximum height [cm] +! diagnosed from maxh using non-asymptotic functions +! +! +! Initial Implementation: Ryan Knox July 2017 +! +!=============================================================================== + +module FatesAllometryMod + +! If this is a unit-test, these globals will be provided by a wrapper + + use EDPFTvarcon , only : EDPftvarcon_inst + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : i4 => fates_int + use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesGlobals , only : fates_log + use FatesGlobals , only : endrun => fates_endrun + + implicit none + + private + public :: h2d_allom ! Generic height to diameter wrapper + public :: h_allom ! Generic diameter to height wrapper + public :: bag_allom ! Generic AGB wrapper + public :: blmax_allom ! Generic maximum leaf biomass wrapper + public :: bsap_allom ! Generic sapwood wrapper + public :: bcr_allom ! Generic coarse root wrapper + public :: bfrmax_allom ! Generic maximum fine root biomass wrapper + public :: bdead_allom ! Generic bdead wrapper + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + +contains + + ! ============================================================================ + ! Parameter Checks and Defaults (subroutine) + ! ============================================================================ + +! subroutine init_allom() + + ! Perform Auto-initializations + + ! Calculate DBH at maximum height + +! end subroutine init_allom + + + ! ============================================================================ + ! Generic height to diameter interface + ! ============================================================================ + + subroutine h2d_allom(h,ipft,d,dddh) + + + real(r8),intent(in) :: h ! height of plant [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out) :: dddh ! change in diameter per height [cm/m] + + real(r8) :: h_sap + real(r8) :: dhdd_sap + real(r8) :: ddedh_sap + real(r8) :: de_sap + real(r8) :: h_adult + real(r8) :: dhdd_adult + real(r8) :: ddedh_adult + real(r8) :: de_adult + integer :: hallom_mode + real(r8) :: p1 + real(r8) :: p2 + real(r8) :: p3 + + associate( & + h_max => EDPftvarcon_inst%h_max(ipft), & + h_min => EDPftvarcon_inst%h_min(ipft), & + eclim => EDPftvarcon_inst%eclim(ipft), & + p1 => EDPftvarcon_inst%allom_d2h1(ipft), & + p2 => EDPftvarcon_inst%allom_d2h2(ipft), & + p3 => EDPftvarcon_inst%allom_d2h3(ipft), & + allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) + + select case(allom_hmode) + case (1) ! chave 2014 + call h2d_chave2014(h,p1,p2,p3,eclim,d,dddh) + case (2) ! poorter 2006 + call h2d_poorter2006(h,p1,p2,p3,d,dddh) + case (3) ! 2 parameter power function + call h2d_2pwr(h,p1,p2,d,dddh) + case (4) ! Obrien et al. 199X BCI + call h2d_obrien(h,p1,p2,h_max,d,dddh) + case (5) ! Martinez-Cano + call h2d_martcano(h,p1,p2,p3,d,dddh) + case DEFAULT + write(fates_log(),*) 'An undefined h2d allometry was specified: ',allom_hmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + + end if + end associate + return + end subroutine h2d_allom + + ! ============================================================================ + ! Generic height interface + ! ============================================================================ + + subroutine h_allom(d,ipft,h,dhdd) + + ! Arguments + real(r8),intent(in) :: d ! plant diameter [cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] + + ! Locals + integer :: allom_hmode + real(r8) :: h_sap + real(r8) :: h_ad + real(r8) :: dhdd_sap + real(r8) :: dhdd_ad + real(r8) :: p1 + real(r8) :: p2 + real(r8) :: p3 + + associate( & + dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & + eclim => EDPftvarcon_inst%eclim(ipft), & + p1 => EDPftvarcon_inst%allom_d2h1(ipft), & + p2 => EDPftvarcon_inst%allom_d2h2(ipft), & + p3 => EDPftvarcon_inst%allom_d2h3(ipft), & + allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) + + select case(allom_hmode) + case (1) ! "chave14") + call d2h_chave2014(d,p1,p2,p3,eclim,dbh_maxh,h,dhdd) + case (2) ! "poorter06" + call d2h_poorter2006(d,p1,p2,p3,h,dhdd) + case (3) ! "2parameter power function h=a*d^b " + call d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) + case (4) ! "obrien" + call d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) + case (5) ! Martinez-Cano + call d2h_martcano(d,p1,p2,p3,h,dhdd) + case DEFAULT + write(fates_log(),*) 'An undefined height allometry was specified: ',allom_hmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end associate + return + end subroutine h_allom + + ! ============================================================================ + ! Generic AGB interface + ! ============================================================================ + + subroutine bag_allom(d,h,ipft,bag,dbagdd) + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bag ! plant height [m] + real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] + + + associate( & + p1 => EDPftvarcon_inst%allom_agb1(ipft), & + p2 => EDPftvarcon_inst%allom_agb2(ipft), & + p3 => EDPftvarcon_inst%allom_agb3(ipft), & + p4 => EDPftvarcon_inst%allom_agb4(ipft), & + wood_density => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft), & + agb_frac => EDPftvarcon_inst%allom_agb_frac(ipft), & + allom_amode => EDPftvarcon_inst%allom_amode(ipft)) + + + select case(allom_amode) + case (1) !"chave14") + call dh2bag_chave2014(d,h,ipft,p1,p2,wood_density,c2b,bag,dbagdd) + case (2) !"2par_pwr") + ! Switch for woodland dbh->drc + call d2bag_2pwr(d,ipft,p1,p2,bag,dbagdd) + case (3) !"salda") + call dh2bag_salda(d,h,ipft,p1,p2,p3,p4,wood_density,c2b,agb_frac,bag,dbagdd) + case DEFAULT + write(fates_log(),*) 'An undefined AGB allometry was specified: ',allom_amode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end associate + return + end subroutine bag_allom + + ! ============================================================================ + ! Generic diameter to maximum leaf biomass interface + ! ============================================================================ + + subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: blmax ! plant leaf biomass [kg] + real(r8),intent(out) :: dblmaxdd ! change leaf bio per diameter [kgC/cm] + + integer :: lallom_mode + real(r8) :: p1 + real(r8) :: p2 + real(r8) :: p3 + real(r8) :: blmax_sap + real(r8) :: dblmaxdd_sap + real(r8) :: blmax_adult + real(r8) :: dblmaxdd_adult + + associate( & + d_adult => EDPftvarcon_inst%d_adult(ipft), & + d_sap => EDPftvarcon_inst%d_sap(ipft), & + dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & + rho => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft)) + + if ( d<=d_sap .or. d>=d_adult) then + + if(d<=d_sap) then + p1 = EDPftvarcon_inst%d2bl1_sap(ipft) + p2 = EDPftvarcon_inst%d2bl2_sap(ipft) + p3 = EDPftvarcon_inst%d2bl3_sap(ipft) + allom_lmode = EDPftvarcon_inst%lallom_sap_mode(ipft) + else + p1 = EDPftvarcon_inst%d2bl1_ad(ipft) + p2 = EDPftvarcon_inst%d2bl2_ad(ipft) + p3 = EDPftvarcon_inst%d2bl3_ad(ipft) + allom_lmode = EDPftvarcon_inst%lallom_ad_mode(ipft) + end if + + select case(allom_lmode) + case(1) !"salda") + call d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) + case(2) !"2par_pwr") + call d2blmax_2pwr(d,p1,p2,c2b,blmax,dblmaxdd) + case(3) ! dh2blmax_2pwr + call dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) + case DEFAULT + write(fates_log(),*) 'An undefined leaf allometry was specified: ', & + allom_lmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + else + + p1 = EDPftvarcon_inst%d2bl1_sap(ipft) + p2 = EDPftvarcon_inst%d2bl2_sap(ipft) + p3 = EDPftvarcon_inst%d2bl3_sap(ipft) + allom_lmode = EDPftvarcon_inst%lallom_sap_mode(ipft) + + select case(allom_lmode) + case(1) !"salda") + call d2blmax_salda(d_sap,p1,p2,p3,rho,dbh_maxh,c2b,blmax_sap,dblmaxdd_sap) + case(2) !"2par_pwr") + call d2blmax_2pwr(d_sap,p1,p2,c2b,blmax_sap,dblmaxdd_sap) + case(3) ! dh2blmax_2pwr + call dh2blmax_2pwr(d_sap,ipft,p1,p2,c2b,blmax_sap,dblmaxdd_sap) + case DEFAULT + write(fates_log(),*) 'An undefined leaf allometry was specified: ', & + allom_lmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + p1 = EDPftvarcon_inst%d2bl1_ad(ipft) + p2 = EDPftvarcon_inst%d2bl2_ad(ipft) + p3 = EDPftvarcon_inst%d2bl3_sap(ipft) + allom_lmode = EDPftvarcon_inst%lallom_ad_mode(ipft) + + select case(allom_lmode) + case(1) !"salda") + call d2blmax_salda(d_adult,p1,p2,p3,rho,dbh_maxh,c2b,blmax_adult,dblmaxdd_adult) + case(2) !"2par_pwr") + call d2blmax_2pwr(d_adult,p1,p2,c2b,blmax_adult,dblmaxdd_adult) + case(3) ! dh2blmax_2pwr + call dh2blmax_2pwr(d_adult,ipft,p1,p2,c2b,blmax_adult,dblmaxdd_adult) + case DEFAULT + write(fates_log(),*) 'An undefined leaf allometry was specified: ',allom_lmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + ! Use cubic spline interolation from d_sap to d_adult + call cspline(d_sap,d_adult,blmax_sap,blmax_adult,dblmaxdd_sap,dblmaxdd_adult,d,blmax,dblmaxdd) + + end if + end associate + return + end subroutine blmax_allom + + ! ============================================================================ + ! Generic sapwood biomass interface + ! ============================================================================ + + subroutine bsap_allom(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: blmax ! plant leaf biomass [kgC] + real(r8),intent(in) :: dblmaxdd ! chage in blmax per diam [kgC/cm] + real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] + real(r8),intent(out) :: dbsapdd ! change leaf bio per d [kgC/cm] + + select case(EDPftvarcon_inst%allom_smode(ipft)) + ! --------------------------------------------------------------------- + ! Currently both sapwood area proportionality methods use the same + ! machinery. The only differences are related to the parameter + ! checking at the beginning. For constant proportionality, the slope + ! of the la:sa to diameter line is zero. + ! --------------------------------------------------------------------- + case(1,2) !"constant","dlinear") + call bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) + case DEFAULT + write(fates_log(),*) 'An undefined sapwood allometry was specified: ', & + EDPftvarcon_inst%allom_smode(ipft) + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + return + end subroutine bsap_allom + + ! ============================================================================ + ! Generic coarse root biomass interface + ! ============================================================================ + + subroutine bcr_allom(d,bag,dbagdd,ipft,bcr,dbcrdd) + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: bag ! above ground biomass [kgC] + real(r8),intent(in) :: dbagdd ! change in agb per diameter [kgC/cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bcr ! coarse root biomass [kgC] + real(r8),intent(out) :: dbcrdd ! change croot bio per diam [kgC/cm] + + select case(EDPftvarcon_inst%allom_cmode(ipft)) + case(1) !"constant") + call bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) + case DEFAULT + write(fates_log(),*) 'An undefined coarse root allometry was specified: ', & + EDPftvarcon_inst%allom_cmode(ipft) + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + return + end subroutine bcr_allom + + ! ============================================================================ + ! Generic maximum fine root biomass interface + ! ============================================================================ + + subroutine bfrmax_allom(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: blmax ! max leaf biomass [kgC] + real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bfrmax ! max fine-root root biomass [kgC] + real(r8),intent(out) :: dbfrmaxdd ! change frmax bio per diam [kgC/cm] + + select case(EDPftvarcon_inst%allom_fmode(ipft)) + case(1) ! "constant") + call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) + case DEFAULT + write(fates_log(),*) 'An undefined fine root allometry was specified: ', & + EDPftvarcon_inst%allom_fmode(ipft) + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + return + end subroutine bfrmax_allom + + ! ============================================================================ + ! Dead biomass interface + ! ============================================================================ + + subroutine bdead_allom(bag,bcr,blmax,bsap,dbagdd,dbcrdd,dblmaxdd,dbsapdd, & + bdead,dbdeaddd) + + + real(r8),intent(in) :: bag ! agb [kgC] + real(r8),intent(in) :: bcr ! coarse root biomass [kgC] + real(r8),intent(in) :: blmax ! max leaf biomass [kgC] + real(r8),intent(in) :: bsap ! sapwood biomass [kgC] + + real(r8),intent(in) :: dbagdd ! change in agb per d [kgC/cm] + real(r8),intent(in) :: dbcrdd ! change in croot per d [kgC/cm] + real(r8),intent(in) :: dblmaxdd ! change in blmax per d [kgC/cm] + real(r8),intent(in) :: dbsapdd ! change in bsap per d [kgC/cm] + + real(r8),intent(out) :: bdead ! dead biomass (heartw/struct) [kgC] + real(r8),intent(out) :: dbdeaddd ! change in bdead per d [kgC/cm] + + ! bdead is diagnosed as the mass balance from all other pools + ! and therefore, no options are necessary + ! We are ignoring blmax right now, because it is insignificant in large + ! trees and may cause negatives in treelets and saplings + + !bdead = bag+bcr-blmax-bsap + bdead = bag+bcr-bsap + dbdeaddd = dbagdd+dbcrdd-dbsapdd + + return + end subroutine bdead_allom + + ! ============================================================================ + ! Specific bfrmax relationships + ! ============================================================================ + + subroutine bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: blmax ! max leaf biomass [kgC] + real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bfrmax ! max fine-root root biomass [kgC] + real(r8),intent(out) :: dbfrmaxdd ! change frmax bio per diam [kgC/cm] + + associate( f2l_ratio => EDPftvarcon_inst%f2l_ratio(ipft) ) + + bfrmax = blmax*f2l_ratio + + ! dbfr/dd = dbfrmax/dblmax * dblmax/dd + dbfrmaxdd = f2l_ratio*dblmaxdd + end associate + return + end subroutine bfrmax_const + + + ! ============================================================================ + ! Specific bcr relationships + ! ============================================================================ + + subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: bag ! above ground biomass [kg] + real(r8),intent(in) :: dbagdd ! change in agb per diameter [kg/cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bcr ! coarse root biomass [kg] + real(r8),intent(out) :: dbcrdd ! change croot bio per diam [kg/cm] + + associate( agb_fraction => EDPftvarcon_inst%agb_fraction(ipft) ) + + ! btot = bag + bcr + ! bag = btot*agb_fraction + ! bag/agb_fraction = bag + bcr + ! bcr = bag*(1/agb_fraction-1) + bcr = bag*(1.0_r8/agb_fraction-1.0_r8) + + ! Derivative + ! dbcr/dd = dbcr/dbag * dbag/dd + dbcrdd = (1.0_r8/agb_fraction-1.0_r8)*dbagdd + end associate + return + end subroutine bcr_const + + + ! ============================================================================ + ! Specific d2bsap relationships + ! ============================================================================ + + subroutine bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,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 + ! of plant size, see Calvo-Alvarado and Bradley Christoferson + ! In this case: parameter latosa (from constant proportionality) + ! is the intercept of the diameter function. + ! + ! For very small plants, the fraction can get very large, so cap the amount + ! of sapwood at X! of agb-bleaf + ! ------------------------------------------------------------------------- + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: blmax ! plant leaf biomass [kgC] + real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] + real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] + real(r8),intent(out) :: dbsapdd ! change leaf bio per diameter [kgC/cm] + + real(r8) :: latosa ! m2 leaf area per cm2 sap area + real(r8) :: hbl2bsap ! sapwood biomass per lineal height + ! and kg of leaf + real(r8) :: bag ! aboveground biomass [kgC] + real(r8) :: dbagdd ! change in agb per diam [kgC/cm] + + ! Constrain sapwood to be no larger than 75% of total agb + real(r8),parameter :: max_agbfrac = 0.75_r8 + + associate ( latosa_int => EDPftvarcon_inst%latosa_int(ipft), & + latosa_slp => EDPftvarcon_inst%latosa_slp(ipft), & + sla => EDPftvarcon_inst%slatop(ipft), & + wood_density => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft)) + + ! ------------------------------------------------------------------------ + ! Calculate sapwood biomass per linear height and kgC of leaf [m-1] + ! Units: + ! (1/latosa)* slatop* gtokg * cm2tom2 / c2b * mg2kg * dens + ! [cm2/m2]*[m2/gC]*[1000gC/1kgC]*[1m2/10000cm2] /[kg/kgC]*[kg/Mg]*[Mg/m3] + ! ->[cm2/gC] + ! ->[cm2/kgC] + ! ->[m2/kgC] + ! ->[m2/kg] + ! ->[m2/Mg] + ! ->[/m] + ! ------------------------------------------------------------------------ + + latosa = latosa_int + d*latosa_slp + + hbl2bsap = sla*g_per_kg*wood_density*kg_per_Megag/(latosa*c2b*cm2_per_m2 ) + + call bag_allom(d,h,ipft,bag,dbagdd) + + ! Force sapwood to be less than a maximum fraction of total alive biomass + ! (this comes into play typically in very small plants) + bsap = min(max_agbfrac*bag,hbl2bsap * h * blmax) + + ! Derivative + ! dbldmaxdd is deriv of blmax wrt dbh (use directives to check oop) + ! dhdd is deriv of height wrt dbh (use directives to check oop) + + if (bsap EDPftvarcon_inst%d_adult(ipft)) + + + + ! This call is needed to calculate the effective dbh + ! Note that this is only necessary for adult plants + ! Because only adult plants are nearing their asymptotic heights + if (d>=d_adult) then + + ! This call is needed to calculate the rate of change of + ! the actual h with d + call h_allom(d,ipft,h,dhdd) + + call h2d_allom(h,ipft,dbh_eff,dddh_eff) + + ! This is the rate of change of the effective diameter + ! with respect to the actual diameter (1.0 in non-height capped) + ddeffdd = dddh_eff * dhdd + else + ! In this case we assume that dbh_eff == d + ! because we are not in some forced asymptotic portion of the curve + dbh_eff = d + ddeffdd = 1.0_r8 + end if + blmax = p1*dbh_eff**p2/c2b + dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd + end associate + return + end subroutine dh2blmax_2pwr + + ! ========================================================================= + ! Diameter to height (D2H) functions + ! ========================================================================= + + subroutine d2h_chave2014(d,p1,p2,p3,eclim,dbh_maxh,h,dhdd) + + ! "d2h_chave2014" + ! "d to height via Chave et al. 2014" + + ! This function calculates tree height based on tree diameter and the + ! environmental stress factor "E", as per Chave et al. 2015 GCB + ! As opposed to previous allometric models in ED, in this formulation + ! we do not impose a hard cap on tree height. But, maximum_height + ! is an important parameter, but instead of imposing a hard limit, in + ! the new methodology, it will be used to trigger a change in carbon + ! balance accounting. Such that a tree that hits its maximum height will + ! begin to route available NPP into seed and defense respiration. + ! + ! The stress function is based on the geographic location of the site. If + ! a user decides to use Chave2015 allometry, the E factor will be read in + ! from a global gridded dataset and assigned for each ED patch (note it + ! will be the same for each ED patch, but this distinction will help in + ! porting ED into different models (patches are pure ED). It + ! assumes that the site is within the pan-tropics, and is a linear function + ! of climatic water deficit, temperature seasonality and precipitation + ! seasonality. See equation 6b of Chave et al. + ! The relevant equation for height in this function is 6a of the same + ! manuscript, and is intended to pair with diameter to relate with + ! structural biomass as per equation 7 (in which H is implicit). + ! + ! Chave et al. Improved allometric models to estimate the abovegroud + ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. + ! + ! ========================================================================= + + !eclim: Chave's climatological influence parameter "E" + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! parameter a + real(r8),intent(in) :: p2 ! parameter b + real(r8),intent(in) :: p3 ! parameter c + real(r8),intent(in) :: eclim ! climatological parameter "E" + real(r8),intent(in) :: dbh_maxh ! dbh at maximum height [cm] + + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] + + real(r8) :: dbh0,fl,ae + real(r8) :: dhpdd + + real(r8),parameter :: ddbh = 0.1_r8 ! 1-mm + real(r8),parameter :: k = 0.25_r8 + + ! For the non derivative solution, if the tree is large and + ! close to any cap that is imposed, then we need to perform a + ! step-integration because the asymptotic function makes the indefinite + ! integral incredibly messy. Thus we use an Euler step, yes ugly, + ! but it is a simple function so don't over-think it + + if (d>0.5_r8*dbh_maxh) then + dbh0=0.5_r8*dbh_maxh + h = exp( p1 - eclim + p2*log(dbh0) + p3*log(dbh0)**2.0_r8 ) + do while (dbh00.5_r8*dbh_maxh) then + dbh0=0.5_r8*dbh_maxh + h = p1*dbh0**p2 + do while(dbh0=dbh_maxh) then + h = 10.0_r8**(log10(dbh_maxh)*p1+p2) + dhdd = 0.0_r8 + else + h = 10.0_r8**(log10(d)*p1+p2) + dhdd = p1*10.0_r8**p2*d**(p1-1.0_r8) + end if + + return + + end subroutine d2h_obrien + + ! =========================================================================== + + subroutine d2h_martcano(d,p1,p2,p3,h,dhdd) + + ! ========================================================================= + ! "d2h_martcano" + ! "d to height via 3 parameter Michaelis-Menten following work at BCI + ! by Martinez-Cano et al. 2016 + ! + ! h = (a*d**b)/(c+d**b) + ! + ! h' = [(a*d**b)'(c+d**b) - (c+d**b)'(a*d**b)]/(c+d**b)**2 + ! dhdd = h' = [(ba*d**(b-1))(c+d**b) - (b*d**(b-1))(a*d**b)]/(c+d**b)**2 + ! + ! args + ! ========================================================================= + ! d: diameter at breast height + ! h: total tree height [m] + ! ========================================================================= + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! parameter a + real(r8),intent(in) :: p2 ! parameter b + real(r8),intent(in) :: p3 ! parameter c + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] + + + h = (p1*d**p2)/(p3+d**p2) + + dhdd = ((p2*p1*d**(p2-1._r8))*(p3+d**p2) - & + (p2*d**(p2-1._r8))*(p1*d**p2) )/ & + (p3+d**p2)**2._r8 + + return + end subroutine d2h_martcano + + + ! ========================================================================= + ! Diameter 2 above-ground biomass + ! ========================================================================= + + subroutine dh2bag_chave2014(d,h,ipft,d2bag1,d2bag2,wood_density,c2b,bag,dbagdd) + + ! ========================================================================= + ! This function calculates tree structural biomass from tree diameter, + ! height and wood density. + ! + ! Chave et al. Improved allometric models to estimate the abovegroud + ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. + ! + ! Input arguments: + ! d: Diameter at breast height [cm] + ! rho: wood specific gravity (dry wood mass per green volume) + ! height: total tree height [m] + ! a1: structural biomass allometry parameter 1 (intercept) + ! a2: structural biomass allometry parameter 2 (slope) + ! Output: + ! bag: Total above ground biomass [kgC] + ! + ! ========================================================================= + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer ,intent(in) :: ipft ! plant pft + real(r8),intent(in) :: d2bag1 ! allometry parameter 1 + real(r8),intent(in) :: d2bag2 ! allometry parameter 2 + real(r8),intent(in) :: wood_density + real(r8),intent(in) :: c2b + real(r8),intent(out) :: bag ! plant height [m] + real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] + + real(r8) :: hj,dhdd + real(r8) :: dbagdd1,dbagdd2,dbagdd3 + + bag = (d2bag1 * (wood_density*d**2.0_r8*h)**d2bag2)/c2b + + ! Need the the derivative of height to diameter to + ! solve the derivative of agb with height + call h_allom(d,ipft,hj,dhdd) + + dbagdd1 = (d2bag1*wood_density**d2bag2)/c2b + dbagdd2 = d2bag2*d**(2.0_r8*d2bag2)*h**(d2bag2-1.0_r8)*dhdd + dbagdd3 = h**d2bag2*2.0_r8*d2bag2*d**(2.0_r8*d2bag2-1.0_r8) + dbagdd = dbagdd1*(dbagdd2 + dbagdd3) + + return + end subroutine dh2bag_chave2014 + + subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) + + ! ========================================================================= + ! This function calculates tree above ground biomass according to 2 + ! parameter power functions. (slope and intercepts of a log-log + ! diameter-agb fit: + ! + ! These relationships are typical for temperate/boreal plants in North + ! America. Parameters are available from Chojnacky 2014 and Jenkins 2003 + ! + ! Note that we are using an effective diameter here, as Chojnacky 2014 + ! and Jenkins use diameter at the base of the plant for "woodland" species + ! The diameters should be converted prior to this routine if drc. + ! + ! Input arguments: + ! diam: effective diameter (d or drc) in cm + ! FOR SPECIES THAT EXPECT DCM, THIS NEEDS TO BE PRE-CALCULATED!!!! + ! Output: + ! agb: Total above ground biomass [kgC] + ! + ! ========================================================================= + ! Aceraceae, Betulaceae, Fagaceae and Salicaceae comprised nearly + ! three-fourths of the hardwood species (Table 3) + ! + ! Fabaceae and Juglandaceae had specific gravities .0.60 and were + ! combined, as were Hippocastanaceae and Tilaceae with specific gravities + ! near 0.30. The remaining 9 families, which included mostly species with + ! specific gravity 0.45–0.55, were initially grouped to construct a general + ! hardwood taxon for those families having few published biomass equa- + ! tions however, 3 warranted separation, leaving 6 families for the general + ! taxon. + ! bag = exp(b0 + b1*ln(diameter))/c2b + ! ========================================================================= + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: d2bag1 ! allometry parameter 1 + real(r8),intent(in) :: d2bag2 ! allometry parameter 2 + real(r8),intent(out) :: bag ! plant height [m] + real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] + + !max_dbh = EDPftvarcon_inst%maxdbh(ipft) + !if(diam>1.10*max_dbh) + ! display("-----------------------------------------------------") + ! display("Tree diameter is 10! larger than diameter where height") + ! display("hits maximum. However, you specified an AGB allometry") + ! display("that does not assume capping. Please consider ") + ! display("re-evaluating your allometric assumptions, growth") + ! display("formulations or maximum height") + ! display("------------------------------------------------------") + !end + + bag = (d2bag1 * d**d2bag2)/c2b + dbagdd = (d2bag2*d2bag1*d**(d2bag2-1.0_r8))/c2b + + return + end subroutine d2bag_2pwr + + + subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag1,d2bag1,d2bag1, & + wood_density,c2b,allom_agb_frac,bag,dbagdd) + + ! In the interest of reducing the number of model parameters, and since + ! Saldarriaga 1988 seems as though it is being deprecated, we will use + ! hard-wired parameter for dh2bag_salda, which would had required 4 + ! variable parameters. + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(in) :: d2bag1 ! = 0.06896_r8 + real(r8),intent(in) :: d2bag2 ! = 0.572_r8 + real(r8),intent(in) :: d2bag3 ! = 1.94_r8 + real(r8),intent(in) :: d2bag4 ! = 0.931_r8 + real(r8),intent(in) :: c2b ! carbon 2 biomass ratio + real(r8),intent(in) :: wood_desnity + real(r8),intent(in) :: allom_agb_frac + + real(r8),intent(out) :: bag ! plant biomass [kgC/indiv] + real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] + + real(r8) :: term1,term2,term3,hj,dhdd + + + + + + bag = allom_agb_frac*d2bag1*(h**d2bag2)*(d**d2bag3)*(wood_density**d2bag4) + + ! bag = a1 * h**a2 * d**a3 * r**a4 + ! dbag/dd = a1*r**a4 * d/dd (h**a2*d**a3) + ! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] + ! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] + + term1 = d2bag1*(wood_density**d2bag4) + term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) + + call h_allom(d,ipft,hj,dhdd) + term3 = d2bag2*h**(d2bag2-1)*(d**d2bag3)*dhdd + dbagdd = term1*(term2+term3) + return + end associate + + end subroutine dh2bag_salda + + ! ============================================================================ + ! height to diameter conversions + ! Note that these conversions will only back-calculate the actual diameter + ! for plants that have not started to experience height capping or an + ! asymptote. In these cases they may be called effective diameter. + ! ============================================================================ + + subroutine h2d_chave2014(h,p1,p2,p3,eclim,de,ddedh) + + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + real(r8),intent(in) :: p3 + real(r8),intent(in) :: eclim + + real(r8),intent(out) :: de ! effective plant diameter [cm] + real(r8),intent(out) :: ddedh ! effective change in d per height [cm/m] + + real(r8) :: ar, eroot, dbh1,dhpdd + + ar = p1-eclim + eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-ar))*p3)) & + /(2.0_r8*p3) + + de = exp(eroot) + + ! Invert the derivative at d without asymtote + dhpdd = exp(ar)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & + exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & + exp(p3*log(de)**2.0_r8) ) + + ddedh = 1.0_r8/dhpdd + + ! term1 = exp(-p2/(2*p3)) + ! term2 = exp(p2**2/(4*p3**2)) + ! term3 = exp(-ar/p3) + ! term4 = h**(1/p3-1.0_r8)/(p3) + ! d = term1*term2*term3*term4 + return + end subroutine h2d_chave2014 + + ! ============================================================================ + + subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) + + ! ------------------------------------------------------------------------- + ! Note that the height to diameter conversion in poorter is only necessary + ! when initializing saplings. In other methods, height to diameter is + ! useful when defining the dbh at which point to asymptote, as maximum + ! height is the user set parameter. This function should not need to set a + ! dbh_max parameter for instance, but it may end up doing so anyway, even + ! if it is not used, do to poor filtering. The poorter et al. d2h and h2d + ! functions are already asymptotic, and the parameter governing maximum + ! height is the p1 parameter. Note as dbh gets very large, the + ! exponential goes to zero, and the maximum height approaches p1. + ! However, the asymptote has a much different shape than the logistic, so + ! therefore in the Poorter et al functions, we do not set p1 == h_max. + ! That being said, if an h_max that is greater than p1 is passed to this + ! function, it will return a complex number. During parameter + ! initialization, a check will be placed that forces: + ! h_max = p1*0.98 + ! ------------------------------------------------------------------------- + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + real(r8),intent(in) :: p3 + + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out) :: dddh ! change in d per height [cm/m] + + ! ------------------------------------------------------------------------- + ! h = a1*(1 - exp(a2*d**a3)) + ! h = a1 - a1*exp(a2*d**a3) + ! a1-h = a1*exp(a2*d**a3) + ! (a1-h)/a1 = exp(a2*d**a3) + ! log(1-h/a1) = a2*d**a3 + ! [log(1-h/a1)/a2]**(1/a3) = d + ! + ! derivative dd/dh + ! dd/dh = [log((a1-h)/a1)/a2]**(1/a3)' + ! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1)* [(log(a1-h)-log(a1))/a2]' + ! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1) * (1/(a2*(h-a1)) + ! dd/dh = -((log(1-h/a1)/a2)**(1/a3-1))/(a2*a3*(a1-h)) + ! ------------------------------------------------------------------------- + + d = (log(1.0_r8-h/p1)/p2)**(1.0_r8/p3) + dddh = -((log(1-h/p1)/p2)**(1.0_r8/p3-1.0_r8))/ & + (p2*p3*(p1-h)) + + return + end subroutine h2d_poorter2006 + + ! ============================================================================ + + subroutine h2d_2pwr(h,p1,p2,d,dddh) + + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 ! parameter 1 + real(r8),intent(in) :: p2 ! parameter 2 + + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out) :: dddh ! change in d per height [cm/m] + + !h = a1*d**a2 + d = (h/p1)**(1.0_r8/p2) + ! d = (1/a1)**(1/a2)*h**(1/a2) + dddh = (1.0_r8/p2)*(1.0_r8/p1)**(1.0_r8/p2) & + *h**(1.0_r8/p2-1.0_r8) + + return + end subroutine h2d_2pwr + + ! ============================================================================ + + subroutine h2d_obrien(h,p1,p2,h_max,d,dddh) + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + real(r8),intent(in) :: h_max + + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out) :: dddh ! change in d per height [cm/m] + + + if (h EDPftvarcon_inst%allom_agb_frac(ipft), & allom_amode => EDPftvarcon_inst%allom_amode(ipft)) - select case(allom_amode) case (1) !"chave14") call dh2bag_chave2014(d,h,ipft,p1,p2,wood_density,c2b,bag,dbagdd) @@ -270,112 +280,102 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) real(r8),intent(out) :: blmax ! plant leaf biomass [kg] real(r8),intent(out) :: dblmaxdd ! change leaf bio per diameter [kgC/cm] - integer :: lallom_mode real(r8) :: p1 real(r8) :: p2 real(r8) :: p3 - real(r8) :: blmax_sap - real(r8) :: dblmaxdd_sap - real(r8) :: blmax_adult - real(r8) :: dblmaxdd_adult associate( & - d_adult => EDPftvarcon_inst%d_adult(ipft), & - d_sap => EDPftvarcon_inst%d_sap(ipft), & - dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & - rho => EDPftvarcon_inst%wood_density(ipft), & - c2b => EDPftvarcon_inst%c2b(ipft)) - - if ( d<=d_sap .or. d>=d_adult) then - - if(d<=d_sap) then - p1 = EDPftvarcon_inst%d2bl1_sap(ipft) - p2 = EDPftvarcon_inst%d2bl2_sap(ipft) - p3 = EDPftvarcon_inst%d2bl3_sap(ipft) - allom_lmode = EDPftvarcon_inst%lallom_sap_mode(ipft) - else - p1 = EDPftvarcon_inst%d2bl1_ad(ipft) - p2 = EDPftvarcon_inst%d2bl2_ad(ipft) - p3 = EDPftvarcon_inst%d2bl3_ad(ipft) - allom_lmode = EDPftvarcon_inst%lallom_ad_mode(ipft) - end if - - select case(allom_lmode) - case(1) !"salda") - call d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) - case(2) !"2par_pwr") - call d2blmax_2pwr(d,p1,p2,c2b,blmax,dblmaxdd) - case(3) ! dh2blmax_2pwr - call dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) - case DEFAULT - write(fates_log(),*) 'An undefined leaf allometry was specified: ', & - allom_lmode - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - else - - p1 = EDPftvarcon_inst%d2bl1_sap(ipft) - p2 = EDPftvarcon_inst%d2bl2_sap(ipft) - p3 = EDPftvarcon_inst%d2bl3_sap(ipft) - allom_lmode = EDPftvarcon_inst%lallom_sap_mode(ipft) - - select case(allom_lmode) - case(1) !"salda") - call d2blmax_salda(d_sap,p1,p2,p3,rho,dbh_maxh,c2b,blmax_sap,dblmaxdd_sap) - case(2) !"2par_pwr") - call d2blmax_2pwr(d_sap,p1,p2,c2b,blmax_sap,dblmaxdd_sap) - case(3) ! dh2blmax_2pwr - call dh2blmax_2pwr(d_sap,ipft,p1,p2,c2b,blmax_sap,dblmaxdd_sap) - case DEFAULT - write(fates_log(),*) 'An undefined leaf allometry was specified: ', & - allom_lmode - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - p1 = EDPftvarcon_inst%d2bl1_ad(ipft) - p2 = EDPftvarcon_inst%d2bl2_ad(ipft) - p3 = EDPftvarcon_inst%d2bl3_sap(ipft) - allom_lmode = EDPftvarcon_inst%lallom_ad_mode(ipft) - - select case(allom_lmode) - case(1) !"salda") - call d2blmax_salda(d_adult,p1,p2,p3,rho,dbh_maxh,c2b,blmax_adult,dblmaxdd_adult) - case(2) !"2par_pwr") - call d2blmax_2pwr(d_adult,p1,p2,c2b,blmax_adult,dblmaxdd_adult) - case(3) ! dh2blmax_2pwr - call dh2blmax_2pwr(d_adult,ipft,p1,p2,c2b,blmax_adult,dblmaxdd_adult) - case DEFAULT - write(fates_log(),*) 'An undefined leaf allometry was specified: ',allom_lmode - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - ! Use cubic spline interolation from d_sap to d_adult - call cspline(d_sap,d_adult,blmax_sap,blmax_adult,dblmaxdd_sap,dblmaxdd_adult,d,blmax,dblmaxdd) - - end if + dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & + rho => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft), & + allom_lmode => EDPftvarcon_inst%lallom_sap_mode(ipft)) + + p1 = EDPftvarcon_inst%allom_d2bl1(ipft) + p2 = EDPftvarcon_inst%allom_d2bl2(ipft) + p3 = EDPftvarcon_inst%allom_d2bl3(ipft) + + select case(allom_lmode) + case(1) !"salda") + call d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) + case(2) !"2par_pwr") + call d2blmax_2pwr(d,p1,p2,c2b,blmax,dblmaxdd) + case(3) ! dh2blmax_2pwr + call dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) + case DEFAULT + write(fates_log(),*) 'An undefined leaf allometry was specified: ', & + allom_lmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select end associate return end subroutine blmax_allom + ! ===================================================================================== + + subroutine bleaf(d,h,ipft,canopy_trim,bleaf,dbleafdd) + + ! ------------------------------------------------------------------------- + ! This subroutine calculates the actual target bleaf + ! based on trimming and sla scaling. Because trimming + ! is not allometry and rather an emergent property, + ! this routine is not name-spaces with allom_ + ! ------------------------------------------------------------------------- + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bleaf ! plant leaf biomass [kg] + real(r8),intent(out),optional :: dbleafdd ! change leaf bio per diameter [kgC/cm] + + real(r8) :: blmax + real(r8) :: dblmaxdd + real(r8) :: slascaler + + call blmax_allom(d,h,ipft,blmax,dblmaxdd) + + ! slascaler seems to be redundant with the slope parameter "a" + ! in our leaf allometry equations (rgk oct-2017) + ! maybe we should remove this? + + slascaler = EDPftvarcon_inst%allom_d2bl_slascaler(ipft) / & + EDPftvarcon_inst%slatop(ipft) + + bleaf = blmax * slascaler + + ! ------------------------------------------------------------------------- + ! Adjust for canopies that have become so deep that their bottom layer is + ! not producing any carbon... + ! nb this will change the allometry and the effects of this remain untested + ! RF. April 2014 + ! ------------------------------------------------------------------------- + + bleaf = bleaf * canopy_trim + + + return + end subroutine bleaf + + ! ============================================================================ ! Generic sapwood biomass interface ! ============================================================================ - subroutine bsap_allom(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) + subroutine bsap_allom(d,ipft,bsap,dbsapdd) - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: h ! plant height [m] - real(r8),intent(in) :: blmax ! plant leaf biomass [kgC] - real(r8),intent(in) :: dblmaxdd ! chage in blmax per diam [kgC/cm] - real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] - real(r8),intent(out) :: dbsapdd ! change leaf bio per d [kgC/cm] + real(r8),intent(in) :: d ! plant diameter [cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] + real(r8),intent(out),optional :: dbsapdd ! change leaf bio per d [kgC/cm] + + real(r8) :: h ! plant height [m] + real(r8) :: blmax ! plant leaf biomass [kgC] + real(r8) :: dblmaxdd ! chage in blmax per diam [kgC/cm] + real(r8) :: dhdd ! change in height per diameter [m/cm] + + + call h_allom(d,ipft,h,dhdd) + call blmax_allom(d,h,ipft,blmax,dblmaxdd) select case(EDPftvarcon_inst%allom_smode(ipft)) ! --------------------------------------------------------------------- @@ -399,15 +399,19 @@ end subroutine bsap_allom ! Generic coarse root biomass interface ! ============================================================================ - subroutine bcr_allom(d,bag,dbagdd,ipft,bcr,dbcrdd) + subroutine bcr_allom(d,h,ipft,bcr,dbcrdd) - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: bag ! above ground biomass [kgC] - real(r8),intent(in) :: dbagdd ! change in agb per diameter [kgC/cm] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bcr ! coarse root biomass [kgC] - real(r8),intent(out) :: dbcrdd ! change croot bio per diam [kgC/cm] + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bcr ! coarse root biomass [kgC] + real(r8),intent(out),optional :: dbcrdd ! change croot bio per diam [kgC/cm] + + real(r8) :: bag ! above ground biomass [kgC] + real(r8) :: dbagdd ! change in agb per diameter [kgC/cm] + + call bag_allom(d,h,ipft,bag,dbadd) select case(EDPftvarcon_inst%allom_cmode(ipft)) case(1) !"constant") @@ -451,31 +455,43 @@ end subroutine bfrmax_allom ! Dead biomass interface ! ============================================================================ - subroutine bdead_allom(bag,bcr,blmax,bsap,dbagdd,dbcrdd,dblmaxdd,dbsapdd, & - bdead,dbdeaddd) + subroutine bdead_allom(bag,bcr,bsap,bdead, & + dbagdd,dbcrdd,dbsapdd,dbdeaddd) real(r8),intent(in) :: bag ! agb [kgC] real(r8),intent(in) :: bcr ! coarse root biomass [kgC] - real(r8),intent(in) :: blmax ! max leaf biomass [kgC] real(r8),intent(in) :: bsap ! sapwood biomass [kgC] - - real(r8),intent(in) :: dbagdd ! change in agb per d [kgC/cm] - real(r8),intent(in) :: dbcrdd ! change in croot per d [kgC/cm] - real(r8),intent(in) :: dblmaxdd ! change in blmax per d [kgC/cm] - real(r8),intent(in) :: dbsapdd ! change in bsap per d [kgC/cm] - real(r8),intent(out) :: bdead ! dead biomass (heartw/struct) [kgC] - real(r8),intent(out) :: dbdeaddd ! change in bdead per d [kgC/cm] + + real(r8),intent(in),optional :: dbagdd ! change in agb per d [kgC/cm] + real(r8),intent(in),optional :: dbcrdd ! change in croot per d [kgC/cm] + real(r8),intent(in),optional :: dbsapdd ! change in bsap per d [kgC/cm] + real(r8),intent(out),optional :: dbdeaddd ! change in bdead per d [kgC/cm] + ! 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 + ! which includes sapwood. Although a small quantity, it needs to be removed + ! from the agb pool. + logical,parameter :: test_b4b = .true. + ! bdead is diagnosed as the mass balance from all other pools ! and therefore, no options are necessary - ! We are ignoring blmax right now, because it is insignificant in large - ! trees and may cause negatives in treelets and saplings - !bdead = bag+bcr-blmax-bsap - bdead = bag+bcr-bsap - dbdeaddd = dbagdd+dbcrdd-dbsapdd + if(test_b4b) then + bdead = bag+bcr + else + bdead = bag+bcr-bsap + end if + + if(present(dbagdd) .and. present(dbcrdd) .and. present(dbsapdd))then + if(test_b4b) then + dbdeaddd = dbagdd+dbcrdd + else + dbdeaddd = dbagdd+dbcrdd-dbsapdd + end if + end if return end subroutine bdead_allom @@ -723,34 +739,25 @@ subroutine dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) real(r8) :: dddh_eff ! effective diameter to height differential real(r8) :: ddeffdd ! effective diameter to diameter differential - associate( & - d_adult => EDPftvarcon_inst%d_adult(ipft)) - - - - ! This call is needed to calculate the effective dbh - ! Note that this is only necessary for adult plants - ! Because only adult plants are nearing their asymptotic heights - if (d>=d_adult) then - - ! This call is needed to calculate the rate of change of - ! the actual h with d - call h_allom(d,ipft,h,dhdd) - call h2d_allom(h,ipft,dbh_eff,dddh_eff) + ! This call is needed to calculate the rate of change of + ! the actual h with d + call h_allom(d,ipft,h,dhdd) + call h2d_allom(h,ipft,dbh_eff,dddh_eff) - ! This is the rate of change of the effective diameter - ! with respect to the actual diameter (1.0 in non-height capped) - ddeffdd = dddh_eff * dhdd - else - ! In this case we assume that dbh_eff == d - ! because we are not in some forced asymptotic portion of the curve - dbh_eff = d - ddeffdd = 1.0_r8 - end if - blmax = p1*dbh_eff**p2/c2b - dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd - end associate + ! This is the rate of change of the effective diameter + ! with respect to the actual diameter (1.0 in non-height capped) + ddeffdd = dddh_eff * dhdd + blmax = p1*dbh_eff**p2/c2b + + ! If this plant has reached its height cap, then it is not + ! adding leaf mass. In this case, dhdd = 0 + if(dhdd>0.0_r8) then + dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd + else + dblmaxdd = 0.0_r8 + end if + return end subroutine dh2blmax_2pwr @@ -801,67 +808,22 @@ subroutine d2h_chave2014(d,p1,p2,p3,eclim,dbh_maxh,h,dhdd) real(r8),intent(out) :: h ! plant height [m] real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] - - real(r8) :: dbh0,fl,ae - real(r8) :: dhpdd - - real(r8),parameter :: ddbh = 0.1_r8 ! 1-mm - real(r8),parameter :: k = 0.25_r8 - - ! For the non derivative solution, if the tree is large and - ! close to any cap that is imposed, then we need to perform a - ! step-integration because the asymptotic function makes the indefinite - ! integral incredibly messy. Thus we use an Euler step, yes ugly, - ! but it is a simple function so don't over-think it - - if (d>0.5_r8*dbh_maxh) then - dbh0=0.5_r8*dbh_maxh - h = exp( p1 - eclim + p2*log(dbh0) + p3*log(dbh0)**2.0_r8 ) - do while (dbh0=dbh_max .and. hallow_hcapping ) then + h = exp( p1e + p2*log(dbh_maxh) + p3*log(dbh_maxh)**2.0 ) + dhdd = 0.0_r8 else - h = exp( p1 - eclim + p2*log(d) + p3*log(d)**2.0 ) + h = exp( p1e + p2*log(d) + p3*log(d)**2.0 ) + dhdd = exp(p1e) * ( 2.0_r8*p3*d**(p2-1.0_r8+p3*log(d))*log(d) + & + p2*d**(p2-1.0_r8+p3*log(d)) ) end if - - ! Deriviative - - ! Find dbh_max where the non asymoted h crosses h_max - ! Find the root for 0 = a + bx + cx**2 - ! where: a = a1-E_chave-log(h_max) - ! b = a2 - ! c = a3 - ! dbh_max = exp(x) - ! solution: x = (-(br**2 - 4*ar*cr)**(1/2)-br)/(2*cr) - ! x = (+(br**2 - 4*ar*cr)**(1/2)-br)/(2*cr) - ! x1 = exp( (-(b**2 - 4*a*c)**(1/2)-b)/(2*c)) - ! dbh_maxh = exp(((p2**2 - ... - ! 4*(-log(h_max)+p1-eclim)*p3)**(1/2)-p2)/(2*p3)) - ! Logistic function - fl = 1.0_r8/(1.0_r8+exp(-k*(d-dbh_maxh))) - ! Derivative of logistic function wrt d - !dfldd = (k.*exp(-k.*(dbh+offset-dbh_max))) ... - ! /(1+exp(-k*(dbh+offset-dbh_max)))**2 - ae = p1-eclim - dhpdd = exp(ae)*( p3*2.0_r8*d**(p2-1.0_r8)*log(d)* & - exp(p3*log(d)**2.0_r8) + p2*d**(p2-1.0_r8)* & - exp(p3*log(d)**2.0_r8) ) - dhdd = dhpdd*(1.0_r8-fl) - - return - + return end subroutine d2h_chave2014 ! =========================================================================== - + subroutine d2h_poorter2006(d,p1,p2,p3,h,dhdd) ! "d2h_poorter2006" @@ -950,36 +912,13 @@ subroutine d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) real(r8),intent(out) :: h ! plant height [m] real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] - real(r8) :: dbh0,fl - - real(r8),parameter :: ddbh = 0.1_r8 ! 1-mm - real(r8),parameter :: k = 0.25_r8 ! sharpness coef for logistic - - ! For the non derivative solution, if the tree is large and - ! close to any cap that is imposed, then we need to perform a - ! step-integration because the asymptotic function makes the indefinite - ! integral incredibly messy. Thus we use an Euler step, yes ugly. - - if (d>0.5_r8*dbh_maxh) then - dbh0=0.5_r8*dbh_maxh - h = p1*dbh0**p2 - do while(dbh0=dbh_maxh .and. hallow_hcapping) then + h = p1*dbh_maxh**p2 + dhdd = 0.0_r8 else - h = p1*d**p2 + h = p1*d**p2 + dhdd = (p2*p1)*d**(p2-1.0_r8) end if - - ! The diameter at maximum height - ! dbh_maxh = (maxh/p1)**(1/p2) - ! Logistic function - fl = 1.0_r8/(1.0_r8+exp(-k*(d-dbh_maxh))) - ! Derivative of logistic function wrt d - dhdd = (p2*p1)*d**(p2-1.0_r8)*(1.0_r8-fl) - return end subroutine d2h_2pwr @@ -996,7 +935,7 @@ subroutine d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) !p1 = 0.64 !p2 = 0.37 - if(d>=dbh_maxh) then + if(d>=dbh_maxh .and. hallow_hcapping) then h = 10.0_r8**(log10(dbh_maxh)*p1+p2) dhdd = 0.0_r8 else @@ -1160,10 +1099,15 @@ end subroutine d2bag_2pwr subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag1,d2bag1,d2bag1, & wood_density,c2b,allom_agb_frac,bag,dbagdd) - ! In the interest of reducing the number of model parameters, and since - ! Saldarriaga 1988 seems as though it is being deprecated, we will use - ! hard-wired parameter for dh2bag_salda, which would had required 4 - ! variable parameters. + ! -------------------------------------------------------------------- + ! 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 + ! Saldarriaga 1988 provided calculations on total dead biomass + ! So here, we calculate total dead, and then call and remove + ! coarse root and sapwood. We ignore fineroot and leaf + ! in the calculations + ! -------------------------------------------------------------------- real(r8),intent(in) :: d ! plant diameter [cm] @@ -1183,23 +1127,23 @@ subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag1,d2bag1,d2bag1, & real(r8) :: term1,term2,term3,hj,dhdd - - + bag = allom_agb_frac*d2bag1*(h**d2bag2)*(d**d2bag3)*(wood_density**d2bag4) + + ! Add sapwood calculation to this - bag = allom_agb_frac*d2bag1*(h**d2bag2)*(d**d2bag3)*(wood_density**d2bag4) + ! bag = a1 * h**a2 * d**a3 * r**a4 + ! dbag/dd = a1*r**a4 * d/dd (h**a2*d**a3) + ! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] + ! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] + + term1 = allom_agb_frac*d2bag1*(wood_density**d2bag4) + term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) + + call h_allom(d,ipft,hj,dhdd) + term3 = d2bag2*h**(d2bag2-1)*(d**d2bag3)*dhdd + dbagdd = term1*(term2+term3) - ! bag = a1 * h**a2 * d**a3 * r**a4 - ! dbag/dd = a1*r**a4 * d/dd (h**a2*d**a3) - ! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] - ! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] - - term1 = d2bag1*(wood_density**d2bag4) - term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) - - call h_allom(d,ipft,hj,dhdd) - term3 = d2bag2*h**(d2bag2-1)*(d**d2bag3)*dhdd - dbagdd = term1*(term2+term3) - return + return end associate end subroutine dh2bag_salda @@ -1223,16 +1167,16 @@ subroutine h2d_chave2014(h,p1,p2,p3,eclim,de,ddedh) real(r8),intent(out) :: de ! effective plant diameter [cm] real(r8),intent(out) :: ddedh ! effective change in d per height [cm/m] - real(r8) :: ar, eroot, dbh1,dhpdd + real(r8) :: p1e, eroot, dbh1,dhpdd - ar = p1-eclim - eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-ar))*p3)) & + p1e = p1-eclim + eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-p1e))*p3)) & /(2.0_r8*p3) de = exp(eroot) ! Invert the derivative at d without asymtote - dhpdd = exp(ar)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & + dhpdd = exp(p1e)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & exp(p3*log(de)**2.0_r8) ) @@ -1240,7 +1184,7 @@ subroutine h2d_chave2014(h,p1,p2,p3,eclim,de,ddedh) ! term1 = exp(-p2/(2*p3)) ! term2 = exp(p2**2/(4*p3**2)) - ! term3 = exp(-ar/p3) + ! term3 = exp(-p1e/p3) ! term4 = h**(1/p3-1.0_r8)/(p3) ! d = term1*term2*term3*term4 return diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 085aee9f10..764ff9346f 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -26,6 +26,13 @@ module EDInitMod use FatesInterfaceMod , only : numpft use ChecksBalancesMod , only : SiteCarbonStock use FatesInterfaceMod , only : nlevsclass + use FatesAllometryMod , only : h2d_allom + use FatesAllometryMod , only : bag_allom + use FatesAllometryMod , only : bcr_allom + use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : bfr_allom + use FatesAllometryMod , only : bsap_allom + use FatesAllometryMod , only : bdead_allom ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -333,8 +340,13 @@ subroutine init_cohorts( patch_in, bc_in) ! ! !LOCAL VARIABLES: type(ed_cohort_type),pointer :: temp_cohort - integer :: cstatus - integer :: pft + integer :: cstatus + integer :: pft + real(r8) :: b_ag ! biomass above ground [kgC] + real(r8) :: b_cr ! biomass in coarse roots [kgC] + real(r8) :: b_leaf ! biomass in leaves [kgC] + real(r8) :: b_fineroot ! biomass in fine roots [kgC] + real(r8) :: b_sapwood ! biomass in sapwood [kgC] !---------------------------------------------------------------------- patch_in%tallest => null() @@ -349,27 +361,46 @@ subroutine init_cohorts( patch_in, bc_in) temp_cohort%pft = pft temp_cohort%n = EDPftvarcon_inst%initd(pft) * patch_in%area temp_cohort%hite = EDPftvarcon_inst%hgt_min(pft) - !temp_cohort%n = 0.5_r8 * 0.0028_r8 * patch_in%area ! BOC for fixed size runs EDPftvarcon_inst%initd(pft) * patch_in%area - !temp_cohort%hite = 28.65_r8 ! BOC translates to DBH of 50cm. EDPftvarcon_inst%hgt_min(pft) - temp_cohort%dbh = Dbh(temp_cohort) ! FIX(RF, 090314) - comment out addition of ' + 0.0001_r8*pft ' - seperate out PFTs a little bit... + + ! Calculate the plant diameter from height + call h2d_allom(temp_cohort%hite,pft,temp_cohort%dbh) + temp_cohort%canopy_trim = 1.0_r8 - temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%allom_l2fr(pft) & - + EDPftvarcon_inst%allom_latosa_int(temp_cohort%pft)*temp_cohort%hite) + + ! Calculate total above-ground biomass from allometry + call bag_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_ag) + + ! Calculate coarse root biomass from allometry + call bcr_allom(temp_cohort%dbh,temp_cohort%h,pft,b_cr) + + ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim + ! and sla scaling factors) + call bleaf(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_leaf) + + ! Calculate fine root biomass + call bfr_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_fineroot) + + ! Calculate sapwood biomass + call bsap_allom(temp_cohort%dbh,pft,b_sapwood) + + temp_cohort%balive = b_leaf + b_fineroot + b_sapwood + + call bdead_allom( b_ag, b_cr, b_sapwood, temp_cohort%bdead ) + temp_cohort%b = temp_cohort%balive + temp_cohort%bdead if( EDPftvarcon_inst%evergreen(pft) == 1) then - temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(pft) + temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(pft) temp_cohort%laimemory = 0._r8 cstatus = 2 endif if( EDPftvarcon_inst%season_decid(pft) == 1 ) then !for dorment places - temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(pft) !stored carbon in new seedlings. + temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(pft) !stored carbon in new seedlings. if(patch_in%siteptr%status == 2)then temp_cohort%laimemory = 0.0_r8 else - temp_cohort%laimemory = Bleaf(temp_cohort) + temp_cohort%laimemory = b_leaf endif ! reduce biomass according to size of store, this will be recovered when elaves com on. temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory @@ -377,8 +408,8 @@ subroutine init_cohorts( patch_in, bc_in) endif if ( EDPftvarcon_inst%stress_decid(pft) == 1 ) then - temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(pft) - temp_cohort%laimemory = Bleaf(temp_cohort) + temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(pft) + temp_cohort%laimemory = b_leaf temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory cstatus = patch_in%siteptr%dstatus endif diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index d01d9c3d0d..6667d61e58 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -748,9 +748,15 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! avgRG (cm/yr?) Average Radial Growth (NOT USED) ! -------------------------------------------------------------------------------------------- - use EDGrowthFunctionsMod, only : hite - use EDGrowthFunctionsMod, only : bleaf - use EDGrowthFunctionsMod, only : bdead + use FatesAllometryMod , only : h_allom + use FatesAllometryMod , only : h2d_allom + use FatesAllometryMod , only : bag_allom + use FatesAllometryMod , only : bcr_allom + use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : bfr_allom + use FatesAllometryMod , only : bsap_allom + use FatesAllometryMod , only : bdead_allom + use EDCohortDynamicsMod , only : create_cohort use FatesInterfaceMod , only : numpft @@ -779,6 +785,11 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & type(ed_cohort_type), pointer :: temp_cohort ! temporary patch (needed for allom funcs) integer :: ipa ! patch idex logical :: matched_patch ! check if cohort was matched w/ patch + real(r8) :: b_ag ! biomass above ground [kgC] + real(r8) :: b_cr ! biomass in coarse roots [kgC] + real(r8) :: b_leaf ! biomass in leaves [kgC] + real(r8) :: b_fineroot ! biomass in fine roots [kgC] + real(r8) :: b_sapwood ! biomass in sapwood [kgC] character(len=128),parameter :: wr_fmt = & '(F7.1,2X,A20,2X,A20,2X,F5.2,2X,F5.2,2X,I4,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2)' @@ -857,31 +868,46 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & allocate(temp_cohort) ! A temporary cohort is needed because we want to make ! use of the allometry functions - - temp_cohort%pft = c_pft temp_cohort%n = c_nplant * cpatch%area - temp_cohort%hite = Hite(temp_cohort) + call h_allom(c_dbh,ipft,temp_cohort%hite) temp_cohort%dbh = c_dbh temp_cohort%canopy_trim = 1.0_r8 - temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%allom_l2fr(c_pft) & - + EDpftvarcon_inst%allom_latosa_int(c_pft)*temp_cohort%hite) + ! Calculate total above-ground biomass from allometry + + call bag_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_ag) + ! Calculate coarse root biomass from allometry + call bcr_allom(temp_cohort%dbh,temp_cohort%h,c_pft,b_cr) + + ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim + ! and sla scaling factors) + call bleaf(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_leaf) + + ! Calculate fine root biomass + call bfr_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_fineroot) + + ! Calculate sapwood biomass + call bsap_allom(temp_cohort%dbh,c_pft,b_sapwood) + + temp_cohort%balive = b_leaf + b_fineroot + b_sapwood + + call bdead_allom( b_ag, b_cr, b_sapwood, temp_cohort%bdead ) + temp_cohort%b = temp_cohort%balive + temp_cohort%bdead if( EDPftvarcon_inst%evergreen(c_pft) == 1) then - temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(c_pft) + temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(c_pft) temp_cohort%laimemory = 0._r8 cstatus = 2 endif if( EDPftvarcon_inst%season_decid(c_pft) == 1 ) then !for dorment places - temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(c_pft) !stored carbon in new seedlings. + temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(c_pft) !stored carbon in new seedlings. if(csite%status == 2)then temp_cohort%laimemory = 0.0_r8 else - temp_cohort%laimemory = Bleaf(temp_cohort) + temp_cohort%laimemory = b_leaf endif ! reduce biomass according to size of store, this will be recovered when elaves com on. temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory @@ -889,8 +915,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & endif if ( EDPftvarcon_inst%stress_decid(c_pft) == 1 ) then - temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(c_pft) - temp_cohort%laimemory = Bleaf(temp_cohort) + temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(c_pft) + temp_cohort%laimemory = b_leaf temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory cstatus = csite%dstatus endif diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 44ac2ea58f..923b377694 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1355,12 +1355,12 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) use EDTypesMod, only : maxpft use EDTypesMod, only : area use EDPatchDynamicsMod, only : zero_patch - use EDGrowthFunctionsMod, only : Dbh use EDCohortDynamicsMod, only : create_cohort use EDInitMod, only : zero_site use EDInitMod, only : init_site_vars use EDPatchDynamicsMod, only : create_patch - use EDPftvarcon, only : EDPftvarcon_inst + use EDPftvarcon, only : EDPftvarcon_inst + use FatesAllometryMod, only : h2d_allom ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this @@ -1477,10 +1477,9 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) endif temp_cohort%hite = 1.25_r8 - ! the dbh function should only take as an argument, the one - ! item it needs, not the entire cohort...refactor - temp_cohort%dbh = Dbh(temp_cohort) + 0.0001_r8*ft - + ! Solve for diameter from height + call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) + if (DEBUG) then write(fates_log(),*) 'EDRestVectorMod.F90::createPatchCohortStructure call create_cohort ' end if From 586975d9610f29cfeb66d8c2435e77bf971220dd Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 3 Oct 2017 14:33:46 -0700 Subject: [PATCH 03/63] Incremental changes towards modular allometry. --- biogeochem/EDPhysiologyMod.F90 | 109 ++++++++++++++++++++----------- biogeochem/FatesAllometryMod.F90 | 46 ++++++++----- main/EDInitMod.F90 | 5 +- 3 files changed, 103 insertions(+), 57 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index a145616d5f..69fb3b0dc1 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -761,7 +761,9 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! Main subroutine controlling growth and allocation derivatives ! ! !USES: - use EDGrowthFunctionsMod , only : Bleaf, dDbhdBd, dhdbd, hite, mortality_rates,dDbhdBl + +! use EDGrowthFunctionsMod , only : Bleaf, dDbhdBd, dhdbd, hite, mortality_rates,dDbhdBl + use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys use EDLoggingMortalityMod, only : LoggingMortality_frac @@ -791,10 +793,14 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) real(r8) :: lmort_collateral ! Mortality fraction associated with logging collateral damage real(r8) :: lmort_infra ! Mortality fraction associated with logging infrastructure real(r8) :: dndt_logging ! Mortality rate (per day) associated with the a logging event - real(r8) :: balive_loss + + integer :: ipft ! local copy of the pft index !---------------------------------------------------------------------- + ipft = currentCohort%pft + + ! Mortality for trees in the understorey. !if trees are in the canopy, then their death is 'disturbance'. This probably needs a different terminology call mortality_rates(currentCohort,cmort,hmort,bmort) @@ -823,12 +829,18 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) call allocate_live_biomass(currentCohort,0) ! calculate target size of living biomass compartment for a given dbh. - target_balive = Bleaf(currentCohort) * (1.0_r8 + EDPftvarcon_inst%allom_l2fr(currentCohort%pft) + & - EDpftvarcon_inst%allom_latosa_int(currentCohort%pft)*h) + call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_leaf) + + call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,b_fineroot) + + call bsap_allom(currentCohort%dbh,ipft,b_sapwood) + + + target_balive = b_leaf + b_fineroot + b_sapwood + !target balive without leaves. if (currentCohort%status_coh == 1)then - target_balive = Bleaf(currentCohort) * (EDPftvarcon_inst%allom_l2fr(currentCohort%pft) + & - EDpftvarcon_inst%allom_latosa_int(currentCohort%pft) * h) + target_balive = b_fineroot + b_sapwood endif ! NPP @@ -842,18 +854,18 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) if (hlm_use_ed_prescribed_phys .eq. itrue) then if (currentCohort%canopy_layer .eq. 1) then - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(currentCohort%pft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ipft) * currentCohort%c_area / currentCohort%n else - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(currentCohort%pft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ipft) * currentCohort%c_area / currentCohort%n endif endif currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n ! Maintenance demands - if (EDPftvarcon_inst%evergreen(currentCohort%pft) == 1)then !grass and EBT - currentCohort%leaf_md = currentCohort%bl / EDPftvarcon_inst%leaf_long(currentCohort%pft) - currentCohort%root_md = currentCohort%br / EDPftvarcon_inst%root_long(currentCohort%pft) + if (EDPftvarcon_inst%evergreen(ipft) == 1)then !grass and EBT + currentCohort%leaf_md = currentCohort%bl / EDPftvarcon_inst%leaf_long(ipft) + currentCohort%root_md = currentCohort%br / EDPftvarcon_inst%root_long(ipft) currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif @@ -862,24 +874,24 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !with which I am not especially comfortable, particularly as the concept of sapwood turnover is unclear for trees that !are still in an expansion phase. - if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then - currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(currentCohort%pft) + if (EDPftvarcon_inst%season_decid(ipft) == 1)then + currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(ipft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then - currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(currentCohort%pft) + if (EDPftvarcon_inst%stress_decid(ipft) == 1)then + currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(ipft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (EDPftvarcon_inst%stress_decid(currentCohort%pft) /= 1 & - .and.EDPftvarcon_inst%season_decid(currentCohort%pft) /= 1.and. & - EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then - write(fates_log(),*) 'problem with phenology definitions',currentCohort%pft, & - EDPftvarcon_inst%stress_decid(currentCohort%pft), & - EDPftvarcon_inst%season_decid(currentCohort%pft),EDPftvarcon_inst%evergreen(currentCohort%pft) + if (EDPftvarcon_inst%stress_decid(ipft) /= 1 & + .and.EDPftvarcon_inst%season_decid(ipft) /= 1.and. & + EDPftvarcon_inst%evergreen(ipft) /= 1)then + write(fates_log(),*) 'problem with phenology definitions',ipft, & + EDPftvarcon_inst%stress_decid(ipft), & + EDPftvarcon_inst%season_decid(ipft),EDPftvarcon_inst%evergreen(ipft) endif ! FIX(RF,032414) -turned off for now as it makes balive go negative.... @@ -891,26 +903,26 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! this is the fraction of maintenance demand we -have- to do... if ( DEBUG ) write(fates_log(),*) 'EDphys 760 ',currentCohort%npp_acc_hold, currentCohort%md, & - EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft) + EDPftvarcon_inst%leaf_stor_priority(ipft) currentCohort%carbon_balance = currentCohort%npp_acc_hold - & - currentCohort%md * EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft) + currentCohort%md * EDPftvarcon_inst%leaf_stor_priority(ipft) ! Allowing only carbon from NPP pool to account for npp flux into the maintenance turnover pools ! ie this does not include any use of storage carbon or balive to make up for missing carbon balance in the transfer currentCohort%npp_leaf = max(0.0_r8,min(currentCohort%npp_acc_hold*currentCohort%leaf_md/currentCohort%md, & - currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft))) + currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(ipft))) currentCohort%npp_froot = max(0.0_r8,min(currentCohort%npp_acc_hold*currentCohort%root_md/currentCohort%md, & - currentCohort%root_md*EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft))) + currentCohort%root_md*EDPftvarcon_inst%leaf_stor_priority(ipft))) - if (Bleaf(currentCohort) > 0._r8)then + if (b_leaf > 0._r8)then if ( DEBUG ) write(fates_log(),*) 'EDphys A ',currentCohort%carbon_balance if (currentCohort%carbon_balance > 0._r8)then !spend C on growing and storing !what fraction of the target storage do we have? - frac = max(0.0_r8,currentCohort%bstore/(Bleaf(currentCohort) * EDPftvarcon_inst%cushion(currentCohort%pft))) + frac = max(0.0_r8,currentCohort%bstore/( b_leaf * EDPftvarcon_inst%cushion(ipft))) ! FIX(SPM,080514,fstore never used ) f_store = max(exp(-1.*frac**4._r8) - exp( -1.0_r8 ),0.0_r8) !what fraction of allocation do we divert to storage? @@ -935,21 +947,21 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) else - write(fates_log(),*) 'No target leaf area in GrowthDerivs? Bleaf(cohort) <= 0?' + write(fates_log(),*) 'No target leaf area in GrowthDerivs? b_leaf <= 0?' call endrun(msg=errMsg(sourcefile, __LINE__)) endif !Do we have enough carbon left over to make up the rest of the turnover demand? balive_loss = 0._r8 - if (currentCohort%carbon_balance > currentCohort%md*(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)))then ! Yes... + if (currentCohort%carbon_balance > currentCohort%md*(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(ipft)))then ! Yes... currentCohort%carbon_balance = currentCohort%carbon_balance - currentCohort%md * (1.0_r8 - & - EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) + EDPftvarcon_inst%leaf_stor_priority(ipft)) currentCohort%npp_leaf = currentCohort%npp_leaf + & - currentCohort%leaf_md * (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) + currentCohort%leaf_md * (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft)) currentCohort%npp_froot = currentCohort%npp_froot + & - currentCohort%root_md * (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) + currentCohort%root_md * (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft)) else ! we can't maintain constant leaf area and root area. Balive is reduced @@ -958,7 +970,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%npp_froot = currentCohort%npp_froot + & max(0.0_r8,currentCohort%carbon_balance*(currentCohort%root_md/currentCohort%md)) - balive_loss = currentCohort%md *(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft))- currentCohort%carbon_balance + balive_loss = currentCohort%md *(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(ipft))- currentCohort%carbon_balance currentCohort%carbon_balance = 0._r8 endif @@ -970,12 +982,31 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !only if carbon balance is +ve if ((currentCohort%balive >= target_balive).AND.(currentCohort%carbon_balance > 0._r8))then ! fraction of carbon going into active vs structural carbon + if (currentCohort%dbh <= EDPftvarcon_inst%allom_dbh_maxheight(currentCohort%pft))then ! cap on leaf biomass - dbldbd = dDbhdBd(currentCohort)/dDbhdBl(currentCohort) - dbrdbd = EDPftvarcon_inst%allom_l2fr(currentCohort%pft) * dbldbd - dhdbd_fn = dhdbd(currentCohort) - dbswdbd = EDpftvarcon_inst%allom_latosa_int(currentCohort%pft) * (h*dbldbd + currentCohort%bl*dhdbd_fn) - u = 1.0_r8 / (dbldbd + dbrdbd + dbswdbd) + + call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_leaf,dbleafdd) + + call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot,dbfrdd) + + call bsap_allom(temp_cohort%dbh,pft,b_sap,dbsapdd) + + ! Tally up the relative change in bdead WRT diameter + call bag_allom(currentCohort%dbh,currentCohort%hite,ipft,b_ag,dbagdd) + call bcr_allom(currentCohort%dbh,currentCohort%h,pft,b_cr,dbcrdd) + call bdead_allom( b_ag, b_cr, b_sap, dbagdd, dbcrdd, dbsapdd, dbdeaddd ) + + ! Change in leaf biomass per dead biomass + dbldbd = dbldd/dbdeaddd + + ! Change in fineroot biomass per dead biomass + dbfrdbd = dbfrdd/dbdeaddd + + ! Change in sapwood biomass per dead biomass + dbsapdbd = dbsapdd/dbdeaddd + + u = 1.0_r8 / (dbldbd + dbfrdbd + dbsapdbd) + va = 1.0_r8 / (1.0_r8 + u) vs = u / (1.0_r8 + u) gr_fract = 1.0_r8 - EDPftvarcon_inst%seed_alloc(currentCohort%pft) @@ -1048,7 +1079,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! spawn new cohorts of juveniles of each PFT ! ! !USES: - use EDGrowthFunctionsMod, only : bdead,dbh, Bleaf +! use EDGrowthFunctionsMod, only : bdead,dbh, Bleaf use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys ! ! !ARGUMENTS diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 5fb3e01b42..b59f6cc7a0 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -95,6 +95,7 @@ module FatesAllometryMod public :: bsap_allom ! Generic sapwood wrapper public :: bcr_allom ! Generic coarse root wrapper public :: bfrmax_allom ! Generic maximum fine root biomass wrapper + public :: bfineroot ! Generic actual fine root biomass wrapper public :: bdead_allom ! Generic bdead wrapper character(len=*), parameter, private :: sourcefile = & @@ -340,8 +341,6 @@ subroutine bleaf(d,h,ipft,canopy_trim,bleaf,dbleafdd) slascaler = EDPftvarcon_inst%allom_d2bl_slascaler(ipft) / & EDPftvarcon_inst%slatop(ipft) - - bleaf = blmax * slascaler ! ------------------------------------------------------------------------- ! Adjust for canopies that have become so deep that their bottom layer is @@ -350,8 +349,8 @@ subroutine bleaf(d,h,ipft,canopy_trim,bleaf,dbleafdd) ! RF. April 2014 ! ------------------------------------------------------------------------- - bleaf = bleaf * canopy_trim - + bleaf = blmax * slascaler * canopy_trim + dbleafdd = dblmaxdd * slascaler * canopy_trim return end subroutine bleaf @@ -426,30 +425,47 @@ subroutine bcr_allom(d,h,ipft,bcr,dbcrdd) end subroutine bcr_allom ! ============================================================================ - ! Generic maximum fine root biomass interface + ! Fine root biomass allometry wrapper ! ============================================================================ - subroutine bfrmax_allom(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) + subroutine bfineroot(d,h,ipft,canopy_trim,bfineroot,dbfrdd) + + ! ------------------------------------------------------------------------- + ! This subroutine calculates the actual target fineroot biomass + ! based on functions that may or may not have prognostic properties. + ! ------------------------------------------------------------------------- - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: blmax ! max leaf biomass [kgC] - real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] + real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bfrmax ! max fine-root root biomass [kgC] - real(r8),intent(out) :: dbfrmaxdd ! change frmax bio per diam [kgC/cm] - + real(r8),intent(out) :: bfineroot ! fine root biomass [kgC] + real(r8),intent(out),optional :: dbfrdd ! change leaf bio per diameter [kgC/cm] + + real(r8) :: slascaler + real(r8) :: bfrmax + real(r8) :: dbfrmaxdd + real(r8) :: slascaler + select case(EDPftvarcon_inst%allom_fmode(ipft)) - case(1) ! "constant") + case(1) ! "constant proportionality with bleaf" + + call blmax_allom(d,h,ipft,blmax,dblmaxdd) call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) + slascaler = EDPftvarcon_inst%allom_d2bl_slascaler(ipft) / & + EDPftvarcon_inst%slatop(ipft) + bfineroot = bfrmax * slascaler * canopy_trim + dbfrdd = dbfrmaxdd * slascaler * canopy_trim + case DEFAULT write(fates_log(),*) 'An undefined fine root allometry was specified: ', & - EDPftvarcon_inst%allom_fmode(ipft) + EDPftvarcon_inst%allom_fmode(ipft) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select return - end subroutine bfrmax_allom + + end subroutine bfineroot + ! ============================================================================ ! Dead biomass interface diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 764ff9346f..4b0d8e25a0 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -12,7 +12,6 @@ module EDInitMod use FatesGlobals , only : fates_log use FatesInterfaceMod , only : hlm_is_restart use EDPftvarcon , only : EDPftvarcon_inst - use EDGrowthFunctionsMod , only : bdead, bleaf, dbh use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts use EDPatchDynamicsMod , only : create_patch use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type @@ -30,7 +29,7 @@ module EDInitMod use FatesAllometryMod , only : bag_allom use FatesAllometryMod , only : bcr_allom use FatesAllometryMod , only : bleaf - use FatesAllometryMod , only : bfr_allom + use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bdead_allom @@ -378,7 +377,7 @@ subroutine init_cohorts( patch_in, bc_in) call bleaf(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_leaf) ! Calculate fine root biomass - call bfr_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_fineroot) + call bfineroot(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,pft,b_sapwood) From 4c221da89cb51ade76469a40f7a497ed79c515f7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 3 Oct 2017 16:20:00 -0700 Subject: [PATCH 04/63] Incremental commit towards modular allometry. --- biogeochem/EDPhysiologyMod.F90 | 95 ++++++++++++++++++++------------ biogeochem/FatesAllometryMod.F90 | 34 ++++-------- main/EDInitMod.F90 | 7 ++- 3 files changed, 76 insertions(+), 60 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 69fb3b0dc1..f5bebda985 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -804,7 +804,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! Mortality for trees in the understorey. !if trees are in the canopy, then their death is 'disturbance'. This probably needs a different terminology call mortality_rates(currentCohort,cmort,hmort,bmort) - call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, & + call LoggingMortality_frac(ipft, currentCohort%dbh, & currentCohort%lmort_logging, & currentCohort%lmort_collateral, & currentCohort%lmort_infra ) @@ -828,14 +828,22 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) call allocate_live_biomass(currentCohort,0) - ! calculate target size of living biomass compartment for a given dbh. + ! ----------------------------------------------------------------------------------- + ! calculate target size of living biomass compartment for a given dbh. + ! ----------------------------------------------------------------------------------- + + ! Calculate leaf biomass, this wrapper finds the maximum per allometry, and then + ! applies trimming call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_leaf) + ! Calculate the fine root biomass, this wrapper finds the maximum per allometry, + ! and in the current default case, will trim fine root biomass at the same proportion + ! that it trims leaves call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,b_fineroot) + ! Calculate sapwood biomass call bsap_allom(currentCohort%dbh,ipft,b_sapwood) - target_balive = b_leaf + b_fineroot + b_sapwood !target balive without leaves. @@ -854,9 +862,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) if (hlm_use_ed_prescribed_phys .eq. itrue) then if (currentCohort%canopy_layer .eq. 1) then - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ipft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ipft) * & + currentCohort%c_area / currentCohort%n else - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ipft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ipft) * & + currentCohort%c_area / currentCohort%n endif endif @@ -980,42 +990,57 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !Use remaining carbon to refill balive or to get larger. !only if carbon balance is +ve - if ((currentCohort%balive >= target_balive).AND.(currentCohort%carbon_balance > 0._r8))then - ! fraction of carbon going into active vs structural carbon - - if (currentCohort%dbh <= EDPftvarcon_inst%allom_dbh_maxheight(currentCohort%pft))then ! cap on leaf biomass - call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_leaf,dbleafdd) + if ((currentCohort%balive >= target_balive).and.(currentCohort%carbon_balance > 0._r8))then + ! fraction of carbon going into active vs structural carbon - call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot,dbfrdd) + ! fraction of carbon going into active vs structural carbon + if (currentCohort%dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass + gr_fract = 1.0_r8 - EDPftvarcon_inst%seed_alloc(ipft) + else + gr_fract = 1.0_r8 - (EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft)) + end if + + call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_leaf,dbleafdd) + + call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot,dbfrdd) + + call bsap_allom(temp_cohort%dbh,pft,b_sap,dbsapdd) + + ! Tally up the relative change in bdead WRT diameter + call bag_allom(currentCohort%dbh,currentCohort%hite,ipft,b_ag,dbagdd) + call bcr_allom(currentCohort%dbh,currentCohort%h,pft,b_cr,dbcrdd) + call bdead_allom( b_ag, b_cr, b_sap, dbagdd, dbcrdd, dbsapdd, dbdeaddd ) + + ! Change in leaf biomass per dead biomass [kgC/kgC] + dbldbd = dbldd/dbdeaddd + + ! Change in fineroot biomass per dead biomass [kgC/kgC] + dbfrdbd = dbfrdd/dbdeaddd + + ! Change in sapwood biomass per dead biomass [kgC/kgC] + dbsapdbd = dbsapdd/dbdeaddd + + ! Total change in alive biomass relative to dead biomass [kgC/kgC] + dbalivedbd = dbldbd + dbfrdbd + dbsapdbd + + if(dbalivedbd>tiny(dbalivedbd))then - call bsap_allom(temp_cohort%dbh,pft,b_sap,dbsapdd) - - ! Tally up the relative change in bdead WRT diameter - call bag_allom(currentCohort%dbh,currentCohort%hite,ipft,b_ag,dbagdd) - call bcr_allom(currentCohort%dbh,currentCohort%h,pft,b_cr,dbcrdd) - call bdead_allom( b_ag, b_cr, b_sap, dbagdd, dbcrdd, dbsapdd, dbdeaddd ) - - ! Change in leaf biomass per dead biomass - dbldbd = dbldd/dbdeaddd - - ! Change in fineroot biomass per dead biomass - dbfrdbd = dbfrdd/dbdeaddd - - ! Change in sapwood biomass per dead biomass - dbsapdbd = dbsapdd/dbdeaddd - u = 1.0_r8 / (dbldbd + dbfrdbd + dbsapdbd) - + va = 1.0_r8 / (1.0_r8 + u) vs = u / (1.0_r8 + u) - gr_fract = 1.0_r8 - EDPftvarcon_inst%seed_alloc(currentCohort%pft) + else - dbldbd = 0._r8; dbrdbd = 0._r8 ;dbswdbd = 0._r8 + ! If there is no change in alive biomass per change in dead, + ! most likely we are dealing with plants that have surpassed + ! an allometric threshold that limits alive biomass. + va = 0.0_r8 vs = 1.0_r8 - gr_fract = 1.0_r8 - (EDPftvarcon_inst%seed_alloc(currentCohort%pft) + EDPftvarcon_inst%clone_alloc(currentCohort%pft)) - endif + + end if + !FIX(RF,032414) - to fix high bl's. needed to prevent numerical errors without the ODEINT. if (currentCohort%balive > target_balive*1.1_r8)then @@ -1024,8 +1049,10 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) endif else + dbldbd = 0._r8; dbrdbd = 0._r8; dbswdbd = 0._r8 - va = 1.0_r8; vs = 0._r8 + va = 1.0_r8; + vs = 0._r8 gr_fract = 1.0_r8 endif @@ -1070,7 +1097,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! If the cohort has grown, it is not new currentCohort%isnew=.false. - end subroutine Growth_Derivatives + end subroutine Growth_Derivatives ! ============================================================================ subroutine recruitment( currentSite, currentPatch, bc_in ) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index b59f6cc7a0..6d36a4526d 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -314,7 +314,7 @@ end subroutine blmax_allom ! ===================================================================================== - subroutine bleaf(d,h,ipft,canopy_trim,bleaf,dbleafdd) + subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target bleaf @@ -326,8 +326,8 @@ subroutine bleaf(d,h,ipft,canopy_trim,bleaf,dbleafdd) real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bleaf ! plant leaf biomass [kg] - real(r8),intent(out),optional :: dbleafdd ! change leaf bio per diameter [kgC/cm] + real(r8),intent(out) :: bl ! plant leaf biomass [kg] + real(r8),intent(out),optional :: dbldd ! change leaf bio per diameter [kgC/cm] real(r8) :: blmax real(r8) :: dblmaxdd @@ -335,13 +335,6 @@ subroutine bleaf(d,h,ipft,canopy_trim,bleaf,dbleafdd) call blmax_allom(d,h,ipft,blmax,dblmaxdd) - ! slascaler seems to be redundant with the slope parameter "a" - ! in our leaf allometry equations (rgk oct-2017) - ! maybe we should remove this? - - slascaler = EDPftvarcon_inst%allom_d2bl_slascaler(ipft) / & - EDPftvarcon_inst%slatop(ipft) - ! ------------------------------------------------------------------------- ! Adjust for canopies that have become so deep that their bottom layer is ! not producing any carbon... @@ -349,8 +342,8 @@ subroutine bleaf(d,h,ipft,canopy_trim,bleaf,dbleafdd) ! RF. April 2014 ! ------------------------------------------------------------------------- - bleaf = blmax * slascaler * canopy_trim - dbleafdd = dblmaxdd * slascaler * canopy_trim + bl = blmax * canopy_trim + dbldd = dblmaxdd * canopy_trim return end subroutine bleaf @@ -372,10 +365,6 @@ subroutine bsap_allom(d,ipft,bsap,dbsapdd) real(r8) :: dblmaxdd ! chage in blmax per diam [kgC/cm] real(r8) :: dhdd ! change in height per diameter [m/cm] - - call h_allom(d,ipft,h,dhdd) - call blmax_allom(d,h,ipft,blmax,dblmaxdd) - select case(EDPftvarcon_inst%allom_smode(ipft)) ! --------------------------------------------------------------------- ! Currently both sapwood area proportionality methods use the same @@ -383,7 +372,9 @@ subroutine bsap_allom(d,ipft,bsap,dbsapdd) ! checking at the beginning. For constant proportionality, the slope ! of the la:sa to diameter line is zero. ! --------------------------------------------------------------------- - case(1,2) !"constant","dlinear") + case(1,2) !"constant","dlinear") + call h_allom(d,ipft,h,dhdd) + call blmax_allom(d,h,ipft,blmax,dblmaxdd) call bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) case DEFAULT write(fates_log(),*) 'An undefined sapwood allometry was specified: ', & @@ -438,10 +429,9 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfineroot,dbfrdd) real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bfineroot ! fine root biomass [kgC] + real(r8),intent(out) :: bfr ! fine root biomass [kgC] real(r8),intent(out),optional :: dbfrdd ! change leaf bio per diameter [kgC/cm] - real(r8) :: slascaler real(r8) :: bfrmax real(r8) :: dbfrmaxdd real(r8) :: slascaler @@ -451,10 +441,8 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfineroot,dbfrdd) call blmax_allom(d,h,ipft,blmax,dblmaxdd) call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) - slascaler = EDPftvarcon_inst%allom_d2bl_slascaler(ipft) / & - EDPftvarcon_inst%slatop(ipft) - bfineroot = bfrmax * slascaler * canopy_trim - dbfrdd = dbfrmaxdd * slascaler * canopy_trim + bfr = bfrmax * canopy_trim + dbfrdd = dbfrmaxdd * canopy_trim case DEFAULT write(fates_log(),*) 'An undefined fine root allometry was specified: ', & diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 4b0d8e25a0..f546253716 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -372,11 +372,12 @@ subroutine init_cohorts( patch_in, bc_in) ! Calculate coarse root biomass from allometry call bcr_allom(temp_cohort%dbh,temp_cohort%h,pft,b_cr) - ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim - ! and sla scaling factors) + ! Calculate the leaf biomass + ! (calculates a maximum first, then applies canopy trim) call bleaf(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_leaf) ! Calculate fine root biomass + ! (calculates a maximum and then trimming value) call bfineroot(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass @@ -386,7 +387,7 @@ subroutine init_cohorts( patch_in, bc_in) call bdead_allom( b_ag, b_cr, b_sapwood, temp_cohort%bdead ) - temp_cohort%b = temp_cohort%balive + temp_cohort%bdead + temp_cohort%b = temp_cohort%balive + temp_cohort%bdead if( EDPftvarcon_inst%evergreen(pft) == 1) then temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(pft) From f34ecbc83058c2c27774eb3c1d3733bfb13e0b64 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 3 Oct 2017 18:30:02 -0700 Subject: [PATCH 05/63] modular allometry, code mostly in place. Must sort out height capping logic. --- biogeochem/EDGrowthFunctionsMod.F90 | 254 +--------------------------- biogeochem/EDPhysiologyMod.F90 | 115 ++++++++----- biogeochem/FatesAllometryMod.F90 | 169 +++++++++--------- main/EDPftvarcon.F90 | 10 -- main/FatesConstantsMod.F90 | 2 +- 5 files changed, 158 insertions(+), 392 deletions(-) diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index 28e99ad3e0..cbcf6cf194 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -11,17 +11,11 @@ module EDGrowthFunctionsMod use EDPftvarcon , only : EDPftvarcon_inst use EDTypesMod , only : ed_cohort_type, nlevleaf, dinc_ed use FatesConstantsMod , only : itrue,ifalse + use FatesAllometryMod, only : bleaf implicit none private - public :: bleaf - public :: hite - public :: ddbhdbd - public :: ddbhdbl - public :: dhdbd - public :: dbh - public :: bdead public :: tree_lai public :: tree_sai public :: c_area @@ -35,106 +29,6 @@ module EDGrowthFunctionsMod contains -! real(r8) function Dbh( cohort_in ) - -! ! ============================================================================ -! ! Creates diameter in cm as a function of height in m -! ! Height(m) diameter(cm) relationships. O'Brien et al - for 56 patch at BCI -! ! ============================================================================ - -! type(ed_cohort_type), intent(in) :: cohort_in - - !FIX(SPM,040214) - move to param file -! real(r8) :: m ! parameter of allometric equation -! real(r8) :: c ! parameter of allometric equation - - 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)) - - return - - end function dbh - -! ============================================================================ - - real(r8) function Hite( cohort_in ) - - ! ============================================================================ - ! Creates height in m as a function of diameter in cm. - ! Height(m) diameter(cm) relationships. O'Brien et al - for 56 pft at BCI - ! ============================================================================ - - type(ed_cohort_type), intent(inout) :: cohort_in - - real(r8) :: m - real(r8) :: c - real(r8) :: h - - 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!' - cohort_in%dbh = 0.1_r8 - endif - - ! if the hite is larger than the maximum allowable height (set by dbhmax) then - ! set the height to the maximum value. - ! this could do with at least re-factoring and probably re-thinking. RF - if(cohort_in%dbh <= EDPftvarcon_inst%allom_dbh_maxheight(cohort_in%pft)) then - h = (10.0_r8**(log10(cohort_in%dbh) * m + c)) - else - h = (10.0_r8**(log10(EDPftvarcon_inst%allom_dbh_maxheight(cohort_in%pft))*m + c)) - endif - Hite = h - - return - - end function Hite - -! ============================================================================ - - real(r8) function Bleaf( cohort_in ) - - ! ============================================================================ - ! Creates leaf biomass (kGC) as a function of tree diameter. - ! ============================================================================ - - type(ed_cohort_type), intent(in) :: cohort_in - - real(r8) :: dbh2bl_a - real(r8) :: dbh2bl_b - real(r8) :: dbh2bl_c - - 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) - - 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 - endif - - if(cohort_in%dbh <= EDPftvarcon_inst%allom_dbh_maxheight(cohort_in%pft))then - bleaf = dbh2bl_a * (cohort_in%dbh**dbh2bl_b) * EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bl_c - else - bleaf = dbh2bl_a * (EDPftvarcon_inst%allom_dbh_maxheight(cohort_in%pft)**dbh2bl_b) * & - EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bl_c - endif - - !write(fates_log(),*) 'bleaf',bleaf, slascaler,cohort_in%pft - - !Adjust for canopies that have become so deep that their bottom layer is not producing any carbon... - !nb this will change the allometry and the effects of this remain untested. RF. April 2014 - - bleaf = bleaf * cohort_in%canopy_trim - - return - end function Bleaf - -! ============================================================================ - real(r8) function tree_lai( cohort_in ) ! ============================================================================ @@ -263,145 +157,6 @@ real(r8) function c_area( cohort_in ) end function c_area -! ============================================================================ - - 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 - ! - ! 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 - - real(r8) :: dbh2bd_a - real(r8) :: dbh2bd_b - real(r8) :: dbh2bd_c - real(r8) :: dbh2bd_d - - 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) - - end function Bdead - -! ============================================================================ - - real(r8) function dHdBd( cohort_in ) - - ! ============================================================================ - ! convert changes in structural biomass to changes in height - ! consistent with Bstem and h-dbh allometries - ! ============================================================================ - - type(ed_cohort_type), intent(in) :: cohort_in - - real(r8) :: dbddh ! rate of change of dead biomass (KgC) per unit change of height (m) - real(r8) :: dbh2bd_a - real(r8) :: dbh2bd_b - real(r8) :: dbh2bd_c - real(r8) :: dbh2bd_d - - 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) - dHdBd = 1.0_r8/dbddh !m/KgC - - return - - end function dHdBd - -! ============================================================================ - real(r8) function dDbhdBd( cohort_in ) - - ! ============================================================================ - ! convert changes in structural biomass to changes in diameter - ! consistent with Bstem and h-dbh allometries - ! ============================================================================ - - type(ed_cohort_type), intent(in) :: cohort_in - - real(r8) :: dBD_dDBH !Rate of change of dead biomass (KgC) with change in DBH (cm) - real(r8) :: dH_dDBH !Rate of change of height (m) with change in DBH (cm) - real(r8) :: m - real(r8) :: c - real(r8) :: h - real(r8) :: dbh2bd_a - 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) - - 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) - - if(cohort_in%dbh < EDPftvarcon_inst%allom_dbh_maxheight(cohort_in%pft))then - dH_dDBH = (10.0_r8**c)*m*(cohort_in%dbh**(m-1.0_r8)) - - dBD_dDBH = dBD_dDBH + dbh2bd_b*dbh2bd_a*(cohort_in%hite**(dbh2bd_b - 1.0_r8))* & - (cohort_in%dbh**dbh2bd_c)*(EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bd_d)*dH_dDBH - endif - - dDbhdBd = 1.0_r8/dBD_dDBH - - return - - end function dDbhdBd - -! ============================================================================ - - real(r8) function dDbhdBl( cohort_in ) - - ! ============================================================================ - ! convert changes in leaf biomass (KgC) to changes in DBH (cm) - ! ============================================================================ - - type(ed_cohort_type), intent(in) :: cohort_in - - real(r8) :: dblddbh ! Rate of change of leaf biomass with change in DBH - real(r8) :: dbh2bl_a - real(r8) :: dbh2bl_b - real(r8) :: dbh2bl_c - - 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 - - if( cohort_in%dbh 0._r8 ) then - if(Bleaf(cohort_in) > 0._r8 .and. cohort_in%bstore <= Bleaf(cohort_in))then - frac = cohort_in%bstore/(Bleaf(cohort_in)) + call bleaf(cohort_in%d,cohort_in%h,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)) else cmort = 0.0_r8 diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index f5bebda985..0b1389c670 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -33,6 +33,15 @@ module EDPhysiologyMod use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesConstantsMod , only : itrue,ifalse + use FatesAllometryMod , only : h_allom + use FatesAllometryMod , only : bag_allom + use FatesAllometryMod , only : sap_allom + use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : bfineroot + use FatesAllometryMod , only : bdead_allom + use FatesAllometryMod , only : bcr_allom + + implicit none private @@ -793,8 +802,26 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) real(r8) :: lmort_collateral ! Mortality fraction associated with logging collateral damage real(r8) :: lmort_infra ! Mortality fraction associated with logging infrastructure real(r8) :: dndt_logging ! Mortality rate (per day) associated with the a logging event - real(r8) :: balive_loss - + real(r8) :: balive_loss ! Carbon that will be removed from the alive pool due to things + ! maintenance turnover + + ! Per plant allocation variables + + real(r8) :: b_leaf ! leaf biomass (kgC) + real(r8) :: db_leaf_dd ! change in leaf biomass wrt diameter (kgC/cm) + real(r8) :: b_fineroot ! fine root biomass (kgC) + real(r8) :: db_fineroot_dd ! change in fine root biomass wrt diameter (kgC/cm) + real(r8) :: b_sap ! sapwood biomass (kgC) + real(r8) :: db_sap_dd ! change in sapwood biomass wrt diameter (kgC/cm) + real(r8) :: b_ag ! above ground biomass (kgC/cm) + real(r8) :: db_ag_dd ! change in above ground biomass wrt diameter (kgC/cm) + real(r8) :: b_cr ! coarse root biomass (kgC) + real(r8) :: db_cr_dd ! change in coarse root biomass (kgC/cm) + real(r8) :: b_dead ! dead (structural) biomass (kgC) + real(r8) :: db_dead_dd ! change in dead biomass wrt diameter (kgC/cm) + real(r8) :: dbalivedbd ! change in alive biomass wrt dead biomass (kgC/kgC) + real(r8) :: jh ! plant height (unused) + real(r8) :: dh_dd ! change in plant height WRT diameter (m/cm) integer :: ipft ! local copy of the pft index !---------------------------------------------------------------------- @@ -828,6 +855,9 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) call allocate_live_biomass(currentCohort,0) + + + ! ----------------------------------------------------------------------------------- ! calculate target size of living biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- @@ -842,13 +872,13 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,b_fineroot) ! Calculate sapwood biomass - call bsap_allom(currentCohort%dbh,ipft,b_sapwood) + call bsap_allom(currentCohort%dbh,ipft,b_sap) - target_balive = b_leaf + b_fineroot + b_sapwood + target_balive = b_leaf + b_fineroot + b_sap !target balive without leaves. if (currentCohort%status_coh == 1)then - target_balive = b_fineroot + b_sapwood + target_balive = b_fineroot + b_sap endif ! NPP @@ -989,6 +1019,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !********************************************/ !Use remaining carbon to refill balive or to get larger. + ! Tally up the relative change in dead biomass WRT diameter + call bag_allom(currentCohort%dbh,currentCohort%hite,ipft,b_ag,db_ag_dd) + call bcr_allom(currentCohort%dbh,currentCohort%h,ipft,b_cr,db_cr_dd) + call bdead_allom( b_ag, b_cr, b_sap, db_ag_dd, db_cr_dd, db_sap_dd, db_dead_dd ) + !only if carbon balance is +ve if ((currentCohort%balive >= target_balive).and.(currentCohort%carbon_balance > 0._r8))then @@ -1001,37 +1036,29 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) gr_fract = 1.0_r8 - (EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft)) end if - call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_leaf,dbleafdd) - - call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot,dbfrdd) - - call bsap_allom(temp_cohort%dbh,pft,b_sap,dbsapdd) - - ! Tally up the relative change in bdead WRT diameter - call bag_allom(currentCohort%dbh,currentCohort%hite,ipft,b_ag,dbagdd) - call bcr_allom(currentCohort%dbh,currentCohort%h,pft,b_cr,dbcrdd) - call bdead_allom( b_ag, b_cr, b_sap, dbagdd, dbcrdd, dbsapdd, dbdeaddd ) - - ! Change in leaf biomass per dead biomass [kgC/kgC] - dbldbd = dbldd/dbdeaddd - - ! Change in fineroot biomass per dead biomass [kgC/kgC] - dbfrdbd = dbfrdd/dbdeaddd - - ! Change in sapwood biomass per dead biomass [kgC/kgC] - dbsapdbd = dbsapdd/dbdeaddd + ! Tally up the relative change in alive biomass WRT diameter + call bleaf(currentCohort%dbh,currentCohort%hite,ipft, & + currentCohort%canopy_trim,b_leaf,db_leaf_dd) + call bfineroot(currentCohort%dbh,currentCohort%hite,ipft, & + currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) + call bsap_allom(temp_cohort%dbh,pft,b_sap,db_sap_dd) ! Total change in alive biomass relative to dead biomass [kgC/kgC] - dbalivedbd = dbldbd + dbfrdbd + dbsapdbd - + dbalivedbd = (db_leaf_dd + db_fineroot_dd + db_sap_dd)/db_dead_dd + if(dbalivedbd>tiny(dbalivedbd))then - - u = 1.0_r8 / (dbldbd + dbfrdbd + dbsapdbd) - + + ! In this case, the plant allometry module is telling us that + ! the plant is still expected to gain live (leaf,froot,sap) + ! biomass as it grows in size, and therfore it should be + ! allocated in proportion with structural + + u = 1.0_r8 / dbalivedbd va = 1.0_r8 / (1.0_r8 + u) vs = u / (1.0_r8 + u) else + ! If there is no change in alive biomass per change in dead, ! most likely we are dealing with plants that have surpassed ! an allometric threshold that limits alive biomass. @@ -1041,21 +1068,28 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) end if - - !FIX(RF,032414) - to fix high bl's. needed to prevent numerical errors without the ODEINT. + ! FIX(RF,032414) - to fix high bl's. needed to + ! prevent numerical errors without the ODEINT. if (currentCohort%balive > target_balive*1.1_r8)then va = 0.0_r8; vs = 1._r8 - if (DEBUG) write(fates_log(),*) 'using high bl cap',target_balive,currentCohort%balive + if (DEBUG) write(fates_log(),*) 'using high bl cap',target_balive,currentCohort%balive endif else - dbldbd = 0._r8; dbrdbd = 0._r8; dbswdbd = 0._r8 - va = 1.0_r8; - vs = 0._r8 + ! -------------------------------------------------------------------------------- + ! In this case, either there was not enough carbon generated, or the plant is off + ! allometry (ie the alive pools are smaller than the maximums dictated by allometry + ! and timming). So push all carbon into the alive pool (va = 1.0), and none + ! into structural (vs = 0.0) or seed (ie non-growth, gr_fract = 1.0). + ! -------------------------------------------------------------------------------- + + va = 1.0_r8 + vs = 0.0_r8 gr_fract = 1.0_r8 - endif + endif + ! calculate derivatives of living and dead carbon pools currentCohort%dbalivedt = gr_fract * va * currentCohort%carbon_balance - balive_loss currentCohort%dbdeaddt = gr_fract * vs * currentCohort%carbon_balance @@ -1090,9 +1124,12 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%npp_bseed = currentCohort%seed_prod - ! calculate change in diameter and height - currentCohort%ddbhdt = currentCohort%dbdeaddt * dDbhdBd(currentCohort) - currentCohort%dhdt = currentCohort%dbdeaddt * dHdBd(currentCohort) + ! calculate change in diameter + currentCohort%ddbhdt = currentCohort%dbdeaddt / db_dead_dd + + ! calculate change in hite + call h_allom(currentCohort%dbh,ipft,height,dh_dd) + currentCohort%dhdt = currentCohort%ddbhdt * dh_dd ! If the cohort has grown, it is not new currentCohort%isnew=.false. diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 6d36a4526d..9fbca942cd 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -94,7 +94,6 @@ module FatesAllometryMod public :: bleaf ! Generic actual leaf biomass wrapper public :: bsap_allom ! Generic sapwood wrapper public :: bcr_allom ! Generic coarse root wrapper - public :: bfrmax_allom ! Generic maximum fine root biomass wrapper public :: bfineroot ! Generic actual fine root biomass wrapper public :: bdead_allom ! Generic bdead wrapper @@ -123,7 +122,7 @@ module FatesAllometryMod ! Generic height to diameter interface ! ============================================================================ - subroutine h2d_allom(h,ipft,d,dddh) + subroutine h2d_allom(h,ipft,d,dddh) real(r8),intent(in) :: h ! height of plant [m] @@ -144,24 +143,25 @@ subroutine h2d_allom(h,ipft,d,dddh) real(r8) :: p2 real(r8) :: p3 - associate( & - h_max => EDPftvarcon_inst%h_max(ipft), & - h_min => EDPftvarcon_inst%h_min(ipft), & - eclim => EDPftvarcon_inst%eclim(ipft), & - p1 => EDPftvarcon_inst%allom_d2h1(ipft), & + associate( p1 => EDPftvarcon_inst%allom_d2h1(ipft), & p2 => EDPftvarcon_inst%allom_d2h2(ipft), & p3 => EDPftvarcon_inst%allom_d2h3(ipft), & allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) + + + print*,huge(ipft) + print*,tiny(ipft) + stop select case(allom_hmode) case (1) ! chave 2014 - call h2d_chave2014(h,p1,p2,p3,eclim,d,dddh) + call h2d_chave2014(h,p1,p2,p3,d,dddh) case (2) ! poorter 2006 call h2d_poorter2006(h,p1,p2,p3,d,dddh) case (3) ! 2 parameter power function call h2d_2pwr(h,p1,p2,d,dddh) case (4) ! Obrien et al. 199X BCI - call h2d_obrien(h,p1,p2,h_max,d,dddh) + call h2d_obrien(h,p1,p2,d,dddh) case (5) ! Martinez-Cano call h2d_martcano(h,p1,p2,p3,d,dddh) case DEFAULT @@ -170,11 +170,9 @@ subroutine h2d_allom(h,ipft,d,dddh) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - - end if end associate return - end subroutine h2d_allom + end subroutine h2d_allom ! ============================================================================ ! Generic height interface @@ -198,9 +196,7 @@ subroutine h_allom(d,ipft,h,dhdd) real(r8) :: p2 real(r8) :: p3 - associate( & - dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & - eclim => EDPftvarcon_inst%eclim(ipft), & + associate( dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & p1 => EDPftvarcon_inst%allom_d2h1(ipft), & p2 => EDPftvarcon_inst%allom_d2h2(ipft), & p3 => EDPftvarcon_inst%allom_d2h3(ipft), & @@ -208,7 +204,7 @@ subroutine h_allom(d,ipft,h,dhdd) select case(allom_hmode) case (1) ! "chave14") - call d2h_chave2014(d,p1,p2,p3,eclim,dbh_maxh,h,dhdd) + call d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) case (2) ! "poorter06" call d2h_poorter2006(d,p1,p2,p3,h,dhdd) case (3) ! "2parameter power function h=a*d^b " @@ -256,7 +252,7 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) call dh2bag_chave2014(d,h,ipft,p1,p2,wood_density,c2b,bag,dbagdd) case (2) !"2par_pwr") ! Switch for woodland dbh->drc - call d2bag_2pwr(d,ipft,p1,p2,bag,dbagdd) + call d2bag_2pwr(d,ipft,p1,p2,c2b,bag,dbagdd) case (3) !"salda") call dh2bag_salda(d,h,ipft,p1,p2,p3,p4,wood_density,c2b,agb_frac,bag,dbagdd) case DEFAULT @@ -267,7 +263,7 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) end associate return - end subroutine bag_allom + end subroutine bag_allom ! ============================================================================ ! Generic diameter to maximum leaf biomass interface @@ -281,20 +277,15 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) real(r8),intent(out) :: blmax ! plant leaf biomass [kg] real(r8),intent(out) :: dblmaxdd ! change leaf bio per diameter [kgC/cm] - real(r8) :: p1 - real(r8) :: p2 - real(r8) :: p3 - associate( & - dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & - rho => EDPftvarcon_inst%wood_density(ipft), & - c2b => EDPftvarcon_inst%c2b(ipft), & - allom_lmode => EDPftvarcon_inst%lallom_sap_mode(ipft)) + dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & + rho => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft), & + allom_lmode => EDPftvarcon_inst%allom_lmode(ipft), & + p1 => EDPftvarcon_inst%allom_d2bl1(ipft), & + p2 => EDPftvarcon_inst%allom_d2bl2(ipft), & + p3 => EDPftvarcon_inst%allom_d2bl3(ipft)) - p1 = EDPftvarcon_inst%allom_d2bl1(ipft) - p2 = EDPftvarcon_inst%allom_d2bl2(ipft) - p3 = EDPftvarcon_inst%allom_d2bl3(ipft) - select case(allom_lmode) case(1) !"salda") call d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) @@ -310,11 +301,11 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) end select end associate return - end subroutine blmax_allom + end subroutine blmax_allom ! ===================================================================================== - subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) + subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target bleaf @@ -326,6 +317,7 @@ subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(in) :: canopy_trim ! trimming function real(r8),intent(out) :: bl ! plant leaf biomass [kg] real(r8),intent(out),optional :: dbldd ! change leaf bio per diameter [kgC/cm] @@ -383,7 +375,7 @@ subroutine bsap_allom(d,ipft,bsap,dbsapdd) call endrun(msg=errMsg(sourcefile, __LINE__)) end select return - end subroutine bsap_allom + end subroutine bsap_allom ! ============================================================================ ! Generic coarse root biomass interface @@ -413,23 +405,24 @@ subroutine bcr_allom(d,h,ipft,bcr,dbcrdd) call endrun(msg=errMsg(sourcefile, __LINE__)) end select return - end subroutine bcr_allom + end subroutine bcr_allom ! ============================================================================ ! Fine root biomass allometry wrapper ! ============================================================================ - subroutine bfineroot(d,h,ipft,canopy_trim,bfineroot,dbfrdd) + subroutine bfineroot(d,h,ipft,canopy_trim,bfr,dbfrdd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target fineroot biomass ! based on functions that may or may not have prognostic properties. ! ------------------------------------------------------------------------- - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: h ! plant height [m] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bfr ! fine root biomass [kgC] + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(in) :: canopy_trim ! trimming function + real(r8),intent(out) :: bfr ! fine root biomass [kgC] real(r8),intent(out),optional :: dbfrdd ! change leaf bio per diameter [kgC/cm] real(r8) :: bfrmax @@ -450,9 +443,9 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfineroot,dbfrdd) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select - return - end subroutine bfineroot + return + end subroutine bfineroot ! ============================================================================ @@ -498,7 +491,7 @@ subroutine bdead_allom(bag,bcr,bsap,bdead, & end if return - end subroutine bdead_allom + end subroutine bdead_allom ! ============================================================================ ! Specific bfrmax relationships @@ -514,15 +507,15 @@ subroutine bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) real(r8),intent(out) :: bfrmax ! max fine-root root biomass [kgC] real(r8),intent(out) :: dbfrmaxdd ! change frmax bio per diam [kgC/cm] - associate( f2l_ratio => EDPftvarcon_inst%f2l_ratio(ipft) ) + associate( l2fr => EDPftvarcon_inst%allom_l2fr(ipft) ) - bfrmax = blmax*f2l_ratio + bfrmax = blmax*l2fr ! dbfr/dd = dbfrmax/dblmax * dblmax/dd - dbfrmaxdd = f2l_ratio*dblmaxdd + dbfrmaxdd = dblmaxdd*l2fr end associate return - end subroutine bfrmax_const + end subroutine bfrmax_const ! ============================================================================ @@ -539,7 +532,7 @@ subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) real(r8),intent(out) :: bcr ! coarse root biomass [kg] real(r8),intent(out) :: dbcrdd ! change croot bio per diam [kg/cm] - associate( agb_fraction => EDPftvarcon_inst%agb_fraction(ipft) ) + associate( agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft) ) ! btot = bag + bcr ! bag = btot*agb_fraction @@ -552,7 +545,7 @@ subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) dbcrdd = (1.0_r8/agb_fraction-1.0_r8)*dbagdd end associate return - end subroutine bcr_const + end subroutine bcr_const ! ============================================================================ @@ -596,11 +589,11 @@ subroutine bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) ! Constrain sapwood to be no larger than 75% of total agb real(r8),parameter :: max_agbfrac = 0.75_r8 - associate ( latosa_int => EDPftvarcon_inst%latosa_int(ipft), & - latosa_slp => EDPftvarcon_inst%latosa_slp(ipft), & - sla => EDPftvarcon_inst%slatop(ipft), & - wood_density => EDPftvarcon_inst%wood_density(ipft), & - c2b => EDPftvarcon_inst%c2b(ipft)) + associate ( latosa_int => EDPftvarcon_inst%allom_latosa_int(ipft), & + latosa_slp => EDPftvarcon_inst%allom_latosa_slp(ipft), & + sla => EDPftvarcon_inst%slatop(ipft), & + wood_density => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft)) ! ------------------------------------------------------------------------ ! Calculate sapwood biomass per linear height and kgC of leaf [m-1] @@ -636,7 +629,7 @@ subroutine bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) end if end associate return - end subroutine bsap_dlinear + end subroutine bsap_dlinear ! ============================================================================ ! Specific d2blmax relationships @@ -664,7 +657,7 @@ subroutine d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) dblmaxdd = 0.0 end if return - end subroutine d2blmax_salda + end subroutine d2blmax_salda ! =========================================================================== @@ -708,7 +701,7 @@ subroutine d2blmax_2pwr(d,p1,p2,c2b,blmax,dblmaxdd) dblmaxdd = p1*p2 *d**(p2-1.0_r8) / c2b return - end subroutine d2blmax_2pwr + end subroutine d2blmax_2pwr ! =========================================================================== @@ -763,13 +756,13 @@ subroutine dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) end if return - end subroutine dh2blmax_2pwr + end subroutine dh2blmax_2pwr ! ========================================================================= ! Diameter to height (D2H) functions ! ========================================================================= - subroutine d2h_chave2014(d,p1,p2,p3,eclim,dbh_maxh,h,dhdd) + subroutine d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) ! "d2h_chave2014" ! "d to height via Chave et al. 2014" @@ -807,14 +800,13 @@ subroutine d2h_chave2014(d,p1,p2,p3,eclim,dbh_maxh,h,dhdd) real(r8),intent(in) :: p1 ! parameter a real(r8),intent(in) :: p2 ! parameter b real(r8),intent(in) :: p3 ! parameter c - real(r8),intent(in) :: eclim ! climatological parameter "E" real(r8),intent(in) :: dbh_maxh ! dbh at maximum height [cm] real(r8),intent(out) :: h ! plant height [m] real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] real(r8) :: p1e - p1e = p1-eclim + p1e = p1 ! -eclim (assumed that p1 already has eclim removed) if(d>=dbh_max .and. hallow_hcapping ) then h = exp( p1e + p2*log(dbh_maxh) + p3*log(dbh_maxh)**2.0 ) dhdd = 0.0_r8 @@ -824,7 +816,7 @@ subroutine d2h_chave2014(d,p1,p2,p3,eclim,dbh_maxh,h,dhdd) p2*d**(p2-1.0_r8+p3*log(d)) ) end if return - end subroutine d2h_chave2014 + end subroutine d2h_chave2014 ! =========================================================================== @@ -866,7 +858,7 @@ subroutine d2h_poorter2006(d,p1,p2,p3,h,dhdd) dhdd = -p1*exp(p2*d**p3) * p3*p2*d**(p3-1.0_r8) return - end subroutine d2h_poorter2006 + end subroutine d2h_poorter2006 ! =========================================================================== @@ -948,8 +940,7 @@ subroutine d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) end if return - - end subroutine d2h_obrien + end subroutine d2h_obrien ! =========================================================================== @@ -1039,9 +1030,9 @@ subroutine dh2bag_chave2014(d,h,ipft,d2bag1,d2bag2,wood_density,c2b,bag,dbagdd) dbagdd = dbagdd1*(dbagdd2 + dbagdd3) return - end subroutine dh2bag_chave2014 + end subroutine dh2bag_chave2014 - subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) + subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) ! ========================================================================= ! This function calculates tree above ground biomass according to 2 @@ -1079,6 +1070,7 @@ subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: d2bag1 ! allometry parameter 1 real(r8),intent(in) :: d2bag2 ! allometry parameter 2 + real(r8),intent(in) :: c2b ! carbon to biomass multiplier ~2 real(r8),intent(out) :: bag ! plant height [m] real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] @@ -1097,10 +1089,10 @@ subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) dbagdd = (d2bag2*d2bag1*d**(d2bag2-1.0_r8))/c2b return - end subroutine d2bag_2pwr + end subroutine d2bag_2pwr - subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag1,d2bag1,d2bag1, & + subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag2,d2bag3,d2bag4, & wood_density,c2b,allom_agb_frac,bag,dbagdd) ! -------------------------------------------------------------------- @@ -1122,7 +1114,7 @@ subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag1,d2bag1,d2bag1, & real(r8),intent(in) :: d2bag3 ! = 1.94_r8 real(r8),intent(in) :: d2bag4 ! = 0.931_r8 real(r8),intent(in) :: c2b ! carbon 2 biomass ratio - real(r8),intent(in) :: wood_desnity + real(r8),intent(in) :: wood_density real(r8),intent(in) :: allom_agb_frac real(r8),intent(out) :: bag ! plant biomass [kgC/indiv] @@ -1148,9 +1140,7 @@ subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag1,d2bag1,d2bag1, & dbagdd = term1*(term2+term3) return - end associate - - end subroutine dh2bag_salda + end subroutine dh2bag_salda ! ============================================================================ ! height to diameter conversions @@ -1159,21 +1149,20 @@ end subroutine dh2bag_salda ! asymptote. In these cases they may be called effective diameter. ! ============================================================================ - subroutine h2d_chave2014(h,p1,p2,p3,eclim,de,ddedh) + subroutine h2d_chave2014(h,p1,p2,p3,de,ddedh) real(r8),intent(in) :: h ! plant height [m] real(r8),intent(in) :: p1 real(r8),intent(in) :: p2 real(r8),intent(in) :: p3 - real(r8),intent(in) :: eclim real(r8),intent(out) :: de ! effective plant diameter [cm] real(r8),intent(out) :: ddedh ! effective change in d per height [cm/m] real(r8) :: p1e, eroot, dbh1,dhpdd - p1e = p1-eclim + p1e = p1 !-eclim (assumed that p1 already has eclim removed) eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-p1e))*p3)) & /(2.0_r8*p3) @@ -1192,7 +1181,7 @@ subroutine h2d_chave2014(h,p1,p2,p3,eclim,de,ddedh) ! term4 = h**(1/p3-1.0_r8)/(p3) ! d = term1*term2*term3*term4 return - end subroutine h2d_chave2014 + end subroutine h2d_chave2014 ! ============================================================================ @@ -1244,7 +1233,7 @@ subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) (p2*p3*(p1-h)) return - end subroutine h2d_poorter2006 + end subroutine h2d_poorter2006 ! ============================================================================ @@ -1265,30 +1254,25 @@ subroutine h2d_2pwr(h,p1,p2,d,dddh) *h**(1.0_r8/p2-1.0_r8) return - end subroutine h2d_2pwr + end subroutine h2d_2pwr ! ============================================================================ - subroutine h2d_obrien(h,p1,p2,h_max,d,dddh) + subroutine h2d_obrien(h,p1,p2,d,dddh) real(r8),intent(in) :: h ! plant height [m] real(r8),intent(in) :: p1 real(r8),intent(in) :: p2 - real(r8),intent(in) :: h_max real(r8),intent(out) :: d ! plant diameter [cm] real(r8),intent(out) :: dddh ! change in d per height [cm/m] - - if (h EDPftvarcon_inst%allom_d2h1(ipft), & p2 => EDPftvarcon_inst%allom_d2h2(ipft), & p3 => EDPftvarcon_inst%allom_d2h3(ipft), & allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) - - print*,huge(ipft) - print*,tiny(ipft) - stop - - select case(allom_hmode) + select case(int(allom_hmode)) case (1) ! chave 2014 call h2d_chave2014(h,p1,p2,p3,d,dddh) case (2) ! poorter 2006 @@ -179,23 +168,23 @@ subroutine h_allom(d,ipft,h,dhdd) real(r8) :: p2 real(r8) :: p3 - associate( dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & + associate( dbh_maxh => EDPftvarcon_inst%allom_dbh_maxheight(ipft), & p1 => EDPftvarcon_inst%allom_d2h1(ipft), & p2 => EDPftvarcon_inst%allom_d2h2(ipft), & p3 => EDPftvarcon_inst%allom_d2h3(ipft), & allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) - select case(allom_hmode) + select case(int(allom_hmode)) case (1) ! "chave14") call d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) case (2) ! "poorter06" - call d2h_poorter2006(d,p1,p2,p3,h,dhdd) + call d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) case (3) ! "2parameter power function h=a*d^b " call d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) case (4) ! "obrien" call d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) case (5) ! Martinez-Cano - call d2h_martcano(d,p1,p2,p3,h,dhdd) + call d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) case DEFAULT write(fates_log(),*) 'An undefined height allometry was specified: ',allom_hmode write(fates_log(),*) 'Aborting' @@ -217,7 +206,7 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: bag ! plant height [m] - real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] + real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] associate( & @@ -230,12 +219,12 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) agb_frac => EDPftvarcon_inst%allom_agb_frac(ipft), & allom_amode => EDPftvarcon_inst%allom_amode(ipft)) - select case(allom_amode) + select case(int(allom_amode)) case (1) !"chave14") call dh2bag_chave2014(d,h,ipft,p1,p2,wood_density,c2b,bag,dbagdd) case (2) !"2par_pwr") ! Switch for woodland dbh->drc - call d2bag_2pwr(d,ipft,p1,p2,c2b,bag,dbagdd) + call d2bag_2pwr(d,p1,p2,c2b,bag,dbagdd) case (3) !"salda") call dh2bag_salda(d,h,ipft,p1,p2,p3,p4,wood_density,c2b,agb_frac,bag,dbagdd) case DEFAULT @@ -258,10 +247,10 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: blmax ! plant leaf biomass [kg] - real(r8),intent(out) :: dblmaxdd ! change leaf bio per diameter [kgC/cm] + real(r8),intent(out),optional :: dblmaxdd ! change leaf bio per diameter [kgC/cm] associate( & - dbh_maxh => EDPftvarcon_inst%max_dbh(ipft), & + dbh_maxh => EDPftvarcon_inst%allom_dbh_maxheight(ipft), & rho => EDPftvarcon_inst%wood_density(ipft), & c2b => EDPftvarcon_inst%c2b(ipft), & allom_lmode => EDPftvarcon_inst%allom_lmode(ipft), & @@ -269,7 +258,7 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) p2 => EDPftvarcon_inst%allom_d2bl2(ipft), & p3 => EDPftvarcon_inst%allom_d2bl3(ipft)) - select case(allom_lmode) + select case(int(allom_lmode)) case(1) !"salda") call d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) case(2) !"2par_pwr") @@ -318,7 +307,10 @@ subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- bl = blmax * canopy_trim - dbldd = dblmaxdd * canopy_trim + + if(present(dbldd))then + dbldd = dblmaxdd * canopy_trim + end if return end subroutine bleaf @@ -340,7 +332,7 @@ subroutine bsap_allom(d,ipft,bsap,dbsapdd) real(r8) :: dblmaxdd ! chage in blmax per diam [kgC/cm] real(r8) :: dhdd ! change in height per diameter [m/cm] - select case(EDPftvarcon_inst%allom_smode(ipft)) + select case(int(EDPftvarcon_inst%allom_smode(ipft))) ! --------------------------------------------------------------------- ! Currently both sapwood area proportionality methods use the same ! machinery. The only differences are related to the parameter @@ -376,9 +368,9 @@ subroutine bcr_allom(d,h,ipft,bcr,dbcrdd) real(r8) :: bag ! above ground biomass [kgC] real(r8) :: dbagdd ! change in agb per diameter [kgC/cm] - call bag_allom(d,h,ipft,bag,dbadd) + call bag_allom(d,h,ipft,bag,dbagdd) - select case(EDPftvarcon_inst%allom_cmode(ipft)) + select case(int(EDPftvarcon_inst%allom_cmode(ipft))) case(1) !"constant") call bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) case DEFAULT @@ -408,18 +400,21 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfr,dbfrdd) real(r8),intent(out) :: bfr ! fine root biomass [kgC] real(r8),intent(out),optional :: dbfrdd ! change leaf bio per diameter [kgC/cm] + real(r8) :: blmax ! maximum leaf biomss per allometry + real(r8) :: dblmaxdd real(r8) :: bfrmax real(r8) :: dbfrmaxdd real(r8) :: slascaler - select case(EDPftvarcon_inst%allom_fmode(ipft)) + select case(int(EDPftvarcon_inst%allom_fmode(ipft))) case(1) ! "constant proportionality with bleaf" call blmax_allom(d,h,ipft,blmax,dblmaxdd) call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) bfr = bfrmax * canopy_trim - dbfrdd = dbfrmaxdd * canopy_trim - + if(present(dbfrdd))then + dbfrdd = dbfrmaxdd * canopy_trim + end if case DEFAULT write(fates_log(),*) 'An undefined fine root allometry was specified: ', & EDPftvarcon_inst%allom_fmode(ipft) @@ -464,15 +459,15 @@ subroutine bdead_allom(bag,bcr,bsap,bdead, & else bdead = bag+bcr-bsap end if - - if(present(dbagdd) .and. present(dbcrdd) .and. present(dbsapdd))then + + if(present(dbagdd) .and. present(dbcrdd) .and. present(dbsapdd) .and. present(dbdeaddd) )then if(test_b4b) then dbdeaddd = dbagdd+dbcrdd else dbdeaddd = dbagdd+dbcrdd-dbsapdd end if end if - + return end subroutine bdead_allom @@ -488,14 +483,17 @@ subroutine bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: bfrmax ! max fine-root root biomass [kgC] - real(r8),intent(out) :: dbfrmaxdd ! change frmax bio per diam [kgC/cm] + real(r8),intent(out),optional :: dbfrmaxdd ! change frmax bio per diam [kgC/cm] associate( l2fr => EDPftvarcon_inst%allom_l2fr(ipft) ) bfrmax = blmax*l2fr ! dbfr/dd = dbfrmax/dblmax * dblmax/dd - dbfrmaxdd = dblmaxdd*l2fr + if(present(dbfrmaxdd))then + dbfrmaxdd = dblmaxdd*l2fr + end if + end associate return end subroutine bfrmax_const @@ -513,7 +511,7 @@ subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) real(r8),intent(in) :: dbagdd ! change in agb per diameter [kg/cm] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: bcr ! coarse root biomass [kg] - real(r8),intent(out) :: dbcrdd ! change croot bio per diam [kg/cm] + real(r8),intent(out),optional :: dbcrdd ! change croot bio per diam [kg/cm] associate( agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft) ) @@ -525,7 +523,10 @@ subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) ! Derivative ! dbcr/dd = dbcr/dbag * dbag/dd - dbcrdd = (1.0_r8/agb_fraction-1.0_r8)*dbagdd + if(present(dbcrdd))then + dbcrdd = (1.0_r8/agb_fraction-1.0_r8)*dbagdd + end if + end associate return end subroutine bcr_const @@ -561,7 +562,7 @@ subroutine bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] - real(r8),intent(out) :: dbsapdd ! change leaf bio per diameter [kgC/cm] + real(r8),intent(out),optional :: dbsapdd ! change leaf bio per diameter [kgC/cm] real(r8) :: latosa ! m2 leaf area per cm2 sap area real(r8) :: hbl2bsap ! sapwood biomass per lineal height @@ -604,11 +605,12 @@ subroutine bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) ! Derivative ! dbldmaxdd is deriv of blmax wrt dbh (use directives to check oop) ! dhdd is deriv of height wrt dbh (use directives to check oop) - - if (bsap0.0_r8) then - dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd - else - dblmaxdd = 0.0_r8 + if(present(dblmaxdd))then + if(dhdd>0.0_r8) then + dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd + else + dblmaxdd = 0.0_r8 + end if end if - + return end subroutine dh2blmax_2pwr @@ -786,24 +800,30 @@ subroutine d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) real(r8),intent(in) :: dbh_maxh ! dbh at maximum height [cm] real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] real(r8) :: p1e p1e = p1 ! -eclim (assumed that p1 already has eclim removed) - if(d>=dbh_max .and. hallow_hcapping ) then + if(d>=dbh_maxh) then h = exp( p1e + p2*log(dbh_maxh) + p3*log(dbh_maxh)**2.0 ) - dhdd = 0.0_r8 else h = exp( p1e + p2*log(d) + p3*log(d)**2.0 ) - dhdd = exp(p1e) * ( 2.0_r8*p3*d**(p2-1.0_r8+p3*log(d))*log(d) + & - p2*d**(p2-1.0_r8+p3*log(d)) ) + end if + + if(present(dhdd))then + if(d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = exp(p1e) * ( 2.0_r8*p3*d**(p2-1.0_r8+p3*log(d))*log(d) + & + p2*d**(p2-1.0_r8+p3*log(d)) ) + end if end if return end subroutine d2h_chave2014 ! =========================================================================== - subroutine d2h_poorter2006(d,p1,p2,p3,h,dhdd) + subroutine d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) ! "d2h_poorter2006" ! "d to height via Poorter et al. 2006, these routines use natively @@ -829,18 +849,26 @@ subroutine d2h_poorter2006(d,p1,p2,p3,h,dhdd) real(r8),intent(in) :: p1 ! parameter a = h_max real(r8),intent(in) :: p2 ! parameter b real(r8),intent(in) :: p3 ! parameter c + real(r8),intent(in) :: dbh_maxh ! dbh at maximum height real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - h = p1*(1.0_r8 - exp(p2*d**p3)) + h = p1*(1.0_r8 - exp(p2*min(d,dbh_maxh)**p3)) + !h = h_max - h_max (exp(a*d**b)) !f(x) = -h_max*exp(g(x)) !g(x) = a*d**b !d/dx f(g(x) = f'(g(x))*g'(x) = -a1*exp(a2*d**a3) * a3*a2*d**(a3-1) - ! - dhdd = -p1*exp(p2*d**p3) * p3*p2*d**(p3-1.0_r8) + + if(present(dhdd))then + if( d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = -p1*exp(p2*d**p3) * p3*p2*d**(p3-1.0_r8) + end if + end if + return - end subroutine d2h_poorter2006 ! =========================================================================== @@ -889,15 +917,18 @@ subroutine d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) real(r8),intent(in) :: p2 ! parameter b real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] - - if(d>=dbh_maxh .and. hallow_hcapping) then - h = p1*dbh_maxh**p2 - dhdd = 0.0_r8 - else - h = p1*d**p2 - dhdd = (p2*p1)*d**(p2-1.0_r8) + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + + h = p1*min(d,dbh_maxh)**p2 + + if(present(dhdd))then + if( d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = (p2*p1)*d**(p2-1.0_r8) + end if end if + return end subroutine d2h_2pwr @@ -910,24 +941,26 @@ subroutine d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) real(r8),intent(in) :: p2 ! parameter b real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] !p1 = 0.64 !p2 = 0.37 - if(d>=dbh_maxh .and. hallow_hcapping) then - h = 10.0_r8**(log10(dbh_maxh)*p1+p2) - dhdd = 0.0_r8 - else - h = 10.0_r8**(log10(d)*p1+p2) - dhdd = p1*10.0_r8**p2*d**(p1-1.0_r8) - end if + h = 10.0_r8**(log10(min(d,dbh_maxh))*p1+p2) + if(present(dhdd))then + if(d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = p1*10.0_r8**p2*d**(p1-1.0_r8) + end if + end if + return end subroutine d2h_obrien ! =========================================================================== - subroutine d2h_martcano(d,p1,p2,p3,h,dhdd) + subroutine d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) ! ========================================================================= ! "d2h_martcano" @@ -949,16 +982,22 @@ subroutine d2h_martcano(d,p1,p2,p3,h,dhdd) real(r8),intent(in) :: p1 ! parameter a real(r8),intent(in) :: p2 ! parameter b real(r8),intent(in) :: p3 ! parameter c + real(r8),intent(in) :: dbh_maxh ! diameter at maximum height real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out) :: dhdd ! change in height per diameter [m/cm] - - - h = (p1*d**p2)/(p3+d**p2) + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + + h = (p1*min(d,dbh_maxh)**p2)/(p3+min(d,dbh_maxh)**p2) - dhdd = ((p2*p1*d**(p2-1._r8))*(p3+d**p2) - & - (p2*d**(p2-1._r8))*(p1*d**p2) )/ & - (p3+d**p2)**2._r8 - + if(present(dhdd))then + if(d>=dbh_maxh ) then + dhdd = 0.0 + else + dhdd = ((p2*p1*d**(p2-1._r8))*(p3+d**p2) - & + (p2*d**(p2-1._r8))*(p1*d**p2) )/ & + (p3+d**p2)**2._r8 + end if + end if + return end subroutine d2h_martcano @@ -966,7 +1005,7 @@ end subroutine d2h_martcano ! ========================================================================= ! Diameter 2 above-ground biomass ! ========================================================================= - + subroutine dh2bag_chave2014(d,h,ipft,d2bag1,d2bag2,wood_density,c2b,bag,dbagdd) ! ========================================================================= @@ -996,22 +1035,25 @@ subroutine dh2bag_chave2014(d,h,ipft,d2bag1,d2bag2,wood_density,c2b,bag,dbagdd) real(r8),intent(in) :: wood_density real(r8),intent(in) :: c2b real(r8),intent(out) :: bag ! plant height [m] - real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] + real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] real(r8) :: hj,dhdd real(r8) :: dbagdd1,dbagdd2,dbagdd3 bag = (d2bag1 * (wood_density*d**2.0_r8*h)**d2bag2)/c2b - ! Need the the derivative of height to diameter to - ! solve the derivative of agb with height - call h_allom(d,ipft,hj,dhdd) - dbagdd1 = (d2bag1*wood_density**d2bag2)/c2b - dbagdd2 = d2bag2*d**(2.0_r8*d2bag2)*h**(d2bag2-1.0_r8)*dhdd - dbagdd3 = h**d2bag2*2.0_r8*d2bag2*d**(2.0_r8*d2bag2-1.0_r8) - dbagdd = dbagdd1*(dbagdd2 + dbagdd3) - + if(present(dbagdd))then + ! Need the the derivative of height to diameter to + ! solve the derivative of agb with height + call h_allom(d,ipft,hj,dhdd) + + dbagdd1 = (d2bag1*wood_density**d2bag2)/c2b + dbagdd2 = d2bag2*d**(2.0_r8*d2bag2)*h**(d2bag2-1.0_r8)*dhdd + dbagdd3 = h**d2bag2*2.0_r8*d2bag2*d**(2.0_r8*d2bag2-1.0_r8) + dbagdd = dbagdd1*(dbagdd2 + dbagdd3) + end if + return end subroutine dh2bag_chave2014 @@ -1055,21 +1097,12 @@ subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) real(r8),intent(in) :: d2bag2 ! allometry parameter 2 real(r8),intent(in) :: c2b ! carbon to biomass multiplier ~2 real(r8),intent(out) :: bag ! plant height [m] - real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] - - !max_dbh = EDPftvarcon_inst%maxdbh(ipft) - !if(diam>1.10*max_dbh) - ! display("-----------------------------------------------------") - ! display("Tree diameter is 10! larger than diameter where height") - ! display("hits maximum. However, you specified an AGB allometry") - ! display("that does not assume capping. Please consider ") - ! display("re-evaluating your allometric assumptions, growth") - ! display("formulations or maximum height") - ! display("------------------------------------------------------") - !end + real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] bag = (d2bag1 * d**d2bag2)/c2b - dbagdd = (d2bag2*d2bag1*d**(d2bag2-1.0_r8))/c2b + if(present(dbagdd))then + dbagdd = (d2bag2*d2bag1*d**(d2bag2-1.0_r8))/c2b + end if return end subroutine d2bag_2pwr @@ -1080,7 +1113,7 @@ subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag2,d2bag3,d2bag4, & ! -------------------------------------------------------------------- ! 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 + ! default params using allometry of J.G. Saldarriaga et al 1988 - Rio Negro ! Journal of Ecology vol 76 p938-958 ! Saldarriaga 1988 provided calculations on total dead biomass ! So here, we calculate total dead, and then call and remove @@ -1101,7 +1134,7 @@ subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag2,d2bag3,d2bag4, & real(r8),intent(in) :: allom_agb_frac real(r8),intent(out) :: bag ! plant biomass [kgC/indiv] - real(r8),intent(out) :: dbagdd ! change in agb per diameter [kgC/cm] + real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] real(r8) :: term1,term2,term3,hj,dhdd @@ -1114,13 +1147,15 @@ subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag2,d2bag3,d2bag4, & ! dbag/dd = a1*r**a4 * d/dd (h**a2*d**a3) ! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] ! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] - - term1 = allom_agb_frac*d2bag1*(wood_density**d2bag4) - term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) - - call h_allom(d,ipft,hj,dhdd) - term3 = d2bag2*h**(d2bag2-1)*(d**d2bag3)*dhdd - dbagdd = term1*(term2+term3) + + if(present(dbagdd)) then + term1 = allom_agb_frac*d2bag1*(wood_density**d2bag4) + term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) + + call h_allom(d,ipft,hj,dhdd) + term3 = d2bag2*h**(d2bag2-1)*(d**d2bag3)*dhdd + dbagdd = term1*(term2+term3) + end if return end subroutine dh2bag_salda @@ -1141,7 +1176,7 @@ subroutine h2d_chave2014(h,p1,p2,p3,de,ddedh) real(r8),intent(in) :: p3 real(r8),intent(out) :: de ! effective plant diameter [cm] - real(r8),intent(out) :: ddedh ! effective change in d per height [cm/m] + real(r8),intent(out),optional :: ddedh ! effective change in d per height [cm/m] real(r8) :: p1e, eroot, dbh1,dhpdd @@ -1151,12 +1186,14 @@ subroutine h2d_chave2014(h,p1,p2,p3,de,ddedh) de = exp(eroot) - ! Invert the derivative at d without asymtote - dhpdd = exp(p1e)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & - exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & - exp(p3*log(de)**2.0_r8) ) - - ddedh = 1.0_r8/dhpdd + if(present(ddedh))then + ! Invert the derivative at d without asymtote + dhpdd = exp(p1e)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & + exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & + exp(p3*log(de)**2.0_r8) ) + + ddedh = 1.0_r8/dhpdd + end if ! term1 = exp(-p2/(2*p3)) ! term2 = exp(p2**2/(4*p3**2)) @@ -1194,7 +1231,7 @@ subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) real(r8),intent(in) :: p3 real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out) :: dddh ! change in d per height [cm/m] + real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] ! ------------------------------------------------------------------------- ! h = a1*(1 - exp(a2*d**a3)) @@ -1212,8 +1249,11 @@ subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) ! ------------------------------------------------------------------------- d = (log(1.0_r8-h/p1)/p2)**(1.0_r8/p3) - dddh = -((log(1-h/p1)/p2)**(1.0_r8/p3-1.0_r8))/ & - (p2*p3*(p1-h)) + + if(present(dddh))then + dddh = -((log(1-h/p1)/p2)**(1.0_r8/p3-1.0_r8))/ & + (p2*p3*(p1-h)) + end if return end subroutine h2d_poorter2006 @@ -1228,13 +1268,16 @@ subroutine h2d_2pwr(h,p1,p2,d,dddh) real(r8),intent(in) :: p2 ! parameter 2 real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out) :: dddh ! change in d per height [cm/m] + real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] !h = a1*d**a2 d = (h/p1)**(1.0_r8/p2) + ! d = (1/a1)**(1/a2)*h**(1/a2) - dddh = (1.0_r8/p2)*(1.0_r8/p1)**(1.0_r8/p2) & - *h**(1.0_r8/p2-1.0_r8) + if(present(dddh)) then + dddh = (1.0_r8/p2)*(1.0_r8/p1)**(1.0_r8/p2) & + *h**(1.0_r8/p2-1.0_r8) + end if return end subroutine h2d_2pwr @@ -1248,11 +1291,13 @@ subroutine h2d_obrien(h,p1,p2,d,dddh) real(r8),intent(in) :: p2 real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out) :: dddh ! change in d per height [cm/m] - - d = 10.0_r8**((log10(h)-p2)/p1) - dddh = 1.0_r8/(p1*10.0_r8**p2*d**(p1-1.0_r8)) + real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] + d = 10.0_r8**((log10(h)-p2)/p1) + + if(present(dddh))then + dddh = 1.0_r8/(p1*10.0_r8**p2*d**(p1-1.0_r8)) + end if return end subroutine h2d_obrien @@ -1284,14 +1329,15 @@ subroutine h2d_martcano(h,p1,p2,p3,d,dddh) real(r8),intent(in) :: p3 real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out) :: dddh ! change in diameter per height [cm/m] + real(r8),intent(out),optional :: dddh ! change in diameter per height [cm/m] d = ((h*p3)/(p1-h))**(1._r8/p2) - dddh = (((1._r8/p2)*(h*p3)**(1._r8/p2-1._r8))*((p1-h)**(1._r8/p2)) - & + if(present(dddh))then + dddh = (((1._r8/p2)*(h*p3)**(1._r8/p2-1._r8))*((p1-h)**(1._r8/p2)) - & ((1._r8/p2)*(p1-h)**(1._r8/p2-1._r8))* ((h*p3)**(1._r8/p2)) ) / & - ((p1-h)**(1._r8/p2))**2._r8 - + ((p1-h)**(1._r8/p2))**2._r8 + end if return end subroutine h2d_martcano diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index f546253716..476fd01736 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -370,7 +370,7 @@ subroutine init_cohorts( patch_in, bc_in) call bag_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_ag) ! Calculate coarse root biomass from allometry - call bcr_allom(temp_cohort%dbh,temp_cohort%h,pft,b_cr) + call bcr_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_cr) ! Calculate the leaf biomass ! (calculates a maximum first, then applies canopy trim) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 00835896f7..c8f09739d8 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -69,7 +69,6 @@ module EDPftvarcon real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) real(r8), allocatable :: grperc(:) - real(r8), allocatable :: c2b(:) real(r8), allocatable :: bmort(:) real(r8), allocatable :: hf_sm_threshold(:) real(r8), allocatable :: vcmaxha(:) @@ -410,10 +409,6 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_c2b' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_prescribed_npp_canopy' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -810,10 +805,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%grperc) - name = 'fates_c2b' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%c2b) - name = 'fates_prescribed_npp_canopy' call fates_params%RetreiveParameterAllocate(name=name, & data=this%prescribed_npp_canopy) @@ -1415,7 +1406,6 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'root_long = ',EDPftvarcon_inst%root_long write(fates_log(),fmt0) 'clone_alloc = ',EDPftvarcon_inst%clone_alloc write(fates_log(),fmt0) 'seed_alloc = ',EDPftvarcon_inst%seed_alloc - write(fates_log(),fmt0) 'C2B = ',EDPftvarcon_inst%c2b write(fates_log(),fmt0) 'woody = ',EDPftvarcon_inst%woody write(fates_log(),fmt0) 'stress_decid = ',EDPftvarcon_inst%stress_decid write(fates_log(),fmt0) 'season_decid = ',EDPftvarcon_inst%season_decid diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index b7fa4f540c..f7980b4bff 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -8,7 +8,7 @@ module FatesConstantsMod ! kinds integer, parameter :: fates_r8 = selected_real_kind(12) ! 8 byte real - integer, parameter :: fates_int = selected_int_kind(8) ! 4 byte int + integer, parameter :: fates_int = selected_int_kind(8) ! 4 byte int ! string lengths integer, parameter :: fates_avg_flag_length = 3 diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 6667d61e58..c539074d2e 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -753,7 +753,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & use FatesAllometryMod , only : bag_allom use FatesAllometryMod , only : bcr_allom use FatesAllometryMod , only : bleaf - use FatesAllometryMod , only : bfr_allom + use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bdead_allom @@ -871,21 +871,21 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%pft = c_pft temp_cohort%n = c_nplant * cpatch%area - call h_allom(c_dbh,ipft,temp_cohort%hite) + call h_allom(c_dbh,c_pft,temp_cohort%hite) temp_cohort%dbh = c_dbh temp_cohort%canopy_trim = 1.0_r8 ! Calculate total above-ground biomass from allometry call bag_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_ag) ! Calculate coarse root biomass from allometry - call bcr_allom(temp_cohort%dbh,temp_cohort%h,c_pft,b_cr) + call bcr_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_cr) ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim ! and sla scaling factors) call bleaf(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_leaf) ! Calculate fine root biomass - call bfr_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_fineroot) + call bfineroot(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,c_pft,b_sapwood) From 3a886113d66ce8d1da6d1884ed350fa812cbda39 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 15 Oct 2017 14:01:30 -0700 Subject: [PATCH 08/63] modular allometry: basic tests passing, trying to create a mode that reproduces previous simulation results. Cleaning generic allometry calls to prep arguments instead of calling other allometry inside specific functions. --- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeochem/FatesAllometryMod.F90 | 1872 +++++++++++++++--------------- 2 files changed, 940 insertions(+), 934 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e774aa56f9..cb89ab7348 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1019,7 +1019,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! Tally up the relative change in dead biomass WRT diameter call bag_allom(currentCohort%dbh,currentCohort%hite,ipft,b_ag,db_ag_dd) call bcr_allom(currentCohort%dbh,currentCohort%hite,ipft,b_cr,db_cr_dd) - call bdead_allom( b_ag, b_cr, b_sap, db_ag_dd, db_cr_dd, db_sap_dd, db_dead_dd ) + call bdead_allom( b_ag, b_cr, b_sap, b_dead, db_ag_dd, db_cr_dd, db_sap_dd, db_dead_dd ) !only if carbon balance is +ve diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 2d63995bf5..3a6be02c8f 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -9,11 +9,9 @@ ! those arguments in those cases are trivially determined from diameter. ! ! Each function presented in this library is written to also return the -! derivative with respect to diameter using a logical switch "dswitch" -! (derivative-switch). With one exception, the h2d function returns the -! change in diameter with respect to height. +! derivative with respect to diameter, if the argument is provided. ! -! The name convention of the functions follows the form d2... Which +! The name convention of the functions follows the form d... Which ! indicates "diameter to ...". Allometries for the following variables are ! calculated: ! h: height [m] @@ -26,51 +24,65 @@ ! bsap: biomass in sapwood (above and below) [kgC] ! bdead: biomass (above and below) in the structural pool [kgC] ! -! "on allometry" assumes the plant has leaves flushed, and has had -! sufficient carbon to meet maintenance turnover. ! -! The following traits are used: +! The following function switches are rused +! ! allom_hmode, integer, height allometry function type ! allom_lmode, integer, maximum leaf allometry function type ! allom_rmode, integer, maximum root allometry function type ! allom_amode, integer, AGB allometry function type ! allom_cmode, integer, coarse root allometry function type ! allom_smode, integer, sapwood allometry function type -! wood_density, real, mean stem wood specific gravity (heart,sap,bark) -! allom_latosa_int, real, leaf area to sap area ratio, intercept [m2/cm2] -! allom_latosa_slp, real, leaf area to sap area ratio, slope on diameter -! [m2/cm2/cm] -! c2b, real, carbon to biomass ratio (~2.0) -! allom_l2fr, real, fine root biomass per leaf biomass ratio [kgC/kgC] -! allom_agb_fraction, real, the fraction of stem above ground [-] -! allom_d2h1, real, parameter 1 for d2h allometry (intercept) -! allom_d2h2, real, parameter 2 for d2h allometry (slope) -! allom_d2h3, real, parameter 3 for d2h allometry (optional) -! eclim influence parameter for d2h allometry (potentially not a parameter) -! allom_d2bl1, real, parameter 1 for d2bl allometry (intercept) -! allom_d2bl2, real, parameter 2 for d2bl allometry (slope) -! allom_d2bl3, real, parameter 3 for d2bl allometry (optional) +! +! The following parameters (traits) are used +! +! wood_density, mean stem wood specific gravity (heart,sap,bark) +! allom_latosa_int, leaf area to sap area ratio, intercept [m2/cm2] +! allom_latosa_slp, leaf area to sap area ratio, slope on diameter [m2/cm2/cm] +! c2b, real, carbon to biomass multiplier (~2.0) +! allom_l2fr, fine root biomass per leaf biomass ratio [kgC/kgC] +! allom_agb_frac, the fraction of stem above ground [-] +! allom_d2h1, parameter 1 for d2h allometry (intercept) +! allom_d2h2, parameter 2 for d2h allometry (slope) +! allom_d2h3, parameter 3 for d2h allometry (optional) +! allom_d2bl1, parameter 1 for d2bl allometry (intercept) +! allom_d2bl2, parameter 2 for d2bl allometry (slope) +! allom_d2bl3, parameter 3 for d2bl allometry (optional) ! allom_agb1 ! allom_agb2 ! allom_agb3 -! -! h_max, real, maximum height of a functional type/group -! h_min, real, the height associated with newly recruited plant [m] -! dbh_min, real, the dbh associated with a newly recruited plant [cm] -! dbh_max, real, the diameter associated with maximum height [cm] -! diagnosed from maxh using non-asymptotic functions +! allom_dbh_maxheight, dbh at maximum height [cm] +! h_min, the height associated with newly recruited plant [m] ! ! Note - i4 types are expressed explicitly to accomodate unit testing calls ! to this module ! ! +! OPEN QUESTIONS: +! SHOULD SAPWOOD ALLOMETRY SUBSUME TRIMMING, OR BE OFF OF BLMAX? +! WHAT IS CONTAINED IN THE AGB POOL? +! +! Carbon Pool Configurations are as follows, and assume a constant proportionality +! between above and below-ground pools. Sapwood (bsap) is both above and below +! ground. Above ground biomass contains above ground dead wood, above ground +! sapwood and leaves. Coarse roots (bcr) contain only the below ground +! deadwood, not the fine roots or the sapwood. Coarse roots are typically +! a proportion of above ground deadwood. +! Leaf biomass, height and above ground biomass typically have non-linear +! allometry models. The default for sapwood is the pipe model. +! +! bag = (bdead+bsap)*agb_frac + bleaf +! bdead = bag - (bsap*agb_frac) - bleaf + bcr +! bcr = bdead * (1-agb_frac) = (bag - (bsap*agb_frac) - bleaf)*(1-agb_frac) +! +! ! Initial Implementation: Ryan Knox July 2017 ! !=============================================================================== module FatesAllometryMod -! If this is a unit-test, these globals will be provided by a wrapper + ! If this is a unit-test, these globals will be provided by a wrapper use EDPFTvarcon , only : EDPftvarcon_inst use FatesConstantsMod, only : r8 => fates_r8 @@ -92,16 +104,23 @@ module FatesAllometryMod public :: bfineroot ! Generic actual fine root biomass wrapper public :: bdead_allom ! Generic bdead wrapper - character(len=*), parameter, private :: sourcefile = & - __FILE__ + 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 + ! which includes sapwood. Although a small quantity, it needs to be removed + ! from the agb pool. + ! Additionally, our calculation of sapwood biomass may be missing some unite conversions + ! + logical,parameter :: test_b4b = .true. contains ! ============================================================================ ! Parameter Checks ! ============================================================================ - + ! Checks to make sure parameters are not within expected ranges for each ! functions @@ -112,9 +131,8 @@ module FatesAllometryMod ! Generic height to diameter interface ! ============================================================================ - subroutine h2d_allom(h,ipft,d,dddh) + subroutine h2d_allom(h,ipft,d,dddh) - real(r8),intent(in) :: h ! height of plant [m] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: d ! plant diameter [cm] @@ -144,7 +162,7 @@ subroutine h2d_allom(h,ipft,d,dddh) end associate return - end subroutine h2d_allom + end subroutine h2d_allom ! ============================================================================ ! Generic height interface @@ -152,56 +170,46 @@ end subroutine h2d_allom subroutine h_allom(d,ipft,h,dhdd) - ! Arguments - real(r8),intent(in) :: d ! plant diameter [cm] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - - ! Locals - integer :: allom_hmode - real(r8) :: h_sap - real(r8) :: h_ad - real(r8) :: dhdd_sap - real(r8) :: dhdd_ad - real(r8) :: p1 - real(r8) :: p2 - real(r8) :: p3 - - associate( dbh_maxh => EDPftvarcon_inst%allom_dbh_maxheight(ipft), & - p1 => EDPftvarcon_inst%allom_d2h1(ipft), & - p2 => EDPftvarcon_inst%allom_d2h2(ipft), & - p3 => EDPftvarcon_inst%allom_d2h3(ipft), & - allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) - - select case(int(allom_hmode)) - case (1) ! "chave14") - call d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) - case (2) ! "poorter06" - call d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) - case (3) ! "2parameter power function h=a*d^b " - call d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) - case (4) ! "obrien" - call d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) - case (5) ! Martinez-Cano - call d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) - case DEFAULT - write(fates_log(),*) 'An undefined height allometry was specified: ',allom_hmode - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - end associate - return + ! Arguments + real(r8),intent(in) :: d ! plant diameter [cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + + associate( dbh_maxh => EDPftvarcon_inst%allom_dbh_maxheight(ipft), & + p1 => EDPftvarcon_inst%allom_d2h1(ipft), & + p2 => EDPftvarcon_inst%allom_d2h2(ipft), & + p3 => EDPftvarcon_inst%allom_d2h3(ipft), & + allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) + + select case(int(allom_hmode)) + case (1) ! "chave14") + call d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) + case (2) ! "poorter06" + call d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) + case (3) ! "2parameter power function h=a*d^b " + call d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) + case (4) ! "obrien" + call d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) + case (5) ! Martinez-Cano + call d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) + case DEFAULT + write(fates_log(),*) 'An undefined height allometry was specified: ',allom_hmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end associate + return end subroutine h_allom - + ! ============================================================================ ! Generic AGB interface ! ============================================================================ subroutine bag_allom(d,h,ipft,bag,dbagdd) - - + + real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index @@ -209,16 +217,15 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - associate( & - p1 => EDPftvarcon_inst%allom_agb1(ipft), & - p2 => EDPftvarcon_inst%allom_agb2(ipft), & - p3 => EDPftvarcon_inst%allom_agb3(ipft), & - p4 => EDPftvarcon_inst%allom_agb4(ipft), & - wood_density => EDPftvarcon_inst%wood_density(ipft), & - c2b => EDPftvarcon_inst%c2b(ipft), & - agb_frac => EDPftvarcon_inst%allom_agb_frac(ipft), & - allom_amode => EDPftvarcon_inst%allom_amode(ipft)) - + associate( p1 => EDPftvarcon_inst%allom_agb1(ipft), & + p2 => EDPftvarcon_inst%allom_agb2(ipft), & + p3 => EDPftvarcon_inst%allom_agb3(ipft), & + p4 => EDPftvarcon_inst%allom_agb4(ipft), & + wood_density => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft), & + agb_frac => EDPftvarcon_inst%allom_agb_frac(ipft), & + allom_amode => EDPftvarcon_inst%allom_amode(ipft)) + select case(int(allom_amode)) case (1) !"chave14") call dh2bag_chave2014(d,h,ipft,p1,p2,wood_density,c2b,bag,dbagdd) @@ -232,31 +239,30 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select - + end associate return - end subroutine bag_allom + end subroutine bag_allom ! ============================================================================ ! Generic diameter to maximum leaf biomass interface ! ============================================================================ - + subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) - + real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: blmax ! plant leaf biomass [kg] real(r8),intent(out),optional :: dblmaxdd ! change leaf bio per diameter [kgC/cm] - associate( & - dbh_maxh => EDPftvarcon_inst%allom_dbh_maxheight(ipft), & - rho => EDPftvarcon_inst%wood_density(ipft), & - c2b => EDPftvarcon_inst%c2b(ipft), & - allom_lmode => EDPftvarcon_inst%allom_lmode(ipft), & - p1 => EDPftvarcon_inst%allom_d2bl1(ipft), & - p2 => EDPftvarcon_inst%allom_d2bl2(ipft), & - p3 => EDPftvarcon_inst%allom_d2bl3(ipft)) + associate( dbh_maxh => EDPftvarcon_inst%allom_dbh_maxheight(ipft), & + rho => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft), & + allom_lmode => EDPftvarcon_inst%allom_lmode(ipft), & + p1 => EDPftvarcon_inst%allom_d2bl1(ipft), & + p2 => EDPftvarcon_inst%allom_d2bl2(ipft), & + p3 => EDPftvarcon_inst%allom_d2bl3(ipft)) select case(int(allom_lmode)) case(1) !"salda") @@ -267,36 +273,35 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) call dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) case DEFAULT write(fates_log(),*) 'An undefined leaf allometry was specified: ', & - allom_lmode + allom_lmode write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select end associate return - end subroutine blmax_allom + end subroutine blmax_allom ! ===================================================================================== - subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) - + subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) + ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target bleaf ! based on trimming and sla scaling. Because trimming ! is not allometry and rather an emergent property, ! this routine is not name-spaces with allom_ ! ------------------------------------------------------------------------- - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: h ! plant height [m] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(in) :: canopy_trim ! trimming function - real(r8),intent(out) :: bl ! plant leaf biomass [kg] + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(in) :: canopy_trim ! trimming function + real(r8),intent(out) :: bl ! plant leaf biomass [kg] real(r8),intent(out),optional :: dbldd ! change leaf bio per diameter [kgC/cm] - + real(r8) :: blmax real(r8) :: dblmaxdd - real(r8) :: slascaler - + call blmax_allom(d,h,ipft,blmax,dblmaxdd) ! ------------------------------------------------------------------------- @@ -307,31 +312,33 @@ subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- bl = blmax * canopy_trim - + if(present(dbldd))then dbldd = dblmaxdd * canopy_trim end if - + return - end subroutine bleaf - - + end subroutine bleaf + + ! ============================================================================ ! Generic sapwood biomass interface ! ============================================================================ - - subroutine bsap_allom(d,ipft,bsap,dbsapdd) + subroutine bsap_allom(d,ipft,bsap,dbsapdd) + real(r8),intent(in) :: d ! plant diameter [cm] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] real(r8),intent(out),optional :: dbsapdd ! change leaf bio per d [kgC/cm] - real(r8) :: h ! plant height [m] - real(r8) :: blmax ! plant leaf biomass [kgC] - real(r8) :: dblmaxdd ! chage in blmax per diam [kgC/cm] - real(r8) :: dhdd ! change in height per diameter [m/cm] - + real(r8) :: h + real(r8) :: dhdd + real(r8) :: blmax + real(r8) :: dblmaxdd + real(r8) :: bag + real(r8) :: dbagdd + select case(int(EDPftvarcon_inst%allom_smode(ipft))) ! --------------------------------------------------------------------- ! Currently both sapwood area proportionality methods use the same @@ -342,73 +349,73 @@ subroutine bsap_allom(d,ipft,bsap,dbsapdd) case(1,2) !"constant","dlinear") call h_allom(d,ipft,h,dhdd) call blmax_allom(d,h,ipft,blmax,dblmaxdd) - call bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) + call bag_allom(d,h,ipft,bag,dbagdd) + call bsap_dlinear(d,h,dhdd,blmax,dblmaxdd,bag,dbagdd,ipft,bsap,dbsapdd) case DEFAULT write(fates_log(),*) 'An undefined sapwood allometry was specified: ', & - EDPftvarcon_inst%allom_smode(ipft) + EDPftvarcon_inst%allom_smode(ipft) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select return - end subroutine bsap_allom - + end subroutine bsap_allom + ! ============================================================================ ! Generic coarse root biomass interface ! ============================================================================ - + subroutine bcr_allom(d,h,ipft,bcr,dbcrdd) - + real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: bcr ! coarse root biomass [kgC] real(r8),intent(out),optional :: dbcrdd ! change croot bio per diam [kgC/cm] - + real(r8) :: bag ! above ground biomass [kgC] real(r8) :: dbagdd ! change in agb per diameter [kgC/cm] - - call bag_allom(d,h,ipft,bag,dbagdd) - + select case(int(EDPftvarcon_inst%allom_cmode(ipft))) case(1) !"constant") + call bag_allom(d,h,ipft,bag,dbagdd) call bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) case DEFAULT write(fates_log(),*) 'An undefined coarse root allometry was specified: ', & - EDPftvarcon_inst%allom_cmode(ipft) + EDPftvarcon_inst%allom_cmode(ipft) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select return - end subroutine bcr_allom + end subroutine bcr_allom ! ============================================================================ ! Fine root biomass allometry wrapper ! ============================================================================ - + subroutine bfineroot(d,h,ipft,canopy_trim,bfr,dbfrdd) - + ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target fineroot biomass ! based on functions that may or may not have prognostic properties. ! ------------------------------------------------------------------------- - + real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(in) :: canopy_trim ! trimming function real(r8),intent(out) :: bfr ! fine root biomass [kgC] real(r8),intent(out),optional :: dbfrdd ! change leaf bio per diameter [kgC/cm] - + real(r8) :: blmax ! maximum leaf biomss per allometry real(r8) :: dblmaxdd real(r8) :: bfrmax real(r8) :: dbfrmaxdd real(r8) :: slascaler - + select case(int(EDPftvarcon_inst%allom_fmode(ipft))) case(1) ! "constant proportionality with bleaf" - + call blmax_allom(d,h,ipft,blmax,dblmaxdd) call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) bfr = bfrmax * canopy_trim @@ -421,19 +428,18 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfr,dbfrdd) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end select - + return - end subroutine bfineroot + end subroutine bfineroot ! ============================================================================ ! Dead biomass interface ! ============================================================================ + + subroutine bdead_allom(bag,bcr,bsap,bdead,dbagdd,dbcrdd,dbsapdd,dbdeaddd) - subroutine bdead_allom(bag,bcr,bsap,bdead, & - dbagdd,dbcrdd,dbsapdd,dbdeaddd) - real(r8),intent(in) :: bag ! agb [kgC] real(r8),intent(in) :: bcr ! coarse root biomass [kgC] real(r8),intent(in) :: bsap ! sapwood biomass [kgC] @@ -443,13 +449,8 @@ subroutine bdead_allom(bag,bcr,bsap,bdead, & real(r8),intent(in),optional :: dbcrdd ! change in croot per d [kgC/cm] real(r8),intent(in),optional :: dbsapdd ! change in bsap per d [kgC/cm] real(r8),intent(out),optional :: dbdeaddd ! change in bdead per d [kgC/cm] - - ! 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 - ! which includes sapwood. Although a small quantity, it needs to be removed - ! from the agb pool. - logical,parameter :: test_b4b = .true. + + ! bdead is diagnosed as the mass balance from all other pools ! and therefore, no options are necessary @@ -458,19 +459,21 @@ subroutine bdead_allom(bag,bcr,bsap,bdead, & bdead = bag+bcr else bdead = bag+bcr-bsap - end if + end if - if(present(dbagdd) .and. present(dbcrdd) .and. present(dbsapdd) .and. present(dbdeaddd) )then - if(test_b4b) then + if(test_b4b) then + if(present(dbagdd) .and. present(dbcrdd) .and. present(dbdeaddd) )then dbdeaddd = dbagdd+dbcrdd - else + end if + else + if(present(dbagdd) .and. present(dbcrdd) .and. present(dbdeaddd) .and. present(dbsapdd) )then dbdeaddd = dbagdd+dbcrdd-dbsapdd end if end if return - end subroutine bdead_allom - + end subroutine bdead_allom + ! ============================================================================ ! Specific bfrmax relationships ! ============================================================================ @@ -493,19 +496,17 @@ subroutine bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) if(present(dbfrmaxdd))then dbfrmaxdd = dblmaxdd*l2fr end if - + end associate return - end subroutine bfrmax_const - + end subroutine bfrmax_const ! ============================================================================ ! Specific bcr relationships ! ============================================================================ subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) - - + real(r8),intent(in) :: d ! plant diameter [cm] real(r8),intent(in) :: bag ! above ground biomass [kg] real(r8),intent(in) :: dbagdd ! change in agb per diameter [kg/cm] @@ -514,866 +515,871 @@ subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) real(r8),intent(out),optional :: dbcrdd ! change croot bio per diam [kg/cm] associate( agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft) ) - + ! btot = bag + bcr ! bag = btot*agb_fraction ! bag/agb_fraction = bag + bcr ! bcr = bag*(1/agb_fraction-1) bcr = bag*(1.0_r8/agb_fraction-1.0_r8) - + ! Derivative ! dbcr/dd = dbcr/dbag * dbag/dd if(present(dbcrdd))then dbcrdd = (1.0_r8/agb_fraction-1.0_r8)*dbagdd end if - + end associate return - end subroutine bcr_const + end subroutine bcr_const - ! ============================================================================ ! Specific d2bsap relationships ! ============================================================================ + subroutine bsap_dlinear(d,h,dhdd,blmax,dblmaxdd,bag,dbagdd,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 +! of plant size, see Calvo-Alvarado and Bradley Christoferson +! In this case: parameter latosa (from constant proportionality) +! is the intercept of the diameter function. +! +! For very small plants, the fraction can get very large, so cap the amount +! of sapwood at X! of agb-bleaf +! ------------------------------------------------------------------------- + +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: h ! plant height [m] +real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] +real(r8),intent(in) :: blmax ! plant leaf biomass [kgC] +real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] +real(r8),intent(in) :: bag ! aboveground biomass [kgC] +real(r8),intent(in) :: dbagdd ! change in agb per diam [kgC/cm] +integer(i4),intent(in) :: ipft ! PFT index +real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] +real(r8),intent(out),optional :: dbsapdd ! change leaf bio per diameter [kgC/cm] + + +real(r8) :: latosa ! applied leaf area to sap area + ! may or may not contain diameter correction +real(r8) :: hbl2bsap ! sapwood biomass per lineal height and kg of leaf + +! Constrain sapwood to be no larger than 75% of total agb +real(r8),parameter :: max_agbfrac = 0.75_r8 + +associate ( latosa_int => EDPftvarcon_inst%allom_latosa_int(ipft), & + latosa_slp => EDPftvarcon_inst%allom_latosa_slp(ipft), & + sla => EDPftvarcon_inst%slatop(ipft), & + wood_density => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft)) + + ! ------------------------------------------------------------------------ + ! Calculate sapwood biomass per linear height and kgC of leaf [m-1] + ! Units: + ! (1/latosa)* slatop* gtokg * cm2tom2 / c2b * mg2kg * dens + ! [cm2/m2]*[m2/gC]*[1000gC/1kgC]*[1m2/10000cm2] /[kg/kgC]*[kg/Mg]*[Mg/m3] + ! ->[cm2/gC] + ! ->[cm2/kgC] + ! ->[m2/kgC] + ! ->[m2/kg] + ! ->[m2/Mg] + ! ->[/m] + ! ------------------------------------------------------------------------ + + if(test_b4b) then + + bsap = blmax * latosa_int * h + + if(present(dbsapdd))then + dbsapdd = latosa_int*(h*dblmaxdd + blmax*dhdd) + end if + + else + + latosa = latosa_int + d*latosa_slp + hbl2bsap = sla*g_per_kg*wood_density*kg_per_Megag/(latosa*c2b*cm2_per_m2 ) + + ! Force sapwood to be less than a maximum fraction of total alive biomass + ! (this comes into play typically in very small plants) + bsap = min(max_agbfrac*bag,hbl2bsap * h * blmax) + + ! Derivative + ! dbldmaxdd is deriv of blmax wrt dbh (use directives to check oop) + ! dhdd is deriv of height wrt dbh (use directives to check oop) + if(present(dbsapdd))then + if (bsap0.0_r8) then +dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd +else +dblmaxdd = 0.0_r8 +end if +end if + +return +end subroutine dh2blmax_2pwr + +! ========================================================================= +! Diameter to height (D2H) functions +! ========================================================================= + +subroutine d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) + + ! "d2h_chave2014" + ! "d to height via Chave et al. 2014" + + ! This function calculates tree height based on tree diameter and the + ! environmental stress factor "E", as per Chave et al. 2015 GCB + ! As opposed to previous allometric models in ED, in this formulation + ! we do not impose a hard cap on tree height. But, maximum_height + ! is an important parameter, but instead of imposing a hard limit, in + ! the new methodology, it will be used to trigger a change in carbon + ! balance accounting. Such that a tree that hits its maximum height will + ! begin to route available NPP into seed and defense respiration. + ! + ! The stress function is based on the geographic location of the site. If + ! a user decides to use Chave2015 allometry, the E factor will be read in + ! from a global gridded dataset and assigned for each ED patch (note it + ! will be the same for each ED patch, but this distinction will help in + ! porting ED into different models (patches are pure ED). It + ! assumes that the site is within the pan-tropics, and is a linear function + ! of climatic water deficit, temperature seasonality and precipitation + ! seasonality. See equation 6b of Chave et al. + ! The relevant equation for height in this function is 6a of the same + ! manuscript, and is intended to pair with diameter to relate with + ! structural biomass as per equation 7 (in which H is implicit). + ! + ! Chave et al. Improved allometric models to estimate the abovegroud + ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. + ! + ! ========================================================================= - subroutine bsap_dlinear(d,h,blmax,dblmaxdd,dhdd,ipft,bsap,dbsapdd) + !eclim: Chave's climatological influence parameter "E" + + +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: p1 ! parameter a +real(r8),intent(in) :: p2 ! parameter b +real(r8),intent(in) :: p3 ! parameter c +real(r8),intent(in) :: dbh_maxh ! dbh at maximum height [cm] + +real(r8),intent(out) :: h ! plant height [m] +real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] +real(r8) :: p1e + +p1e = p1 ! -eclim (assumed that p1 already has eclim removed) +if(d>=dbh_maxh) then +h = exp( p1e + p2*log(dbh_maxh) + p3*log(dbh_maxh)**2.0 ) +else +h = exp( p1e + p2*log(d) + p3*log(d)**2.0 ) +end if + +if(present(dhdd))then +if(d>=dbh_maxh ) then +dhdd = 0.0_r8 +else +dhdd = exp(p1e) * ( 2.0_r8*p3*d**(p2-1.0_r8+p3*log(d))*log(d) + & + p2*d**(p2-1.0_r8+p3*log(d)) ) +end if +end if +return +end subroutine d2h_chave2014 + +! =========================================================================== + +subroutine d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) + + ! "d2h_poorter2006" + ! "d to height via Poorter et al. 2006, these routines use natively + ! asymtotic functions" + ! + ! Poorter et al calculated height diameter allometries over a variety of + ! species in Bolivia, including those that could be classified in guilds + ! that were Partial-shade-tolerants, long-lived pioneers, shade-tolerants + ! and short-lived pioneers. There results between height and diameter + ! found that small stature trees had less of a tendency to asymotote in + ! height and showed more linear relationships, and the largest stature + ! trees tended to show non-linear relationships that asymtote. + ! + ! h = h_max*(1-exp(-a*d**b)) + ! + ! Poorter L, L Bongers and F Bongers. Architecture of 54 moist-forest tree + ! species: traits, trade-offs, and functional groups. Ecology 87(5), 2006. + ! + ! ========================================================================= - use FatesConstantsMod, only : g_per_kg - use FatesConstantsMod, only : cm2_per_m2 - use FatesConstantsMod, only : kg_per_Megag +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: p1 ! parameter a = h_max +real(r8),intent(in) :: p2 ! parameter b +real(r8),intent(in) :: p3 ! parameter c +real(r8),intent(in) :: dbh_maxh ! dbh at maximum height +real(r8),intent(out) :: h ! plant height [m] +real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - ! ------------------------------------------------------------------------- - ! Calculate sapwood biomass based on leaf area to sapwood area - ! proportionality. In this function, the leaftosapwood area is a function - ! of plant size, see Calvo-Alvarado and Bradley Christoferson - ! In this case: parameter latosa (from constant proportionality) - ! is the intercept of the diameter function. - ! - ! For very small plants, the fraction can get very large, so cap the amount - ! of sapwood at X! of agb-bleaf - ! ------------------------------------------------------------------------- +h = p1*(1.0_r8 - exp(p2*min(d,dbh_maxh)**p3)) - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: h ! plant height [m] - real(r8),intent(in) :: blmax ! plant leaf biomass [kgC] - real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] - real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] - real(r8),intent(out),optional :: dbsapdd ! change leaf bio per diameter [kgC/cm] - - real(r8) :: latosa ! m2 leaf area per cm2 sap area - real(r8) :: hbl2bsap ! sapwood biomass per lineal height - ! and kg of leaf - real(r8) :: bag ! aboveground biomass [kgC] - real(r8) :: dbagdd ! change in agb per diam [kgC/cm] - - ! Constrain sapwood to be no larger than 75% of total agb - real(r8),parameter :: max_agbfrac = 0.75_r8 - - associate ( latosa_int => EDPftvarcon_inst%allom_latosa_int(ipft), & - latosa_slp => EDPftvarcon_inst%allom_latosa_slp(ipft), & - sla => EDPftvarcon_inst%slatop(ipft), & - wood_density => EDPftvarcon_inst%wood_density(ipft), & - c2b => EDPftvarcon_inst%c2b(ipft)) - - ! ------------------------------------------------------------------------ - ! Calculate sapwood biomass per linear height and kgC of leaf [m-1] - ! Units: - ! (1/latosa)* slatop* gtokg * cm2tom2 / c2b * mg2kg * dens - ! [cm2/m2]*[m2/gC]*[1000gC/1kgC]*[1m2/10000cm2] /[kg/kgC]*[kg/Mg]*[Mg/m3] - ! ->[cm2/gC] - ! ->[cm2/kgC] - ! ->[m2/kgC] - ! ->[m2/kg] - ! ->[m2/Mg] - ! ->[/m] - ! ------------------------------------------------------------------------ - - latosa = latosa_int + d*latosa_slp +!h = h_max - h_max (exp(a*d**b)) +!f(x) = -h_max*exp(g(x)) +!g(x) = a*d**b +!d/dx f(g(x) = f'(g(x))*g'(x) = -a1*exp(a2*d**a3) * a3*a2*d**(a3-1) - hbl2bsap = sla*g_per_kg*wood_density*kg_per_Megag/(latosa*c2b*cm2_per_m2 ) +if(present(dhdd))then +if( d>=dbh_maxh ) then +dhdd = 0.0_r8 +else +dhdd = -p1*exp(p2*d**p3) * p3*p2*d**(p3-1.0_r8) +end if +end if - call bag_allom(d,h,ipft,bag,dbagdd) +return +end subroutine d2h_poorter2006 - ! Force sapwood to be less than a maximum fraction of total alive biomass - ! (this comes into play typically in very small plants) - bsap = min(max_agbfrac*bag,hbl2bsap * h * blmax) +! =========================================================================== - ! Derivative - ! dbldmaxdd is deriv of blmax wrt dbh (use directives to check oop) - ! dhdd is deriv of height wrt dbh (use directives to check oop) - if(present(dbsapdd))then - if (bsap=dbh_maxh ) then +dhdd = 0.0_r8 +else +dhdd = (p2*p1)*d**(p2-1.0_r8) +end if +end if - if(present(dblmaxdd))then - dblmaxdd = p1*p2 *d**(p2-1.0_r8) / c2b - end if +return +end subroutine d2h_2pwr - return - end subroutine d2blmax_2pwr +! ============================================================================ - ! =========================================================================== - - subroutine dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) - - ! ------------------------------------------------------------------------- - ! This formulation is very similar to d2blmax_2pwr - ! The difference is that for very large trees that have reached peak - ! height, we calculate an effective diameter to estimate the leaf biomass. - ! The effective diameter is the diameter that matches the height on - ! the non-capped portion of the plants height-diameter curve. For pft's - ! that have naturally asymptotic formulations (Poorter, Michaeles-Menten, - ! etc) - ! This will render the same results as d2blmax_2pwr, as the effective - ! diameter equals the actual diameter. But for hard caps and logistic - ! caps, this will prevent trees with huge diameters and non-emergent - ! heights to have reasonable leaf levels. - ! -------------------------------------------------------------------------- - - real(r8),intent(in) :: d ! plant diameter [cm] - integer,intent(in) :: ipft ! pft index - real(r8),intent(in) :: p1 ! parameter 1 - real(r8),intent(in) :: p2 ! parameter 2 - real(r8),intent(in) :: c2b ! carbon 2 biomass multiplier - - real(r8),intent(out) :: blmax ! plant leaf biomass [kg] - real(r8),intent(out),optional :: dblmaxdd ! change leaf bio per diameter [kgC/cm] +subroutine d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) - real(r8) :: h ! plant height - real(r8) :: dhdd ! height to diameter differential - real(r8) :: dbh_eff ! effective diameter - real(r8) :: dddh_eff ! effective diameter to height differential - real(r8) :: ddeffdd ! effective diameter to diameter differential - - - ! This call is needed to calculate the rate of change of - ! the actual h with d - call h_allom(d,ipft,h,dhdd) - call h2d_allom(h,ipft,dbh_eff,dddh_eff) - - ! This is the rate of change of the effective diameter - ! with respect to the actual diameter (1.0 in non-height capped) - ddeffdd = dddh_eff * dhdd - blmax = p1*dbh_eff**p2/c2b - - ! If this plant has reached its height cap, then it is not - ! adding leaf mass. In this case, dhdd = 0 - if(present(dblmaxdd))then - if(dhdd>0.0_r8) then - dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd - else - dblmaxdd = 0.0_r8 - end if - end if +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: p1 ! parameter a +real(r8),intent(in) :: p2 ! parameter b +real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] +real(r8),intent(out) :: h ! plant height [m] +real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - return - end subroutine dh2blmax_2pwr +!p1 = 0.64 +!p2 = 0.37 +h = 10.0_r8**(log10(min(d,dbh_maxh))*p1+p2) + +if(present(dhdd))then +if(d>=dbh_maxh ) then +dhdd = 0.0_r8 +else +dhdd = p1*10.0_r8**p2*d**(p1-1.0_r8) +end if +end if + +return +end subroutine d2h_obrien + +! =========================================================================== + +subroutine d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) ! ========================================================================= - ! Diameter to height (D2H) functions + ! "d2h_martcano" + ! "d to height via 3 parameter Michaelis-Menten following work at BCI + ! by Martinez-Cano et al. 2016 + ! + ! h = (a*d**b)/(c+d**b) + ! + ! h' = [(a*d**b)'(c+d**b) - (c+d**b)'(a*d**b)]/(c+d**b)**2 + ! dhdd = h' = [(ba*d**(b-1))(c+d**b) - (b*d**(b-1))(a*d**b)]/(c+d**b)**2 + ! + ! args + ! ========================================================================= + ! d: diameter at breast height + ! h: total tree height [m] ! ========================================================================= - subroutine d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: p1 ! parameter a +real(r8),intent(in) :: p2 ! parameter b +real(r8),intent(in) :: p3 ! parameter c +real(r8),intent(in) :: dbh_maxh ! diameter at maximum height +real(r8),intent(out) :: h ! plant height [m] +real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - ! "d2h_chave2014" - ! "d to height via Chave et al. 2014" - - ! This function calculates tree height based on tree diameter and the - ! environmental stress factor "E", as per Chave et al. 2015 GCB - ! As opposed to previous allometric models in ED, in this formulation - ! we do not impose a hard cap on tree height. But, maximum_height - ! is an important parameter, but instead of imposing a hard limit, in - ! the new methodology, it will be used to trigger a change in carbon - ! balance accounting. Such that a tree that hits its maximum height will - ! begin to route available NPP into seed and defense respiration. - ! - ! The stress function is based on the geographic location of the site. If - ! a user decides to use Chave2015 allometry, the E factor will be read in - ! from a global gridded dataset and assigned for each ED patch (note it - ! will be the same for each ED patch, but this distinction will help in - ! porting ED into different models (patches are pure ED). It - ! assumes that the site is within the pan-tropics, and is a linear function - ! of climatic water deficit, temperature seasonality and precipitation - ! seasonality. See equation 6b of Chave et al. - ! The relevant equation for height in this function is 6a of the same - ! manuscript, and is intended to pair with diameter to relate with - ! structural biomass as per equation 7 (in which H is implicit). - ! - ! Chave et al. Improved allometric models to estimate the abovegroud - ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. - ! - ! ========================================================================= - - !eclim: Chave's climatological influence parameter "E" +h = (p1*min(d,dbh_maxh)**p2)/(p3+min(d,dbh_maxh)**p2) - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: p1 ! parameter a - real(r8),intent(in) :: p2 ! parameter b - real(r8),intent(in) :: p3 ! parameter c - real(r8),intent(in) :: dbh_maxh ! dbh at maximum height [cm] - - real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - real(r8) :: p1e - - p1e = p1 ! -eclim (assumed that p1 already has eclim removed) - if(d>=dbh_maxh) then - h = exp( p1e + p2*log(dbh_maxh) + p3*log(dbh_maxh)**2.0 ) - else - h = exp( p1e + p2*log(d) + p3*log(d)**2.0 ) - end if +if(present(dhdd))then +if(d>=dbh_maxh ) then +dhdd = 0.0 +else +dhdd = ((p2*p1*d**(p2-1._r8))*(p3+d**p2) - & + (p2*d**(p2-1._r8))*(p1*d**p2) )/ & + (p3+d**p2)**2._r8 +end if +end if - if(present(dhdd))then - if(d>=dbh_maxh ) then - dhdd = 0.0_r8 - else - dhdd = exp(p1e) * ( 2.0_r8*p3*d**(p2-1.0_r8+p3*log(d))*log(d) + & - p2*d**(p2-1.0_r8+p3*log(d)) ) - end if - end if - return - end subroutine d2h_chave2014 +return +end subroutine d2h_martcano - ! =========================================================================== - - subroutine d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) - - ! "d2h_poorter2006" - ! "d to height via Poorter et al. 2006, these routines use natively - ! asymtotic functions" - ! - ! Poorter et al calculated height diameter allometries over a variety of - ! species in Bolivia, including those that could be classified in guilds - ! that were Partial-shade-tolerants, long-lived pioneers, shade-tolerants - ! and short-lived pioneers. There results between height and diameter - ! found that small stature trees had less of a tendency to asymotote in - ! height and showed more linear relationships, and the largest stature - ! trees tended to show non-linear relationships that asymtote. - ! - ! h = h_max*(1-exp(-a*d**b)) - ! - ! Poorter L, L Bongers and F Bongers. Architecture of 54 moist-forest tree - ! species: traits, trade-offs, and functional groups. Ecology 87(5), 2006. - ! - ! ========================================================================= - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: p1 ! parameter a = h_max - real(r8),intent(in) :: p2 ! parameter b - real(r8),intent(in) :: p3 ! parameter c - real(r8),intent(in) :: dbh_maxh ! dbh at maximum height - real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - - h = p1*(1.0_r8 - exp(p2*min(d,dbh_maxh)**p3)) - - !h = h_max - h_max (exp(a*d**b)) - !f(x) = -h_max*exp(g(x)) - !g(x) = a*d**b - !d/dx f(g(x) = f'(g(x))*g'(x) = -a1*exp(a2*d**a3) * a3*a2*d**(a3-1) - - if(present(dhdd))then - if( d>=dbh_maxh ) then - dhdd = 0.0_r8 - else - dhdd = -p1*exp(p2*d**p3) * p3*p2*d**(p3-1.0_r8) - end if - end if +! ========================================================================= +! Diameter 2 above-ground biomass +! ========================================================================= - return - end subroutine d2h_poorter2006 - - ! =========================================================================== - - subroutine d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) - - ! ========================================================================= - ! "d2h_2pwr" - ! "d to height via 2 parameter power function" - ! where height h is related to diameter by a linear relationship on the log - ! transform where log(a) is the intercept and b is the slope parameter. - ! - ! log(h) = log(a) + b*log(d) - ! h = exp(log(a)) * exp(log(d))**b - ! h = a*d**b - ! - ! This functional form is used often in temperate allometries - ! Therefore, no base reference is cited. Although, the reader is pointed - ! towards Dietze et al. 2008, King 1991, Ducey 2012 and many others for - ! reasonable parameters. Note that this subroutine is intended only for - ! trees well below their maximum height, ie initialization. - ! - ! ========================================================================= - ! From King et al. 1990 at BCI for saplings - ! log(d) = a + b*log(h) - ! d = exp(a) * h**b - ! h = (1/exp(a)) * d**(1/b) - ! h = p1*d**p2 where p1 = 1/exp(a) = 1.07293 p2 = 1/b = 1.4925 - ! d = (h/p1)**(1/p2) - ! For T. tuberculata (canopy tree) a = -0.0704, b = 0.67 - ! ========================================================================= - - ! args - ! ========================================================================= - ! d: diameter at breast height - ! p1: the intercept parameter - ! (however exponential of the fitted log trans) - ! p2: the slope parameter - ! return: - ! h: total tree height [m] - ! ========================================================================= +subroutine dh2bag_chave2014(d,h,ipft,d2bag1,d2bag2,wood_density,c2b,bag,dbagdd) - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: p1 ! parameter a - real(r8),intent(in) :: p2 ! parameter b - real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] - real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - - h = p1*min(d,dbh_maxh)**p2 - - if(present(dhdd))then - if( d>=dbh_maxh ) then - dhdd = 0.0_r8 - else - dhdd = (p2*p1)*d**(p2-1.0_r8) - end if - end if + ! ========================================================================= + ! This function calculates tree structural biomass from tree diameter, + ! height and wood density. + ! + ! Chave et al. Improved allometric models to estimate the abovegroud + ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. + ! + ! Input arguments: + ! d: Diameter at breast height [cm] + ! rho: wood specific gravity (dry wood mass per green volume) + ! height: total tree height [m] + ! a1: structural biomass allometry parameter 1 (intercept) + ! a2: structural biomass allometry parameter 2 (slope) + ! Output: + ! bag: Total above ground biomass [kgC] + ! + ! ========================================================================= - return - end subroutine d2h_2pwr - ! ============================================================================ +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: h ! plant height [m] +integer ,intent(in) :: ipft ! plant pft +real(r8),intent(in) :: d2bag1 ! allometry parameter 1 +real(r8),intent(in) :: d2bag2 ! allometry parameter 2 +real(r8),intent(in) :: wood_density +real(r8),intent(in) :: c2b +real(r8),intent(out) :: bag ! plant height [m] +real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - subroutine d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: p1 ! parameter a - real(r8),intent(in) :: p2 ! parameter b - real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] - real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - - !p1 = 0.64 - !p2 = 0.37 - h = 10.0_r8**(log10(min(d,dbh_maxh))*p1+p2) - - if(present(dhdd))then - if(d>=dbh_maxh ) then - dhdd = 0.0_r8 - else - dhdd = p1*10.0_r8**p2*d**(p1-1.0_r8) - end if - end if +real(r8) :: hj,dhdd +real(r8) :: dbagdd1,dbagdd2,dbagdd3 - return - end subroutine d2h_obrien +bag = (d2bag1 * (wood_density*d**2.0_r8*h)**d2bag2)/c2b - ! =========================================================================== - - subroutine d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) - - ! ========================================================================= - ! "d2h_martcano" - ! "d to height via 3 parameter Michaelis-Menten following work at BCI - ! by Martinez-Cano et al. 2016 - ! - ! h = (a*d**b)/(c+d**b) - ! - ! h' = [(a*d**b)'(c+d**b) - (c+d**b)'(a*d**b)]/(c+d**b)**2 - ! dhdd = h' = [(ba*d**(b-1))(c+d**b) - (b*d**(b-1))(a*d**b)]/(c+d**b)**2 - ! - ! args - ! ========================================================================= - ! d: diameter at breast height - ! h: total tree height [m] - ! ========================================================================= - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: p1 ! parameter a - real(r8),intent(in) :: p2 ! parameter b - real(r8),intent(in) :: p3 ! parameter c - real(r8),intent(in) :: dbh_maxh ! diameter at maximum height - real(r8),intent(out) :: h ! plant height [m] - real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - - h = (p1*min(d,dbh_maxh)**p2)/(p3+min(d,dbh_maxh)**p2) - - if(present(dhdd))then - if(d>=dbh_maxh ) then - dhdd = 0.0 - else - dhdd = ((p2*p1*d**(p2-1._r8))*(p3+d**p2) - & - (p2*d**(p2-1._r8))*(p1*d**p2) )/ & - (p3+d**p2)**2._r8 - end if - end if - return - end subroutine d2h_martcano - +if(present(dbagdd))then + ! Need the the derivative of height to diameter to + ! solve the derivative of agb with height +call h_allom(d,ipft,hj,dhdd) - ! ========================================================================= - ! Diameter 2 above-ground biomass - ! ========================================================================= +dbagdd1 = (d2bag1*wood_density**d2bag2)/c2b +dbagdd2 = d2bag2*d**(2.0_r8*d2bag2)*h**(d2bag2-1.0_r8)*dhdd +dbagdd3 = h**d2bag2*2.0_r8*d2bag2*d**(2.0_r8*d2bag2-1.0_r8) +dbagdd = dbagdd1*(dbagdd2 + dbagdd3) +end if - subroutine dh2bag_chave2014(d,h,ipft,d2bag1,d2bag2,wood_density,c2b,bag,dbagdd) - - ! ========================================================================= - ! This function calculates tree structural biomass from tree diameter, - ! height and wood density. - ! - ! Chave et al. Improved allometric models to estimate the abovegroud - ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. - ! - ! Input arguments: - ! d: Diameter at breast height [cm] - ! rho: wood specific gravity (dry wood mass per green volume) - ! height: total tree height [m] - ! a1: structural biomass allometry parameter 1 (intercept) - ! a2: structural biomass allometry parameter 2 (slope) - ! Output: - ! bag: Total above ground biomass [kgC] - ! - ! ========================================================================= +return +end subroutine dh2bag_chave2014 - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: h ! plant height [m] - integer ,intent(in) :: ipft ! plant pft - real(r8),intent(in) :: d2bag1 ! allometry parameter 1 - real(r8),intent(in) :: d2bag2 ! allometry parameter 2 - real(r8),intent(in) :: wood_density - real(r8),intent(in) :: c2b - real(r8),intent(out) :: bag ! plant height [m] - real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - - real(r8) :: hj,dhdd - real(r8) :: dbagdd1,dbagdd2,dbagdd3 - - bag = (d2bag1 * (wood_density*d**2.0_r8*h)**d2bag2)/c2b - - - if(present(dbagdd))then - ! Need the the derivative of height to diameter to - ! solve the derivative of agb with height - call h_allom(d,ipft,hj,dhdd) - - dbagdd1 = (d2bag1*wood_density**d2bag2)/c2b - dbagdd2 = d2bag2*d**(2.0_r8*d2bag2)*h**(d2bag2-1.0_r8)*dhdd - dbagdd3 = h**d2bag2*2.0_r8*d2bag2*d**(2.0_r8*d2bag2-1.0_r8) - dbagdd = dbagdd1*(dbagdd2 + dbagdd3) - end if - - return - end subroutine dh2bag_chave2014 - - subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) - - ! ========================================================================= - ! This function calculates tree above ground biomass according to 2 - ! parameter power functions. (slope and intercepts of a log-log - ! diameter-agb fit: - ! - ! These relationships are typical for temperate/boreal plants in North - ! America. Parameters are available from Chojnacky 2014 and Jenkins 2003 - ! - ! Note that we are using an effective diameter here, as Chojnacky 2014 - ! and Jenkins use diameter at the base of the plant for "woodland" species - ! The diameters should be converted prior to this routine if drc. - ! - ! Input arguments: - ! diam: effective diameter (d or drc) in cm - ! FOR SPECIES THAT EXPECT DCM, THIS NEEDS TO BE PRE-CALCULATED!!!! - ! Output: - ! agb: Total above ground biomass [kgC] - ! - ! ========================================================================= - ! Aceraceae, Betulaceae, Fagaceae and Salicaceae comprised nearly - ! three-fourths of the hardwood species (Table 3) - ! - ! Fabaceae and Juglandaceae had specific gravities .0.60 and were - ! combined, as were Hippocastanaceae and Tilaceae with specific gravities - ! near 0.30. The remaining 9 families, which included mostly species with - ! specific gravity 0.45–0.55, were initially grouped to construct a general - ! hardwood taxon for those families having few published biomass equa- - ! tions however, 3 warranted separation, leaving 6 families for the general - ! taxon. - ! bag = exp(b0 + b1*ln(diameter))/c2b - ! ========================================================================= +subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: d2bag1 ! allometry parameter 1 - real(r8),intent(in) :: d2bag2 ! allometry parameter 2 - real(r8),intent(in) :: c2b ! carbon to biomass multiplier ~2 - real(r8),intent(out) :: bag ! plant height [m] - real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - - bag = (d2bag1 * d**d2bag2)/c2b - if(present(dbagdd))then - dbagdd = (d2bag2*d2bag1*d**(d2bag2-1.0_r8))/c2b - end if - - return - end subroutine d2bag_2pwr - - - subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag2,d2bag3,d2bag4, & - wood_density,c2b,allom_agb_frac,bag,dbagdd) - - ! -------------------------------------------------------------------- - ! 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 - ! Saldarriaga 1988 provided calculations on total dead biomass - ! So here, we calculate total dead, and then call and remove - ! coarse root and sapwood. We ignore fineroot and leaf - ! in the calculations - ! -------------------------------------------------------------------- + ! ========================================================================= + ! This function calculates tree above ground biomass according to 2 + ! parameter power functions. (slope and intercepts of a log-log + ! diameter-agb fit: + ! + ! These relationships are typical for temperate/boreal plants in North + ! America. Parameters are available from Chojnacky 2014 and Jenkins 2003 + ! + ! Note that we are using an effective diameter here, as Chojnacky 2014 + ! and Jenkins use diameter at the base of the plant for "woodland" species + ! The diameters should be converted prior to this routine if drc. + ! + ! Input arguments: + ! diam: effective diameter (d or drc) in cm + ! FOR SPECIES THAT EXPECT DCM, THIS NEEDS TO BE PRE-CALCULATED!!!! + ! Output: + ! agb: Total above ground biomass [kgC] + ! + ! ========================================================================= + ! Aceraceae, Betulaceae, Fagaceae and Salicaceae comprised nearly + ! three-fourths of the hardwood species (Table 3) + ! + ! Fabaceae and Juglandaceae had specific gravities .0.60 and were + ! combined, as were Hippocastanaceae and Tilaceae with specific gravities + ! near 0.30. The remaining 9 families, which included mostly species with + ! specific gravity 0.45–0.55, were initially grouped to construct a general + ! hardwood taxon for those families having few published biomass equa- + ! tions however, 3 warranted separation, leaving 6 families for the general + ! taxon. + ! bag = exp(b0 + b1*ln(diameter))/c2b + ! ========================================================================= - - real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: h ! plant height [m] - integer(i4),intent(in) :: ipft ! PFT index - real(r8),intent(in) :: d2bag1 ! = 0.06896_r8 - real(r8),intent(in) :: d2bag2 ! = 0.572_r8 - real(r8),intent(in) :: d2bag3 ! = 1.94_r8 - real(r8),intent(in) :: d2bag4 ! = 0.931_r8 - real(r8),intent(in) :: c2b ! carbon 2 biomass ratio - real(r8),intent(in) :: wood_density - real(r8),intent(in) :: allom_agb_frac - real(r8),intent(out) :: bag ! plant biomass [kgC/indiv] - real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: d2bag1 ! allometry parameter 1 +real(r8),intent(in) :: d2bag2 ! allometry parameter 2 +real(r8),intent(in) :: c2b ! carbon to biomass multiplier ~2 +real(r8),intent(out) :: bag ! plant height [m] +real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - real(r8) :: term1,term2,term3,hj,dhdd +bag = (d2bag1 * d**d2bag2)/c2b +if(present(dbagdd))then +dbagdd = (d2bag2*d2bag1*d**(d2bag2-1.0_r8))/c2b +end if +return +end subroutine d2bag_2pwr - bag = allom_agb_frac*d2bag1*(h**d2bag2)*(d**d2bag3)*(wood_density**d2bag4) - - ! Add sapwood calculation to this - ! bag = a1 * h**a2 * d**a3 * r**a4 - ! dbag/dd = a1*r**a4 * d/dd (h**a2*d**a3) - ! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] - ! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] +subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag2,d2bag3,d2bag4, & +wood_density,c2b,allom_agb_frac,bag,dbagdd) - if(present(dbagdd)) then - term1 = allom_agb_frac*d2bag1*(wood_density**d2bag4) - term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) - - call h_allom(d,ipft,hj,dhdd) - term3 = d2bag2*h**(d2bag2-1)*(d**d2bag3)*dhdd - dbagdd = term1*(term2+term3) - end if + ! -------------------------------------------------------------------- + ! 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 + ! Saldarriaga 1988 provided calculations on total dead biomass + ! So here, we calculate total dead, and then call and remove + ! coarse root and sapwood. We ignore fineroot and leaf + ! in the calculations + ! -------------------------------------------------------------------- - return - end subroutine dh2bag_salda - ! ============================================================================ - ! height to diameter conversions - ! Note that these conversions will only back-calculate the actual diameter - ! for plants that have not started to experience height capping or an - ! asymptote. In these cases they may be called effective diameter. - ! ============================================================================ - - subroutine h2d_chave2014(h,p1,p2,p3,de,ddedh) +real(r8),intent(in) :: d ! plant diameter [cm] +real(r8),intent(in) :: h ! plant height [m] +integer(i4),intent(in) :: ipft ! PFT index +real(r8),intent(in) :: d2bag1 ! = 0.06896_r8 +real(r8),intent(in) :: d2bag2 ! = 0.572_r8 +real(r8),intent(in) :: d2bag3 ! = 1.94_r8 +real(r8),intent(in) :: d2bag4 ! = 0.931_r8 +real(r8),intent(in) :: c2b ! carbon 2 biomass ratio +real(r8),intent(in) :: wood_density +real(r8),intent(in) :: allom_agb_frac + +real(r8),intent(out) :: bag ! plant biomass [kgC/indiv] +real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] + +real(r8) :: term1,term2,term3,hj,dhdd + + +bag = allom_agb_frac*d2bag1*(h**d2bag2)*(d**d2bag3)*(wood_density**d2bag4) + +! Add sapwood calculation to this + +! bag = a1 * h**a2 * d**a3 * r**a4 +! dbag/dd = a1*r**a4 * d/dd (h**a2*d**a3) +! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] +! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] + +if(present(dbagdd)) then +term1 = allom_agb_frac*d2bag1*(wood_density**d2bag4) +term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) + +call h_allom(d,ipft,hj,dhdd) +term3 = d2bag2*h**(d2bag2-1)*(d**d2bag3)*dhdd +dbagdd = term1*(term2+term3) +end if + +return +end subroutine dh2bag_salda + +! ============================================================================ +! height to diameter conversions +! Note that these conversions will only back-calculate the actual diameter +! for plants that have not started to experience height capping or an +! asymptote. In these cases they may be called effective diameter. +! ============================================================================ + +subroutine h2d_chave2014(h,p1,p2,p3,de,ddedh) + + +real(r8),intent(in) :: h ! plant height [m] +real(r8),intent(in) :: p1 +real(r8),intent(in) :: p2 +real(r8),intent(in) :: p3 + +real(r8),intent(out) :: de ! effective plant diameter [cm] +real(r8),intent(out),optional :: ddedh ! effective change in d per height [cm/m] + +real(r8) :: p1e, eroot, dbh1,dhpdd + +p1e = p1 !-eclim (assumed that p1 already has eclim removed) +eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-p1e))*p3)) & +/(2.0_r8*p3) + +de = exp(eroot) + +if(present(ddedh))then + ! Invert the derivative at d without asymtote +dhpdd = exp(p1e)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & +exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & +exp(p3*log(de)**2.0_r8) ) + +ddedh = 1.0_r8/dhpdd +end if + +! term1 = exp(-p2/(2*p3)) +! term2 = exp(p2**2/(4*p3**2)) +! term3 = exp(-p1e/p3) +! term4 = h**(1/p3-1.0_r8)/(p3) +! d = term1*term2*term3*term4 +return +end subroutine h2d_chave2014 + +! ============================================================================ + +subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) + + ! ------------------------------------------------------------------------- + ! Note that the height to diameter conversion in poorter is only necessary + ! when initializing saplings. In other methods, height to diameter is + ! useful when defining the dbh at which point to asymptote, as maximum + ! height is the user set parameter. This function should not need to set a + ! dbh_max parameter for instance, but it may end up doing so anyway, even + ! if it is not used, do to poor filtering. The poorter et al. d2h and h2d + ! functions are already asymptotic, and the parameter governing maximum + ! height is the p1 parameter. Note as dbh gets very large, the + ! exponential goes to zero, and the maximum height approaches p1. + ! However, the asymptote has a much different shape than the logistic, so + ! therefore in the Poorter et al functions, we do not set p1 == h_max. + ! That being said, if an h_max that is greater than p1 is passed to this + ! function, it will return a complex number. During parameter + ! initialization, a check will be placed that forces: + ! h_max = p1*0.98 + ! ------------------------------------------------------------------------- + +real(r8),intent(in) :: h ! plant height [m] +real(r8),intent(in) :: p1 +real(r8),intent(in) :: p2 +real(r8),intent(in) :: p3 + +real(r8),intent(out) :: d ! plant diameter [cm] +real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] + +! ------------------------------------------------------------------------- +! h = a1*(1 - exp(a2*d**a3)) +! h = a1 - a1*exp(a2*d**a3) +! a1-h = a1*exp(a2*d**a3) +! (a1-h)/a1 = exp(a2*d**a3) +! log(1-h/a1) = a2*d**a3 +! [log(1-h/a1)/a2]**(1/a3) = d +! +! derivative dd/dh +! dd/dh = [log((a1-h)/a1)/a2]**(1/a3)' +! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1)* [(log(a1-h)-log(a1))/a2]' +! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1) * (1/(a2*(h-a1)) +! dd/dh = -((log(1-h/a1)/a2)**(1/a3-1))/(a2*a3*(a1-h)) +! ------------------------------------------------------------------------- - - real(r8),intent(in) :: h ! plant height [m] - real(r8),intent(in) :: p1 - real(r8),intent(in) :: p2 - real(r8),intent(in) :: p3 +d = (log(1.0_r8-h/p1)/p2)**(1.0_r8/p3) - real(r8),intent(out) :: de ! effective plant diameter [cm] - real(r8),intent(out),optional :: ddedh ! effective change in d per height [cm/m] +if(present(dddh))then +dddh = -((log(1-h/p1)/p2)**(1.0_r8/p3-1.0_r8))/ & +(p2*p3*(p1-h)) +end if - real(r8) :: p1e, eroot, dbh1,dhpdd +return +end subroutine h2d_poorter2006 - p1e = p1 !-eclim (assumed that p1 already has eclim removed) - eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-p1e))*p3)) & - /(2.0_r8*p3) +! ============================================================================ - de = exp(eroot) - - if(present(ddedh))then - ! Invert the derivative at d without asymtote - dhpdd = exp(p1e)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & - exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & - exp(p3*log(de)**2.0_r8) ) - - ddedh = 1.0_r8/dhpdd - end if - - ! term1 = exp(-p2/(2*p3)) - ! term2 = exp(p2**2/(4*p3**2)) - ! term3 = exp(-p1e/p3) - ! term4 = h**(1/p3-1.0_r8)/(p3) - ! d = term1*term2*term3*term4 - return - end subroutine h2d_chave2014 +subroutine h2d_2pwr(h,p1,p2,d,dddh) - ! ============================================================================ - subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) - - ! ------------------------------------------------------------------------- - ! Note that the height to diameter conversion in poorter is only necessary - ! when initializing saplings. In other methods, height to diameter is - ! useful when defining the dbh at which point to asymptote, as maximum - ! height is the user set parameter. This function should not need to set a - ! dbh_max parameter for instance, but it may end up doing so anyway, even - ! if it is not used, do to poor filtering. The poorter et al. d2h and h2d - ! functions are already asymptotic, and the parameter governing maximum - ! height is the p1 parameter. Note as dbh gets very large, the - ! exponential goes to zero, and the maximum height approaches p1. - ! However, the asymptote has a much different shape than the logistic, so - ! therefore in the Poorter et al functions, we do not set p1 == h_max. - ! That being said, if an h_max that is greater than p1 is passed to this - ! function, it will return a complex number. During parameter - ! initialization, a check will be placed that forces: - ! h_max = p1*0.98 - ! ------------------------------------------------------------------------- - - real(r8),intent(in) :: h ! plant height [m] - real(r8),intent(in) :: p1 - real(r8),intent(in) :: p2 - real(r8),intent(in) :: p3 +real(r8),intent(in) :: h ! plant height [m] +real(r8),intent(in) :: p1 ! parameter 1 +real(r8),intent(in) :: p2 ! parameter 2 - real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] - - ! ------------------------------------------------------------------------- - ! h = a1*(1 - exp(a2*d**a3)) - ! h = a1 - a1*exp(a2*d**a3) - ! a1-h = a1*exp(a2*d**a3) - ! (a1-h)/a1 = exp(a2*d**a3) - ! log(1-h/a1) = a2*d**a3 - ! [log(1-h/a1)/a2]**(1/a3) = d - ! - ! derivative dd/dh - ! dd/dh = [log((a1-h)/a1)/a2]**(1/a3)' - ! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1)* [(log(a1-h)-log(a1))/a2]' - ! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1) * (1/(a2*(h-a1)) - ! dd/dh = -((log(1-h/a1)/a2)**(1/a3-1))/(a2*a3*(a1-h)) - ! ------------------------------------------------------------------------- - - d = (log(1.0_r8-h/p1)/p2)**(1.0_r8/p3) +real(r8),intent(out) :: d ! plant diameter [cm] +real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] - if(present(dddh))then - dddh = -((log(1-h/p1)/p2)**(1.0_r8/p3-1.0_r8))/ & - (p2*p3*(p1-h)) - end if +!h = a1*d**a2 +d = (h/p1)**(1.0_r8/p2) - return - end subroutine h2d_poorter2006 +! d = (1/a1)**(1/a2)*h**(1/a2) +if(present(dddh)) then +dddh = (1.0_r8/p2)*(1.0_r8/p1)**(1.0_r8/p2) & +*h**(1.0_r8/p2-1.0_r8) +end if - ! ============================================================================ +return +end subroutine h2d_2pwr - subroutine h2d_2pwr(h,p1,p2,d,dddh) +! ============================================================================ - - real(r8),intent(in) :: h ! plant height [m] - real(r8),intent(in) :: p1 ! parameter 1 - real(r8),intent(in) :: p2 ! parameter 2 +subroutine h2d_obrien(h,p1,p2,d,dddh) - real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] +real(r8),intent(in) :: h ! plant height [m] +real(r8),intent(in) :: p1 +real(r8),intent(in) :: p2 - !h = a1*d**a2 - d = (h/p1)**(1.0_r8/p2) +real(r8),intent(out) :: d ! plant diameter [cm] +real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] - ! d = (1/a1)**(1/a2)*h**(1/a2) - if(present(dddh)) then - dddh = (1.0_r8/p2)*(1.0_r8/p1)**(1.0_r8/p2) & - *h**(1.0_r8/p2-1.0_r8) - end if +d = 10.0_r8**((log10(h)-p2)/p1) - return - end subroutine h2d_2pwr - - ! ============================================================================ - - subroutine h2d_obrien(h,p1,p2,d,dddh) - - real(r8),intent(in) :: h ! plant height [m] - real(r8),intent(in) :: p1 - real(r8),intent(in) :: p2 +if(present(dddh))then +dddh = 1.0_r8/(p1*10.0_r8**p2*d**(p1-1.0_r8)) +end if - real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] +return +end subroutine h2d_obrien - d = 10.0_r8**((log10(h)-p2)/p1) +! ============================================================================ - if(present(dddh))then - dddh = 1.0_r8/(p1*10.0_r8**p2*d**(p1-1.0_r8)) - end if +subroutine h2d_martcano(h,p1,p2,p3,d,dddh) - return - end subroutine h2d_obrien + ! ========================================================================= + ! "d2h_martcano" + ! "d to height via 3 parameter Michaelis-Menten following work at BCI + ! by Martinez-Cano et al. 2016 + ! + ! h = (a*d**b)/(c+d**b) + ! + ! d = [(h*c)/(a-h)]**(1/b) + ! d = [(h*c)**(1/b)] / [(a-h)**(1/b)] + ! d' = {[(h*c)**(1/b)]' [(a-h)**(1/b)] - [(a-h)**(1/b)]'[(h*c)**(1/b)]} / + ! [(a-h)**(1/b)]**2 + ! dddh = d' = {[(1/b)(h*c)**(1/b-1)] [(a-h)**(1/b)] - + ! [(1/b)(a-h)**(1/b-1)] [(h*c)**(1/b)]} / + ! [(a-h)**(1/b)]**2 + ! + ! ========================================================================= - ! ============================================================================ +real(r8),intent(in) :: h ! plant height [m] +real(r8),intent(in) :: p1 +real(r8),intent(in) :: p2 +real(r8),intent(in) :: p3 - subroutine h2d_martcano(h,p1,p2,p3,d,dddh) - - ! ========================================================================= - ! "d2h_martcano" - ! "d to height via 3 parameter Michaelis-Menten following work at BCI - ! by Martinez-Cano et al. 2016 - ! - ! h = (a*d**b)/(c+d**b) - ! - ! d = [(h*c)/(a-h)]**(1/b) - ! d = [(h*c)**(1/b)] / [(a-h)**(1/b)] - ! d' = {[(h*c)**(1/b)]' [(a-h)**(1/b)] - [(a-h)**(1/b)]'[(h*c)**(1/b)]} / - ! [(a-h)**(1/b)]**2 - ! dddh = d' = {[(1/b)(h*c)**(1/b-1)] [(a-h)**(1/b)] - - ! [(1/b)(a-h)**(1/b-1)] [(h*c)**(1/b)]} / - ! [(a-h)**(1/b)]**2 - ! - ! ========================================================================= - - real(r8),intent(in) :: h ! plant height [m] - real(r8),intent(in) :: p1 - real(r8),intent(in) :: p2 - real(r8),intent(in) :: p3 +real(r8),intent(out) :: d ! plant diameter [cm] +real(r8),intent(out),optional :: dddh ! change in diameter per height [cm/m] - real(r8),intent(out) :: d ! plant diameter [cm] - real(r8),intent(out),optional :: dddh ! change in diameter per height [cm/m] +d = ((h*p3)/(p1-h))**(1._r8/p2) - d = ((h*p3)/(p1-h))**(1._r8/p2) - - if(present(dddh))then - dddh = (((1._r8/p2)*(h*p3)**(1._r8/p2-1._r8))*((p1-h)**(1._r8/p2)) - & - ((1._r8/p2)*(p1-h)**(1._r8/p2-1._r8))* ((h*p3)**(1._r8/p2)) ) / & - ((p1-h)**(1._r8/p2))**2._r8 - end if - return - end subroutine h2d_martcano +if(present(dddh))then +dddh = (((1._r8/p2)*(h*p3)**(1._r8/p2-1._r8))*((p1-h)**(1._r8/p2)) - & +((1._r8/p2)*(p1-h)**(1._r8/p2-1._r8))* ((h*p3)**(1._r8/p2)) ) / & +((p1-h)**(1._r8/p2))**2._r8 +end if +return +end subroutine h2d_martcano - ! =========================================================================== +! =========================================================================== - subroutine cspline(x1,x2,y1,y2,dydx1,dydx2,x,y,dydx) +subroutine cspline(x1,x2,y1,y2,dydx1,dydx2,x,y,dydx) - ! ============================================================================ - ! This subroutine performs a cubic spline interpolation between known - ! endpoints. The endpoints have known coordinats and slopes - ! ============================================================================ - - ! Arguments - - real(r8),intent(in) :: x1 ! Lower endpoint independent - real(r8),intent(in) :: x2 ! Upper endpoint independent - real(r8),intent(in) :: y1 ! Lower endpoint dependent - real(r8),intent(in) :: y2 ! Upper endpoint dependent - real(r8),intent(in) :: dydx1 ! Lower endpoint slope - real(r8),intent(in) :: dydx2 ! Upper endpoint slope - real(r8),intent(in) :: x ! Independent - real(r8),intent(out) :: y ! Dependent - real(r8),intent(out) :: dydx ! Slope - - ! Temps - real(r8) :: t - real(r8) :: a - real(r8) :: b - - t = (x-x1)/(x2-x1) - a = dydx1*(x2-x1) - (y2-y1) - b = -dydx2*(x2-x1) + (y2-y1) - - y = (1.0_r8-t)*y1 + t*y2 + t*(1.0_r8-t)*(a*(1.0_r8-t) + b*t) - dydx = (y2-y1)/(x2-x1) + (1.0_r8-2.0_r8*t)*(a*(1.0_r8-t)+b*t)/(x2-x1) + t*(1.0_r8-t)*(b-a)/(x2-x1) - return - end subroutine cspline + ! ============================================================================ + ! This subroutine performs a cubic spline interpolation between known + ! endpoints. The endpoints have known coordinats and slopes + ! ============================================================================ + + ! Arguments + +real(r8),intent(in) :: x1 ! Lower endpoint independent +real(r8),intent(in) :: x2 ! Upper endpoint independent +real(r8),intent(in) :: y1 ! Lower endpoint dependent +real(r8),intent(in) :: y2 ! Upper endpoint dependent +real(r8),intent(in) :: dydx1 ! Lower endpoint slope +real(r8),intent(in) :: dydx2 ! Upper endpoint slope +real(r8),intent(in) :: x ! Independent +real(r8),intent(out) :: y ! Dependent +real(r8),intent(out) :: dydx ! Slope + +! Temps +real(r8) :: t +real(r8) :: a +real(r8) :: b + +t = (x-x1)/(x2-x1) +a = dydx1*(x2-x1) - (y2-y1) +b = -dydx2*(x2-x1) + (y2-y1) + +y = (1.0_r8-t)*y1 + t*y2 + t*(1.0_r8-t)*(a*(1.0_r8-t) + b*t) +dydx = (y2-y1)/(x2-x1) + (1.0_r8-2.0_r8*t)*(a*(1.0_r8-t)+b*t)/(x2-x1) + t*(1.0_r8-t)*(b-a)/(x2-x1) +return +end subroutine cspline end module FatesAllometryMod From 50e1f65d9d298f9deccf92369fdd8ac94e686a45 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 16 Oct 2017 13:52:49 -0700 Subject: [PATCH 09/63] modular allometry: re-case saldarriaga biomass estimates to be consistent with previous methods. Added some diagnostic variables. --- biogeochem/EDPhysiologyMod.F90 | 4 +-- biogeochem/FatesAllometryMod.F90 | 49 +++++++++++++++++++------------ main/EDInitMod.F90 | 2 +- main/FatesHistoryInterfaceMod.F90 | 26 ++++++++++++---- main/FatesInventoryInitMod.F90 | 2 +- 5 files changed, 55 insertions(+), 28 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index cb89ab7348..92226aaafe 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1019,7 +1019,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! Tally up the relative change in dead biomass WRT diameter call bag_allom(currentCohort%dbh,currentCohort%hite,ipft,b_ag,db_ag_dd) call bcr_allom(currentCohort%dbh,currentCohort%hite,ipft,b_cr,db_cr_dd) - call bdead_allom( b_ag, b_cr, b_sap, b_dead, db_ag_dd, db_cr_dd, db_sap_dd, db_dead_dd ) + call bdead_allom( b_ag, b_cr, b_sap, ipft, b_dead, db_ag_dd, db_cr_dd, db_sap_dd, db_dead_dd ) !only if carbon balance is +ve @@ -1171,7 +1171,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call bag_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_aboveground) call bcr_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_coarseroot) - call bdead_allom(b_aboveground,b_coarseroot,b_sapwood,temp_cohort%bdead) + call bdead_allom(b_aboveground,b_coarseroot,b_sapwood,ft,temp_cohort%bdead) ! Initialize balive (leaf+fineroot+sapwood) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 3a6be02c8f..ec5c3f268b 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -437,12 +437,13 @@ end subroutine bfineroot ! Dead biomass interface ! ============================================================================ - subroutine bdead_allom(bag,bcr,bsap,bdead,dbagdd,dbcrdd,dbsapdd,dbdeaddd) + subroutine bdead_allom(bag,bcr,bsap,ipft,bdead,dbagdd,dbcrdd,dbsapdd,dbdeaddd) real(r8),intent(in) :: bag ! agb [kgC] real(r8),intent(in) :: bcr ! coarse root biomass [kgC] real(r8),intent(in) :: bsap ! sapwood biomass [kgC] + integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(out) :: bdead ! dead biomass (heartw/struct) [kgC] real(r8),intent(in),optional :: dbagdd ! change in agb per d [kgC/cm] @@ -450,27 +451,37 @@ subroutine bdead_allom(bag,bcr,bsap,bdead,dbagdd,dbcrdd,dbsapdd,dbdeaddd) real(r8),intent(in),optional :: dbsapdd ! change in bsap per d [kgC/cm] real(r8),intent(out),optional :: dbdeaddd ! change in bdead per d [kgC/cm] - - ! bdead is diagnosed as the mass balance from all other pools ! and therefore, no options are necessary - if(test_b4b) then - bdead = bag+bcr - else - bdead = bag+bcr-bsap - end if - - if(test_b4b) then - if(present(dbagdd) .and. present(dbcrdd) .and. present(dbdeaddd) )then - dbdeaddd = dbagdd+dbcrdd - end if - else - if(present(dbagdd) .and. present(dbcrdd) .and. present(dbdeaddd) .and. present(dbsapdd) )then - dbdeaddd = dbagdd+dbcrdd-dbsapdd - end if - end if - + associate( agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft)) + + select case(int(EDPftvarcon_inst%allom_amode(ipft))) + case(3) ! Saldariagga mass allometry originally calculated bdead directly. + ! we assume proportionality between bdead and bag + + bdead = bag/agb_fraction + if(present(dbagdd) .and. present(dbdeaddd))then + dbdeaddd = dbagdd/agb_fraction + end if + + case(1,2) + + bdead = bag+bcr-bsap + if(present(dbagdd) .and. present(dbcrdd) .and. & + present(dbdeaddd) .and. present(dbsapdd) )then + dbdeaddd = dbagdd+dbcrdd-dbsapdd + end if + + case DEFAULT + + write(fates_log(),*) 'An undefined AGB allometry was specified: ',& + EDPftvarcon_inst%allom_amode(ipft) + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + end associate return end subroutine bdead_allom diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 476fd01736..2081bc69f7 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -385,7 +385,7 @@ subroutine init_cohorts( patch_in, bc_in) temp_cohort%balive = b_leaf + b_fineroot + b_sapwood - call bdead_allom( b_ag, b_cr, b_sapwood, temp_cohort%bdead ) + call bdead_allom( b_ag, b_cr, b_sapwood, pft, temp_cohort%bdead ) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 55166eac8d..16300a8c2c 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -71,6 +71,8 @@ module FatesHistoryInterfaceMod integer, private :: ih_bdead_pa integer, private :: ih_balive_pa integer, private :: ih_bleaf_pa + integer, private :: ih_bsapwood_pa + integer, private :: ih_bfineroot_pa integer, private :: ih_btotal_pa integer, private :: ih_npp_pa integer, private :: ih_gpp_pa @@ -1170,6 +1172,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bdead_pa => this%hvars(ih_bdead_pa)%r81d, & hio_balive_pa => this%hvars(ih_balive_pa)%r81d, & hio_bleaf_pa => this%hvars(ih_bleaf_pa)%r81d, & + hio_bsapwood_pa => this%hvars(ih_bsapwood_pa)%r81d, & + hio_bfineroot_pa => this%hvars(ih_bfineroot_pa)%r81d, & hio_btotal_pa => this%hvars(ih_btotal_pa)%r81d, & hio_canopy_biomass_pa => this%hvars(ih_canopy_biomass_pa)%r81d, & hio_understory_biomass_pa => this%hvars(ih_understory_biomass_pa)%r81d, & @@ -1376,11 +1380,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) + ccohort%c_area * AREA_INV ! Update biomass components - hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * g_per_kg - hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * g_per_kg - hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b * g_per_kg - hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * ccohort%bdead * g_per_kg - hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * ccohort%balive * g_per_kg + hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * g_per_kg + hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * g_per_kg + hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b * g_per_kg + hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * ccohort%bdead * g_per_kg + hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * ccohort%balive * g_per_kg + hio_bsapwood_pa(io_pa) = hio_bsapwood_pa(io_pa) + n_density * ccohort%bsw * g_per_kg + hio_bfineroot_pa(io_pa) = hio_bfineroot_pa(io_pa) + n_density * ccohort%br * g_per_kg ! Update PFT partitioned biomass components hio_leafbiomass_si_pft(io_si,ft) = hio_leafbiomass_si_pft(io_si,ft) + & @@ -2745,6 +2751,16 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_bleaf_pa ) + call this%set_history_var(vname='ED_bsapwood', units='gC m-2', & + long='Sapwood biomass', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bsapwood_pa ) + + call this%set_history_var(vname='ED_bfineroot', units='gC m-2', & + long='Fine root biomass', use_default='active', & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bfineroot_pa ) + call this%set_history_var(vname='ED_biomass', units='gC m-2', & long='Total biomass', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index c539074d2e..9104b4b874 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -892,7 +892,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%balive = b_leaf + b_fineroot + b_sapwood - call bdead_allom( b_ag, b_cr, b_sapwood, temp_cohort%bdead ) + call bdead_allom( b_ag, b_cr, b_sapwood, c_pft, temp_cohort%bdead ) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead From 58c7324870806f74f1674516de6c3c11276098b7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 16 Oct 2017 15:04:07 -0700 Subject: [PATCH 10/63] modular allometry: updated some descriptive text, fixed a b4b formulation for bsw, where I was using blmax instead of bleaf. --- biogeochem/EDPhysiologyMod.F90 | 2 ++ biogeochem/FatesAllometryMod.F90 | 15 +++++++++++---- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 92226aaafe..b7ab271249 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1034,6 +1034,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) end if ! Tally up the relative change in alive biomass WRT diameter + ! These calculations will take into account any height capping + ! (if the user wanted it) and its implications to these pools call bleaf(currentCohort%dbh,currentCohort%hite,ipft, & currentCohort%canopy_trim,b_leaf,db_leaf_dd) call bfineroot(currentCohort%dbh,currentCohort%hite,ipft, & diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index ec5c3f268b..a76ace2b43 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -61,6 +61,7 @@ ! OPEN QUESTIONS: ! SHOULD SAPWOOD ALLOMETRY SUBSUME TRIMMING, OR BE OFF OF BLMAX? ! WHAT IS CONTAINED IN THE AGB POOL? +! UNBOUND CALLS TO BSW,BLEAF and BFR STILL EXIST IN CODE ! ! Carbon Pool Configurations are as follows, and assume a constant proportionality ! between above and below-ground pools. Sapwood (bsap) is both above and below @@ -71,9 +72,11 @@ ! Leaf biomass, height and above ground biomass typically have non-linear ! allometry models. The default for sapwood is the pipe model. ! -! bag = (bdead+bsap)*agb_frac + bleaf -! bdead = bag - (bsap*agb_frac) - bleaf + bcr -! bcr = bdead * (1-agb_frac) = (bag - (bsap*agb_frac) - bleaf)*(1-agb_frac) +! We ignore leaf biomass contributions in allometry to AGB: +! +! bag = (bdead+bsap)*agb_frac +! bdead = bag - (bsap*agb_frac) + bcr +! bcr = bdead * (1-agb_frac) = (bag - (bsap*agb_frac) + bcr)*(1-agb_frac) ! ! ! Initial Implementation: Ryan Knox July 2017 @@ -348,7 +351,11 @@ subroutine bsap_allom(d,ipft,bsap,dbsapdd) ! --------------------------------------------------------------------- case(1,2) !"constant","dlinear") call h_allom(d,ipft,h,dhdd) - call blmax_allom(d,h,ipft,blmax,dblmaxdd) + if(test_b4b)then + call bleaf(d,h,ipft,blmax,dblmaxdd) + else + call blmax_allom(d,h,ipft,blmax,dblmaxdd) + end if call bag_allom(d,h,ipft,bag,dbagdd) call bsap_dlinear(d,h,dhdd,blmax,dblmaxdd,bag,dbagdd,ipft,bsap,dbsapdd) case DEFAULT From 6a02f1e2ee71c13b69422534b7967ebbf108f614 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 17 Oct 2017 11:52:13 -0700 Subject: [PATCH 11/63] modular allometry, set a b4b test switch on the leaf2dead biomass derivative, imported modular functions into alive biomass calculations. --- biogeochem/EDCohortDynamicsMod.F90 | 36 ++++++++++++++++++----------- biogeochem/EDPhysiologyMod.F90 | 4 ++-- biogeochem/FatesAllometryMod.F90 | 37 +++++++++++++++++++----------- 3 files changed, 49 insertions(+), 28 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 89c96b8b3a..99c39e1b5b 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -10,7 +10,7 @@ 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 FatesConstantsMod , only : itrue,ifalse use FatesInterfaceMod , only : hlm_days_per_year use EDPftvarcon , only : EDPftvarcon_inst use EDGrowthFunctionsMod , only : c_area, tree_lai @@ -210,6 +210,11 @@ subroutine allocate_live_biomass(cc_p,mode) real(r8) :: new_bl real(r8) :: new_br real(r8) :: new_bsw + real(r8) :: tar_bl ! target leaf biomass when leaves are flushed (includes trimming) + real(r8) :: tar_br ! target fineroot biomass (includes trimming) + real(r8) :: tar_bsw ! target sapwood biomass + real(r8) :: bfr_per_leaf ! ratio of fine roots to leaf mass when plants are on allometry + real(r8) :: bsw_per_leaf ! ratio of sapwood to leaf mass when plants are on allometry integer :: ft ! functional type integer :: leaves_off_switch @@ -217,7 +222,14 @@ subroutine allocate_live_biomass(cc_p,mode) currentCohort => cc_p ft = currentcohort%pft - leaf_frac = 1.0_r8/(1.0_r8 + EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite + EDPftvarcon_inst%allom_l2fr(ft)) + + call bleaf(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_bl) + call bfineroot(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_br) + call bsap_allom(currentcohort%dbh,ft,tar_bsw) + + leaf_frac = tar_bl/(tar_bl+tar_br+tar_bsw) + bfr_per_leaf = tar_br/tar_bl + bsw_per_leaf = tar_bsw/tar_bl !currentcohort%bl = currentcohort%balive*leaf_frac !for deciduous trees, there are no leaves @@ -242,14 +254,13 @@ subroutine allocate_live_biomass(cc_p,mode) endif ! Use different proportions if the leaves are on vs off - if(leaves_off_switch==0)then + if(leaves_off_switch.eq.ifalse)then ! leaves are on new_bl = currentcohort%balive*leaf_frac - new_br = EDpftvarcon_inst%allom_l2fr(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + new_br = bfr_per_leaf * (currentcohort%balive + currentcohort%laimemory) * leaf_frac - new_bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite *(currentcohort%balive + & - currentcohort%laimemory)*leaf_frac + new_bsw = bsw_per_leaf * (currentcohort%balive + currentcohort%laimemory) * leaf_frac !diagnose the root and stem biomass from the functional balance hypothesis. This is used when the leaves are !fully on. @@ -271,7 +282,7 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%br = new_br currentcohort%bsw = new_bsw - else ! Leaves are off (leaves_off_switch==1) + else ! Leaves are off (leaves_off_switch==.itrue.) !the purpose of this section is to figure out the root and stem biomass when the leaves are off !at this point, we know the former leaf mass (laimemory) and the current alive mass @@ -280,14 +291,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%allom_l2fr(ft) + & - currentcohort%laimemory* EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite + ideal_balive = currentcohort%laimemory * bfr_per_leaf + currentcohort%laimemory * bsw_per_leaf + ratio_balive = currentcohort%balive / ideal_balive - new_br = EDpftvarcon_inst%allom_l2fr(ft) * (ideal_balive + currentcohort%laimemory) * & - leaf_frac * ratio_balive - new_bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite * & - (ideal_balive + currentcohort%laimemory) * leaf_frac * ratio_balive + new_br = bfr_per_leaf * (ideal_balive + currentcohort%laimemory) * leaf_frac * ratio_balive + + new_bsw = bsw_per_leaf * (ideal_balive + currentcohort%laimemory) * leaf_frac * ratio_balive ! Diagnostics if(mode==1)then diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index b7ab271249..309dfed90c 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -789,7 +789,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) real(r8) :: dhdbd_fn !rate of change of height per unit dbh real(r8) :: va !fraction of growth going to alive biomass real(r8) :: vs !fraction of growth going to structural biomass - real(r8) :: u,h !intermediates + real(r8) :: u real(r8) :: frac !fraction the stored carbon is of target store amount real(r8) :: f_store !fraction of NPP allocated to storage in this timestep (functionf of stored pool) real(r8) :: gr_fract !fraction of carbon balance that is allocated to growth (not reproduction) @@ -1036,7 +1036,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! Tally up the relative change in alive biomass WRT diameter ! These calculations will take into account any height capping ! (if the user wanted it) and its implications to these pools - call bleaf(currentCohort%dbh,currentCohort%hite,ipft, & + call bleaf(currentCohort%dbh,currentCohort%hite,ipft, & currentCohort%canopy_trim,b_leaf,db_leaf_dd) call bfineroot(currentCohort%dbh,currentCohort%hite,ipft, & currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index a76ace2b43..69e0b154e6 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -659,17 +659,21 @@ subroutine d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) real(r8),intent(out),optional :: dblmaxdd ! change leaf bio per diam [kgC/cm] if( d Date: Tue, 17 Oct 2017 15:16:20 -0600 Subject: [PATCH 12/63] added changes to carbon balance check for when in prescribed physiology mode --- biogeochem/EDPhysiologyMod.F90 | 87 +++++++++++++++++++--------------- 1 file changed, 48 insertions(+), 39 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index a145616d5f..3ea17e04f0 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -843,8 +843,10 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) if (hlm_use_ed_prescribed_phys .eq. itrue) then if (currentCohort%canopy_layer .eq. 1) then currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(currentCohort%pft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year ! add these for balance checking purposes else currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(currentCohort%pft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year ! add these for balance checking purposes endif endif @@ -1067,51 +1069,58 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) do ft = 1,numpft - temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded - temp_cohort%pft = ft - temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) - temp_cohort%dbh = Dbh(temp_cohort) - temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & - + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite) - temp_cohort%bstore = EDPftvarcon_inst%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & - + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite)) - - if (hlm_use_ed_prescribed_phys .eq. ifalse) then - temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & - / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) - else - ! prescribed recruitment rates. number per sq. meter per year - temp_cohort%n = currentPatch%area * EDPftvarcon_inst%prescribed_recruitment(ft) * hlm_freq_day - endif + if ( EDpftvarcon_inst%pft_used == itrue ) then + + temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded + temp_cohort%pft = ft + temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) + temp_cohort%dbh = Dbh(temp_cohort) + temp_cohort%bdead = Bdead(temp_cohort) + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & + + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite) + temp_cohort%bstore = EDPftvarcon_inst%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & + + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite)) + + if (hlm_use_ed_prescribed_phys .eq. ifalse .or. EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0. ) then + temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & + / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) + else + ! prescribed recruitment rates. number per sq. meter per year + temp_cohort%n = currentPatch%area * EDPftvarcon_inst%prescribed_recruitment(ft) * hlm_freq_day + ! modify the carbon balance accumulators to take into account the different way of defining recruitment + ! add prescribed rates as an input C flux, and the recruitment that would have otherwise occured as an output flux + ! (since the carbon associated with them effectively vanishes) + currentSite%flux_in = currentSite%flux_in + temp_cohort%n * (temp_cohort%bstore + temp_cohort%balive + temp_cohort%bdead) + currentSite%flux_out = currentSite%flux_out + currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day + endif - temp_cohort%laimemory = 0.0_r8 - if (EDPftvarcon_inst%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & - EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive - endif - if (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & - EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive - endif + temp_cohort%laimemory = 0.0_r8 + if (EDPftvarcon_inst%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive + endif + if (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive + endif - cohortstatus = currentSite%status - if (EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. - cohortstatus = currentSite%dstatus - endif + cohortstatus = currentSite%status + if (EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. + cohortstatus = currentSite%dstatus + endif - if (temp_cohort%n > 0.0_r8 )then - if ( DEBUG ) write(fates_log(),*) 'EDPhysiologyMod.F90 call create_cohort ' - call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & - temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & - bc_in) + if (temp_cohort%n > 0.0_r8 )then + if ( DEBUG ) write(fates_log(),*) 'EDPhysiologyMod.F90 call create_cohort ' + call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & + temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & + bc_in) - ! keep track of how many individuals were recruited for passing to history - currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n + ! keep track of how many individuals were recruited for passing to history + currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n + endif endif - enddo !pft loop deallocate(temp_cohort) ! delete temporary cohort From 39da5360c7d77b4fdb761d6edd4a1036fc077c82 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 17 Oct 2017 15:33:59 -0600 Subject: [PATCH 13/63] bugfix on prior --- biogeochem/EDPhysiologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 3ea17e04f0..dc4de56453 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1069,7 +1069,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) do ft = 1,numpft - if ( EDpftvarcon_inst%pft_used == itrue ) then + if ( EDpftvarcon_inst%pft_used(ft) .eq. itrue ) then temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded temp_cohort%pft = ft From f6054842a7f7c4b995402d69c9b03cf9cb0a78d8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 17 Oct 2017 17:40:18 -0600 Subject: [PATCH 14/63] Shorten lines so can compile with nag compiler on hobart --- biogeochem/EDCohortDynamicsMod.F90 | 27 ++++++++++++++++++--------- biogeochem/EDPatchDynamicsMod.F90 | 6 ++++-- fire/SFMainMod.F90 | 3 ++- main/FatesHistoryInterfaceMod.F90 | 4 ++-- 4 files changed, 26 insertions(+), 14 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 46f297da68..aaed748f21 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -853,18 +853,27 @@ subroutine fuse_cohorts(patchptr, bc_in) currentCohort%fmort = (currentCohort%n*currentCohort%fmort + nextc%n*nextc%fmort)/newn ! npp diagnostics - currentCohort%npp_leaf = (currentCohort%n*currentCohort%npp_leaf + nextc%n*nextc%npp_leaf)/newn - currentCohort%npp_froot = (currentCohort%n*currentCohort%npp_froot + nextc%n*nextc%npp_froot)/newn - currentCohort%npp_bsw = (currentCohort%n*currentCohort%npp_bsw + nextc%n*nextc%npp_bsw)/newn - currentCohort%npp_bdead = (currentCohort%n*currentCohort%npp_bdead + nextc%n*nextc%npp_bdead)/newn - currentCohort%npp_bseed = (currentCohort%n*currentCohort%npp_bseed + nextc%n*nextc%npp_bseed)/newn - currentCohort%npp_store = (currentCohort%n*currentCohort%npp_store + nextc%n*nextc%npp_store)/newn + currentCohort%npp_leaf = (currentCohort%n*currentCohort%npp_leaf + nextc%n*nextc%npp_leaf) & + /newn + currentCohort%npp_froot = (currentCohort%n*currentCohort%npp_froot + nextc%n*nextc%npp_froot) & + /newn + currentCohort%npp_bsw = (currentCohort%n*currentCohort%npp_bsw + nextc%n*nextc%npp_bsw) & + /newn + currentCohort%npp_bdead = (currentCohort%n*currentCohort%npp_bdead + nextc%n*nextc%npp_bdead) & + /newn + currentCohort%npp_bseed = (currentCohort%n*currentCohort%npp_bseed + nextc%n*nextc%npp_bseed) & + /newn + currentCohort%npp_store = (currentCohort%n*currentCohort%npp_store + nextc%n*nextc%npp_store) & + /newn ! biomass and dbh tendencies currentCohort%ddbhdt = (currentCohort%n*currentCohort%ddbhdt + nextc%n*nextc%ddbhdt)/newn - currentCohort%dbalivedt = (currentCohort%n*currentCohort%dbalivedt + nextc%n*nextc%dbalivedt)/newn - currentCohort%dbdeaddt = (currentCohort%n*currentCohort%dbdeaddt + nextc%n*nextc%dbdeaddt)/newn - currentCohort%dbstoredt = (currentCohort%n*currentCohort%dbstoredt + nextc%n*nextc%dbstoredt)/newn + currentCohort%dbalivedt = (currentCohort%n*currentCohort%dbalivedt + nextc%n*nextc%dbalivedt) & + /newn + currentCohort%dbdeaddt = (currentCohort%n*currentCohort%dbdeaddt + nextc%n*nextc%dbdeaddt) & + /newn + currentCohort%dbstoredt = (currentCohort%n*currentCohort%dbstoredt + nextc%n*nextc%dbstoredt) & + /newn do i=1, nlevleaf if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 4bbf6194c1..24da7600b3 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -530,8 +530,10 @@ subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis ! some of their area has been carved out for this new patches which is receiving donations. ! Lets maintain conservation on that pre-existing mass flux in these newly disturbed patches - newPatch%root_litter_out(p) = newPatch%root_litter_out(p) + currentPatch%root_litter_out(p) * patch_site_areadis/newPatch%area - newPatch%leaf_litter_out(p) = newPatch%leaf_litter_out(p) + currentPatch%leaf_litter_out(p) * patch_site_areadis/newPatch%area + newPatch%root_litter_out(p) = newPatch%root_litter_out(p) + currentPatch%root_litter_out(p) * & + patch_site_areadis/newPatch%area + newPatch%leaf_litter_out(p) = newPatch%leaf_litter_out(p) + currentPatch%leaf_litter_out(p) * & + patch_site_areadis/newPatch%area enddo diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 8a5ab94168..8980b3ca0b 100755 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -468,7 +468,8 @@ subroutine rate_of_spread ( currentSite ) if (DEBUG) then if ( hlm_masterproc == itrue .and.DEBUG) write(fates_log(),*) 'SF - c ',c - if ( hlm_masterproc == itrue .and.DEBUG) write(fates_log(),*) 'SF - currentPatch%effect_wspeed ',currentPatch%effect_wspeed + if ( hlm_masterproc == itrue .and.DEBUG) write(fates_log(),*) 'SF - currentPatch%effect_wspeed ', & + currentPatch%effect_wspeed if ( hlm_masterproc == itrue .and.DEBUG) write(fates_log(),*) 'SF - b ',b if ( hlm_masterproc == itrue .and.DEBUG) write(fates_log(),*) 'SF - beta_ratio ',beta_ratio if ( hlm_masterproc == itrue .and.DEBUG) write(fates_log(),*) 'SF - e ',e diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 740955d798..d5509351a4 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2964,8 +2964,8 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scag ) call this%set_history_var(vname='DDBH_CANOPY_SCAG',units = 'cm/yr/ha', & - long='growth rate of canopy plantsnumber of plants per hectare in canopy in each size x age class', use_default='inactive', & - avgflag='A', vtype=site_scag_r8, hlms='CLM:ALM', flushval=0.0_r8, & + long='growth rate of canopy plantsnumber of plants per hectare in canopy in each size x age class', & + use_default='inactive', avgflag='A', vtype=site_scag_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_scag ) call this%set_history_var(vname='DDBH_UNDERSTORY_SCAG',units = 'cm/yr/ha', & From f8cada1f7715fe23a5afca49f0146c98da37166f Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 17 Oct 2017 17:48:58 -0600 Subject: [PATCH 15/63] bug fix to prevent double counting of imort, also a unit error fix on logging mortality carbon fluxes --- main/FatesHistoryInterfaceMod.F90 | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 55166eac8d..b81aff8b9d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1531,10 +1531,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & + ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & - (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra)* ccohort%b * & - ccohort%n * g_per_kg * ha_per_m2 hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n @@ -1582,7 +1581,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n @@ -1604,15 +1603,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort +& + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort +& ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & - ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & - (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%b * & - ccohort%n * g_per_kg * ha_per_m2 - + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & + ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n From ae6c742d0814ba5e16fdec0ae632a5eb5f26b7c2 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 17 Oct 2017 21:43:32 -0600 Subject: [PATCH 16/63] bugfix on prior --- main/FatesHistoryInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index b81aff8b9d..ec0b90d115 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1533,7 +1533,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n From e4c6057f19ea940a3c13a35b4c1a554c36692aa6 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 17 Oct 2017 23:08:33 -0700 Subject: [PATCH 17/63] modular allometry: moved some prep functions to outside the specific functions and into the wrappers, cleaned up some variable definitions, fixed a problem where height was out of sync during alive biomass calculations. --- biogeochem/EDCohortDynamicsMod.F90 | 9 +- biogeochem/EDPhysiologyMod.F90 | 52 +- biogeochem/FatesAllometryMod.F90 | 1651 ++++++++++---------- biogeophys/FatesPlantRespPhotosynthMod.F90 | 23 +- main/EDInitMod.F90 | 2 +- main/EDMainMod.F90 | 4 + main/FatesInventoryInitMod.F90 | 2 +- 7 files changed, 864 insertions(+), 879 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 99c39e1b5b..293c6a8167 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -29,7 +29,10 @@ module EDCohortDynamicsMod use FatesPlantHydraulicsMod, only : InitHydrCohort use FatesPlantHydraulicsMod, only : DeallocateHydrCohort use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index - + use FatesAllometryMod , only : bsap_allom + use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : bfineroot + use FatesAllometryMod , only : h_allom ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -216,6 +219,8 @@ subroutine allocate_live_biomass(cc_p,mode) real(r8) :: bfr_per_leaf ! ratio of fine roots to leaf mass when plants are on allometry real(r8) :: bsw_per_leaf ! ratio of sapwood to leaf mass when plants are on allometry + real(r8) :: temp_h + integer :: ft ! functional type integer :: leaves_off_switch !---------------------------------------------------------------------- @@ -225,7 +230,7 @@ subroutine allocate_live_biomass(cc_p,mode) call bleaf(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_bl) call bfineroot(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_br) - call bsap_allom(currentcohort%dbh,ft,tar_bsw) + call bsap_allom(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_bsw) leaf_frac = tar_bl/(tar_bl+tar_br+tar_bsw) bfr_per_leaf = tar_br/tar_bl diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 309dfed90c..b4ba6e9c73 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -176,7 +176,11 @@ subroutine trim_canopy( currentSite ) type (ed_patch_type) , pointer :: currentPatch integer :: z ! leaf layer + integer :: ipft ! pft index integer :: trimmed ! was this layer trimmed in this year? If not expand the canopy. + real(r8) :: tar_bl ! target leaf biomass (leaves flushed, trimmed) + real(r8) :: tar_bfr ! target fine-root biomass (leaves flushed, trimmed) + real(r8) :: bfr_per_bleaf ! ratio of fine root per leaf biomass !---------------------------------------------------------------------- @@ -186,6 +190,7 @@ subroutine trim_canopy( currentSite ) currentCohort => currentPatch%tallest do while (associated(currentCohort)) trimmed = 0 + ipft = currentCohort%pft currentCohort%treelai = tree_lai(currentCohort) currentCohort%nv = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed) if (currentCohort%nv > nlevleaf)then @@ -193,38 +198,44 @@ subroutine trim_canopy( currentSite ) currentCohort%c_area,currentCohort%n,currentCohort%bl endif + call bleaf(currentcohort%dbh,currentcohort%hite,ipft,currentcohort%canopy_trim,tar_bl) + call bfineroot(currentcohort%dbh,currentcohort%hite,ipft,currentcohort%canopy_trim,tar_bfr) + + bfr_per_bleaf = tar_bfr/tar_bl + !Leaf cost vs netuptake for each leaf layer. do z = 1,nlevleaf if (currentCohort%year_net_uptake(z) /= 999._r8)then !there was activity this year in this leaf layer. !Leaf Cost kgC/m2/year-1 !decidous costs. - if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1.or. & - EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then - currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) + if (EDPftvarcon_inst%season_decid(ipft) == 1.or. & + EDPftvarcon_inst%stress_decid(ipft) == 1)then + + + currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) currentCohort%leaf_cost = currentCohort%leaf_cost + & - 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & - EDPftvarcon_inst%allom_l2fr(currentCohort%pft) / EDPftvarcon_inst%root_long(currentCohort%pft) - currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) + 1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft) + + currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(ipft) + 1._r8) else !evergreen costs - currentCohort%leaf_cost = 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)* & - EDPftvarcon_inst%leaf_long(currentCohort%pft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 + 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(currentCohort%pft)*1000.0_r8) * & - EDPftvarcon_inst%allom_l2fr(currentCohort%pft) / EDPftvarcon_inst%root_long(currentCohort%pft) - currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) + 1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft) + currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(ipft) + 1._r8) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then - if (currentCohort%canopy_trim > EDPftvarcon_inst%trim_limit(currentCohort%pft))then + if (currentCohort%canopy_trim > EDPftvarcon_inst%trim_limit(ipft))then if ( DEBUG ) then write(fates_log(),*) 'trimming leaves',currentCohort%canopy_trim,currentCohort%leaf_cost endif ! keep trimming until none of the canopy is in negative carbon balance. - if (currentCohort%hite > EDPftvarcon_inst%hgt_min(currentCohort%pft))then - currentCohort%canopy_trim = currentCohort%canopy_trim - EDPftvarcon_inst%trim_inc(currentCohort%pft) - if (EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then - currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - EDPftvarcon_inst%trim_inc(currentCohort%pft)) + if (currentCohort%hite > EDPftvarcon_inst%hgt_min(ipft))then + currentCohort%canopy_trim = currentCohort%canopy_trim - EDPftvarcon_inst%trim_inc(ipft) + if (EDPftvarcon_inst%evergreen(ipft) /= 1)then + currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - EDPftvarcon_inst%trim_inc(ipft)) endif trimmed = 1 endif @@ -240,7 +251,7 @@ subroutine trim_canopy( currentSite ) currentCohort%year_net_uptake(:) = 999.0_r8 if (trimmed == 0.and.currentCohort%canopy_trim < 1.0_r8)then - currentCohort%canopy_trim = currentCohort%canopy_trim + EDPftvarcon_inst%trim_inc(currentCohort%pft) + currentCohort%canopy_trim = currentCohort%canopy_trim + EDPftvarcon_inst%trim_inc(ipft) endif if ( DEBUG ) then @@ -869,7 +880,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass - call bsap_allom(currentCohort%dbh,ipft,b_sap) + call bsap_allom(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_sap) target_balive = b_leaf + b_fineroot + b_sap @@ -1040,7 +1051,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%canopy_trim,b_leaf,db_leaf_dd) call bfineroot(currentCohort%dbh,currentCohort%hite,ipft, & currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) - call bsap_allom(currentCohort%dbh,ipft,b_sap,db_sap_dd) + call bsap_allom(currentCohort%dbh,currentCohort%hite,ipft, & + currentCohort%canopy_trim,b_sap,db_sap_dd) ! Total change in alive biomass relative to dead biomass [kgC/kgC] dbalivedbd = (db_leaf_dd + db_fineroot_dd + db_sap_dd)/db_dead_dd @@ -1179,7 +1191,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! Initialize balive (leaf+fineroot+sapwood) call bleaf(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_leaf) call bfineroot(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_fineroot) - call bsap_allom(temp_cohort%dbh,ft,b_sapwood) + call bsap_allom(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_sapwood) temp_cohort%balive = b_leaf + b_sapwood + b_fineroot temp_cohort%bstore = EDPftvarcon_inst%cushion(ft) * b_leaf diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 69e0b154e6..a4b6ac81b0 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -59,9 +59,10 @@ ! ! ! OPEN QUESTIONS: -! SHOULD SAPWOOD ALLOMETRY SUBSUME TRIMMING, OR BE OFF OF BLMAX? -! WHAT IS CONTAINED IN THE AGB POOL? -! UNBOUND CALLS TO BSW,BLEAF and BFR STILL EXIST IN CODE +! SHOULD SAPWOOD ALLOMETRY BE EFFECTED BY TRIMMING, OR BE OFF OF BLMAX? +! WHAT POOLS DO WE ASSUME ARE CONTAINED in AGB ALLOMETRY? +! WE ARE NOT EXTENDING SAPWOOD BELOW GROUND, WE PROBABLY SHOULD +! ! ! Carbon Pool Configurations are as follows, and assume a constant proportionality ! between above and below-ground pools. Sapwood (bsap) is both above and below @@ -219,6 +220,8 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) real(r8),intent(out) :: bag ! plant height [m] real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] + real(r8) :: hj ! height (dummy arg) + real(r8) :: dhdd ! change in height wrt d associate( p1 => EDPftvarcon_inst%allom_agb1(ipft), & p2 => EDPftvarcon_inst%allom_agb2(ipft), & @@ -231,12 +234,14 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) select case(int(allom_amode)) case (1) !"chave14") - call dh2bag_chave2014(d,h,ipft,p1,p2,wood_density,c2b,bag,dbagdd) + call h_allom(d,ipft,hj,dhdd) + call dh2bag_chave2014(d,h,dhdd,p1,p2,wood_density,c2b,bag,dbagdd) case (2) !"2par_pwr") ! Switch for woodland dbh->drc call d2bag_2pwr(d,p1,p2,c2b,bag,dbagdd) case (3) !"salda") - call dh2bag_salda(d,h,ipft,p1,p2,p3,p4,wood_density,c2b,agb_frac,bag,dbagdd) + call h_allom(d,ipft,hj,dhdd) + call dh2bag_salda(d,h,dhdd,p1,p2,p3,p4,wood_density,c2b,agb_frac,bag,dbagdd) case DEFAULT write(fates_log(),*) 'An undefined AGB allometry was specified: ',allom_amode write(fates_log(),*) 'Aborting' @@ -273,7 +278,7 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) case(2) !"2par_pwr") call d2blmax_2pwr(d,p1,p2,c2b,blmax,dblmaxdd) case(3) ! dh2blmax_2pwr - call dh2blmax_2pwr(d,ipft,p1,p2,c2b,blmax,dblmaxdd) + call dh2blmax_2pwr(d,p1,p2,dbh_maxh,c2b,blmax,dblmaxdd) case DEFAULT write(fates_log(),*) 'An undefined leaf allometry was specified: ', & allom_lmode @@ -285,14 +290,14 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) end subroutine blmax_allom ! ===================================================================================== - + subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target bleaf - ! based on trimming and sla scaling. Because trimming + ! based on trimming. Because trimming ! is not allometry and rather an emergent property, - ! this routine is not name-spaces with allom_ + ! this routine is not name-spaced with allom_ ! ------------------------------------------------------------------------- real(r8),intent(in) :: d ! plant diameter [cm] @@ -328,14 +333,15 @@ end subroutine bleaf ! Generic sapwood biomass interface ! ============================================================================ - subroutine bsap_allom(d,ipft,bsap,dbsapdd) + subroutine bsap_allom(d,h,ipft,canopy_trim,bsap,dbsapdd) real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(in) :: canopy_trim real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] real(r8),intent(out),optional :: dbsapdd ! change leaf bio per d [kgC/cm] - real(r8) :: h real(r8) :: dhdd real(r8) :: blmax real(r8) :: dblmaxdd @@ -350,9 +356,9 @@ subroutine bsap_allom(d,ipft,bsap,dbsapdd) ! of the la:sa to diameter line is zero. ! --------------------------------------------------------------------- case(1,2) !"constant","dlinear") - call h_allom(d,ipft,h,dhdd) + if(test_b4b)then - call bleaf(d,h,ipft,blmax,dblmaxdd) + call bleaf(d,h,ipft,canopy_trim,blmax,dblmaxdd) else call blmax_allom(d,h,ipft,blmax,dblmaxdd) end if @@ -553,862 +559,815 @@ end subroutine bcr_const ! ============================================================================ ! Specific d2bsap relationships ! ============================================================================ + subroutine bsap_dlinear(d,h,dhdd,blmax,dblmaxdd,bag,dbagdd,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 + ! of plant size, see Calvo-Alvarado and Bradley Christoferson + ! In this case: parameter latosa (from constant proportionality) + ! is the intercept of the diameter function. + ! + ! For very small plants, the fraction can get very large, so cap the amount + ! of sapwood at X! of agb-bleaf + ! ------------------------------------------------------------------------- + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] + real(r8),intent(in) :: blmax ! plant leaf biomass [kgC] + real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] + real(r8),intent(in) :: bag ! aboveground biomass [kgC] + real(r8),intent(in) :: dbagdd ! change in agb per diam [kgC/cm] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] + real(r8),intent(out),optional :: dbsapdd ! change leaf bio per diameter [kgC/cm] + -! ------------------------------------------------------------------------- -! Calculate sapwood biomass based on leaf area to sapwood area -! proportionality. In this function, the leaftosapwood area is a function -! of plant size, see Calvo-Alvarado and Bradley Christoferson -! In this case: parameter latosa (from constant proportionality) -! is the intercept of the diameter function. -! -! For very small plants, the fraction can get very large, so cap the amount -! of sapwood at X! of agb-bleaf -! ------------------------------------------------------------------------- - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: h ! plant height [m] -real(r8),intent(in) :: dhdd ! change in height per diameter [m/cm] -real(r8),intent(in) :: blmax ! plant leaf biomass [kgC] -real(r8),intent(in) :: dblmaxdd ! change in blmax per diam [kgC/cm] -real(r8),intent(in) :: bag ! aboveground biomass [kgC] -real(r8),intent(in) :: dbagdd ! change in agb per diam [kgC/cm] -integer(i4),intent(in) :: ipft ! PFT index -real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] -real(r8),intent(out),optional :: dbsapdd ! change leaf bio per diameter [kgC/cm] - - -real(r8) :: latosa ! applied leaf area to sap area - ! may or may not contain diameter correction -real(r8) :: hbl2bsap ! sapwood biomass per lineal height and kg of leaf - -! Constrain sapwood to be no larger than 75% of total agb -real(r8),parameter :: max_agbfrac = 0.75_r8 - -associate ( latosa_int => EDPftvarcon_inst%allom_latosa_int(ipft), & - latosa_slp => EDPftvarcon_inst%allom_latosa_slp(ipft), & - sla => EDPftvarcon_inst%slatop(ipft), & - wood_density => EDPftvarcon_inst%wood_density(ipft), & - c2b => EDPftvarcon_inst%c2b(ipft)) - - ! ------------------------------------------------------------------------ - ! Calculate sapwood biomass per linear height and kgC of leaf [m-1] - ! Units: - ! (1/latosa)* slatop* gtokg * cm2tom2 / c2b * mg2kg * dens - ! [cm2/m2]*[m2/gC]*[1000gC/1kgC]*[1m2/10000cm2] /[kg/kgC]*[kg/Mg]*[Mg/m3] - ! ->[cm2/gC] - ! ->[cm2/kgC] - ! ->[m2/kgC] - ! ->[m2/kg] - ! ->[m2/Mg] - ! ->[/m] - ! ------------------------------------------------------------------------ - - if(test_b4b) then - - bsap = blmax * latosa_int * h - - if(present(dbsapdd))then - dbsapdd = latosa_int*(h*dblmaxdd + blmax*dhdd) - end if - - else - - latosa = latosa_int + d*latosa_slp - hbl2bsap = sla*g_per_kg*wood_density*kg_per_Megag/(latosa*c2b*cm2_per_m2 ) - - ! Force sapwood to be less than a maximum fraction of total alive biomass - ! (this comes into play typically in very small plants) - bsap = min(max_agbfrac*bag,hbl2bsap * h * blmax) - - ! Derivative - ! dbldmaxdd is deriv of blmax wrt dbh (use directives to check oop) - ! dhdd is deriv of height wrt dbh (use directives to check oop) - if(present(dbsapdd))then - if (bsap EDPftvarcon_inst%allom_latosa_int(ipft), & + latosa_slp => EDPftvarcon_inst%allom_latosa_slp(ipft), & + sla => EDPftvarcon_inst%slatop(ipft), & + wood_density => EDPftvarcon_inst%wood_density(ipft), & + c2b => EDPftvarcon_inst%c2b(ipft)) + + ! ------------------------------------------------------------------------ + ! Calculate sapwood biomass per linear height and kgC of leaf [m-1] + ! Units: + ! (1/latosa)* slatop* gtokg * cm2tom2 / c2b * mg2kg * dens + ! [cm2/m2]*[m2/gC]*[1000gC/1kgC]*[1m2/10000cm2] /[kg/kgC]*[kg/Mg]*[Mg/m3] + ! ->[cm2/gC] + ! ->[cm2/kgC] + ! ->[m2/kgC] + ! ->[m2/kg] + ! ->[m2/Mg] + ! ->[/m] + ! ------------------------------------------------------------------------ + + if(test_b4b) then + + bsap = blmax * latosa_int * h + + if(present(dbsapdd))then + dbsapdd = latosa_int*(h*dblmaxdd + blmax*dhdd) + end if + else - dblmaxdd = p1*p2 * d**(p2-1.0_r8) * rho**p3 + + latosa = latosa_int + d*latosa_slp + hbl2bsap = sla*g_per_kg*wood_density*kg_per_Megag/(latosa*c2b*cm2_per_m2 ) + + ! Force sapwood to be less than a maximum fraction of total alive biomass + ! (this comes into play typically in very small plants) + bsap = min(max_agbfrac*bag,hbl2bsap * h * blmax) + + ! Derivative + ! dbldmaxdd is deriv of blmax wrt dbh (use directives to check oop) + ! dhdd is deriv of height wrt dbh (use directives to check oop) + if(present(dbsapdd))then + if (bsap0.0_r8) then -dblmaxdd = p1*p2*dbh_eff**(p2-1.0_r8) / c2b * ddeffdd -else -dblmaxdd = 0.0_r8 -end if -end if - -return -end subroutine dh2blmax_2pwr - -! ========================================================================= -! Diameter to height (D2H) functions -! ========================================================================= - -subroutine d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) - - ! "d2h_chave2014" - ! "d to height via Chave et al. 2014" - - ! This function calculates tree height based on tree diameter and the - ! environmental stress factor "E", as per Chave et al. 2015 GCB - ! As opposed to previous allometric models in ED, in this formulation - ! we do not impose a hard cap on tree height. But, maximum_height - ! is an important parameter, but instead of imposing a hard limit, in - ! the new methodology, it will be used to trigger a change in carbon - ! balance accounting. Such that a tree that hits its maximum height will - ! begin to route available NPP into seed and defense respiration. - ! - ! The stress function is based on the geographic location of the site. If - ! a user decides to use Chave2015 allometry, the E factor will be read in - ! from a global gridded dataset and assigned for each ED patch (note it - ! will be the same for each ED patch, but this distinction will help in - ! porting ED into different models (patches are pure ED). It - ! assumes that the site is within the pan-tropics, and is a linear function - ! of climatic water deficit, temperature seasonality and precipitation - ! seasonality. See equation 6b of Chave et al. - ! The relevant equation for height in this function is 6a of the same - ! manuscript, and is intended to pair with diameter to relate with - ! structural biomass as per equation 7 (in which H is implicit). - ! - ! Chave et al. Improved allometric models to estimate the abovegroud - ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. - ! - ! ========================================================================= - - !eclim: Chave's climatological influence parameter "E" - - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: p1 ! parameter a -real(r8),intent(in) :: p2 ! parameter b -real(r8),intent(in) :: p3 ! parameter c -real(r8),intent(in) :: dbh_maxh ! dbh at maximum height [cm] - -real(r8),intent(out) :: h ! plant height [m] -real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] -real(r8) :: p1e - -p1e = p1 ! -eclim (assumed that p1 already has eclim removed) -if(d>=dbh_maxh) then -h = exp( p1e + p2*log(dbh_maxh) + p3*log(dbh_maxh)**2.0 ) -else -h = exp( p1e + p2*log(d) + p3*log(d)**2.0 ) -end if - -if(present(dhdd))then -if(d>=dbh_maxh ) then -dhdd = 0.0_r8 -else -dhdd = exp(p1e) * ( 2.0_r8*p3*d**(p2-1.0_r8+p3*log(d))*log(d) + & - p2*d**(p2-1.0_r8+p3*log(d)) ) -end if -end if -return -end subroutine d2h_chave2014 - -! =========================================================================== - -subroutine d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) - - ! "d2h_poorter2006" - ! "d to height via Poorter et al. 2006, these routines use natively - ! asymtotic functions" - ! - ! Poorter et al calculated height diameter allometries over a variety of - ! species in Bolivia, including those that could be classified in guilds - ! that were Partial-shade-tolerants, long-lived pioneers, shade-tolerants - ! and short-lived pioneers. There results between height and diameter - ! found that small stature trees had less of a tendency to asymotote in - ! height and showed more linear relationships, and the largest stature - ! trees tended to show non-linear relationships that asymtote. - ! - ! h = h_max*(1-exp(-a*d**b)) - ! - ! Poorter L, L Bongers and F Bongers. Architecture of 54 moist-forest tree - ! species: traits, trade-offs, and functional groups. Ecology 87(5), 2006. - ! - ! ========================================================================= - - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: p1 ! parameter a = h_max -real(r8),intent(in) :: p2 ! parameter b -real(r8),intent(in) :: p3 ! parameter c -real(r8),intent(in) :: dbh_maxh ! dbh at maximum height -real(r8),intent(out) :: h ! plant height [m] -real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - -h = p1*(1.0_r8 - exp(p2*min(d,dbh_maxh)**p3)) - -!h = h_max - h_max (exp(a*d**b)) -!f(x) = -h_max*exp(g(x)) -!g(x) = a*d**b -!d/dx f(g(x) = f'(g(x))*g'(x) = -a1*exp(a2*d**a3) * a3*a2*d**(a3-1) - -if(present(dhdd))then -if( d>=dbh_maxh ) then -dhdd = 0.0_r8 -else -dhdd = -p1*exp(p2*d**p3) * p3*p2*d**(p3-1.0_r8) -end if -end if - -return -end subroutine d2h_poorter2006 - -! =========================================================================== - -subroutine d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) - - ! ========================================================================= - ! "d2h_2pwr" - ! "d to height via 2 parameter power function" - ! where height h is related to diameter by a linear relationship on the log - ! transform where log(a) is the intercept and b is the slope parameter. - ! - ! log(h) = log(a) + b*log(d) - ! h = exp(log(a)) * exp(log(d))**b - ! h = a*d**b - ! - ! This functional form is used often in temperate allometries - ! Therefore, no base reference is cited. Although, the reader is pointed - ! towards Dietze et al. 2008, King 1991, Ducey 2012 and many others for - ! reasonable parameters. Note that this subroutine is intended only for - ! trees well below their maximum height, ie initialization. - ! - ! ========================================================================= - ! From King et al. 1990 at BCI for saplings - ! log(d) = a + b*log(h) - ! d = exp(a) * h**b - ! h = (1/exp(a)) * d**(1/b) - ! h = p1*d**p2 where p1 = 1/exp(a) = 1.07293 p2 = 1/b = 1.4925 - ! d = (h/p1)**(1/p2) - ! For T. tuberculata (canopy tree) a = -0.0704, b = 0.67 - ! ========================================================================= - - ! args - ! ========================================================================= - ! d: diameter at breast height - ! p1: the intercept parameter - ! (however exponential of the fitted log trans) - ! p2: the slope parameter - ! return: - ! h: total tree height [m] - ! ========================================================================= - - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: p1 ! parameter a -real(r8),intent(in) :: p2 ! parameter b -real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] -real(r8),intent(out) :: h ! plant height [m] -real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - -h = p1*min(d,dbh_maxh)**p2 - -if(present(dhdd))then -if( d>=dbh_maxh ) then -dhdd = 0.0_r8 -else -dhdd = (p2*p1)*d**(p2-1.0_r8) -end if -end if - -return -end subroutine d2h_2pwr - -! ============================================================================ - -subroutine d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: p1 ! parameter a -real(r8),intent(in) :: p2 ! parameter b -real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] -real(r8),intent(out) :: h ! plant height [m] -real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - -!p1 = 0.64 -!p2 = 0.37 -h = 10.0_r8**(log10(min(d,dbh_maxh))*p1+p2) - -if(present(dhdd))then -if(d>=dbh_maxh ) then -dhdd = 0.0_r8 -else -dhdd = p1*10.0_r8**p2*d**(p1-1.0_r8) -end if -end if - - -return -end subroutine d2h_obrien - -! =========================================================================== - -subroutine d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) - - ! ========================================================================= - ! "d2h_martcano" - ! "d to height via 3 parameter Michaelis-Menten following work at BCI - ! by Martinez-Cano et al. 2016 - ! - ! h = (a*d**b)/(c+d**b) - ! - ! h' = [(a*d**b)'(c+d**b) - (c+d**b)'(a*d**b)]/(c+d**b)**2 - ! dhdd = h' = [(ba*d**(b-1))(c+d**b) - (b*d**(b-1))(a*d**b)]/(c+d**b)**2 - ! - ! args - ! ========================================================================= - ! d: diameter at breast height - ! h: total tree height [m] - ! ========================================================================= - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: p1 ! parameter a -real(r8),intent(in) :: p2 ! parameter b -real(r8),intent(in) :: p3 ! parameter c -real(r8),intent(in) :: dbh_maxh ! diameter at maximum height -real(r8),intent(out) :: h ! plant height [m] -real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] - -h = (p1*min(d,dbh_maxh)**p2)/(p3+min(d,dbh_maxh)**p2) - -if(present(dhdd))then -if(d>=dbh_maxh ) then -dhdd = 0.0 -else -dhdd = ((p2*p1*d**(p2-1._r8))*(p3+d**p2) - & - (p2*d**(p2-1._r8))*(p1*d**p2) )/ & - (p3+d**p2)**2._r8 -end if -end if - -return -end subroutine d2h_martcano - - -! ========================================================================= -! Diameter 2 above-ground biomass -! ========================================================================= - -subroutine dh2bag_chave2014(d,h,ipft,d2bag1,d2bag2,wood_density,c2b,bag,dbagdd) - - ! ========================================================================= - ! This function calculates tree structural biomass from tree diameter, - ! height and wood density. - ! - ! Chave et al. Improved allometric models to estimate the abovegroud - ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. - ! - ! Input arguments: - ! d: Diameter at breast height [cm] - ! rho: wood specific gravity (dry wood mass per green volume) - ! height: total tree height [m] - ! a1: structural biomass allometry parameter 1 (intercept) - ! a2: structural biomass allometry parameter 2 (slope) - ! Output: - ! bag: Total above ground biomass [kgC] - ! - ! ========================================================================= - - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: h ! plant height [m] -integer ,intent(in) :: ipft ! plant pft -real(r8),intent(in) :: d2bag1 ! allometry parameter 1 -real(r8),intent(in) :: d2bag2 ! allometry parameter 2 -real(r8),intent(in) :: wood_density -real(r8),intent(in) :: c2b -real(r8),intent(out) :: bag ! plant height [m] -real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - -real(r8) :: hj,dhdd -real(r8) :: dbagdd1,dbagdd2,dbagdd3 - -bag = (d2bag1 * (wood_density*d**2.0_r8*h)**d2bag2)/c2b - - -if(present(dbagdd))then - ! Need the the derivative of height to diameter to - ! solve the derivative of agb with height -call h_allom(d,ipft,hj,dhdd) - -dbagdd1 = (d2bag1*wood_density**d2bag2)/c2b -dbagdd2 = d2bag2*d**(2.0_r8*d2bag2)*h**(d2bag2-1.0_r8)*dhdd -dbagdd3 = h**d2bag2*2.0_r8*d2bag2*d**(2.0_r8*d2bag2-1.0_r8) -dbagdd = dbagdd1*(dbagdd2 + dbagdd3) -end if - -return -end subroutine dh2bag_chave2014 + end associate + return + end subroutine bsap_dlinear + + ! ============================================================================ + ! Specific d2blmax relationships + ! ============================================================================ + + subroutine d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) -subroutine d2bag_2pwr(d,d2bag1,d2bag2,c2b,bag,dbagdd) + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + real(r8),intent(in) :: p3 + real(r8),intent(in) :: rho ! plant's wood specific gravity + real(r8),intent(in) :: dbh_maxh ! dbh at which max height occurs + real(r8),intent(in) :: c2b ! c to biomass multiplier (~2.0) + + real(r8),intent(out) :: blmax ! plant leaf biomass [kg] + real(r8),intent(out),optional :: dblmaxdd ! change leaf bio per diam [kgC/cm] + + if( d=dbh_maxh)then + dblmaxdd = 0.0_r8 + else + dblmaxdd = p1*p2*d**(p2-1.0_r8) / c2b + end if + end if + + return + end subroutine dh2blmax_2pwr + ! ========================================================================= - ! This function calculates tree above ground biomass according to 2 - ! parameter power functions. (slope and intercepts of a log-log - ! diameter-agb fit: - ! - ! These relationships are typical for temperate/boreal plants in North - ! America. Parameters are available from Chojnacky 2014 and Jenkins 2003 - ! - ! Note that we are using an effective diameter here, as Chojnacky 2014 - ! and Jenkins use diameter at the base of the plant for "woodland" species - ! The diameters should be converted prior to this routine if drc. - ! - ! Input arguments: - ! diam: effective diameter (d or drc) in cm - ! FOR SPECIES THAT EXPECT DCM, THIS NEEDS TO BE PRE-CALCULATED!!!! - ! Output: - ! agb: Total above ground biomass [kgC] - ! - ! ========================================================================= - ! Aceraceae, Betulaceae, Fagaceae and Salicaceae comprised nearly - ! three-fourths of the hardwood species (Table 3) - ! - ! Fabaceae and Juglandaceae had specific gravities .0.60 and were - ! combined, as were Hippocastanaceae and Tilaceae with specific gravities - ! near 0.30. The remaining 9 families, which included mostly species with - ! specific gravity 0.45–0.55, were initially grouped to construct a general - ! hardwood taxon for those families having few published biomass equa- - ! tions however, 3 warranted separation, leaving 6 families for the general - ! taxon. - ! bag = exp(b0 + b1*ln(diameter))/c2b + ! Diameter to height (D2H) functions ! ========================================================================= + + subroutine d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) + + ! "d2h_chave2014" + ! "d to height via Chave et al. 2014" + + ! This function calculates tree height based on tree diameter and the + ! environmental stress factor "E", as per Chave et al. 2015 GCB + ! As opposed to previous allometric models in ED, in this formulation + ! we do not impose a hard cap on tree height. But, maximum_height + ! is an important parameter, but instead of imposing a hard limit, in + ! the new methodology, it will be used to trigger a change in carbon + ! balance accounting. Such that a tree that hits its maximum height will + ! begin to route available NPP into seed and defense respiration. + ! + ! The stress function is based on the geographic location of the site. If + ! a user decides to use Chave2015 allometry, the E factor will be read in + ! from a global gridded dataset and assigned for each ED patch (note it + ! will be the same for each ED patch, but this distinction will help in + ! porting ED into different models (patches are pure ED). It + ! assumes that the site is within the pan-tropics, and is a linear function + ! of climatic water deficit, temperature seasonality and precipitation + ! seasonality. See equation 6b of Chave et al. + ! The relevant equation for height in this function is 6a of the same + ! manuscript, and is intended to pair with diameter to relate with + ! structural biomass as per equation 7 (in which H is implicit). + ! + ! Chave et al. Improved allometric models to estimate the abovegroud + ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. + ! + ! ========================================================================= + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! parameter a + real(r8),intent(in) :: p2 ! parameter b + real(r8),intent(in) :: p3 ! parameter c + real(r8),intent(in) :: dbh_maxh ! dbh at maximum height [cm] + + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + real(r8) :: p1e + + p1e = p1 ! -eclim (assumed that p1 already has eclim removed) + if(d>=dbh_maxh) then + h = exp( p1e + p2*log(dbh_maxh) + p3*log(dbh_maxh)**2.0 ) + else + h = exp( p1e + p2*log(d) + p3*log(d)**2.0 ) + end if + + if(present(dhdd))then + if(d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = exp(p1e) * ( 2.0_r8*p3*d**(p2-1.0_r8+p3*log(d))*log(d) + & + p2*d**(p2-1.0_r8+p3*log(d)) ) + end if + end if + return + end subroutine d2h_chave2014 + ! =========================================================================== + + subroutine d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) + + ! "d2h_poorter2006" + ! "d to height via Poorter et al. 2006, these routines use natively + ! asymtotic functions" + ! + ! Poorter et al calculated height diameter allometries over a variety of + ! species in Bolivia, including those that could be classified in guilds + ! that were Partial-shade-tolerants, long-lived pioneers, shade-tolerants + ! and short-lived pioneers. There results between height and diameter + ! found that small stature trees had less of a tendency to asymotote in + ! height and showed more linear relationships, and the largest stature + ! trees tended to show non-linear relationships that asymtote. + ! + ! h = h_max*(1-exp(-a*d**b)) + ! + ! Poorter L, L Bongers and F Bongers. Architecture of 54 moist-forest tree + ! species: traits, trade-offs, and functional groups. Ecology 87(5), 2006. + ! + ! ========================================================================= + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! parameter a = h_max + real(r8),intent(in) :: p2 ! parameter b + real(r8),intent(in) :: p3 ! parameter c + real(r8),intent(in) :: dbh_maxh ! dbh at maximum height + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + + h = p1*(1.0_r8 - exp(p2*min(d,dbh_maxh)**p3)) + + !h = h_max - h_max (exp(a*d**b)) + !f(x) = -h_max*exp(g(x)) + !g(x) = a*d**b + !d/dx f(g(x) = f'(g(x))*g'(x) = -a1*exp(a2*d**a3) * a3*a2*d**(a3-1) + + if(present(dhdd))then + if( d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = -p1*exp(p2*d**p3) * p3*p2*d**(p3-1.0_r8) + end if + end if -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: d2bag1 ! allometry parameter 1 -real(r8),intent(in) :: d2bag2 ! allometry parameter 2 -real(r8),intent(in) :: c2b ! carbon to biomass multiplier ~2 -real(r8),intent(out) :: bag ! plant height [m] -real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - -bag = (d2bag1 * d**d2bag2)/c2b -if(present(dbagdd))then -dbagdd = (d2bag2*d2bag1*d**(d2bag2-1.0_r8))/c2b -end if - -return -end subroutine d2bag_2pwr - - -subroutine dh2bag_salda(d,h,ipft,d2bag1,d2bag2,d2bag3,d2bag4, & -wood_density,c2b,allom_agb_frac,bag,dbagdd) - - ! -------------------------------------------------------------------- - ! 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 - ! Saldarriaga 1988 provided calculations on total dead biomass - ! So here, we calculate total dead, and then call and remove - ! coarse root and sapwood. We ignore fineroot and leaf - ! in the calculations - ! -------------------------------------------------------------------- - - -real(r8),intent(in) :: d ! plant diameter [cm] -real(r8),intent(in) :: h ! plant height [m] -integer(i4),intent(in) :: ipft ! PFT index -real(r8),intent(in) :: d2bag1 ! = 0.06896_r8 -real(r8),intent(in) :: d2bag2 ! = 0.572_r8 -real(r8),intent(in) :: d2bag3 ! = 1.94_r8 -real(r8),intent(in) :: d2bag4 ! = 0.931_r8 -real(r8),intent(in) :: c2b ! carbon 2 biomass ratio -real(r8),intent(in) :: wood_density -real(r8),intent(in) :: allom_agb_frac - -real(r8),intent(out) :: bag ! plant biomass [kgC/indiv] -real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] - -real(r8) :: term1,term2,term3,hj,dhdd - - -bag = allom_agb_frac*d2bag1*(h**d2bag2)*(d**d2bag3)*(wood_density**d2bag4) - -! Add sapwood calculation to this - -! bag = a1 * h**a2 * d**a3 * r**a4 -! dbag/dd = a1*r**a4 * d/dd (h**a2 * d**a3) -! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] -! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] - -! From code -! dbag/dd = a3 * a1 *(h**a2)*(d**(a3-1))* (r**a4) + a2*a1*(h**(a2-1))*(d**a3)*(r**a4)*dhdd -! dbag/dd = a1*r**a4 * [ d**a3 * a2* h**(a2-1)*dhdd + a3 * (h**a2)*(d**(a3-1)) ] - - -if(present(dbagdd)) then - term1 = allom_agb_frac*d2bag1*(wood_density**d2bag4) - term2 = (h**d2bag2)*d2bag3*d**(d2bag3-1.0_r8) - - call h_allom(d,ipft,hj,dhdd) - term3 = d2bag2*h**(d2bag2-1.0_r8)*(d**d2bag3)*dhdd - dbagdd = term1*(term2+term3) - -end if - -return -end subroutine dh2bag_salda - -! ============================================================================ -! height to diameter conversions -! Note that these conversions will only back-calculate the actual diameter -! for plants that have not started to experience height capping or an -! asymptote. In these cases they may be called effective diameter. -! ============================================================================ - -subroutine h2d_chave2014(h,p1,p2,p3,de,ddedh) - - -real(r8),intent(in) :: h ! plant height [m] -real(r8),intent(in) :: p1 -real(r8),intent(in) :: p2 -real(r8),intent(in) :: p3 - -real(r8),intent(out) :: de ! effective plant diameter [cm] -real(r8),intent(out),optional :: ddedh ! effective change in d per height [cm/m] - -real(r8) :: p1e, eroot, dbh1,dhpdd - -p1e = p1 !-eclim (assumed that p1 already has eclim removed) -eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-p1e))*p3)) & -/(2.0_r8*p3) - -de = exp(eroot) - -if(present(ddedh))then - ! Invert the derivative at d without asymtote -dhpdd = exp(p1e)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & -exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & -exp(p3*log(de)**2.0_r8) ) - -ddedh = 1.0_r8/dhpdd -end if - -! term1 = exp(-p2/(2*p3)) -! term2 = exp(p2**2/(4*p3**2)) -! term3 = exp(-p1e/p3) -! term4 = h**(1/p3-1.0_r8)/(p3) -! d = term1*term2*term3*term4 -return -end subroutine h2d_chave2014 - -! ============================================================================ - -subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) - - ! ------------------------------------------------------------------------- - ! Note that the height to diameter conversion in poorter is only necessary - ! when initializing saplings. In other methods, height to diameter is - ! useful when defining the dbh at which point to asymptote, as maximum - ! height is the user set parameter. This function should not need to set a - ! dbh_max parameter for instance, but it may end up doing so anyway, even - ! if it is not used, do to poor filtering. The poorter et al. d2h and h2d - ! functions are already asymptotic, and the parameter governing maximum - ! height is the p1 parameter. Note as dbh gets very large, the - ! exponential goes to zero, and the maximum height approaches p1. - ! However, the asymptote has a much different shape than the logistic, so - ! therefore in the Poorter et al functions, we do not set p1 == h_max. - ! That being said, if an h_max that is greater than p1 is passed to this - ! function, it will return a complex number. During parameter - ! initialization, a check will be placed that forces: - ! h_max = p1*0.98 - ! ------------------------------------------------------------------------- - -real(r8),intent(in) :: h ! plant height [m] -real(r8),intent(in) :: p1 -real(r8),intent(in) :: p2 -real(r8),intent(in) :: p3 - -real(r8),intent(out) :: d ! plant diameter [cm] -real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] - -! ------------------------------------------------------------------------- -! h = a1*(1 - exp(a2*d**a3)) -! h = a1 - a1*exp(a2*d**a3) -! a1-h = a1*exp(a2*d**a3) -! (a1-h)/a1 = exp(a2*d**a3) -! log(1-h/a1) = a2*d**a3 -! [log(1-h/a1)/a2]**(1/a3) = d -! -! derivative dd/dh -! dd/dh = [log((a1-h)/a1)/a2]**(1/a3)' -! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1)* [(log(a1-h)-log(a1))/a2]' -! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1) * (1/(a2*(h-a1)) -! dd/dh = -((log(1-h/a1)/a2)**(1/a3-1))/(a2*a3*(a1-h)) -! ------------------------------------------------------------------------- - -d = (log(1.0_r8-h/p1)/p2)**(1.0_r8/p3) - -if(present(dddh))then -dddh = -((log(1-h/p1)/p2)**(1.0_r8/p3-1.0_r8))/ & -(p2*p3*(p1-h)) -end if - -return -end subroutine h2d_poorter2006 - -! ============================================================================ - -subroutine h2d_2pwr(h,p1,p2,d,dddh) - - -real(r8),intent(in) :: h ! plant height [m] -real(r8),intent(in) :: p1 ! parameter 1 -real(r8),intent(in) :: p2 ! parameter 2 - -real(r8),intent(out) :: d ! plant diameter [cm] -real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] - -!h = a1*d**a2 -d = (h/p1)**(1.0_r8/p2) - -! d = (1/a1)**(1/a2)*h**(1/a2) -if(present(dddh)) then -dddh = (1.0_r8/p2)*(1.0_r8/p1)**(1.0_r8/p2) & -*h**(1.0_r8/p2-1.0_r8) -end if - -return -end subroutine h2d_2pwr - -! ============================================================================ - -subroutine h2d_obrien(h,p1,p2,d,dddh) - -real(r8),intent(in) :: h ! plant height [m] -real(r8),intent(in) :: p1 -real(r8),intent(in) :: p2 - -real(r8),intent(out) :: d ! plant diameter [cm] -real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] - -d = 10.0_r8**((log10(h)-p2)/p1) - -if(present(dddh))then -dddh = 1.0_r8/(p1*10.0_r8**p2*d**(p1-1.0_r8)) -end if - -return -end subroutine h2d_obrien - -! ============================================================================ - -subroutine h2d_martcano(h,p1,p2,p3,d,dddh) + return + end subroutine d2h_poorter2006 + ! =========================================================================== + + subroutine d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) + + ! ========================================================================= + ! "d2h_2pwr" + ! "d to height via 2 parameter power function" + ! where height h is related to diameter by a linear relationship on the log + ! transform where log(a) is the intercept and b is the slope parameter. + ! + ! log(h) = log(a) + b*log(d) + ! h = exp(log(a)) * exp(log(d))**b + ! h = a*d**b + ! + ! This functional form is used often in temperate allometries + ! Therefore, no base reference is cited. Although, the reader is pointed + ! towards Dietze et al. 2008, King 1991, Ducey 2012 and many others for + ! reasonable parameters. Note that this subroutine is intended only for + ! trees well below their maximum height, ie initialization. + ! + ! ========================================================================= + ! From King et al. 1990 at BCI for saplings + ! log(d) = a + b*log(h) + ! d = exp(a) * h**b + ! h = (1/exp(a)) * d**(1/b) + ! h = p1*d**p2 where p1 = 1/exp(a) = 1.07293 p2 = 1/b = 1.4925 + ! d = (h/p1)**(1/p2) + ! For T. tuberculata (canopy tree) a = -0.0704, b = 0.67 + ! ========================================================================= + + ! args + ! ========================================================================= + ! d: diameter at breast height + ! p1: the intercept parameter + ! (however exponential of the fitted log trans) + ! p2: the slope parameter + ! return: + ! h: total tree height [m] + ! ========================================================================= + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! parameter a + real(r8),intent(in) :: p2 ! parameter b + real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + + h = p1*min(d,dbh_maxh)**p2 + + if(present(dhdd))then + if( d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = (p2*p1)*d**(p2-1.0_r8) + end if + end if + + return + end subroutine d2h_2pwr + + ! ============================================================================ + + subroutine d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! parameter a + real(r8),intent(in) :: p2 ! parameter b + real(r8),intent(in) :: dbh_maxh ! dbh where max height occurs [cm] + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + + !p1 = 0.64 + !p2 = 0.37 + h = 10.0_r8**(log10(min(d,dbh_maxh))*p1+p2) + + if(present(dhdd))then + if(d>=dbh_maxh ) then + dhdd = 0.0_r8 + else + dhdd = p1*10.0_r8**p2*d**(p1-1.0_r8) + end if + end if + + + return + end subroutine d2h_obrien + + ! =========================================================================== + + subroutine d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) + + ! ========================================================================= + ! "d2h_martcano" + ! "d to height via 3 parameter Michaelis-Menten following work at BCI + ! by Martinez-Cano et al. 2016 + ! + ! h = (a*d**b)/(c+d**b) + ! + ! h' = [(a*d**b)'(c+d**b) - (c+d**b)'(a*d**b)]/(c+d**b)**2 + ! dhdd = h' = [(ba*d**(b-1))(c+d**b) - (b*d**(b-1))(a*d**b)]/(c+d**b)**2 + ! + ! args + ! ========================================================================= + ! d: diameter at breast height + ! h: total tree height [m] + ! ========================================================================= + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! parameter a + real(r8),intent(in) :: p2 ! parameter b + real(r8),intent(in) :: p3 ! parameter c + real(r8),intent(in) :: dbh_maxh ! diameter at maximum height + real(r8),intent(out) :: h ! plant height [m] + real(r8),intent(out),optional :: dhdd ! change in height per diameter [m/cm] + + h = (p1*min(d,dbh_maxh)**p2)/(p3+min(d,dbh_maxh)**p2) + + if(present(dhdd))then + if(d>=dbh_maxh ) then + dhdd = 0.0 + else + dhdd = ((p2*p1*d**(p2-1._r8))*(p3+d**p2) - & + (p2*d**(p2-1._r8))*(p1*d**p2) )/ & + (p3+d**p2)**2._r8 + end if + end if + + return + end subroutine d2h_martcano + + ! ========================================================================= - ! "d2h_martcano" - ! "d to height via 3 parameter Michaelis-Menten following work at BCI - ! by Martinez-Cano et al. 2016 - ! - ! h = (a*d**b)/(c+d**b) - ! - ! d = [(h*c)/(a-h)]**(1/b) - ! d = [(h*c)**(1/b)] / [(a-h)**(1/b)] - ! d' = {[(h*c)**(1/b)]' [(a-h)**(1/b)] - [(a-h)**(1/b)]'[(h*c)**(1/b)]} / - ! [(a-h)**(1/b)]**2 - ! dddh = d' = {[(1/b)(h*c)**(1/b-1)] [(a-h)**(1/b)] - - ! [(1/b)(a-h)**(1/b-1)] [(h*c)**(1/b)]} / - ! [(a-h)**(1/b)]**2 - ! + ! Diameter to (2) above-ground biomass ! ========================================================================= + + subroutine dh2bag_chave2014(d,h,dhdd,p1,p2,wood_density,c2b,bag,dbagdd) + + ! ========================================================================= + ! This function calculates tree structural biomass from tree diameter, + ! height and wood density. + ! + ! Chave et al. Improved allometric models to estimate the abovegroud + ! biomass of tropical trees. Global Change Biology. V20, p3177-3190. 2015. + ! + ! Input arguments: + ! d: Diameter at breast height [cm] + ! rho: wood specific gravity (dry wood mass per green volume) + ! height: total tree height [m] + ! a1: structural biomass allometry parameter 1 (intercept) + ! a2: structural biomass allometry parameter 2 (slope) + ! Output: + ! bag: Total above ground biomass [kgC] + ! + ! ========================================================================= + + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: dhdd ! change in height wrt diameter + real(r8),intent(in) :: p1 ! allometry parameter 1 + real(r8),intent(in) :: p2 ! allometry parameter 2 + real(r8),intent(in) :: wood_density + real(r8),intent(in) :: c2b + real(r8),intent(out) :: bag ! plant height [m] + real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] + + real(r8) :: dbagdd1,dbagdd2,dbagdd3 + + bag = (p1 * (wood_density*d**2.0_r8*h)**p2)/c2b + + + if(present(dbagdd))then + ! Need the the derivative of height to diameter to + ! solve the derivative of agb with height + dbagdd1 = (p1*wood_density**p2)/c2b + dbagdd2 = p2*d**(2.0_r8*p2)*h**(p2-1.0_r8)*dhdd + dbagdd3 = h**p2*2.0_r8*p2*d**(2.0_r8*p2-1.0_r8) + dbagdd = dbagdd1*(dbagdd2 + dbagdd3) + end if + + return + end subroutine dh2bag_chave2014 + + subroutine d2bag_2pwr(d,p1,p2,c2b,bag,dbagdd) + + ! ========================================================================= + ! This function calculates tree above ground biomass according to 2 + ! parameter power functions. (slope and intercepts of a log-log + ! diameter-agb fit: + ! + ! These relationships are typical for temperate/boreal plants in North + ! America. Parameters are available from Chojnacky 2014 and Jenkins 2003 + ! + ! Note that we are using an effective diameter here, as Chojnacky 2014 + ! and Jenkins use diameter at the base of the plant for "woodland" species + ! The diameters should be converted prior to this routine if drc. + ! + ! Input arguments: + ! diam: effective diameter (d or drc) in cm + ! FOR SPECIES THAT EXPECT DCM, THIS NEEDS TO BE PRE-CALCULATED!!!! + ! Output: + ! agb: Total above ground biomass [kgC] + ! + ! ========================================================================= + ! Aceraceae, Betulaceae, Fagaceae and Salicaceae comprised nearly + ! three-fourths of the hardwood species (Table 3) + ! + ! Fabaceae and Juglandaceae had specific gravities .0.60 and were + ! combined, as were Hippocastanaceae and Tilaceae with specific gravities + ! near 0.30. The remaining 9 families, which included mostly species with + ! specific gravity 0.45–0.55, were initially grouped to construct a general + ! hardwood taxon for those families having few published biomass equa- + ! tions however, 3 warranted separation, leaving 6 families for the general + ! taxon. + ! bag = exp(b0 + b1*ln(diameter))/c2b + ! ========================================================================= -real(r8),intent(in) :: h ! plant height [m] -real(r8),intent(in) :: p1 -real(r8),intent(in) :: p2 -real(r8),intent(in) :: p3 - -real(r8),intent(out) :: d ! plant diameter [cm] -real(r8),intent(out),optional :: dddh ! change in diameter per height [cm/m] - -d = ((h*p3)/(p1-h))**(1._r8/p2) - -if(present(dddh))then -dddh = (((1._r8/p2)*(h*p3)**(1._r8/p2-1._r8))*((p1-h)**(1._r8/p2)) - & -((1._r8/p2)*(p1-h)**(1._r8/p2-1._r8))* ((h*p3)**(1._r8/p2)) ) / & -((p1-h)**(1._r8/p2))**2._r8 -end if -return -end subroutine h2d_martcano + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: p1 ! allometry parameter 1 + real(r8),intent(in) :: p2 ! allometry parameter 2 + real(r8),intent(in) :: c2b ! carbon to biomass multiplier ~2 + real(r8),intent(out) :: bag ! plant height [m] + real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] + + bag = (p1 * d**p2)/c2b + if(present(dbagdd))then + dbagdd = (p2*p1*d**(p2-1.0_r8))/c2b + end if + + return + end subroutine d2bag_2pwr + + + subroutine dh2bag_salda(d,h,dhdd,p1,p2,p3,p4, & + wood_density,c2b,allom_agb_frac,bag,dbagdd) + + ! -------------------------------------------------------------------- + ! 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 + ! Saldarriaga 1988 provided calculations on total dead biomass + ! So here, we calculate total dead, and then remove the below-ground + ! fraction + ! -------------------------------------------------------------------- + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: dhdd ! change in height wrt diameter + real(r8),intent(in) :: p1 ! = 0.06896_r8 + real(r8),intent(in) :: p2 ! = 0.572_r8 + real(r8),intent(in) :: p3 ! = 1.94_r8 + real(r8),intent(in) :: p4 ! = 0.931_r8 + real(r8),intent(in) :: c2b ! carbon 2 biomass ratio + real(r8),intent(in) :: wood_density + real(r8),intent(in) :: allom_agb_frac + real(r8),intent(out) :: bag ! plant biomass [kgC/indiv] + real(r8),intent(out),optional :: dbagdd ! change in agb per diameter [kgC/cm] + + real(r8) :: term1,term2,term3 + + + bag = allom_agb_frac*p1*(h**p2)*(d**p3)*(wood_density**p4) -! =========================================================================== + ! Add sapwood calculation to this? + + ! bag = a1 * h**a2 * d**a3 * r**a4 + ! dbag/dd = a1*r**a4 * d/dd (h**a2 * d**a3) + ! dbag/dd = a1*r**a4 * [ d**a3 *d/dd(h**a2) + h**a2*d/dd(d**a3) ] + ! dbag/dd = a1*r**a4 * [ d**a3 * a2*h**(a2-1)dh/dd + h**a2*a3*d**(a3-1)] + + ! From code + ! dbag/dd = a3 * a1 *(h**a2)*(d**(a3-1))* (r**a4) + a2*a1*(h**(a2-1))*(d**a3)*(r**a4)*dhdd + ! dbag/dd = a1*r**a4 * [ d**a3 * a2* h**(a2-1)*dhdd + a3 * (h**a2)*(d**(a3-1)) ] + + + if(present(dbagdd)) then -subroutine cspline(x1,x2,y1,y2,dydx1,dydx2,x,y,dydx) + term1 = allom_agb_frac*p1*(wood_density**p4) + term2 = (h**p2)*p3*d**(p3-1.0_r8) + term3 = p2*h**(p2-1.0_r8)*(d**p3)*dhdd + dbagdd = term1*(term2+term3) + + end if + return + end subroutine dh2bag_salda + ! ============================================================================ - ! This subroutine performs a cubic spline interpolation between known - ! endpoints. The endpoints have known coordinats and slopes + ! height to diameter conversions + ! Note that these conversions will only back-calculate the actual diameter + ! for plants that have not started to experience height capping or an + ! asymptote. In these cases they may be called effective diameter. ! ============================================================================ - ! Arguments - -real(r8),intent(in) :: x1 ! Lower endpoint independent -real(r8),intent(in) :: x2 ! Upper endpoint independent -real(r8),intent(in) :: y1 ! Lower endpoint dependent -real(r8),intent(in) :: y2 ! Upper endpoint dependent -real(r8),intent(in) :: dydx1 ! Lower endpoint slope -real(r8),intent(in) :: dydx2 ! Upper endpoint slope -real(r8),intent(in) :: x ! Independent -real(r8),intent(out) :: y ! Dependent -real(r8),intent(out) :: dydx ! Slope - -! Temps -real(r8) :: t -real(r8) :: a -real(r8) :: b - -t = (x-x1)/(x2-x1) -a = dydx1*(x2-x1) - (y2-y1) -b = -dydx2*(x2-x1) + (y2-y1) - -y = (1.0_r8-t)*y1 + t*y2 + t*(1.0_r8-t)*(a*(1.0_r8-t) + b*t) -dydx = (y2-y1)/(x2-x1) + (1.0_r8-2.0_r8*t)*(a*(1.0_r8-t)+b*t)/(x2-x1) + t*(1.0_r8-t)*(b-a)/(x2-x1) -return -end subroutine cspline + subroutine h2d_chave2014(h,p1,p2,p3,de,ddedh) + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + real(r8),intent(in) :: p3 + + real(r8),intent(out) :: de ! effective plant diameter [cm] + real(r8),intent(out),optional :: ddedh ! effective change in d per height [cm/m] + + real(r8) :: p1e, eroot, dbh1,dhpdd + + p1e = p1 !-eclim (assumed that p1 already has eclim removed) + eroot = (-p2 + sqrt(p2**2.0_r8 + 4.0_r8*log(h*exp(-p1e))*p3)) & + /(2.0_r8*p3) + + de = exp(eroot) + + if(present(ddedh))then + ! Invert the derivative at d without asymtote + dhpdd = exp(p1e)*( p3*2.0_r8*de**(p2-1.0_r8)*log(de)* & + exp(p3*log(de)**2) + p2*de**(p2-1.0_r8)* & + exp(p3*log(de)**2.0_r8) ) + + ddedh = 1.0_r8/dhpdd + end if + + ! term1 = exp(-p2/(2*p3)) + ! term2 = exp(p2**2/(4*p3**2)) + ! term3 = exp(-p1e/p3) + ! term4 = h**(1/p3-1.0_r8)/(p3) + ! d = term1*term2*term3*term4 + return + end subroutine h2d_chave2014 + + ! ============================================================================ + + subroutine h2d_poorter2006(h,p1,p2,p3,d,dddh) + + ! ------------------------------------------------------------------------- + ! Note that the height to diameter conversion in poorter is only necessary + ! when initializing saplings. In other methods, height to diameter is + ! useful when defining the dbh at which point to asymptote, as maximum + ! height is the user set parameter. This function should not need to set a + ! dbh_max parameter for instance, but it may end up doing so anyway, even + ! if it is not used, do to poor filtering. The poorter et al. d2h and h2d + ! functions are already asymptotic, and the parameter governing maximum + ! height is the p1 parameter. Note as dbh gets very large, the + ! exponential goes to zero, and the maximum height approaches p1. + ! However, the asymptote has a much different shape than the logistic, so + ! therefore in the Poorter et al functions, we do not set p1 == h_max. + ! That being said, if an h_max that is greater than p1 is passed to this + ! function, it will return a complex number. During parameter + ! initialization, a check will be placed that forces: + ! h_max = p1*0.98 + ! ------------------------------------------------------------------------- + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + real(r8),intent(in) :: p3 + + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] + + ! ------------------------------------------------------------------------- + ! h = a1*(1 - exp(a2*d**a3)) + ! h = a1 - a1*exp(a2*d**a3) + ! a1-h = a1*exp(a2*d**a3) + ! (a1-h)/a1 = exp(a2*d**a3) + ! log(1-h/a1) = a2*d**a3 + ! [log(1-h/a1)/a2]**(1/a3) = d + ! + ! derivative dd/dh + ! dd/dh = [log((a1-h)/a1)/a2]**(1/a3)' + ! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1)* [(log(a1-h)-log(a1))/a2]' + ! = (1/a3)*[log((a1-h)/a1)/a2]**(1/a3-1) * (1/(a2*(h-a1)) + ! dd/dh = -((log(1-h/a1)/a2)**(1/a3-1))/(a2*a3*(a1-h)) + ! ------------------------------------------------------------------------- + + d = (log(1.0_r8-h/p1)/p2)**(1.0_r8/p3) + + if(present(dddh))then + dddh = -((log(1-h/p1)/p2)**(1.0_r8/p3-1.0_r8))/ & + (p2*p3*(p1-h)) + end if + + return + end subroutine h2d_poorter2006 + + ! ============================================================================ + + subroutine h2d_2pwr(h,p1,p2,d,dddh) + + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 ! parameter 1 + real(r8),intent(in) :: p2 ! parameter 2 + + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] + + !h = a1*d**a2 + d = (h/p1)**(1.0_r8/p2) + + ! d = (1/a1)**(1/a2)*h**(1/a2) + if(present(dddh)) then + dddh = (1.0_r8/p2)*(1.0_r8/p1)**(1.0_r8/p2) & + *h**(1.0_r8/p2-1.0_r8) + end if + + return + end subroutine h2d_2pwr + + ! ============================================================================ + + subroutine h2d_obrien(h,p1,p2,d,dddh) + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out),optional :: dddh ! change in d per height [cm/m] + + d = 10.0_r8**((log10(h)-p2)/p1) + + if(present(dddh))then + dddh = 1.0_r8/(p1*10.0_r8**p2*d**(p1-1.0_r8)) + end if + + return + end subroutine h2d_obrien + + ! ============================================================================ + + subroutine h2d_martcano(h,p1,p2,p3,d,dddh) + + ! ========================================================================= + ! "d2h_martcano" + ! "d to height via 3 parameter Michaelis-Menten following work at BCI + ! by Martinez-Cano et al. 2016 + ! + ! h = (a*d**b)/(c+d**b) + ! + ! d = [(h*c)/(a-h)]**(1/b) + ! d = [(h*c)**(1/b)] / [(a-h)**(1/b)] + ! d' = {[(h*c)**(1/b)]' [(a-h)**(1/b)] - [(a-h)**(1/b)]'[(h*c)**(1/b)]} / + ! [(a-h)**(1/b)]**2 + ! dddh = d' = {[(1/b)(h*c)**(1/b-1)] [(a-h)**(1/b)] - + ! [(1/b)(a-h)**(1/b-1)] [(h*c)**(1/b)]} / + ! [(a-h)**(1/b)]**2 + ! + ! ========================================================================= + + real(r8),intent(in) :: h ! plant height [m] + real(r8),intent(in) :: p1 + real(r8),intent(in) :: p2 + real(r8),intent(in) :: p3 + + real(r8),intent(out) :: d ! plant diameter [cm] + real(r8),intent(out),optional :: dddh ! change in diameter per height [cm/m] + + d = ((h*p3)/(p1-h))**(1._r8/p2) + + if(present(dddh))then + dddh = (((1._r8/p2)*(h*p3)**(1._r8/p2-1._r8))*((p1-h)**(1._r8/p2)) - & + ((1._r8/p2)*(p1-h)**(1._r8/p2-1._r8))* ((h*p3)**(1._r8/p2)) ) / & + ((p1-h)**(1._r8/p2))**2._r8 + end if + return + end subroutine h2d_martcano + + ! =========================================================================== + + subroutine cspline(x1,x2,y1,y2,dydx1,dydx2,x,y,dydx) + + ! ============================================================================ + ! This subroutine performs a cubic spline interpolation between known + ! endpoints. The endpoints have known coordinats and slopes + ! + ! This routine may come in handy if we ever want to start using allometries + ! that are different for juvenile and adult plants, and then connect + ! the curves smoothly + ! + ! ============================================================================ + + ! Arguments + + real(r8),intent(in) :: x1 ! Lower endpoint independent + real(r8),intent(in) :: x2 ! Upper endpoint independent + real(r8),intent(in) :: y1 ! Lower endpoint dependent + real(r8),intent(in) :: y2 ! Upper endpoint dependent + real(r8),intent(in) :: dydx1 ! Lower endpoint slope + real(r8),intent(in) :: dydx2 ! Upper endpoint slope + real(r8),intent(in) :: x ! Independent + real(r8),intent(out) :: y ! Dependent + real(r8),intent(out) :: dydx ! Slope + + ! Temps + real(r8) :: t + real(r8) :: a + real(r8) :: b + + t = (x-x1)/(x2-x1) + a = dydx1*(x2-x1) - (y2-y1) + b = -dydx2*(x2-x1) + (y2-y1) + + y = (1.0_r8-t)*y1 + t*y2 + t*(1.0_r8-t)*(a*(1.0_r8-t) + b*t) + dydx = (y2-y1)/(x2-x1) + (1.0_r8-2.0_r8*t)*(a*(1.0_r8-t)+b*t)/(x2-x1) + t*(1.0_r8-t)*(b-a)/(x2-x1) + return + end subroutine cspline + end module FatesAllometryMod diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 0cfd778323..2154e20352 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -193,6 +193,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! ----------------------------------------------------------------------------------- real(r8), dimension(2) :: bbbopt + logical, parameter :: test_b4b = .true. ! Leave in place some questionable allometry + ! while modular allometry is being introduce + ! to preserve results with previous release + associate( & c3psn => EDPftvarcon_inst%c3psn , & @@ -493,15 +497,16 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! fine root pools. ! ------------------------------------------------------------------ - leaf_frac = 1.0_r8/(currentCohort%canopy_trim + & - EDPftvarcon_inst%allom_latosa_int(currentCohort%pft) * & - currentCohort%hite + EDPftvarcon_inst%allom_l2fr(currentCohort%pft)) - - - currentCohort%bsw = EDPftvarcon_inst%allom_latosa_int(currentCohort%pft) * & - currentCohort%hite * & - (currentCohort%balive + currentCohort%laimemory)*leaf_frac - + if(test_b4b)then + leaf_frac = 1.0_r8/(currentCohort%canopy_trim + & + EDPftvarcon_inst%allom_latosa_int(currentCohort%pft) * & + currentCohort%hite + EDPftvarcon_inst%allom_l2fr(currentCohort%pft)) + + + currentCohort%bsw = EDPftvarcon_inst%allom_latosa_int(currentCohort%pft) * & + currentCohort%hite * & + (currentCohort%balive + currentCohort%laimemory)*leaf_frac + end if ! Calculate the amount of nitrogen in the above and below ground ! stem and root pools, used for maint resp diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 2081bc69f7..c181f09b6d 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -381,7 +381,7 @@ subroutine init_cohorts( patch_in, bc_in) call bfineroot(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,pft,b_sapwood) + call bsap_allom(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_sapwood) temp_cohort%balive = b_leaf + b_fineroot + b_sapwood diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 6fa2970d0d..fda5fdb544 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -42,6 +42,7 @@ module EDMainMod use EDTypesMod , only : do_ed_phenology use EDTypesMod , only : AREA use FatesConstantsMod , only : itrue,ifalse + use FatesAllometryMod , only : h_allom use FatesPlantHydraulicsMod , only : do_growthrecruiteffects use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydProps use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydStates @@ -271,6 +272,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentCohort%dbh = max(small_no,currentCohort%dbh + currentCohort%ddbhdt * hlm_freq_day ) currentCohort%balive = currentCohort%balive + currentCohort%dbalivedt * hlm_freq_day currentCohort%bdead = max(small_no,currentCohort%bdead + currentCohort%dbdeaddt * hlm_freq_day ) +! call h_allom(currentcohort%dbh,currentCohort%pft,currentCohort%hite) + if ( DEBUG ) then write(fates_log(),*) 'EDMainMod dbstoredt I ',currentCohort%bstore, & currentCohort%dbstoredt,hlm_freq_day @@ -298,6 +301,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentCohort%gpp_acc = 0.0_r8 currentCohort%resp_acc = 0.0_r8 + call allocate_live_biomass(currentCohort,1) ! BOC...update tree 'hydraulic geometry' diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 9104b4b874..9df0be9168 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -888,7 +888,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call bfineroot(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,c_pft,b_sapwood) + call bsap_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_sapwood) temp_cohort%balive = b_leaf + b_fineroot + b_sapwood From 01de09d860f82cd6ef0e256ad319fdedc9050e41 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 18 Oct 2017 13:23:55 -0700 Subject: [PATCH 18/63] Changed order/indexing of allometry modules. --- biogeochem/FatesAllometryMod.F90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index a4b6ac81b0..6167024a1f 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -148,14 +148,14 @@ subroutine h2d_allom(h,ipft,d,dddh) allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) select case(int(allom_hmode)) - case (1) ! chave 2014 - call h2d_chave2014(h,p1,p2,p3,d,dddh) + case (1) ! Obrien et al. 199X BCI + call h2d_obrien(h,p1,p2,d,dddh) case (2) ! poorter 2006 call h2d_poorter2006(h,p1,p2,p3,d,dddh) case (3) ! 2 parameter power function call h2d_2pwr(h,p1,p2,d,dddh) - case (4) ! Obrien et al. 199X BCI - call h2d_obrien(h,p1,p2,d,dddh) + case (4) ! chave 2014 + call h2d_chave2014(h,p1,p2,p3,d,dddh) case (5) ! Martinez-Cano call h2d_martcano(h,p1,p2,p3,d,dddh) case DEFAULT @@ -187,14 +187,14 @@ subroutine h_allom(d,ipft,h,dhdd) allom_hmode => EDPftvarcon_inst%allom_hmode(ipft)) select case(int(allom_hmode)) - case (1) ! "chave14") - call d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) + case (1) ! "obrien" + call d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) case (2) ! "poorter06" call d2h_poorter2006(d,p1,p2,p3,dbh_maxh,h,dhdd) case (3) ! "2parameter power function h=a*d^b " call d2h_2pwr(d,p1,p2,dbh_maxh,h,dhdd) - case (4) ! "obrien" - call d2h_obrien(d,p1,p2,dbh_maxh,h,dhdd) + case (4) ! "chave14") + call d2h_chave2014(d,p1,p2,p3,dbh_maxh,h,dhdd) case (5) ! Martinez-Cano call d2h_martcano(d,p1,p2,p3,dbh_maxh,h,dhdd) case DEFAULT @@ -233,15 +233,15 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) allom_amode => EDPftvarcon_inst%allom_amode(ipft)) select case(int(allom_amode)) - case (1) !"chave14") + case (1) !"salda") call h_allom(d,ipft,hj,dhdd) - call dh2bag_chave2014(d,h,dhdd,p1,p2,wood_density,c2b,bag,dbagdd) + call dh2bag_salda(d,h,dhdd,p1,p2,p3,p4,wood_density,c2b,agb_frac,bag,dbagdd) case (2) !"2par_pwr") ! Switch for woodland dbh->drc call d2bag_2pwr(d,p1,p2,c2b,bag,dbagdd) - case (3) !"salda") + case (3) !"chave14") call h_allom(d,ipft,hj,dhdd) - call dh2bag_salda(d,h,dhdd,p1,p2,p3,p4,wood_density,c2b,agb_frac,bag,dbagdd) + call dh2bag_chave2014(d,h,dhdd,p1,p2,wood_density,c2b,bag,dbagdd) case DEFAULT write(fates_log(),*) 'An undefined AGB allometry was specified: ',allom_amode write(fates_log(),*) 'Aborting' @@ -470,7 +470,7 @@ subroutine bdead_allom(bag,bcr,bsap,ipft,bdead,dbagdd,dbcrdd,dbsapdd,dbdeaddd) associate( agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft)) select case(int(EDPftvarcon_inst%allom_amode(ipft))) - case(3) ! Saldariagga mass allometry originally calculated bdead directly. + case(1) ! Saldariagga mass allometry originally calculated bdead directly. ! we assume proportionality between bdead and bag bdead = bag/agb_fraction @@ -478,7 +478,7 @@ subroutine bdead_allom(bag,bcr,bsap,ipft,bdead,dbagdd,dbcrdd,dbsapdd,dbdeaddd) dbdeaddd = dbagdd/agb_fraction end if - case(1,2) + case(2,3) bdead = bag+bcr-bsap if(present(dbagdd) .and. present(dbcrdd) .and. & From 5258bf0e457a4189dcd5ae2813fd356aae733c00 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 18 Oct 2017 13:25:28 -0700 Subject: [PATCH 19/63] removed commented code --- main/EDMainMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index fda5fdb544..9e92f3180e 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -42,7 +42,6 @@ module EDMainMod use EDTypesMod , only : do_ed_phenology use EDTypesMod , only : AREA use FatesConstantsMod , only : itrue,ifalse - use FatesAllometryMod , only : h_allom use FatesPlantHydraulicsMod , only : do_growthrecruiteffects use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydProps use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydStates @@ -272,7 +271,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentCohort%dbh = max(small_no,currentCohort%dbh + currentCohort%ddbhdt * hlm_freq_day ) currentCohort%balive = currentCohort%balive + currentCohort%dbalivedt * hlm_freq_day currentCohort%bdead = max(small_no,currentCohort%bdead + currentCohort%dbdeaddt * hlm_freq_day ) -! call h_allom(currentcohort%dbh,currentCohort%pft,currentCohort%hite) if ( DEBUG ) then write(fates_log(),*) 'EDMainMod dbstoredt I ',currentCohort%bstore, & From d3f1bfdf5eade913fb341d80fe19a5789b20a07a Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 18 Oct 2017 17:03:43 -0600 Subject: [PATCH 20/63] removed conditional canopy level logic around litter fluxes --- biogeochem/EDPhysiologyMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index dc4de56453..f24266acea 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1181,7 +1181,7 @@ subroutine CWD_Input( currentSite, currentPatch) SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *(1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) enddo - if (currentCohort%canopy_layer > 1)then + !if (currentCohort%canopy_layer > 1)then ! ================================================ ! Litter fluxes for understorey mortality. KgC/m2/year @@ -1280,7 +1280,7 @@ subroutine CWD_Input( currentSite, currentPatch) currentSite%resources_management%delta_individual + & (dead_n_dlogging+dead_n_ilogging) * hlm_freq_day * currentPatch%area - endif !canopy layer + !endif !canopy layer currentCohort => currentCohort%taller enddo ! end loop over cohorts From 0ebf3d885096db9d3d630afdab8ede72cf5c2605 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 19 Oct 2017 22:17:53 -0600 Subject: [PATCH 21/63] added site-level diagnstic tracking variable to handle imort issues --- biogeochem/EDPatchDynamicsMod.F90 | 18 ++++++- biogeochem/EDPhysiologyMod.F90 | 89 +++++++++++++++---------------- main/EDInitMod.F90 | 3 ++ main/EDTypesMod.F90 | 2 + main/FatesHistoryInterfaceMod.F90 | 36 ++++++++----- 5 files changed, 87 insertions(+), 61 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c5a5025bbc..587550751f 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -31,6 +31,10 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_litter_fluxes use EDLoggingMortalityMod, only : logging_time use EDParamsMod , only : fates_mortality_disturbance_fraction + use FatesConstantsMod , only : g_per_kg + use FatesConstantsMod , only : ha_per_m2 + use FatesConstantsMod , only : days_per_sec + use FatesConstantsMod , only : years_per_day ! CIME globals @@ -414,7 +418,18 @@ subroutine spawn_patches( currentSite, bc_in) ! The number density per square are doesn't change, but since the patch is smaller ! and cohort counts are absolute, reduce this number. nc%n = currentCohort%n * patch_site_areadis/currentPatch%area - + + ! because the mortality rate due to impact for the cohorts which had been in the understory and are now in the newly- + ! disturbed patch is very high, passing the imort directly to history results in large numerical errors, on account + ! of the sharply reduced number densities. so instead pass this info via a site-level diagnostic variable before reducing + ! the number density. + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) = & + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & + nc%n * ED_val_understorey_death / hlm_freq_day + currentSite%imort_carbonflux = currentSite%imort_carbonflux + & + (nc%n * ED_val_understorey_death / hlm_freq_day ) * & + currentCohort%b * currentCohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + ! Step 2: Apply survivor ship function based on the understory death fraction ! remaining of understory plants of those that are knocked over by the overstorey trees dying... nc%n = nc%n * (1.0_r8 - ED_val_understorey_death) @@ -443,6 +458,7 @@ subroutine spawn_patches( currentSite, bc_in) ! Besides, the current and newly created patch sum to unity currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + else ! grass is not killed by mortality disturbance events. Just move it into the new patch area. ! Just split the grass into the existing and new patch structures diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index f24266acea..4752963b78 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1069,57 +1069,54 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) do ft = 1,numpft - if ( EDpftvarcon_inst%pft_used(ft) .eq. itrue ) then - - temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded - temp_cohort%pft = ft - temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) - temp_cohort%dbh = Dbh(temp_cohort) - temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & - + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite) - temp_cohort%bstore = EDPftvarcon_inst%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & - + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite)) - - if (hlm_use_ed_prescribed_phys .eq. ifalse .or. EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0. ) then - temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & - / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) - else - ! prescribed recruitment rates. number per sq. meter per year - temp_cohort%n = currentPatch%area * EDPftvarcon_inst%prescribed_recruitment(ft) * hlm_freq_day - ! modify the carbon balance accumulators to take into account the different way of defining recruitment - ! add prescribed rates as an input C flux, and the recruitment that would have otherwise occured as an output flux - ! (since the carbon associated with them effectively vanishes) - currentSite%flux_in = currentSite%flux_in + temp_cohort%n * (temp_cohort%bstore + temp_cohort%balive + temp_cohort%bdead) - currentSite%flux_out = currentSite%flux_out + currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day - endif + temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded + temp_cohort%pft = ft + temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) + temp_cohort%dbh = Dbh(temp_cohort) + temp_cohort%bdead = Bdead(temp_cohort) + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & + + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite) + temp_cohort%bstore = EDPftvarcon_inst%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & + + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite)) + + if (hlm_use_ed_prescribed_phys .eq. ifalse .or. EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0. ) then + temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & + / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) + else + ! prescribed recruitment rates. number per sq. meter per year + temp_cohort%n = currentPatch%area * EDPftvarcon_inst%prescribed_recruitment(ft) * hlm_freq_day + ! modify the carbon balance accumulators to take into account the different way of defining recruitment + ! add prescribed rates as an input C flux, and the recruitment that would have otherwise occured as an output flux + ! (since the carbon associated with them effectively vanishes) + currentSite%flux_in = currentSite%flux_in + temp_cohort%n * (temp_cohort%bstore + temp_cohort%balive + temp_cohort%bdead) + currentSite%flux_out = currentSite%flux_out + currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day + endif - temp_cohort%laimemory = 0.0_r8 - if (EDPftvarcon_inst%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & - EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive - endif - if (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & - EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive - endif + temp_cohort%laimemory = 0.0_r8 + if (EDPftvarcon_inst%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive + endif + if (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive + endif - cohortstatus = currentSite%status - if (EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. - cohortstatus = currentSite%dstatus - endif + cohortstatus = currentSite%status + if (EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. + cohortstatus = currentSite%dstatus + endif - if (temp_cohort%n > 0.0_r8 )then - if ( DEBUG ) write(fates_log(),*) 'EDPhysiologyMod.F90 call create_cohort ' - call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & - temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & - bc_in) + if (temp_cohort%n > 0.0_r8 )then + if ( DEBUG ) write(fates_log(),*) 'EDPhysiologyMod.F90 call create_cohort ' + call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & + temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & + bc_in) - ! keep track of how many individuals were recruited for passing to history - currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n + ! keep track of how many individuals were recruited for passing to history + currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n - endif endif enddo !pft loop diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 085aee9f10..a7a7a34e5f 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -64,6 +64,7 @@ subroutine init_site_vars( site_in ) allocate(site_in%terminated_nindivs(1:nlevsclass,1:numpft,2)) allocate(site_in%demotion_rate(1:nlevsclass)) allocate(site_in%promotion_rate(1:nlevsclass)) + allocate(site_in%imort_rate(1:nlevsclass,1:numpft)) ! end subroutine init_site_vars @@ -115,6 +116,8 @@ subroutine zero_site( site_in ) site_in%terminated_nindivs(:,:,:) = 0._r8 site_in%termination_carbonflux(:) = 0._r8 site_in%recruitment_rate(:) = 0._r8 + site_in%imort_rate(:,:) = 0._r8 + site_in%imort_carbonflux = 0._r8 ! demotion/promotion info site_in%demotion_rate(:) = 0._r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 82265c093c..461c828d15 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -540,6 +540,8 @@ module EDTypesMod real(r8) :: demotion_carbonflux ! biomass of demoted individuals from canopy to understory [kgC/ha/day] real(r8), allocatable :: promotion_rate(:) ! rate of individuals promoted from understory to canopy per FATES timestep real(r8) :: promotion_carbonflux ! biomass of promoted individuals from understory to canopy [kgC/ha/day] + real(r8), allocatable :: imort_rate(:,:) ! rate of individuals killed due to impact mortality per year. on size x pft array + real(r8) :: imort_carbonflux ! biomass of individuals killed due to impact mortality per year. [kgC/ha/day] ! some diagnostic-only (i.e. not resolved by ODE solver) flux of carbon to CWD and litter pools from termination and canopy mortality real(r8) :: CWD_AG_diagnostic_input_carbonflux(1:ncwd) ! diagnostic flux to AG CWD [kg C / m2 / yr] diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index ec0b90d115..2a9d834bbc 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1503,10 +1503,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg !hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & - ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n + ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * ccohort%n hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort+ & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort+ & ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + ccohort%n @@ -1578,7 +1578,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bl * ccohort%n hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg !hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & - ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n + ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * ccohort%n hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & @@ -1644,17 +1644,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%canopy_layer_yesterday * ccohort%n endif ! - ! consider imort as understory mortality even if it happens in - ! cohorts that may have been promoted as part of the patch creation... - hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & - (ccohort%imort) * ccohort%n - hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & - (ccohort%imort) * ccohort%n - hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & - (ccohort%imort) * & - ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - hio_mortality_understory_si_scag(io_si,iscag) = hio_mortality_understory_si_scag(io_si,iscag) + & - (ccohort%imort) * ccohort%n ! ccohort%canopy_layer_yesterday = real(ccohort%canopy_layer, r8) @@ -1767,9 +1756,28 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%terminated_nindivs(i_scls,i_pft,1) * days_per_year hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf) + & sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year + ! + ! consider imort as understory mortality even if it happens in + ! cohorts that may have been promoted as part of the patch creation, and use the pre-calculated site-level + ! values to avoid biasing the results by the dramatically-reduced number densities in cohorts that are subject to imort + hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf)+ & + sites(s)%imort_rate(i_scls, i_pft) + hio_mortality_understory_si_scls(io_si,i_scls) = hio_mortality_understory_si_scls(io_si,i_scls) + & + sites(s)%imort_rate(i_scls, i_pft) + ! + iscag = i_scls ! since imort is by definition something that only happens in newly disturbed patches, treat as such + hio_mortality_understory_si_scag(io_si,iscag) = hio_mortality_understory_si_scag(io_si,iscag) + & + sites(s)%imort_rate(i_scls, i_pft) end do end do + ! + ! treat carbon flux from imort the same way + hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & + sites(s)%imort_carbonflux + ! sites(s)%terminated_nindivs(:,:,:) = 0._r8 + sites(s)%imort_carbonflux = 0._r8 + sites(s)%imort_rate(:,:) = 0._r8 ! pass the recruitment rate as a flux to the history, and then reset the recruitment buffer do i_pft = 1, numpft From 1983285812d8193f611a00634a8d81d191397982 Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 20 Oct 2017 14:58:49 -0600 Subject: [PATCH 22/63] fixed carbon balance error bug when fates_mort_disturb_frac set to other than one, and also a unit error in imort_carbonflux calc --- biogeochem/EDPatchDynamicsMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 587550751f..032d922fcc 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -428,7 +428,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%n * ED_val_understorey_death / hlm_freq_day currentSite%imort_carbonflux = currentSite%imort_carbonflux + & (nc%n * ED_val_understorey_death / hlm_freq_day ) * & - currentCohort%b * currentCohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + currentCohort%b * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! Step 2: Apply survivor ship function based on the understory death fraction ! remaining of understory plants of those that are knocked over by the overstorey trees dying... @@ -1006,7 +1006,7 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat !currentCohort%dmort = mortality_rates(currentCohort) !the disturbance calculations are done with the previous n, c_area and d_mort. So it's probably & !not right to recalcualte dmort here. - canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * hlm_freq_day) + canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * hlm_freq_day * fates_mortality_disturbance_fraction) canopy_mortality_woody_litter = canopy_mortality_woody_litter + & canopy_dead*(currentCohort%bdead+currentCohort%bsw) From 5c735036a3d8c0eb572901f744caa088c5ac8bdb Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 20 Oct 2017 16:25:57 -0600 Subject: [PATCH 23/63] fixed unit issue between normal and logging mortality in history fields --- main/FatesHistoryInterfaceMod.F90 | 39 ++++++++++++++++++------------- 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 2a9d834bbc..c62887b533 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1505,9 +1505,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) !hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * ccohort%n - hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort+ & - ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n + hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * ccohort%n + & + (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year + hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + ccohort%n hio_nplant_canopy_si_scls(io_si,scls) = hio_nplant_canopy_si_scls(io_si,scls) + ccohort%n @@ -1527,14 +1529,16 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_canopy_si_scls(io_si,scls) = hio_mortality_canopy_si_scls(io_si,scls) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & - ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort ) * ccohort%n + & + (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & - ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * & + ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra)* ccohort%b * & + ccohort%n * g_per_kg * ha_per_m2 + hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n hio_root_md_canopy_si_scls(io_si,scls) = hio_root_md_canopy_si_scls(io_si,scls) + & @@ -1581,8 +1585,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * ccohort%n hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & - ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort ) * ccohort%n + & + (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + ccohort%n @@ -1603,13 +1608,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! sum of all mortality hio_mortality_understory_si_scls(io_si,scls) = hio_mortality_understory_si_scls(io_si,scls) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort +& - ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort ) * ccohort%n + & + (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & + ccohort%n * sec_per_day * days_per_year hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + & - ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & - ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & + ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%b * & + ccohort%n * g_per_kg * ha_per_m2 ! hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n From e00d559191f0da69727d85caddbec91dbd19f3b2 Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 20 Oct 2017 16:28:29 -0600 Subject: [PATCH 24/63] fixed another bug that crept into last one --- main/FatesHistoryInterfaceMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index c62887b533..b6e0d72e5c 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1613,10 +1613,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%n * sec_per_day * days_per_year hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & - ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & - (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%b * & - ccohort%n * g_per_kg * ha_per_m2 + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * & + ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & + (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%b * & + ccohort%n * g_per_kg * ha_per_m2 ! hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n From 0ce94baf35210e54e0284b8b8b6d7541cb7445c6 Mon Sep 17 00:00:00 2001 From: ckoven Date: Mon, 23 Oct 2017 23:27:12 -0600 Subject: [PATCH 25/63] got rid of cohort%imort term entirely and also added site-level imort diagnostic to logging mortality --- biogeochem/EDCohortDynamicsMod.F90 | 2 -- biogeochem/EDPatchDynamicsMod.F90 | 20 +++++++++++--------- main/EDMainMod.F90 | 1 - main/EDTypesMod.F90 | 2 -- main/FatesHistoryInterfaceMod.F90 | 6 ++++-- main/FatesRestartInterfaceMod.F90 | 10 ---------- 6 files changed, 15 insertions(+), 26 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 89c96b8b3a..9adfa3d1a6 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -863,7 +863,6 @@ subroutine fuse_cohorts(patchptr, bc_in) currentCohort%cmort = (currentCohort%n*currentCohort%cmort + nextc%n*nextc%cmort)/newn currentCohort%hmort = (currentCohort%n*currentCohort%hmort + nextc%n*nextc%hmort)/newn currentCohort%bmort = (currentCohort%n*currentCohort%bmort + nextc%n*nextc%bmort)/newn - currentCohort%imort = (currentCohort%n*currentCohort%imort + nextc%n*nextc%imort)/newn currentCohort%fmort = (currentCohort%n*currentCohort%fmort + nextc%n*nextc%fmort)/newn ! logging mortality, Yi Xu @@ -1245,7 +1244,6 @@ subroutine copy_cohort( currentCohort,copyc ) ! Mortality diagnostics n%cmort = o%cmort n%bmort = o%bmort - n%imort = o%imort n%fmort = o%fmort n%hmort = o%hmort diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 032d922fcc..fb1e6d2835 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -121,7 +121,6 @@ subroutine disturbance_rates( site_in) currentCohort%cmort = cmort currentCohort%bmort = bmort currentCohort%hmort = hmort - currentCohort%imort = 0.0_r8 ! Impact mortality is always zero except in new patches currentCohort%fmort = 0.0_r8 ! Fire mortality is initialized as zero, but may be changed call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, & @@ -203,7 +202,6 @@ subroutine disturbance_rates( site_in) currentCohort%hmort = currentCohort%hmort*(1.0_r8 - fates_mortality_disturbance_fraction) currentCohort%bmort = currentCohort%bmort*(1.0_r8 - fates_mortality_disturbance_fraction) currentCohort%dmort = currentCohort%dmort*(1.0_r8 - fates_mortality_disturbance_fraction) - ! currentCohort%imort will likely exist with logging end if currentCohort => currentCohort%taller enddo !currentCohort @@ -403,7 +401,6 @@ subroutine spawn_patches( currentSite, bc_in) nc%hmort = nan nc%bmort = nan nc%fmort = nan - nc%imort = nan nc%lmort_logging = nan nc%lmort_collateral = nan nc%lmort_infra = nan @@ -443,7 +440,6 @@ subroutine spawn_patches( currentSite, bc_in) ! so with the number density must come the effective mortality rates. nc%fmort = 0.0_r8 ! Should had also been zero in the donor - nc%imort = ED_val_understorey_death/hlm_freq_day ! This was zero in the donor nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort @@ -468,7 +464,6 @@ subroutine spawn_patches( currentSite, bc_in) currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) nc%fmort = 0.0_r8 - nc%imort = 0.0_r8 nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort @@ -494,7 +489,6 @@ subroutine spawn_patches( currentSite, bc_in) nc%n = nc%n * (1.0_r8 - currentCohort%fire_mort) nc%fmort = currentCohort%fire_mort/hlm_freq_day - nc%imort = 0.0_r8 nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort @@ -524,7 +518,6 @@ subroutine spawn_patches( currentSite, bc_in) nc%hmort = nan nc%bmort = nan nc%fmort = nan - nc%imort = nan nc%lmort_logging = nan nc%lmort_collateral = nan nc%lmort_infra = nan @@ -542,6 +535,17 @@ subroutine spawn_patches( currentSite, bc_in) ! The number density per square are doesn't change, but since the patch is smaller ! and cohort counts are absolute, reduce this number. nc%n = currentCohort%n * patch_site_areadis/currentPatch%area + + ! because the mortality rate due to impact for the cohorts which had been in the understory and are now in the newly- + ! disturbed patch is very high, passing the imort directly to history results in large numerical errors, on account + ! of the sharply reduced number densities. so instead pass this info via a site-level diagnostic variable before reducing + ! the number density. + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) = & + currentSite%imort_rate(currentCohort%size_class, currentCohort%pft) + & + nc%n * ED_val_understorey_death / hlm_freq_day + currentSite%imort_carbonflux = currentSite%imort_carbonflux + & + (nc%n * ED_val_understorey_death / hlm_freq_day ) * & + currentCohort%b * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! Step 2: Apply survivor ship function based on the understory death fraction @@ -556,7 +560,6 @@ subroutine spawn_patches( currentSite, bc_in) nc%fmort = 0.0_r8 - nc%imort = ED_val_understorey_death/hlm_freq_day nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort @@ -576,7 +579,6 @@ subroutine spawn_patches( currentSite, bc_in) ! No grass impact mortality imposed on the newly created patch nc%fmort = 0.0_r8 - nc%imort = 0.0_r8 nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 6fa2970d0d..dc3a7fd9f5 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -609,7 +609,6 @@ subroutine bypass_dynamics(currentSite) currentCohort%bmort = 0.0_r8 currentCohort%hmort = 0.0_r8 currentCohort%cmort = 0.0_r8 - currentCohort%imort = 0.0_r8 currentCohort%fmort = 0.0_r8 currentCohort => currentCohort%taller diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 461c828d15..05e0775205 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -226,7 +226,6 @@ module EDTypesMod real(r8) :: bmort ! background mortality rate n/year real(r8) :: cmort ! carbon starvation mortality rate n/year real(r8) :: hmort ! hydraulic failure mortality rate n/year - real(r8) :: imort ! mortality from impacts by others n/year real(r8) :: fmort ! fire mortality n/year ! Logging Mortality Rate @@ -745,7 +744,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%woody_turnover = ', ccohort%woody_turnover write(fates_log(),*) 'co%cmort = ', ccohort%cmort write(fates_log(),*) 'co%bmort = ', ccohort%bmort - write(fates_log(),*) 'co%imort = ', ccohort%imort write(fates_log(),*) 'co%fmort = ', ccohort%fmort write(fates_log(),*) 'co%hmort = ', ccohort%hmort write(fates_log(),*) 'co%isnew = ', ccohort%isnew diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index b6e0d72e5c..f08032e65e 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1459,7 +1459,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*ccohort%n hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*ccohort%n hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*ccohort%n - hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + ccohort%imort*ccohort%n hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*ccohort%n @@ -1764,7 +1763,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf) + & sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year ! - ! consider imort as understory mortality even if it happens in + ! imort on its own + hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + sites(s)%imort_rate(i_scls, i_pft) + ! + ! add imort to other mortality terms. consider imort as understory mortality even if it happens in ! cohorts that may have been promoted as part of the patch creation, and use the pre-calculated site-level ! values to avoid biasing the results by the dramatically-reduced number densities in cohorts that are subject to imort hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf)+ & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 44ac2ea58f..5f2247614f 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -98,7 +98,6 @@ module FatesRestartInterfaceMod integer, private :: ir_bmort_co integer, private :: ir_hmort_co integer, private :: ir_cmort_co - integer, private :: ir_imort_co integer, private :: ir_fmort_co !Logging @@ -739,11 +738,6 @@ subroutine define_restart_vars(this, initialize_variables) units='/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cmort_co ) - call this%set_restart_var(vname='fates_imort', vtype=cohort_r8, & - long_name='ed cohort - impact mortality rate', & - units='/year', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_imort_co ) - call this%set_restart_var(vname='fates_fmort', vtype=cohort_r8, & long_name='ed cohort - frost mortality rate', & units='/year', flushval = flushzero, & @@ -1060,7 +1054,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & - rio_imort_co => this%rvars(ir_imort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & @@ -1182,7 +1175,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_bmort_co(io_idx_co) = ccohort%bmort rio_hmort_co(io_idx_co) = ccohort%hmort rio_cmort_co(io_idx_co) = ccohort%cmort - rio_imort_co(io_idx_co) = ccohort%imort rio_fmort_co(io_idx_co) = ccohort%fmort !Logging @@ -1644,7 +1636,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & - rio_imort_co => this%rvars(ir_imort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & rio_lmort_logging_co => this%rvars(ir_lmort_logging_co)%r81d, & @@ -1749,7 +1740,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%bmort = rio_bmort_co(io_idx_co) ccohort%hmort = rio_hmort_co(io_idx_co) ccohort%cmort = rio_cmort_co(io_idx_co) - ccohort%imort = rio_imort_co(io_idx_co) ccohort%fmort = rio_fmort_co(io_idx_co) !Logging From 4640b858101097b1f8f619abb0495c2c7e29147f Mon Sep 17 00:00:00 2001 From: ckoven Date: Mon, 23 Oct 2017 23:39:49 -0600 Subject: [PATCH 26/63] bugfix on prior --- main/FatesHistoryInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index f08032e65e..85ff7b6a54 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1764,7 +1764,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year ! ! imort on its own - hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + sites(s)%imort_rate(i_scls, i_pft) + hio_m4_si_scpf(io_si,i_scpf) = hio_m4_si_scpf(io_si,i_scpf) + sites(s)%imort_rate(i_scls, i_pft) ! ! add imort to other mortality terms. consider imort as understory mortality even if it happens in ! cohorts that may have been promoted as part of the patch creation, and use the pre-calculated site-level From c773d19817b58eec983a31ca7785d0135044cddd Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 Oct 2017 15:50:40 -0700 Subject: [PATCH 27/63] Moved c_area to modular allometry scheme. --- biogeochem/EDCanopyStructureMod.F90 | 49 +++++++------- biogeochem/EDCohortDynamicsMod.F90 | 6 +- biogeochem/EDGrowthFunctionsMod.F90 | 57 +---------------- biogeochem/EDLoggingMortalityMod.F90 | 5 +- biogeochem/EDPatchDynamicsMod.F90 | 12 ++-- biogeochem/EDPhysiologyMod.F90 | 6 +- biogeochem/FatesAllometryMod.F90 | 95 +++++++++++++++++++++++++++- 7 files changed, 137 insertions(+), 93 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 9c769255a4..35be33f68e 100755 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -8,7 +8,7 @@ module EDCanopyStructureMod use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : fates_log use EDPftvarcon , only : EDPftvarcon_inst - use EDGrowthFunctionsMod , only : c_area + use FatesAllometryMod , only : carea_allom use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd use EDTypesMod , only : nclmax @@ -317,7 +317,9 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) rankordered_area_sofar = 0.0_r8 currentCohort => currentPatch%tallest do while (associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) + + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + if(arealayer > currentPatch%area.and.currentCohort%canopy_layer == i_lyr)then if (ED_val_comp_excln .ge. 0.0_r8 ) then ! normal (stochastic) case. weight cohort demotion by inverse size to a constant power @@ -443,9 +445,10 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) currentCohort%n = 0.0_r8 currentCohort%c_area = 0._r8 else - currentCohort%c_area = c_area(currentCohort) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) endif - copyc%c_area = c_area(copyc) + + call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft,copyc%c_area) !----------- Insert copy into linked list ------------------------! @@ -517,7 +520,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) currentCohort%c_area = 0._r8 else - currentCohort%c_area = c_area(currentCohort) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) endif endif ! matches: if (cc_loss < currentCohort%c_area)then @@ -619,8 +622,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) do while (associated(currentCohort)) if(currentCohort%canopy_layer == i_lyr+1)then !look at the cohorts in the canopy layer below... currentCohort%canopy_layer = i_lyr - currentCohort%c_area = c_area(currentCohort) - + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(currentCohort%size_class) = & currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n @@ -639,7 +641,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! This is the opposite of the demotion weighting... currentCohort => currentPatch%tallest do while (associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) if(currentCohort%canopy_layer == i_lyr+1)then !look at the cohorts in the canopy layer below... if (ED_val_comp_excln .ge. 0.0_r8 ) then ! normal (stochastic) case, as above. @@ -720,8 +722,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentCohort%dbh = currentCohort%dbh - 0.000000000001_r8 copyc%dbh = copyc%dbh + 0.000000000001_r8 - currentCohort%c_area = c_area(currentCohort) - copyc%c_area = c_area(copyc) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + call carea_allom(copyc%dbh,copyc%n,currentSite%spread,copyc%pft,copyc%c_area) !----------- Insert copy into linked list ------------------------! copyc%shorter => currentCohort @@ -738,8 +740,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! update area AFTER we sum up the losses. the cohort may shrink at this point, ! if the upper canopy spread is smaller. this shold be dealt with by the 'excess area' loop. - currentCohort%c_area = c_area(currentCohort) - + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(currentCohort%size_class) = & currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n @@ -826,7 +828,7 @@ subroutine canopy_spread( currentSite ) !calculate canopy area in each patch... currentCohort => currentPatch%tallest do while (associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) if(EDPftvarcon_inst%woody(currentCohort%pft) .eq. 1 .and. currentCohort%canopy_layer .eq. 1 ) then sitelevel_canopyarea = sitelevel_canopyarea + currentCohort%c_area endif @@ -862,7 +864,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use EDPatchDynamicsMod , only : set_patchno use EDPatchDynamicsMod , only : set_root_fraction use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index - use EDGrowthFunctionsMod , only : tree_lai, c_area + use EDGrowthFunctionsMod , only : tree_lai use EDtypesMod , only : area use EDPftvarcon , only : EDPftvarcon_inst @@ -921,9 +923,9 @@ subroutine canopy_summarization( nsites, sites, bc_in ) currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore + call carea_allom(currentCohort%dbh,currentCohort%n,sites(s)%spread,currentCohort%pft,currentCohort%c_area) currentCohort%treelai = tree_lai(currentCohort) - - currentCohort%c_area = c_area(currentCohort) + canopy_leaf_area = canopy_leaf_area + currentCohort%treelai *currentCohort%c_area if(currentCohort%canopy_layer==1)then @@ -976,7 +978,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! ! !USES: - use EDGrowthFunctionsMod , only : tree_lai, tree_sai, c_area + use EDGrowthFunctionsMod , only : tree_lai, tree_sai use EDtypesMod , only : area, dinc_ed, hitemax, n_hite_bins ! @@ -1026,8 +1028,8 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) currentPatch%canopy_layer_lai(:) = 0._r8 NC = 0 currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) + do while(associated(currentCohort)) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) currentPatch%canopy_area = currentPatch%canopy_area + currentCohort%c_area NC = NC+1 currentCohort => currentCohort%taller @@ -1594,8 +1596,8 @@ subroutine CanopyLayerArea(currentPatch,layer_index,layer_area) layer_area = 0.0_r8 currentCohort => currentPatch%tallest - do while (associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) ! Reassess cohort area. + do while (associated(currentCohort)) + call carea_allom(currentCohort%dbh,currentCohort%n,currentPatch%siteptr%spread,currentCohort%pft,currentCohort%c_area) if (currentCohort%canopy_layer .eq. layer_index) then layer_area = layer_area + currentCohort%c_area end if @@ -1623,7 +1625,7 @@ function NumPotentialCanopyLayers(currentPatch,include_substory) result(z) type(ed_cohort_type),pointer :: currentCohort integer :: z - + real(r8) :: c_area real(r8) :: arealayer z = 1 @@ -1638,7 +1640,8 @@ function NumPotentialCanopyLayers(currentPatch,include_substory) result(z) currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == z) then - arealayer = arealayer + c_area(currentCohort) + call carea_allom(currentCohort%dbh,currentCohort%n,currentPatch%siteptr%spread,currentCohort%pft,c_area) + arealayer = arealayer + c_area end if currentCohort => currentCohort%shorter enddo diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 293c6a8167..6f9316ca3d 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -13,7 +13,7 @@ module EDCohortDynamicsMod use FatesConstantsMod , only : itrue,ifalse use FatesInterfaceMod , only : hlm_days_per_year use EDPftvarcon , only : EDPftvarcon_inst - use EDGrowthFunctionsMod , only : c_area, tree_lai + use EDGrowthFunctionsMod , only : tree_lai use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax use EDTypesMod , only : ncwd @@ -33,6 +33,7 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : h_allom + use FatesAllometryMod , only : carea_allom ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -146,7 +147,8 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & call allocate_live_biomass(new_cohort,0) ! Assign canopy extent and depth - new_cohort%c_area = c_area(new_cohort) + call carea_allom(new_cohort%dbh,new_cohort%n,new_cohort%siteptr%spread,new_cohort%pft,new_cohort%c_area) + new_cohort%treelai = tree_lai(new_cohort) new_cohort%lai = new_cohort%treelai * new_cohort%c_area/patchptr%area new_cohort%treesai = 0.0_r8 !FIX(RF,032414) diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index 0da6dd36e5..fbb08730b3 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -18,7 +18,6 @@ module EDGrowthFunctionsMod public :: tree_lai public :: tree_sai - public :: c_area public :: mortality_rates logical :: DEBUG_growth = .false. @@ -46,7 +45,6 @@ real(r8) function tree_lai( cohort_in ) if( cohort_in%status_coh == 2 ) then ! are the leaves on? slat = 1000.0_r8 * EDPftvarcon_inst%slatop(cohort_in%pft) ! m2/g to m2/kg - cohort_in%c_area = c_area(cohort_in) ! call the tree area leafc_per_unitarea = cohort_in%bl/(cohort_in%c_area/cohort_in%n) !KgC/m2 if(leafc_per_unitarea > 0.0_r8)then tree_lai = leafc_per_unitarea * slat !kg/m2 * m2/kg = unitless LAI @@ -88,7 +86,6 @@ real(r8) function tree_sai( cohort_in ) write(fates_log(),*) 'problem in treesai',cohort_in%bdead,cohort_in%pft endif - cohort_in%c_area = c_area(cohort_in) ! call the tree area bdead_per_unitarea = cohort_in%bdead/(cohort_in%c_area/cohort_in%n) !KgC/m2 tree_sai = bdead_per_unitarea * sai_scaler !kg/m2 * m2/kg = unitless LAI @@ -105,59 +102,7 @@ real(r8) function tree_sai( cohort_in ) end function tree_sai - -! ============================================================================ - - real(r8) function c_area( cohort_in ) - - ! ============================================================================ - ! Calculate area of ground covered by entire cohort. (m2) - ! Function of DBH (cm) canopy spread (m/cm) and number of individuals. - ! ============================================================================ - - use EDTypesMod , only : nclmax - - type(ed_cohort_type), intent(in) :: cohort_in - - real(r8) :: dbh ! Tree diameter at breat height. cm. - real(r8) :: crown_area_to_dbh_exponent - real(r8) :: spreadterm - - ! 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 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%allom_dbh_maxheight - write(fates_log(),*) 'z_area 3',EDPftvarcon_inst%woody - write(fates_log(),*) 'z_area 4',cohort_in%n - write(fates_log(),*) 'z_area 5',cohort_in%siteptr%spread - write(fates_log(),*) 'z_area 6',cohort_in%canopy_layer - end if - - dbh = min(cohort_in%dbh,EDPftvarcon_inst%allom_dbh_maxheight(cohort_in%pft)) - - ! ---------------------------------------------------------------------------------- - ! The function c_area is called during the process of canopy position demotion - ! and promotion. As such, some cohorts are temporarily elevated to canopy positions - ! that are outside the number of alloted canopy spaces. Ie, a two story canopy - ! may have a third-story plant, if only for a moment. However, these plants - ! still need to generate a crown area to complete the promotion, demotion process. - ! So we allow layer index exceedence here and force it down to max. - ! (rgk/cdk 05/2017) - ! ---------------------------------------------------------------------------------- - - ! apply site-level spread elasticity to the cohort crown allometry term - spreadterm = cohort_in%siteptr%spread * EDPftvarcon_inst%allom_d2ca_coefficient_max(cohort_in%pft) + & - (1._r8 - cohort_in%siteptr%spread) * EDPftvarcon_inst%allom_d2ca_coefficient_min(cohort_in%pft) - ! - c_area = cohort_in%n * spreadterm * dbh ** crown_area_to_dbh_exponent - - end function c_area - -! ============================================================================ + ! ============================================================================ subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 4f87fcaaed..d3fe5d6b1e 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -225,7 +225,8 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site use EDtypesMod, only : ed_site_type use EDtypesMod, only : ed_patch_type use EDtypesMod, only : ed_cohort_type - use EDGrowthFunctionsMod, only : c_area + use FatesAllometryMod , only : carea_allom + ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: currentSite @@ -451,7 +452,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site currentCohort => newPatch%shortest do while(associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) currentCohort => currentCohort%taller enddo diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c5a5025bbc..61364624d3 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -31,7 +31,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : logging_litter_fluxes use EDLoggingMortalityMod, only : logging_time use EDParamsMod , only : fates_mortality_disturbance_fraction - + use FatesAllometryMod , only : carea_allom ! CIME globals use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -74,7 +74,7 @@ subroutine disturbance_rates( site_in) ! Modify to add logging disturbance ! !USES: - use EDGrowthFunctionsMod , only : c_area, mortality_rates + use EDGrowthFunctionsMod , only : mortality_rates ! loging flux use EDLoggingMortalityMod , only : LoggingMortality_frac @@ -94,7 +94,7 @@ subroutine disturbance_rates( site_in) real(r8) :: lmort_collateral real(r8) :: lmort_infra - integer :: threshold_sizeclass + integer :: threshold_sizeclass !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -111,7 +111,8 @@ subroutine disturbance_rates( site_in) call mortality_rates(currentCohort,cmort,hmort,bmort) currentCohort%dmort = cmort+hmort+bmort - currentCohort%c_area = c_area(currentCohort) + + call carea_allom(currentCohort%dbh,currentCohort%n,site_in%spread,currentCohort%pft,currentCohort%c_area) ! Initialize diagnostic mortality rates currentCohort%cmort = cmort @@ -759,7 +760,6 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si ! ! !USES: use SFParamsMod, only : SF_VAL_CWD_FRAC - use EDGrowthFunctionsMod, only : c_area use EDtypesMod , only : dl_sf ! ! !ARGUMENTS: @@ -917,7 +917,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si currentCohort => new_patch%shortest do while(associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentCohort%cfa else diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index b4ba6e9c73..656e08cdb8 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -41,6 +41,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : bcr_allom + use FatesAllometryMod , only : carea_allom implicit none @@ -191,6 +192,7 @@ subroutine trim_canopy( currentSite ) do while (associated(currentCohort)) trimmed = 0 ipft = currentCohort%pft + call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) currentCohort%treelai = tree_lai(currentCohort) currentCohort%nv = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed) if (currentCohort%nv > nlevleaf)then @@ -1053,7 +1055,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) call bsap_allom(currentCohort%dbh,currentCohort%hite,ipft, & currentCohort%canopy_trim,b_sap,db_sap_dd) - + ! Total change in alive biomass relative to dead biomass [kgC/kgC] dbalivedbd = (db_leaf_dd + db_fineroot_dd + db_sap_dd)/db_dead_dd @@ -1101,7 +1103,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) endif - ! calculate derivatives of living and dead carbon pools + ! calculate derivatives of living and dead carbon pools currentCohort%dbalivedt = gr_fract * va * currentCohort%carbon_balance - balive_loss currentCohort%dbdeaddt = gr_fract * vs * currentCohort%carbon_balance currentCohort%dbstoredt = currentCohort%storage_flux diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 6167024a1f..e8afe6c357 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -107,6 +107,7 @@ module FatesAllometryMod public :: bcr_allom ! Generic coarse root wrapper public :: bfineroot ! Generic actual fine root biomass wrapper public :: bdead_allom ! Generic bdead wrapper + public :: carea_allom ! Generic crown area wrapper character(len=*), parameter :: sourcefile = __FILE__ @@ -289,6 +290,49 @@ subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) return end subroutine blmax_allom + ! ============================================================================ + ! Generic crown area allometry wrapper + ! ============================================================================ + + subroutine carea_allom(d,nplant,site_spread,ipft,c_area) + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: site_spread ! site level spread factor (crowdedness) + real(r8),intent(in) :: nplant ! number of plants [1/ha] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: c_area ! crown area per plant (m2) + + real(r8) :: d_eff ! Effective diameter (cm) + + associate( dbh_maxh => EDPftvarcon_inst%allom_dbh_maxheight(ipft), & + allom_lmode => EDPftvarcon_inst%allom_lmode(ipft), & + d2bl_p2 => EDPftvarcon_inst%allom_d2bl2(ipft), & + d2bl_ediff => EDPftvarcon_inst%allom_blca_expnt_diff(ipft), & + d2ca_min => EDPftvarcon_inst%allom_d2ca_coefficient_min(ipft), & + d2ca_max => EDPftvarcon_inst%allom_d2ca_coefficient_max(ipft)) + + select case(int(allom_lmode)) + case(1,3) ! "salda" and "height capped generic two power" + d_eff = min(d,dbh_maxh) + call carea_2pwr(d_eff,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area) + case(2) ! "2par_pwr") + call carea_2pwr(d,site_spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area) + case DEFAULT + write(fates_log(),*) 'An undefined leaf allometry was specified: ', & + allom_lmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + c_area = c_area * nplant + + + end associate + return + end subroutine carea_allom + + + ! ===================================================================================== subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) @@ -703,7 +747,7 @@ subroutine d2blmax_2pwr(d,p1,p2,c2b,blmax,dblmaxdd) real(r8),intent(in) :: p2 ! parameter 2 real(r8),intent(in) :: c2b ! carbon to biomass multiplier - real(r8),intent(out) :: blmax ! plant leaf biomass [kg] + real(r8),intent(out) :: blmax ! plant leaf biomass [kgC] real(r8),intent(out),optional :: dblmaxdd ! change leaf bio per diameter [kgC/cm] blmax = p1*d**p2 / c2b @@ -731,7 +775,7 @@ subroutine dh2blmax_2pwr(d,p1,p2,dbh_maxh,c2b,blmax,dblmaxdd) real(r8),intent(in) :: c2b ! carbon 2 biomass multiplier real(r8),intent(in) :: dbh_maxh ! dbh at maximum height - real(r8),intent(out) :: blmax ! plant leaf biomass [kg] + real(r8),intent(out) :: blmax ! plant leaf biomass [kgC] real(r8),intent(out),optional :: dblmaxdd ! change leaf bio per diameter [kgC/cm] blmax = p1*min(d,dbh_maxh)**p2/c2b @@ -1329,6 +1373,53 @@ subroutine h2d_martcano(h,p1,p2,p3,d,dddh) end if return end subroutine h2d_martcano + + ! ============================================================================= + ! Specific diameter to crown area allometries + ! ============================================================================= + + + subroutine carea_2pwr(d,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area) + + ! ============================================================================ + ! Calculate area of ground covered by entire cohort. (m2) + ! Function of DBH (cm) canopy spread (m/cm) and number of individuals. + ! ============================================================================ + + real(r8),intent(in) :: d ! diameter [cm] + real(r8),intent(in) :: spread ! site level relative spread score [0-1] + real(r8),intent(in) :: d2bl_p2 ! parameter 2 in the diameter->bleaf allometry (exponent) + real(r8),intent(in) :: d2bl_ediff ! area difference factor in the diameter-bleaf allometry (exponent) + real(r8),intent(in) :: d2ca_min ! minimum diameter to crown area scaling factor + real(r8),intent(in) :: d2ca_max ! maximum diameter to crown area scaling factor + real(r8),intent(out) :: c_area ! crown area for one plant [m2] + + real(r8) :: crown_area_to_dbh_exponent + real(r8) :: spreadterm ! Effective 2bh to crown area scaling factor + + ! 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 + ! allom_blca_expnt_diff term (which has default value of zero) + crown_area_to_dbh_exponent = d2bl_p2 + d2bl_ediff + + ! ---------------------------------------------------------------------------------- + ! The function c_area is called during the process of canopy position demotion + ! and promotion. As such, some cohorts are temporarily elevated to canopy positions + ! that are outside the number of alloted canopy spaces. Ie, a two story canopy + ! may have a third-story plant, if only for a moment. However, these plants + ! still need to generate a crown area to complete the promotion, demotion process. + ! So we allow layer index exceedence here and force it down to max. + ! (rgk/cdk 05/2017) + ! ---------------------------------------------------------------------------------- + + ! apply site-level spread elasticity to the cohort crown allometry term + + spreadterm = spread * d2ca_max + (1._r8 - spread) * d2ca_min + + c_area = spreadterm * d ** crown_area_to_dbh_exponent + + end subroutine carea_2pwr + ! =========================================================================== From 3a3a7fdd48e1a431544ed6753a07d4c46a33ff1e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 Oct 2017 16:06:48 -0700 Subject: [PATCH 28/63] Changed file permissions on biogeochem files that for some reason had execute permissions? --- biogeochem/EDCanopyStructureMod.F90 | 0 biogeochem/EDCohortDynamicsMod.F90 | 0 biogeochem/EDGrowthFunctionsMod.F90 | 0 biogeochem/EDPhysiologyMod.F90 | 0 4 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 biogeochem/EDCanopyStructureMod.F90 mode change 100755 => 100644 biogeochem/EDCohortDynamicsMod.F90 mode change 100755 => 100644 biogeochem/EDGrowthFunctionsMod.F90 mode change 100755 => 100644 biogeochem/EDPhysiologyMod.F90 diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 old mode 100755 new mode 100644 diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 old mode 100755 new mode 100644 diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 old mode 100755 new mode 100644 diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 old mode 100755 new mode 100644 From 9940eb922595b68b252629df040619c79f710558 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 Oct 2017 16:08:55 -0700 Subject: [PATCH 29/63] Changed file permissions on main --- main/EDInitMod.F90 | 0 main/EDMainMod.F90 | 0 main/EDTypesMod.F90 | 0 3 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 main/EDInitMod.F90 mode change 100755 => 100644 main/EDMainMod.F90 mode change 100755 => 100644 main/EDTypesMod.F90 diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 old mode 100755 new mode 100644 diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 old mode 100755 new mode 100644 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 old mode 100755 new mode 100644 From e2f605703ade066e6e1f77a9c18a46b5790b4286 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 Oct 2017 16:09:26 -0700 Subject: [PATCH 30/63] Changed file permissions on fire --- fire/SFMainMod.F90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 fire/SFMainMod.F90 diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 old mode 100755 new mode 100644 From cc70d598aa82503957d7e3537cc2b2e160b839bc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 Oct 2017 16:29:03 -0700 Subject: [PATCH 31/63] Cleaned out EDGrowthFunctions. The lai and sai were sent to EDCohortDynamcis, mortality remained and changed name of module for consistency. --- biogeochem/EDCanopyStructureMod.F90 | 4 +- biogeochem/EDCohortDynamicsMod.F90 | 81 +++++++++++- biogeochem/EDGrowthFunctionsMod.F90 | 171 ------------------------- biogeochem/EDMortalityFunctionsMod.F90 | 95 ++++++++++++++ biogeochem/EDPatchDynamicsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 5 +- 6 files changed, 181 insertions(+), 177 deletions(-) delete mode 100644 biogeochem/EDGrowthFunctionsMod.F90 create mode 100644 biogeochem/EDMortalityFunctionsMod.F90 diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 35be33f68e..d83a952154 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -10,6 +10,8 @@ module EDCanopyStructureMod use EDPftvarcon , only : EDPftvarcon_inst use FatesAllometryMod , only : carea_allom use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts + use EDCohortDynamicsMod , only : tree_lai + use EDCohortDynamicsMod , only : tree_sai use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf @@ -864,7 +866,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use EDPatchDynamicsMod , only : set_patchno use EDPatchDynamicsMod , only : set_root_fraction use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index - use EDGrowthFunctionsMod , only : tree_lai use EDtypesMod , only : area use EDPftvarcon , only : EDPftvarcon_inst @@ -978,7 +979,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! ! !USES: - use EDGrowthFunctionsMod , only : tree_lai, tree_sai use EDtypesMod , only : area, dinc_ed, hitemax, n_hite_bins ! diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 3ad3d739ba..3f1c63d168 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -21,6 +21,8 @@ module EDCohortDynamicsMod use EDTypesMod , only : AREA use EDTypesMod , only : min_npm2, min_nppatch use EDTypesMod , only : min_n_safemath + use EDTypesMod , only : nlevleaf + use EDTypesMod , only : dinc_ed use FatesInterfaceMod , only : hlm_use_planthydro use FatesPlantHydraulicsMod, only : FuseCohortHydraulics use FatesPlantHydraulicsMod, only : CopyCohortHydraulics @@ -51,6 +53,8 @@ module EDCohortDynamicsMod public :: copy_cohort public :: count_cohorts public :: allocate_live_biomass + public :: tree_lai + public :: tree_sai logical, parameter :: DEBUG = .false. ! local debug flag @@ -687,7 +691,6 @@ subroutine fuse_cohorts(patchptr, bc_in) ! Join similar cohorts to reduce total number ! ! !USES: - use EDTypesMod , only : nlevleaf use EDParamsMod , only : ED_val_cohort_fusion_tol use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) ! @@ -1351,7 +1354,83 @@ function count_cohorts( currentPatch ) result ( backcount ) end function count_cohorts + ! ===================================================================================== + real(r8) function tree_lai( cohort_in ) + + ! ============================================================================ + ! LAI of individual trees is a function of the total leaf area and the total canopy area. + ! ============================================================================ + + type(ed_cohort_type), intent(inout) :: cohort_in + + real(r8) :: leafc_per_unitarea ! KgC of leaf per m2 area of ground. + real(r8) :: slat ! the sla of the top leaf layer. m2/kgC + + if( cohort_in%bl < 0._r8 .or. cohort_in%pft == 0 ) then + write(fates_log(),*) 'problem in treelai',cohort_in%bl,cohort_in%pft + endif + + if( cohort_in%status_coh == 2 ) then ! are the leaves on? + slat = 1000.0_r8 * EDPftvarcon_inst%slatop(cohort_in%pft) ! m2/g to m2/kg + leafc_per_unitarea = cohort_in%bl/(cohort_in%c_area/cohort_in%n) !KgC/m2 + if(leafc_per_unitarea > 0.0_r8)then + tree_lai = leafc_per_unitarea * slat !kg/m2 * m2/kg = unitless LAI + else + tree_lai = 0.0_r8 + endif + else + tree_lai = 0.0_r8 + endif !status + cohort_in%treelai = tree_lai + + ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it + ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a + ! huge error + if(cohort_in%treelai > nlevleaf*dinc_ed)then + write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevleaf * dinc_ed + endif + + return + + end function tree_lai + + ! ============================================================================ + + real(r8) function tree_sai( cohort_in ) + + ! ============================================================================ + ! SAI of individual trees is a function of the total dead biomass per unit canopy area. + ! ============================================================================ + + type(ed_cohort_type), intent(inout) :: cohort_in + + real(r8) :: bdead_per_unitarea ! KgC of leaf per m2 area of ground. + real(r8) :: sai_scaler + + 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 + endif + + bdead_per_unitarea = cohort_in%bdead/(cohort_in%c_area/cohort_in%n) !KgC/m2 + tree_sai = bdead_per_unitarea * sai_scaler !kg/m2 * m2/kg = unitless LAI + + cohort_in%treesai = tree_sai + + ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it + ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a + ! huge error + if(cohort_in%treesai > nlevleaf*dinc_ed)then + write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevleaf * dinc_ed + endif + + return + + end function tree_sai + + ! ============================================================================ !-------------------------------------------------------------------------------------! diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 deleted file mode 100644 index fbb08730b3..0000000000 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ /dev/null @@ -1,171 +0,0 @@ -module EDGrowthFunctionsMod - - ! ============================================================================ - ! Functions that control the trajectory of plant growth. - ! Ideally these would all use parameters that are fed in from the parameter file. - ! At present, there is only a single allocation trajectory. - ! ============================================================================ - - use FatesConstantsMod, only : r8 => fates_r8 - use FatesGlobals , only : fates_log - use EDPftvarcon , only : EDPftvarcon_inst - use EDTypesMod , only : ed_cohort_type, nlevleaf, dinc_ed - use FatesConstantsMod , only : itrue,ifalse - use FatesAllometryMod, only : bleaf - - implicit none - private - - public :: tree_lai - public :: tree_sai - public :: mortality_rates - - logical :: DEBUG_growth = .false. - - ! ============================================================================ - ! 10/30/09: Created by Rosie Fisher - ! ============================================================================ - -contains - - real(r8) function tree_lai( cohort_in ) - - ! ============================================================================ - ! LAI of individual trees is a function of the total leaf area and the total canopy area. - ! ============================================================================ - - type(ed_cohort_type), intent(inout) :: cohort_in - - real(r8) :: leafc_per_unitarea ! KgC of leaf per m2 area of ground. - real(r8) :: slat ! the sla of the top leaf layer. m2/kgC - - if( cohort_in%bl < 0._r8 .or. cohort_in%pft == 0 ) then - write(fates_log(),*) 'problem in treelai',cohort_in%bl,cohort_in%pft - endif - - if( cohort_in%status_coh == 2 ) then ! are the leaves on? - slat = 1000.0_r8 * EDPftvarcon_inst%slatop(cohort_in%pft) ! m2/g to m2/kg - leafc_per_unitarea = cohort_in%bl/(cohort_in%c_area/cohort_in%n) !KgC/m2 - if(leafc_per_unitarea > 0.0_r8)then - tree_lai = leafc_per_unitarea * slat !kg/m2 * m2/kg = unitless LAI - else - tree_lai = 0.0_r8 - endif - else - tree_lai = 0.0_r8 - endif !status - cohort_in%treelai = tree_lai - - ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it - ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a - ! huge error - if(cohort_in%treelai > nlevleaf*dinc_ed)then - write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevleaf * dinc_ed - endif - - return - - end function tree_lai - - ! ============================================================================ - - real(r8) function tree_sai( cohort_in ) - - ! ============================================================================ - ! SAI of individual trees is a function of the total dead biomass per unit canopy area. - ! ============================================================================ - - type(ed_cohort_type), intent(inout) :: cohort_in - - real(r8) :: bdead_per_unitarea ! KgC of leaf per m2 area of ground. - real(r8) :: sai_scaler - - 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 - endif - - bdead_per_unitarea = cohort_in%bdead/(cohort_in%c_area/cohort_in%n) !KgC/m2 - tree_sai = bdead_per_unitarea * sai_scaler !kg/m2 * m2/kg = unitless LAI - - cohort_in%treesai = tree_sai - - ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it - ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a - ! huge error - if(cohort_in%treesai > nlevleaf*dinc_ed)then - write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevleaf * dinc_ed - endif - - return - - end function tree_sai - - ! ============================================================================ - - subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) - - ! ============================================================================ - ! Calculate mortality rates as a function of carbon storage - ! ============================================================================ - - use EDParamsMod, only : ED_val_stress_mort - use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys - - type (ed_cohort_type), intent(in) :: cohort_in - real(r8),intent(out) :: bmort ! background mortality : Fraction per year - real(r8),intent(out) :: cmort ! carbon starvation mortality - real(r8),intent(out) :: hmort ! hydraulic failure mortality - - real(r8) :: frac ! relativised stored carbohydrate - real(r8) :: b_leaf ! leaf biomass kgC - real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold - - - if (hlm_use_ed_prescribed_phys .eq. ifalse) then - - ! 'Background' mortality (can vary as a function of density as in ED1.0 and ED2.0, but doesn't here for tractability) - bmort = EDPftvarcon_inst%bmort(cohort_in%pft) - - ! Proxy for hydraulic failure induced mortality. - 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 - else - hmort = 0.0_r8 - endif - - ! Carbon Starvation induced mortality. - if ( cohort_in%dbh > 0._r8 ) then - call bleaf(cohort_in%dbh,cohort_in%hite,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)) - else - cmort = 0.0_r8 - endif - - else - write(fates_log(),*) 'dbh problem in mortality_rates', & - cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer - endif - - !mortality_rates = bmort + hmort + cmort - - else ! i.e. hlm_use_ed_prescribed_phys is true - if ( cohort_in%canopy_layer .eq. 1) then - bmort = EDPftvarcon_inst%prescribed_mortality_canopy(cohort_in%pft) - else - bmort = EDPftvarcon_inst%prescribed_mortality_understory(cohort_in%pft) - endif - cmort = 0._r8 - hmort = 0._r8 - endif - - end subroutine mortality_rates - -! ============================================================================ - -end module EDGrowthFunctionsMod diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 new file mode 100644 index 0000000000..c4e34b0c52 --- /dev/null +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -0,0 +1,95 @@ +module EDMortalityFunctionsMod + + ! ============================================================================ + ! Functions that control mortality. + ! ============================================================================ + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals , only : fates_log + use EDPftvarcon , only : EDPftvarcon_inst + use EDTypesMod , only : ed_cohort_type + use FatesConstantsMod, only : itrue,ifalse + use FatesAllometryMod, only : bleaf + use EDParamsMod , only : ED_val_stress_mort + use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys + + implicit none + private + + + public :: mortality_rates + + logical :: DEBUG_growth = .false. + + ! ============================================================================ + ! 10/30/09: Created by Rosie Fisher + ! ============================================================================ + +contains + + + + subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) + + ! ============================================================================ + ! Calculate mortality rates as a function of carbon storage + ! ============================================================================ + + + + type (ed_cohort_type), intent(in) :: cohort_in + real(r8),intent(out) :: bmort ! background mortality : Fraction per year + real(r8),intent(out) :: cmort ! carbon starvation mortality + real(r8),intent(out) :: hmort ! hydraulic failure mortality + + real(r8) :: frac ! relativised stored carbohydrate + real(r8) :: b_leaf ! leaf biomass kgC + real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold + + + if (hlm_use_ed_prescribed_phys .eq. ifalse) then + + ! 'Background' mortality (can vary as a function of density as in ED1.0 and ED2.0, but doesn't here for tractability) + bmort = EDPftvarcon_inst%bmort(cohort_in%pft) + + ! Proxy for hydraulic failure induced mortality. + 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 + else + hmort = 0.0_r8 + endif + + ! Carbon Starvation induced mortality. + if ( cohort_in%dbh > 0._r8 ) then + call bleaf(cohort_in%dbh,cohort_in%hite,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)) + else + cmort = 0.0_r8 + endif + + else + write(fates_log(),*) 'dbh problem in mortality_rates', & + cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer + endif + + !mortality_rates = bmort + hmort + cmort + + else ! i.e. hlm_use_ed_prescribed_phys is true + if ( cohort_in%canopy_layer .eq. 1) then + bmort = EDPftvarcon_inst%prescribed_mortality_canopy(cohort_in%pft) + else + bmort = EDPftvarcon_inst%prescribed_mortality_understory(cohort_in%pft) + endif + cmort = 0._r8 + hmort = 0._r8 + endif + + end subroutine mortality_rates + +! ============================================================================ + +end module EDMortalityFunctionsMod diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6334d47333..051baf689a 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -79,7 +79,7 @@ subroutine disturbance_rates( site_in) ! Modify to add logging disturbance ! !USES: - use EDGrowthFunctionsMod , only : mortality_rates + use EDMortalityFunctionsMod , only : mortality_rates ! loging flux use EDLoggingMortalityMod , only : LoggingMortality_frac diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 2702222fd5..d04a2c364c 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -17,6 +17,8 @@ module EDPhysiologyMod use FatesInterfaceMod, only : bc_in_type use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort use EDCohortDynamicsMod , only : create_cohort, sort_cohorts + use EDCohortDynamicsMod , only : tree_lai + use EDCohortDynamicsMod , only : tree_sai use EDTypesMod , only : numWaterMem use EDTypesMod , only : dl_sf, dinc_ed @@ -167,7 +169,6 @@ subroutine trim_canopy( currentSite ) ! ! !USES: ! - use EDGrowthFunctionsMod, only : tree_lai ! ! !ARGUMENTS type (ed_site_type),intent(inout), target :: currentSite @@ -785,7 +786,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! ! !USES: - use EDGrowthFunctionsMod , only : mortality_rates + use EDMortalityFunctionsMod , only : mortality_rates use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys use EDLoggingMortalityMod, only : LoggingMortality_frac From b2f171f01acecc037e419c6fe39ea216fc7d0608 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 Oct 2017 16:37:47 -0700 Subject: [PATCH 32/63] Small bug-fix, wrong module call to tree_lai from its host module. --- biogeochem/EDCohortDynamicsMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 3f1c63d168..72f0ac1a8b 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -13,7 +13,6 @@ module EDCohortDynamicsMod use FatesConstantsMod , only : itrue,ifalse use FatesInterfaceMod , only : hlm_days_per_year use EDPftvarcon , only : EDPftvarcon_inst - use EDGrowthFunctionsMod , only : tree_lai use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax use EDTypesMod , only : ncwd From 066a9c4bdb56a97a3d7473fae47cdb9818f18b09 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 Oct 2017 12:15:30 -0700 Subject: [PATCH 33/63] allometry bug-fix: restarts must pass a positive trimming value during cohort creation or else there will be problems calculating some token values with the new allometry functions. A test_b4b clause was added to reproduce previous results and then opt-out in the next PR. --- biogeochem/EDPhysiologyMod.F90 | 18 ++++++++++++------ main/FatesRestartInterfaceMod.F90 | 2 +- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index d04a2c364c..24bed38a6d 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -67,6 +67,9 @@ module EDPhysiologyMod logical, parameter :: DEBUG = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & __FILE__ + + logical, parameter :: test_b4b = .true. + ! ============================================================================ contains @@ -889,11 +892,14 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !target balive without leaves. if (currentCohort%status_coh == 1)then - target_balive = b_fineroot + b_sap - endif - ! NPP - if ( DEBUG ) write(fates_log(),*) 'EDphys 716 ',currentCohort%npp_acc + if(test_b4b) then + target_balive = b_fineroot + b_sap/b_leaf + else + target_balive = b_fineroot + b_sap + end if + + endif ! convert from kgC/indiv/day into kgC/indiv/year ! TODO: CONVERT DAYS_PER_YEAR TO DBLE (HOLDING FOR B4B COMPARISONS, RGK-01-2017) @@ -903,11 +909,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) if (hlm_use_ed_prescribed_phys .eq. itrue) then if (currentCohort%canopy_layer .eq. 1) then - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(currentCohort%pft) & + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(ipft) & * currentCohort%c_area / currentCohort%n currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year ! add these for balance checking purposes else - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(currentCohort%pft) & + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(ipft) & * currentCohort%c_area / currentCohort%n currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year ! add these for balance checking purposes endif diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 31c427578c..7ccbe0bdab 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1450,7 +1450,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) temp_cohort%bdead = 0.0_r8 temp_cohort%bstore = 0.0_r8 temp_cohort%laimemory = 0.0_r8 - temp_cohort%canopy_trim = 0.0_r8 + temp_cohort%canopy_trim = 1.0_r8 temp_cohort%canopy_layer = 1.0_r8 temp_cohort%canopy_layer_yesterday = 1.0_r8 From f888765e53a5eb283f03bb6055787c8b9c6a61da Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 Oct 2017 14:23:49 -0700 Subject: [PATCH 34/63] allometry: reverted calculation of target_balive, previous commit to preserve b4b was erroneous. --- biogeochem/EDPhysiologyMod.F90 | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 24bed38a6d..1ba821fadb 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -68,7 +68,6 @@ module EDPhysiologyMod character(len=*), parameter, private :: sourcefile = & __FILE__ - logical, parameter :: test_b4b = .true. ! ============================================================================ @@ -892,13 +891,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !target balive without leaves. if (currentCohort%status_coh == 1)then - - if(test_b4b) then - target_balive = b_fineroot + b_sap/b_leaf - else - target_balive = b_fineroot + b_sap - end if - + target_balive = b_fineroot + b_sap endif ! convert from kgC/indiv/day into kgC/indiv/year From dc3a97ba834fc3f55f51a8203fe8e99406922390 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 Oct 2017 14:35:08 -0700 Subject: [PATCH 35/63] Fixed order of calcualtions of carbon pools in recruits; sapwood was calculated after total bdead, but needs to come before. --- biogeochem/EDPhysiologyMod.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 1ba821fadb..59844b68c3 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1041,7 +1041,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) if ((currentCohort%balive >= target_balive).and.(currentCohort%carbon_balance > 0._r8))then ! fraction of carbon going into active vs structural carbon - ! fraction of carbon going into active vs structural carbon + ! fraction of carbon not going towards reproduction if (currentCohort%dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass gr_fract = 1.0_r8 - EDPftvarcon_inst%seed_alloc(ipft) else @@ -1187,16 +1187,15 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) - call bag_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_aboveground) - call bcr_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_coarseroot) - call bdead_allom(b_aboveground,b_coarseroot,b_sapwood,ft,temp_cohort%bdead) - - ! Initialize balive (leaf+fineroot+sapwood) call bleaf(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_leaf) call bfineroot(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_fineroot) call bsap_allom(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_sapwood) + call bag_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_aboveground) + call bcr_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_coarseroot) + call bdead_allom(b_aboveground,b_coarseroot,b_sapwood,ft,temp_cohort%bdead) + temp_cohort%balive = b_leaf + b_sapwood + b_fineroot temp_cohort%bstore = EDPftvarcon_inst%cushion(ft) * b_leaf From b4a26f844c9dd7c6535fa3ef37d32fd9e085003e Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 17 Nov 2017 10:36:19 -0800 Subject: [PATCH 36/63] changed order of setting allometry functions to fix biomass problem during inventory initialization --- main/FatesInventoryInitMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index d01d9c3d0d..c9a5ee3d4b 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -862,8 +862,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%pft = c_pft temp_cohort%n = c_nplant * cpatch%area - temp_cohort%hite = Hite(temp_cohort) temp_cohort%dbh = c_dbh + temp_cohort%hite = Hite(temp_cohort) temp_cohort%canopy_trim = 1.0_r8 temp_cohort%bdead = Bdead(temp_cohort) temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%allom_l2fr(c_pft) & From 5ccdcc5adc6fa36fefcc2f72f12a774f730acf07 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 21 Nov 2017 15:42:18 -0700 Subject: [PATCH 37/63] added a few new structured history variables, and made several of the structured history variables default-on --- main/FatesHistoryInterfaceMod.F90 | 124 ++++++++++++++++++++++++------ 1 file changed, 102 insertions(+), 22 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7be3fd8c09..2255388bd0 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -161,8 +161,6 @@ module FatesHistoryInterfaceMod integer, private :: ih_m4_si_scpf integer, private :: ih_m5_si_scpf integer, private :: ih_m6_si_scpf - - !LOGGING , make sure to add ih_m7_si_scpf and hio_m7_si_scpf integer, private :: ih_m7_si_scpf integer, private :: ih_ar_si_scpf @@ -175,6 +173,7 @@ module FatesHistoryInterfaceMod ! indices to (site x scls) variables integer, private :: ih_ba_si_scls + integer, private :: ih_nplant_si_scls integer, private :: ih_nplant_canopy_si_scls integer, private :: ih_nplant_understory_si_scls integer, private :: ih_mortality_canopy_si_scls @@ -187,6 +186,17 @@ module FatesHistoryInterfaceMod integer, private :: ih_crown_area_understory_si_scls integer, private :: ih_ddbh_canopy_si_scls integer, private :: ih_ddbh_understory_si_scls + integer, private :: ih_agb_si_scls + integer, private :: ih_b_si_scls + + ! mortality vars + integer, private :: ih_m1_si_scls + integer, private :: ih_m2_si_scls + integer, private :: ih_m3_si_scls + integer, private :: ih_m4_si_scls + integer, private :: ih_m5_si_scls + integer, private :: ih_m6_si_scls + integer, private :: ih_m7_si_scls ! lots of non-default diagnostics for understanding canopy versus understory carbon balances integer, private :: ih_rdark_canopy_si_scls @@ -1212,10 +1222,18 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m4_si_scpf => this%hvars(ih_m4_si_scpf)%r82d, & hio_m5_si_scpf => this%hvars(ih_m5_si_scpf)%r82d, & hio_m6_si_scpf => this%hvars(ih_m6_si_scpf)%r82d, & - hio_m7_si_scpf => this%hvars(ih_m7_si_scpf)%r82d, & - + hio_m1_si_scls => this%hvars(ih_m1_si_scls)%r82d, & + hio_m2_si_scls => this%hvars(ih_m2_si_scls)%r82d, & + hio_m3_si_scls => this%hvars(ih_m3_si_scls)%r82d, & + hio_m4_si_scls => this%hvars(ih_m4_si_scls)%r82d, & + hio_m5_si_scls => this%hvars(ih_m5_si_scls)%r82d, & + hio_m6_si_scls => this%hvars(ih_m6_si_scls)%r82d, & + hio_m7_si_scls => this%hvars(ih_m7_si_scls)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & + hio_agb_si_scls => this%hvars(ih_agb_si_scls)%r82d, & + hio_b_si_scls => this%hvars(ih_b_si_scls)%r82d, & + hio_nplant_si_scls => this%hvars(ih_nplant_si_scls)%r82d, & hio_nplant_canopy_si_scls => this%hvars(ih_nplant_canopy_si_scls)%r82d, & hio_nplant_understory_si_scls => this%hvars(ih_nplant_understory_si_scls)%r82d, & hio_mortality_canopy_si_scls => this%hvars(ih_mortality_canopy_si_scls)%r82d, & @@ -1466,12 +1484,16 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*ccohort%n hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*ccohort%n hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*ccohort%n - - - !Y.X. hio_m7_si_scpf(io_si,scpf) = hio_m7_si_scpf(io_si,scpf) + & (ccohort%lmort_logging+ccohort%lmort_collateral+ccohort%lmort_infra) * ccohort%n + hio_m1_si_scls(io_si,scls) = hio_m1_si_scls(io_si,scls) + ccohort%bmort*ccohort%n + hio_m2_si_scls(io_si,scls) = hio_m2_si_scls(io_si,scls) + ccohort%hmort*ccohort%n + hio_m3_si_scls(io_si,scls) = hio_m3_si_scls(io_si,scls) + ccohort%cmort*ccohort%n + hio_m5_si_scls(io_si,scls) = hio_m5_si_scls(io_si,scls) + ccohort%fmort*ccohort%n + hio_m7_si_scls(io_si,scls) = hio_m7_si_scls(io_si,scls) + & + (ccohort%lmort_logging+ccohort%lmort_collateral+ccohort%lmort_infra) * ccohort%n + ! basal area [m2/ha] hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & @@ -1488,12 +1510,20 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%ddbhdt*ccohort%n end if + hio_agb_si_scls(io_si,scls) = hio_agb_si_scls(io_si,scls) + & + ccohort%b * ccohort%n * EDPftvarcon_inst%allom_agb_frac(ccohort%pft) * AREA_INV + + hio_b_si_scls(io_si,scls) = hio_b_si_scls(io_si,scls) + & + ccohort%b * ccohort%n * AREA_INV + ! update size-class x patch-age related quantities iscag = get_sizeage_class_index(ccohort%dbh,cpatch%age) hio_nplant_si_scag(io_si,iscag) = hio_nplant_si_scag(io_si,iscag) + ccohort%n + hio_nplant_si_scls(io_si,scls) = hio_nplant_si_scls(io_si,scls) + ccohort%n + ! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities if (ccohort%canopy_layer .eq. 1) then hio_nplant_canopy_si_scag(io_si,iscag) = hio_nplant_canopy_si_scag(io_si,iscag) + ccohort%n @@ -1760,6 +1790,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) i_scpf = (i_pft-1)*nlevsclass + i_scls hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%terminated_nindivs(i_scls,i_pft,1) + & sites(s)%terminated_nindivs(i_scls,i_pft,2)) * days_per_year + hio_m6_si_scls(io_si,i_scls) = (sites(s)%terminated_nindivs(i_scls,i_pft,1) + & + sites(s)%terminated_nindivs(i_scls,i_pft,2)) * days_per_year hio_mortality_canopy_si_scls(io_si,i_scls) = hio_mortality_canopy_si_scls(io_si,i_scls) + & sites(s)%terminated_nindivs(i_scls,i_pft,1) * days_per_year hio_mortality_understory_si_scls(io_si,i_scls) = hio_mortality_understory_si_scls(io_si,i_scls) + & @@ -1771,6 +1803,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! ! imort on its own hio_m4_si_scpf(io_si,i_scpf) = hio_m4_si_scpf(io_si,i_scpf) + sites(s)%imort_rate(i_scls, i_pft) + hio_m4_si_scls(io_si,i_scls) = hio_m4_si_scls(io_si,i_scls) + sites(s)%imort_rate(i_scls, i_pft) ! ! add imort to other mortality terms. consider imort as understory mortality even if it happens in ! cohorts that may have been promoted as part of the patch creation, and use the pre-calculated site-level @@ -3038,18 +3071,18 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_carbonflux_si ) call this%set_history_var(vname='MORTALITY_CARBONFLUX_CANOPY', units = 'gC/m2/s', & - long='flux of biomass carbon from live to dead pools from mortality of canopy plants', use_default='inactive', & + long='flux of biomass carbon from live to dead pools from mortality of canopy plants', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_canopy_mortality_carbonflux_si ) call this%set_history_var(vname='MORTALITY_CARBONFLUX_UNDERSTORY', units = 'gC/m2/s', & - long='flux of biomass carbon from live to dead pools from mortality of understory plants',use_default='inactive',& + long='flux of biomass carbon from live to dead pools from mortality of understory plants',use_default='active',& avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_understory_mortality_carbonflux_si ) - + ! size class by age dimensioned variables call this%set_history_var(vname='NPLANT_SCAG',units = 'plants/ha', & - long='number of plants per hectare in each size x age class', use_default='inactive', & + long='number of plants per hectare in each size x age class', use_default='active', & avgflag='A', vtype=site_scag_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scag ) @@ -3214,14 +3247,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m6_si_scpf ) - - !Logging call this%set_history_var(vname='M7_SCPF', units = 'N/ha/event', & - long='logging mortalities by pft/size',use_default='inactive', & + long='logging mortality by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m7_si_scpf ) - call this%set_history_var(vname='MORTALITY_CANOPY_SCPF', units = 'N/ha/yr', & long='total mortality of canopy plants by pft/size', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3332,12 +3362,12 @@ subroutine define_history_vars(this, initialize_variables) ! size-class only variables call this%set_history_var(vname='DDBH_CANOPY_SCLS', units = 'cm/yr/ha', & - long='diameter growth increment by pft/size',use_default='inactive', & + long='diameter growth increment by pft/size',use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_canopy_si_scls ) call this%set_history_var(vname='DDBH_UNDERSTORY_SCLS', units = 'cm/yr/ha', & - long='diameter growth increment by pft/size',use_default='inactive', & + long='diameter growth increment by pft/size',use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_understory_si_scls ) @@ -3352,10 +3382,20 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_yesterdaycanopylevel_understory_si_scls ) call this%set_history_var(vname='BA_SCLS', units = 'm2/ha', & - long='basal area by size class', use_default='inactive', & + long='basal area by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ba_si_scls ) + call this%set_history_var(vname='AGB_SCLS', units = 'kgC/m2', & + long='Aboveground biomass by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_agb_si_scls ) + + call this%set_history_var(vname='BIOMASS_SCLS', units = 'kgC/m2', & + long='Total biomass by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_b_si_scls ) + call this%set_history_var(vname='DEMOTION_RATE_SCLS', units = 'indiv/ha/yr', & long='demotion rate from canopy to understory by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3367,22 +3407,62 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_rate_si_scls ) call this%set_history_var(vname='NPLANT_CANOPY_SCLS', units = 'indiv/ha', & - long='number of canopy plants by size class', use_default='inactive', & + long='number of canopy plants by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_scls ) call this%set_history_var(vname='MORTALITY_CANOPY_SCLS', units = 'indiv/ha/yr', & - long='total mortality of canopy trees by size class', use_default='inactive', & + long='total mortality of canopy trees by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scls ) call this%set_history_var(vname='NPLANT_UNDERSTORY_SCLS', units = 'indiv/ha', & - long='number of understory plants by size class', use_default='inactive', & + long='number of understory plants by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scls ) + call this%set_history_var(vname='NPLANT_SCLS', units = 'indiv/ha', & + long='number of plants by size class', use_default='active', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scls ) + + call this%set_history_var(vname='M1_SCLS', units = 'N/ha/yr', & + long='background mortality by size', use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m1_si_scls ) + + call this%set_history_var(vname='M2_SCLS', units = 'N/ha/yr', & + long='hydraulic mortality by size',use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m2_si_scls ) + + call this%set_history_var(vname='M3_SCLS', units = 'N/ha/yr', & + long='carbon starvation mortality by size', use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_scls ) + + call this%set_history_var(vname='M4_SCLS', units = 'N/ha/yr', & + long='impact mortality by size',use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m4_si_scls ) + + call this%set_history_var(vname='M5_SCLS', units = 'N/ha/yr', & + long='fire mortality by size',use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m5_si_scls ) + + call this%set_history_var(vname='M6_SCLS', units = 'N/ha/yr', & + long='termination mortality by size',use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m6_si_scls ) + + call this%set_history_var(vname='M7_SCLS', units = 'N/ha/event', & + long='logging mortality by size',use_default='active', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m7_si_scls ) + call this%set_history_var(vname='MORTALITY_UNDERSTORY_SCLS', units = 'indiv/ha/yr', & - long='total mortality of understory trees by size class', use_default='inactive', & + long='total mortality of understory trees by size class', use_default='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scls ) From c95b775d0ed463f33b75bcc6392a4ddabab4f5ef Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Nov 2017 12:18:14 -0700 Subject: [PATCH 38/63] bugfix on new history variable array sizing --- main/FatesHistoryInterfaceMod.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 2255388bd0..271b60947c 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -3428,37 +3428,37 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='M1_SCLS', units = 'N/ha/yr', & long='background mortality by size', use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m1_si_scls ) call this%set_history_var(vname='M2_SCLS', units = 'N/ha/yr', & long='hydraulic mortality by size',use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m2_si_scls ) call this%set_history_var(vname='M3_SCLS', units = 'N/ha/yr', & long='carbon starvation mortality by size', use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_scls ) call this%set_history_var(vname='M4_SCLS', units = 'N/ha/yr', & long='impact mortality by size',use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m4_si_scls ) call this%set_history_var(vname='M5_SCLS', units = 'N/ha/yr', & long='fire mortality by size',use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m5_si_scls ) call this%set_history_var(vname='M6_SCLS', units = 'N/ha/yr', & long='termination mortality by size',use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m6_si_scls ) call this%set_history_var(vname='M7_SCLS', units = 'N/ha/event', & long='logging mortality by size',use_default='active', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m7_si_scls ) call this%set_history_var(vname='MORTALITY_UNDERSTORY_SCLS', units = 'indiv/ha/yr', & From 841d9eead1b8ffe18b7cd2439943b9e464076e8e Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Nov 2017 12:50:38 -0700 Subject: [PATCH 39/63] fixed another error on how m6_scls was being calculated --- main/FatesHistoryInterfaceMod.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 271b60947c..3d3d79348e 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1788,10 +1788,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) do i_pft = 1, numpft do i_scls = 1,nlevsclass i_scpf = (i_pft-1)*nlevsclass + i_scls + ! + ! termination mortality. sum of canopy and understory indices hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%terminated_nindivs(i_scls,i_pft,1) + & sites(s)%terminated_nindivs(i_scls,i_pft,2)) * days_per_year - hio_m6_si_scls(io_si,i_scls) = (sites(s)%terminated_nindivs(i_scls,i_pft,1) + & + hio_m6_si_scls(io_si,i_scls) = hio_m6_si_scls(io_si,i_scls) + & + (sites(s)%terminated_nindivs(i_scls,i_pft,1) + & sites(s)%terminated_nindivs(i_scls,i_pft,2)) * days_per_year + ! + ! add termination mortality to canopy and understory mortality hio_mortality_canopy_si_scls(io_si,i_scls) = hio_mortality_canopy_si_scls(io_si,i_scls) + & sites(s)%terminated_nindivs(i_scls,i_pft,1) * days_per_year hio_mortality_understory_si_scls(io_si,i_scls) = hio_mortality_understory_si_scls(io_si,i_scls) + & @@ -1802,7 +1807,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year ! ! imort on its own - hio_m4_si_scpf(io_si,i_scpf) = hio_m4_si_scpf(io_si,i_scpf) + sites(s)%imort_rate(i_scls, i_pft) + hio_m4_si_scpf(io_si,i_scpf) = sites(s)%imort_rate(i_scls, i_pft) hio_m4_si_scls(io_si,i_scls) = hio_m4_si_scls(io_si,i_scls) + sites(s)%imort_rate(i_scls, i_pft) ! ! add imort to other mortality terms. consider imort as understory mortality even if it happens in From 8d085c936f007d2286116127d4f33ade067d61bf Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 22 Nov 2017 15:29:50 -0700 Subject: [PATCH 40/63] addition of more decriptive name to variable --- main/FatesHistoryInterfaceMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 3d3d79348e..79e63357ca 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -187,7 +187,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_ddbh_canopy_si_scls integer, private :: ih_ddbh_understory_si_scls integer, private :: ih_agb_si_scls - integer, private :: ih_b_si_scls + integer, private :: ih_biomass_si_scls ! mortality vars integer, private :: ih_m1_si_scls @@ -1232,7 +1232,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m7_si_scls => this%hvars(ih_m7_si_scls)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & hio_agb_si_scls => this%hvars(ih_agb_si_scls)%r82d, & - hio_b_si_scls => this%hvars(ih_b_si_scls)%r82d, & + hio_biomass_si_scls => this%hvars(ih_biomass_si_scls)%r82d, & hio_nplant_si_scls => this%hvars(ih_nplant_si_scls)%r82d, & hio_nplant_canopy_si_scls => this%hvars(ih_nplant_canopy_si_scls)%r82d, & hio_nplant_understory_si_scls => this%hvars(ih_nplant_understory_si_scls)%r82d, & @@ -1513,7 +1513,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_agb_si_scls(io_si,scls) = hio_agb_si_scls(io_si,scls) + & ccohort%b * ccohort%n * EDPftvarcon_inst%allom_agb_frac(ccohort%pft) * AREA_INV - hio_b_si_scls(io_si,scls) = hio_b_si_scls(io_si,scls) + & + hio_biomass_si_scls(io_si,scls) = hio_biomass_si_scls(io_si,scls) + & ccohort%b * ccohort%n * AREA_INV ! update size-class x patch-age related quantities @@ -3399,7 +3399,7 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='BIOMASS_SCLS', units = 'kgC/m2', & long='Total biomass by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_b_si_scls ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_biomass_si_scls ) call this%set_history_var(vname='DEMOTION_RATE_SCLS', units = 'indiv/ha/yr', & long='demotion rate from canopy to understory by size class', use_default='inactive', & From 491937869605884dc72cdb812b5a2a1da94b83c2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 27 Nov 2017 12:03:55 -0700 Subject: [PATCH 41/63] Shorten lines so can compile and run with the the NAG compiler. --- biogeochem/EDPhysiologyMod.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 7bc59ec483..dcdcdf437d 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -213,7 +213,8 @@ subroutine trim_canopy( currentSite ) if (currentCohort%hite > EDPftvarcon_inst%hgt_min(currentCohort%pft))then currentCohort%canopy_trim = currentCohort%canopy_trim - EDPftvarcon_inst%trim_inc(currentCohort%pft) if (EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then - currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - EDPftvarcon_inst%trim_inc(currentCohort%pft)) + currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - & + EDPftvarcon_inst%trim_inc(currentCohort%pft)) endif trimmed = 1 endif @@ -930,7 +931,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%npp_froot = currentCohort%npp_froot + & max(0.0_r8,currentCohort%carbon_balance*(currentCohort%root_md/currentCohort%md)) - balive_loss = currentCohort%md *(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft))- currentCohort%carbon_balance + balive_loss = currentCohort%md *(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) - & + currentCohort%carbon_balance currentCohort%carbon_balance = 0._r8 endif @@ -1584,7 +1586,8 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) currentCohort => currentPatch%tallest do while(associated(currentCohort)) biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + & - currentCohort%b * (currentCohort%n / currentPatch%area) * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + currentCohort%b * (currentCohort%n / currentPatch%area) * & + (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) currentCohort => currentCohort%shorter enddo !currentCohort ! From a7e5afeef7d1a15753ff104efed29adead48a19d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 20 Dec 2017 19:13:57 -0700 Subject: [PATCH 42/63] Changes to compile with nag on hobart --- biogeochem/EDCohortDynamicsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 8ed2c61200..6a6be90fac 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -851,7 +851,7 @@ subroutine fuse_cohorts(patchptr, bc_in) nextc%n*nextc%lmort_logging)/newn currentCohort%lmort_infra = (currentCohort%n*currentCohort%lmort_infra + & nextc%n*nextc%lmort_infra)/newn - currentCohort%lmort_collateral = (currentCohort%n*currentCohort%lmort_collateral + & + currentCohort%lmort_collateral = (currentCohort%n*currentCohort%lmort_collateral + & nextc%n*nextc%lmort_collateral)/newn currentCohort%fire_mort = (currentCohort%n*currentCohort%fire_mort + & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 68d13f9338..7bc7f1a393 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -843,9 +843,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) if (hlm_use_ed_prescribed_phys .eq. itrue) then if (currentCohort%canopy_layer .eq. 1) then - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(currentCohort%pft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_canopy(currentCohort%pft) & + * currentCohort%c_area / currentCohort%n else - currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(currentCohort%pft) * currentCohort%c_area / currentCohort%n + currentCohort%npp_acc_hold = EDPftvarcon_inst%prescribed_npp_understory(currentCohort%pft) & + * currentCohort%c_area / currentCohort%n endif endif From 9a436f61ba1b14bdb724119301f01bd48ceee33c Mon Sep 17 00:00:00 2001 From: rosiealice Date: Wed, 3 Jan 2018 13:06:32 -0700 Subject: [PATCH 43/63] Update README.md --- README.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index f95e973e84..8bc4f8b1a2 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # NGEE-T fates repository ------------------------------ -This is the developer repository of the Next Generation Ecosystem Experiment Tropics’ (NGEE-T) model: the Functionally Assembled Terrestrial Ecosystem Simulator (FATES). +This is the developer repository of the Next Generation Ecosystem Experiment Tropics’ (NGEE-T) model: the Functionally Assembled Terrestrial Ecosystem Simulator (FATES). (https://github.com/NGEET/fates) For more information on the FATES model, see our wiki: https://github.com/NGEET/fates/wiki @@ -20,3 +20,5 @@ http://www.cesm.ucar.edu/ The NGEE-T project maintains a mirror of CLM. That software system will automatically pull in the FATES software, and is where most users should go to clone the code: https://github.com/NGEET/fates-clm + + From 525153b5ddb1d88ec6162222d49a96e786351f1c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 11 Jan 2018 13:31:44 -0800 Subject: [PATCH 44/63] Added the script FatesPFTIndexSwapper.py to new tools directory --- tools/FatesPFTIndexSwapper.py | 219 ++++++++++++++++++++++++++++++++++ 1 file changed, 219 insertions(+) create mode 100644 tools/FatesPFTIndexSwapper.py diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py new file mode 100644 index 0000000000..56706136ff --- /dev/null +++ b/tools/FatesPFTIndexSwapper.py @@ -0,0 +1,219 @@ +# ======================================================================================= +# ======================================================================================= + +import numpy as np +import sys +import getopt +import code # For development: code.interact(local=locals()) +from datetime import datetime +from matplotlib.dates import date2num, num2date +import csv +from scipy.io import netcdf +import matplotlib.pyplot as plt + +# ======================================================================================= +# Parameters +# ======================================================================================= + +pft_dim_name = 'fates_pft' + + +class timetype: + + # This is time, like the thing that always goes forward and cant be seen + # or touched, insert creative riddle here + + def __init__(self,ntimes): + + self.year = -9*np.ones((ntimes)) + self.month = -9*np.ones((ntimes)) + # This is a floating point decimal day + self.day = -9.0*np.ones((ntimes)) + + # This is a decimal datenumber + self.datenum = -9.0*np.ones((ntimes)) + + +def usage(): + print('') + print('=======================================================================') + print('') + print(' python CloneFATESPFTFile.py -h --num-pfts=>n> ') + print(' --pft-index= ') + print(' --fin= ') + print(' --fout=') + print('') + print('') + print(' -h --help ') + print(' print this help message') + print('') + print('') + print(' --pft-index=') + print(' This is the PFT index of the base file that you want copied into the new file') + print('') + print('') + print(' --num-pfts=') + print(' This is the desired number of pfts you want in the output file.') + print('') + print('') + print(' --fin=') + print(' This is the full path to the netcdf file you are basing off of') + print('') + print('') + print(' --fout=') + print(' This is the full path to the netcdf file you are writing to.') + print('') + print('') + print('=======================================================================') + + +def interp_args(argv): + + argv.pop(0) # The script itself is the first argument, forget it + + # Name of the conversion file + + input_fname = "none" + output_fname = "none" + donor_pft_index = -9 + num_pft_out = -9 + try: + opts, args = getopt.getopt(argv, 'h',["fin=","fout=","pft-index=","num-pfts="]) + + except getopt.GetoptError as err: + print('Argument error, see usage') + usage() + sys.exit(2) + for o, a in opts: + if o in ("-h", "--help"): + usage() + sys.exit(0) + elif o in ("--fin"): + input_fname = a + elif o in ("--fout"): + output_fname = a + elif o in ("--pft-index"): + donor_pft_index = int(a.strip()) + elif o in ("--num-pfts"): + num_pft_out = int(a.strip()) + else: + assert False, "unhandled option" + + + if (input_fname == "none"): + print("You must specify an input file:") + usage() + sys.exit(2) + + if (output_fname == "none"): + print("You must specify an output file:") + usage() + sys.exit(2) + + if (donor_pft_index == -9): + print("You must specify the donor pft index, > 0:") + usage() + sys.exit(2) + + if (num_pft_out == -9): + print("You must specify the number of output pfts") + usage() + sys.exit(2) + + + return (input_fname,output_fname,donor_pft_index,num_pft_out) + + +# ======================================================================================== +# ======================================================================================== +# Main +# ======================================================================================== +# ======================================================================================== + +def main(argv): + + # Interpret the arguments to the script + [input_fname,output_fname,donor_pft_index,num_pft_out] = interp_args(argv) + + + # Open the netcdf files + fp_out = netcdf.netcdf_file(output_fname, 'w') + + fp_in = netcdf.netcdf_file(input_fname, 'r') + +# code.interact(local=locals()) + + for key, value in sorted(fp_in.dimensions.iteritems()): + print('Creating Dimension: ',value) + if(key==pft_dim_name): + fp_out.createDimension(key,int(num_pft_out)) + else: + fp_out.createDimension(key,int(value)) + + for key, value in sorted(fp_in.variables.iteritems()): + print('Creating Variable: ',key) + # code.interact(local=locals()) + + out_var = fp_out.createVariable(key,'f',(fp_in.variables.get(key).dimensions)) + in_var = fp_in.variables.get(key) + out_var.units = in_var.units + out_var.long_name = in_var.long_name + + # Idenfity if this variable has pft dimension + pft_dim_found = -1 + pft_dim_len = len(fp_in.variables.get(key).dimensions) + + for idim, name in enumerate(fp_in.variables.get(key).dimensions): + # Manipulate data + if(name==pft_dim_name): + pft_dim_found = idim + + # Copy over the input data + # Tedious, but I have to permute through all combinations of dimension position + if( pft_dim_len == 0 ): + out_var.assignValue(float(fp_in.variables.get(key).data)) + elif(pft_dim_found==-1): + out_var[:] = in_var[:] + elif( (pft_dim_found==0) & (pft_dim_len==1) ): # 1D fates_pft + tmp_out = fp_in.variables.get(key).data[donor_pft_index-1] * np.ones([num_pft_out]) + out_var[:] = tmp_out + elif( (pft_dim_found==1) & (pft_dim_len==2) ): # 2D hdyro_organ - fate_pft + dim2_len = fp_in.dimensions.get(fp_in.variables.get(key).dimensions[0]) + tmp_out = np.ones([dim2_len,num_pft_out]) + for idim in range(0,dim2_len): + tmp_out[idim,:] = tmp_out[idim,:] * fp_in.variables.get(key).data[idim,donor_pft_index-1] + out_var[:] = tmp_out + else: + print('This variable has a dimensioning that we have not considered yet.') + print('Please add this condition to the logic above this statement.') + print('Aborting') + exit(2) + + fp_out.history = "This file was made from CloneHLMPFTFile.py" + + + #var_out.mode = var.mode + #fp.flush() + + fp_in.close() + fp_out.close() + + print('Cloneing complete!') + exit(0) + + + + +# ======================================================================================= +# This is the actual call to main + +if __name__ == "__main__": + main(sys.argv) + + + + + + + + From 8bf7f9383d4f4f6dad7c3920051499a19fafc095 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 11 Jan 2018 14:58:10 -0800 Subject: [PATCH 45/63] Updated PFT swapper script to allow generic selecting and copying of pfts. --- tools/FatesPFTIndexSwapper.py | 78 +++++++++++++++++++---------------- 1 file changed, 42 insertions(+), 36 deletions(-) diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py index 56706136ff..837488c157 100644 --- a/tools/FatesPFTIndexSwapper.py +++ b/tools/FatesPFTIndexSwapper.py @@ -1,4 +1,10 @@ # ======================================================================================= +# +# This python script will open an input FATES parameter file, and given a list of PFT +# indices supplied by the user, will create a new parameter file with PFTs entries cloned +# from the original file as-per the list of indices supplied by the user. +# +# First Added, Ryan Knox: Thu Jan 11 13:36:14 PST 2018 # ======================================================================================= import numpy as np @@ -38,8 +44,7 @@ def usage(): print('') print('=======================================================================') print('') - print(' python CloneFATESPFTFile.py -h --num-pfts=>n> ') - print(' --pft-index= ') + print(' python FatesPFTIndexSwapper.py -h --pft-indices= ') print(' --fin= ') print(' --fout=') print('') @@ -48,12 +53,11 @@ def usage(): print(' print this help message') print('') print('') - print(' --pft-index=') - print(' This is the PFT index of the base file that you want copied into the new file') - print('') - print('') - print(' --num-pfts=') - print(' This is the desired number of pfts you want in the output file.') + print(' --pft-indices=') + print(' This is a comma delimited list of integer positions of the PFTs') + print(' to be copied into the new file. Note that first pft position') + print(' is treated as 1 (not C or python like), and any order or multiples') + print(' of indices can be chosen') print('') print('') print(' --fin=') @@ -75,10 +79,10 @@ def interp_args(argv): input_fname = "none" output_fname = "none" - donor_pft_index = -9 - num_pft_out = -9 + donor_pft_indices = -9 + donot_pft_indices_str = '' try: - opts, args = getopt.getopt(argv, 'h',["fin=","fout=","pft-index=","num-pfts="]) + opts, args = getopt.getopt(argv, 'h',["fin=","fout=","pft-indices="]) except getopt.GetoptError as err: print('Argument error, see usage') @@ -92,36 +96,33 @@ def interp_args(argv): input_fname = a elif o in ("--fout"): output_fname = a - elif o in ("--pft-index"): - donor_pft_index = int(a.strip()) - elif o in ("--num-pfts"): - num_pft_out = int(a.strip()) + elif o in ("--pft-indices"): + donor_pft_indices_str = a.strip() else: assert False, "unhandled option" if (input_fname == "none"): - print("You must specify an input file:") + print("You must specify an input file:\n\n") usage() sys.exit(2) if (output_fname == "none"): - print("You must specify an output file:") + print("You must specify an output file:\n\n") usage() sys.exit(2) - if (donor_pft_index == -9): - print("You must specify the donor pft index, > 0:") - usage() - sys.exit(2) - - if (num_pft_out == -9): - print("You must specify the number of output pfts") + if (donor_pft_indices_str == ''): + print("You must specify at least one donor pft index!\n\n") usage() sys.exit(2) + else: + donor_pft_indices = [] + for strpft in donor_pft_indices_str.split(','): + donor_pft_indices.append(int(strpft)) - return (input_fname,output_fname,donor_pft_index,num_pft_out) + return (input_fname,output_fname,donor_pft_indices) # ======================================================================================== @@ -133,22 +134,22 @@ def interp_args(argv): def main(argv): # Interpret the arguments to the script - [input_fname,output_fname,donor_pft_index,num_pft_out] = interp_args(argv) - + [input_fname,output_fname,donor_pft_indices] = interp_args(argv) + + num_pft_out = len(donor_pft_indices) # Open the netcdf files fp_out = netcdf.netcdf_file(output_fname, 'w') fp_in = netcdf.netcdf_file(input_fname, 'r') -# code.interact(local=locals()) - for key, value in sorted(fp_in.dimensions.iteritems()): - print('Creating Dimension: ',value) if(key==pft_dim_name): fp_out.createDimension(key,int(num_pft_out)) + print('Creating Dimension: {}={}'.format(key,num_pft_out)) else: fp_out.createDimension(key,int(value)) + print('Creating Dimension: {}={}'.format(key,value)) for key, value in sorted(fp_in.variables.iteritems()): print('Creating Variable: ',key) @@ -175,13 +176,18 @@ def main(argv): elif(pft_dim_found==-1): out_var[:] = in_var[:] elif( (pft_dim_found==0) & (pft_dim_len==1) ): # 1D fates_pft - tmp_out = fp_in.variables.get(key).data[donor_pft_index-1] * np.ones([num_pft_out]) + tmp_out = np.zeros([num_pft_out]) + for id,ipft in enumerate(donor_pft_indices): + tmp_out[id] = fp_in.variables.get(key).data[ipft-1] out_var[:] = tmp_out + + elif( (pft_dim_found==1) & (pft_dim_len==2) ): # 2D hdyro_organ - fate_pft dim2_len = fp_in.dimensions.get(fp_in.variables.get(key).dimensions[0]) - tmp_out = np.ones([dim2_len,num_pft_out]) - for idim in range(0,dim2_len): - tmp_out[idim,:] = tmp_out[idim,:] * fp_in.variables.get(key).data[idim,donor_pft_index-1] + tmp_out = np.zeros([dim2_len,num_pft_out]) + for id,ipft in enumerate(donor_pft_indices): + for idim in range(0,dim2_len): + tmp_out[idim,id] = fp_in.variables.get(key).data[idim,ipft-1] out_var[:] = tmp_out else: print('This variable has a dimensioning that we have not considered yet.') @@ -189,8 +195,8 @@ def main(argv): print('Aborting') exit(2) - fp_out.history = "This file was made from CloneHLMPFTFile.py" - + fp_out.history = "This file was made from FatesPFTIndexSwapper.py \n Input File = {} \n Indices = {}"\ + .format(input_fname,donor_pft_indices) #var_out.mode = var.mode #fp.flush() From 187b727f73f29301c2229a3668143ab1a82e3aca Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 11 Jan 2018 15:05:15 -0800 Subject: [PATCH 46/63] removed unused library calls at top of FatesPFTIndexSwapper.py --- tools/FatesPFTIndexSwapper.py | 2 -- 1 file changed, 2 deletions(-) diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py index 837488c157..9942dda333 100644 --- a/tools/FatesPFTIndexSwapper.py +++ b/tools/FatesPFTIndexSwapper.py @@ -12,8 +12,6 @@ import getopt import code # For development: code.interact(local=locals()) from datetime import datetime -from matplotlib.dates import date2num, num2date -import csv from scipy.io import netcdf import matplotlib.pyplot as plt From fb165ea4b7438d645ef8461f165029dcc1563050 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 12 Jan 2018 16:19:26 -0700 Subject: [PATCH 47/63] Fixed uninitialized dhdd (heigh deriv with diameter) in sapwood allometry --- biogeochem/EDCohortDynamicsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 6 +++--- biogeochem/FatesAllometryMod.F90 | 5 +++-- main/EDInitMod.F90 | 2 +- main/FatesInventoryInitMod.F90 | 2 +- 5 files changed, 9 insertions(+), 8 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 72f0ac1a8b..d075ec25c3 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -235,7 +235,7 @@ subroutine allocate_live_biomass(cc_p,mode) call bleaf(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_bl) call bfineroot(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_br) - call bsap_allom(currentcohort%dbh,currentcohort%hite,ft,currentcohort%canopy_trim,tar_bsw) + call bsap_allom(currentcohort%dbh,ft,currentcohort%canopy_trim,tar_bsw) leaf_frac = tar_bl/(tar_bl+tar_br+tar_bsw) bfr_per_leaf = tar_br/tar_bl diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 59844b68c3..a08f0bb2e8 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -885,7 +885,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass - call bsap_allom(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_sap) + call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,b_sap) target_balive = b_leaf + b_fineroot + b_sap @@ -1055,7 +1055,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%canopy_trim,b_leaf,db_leaf_dd) call bfineroot(currentCohort%dbh,currentCohort%hite,ipft, & currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) - call bsap_allom(currentCohort%dbh,currentCohort%hite,ipft, & + call bsap_allom(currentCohort%dbh,ipft, & currentCohort%canopy_trim,b_sap,db_sap_dd) ! Total change in alive biomass relative to dead biomass [kgC/kgC] @@ -1190,7 +1190,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! Initialize balive (leaf+fineroot+sapwood) call bleaf(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_leaf) call bfineroot(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_fineroot) - call bsap_allom(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_sapwood) + call bsap_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_sapwood) call bag_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_aboveground) call bcr_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_coarseroot) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index e8afe6c357..38e0631124 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -377,15 +377,15 @@ end subroutine bleaf ! Generic sapwood biomass interface ! ============================================================================ - subroutine bsap_allom(d,h,ipft,canopy_trim,bsap,dbsapdd) + subroutine bsap_allom(d,ipft,canopy_trim,bsap,dbsapdd) real(r8),intent(in) :: d ! plant diameter [cm] - real(r8),intent(in) :: h ! plant height [m] integer(i4),intent(in) :: ipft ! PFT index real(r8),intent(in) :: canopy_trim real(r8),intent(out) :: bsap ! plant leaf biomass [kgC] real(r8),intent(out),optional :: dbsapdd ! change leaf bio per d [kgC/cm] + real(r8) :: h ! Plant height [m] real(r8) :: dhdd real(r8) :: blmax real(r8) :: dblmaxdd @@ -401,6 +401,7 @@ subroutine bsap_allom(d,h,ipft,canopy_trim,bsap,dbsapdd) ! --------------------------------------------------------------------- case(1,2) !"constant","dlinear") + call h_allom(d,ipft,h,dhdd) if(test_b4b)then call bleaf(d,h,ipft,canopy_trim,blmax,dblmaxdd) else diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index f1fe6501a5..a6eed3097c 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -384,7 +384,7 @@ subroutine init_cohorts( patch_in, bc_in) call bfineroot(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_sapwood) + call bsap_allom(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_sapwood) temp_cohort%balive = b_leaf + b_fineroot + b_sapwood diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 66a8a8c5ef..ff8010a281 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -889,7 +889,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call bfineroot(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_sapwood) + call bsap_allom(temp_cohort%dbh,c_pft,temp_cohort%canopy_trim,b_sapwood) temp_cohort%balive = b_leaf + b_fineroot + b_sapwood From bbefa2d59050c1a4ceffccaa10d44ca9632e39c4 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 18 Jan 2018 09:14:27 -0800 Subject: [PATCH 48/63] updated copyright year in license file to 2018 --- LICENSE.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LICENSE.txt b/LICENSE.txt index 12f41fb609..be5cae20af 100644 --- a/LICENSE.txt +++ b/LICENSE.txt @@ -1,6 +1,6 @@ Functionally Assembled Terrestrial Ecosystem Simulator (“FATES”) -Copyright (c) 2016-2017, The Regents of the University of California, through Lawrence +Copyright (c) 2016-2018, The Regents of the University of California, through Lawrence Berkeley National Laboratory, University Corporation for Atmospheric Research, Los Alamos National Security, LLC (LANS), as operator of Los Alamos National Laboratory (LANL), and President and Fellows of Harvard College. All rights reserved. From 511e55cda7f0542194c18b67ee134421bbc535da Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 16:03:20 -0800 Subject: [PATCH 49/63] Added PR template and contributing. --- .github/PULL_REQUEST_TEMPLATE.md | 41 ++++++++++++++++++++++++++ CONTRIBUTING.md | 49 ++++++++++++++++++++++++++++++++ 2 files changed, 90 insertions(+) create mode 100644 .github/PULL_REQUEST_TEMPLATE.md create mode 100644 CONTRIBUTING.md diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000000..5119566ad3 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,41 @@ + + +## Description + + + +## Collaborators + + + + +## Answer Changing/B4b + + + + + +## Checklist: + + +- [ ] My change requires a change to the documentation. +- [ ] I have updated the in-code documentation AND wiki accordingly. +- [ ] I have read the **CONTRIBUTING** document. +- [ ] FATES PASS/FAIL regression tests were run +- [ ] If answers were expected to change, evaluation was performed and provided + +## Test Results: + + + + +FATES-CLM (or) HLM test hash-tag: +FATES-CLM (or) HLM baseline hash-tag: +FATES baseline hash-tag: + +Test Results: + + + + + \ No newline at end of file diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000000..4709c1df55 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,49 @@ +# How to contribute + +Thank you for considering contributing to the development of FATES. There are a few guidelines that we need contributions to follow. + +## Read and Understand the FATES license: + +https://github.com/NGEET/fates/blob/master/LICENSE.txt + + +## Getting Started + +Those who wish to contribute code back FATES, must have those changes integrated through the developer repository NGEET/fates. Changes that make it to public releases must go through this repository first, as well. Here are some basic first steps. + +* All developers should create a fork of the NGEET/fates repository into their personal space on github +* Each set of changes should have it's own feature branch that encapsulates your desired changes, following the conventions outlined here: https://github.com/NGEET/fates/wiki/Feature-Branch-Naming-Convention +* Follow the developer work-flow described here: https://github.com/NGEET/fates/wiki/FATES-Development-Workflow +* The work-flow will lead you eventually to submit a Pull-Request to NGEET/fates:master, please follow the template in the Pull Request and communicate as best you can if you are unsure how to fill out the text +* It is best to create an issue to describe the work your are undertaking prior to starting. This helps the community sync with your efforts, prevents duplication of efforts, and science is not done in a vaccuum. +* Expect peers to interact, help, discuss and eventually approve your submission (pull-request) + + +## Things to Remember + +* Make commits in logical units (i.e. group changes) +* Changes that are submitted should be limited to 1 single feature (i.e. don't submit changes to the radiation code and the nutrient cycle simultaneous, pick one thing) +* Check for unnecessary whitespace with `git diff --check` before committing +* We have no standard protocol for commit messages, but try to make them meaningful, concise and succinct. +* You will most likely have to test (see workflow above), see: https://github.com/NGEET/fates/wiki/Testing-Protocols + + +## Coding Practices and Style + +Please refer to the FATES style guide: https://github.com/NGEET/fates/wiki/Coding-Practices-and-Style-Guide + + +## Trivial Changes + +If changes are trivial, its possible testing will not be required, conversations via the Pull Request will address if tests are not needed + +## Documentation + +Yes please! If you are creating new code, fixing existing code, anything. Please add comments in the code itself. Please also follow the style guide for comments. Also, please create and/or modify wiki documentation on this stuff too. + + +## Additional Resources + +* [General GitHub documentation](https://help.github.com/) +* [GitHub pull request documentation](https://help.github.com/articles/creating-a-pull-request/) +* [FATES Wiki](https://github.com/NGEET/fates/wiki) From 8879b0ef5ed98e39dd13537439b90bd2046ba081 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 16:11:26 -0800 Subject: [PATCH 50/63] Edited language in the PR template and CONTRIBUTING.md --- .github/PULL_REQUEST_TEMPLATE.md | 12 ++++++------ CONTRIBUTING.md | 9 +++++---- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 5119566ad3..b942bc4f81 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -1,21 +1,21 @@ -## Description +### Description -## Collaborators +### Collaborators -## Answer Changing/B4b +### Answer Changing/B4B -## Checklist: +### Checklist: - [ ] My change requires a change to the documentation. @@ -24,7 +24,7 @@ - [ ] FATES PASS/FAIL regression tests were run - [ ] If answers were expected to change, evaluation was performed and provided -## Test Results: +### Test Results: @@ -33,7 +33,7 @@ FATES-CLM (or) HLM test hash-tag: FATES-CLM (or) HLM baseline hash-tag: FATES baseline hash-tag: -Test Results: +Test Output: diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 4709c1df55..ec71fd95b3 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -9,13 +9,14 @@ https://github.com/NGEET/fates/blob/master/LICENSE.txt ## Getting Started -Those who wish to contribute code back FATES, must have those changes integrated through the developer repository NGEET/fates. Changes that make it to public releases must go through this repository first, as well. Here are some basic first steps. +Those who wish to contribute code to FATES must have those changes integrated through the developer repository NGEET/fates. Changes that make it to public releases must go through this repository first, as well. Here are some basic first steps. * All developers should create a fork of the NGEET/fates repository into their personal space on github -* Each set of changes should have it's own feature branch that encapsulates your desired changes, following the conventions outlined here: https://github.com/NGEET/fates/wiki/Feature-Branch-Naming-Convention * Follow the developer work-flow described here: https://github.com/NGEET/fates/wiki/FATES-Development-Workflow + +* Each set of changes should have it's own feature branch that encapsulates your desired changes, following the conventions outlined here: https://github.com/NGEET/fates/wiki/Feature-Branch-Naming-Convention * The work-flow will lead you eventually to submit a Pull-Request to NGEET/fates:master, please follow the template in the Pull Request and communicate as best you can if you are unsure how to fill out the text -* It is best to create an issue to describe the work your are undertaking prior to starting. This helps the community sync with your efforts, prevents duplication of efforts, and science is not done in a vaccuum. +* It is best to create an issue to describe the work your are undertaking prior to starting. This helps the community sync with your efforts, prevents duplication of efforts, and science is not done in a vaccuum! * Expect peers to interact, help, discuss and eventually approve your submission (pull-request) @@ -39,7 +40,7 @@ If changes are trivial, its possible testing will not be required, conversations ## Documentation -Yes please! If you are creating new code, fixing existing code, anything. Please add comments in the code itself. Please also follow the style guide for comments. Also, please create and/or modify wiki documentation on this stuff too. +Yes please! If you are creating new code, fixing existing code, anything. Please add comments in the code itself. Please also follow the style guide for comments. Also, please create and/or modify existing wiki documentation. You may be asked to add documtation prior to having a pull-request approved. ## Additional Resources From 8e8684fe50731ec17075694c16b0657ca574fd9d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 16:12:29 -0800 Subject: [PATCH 51/63] Edited language in the PR template and CONTRIBUTING.md --- .github/PULL_REQUEST_TEMPLATE.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index b942bc4f81..64d57ab000 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -30,7 +30,9 @@ FATES-CLM (or) HLM test hash-tag: + FATES-CLM (or) HLM baseline hash-tag: + FATES baseline hash-tag: Test Output: From f408a93259d08d930d9407ed7ccd75236f72a920 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 16:13:56 -0800 Subject: [PATCH 52/63] Edited language in the PR template --- .github/PULL_REQUEST_TEMPLATE.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 64d57ab000..f0d278be10 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -1,15 +1,15 @@ -### Description +### Description: -### Collaborators +### Collaborators: -### Answer Changing/B4B +### Expectation of Answer Changes: From 7608e8770b28114d645368474aed649ab649c581 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 16:15:25 -0800 Subject: [PATCH 53/63] Edited language in the PR template --- .github/PULL_REQUEST_TEMPLATE.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index f0d278be10..3b35cc8d09 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -20,10 +20,11 @@ - [ ] My change requires a change to the documentation. - [ ] I have updated the in-code documentation AND wiki accordingly. -- [ ] I have read the **CONTRIBUTING** document. +- [ ] I have read the [**CONTRIBUTING**](https://github.com/rgknox/fates/blob/rgknox-new-PR-template/CONTRIBUTING.md) document. - [ ] FATES PASS/FAIL regression tests were run - [ ] If answers were expected to change, evaluation was performed and provided + ### Test Results: From fc2a774295f7ba0a7b0cced05f6cddb6330a1eba Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 19 Jan 2018 11:55:59 -0800 Subject: [PATCH 54/63] Removed the = sign in the help message to indicate they are not needed --- tools/FatesPFTIndexSwapper.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py index 9942dda333..b582ccccc1 100644 --- a/tools/FatesPFTIndexSwapper.py +++ b/tools/FatesPFTIndexSwapper.py @@ -42,9 +42,9 @@ def usage(): print('') print('=======================================================================') print('') - print(' python FatesPFTIndexSwapper.py -h --pft-indices= ') - print(' --fin= ') - print(' --fout=') + print(' python FatesPFTIndexSwapper.py -h --pft-indices ') + print(' --fin ') + print(' --fout ') print('') print('') print(' -h --help ') @@ -81,11 +81,11 @@ def interp_args(argv): donot_pft_indices_str = '' try: opts, args = getopt.getopt(argv, 'h',["fin=","fout=","pft-indices="]) - except getopt.GetoptError as err: print('Argument error, see usage') usage() sys.exit(2) + for o, a in opts: if o in ("-h", "--help"): usage() From bff72c44a775a116c5fff25ab665963c4392028b Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 19 Jan 2018 11:57:19 -0800 Subject: [PATCH 55/63] Removed the = sign in the help message to indicate they are not needed, second --- tools/FatesPFTIndexSwapper.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py index b582ccccc1..72c891071e 100644 --- a/tools/FatesPFTIndexSwapper.py +++ b/tools/FatesPFTIndexSwapper.py @@ -51,18 +51,18 @@ def usage(): print(' print this help message') print('') print('') - print(' --pft-indices=') + print(' --pft-indices ') print(' This is a comma delimited list of integer positions of the PFTs') print(' to be copied into the new file. Note that first pft position') print(' is treated as 1 (not C or python like), and any order or multiples') print(' of indices can be chosen') print('') print('') - print(' --fin=') + print(' --fin ') print(' This is the full path to the netcdf file you are basing off of') print('') print('') - print(' --fout=') + print(' --fout ') print(' This is the full path to the netcdf file you are writing to.') print('') print('') From 8b115bb24bb99e96e4f9aea8920ce6f1e9382150 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 19 Jan 2018 13:01:34 -0800 Subject: [PATCH 56/63] added script modify_fates_paramfile.py --- tools/modify_fates_paramfile.py | 95 +++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100755 tools/modify_fates_paramfile.py diff --git a/tools/modify_fates_paramfile.py b/tools/modify_fates_paramfile.py new file mode 100755 index 0000000000..c81a944b55 --- /dev/null +++ b/tools/modify_fates_paramfile.py @@ -0,0 +1,95 @@ +#!/usr/bin/env python + +#### this script modifies a FATES parameter file. It accepts the following flags +# --var or --variable: variable. +# --pft or --PFT: PFT number. If this is missing, script will assume that its a global variable that is being modified. +# --input or --fin: input filename. +# --output or --fout: output filename. If missing, will assume its directly modifying the input file, and will prompt unless -O is specified +# --O or --overwrite: overwrite output file without asking. +# --value or --val: value to put in variable +#### + + +# ======================================================================================= +# ======================================================================================= + +import numpy as np +import os +from scipy.io import netcdf as nc +import argparse +import shutil + +# ======================================================================================== +# ======================================================================================== +# Main +# ======================================================================================== +# ======================================================================================== + +def main(): + parser = argparse.ArgumentParser(description='Parse command line arguments to this script.') + # + parser.add_argument('--var','--variable', dest='varname', type=str, help="What variable to modify? Required.", required=True) + parser.add_argument('--pft','--PFT', dest='pftnum', type=int, help="PFT number to modify. If this is missing, will assume a global variable.") + parser.add_argument('--fin', '--input', dest='inputfname', type=str, help="Input filename. Required.", required=True) + parser.add_argument('--fout','--output', dest='outputfname', type=str, help="Output filename. Required.", required=True) + parser.add_argument('--val', '--value', dest='val', type=float, help="New value of PFT variable. Required.", required=True) + parser.add_argument('--O','--overwrite', dest='overwrite', help="If present, automatically overwrite the output file.", action="store_true") + # + args = parser.parse_args() + # print(args.varname, args.pftnum, args.inputfname, args.outputfname, args.val, args.overwrite) + # + # check to see if output file exists + if os.path.isfile(args.outputfname): + if args.overwrite: + print('replacing file: '+args.outputfname) + os.remove(args.outputfname) + else: + raise ValueError('Output file already exists and overwrite flag not specified for filename: '+args.outputfname) + # + shutil.copyfile(args.inputfname, args.outputfname) + # + ncfile = nc.netcdf_file(args.outputfname, 'a') + # + var = ncfile.variables[args.varname] + # + ### check to make sure that, if a PFT is specified, the variable has a PFT dimension, and if not, then it doesn't. and also that shape is reasonable. + ndim_file = len(var.dimensions) + ispftvar = False + for i in range(ndim_file): + if var.dimensions[i] == 'fates_pft': + ispftvar = True + npft_file = var.shape[i] + pftdim = 0 + else: + npft_file = None + pftdim = None + if args.pftnum == None and ispftvar: + raise ValueError('pft value is missing but variable has pft dimension.') + if args.pftnum != None and not ispftvar: + raise ValueError('pft value is present but variable does not have pft dimension.') + if ndim_file > 1: + raise ValueError('variable dimensionality is too high for this script') + if ndim_file == 1 and not ispftvar: + raise ValueError('variable dimensionality is too high for this script') + if args.pftnum != None and ispftvar: + if args.pftnum > npft_file: + raise ValueError('PFT specified ('+str(args.pftnum)+') is larger than the number of PFTs in the file ('+str(npft_file)+').') + if pftdim == 0: + var[args.pftnum-1] = args.val + elif args.pftnum == None and not ispftvar: + var[:] = args.val + else: + raise ValueError('Nothing happened somehow.') + # + # + ncfile.close() + + + + +# ======================================================================================= +# This is the actual call to main + +if __name__ == "__main__": + main() + From ffa4956ac98bed6235aa7620df2747ede02d551d Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 19 Jan 2018 13:49:48 -0800 Subject: [PATCH 57/63] added execution permission on pftindexswapper and added silent mode on modify_paramfile. --- tools/FatesPFTIndexSwapper.py | 2 ++ tools/modify_fates_paramfile.py | 9 ++++++++- 2 files changed, 10 insertions(+), 1 deletion(-) mode change 100644 => 100755 tools/FatesPFTIndexSwapper.py diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py old mode 100644 new mode 100755 index 72c891071e..af901b3d18 --- a/tools/FatesPFTIndexSwapper.py +++ b/tools/FatesPFTIndexSwapper.py @@ -1,3 +1,5 @@ +#!/usr/bin/env python + # ======================================================================================= # # This python script will open an input FATES parameter file, and given a list of PFT diff --git a/tools/modify_fates_paramfile.py b/tools/modify_fates_paramfile.py index c81a944b55..92ab14dab1 100755 --- a/tools/modify_fates_paramfile.py +++ b/tools/modify_fates_paramfile.py @@ -7,6 +7,7 @@ # --output or --fout: output filename. If missing, will assume its directly modifying the input file, and will prompt unless -O is specified # --O or --overwrite: overwrite output file without asking. # --value or --val: value to put in variable +# --s or --silent: don't write anything on successful execution. #### @@ -34,6 +35,7 @@ def main(): parser.add_argument('--fout','--output', dest='outputfname', type=str, help="Output filename. Required.", required=True) parser.add_argument('--val', '--value', dest='val', type=float, help="New value of PFT variable. Required.", required=True) parser.add_argument('--O','--overwrite', dest='overwrite', help="If present, automatically overwrite the output file.", action="store_true") + parser.add_argument('--silent', '--s', dest='silent', help="prevent writing of output.", action="store_true") # args = parser.parse_args() # print(args.varname, args.pftnum, args.inputfname, args.outputfname, args.val, args.overwrite) @@ -41,7 +43,8 @@ def main(): # check to see if output file exists if os.path.isfile(args.outputfname): if args.overwrite: - print('replacing file: '+args.outputfname) + if not args.silent: + print('replacing file: '+args.outputfname) os.remove(args.outputfname) else: raise ValueError('Output file already exists and overwrite flag not specified for filename: '+args.outputfname) @@ -75,8 +78,12 @@ def main(): if args.pftnum > npft_file: raise ValueError('PFT specified ('+str(args.pftnum)+') is larger than the number of PFTs in the file ('+str(npft_file)+').') if pftdim == 0: + if not args.silent: + print('replacing prior value of variable '+args.varname+', for PFT '+str(args.pftnum)+', which was '+str(var[args.pftnum-1])+', with new value of '+str(args.val)) var[args.pftnum-1] = args.val elif args.pftnum == None and not ispftvar: + if not args.silent: + print('replacing prior value of variable '+args.varname+', which was '+str(var[:])+', with new value of '+str(args.val)) var[:] = args.val else: raise ValueError('Nothing happened somehow.') From 3d790845cf681d36827a1ee95c76ec4fa465b658 Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 19 Jan 2018 15:42:49 -0700 Subject: [PATCH 58/63] added link to developer repo policy and fixed a couple typos --- CONTRIBUTING.md | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index ec71fd95b3..95028b56eb 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -6,6 +6,9 @@ Thank you for considering contributing to the development of FATES. There are a https://github.com/NGEET/fates/blob/master/LICENSE.txt +## If working with unreleased code, please read the use policy that governs the developer repository: + +https://github.com/NGEET/fates/wiki/Use-and-distribution-policy-for-fates-developer-repository ## Getting Started @@ -13,10 +16,9 @@ Those who wish to contribute code to FATES must have those changes integrated th * All developers should create a fork of the NGEET/fates repository into their personal space on github * Follow the developer work-flow described here: https://github.com/NGEET/fates/wiki/FATES-Development-Workflow - -* Each set of changes should have it's own feature branch that encapsulates your desired changes, following the conventions outlined here: https://github.com/NGEET/fates/wiki/Feature-Branch-Naming-Convention +* Each set of changes should have its own feature branch that encapsulates your desired changes, following the conventions outlined here: https://github.com/NGEET/fates/wiki/Feature-Branch-Naming-Convention * The work-flow will lead you eventually to submit a Pull-Request to NGEET/fates:master, please follow the template in the Pull Request and communicate as best you can if you are unsure how to fill out the text -* It is best to create an issue to describe the work your are undertaking prior to starting. This helps the community sync with your efforts, prevents duplication of efforts, and science is not done in a vaccuum! +* It is best to create an issue to describe the work you are undertaking prior to starting. This helps the community sync with your efforts, prevents duplication of efforts, and science is not done in a vaccuum! * Expect peers to interact, help, discuss and eventually approve your submission (pull-request) @@ -36,7 +38,7 @@ Please refer to the FATES style guide: https://github.com/NGEET/fates/wiki/Codin ## Trivial Changes -If changes are trivial, its possible testing will not be required, conversations via the Pull Request will address if tests are not needed +If changes are trivial, it's possible testing will not be required. Conversations via the Pull Request will address if tests are not needed ## Documentation From c6d508b7f90d3ba2fd4ce5c8043686e602d914cb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 24 Jan 2018 23:10:14 -0700 Subject: [PATCH 59/63] Get unit tests working by listing all files needed --- main/CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index 5f8dbdcfb9..4506d2c354 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -2,7 +2,13 @@ # source files that are currently used in unit tests list(APPEND clm_sources + FatesGlobals.F90 + EDTypesMod.F90 EDPftvarcon.F90 + FatesConstantsMod.F90 + FatesHydraulicsMemMod.F90 + FatesParametersInterface.F90 + FatesUtilsMod.F90 ) sourcelist_to_parent(clm_sources) From eac687ba39bdc6ca27e8c27e134c9de56d812bac Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 Jan 2018 14:54:48 -0700 Subject: [PATCH 60/63] Temporarily disabling NPP partition diagnostics --- main/FatesHistoryInterfaceMod.F90 | 202 +++++++++++++++--------------- 1 file changed, 102 insertions(+), 100 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 79e63357ca..3c3b2a5072 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1461,21 +1461,23 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & ccohort%npp_store*n_perm2 - if( abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_froot+ & - ccohort%npp_bsw+ccohort%npp_bdead+ & - ccohort%npp_bseed+ccohort%npp_store))>1.e-9) then - write(fates_log(),*) 'NPP Partitions are not balancing' - write(fates_log(),*) 'Fractional Error: ', & - abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_froot+ & - ccohort%npp_bsw+ccohort%npp_bdead+ & - ccohort%npp_bseed+ccohort%npp_store))/ccohort%npp_acc_hold - write(fates_log(),*) 'Terms: ',ccohort%npp_acc_hold,ccohort%npp_leaf,ccohort%npp_froot, & - ccohort%npp_bsw,ccohort%npp_bdead, & - ccohort%npp_bseed,ccohort%npp_store - write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance ' - stop ! we need termination control for FATES!!! - ! call endrun(msg=errMsg(__FILE__, __LINE__)) - end if + ! TEMPORARILY DISABLING THIS UNTIL THE ALLOCATION REFACTOR IS COMPLETE + ! RGK Feb-2017 +! if( abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_froot+ & +! ccohort%npp_bsw+ccohort%npp_bdead+ & +! ccohort%npp_bseed+ccohort%npp_store))>1.e-9) then +! write(fates_log(),*) 'NPP Partitions are not balancing' +! write(fates_log(),*) 'Fractional Error: ', & +! abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_froot+ & +! ccohort%npp_bsw+ccohort%npp_bdead+ & +! ccohort%npp_bseed+ccohort%npp_store))/ccohort%npp_acc_hold +! write(fates_log(),*) 'Terms: ',ccohort%npp_acc_hold,ccohort%npp_leaf,ccohort%npp_froot, & +! ccohort%npp_bsw,ccohort%npp_bdead, & +! ccohort%npp_bseed,ccohort%npp_store +! write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance ' +! stop ! we need termination control for FATES!!! +! ! call endrun(msg=errMsg(__FILE__, __LINE__)) +! end if ! Woody State Variables (basal area and number density and mortality) if (EDPftvarcon_inst%woody(ft) == 1) then @@ -3157,45 +3159,45 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_totl_si_scpf ) - call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & - long='NPP flux into leaves by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_si_scpf ) +! call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & +! long='NPP flux into leaves by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_si_scpf ) - call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & - long='NPP flux into seeds by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_si_scpf ) +! call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & +! long='NPP flux into seeds by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_si_scpf ) - call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & - long='NPP flux into fine roots by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_si_scpf ) +! call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & +! long='NPP flux into fine roots by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_si_scpf ) - call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & - long='NPP flux into below-ground sapwood by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgsw_si_scpf ) +! call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & +! long='NPP flux into below-ground sapwood by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgsw_si_scpf ) - call this%set_history_var(vname='NPP_BGDW_SCPF', units='kgC/m2/yr', & - long='NPP flux into below-ground deadwood by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgdw_si_scpf ) +! call this%set_history_var(vname='NPP_BGDW_SCPF', units='kgC/m2/yr', & +! long='NPP flux into below-ground deadwood by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgdw_si_scpf ) - call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & - long='NPP flux into above-ground sapwood by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agsw_si_scpf ) +! call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & +! long='NPP flux into above-ground sapwood by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agsw_si_scpf ) - call this%set_history_var(vname = 'NPP_AGDW_SCPF', units='kgC/m2/yr', & - long='NPP flux into above-ground deadwood by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agdw_si_scpf ) +! call this%set_history_var(vname = 'NPP_AGDW_SCPF', units='kgC/m2/yr', & +! long='NPP flux into above-ground deadwood by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agdw_si_scpf ) - call this%set_history_var(vname = 'NPP_STOR_SCPF', units='kgC/m2/yr', & - long='NPP flux into storage by pft/size', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_si_scpf ) +! call this%set_history_var(vname = 'NPP_STOR_SCPF', units='kgC/m2/yr', & +! long='NPP flux into storage by pft/size', use_default='inactive', & +! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_si_scpf ) call this%set_history_var(vname='DDBH_SCPF', units = 'cm/yr/ha', & long='diameter growth increment by pft/size',use_default='inactive', & @@ -3531,35 +3533,35 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storage_flux_canopy_si_scls ) - call this%set_history_var(vname='NPP_LEAF_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='NPP_LEAF for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_canopy_si_scls ) +! call this%set_history_var(vname='NPP_LEAF_CANOPY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_LEAF for canopy plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_canopy_si_scls ) - call this%set_history_var(vname='NPP_FROOT_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='NPP_FROOT for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_canopy_si_scls ) +! call this%set_history_var(vname='NPP_FROOT_CANOPY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_FROOT for canopy plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_canopy_si_scls ) - call this%set_history_var(vname='NPP_BSW_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='NPP_BSW for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_canopy_si_scls ) +! call this%set_history_var(vname='NPP_BSW_CANOPY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_BSW for canopy plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_canopy_si_scls ) - call this%set_history_var(vname='NPP_BDEAD_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='NPP_BDEAD for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_canopy_si_scls ) +! call this%set_history_var(vname='NPP_BDEAD_CANOPY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_BDEAD for canopy plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_canopy_si_scls ) - call this%set_history_var(vname='NPP_BSEED_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='NPP_BSEED for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_canopy_si_scls ) +! call this%set_history_var(vname='NPP_BSEED_CANOPY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_BSEED for canopy plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_canopy_si_scls ) - call this%set_history_var(vname='NPP_STORE_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='NPP_STORE for canopy plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_canopy_si_scls ) +! call this%set_history_var(vname='NPP_STORE_CANOPY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_STORE for canopy plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_canopy_si_scls ) call this%set_history_var(vname='RDARK_CANOPY_SCLS', units = 'kg C / ha / yr', & long='RDARK for canopy plants by size class', use_default='inactive', & @@ -3631,35 +3633,35 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storage_flux_understory_si_scls ) - call this%set_history_var(vname='NPP_LEAF_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='NPP_LEAF for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_understory_si_scls ) - - call this%set_history_var(vname='NPP_FROOT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='NPP_FROOT for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_understory_si_scls ) - - call this%set_history_var(vname='NPP_BSW_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='NPP_BSW for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_understory_si_scls ) - - call this%set_history_var(vname='NPP_BDEAD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='NPP_BDEAD for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_understory_si_scls ) - - call this%set_history_var(vname='NPP_BSEED_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='NPP_BSEED for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_understory_si_scls ) - - call this%set_history_var(vname='NPP_STORE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='NPP_STORE for understory plants by size class', use_default='inactive', & - avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_understory_si_scls ) +! call this%set_history_var(vname='NPP_LEAF_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_LEAF for understory plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_understory_si_scls ) + +! call this%set_history_var(vname='NPP_FROOT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_FROOT for understory plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_understory_si_scls ) + +! call this%set_history_var(vname='NPP_BSW_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_BSW for understory plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_understory_si_scls ) + +! call this%set_history_var(vname='NPP_BDEAD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_BDEAD for understory plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_understory_si_scls ) + +! call this%set_history_var(vname='NPP_BSEED_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_BSEED for understory plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_understory_si_scls ) + +! call this%set_history_var(vname='NPP_STORE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & +! long='NPP_STORE for understory plants by size class', use_default='inactive', & +! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & +! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_understory_si_scls ) call this%set_history_var(vname='RDARK_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & long='RDARK for understory plants by size class', use_default='inactive', & From 3291661804b461fe7c2372e79c8d26793f0b5f18 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 Jan 2018 15:43:09 -0700 Subject: [PATCH 61/63] Modified method of turning off NPP partition diagnostics. Allowing history variables to exist to accomodate testing, but forcing invalid flagged values. --- main/FatesHistoryInterfaceMod.F90 | 267 +++++++++++++++--------------- 1 file changed, 134 insertions(+), 133 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 3c3b2a5072..a76a2419eb 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1436,30 +1436,30 @@ subroutine update_history_dyn(this,nc,nsites,sites) associate( scpf => ccohort%size_by_pft_class, & scls => ccohort%size_class ) - hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & - n_perm2*ccohort%gpp_acc_hold ! [kgC/m2/yr] - hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & - ccohort%npp_acc_hold *n_perm2 - hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & - ccohort%npp_leaf*n_perm2 - hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & - ccohort%npp_froot*n_perm2 - hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & - ccohort%npp_bsw*n_perm2* & - (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) - hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & - ccohort%npp_bsw*n_perm2* & - EDPftvarcon_inst%allom_agb_frac(ccohort%pft) - hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & - ccohort%npp_bdead*n_perm2* & - (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) - hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & - ccohort%npp_bdead*n_perm2* & - EDPftvarcon_inst%allom_agb_frac(ccohort%pft) - hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & - ccohort%npp_bseed*n_perm2 - hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & - ccohort%npp_store*n_perm2 +! hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & +! n_perm2*ccohort%gpp_acc_hold ! [kgC/m2/yr] +! hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & +! ccohort%npp_acc_hold *n_perm2 +! hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & +! ccohort%npp_leaf*n_perm2 +! hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & +! ccohort%npp_froot*n_perm2 +! hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & +! ccohort%npp_bsw*n_perm2* & +! (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) +! hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & +! ccohort%npp_bsw*n_perm2* & +! EDPftvarcon_inst%allom_agb_frac(ccohort%pft) +! hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & +! ccohort%npp_bdead*n_perm2* & +! (1._r8-EDPftvarcon_inst%allom_agb_frac(ccohort%pft)) +! hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & +! ccohort%npp_bdead*n_perm2* & +! EDPftvarcon_inst%allom_agb_frac(ccohort%pft) +! hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & +! ccohort%npp_bseed*n_perm2 +! hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & +! ccohort%npp_store*n_perm2 ! TEMPORARILY DISABLING THIS UNTIL THE ALLOCATION REFACTOR IS COMPLETE ! RGK Feb-2017 @@ -1592,18 +1592,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%dbstoredt * ccohort%n hio_storage_flux_canopy_si_scls(io_si,scls) = hio_storage_flux_canopy_si_scls(io_si,scls) + & ccohort%storage_flux * ccohort%n - hio_npp_leaf_canopy_si_scls(io_si,scls) = hio_npp_leaf_canopy_si_scls(io_si,scls) + & - ccohort%npp_leaf * ccohort%n - hio_npp_froot_canopy_si_scls(io_si,scls) = hio_npp_froot_canopy_si_scls(io_si,scls) + & - ccohort%npp_froot * ccohort%n - hio_npp_bsw_canopy_si_scls(io_si,scls) = hio_npp_bsw_canopy_si_scls(io_si,scls) + & - ccohort%npp_bsw * ccohort%n - hio_npp_bdead_canopy_si_scls(io_si,scls) = hio_npp_bdead_canopy_si_scls(io_si,scls) + & - ccohort%npp_bdead * ccohort%n - hio_npp_bseed_canopy_si_scls(io_si,scls) = hio_npp_bseed_canopy_si_scls(io_si,scls) + & - ccohort%npp_bseed * ccohort%n - hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + & - ccohort%npp_store * ccohort%n + +! hio_npp_leaf_canopy_si_scls(io_si,scls) = hio_npp_leaf_canopy_si_scls(io_si,scls) + & +! ccohort%npp_leaf * ccohort%n +! hio_npp_froot_canopy_si_scls(io_si,scls) = hio_npp_froot_canopy_si_scls(io_si,scls) + & +! ccohort%npp_froot * ccohort%n +! hio_npp_bsw_canopy_si_scls(io_si,scls) = hio_npp_bsw_canopy_si_scls(io_si,scls) + & +! ccohort%npp_bsw * ccohort%n +! hio_npp_bdead_canopy_si_scls(io_si,scls) = hio_npp_bdead_canopy_si_scls(io_si,scls) + & +! ccohort%npp_bdead * ccohort%n +! hio_npp_bseed_canopy_si_scls(io_si,scls) = hio_npp_bseed_canopy_si_scls(io_si,scls) + & +! ccohort%npp_bseed * ccohort%n +! hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + & +! ccohort%npp_store * ccohort%n hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n @@ -1671,18 +1672,18 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%dbstoredt * ccohort%n hio_storage_flux_understory_si_scls(io_si,scls) = hio_storage_flux_understory_si_scls(io_si,scls) + & ccohort%storage_flux * ccohort%n - hio_npp_leaf_understory_si_scls(io_si,scls) = hio_npp_leaf_understory_si_scls(io_si,scls) + & - ccohort%npp_leaf * ccohort%n - hio_npp_froot_understory_si_scls(io_si,scls) = hio_npp_froot_understory_si_scls(io_si,scls) + & - ccohort%npp_froot * ccohort%n - hio_npp_bsw_understory_si_scls(io_si,scls) = hio_npp_bsw_understory_si_scls(io_si,scls) + & - ccohort%npp_bsw * ccohort%n - hio_npp_bdead_understory_si_scls(io_si,scls) = hio_npp_bdead_understory_si_scls(io_si,scls) + & - ccohort%npp_bdead * ccohort%n - hio_npp_bseed_understory_si_scls(io_si,scls) = hio_npp_bseed_understory_si_scls(io_si,scls) + & - ccohort%npp_bseed * ccohort%n - hio_npp_store_understory_si_scls(io_si,scls) = hio_npp_store_understory_si_scls(io_si,scls) + & - ccohort%npp_store * ccohort%n +! hio_npp_leaf_understory_si_scls(io_si,scls) = hio_npp_leaf_understory_si_scls(io_si,scls) + & +! ccohort%npp_leaf * ccohort%n +! hio_npp_froot_understory_si_scls(io_si,scls) = hio_npp_froot_understory_si_scls(io_si,scls) + & +! ccohort%npp_froot * ccohort%n +! hio_npp_bsw_understory_si_scls(io_si,scls) = hio_npp_bsw_understory_si_scls(io_si,scls) + & +! ccohort%npp_bsw * ccohort%n +! hio_npp_bdead_understory_si_scls(io_si,scls) = hio_npp_bdead_understory_si_scls(io_si,scls) + & +! ccohort%npp_bdead * ccohort%n +! hio_npp_bseed_understory_si_scls(io_si,scls) = hio_npp_bseed_understory_si_scls(io_si,scls) + & +! ccohort%npp_bseed * ccohort%n +! hio_npp_store_understory_si_scls(io_si,scls) = hio_npp_store_understory_si_scls(io_si,scls) + & +! ccohort%npp_store * ccohort%n hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n @@ -3159,45 +3160,45 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_totl_si_scpf ) -! call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & -! long='NPP flux into leaves by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_si_scpf ) + call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & + long='NPP flux into leaves by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_si_scpf ) -! call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & -! long='NPP flux into seeds by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_si_scpf ) + call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & + long='NPP flux into seeds by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_si_scpf ) -! call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & -! long='NPP flux into fine roots by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_si_scpf ) + call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & + long='NPP flux into fine roots by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_si_scpf ) -! call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & -! long='NPP flux into below-ground sapwood by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgsw_si_scpf ) + call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & + long='NPP flux into below-ground sapwood by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgsw_si_scpf ) -! call this%set_history_var(vname='NPP_BGDW_SCPF', units='kgC/m2/yr', & -! long='NPP flux into below-ground deadwood by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgdw_si_scpf ) + call this%set_history_var(vname='NPP_BGDW_SCPF', units='kgC/m2/yr', & + long='NPP flux into below-ground deadwood by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgdw_si_scpf ) -! call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & -! long='NPP flux into above-ground sapwood by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agsw_si_scpf ) + call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & + long='NPP flux into above-ground sapwood by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agsw_si_scpf ) -! call this%set_history_var(vname = 'NPP_AGDW_SCPF', units='kgC/m2/yr', & -! long='NPP flux into above-ground deadwood by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agdw_si_scpf ) + call this%set_history_var(vname = 'NPP_AGDW_SCPF', units='kgC/m2/yr', & + long='NPP flux into above-ground deadwood by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agdw_si_scpf ) -! call this%set_history_var(vname = 'NPP_STOR_SCPF', units='kgC/m2/yr', & -! long='NPP flux into storage by pft/size', use_default='inactive', & -! avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_si_scpf ) + call this%set_history_var(vname = 'NPP_STOR_SCPF', units='kgC/m2/yr', & + long='NPP flux into storage by pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_si_scpf ) call this%set_history_var(vname='DDBH_SCPF', units = 'cm/yr/ha', & long='diameter growth increment by pft/size',use_default='inactive', & @@ -3533,35 +3534,35 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storage_flux_canopy_si_scls ) -! call this%set_history_var(vname='NPP_LEAF_CANOPY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_LEAF for canopy plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_canopy_si_scls ) + call this%set_history_var(vname='NPP_LEAF_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_LEAF for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_canopy_si_scls ) -! call this%set_history_var(vname='NPP_FROOT_CANOPY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_FROOT for canopy plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_canopy_si_scls ) + call this%set_history_var(vname='NPP_FROOT_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_FROOT for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_canopy_si_scls ) -! call this%set_history_var(vname='NPP_BSW_CANOPY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_BSW for canopy plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_canopy_si_scls ) + call this%set_history_var(vname='NPP_BSW_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSW for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_canopy_si_scls ) -! call this%set_history_var(vname='NPP_BDEAD_CANOPY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_BDEAD for canopy plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_canopy_si_scls ) + call this%set_history_var(vname='NPP_BDEAD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BDEAD for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_canopy_si_scls ) -! call this%set_history_var(vname='NPP_BSEED_CANOPY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_BSEED for canopy plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_canopy_si_scls ) + call this%set_history_var(vname='NPP_BSEED_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSEED for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_canopy_si_scls ) -! call this%set_history_var(vname='NPP_STORE_CANOPY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_STORE for canopy plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_canopy_si_scls ) + call this%set_history_var(vname='NPP_STORE_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_STORE for canopy plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_canopy_si_scls ) call this%set_history_var(vname='RDARK_CANOPY_SCLS', units = 'kg C / ha / yr', & long='RDARK for canopy plants by size class', use_default='inactive', & @@ -3633,35 +3634,35 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storage_flux_understory_si_scls ) -! call this%set_history_var(vname='NPP_LEAF_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_LEAF for understory plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_understory_si_scls ) - -! call this%set_history_var(vname='NPP_FROOT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_FROOT for understory plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_understory_si_scls ) - -! call this%set_history_var(vname='NPP_BSW_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_BSW for understory plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_understory_si_scls ) - -! call this%set_history_var(vname='NPP_BDEAD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_BDEAD for understory plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_understory_si_scls ) - -! call this%set_history_var(vname='NPP_BSEED_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_BSEED for understory plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_understory_si_scls ) - -! call this%set_history_var(vname='NPP_STORE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & -! long='NPP_STORE for understory plants by size class', use_default='inactive', & -! avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & -! upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_understory_si_scls ) + call this%set_history_var(vname='NPP_LEAF_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_LEAF for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_understory_si_scls ) + + call this%set_history_var(vname='NPP_FROOT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_FROOT for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_froot_understory_si_scls ) + + call this%set_history_var(vname='NPP_BSW_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSW for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bsw_understory_si_scls ) + + call this%set_history_var(vname='NPP_BDEAD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BDEAD for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bdead_understory_si_scls ) + + call this%set_history_var(vname='NPP_BSEED_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_BSEED for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bseed_understory_si_scls ) + + call this%set_history_var(vname='NPP_STORE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_STORE for understory plants by size class', use_default='inactive', & + avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=-999.9_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_store_understory_si_scls ) call this%set_history_var(vname='RDARK_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & long='RDARK for understory plants by size class', use_default='inactive', & From 38d2e830585f5eba07533894bac03d0452357cae Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 Jan 2018 15:45:54 -0700 Subject: [PATCH 62/63] total GPP and NPP were being withheld from output during NPP partition bugfix, added back --- main/FatesHistoryInterfaceMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index a76a2419eb..8287713fe6 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1436,10 +1436,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) associate( scpf => ccohort%size_by_pft_class, & scls => ccohort%size_class ) -! hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & -! n_perm2*ccohort%gpp_acc_hold ! [kgC/m2/yr] -! hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & -! ccohort%npp_acc_hold *n_perm2 + hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & + n_perm2*ccohort%gpp_acc_hold ! [kgC/m2/yr] + hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & + ccohort%npp_acc_hold *n_perm2 ! hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & ! ccohort%npp_leaf*n_perm2 ! hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & From 0eb71d9e6976c202249ef03b81daf321be0d41cc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 30 Jan 2018 01:43:30 -0700 Subject: [PATCH 63/63] Removed %imort --- biogeochem/EDPatchDynamicsMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e2a6910111..10d84a221b 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -403,7 +403,6 @@ subroutine spawn_patches( currentSite, bc_in) nc%hmort = nan nc%bmort = nan nc%fmort = nan - nc%imort = nan nc%lmort_direct = nan nc%lmort_collateral = nan nc%lmort_infra = nan @@ -521,7 +520,6 @@ subroutine spawn_patches( currentSite, bc_in) nc%hmort = nan nc%bmort = nan nc%fmort = nan - nc%imort = nan nc%lmort_direct = nan nc%lmort_collateral = nan nc%lmort_infra = nan