From d350c36a41c9a35281ce9d1670829a06e4c2f09d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 29 Sep 2017 16:55:34 -0700 Subject: [PATCH 001/111] 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 003/111] 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 004/111] 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 005/111] 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 1)then ! Include understory logging mortality rates not associated with disturbance - dndt_logging = (currentCohort%lmort_logging + & + dndt_logging = (currentCohort%lmort_direct + & currentCohort%lmort_collateral + & currentCohort%lmort_infra)/hlm_freq_day @@ -1183,7 +1183,7 @@ subroutine CWD_Input( currentSite, currentPatch) ! Total number of dead understory from direct logging ! (it is possible that large harvestable trees are in the understory) - dead_n_dlogging = ( currentCohort%lmort_logging) * & + dead_n_dlogging = ( currentCohort%lmort_direct) * & currentCohort%n/hlm_freq_day/currentPatch%area ! Total number of dead understory from indirect logging diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index b6da0529e7..f9cc8a54a3 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -444,6 +444,7 @@ subroutine FatesReportParams(is_master) write(fates_log(),fmt0) 'hydr_psicap = ',hydr_psicap write(fates_log(),fmt0) 'logging_dbhmin = ',logging_dbhmin write(fates_log(),fmt0) 'logging_collateral_frac = ',logging_collateral_frac + write(fates_log(),fmt0) 'logging_coll_under_frac = ',logging_coll_under_frac write(fates_log(),fmt0) 'logging_direct_frac = ',logging_direct_frac write(fates_log(),fmt0) 'logging_mechanical_frac = ',logging_mechanical_frac write(fates_log(),fmt0) 'logging_event_code = ',logging_event_code diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 82265c093c..9c3e8f5bc4 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -230,11 +230,10 @@ module EDTypesMod real(r8) :: fmort ! fire mortality n/year ! Logging Mortality Rate - ! Yi Xu - real(r8) :: lmort_logging ! directly logging rate %/per logging activity + ! Yi Xu & M. Huang + real(r8) :: lmort_direct ! directly logging rate %/per logging activity real(r8) :: lmort_collateral ! collaterally damaged rate %/per logging activity real(r8) :: lmort_infra ! mechanically damaged rate %/per logging activity - ! NITROGEN POOLS ! ---------------------------------------------------------------------------------- diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 55166eac8d..ca59ef1d8b 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1463,9 +1463,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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 + !Y.X. + hio_m7_si_scpf(io_si,scpf) = hio_m7_si_scpf(io_si,scpf) + & + (ccohort%lmort_direct+ccohort%lmort_collateral+ccohort%lmort_infra) * ccohort%n ! basal area [m2/ha] @@ -1507,7 +1507,7 @@ 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%imort + ccohort%fmort+ & - ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n + ccohort%lmort_direct + 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 hio_nplant_canopy_si_scls(io_si,scls) = hio_nplant_canopy_si_scls(io_si,scls) + ccohort%n @@ -1528,12 +1528,12 @@ 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%lmort_direct + 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%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%lmort_direct + 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) + & @@ -1583,7 +1583,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n + ccohort%lmort_direct + 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 hio_nplant_understory_si_scls(io_si,scls) = hio_nplant_understory_si_scls(io_si,scls) + ccohort%n @@ -1605,12 +1605,12 @@ 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%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%n + ccohort%lmort_direct + 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%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%b * & ccohort%n * g_per_kg * ha_per_m2 ! @@ -1799,7 +1799,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m4_si_scpf(io_si,i_scpf) + & hio_m5_si_scpf(io_si,i_scpf) + & hio_m6_si_scpf(io_si,i_scpf) + & - hio_m7_si_scpf(io_si,i_scpf) + hio_m7_si_scpf(io_si,i_scpf) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 44ac2ea58f..6a736a2557 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -102,7 +102,7 @@ module FatesRestartInterfaceMod integer, private :: ir_fmort_co !Logging - integer, private :: ir_lmort_logging_co + integer, private :: ir_lmort_direct_co integer, private :: ir_lmort_collateral_co integer, private :: ir_lmort_infra_co @@ -750,10 +750,10 @@ subroutine define_restart_vars(this, initialize_variables) hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmort_co ) - call this%set_restart_var(vname='fates_lmort_logging', vtype=cohort_r8, & + call this%set_restart_var(vname='fates_lmort_direct', vtype=cohort_r8, & long_name='ed cohort - directly logging mortality rate', & units='%/event', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_lmort_logging_co ) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_lmort_direct_co ) call this%set_restart_var(vname='fates_lmort_collateral', vtype=cohort_r8, & long_name='ed cohort - collateral mortality rate', & @@ -1062,14 +1062,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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, & - rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & - rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & - - + rio_lmort_direct_co => this%rvars(ir_lmort_direct_co)%r81d, & + rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & + rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & rio_dbalivedt_co => this%rvars(ir_dbalivedt_co)%r81d, & rio_dbdeaddt_co => this%rvars(ir_dbdeaddt_co)%r81d, & @@ -1186,11 +1181,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_fmort_co(io_idx_co) = ccohort%fmort !Logging - rio_lmort_logging_co(io_idx_co) = ccohort%lmort_logging - rio_lmort_collateral_co(io_idx_co) = ccohort%lmort_collateral - rio_lmort_infra_co(io_idx_co) = ccohort%lmort_infra - - + rio_lmort_direct_co(io_idx_co) = ccohort%lmort_direct + rio_lmort_collateral_co(io_idx_co) = ccohort%lmort_collateral + rio_lmort_infra_co(io_idx_co) = ccohort%lmort_infra rio_ddbhdt_co(io_idx_co) = ccohort%ddbhdt rio_dbalivedt_co(io_idx_co) = ccohort%dbalivedt @@ -1647,11 +1640,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) 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, & - rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & - rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & - - + rio_lmort_direct_co => this%rvars(ir_lmort_direct_co)%r81d, & + rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & + rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & rio_dbalivedt_co => this%rvars(ir_dbalivedt_co)%r81d, & @@ -1752,12 +1743,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%imort = rio_imort_co(io_idx_co) ccohort%fmort = rio_fmort_co(io_idx_co) - !Logging - ccohort%lmort_logging = rio_lmort_logging_co(io_idx_co) - ccohort%lmort_collateral = rio_lmort_collateral_co(io_idx_co) - ccohort%lmort_infra = rio_lmort_infra_co(io_idx_co) - - + !Logging + ccohort%lmort_direct = rio_lmort_direct_co(io_idx_co) + ccohort%lmort_collateral = rio_lmort_collateral_co(io_idx_co) + ccohort%lmort_infra = rio_lmort_infra_co(io_idx_co) ccohort%ddbhdt = rio_ddbhdt_co(io_idx_co) ccohort%dbalivedt = rio_dbalivedt_co(io_idx_co) From f2605037942979eb663e6be5046dd25de29a8675 Mon Sep 17 00:00:00 2001 From: Maoyi Huang Date: Wed, 11 Oct 2017 15:03:20 -0700 Subject: [PATCH 007/111] additional changes related to the logging module --- biogeochem/EDLoggingMortalityMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 85a4c8c813..679ea921de 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -30,7 +30,7 @@ module EDLoggingMortalityMod use EDParamsMod , only : logging_collateral_frac use EDParamsMod , only : logging_direct_frac use EDParamsMod , only : logging_mechanical_frac - use EDParamsMod , only : ED_val_understorey_death + use EDParamsMod , only : logging_coll_under_frac use FatesInterfaceMod , only : hlm_current_year use FatesInterfaceMod , only : hlm_current_month use FatesInterfaceMod , only : hlm_current_day @@ -281,7 +281,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site else if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then direct_dead = 0.0_r8 - indirect_dead = ED_val_understorey_death * currentCohort%n * & + indirect_dead = logging_coll_under_frac * currentCohort%n * & (patch_site_areadis/currentPatch%area) !kgC/site/day else ! If the cohort of interest is grass, it will not experience From ebc08e6cd4fdff10e5d4a44e87d34be058ec58d0 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 13 Oct 2017 15:49:47 -0700 Subject: [PATCH 008/111] Minor syntax changes to allometrymod. --- biogeochem/FatesAllometryMod.F90 | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 9fbca942cd..6fab5eeb22 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -60,15 +60,6 @@ ! dbh_max, real, the diameter associated with maximum height [cm] ! diagnosed from maxh using non-asymptotic functions ! -! Some def -! -! -! -! -! -! -! -! ! Initial Implementation: Ryan Knox July 2017 ! !=============================================================================== @@ -106,17 +97,9 @@ module FatesAllometryMod contains ! ============================================================================ - ! Parameter Checks and Defaults (subroutine) + ! Parameter Checks ! ============================================================================ -! subroutine init_allom() - - ! Perform Auto-initializations - - ! Calculate DBH at maximum height - -! end subroutine init_allom - ! ============================================================================ ! Generic height to diameter interface From 5594138b9ec07c6d2fae93e84168aa3ff2e066da Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 13 Oct 2017 18:41:09 -0700 Subject: [PATCH 009/111] Allometry module: cleaning module, consistency in height caps, cleaning calls, cleaning optional arguments and derivatives. --- biogeochem/EDGrowthFunctionsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 54 +++-- biogeochem/FatesAllometryMod.F90 | 352 ++++++++++++++++------------ main/EDInitMod.F90 | 2 +- main/EDPftvarcon.F90 | 10 - main/FatesConstantsMod.F90 | 2 +- main/FatesInventoryInitMod.F90 | 8 +- 7 files changed, 237 insertions(+), 193 deletions(-) diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index cbcf6cf194..0da6dd36e5 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -194,7 +194,7 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) ! Carbon Starvation induced mortality. if ( cohort_in%dbh > 0._r8 ) then - call bleaf(cohort_in%d,cohort_in%h,cohort_in%pft,cohort_in%canopy_trim,b_leaf) + 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)) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 0b1389c670..e774aa56f9 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -34,8 +34,9 @@ module EDPhysiologyMod use FatesConstantsMod , only : itrue,ifalse use FatesAllometryMod , only : h_allom + use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bag_allom - use FatesAllometryMod , only : sap_allom + use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bdead_allom @@ -771,8 +772,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! ! !USES: -! use EDGrowthFunctionsMod , only : Bleaf, dDbhdBd, dhdbd, hite, mortality_rates,dDbhdBl - + use EDGrowthFunctionsMod , only : mortality_rates use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys use EDLoggingMortalityMod, only : LoggingMortality_frac @@ -804,6 +804,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) real(r8) :: dndt_logging ! Mortality rate (per day) associated with the a logging event real(r8) :: balive_loss ! Carbon that will be removed from the alive pool due to things ! maintenance turnover + real(r8) :: height ! plant height ! Per plant allocation variables @@ -827,7 +828,6 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) 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) @@ -850,14 +850,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) endif ! Height - currentCohort%hite = Hite(currentCohort) - h = currentCohort%hite + + call h_allom(currentCohort%dbh,currentCohort%pft,currentCohort%hite) call allocate_live_biomass(currentCohort,0) - - - ! ----------------------------------------------------------------------------------- ! calculate target size of living biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- @@ -869,7 +866,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! 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) + call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass call bsap_allom(currentCohort%dbh,ipft,b_sap) @@ -1021,7 +1018,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%h,ipft,b_cr,db_cr_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 ) !only if carbon balance is +ve @@ -1041,7 +1038,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(temp_cohort%dbh,pft,b_sap,db_sap_dd) + call bsap_allom(currentCohort%dbh,ipft,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 @@ -1143,7 +1140,6 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! spawn new cohorts of juveniles of each PFT ! ! !USES: -! use EDGrowthFunctionsMod, only : bdead,dbh, Bleaf use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys ! ! !ARGUMENTS @@ -1155,6 +1151,12 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) integer :: ft type (ed_cohort_type) , pointer :: temp_cohort integer :: cohortstatus + real(r8) :: b_leaf + real(r8) :: b_fineroot + real(r8) :: b_sapwood + real(r8) :: b_aboveground + real(r8) :: b_coarseroot + !---------------------------------------------------------------------- allocate(temp_cohort) ! create temporary cohort @@ -1165,12 +1167,20 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) 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)) + 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,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,ft,b_sapwood) + + temp_cohort%balive = b_leaf + b_sapwood + b_fineroot + temp_cohort%bstore = EDPftvarcon_inst%cushion(ft) * b_leaf if (hlm_use_ed_prescribed_phys .eq. ifalse) then temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & @@ -1182,12 +1192,10 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) 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 + temp_cohort%laimemory = b_leaf 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 + temp_cohort%laimemory = b_leaf endif cohortstatus = currentSite%status diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 6fab5eeb22..2d63995bf5 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -58,7 +58,11 @@ ! 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 +! diagnosed from maxh using non-asymptotic functions +! +! Note - i4 types are expressed explicitly to accomodate unit testing calls +! to this module +! ! ! Initial Implementation: Ryan Knox July 2017 ! @@ -91,8 +95,6 @@ module FatesAllometryMod character(len=*), parameter, private :: sourcefile = & __FILE__ - logical, parameter :: allow_hcapping = .true. - contains @@ -100,6 +102,11 @@ module FatesAllometryMod ! Parameter Checks ! ============================================================================ + ! Checks to make sure parameters are not within expected ranges for each + ! functions + + ! Check to make sure Martinez-Cano height cap is not on, or explicitly allowed + ! ============================================================================ ! Generic height to diameter interface @@ -113,30 +120,12 @@ subroutine h2d_allom(h,ipft,d,dddh) real(r8),intent(out) :: d ! plant diameter [cm] real(r8),intent(out),optional :: 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( 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) + 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 010/111] 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 011/111] 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 012/111] 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 013/111] 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 23:08:33 -0700 Subject: [PATCH 014/111] 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 015/111] 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 016/111] 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 1519a0db1477772f503d124caff6d1ffe73f1a22 Mon Sep 17 00:00:00 2001 From: Jennifer Holm Date: Tue, 24 Oct 2017 17:29:51 -0700 Subject: [PATCH 017/111] updates for including freezing mortality --- biogeochem/EDCohortDynamicsMod.F90 | 2 ++ biogeochem/EDGrowthFunctionsMod.F90 | 25 ++++++++++++++++++++-- biogeochem/EDPatchDynamicsMod.F90 | 20 +++++++++++++---- biogeochem/EDPhysiologyMod.F90 | 7 +++--- main/EDMainMod.F90 | 1 + main/EDPftvarcon.F90 | 2 +- main/EDTypesMod.F90 | 8 ++++--- main/FatesHistoryInterfaceMod.F90 | 33 +++++++++++++++++------------ main/FatesRestartInterfaceMod.F90 | 12 +++++++++-- 9 files changed, 81 insertions(+), 29 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 755c5277f2..afcbac1344 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -864,6 +864,7 @@ subroutine fuse_cohorts(patchptr, bc_in) currentCohort%hmort = (currentCohort%n*currentCohort%hmort + nextc%n*nextc%hmort)/newn currentCohort%bmort = (currentCohort%n*currentCohort%bmort + nextc%n*nextc%bmort)/newn currentCohort%fmort = (currentCohort%n*currentCohort%fmort + nextc%n*nextc%fmort)/newn + currentCohort%frmort = (currentCohort%n*currentCohort%frmort + nextc%n*nextc%frmort)/newn ! logging mortality, Yi Xu currentCohort%lmort_logging = (currentCohort%n*currentCohort%lmort_logging + & @@ -1255,6 +1256,7 @@ subroutine copy_cohort( currentCohort,copyc ) n%bmort = o%bmort n%fmort = o%fmort n%hmort = o%hmort + n%frmort = o%frmort ! logging mortalities, Yi Xu n%lmort_logging=o%lmort_logging diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index 075c216a33..25f31827ce 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -11,6 +11,7 @@ module EDGrowthFunctionsMod use EDPftvarcon , only : EDPftvarcon_inst use EDTypesMod , only : ed_cohort_type, nlevleaf, dinc_ed use FatesConstantsMod , only : itrue,ifalse + use FatesInterfaceMod , only : bc_in_type implicit none private @@ -404,7 +405,7 @@ end function dDbhdBl ! ============================================================================ - subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) + subroutine mortality_rates( cohort_in,cmort,hmort,bmort,frmort,bc_in ) ! ============================================================================ ! Calculate mortality rates as a function of carbon storage @@ -412,15 +413,24 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) use EDParamsMod, only : ED_val_stress_mort use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm type (ed_cohort_type), intent(in) :: cohort_in + type (bc_in_type), intent(in) :: bc_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),intent(out) :: frmort ! freezing stress mortality real(r8) :: frac ! relativised stored carbohydrate real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold + real(r8) :: temp_dep ! Temp. function (freezing mortality) + real(r8) :: temp_in_C ! Daily averaged temperature in Celcius + real(r8) :: frost_mort ! Scaling factor for freezing mortality + + temp_in_C = bc_in%t_veg24_si - tfrz + frost_mort = 3.0_r8 if (hlm_use_ed_prescribed_phys .eq. ifalse) then @@ -451,7 +461,17 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer endif - !mortality_rates = bmort + hmort + cmort + ! Mortality due to cold and freezing stress (frmort), based on ED2 and: + ! Albani, M.; D. Medvigy; G. C. Hurtt; P. R. Moorcroft, 2006: The contributions + ! of land-use change, CO2 fertilization, and climate variability to the + ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, + ! doi: 10.1111/j.1365-2486.2006.01254.x + + temp_dep = max(0.0,min(1.0,1.0 - (temp_in_C - EDPftvarcon_inst%freezetol(cohort_in%pft))/5.0) ) + frmort = frost_mort * temp_dep + + + !mortality_rates = bmort + hmort + cmort + frmort else ! i.e. hlm_use_ed_prescribed_phys is true if ( cohort_in%canopy_layer .eq. 1) then @@ -461,6 +481,7 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) endif cmort = 0._r8 hmort = 0._r8 + frmort = 0._r8 endif end subroutine mortality_rates diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index bde59dafcd..1964dea6d5 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -66,7 +66,7 @@ module EDPatchDynamicsMod contains ! ============================================================================ - subroutine disturbance_rates( site_in) + subroutine disturbance_rates( site_in, bc_in) ! ! !DESCRIPTION: ! Calculates the fire and mortality related disturbance rates for each patch, @@ -85,6 +85,7 @@ subroutine disturbance_rates( site_in) ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: site_in + type(bc_in_type) , intent(in) :: bc_in ! ! !LOCAL VARIABLES: type (ed_patch_type) , pointer :: currentPatch @@ -93,6 +94,7 @@ subroutine disturbance_rates( site_in) real(r8) :: cmort real(r8) :: bmort real(r8) :: hmort + real(r8) :: frmort real(r8) :: lmort_logging real(r8) :: lmort_collateral @@ -113,14 +115,15 @@ subroutine disturbance_rates( site_in) ! Mortality for trees in the understorey. currentCohort%patchptr => currentPatch - call mortality_rates(currentCohort,cmort,hmort,bmort) - currentCohort%dmort = cmort+hmort+bmort + call mortality_rates(currentCohort,cmort,hmort,bmort,frmort,bc_in) + currentCohort%dmort = cmort+hmort+bmort+frmort currentCohort%c_area = c_area(currentCohort) ! Initialize diagnostic mortality rates currentCohort%cmort = cmort currentCohort%bmort = bmort currentCohort%hmort = hmort + currentCohort%hmort = frmort currentCohort%fmort = 0.0_r8 ! Fire mortality is initialized as zero, but may be changed call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, & @@ -202,6 +205,7 @@ 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%frmort = currentCohort%frmort*(1.0_r8 - fates_mortality_disturbance_fraction) end if currentCohort => currentCohort%taller enddo !currentCohort @@ -220,6 +224,7 @@ 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%frmort = currentCohort%frmort*(1.0_r8 - fates_mortality_disturbance_fraction) currentCohort%lmort_logging = 0.0_r8 currentCohort%lmort_collateral = 0.0_r8 currentCohort%lmort_infra = 0.0_r8 @@ -390,7 +395,7 @@ subroutine spawn_patches( currentSite, bc_in) ! In the donor patch we are left with fewer trees because the area has decreased ! the plant density for large trees does not actually decrease in the donor patch ! because this is the part of the original patch where no trees have actually fallen - ! The diagnostic cmort,bmort and hmort rates have already been saved + ! The diagnostic cmort,bmort,hmort, and frmort rates have already been saved currentCohort%n = currentCohort%n * (1.0_r8 - fates_mortality_disturbance_fraction * & min(1.0_r8,currentCohort%dmort * hlm_freq_day)) @@ -401,6 +406,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%hmort = nan nc%bmort = nan nc%fmort = nan + nc%frmort = nan nc%lmort_logging = nan nc%lmort_collateral = nan nc%lmort_infra = nan @@ -443,6 +449,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral @@ -467,6 +474,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral @@ -493,6 +501,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral @@ -517,6 +526,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = nan nc%hmort = nan nc%bmort = nan + nc%frmort = nan nc%fmort = nan nc%lmort_logging = nan nc%lmort_collateral = nan @@ -563,6 +573,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral @@ -582,6 +593,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 4752963b78..c60b1fd7d6 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -786,6 +786,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) real(r8) :: cmort ! starvation mortality rate (fraction per year) real(r8) :: bmort ! background mortality rate (fraction per year) real(r8) :: hmort ! hydraulic failure mortality rate (fraction per year) + real(r8) :: frmort ! freezing tolerance mortality rate (fraction per year) real(r8) :: lmort_logging ! Mortality fraction associated with direct logging real(r8) :: lmort_collateral ! Mortality fraction associated with logging collateral damage @@ -797,7 +798,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 mortality_rates(currentCohort,cmort,hmort,bmort,frmort,bc_in) call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, & currentCohort%lmort_logging, & currentCohort%lmort_collateral, & @@ -810,10 +811,10 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%lmort_collateral + & currentCohort%lmort_infra)/hlm_freq_day - currentCohort%dndt = -1.0_r8 * (cmort+hmort+bmort+dndt_logging) * currentCohort%n + currentCohort%dndt = -1.0_r8 * (cmort+hmort+bmort+frmort+dndt_logging) * currentCohort%n else currentCohort%dndt = -(1.0_r8 - fates_mortality_disturbance_fraction) & - * (cmort+hmort+bmort) * currentCohort%n + * (cmort+hmort+bmort+frmort) * currentCohort%n endif ! Height diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index dc3a7fd9f5..eaec28fb9f 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -610,6 +610,7 @@ subroutine bypass_dynamics(currentSite) currentCohort%hmort = 0.0_r8 currentCohort%cmort = 0.0_r8 currentCohort%fmort = 0.0_r8 + currentCohort%frmort = 0.0_r8 currentCohort => currentCohort%taller enddo diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 465a28fc59..a38e3b3588 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -27,7 +27,7 @@ module EDPftvarcon type, public :: EDPftvarcon_type real(r8), allocatable :: pft_used (:) ! Switch to turn on and off PFTs - real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance (NOT CURRENTY USED) + real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance real(r8), allocatable :: wood_density (:) ! wood density g cm^-3 ... real(r8), allocatable :: hgt_min (:) ! sapling height m real(r8), allocatable :: dbh_repro_threshold(:) ! diameter at which mature plants shift allocation diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 05e0775205..7e9a247f13 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -100,12 +100,12 @@ module EDTypesMod ! special mode to cause PFTs to create seed mass of all currently-existing PFTs logical, parameter :: homogenize_seed_pfts = .false. - integer, parameter :: nlevmclass_ed = 5 ! nlev "mortality" classes in ED + integer, parameter :: nlevmclass_ed = 6 ! nlev "mortality" classes in ED ! Number of ways to die - ! (background,hydraulic,carbon,impact,fire) + ! (background,hydraulic,carbon,impact,fire,freezing) character(len = 10), parameter,dimension(nlevmclass_ed) :: char_list = & - (/"background","hydraulic ","carbon ","impact ","fire "/) + (/"background","hydraulic ","carbon ","impact ","fire ","freezing "/) !************************************ @@ -227,6 +227,7 @@ module EDTypesMod real(r8) :: cmort ! carbon starvation mortality rate n/year real(r8) :: hmort ! hydraulic failure mortality rate n/year real(r8) :: fmort ! fire mortality n/year + real(r8) :: frmort ! freezing mortality n/year ! Logging Mortality Rate ! Yi Xu @@ -746,6 +747,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%bmort = ', ccohort%bmort write(fates_log(),*) 'co%fmort = ', ccohort%fmort write(fates_log(),*) 'co%hmort = ', ccohort%hmort + write(fates_log(),*) 'co%frmort = ', ccohort%frmort write(fates_log(),*) 'co%isnew = ', ccohort%isnew write(fates_log(),*) 'co%dndt = ', ccohort%dndt write(fates_log(),*) 'co%dhdt = ', ccohort%dhdt diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index d32732339b..52c4cfbb0b 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -159,6 +159,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_m4_si_scpf integer, private :: ih_m5_si_scpf integer, private :: ih_m6_si_scpf + integer, private :: ih_m8_si_scpf !LOGGING , make sure to add ih_m7_si_scpf and hio_m7_si_scpf integer, private :: ih_m7_si_scpf @@ -1208,9 +1209,8 @@ 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_m8_si_scpf => this%hvars(ih_m8_si_scpf)%r82d, & hio_ba_si_scls => this%hvars(ih_ba_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, & @@ -1460,7 +1460,7 @@ 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 - + hio_m8_si_scpf(io_si,scpf) = hio_m8_si_scpf(io_si,scpf) + ccohort%frmort*ccohort%n !Y.X. hio_m7_si_scpf(io_si,scpf) = hio_m7_si_scpf(io_si,scpf) + & @@ -1492,7 +1492,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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 hio_mortality_canopy_si_scag(io_si,iscag) = hio_mortality_canopy_si_scag(io_si,iscag) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * ccohort%n + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * ccohort%n hio_ddbh_canopy_si_scag(io_si,iscag) = hio_ddbh_canopy_si_scag(io_si,iscag) + & ccohort%ddbhdt*ccohort%n hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + & @@ -1502,10 +1502,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%fmort) * ccohort%n + ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * 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%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * ccohort%n + & (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year @@ -1528,12 +1528,12 @@ 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%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * 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%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * & 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 @@ -1572,7 +1572,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) else hio_nplant_understory_si_scag(io_si,iscag) = hio_nplant_understory_si_scag(io_si,iscag) + ccohort%n hio_mortality_understory_si_scag(io_si,iscag) = hio_mortality_understory_si_scag(io_si,iscag) + & - (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort) * ccohort%n + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * ccohort%n hio_ddbh_understory_si_scag(io_si,iscag) = hio_ddbh_understory_si_scag(io_si,iscag) + & ccohort%ddbhdt*ccohort%n hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & @@ -1581,10 +1581,10 @@ 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%fmort) * ccohort%n + ! (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * 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%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * ccohort%n + & (ccohort%lmort_logging + ccohort%lmort_collateral + ccohort%lmort_infra) * & ccohort%n * sec_per_day * days_per_year @@ -1607,12 +1607,12 @@ 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%n + & + (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * 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%bmort + ccohort%hmort + ccohort%cmort + ccohort%fmort + ccohort%frmort) * & 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 @@ -1813,7 +1813,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m4_si_scpf(io_si,i_scpf) + & hio_m5_si_scpf(io_si,i_scpf) + & hio_m6_si_scpf(io_si,i_scpf) + & - hio_m7_si_scpf(io_si,i_scpf) + hio_m7_si_scpf(io_si,i_scpf) + & + hio_m8_si_scpf(io_si,i_scpf) @@ -3198,6 +3199,10 @@ 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 ) + call this%set_history_var(vname='M8_SCPF', units = 'N/ha/yr', & + long='freezing 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_m8_si_scpf ) !Logging call this%set_history_var(vname='M7_SCPF', units = 'N/ha/event', & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 5f2247614f..36af9c33fa 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -99,6 +99,7 @@ module FatesRestartInterfaceMod integer, private :: ir_hmort_co integer, private :: ir_cmort_co integer, private :: ir_fmort_co + integer, private :: ir_frmort_co !Logging integer, private :: ir_lmort_logging_co @@ -739,10 +740,14 @@ subroutine define_restart_vars(this, initialize_variables) hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cmort_co ) call this%set_restart_var(vname='fates_fmort', vtype=cohort_r8, & - long_name='ed cohort - frost mortality rate', & + long_name='ed cohort - fire mortality rate', & units='/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmort_co ) + call this%set_restart_var(vname='fates_frmort', vtype=cohort_r8, & + long_name='ed cohort - freezing mortality rate', & + units='/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_frmort_co ) call this%set_restart_var(vname='fates_lmort_logging', vtype=cohort_r8, & long_name='ed cohort - directly logging mortality rate', & @@ -1055,7 +1060,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & - + rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & rio_lmort_logging_co => this%rvars(ir_lmort_logging_co)%r81d, & @@ -1176,6 +1181,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_hmort_co(io_idx_co) = ccohort%hmort rio_cmort_co(io_idx_co) = ccohort%cmort rio_fmort_co(io_idx_co) = ccohort%fmort + rio_frmort_co(io_idx_co) = ccohort%frmort !Logging rio_lmort_logging_co(io_idx_co) = ccohort%lmort_logging @@ -1637,6 +1643,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & + rio_frmort_co => this%rvars(ir_frmort_co)%r81d, & rio_lmort_logging_co => this%rvars(ir_lmort_logging_co)%r81d, & rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & @@ -1741,6 +1748,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%hmort = rio_hmort_co(io_idx_co) ccohort%cmort = rio_cmort_co(io_idx_co) ccohort%fmort = rio_fmort_co(io_idx_co) + ccohort%frmort = rio_frmort_co(io_idx_co) !Logging ccohort%lmort_logging = rio_lmort_logging_co(io_idx_co) From c773d19817b58eec983a31ca7785d0135044cddd Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 Oct 2017 15:50:40 -0700 Subject: [PATCH 018/111] 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 019/111] 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 020/111] 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 021/111] 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 022/111] 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 023/111] 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 024/111] 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 025/111] 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 026/111] 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 abe297e50ae4432718676795fdb3f6bf52270fb9 Mon Sep 17 00:00:00 2001 From: Jennifer Holm Date: Wed, 1 Nov 2017 17:36:57 -0700 Subject: [PATCH 027/111] updated EDMainMod to bring in daily temperature for freezing mortality tolerances --- main/EDMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index eaec28fb9f..8547d0894e 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -120,7 +120,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) ! Calculate disturbance and mortality based on previous timestep vegetation. ! disturbance_rates calls logging mortality and other mortalities, Yi Xu - call disturbance_rates(currentSite) + call disturbance_rates(currentSite, bc_in) end if if (hlm_use_ed_st3.eq.ifalse) then From b81e6aea39964589e5aca395c55ea050bb09611a Mon Sep 17 00:00:00 2001 From: Jennifer Holm Date: Wed, 15 Nov 2017 13:03:53 -0800 Subject: [PATCH 028/111] fixed typo for frmort, defined parameters for freezing mortality --- biogeochem/EDGrowthFunctionsMod.F90 | 12 ++++++------ biogeochem/EDPatchDynamicsMod.F90 | 4 ++-- biogeochem/EDPhysiologyMod.F90 | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index 25f31827ce..b34677b4f9 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -405,7 +405,7 @@ end function dDbhdBl ! ============================================================================ - subroutine mortality_rates( cohort_in,cmort,hmort,bmort,frmort,bc_in ) + subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) ! ============================================================================ ! Calculate mortality rates as a function of carbon storage @@ -427,10 +427,10 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort,frmort,bc_in ) real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold real(r8) :: temp_dep ! Temp. function (freezing mortality) real(r8) :: temp_in_C ! Daily averaged temperature in Celcius - real(r8) :: frost_mort ! Scaling factor for freezing mortality + real(r8),parameter :: frost_mort_scaler = 3.0_r8 ! Scaling factor for freezing mortality + real(r8),parameter :: frost_mort_buffer = 5.0_r8 ! 5deg buffer for freezing mortality temp_in_C = bc_in%t_veg24_si - tfrz - frost_mort = 3.0_r8 if (hlm_use_ed_prescribed_phys .eq. ifalse) then @@ -467,9 +467,9 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort,frmort,bc_in ) ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, ! doi: 10.1111/j.1365-2486.2006.01254.x - temp_dep = max(0.0,min(1.0,1.0 - (temp_in_C - EDPftvarcon_inst%freezetol(cohort_in%pft))/5.0) ) - frmort = frost_mort * temp_dep - + temp_dep = max(0.0,min(1.0,1.0 - (temp_in_C - EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) ) + frmort = frost_mort_scaler * temp_dep + !mortality_rates = bmort + hmort + cmort + frmort diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 1964dea6d5..0592a276f8 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -115,7 +115,7 @@ subroutine disturbance_rates( site_in, bc_in) ! Mortality for trees in the understorey. currentCohort%patchptr => currentPatch - call mortality_rates(currentCohort,cmort,hmort,bmort,frmort,bc_in) + call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort) currentCohort%dmort = cmort+hmort+bmort+frmort currentCohort%c_area = c_area(currentCohort) @@ -123,7 +123,7 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%cmort = cmort currentCohort%bmort = bmort currentCohort%hmort = hmort - currentCohort%hmort = frmort + currentCohort%frmort = frmort currentCohort%fmort = 0.0_r8 ! Fire mortality is initialized as zero, but may be changed call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index c60b1fd7d6..adcc9260b2 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -798,7 +798,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,frmort,bc_in) + call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort) call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, & currentCohort%lmort_logging, & currentCohort%lmort_collateral, & From 35c2d3903aedcddecc50468453a9ae33c0dfe473 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 15 Nov 2017 13:18:54 -0800 Subject: [PATCH 029/111] pft-specific agb fractions being applied to litter partitions during treefall mortality. Minor syntax formatting fixes. --- biogeochem/EDPatchDynamicsMod.F90 | 53 +++++++++++++++---------------- 1 file changed, 25 insertions(+), 28 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 1964dea6d5..8e729c9126 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -449,7 +449,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral @@ -474,7 +474,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral @@ -501,7 +501,7 @@ subroutine spawn_patches( currentSite, bc_in) nc%cmort = currentCohort%cmort nc%hmort = currentCohort%hmort nc%bmort = currentCohort%bmort - nc%frmort = currentCohort%frmort + nc%frmort = currentCohort%frmort nc%dmort = currentCohort%dmort nc%lmort_logging = currentCohort%lmort_logging nc%lmort_collateral = currentCohort%lmort_collateral @@ -1002,15 +1002,14 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat real(r8) :: canopy_dead !Number of individual dead from the understorey layer /day real(r8) :: np_mult !Fraction of the new patch which came from the current patch (and so needs the same litter) integer :: p,c - real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/day + real(r8) :: canopy_mortality_woody_litter(maxpft) ! flux of wood litter in to litter pool: KgC/m2/day real(r8) :: canopy_mortality_leaf_litter(maxpft) ! flux in to leaf litter from tree death: KgC/m2/day real(r8) :: canopy_mortality_root_litter(maxpft) ! flux in to froot litter from tree death: KgC/m2/day - real(r8) :: mean_agb_frac ! mean fraction of AGB to total woody biomass (stand mean) !--------------------------------------------------------------------- currentPatch => cp_target new_patch => new_patch_target - canopy_mortality_woody_litter = 0.0_r8 ! mortality generated litter. KgC/m2/day + canopy_mortality_woody_litter(:) = 0.0_r8 ! mortality generated litter. KgC/m2/day canopy_mortality_leaf_litter(:) = 0.0_r8 canopy_mortality_root_litter(:) = 0.0_r8 @@ -1024,18 +1023,18 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat !not right to recalcualte dmort here. 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_mortality_woody_litter(p)= canopy_mortality_woody_litter(p) + & canopy_dead*(currentCohort%bdead+currentCohort%bsw) - canopy_mortality_leaf_litter(p) = canopy_mortality_leaf_litter(p)+ & + canopy_mortality_leaf_litter(p) = canopy_mortality_leaf_litter(p) + & canopy_dead*(currentCohort%bl) - canopy_mortality_root_litter(p) = canopy_mortality_root_litter(p)+ & + canopy_mortality_root_litter(p) = canopy_mortality_root_litter(p) + & canopy_dead*(currentCohort%br+currentCohort%bstore) else if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then understorey_dead = ED_val_understorey_death * currentCohort%n * (patch_site_areadis/currentPatch%area) !kgC/site/day - canopy_mortality_woody_litter = canopy_mortality_woody_litter + & + canopy_mortality_woody_litter(p) = canopy_mortality_woody_litter(p) + & understorey_dead*(currentCohort%bdead+currentCohort%bsw) canopy_mortality_leaf_litter(p)= canopy_mortality_leaf_litter(p)+ & understorey_dead* currentCohort%bl @@ -1070,26 +1069,24 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat ! For the new patch, only some fraction of its land area (patch_areadis/np%area) is derived from the current patch ! so we need to multiply by patch_areadis/np%area - mean_agb_frac = sum(EDPftvarcon_inst%allom_agb_frac(1:numpft))/dble(numpft) - - do c = 1,ncwd - - cwd_litter_density = SF_val_CWD_frac(c) * canopy_mortality_woody_litter / litter_area - - new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + mean_agb_frac * cwd_litter_density * np_mult - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + mean_agb_frac * cwd_litter_density - new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + (1._r8-mean_agb_frac) * cwd_litter_density * np_mult - currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + (1._r8-mean_agb_frac) * cwd_litter_density - - ! track as diagnostic fluxes - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * canopy_mortality_woody_litter * hlm_days_per_year * mean_agb_frac/ AREA - currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) + & - SF_val_CWD_frac(c) * canopy_mortality_woody_litter * hlm_days_per_year * (1.0_r8 - mean_agb_frac) / AREA - enddo - do p = 1,numpft + do c = 1,ncwd + + cwd_litter_density = SF_val_CWD_frac(c) * canopy_mortality_woody_litter(p) / litter_area + + new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + EDPftvarcon_inst%allom_agb_frac(p) * cwd_litter_density * np_mult + currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + EDPftvarcon_inst%allom_agb_frac(p) * cwd_litter_density + new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + (1._r8-EDPftvarcon_inst%allom_agb_frac(p)) * cwd_litter_density * np_mult + currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + (1._r8-EDPftvarcon_inst%allom_agb_frac(p)) * cwd_litter_density + + ! track as diagnostic fluxes + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & + SF_val_CWD_frac(c) * canopy_mortality_woody_litter(p) * hlm_days_per_year * EDPftvarcon_inst%allom_agb_frac(p)/ AREA + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) + & + SF_val_CWD_frac(c) * canopy_mortality_woody_litter(p) * hlm_days_per_year * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(p)) / AREA + enddo + new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + canopy_mortality_leaf_litter(p) / litter_area * np_mult new_patch%root_litter(p) = new_patch%root_litter(p) + canopy_mortality_root_litter(p) / litter_area * np_mult From b4a26f844c9dd7c6535fa3ef37d32fd9e085003e Mon Sep 17 00:00:00 2001 From: ckoven Date: Fri, 17 Nov 2017 10:36:19 -0800 Subject: [PATCH 030/111] 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 031/111] 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 032/111] 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 033/111] 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 034/111] 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 47aa909cc76bdab91c412f4272d9dbbecb5a00ae Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 22 Nov 2017 17:38:05 -0800 Subject: [PATCH 035/111] Removed redundant call to bsw calc during respiration call, removed deprecated locals, updated the sapwood and agb/bgb calculations in the allometry module. --- biogeochem/EDPhysiologyMod.F90 | 4 - biogeochem/FatesAllometryMod.F90 | 404 ++++++++++++--------- biogeophys/FatesPlantRespPhotosynthMod.F90 | 16 - 3 files changed, 227 insertions(+), 197 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 59844b68c3..af16c03594 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -799,10 +799,6 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) type(bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: - real(r8) :: dbldbd !rate of change of dead biomass per unit dbh - real(r8) :: dbrdbd !rate of change of root biomass per unit dbh - real(r8) :: dbswdbd !rate of change of sapwood biomass per unit dbh - 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 diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index e8afe6c357..a9f0813371 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -14,12 +14,17 @@ ! The name convention of the functions follows the form d... Which ! indicates "diameter to ...". Allometries for the following variables are ! calculated: -! h: height [m] -! bag: biomass above ground [kgC] (aka AGB) +! h: height [m] +! bagw: biomass above ground woody tissues [kgC] +! this is an all encompassing definition of "woody", which +! is intended to include all non-leaf woody or fibrous +! tissues, including sap and structural materials ! 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) +! bbgw: biomass below ground woody tissues [kgC] +! similar to AGBW, this essentially encompasses +! all non-fineroot belowground tissues ! 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] @@ -57,27 +62,20 @@ ! Note - i4 types are expressed explicitly to accomodate unit testing calls ! to this module ! +! Explanation of pools and their control volumes ! -! OPEN QUESTIONS: -! 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 +! ------------------------------------------------------------------------------ ! +! total biomass = bleaf + bfineroot + agbw + bgbw +! ... or ... +! total biomass = bleaf + bfineroot + bdead + bsap +! ... and ... +! bdead = agbw + bgbw - bsap +! +! ------------------------------------------------------------------------------ ! -! 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. -! -! 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 @@ -100,11 +98,11 @@ module FatesAllometryMod private public :: h2d_allom ! Generic height to diameter wrapper public :: h_allom ! Generic diameter to height wrapper - public :: bag_allom ! Generic AGB wrapper + public :: bagw_allom ! Generic AGWB (above grnd. woody bio) wrapper public :: blmax_allom ! Generic maximum leaf biomass wrapper public :: bleaf ! Generic actual leaf biomass wrapper public :: bsap_allom ! Generic sapwood wrapper - public :: bcr_allom ! Generic coarse root wrapper + public :: bbgw_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 @@ -118,7 +116,7 @@ module FatesAllometryMod ! from the agb pool. ! Additionally, our calculation of sapwood biomass may be missing some unite conversions ! - logical,parameter :: test_b4b = .true. + contains @@ -212,14 +210,14 @@ end subroutine h_allom ! Generic AGB interface ! ============================================================================ - subroutine bag_allom(d,h,ipft,bag,dbagdd) + subroutine bagw_allom(d,h,ipft,bagw,dbagwdd) 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),optional :: dbagdd ! change in agb per diameter [kgC/cm] + real(r8),intent(out) :: bagw ! biomass above ground woody tissues + real(r8),intent(out),optional :: dbagwdd ! change in agbw per diameter [kgC/cm] real(r8) :: hj ! height (dummy arg) real(r8) :: dhdd ! change in height wrt d @@ -236,13 +234,13 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) select case(int(allom_amode)) case (1) !"salda") 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 dh2bagw_salda(d,h,dhdd,p1,p2,p3,p4,wood_density,c2b,agb_frac,bagw,dbagwdd) case (2) !"2par_pwr") ! Switch for woodland dbh->drc - call d2bag_2pwr(d,p1,p2,c2b,bag,dbagdd) + call d2bagw_2pwr(d,p1,p2,c2b,bagw,dbagwdd) case (3) !"chave14") call h_allom(d,ipft,hj,dhdd) - call dh2bag_chave2014(d,h,dhdd,p1,p2,wood_density,c2b,bag,dbagdd) + call dh2bagw_chave2014(d,h,dhdd,p1,p2,wood_density,c2b,bagw,dbagwdd) case DEFAULT write(fates_log(),*) 'An undefined AGB allometry was specified: ',allom_amode write(fates_log(),*) 'Aborting' @@ -251,7 +249,7 @@ subroutine bag_allom(d,h,ipft,bag,dbagdd) end associate return - end subroutine bag_allom + end subroutine bagw_allom ! ============================================================================ ! Generic diameter to maximum leaf biomass interface @@ -377,21 +375,30 @@ 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 real(r8) :: dhdd - real(r8) :: blmax - real(r8) :: dblmaxdd - real(r8) :: bag - real(r8) :: dbagdd - + real(r8) :: bl + real(r8) :: dbldd + real(r8) :: bbgw + real(r8) :: dbbgwdd + real(r8) :: bagw + real(r8) :: dbagwdd + real(r8) :: bsap_cap ! cap sapwood so that it is no larger + ! than some specified proportion of woody biomass + ! should not trip, and only in small plants + + ! Constrain sapwood so that its above ground portion be no larger than + ! X% of total woody/fibrous (ie non leaf/fineroot) tissues + real(r8),parameter :: max_frac = 0.95_r8 + select case(int(EDPftvarcon_inst%allom_smode(ipft))) ! --------------------------------------------------------------------- ! Currently both sapwood area proportionality methods use the same @@ -401,13 +408,30 @@ subroutine bsap_allom(d,h,ipft,canopy_trim,bsap,dbsapdd) ! --------------------------------------------------------------------- case(1,2) !"constant","dlinear") - if(test_b4b)then - call bleaf(d,h,ipft,canopy_trim,blmax,dblmaxdd) - else - call blmax_allom(d,h,ipft,blmax,dblmaxdd) + call h_allom(d,ipft,h,dhdd) + call bleaf(d,h,ipft,canopy_trim,bl,dbldd) + call bsap_dlinear(d,h,dhdd,bl,dbldd,ipft,bsap,dbsapdd) + + ! Perform a capping/check on total woody biomass + call bagw_allom(d,h,ipft,bagw,dbagwdd) + call bbgw_allom(d,h,ipft,bbgw,dbbgwdd) + + ! Force sapwood to be less than a maximum fraction of total biomass + ! (this comes into play typically in very small plants) + bsap_cap = max_frac*(bagw+bbgw) + bsap = min( bsap_cap,bsap) + if(present(dbsapdd))then + if ( bsap >= bsap_cap ) then + dbsapdd = max_frac*(dbagwdd+dbbgwdd) + end if end if - call bag_allom(d,h,ipft,bag,dbagdd) - call bsap_dlinear(d,h,dhdd,blmax,dblmaxdd,bag,dbagdd,ipft,bsap,dbsapdd) + + case(9) ! deprecated + + call h_allom(d,ipft,h,dhdd) + call bleaf(d,h,ipft,canopy_trim,bl,dbldd) + call bsap_deprecated(d,h,dhdd,bl,dbldd,ipft,bsap,dbsapdd) + case DEFAULT write(fates_log(),*) 'An undefined sapwood allometry was specified: ', & EDPftvarcon_inst%allom_smode(ipft) @@ -418,34 +442,35 @@ subroutine bsap_allom(d,h,ipft,canopy_trim,bsap,dbsapdd) end subroutine bsap_allom ! ============================================================================ - ! Generic coarse root biomass interface + ! Generic below ground woody biomass (structure and live/conducting tissues) + ! (this pool, (like agb and leaves) is assumed to contain all belowground + ! non-fineroot biomass. ! ============================================================================ - subroutine bcr_allom(d,h,ipft,bcr,dbcrdd) + subroutine bbgw_allom(d,h,ipft,bbgw,dbbgwdd) - - 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),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) :: bbgw ! below ground woody biomass [kgC] + real(r8),intent(out),optional :: dbbgwdd ! change bbgw per diam [kgC/cm] - real(r8) :: bag ! above ground biomass [kgC] - real(r8) :: dbagdd ! change in agb per diameter [kgC/cm] + real(r8) :: bagw ! above ground biomass [kgC] + real(r8) :: dbagwdd ! change in agb per diameter [kgC/cm] 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) + call bagw_allom(d,h,ipft,bagw,dbagwdd) + call bbgw_const(d,bagw,dbagwdd,ipft,bbgw,dbbgwdd) 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 bbgw_allom + ! ============================================================================ ! Fine root biomass allometry wrapper ! ============================================================================ @@ -494,40 +519,44 @@ end subroutine bfineroot ! Dead biomass interface ! ============================================================================ - subroutine bdead_allom(bag,bcr,bsap,ipft,bdead,dbagdd,dbcrdd,dbsapdd,dbdeaddd) + subroutine bdead_allom(bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeaddd) + real(r8),intent(in) :: bagw ! biomass above ground wood (agb) [kgC] + real(r8),intent(in) :: bbgw ! biomass below ground (bgb) [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 :: dbagwdd ! change in agb per d [kgC/cm] + real(r8),intent(in),optional :: dbbgwdd ! change in bbgw 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] + + ! bdead is diagnosed as the mass balance from all other pools + ! and therefore, no options are necessary + ! + ! Assumption: We assume that the leaf biomass component of AGB is negligable + ! and do not assume it is part of the AGB measurement, nor are fineroots part of the + ! bbgw. Therefore, it is not removed from AGB and BBGW in the calculation of dead mass. - 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] - 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] - - ! bdead is diagnosed as the mass balance from all other pools - ! and therefore, no options are necessary associate( agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft)) select case(int(EDPftvarcon_inst%allom_amode(ipft))) case(1) ! Saldariagga mass allometry originally calculated bdead directly. - ! we assume proportionality between bdead and bag + ! we assume proportionality between bdead and bagw - bdead = bag/agb_fraction - if(present(dbagdd) .and. present(dbdeaddd))then - dbdeaddd = dbagdd/agb_fraction + bdead = bagw/agb_fraction + if(present(dbagwdd) .and. present(dbdeaddd))then + dbdeaddd = dbagwdd/agb_fraction end if case(2,3) - bdead = bag+bcr-bsap - if(present(dbagdd) .and. present(dbcrdd) .and. & + bdead = bagw + bbgw - bsap + if(present(dbagwdd) .and. present(dbbgwdd) .and. & present(dbdeaddd) .and. present(dbsapdd) )then - dbdeaddd = dbagdd+dbcrdd-dbsapdd + dbdeaddd = dbagwdd+dbbgwdd-dbsapdd end if case DEFAULT @@ -570,41 +599,86 @@ subroutine bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) end subroutine bfrmax_const ! ============================================================================ - ! Specific bcr relationships + ! Specific bbgw relationships ! ============================================================================ - subroutine bcr_const(d,bag,dbagdd,ipft,bcr,dbcrdd) + subroutine bbgw_const(d,bagw,dbagwdd,ipft,bbgw,dbbgwdd) 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] + real(r8),intent(in) :: bagw ! above ground biomass [kg] + real(r8),intent(in) :: dbagwdd ! 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),optional :: dbcrdd ! change croot bio per diam [kg/cm] + real(r8),intent(out) :: bbgw ! coarse root biomass [kg] + real(r8),intent(out),optional :: dbbgwdd ! 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) + bbgw = (1.0_r8/agb_fraction-1.0_r8)*bagw ! Derivative - ! dbcr/dd = dbcr/dbag * dbag/dd - if(present(dbcrdd))then - dbcrdd = (1.0_r8/agb_fraction-1.0_r8)*dbagdd + ! dbbgw/dd = dbbgw/dbagw * dbagw/dd + if(present(dbbgwdd))then + dbbgwdd = (1.0_r8/agb_fraction-1.0_r8)*dbagwdd end if end associate return - end subroutine bcr_const + end subroutine bbgw_const ! ============================================================================ ! Specific d2bsap relationships ! ============================================================================ - subroutine bsap_dlinear(d,h,dhdd,blmax,dblmaxdd,bag,dbagdd,ipft,bsap,dbsapdd) + subroutine bsap_deprecated(d,h,dhdd,bleaf,dbleafdd,ipft,bsap,dbsapdd) + + use FatesConstantsMod, only : g_per_kg + use FatesConstantsMod, only : cm2_per_m2 + use FatesConstantsMod, only : kg_per_Megag + + ! ------------------------------------------------------------------------- + ! ------------------------------------------------------------------------- + + 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) :: bleaf ! plant leaf biomass [kgC] + real(r8),intent(in) :: dbleafdd ! change in blmax 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 + + + 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), & + agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft) ) + + ! notes: + ! latosa_int units of [/m] + ! (1/latosa)* slatop* gtokg * cm2tom2 / c2b * mg2kg * dens + ! density (g/cm3 == Mg/m3 b/c 1e6 = 100^3) + ! [cm2/m2] * [m2/gC]*[1000gC/1kgC]*[1m2/10000cm2] /[kg/kgC]*[kg/Mg]*[Mg/m3] = [/m] + ! 0.012 * 1000 * (1/10000) / 2 * 1000 * 0.7 + + bsap = bleaf * latosa_int * h + + if(present(dbsapdd))then + dbsapdd = latosa_int*(h*dbleafdd + bleaf*dhdd) + end if + + end associate + return + end subroutine bsap_deprecated + + ! ======================================================================== + + subroutine bsap_dlinear(d,h,dhdd,bleaf,dbleafdd,ipft,bsap,dbsapdd) use FatesConstantsMod, only : g_per_kg use FatesConstantsMod, only : cm2_per_m2 @@ -616,77 +690,57 @@ subroutine bsap_dlinear(d,h,dhdd,blmax,dblmaxdd,bag,dbagdd,ipft,bsap,dbsapdd) ! of plant size, see Calvo-Alvarado and Bradley Christoferson ! In this case: parameter latosa (from constant proportionality) ! is the intercept of the diameter function. + ! + ! Important note: this is above and below-ground sapwood ! - ! 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] + real(r8),intent(in) :: bleaf ! plant leaf biomass [kgC] + real(r8),intent(in) :: dbleafdd ! change in blmax 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)) + c2b => EDPftvarcon_inst%c2b(ipft), & + agb_fraction => EDPftvarcon_inst%allom_agb_frac(ipft) ) ! ------------------------------------------------------------------------ ! Calculate sapwood biomass per linear height and kgC of leaf [m-1] ! Units: - ! (1/latosa)* slatop* gtokg * cm2tom2 / c2b * mg2kg * dens + ! 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] + ! ->[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%c3psn , & slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, @@ -496,17 +491,6 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Part VIII: Calculate maintenance respiration in the sapwood and ! fine root pools. ! ------------------------------------------------------------------ - - 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 From 183807f5108eae29db0e69ad1a34b91d6ab7d2c5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 26 Nov 2017 12:29:07 -0800 Subject: [PATCH 036/111] Modified calls to allometry functions to accomodate new arguments and names --- biogeochem/EDCohortDynamicsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 42 +++++++++++----------- biogeochem/FatesAllometryMod.F90 | 2 +- biogeophys/FatesPlantRespPhotosynthMod.F90 | 2 +- main/EDInitMod.F90 | 18 +++++----- main/FatesInventoryInitMod.F90 | 18 +++++----- 6 files changed, 43 insertions(+), 41 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 af16c03594..165f2f089c 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -37,12 +37,12 @@ module EDPhysiologyMod use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : h2d_allom - use FatesAllometryMod , only : bag_allom + use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bdead_allom - use FatesAllometryMod , only : bcr_allom + use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : carea_allom @@ -826,10 +826,10 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) 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_agw ! above ground biomass (kgC/cm) + real(r8) :: db_agw_dd ! change in above ground biomass wrt diameter (kgC/cm) + real(r8) :: b_bgw ! coarse root biomass (kgC) + real(r8) :: db_bgw_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) @@ -881,7 +881,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 @@ -1028,9 +1028,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%hite,ipft,b_cr,db_cr_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 ) + ! biomass above ground woody/fibrous (non-leaf) tissues + call bagw_allom(currentCohort%dbh,currentCohort%hite,ipft,b_agw,db_agw_dd) + ! biomass below ground in woody/fibrous (non-fineroot) tissues + call bbgw_allom(currentCohort%dbh,currentCohort%hite,ipft,b_bgw,db_bgw_dd) + call bdead_allom( b_agw, b_bgw, b_sap, ipft, b_dead, db_agw_dd, db_bgw_dd, db_sap_dd, db_dead_dd ) !only if carbon balance is +ve @@ -1051,8 +1053,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,currentCohort%hite,ipft, & - currentCohort%canopy_trim,b_sap,db_sap_dd) + 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] dbalivedbd = (db_leaf_dd + db_fineroot_dd + db_sap_dd)/db_dead_dd @@ -1166,10 +1168,10 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) type (ed_cohort_type) , pointer :: temp_cohort integer :: cohortstatus real(r8) :: b_leaf - real(r8) :: b_fineroot - real(r8) :: b_sapwood - real(r8) :: b_aboveground - real(r8) :: b_coarseroot + real(r8) :: b_fineroot ! fine root biomass [kgC] + real(r8) :: b_sapwood ! sapwood biomass [kgC] + real(r8) :: b_agw ! Above ground biomass [kgC] + real(r8) :: b_bgw ! Below ground biomass [kgC] !---------------------------------------------------------------------- @@ -1186,11 +1188,11 @@ 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) - call bdead_allom(b_aboveground,b_coarseroot,b_sapwood,ft,temp_cohort%bdead) + call bagw_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_agw) + call bbgw_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_bgw) + call bdead_allom(b_agw,b_bgw,b_sapwood,ft,temp_cohort%bdead) 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 a9f0813371..ba8984d221 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -426,7 +426,7 @@ subroutine bsap_allom(d,ipft,canopy_trim,bsap,dbsapdd) end if end if - case(9) ! deprecated + case(9) ! deprecated (9) call h_allom(d,ipft,h,dhdd) call bleaf(d,h,ipft,canopy_trim,bl,dbldd) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index cd40626b2c..9ac33909df 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -491,7 +491,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! Part VIII: Calculate maintenance respiration in the sapwood and ! fine root pools. ! ------------------------------------------------------------------ - + ! Calculate the amount of nitrogen in the above and below ground ! stem and root pools, used for maint resp ! We are using the fine-root C:N ratio as an approximation for diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index f1fe6501a5..ed6d93c330 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -26,8 +26,8 @@ module EDInitMod 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 : bagw_allom + use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bsap_allom @@ -344,9 +344,9 @@ subroutine init_cohorts( patch_in, bc_in) type(ed_cohort_type),pointer :: temp_cohort 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_agw ! biomass above ground (non-leaf) [kgC] + real(r8) :: b_bgw ! biomass below ground (non-fineroot) [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] !---------------------------------------------------------------------- @@ -370,10 +370,10 @@ subroutine init_cohorts( patch_in, bc_in) temp_cohort%canopy_trim = 1.0_r8 ! Calculate total above-ground biomass from allometry - call bag_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_ag) + call bagw_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_agw) ! Calculate coarse root biomass from allometry - call bcr_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_cr) + call bbgw_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_bgw) ! Calculate the leaf biomass ! (calculates a maximum first, then applies canopy trim) @@ -384,11 +384,11 @@ 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 - call bdead_allom( b_ag, b_cr, b_sapwood, pft, temp_cohort%bdead ) + call bdead_allom( b_agw, b_bgw, b_sapwood, pft, temp_cohort%bdead ) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 66a8a8c5ef..36bf991e4e 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -750,8 +750,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : h2d_allom - use FatesAllometryMod , only : bag_allom - use FatesAllometryMod , only : bcr_allom + use FatesAllometryMod , only : bagw_allom + use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bsap_allom @@ -785,9 +785,9 @@ 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_agw ! biomass above ground non-leaf [kgC] + real(r8) :: b_bgw ! biomass below ground non-leaf [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] @@ -877,9 +877,9 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! Calculate total above-ground biomass from allometry - call bag_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_ag) + call bagw_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_agw) ! Calculate coarse root biomass from allometry - call bcr_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_cr) + call bbgw_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_bgw) ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim ! and sla scaling factors) @@ -889,11 +889,11 @@ 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 - call bdead_allom( b_ag, b_cr, b_sapwood, c_pft, temp_cohort%bdead ) + call bdead_allom( b_agw, b_bgw, b_sapwood, c_pft, temp_cohort%bdead ) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead From b9a669408498db377ce7e7c1612e47128cd8e88e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 26 Nov 2017 19:14:39 -0800 Subject: [PATCH 037/111] Removed height arg from the bagw_call and bbgw_call --- biogeochem/EDPhysiologyMod.F90 | 8 ++++---- biogeochem/FatesAllometryMod.F90 | 18 ++++++++---------- main/EDInitMod.F90 | 4 ++-- main/FatesInventoryInitMod.F90 | 4 ++-- 4 files changed, 16 insertions(+), 18 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 165f2f089c..e05c0d531c 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1029,9 +1029,9 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! Tally up the relative change in dead biomass WRT diameter ! biomass above ground woody/fibrous (non-leaf) tissues - call bagw_allom(currentCohort%dbh,currentCohort%hite,ipft,b_agw,db_agw_dd) + call bagw_allom(currentCohort%dbh,ipft,b_agw,db_agw_dd) ! biomass below ground in woody/fibrous (non-fineroot) tissues - call bbgw_allom(currentCohort%dbh,currentCohort%hite,ipft,b_bgw,db_bgw_dd) + call bbgw_allom(currentCohort%dbh,ipft,b_bgw,db_bgw_dd) call bdead_allom( b_agw, b_bgw, b_sap, ipft, b_dead, db_agw_dd, db_bgw_dd, db_sap_dd, db_dead_dd ) !only if carbon balance is +ve @@ -1190,8 +1190,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call bfineroot(temp_cohort%dbh,temp_cohort%hite,ft,temp_cohort%canopy_trim,b_fineroot) call bsap_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_sapwood) - call bagw_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_agw) - call bbgw_allom(temp_cohort%dbh,temp_cohort%hite,ft,b_bgw) + call bagw_allom(temp_cohort%dbh,ft,b_agw) + call bbgw_allom(temp_cohort%dbh,ft,b_bgw) call bdead_allom(b_agw,b_bgw,b_sapwood,ft,temp_cohort%bdead) temp_cohort%balive = b_leaf + b_sapwood + b_fineroot diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index ba8984d221..749e7faeb7 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -210,16 +210,15 @@ end subroutine h_allom ! Generic AGB interface ! ============================================================================ - subroutine bagw_allom(d,h,ipft,bagw,dbagwdd) + subroutine bagw_allom(d,ipft,bagw,dbagwdd) 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) :: bagw ! biomass above ground woody tissues real(r8),intent(out),optional :: dbagwdd ! change in agbw per diameter [kgC/cm] - real(r8) :: hj ! height (dummy arg) + real(r8) :: h ! height real(r8) :: dhdd ! change in height wrt d associate( p1 => EDPftvarcon_inst%allom_agb1(ipft), & @@ -233,13 +232,13 @@ subroutine bagw_allom(d,h,ipft,bagw,dbagwdd) select case(int(allom_amode)) case (1) !"salda") - call h_allom(d,ipft,hj,dhdd) + call h_allom(d,ipft,h,dhdd) call dh2bagw_salda(d,h,dhdd,p1,p2,p3,p4,wood_density,c2b,agb_frac,bagw,dbagwdd) case (2) !"2par_pwr") ! Switch for woodland dbh->drc call d2bagw_2pwr(d,p1,p2,c2b,bagw,dbagwdd) case (3) !"chave14") - call h_allom(d,ipft,hj,dhdd) + call h_allom(d,ipft,h,dhdd) call dh2bagw_chave2014(d,h,dhdd,p1,p2,wood_density,c2b,bagw,dbagwdd) case DEFAULT write(fates_log(),*) 'An undefined AGB allometry was specified: ',allom_amode @@ -413,8 +412,8 @@ subroutine bsap_allom(d,ipft,canopy_trim,bsap,dbsapdd) call bsap_dlinear(d,h,dhdd,bl,dbldd,ipft,bsap,dbsapdd) ! Perform a capping/check on total woody biomass - call bagw_allom(d,h,ipft,bagw,dbagwdd) - call bbgw_allom(d,h,ipft,bbgw,dbbgwdd) + call bagw_allom(d,ipft,bagw,dbagwdd) + call bbgw_allom(d,ipft,bbgw,dbbgwdd) ! Force sapwood to be less than a maximum fraction of total biomass ! (this comes into play typically in very small plants) @@ -447,10 +446,9 @@ end subroutine bsap_allom ! non-fineroot biomass. ! ============================================================================ - subroutine bbgw_allom(d,h,ipft,bbgw,dbbgwdd) + subroutine bbgw_allom(d,ipft,bbgw,dbbgwdd) 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) :: bbgw ! below ground woody biomass [kgC] real(r8),intent(out),optional :: dbbgwdd ! change bbgw per diam [kgC/cm] @@ -460,7 +458,7 @@ subroutine bbgw_allom(d,h,ipft,bbgw,dbbgwdd) select case(int(EDPftvarcon_inst%allom_cmode(ipft))) case(1) !"constant") - call bagw_allom(d,h,ipft,bagw,dbagwdd) + call bagw_allom(d,ipft,bagw,dbagwdd) call bbgw_const(d,bagw,dbagwdd,ipft,bbgw,dbbgwdd) case DEFAULT write(fates_log(),*) 'An undefined coarse root allometry was specified: ', & diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index ed6d93c330..79d38b5f94 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -370,10 +370,10 @@ subroutine init_cohorts( patch_in, bc_in) temp_cohort%canopy_trim = 1.0_r8 ! Calculate total above-ground biomass from allometry - call bagw_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_agw) + call bagw_allom(temp_cohort%dbh,pft,b_agw) ! Calculate coarse root biomass from allometry - call bbgw_allom(temp_cohort%dbh,temp_cohort%hite,pft,b_bgw) + call bbgw_allom(temp_cohort%dbh,pft,b_bgw) ! Calculate the leaf biomass ! (calculates a maximum first, then applies canopy trim) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 36bf991e4e..e8c4b281e4 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -877,9 +877,9 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! Calculate total above-ground biomass from allometry - call bagw_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_agw) + call bagw_allom(temp_cohort%dbh,c_pft,b_agw) ! Calculate coarse root biomass from allometry - call bbgw_allom(temp_cohort%dbh,temp_cohort%hite,c_pft,b_bgw) + call bbgw_allom(temp_cohort%dbh,c_pft,b_bgw) ! Calculate the leaf biomass (calculates a maximum first, then applies canopy trim ! and sla scaling factors) From 491937869605884dc72cdb812b5a2a1da94b83c2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 27 Nov 2017 12:03:55 -0700 Subject: [PATCH 038/111] 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 edca4101e73c7404becc48ab5807694bbf76acf6 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 27 Nov 2017 13:17:59 -0800 Subject: [PATCH 039/111] Removed redundant wrapper to canopy_derivs. Removed redundant live biomass allometry calls during growth derivs. Included height to be updated when dbh and bdead and balive are integrated. --- biogeochem/EDCohortDynamicsMod.F90 | 1 + biogeochem/EDPhysiologyMod.F90 | 53 +++++------------------------- main/EDMainMod.F90 | 10 +++--- 3 files changed, 15 insertions(+), 49 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index d075ec25c3..a84f0b7655 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -233,6 +233,7 @@ subroutine allocate_live_biomass(cc_p,mode) currentCohort => cc_p ft = currentcohort%pft + 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,currentcohort%canopy_trim,tar_bsw) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e05c0d531c..3465fb8da2 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -49,12 +49,11 @@ module EDPhysiologyMod implicit none private - public :: canopy_derivs public :: non_canopy_derivs public :: trim_canopy public :: phenology private :: phenology_leafonoff - private :: Growth_Derivatives + public :: Growth_Derivatives public :: recruitment private :: cwd_input private :: cwd_out @@ -74,34 +73,7 @@ module EDPhysiologyMod contains ! ============================================================================ - subroutine canopy_derivs( currentSite, currentPatch, bc_in ) - ! - ! !DESCRIPTION: - ! spawn new cohorts of juveniles of each PFT - ! - ! !USES: - ! - ! !ARGUMENTS - type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type) , intent(inout), target :: currentPatch - type(bc_in_type), intent(in) :: bc_in - ! - ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer ::currentCohort - !---------------------------------------------------------------------- - ! call plant growth functions - - currentCohort => currentPatch%shortest - - do while(associated(currentCohort)) - call Growth_Derivatives(currentSite, currentCohort, bc_in ) - currentCohort => currentCohort%taller - enddo - - end subroutine canopy_derivs - - ! ============================================================================ subroutine non_canopy_derivs( currentSite, currentPatch, bc_in ) ! ! !DESCRIPTION: @@ -862,9 +834,10 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) endif ! Height - + + ! When this model becomes fully prognostic for leaf, fineroot and sapwood + ! we will not need to call this routine here (RGK 11-2017) call h_allom(currentCohort%dbh,currentCohort%pft,currentCohort%hite) - call allocate_live_biomass(currentCohort,0) ! ----------------------------------------------------------------------------------- @@ -873,15 +846,15 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! 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) + call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_leaf,db_leaf_dd) ! 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,currentCohort%canopy_trim,b_fineroot) + call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) ! Calculate sapwood biomass - call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,b_sap) + call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,b_sap,db_sap_dd) target_balive = b_leaf + b_fineroot + b_sap @@ -1046,16 +1019,6 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) gr_fract = 1.0_r8 - (EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft)) 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, & - currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) - 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] dbalivedbd = (db_leaf_dd + db_fineroot_dd + db_sap_dd)/db_dead_dd @@ -1093,7 +1056,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! -------------------------------------------------------------------------------- ! 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 + ! and trimming). 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). ! -------------------------------------------------------------------------------- diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index b7d488ff32..a9092533aa 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -28,7 +28,7 @@ module EDMainMod use EDPatchDynamicsMod , only : fuse_patches use EDPatchDynamicsMod , only : spawn_patches use EDPatchDynamicsMod , only : terminate_patches - use EDPhysiologyMod , only : canopy_derivs + use EDPhysiologyMod , only : Growth_Derivatives use EDPhysiologyMod , only : non_canopy_derivs use EDPhysiologyMod , only : phenology use EDPhysiologyMod , only : recruitment @@ -47,6 +47,7 @@ module EDMainMod use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydStates use FatesPlantHydraulicsMod , only : initTreeHydStates use FatesPlantHydraulicsMod , only : updateSizeDepRhizHydProps + use FatesAllometryMod , only : h_allom ! use FatesPlantHydraulicsMod , only : updateSizeDepRhizHydStates use EDLoggingMortalityMod , only : IsItLoggingTime use FatesGlobals , only : endrun => fates_endrun @@ -260,17 +261,18 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! check to see if the patch has moved to the next age class currentPatch%age_class = get_age_class_index(currentPatch%age) - ! Find the derivatives of the growth and litter processes. - call canopy_derivs(currentSite, currentPatch, bc_in) - ! Update Canopy Biomass Pools currentCohort => currentPatch%shortest do while(associated(currentCohort)) + ! Calculate the rates of change of live and dead tissues + call Growth_Derivatives( currentSite, currentCohort, bc_in) + cohort_biomass_store = (currentCohort%balive+currentCohort%bdead+currentCohort%bstore) 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 5f4ed7e72ba442763314c9cc7ea48020f6792701 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 27 Nov 2017 16:44:04 -0800 Subject: [PATCH 040/111] First pass at refactoring allocation. --- biogeochem/EDCohortDynamicsMod.F90 | 1 - biogeochem/EDMortalityFunctionsMod.F90 | 107 ++++- biogeochem/EDPhysiologyMod.F90 | 590 ++++++++++++++----------- main/EDMainMod.F90 | 11 +- main/EDTypesMod.F90 | 1 + 5 files changed, 427 insertions(+), 283 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index a84f0b7655..d075ec25c3 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -233,7 +233,6 @@ subroutine allocate_live_biomass(cc_p,mode) currentCohort => cc_p ft = currentcohort%pft - 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,currentcohort%canopy_trim,tar_bsw) diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index c4e34b0c52..68cca9934d 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -4,27 +4,36 @@ 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 - ! ============================================================================ - + use FatesConstantsMod , only : r8 => fates_r8 + use FatesGlobals , only : fates_log + use EDPftvarcon , only : EDPftvarcon_inst + use EDTypesMod , only : ed_cohort_type + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : ed_patch_type + use FatesConstantsMod , only : itrue,ifalse + use FatesAllometryMod , only : bleaf + use EDParamsMod , only : ED_val_stress_mort + use FatesInterfaceMod , only : bc_in_type + use FatesInterfaceMod , only : hlm_use_ed_prescribed_phys + use FatesInterfaceMod , only : hlm_freq_day + use EDLoggingMortalityMod , only : LoggingMortality_frac + use EDParamsMod , only : fates_mortality_disturbance_fraction + use FatesInterfaceMod , only : bc_in_type + + + implicit none + private + + + public :: mortality_rates + public :: Mortality_Derivative + + logical :: DEBUG_growth = .false. + + ! ============================================================================ + ! 10/30/09: Created by Rosie Fisher + ! ============================================================================ + contains @@ -90,6 +99,60 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) end subroutine mortality_rates -! ============================================================================ + ! ============================================================================ + + subroutine Mortality_Derivative( currentSite, currentCohort, bc_in) + + ! + ! !DESCRIPTION: + ! Calculate the change in number density per unit time from the contributing + ! rates. These rates are not disturbance-inducing rates (that is handled + ! elsewhere). + ! + ! !USES: + + ! + ! !ARGUMENTS + type(ed_site_type), intent(inout), target :: currentSite + type(ed_cohort_type),intent(inout), target :: currentCohort + type(bc_in_type), intent(in) :: bc_in + ! + ! !LOCAL VARIABLES: + real(r8) :: cmort ! starvation mortality rate (fraction per year) + real(r8) :: bmort ! background mortality rate (fraction per year) + real(r8) :: hmort ! hydraulic failure mortality rate (fraction per year) + real(r8) :: lmort_logging ! Mortality fraction associated with direct logging + 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 + 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) + call LoggingMortality_frac(ipft, currentCohort%dbh, & + currentCohort%lmort_logging, & + currentCohort%lmort_collateral, & + currentCohort%lmort_infra ) + + if (currentCohort%canopy_layer > 1)then + + ! Include understory logging mortality rates not associated with disturbance + dndt_logging = (currentCohort%lmort_logging + & + currentCohort%lmort_collateral + & + currentCohort%lmort_infra)/hlm_freq_day + + currentCohort%dndt = -1.0_r8 * (cmort+hmort+bmort+dndt_logging) * currentCohort%n + else + currentCohort%dndt = -(1.0_r8 - fates_mortality_disturbance_fraction) & + * (cmort+hmort+bmort) * currentCohort%n + endif + + return + + end subroutine Mortality_Derivative end module EDMortalityFunctionsMod diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 3465fb8da2..8d46820a10 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -759,10 +759,10 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! Main subroutine controlling growth and allocation derivatives ! ! !USES: + ! Original: Rosie Fisher + ! Updated: Ryan Knox - use EDMortalityFunctionsMod , only : mortality_rates use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys - use EDLoggingMortalityMod, only : LoggingMortality_frac ! ! !ARGUMENTS @@ -777,339 +777,415 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) 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) - real(r8) :: target_balive !target leaf biomass under allometric optimum. - real(r8) :: cmort ! starvation mortality rate (fraction per year) - real(r8) :: bmort ! background mortality rate (fraction per year) - real(r8) :: hmort ! hydraulic failure mortality rate (fraction per year) - - real(r8) :: lmort_logging ! Mortality fraction associated with direct logging - 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 ! Carbon that will be removed from the alive pool due to things - ! maintenance turnover - real(r8) :: height ! plant height - - ! 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_agw ! above ground biomass (kgC/cm) - real(r8) :: db_agw_dd ! change in above ground biomass wrt diameter (kgC/cm) - real(r8) :: b_bgw ! coarse root biomass (kgC) - real(r8) :: db_bgw_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 - !---------------------------------------------------------------------- - ipft = currentCohort%pft + ! Per plant allocation targets - ! 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(ipft, currentCohort%dbh, & - currentCohort%lmort_logging, & - currentCohort%lmort_collateral, & - currentCohort%lmort_infra ) + real(r8) :: bt_leaf ! leaf biomass (kgC) + real(r8) :: dbt_leaf_dd ! change in leaf biomass wrt diameter (kgC/cm) + real(r8) :: bt_fineroot ! fine root biomass (kgC) + real(r8) :: dbt_fineroot_dd ! change in fine root biomass wrt diameter (kgC/cm) + real(r8) :: bt_sap ! sapwood biomass (kgC) + real(r8) :: dbt_sap_dd ! change in sapwood biomass wrt diameter (kgC/cm) + real(r8) :: bt_agw ! above ground biomass (kgC/cm) + real(r8) :: dbt_agw_dd ! change in above ground biomass wrt diameter (kgC/cm) + real(r8) :: bt_bgw ! coarse root biomass (kgC) + real(r8) :: dbt_bgw_dd ! change in coarse root biomass (kgC/cm) + real(r8) :: bt_dead ! dead (structural) biomass (kgC) + real(r8) :: dbt_dead_dd ! change in dead biomass wrt diameter (kgC/cm) + real(r8) :: bt_store ! target storage biomass (kgC) + real(r8) :: dbt_store_dd ! target rate of change in storage (kgC/cm) - if (currentCohort%canopy_layer > 1)then - - ! Include understory logging mortality rates not associated with disturbance - dndt_logging = (currentCohort%lmort_logging + & - currentCohort%lmort_collateral + & - currentCohort%lmort_infra)/hlm_freq_day - currentCohort%dndt = -1.0_r8 * (cmort+hmort+bmort+dndt_logging) * currentCohort%n - else - currentCohort%dndt = -(1.0_r8 - fates_mortality_disturbance_fraction) & - * (cmort+hmort+bmort) * currentCohort%n - endif - - ! Height + !---------------------------------------------------------------------- - ! When this model becomes fully prognostic for leaf, fineroot and sapwood - ! we will not need to call this routine here (RGK 11-2017) - call h_allom(currentCohort%dbh,currentCohort%pft,currentCohort%hite) - call allocate_live_biomass(currentCohort,0) + ipft = currentCohort%pft ! ----------------------------------------------------------------------------------- - ! calculate target size of living biomass compartment for a given dbh. + ! I. Identify the net carbon gain for this dynamics interval ! ----------------------------------------------------------------------------------- - - ! 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,db_leaf_dd) - - ! 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,currentCohort%canopy_trim,b_fineroot,db_fineroot_dd) - ! Calculate sapwood biomass - call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,b_sap,db_sap_dd) - - target_balive = b_leaf + b_fineroot + b_sap - - !target balive without leaves. - if (currentCohort%status_coh == 1)then - target_balive = b_fineroot + b_sap - endif - ! convert from kgC/indiv/day into kgC/indiv/year - ! TODO: CONVERT DAYS_PER_YEAR TO DBLE (HOLDING FOR B4B COMPARISONS, RGK-01-2017) - currentCohort%npp_acc_hold = currentCohort%npp_acc * hlm_days_per_year - currentCohort%gpp_acc_hold = currentCohort%gpp_acc * hlm_days_per_year - currentCohort%resp_acc_hold = currentCohort%resp_acc * hlm_days_per_year - + ! _acc_hold is remembered until the next dynamics step (used for I/O) + ! _acc will be reset soon and will be accumulated on the next leaf photosynthesis + ! step + 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 = currentCohort%npp_acc_hold / hlm_days_per_year ! add these for balance checking purposes + ! add these for balance checking purposes + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year else 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 + ! add these for balance checking purposes + currentCohort%npp_acc = currentCohort%npp_acc_hold / hlm_days_per_year endif + else + currentCohort%npp_acc_hold = currentCohort%npp_acc * dble(hlm_days_per_year) + currentCohort%gpp_acc_hold = currentCohort%gpp_acc * dble(hlm_days_per_year) + currentCohort%resp_acc_hold = currentCohort%resp_acc * dble(hlm_days_per_year) endif currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n - ! Maintenance demands - if (EDPftvarcon_inst%evergreen(ipft) == 1)then !grass and EBT + + + + + ! ----------------------------------------------------------------------------------- + ! II. Calculate target size of living biomass compartment for a given dbh. + ! ----------------------------------------------------------------------------------- + + ! Target leaf biomass according to allometry and trimming + call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) + + ! If status_coh is 1, then leaves are in a dropped (off allometry) + if( currentcohort%status_coh == 1 ) then + bt_leaf = 0.0_r8 + dbt_leaf_db = 0.0_r8 + end if + + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) + + ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] + call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) + + ! Target total above ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] + call bagw_allom(currentCohort%dbh,ipft,bt_agw,dbt_agw_dd) + + ! Target total below ground deriv. biomass in woody/fibrous tissues [kgC, kgC/cm] + call bbgw_allom(currentCohort%dbh,ipft,bt_bgw,dbt_bgw_dd) + + ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] + call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) + + + + ! ----------------------------------------------------------------------------------- + ! III. If fusion pushed a plant off allometry, we could have negatives + ! here. We allow negative deficits to push carbon downward too, and we take + ! that carbon back into the carbon flux pool + ! ----------------------------------------------------------------------------------- + + leaf_deficit = bt_leaf - currentCohort%bl + froot_deficit = bt_fineroot - currentCohort%br + sap_deficit = bt_sap - currentCohort%bsw + store_deficit = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore + dead_deficit = bt_dead - currentCohort%bdead + + if(leaf_deficit<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_deficit + currentCohort%bl = currentCohort%bl + leaf_deficit + currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_deficit * hlm_freq_day + leaf_deficit = 0.0_r8 + end if + + if(froot_deficit<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - froot_deficit + currentCohort%br = currentCohort%br + froot_deficit + currentCohort%npp_froot = currentCohort%npp_froot + froot_deficit * hlm_freq_day + froot_deficit = 0.0_r8 + end if + + if(sap_deficit<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - sap_deficit + currentCohort%bsw = currentCohort%bsw + sap_deficit + currentCohort%npp_bsw = currentCohort%npp_bsw + sap_deficit * hlm_freq_day + sap_deficit = 0.0_r8 + end if + + if(store_deficit<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - store_deficit + currentCohort%bstore = currentCohort%bstore + store_deficit + currentCohort%npp_store = currentCohort%npp_bsw + store_deficit * hlm_freq_day + store_deficit = 0.0_r8 + end if + + if(dead_deficit<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - dead_deficit + currentCohort%bdead = currentCohort%bdead + dead_deficit + currentCohort%npp_bdead = currentCohort%npp_bdead + dead_deficit * hlm_freq_day + store_deficit = 0.0_r8 + end if + + + ! ----------------------------------------------------------------------------------- + ! IV(a). Calculate the maintenance turnover demands + ! Pre-check, make sure phenology is mutually exclusive and at least one chosen + ! (MOVE THIS TO THE PARAMETER READ-IN) + ! ----------------------------------------------------------------------------------- + + if (EDPftvarcon_inst%evergreen(ipft) == 1) then + if (EDPftvarcon_inst%season_decid(ipft) == 1)then + write(fates_log(),*) 'PFT # ',ipft,' was specified as being both evergreen' + write(fates_log(),*) ' and seasonally deciduous, impossible, aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (EDPftvarcon_inst%stress_decid(ipft) == 1)then + write(fates_log(),*) 'PFT # ',ipft,' was specified as being both evergreen' + write(fates_log(),*) ' and stress deciduous, impossible, aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + if (EDPftvarcon_inst%stress_decid(ipft) /= 1 .and. & + EDPftvarcon_inst%season_decid(ipft) /= 1 .and. & + EDPftvarcon_inst%evergreen(ipft) /= 1) then + write(fates_log(),*) 'PFT # ',ipft,' must be defined as having one of three' + write(fates_log(),*) 'phenology habits, ie == 1' + write(fates_log(),*) 'stress_decid: ',EDPftvarcon_inst%stress_decid(ipft) + write(fates_log(),*) 'season_decid: ',DPftvarcon_inst%season_decid(ipft) + write(fates_log(),*) 'evergreen: ',EDPftvarcon_inst%evergreen(ipft) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + + + ! ----------------------------------------------------------------------------------- + ! IV(b). Calculate the maintenance turnover demands + ! ----------------------------------------------------------------------------------- + + if (EDPftvarcon_inst%evergreen(ipft) == 1)then 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 - !FIX(RF,032414) - I took out the stem turnover demand as it seemed excesively high and caused odd size-reated - ! decline affect - !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(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(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(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 + ! Stem turnover is turned off for now. SHould make provisions for storms, + ! or for scenarios where stem wood turnover is high, it brings some leaf/root + ! with it. + currentCohort%stem_md = 0.0_r8 - ! FIX(RF,032414) -turned off for now as it makes balive go negative.... - ! FIX(RF,032414) jan2012 0.01_r8 * currentCohort%bdead - currentCohort%woody_turnover = 0.0_r8 - currentCohort%md = currentCohort%md + currentCohort%woody_turnover - ! Calculate carbon balance - ! 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(ipft) + ! ----------------------------------------------------------------------------------- + ! V. Remove turnover from the appropriate pools + ! + ! Units: kgC/year / (1/days_per_year) = kgC/day -> (day elapsed) -> kgC + ! ADD THESE TO THE LITTER FLUX + ! ----------------------------------------------------------------------------------- + + ! leaf biomass + currentCohort%bl = currentCohort%bl - currentCohort%leaf_md/hlm_freq_day + + ! fine-root biomass + currentcohort%br = currentcohort%br - currentCohort%root_md/hlm_freq_day + + - currentCohort%carbon_balance = currentCohort%npp_acc_hold - & - currentCohort%md * EDPftvarcon_inst%leaf_stor_priority(ipft) + ! ----------------------------------------------------------------------------------- + ! VI. Set the available carbon pool, identify allocation portions, and decrement + ! the available carbon pool to zero. + ! ----------------------------------------------------------------------------------- - ! 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(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(ipft))) + ! Available carbon, convert [kgC/year] to [kgC] + currentCohort%carbon_balance = currentCohort%npp_acc_hold/hlm_freq_day - if (b_leaf > 0._r8)then + ! Initialize some NPP flux diagnostics + currentCohort%npp_store = 0.0_r8 + currentCohort%npp_leaf = 0.0_r8 + currentCohort%npp_froot = 0.0_r8 - if ( DEBUG ) write(fates_log(),*) 'EDphys A ',currentCohort%carbon_balance + ! ----------------------------------------------------------------------------------- + ! VI(a) if carbon balance is negative, re-coup the losses from storage + ! ALLOW NEGATIVE STORAGE CARBON FOR NOW + ! ----------------------------------------------------------------------------------- + if( currentCohort%carbon_balance < 0.0_r8 ) then + storage_flux = -currentCohort%carbon_balance + currentCohort%carbon_balance = currentCohort%carbon_balance + storage_flux + currentCohort%bstore = currentCohort%bstore - storage_flux + currentCohort%npp_store = currentCohort%npp_store - storage_flux * hlm_freq_day +! if( currentCohort%carbon_balance < -tiny(currentCohort%carbon_balance) ) then +! write(fates_log(),*) ' A cohort has a negative carbon balance (ie more respiration' +! write(fates_log(),*) ' than assimilate), and does not have enough storage to' +! write(fates_log(),*) ' accomodate the losses. Maintenance respiration' +! write(fates_log(),*) ' SHOULD be attenuating at this point and driving up' +! write(fates_log9),*) ' mortality. Exiting.' +! call endrun(msg=errMsg(sourcefile, __LINE__)) +! end if + end if + - if (currentCohort%carbon_balance > 0._r8)then !spend C on growing and storing + ! ----------------------------------------------------------------------------------- + ! VI(b). Prioritize some amount of carbon to replace leaf/root turnover + ! ----------------------------------------------------------------------------------- - !what fraction of the target storage do we have? - 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? - !what is the flux into the store? - currentCohort%storage_flux = currentCohort%carbon_balance * f_store + leaf_turnover_demand = currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(ipft)/hlm_freq_day + root_turnover_demand = currentCohort%root_md*EDPftvarcon_inst%leaf_stor_priority(ipft)/hlm_freq_day + total_turnover_demand = leaf_turnover_demand + root_turnover_demand + + if(total_turnover_demand>0.0_r8)then - currentCohort%npp_store = currentCohort%carbon_balance * f_store - if ( DEBUG ) write(fates_log(),*) 'EDphys B ',f_store + leaf_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux + currentCohort%bl = currentCohort%bl + leaf_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day - !what is the tax on the carbon available for growth? - currentCohort%carbon_balance = currentCohort%carbon_balance * (1.0_r8 - f_store) - else !cbalance is negative. Take C out of store to pay for maintenance respn. + root_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - root_flux + currentCohort%br = currentCohort%br + root_flux + currentCohort%npp_froot = currentCohort%npp_froot + root_flux * hlm_freq_day + end if + - currentCohort%storage_flux = currentCohort%carbon_balance - ! Note that npp_store only tracks the flux between NPP and storage. Storage can - ! also be drawn down to support some turnover demand. - currentCohort%npp_store = min(0.0_r8,currentCohort%npp_acc_hold) + ! ----------------------------------------------------------------------------------- + ! VI(c). If carbon is still available, prioritize some allocation to storage + ! ----------------------------------------------------------------------------------- + storage_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft))) + storage_flux_fraction = max(exp(-1.*storage_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) + storage_flux = currentCohort%carbon_balance * storage_flux_fraction + currentCohort%carbon_balance = currentCohort%carbon_balance - storage_flux + currentCohort%bstore = currentCohort%bstore + storage_flux + currentCohort%npp_store = currentCohort%npp_store + storage_flux * hlm_freq_day - currentCohort%carbon_balance = 0._r8 - endif - else + ! ----------------------------------------------------------------------------------- + ! VI(d). If carbon is still available, prioritize some allocation to replace + ! the rest of the leaf/fineroot turnover demand + ! ----------------------------------------------------------------------------------- + + leaf_turnover_demand = currentCohort%leaf_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))/hlm_freq_day + root_turnover_demand = currentCohort%root_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))/hlm_freq_day + total_turnover_demand = leaf_turnover_demand + root_turnover_demand + + if(total_turnover_demand>0.0_r8)then - write(fates_log(),*) 'No target leaf area in GrowthDerivs? b_leaf <= 0?' - call endrun(msg=errMsg(sourcefile, __LINE__)) + leaf_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux + currentCohort%bl = currentCohort%bl + leaf_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day + + root_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - root_flux + currentCohort%br = currentCohort%br + root_flux + currentCohort%npp_froot = currentCohort%npp_froot + root_flux * hlm_freq_day + end if - 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(ipft)))then ! Yes... - currentCohort%carbon_balance = currentCohort%carbon_balance - currentCohort%md * (1.0_r8 - & - EDPftvarcon_inst%leaf_stor_priority(ipft)) + ! ----------------------------------------------------------------------------------- + ! V(e). If carbon is still available, we try to push all alive pools back towards allometry + ! + ! SUGGESTED VARIABLE NAMES: below_target + ! + ! ----------------------------------------------------------------------------------- - currentCohort%npp_leaf = currentCohort%npp_leaf + & - 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(ipft)) + leaf_deficit = bt_leaf - currentCohort%bl + froot_deficit = bt_fineroot - currentCohort%br + sap_deficit = bt_sap - currentCohort%bsw + store_deficit = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore + total_deficit = leaf_deficit + froot_deficit + sap_deficit + store_deficit + + if ( currentCohort%carbon_balance .and. total_deficit>0.0_r8) then - else ! we can't maintain constant leaf area and root area. Balive is reduced + leaf_flux = min(leaf_deficit,currentCohort%carbon_balance * leaf_deficit/total_deficit) + currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux + currentCohort%bl = currentCohort%bl + leaf_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day - currentCohort%npp_leaf = currentCohort%npp_leaf + & - max(0.0_r8,currentCohort%carbon_balance*(currentCohort%leaf_md/currentCohort%md)) - currentCohort%npp_froot = currentCohort%npp_froot + & - max(0.0_r8,currentCohort%carbon_balance*(currentCohort%root_md/currentCohort%md)) + froot_flux = min(froot_deficit,currentCohort%carbon_balance * froot_deficit/total_deficit) + currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux + currentCohort%br = currentCohort%br + froot_flux + currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day + + sap_flux = min(sap_deficit,currentCohort%carbon_balance * sap_deficit/total_deficit) + currentCohort%carbon_balance = currentCohort%carbon_balance - sap_flux + currentCohort%bsw = currentCohort%bsw + sap_flux + currentCohort%npp_bsw = currentCohort%npp_bsw + sap_flux * hlm_freq_day - balive_loss = currentCohort%md *(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(ipft))- currentCohort%carbon_balance - currentCohort%carbon_balance = 0._r8 - endif + storage_flux = min(store_deficit,currentCohort%carbon_balance * store_deficit/total_deficit) + currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux + currentCohort%bstore = currentCohort%store + store_flux + currentCohort%npp_store = currentCohort%npp_bsw + store_flux * hlm_freq_day - !********************************************/ - ! Allometry & allocation of remaining carbon*/ - !********************************************/ - !Use remaining carbon to refill balive or to get larger. + end if + - ! Tally up the relative change in dead biomass WRT diameter - ! biomass above ground woody/fibrous (non-leaf) tissues - call bagw_allom(currentCohort%dbh,ipft,b_agw,db_agw_dd) - ! biomass below ground in woody/fibrous (non-fineroot) tissues - call bbgw_allom(currentCohort%dbh,ipft,b_bgw,db_bgw_dd) - call bdead_allom( b_agw, b_bgw, b_sap, ipft, b_dead, db_agw_dd, db_bgw_dd, db_sap_dd, db_dead_dd ) - !only if carbon balance is +ve + ! ----------------------------------------------------------------------------------- + ! V(e). If carbon is yet still available ... + ! Our alive pools are now on allometry, and we can increment all pools + ! including structure and reproduction according to their rates + ! ----------------------------------------------------------------------------------- - if ((currentCohort%balive >= target_balive).and.(currentCohort%carbon_balance > 0._r8))then - ! fraction of carbon going into active vs structural carbon + if (currentCohort%carbon_balance > 0._r8 ) then - ! fraction of carbon not going towards reproduction + ! fraction of carbon 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) + repro_frac = EDPftvarcon_inst%seed_alloc(ipft) else - gr_fract = 1.0_r8 - (EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft)) + repro_frac = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) end if - ! Total change in alive biomass relative to dead biomass [kgC/kgC] - dbalivedbd = (db_leaf_dd + db_fineroot_dd + db_sap_dd)/db_dead_dd - - if(dbalivedbd>tiny(dbalivedbd))then + dbt_total_dd = db_leaf_dd + db_fineroot_dd + db_sap_dd + db_dead_dd + db_store_dd - ! 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. - - va = 0.0_r8 - vs = 1.0_r8 - - 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 - va = 0.0_r8; vs = 1._r8 - if (DEBUG) write(fates_log(),*) 'using high bl cap',target_balive,currentCohort%balive - endif + leaf_flux = currentCohort%carbon_balance * (db_leaf_dd/dbt_total_dd)*(1.0_repro_frac) + froot_flux = currentCohort%carbon_balance * (db_fineroot_dd/dbt_total_dd)*(1.0_repro_frac) + sap_flux = currentCohort%carbon_balance * (db_sap_dd/dbt_total_dd)*(1.0_repro_frac) + dead_flux = currentCohort%carbon_balance * (db_dead_dd/dbt_total_dd)*(1.0_repro_frac) + repro_flux = currentCohort%carbon_balance * repro_frac - else + ! Take an Euler Step to integrate all pools - ! -------------------------------------------------------------------------------- - ! 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 trimming). 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 - - ! 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 - - if ( DEBUG ) write(fates_log(),*) 'EDPhys dbstoredt I ',currentCohort%dbstoredt - - currentCohort%seed_prod = (1.0_r8 - gr_fract) * currentCohort%carbon_balance - - if (abs(currentCohort%npp_acc_hold-(currentCohort%dbalivedt+currentCohort%dbdeaddt+currentCohort%dbstoredt+ & - currentCohort%seed_prod+currentCohort%md)) > 0.0000000001_r8)then - write(fates_log(),*) 'error in carbon check growth derivs',currentCohort%npp_acc_hold- & - (currentCohort%dbalivedt+currentCohort%dbdeaddt+currentCohort%dbstoredt+currentCohort%seed_prod+currentCohort%md) - write(fates_log(),*) 'cohort fluxes',currentCohort%pft,currentCohort%canopy_layer,currentCohort%n, & - currentCohort%npp_acc_hold,currentCohort%dbalivedt,balive_loss, & - currentCohort%dbdeaddt,currentCohort%dbstoredt,currentCohort%seed_prod,currentCohort%md * & - EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft) - write(fates_log(),*) 'proxies' ,target_balive,currentCohort%balive,currentCohort%dbh,va,vs,gr_fract - endif - - ! prevent negative leaf pool (but not negative store pool). This is also a numerical error prevention, - ! but it shouldn't happen actually... - if (-1.0_r8*currentCohort%dbalivedt * hlm_freq_day > currentCohort%balive*0.99)then - write(fates_log(),*) 'using non-neg leaf mass cap',currentCohort%balive , currentCohort%dbalivedt,currentCohort%dbstoredt, & - currentCohort%carbon_balance - currentCohort%dbstoredt = currentCohort%dbstoredt + currentCohort%dbalivedt - - if ( DEBUG ) write(fates_log(),*) 'EDPhys dbstoredt II ',currentCohort%dbstoredt + currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux + currentCohort%bl = currentCohort%bl + leaf_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day + + currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux + currentCohort%br = currentCohort%br + froot_flux + currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day - currentCohort%dbalivedt = 0._r8 - endif + currentCohort%carbon_balance = currentCohort%carbon_balance - sap_flux + currentCohort%bsw = currentCohort%bsw + sap_flux + currentCohort%npp_bsw = currentCohort%npp_bsw + sap_flux * hlm_freq_day + + currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux + currentCohort%bstore = currentCohort%store + store_flux + currentCohort%npp_store = currentCohort%npp_bsw + store_flux * hlm_freq_day + + currentCohort%carbon_balance = currentCohort%carbon_balance - dead_flux + currentCohort%bdead = currentCohort%bdead + dead_flux + currentCohort%npp_store = currentCohort%npp_bdead + dead_flux * hlm_freq_day + + currentCohort%carbon_balance = currentCohort%carbon_balance - repro_flux + currentCohort%bseed = currentCohort%bseed + repro_flux + currentCohort%npp_bseed = currentCohort%npp_bseed + repro_flux * hlm_freq_day + currentCohort%seed_prod = repro_flux * hlm_freq_day + + ! ----------------------------------------------------------------------------------- + ! VII. Update the diameter and height allometries if we had structural growth + ! ----------------------------------------------------------------------------------- + + currentCohort%dbh = currentCohort%dbh + dead_flux / db_dead_dd + + call h_allom(currentCohort%dbh,ipft,currentCohort%hite) - currentCohort%npp_bseed = currentCohort%seed_prod - ! calculate change in diameter - currentCohort%ddbhdt = currentCohort%dbdeaddt / db_dead_dd + ! ------------------------------------------------------------------------------------ + ! VIII. Run a post integration test to see if our integrated quantities match + ! the diagnostic quantities + ! ------------------------------------------------------------------------------------ + + call check_integrated_allometries(currentCohort%dbh,) - ! calculate change in hite - call h_allom(currentCohort%dbh,ipft,height,dh_dd) - currentCohort%dhdt = currentCohort%ddbhdt * dh_dd + end if + ! If the cohort has grown, it is not new currentCohort%isnew=.false. + + return end subroutine Growth_Derivatives ! ============================================================================ diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index a9092533aa..a8d7f560b8 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -52,7 +52,7 @@ module EDMainMod use EDLoggingMortalityMod , only : IsItLoggingTime use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteCarbonStock - + use EDMortalityFunctionsMod , only : Mortality_Derivative ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -265,8 +265,13 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentCohort => currentPatch%shortest do while(associated(currentCohort)) - ! Calculate the rates of change of live and dead tissues - call Growth_Derivatives( currentSite, currentCohort, bc_in) + + ! Calculate the mortality derivatives + call Mortality_Derivative( currentSite, currentCohort, bc_in ) + + + ! Apply growth to potentially all carbon pools + call Growth_Derivatives( currentSite, currentCohort, bc_in ) cohort_biomass_store = (currentCohort%balive+currentCohort%bdead+currentCohort%bstore) currentCohort%dbh = max(small_no,currentCohort%dbh + currentCohort%ddbhdt * hlm_freq_day ) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 05e0775205..1b760d05b0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -214,6 +214,7 @@ module EDTypesMod real(r8) :: md ! plant maintenance demand: kgC/indiv/year real(r8) :: leaf_md ! leaf maintenance demand: kgC/indiv/year real(r8) :: root_md ! root maintenance demand: kgC/indiv/year + real(r8) :: stem_md ! stem maintenance demand: kgC/indiv/year real(r8) :: carbon_balance ! carbon remaining for growth and storage: kg/indiv/year real(r8) :: seed_prod ! reproduction seed and clonal: KgC/indiv/year real(r8) :: leaf_litter ! leaf litter from phenology: KgC/m2 From f08920cf155e1659938ebead433cbf45c5fb9360 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 27 Nov 2017 18:25:17 -0800 Subject: [PATCH 041/111] Updates on allocation: added integrator check, added variable definitions, added provisions for woody maintenance turnover. --- biogeochem/EDPhysiologyMod.F90 | 276 ++++++++++++++++++------------- biogeochem/FatesAllometryMod.F90 | 82 +++++++++ 2 files changed, 245 insertions(+), 113 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 8d46820a10..e23ceab93d 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -44,6 +44,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : carea_allom + use FatesAllometryMod , only : check_integrated_allometries implicit none @@ -771,12 +772,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) type(bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: - real(r8) :: va !fraction of growth going to alive biomass - real(r8) :: vs !fraction of growth going to structural biomass - 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) + + integer :: ipft ! PFT index ! Per plant allocation targets @@ -795,13 +792,49 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) real(r8) :: bt_store ! target storage biomass (kgC) real(r8) :: dbt_store_dd ! target rate of change in storage (kgC/cm) + real(r8) :: leaf_below_target + real(r8) :: froot_below_target + real(r8) :: sap_below_target + real(r8) :: store_below_target + real(r8) :: dead_below_target - !---------------------------------------------------------------------- + + real(r8) :: store_flux ! carbon fluxing into storage [kgC] + real(r8) :: leaf_flux + real(r8) :: froot_flux + real(r8) :: sap_flux + real(r8) :: dead_flux + real(r8) :: repro_flux + + real(r8) :: store_target_fraction + real(r8) :: store_flux_fraction + real(r8) :: repro_fraction + + real(r8) :: leaf_turnover_demand + real(r8) :: root_turnover_demand + + + real(r8) :: total_turnover_demand + + ! Woody turnover timescale [years] + real(r8), parameter :: background_woody_turnover = 20.0_r8 ipft = currentCohort%pft + + ! Initialize NPP flux diagnostics + currentCohort%npp_bstore = 0.0_r8 + currentCohort%npp_leaf = 0.0_r8 + currentCohort%npp_froot = 0.0_r8 + currentCohort%npp_bdead = 0.0_r8 + currentCohort%npp_bseed = 0.0_r8 + + + ! ----------------------------------------------------------------------------------- ! I. Identify the net carbon gain for this dynamics interval + ! Set the available carbon pool, identify allocation portions, and decrement + ! the available carbon pool to zero. ! ----------------------------------------------------------------------------------- ! convert from kgC/indiv/day into kgC/indiv/year @@ -830,7 +863,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n - + ! Available carbon for growth [kgC] + currentCohort%carbon_balance = currentCohort%npp_acc ! ----------------------------------------------------------------------------------- @@ -869,45 +903,45 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! that carbon back into the carbon flux pool ! ----------------------------------------------------------------------------------- - leaf_deficit = bt_leaf - currentCohort%bl - froot_deficit = bt_fineroot - currentCohort%br - sap_deficit = bt_sap - currentCohort%bsw - store_deficit = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore - dead_deficit = bt_dead - currentCohort%bdead + leaf_below_target = bt_leaf - currentCohort%bl + froot_below_target = bt_fineroot - currentCohort%br + sap_below_target = bt_sap - currentCohort%bsw + store_below_target = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore + dead_below_target = bt_dead - currentCohort%bdead - if(leaf_deficit<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_deficit - currentCohort%bl = currentCohort%bl + leaf_deficit - currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_deficit * hlm_freq_day - leaf_deficit = 0.0_r8 + if(leaf_below_target<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_below_target + currentCohort%bl = currentCohort%bl + leaf_below_target + currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_below_target * hlm_freq_day + leaf_below_target = 0.0_r8 end if - if(froot_deficit<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - froot_deficit - currentCohort%br = currentCohort%br + froot_deficit - currentCohort%npp_froot = currentCohort%npp_froot + froot_deficit * hlm_freq_day - froot_deficit = 0.0_r8 + if(froot_below_target<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - froot_below_target + currentCohort%br = currentCohort%br + froot_below_target + currentCohort%npp_froot = currentCohort%npp_froot + froot_below_target * hlm_freq_day + froot_below_target = 0.0_r8 end if - if(sap_deficit<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - sap_deficit - currentCohort%bsw = currentCohort%bsw + sap_deficit - currentCohort%npp_bsw = currentCohort%npp_bsw + sap_deficit * hlm_freq_day - sap_deficit = 0.0_r8 + if(sap_below_target<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - sap_below_target + currentCohort%bsw = currentCohort%bsw + sap_below_target + currentCohort%npp_bsw = currentCohort%npp_bsw + sap_below_target * hlm_freq_day + sap_below_target = 0.0_r8 end if - if(store_deficit<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - store_deficit - currentCohort%bstore = currentCohort%bstore + store_deficit - currentCohort%npp_store = currentCohort%npp_bsw + store_deficit * hlm_freq_day - store_deficit = 0.0_r8 + if(store_below_target<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - store_below_target + currentCohort%bstore = currentCohort%bstore + store_below_target + currentCohort%npp_bstore = currentCohort%npp_bstore + store_below_target * hlm_freq_day + store_below_target = 0.0_r8 end if - if(dead_deficit<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - dead_deficit - currentCohort%bdead = currentCohort%bdead + dead_deficit - currentCohort%npp_bdead = currentCohort%npp_bdead + dead_deficit * hlm_freq_day - store_deficit = 0.0_r8 + if(dead_below_target<0.0_r8) then + currentCohort%carbon_balance = currentCohort%carbon_balance - dead_below_target + currentCohort%bdead = currentCohort%bdead + dead_below_target + currentCohort%npp_bdead = currentCohort%npp_bdead + dead_below_target * hlm_freq_day + store_below_target = 0.0_r8 end if @@ -961,18 +995,18 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%leaf_md = 0._r8 endif - ! Stem turnover is turned off for now. SHould make provisions for storms, - ! or for scenarios where stem wood turnover is high, it brings some leaf/root - ! with it. - currentCohort%stem_md = 0.0_r8 - + currentCohort%bsw_md = currentCohort%bsw / background_woody_turnover + currentCohort%bdead_md = currentCohort%bdead / background_woody_turnover + currentCohort%bstore_md = currentCohort%bstore / background_woody_turnover + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! COMPLETE THE ENTRIES FOR THESE THREE ABOVE, MUST FUSE, CREATE OUTPUT, COPY, ETC + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ----------------------------------------------------------------------------------- ! V. Remove turnover from the appropriate pools ! ! Units: kgC/year / (1/days_per_year) = kgC/day -> (day elapsed) -> kgC - ! ADD THESE TO THE LITTER FLUX ! ----------------------------------------------------------------------------------- ! leaf biomass @@ -981,38 +1015,31 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! fine-root biomass currentcohort%br = currentcohort%br - currentCohort%root_md/hlm_freq_day - - - ! ----------------------------------------------------------------------------------- - ! VI. Set the available carbon pool, identify allocation portions, and decrement - ! the available carbon pool to zero. - ! ----------------------------------------------------------------------------------- - - ! Available carbon, convert [kgC/year] to [kgC] - currentCohort%carbon_balance = currentCohort%npp_acc_hold/hlm_freq_day + ! sapwood biomass loss + currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md/hlm_freq_day - ! Initialize some NPP flux diagnostics - currentCohort%npp_store = 0.0_r8 - currentCohort%npp_leaf = 0.0_r8 - currentCohort%npp_froot = 0.0_r8 + ! structural biomass loss + currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md/hlm_freq_day + ! storage biomass loss + currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md/hlm_freq_day + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! CHECK LITTER FLUXES AND SEE WHERE THE LITTER IS GENERATED + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! ----------------------------------------------------------------------------------- ! VI(a) if carbon balance is negative, re-coup the losses from storage - ! ALLOW NEGATIVE STORAGE CARBON FOR NOW ! ----------------------------------------------------------------------------------- + + if( currentCohort%carbon_balance < 0.0_r8 ) then - storage_flux = -currentCohort%carbon_balance - currentCohort%carbon_balance = currentCohort%carbon_balance + storage_flux - currentCohort%bstore = currentCohort%bstore - storage_flux - currentCohort%npp_store = currentCohort%npp_store - storage_flux * hlm_freq_day -! if( currentCohort%carbon_balance < -tiny(currentCohort%carbon_balance) ) then -! write(fates_log(),*) ' A cohort has a negative carbon balance (ie more respiration' -! write(fates_log(),*) ' than assimilate), and does not have enough storage to' -! write(fates_log(),*) ' accomodate the losses. Maintenance respiration' -! write(fates_log(),*) ' SHOULD be attenuating at this point and driving up' -! write(fates_log9),*) ' mortality. Exiting.' -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if + store_flux = -currentCohort%carbon_balance + currentCohort%carbon_balance = currentCohort%carbon_balance + store_flux + currentCohort%bstore = currentCohort%bstore - store_flux + currentCohort%npp_store = currentCohort%npp_store - store_flux * hlm_freq_day + ! We have pushed to net-zero carbon, the rest of this routine can be ignored + return end if @@ -1031,10 +1058,10 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%bl = currentCohort%bl + leaf_flux currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day - root_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - root_flux - currentCohort%br = currentCohort%br + root_flux - currentCohort%npp_froot = currentCohort%npp_froot + root_flux * hlm_freq_day + froot_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux + currentCohort%br = currentCohort%br + froot_flux + currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day end if @@ -1042,12 +1069,12 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! ----------------------------------------------------------------------------------- ! VI(c). If carbon is still available, prioritize some allocation to storage ! ----------------------------------------------------------------------------------- - storage_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft))) - storage_flux_fraction = max(exp(-1.*storage_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) - storage_flux = currentCohort%carbon_balance * storage_flux_fraction - currentCohort%carbon_balance = currentCohort%carbon_balance - storage_flux - currentCohort%bstore = currentCohort%bstore + storage_flux - currentCohort%npp_store = currentCohort%npp_store + storage_flux * hlm_freq_day + store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft))) + store_flux_fraction = max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) + store_flux = currentCohort%carbon_balance * store_flux_fraction + currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux + currentCohort%bstore = currentCohort%bstore + store_flux + currentCohort%npp_store = currentCohort%npp_store + store_flux * hlm_freq_day ! ----------------------------------------------------------------------------------- @@ -1066,55 +1093,75 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%bl = currentCohort%bl + leaf_flux currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day - root_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - root_flux - currentCohort%br = currentCohort%br + root_flux - currentCohort%npp_froot = currentCohort%npp_froot + root_flux * hlm_freq_day + froot_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux + currentCohort%br = currentCohort%br + froot_flux + currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day end if ! ----------------------------------------------------------------------------------- - ! V(e). If carbon is still available, we try to push all alive pools back towards allometry - ! - ! SUGGESTED VARIABLE NAMES: below_target - ! + ! V(e). If carbon is still available, we try to push all live + ! pools back towards allometry ! ----------------------------------------------------------------------------------- - leaf_deficit = bt_leaf - currentCohort%bl - froot_deficit = bt_fineroot - currentCohort%br - sap_deficit = bt_sap - currentCohort%bsw - store_deficit = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore - total_deficit = leaf_deficit + froot_deficit + sap_deficit + store_deficit + leaf_below_target = bt_leaf - currentCohort%bl + froot_below_target = bt_fineroot - currentCohort%br + sap_below_target = bt_sap - currentCohort%bsw + store_below_target = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore + total_below_target = leaf_below_target + froot_below_target + sap_below_target + store_below_target - if ( currentCohort%carbon_balance .and. total_deficit>0.0_r8) then + if ( currentCohort%carbon_balance > 0.0_r8 .and. total_below_target>0.0_r8) then + + leaf_flux = min(leaf_below_target, & + currentCohort%carbon_balance * leaf_below_target/total_below_target) + froot_flux = min(froot_below_target, & + currentCohort%carbon_balance * froot_below_target/total_below_target) + sap_flux = min(sap_below_target, & + currentCohort%carbon_balance * sap_below_target/total_below_target) + store_flux = min(store_below_target, & + currentCohort%carbon_balance * store_below_target/total_below_target) - leaf_flux = min(leaf_deficit,currentCohort%carbon_balance * leaf_deficit/total_deficit) currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux currentCohort%bl = currentCohort%bl + leaf_flux currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day - - froot_flux = min(froot_deficit,currentCohort%carbon_balance * froot_deficit/total_deficit) + currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux currentCohort%br = currentCohort%br + froot_flux currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day - sap_flux = min(sap_deficit,currentCohort%carbon_balance * sap_deficit/total_deficit) currentCohort%carbon_balance = currentCohort%carbon_balance - sap_flux currentCohort%bsw = currentCohort%bsw + sap_flux currentCohort%npp_bsw = currentCohort%npp_bsw + sap_flux * hlm_freq_day - - storage_flux = min(store_deficit,currentCohort%carbon_balance * store_deficit/total_deficit) + currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux - currentCohort%bstore = currentCohort%store + store_flux - currentCohort%npp_store = currentCohort%npp_bsw + store_flux * hlm_freq_day + currentCohort%bstore = currentCohort%bstore + store_flux + currentCohort%npp_bstore = currentCohort%npp_bdead + store_flux * hlm_freq_day + + end if + + ! ----------------------------------------------------------------------------------- + ! V(f). If carbon is still available, replenish the structural pool to get + ! back on allometry + ! ----------------------------------------------------------------------------------- + + dead_below_target = bt_dead - currentCohort%bdead + + if ( currentCohort%carbon_balance > 0.0_r8 .and. dead_below_target>0.0_r8) then + + dead_flux = min(currentCohort%carbon_balance,dead_below_target) + currentCohort%carbon_balance = currentCohort%carbon_balance - dead_flux + currentCohort%bdead = currentCohort%bdead + dead_flux + currentCohort%npp_bdead = currentCohort%npp_bdead + dead_flux * hlm_freq_day + end if - + ! ----------------------------------------------------------------------------------- ! V(e). If carbon is yet still available ... - ! Our alive pools are now on allometry, and we can increment all pools + ! Our pools are now on allometry, and we can increment all pools ! including structure and reproduction according to their rates ! ----------------------------------------------------------------------------------- @@ -1122,18 +1169,18 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! fraction of carbon going towards reproduction if (currentCohort%dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass - repro_frac = EDPftvarcon_inst%seed_alloc(ipft) + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) else - repro_frac = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) end if dbt_total_dd = db_leaf_dd + db_fineroot_dd + db_sap_dd + db_dead_dd + db_store_dd - leaf_flux = currentCohort%carbon_balance * (db_leaf_dd/dbt_total_dd)*(1.0_repro_frac) - froot_flux = currentCohort%carbon_balance * (db_fineroot_dd/dbt_total_dd)*(1.0_repro_frac) - sap_flux = currentCohort%carbon_balance * (db_sap_dd/dbt_total_dd)*(1.0_repro_frac) - dead_flux = currentCohort%carbon_balance * (db_dead_dd/dbt_total_dd)*(1.0_repro_frac) - repro_flux = currentCohort%carbon_balance * repro_frac + leaf_flux = currentCohort%carbon_balance * (db_leaf_dd/dbt_total_dd)*(1.0_repro_fraction) + froot_flux = currentCohort%carbon_balance * (db_fineroot_dd/dbt_total_dd)*(1.0_repro_fraction) + sap_flux = currentCohort%carbon_balance * (db_sap_dd/dbt_total_dd)*(1.0_repro_fraction) + dead_flux = currentCohort%carbon_balance * (db_dead_dd/dbt_total_dd)*(1.0_repro_fraction) + repro_flux = currentCohort%carbon_balance * repro_fraction ! Take an Euler Step to integrate all pools @@ -1173,10 +1220,13 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! ------------------------------------------------------------------------------------ ! VIII. Run a post integration test to see if our integrated quantities match - ! the diagnostic quantities + ! the diagnostic quantities. (note we do not need to pass in leaf status + ! because we would not make it to this check if we were not on allometry ! ------------------------------------------------------------------------------------ - call check_integrated_allometries(currentCohort%dbh,) + call check_integrated_allometries(currentCohort%dbh,ipft,currentCohort%canopy_trim, & + currentCohort%bl,currentCohort%br, & + currentCohort%bsw,currentCohort%bdead) end if diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 749e7faeb7..bf87011fdf 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -130,6 +130,88 @@ module FatesAllometryMod ! Check to make sure Martinez-Cano height cap is not on, or explicitly allowed + subroutine check_integrated_allometries(dbh,ipft,bl,bfr,bsap,bdead) + + ! This routine checks the error on the carbon allocation + ! integration step. The integrated quantities should + ! be a close match on the diagnosed quantities. + ! We don't have to worry about small accumulating biases, + ! or small errors because the scheme automatically pushes + ! all carbon pools towards the allometric value corresponding + ! to the diameter on each step, prior to performing an integration. + + real(r8),intent(in) :: dbh ! diameter of plant [cm] + integer,intent(in) :: ipft ! plant functional type index + real(r8),intent(in) :: canopy_trim ! trimming function + real(r8),intent(in) :: bl ! integrated leaf biomass [kgC] + real(r8),intent(in) :: bfr ! integrated fine root biomass [kgC] + real(r8),intent(in) :: bsap ! integrated sapwood biomass [kgC] + real(r8),intent(in) :: bdead ! integrated structural biomass [kgc] + + real(r8) :: height ! diagnosed height [m] + real(r8) :: bl_diag ! diagnosed leaf biomass [kgC] + real(r8) :: bfr_diag ! diagnosed fine-root biomass [kgC] + real(r8) :: bsap_diag ! diagnosed sapwood biomass [kgC] + real(r8) :: bdead_diag ! diagnosed structural biomass [kgC] + real(r8) :: bagw_diag ! diagnosed agbw [kgC] + real(r8) :: bbgw_diag ! diagnosed below ground wood [kgC] + + real(r8) :: relative_err_thresh = 1.0e-4_r8 + + + call h_allom(dbh,ipft,height) + call bleaf(dbh,height,ipft,canopy_trim,bl_diag) + call bfineroot(dbh,height,ipft,canopy_trim,bfr_diag) + call bsap_allom(dbh,ipft,canopy_trim,bsap_diag) + call bagw_allom(dbh,ipft,bagw_diag) + call bbgw_allom(dbh,ipft,bbgw_diag) + call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) + + if( abs(bl_diag-bl)/bl_diag > relative_err_thresh ) then + write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bl (integrated): ',bl + write(fates_log(),*) 'bl (diagnosed): ',bl_diag + write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if( abs(bfr_diag-bfr)/bfr_diag > relative_err_thresh ) then + write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bfr (integrated): ',bfr + write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag + write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if( abs(bsap_diag-bsap)/bsap_diag > relative_err_thresh ) then + write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bsap (integrated): ',bsap + write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag + write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if( abs(bdead_diag-bdead)/bdead_diag > relative_err_thresh ) then + write(fates_log(),*) 'disparity in integrated/diagnosed structural carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bdead (integrated): ',bdead + write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag + write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + return + end subroutine check_integrated_allometries + + + ! ============================================================================ ! Generic height to diameter interface ! ============================================================================ From 5da76dcade2c77ddeefb3b013625f9c76a45d10e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 28 Nov 2017 16:04:03 -0800 Subject: [PATCH 042/111] Allocation: provisions for more _md pools. Changed create_cohort to enable 3 live pools. --- biogeochem/EDCohortDynamicsMod.F90 | 30 ++++++-- biogeochem/EDPhysiologyMod.F90 | 108 +++++++++++++++-------------- main/EDInitMod.F90 | 6 +- main/EDMainMod.F90 | 37 ++-------- main/EDTypesMod.F90 | 9 ++- main/FatesHistoryInterfaceMod.F90 | 54 +++++++++++++++ main/FatesInventoryInitMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 48 +++++++++++-- 8 files changed, 189 insertions(+), 105 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index d075ec25c3..ccff4ccae1 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -51,7 +51,6 @@ module EDCohortDynamicsMod public :: sort_cohorts public :: copy_cohort public :: count_cohorts - public :: allocate_live_biomass public :: tree_lai public :: tree_sai @@ -67,7 +66,7 @@ module EDCohortDynamicsMod !-------------------------------------------------------------------------------------! subroutine create_cohort(patchptr, pft, nn, hite, dbh, & - balive, bdead, bstore, laimemory, status, ctrim, clayer, bc_in) + bleaf, bfineroot, bsap, bdead, bstore, laimemory, status, ctrim, clayer, bc_in) ! ! !DESCRIPTION: ! create new cohort @@ -82,7 +81,9 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & real(r8), intent(in) :: nn ! number of individuals in cohort per 'area' (10000m2 default) real(r8), intent(in) :: hite ! height: meters real(r8), intent(in) :: dbh ! dbh: cm - real(r8), intent(in) :: balive ! total living biomass: kGC per indiv + real(r8), intent(in) :: bleaf ! biomass in leaves: kgC + real(r8), intent(in) :: bfineroot ! biomass in fineroots: kgC + real(r8), intent(in) :: bsap ! biomass in sapwood: kgC real(r8), intent(in) :: bdead ! total dead biomass: kGC per indiv real(r8), intent(in) :: bstore ! stored carbon: kGC per indiv real(r8), intent(in) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv @@ -119,8 +120,11 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%canopy_layer_yesterday = real(clayer, r8) new_cohort%laimemory = laimemory new_cohort%bdead = bdead - new_cohort%balive = balive new_cohort%bstore = bstore + new_cohort%bl = bleaf + new_cohort%br = bfineroot + new_cohort%bsw = bsap + new_cohort%balive = bleaf + bfineroot + bsap call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & new_cohort%size_class,new_cohort%size_by_pft_class) @@ -145,9 +149,6 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & if (new_cohort%siteptr%dstatus==2 .and. EDPftvarcon_inst%stress_decid(pft) == 1) then new_cohort%laimemory = 0.0_r8 endif - - ! Calculate live biomass allocation - call allocate_live_biomass(new_cohort,0) ! Assign canopy extent and depth call carea_allom(new_cohort%dbh,new_cohort%n,new_cohort%siteptr%spread,new_cohort%pft,new_cohort%c_area) @@ -434,6 +435,9 @@ subroutine nan_cohort(cc_p) currentCohort%md = nan ! plant maintenance demand: kgC/indiv/year currentCohort%leaf_md = nan ! leaf maintenance demand: kgC/indiv/year currentCohort%root_md = nan ! root maintenance demand: kgC/indiv/year + currentCohort%bsw_md = nan + currentCohort%bdead_md = nan + currentCohort%bstore_md = nan currentCohort%carbon_balance = nan ! carbon remaining for growth and storage: kg/indiv/year currentCohort%dmort = nan ! proportional mortality rate. (year-1) currentCohort%lmort_logging = nan @@ -508,6 +512,9 @@ subroutine zero_cohort(cc_p) currentcohort%md = 0._r8 currentcohort%root_md = 0._r8 currentcohort%leaf_md = 0._r8 + currentcohort%bstore_md = 0._r8 + currentcohort%bsw_md = 0._r8 + currentcohort%bdead_md = 0._r8 currentcohort%npp_acc_hold = 0._r8 currentcohort%gpp_acc_hold = 0._r8 currentcohort%storage_flux = 0._r8 @@ -844,6 +851,12 @@ subroutine fuse_cohorts(patchptr, bc_in) nextc%n*nextc%root_md)/newn currentCohort%leaf_md = (currentCohort%n*currentCohort%leaf_md + & nextc%n*nextc%leaf_md)/newn + currentCohort%bstore_md = (currentCohort%n*currentCohort%bstore_md + & + nextc%n*nextc%bstore_md)/newn + currentCohort%bsw_md = (currentCohort%n*currentCohort%bsw_md + & + nextc%n*nextc%bsw_md)/newn + currentCohort%bdead_md = (currentCohort%n*currentCohort%bdead_md + & + nextc%n*nextc%bdead_md)/newn currentCohort%carbon_balance = (currentCohort%n*currentCohort%carbon_balance + & nextc%n*nextc%carbon_balance)/newn currentCohort%storage_flux = (currentCohort%n*currentCohort%storage_flux + & @@ -1257,6 +1270,9 @@ subroutine copy_cohort( currentCohort,copyc ) n%md = o%md n%leaf_md = o%leaf_md n%root_md = o%root_md + n%bsw_md = o%bsw_md + n%bdead_md = o%bdead_md + n%bstore_md = o%bstore_md n%carbon_balance = o%carbon_balance n%dmort = o%dmort n%lmort_logging = o%lmort_logging diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e23ceab93d..2c8490eef8 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -54,7 +54,7 @@ module EDPhysiologyMod public :: trim_canopy public :: phenology private :: phenology_leafonoff - public :: Growth_Derivatives + public :: PlantGrowth public :: recruitment private :: cwd_input private :: cwd_out @@ -221,11 +221,6 @@ subroutine trim_canopy( currentSite ) endif endif !leaf activity? enddo !z - if (currentCohort%NV.gt.2)then - ! leaf_cost may be uninitialized, removing its diagnostic from the log - ! to allow checking with fpe_traps (RGK) - write(fates_log(),*) 'nv>4',currentCohort%year_net_uptake(1:6),currentCohort%canopy_trim - endif currentCohort%year_net_uptake(:) = 999.0_r8 if (trimmed == 0.and.currentCohort%canopy_trim < 1.0_r8)then @@ -754,10 +749,10 @@ subroutine seed_germination( currentSite, currentPatch ) end subroutine seed_germination ! ============================================================================ - subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) + subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ! !DESCRIPTION: - ! Main subroutine controlling growth and allocation derivatives + ! Main subroutine for plant allocation and growth ! ! !USES: ! Original: Rosie Fisher @@ -792,31 +787,31 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) real(r8) :: bt_store ! target storage biomass (kgC) real(r8) :: dbt_store_dd ! target rate of change in storage (kgC/cm) - real(r8) :: leaf_below_target - real(r8) :: froot_below_target - real(r8) :: sap_below_target - real(r8) :: store_below_target - real(r8) :: dead_below_target - - - real(r8) :: store_flux ! carbon fluxing into storage [kgC] - real(r8) :: leaf_flux - real(r8) :: froot_flux - real(r8) :: sap_flux - real(r8) :: dead_flux - real(r8) :: repro_flux - - real(r8) :: store_target_fraction - real(r8) :: store_flux_fraction - real(r8) :: repro_fraction - - real(r8) :: leaf_turnover_demand - real(r8) :: root_turnover_demand + real(r8) :: leaf_below_target ! leaf biomass below target amount [kgC] + real(r8) :: froot_below_target ! fineroot biomass below target amount [kgC] + real(r8) :: sap_below_target ! sapwood biomass below target amount [kgC] + real(r8) :: store_below_target ! storage biomass below target amount [kgC] + real(r8) :: dead_below_target ! dead (structural) biomass below target amount [kgC] + real(r8) :: store_flux ! carbon fluxing into storage [kgC] + real(r8) :: leaf_flux ! carbon fluxing into leaves [kgC] + real(r8) :: froot_flux ! carbon fluxing into fineroots [kgC] + real(r8) :: sap_flux ! carbon fluxing into sapwood [kgC] + real(r8) :: dead_flux ! carbon fluxing into structure [kgC] + real(r8) :: repro_flux ! carbon fluxing into reproductive tissues [kgC] + + real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] + real(r8) :: repro_fraction ! fraction of carbon gain sent to reproduction when on-allometry - real(r8) :: total_turnover_demand + real(r8) :: leaf_turnover_demand ! leaf carbon that is demanded to replace maintenance turnover [kgC] + real(r8) :: root_turnover_demand ! fineroot carbon that is demanded to replace maintenance turnover [kgC] + real(r8) :: total_turnover_demand ! total carbon that is demanded to replace maintenance turnover [kgC] ! Woody turnover timescale [years] + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! THIS NEEDS A PFT VARIABLE, OR LIKE OTHER POOLS SHOULD BE HOOKED INTO THE DISTURBANCE ALGORITHM + ! RGK 11-2017 + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(r8), parameter :: background_woody_turnover = 20.0_r8 ipft = currentCohort%pft @@ -829,8 +824,6 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%npp_bdead = 0.0_r8 currentCohort%npp_bseed = 0.0_r8 - - ! ----------------------------------------------------------------------------------- ! I. Identify the net carbon gain for this dynamics interval ! Set the available carbon pool, identify allocation portions, and decrement @@ -978,8 +971,14 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! ----------------------------------------------------------------------------------- ! IV(b). Calculate the maintenance turnover demands + ! NOTE(RGK): If branches are falling all year, even on deciduous trees, we should + ! be pulling some leaves with them when leaves are out... ! ----------------------------------------------------------------------------------- + currentCohort%bsw_md = currentCohort%bsw / background_woody_turnover + currentCohort%bdead_md = currentCohort%bdead / background_woody_turnover + currentCohort%bstore_md = currentCohort%bstore / background_woody_turnover + if (EDPftvarcon_inst%evergreen(ipft) == 1)then currentCohort%leaf_md = currentCohort%bl / EDPftvarcon_inst%leaf_long(ipft) currentCohort%root_md = currentCohort%br / EDPftvarcon_inst%root_long(ipft) @@ -995,14 +994,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentCohort%leaf_md = 0._r8 endif - currentCohort%bsw_md = currentCohort%bsw / background_woody_turnover - currentCohort%bdead_md = currentCohort%bdead / background_woody_turnover - currentCohort%bstore_md = currentCohort%bstore / background_woody_turnover - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! COMPLETE THE ENTRIES FOR THESE THREE ABOVE, MUST FUSE, CREATE OUTPUT, COPY, ETC - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + ! ----------------------------------------------------------------------------------- ! V. Remove turnover from the appropriate pools ! @@ -1069,9 +1061,9 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! ----------------------------------------------------------------------------------- ! VI(c). If carbon is still available, prioritize some allocation to storage ! ----------------------------------------------------------------------------------- - store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft))) - store_flux_fraction = max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) - store_flux = currentCohort%carbon_balance * store_flux_fraction + store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft))) + store_flux = currentCohort%carbon_balance * & + max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux currentCohort%bstore = currentCohort%bstore + store_flux currentCohort%npp_store = currentCohort%npp_store + store_flux * hlm_freq_day @@ -1231,12 +1223,16 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) end if + + currentCohort%balive = currentCohort%bl + currentCohort%br + currentCohort%bsw + + ! If the cohort has grown, it is not new currentCohort%isnew=.false. return - end subroutine Growth_Derivatives + end subroutine PlantGrowth ! ============================================================================ subroutine recruitment( currentSite, currentPatch, bc_in ) @@ -1315,9 +1311,9 @@ subroutine recruitment( currentSite, currentPatch, 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) + b_leaf, b_fineroot, b_sap, 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 @@ -1370,17 +1366,25 @@ subroutine CWD_Input( currentSite, currentPatch) currentCohort%leaf_md * currentCohort%n/currentPatch%area !turnover currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & - currentCohort%root_md * currentCohort%n/currentPatch%area !turnover + (currentCohort%root_md + currentCohort%bstore_md) & + * currentCohort%n/currentPatch%area !turnover + currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & currentCohort%leaf_litter * currentCohort%n/currentPatch%area/hlm_freq_day !daily leaf loss needs to be scaled up to the annual scale here. - + + ! --------------------------------------------------------------------------------- + ! Assumption: turnover from deadwood and sapwood are lumped together in CWD pool + ! --------------------------------------------------------------------------------- + do c = 1,ncwd - currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + currentCohort%woody_turnover * & - SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) - currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + currentCohort%woody_turnover * & - SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *(1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + & + (currentCohort%bdead_md + currentCohort%bsw_md) * & + SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) + currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + & + (currentCohort%bdead_md + currentCohort%bsw_md) * & + 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 diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 79d38b5f94..d274f6f039 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -375,11 +375,11 @@ subroutine init_cohorts( patch_in, bc_in) ! Calculate coarse root biomass from allometry call bbgw_allom(temp_cohort%dbh,pft,b_bgw) - ! Calculate the leaf biomass + ! Calculate the leaf biomass from allometry ! (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 + ! Calculate fine root biomass from allometry ! (calculates a maximum and then trimming value) call bfineroot(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_fineroot) @@ -420,7 +420,7 @@ subroutine init_cohorts( patch_in, bc_in) if ( DEBUG ) write(fates_log(),*) 'EDInitMod.F90 call create_cohort ' call create_cohort(patch_in, pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + b_leaf, b_fineroot, b_sapwood, temp_cohort%bdead, temp_cohort%bstore, & temp_cohort%laimemory, cstatus, temp_cohort%canopy_trim, 1, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index a8d7f560b8..cf702bb89c 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -28,7 +28,7 @@ module EDMainMod use EDPatchDynamicsMod , only : fuse_patches use EDPatchDynamicsMod , only : spawn_patches use EDPatchDynamicsMod , only : terminate_patches - use EDPhysiologyMod , only : Growth_Derivatives + use EDPhysiologyMod , only : PlantGrowth use EDPhysiologyMod , only : non_canopy_derivs use EDPhysiologyMod , only : phenology use EDPhysiologyMod , only : recruitment @@ -271,44 +271,15 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! Apply growth to potentially all carbon pools - call Growth_Derivatives( currentSite, currentCohort, bc_in ) + call PlantGrowth( currentSite, currentCohort, bc_in ) - cohort_biomass_store = (currentCohort%balive+currentCohort%bdead+currentCohort%bstore) - 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) + ! Carbon assimilate has been spent at this point + ! and can now be safely zero'd - if ( DEBUG ) then - write(fates_log(),*) 'EDMainMod dbstoredt I ',currentCohort%bstore, & - currentCohort%dbstoredt,hlm_freq_day - end if - currentCohort%bstore = currentCohort%bstore + currentCohort%dbstoredt * hlm_freq_day - if ( DEBUG ) then - write(fates_log(),*) 'EDMainMod dbstoredt II ',currentCohort%bstore, & - currentCohort%dbstoredt,hlm_freq_day - end if - - if( (currentCohort%balive+currentCohort%bdead+currentCohort%bstore)*currentCohort%n<0._r8)then - write(fates_log(),*) 'biomass is negative', currentCohort%n,currentCohort%balive, & - currentCohort%bdead,currentCohort%bstore - endif - - if(abs((currentCohort%balive+currentCohort%bdead+currentCohort%bstore+hlm_freq_day*(currentCohort%md+ & - currentCohort%seed_prod)-cohort_biomass_store)-currentCohort%npp_acc) > 1e-8_r8)then - write(fates_log(),*) 'issue with c balance in integration', abs(currentCohort%balive+currentCohort%bdead+ & - currentCohort%bstore+hlm_freq_day* & - (currentCohort%md+currentCohort%seed_prod)-cohort_biomass_store-currentCohort%npp_acc) - endif - - ! THESE SHOULD BE MOVED TO A MORE "VISIBLE" LOCATION (RGK 10-2016) currentCohort%npp_acc = 0.0_r8 currentCohort%gpp_acc = 0.0_r8 currentCohort%resp_acc = 0.0_r8 - - call allocate_live_biomass(currentCohort,1) - ! BOC...update tree 'hydraulic geometry' ! (size --> heights of elements --> hydraulic path lengths --> ! maximum node-to-node conductances) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 1b760d05b0..06b2bdcba8 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -214,11 +214,13 @@ module EDTypesMod real(r8) :: md ! plant maintenance demand: kgC/indiv/year real(r8) :: leaf_md ! leaf maintenance demand: kgC/indiv/year real(r8) :: root_md ! root maintenance demand: kgC/indiv/year - real(r8) :: stem_md ! stem maintenance demand: kgC/indiv/year + real(r8) :: bsw_md ! sawpwood maintenance demand: kgC/indiv/year + real(r8) :: bstore_md ! storage maintenance demand: kgC/indiv/year + real(r8) :: bdead_md ! structural (branch) maintenance demand: kgC/indiv/year + real(r8) :: carbon_balance ! carbon remaining for growth and storage: kg/indiv/year real(r8) :: seed_prod ! reproduction seed and clonal: KgC/indiv/year real(r8) :: leaf_litter ! leaf litter from phenology: KgC/m2 - real(r8) :: woody_turnover ! amount of wood lost each day: kgC/indiv/year. Currently set to zero. !MORTALITY real(r8) :: dmort ! proportional mortality rate. (year-1) @@ -735,6 +737,9 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%md = ', ccohort%md write(fates_log(),*) 'co%leaf_md = ', ccohort%leaf_md write(fates_log(),*) 'co%root_md = ', ccohort%root_md + write(fates_log(),*) 'co%bstore_md = ', ccohort%bstore_md + write(fates_log(),*) 'co%bdead_md = ', ccohort%bdead_md + write(fates_log(),*) 'co%bsw_md = ', ccohort%bsw_md write(fates_log(),*) 'co%carbon_balance = ', ccohort%carbon_balance write(fates_log(),*) 'co%dmort = ', ccohort%dmort write(fates_log(),*) 'co%seed_prod = ', ccohort%seed_prod diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7be3fd8c09..5e0bb00a15 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -197,6 +197,9 @@ module FatesHistoryInterfaceMod integer, private :: ih_resp_m_canopy_si_scls integer, private :: ih_leaf_md_canopy_si_scls integer, private :: ih_root_md_canopy_si_scls + integer, private :: ih_bstore_md_canopy_si_scls + integer, private :: ih_bdead_md_canopy_si_scls + integer, private :: ih_bsw_md_canopy_si_scls integer, private :: ih_carbon_balance_canopy_si_scls integer, private :: ih_seed_prod_canopy_si_scls integer, private :: ih_dbalivedt_canopy_si_scls @@ -218,6 +221,9 @@ module FatesHistoryInterfaceMod integer, private :: ih_resp_m_understory_si_scls integer, private :: ih_leaf_md_understory_si_scls integer, private :: ih_root_md_understory_si_scls + integer, private :: ih_bsw_md_understory_si_scls + integer, private :: ih_bdead_md_understory_si_scls + integer, private :: ih_bstore_md_understory_si_scls integer, private :: ih_carbon_balance_understory_si_scls integer, private :: ih_seed_prod_understory_si_scls integer, private :: ih_dbalivedt_understory_si_scls @@ -1232,6 +1238,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_understory_mortality_carbonflux_si => this%hvars(ih_understory_mortality_carbonflux_si)%r81d, & hio_leaf_md_canopy_si_scls => this%hvars(ih_leaf_md_canopy_si_scls)%r82d, & hio_root_md_canopy_si_scls => this%hvars(ih_root_md_canopy_si_scls)%r82d, & + hio_bsw_md_canopy_si_scls => this%hvars(ih_bsw_md_canopy_si_scls)%r82d, & + hio_bdead_md_canopy_si_scls => this%hvars(ih_bdead_md_canopy_si_scls)%r82d, & + hio_bstore_md_canopy_si_scls => this%hvars(ih_bstore_md_canopy_si_scls)%r82d, & hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & hio_seed_prod_canopy_si_scls => this%hvars(ih_seed_prod_canopy_si_scls)%r82d, & hio_dbalivedt_canopy_si_scls => this%hvars(ih_dbalivedt_canopy_si_scls)%r82d, & @@ -1246,6 +1255,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_store_canopy_si_scls => this%hvars(ih_npp_store_canopy_si_scls)%r82d, & hio_leaf_md_understory_si_scls => this%hvars(ih_leaf_md_understory_si_scls)%r82d, & hio_root_md_understory_si_scls => this%hvars(ih_root_md_understory_si_scls)%r82d, & + hio_bstore_md_understory_si_scls => this%hvars(ih_bstore_md_understory_si_scls)%r82d, & + hio_bsw_md_understory_si_scls => this%hvars(ih_bsw_md_understory_si_scls)%r82d, & + hio_bdead_md_understory_si_scls => this%hvars(ih_bdead_md_understory_si_scls)%r82d, & hio_carbon_balance_understory_si_scls=> this%hvars(ih_carbon_balance_understory_si_scls)%r82d, & hio_seed_prod_understory_si_scls => this%hvars(ih_seed_prod_understory_si_scls)%r82d, & hio_dbalivedt_understory_si_scls => this%hvars(ih_dbalivedt_understory_si_scls)%r82d, & @@ -1548,6 +1560,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%leaf_md * ccohort%n hio_root_md_canopy_si_scls(io_si,scls) = hio_root_md_canopy_si_scls(io_si,scls) + & ccohort%root_md * ccohort%n + hio_bsw_md_canopy_si_scls(io_si,scls) = hio_bsw_md_canopy_si_scls(io_si,scls) + & + ccohort%bsw_md * ccohort%n + hio_bstore_md_canopy_si_scls(io_si,scls) = hio_bstore_md_canopy_si_scls(io_si,scls) + & + ccohort%bstore_md * ccohort%n + hio_bdead_md_canopy_si_scls(io_si,scls) = hio_bdead_md_canopy_si_scls(io_si,scls) + & + ccohort%bdead_md * ccohort%n hio_carbon_balance_canopy_si_scls(io_si,scls) = hio_carbon_balance_canopy_si_scls(io_si,scls) + & ccohort%carbon_balance * ccohort%n hio_seed_prod_canopy_si_scls(io_si,scls) = hio_seed_prod_canopy_si_scls(io_si,scls) + & @@ -1627,6 +1645,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%leaf_md * ccohort%n hio_root_md_understory_si_scls(io_si,scls) = hio_root_md_understory_si_scls(io_si,scls) + & ccohort%root_md * ccohort%n + hio_bsw_md_understory_si_scls(io_si,scls) = hio_bsw_md_understory_si_scls(io_si,scls) + & + ccohort%bsw_md * ccohort%n + hio_bstore_md_understory_si_scls(io_si,scls) = hio_bstore_md_understory_si_scls(io_si,scls) + & + ccohort%bstore_md * ccohort%n + hio_bdead_md_understory_si_scls(io_si,scls) = hio_bdead_md_understory_si_scls(io_si,scls) + & + ccohort%bdead_md * ccohort%n hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & ccohort%carbon_balance * ccohort%n hio_seed_prod_understory_si_scls(io_si,scls) = hio_seed_prod_understory_si_scls(io_si,scls) + & @@ -3416,6 +3440,21 @@ 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_root_md_canopy_si_scls ) + call this%set_history_var(vname='BSTORE_MD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='BSTORE_MD 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_bstore_md_canopy_si_scls ) + + call this%set_history_var(vname='BDEAD_MD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='BDEAD_MD 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_bdead_md_canopy_si_scls ) + + call this%set_history_var(vname='BSW_MD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='BSW_MD 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_bsw_md_canopy_si_scls ) + call this%set_history_var(vname='CARBON_BALANCE_CANOPY_SCLS', units = 'kg C / ha / yr', & long='CARBON_BALANCE for canopy plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3511,6 +3550,21 @@ 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_leaf_md_understory_si_scls ) + call this%set_history_var(vname='ROOT_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='ROOT_MD 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_root_md_understory_si_scls ) + + call this%set_history_var(vname='BSTORE_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='BSTORE_MD 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_bstore_md_understory_si_scls ) + + call this%set_history_var(vname='BDEAD_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='BDEAD_MD 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_bdead_md_understory_si_scls ) + call this%set_history_var(vname='ROOT_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & long='ROOT_MD for understory plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index e8c4b281e4..0fa61fe83c 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -923,7 +923,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & endif call create_cohort(cpatch, c_pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + b_leaf, b_fineroot, b_sapwood, temp_cohort%bdead, temp_cohort%bstore, & temp_cohort%laimemory, cstatus, temp_cohort%canopy_trim, 1, bc_in) deallocate(temp_cohort) ! get rid of temporary cohort diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 7ccbe0bdab..573292863b 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -84,6 +84,9 @@ module FatesRestartInterfaceMod integer, private :: ir_laimemory_co integer, private :: ir_leaf_md_co integer, private :: ir_root_md_co + integer, private :: ir_sapwood_md_co + integer, private :: ir_dead_md_co + integer, private :: ir_store_md_co integer, private :: ir_nplant_co integer, private :: ir_gpp_acc_co integer, private :: ir_npp_acc_co @@ -668,6 +671,21 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_root_md_co ) + call this%set_restart_var(vname='fates_store_maint_dmnd', vtype=cohort_r8, & + long_name='ed cohort - storage maintenance demand', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_store_md_co ) + + call this%set_restart_var(vname='fates_sapwood_maint_dmnd', vtype=cohort_r8, & + long_name='ed cohort - sapwood maintenance demand', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_sapwood_md_co ) + + call this%set_restart_var(vname='fates_dead_maint_dmnd', vtype=cohort_r8, & + long_name='ed cohort - structure maintenance demand', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dead_md_co ) + call this%set_restart_var(vname='fates_nplant', vtype=cohort_r8, & long_name='ed cohort - number of plants in the cohort', & units='/patch', flushval = flushzero, & @@ -1040,6 +1058,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & rio_leaf_md_co => this%rvars(ir_leaf_md_co)%r81d, & rio_root_md_co => this%rvars(ir_root_md_co)%r81d, & + rio_store_md_co => this%rvars(ir_store_md_co)%r81d, & + rio_sapwood_md_co => this%rvars(ir_sapwood_md_co)%r81d, & + rio_dead_md_co => this%rvars(ir_dead_md_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & rio_gpp_acc_co => this%rvars(ir_gpp_acc_co)%r81d, & rio_npp_acc_co => this%rvars(ir_npp_acc_co)%r81d, & @@ -1161,6 +1182,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_laimemory_co(io_idx_co) = ccohort%laimemory rio_leaf_md_co(io_idx_co) = ccohort%leaf_md rio_root_md_co(io_idx_co) = ccohort%root_md + rio_store_md_co(io_idx_co) = ccohort%bstore_md + rio_sapwood_md_co(io_idx_co) = ccohort%bsw_md + rio_dead_md_co(io_idx_co) = ccohort%bdead_md rio_nplant_co(io_idx_co) = ccohort%n rio_gpp_acc_co(io_idx_co) = ccohort%gpp_acc rio_npp_acc_co(io_idx_co) = ccohort%npp_acc @@ -1178,11 +1202,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_fmort_co(io_idx_co) = ccohort%fmort !Logging - rio_lmort_logging_co(io_idx_co) = ccohort%lmort_logging - rio_lmort_collateral_co(io_idx_co) = ccohort%lmort_collateral - rio_lmort_infra_co(io_idx_co) = ccohort%lmort_infra - - + rio_lmort_logging_co(io_idx_co) = ccohort%lmort_logging + rio_lmort_collateral_co(io_idx_co) = ccohort%lmort_collateral + rio_lmort_infra_co(io_idx_co) = ccohort%lmort_infra rio_ddbhdt_co(io_idx_co) = ccohort%ddbhdt rio_dbalivedt_co(io_idx_co) = ccohort%dbalivedt @@ -1375,7 +1397,9 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) integer :: idx_pa ! local patch index integer :: io_idx_si ! global site index in IO vector integer :: io_idx_co_1st ! global cohort index in IO vector - + real(r8) :: b_leaf ! leaf biomass dummy var (kgC) + real(r8) :: b_fineroot ! fineroot dummy var (kgC) + real(r8) :: b_sapwood ! sapwood dummy var (kgC) integer :: fto integer :: ft @@ -1475,9 +1499,13 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) if (DEBUG) then write(fates_log(),*) 'EDRestVectorMod.F90::createPatchCohortStructure call create_cohort ' end if + + b_leaf = 0.0_r8 + b_fineroot = 0.0_r8 + b_sapwood = 0.0_r8 call create_cohort(newp, ft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & - temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + b_leaf, b_fineroot, b_sapwood, temp_cohort%bdead, temp_cohort%bstore, & temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, newp%NCL_p, & bc_in(s)) @@ -1621,6 +1649,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & rio_leaf_md_co => this%rvars(ir_leaf_md_co)%r81d, & rio_root_md_co => this%rvars(ir_root_md_co)%r81d, & + rio_sapwood_md_co => this%rvars(ir_sapwood_md_co)%r81d, & + rio_store_md_co => this%rvars(ir_store_md_co)%r81d, & + rio_dead_md_co => this%rvars(ir_dead_md_co)%r81d, & rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & rio_gpp_acc_co => this%rvars(ir_gpp_acc_co)%r81d, & rio_npp_acc_co => this%rvars(ir_npp_acc_co)%r81d, & @@ -1725,6 +1756,9 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%laimemory = rio_laimemory_co(io_idx_co) ccohort%leaf_md = rio_leaf_md_co(io_idx_co) ccohort%root_md = rio_root_md_co(io_idx_co) + ccohort%bstore_md = rio_store_md_co(io_idx_co) + ccohort%bsw_md = rio_sapwood_md_co(io_idx_co) + ccohort%bdead_md = rio_dead_md_co(io_idx_co) ccohort%n = rio_nplant_co(io_idx_co) ccohort%gpp_acc = rio_gpp_acc_co(io_idx_co) ccohort%npp_acc = rio_npp_acc_co(io_idx_co) From d977b0fb9db11a49a50be7bc6c0106fdc731ca80 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 28 Nov 2017 18:26:52 -0800 Subject: [PATCH 043/111] Allometry: compiles and runs, removed balive and b, some fixes to central algorithm. CUrrently the integrator check is not passing. Could be an honest truncation error, or problem with algorithm. --- biogeochem/EDCanopyStructureMod.F90 | 36 ++--- biogeochem/EDCohortDynamicsMod.F90 | 242 ++++------------------------ biogeochem/EDPatchDynamicsMod.F90 | 20 ++- biogeochem/EDPhysiologyMod.F90 | 96 +++++------ biogeochem/FatesAllometryMod.F90 | 5 +- biogeophys/EDBtranMod.F90 | 3 +- main/ChecksBalancesMod.F90 | 15 +- main/EDInitMod.F90 | 6 - main/EDMainMod.F90 | 3 +- main/EDTypesMod.F90 | 44 +++-- main/FatesHistoryInterfaceMod.F90 | 49 ++---- main/FatesInventoryInitMod.F90 | 6 - main/FatesRestartInterfaceMod.F90 | 31 +--- 13 files changed, 180 insertions(+), 376 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index d83a952154..d575fbaddb 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -396,8 +396,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of demoted cohort currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n - currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & - currentCohort%b * currentCohort%n + currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + currentCohort%b_total() * currentCohort%n !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i_lyr+1 > nclmax)then @@ -471,8 +470,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of demoted cohort currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n - currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & - currentCohort%b * currentCohort%n + currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + currentCohort%b_total() * currentCohort%n !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i_lyr+1 > nclmax)then @@ -628,8 +626,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(currentCohort%size_class) = & currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n - currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & - currentCohort%b * currentCohort%n + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + currentCohort%b_total() * currentCohort%n + endif currentCohort => currentCohort%shorter enddo @@ -715,8 +713,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(copyc%size_class) = & currentSite%promotion_rate(copyc%size_class) + copyc%n - currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & - copyc%b * copyc%n + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + copyc%b_total() * copyc%n ! seperate cohorts. ! needs to be a very small number to avoid causing non-linearity issues with c_area. @@ -747,8 +744,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(currentCohort%size_class) = & currentSite%promotion_rate(currentCohort%size_class) + currentCohort%n - currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & - currentCohort%b * currentCohort%n + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + currentCohort%b_total() * currentCohort%n endif ! if(cc_gain < currentCohort%c_area)then @@ -922,8 +918,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & currentCohort%size_class,currentCohort%size_by_pft_class) - - 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) @@ -945,9 +939,9 @@ subroutine canopy_summarization( nsites, sites, bc_in ) write(fates_log(),*) 'ED: PFT or trim is zero in canopy_summarization', & currentCohort%pft,currentCohort%canopy_trim endif - if(currentCohort%balive <= 0._r8)then - write(fates_log(),*) 'ED: balive is zero in canopy_summarization', & - currentCohort%balive + if( (currentCohort%bsw + currentCohort%bl + currentCohort%br) <= 0._r8)then + write(fates_log(),*) 'ED: alive biomass is zero in canopy_summarization', & + currentCohort%bsw + currentCohort%bl + currentCohort%br endif currentCohort => currentCohort%taller @@ -1181,7 +1175,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) else fleaf = 0._r8 write(fates_log(), *) 'ED: no stem or leaf area' ,currentCohort%pft,currentCohort%bl, & - currentCohort%balive,currentCohort%treelai,currentCohort%treesai,currentCohort%dbh, & + currentCohort%treelai,currentCohort%treesai,currentCohort%dbh, & currentCohort%n,currentCohort%status_coh endif currentPatch%ncan(L,ft) = max(currentPatch%ncan(L,ft),currentCohort%NV) @@ -1229,6 +1223,9 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) !Bottom layer iv = currentCohort%NV ! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + print*,currentCohort%hite,iv,currentCohort%NV,currentCohort%treelai,currentCohort%treesai,currentCohort%bl + print*,EDPftvarcon_inst%crown(currentCohort%pft) + layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & EDPftvarcon_inst%crown(currentCohort%pft) ) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) @@ -1276,12 +1273,15 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) if ( DEBUG ) write(fates_log(), *) 'LHP', currentPatch%layer_height_profile(L,ft,iv) if(currentCohort%dbh <= 0._r8.or.currentCohort%n == 0._r8)then write(fates_log(), *) 'ED: dbh or n is zero in clmedlink', currentCohort%dbh,currentCohort%n + call endrun(msg=errMsg(sourcefile, __LINE__)) endif if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then write(fates_log(), *) 'ED: PFT or trim is zero in clmedlink',currentCohort%pft,currentCohort%canopy_trim + call endrun(msg=errMsg(sourcefile, __LINE__)) endif - if(currentCohort%balive <= 0._r8.or.currentCohort%bl < 0._r8)then - write(fates_log(), *) 'ED: balive is zero in clmedlink',currentCohort%balive,currentCohort%bl + if(currentCohort%bl < 0._r8)then + write(fates_log(), *) 'ED: bl (leaf biomass) is lt zero',currentCohort%bl + call endrun(msg=errMsg(sourcefile, __LINE__)) endif currentCohort => currentCohort%taller diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index ccff4ccae1..43e949f5d6 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -124,7 +124,6 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%bl = bleaf new_cohort%br = bfineroot new_cohort%bsw = bsap - new_cohort%balive = bleaf + bfineroot + bsap call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & new_cohort%size_class,new_cohort%size_by_pft_class) @@ -157,6 +156,8 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%lai = new_cohort%treelai * new_cohort%c_area/patchptr%area new_cohort%treesai = 0.0_r8 !FIX(RF,032414) + print*,"NEW COHORT:",new_cohort%treelai,new_cohort%bl + ! Put cohort at the right place in the linked list storebigcohort => patchptr%tallest storesmallcohort => patchptr%shortest @@ -197,150 +198,7 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & end subroutine create_cohort !-------------------------------------------------------------------------------------! - subroutine allocate_live_biomass(cc_p,mode) - ! - ! !DESCRIPTION: - ! Divide alive biomass between leaf, root and sapwood parts. - ! Needs to be called whenver balive changes. - ! - ! !USES: - ! - ! !ARGUMENTS - type (ed_cohort_type), intent(inout), target :: cc_p ! current cohort pointer - integer , intent(in) :: mode - ! - ! !LOCAL VARIABLES: - type (ed_cohort_type), pointer :: currentCohort - real(r8) :: leaf_frac ! fraction of live biomass in leaves - real(r8) :: ideal_balive ! theoretical ideal (root and stem) biomass for deciduous trees with leaves off. - ! accounts for the fact that live biomass may decline in the off-season, - ! making leaf_memory unrealistic. - real(r8) :: ratio_balive ! ratio between root+shoot biomass now and root+shoot biomass when leaves fell off. - 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 - - real(r8) :: temp_h - - integer :: ft ! functional type - integer :: leaves_off_switch - !---------------------------------------------------------------------- - - currentCohort => cc_p - ft = currentcohort%pft - - 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,currentcohort%canopy_trim,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 - - if (EDPftvarcon_inst%evergreen(ft) == 1) then - currentcohort%laimemory = 0._r8 - currentcohort%status_coh = 2 - endif - - ! iagnore the root and stem biomass from the functional balance hypothesis. This is used when the leaves are - !fully on. - !currentcohort%br = EDPftvarcon_inst%allom_l2fr(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac - !currentcohort%bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite *(currentcohort%balive + & - ! currentcohort%laimemory)*leaf_frac - - leaves_off_switch = 0 - if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves - leaves_off_switch = 1 !drought decid - endif - if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves - leaves_off_switch = 1 !cold decid - endif - - ! Use different proportions if the leaves are on vs off - if(leaves_off_switch.eq.ifalse)then ! leaves are on - - new_bl = currentcohort%balive*leaf_frac - - new_br = bfr_per_leaf * (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. - if(mode==1)then - - currentcohort%npp_leaf = currentcohort%npp_leaf + & - max(0.0_r8,new_bl - currentcohort%bl) / hlm_freq_day - - currentcohort%npp_froot = currentcohort%npp_froot + & - max(0._r8,new_br - currentcohort%br) / hlm_freq_day - - currentcohort%npp_bsw = max(0.0_r8, new_bsw - currentcohort%bsw)/hlm_freq_day - - currentcohort%npp_bdead = currentCohort%dbdeaddt - - end if - - currentcohort%bl = new_bl - currentcohort%br = new_br - currentcohort%bsw = new_bsw - - 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 - !because balive may decline in the off-season, we need to adjust the - !root and stem biomass that are predicted from the laimemory, for the fact that we now might - !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 * bfr_per_leaf + currentcohort%laimemory * bsw_per_leaf - - ratio_balive = currentcohort%balive / ideal_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 - - currentcohort%npp_froot = currentcohort%npp_froot + & - max(0.0_r8,new_br-currentcohort%br)/hlm_freq_day - currentcohort%npp_bsw = max(0.0_r8, new_bsw-currentcohort%bsw)/hlm_freq_day - - currentcohort%npp_bdead = currentCohort%dbdeaddt - - end if - - currentcohort%bl = 0.0_r8 - currentcohort%br = new_br - currentcohort%bsw = new_bsw - - endif - - if (abs(currentcohort%balive -currentcohort%bl- currentcohort%br - currentcohort%bsw)>1e-12) then - write(fates_log(),*) 'issue with carbon allocation in create_cohort,allocate_live_biomass',& - currentcohort%balive -currentcohort%bl- currentcohort%br - currentcohort%bsw, & - currentcohort%status_coh,currentcohort%balive - write(fates_log(),*) 'actual vs predicted balive',ideal_balive,currentcohort%balive ,ratio_balive,leaf_frac - write(fates_log(),*) 'leaf,root,stem',currentcohort%bl,currentcohort%br,currentcohort%bsw - write(fates_log(),*) 'pft',ft,EDPftvarcon_inst%evergreen(ft),EDPftvarcon_inst%season_decid(ft),leaves_off_switch - endif - currentCohort%b = currentCohort%bdead + currentCohort%balive - - end subroutine allocate_live_biomass - - !-------------------------------------------------------------------------------------! subroutine nan_cohort(cc_p) ! ! !DESCRIPTION: @@ -383,11 +241,9 @@ subroutine nan_cohort(cc_p) currentCohort%n = nan ! number of individuals in cohort per 'area' (10000m2 default) currentCohort%dbh = nan ! 'diameter at breast height' in cm currentCohort%hite = nan ! height: meters - currentCohort%balive = nan ! total living biomass: kGC per indiv currentCohort%bdead = nan ! dead biomass: kGC per indiv currentCohort%bstore = nan ! stored carbon: kGC per indiv currentCohort%laimemory = nan ! target leaf biomass- set from previous year: kGC per indiv - currentCohort%b = nan ! total biomass: kGC per indiv currentCohort%bsw = nan ! sapwood in stem and roots: kGC per indiv currentCohort%bl = nan ! leaf biomass: kGC per indiv currentCohort%br = nan ! fine root biomass: kGC per indiv @@ -450,13 +306,11 @@ subroutine nan_cohort(cc_p) currentCohort%treelai = nan ! lai of tree (total leaf area (m2) / canopy area (m2) currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2) currentCohort%leaf_litter = nan ! leaf litter from phenology: KgC/m2 - currentCohort%woody_turnover = nan ! amount of wood lost each day: kgC/indiv/year. Currently set to zero. ! VARIABLES NEEDED FOR INTEGRATION currentCohort%dndt = nan ! time derivative of cohort size currentCohort%dhdt = nan ! time derivative of height currentCohort%ddbhdt = nan ! time derivative of dbh - currentCohort%dbalivedt = nan ! time derivative of total living biomass currentCohort%dbdeaddt = nan ! time derivative of dead biomass currentCohort%dbstoredt = nan ! time derivative of stored biomass currentCohort%storage_flux = nan ! flux from npp into bstore @@ -603,22 +457,30 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) endif ! live biomass pools are terminally depleted - if (currentCohort%balive < 1e-10_r8 .or. currentCohort%bstore < 1e-10_r8) then + if ( (currentCohort%bsw+currentCohort%bl+currentCohort%br) < 1e-10_r8 .or. & + currentCohort%bstore < 1e-10_r8) then terminate = 1 if ( DEBUG ) then - write(fates_log(),*) 'terminating cohorts 3', currentCohort%balive,currentCohort%bstore + write(fates_log(),*) 'terminating cohorts 3', & + currentCohort%bsw,currentCohort%bl,currentCohort%br,currentCohort%bstore endif endif ! Total cohort biomass is negative - if (currentCohort%balive+currentCohort%bdead+currentCohort%bstore < 0._r8) then + if ( (currentCohort%bsw + & + currentCohort%bl + & + currentCohort%br + & + currentCohort%bdead + & + currentCohort%bstore) < 0._r8) then terminate = 1 if ( DEBUG ) then - write(fates_log(),*) 'terminating cohorts 4', currentCohort%balive, & - currentCohort%bstore, currentCohort%bdead, & - currentCohort%balive+currentCohort%bdead+& - currentCohort%bstore, currentCohort%n - endif + write(fates_log(),*) 'terminating cohorts 4', & + currentCohort%bsw, & + currentCohort%bl, & + currentCohort%br, & + currentCohort%bdead, & + currentCohort%bstore + endif endif endif ! if (.not.currentCohort%isnew .and. level == 2) then @@ -634,7 +496,13 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n ! currentSite%termination_carbonflux(levcan) = currentSite%termination_carbonflux(levcan) + & - currentCohort%n * currentCohort%b + currentCohort%n * & + (currentCohort%bsw + & + currentCohort%bl + & + currentCohort%br + & + currentCohort%bdead + & + currentCohort%bstore) + if (.not. associated(currentCohort%taller)) then currentPatch%tallest => currentCohort%shorter else @@ -786,11 +654,9 @@ subroutine fuse_cohorts(patchptr, bc_in) write(fates_log(),*) 'Cohort I, Cohort II' write(fates_log(),*) 'n:',currentCohort%n,nextc%n write(fates_log(),*) 'isnew:',currentCohort%isnew,nextc%isnew - write(fates_log(),*) 'balive:',currentCohort%balive,nextc%balive write(fates_log(),*) 'bdead:',currentCohort%bdead,nextc%bdead write(fates_log(),*) 'bstore:',currentCohort%bstore,nextc%bstore write(fates_log(),*) 'laimemory:',currentCohort%laimemory,nextc%laimemory - write(fates_log(),*) 'b:',currentCohort%b,nextc%b write(fates_log(),*) 'bsw:',currentCohort%bsw,nextc%bsw write(fates_log(),*) 'bl:',currentCohort%bl ,nextc%bl write(fates_log(),*) 'br:',currentCohort%br,nextc%br @@ -806,16 +672,12 @@ subroutine fuse_cohorts(patchptr, bc_in) end do end if - currentCohort%balive = (currentCohort%n*currentCohort%balive & - + nextc%n*nextc%balive)/newn currentCohort%bdead = (currentCohort%n*currentCohort%bdead & + nextc%n*nextc%bdead)/newn currentCohort%bstore = (currentCohort%n*currentCohort%bstore & + nextc%n*nextc%bstore)/newn currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory & + nextc%n*nextc%laimemory)/newn - currentCohort%b = (currentCohort%n*currentCohort%b & - + nextc%n*nextc%b)/newn currentCohort%bsw = (currentCohort%n*currentCohort%bsw & + nextc%n*nextc%bsw)/newn currentCohort%bl = (currentCohort%n*currentCohort%bl & @@ -921,8 +783,6 @@ subroutine fuse_cohorts(patchptr, bc_in) ! 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) & @@ -1209,13 +1069,11 @@ subroutine copy_cohort( currentCohort,copyc ) n%pft = o%pft n%n = o%n n%dbh = o%dbh - n%hite = o%hite - n%b = o%b - n%balive = o%balive + n%hite = o%hite n%bdead = o%bdead n%bstore = o%bstore n%laimemory = o%laimemory - n%bsw = o%bsw + n%bsw = o%bsw n%bl = o%bl n%br = o%br n%lai = o%lai @@ -1283,7 +1141,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%treesai = o%treesai n%leaf_litter = o%leaf_litter n%c_area = o%c_area - n%woody_turnover = o%woody_turnover ! Mortality diagnostics n%cmort = o%cmort @@ -1303,7 +1160,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%dndt = o%dndt n%dhdt = o%dhdt n%ddbhdt = o%ddbhdt - n%dbalivedt = o%dbalivedt n%dbdeaddt = o%dbdeaddt n%dbstoredt = o%dbstoredt @@ -1447,48 +1303,4 @@ end function tree_sai ! ============================================================================ - - !-------------------------------------------------------------------------------------! -! function countCohorts( bounds, ed_allsites_inst ) result ( totNumCohorts ) - ! - ! !DESCRIPTION: - ! counts the total number of cohorts over all p levels (ed_patch_type) so we - ! can allocate vectors, copy from LL -> vector and read/write restarts. - ! - ! !USES: -! use decompMod, only : bounds_type - ! - ! !ARGUMENTS -! type(bounds_type) , intent(in) :: bounds -! type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) - ! - ! !LOCAL VARIABLES: -! type (ed_patch_type) , pointer :: currentPatch -! type (ed_cohort_type) , pointer :: currentCohort -! integer :: g, totNumCohorts -! logical :: error - !---------------------------------------------------------------------- - -! totNumCohorts = 0 - -! do g = bounds%begg,bounds%endg - -! if (ed_allsites_inst(g)%istheresoil) then - -! currentPatch => ed_allsites_inst(g)%oldest_patch -! do while(associated(currentPatch)) - -! currentCohort => currentPatch%shortest -! do while(associated(currentCohort)) -! totNumCohorts = totNumCohorts + 1 -! currentCohort => currentCohort%taller -! enddo !currentCohort -! currentPatch => currentPatch%younger -! end do - -! end if -! end do - -! end function countCohorts - end module EDCohortDynamicsMod diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 051baf689a..e7cd9f8183 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -427,7 +427,11 @@ 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 * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + (currentCohort%bdead + & + currentCohort%bsw + & + currentCohort%bl + & + currentCohort%br + & + currentCohort%bstore) * 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... @@ -547,7 +551,11 @@ 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 * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + (currentCohort%bdead + & + currentCohort%bsw + & + currentCohort%bl + & + currentCohort%br + & + currentCohort%bstore) * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! Step 2: Apply survivor ship function based on the understory death fraction @@ -940,14 +948,14 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si 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 + burned_leaves = min(currentCohort%bl, (currentCohort%bl+currentCohort%bsw) * currentCohort%cfa) else - burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentPatch%burnt_frac_litter(6) + burned_leaves = min(currentCohort%bl, (currentCohort%bl+currentCohort%bsw) * currentPatch%burnt_frac_litter(6)) endif if (burned_leaves > 0.0_r8) then - currentCohort%balive = max(currentCohort%br,currentCohort%balive - burned_leaves) - currentCohort%bl = max(0.00001_r8, currentCohort%bl - burned_leaves) + currentCohort%bl = currentCohort%bl - burned_leaves + !KgC/gridcell/day currentSite%flux_out = currentSite%flux_out + burned_leaves * currentCohort%n * & patch_site_areadis/currentPatch%area * AREA diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 2c8490eef8..4146b60846 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -15,7 +15,7 @@ module EDPhysiologyMod use FatesConstantsMod, only : r8 => fates_r8 use EDPftvarcon , only : EDPftvarcon_inst use FatesInterfaceMod, only : bc_in_type - use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort + use EDCohortDynamicsMod , only : zero_cohort use EDCohortDynamicsMod , only : create_cohort, sort_cohorts use EDCohortDynamicsMod , only : tree_lai use EDCohortDynamicsMod , only : tree_sai @@ -528,8 +528,6 @@ subroutine phenology_leafonoff(currentSite) currentCohort%bl = currentCohort%bstore * store_output endif - ! Add deployed carbon to alive biomass pool - currentCohort%balive = currentCohort%balive + currentCohort%bl if ( DEBUG ) write(fates_log(),*) 'EDPhysMod 1 ',currentCohort%bstore @@ -549,8 +547,7 @@ subroutine phenology_leafonoff(currentSite) currentCohort%status_coh = 1 !remember what the lai was this year to put the same amount back on in the spring... currentCohort%laimemory = currentCohort%bl - ! decrement balive for leaf litterfall - currentCohort%balive = currentCohort%balive - currentCohort%bl + ! add lost carbon to litter currentCohort%leaf_litter = currentCohort%bl currentCohort%bl = 0.0_r8 @@ -568,7 +565,6 @@ subroutine phenology_leafonoff(currentSite) else currentCohort%bl = currentCohort%bstore * store_output !we can only put on as much carbon as there is in the store... endif - currentCohort%balive = currentCohort%balive + currentCohort%bl if ( DEBUG ) write(fates_log(),*) 'EDPhysMod 3 ',currentCohort%bstore @@ -586,8 +582,6 @@ subroutine phenology_leafonoff(currentSite) if (currentCohort%status_coh == 2)then ! leaves have not dropped currentCohort%status_coh = 1 currentCohort%laimemory = currentCohort%bl - ! decrement balive for leaf litterfall - currentCohort%balive = currentCohort%balive - currentCohort%bl ! add retranslocated carbon (very small) to store. currentCohort%bstore = currentCohort%bstore ! add falling leaves to litter pools . convert to KgC/m2 @@ -786,13 +780,15 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: dbt_dead_dd ! change in dead biomass wrt diameter (kgC/cm) real(r8) :: bt_store ! target storage biomass (kgC) real(r8) :: dbt_store_dd ! target rate of change in storage (kgC/cm) + real(r8) :: dbt_total_dd ! total target biomass rate of change (kgC/cm) real(r8) :: leaf_below_target ! leaf biomass below target amount [kgC] real(r8) :: froot_below_target ! fineroot biomass below target amount [kgC] real(r8) :: sap_below_target ! sapwood biomass below target amount [kgC] real(r8) :: store_below_target ! storage biomass below target amount [kgC] real(r8) :: dead_below_target ! dead (structural) biomass below target amount [kgC] - + real(r8) :: total_below_target ! total biomass below the allometric target [kgC] + real(r8) :: store_flux ! carbon fluxing into storage [kgC] real(r8) :: leaf_flux ! carbon fluxing into leaves [kgC] real(r8) :: froot_flux ! carbon fluxing into fineroots [kgC] @@ -813,16 +809,17 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! RGK 11-2017 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(r8), parameter :: background_woody_turnover = 20.0_r8 + logical, parameter :: do_wood_turnover = .false. ipft = currentCohort%pft - ! Initialize NPP flux diagnostics - currentCohort%npp_bstore = 0.0_r8 + currentCohort%npp_store = 0.0_r8 currentCohort%npp_leaf = 0.0_r8 currentCohort%npp_froot = 0.0_r8 currentCohort%npp_bdead = 0.0_r8 currentCohort%npp_bseed = 0.0_r8 + currentCohort%npp_bsw = 0.0_r8 ! ----------------------------------------------------------------------------------- ! I. Identify the net carbon gain for this dynamics interval @@ -860,6 +857,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%carbon_balance = currentCohort%npp_acc + print*," currentCohort%carbon_balance: ", currentCohort%carbon_balance + ! ----------------------------------------------------------------------------------- ! II. Calculate target size of living biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- @@ -867,10 +866,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Target leaf biomass according to allometry and trimming call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) + print*,"currentcohort%status_coh: ", currentcohort%status_coh + ! If status_coh is 1, then leaves are in a dropped (off allometry) if( currentcohort%status_coh == 1 ) then bt_leaf = 0.0_r8 - dbt_leaf_db = 0.0_r8 + dbt_leaf_dd = 0.0_r8 end if ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] @@ -926,7 +927,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if(store_below_target<0.0_r8) then currentCohort%carbon_balance = currentCohort%carbon_balance - store_below_target currentCohort%bstore = currentCohort%bstore + store_below_target - currentCohort%npp_bstore = currentCohort%npp_bstore + store_below_target * hlm_freq_day + currentCohort%npp_store = currentCohort%npp_store + store_below_target * hlm_freq_day store_below_target = 0.0_r8 end if @@ -962,7 +963,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) write(fates_log(),*) 'PFT # ',ipft,' must be defined as having one of three' write(fates_log(),*) 'phenology habits, ie == 1' write(fates_log(),*) 'stress_decid: ',EDPftvarcon_inst%stress_decid(ipft) - write(fates_log(),*) 'season_decid: ',DPftvarcon_inst%season_decid(ipft) + write(fates_log(),*) 'season_decid: ',EDPftvarcon_inst%season_decid(ipft) write(fates_log(),*) 'evergreen: ',EDPftvarcon_inst%evergreen(ipft) call endrun(msg=errMsg(sourcefile, __LINE__)) endif @@ -975,9 +976,15 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! be pulling some leaves with them when leaves are out... ! ----------------------------------------------------------------------------------- - currentCohort%bsw_md = currentCohort%bsw / background_woody_turnover - currentCohort%bdead_md = currentCohort%bdead / background_woody_turnover - currentCohort%bstore_md = currentCohort%bstore / background_woody_turnover + if ( do_wood_turnover ) then + currentCohort%bsw_md = currentCohort%bsw / background_woody_turnover + currentCohort%bdead_md = currentCohort%bdead / background_woody_turnover + currentCohort%bstore_md = currentCohort%bstore / background_woody_turnover + else + currentCohort%bsw_md = 0.0_r8 + currentCohort%bdead_md = 0.0_r8 + currentCohort%bstore_md = 0.0_r8 + end if if (EDPftvarcon_inst%evergreen(ipft) == 1)then currentCohort%leaf_md = currentCohort%bl / EDPftvarcon_inst%leaf_long(ipft) @@ -998,28 +1005,25 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! V. Remove turnover from the appropriate pools ! - ! Units: kgC/year / (1/days_per_year) = kgC/day -> (day elapsed) -> kgC + ! Units: kgC/year * (year/days_per_year) = kgC/day -> (day elapsed) -> kgC ! ----------------------------------------------------------------------------------- ! leaf biomass - currentCohort%bl = currentCohort%bl - currentCohort%leaf_md/hlm_freq_day + currentCohort%bl = currentCohort%bl - currentCohort%leaf_md*hlm_freq_day ! fine-root biomass - currentcohort%br = currentcohort%br - currentCohort%root_md/hlm_freq_day + currentcohort%br = currentcohort%br - currentCohort%root_md*hlm_freq_day ! sapwood biomass loss - currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md/hlm_freq_day + currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md*hlm_freq_day ! structural biomass loss - currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md/hlm_freq_day + currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md*hlm_freq_day ! storage biomass loss - currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md/hlm_freq_day - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! CHECK LITTER FLUXES AND SEE WHERE THE LITTER IS GENERATED - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md*hlm_freq_day + ! ----------------------------------------------------------------------------------- ! VI(a) if carbon balance is negative, re-coup the losses from storage ! ----------------------------------------------------------------------------------- @@ -1061,7 +1065,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! VI(c). If carbon is still available, prioritize some allocation to storage ! ----------------------------------------------------------------------------------- - store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft))) + store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft)) store_flux = currentCohort%carbon_balance * & max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux @@ -1114,6 +1118,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) store_flux = min(store_below_target, & currentCohort%carbon_balance * store_below_target/total_below_target) + print*,leaf_flux,froot_flux,sap_flux,sap_below_target ,store_flux,total_below_target + + currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux currentCohort%bl = currentCohort%bl + leaf_flux currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day @@ -1128,7 +1135,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux currentCohort%bstore = currentCohort%bstore + store_flux - currentCohort%npp_bstore = currentCohort%npp_bdead + store_flux * hlm_freq_day + currentCohort%npp_store = currentCohort%npp_store + store_flux * hlm_freq_day end if @@ -1166,12 +1173,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) end if - dbt_total_dd = db_leaf_dd + db_fineroot_dd + db_sap_dd + db_dead_dd + db_store_dd + dbt_total_dd = dbt_leaf_dd + dbt_fineroot_dd + dbt_sap_dd + dbt_dead_dd + dbt_store_dd - leaf_flux = currentCohort%carbon_balance * (db_leaf_dd/dbt_total_dd)*(1.0_repro_fraction) - froot_flux = currentCohort%carbon_balance * (db_fineroot_dd/dbt_total_dd)*(1.0_repro_fraction) - sap_flux = currentCohort%carbon_balance * (db_sap_dd/dbt_total_dd)*(1.0_repro_fraction) - dead_flux = currentCohort%carbon_balance * (db_dead_dd/dbt_total_dd)*(1.0_repro_fraction) + leaf_flux = currentCohort%carbon_balance * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + froot_flux = currentCohort%carbon_balance * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + sap_flux = currentCohort%carbon_balance * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + dead_flux = currentCohort%carbon_balance * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) repro_flux = currentCohort%carbon_balance * repro_fraction ! Take an Euler Step to integrate all pools @@ -1189,7 +1196,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_bsw = currentCohort%npp_bsw + sap_flux * hlm_freq_day currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux - currentCohort%bstore = currentCohort%store + store_flux + currentCohort%bstore = currentCohort%bstore + store_flux currentCohort%npp_store = currentCohort%npp_bsw + store_flux * hlm_freq_day currentCohort%carbon_balance = currentCohort%carbon_balance - dead_flux @@ -1197,7 +1204,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_store = currentCohort%npp_bdead + dead_flux * hlm_freq_day currentCohort%carbon_balance = currentCohort%carbon_balance - repro_flux - currentCohort%bseed = currentCohort%bseed + repro_flux currentCohort%npp_bseed = currentCohort%npp_bseed + repro_flux * hlm_freq_day currentCohort%seed_prod = repro_flux * hlm_freq_day @@ -1205,7 +1211,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! VII. Update the diameter and height allometries if we had structural growth ! ----------------------------------------------------------------------------------- - currentCohort%dbh = currentCohort%dbh + dead_flux / db_dead_dd + currentCohort%dbh = currentCohort%dbh + dead_flux / dbt_dead_dd call h_allom(currentCohort%dbh,ipft,currentCohort%hite) @@ -1223,8 +1229,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if - - currentCohort%balive = currentCohort%bl + currentCohort%br + currentCohort%bsw ! If the cohort has grown, it is not new @@ -1270,7 +1274,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) - ! Initialize balive (leaf+fineroot+sapwood) + ! Initialize live pools 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,temp_cohort%canopy_trim,b_sapwood) @@ -1279,19 +1283,19 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call bbgw_allom(temp_cohort%dbh,ft,b_bgw) call bdead_allom(b_agw,b_bgw,b_sapwood,ft,temp_cohort%bdead) - temp_cohort%balive = b_leaf + b_sapwood + b_fineroot temp_cohort%bstore = EDPftvarcon_inst%cushion(ft) * b_leaf 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) + / (temp_cohort%bdead+b_leaf+b_fineroot+b_sapwood+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_in = currentSite%flux_in + temp_cohort%n * & + (temp_cohort%bstore + b_leaf + b_fineroot + b_sapwood + temp_cohort%bdead) currentSite%flux_out = currentSite%flux_out + currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day endif @@ -1311,7 +1315,7 @@ subroutine recruitment( currentSite, currentPatch, 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, & - b_leaf, b_fineroot, b_sap, temp_cohort%bdead, temp_cohort%bstore, & + b_leaf, b_fineroot, b_sapwood, temp_cohort%bdead, temp_cohort%bstore, & temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p, & bc_in) @@ -1906,7 +1910,9 @@ 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%bdead + currentCohort%bsw ) * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + & + (currentCohort%br + currentCohort%bstore )) + & + (currentCohort%n / currentPatch%area) currentCohort => currentCohort%shorter enddo !currentCohort ! diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index bf87011fdf..29f9832ef1 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -106,6 +106,7 @@ module FatesAllometryMod public :: bfineroot ! Generic actual fine root biomass wrapper public :: bdead_allom ! Generic bdead wrapper public :: carea_allom ! Generic crown area wrapper + public :: check_integrated_allometries character(len=*), parameter :: sourcefile = __FILE__ @@ -130,7 +131,7 @@ module FatesAllometryMod ! Check to make sure Martinez-Cano height cap is not on, or explicitly allowed - subroutine check_integrated_allometries(dbh,ipft,bl,bfr,bsap,bdead) + subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) ! This routine checks the error on the carbon allocation ! integration step. The integrated quantities should @@ -156,7 +157,7 @@ subroutine check_integrated_allometries(dbh,ipft,bl,bfr,bsap,bdead) real(r8) :: bagw_diag ! diagnosed agbw [kgC] real(r8) :: bbgw_diag ! diagnosed below ground wood [kgC] - real(r8) :: relative_err_thresh = 1.0e-4_r8 + real(r8) :: relative_err_thresh = 1.0e-3_r8 call h_allom(dbh,ipft,height) diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 47a70b16df..65dbfb250c 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -113,8 +113,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) real(r8) :: rresis ! suction limitation to transpiration independent ! of root density real(r8) :: pftgs(maxpft) ! pft weighted stomatal conductance s/m - real(r8) :: temprootr - real(r8) :: balive_patch + real(r8) :: temprootr real(r8) :: sum_pftgs ! sum of weighted conductances (for normalization) !------------------------------------------------------------------------------ diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index 49a0351fd0..c9644ab108 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -78,8 +78,11 @@ subroutine SummarizeNetFluxes( nsites, sites, bc_in, is_beg_day ) ! map biomass pools to column level sites(s)%biomass_stock = sites(s)%biomass_stock + & - (currentCohort%bdead + currentCohort%balive + & - currentCohort%bstore) * n_perm2 * 1.e3_r8 + (currentCohort%bdead + & + currentCohort%bsw + & + currentCohort%bl + & + currentCohort%br + & + currentCohort%bstore) * n_perm2 * 1.e3_r8 currentCohort => currentCohort%shorter enddo !currentCohort @@ -264,8 +267,12 @@ subroutine SiteCarbonStock(currentSite,total_stock,biomass_stock,litter_stock,se currentCohort => currentPatch%tallest do while(associated(currentCohort)) - biomass_stock = biomass_stock + (currentCohort%bdead + currentCohort%balive + & - currentCohort%bstore) * currentCohort%n + biomass_stock = biomass_stock + & + (currentCohort%bdead + & + currentCohort%bsw + & + currentCohort%br + & + currentCohort%bl + & + currentCohort%bstore) * currentCohort%n currentCohort => currentCohort%shorter enddo !end cohort loop currentPatch => currentPatch%younger diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index d274f6f039..8d343489ce 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -386,12 +386,8 @@ subroutine init_cohorts( patch_in, bc_in) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_sapwood) - temp_cohort%balive = b_leaf + b_fineroot + b_sapwood - call bdead_allom( b_agw, b_bgw, b_sapwood, pft, 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) temp_cohort%laimemory = 0._r8 @@ -406,14 +402,12 @@ subroutine init_cohorts( patch_in, bc_in) 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 cstatus = patch_in%siteptr%status endif if ( EDPftvarcon_inst%stress_decid(pft) == 1 ) then 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/EDMainMod.F90 b/main/EDMainMod.F90 index cf702bb89c..79ee0082de 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -19,7 +19,6 @@ module EDMainMod use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : hlm_masterproc use FatesInterfaceMod , only : numpft - use EDCohortDynamicsMod , only : allocate_live_biomass use EDCohortDynamicsMod , only : terminate_cohorts use EDCohortDynamicsMod , only : fuse_cohorts use EDCohortDynamicsMod , only : sort_cohorts @@ -523,7 +522,7 @@ subroutine ed_total_balance_check (currentSite, call_index ) write(fates_log(),*)'---' currentCohort => currentPatch%tallest do while(associated(currentCohort)) - write(fates_log(),*) currentCohort%bdead,currentCohort%balive,currentCohort%bstore,currentCohort%n + write(fates_log(),*) currentCohort%bdead,currentCohort%bstore,currentCohort%n currentCohort => currentCohort%shorter; enddo !end cohort loop currentPatch => currentPatch%younger diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 06b2bdcba8..d5eaba7027 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -125,13 +125,13 @@ module EDTypesMod real(r8) :: dbh ! dbh: cm real(r8) :: hite ! height: meters integer :: indexnumber ! unique number for each cohort. (within clump?) - real(r8) :: balive ! total living biomass: kGC per indiv real(r8) :: bdead ! dead biomass: kGC per indiv real(r8) :: bstore ! stored carbon: kGC per indiv real(r8) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) - real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort (1 = canopy, 2 = understorey, etc.) real to be conservative during fusion - real(r8) :: b ! total biomass: kGC per indiv + real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort + ! (1 = canopy, 2 = understorey, etc.) + ! real to be conservative during fusion real(r8) :: bsw ! sapwood in stem and roots: kGC per indiv real(r8) :: bl ! leaf biomass: kGC per indiv real(r8) :: br ! fine root biomass: kGC per indiv @@ -189,13 +189,13 @@ module EDTypesMod ! Net Primary Production Partitions - real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/year - real(r8) :: npp_froot ! NPP into fine roots (includes replacement of turnover): KgC/indiv/year + real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/year + real(r8) :: npp_froot ! NPP into fine roots (includes replacement of turnover): KgC/indiv/year - real(r8) :: npp_bsw ! NPP into sapwood: KgC/indiv/year - real(r8) :: npp_bdead ! NPP into deadwood (structure): KgC/indiv/year - real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/year - real(r8) :: npp_store ! NPP into storage: KgC/indiv/year + real(r8) :: npp_bsw ! NPP into sapwood: KgC/indiv/year + real(r8) :: npp_bdead ! NPP into deadwood (structure): KgC/indiv/year + real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/year + real(r8) :: npp_store ! NPP into storage: KgC/indiv/year real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/s real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year @@ -249,7 +249,6 @@ module EDTypesMod real(r8) :: dndt ! time derivative of cohort size : n/year real(r8) :: dhdt ! time derivative of height : m/year real(r8) :: ddbhdt ! time derivative of dbh : cm/year - real(r8) :: dbalivedt ! time derivative of total living biomass : KgC/year real(r8) :: dbdeaddt ! time derivative of dead biomass : KgC/year real(r8) :: dbstoredt ! time derivative of stored biomass : KgC/year real(r8) :: storage_flux ! flux from npp into bstore : KgC/year @@ -263,8 +262,15 @@ module EDTypesMod ! Hydraulics type(ed_cohort_hydr_type), pointer :: co_hydr ! All cohort hydraulics data, see FatesHydraulicsMemMod.F90 + contains - end type ed_cohort_type + procedure, public :: b_total + + end type ed_cohort_type + + + + !************************************ !** Patch type structure ** @@ -558,6 +564,18 @@ module EDTypesMod contains + function b_total(this) + + ! Calculate total plant biomass + + implicit none + class(ed_cohort_type), intent(inout) :: this + real(r8) :: b_total + + b_total = this%bl + this%br + this%bsw + this%bdead + this%bstore + + end function b_total + ! ===================================================================================== subroutine val_check_ed_vars(currentPatch,var_aliases,return_code) @@ -691,8 +709,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%n = ', ccohort%n write(fates_log(),*) 'co%dbh = ', ccohort%dbh write(fates_log(),*) 'co%hite = ', ccohort%hite - write(fates_log(),*) 'co%b = ', ccohort%b - write(fates_log(),*) 'co%balive = ', ccohort%balive write(fates_log(),*) 'co%bdead = ', ccohort%bdead write(fates_log(),*) 'co%bstore = ', ccohort%bstore write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory @@ -747,7 +763,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%treesai = ', ccohort%treesai write(fates_log(),*) 'co%leaf_litter = ', ccohort%leaf_litter write(fates_log(),*) 'co%c_area = ', ccohort%c_area - 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%fmort = ', ccohort%fmort @@ -756,7 +771,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%dndt = ', ccohort%dndt write(fates_log(),*) 'co%dhdt = ', ccohort%dhdt write(fates_log(),*) 'co%ddbhdt = ', ccohort%ddbhdt - write(fates_log(),*) 'co%dbalivedt = ', ccohort%dbalivedt write(fates_log(),*) 'co%dbdeaddt = ', ccohort%dbdeaddt write(fates_log(),*) 'co%dbstoredt = ', ccohort%dbstoredt write(fates_log(),*) 'co%storage_flux = ', ccohort%storage_flux diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 5e0bb00a15..4dcb7268c4 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -202,7 +202,6 @@ module FatesHistoryInterfaceMod integer, private :: ih_bsw_md_canopy_si_scls integer, private :: ih_carbon_balance_canopy_si_scls integer, private :: ih_seed_prod_canopy_si_scls - integer, private :: ih_dbalivedt_canopy_si_scls integer, private :: ih_dbdeaddt_canopy_si_scls integer, private :: ih_dbstoredt_canopy_si_scls integer, private :: ih_storage_flux_canopy_si_scls @@ -226,7 +225,6 @@ module FatesHistoryInterfaceMod integer, private :: ih_bstore_md_understory_si_scls integer, private :: ih_carbon_balance_understory_si_scls integer, private :: ih_seed_prod_understory_si_scls - integer, private :: ih_dbalivedt_understory_si_scls integer, private :: ih_dbdeaddt_understory_si_scls integer, private :: ih_dbstoredt_understory_si_scls integer, private :: ih_storage_flux_understory_si_scls @@ -1243,7 +1241,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bstore_md_canopy_si_scls => this%hvars(ih_bstore_md_canopy_si_scls)%r82d, & hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & hio_seed_prod_canopy_si_scls => this%hvars(ih_seed_prod_canopy_si_scls)%r82d, & - hio_dbalivedt_canopy_si_scls => this%hvars(ih_dbalivedt_canopy_si_scls)%r82d, & hio_dbdeaddt_canopy_si_scls => this%hvars(ih_dbdeaddt_canopy_si_scls)%r82d, & hio_dbstoredt_canopy_si_scls => this%hvars(ih_dbstoredt_canopy_si_scls)%r82d, & hio_storage_flux_canopy_si_scls => this%hvars(ih_storage_flux_canopy_si_scls)%r82d, & @@ -1260,7 +1257,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bdead_md_understory_si_scls => this%hvars(ih_bdead_md_understory_si_scls)%r82d, & hio_carbon_balance_understory_si_scls=> this%hvars(ih_carbon_balance_understory_si_scls)%r82d, & hio_seed_prod_understory_si_scls => this%hvars(ih_seed_prod_understory_si_scls)%r82d, & - hio_dbalivedt_understory_si_scls => this%hvars(ih_dbalivedt_understory_si_scls)%r82d, & hio_dbdeaddt_understory_si_scls => this%hvars(ih_dbdeaddt_understory_si_scls)%r82d, & hio_dbstoredt_understory_si_scls => this%hvars(ih_dbstoredt_understory_si_scls)%r82d, & hio_storage_flux_understory_si_scls => this%hvars(ih_storage_flux_understory_si_scls)%r82d, & @@ -1394,12 +1390,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! 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_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * & + (ccohort%bsw + ccohort%br + ccohort%bl) * 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 - + hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b_total() * g_per_kg + ! Update PFT partitioned biomass components hio_leafbiomass_si_pft(io_si,ft) = hio_leafbiomass_si_pft(io_si,ft) + & (ccohort%n * AREA_INV) * ccohort%bl * g_per_kg @@ -1411,11 +1408,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%n * AREA_INV hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & - (ccohort%n * AREA_INV) * ccohort%b * g_per_kg + (ccohort%n * AREA_INV) * ccohort%b_total() * g_per_kg ! update total biomass per age bin hio_biomass_si_age(io_si,cpatch%age_class) = hio_biomass_si_age(io_si,cpatch%age_class) & - + ccohort%b * ccohort%n * AREA_INV + + ccohort%b_total() * ccohort%n * AREA_INV ! Site by Size-Class x PFT (SCPF) @@ -1517,7 +1514,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bstore * ccohort%n hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & ccohort%bl * ccohort%n - hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg + + hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b_total() * 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%fmort) * ccohort%n @@ -1552,8 +1550,8 @@ 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%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%b_total() * 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_total() * & 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) + & @@ -1570,8 +1568,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%carbon_balance * ccohort%n hio_seed_prod_canopy_si_scls(io_si,scls) = hio_seed_prod_canopy_si_scls(io_si,scls) + & ccohort%seed_prod * ccohort%n - hio_dbalivedt_canopy_si_scls(io_si,scls) = hio_dbalivedt_canopy_si_scls(io_si,scls) + & - ccohort%dbalivedt * ccohort%n hio_dbdeaddt_canopy_si_scls(io_si,scls) = hio_dbdeaddt_canopy_si_scls(io_si,scls) + & ccohort%dbdeaddt * ccohort%n hio_dbstoredt_canopy_si_scls(io_si,scls) = hio_dbstoredt_canopy_si_scls(io_si,scls) + & @@ -1603,7 +1599,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bstore * ccohort%n hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & ccohort%bl * ccohort%n - hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg + hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + & + n_density * ccohort%b_total() * 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%fmort) * ccohort%n @@ -1637,8 +1634,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & (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%b_total() * 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_total() * & 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) + & @@ -1655,8 +1652,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%carbon_balance * ccohort%n hio_seed_prod_understory_si_scls(io_si,scls) = hio_seed_prod_understory_si_scls(io_si,scls) + & ccohort%seed_prod * ccohort%n - hio_dbalivedt_understory_si_scls(io_si,scls) = hio_dbalivedt_understory_si_scls(io_si,scls) + & - ccohort%dbalivedt * ccohort%n hio_dbdeaddt_understory_si_scls(io_si,scls) = hio_dbdeaddt_understory_si_scls(io_si,scls) + & ccohort%dbdeaddt * ccohort%n hio_dbstoredt_understory_si_scls(io_si,scls) = hio_dbstoredt_understory_si_scls(io_si,scls) + & @@ -3465,11 +3460,6 @@ 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_seed_prod_canopy_si_scls ) - call this%set_history_var(vname='DBALIVEDT_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='DBALIVEDT 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_dbalivedt_canopy_si_scls ) - call this%set_history_var(vname='DBDEADDT_CANOPY_SCLS', units = 'kg C / ha / yr', & long='DBDEADDT for canopy plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3565,10 +3555,10 @@ 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_bdead_md_understory_si_scls ) - call this%set_history_var(vname='ROOT_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='ROOT_MD for understory plants by size class', use_default='inactive', & + call this%set_history_var(vname='BSW_MD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='BSW_MD 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_root_md_understory_si_scls ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_bsw_md_understory_si_scls ) call this%set_history_var(vname='CARBON_BALANCE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & long='CARBON_BALANCE for understory plants by size class', use_default='inactive', & @@ -3580,11 +3570,6 @@ 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_seed_prod_understory_si_scls ) - call this%set_history_var(vname='DBALIVEDT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='DBALIVEDT 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_dbalivedt_understory_si_scls ) - call this%set_history_var(vname='DBDEADDT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & long='DBDEADDT for understory plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 0fa61fe83c..0aefed13b9 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -891,12 +891,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,c_pft,temp_cohort%canopy_trim,b_sapwood) - temp_cohort%balive = b_leaf + b_fineroot + b_sapwood - call bdead_allom( b_agw, b_bgw, b_sapwood, c_pft, temp_cohort%bdead ) - temp_cohort%b = temp_cohort%balive + temp_cohort%bdead - if( EDPftvarcon_inst%evergreen(c_pft) == 1) then temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(c_pft) temp_cohort%laimemory = 0._r8 @@ -911,14 +907,12 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & 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 cstatus = csite%status endif if ( EDPftvarcon_inst%stress_decid(c_pft) == 1 ) then 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 573292863b..acaba26574 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -71,7 +71,7 @@ module FatesRestartInterfaceMod integer, private :: ir_seedrainflux_si integer, private :: ir_trunk_product_si integer, private :: ir_ncohort_pa - integer, private :: ir_balive_co + integer, private :: ir_bsw_co integer, private :: ir_bdead_co integer, private :: ir_bleaf_co integer, private :: ir_broot_co @@ -110,7 +110,6 @@ module FatesRestartInterfaceMod integer, private :: ir_ddbhdt_co - integer, private :: ir_dbalivedt_co integer, private :: ir_dbdeaddt_co integer, private :: ir_dbstoredt_co integer, private :: ir_resp_tstep_co @@ -615,9 +614,9 @@ subroutine define_restart_vars(this, initialize_variables) ! 1D cohort Variables ! ----------------------------------------------------------------------------------- - call this%set_restart_var(vname='fates_balive', vtype=cohort_r8, & - long_name='ed cohort alive biomass', units='kgC/indiv', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_balive_co ) + call this%set_restart_var(vname='fates_bsw', vtype=cohort_r8, & + long_name='ed cohort sapwood biomass', units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bsw_co ) call this%set_restart_var(vname='fates_bdead', vtype=cohort_r8, & long_name='ed cohort - dead (structural) biomass in living plants', & @@ -783,11 +782,6 @@ subroutine define_restart_vars(this, initialize_variables) units='cm/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ddbhdt_co ) - call this%set_restart_var(vname='fates_dbalivedt', vtype=cohort_r8, & - long_name='ed cohort - differential: ddbh/dt', & - units='cm/year', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dbalivedt_co ) - call this%set_restart_var(vname='fates_dbdeaddt', vtype=cohort_r8, & long_name='ed cohort - differential: ddbh/dt', & units='cm/year', flushval = flushzero, & @@ -1045,7 +1039,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_seedrainflux_si => this%rvars(ir_seedrainflux_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & - rio_balive_co => this%rvars(ir_balive_co)%r81d, & + rio_bsw_co => this%rvars(ir_bsw_co)%r81d, & rio_bdead_co => this%rvars(ir_bdead_co)%r81d, & rio_bleaf_co => this%rvars(ir_bleaf_co)%r81d, & rio_broot_co => this%rvars(ir_broot_co)%r81d, & @@ -1085,7 +1079,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & - rio_dbalivedt_co => this%rvars(ir_dbalivedt_co)%r81d, & rio_dbdeaddt_co => this%rvars(ir_dbdeaddt_co)%r81d, & rio_dbstoredt_co => this%rvars(ir_dbstoredt_co)%r81d, & rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & @@ -1169,7 +1162,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) write(fates_log(),*) 'CLTV upperbound ', ubound(rio_npp_acc_co,1) endif - rio_balive_co(io_idx_co) = ccohort%balive + rio_bsw_co(io_idx_co) = ccohort%bsw rio_bdead_co(io_idx_co) = ccohort%bdead rio_bleaf_co(io_idx_co) = ccohort%bl rio_broot_co(io_idx_co) = ccohort%br @@ -1207,7 +1200,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_lmort_infra_co(io_idx_co) = ccohort%lmort_infra rio_ddbhdt_co(io_idx_co) = ccohort%ddbhdt - rio_dbalivedt_co(io_idx_co) = ccohort%dbalivedt rio_dbdeaddt_co(io_idx_co) = ccohort%dbdeaddt rio_dbstoredt_co(io_idx_co) = ccohort%dbstoredt rio_resp_tstep_co(io_idx_co) = ccohort%resp_tstep @@ -1470,7 +1462,6 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) allocate(temp_cohort) temp_cohort%n = 700.0_r8 - temp_cohort%balive = 0.0_r8 temp_cohort%bdead = 0.0_r8 temp_cohort%bstore = 0.0_r8 temp_cohort%laimemory = 0.0_r8 @@ -1636,7 +1627,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_seedrainflux_si => this%rvars(ir_seedrainflux_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & - rio_balive_co => this%rvars(ir_balive_co)%r81d, & + rio_bsw_co => this%rvars(ir_bsw_co)%r81d, & rio_bdead_co => this%rvars(ir_bdead_co)%r81d, & rio_bleaf_co => this%rvars(ir_bleaf_co)%r81d, & rio_broot_co => this%rvars(ir_broot_co)%r81d, & @@ -1672,10 +1663,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & - - rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & - rio_dbalivedt_co => this%rvars(ir_dbalivedt_co)%r81d, & rio_dbdeaddt_co => this%rvars(ir_dbdeaddt_co)%r81d, & rio_dbstoredt_co => this%rvars(ir_dbstoredt_co)%r81d, & rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & @@ -1743,7 +1731,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) write(fates_log(),*) 'CVTL io_idx_co ',io_idx_co endif - ccohort%balive = rio_balive_co(io_idx_co) + ccohort%bsw = rio_bsw_co(io_idx_co) ccohort%bdead = rio_bdead_co(io_idx_co) ccohort%bl = rio_bleaf_co(io_idx_co) ccohort%br = rio_broot_co(io_idx_co) @@ -1780,10 +1768,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%lmort_collateral = rio_lmort_collateral_co(io_idx_co) ccohort%lmort_infra = rio_lmort_infra_co(io_idx_co) - - ccohort%ddbhdt = rio_ddbhdt_co(io_idx_co) - ccohort%dbalivedt = rio_dbalivedt_co(io_idx_co) ccohort%dbdeaddt = rio_dbdeaddt_co(io_idx_co) ccohort%dbstoredt = rio_dbstoredt_co(io_idx_co) ccohort%resp_tstep = rio_resp_tstep_co(io_idx_co) From b37ba1dec9d339127befc7401f3508907e3fe2dc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 28 Nov 2017 23:02:53 -0800 Subject: [PATCH 044/111] Allocation: added an adaptive euler step to growth along the allometric curve, still debugging --- biogeochem/EDPhysiologyMod.F90 | 338 +++++++++++++++++++------------ biogeochem/FatesAllometryMod.F90 | 36 ++-- 2 files changed, 236 insertions(+), 138 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 4146b60846..32bbc5248e 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -44,7 +44,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : carea_allom - use FatesAllometryMod , only : check_integrated_allometries + use FatesAllometryMod , only : CheckIntegratedAllometries implicit none @@ -789,12 +789,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: dead_below_target ! dead (structural) biomass below target amount [kgC] real(r8) :: total_below_target ! total biomass below the allometric target [kgC] - real(r8) :: store_flux ! carbon fluxing into storage [kgC] - real(r8) :: leaf_flux ! carbon fluxing into leaves [kgC] - real(r8) :: froot_flux ! carbon fluxing into fineroots [kgC] - real(r8) :: sap_flux ! carbon fluxing into sapwood [kgC] - real(r8) :: dead_flux ! carbon fluxing into structure [kgC] - real(r8) :: repro_flux ! carbon fluxing into reproductive tissues [kgC] + real(r8) :: bstore_flux ! carbon fluxing into storage [kgC] + real(r8) :: bl_flux ! carbon fluxing into leaves [kgC] + real(r8) :: br_flux ! carbon fluxing into fineroots [kgC] + real(r8) :: bsw_flux ! carbon fluxing into sapwood [kgC] + real(r8) :: bdead_flux ! carbon fluxing into structure [kgC] + real(r8) :: brepro_flux ! carbon fluxing into reproductive tissues [kgC] real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] real(r8) :: repro_fraction ! fraction of carbon gain sent to reproduction when on-allometry @@ -803,6 +803,20 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: root_turnover_demand ! fineroot carbon that is demanded to replace maintenance turnover [kgC] real(r8) :: total_turnover_demand ! total carbon that is demanded to replace maintenance turnover [kgC] + ! integrator variables + real(r8) :: deltaC ! trial value for substep + integer :: ierr ! error flag for allometric growth step + real(r8) :: totalC ! total carbon allocated over alometric growth step + real(r8) :: dbh_sub ! substep dbh + real(r8) :: h_sub ! substep h + real(r8) :: bl_sub ! substep leaf biomass + real(r8) :: br_sub ! substep root biomass + real(r8) :: bsw_sub ! substep sapwood biomass + real(r8) :: bstore_sub ! substep storage biomass + real(r8) :: bdead_sub ! substep structural biomass + real(r8) :: brepro_sub ! substep reproductive biomass + + ! Woody turnover timescale [years] ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! THIS NEEDS A PFT VARIABLE, OR LIKE OTHER POOLS SHOULD BE HOOKED INTO THE DISTURBANCE ALGORITHM @@ -810,6 +824,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(r8), parameter :: background_woody_turnover = 20.0_r8 logical, parameter :: do_wood_turnover = .false. + real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ipft = currentCohort%pft @@ -1008,19 +1023,11 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Units: kgC/year * (year/days_per_year) = kgC/day -> (day elapsed) -> kgC ! ----------------------------------------------------------------------------------- - ! leaf biomass + currentCohort%bl = currentCohort%bl - currentCohort%leaf_md*hlm_freq_day - - ! fine-root biomass currentcohort%br = currentcohort%br - currentCohort%root_md*hlm_freq_day - - ! sapwood biomass loss currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md*hlm_freq_day - - ! structural biomass loss currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md*hlm_freq_day - - ! storage biomass loss currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md*hlm_freq_day @@ -1030,10 +1037,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if( currentCohort%carbon_balance < 0.0_r8 ) then - store_flux = -currentCohort%carbon_balance - currentCohort%carbon_balance = currentCohort%carbon_balance + store_flux - currentCohort%bstore = currentCohort%bstore - store_flux - currentCohort%npp_store = currentCohort%npp_store - store_flux * hlm_freq_day + bstore_flux = -currentCohort%carbon_balance + currentCohort%carbon_balance = currentCohort%carbon_balance + bstore_flux + currentCohort%bstore = currentCohort%bstore - bstore_flux + currentCohort%npp_store = currentCohort%npp_store - bstore_flux * hlm_freq_day ! We have pushed to net-zero carbon, the rest of this routine can be ignored return end if @@ -1049,15 +1056,15 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if(total_turnover_demand>0.0_r8)then - leaf_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux - currentCohort%bl = currentCohort%bl + leaf_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day + bl_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day - froot_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux - currentCohort%br = currentCohort%br + froot_flux - currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day + br_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day end if @@ -1065,12 +1072,13 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! VI(c). If carbon is still available, prioritize some allocation to storage ! ----------------------------------------------------------------------------------- + store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft)) - store_flux = currentCohort%carbon_balance * & + bstore_flux = currentCohort%carbon_balance * & max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) - currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux - currentCohort%bstore = currentCohort%bstore + store_flux - currentCohort%npp_store = currentCohort%npp_store + store_flux * hlm_freq_day + currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_store = currentCohort%npp_store + bstore_flux * hlm_freq_day ! ----------------------------------------------------------------------------------- @@ -1084,15 +1092,15 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if(total_turnover_demand>0.0_r8)then - leaf_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux - currentCohort%bl = currentCohort%bl + leaf_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day + bl_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day - froot_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux - currentCohort%br = currentCohort%br + froot_flux - currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day + br_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) + currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day end if @@ -1101,58 +1109,67 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! pools back towards allometry ! ----------------------------------------------------------------------------------- + if(abs(currentCohort%carbon_balance) 0.0_r8 .and. total_below_target>0.0_r8) then - - leaf_flux = min(leaf_below_target, & - currentCohort%carbon_balance * leaf_below_target/total_below_target) - froot_flux = min(froot_below_target, & - currentCohort%carbon_balance * froot_below_target/total_below_target) - sap_flux = min(sap_below_target, & - currentCohort%carbon_balance * sap_below_target/total_below_target) - store_flux = min(store_below_target, & - currentCohort%carbon_balance * store_below_target/total_below_target) + if ( total_below_target>0.0_r8) then + + if( total_below_target > currentCohort%carbon_balance) then + bl_flux = currentCohort%carbon_balance * leaf_below_target/total_below_target + br_flux = currentCohort%carbon_balance * froot_below_target/total_below_target + bsw_flux = currentCohort%carbon_balance * sap_below_target/total_below_target + bstore_flux = currentCohort%carbon_balance * store_below_target/total_below_target + else + bl_flux = leaf_below_target + br_flux = froot_below_target + bsw_flux = sap_below_target + bstore_flux = store_below_target + end if - print*,leaf_flux,froot_flux,sap_flux,sap_below_target ,store_flux,total_below_target + print*,"leaf live targetting:",leaf_below_target,bt_leaf,currentCohort%bl,total_below_target,currentCohort%carbon_balance - currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_flux - currentCohort%bl = currentCohort%bl + leaf_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_flux * hlm_freq_day + currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day - currentCohort%carbon_balance = currentCohort%carbon_balance - froot_flux - currentCohort%br = currentCohort%br + froot_flux - currentCohort%npp_froot = currentCohort%npp_froot + froot_flux * hlm_freq_day + currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day - currentCohort%carbon_balance = currentCohort%carbon_balance - sap_flux - currentCohort%bsw = currentCohort%bsw + sap_flux - currentCohort%npp_bsw = currentCohort%npp_bsw + sap_flux * hlm_freq_day + currentCohort%carbon_balance = currentCohort%carbon_balance - bsw_flux + currentCohort%bsw = currentCohort%bsw + bsw_flux + currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux * hlm_freq_day - currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux - currentCohort%bstore = currentCohort%bstore + store_flux - currentCohort%npp_store = currentCohort%npp_store + store_flux * hlm_freq_day + currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_store = currentCohort%npp_store + bstore_flux * hlm_freq_day end if - + + print*,"REMAINING CARBON:",currentCohort%carbon_balance,bl_flux,br_flux,bsw_flux,bstore_flux + ! ----------------------------------------------------------------------------------- ! V(f). If carbon is still available, replenish the structural pool to get ! back on allometry ! ----------------------------------------------------------------------------------- + if(abs(currentCohort%carbon_balance) 0.0_r8 .and. dead_below_target>0.0_r8) then - dead_flux = min(currentCohort%carbon_balance,dead_below_target) - currentCohort%carbon_balance = currentCohort%carbon_balance - dead_flux - currentCohort%bdead = currentCohort%bdead + dead_flux - currentCohort%npp_bdead = currentCohort%npp_bdead + dead_flux * hlm_freq_day + bdead_flux = min(currentCohort%carbon_balance,dead_below_target) + currentCohort%carbon_balance = currentCohort%carbon_balance - bdead_flux + currentCohort%bdead = currentCohort%bdead + bdead_flux + currentCohort%npp_bdead = currentCohort%npp_bdead + bdead_flux * hlm_freq_day end if @@ -1162,79 +1179,150 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! V(e). If carbon is yet still available ... ! Our pools are now on allometry, and we can increment all pools ! including structure and reproduction according to their rates + ! Use an adaptive euler integration. If the error is not nominal, + ! the carbon balance sub-step (deltaC) will be halved and tried again ! ----------------------------------------------------------------------------------- - if (currentCohort%carbon_balance > 0._r8 ) then - - ! fraction of carbon going towards reproduction - if (currentCohort%dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) - else - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) - end if - - dbt_total_dd = dbt_leaf_dd + dbt_fineroot_dd + dbt_sap_dd + dbt_dead_dd + dbt_store_dd + if(abs(currentCohort%carbon_balance) 0.0 ) + + call bleaf(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) + call bfineroot(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) + call bsap_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) + call bagw_allom(dbh_sub,ipft,bt_agw,dbt_agw_dd) + call bbgw_allom(dbh_sub,ipft,bt_bgw,dbt_bgw_dd) + call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) + dbt_store_dd = dbt_leaf_dd * EDPftvarcon_inst%cushion(ipft) + + ! fraction of carbon going towards reproduction + if (dbh_sub <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + else + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) + end if + + dbt_total_dd = dbt_leaf_dd + dbt_fineroot_dd + dbt_sap_dd + dbt_dead_dd + dbt_store_dd + + bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + brepro_flux = deltaC * repro_fraction + + ! Take a sub-step + + bl_sub = bl_sub + bl_flux + br_sub = br_sub + br_flux + bsw_sub = bsw_sub + bsw_flux + bstore_sub = bstore_sub + bstore_flux + bdead_sub = bdead_sub + bdead_flux + brepro_sub = brepro_sub + brepro_flux + + ! ----------------------------------------------------------------------------------- + ! VII. Update the diameter and height allometries if we had structural growth + ! ----------------------------------------------------------------------------------- + + dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd + + ! ------------------------------------------------------------------------------------ + ! VIII. Run a post integration test to see if our integrated quantities match + ! the diagnostic quantities. (note we do not need to pass in leaf status + ! because we would not make it to this check if we were not on allometry + ! ------------------------------------------------------------------------------------ + + totalC = totalC - deltaC + + end do - currentCohort%carbon_balance = currentCohort%carbon_balance - store_flux - currentCohort%bstore = currentCohort%bstore + store_flux - currentCohort%npp_store = currentCohort%npp_bsw + store_flux * hlm_freq_day - - currentCohort%carbon_balance = currentCohort%carbon_balance - dead_flux - currentCohort%bdead = currentCohort%bdead + dead_flux - currentCohort%npp_store = currentCohort%npp_bdead + dead_flux * hlm_freq_day - - currentCohort%carbon_balance = currentCohort%carbon_balance - repro_flux - currentCohort%npp_bseed = currentCohort%npp_bseed + repro_flux * hlm_freq_day - currentCohort%seed_prod = repro_flux * hlm_freq_day - - ! ----------------------------------------------------------------------------------- - ! VII. Update the diameter and height allometries if we had structural growth - ! ----------------------------------------------------------------------------------- + call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & + bl_sub,br_sub,bsw_sub,bdead_sub,ierr) - currentCohort%dbh = currentCohort%dbh + dead_flux / dbt_dead_dd - call h_allom(currentCohort%dbh,ipft,currentCohort%hite) - - - ! ------------------------------------------------------------------------------------ - ! VIII. Run a post integration test to see if our integrated quantities match - ! the diagnostic quantities. (note we do not need to pass in leaf status - ! because we would not make it to this check if we were not on allometry - ! ------------------------------------------------------------------------------------ + if(ierr.eq.0) then - call check_integrated_allometries(currentCohort%dbh,ipft,currentCohort%canopy_trim, & - currentCohort%bl,currentCohort%br, & - currentCohort%bsw,currentCohort%bdead) + ! Reset this value for diagnostic + totalC = currentCohort%carbon_balance + + bl_flux = bl_sub - currentCohort%bl + currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day + + br_flux = br_sub - currentCohort%br + currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day + + bsw_flux = bsw_sub - currentCohort%bsw + currentCohort%carbon_balance = currentCohort%carbon_balance - bsw_flux + currentCohort%bsw = currentCohort%bsw + bsw_flux + currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux * hlm_freq_day + + bstore_flux = bstore_sub - currentCohort%bstore + currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_store = currentCohort%npp_bsw + bstore_flux * hlm_freq_day + + bdead_flux = bdead_sub - currentCohort%bdead + currentCohort%carbon_balance = currentCohort%carbon_balance - bdead_flux + currentCohort%bdead = currentCohort%bdead + bdead_flux + currentCohort%npp_store = currentCohort%npp_bdead + bdead_flux * hlm_freq_day + currentCohort%carbon_balance = currentCohort%carbon_balance - brepro_sub + currentCohort%npp_bseed = currentCohort%npp_bseed + brepro_sub * hlm_freq_day + currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub * hlm_freq_day - end if - + currentCohort%dbh = dbh_sub + + call h_allom(currentCohort%dbh,ipft,currentCohort%hite) + + if( abs(currentCohort%carbon_balance)>1e-12_r8 ) then + write(fates_log(),*) 'carbon conservation error while integrating pools' + write(fates_log(),*) 'along alometric curve' + write(fates_log(),*) 'currentCohort%carbon_balance = ',currentCohort%carbon_balance + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + else + + deltaC = 0.5*deltaC + + end if + + end do + + print*,deltaC/totalC + ! If the cohort has grown, it is not new currentCohort%isnew=.false. - + return end subroutine PlantGrowth diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 29f9832ef1..4089b7e008 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -106,7 +106,7 @@ module FatesAllometryMod public :: bfineroot ! Generic actual fine root biomass wrapper public :: bdead_allom ! Generic bdead wrapper public :: carea_allom ! Generic crown area wrapper - public :: check_integrated_allometries + public :: CheckIntegratedAllometries character(len=*), parameter :: sourcefile = __FILE__ @@ -131,7 +131,7 @@ module FatesAllometryMod ! Check to make sure Martinez-Cano height cap is not on, or explicitly allowed - subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) + subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ierr) ! This routine checks the error on the carbon allocation ! integration step. The integrated quantities should @@ -148,6 +148,7 @@ subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) real(r8),intent(in) :: bfr ! integrated fine root biomass [kgC] real(r8),intent(in) :: bsap ! integrated sapwood biomass [kgC] real(r8),intent(in) :: bdead ! integrated structural biomass [kgc] + integer,intent(out) :: ierr ! Error flag (0=pass, 1=fail) real(r8) :: height ! diagnosed height [m] real(r8) :: bl_diag ! diagnosed leaf biomass [kgC] @@ -157,9 +158,10 @@ subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) real(r8) :: bagw_diag ! diagnosed agbw [kgC] real(r8) :: bbgw_diag ! diagnosed below ground wood [kgC] - real(r8) :: relative_err_thresh = 1.0e-3_r8 + real(r8) :: relative_err_thresh = 1.0e-4_r8 + + ierr = 0 - call h_allom(dbh,ipft,height) call bleaf(dbh,height,ipft,canopy_trim,bl_diag) call bfineroot(dbh,height,ipft,canopy_trim,bfr_diag) @@ -174,8 +176,10 @@ subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) write(fates_log(),*) 'bl (integrated): ',bl write(fates_log(),*) 'bl (diagnosed): ',bl_diag write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + print*,'bl relative error: ',abs(bl_diag-bl)/bl_diag +! write(fates_log(),*) 'exiting' +! call endrun(msg=errMsg(sourcefile, __LINE__)) + ierr = 1 end if if( abs(bfr_diag-bfr)/bfr_diag > relative_err_thresh ) then @@ -184,8 +188,10 @@ subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) write(fates_log(),*) 'bfr (integrated): ',bfr write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + print*,'bfr relative error: ',abs(bfr_diag-bfr)/bfr_diag +! write(fates_log(),*) 'exiting' +! call endrun(msg=errMsg(sourcefile, __LINE__)) + ierr = 1 end if if( abs(bsap_diag-bsap)/bsap_diag > relative_err_thresh ) then @@ -194,8 +200,10 @@ subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) write(fates_log(),*) 'bsap (integrated): ',bsap write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + print*,'bsap relative error: ',abs(bsap_diag-bsap)/bsap_diag +! write(fates_log(),*) 'exiting' +! call endrun(msg=errMsg(sourcefile, __LINE__)) + ierr = 1 end if if( abs(bdead_diag-bdead)/bdead_diag > relative_err_thresh ) then @@ -204,12 +212,14 @@ subroutine check_integrated_allometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead) write(fates_log(),*) 'bdead (integrated): ',bdead write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + print*,'bdead relative error: ',abs(bdead_diag-bdead)/bdead_diag +! write(fates_log(),*) 'exiting' +! call endrun(msg=errMsg(sourcefile, __LINE__)) + ierr = 1 end if return - end subroutine check_integrated_allometries + end subroutine CheckIntegratedAllometries From 7c4714f268eda3a3391234c9969bd74a3dd92507 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 29 Nov 2017 11:56:59 -0800 Subject: [PATCH 045/111] Allocation - bug fixes to new implementation --- biogeochem/EDCohortDynamicsMod.F90 | 12 +-- biogeochem/EDPhysiologyMod.F90 | 142 +++++++++++++++++------------ biogeochem/FatesAllometryMod.F90 | 8 +- 3 files changed, 95 insertions(+), 67 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 43e949f5d6..aaf5f70acf 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -378,12 +378,12 @@ subroutine zero_cohort(cc_p) currentCohort%lmort_logging = 0._r8 currentCohort%lmort_infra = 0._r8 currentCohort%lmort_collateral = 0._r8 - ! currentCohort%npp_leaf = 0._r8 - ! currentCohort%npp_froot = 0._r8 - ! currentCohort%npp_bsw = 0._r8 - ! currentCohort%npp_bdead = 0._r8 - ! currentCohort%npp_bseed = 0._r8 - ! currentCohort%npp_store = 0._r8 + currentCohort%npp_leaf = 0._r8 + currentCohort%npp_froot = 0._r8 + currentCohort%npp_bsw = 0._r8 + currentCohort%npp_bdead = 0._r8 + currentCohort%npp_bseed = 0._r8 + currentCohort%npp_store = 0._r8 end subroutine zero_cohort diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 32bbc5248e..3c5e96828a 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -790,9 +790,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: total_below_target ! total biomass below the allometric target [kgC] real(r8) :: bstore_flux ! carbon fluxing into storage [kgC] - real(r8) :: bl_flux ! carbon fluxing into leaves [kgC] - real(r8) :: br_flux ! carbon fluxing into fineroots [kgC] - real(r8) :: bsw_flux ! carbon fluxing into sapwood [kgC] + real(r8) :: bl_flux ! carbon fluxing into leaves [kgC] + real(r8) :: br_flux ! carbon fluxing into fineroots [kgC] + real(r8) :: bsw_flux ! carbon fluxing into sapwood [kgC] real(r8) :: bdead_flux ! carbon fluxing into structure [kgC] real(r8) :: brepro_flux ! carbon fluxing into reproductive tissues [kgC] @@ -822,8 +822,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! THIS NEEDS A PFT VARIABLE, OR LIKE OTHER POOLS SHOULD BE HOOKED INTO THE DISTURBANCE ALGORITHM ! RGK 11-2017 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(r8), parameter :: background_woody_turnover = 20.0_r8 - logical, parameter :: do_wood_turnover = .false. + real(r8), parameter :: background_woody_turnover = 0.0_r8 real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ipft = currentCohort%pft @@ -872,8 +871,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%carbon_balance = currentCohort%npp_acc - print*," currentCohort%carbon_balance: ", currentCohort%carbon_balance - ! ----------------------------------------------------------------------------------- ! II. Calculate target size of living biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- @@ -881,8 +878,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Target leaf biomass according to allometry and trimming call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) - print*,"currentcohort%status_coh: ", currentcohort%status_coh - ! If status_coh is 1, then leaves are in a dropped (off allometry) if( currentcohort%status_coh == 1 ) then bt_leaf = 0.0_r8 @@ -905,11 +900,13 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) - ! ----------------------------------------------------------------------------------- ! III. If fusion pushed a plant off allometry, we could have negatives ! here. We allow negative deficits to push carbon downward too, and we take ! that carbon back into the carbon flux pool + ! Note that since this is a carbon conservative process, ie has nothing to + ! do with NPP, and because the values are hopefully small, we do not + ! track these npp partition diagnostics. ! ----------------------------------------------------------------------------------- leaf_below_target = bt_leaf - currentCohort%bl @@ -918,46 +915,51 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) store_below_target = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore dead_below_target = bt_dead - currentCohort%bdead + print*,"leaf III", bt_leaf , currentCohort%bl + print*,"fr III", bt_fineroot , currentCohort%br + print*,"sap III", bt_sap , currentCohort%bsw + print*,"store III",bt_leaf * EDPftvarcon_inst%cushion(ipft) , currentCohort%bstore + + if(leaf_below_target<0.0_r8) then currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_below_target currentCohort%bl = currentCohort%bl + leaf_below_target - currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_below_target * hlm_freq_day - leaf_below_target = 0.0_r8 + currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_below_target / hlm_freq_day end if if(froot_below_target<0.0_r8) then currentCohort%carbon_balance = currentCohort%carbon_balance - froot_below_target currentCohort%br = currentCohort%br + froot_below_target - currentCohort%npp_froot = currentCohort%npp_froot + froot_below_target * hlm_freq_day - froot_below_target = 0.0_r8 + currentCohort%npp_froot = currentCohort%npp_froot + froot_below_target / hlm_freq_day end if if(sap_below_target<0.0_r8) then currentCohort%carbon_balance = currentCohort%carbon_balance - sap_below_target - currentCohort%bsw = currentCohort%bsw + sap_below_target - currentCohort%npp_bsw = currentCohort%npp_bsw + sap_below_target * hlm_freq_day - sap_below_target = 0.0_r8 + currentCohort%bsw = currentCohort%bsw + sap_below_target + currentCohort%npp_bsw = currentCohort%npp_bsw + sap_below_target / hlm_freq_day end if if(store_below_target<0.0_r8) then currentCohort%carbon_balance = currentCohort%carbon_balance - store_below_target currentCohort%bstore = currentCohort%bstore + store_below_target - currentCohort%npp_store = currentCohort%npp_store + store_below_target * hlm_freq_day - store_below_target = 0.0_r8 + currentCohort%npp_store = currentCohort%npp_store + store_below_target / hlm_freq_day end if if(dead_below_target<0.0_r8) then currentCohort%carbon_balance = currentCohort%carbon_balance - dead_below_target currentCohort%bdead = currentCohort%bdead + dead_below_target - currentCohort%npp_bdead = currentCohort%npp_bdead + dead_below_target * hlm_freq_day - store_below_target = 0.0_r8 + currentCohort%npp_bdead = currentCohort%npp_bdead + dead_below_target / hlm_freq_day end if + print*,"leaf IIIb", bt_leaf - currentCohort%bl + print*,"fr IIIb", bt_fineroot - currentCohort%br + print*,"sap IIIb", bt_sap - currentCohort%bsw + print*,"store IIIb",bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore ! ----------------------------------------------------------------------------------- ! IV(a). Calculate the maintenance turnover demands ! Pre-check, make sure phenology is mutually exclusive and at least one chosen - ! (MOVE THIS TO THE PARAMETER READ-IN) + ! (MOVE THIS TO THE PARAMETER READ-IN SECTION) ! ----------------------------------------------------------------------------------- if (EDPftvarcon_inst%evergreen(ipft) == 1) then @@ -989,9 +991,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! IV(b). Calculate the maintenance turnover demands ! NOTE(RGK): If branches are falling all year, even on deciduous trees, we should ! be pulling some leaves with them when leaves are out... + ! + ! If the turnover time-scales are zero, that means there is no turnover. + ! ! ----------------------------------------------------------------------------------- - if ( do_wood_turnover ) then + if ( background_woody_turnover > tiny(background_woody_turnover) ) then currentCohort%bsw_md = currentCohort%bsw / background_woody_turnover currentCohort%bdead_md = currentCohort%bdead / background_woody_turnover currentCohort%bstore_md = currentCohort%bstore / background_woody_turnover @@ -1031,16 +1036,22 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md*hlm_freq_day + print*,"leaf V", bt_leaf , currentCohort%bl + print*,"fr V", bt_fineroot , currentCohort%br + print*,"sap V", bt_sap , currentCohort%bsw + print*,"store V",bt_leaf * EDPftvarcon_inst%cushion(ipft) , currentCohort%bstore + print*,"cbal V", currentCohort%carbon_balance + ! ----------------------------------------------------------------------------------- ! VI(a) if carbon balance is negative, re-coup the losses from storage ! ----------------------------------------------------------------------------------- - + if( currentCohort%carbon_balance < 0.0_r8 ) then - bstore_flux = -currentCohort%carbon_balance - currentCohort%carbon_balance = currentCohort%carbon_balance + bstore_flux - currentCohort%bstore = currentCohort%bstore - bstore_flux - currentCohort%npp_store = currentCohort%npp_store - bstore_flux * hlm_freq_day + bstore_flux = currentCohort%carbon_balance + currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day ! We have pushed to net-zero carbon, the rest of this routine can be ignored return end if @@ -1050,8 +1061,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! VI(b). Prioritize some amount of carbon to replace leaf/root turnover ! ----------------------------------------------------------------------------------- - leaf_turnover_demand = currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(ipft)/hlm_freq_day - root_turnover_demand = currentCohort%root_md*EDPftvarcon_inst%leaf_stor_priority(ipft)/hlm_freq_day + leaf_turnover_demand = currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(ipft)*hlm_freq_day + root_turnover_demand = currentCohort%root_md*EDPftvarcon_inst%leaf_stor_priority(ipft)*hlm_freq_day total_turnover_demand = leaf_turnover_demand + root_turnover_demand if(total_turnover_demand>0.0_r8)then @@ -1059,26 +1070,30 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) bl_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day br_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day + currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day end if - + print*,"leaf VI", bt_leaf , currentCohort%bl + print*,"fr VI", bt_fineroot , currentCohort%br + print*,"sap VI", bt_sap , currentCohort%bsw + print*,"store VI",bt_leaf * EDPftvarcon_inst%cushion(ipft) , currentCohort%bstore + print*,"cbal VI", currentCohort%carbon_balance ! ----------------------------------------------------------------------------------- ! VI(c). If carbon is still available, prioritize some allocation to storage ! ----------------------------------------------------------------------------------- - + store_below_target = max(bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore,0.0_r8) store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft)) - bstore_flux = currentCohort%carbon_balance * & - max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8) + bstore_flux = min(store_below_target,currentCohort%carbon_balance * & + max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_store = currentCohort%npp_store + bstore_flux * hlm_freq_day + currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day ! ----------------------------------------------------------------------------------- @@ -1086,8 +1101,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! the rest of the leaf/fineroot turnover demand ! ----------------------------------------------------------------------------------- - leaf_turnover_demand = currentCohort%leaf_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))/hlm_freq_day - root_turnover_demand = currentCohort%root_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))/hlm_freq_day + leaf_turnover_demand = currentCohort%leaf_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day + root_turnover_demand = currentCohort%root_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day total_turnover_demand = leaf_turnover_demand + root_turnover_demand if(total_turnover_demand>0.0_r8)then @@ -1095,17 +1110,17 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) bl_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day br_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day + currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day end if ! ----------------------------------------------------------------------------------- - ! V(e). If carbon is still available, we try to push all live + ! VII(e). If carbon is still available, we try to push all live ! pools back towards allometry ! ----------------------------------------------------------------------------------- @@ -1117,6 +1132,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) store_below_target = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore total_below_target = leaf_below_target + froot_below_target + sap_below_target + store_below_target + print*,"leaf", bt_leaf , currentCohort%bl + print*,"fr", bt_fineroot , currentCohort%br + print*,"sap", bt_sap , currentCohort%bsw + print*,"store",bt_leaf * EDPftvarcon_inst%cushion(ipft) , currentCohort%bstore + + if ( total_below_target>0.0_r8) then if( total_below_target > currentCohort%carbon_balance) then @@ -1136,23 +1157,23 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day + currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day currentCohort%carbon_balance = currentCohort%carbon_balance - bsw_flux currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux * hlm_freq_day + currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux / hlm_freq_day currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_store = currentCohort%npp_store + bstore_flux * hlm_freq_day + currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day end if - print*,"REMAINING CARBON:",currentCohort%carbon_balance,bl_flux,br_flux,bsw_flux,bstore_flux + print*,"REMAINING CARBON:",total_below_target,currentCohort%carbon_balance,bl_flux,br_flux,bsw_flux,bstore_flux ! ----------------------------------------------------------------------------------- @@ -1169,7 +1190,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) bdead_flux = min(currentCohort%carbon_balance,dead_below_target) currentCohort%carbon_balance = currentCohort%carbon_balance - bdead_flux currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_bdead = currentCohort%npp_bdead + bdead_flux * hlm_freq_day + currentCohort%npp_bdead = currentCohort%npp_bdead + bdead_flux / hlm_freq_day end if @@ -1204,10 +1225,15 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call bleaf(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) print*,"leaf comparison:",currentCohort%bl,bt_leaf + print*,"root comparison:",currentCohort%br,bt_fineroot + print*,"sap comparison:",currentCohort%bsw,bt_sap + print*,"store comparison:",currentCohort%bstore,bt_leaf*EDPftvarcon_inst%cushion(ipft) + print*,"dead comparison:",currentCohort%bdead,bt_dead + print*,deltaC,totalC - do while ( totalC > 0.0 ) + do while ( totalC > tiny(totalC) ) call bleaf(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) call bfineroot(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) @@ -1270,34 +1296,36 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) bl_flux = bl_sub - currentCohort%bl currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux * hlm_freq_day + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day br_flux = br_sub - currentCohort%br currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux * hlm_freq_day + currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day bsw_flux = bsw_sub - currentCohort%bsw currentCohort%carbon_balance = currentCohort%carbon_balance - bsw_flux currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux * hlm_freq_day + currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux / hlm_freq_day bstore_flux = bstore_sub - currentCohort%bstore currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_store = currentCohort%npp_bsw + bstore_flux * hlm_freq_day + currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day bdead_flux = bdead_sub - currentCohort%bdead currentCohort%carbon_balance = currentCohort%carbon_balance - bdead_flux currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_store = currentCohort%npp_bdead + bdead_flux * hlm_freq_day + currentCohort%npp_bdead = currentCohort%npp_bdead + bdead_flux / hlm_freq_day currentCohort%carbon_balance = currentCohort%carbon_balance - brepro_sub - currentCohort%npp_bseed = currentCohort%npp_bseed + brepro_sub * hlm_freq_day - currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub * hlm_freq_day + currentCohort%npp_bseed = currentCohort%npp_bseed + brepro_sub / hlm_freq_day + currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day + currentCohort%dbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day currentCohort%dbh = dbh_sub - + + call h_allom(currentCohort%dbh,ipft,currentCohort%hite) if( abs(currentCohort%carbon_balance)>1e-12_r8 ) then diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 4089b7e008..05ce953e5d 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -176,7 +176,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier write(fates_log(),*) 'bl (integrated): ',bl write(fates_log(),*) 'bl (diagnosed): ',bl_diag write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag - print*,'bl relative error: ',abs(bl_diag-bl)/bl_diag +! print*,'bl relative error: ',abs(bl_diag-bl)/bl_diag ! write(fates_log(),*) 'exiting' ! call endrun(msg=errMsg(sourcefile, __LINE__)) ierr = 1 @@ -188,7 +188,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier write(fates_log(),*) 'bfr (integrated): ',bfr write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag - print*,'bfr relative error: ',abs(bfr_diag-bfr)/bfr_diag +! print*,'bfr relative error: ',abs(bfr_diag-bfr)/bfr_diag ! write(fates_log(),*) 'exiting' ! call endrun(msg=errMsg(sourcefile, __LINE__)) ierr = 1 @@ -200,7 +200,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier write(fates_log(),*) 'bsap (integrated): ',bsap write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag - print*,'bsap relative error: ',abs(bsap_diag-bsap)/bsap_diag +! print*,'bsap relative error: ',abs(bsap_diag-bsap)/bsap_diag ! write(fates_log(),*) 'exiting' ! call endrun(msg=errMsg(sourcefile, __LINE__)) ierr = 1 @@ -212,7 +212,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier write(fates_log(),*) 'bdead (integrated): ',bdead write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag - print*,'bdead relative error: ',abs(bdead_diag-bdead)/bdead_diag +! print*,'bdead relative error: ',abs(bdead_diag-bdead)/bdead_diag ! write(fates_log(),*) 'exiting' ! call endrun(msg=errMsg(sourcefile, __LINE__)) ierr = 1 From 06d385a116e04dc5fa59d8356768b2dd1f35874f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 29 Nov 2017 11:57:39 -0800 Subject: [PATCH 046/111] Allocation - bug fixes to new implementation --- biogeochem/EDPhysiologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 3c5e96828a..5f539e5cde 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1322,7 +1322,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_bseed = currentCohort%npp_bseed + brepro_sub / hlm_freq_day currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day - currentCohort%dbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day + currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day currentCohort%dbh = dbh_sub From 0487cb6eb84c2d0386d2afad73eb7686428bd586 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 29 Nov 2017 21:48:07 -0800 Subject: [PATCH 047/111] Allocation: v1 working version, minor fixes in this commit, including eulerian integrator control. --- biogeochem/EDCanopyStructureMod.F90 | 2 - biogeochem/EDCohortDynamicsMod.F90 | 8 --- biogeochem/EDPhysiologyMod.F90 | 103 ++++++++++++---------------- main/EDTypesMod.F90 | 3 - main/FatesHistoryInterfaceMod.F90 | 4 +- 5 files changed, 45 insertions(+), 75 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index d575fbaddb..716b071ae1 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1223,8 +1223,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) !Bottom layer iv = currentCohort%NV ! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. - print*,currentCohort%hite,iv,currentCohort%NV,currentCohort%treelai,currentCohort%treesai,currentCohort%bl - print*,EDPftvarcon_inst%crown(currentCohort%pft) layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & EDPftvarcon_inst%crown(currentCohort%pft) ) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index aaf5f70acf..5a2dc2514b 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -156,8 +156,6 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%lai = new_cohort%treelai * new_cohort%c_area/patchptr%area new_cohort%treesai = 0.0_r8 !FIX(RF,032414) - print*,"NEW COHORT:",new_cohort%treelai,new_cohort%bl - ! Put cohort at the right place in the linked list storebigcohort => patchptr%tallest storesmallcohort => patchptr%shortest @@ -313,7 +311,6 @@ subroutine nan_cohort(cc_p) currentCohort%ddbhdt = nan ! time derivative of dbh currentCohort%dbdeaddt = nan ! time derivative of dead biomass currentCohort%dbstoredt = nan ! time derivative of stored biomass - currentCohort%storage_flux = nan ! flux from npp into bstore ! FIRE currentCohort%cfa = nan ! proportion of crown affected by fire @@ -371,7 +368,6 @@ subroutine zero_cohort(cc_p) currentcohort%bdead_md = 0._r8 currentcohort%npp_acc_hold = 0._r8 currentcohort%gpp_acc_hold = 0._r8 - currentcohort%storage_flux = 0._r8 currentcohort%dmort = 0._r8 currentcohort%gscan = 0._r8 currentcohort%treesai = 0._r8 @@ -721,8 +717,6 @@ subroutine fuse_cohorts(patchptr, bc_in) nextc%n*nextc%bdead_md)/newn currentCohort%carbon_balance = (currentCohort%n*currentCohort%carbon_balance + & nextc%n*nextc%carbon_balance)/newn - currentCohort%storage_flux = (currentCohort%n*currentCohort%storage_flux + & - nextc%n*nextc%storage_flux)/newn currentCohort%gpp_acc = (currentCohort%n*currentCohort%gpp_acc + & nextc%n*nextc%gpp_acc)/newn currentCohort%npp_acc = (currentCohort%n*currentCohort%npp_acc + & @@ -1165,8 +1159,6 @@ subroutine copy_cohort( currentCohort,copyc ) if ( DEBUG ) write(fates_log(),*) 'EDCohortDyn dpstoredt ',o%dbstoredt - n%storage_flux = o%storage_flux - ! FIRE n%cfa = o%cfa n%fire_mort = o%fire_mort diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 5f539e5cde..4c2957bb21 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -806,6 +806,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! integrator variables real(r8) :: deltaC ! trial value for substep integer :: ierr ! error flag for allometric growth step + integer :: nsteps ! number of sub-steps + integer :: istep ! current substep index real(r8) :: totalC ! total carbon allocated over alometric growth step real(r8) :: dbh_sub ! substep dbh real(r8) :: h_sub ! substep h @@ -819,14 +821,19 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Woody turnover timescale [years] ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! THIS NEEDS A PFT VARIABLE, OR LIKE OTHER POOLS SHOULD BE HOOKED INTO THE DISTURBANCE ALGORITHM + ! THIS NEEDS A PFT VARIABLE, OR LIKE OTHER POOLS COULD + ! BE HOOKED INTO THE DISTURBANCE ALGORITHM OR BE DYNAMIC ! RGK 11-2017 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(r8), parameter :: background_woody_turnover = 0.0_r8 real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance + integer , parameter :: max_substeps = 16 ipft = currentCohort%pft + ! Initialize seed production + currentCohort%seed_prod = 0.0_r8 + ! Initialize NPP flux diagnostics currentCohort%npp_store = 0.0_r8 currentCohort%npp_leaf = 0.0_r8 @@ -835,6 +842,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_bseed = 0.0_r8 currentCohort%npp_bsw = 0.0_r8 + ! Initialize rates of change + currentCohort%dhdt = 0.0_r8 + currentCohort%dbdeaddt = 0.0_r8 + currentCohort%dbstoredt = 0.0_r8 + currentCohort%ddbhdt = 0.0_r8 + ! ----------------------------------------------------------------------------------- ! I. Identify the net carbon gain for this dynamics interval ! Set the available carbon pool, identify allocation portions, and decrement @@ -915,11 +928,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) store_below_target = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore dead_below_target = bt_dead - currentCohort%bdead - print*,"leaf III", bt_leaf , currentCohort%bl - print*,"fr III", bt_fineroot , currentCohort%br - print*,"sap III", bt_sap , currentCohort%bsw - print*,"store III",bt_leaf * EDPftvarcon_inst%cushion(ipft) , currentCohort%bstore - if(leaf_below_target<0.0_r8) then currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_below_target @@ -951,10 +959,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_bdead = currentCohort%npp_bdead + dead_below_target / hlm_freq_day end if - print*,"leaf IIIb", bt_leaf - currentCohort%bl - print*,"fr IIIb", bt_fineroot - currentCohort%br - print*,"sap IIIb", bt_sap - currentCohort%bsw - print*,"store IIIb",bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore ! ----------------------------------------------------------------------------------- ! IV(a). Calculate the maintenance turnover demands @@ -1036,12 +1040,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md*hlm_freq_day - print*,"leaf V", bt_leaf , currentCohort%bl - print*,"fr V", bt_fineroot , currentCohort%br - print*,"sap V", bt_sap , currentCohort%bsw - print*,"store V",bt_leaf * EDPftvarcon_inst%cushion(ipft) , currentCohort%bstore - print*,"cbal V", currentCohort%carbon_balance - ! ----------------------------------------------------------------------------------- ! VI(a) if carbon balance is negative, re-coup the losses from storage ! ----------------------------------------------------------------------------------- @@ -1078,12 +1076,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day end if - print*,"leaf VI", bt_leaf , currentCohort%bl - print*,"fr VI", bt_fineroot , currentCohort%br - print*,"sap VI", bt_sap , currentCohort%bsw - print*,"store VI",bt_leaf * EDPftvarcon_inst%cushion(ipft) , currentCohort%bstore - print*,"cbal VI", currentCohort%carbon_balance - ! ----------------------------------------------------------------------------------- ! VI(c). If carbon is still available, prioritize some allocation to storage ! ----------------------------------------------------------------------------------- @@ -1124,7 +1116,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! pools back towards allometry ! ----------------------------------------------------------------------------------- - if(abs(currentCohort%carbon_balance)0.0_r8) then if( total_below_target > currentCohort%carbon_balance) then @@ -1152,9 +1138,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) bstore_flux = store_below_target end if - print*,"leaf live targetting:",leaf_below_target,bt_leaf,currentCohort%bl,total_below_target,currentCohort%carbon_balance - - currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day @@ -1173,15 +1156,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if - print*,"REMAINING CARBON:",total_below_target,currentCohort%carbon_balance,bl_flux,br_flux,bsw_flux,bstore_flux - - ! ----------------------------------------------------------------------------------- ! V(f). If carbon is still available, replenish the structural pool to get ! back on allometry ! ----------------------------------------------------------------------------------- - if(abs(currentCohort%carbon_balance) tiny(totalC) ) + do istep=1,nsteps call bleaf(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) call bfineroot(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) @@ -1273,6 +1243,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd + call h_allom(dbh_sub,ipft,h_sub) ! ------------------------------------------------------------------------------------ ! VIII. Run a post integration test to see if our integrated quantities match @@ -1283,13 +1254,19 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) totalC = totalC - deltaC end do + + if( abs(totalC)>1e-12_r8 ) then + print*,"TOTALC IS NON-ZERO,IT SHOULD BE ZERO",totalC,deltaC,tiny(totalC) + stop + end if call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & bl_sub,br_sub,bsw_sub,bdead_sub,ierr) - if(ierr.eq.0) then - + if(ierr.eq.0 .or. nsteps > max_substeps ) then + + ierr = 0 ! Reset this value for diagnostic totalC = currentCohort%carbon_balance @@ -1322,29 +1299,35 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_bseed = currentCohort%npp_bseed + brepro_sub / hlm_freq_day currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day - currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - currentCohort%dbh = dbh_sub - + ! Set derivatives used as diagnostics + currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day + currentCohort%dbdeaddt = bdead_flux/hlm_freq_day + currentCohort%dbstoredt = bstore_flux/hlm_freq_day + currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - call h_allom(currentCohort%dbh,ipft,currentCohort%hite) + currentCohort%dbh = dbh_sub + currentCohort%hite = h_sub if( abs(currentCohort%carbon_balance)>1e-12_r8 ) then write(fates_log(),*) 'carbon conservation error while integrating pools' write(fates_log(),*) 'along alometric curve' - write(fates_log(),*) 'currentCohort%carbon_balance = ',currentCohort%carbon_balance + write(fates_log(),*) 'currentCohort%carbon_balance = ',currentCohort%carbon_balance,totalC write(fates_log(),*) 'exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if + + else - deltaC = 0.5*deltaC + deltaC = 0.5_r8*deltaC + nsteps = nsteps*2 end if end do - - print*,deltaC/totalC + +! if(deltaC/totalC < 1.0_r8 )print*,deltaC/totalC ! If the cohort has grown, it is not new diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index d5eaba7027..6ade9f99e0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -3,7 +3,6 @@ module EDTypesMod use FatesConstantsMod, only : r8 => fates_r8 use FatesGlobals, only : fates_log use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) - use FatesHydraulicsMemMod, only : ed_cohort_hydr_type use FatesHydraulicsMemMod, only : ed_patch_hydr_type use FatesHydraulicsMemMod, only : ed_site_hydr_type @@ -251,7 +250,6 @@ module EDTypesMod real(r8) :: ddbhdt ! time derivative of dbh : cm/year real(r8) :: dbdeaddt ! time derivative of dead biomass : KgC/year real(r8) :: dbstoredt ! time derivative of stored biomass : KgC/year - real(r8) :: storage_flux ! flux from npp into bstore : KgC/year ! FIRE real(r8) :: cfa ! proportion of crown affected by fire:- @@ -773,7 +771,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%ddbhdt = ', ccohort%ddbhdt write(fates_log(),*) 'co%dbdeaddt = ', ccohort%dbdeaddt write(fates_log(),*) 'co%dbstoredt = ', ccohort%dbstoredt - write(fates_log(),*) 'co%storage_flux = ', ccohort%storage_flux write(fates_log(),*) 'co%cfa = ', ccohort%cfa write(fates_log(),*) 'co%fire_mort = ', ccohort%fire_mort write(fates_log(),*) 'co%crownfire_mort = ', ccohort%crownfire_mort diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 4dcb7268c4..33585b66b6 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1573,7 +1573,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_dbstoredt_canopy_si_scls(io_si,scls) = hio_dbstoredt_canopy_si_scls(io_si,scls) + & 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 + 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) + & @@ -1657,7 +1657,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_dbstoredt_understory_si_scls(io_si,scls) = hio_dbstoredt_understory_si_scls(io_si,scls) + & 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 + 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) + & From a6b3089826ae1bf026830c7353932db4e29faf06 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 Nov 2017 17:02:51 -0800 Subject: [PATCH 048/111] Allocation - created PFT parameter for allom_stmode, but bypassing read until next version of parameter file is released. Added wrapper and specific function for storage allometry into allometry module. One specific function exists, the current default, where storage is scaled (cushion) off of maximum leaf biomass. --- biogeochem/EDPhysiologyMod.F90 | 22 +++-- biogeochem/FatesAllometryMod.F90 | 143 +++++++++++++++++++++++-------- main/EDInitMod.F90 | 8 +- main/EDPftvarcon.F90 | 36 ++++++-- main/FatesInventoryInitMod.F90 | 7 +- 5 files changed, 158 insertions(+), 58 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 4c2957bb21..4a87e4eca4 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -33,7 +33,7 @@ module EDPhysiologyMod use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use EDParamsMod , only : fates_mortality_disturbance_fraction - use FatesConstantsMod , only : itrue,ifalse + use FatesConstantsMod , only : itrue,ifalse use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : h2d_allom @@ -42,11 +42,13 @@ module EDPhysiologyMod use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bdead_allom + use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : CheckIntegratedAllometries + implicit none private @@ -912,6 +914,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) + ! Target storage carbon [kgC,kgC/cm] + call bstore_allom(currentCohort%dbh,currentCohort%hite,ipft, & + currentCohort%canopy_trim,bt_store,dbt_store_dd) ! ----------------------------------------------------------------------------------- ! III. If fusion pushed a plant off allometry, we could have negatives @@ -925,7 +930,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) leaf_below_target = bt_leaf - currentCohort%bl froot_below_target = bt_fineroot - currentCohort%br sap_below_target = bt_sap - currentCohort%bsw - store_below_target = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore + store_below_target = bt_store - currentCohort%bstore dead_below_target = bt_dead - currentCohort%bdead @@ -1079,8 +1084,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! VI(c). If carbon is still available, prioritize some allocation to storage ! ----------------------------------------------------------------------------------- - store_below_target = max(bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore,0.0_r8) - store_target_fraction = currentCohort%bstore/( bt_leaf * EDPftvarcon_inst%cushion(ipft)) + store_below_target = max(bt_store - currentCohort%bstore,0.0_r8) + store_target_fraction = currentCohort%bstore/bt_store bstore_flux = min(store_below_target,currentCohort%carbon_balance * & max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux @@ -1121,7 +1126,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) leaf_below_target = bt_leaf - currentCohort%bl froot_below_target = bt_fineroot - currentCohort%br sap_below_target = bt_sap - currentCohort%bsw - store_below_target = bt_leaf * EDPftvarcon_inst%cushion(ipft) - currentCohort%bstore + store_below_target = bt_store - currentCohort%bstore total_below_target = leaf_below_target + froot_below_target + sap_below_target + store_below_target if ( total_below_target>0.0_r8) then @@ -1210,8 +1215,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call bsap_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) call bagw_allom(dbh_sub,ipft,bt_agw,dbt_agw_dd) call bbgw_allom(dbh_sub,ipft,bt_bgw,dbt_bgw_dd) - call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) - dbt_store_dd = dbt_leaf_dd * EDPftvarcon_inst%cushion(ipft) + call bdead_allom(bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) + call bstore_allom(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) ! fraction of carbon going towards reproduction if (dbh_sub <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass @@ -1382,7 +1387,8 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call bbgw_allom(temp_cohort%dbh,ft,b_bgw) call bdead_allom(b_agw,b_bgw,b_sapwood,ft,temp_cohort%bdead) - temp_cohort%bstore = EDPftvarcon_inst%cushion(ft) * b_leaf + call bstore_allom(temp_cohort%dbh,temp_cohort%hite, ft, & + temp_cohort%canopy_trim,temp_cohort%bstore) 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 & diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 05ce953e5d..42f9833f0a 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -38,6 +38,7 @@ ! allom_amode, integer, AGB allometry function type ! allom_cmode, integer, coarse root allometry function type ! allom_smode, integer, sapwood allometry function type +! allom_stmode, integer, storage allometry function type ! ! The following parameters (traits) are used ! @@ -74,10 +75,6 @@ ! ! ------------------------------------------------------------------------------ ! -! -! -! -! ! Initial Implementation: Ryan Knox July 2017 ! !=============================================================================== @@ -102,14 +99,19 @@ module FatesAllometryMod public :: blmax_allom ! Generic maximum leaf biomass wrapper public :: bleaf ! Generic actual leaf biomass wrapper public :: bsap_allom ! Generic sapwood wrapper - public :: bbgw_allom ! Generic coarse root wrapper + public :: bbgw_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 + public :: bstore_allom ! Generic maximum storage carbon wrapper + public :: CheckIntegratedAllometries + + logical , parameter :: verbose_logging = .false. character(len=*), parameter :: sourcefile = __FILE__ + ! If testing b4b with older versions, do not remove sapwood ! Our old methods with saldarriaga did not remove sapwood from the ! bdead pool. But newer allometries are providing total agb @@ -171,50 +173,46 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) if( abs(bl_diag-bl)/bl_diag > relative_err_thresh ) then - write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bl (integrated): ',bl - write(fates_log(),*) 'bl (diagnosed): ',bl_diag - write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag -! print*,'bl relative error: ',abs(bl_diag-bl)/bl_diag -! write(fates_log(),*) 'exiting' -! call endrun(msg=errMsg(sourcefile, __LINE__)) + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bl (integrated): ',bl + write(fates_log(),*) 'bl (diagnosed): ',bl_diag + write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag + end if ierr = 1 end if if( abs(bfr_diag-bfr)/bfr_diag > relative_err_thresh ) then - write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bfr (integrated): ',bfr - write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag - write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag -! print*,'bfr relative error: ',abs(bfr_diag-bfr)/bfr_diag -! write(fates_log(),*) 'exiting' -! call endrun(msg=errMsg(sourcefile, __LINE__)) + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bfr (integrated): ',bfr + write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag + write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag + end if ierr = 1 end if if( abs(bsap_diag-bsap)/bsap_diag > relative_err_thresh ) then - write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bsap (integrated): ',bsap - write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag - write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag -! print*,'bsap relative error: ',abs(bsap_diag-bsap)/bsap_diag -! write(fates_log(),*) 'exiting' -! call endrun(msg=errMsg(sourcefile, __LINE__)) + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bsap (integrated): ',bsap + write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag + write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag + end if ierr = 1 end if if( abs(bdead_diag-bdead)/bdead_diag > relative_err_thresh ) then - write(fates_log(),*) 'disparity in integrated/diagnosed structural carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bdead (integrated): ',bdead - write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag - write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag -! print*,'bdead relative error: ',abs(bdead_diag-bdead)/bdead_diag -! write(fates_log(),*) 'exiting' -! call endrun(msg=errMsg(sourcefile, __LINE__)) + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed structural carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bdead (integrated): ',bdead + write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag + write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag + end if ierr = 1 end if @@ -606,6 +604,48 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfr,dbfrdd) end subroutine bfineroot + ! ============================================================================ + ! Storage biomass interface + ! ============================================================================ + + subroutine bstore_allom(d,h,ipft,canopy_trim,bstore,dbstoredd) + + 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 ! Crown trimming function [0-1] + real(r8),intent(out) :: bstore ! allometric target storage [kgC] + real(r8),intent(out),optional :: dbstoredd ! change storage per cm [kgC/cm] + + real(r8) :: bl ! Allometric target leaf biomass + real(r8) :: dbldd ! Allometric target change in leaf biomass per cm + + + ! TODO: allom_stmode needs to be added to the parameter file + + associate( allom_stmode => EDPftvarcon_inst%allom_stmode(ipft), & + cushion => EDPftvarcon_inst%cushion(ipft) ) + + select case(int(allom_stmode)) + case(1) ! Storage is constant proportionality of trimmed maximum leaf + ! biomass (ie cushion * bleaf) + + call bleaf(d,h,ipft,canopy_trim,bl,dbldd) + call bstore_blcushion(d,bl,dbldd,cushion,ipft,bstore,dbstoredd) + + case DEFAULT + write(fates_log(),*) 'An undefined fine storage allometry was specified: ', & + allom_stmode + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end associate + return + end subroutine bstore_allom + + + ! ============================================================================ ! Dead biomass interface ! ============================================================================ @@ -835,7 +875,36 @@ subroutine bsap_dlinear(d,h,dhdd,bleaf,dbleafdd,ipft,bsap,dbsapdd) end associate return end subroutine bsap_dlinear + + ! ============================================================================ + ! Specific storage relationships + ! ============================================================================ + subroutine bstore_blcushion(d,bl,dbldd,cushion,ipft,bstore,dbstoredd) + + ! This discracefully simple subroutine calculates allometric target + ! storage biomass based on a constant-specified ratio (cushion) + ! of storage to target allometricc leaf biomass + + real(r8),intent(in) :: d ! plant diameter [cm] + real(r8),intent(in) :: bl ! plant leaf biomass [kgC] + real(r8),intent(in) :: dbldd ! change in blmax per diam [kgC/cm] + real(r8),intent(in) :: cushion ! simple constant ration bstore/bleaf + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(out) :: bstore ! plant leaf biomass [kgC] + real(r8),intent(out),optional :: dbstoredd ! change leaf bio per diameter [kgC/cm] + + + bstore = bl * cushion + + if(present(dbstoredd)) then + dbstoredd = dbldd * cushion + end if + + return + end subroutine bstore_blcushion + + ! ============================================================================ ! Specific d2blmax relationships ! ============================================================================ diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 8d343489ce..44a50d1ea7 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -32,6 +32,7 @@ module EDInitMod use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bdead_allom + use FatesAllometryMod , only : bstore_allom ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -388,14 +389,16 @@ subroutine init_cohorts( patch_in, bc_in) call bdead_allom( b_agw, b_bgw, b_sapwood, pft, temp_cohort%bdead ) + call bstore_allom(temp_cohort%dbh,temp_cohort%hite, pft, & + temp_cohort%canopy_trim,temp_cohort%bstore) + + if( EDPftvarcon_inst%evergreen(pft) == 1) then - 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 = 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 @@ -406,7 +409,6 @@ subroutine init_cohorts( patch_in, bc_in) endif if ( EDPftvarcon_inst%stress_decid(pft) == 1 ) then - temp_cohort%bstore = b_leaf * EDPftvarcon_inst%cushion(pft) temp_cohort%laimemory = b_leaf cstatus = patch_in%siteptr%dstatus endif diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index c8f09739d8..9f44f2dfb2 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -107,6 +107,8 @@ module EDPftvarcon real(r8), allocatable :: allom_amode(:) ! AGB allometry function type real(r8), allocatable :: allom_cmode(:) ! Coarse root allometry function type real(r8), allocatable :: allom_smode(:) ! sapwood allometry function type + real(r8), allocatable :: allom_stmode(:) ! storage allometry functional type + ! (HARD-CODED FOR TIME BEING, RGK 11-2017) real(r8), allocatable :: allom_latosa_int(:) ! Leaf area to sap area ratio, intercept [m2/cm2] real(r8), allocatable :: allom_latosa_slp(:) ! Leaf area to sap area ratio, slope on diameter ! [m2/cm2/cm] @@ -121,19 +123,26 @@ module EDPftvarcon real(r8), allocatable :: allom_sai_scaler(:) ! real(r8), allocatable :: allom_blca_expnt_diff(:) ! Any difference in the exponent between the leaf ! biomass and crown area scaling - real(r8), allocatable :: allom_d2ca_coefficient_max(:) ! upper (savanna) value for crown area to dbh coefficient - real(r8), allocatable :: allom_d2ca_coefficient_min(:) ! lower (closed-canopy forest) value for crown area to dbh coefficient + real(r8), allocatable :: allom_d2ca_coefficient_max(:) ! upper (savanna) value for crown + ! area to dbh coefficient + real(r8), allocatable :: allom_d2ca_coefficient_min(:) ! lower (closed-canopy forest) value for crown + ! area to dbh coefficient real(r8), allocatable :: allom_agb1(:) ! Parameter 1 for agb allometry real(r8), allocatable :: allom_agb2(:) ! Parameter 2 for agb allometry real(r8), allocatable :: allom_agb3(:) ! Parameter 3 for agb allometry real(r8), allocatable :: allom_agb4(:) ! Parameter 3 for agb allometry ! Prescribed Physiology Mode Parameters - real(r8), allocatable :: prescribed_npp_canopy(:) ! this is only for the special prescribed_physiology_mode - real(r8), allocatable :: prescribed_npp_understory(:) ! this is only for the special prescribed_physiology_mode - real(r8), allocatable :: prescribed_mortality_canopy(:) ! this is only for the special prescribed_physiology_mode - real(r8), allocatable :: prescribed_mortality_understory(:) ! this is only for the special prescribed_physiology_mode - real(r8), allocatable :: prescribed_recruitment(:) ! this is only for the special prescribed_physiology_mode + real(r8), allocatable :: prescribed_npp_canopy(:) ! this is only for the special + ! prescribed_physiology_mode + real(r8), allocatable :: prescribed_npp_understory(:) ! this is only for the special + ! prescribed_physiology_mode + real(r8), allocatable :: prescribed_mortality_canopy(:) ! this is only for the special + ! prescribed_physiology_mode + real(r8), allocatable :: prescribed_mortality_understory(:) ! this is only for the special + ! prescribed_physiology_mode + real(r8), allocatable :: prescribed_recruitment(:) ! this is only for the special + ! prescribed_physiology_mode ! Plant Hydraulic Parameters @@ -453,6 +462,11 @@ 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) +! THIS VARIABLE IS NOT YET IN THE DEFAULT PARAMETER FILE +! name = 'fates_allom_stmode' +! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & +! dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_allom_cmode' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -849,6 +863,14 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_amode) + ! THIS PARAMETER IS NOT YET IN THE DEFAULT FILE + ! USE AMODE TO TEMPORARILY FILL AND ALLOCATE + ! name = 'fates_allom_stmode' + name = 'fates_allom_amode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_stmode) + this%allom_stmode(:) = 1.0_r8 + name = 'fates_allom_cmode' call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_cmode) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 0aefed13b9..3dabf26060 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -756,6 +756,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bdead_allom + use FatesAllometryMod , only : bstore_allom use EDCohortDynamicsMod , only : create_cohort use FatesInterfaceMod , only : numpft @@ -892,15 +893,16 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call bsap_allom(temp_cohort%dbh,c_pft,temp_cohort%canopy_trim,b_sapwood) call bdead_allom( b_agw, b_bgw, b_sapwood, c_pft, temp_cohort%bdead ) + + call bstore_allom(temp_cohort%dbh,temp_cohort%hite, c_pft, & + temp_cohort%canopy_trim,temp_cohort%bstore) if( EDPftvarcon_inst%evergreen(c_pft) == 1) then - 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 = b_leaf * EDPftvarcon_inst%cushion(c_pft) !stored carbon in new seedlings. if(csite%status == 2)then temp_cohort%laimemory = 0.0_r8 else @@ -911,7 +913,6 @@ 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 = b_leaf * EDPftvarcon_inst%cushion(c_pft) temp_cohort%laimemory = b_leaf cstatus = csite%dstatus endif From 0770a733102a62e82539d5d789ededab66a3ed63 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 1 Dec 2017 15:33:13 -0800 Subject: [PATCH 049/111] Allocation: changed some npp parition diagnostics to fusion fix diagnostics. Fixed a bug where leaf maintenance pay-back could had been negative. Also enabled the pay-at-all-costs hypothesis to compare with master. --- biogeochem/EDCohortDynamicsMod.F90 | 84 +++++---- biogeochem/EDPhysiologyMod.F90 | 266 +++++++++++++++++------------ main/EDMainMod.F90 | 18 +- main/EDTypesMod.F90 | 41 +++-- main/FatesConstantsMod.F90 | 8 + main/FatesHistoryInterfaceMod.F90 | 259 ++++++++++++++++------------ main/FatesRestartInterfaceMod.F90 | 77 +++++++-- 7 files changed, 477 insertions(+), 276 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 5a2dc2514b..daf82aa8d8 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -269,13 +269,18 @@ subroutine nan_cohort(cc_p) currentCohort%resp_tstep = nan ! RESP: kgC/indiv/timestep currentCohort%resp_acc = nan ! RESP: kGC/cohort/day - currentCohort%npp_leaf = nan - currentCohort%npp_froot = nan - currentCohort%npp_bsw = nan - currentCohort%npp_bdead = nan - currentCohort%npp_bseed = nan - currentCohort%npp_store = nan - + currentCohort%npp_leaf = nan + currentCohort%npp_fnrt = nan + currentCohort%npp_sapw = nan + currentCohort%npp_dead = nan + currentCohort%npp_seed = nan + currentCohort%npp_stor = nan + + currentCohort%fcfix_leaf = nan + currentCohort%fcfix_fnrt = nan + currentCohort%fcfix_sapw = nan + currentCohort%fcfix_dead = nan + currentCohort%fcfix_stor = nan !RESPIRATION currentCohort%rdark = nan @@ -292,7 +297,6 @@ subroutine nan_cohort(cc_p) currentCohort%bsw_md = nan currentCohort%bdead_md = nan currentCohort%bstore_md = nan - currentCohort%carbon_balance = nan ! carbon remaining for growth and storage: kg/indiv/year currentCohort%dmort = nan ! proportional mortality rate. (year-1) currentCohort%lmort_logging = nan currentCohort%lmort_infra = nan @@ -354,7 +358,6 @@ subroutine zero_cohort(cc_p) currentcohort%gpp_tstep = 0._r8 currentcohort%resp_tstep = 0._r8 currentcohort%resp_acc_hold = 0._r8 - currentcohort%carbon_balance = 0._r8 currentcohort%leaf_litter = 0._r8 currentcohort%year_net_uptake(:) = 999._r8 ! this needs to be 999, or trimming of new cohorts will break. currentcohort%ts_net_uptake(:) = 0._r8 @@ -374,12 +377,18 @@ subroutine zero_cohort(cc_p) currentCohort%lmort_logging = 0._r8 currentCohort%lmort_infra = 0._r8 currentCohort%lmort_collateral = 0._r8 - currentCohort%npp_leaf = 0._r8 - currentCohort%npp_froot = 0._r8 - currentCohort%npp_bsw = 0._r8 - currentCohort%npp_bdead = 0._r8 - currentCohort%npp_bseed = 0._r8 - currentCohort%npp_store = 0._r8 + currentCohort%npp_leaf = 0._r8 + currentCohort%npp_fnrt = 0._r8 + currentCohort%npp_sapw = 0._r8 + currentCohort%npp_dead = 0._r8 + currentCohort%npp_seed = 0._r8 + currentCohort%npp_stor = 0._r8 + + currentCohort%fcfix_leaf = 0._r8 + currentCohort%fcfix_fnrt = 0._r8 + currentCohort%fcfix_sapw = 0._r8 + currentCohort%fcfix_dead = 0._r8 + currentCohort%fcfix_stor = 0._r8 end subroutine zero_cohort @@ -715,8 +724,6 @@ subroutine fuse_cohorts(patchptr, bc_in) nextc%n*nextc%bsw_md)/newn currentCohort%bdead_md = (currentCohort%n*currentCohort%bdead_md + & nextc%n*nextc%bdead_md)/newn - currentCohort%carbon_balance = (currentCohort%n*currentCohort%carbon_balance + & - nextc%n*nextc%carbon_balance)/newn currentCohort%gpp_acc = (currentCohort%n*currentCohort%gpp_acc + & nextc%n*nextc%gpp_acc)/newn currentCohort%npp_acc = (currentCohort%n*currentCohort%npp_acc + & @@ -762,19 +769,31 @@ subroutine fuse_cohorts(patchptr, bc_in) nextc%n*nextc%lmort_infra)/newn ! npp diagnostics - currentCohort%npp_leaf = (currentCohort%n*currentCohort%npp_leaf + nextc%n*nextc%npp_leaf) & + currentCohort%npp_leaf = (currentCohort%n*currentCohort%npp_leaf + nextc%n*nextc%npp_leaf) & + /newn + currentCohort%npp_fnrt = (currentCohort%n*currentCohort%npp_fnrt + nextc%n*nextc%npp_fnrt) & + /newn + currentCohort%npp_sapw = (currentCohort%n*currentCohort%npp_sapw + nextc%n*nextc%npp_sapw) & + /newn + currentCohort%npp_dead = (currentCohort%n*currentCohort%npp_dead + nextc%n*nextc%npp_dead) & /newn - currentCohort%npp_froot = (currentCohort%n*currentCohort%npp_froot + nextc%n*nextc%npp_froot) & + currentCohort%npp_seed = (currentCohort%n*currentCohort%npp_seed + nextc%n*nextc%npp_seed) & /newn - currentCohort%npp_bsw = (currentCohort%n*currentCohort%npp_bsw + nextc%n*nextc%npp_bsw) & + currentCohort%npp_stor = (currentCohort%n*currentCohort%npp_stor + nextc%n*nextc%npp_stor) & /newn - currentCohort%npp_bdead = (currentCohort%n*currentCohort%npp_bdead + nextc%n*nextc%npp_bdead) & + + currentCohort%fcfix_leaf = (currentCohort%n*currentCohort%fcfix_leaf + nextc%n*nextc%fcfix_leaf) & + /newn + currentCohort%fcfix_fnrt = (currentCohort%n*currentCohort%fcfix_fnrt + nextc%n*nextc%fcfix_fnrt) & + /newn + currentCohort%fcfix_sapw = (currentCohort%n*currentCohort%fcfix_sapw + nextc%n*nextc%fcfix_sapw) & /newn - currentCohort%npp_bseed = (currentCohort%n*currentCohort%npp_bseed + nextc%n*nextc%npp_bseed) & + currentCohort%fcfix_dead = (currentCohort%n*currentCohort%fcfix_dead + nextc%n*nextc%fcfix_dead) & /newn - currentCohort%npp_store = (currentCohort%n*currentCohort%npp_store + nextc%n*nextc%npp_store) & + currentCohort%fcfix_stor = (currentCohort%n*currentCohort%fcfix_stor + nextc%n*nextc%fcfix_stor) & /newn + ! biomass and dbh tendencies currentCohort%ddbhdt = (currentCohort%n*currentCohort%ddbhdt + nextc%n*nextc%ddbhdt)/newn currentCohort%dbdeaddt = (currentCohort%n*currentCohort%dbdeaddt + nextc%n*nextc%dbdeaddt) & @@ -1103,12 +1122,18 @@ subroutine copy_cohort( currentCohort,copyc ) n%year_net_uptake = o%year_net_uptake n%ts_net_uptake = o%ts_net_uptake - n%npp_leaf = o%npp_leaf - n%npp_froot = o%npp_froot - n%npp_bsw = o%npp_bsw - n%npp_bdead = o%npp_bdead - n%npp_bseed = o%npp_bseed - n%npp_store = o%npp_store + n%npp_leaf = o%npp_leaf + n%npp_fnrt = o%npp_fnrt + n%npp_sapw = o%npp_sapw + n%npp_dead = o%npp_dead + n%npp_seed = o%npp_seed + n%npp_stor = o%npp_stor + + n%fcfix_leaf = o%fcfix_leaf + n%fcfix_fnrt = o%fcfix_fnrt + n%fcfix_sapw = o%fcfix_sapw + n%fcfix_dead = o%fcfix_dead + n%fcfix_stor = o%fcfix_stor !RESPIRATION n%rdark = o%rdark @@ -1125,7 +1150,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%bsw_md = o%bsw_md n%bdead_md = o%bdead_md n%bstore_md = o%bstore_md - n%carbon_balance = o%carbon_balance n%dmort = o%dmort n%lmort_logging = o%lmort_logging n%lmort_infra = o%lmort_infra diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 4a87e4eca4..540352cde8 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -34,6 +34,7 @@ module EDPhysiologyMod use FatesGlobals , only : endrun => fates_endrun use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesConstantsMod , only : itrue,ifalse + use FatesConstantsMod , only : calloc_abs_error use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : h2d_allom @@ -66,6 +67,9 @@ module EDPhysiologyMod private :: seed_germination public :: flux_into_litter_pools + logical, parameter :: test_b4b = .true. ! flag used to test + ! hypothesese or just hold + ! change for later logical, parameter :: DEBUG = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -766,8 +770,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) integer :: ipft ! PFT index - ! Per plant allocation targets + real(r8) :: carbon_balance ! daily carbon balance for this cohort + + ! Per plant allocation targets real(r8) :: bt_leaf ! leaf biomass (kgC) real(r8) :: dbt_leaf_dd ! change in leaf biomass wrt diameter (kgC/cm) real(r8) :: bt_fineroot ! fine root biomass (kgC) @@ -834,15 +840,22 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ipft = currentCohort%pft ! Initialize seed production - currentCohort%seed_prod = 0.0_r8 + currentCohort%seed_prod = 0.0_r8 ! Initialize NPP flux diagnostics - currentCohort%npp_store = 0.0_r8 - currentCohort%npp_leaf = 0.0_r8 - currentCohort%npp_froot = 0.0_r8 - currentCohort%npp_bdead = 0.0_r8 - currentCohort%npp_bseed = 0.0_r8 - currentCohort%npp_bsw = 0.0_r8 + currentCohort%npp_stor = 0.0_r8 + currentCohort%npp_leaf = 0.0_r8 + currentCohort%npp_fnrt = 0.0_r8 + currentCohort%npp_dead = 0.0_r8 + currentCohort%npp_seed = 0.0_r8 + currentCohort%npp_sapw = 0.0_r8 + + ! Initialize the diagnostic that tracks corrections from fusion redistribution + currentCohort%fcfix_leaf = 0.0_r8 + currentCohort%fcfix_fnrt = 0.0_r8 + currentCohort%fcfix_dead = 0.0_r8 + currentCohort%fcfix_stor = 0.0_r8 + currentCohort%fcfix_sapw = 0.0_r8 ! Initialize rates of change currentCohort%dhdt = 0.0_r8 @@ -883,7 +896,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Available carbon for growth [kgC] - currentCohort%carbon_balance = currentCohort%npp_acc + carbon_balance = currentCohort%npp_acc ! ----------------------------------------------------------------------------------- @@ -935,33 +948,33 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if(leaf_below_target<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - leaf_below_target - currentCohort%bl = currentCohort%bl + leaf_below_target - currentCohort%npp_leaf = currentCohort%npp_leaf + leaf_below_target / hlm_freq_day + carbon_balance = carbon_balance - leaf_below_target + currentCohort%bl = currentCohort%bl + leaf_below_target + currentCohort%fcfix_leaf = currentCohort%fcfix_leaf + leaf_below_target / hlm_freq_day end if if(froot_below_target<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - froot_below_target - currentCohort%br = currentCohort%br + froot_below_target - currentCohort%npp_froot = currentCohort%npp_froot + froot_below_target / hlm_freq_day + carbon_balance = carbon_balance - froot_below_target + currentCohort%br = currentCohort%br + froot_below_target + currentCohort%fcfix_fnrt = currentCohort%fcfix_fnrt + froot_below_target / hlm_freq_day end if if(sap_below_target<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - sap_below_target - currentCohort%bsw = currentCohort%bsw + sap_below_target - currentCohort%npp_bsw = currentCohort%npp_bsw + sap_below_target / hlm_freq_day + carbon_balance = carbon_balance - sap_below_target + currentCohort%bsw = currentCohort%bsw + sap_below_target + currentCohort%fcfix_sapw = currentCohort%fcfix_sapw + sap_below_target / hlm_freq_day end if if(store_below_target<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - store_below_target - currentCohort%bstore = currentCohort%bstore + store_below_target - currentCohort%npp_store = currentCohort%npp_store + store_below_target / hlm_freq_day + carbon_balance = carbon_balance - store_below_target + currentCohort%bstore = currentCohort%bstore + store_below_target + currentCohort%fcfix_stor = currentCohort%fcfix_stor + store_below_target / hlm_freq_day end if if(dead_below_target<0.0_r8) then - currentCohort%carbon_balance = currentCohort%carbon_balance - dead_below_target - currentCohort%bdead = currentCohort%bdead + dead_below_target - currentCohort%npp_bdead = currentCohort%npp_bdead + dead_below_target / hlm_freq_day + carbon_balance = carbon_balance - dead_below_target + currentCohort%bdead = currentCohort%bdead + dead_below_target + currentCohort%fcfix_dead = currentCohort%fcfix_dead + dead_below_target / hlm_freq_day end if @@ -1043,25 +1056,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md*hlm_freq_day currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md*hlm_freq_day currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md*hlm_freq_day - - - ! ----------------------------------------------------------------------------------- - ! VI(a) if carbon balance is negative, re-coup the losses from storage - ! ----------------------------------------------------------------------------------- - - if( currentCohort%carbon_balance < 0.0_r8 ) then - bstore_flux = currentCohort%carbon_balance - currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day - ! We have pushed to net-zero carbon, the rest of this routine can be ignored - return - end if - ! ----------------------------------------------------------------------------------- ! VI(b). Prioritize some amount of carbon to replace leaf/root turnover + ! Make sure it isnt a negative payment, and either pay what is available + ! or forcefully pay from storage. ! ----------------------------------------------------------------------------------- leaf_turnover_demand = currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(ipft)*hlm_freq_day @@ -1070,32 +1070,61 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if(total_turnover_demand>0.0_r8)then - bl_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + ! If we are testing b4b, then we pay this even if we don't have the carbon + if(test_b4b) then + bl_flux = leaf_turnover_demand + else + bl_flux = min(leaf_turnover_demand, max(0.0_r8,carbon_balance*(leaf_turnover_demand/total_turnover_demand))) + end if + + carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - br_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day + ! If we are testing b4b, then we pay this even if we don't have the carbon + if(test_b4b) then + br_flux = root_turnover_demand + else + br_flux = min(root_turnover_demand, max(0.0_r8,carbon_balance*(root_turnover_demand/total_turnover_demand))) + end if + + + carbon_balance = carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day end if + ! ----------------------------------------------------------------------------------- - ! VI(c). If carbon is still available, prioritize some allocation to storage + ! VI(a) if carbon balance is negative, re-coup the losses from storage + ! if it is positive, give some love to storage carbon ! ----------------------------------------------------------------------------------- - store_below_target = max(bt_store - currentCohort%bstore,0.0_r8) - store_target_fraction = currentCohort%bstore/bt_store - bstore_flux = min(store_below_target,currentCohort%carbon_balance * & - max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) - currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day + if( carbon_balance < 0.0_r8 ) then + + bstore_flux = carbon_balance + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + ! We have pushed to net-zero carbon, the rest of this routine can be ignored + return + + else + + store_below_target = max(bt_store - currentCohort%bstore,0.0_r8) + store_target_fraction = max(0.0_r8,currentCohort%bstore/bt_store) + bstore_flux = min(store_below_target,carbon_balance * & + max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + + end if ! ----------------------------------------------------------------------------------- ! VI(d). If carbon is still available, prioritize some allocation to replace ! the rest of the leaf/fineroot turnover demand + ! carbon balance is gauranteed to be positive beyond this point ! ----------------------------------------------------------------------------------- leaf_turnover_demand = currentCohort%leaf_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day @@ -1104,15 +1133,15 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if(total_turnover_demand>0.0_r8)then - bl_flux = min(leaf_turnover_demand, currentCohort%carbon_balance*(leaf_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + bl_flux = min(leaf_turnover_demand, carbon_balance*(leaf_turnover_demand/total_turnover_demand)) + carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - br_flux = min(root_turnover_demand, currentCohort%carbon_balance*(root_turnover_demand/total_turnover_demand)) - currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux + br_flux = min(root_turnover_demand, carbon_balance*(root_turnover_demand/total_turnover_demand)) + carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day end if @@ -1121,21 +1150,22 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! pools back towards allometry ! ----------------------------------------------------------------------------------- - if( currentCohort%carbon_balance0.0_r8) then - if( total_below_target > currentCohort%carbon_balance) then - bl_flux = currentCohort%carbon_balance * leaf_below_target/total_below_target - br_flux = currentCohort%carbon_balance * froot_below_target/total_below_target - bsw_flux = currentCohort%carbon_balance * sap_below_target/total_below_target - bstore_flux = currentCohort%carbon_balance * store_below_target/total_below_target + if( total_below_target > carbon_balance) then + bl_flux = carbon_balance * leaf_below_target/total_below_target + br_flux = carbon_balance * froot_below_target/total_below_target + bsw_flux = carbon_balance * sap_below_target/total_below_target + bstore_flux = carbon_balance * store_below_target/total_below_target else bl_flux = leaf_below_target br_flux = froot_below_target @@ -1143,21 +1173,21 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) bstore_flux = store_below_target end if - currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux + carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - currentCohort%carbon_balance = currentCohort%carbon_balance - bsw_flux + carbon_balance = carbon_balance - bsw_flux currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux / hlm_freq_day + currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux + carbon_balance = carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day end if @@ -1166,21 +1196,19 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! back on allometry ! ----------------------------------------------------------------------------------- - if( currentCohort%carbon_balance 0.0_r8 .and. dead_below_target>0.0_r8) then + if ( carbon_balance > 0.0_r8 .and. dead_below_target>0.0_r8) then - bdead_flux = min(currentCohort%carbon_balance,dead_below_target) - currentCohort%carbon_balance = currentCohort%carbon_balance - bdead_flux + bdead_flux = min(carbon_balance,dead_below_target) + carbon_balance = carbon_balance - bdead_flux currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_bdead = currentCohort%npp_bdead + bdead_flux / hlm_freq_day + currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day end if - - ! ----------------------------------------------------------------------------------- ! V(e). If carbon is yet still available ... ! Our pools are now on allometry, and we can increment all pools @@ -1189,16 +1217,45 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! the carbon balance sub-step (deltaC) will be halved and tried again ! ----------------------------------------------------------------------------------- - if( currentCohort%carbon_balancecalloc_abs_error) then + write(fates_log(),*) 'leaves are not on-allometry at the growth step' + write(fates_log(),*) 'exiting',currentCohort%bl,bt_leaf,currentCohort%bl - bt_leaf + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if(abs(currentCohort%br - bt_fineroot)>calloc_abs_error) then + write(fates_log(),*) 'fineroots are not on-allometry at the growth step' + write(fates_log(),*) 'exiting',currentCohort%br,bt_fineroot,currentCohort%br - bt_fineroot + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - deltaC = currentCohort%carbon_balance + if(abs(currentCohort%bsw - bt_sap)>calloc_abs_error) then + write(fates_log(),*) 'sapwood is not on-allometry at the growth step' + write(fates_log(),*) 'exiting',currentCohort%bsw,bt_sap,currentCohort%bsw - bt_sap + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if(abs(currentCohort%bdead - bt_dead)>calloc_abs_error) then + write(fates_log(),*) 'dead wood is not on-allometry at the growth step' + write(fates_log(),*) 'exiting',currentCohort%bdead,bt_dead,currentCohort%bdead - bt_dead + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if(abs(currentCohort%bstore - bt_store)>calloc_abs_error) then + write(fates_log(),*) 'storage is not on-allometry at the growth step' + write(fates_log(),*) 'exiting',currentCohort%bstore,bt_store,currentCohort%bstore - bt_store + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + deltaC = carbon_balance nsteps = 1 ierr = 1 do while( ierr .ne. 0 ) - totalC = currentCohort%carbon_balance + totalC = carbon_balance dbh_sub = currentCohort%dbh h_sub = currentCohort%hite bl_sub = currentCohort%bl @@ -1227,9 +1284,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) dbt_total_dd = dbt_leaf_dd + dbt_fineroot_dd + dbt_sap_dd + dbt_dead_dd + dbt_store_dd - bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) brepro_flux = deltaC * repro_fraction @@ -1260,9 +1317,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end do - if( abs(totalC)>1e-12_r8 ) then - print*,"TOTALC IS NON-ZERO,IT SHOULD BE ZERO",totalC,deltaC,tiny(totalC) - stop + if( abs(totalC)>calloc_abs_error ) then + write(fates_log(),*) 'carbon gain during allometric growth was not conserved' + write(fates_log(),*) 'exiting',totalC + call endrun(msg=errMsg(sourcefile, __LINE__)) end if call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & @@ -1273,35 +1331,35 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ierr = 0 ! Reset this value for diagnostic - totalC = currentCohort%carbon_balance + totalC = carbon_balance bl_flux = bl_sub - currentCohort%bl - currentCohort%carbon_balance = currentCohort%carbon_balance - bl_flux + carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day br_flux = br_sub - currentCohort%br - currentCohort%carbon_balance = currentCohort%carbon_balance - br_flux + carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_froot = currentCohort%npp_froot + br_flux / hlm_freq_day + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day bsw_flux = bsw_sub - currentCohort%bsw - currentCohort%carbon_balance = currentCohort%carbon_balance - bsw_flux + carbon_balance = carbon_balance - bsw_flux currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_bsw = currentCohort%npp_bsw + bsw_flux / hlm_freq_day + currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day bstore_flux = bstore_sub - currentCohort%bstore - currentCohort%carbon_balance = currentCohort%carbon_balance - bstore_flux + carbon_balance = carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_store = currentCohort%npp_store + bstore_flux / hlm_freq_day + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day bdead_flux = bdead_sub - currentCohort%bdead - currentCohort%carbon_balance = currentCohort%carbon_balance - bdead_flux + carbon_balance = carbon_balance - bdead_flux currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_bdead = currentCohort%npp_bdead + bdead_flux / hlm_freq_day + currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - currentCohort%carbon_balance = currentCohort%carbon_balance - brepro_sub - currentCohort%npp_bseed = currentCohort%npp_bseed + brepro_sub / hlm_freq_day + carbon_balance = carbon_balance - brepro_sub + currentCohort%npp_seed = currentCohort%npp_seed + brepro_sub / hlm_freq_day currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day ! Set derivatives used as diagnostics @@ -1313,15 +1371,13 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%dbh = dbh_sub currentCohort%hite = h_sub - if( abs(currentCohort%carbon_balance)>1e-12_r8 ) then + if( abs(carbon_balance)>calloc_abs_error ) then write(fates_log(),*) 'carbon conservation error while integrating pools' write(fates_log(),*) 'along alometric curve' - write(fates_log(),*) 'currentCohort%carbon_balance = ',currentCohort%carbon_balance,totalC + write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC write(fates_log(),*) 'exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - - else @@ -1332,8 +1388,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end do -! if(deltaC/totalC < 1.0_r8 )print*,deltaC/totalC - ! If the cohort has grown, it is not new currentCohort%isnew=.false. diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 79ee0082de..8a6101a1d7 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -578,12 +578,18 @@ subroutine bypass_dynamics(currentSite) currentCohort%gpp_acc = 0.0_r8 currentCohort%resp_acc = 0.0_r8 - currentCohort%npp_leaf = 0.0_r8 - currentCohort%npp_froot = 0.0_r8 - currentCohort%npp_bsw = 0.0_r8 - currentCohort%npp_bdead = 0.0_r8 - currentCohort%npp_bseed = 0.0_r8 - currentCohort%npp_store = 0.0_r8 + currentCohort%npp_leaf = 0.0_r8 + currentCohort%npp_fnrt = 0.0_r8 + currentCohort%npp_sapw = 0.0_r8 + currentCohort%npp_dead = 0.0_r8 + currentCohort%npp_seed = 0.0_r8 + currentCohort%npp_stor = 0.0_r8 + + currentCohort%fcfix_leaf = 0.0_r8 + currentCohort%fcfix_fnrt = 0.0_r8 + currentCohort%fcfix_sapw = 0.0_r8 + currentCohort%fcfix_dead = 0.0_r8 + currentCohort%fcfix_stor = 0.0_r8 currentCohort%bmort = 0.0_r8 currentCohort%hmort = 0.0_r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 6ade9f99e0..e26d409972 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -186,15 +186,23 @@ module EDTypesMod real(r8) :: resp_acc real(r8) :: resp_acc_hold - ! Net Primary Production Partitions + ! Plant Tissue Carbon Fluxes - real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/year - real(r8) :: npp_froot ! NPP into fine roots (includes replacement of turnover): KgC/indiv/year + ! Fluxes in from Net Primary Production + real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/year + real(r8) :: npp_fnrt ! NPP into fine roots (includes replacement of turnover): KgC/indiv/year + real(r8) :: npp_sapw ! NPP into sapwood: KgC/indiv/year + real(r8) :: npp_dead ! NPP into deadwood (structure): KgC/indiv/year + real(r8) :: npp_seed ! NPP into seeds: KgC/indiv/year + real(r8) :: npp_stor ! NPP into storage: KgC/indiv/year + + ! Fluxes due to fixing allometry breaking during fusion + real(r8) :: fcfix_leaf ! Carbon leaving leaves into carbon gain after weird fusion KgC/indiv/year + real(r8) :: fcfix_fnrt ! Carbon leaving froots into carbon gain "" KgC/indiv/year + real(r8) :: fcfix_sapw ! Carbon leaving sapwood into carbon gain "" KgC/indiv/year + real(r8) :: fcfix_dead ! Carbon leaving deadwood into carbon gain "" KgC/indiv/year + real(r8) :: fcfix_stor ! Carbon leaving storage into carbon gain "" KgC/indiv/year - real(r8) :: npp_bsw ! NPP into sapwood: KgC/indiv/year - real(r8) :: npp_bdead ! NPP into deadwood (structure): KgC/indiv/year - real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/year - real(r8) :: npp_store ! NPP into storage: KgC/indiv/year real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/s real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year @@ -217,7 +225,6 @@ module EDTypesMod real(r8) :: bstore_md ! storage maintenance demand: kgC/indiv/year real(r8) :: bdead_md ! structural (branch) maintenance demand: kgC/indiv/year - real(r8) :: carbon_balance ! carbon remaining for growth and storage: kg/indiv/year real(r8) :: seed_prod ! reproduction seed and clonal: KgC/indiv/year real(r8) :: leaf_litter ! leaf litter from phenology: KgC/m2 @@ -737,11 +744,18 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%resp_acc = ', ccohort%resp_acc write(fates_log(),*) 'co%resp_acc_hold = ', ccohort%resp_acc_hold write(fates_log(),*) 'co%npp_leaf = ', ccohort%npp_leaf - write(fates_log(),*) 'co%npp_froot = ', ccohort%npp_froot - write(fates_log(),*) 'co%npp_bsw = ', ccohort%npp_bsw - write(fates_log(),*) 'co%npp_bdead = ', ccohort%npp_bdead - write(fates_log(),*) 'co%npp_bseed = ', ccohort%npp_bseed - write(fates_log(),*) 'co%npp_store = ', ccohort%npp_store + write(fates_log(),*) 'co%npp_fnrt = ', ccohort%npp_fnrt + write(fates_log(),*) 'co%npp_sapw = ', ccohort%npp_sapw + write(fates_log(),*) 'co%npp_dead = ', ccohort%npp_dead + write(fates_log(),*) 'co%npp_seed = ', ccohort%npp_seed + write(fates_log(),*) 'co%npp_stor = ', ccohort%npp_stor + + write(fates_log(),*) 'co%fcfix_leaf = ', ccohort%fcfix_leaf + write(fates_log(),*) 'co%fcfix_fnrt = ', ccohort%fcfix_fnrt + write(fates_log(),*) 'co%fcfix_sapw = ', ccohort%fcfix_sapw + write(fates_log(),*) 'co%fcfix_dead = ', ccohort%fcfix_dead + write(fates_log(),*) 'co%fcfix_stor = ', ccohort%fcfix_stor + write(fates_log(),*) 'co%rdark = ', ccohort%rdark write(fates_log(),*) 'co%resp_m = ', ccohort%resp_m write(fates_log(),*) 'co%resp_g = ', ccohort%resp_g @@ -754,7 +768,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%bstore_md = ', ccohort%bstore_md write(fates_log(),*) 'co%bdead_md = ', ccohort%bdead_md write(fates_log(),*) 'co%bsw_md = ', ccohort%bsw_md - write(fates_log(),*) 'co%carbon_balance = ', ccohort%carbon_balance write(fates_log(),*) 'co%dmort = ', ccohort%dmort write(fates_log(),*) 'co%seed_prod = ', ccohort%seed_prod write(fates_log(),*) 'co%treelai = ', ccohort%treelai diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index f7980b4bff..fc4f20b088 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -26,6 +26,14 @@ module FatesConstantsMod integer, parameter :: ifalse = 0 + ! Error Tolerances + + ! Allowable error in carbon allocations, should be applied to estimates + ! of carbon conservation in units of kgC/plant. This gives an effective + ! error tolerance of 1 microgram. + real(fates_r8), parameter :: calloc_abs_error = 1.0e-9_fates_r8 + + ! Unit conversion constants: ! Conversion factor umols of Carbon -> kg of Carbon (1 mol = 12g) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 33585b66b6..e204500c44 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -3,6 +3,7 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_avg_flag_length, fates_short_string_length, fates_long_string_length use FatesConstantsMod , only : itrue,ifalse + use FatesConstantsMod , only : calloc_abs_error use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun @@ -137,6 +138,12 @@ module FatesHistoryInterfaceMod integer, private :: ih_npp_agsw_si_scpf integer, private :: ih_npp_agdw_si_scpf integer, private :: ih_npp_stor_si_scpf + + integer, private :: ih_fcfix_leaf_si_scpf + integer, private :: ih_fcfix_fnrt_si_scpf + integer, private :: ih_fcfix_stor_si_scpf + integer, private :: ih_fcfix_dead_si_scpf + integer, private :: ih_fcfix_sapw_si_scpf integer, private :: ih_bstor_canopy_si_scpf integer, private :: ih_bstor_understory_si_scpf @@ -200,17 +207,16 @@ module FatesHistoryInterfaceMod integer, private :: ih_bstore_md_canopy_si_scls integer, private :: ih_bdead_md_canopy_si_scls integer, private :: ih_bsw_md_canopy_si_scls - integer, private :: ih_carbon_balance_canopy_si_scls integer, private :: ih_seed_prod_canopy_si_scls integer, private :: ih_dbdeaddt_canopy_si_scls integer, private :: ih_dbstoredt_canopy_si_scls integer, private :: ih_storage_flux_canopy_si_scls integer, private :: ih_npp_leaf_canopy_si_scls - integer, private :: ih_npp_froot_canopy_si_scls - integer, private :: ih_npp_bsw_canopy_si_scls - integer, private :: ih_npp_bdead_canopy_si_scls - integer, private :: ih_npp_bseed_canopy_si_scls - integer, private :: ih_npp_store_canopy_si_scls + integer, private :: ih_npp_fnrt_canopy_si_scls + integer, private :: ih_npp_sapw_canopy_si_scls + integer, private :: ih_npp_dead_canopy_si_scls + integer, private :: ih_npp_seed_canopy_si_scls + integer, private :: ih_npp_stor_canopy_si_scls integer, private :: ih_rdark_understory_si_scls integer, private :: ih_livestem_mr_understory_si_scls @@ -223,17 +229,16 @@ module FatesHistoryInterfaceMod integer, private :: ih_bsw_md_understory_si_scls integer, private :: ih_bdead_md_understory_si_scls integer, private :: ih_bstore_md_understory_si_scls - integer, private :: ih_carbon_balance_understory_si_scls integer, private :: ih_seed_prod_understory_si_scls integer, private :: ih_dbdeaddt_understory_si_scls integer, private :: ih_dbstoredt_understory_si_scls integer, private :: ih_storage_flux_understory_si_scls integer, private :: ih_npp_leaf_understory_si_scls - integer, private :: ih_npp_froot_understory_si_scls - integer, private :: ih_npp_bsw_understory_si_scls - integer, private :: ih_npp_bdead_understory_si_scls - integer, private :: ih_npp_bseed_understory_si_scls - integer, private :: ih_npp_store_understory_si_scls + integer, private :: ih_npp_fnrt_understory_si_scls + integer, private :: ih_npp_sapw_understory_si_scls + integer, private :: ih_npp_dead_understory_si_scls + integer, private :: ih_npp_seed_understory_si_scls + integer, private :: ih_npp_stor_understory_si_scls integer, private :: ih_yesterdaycanopylevel_canopy_si_scls integer, private :: ih_yesterdaycanopylevel_understory_si_scls @@ -1191,6 +1196,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_agsw_si_scpf => this%hvars(ih_npp_agsw_si_scpf)%r82d, & hio_npp_agdw_si_scpf => this%hvars(ih_npp_agdw_si_scpf)%r82d, & hio_npp_stor_si_scpf => this%hvars(ih_npp_stor_si_scpf)%r82d, & + + hio_fcfix_leaf_si_scpf => this%hvars(ih_fcfix_leaf_si_scpf)%r82d, & + hio_fcfix_fnrt_si_scpf => this%hvars(ih_fcfix_fnrt_si_scpf)%r82d, & + hio_fcfix_stor_si_scpf => this%hvars(ih_fcfix_stor_si_scpf)%r82d, & + hio_fcfix_dead_si_scpf => this%hvars(ih_fcfix_dead_si_scpf)%r82d, & + hio_fcfix_sapw_si_scpf => this%hvars(ih_fcfix_sapw_si_scpf)%r82d, & + hio_bstor_canopy_si_scpf => this%hvars(ih_bstor_canopy_si_scpf)%r82d, & hio_bstor_understory_si_scpf => this%hvars(ih_bstor_understory_si_scpf)%r82d, & hio_bleaf_canopy_si_scpf => this%hvars(ih_bleaf_canopy_si_scpf)%r82d, & @@ -1210,13 +1222,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ddbh_si_scpf => this%hvars(ih_ddbh_si_scpf)%r82d, & hio_ba_si_scpf => this%hvars(ih_ba_si_scpf)%r82d, & hio_nplant_si_scpf => this%hvars(ih_nplant_si_scpf)%r82d, & + hio_m1_si_scpf => this%hvars(ih_m1_si_scpf)%r82d, & hio_m2_si_scpf => this%hvars(ih_m2_si_scpf)%r82d, & hio_m3_si_scpf => this%hvars(ih_m3_si_scpf)%r82d, & 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_ba_si_scls => this%hvars(ih_ba_si_scls)%r82d, & @@ -1239,33 +1251,31 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_bsw_md_canopy_si_scls => this%hvars(ih_bsw_md_canopy_si_scls)%r82d, & hio_bdead_md_canopy_si_scls => this%hvars(ih_bdead_md_canopy_si_scls)%r82d, & hio_bstore_md_canopy_si_scls => this%hvars(ih_bstore_md_canopy_si_scls)%r82d, & - hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & hio_seed_prod_canopy_si_scls => this%hvars(ih_seed_prod_canopy_si_scls)%r82d, & hio_dbdeaddt_canopy_si_scls => this%hvars(ih_dbdeaddt_canopy_si_scls)%r82d, & hio_dbstoredt_canopy_si_scls => this%hvars(ih_dbstoredt_canopy_si_scls)%r82d, & hio_storage_flux_canopy_si_scls => this%hvars(ih_storage_flux_canopy_si_scls)%r82d, & hio_npp_leaf_canopy_si_scls => this%hvars(ih_npp_leaf_canopy_si_scls)%r82d, & - hio_npp_froot_canopy_si_scls => this%hvars(ih_npp_froot_canopy_si_scls)%r82d, & - hio_npp_bsw_canopy_si_scls => this%hvars(ih_npp_bsw_canopy_si_scls)%r82d, & - hio_npp_bdead_canopy_si_scls => this%hvars(ih_npp_bdead_canopy_si_scls)%r82d, & - hio_npp_bseed_canopy_si_scls => this%hvars(ih_npp_bseed_canopy_si_scls)%r82d, & - hio_npp_store_canopy_si_scls => this%hvars(ih_npp_store_canopy_si_scls)%r82d, & + hio_npp_fnrt_canopy_si_scls => this%hvars(ih_npp_fnrt_canopy_si_scls)%r82d, & + hio_npp_sapw_canopy_si_scls => this%hvars(ih_npp_sapw_canopy_si_scls)%r82d, & + hio_npp_dead_canopy_si_scls => this%hvars(ih_npp_dead_canopy_si_scls)%r82d, & + hio_npp_seed_canopy_si_scls => this%hvars(ih_npp_seed_canopy_si_scls)%r82d, & + hio_npp_stor_canopy_si_scls => this%hvars(ih_npp_stor_canopy_si_scls)%r82d, & hio_leaf_md_understory_si_scls => this%hvars(ih_leaf_md_understory_si_scls)%r82d, & hio_root_md_understory_si_scls => this%hvars(ih_root_md_understory_si_scls)%r82d, & hio_bstore_md_understory_si_scls => this%hvars(ih_bstore_md_understory_si_scls)%r82d, & hio_bsw_md_understory_si_scls => this%hvars(ih_bsw_md_understory_si_scls)%r82d, & hio_bdead_md_understory_si_scls => this%hvars(ih_bdead_md_understory_si_scls)%r82d, & - hio_carbon_balance_understory_si_scls=> this%hvars(ih_carbon_balance_understory_si_scls)%r82d, & hio_seed_prod_understory_si_scls => this%hvars(ih_seed_prod_understory_si_scls)%r82d, & hio_dbdeaddt_understory_si_scls => this%hvars(ih_dbdeaddt_understory_si_scls)%r82d, & hio_dbstoredt_understory_si_scls => this%hvars(ih_dbstoredt_understory_si_scls)%r82d, & hio_storage_flux_understory_si_scls => this%hvars(ih_storage_flux_understory_si_scls)%r82d, & hio_npp_leaf_understory_si_scls => this%hvars(ih_npp_leaf_understory_si_scls)%r82d, & - hio_npp_froot_understory_si_scls => this%hvars(ih_npp_froot_understory_si_scls)%r82d, & - hio_npp_bsw_understory_si_scls => this%hvars(ih_npp_bsw_understory_si_scls)%r82d, & - hio_npp_bdead_understory_si_scls => this%hvars(ih_npp_bdead_understory_si_scls)%r82d, & - hio_npp_bseed_understory_si_scls => this%hvars(ih_npp_bseed_understory_si_scls)%r82d, & - hio_npp_store_understory_si_scls => this%hvars(ih_npp_store_understory_si_scls)%r82d, & + hio_npp_fnrt_understory_si_scls => this%hvars(ih_npp_fnrt_understory_si_scls)%r82d, & + hio_npp_sapw_understory_si_scls => this%hvars(ih_npp_sapw_understory_si_scls)%r82d, & + hio_npp_dead_understory_si_scls => this%hvars(ih_npp_dead_understory_si_scls)%r82d, & + hio_npp_seed_understory_si_scls => this%hvars(ih_npp_seed_understory_si_scls)%r82d, & + hio_npp_stor_understory_si_scls => this%hvars(ih_npp_stor_understory_si_scls)%r82d, & hio_yesterdaycanopylevel_canopy_si_scls => this%hvars(ih_yesterdaycanopylevel_canopy_si_scls)%r82d, & hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & @@ -1434,35 +1444,56 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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 + ccohort%npp_fnrt*n_perm2 hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & - ccohort%npp_bsw*n_perm2* & + ccohort%npp_sapw*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* & + ccohort%npp_sapw*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* & + ccohort%npp_dead*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* & + ccohort%npp_dead*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 + ccohort%npp_seed*n_perm2 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 + ccohort%npp_stor*n_perm2 + + ! Track carbon fluxes from fusion corrections + + hio_fcfix_leaf_si_scpf(io_si,scpf) = hio_fcfix_leaf_si_scpf(io_si,scpf)+ & + ccohort%fcfix_leaf*n_perm2 + hio_fcfix_fnrt_si_scpf(io_si,scpf) = hio_fcfix_fnrt_si_scpf(io_si,scpf)+ & + ccohort%fcfix_fnrt*n_perm2 + hio_fcfix_stor_si_scpf(io_si,scpf) = hio_fcfix_stor_si_scpf(io_si,scpf)+ & + ccohort%fcfix_stor*n_perm2 + hio_fcfix_dead_si_scpf(io_si,scpf) = hio_fcfix_dead_si_scpf(io_si,scpf)+ & + ccohort%fcfix_dead*n_perm2 + hio_fcfix_sapw_si_scpf(io_si,scpf) = hio_fcfix_sapw_si_scpf(io_si,scpf)+ & + ccohort%fcfix_sapw*n_perm2 + + + if( abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & + ccohort%npp_sapw+ccohort%npp_dead+ & + ccohort%npp_seed+ccohort%npp_stor+ & + ccohort%fcfix_leaf + ccohort%fcfix_fnrt + & + ccohort%fcfix_sapw + ccohort%fcfix_dead + ccohort%fcfix_stor)) > calloc_abs_error) 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 + abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & + ccohort%npp_sapw+ccohort%npp_dead+ & + ccohort%npp_seed+ccohort%npp_stor+ & + ccohort%fcfix_leaf + ccohort%fcfix_fnrt + & + ccohort%fcfix_sapw + ccohort%fcfix_dead + ccohort%fcfix_stor))/ccohort%npp_acc_hold + write(fates_log(),*) 'Terms: ',ccohort%npp_acc_hold,ccohort%npp_leaf,ccohort%npp_fnrt, & + ccohort%npp_sapw,ccohort%npp_dead, & + ccohort%npp_seed,ccohort%npp_stor, & + ccohort%fcfix_leaf + ccohort%fcfix_fnrt + & + ccohort%fcfix_sapw + ccohort%fcfix_dead + & + ccohort%fcfix_stor 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__)) @@ -1564,8 +1595,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bstore_md * ccohort%n hio_bdead_md_canopy_si_scls(io_si,scls) = hio_bdead_md_canopy_si_scls(io_si,scls) + & ccohort%bdead_md * ccohort%n - hio_carbon_balance_canopy_si_scls(io_si,scls) = hio_carbon_balance_canopy_si_scls(io_si,scls) + & - ccohort%carbon_balance * ccohort%n hio_seed_prod_canopy_si_scls(io_si,scls) = hio_seed_prod_canopy_si_scls(io_si,scls) + & ccohort%seed_prod * ccohort%n hio_dbdeaddt_canopy_si_scls(io_si,scls) = hio_dbdeaddt_canopy_si_scls(io_si,scls) + & @@ -1573,19 +1602,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_dbstoredt_canopy_si_scls(io_si,scls) = hio_dbstoredt_canopy_si_scls(io_si,scls) + & ccohort%dbstoredt * ccohort%n hio_storage_flux_canopy_si_scls(io_si,scls) = hio_storage_flux_canopy_si_scls(io_si,scls) + & - ccohort%npp_store * ccohort%n + ccohort%npp_stor * 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_fnrt_canopy_si_scls(io_si,scls) = hio_npp_fnrt_canopy_si_scls(io_si,scls) + & + ccohort%npp_fnrt * ccohort%n + hio_npp_sapw_canopy_si_scls(io_si,scls) = hio_npp_sapw_canopy_si_scls(io_si,scls) + & + ccohort%npp_sapw * ccohort%n + hio_npp_dead_canopy_si_scls(io_si,scls) = hio_npp_dead_canopy_si_scls(io_si,scls) + & + ccohort%npp_dead * ccohort%n + hio_npp_seed_canopy_si_scls(io_si,scls) = hio_npp_seed_canopy_si_scls(io_si,scls) + & + ccohort%npp_seed * ccohort%n + hio_npp_stor_canopy_si_scls(io_si,scls) = hio_npp_stor_canopy_si_scls(io_si,scls) + & + ccohort%npp_stor * ccohort%n hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n @@ -1648,8 +1677,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bstore_md * ccohort%n hio_bdead_md_understory_si_scls(io_si,scls) = hio_bdead_md_understory_si_scls(io_si,scls) + & ccohort%bdead_md * ccohort%n - hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & - ccohort%carbon_balance * ccohort%n hio_seed_prod_understory_si_scls(io_si,scls) = hio_seed_prod_understory_si_scls(io_si,scls) + & ccohort%seed_prod * ccohort%n hio_dbdeaddt_understory_si_scls(io_si,scls) = hio_dbdeaddt_understory_si_scls(io_si,scls) + & @@ -1657,19 +1684,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_dbstoredt_understory_si_scls(io_si,scls) = hio_dbstoredt_understory_si_scls(io_si,scls) + & ccohort%dbstoredt * ccohort%n hio_storage_flux_understory_si_scls(io_si,scls) = hio_storage_flux_understory_si_scls(io_si,scls) + & - ccohort%npp_store * ccohort%n + ccohort%npp_stor * 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_fnrt_understory_si_scls(io_si,scls) = hio_npp_fnrt_understory_si_scls(io_si,scls) + & + ccohort%npp_fnrt * ccohort%n + hio_npp_sapw_understory_si_scls(io_si,scls) = hio_npp_sapw_understory_si_scls(io_si,scls) + & + ccohort%npp_sapw * ccohort%n + hio_npp_dead_understory_si_scls(io_si,scls) = hio_npp_dead_understory_si_scls(io_si,scls) + & + ccohort%npp_dead * ccohort%n + hio_npp_seed_understory_si_scls(io_si,scls) = hio_npp_seed_understory_si_scls(io_si,scls) + & + ccohort%npp_seed * ccohort%n + hio_npp_stor_understory_si_scls(io_si,scls) = hio_npp_stor_understory_si_scls(io_si,scls) + & + ccohort%npp_stor * ccohort%n hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n @@ -3137,7 +3164,6 @@ 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_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, & @@ -3178,6 +3204,31 @@ 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_npp_stor_si_scpf ) + call this%set_history_var(vname = 'FCFIX_STOR_SCPF', units='kgC/m2/yr', & + long='flux into storage for fusion corrections 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_fcfix_stor_si_scpf ) + + call this%set_history_var(vname = 'FCFIX_LEAF_SCPF', units='kgC/m2/yr', & + long='flux into leaves for fusion corrections 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_fcfix_leaf_si_scpf ) + + call this%set_history_var(vname = 'FCFIX_FNRT_SCPF', units='kgC/m2/yr', & + long='flux into fine-roots for fusion corrections 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_fcfix_fnrt_si_scpf ) + + call this%set_history_var(vname = 'FCFIX_SAPW_SCPF', units='kgC/m2/yr', & + long='flux into sapwood for fusion corrections 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_fcfix_sapw_si_scpf ) + + call this%set_history_var(vname = 'FCFIX_DEAD_SCPF', units='kgC/m2/yr', & + long='flux into structure for fusion corrections 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_fcfix_dead_si_scpf ) + call this%set_history_var(vname='DDBH_SCPF', units = 'cm/yr/ha', & long='diameter growth increment by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3450,11 +3501,6 @@ 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_bsw_md_canopy_si_scls ) - call this%set_history_var(vname='CARBON_BALANCE_CANOPY_SCLS', units = 'kg C / ha / yr', & - long='CARBON_BALANCE 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_carbon_balance_canopy_si_scls ) - call this%set_history_var(vname='SEED_PROD_CANOPY_SCLS', units = 'kg C / ha / yr', & long='SEED_PROD for canopy plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3480,30 +3526,30 @@ 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_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', & + call this%set_history_var(vname='NPP_FNRT_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_FNRT 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_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', & + call this%set_history_var(vname='NPP_SAPW_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_SAPW 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_sapw_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', & + call this%set_history_var(vname='NPP_DEAD_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_DEAD 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_dead_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', & + call this%set_history_var(vname='NPP_SEED_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_SEED 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_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', & + call this%set_history_var(vname='NPP_STOR_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='NPP_STOR 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_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', & @@ -3560,11 +3606,6 @@ 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_bsw_md_understory_si_scls ) - call this%set_history_var(vname='CARBON_BALANCE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & - long='CARBON_BALANCE 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_carbon_balance_understory_si_scls ) - call this%set_history_var(vname='SEED_PROD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & long='SEED_PROD for understory plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3590,30 +3631,30 @@ 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_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', & + call this%set_history_var(vname='NPP_FNRT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_FNRT 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_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', & + call this%set_history_var(vname='NPP_SAPW_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_SAPW 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_sapw_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', & + call this%set_history_var(vname='NPP_DEAD_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_DEAD 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_dead_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', & + call this%set_history_var(vname='NPP_SEED_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_SEED 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_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', & + call this%set_history_var(vname='NPP_STOR_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='NPP_STOR 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 ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_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', & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index acaba26574..7e6585a2e2 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -98,6 +98,13 @@ module FatesRestartInterfaceMod integer, private :: ir_npp_dead_co integer, private :: ir_npp_seed_co integer, private :: ir_npp_store_co + + integer, private :: ir_fcfix_leaf_co + integer, private :: ir_fcfix_fnrt_co + integer, private :: ir_fcfix_sapw_co + integer, private :: ir_fcfix_dead_co + integer, private :: ir_fcfix_stor_co + integer, private :: ir_bmort_co integer, private :: ir_hmort_co integer, private :: ir_cmort_co @@ -740,6 +747,32 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_store_co ) + call this%set_restart_var(vname='fates_fcfix_stor', vtype=cohort_r8, & + long_name='ed cohort - fusion corrections sent to storage biomass', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_stor_co ) + + call this%set_restart_var(vname='fates_fcfix_sapw', vtype=cohort_r8, & + long_name='ed cohort - fusion corrections sent to sapwood biomass', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_sapw_co ) + + call this%set_restart_var(vname='fates_fcfix_fnrt', vtype=cohort_r8, & + long_name='ed cohort - fusion corrections sent to fineroot biomass', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_fnrt_co ) + + call this%set_restart_var(vname='fates_fcfix_leaf', vtype=cohort_r8, & + long_name='ed cohort - fusion corrections sent to leaf biomass', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_leaf_co ) + + call this%set_restart_var(vname='fates_fcfix_dead', vtype=cohort_r8, & + long_name='ed cohort - fusion corrections sent to storage biomass', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_dead_co ) + + call this%set_restart_var(vname='fates_bmort', vtype=cohort_r8, & long_name='ed cohort - background mortality rate', & units='/year', flushval = flushzero, & @@ -1071,7 +1104,11 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & - + rio_fcfix_leaf_co => this%rvars(ir_fcfix_leaf_co)%r81d, & + rio_fcfix_fnrt_co => this%rvars(ir_fcfix_fnrt_co)%r81d, & + rio_fcfix_sapw_co => this%rvars(ir_fcfix_sapw_co)%r81d, & + rio_fcfix_stor_co => this%rvars(ir_fcfix_stor_co)%r81d, & + rio_fcfix_dead_co => this%rvars(ir_fcfix_dead_co)%r81d, & rio_lmort_logging_co => this%rvars(ir_lmort_logging_co)%r81d, & rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & @@ -1184,16 +1221,22 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_gpp_acc_hold_co(io_idx_co) = ccohort%gpp_acc_hold rio_npp_acc_hold_co(io_idx_co) = ccohort%npp_acc_hold rio_npp_leaf_co(io_idx_co) = ccohort%npp_leaf - rio_npp_froot_co(io_idx_co) = ccohort%npp_froot - rio_npp_sw_co(io_idx_co) = ccohort%npp_bsw - rio_npp_dead_co(io_idx_co) = ccohort%npp_bdead - rio_npp_seed_co(io_idx_co) = ccohort%npp_bseed - rio_npp_store_co(io_idx_co) = ccohort%npp_store + rio_npp_froot_co(io_idx_co) = ccohort%npp_fnrt + rio_npp_sw_co(io_idx_co) = ccohort%npp_sapw + rio_npp_dead_co(io_idx_co) = ccohort%npp_dead + rio_npp_seed_co(io_idx_co) = ccohort%npp_seed + rio_npp_store_co(io_idx_co) = ccohort%npp_stor 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_fmort_co(io_idx_co) = ccohort%fmort + rio_fcfix_leaf_co(io_idx_co) = ccohort%fcfix_leaf + rio_fcfix_fnrt_co(io_idx_co) = ccohort%fcfix_fnrt + rio_fcfix_sapw_co(io_idx_co) = ccohort%fcfix_sapw + rio_fcfix_stor_co(io_idx_co) = ccohort%fcfix_stor + rio_fcfix_dead_co(io_idx_co) = ccohort%fcfix_dead + !Logging rio_lmort_logging_co(io_idx_co) = ccohort%lmort_logging rio_lmort_collateral_co(io_idx_co) = ccohort%lmort_collateral @@ -1659,6 +1702,12 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & + rio_fcfix_leaf_co => this%rvars(ir_fcfix_leaf_co)%r81d, & + rio_fcfix_fnrt_co => this%rvars(ir_fcfix_fnrt_co)%r81d, & + rio_fcfix_sapw_co => this%rvars(ir_fcfix_sapw_co)%r81d, & + rio_fcfix_stor_co => this%rvars(ir_fcfix_stor_co)%r81d, & + rio_fcfix_dead_co => this%rvars(ir_fcfix_dead_co)%r81d, & + rio_lmort_logging_co => this%rvars(ir_lmort_logging_co)%r81d, & rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & @@ -1753,16 +1802,22 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%gpp_acc_hold = rio_gpp_acc_hold_co(io_idx_co) ccohort%npp_acc_hold = rio_npp_acc_hold_co(io_idx_co) ccohort%npp_leaf = rio_npp_leaf_co(io_idx_co) - ccohort%npp_froot = rio_npp_froot_co(io_idx_co) - ccohort%npp_bsw = rio_npp_sw_co(io_idx_co) - ccohort%npp_bdead = rio_npp_dead_co(io_idx_co) - ccohort%npp_bseed = rio_npp_seed_co(io_idx_co) - ccohort%npp_store = rio_npp_store_co(io_idx_co) + ccohort%npp_fnrt = rio_npp_froot_co(io_idx_co) + ccohort%npp_sapw = rio_npp_sw_co(io_idx_co) + ccohort%npp_dead = rio_npp_dead_co(io_idx_co) + ccohort%npp_seed = rio_npp_seed_co(io_idx_co) + ccohort%npp_stor = rio_npp_store_co(io_idx_co) 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%fmort = rio_fmort_co(io_idx_co) + ccohort%fcfix_leaf = rio_fcfix_leaf_co(io_idx_co) + ccohort%fcfix_fnrt = rio_fcfix_fnrt_co(io_idx_co) + ccohort%fcfix_sapw = rio_fcfix_sapw_co(io_idx_co) + ccohort%fcfix_stor = rio_fcfix_stor_co(io_idx_co) + ccohort%fcfix_dead = rio_fcfix_dead_co(io_idx_co) + !Logging ccohort%lmort_logging = rio_lmort_logging_co(io_idx_co) ccohort%lmort_collateral = rio_lmort_collateral_co(io_idx_co) From a7e5afeef7d1a15753ff104efed29adead48a19d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 20 Dec 2017 19:13:57 -0700 Subject: [PATCH 050/111] 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 051/111] 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 052/111] 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 053/111] 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 054/111] 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 055/111] 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 89cff37a4ee1cdaae270f1cba57d5adb7072e223 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 12 Jan 2018 20:13:07 -0800 Subject: [PATCH 056/111] Modified prioritized carbon flux for leaf and fineroot turnover replacement. --- biogeochem/EDPhysiologyMod.F90 | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 540352cde8..b3752fe23a 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1071,23 +1071,16 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if(total_turnover_demand>0.0_r8)then ! If we are testing b4b, then we pay this even if we don't have the carbon - if(test_b4b) then - bl_flux = leaf_turnover_demand - else - bl_flux = min(leaf_turnover_demand, max(0.0_r8,carbon_balance*(leaf_turnover_demand/total_turnover_demand))) - end if - + ! Just don't pay so much carbon that storage+carbon_balance can't pay for it + + bl_flux = min(leaf_turnover_demand, (currentCohort%bstore+carbon_balance)*(leaf_turnover_demand/total_turnover_demand)) + carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day ! If we are testing b4b, then we pay this even if we don't have the carbon - if(test_b4b) then - br_flux = root_turnover_demand - else - br_flux = min(root_turnover_demand, max(0.0_r8,carbon_balance*(root_turnover_demand/total_turnover_demand))) - end if - + br_flux = min(root_turnover_demand, (currentCohort%bstore+carbon_balance)*(root_turnover_demand/total_turnover_demand)) carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux From c1ffd87eae6faebd5bed654ac7c472e1f18f0d1a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 13 Jan 2018 13:42:13 -0800 Subject: [PATCH 057/111] Cleaned up some allometry calls that do not need height arguments --- biogeochem/EDMortalityFunctionsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 27 +++++++++++----------- biogeochem/FatesAllometryMod.F90 | 32 +++++++++++--------------- main/EDInitMod.F90 | 7 +++--- main/FatesInventoryInitMod.F90 | 7 +++--- 5 files changed, 34 insertions(+), 41 deletions(-) diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 68cca9934d..5f48c77c33 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -72,7 +72,7 @@ subroutine mortality_rates( cohort_in,cmort,hmort,bmort ) ! 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) + call bleaf(cohort_in%dbh,cohort_in%pft,cohort_in%canopy_trim,b_leaf) if( b_leaf > 0._r8 .and. cohort_in%bstore <= b_leaf )then frac = cohort_in%bstore/ b_leaf cmort = max(0.0_r8,ED_val_stress_mort*(1.0_r8 - frac)) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index b3752fe23a..e91ddca088 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -182,8 +182,8 @@ 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) + call bleaf(currentcohort%dbh,ipft,currentcohort%canopy_trim,tar_bl) + call bfineroot(currentcohort%dbh,ipft,currentcohort%canopy_trim,tar_bfr) bfr_per_bleaf = tar_bfr/tar_bl @@ -904,7 +904,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! Target leaf biomass according to allometry and trimming - call bleaf(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) + call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) ! If status_coh is 1, then leaves are in a dropped (off allometry) if( currentcohort%status_coh == 1 ) then @@ -913,7 +913,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] - call bfineroot(currentCohort%dbh,currentCohort%hite,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) + call bfineroot(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) ! Target sapwood biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bsap_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) @@ -928,8 +928,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) ! Target storage carbon [kgC,kgC/cm] - call bstore_allom(currentCohort%dbh,currentCohort%hite,ipft, & - currentCohort%canopy_trim,bt_store,dbt_store_dd) + call bstore_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) ! ----------------------------------------------------------------------------------- ! III. If fusion pushed a plant off allometry, we could have negatives @@ -1260,13 +1259,14 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) do istep=1,nsteps - call bleaf(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) - call bfineroot(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) + call bleaf(dbh_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) + call bfineroot(dbh_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) call bsap_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) call bagw_allom(dbh_sub,ipft,bt_agw,dbt_agw_dd) call bbgw_allom(dbh_sub,ipft,bt_bgw,dbt_bgw_dd) - call bdead_allom(bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) - call bstore_allom(dbh_sub,h_sub,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) + call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & + dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) + call bstore_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) ! fraction of carbon going towards reproduction if (dbh_sub <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass @@ -1426,16 +1426,15 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) ! Initialize live pools - 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 bleaf(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_leaf) + call bfineroot(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_fineroot) call bsap_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,b_sapwood) call bagw_allom(temp_cohort%dbh,ft,b_agw) call bbgw_allom(temp_cohort%dbh,ft,b_bgw) call bdead_allom(b_agw,b_bgw,b_sapwood,ft,temp_cohort%bdead) - call bstore_allom(temp_cohort%dbh,temp_cohort%hite, ft, & - temp_cohort%canopy_trim,temp_cohort%bstore) + call bstore_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,temp_cohort%bstore) 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 & diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 42f9833f0a..781b134fd6 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -165,8 +165,8 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier ierr = 0 call h_allom(dbh,ipft,height) - call bleaf(dbh,height,ipft,canopy_trim,bl_diag) - call bfineroot(dbh,height,ipft,canopy_trim,bfr_diag) + call bleaf(dbh,ipft,canopy_trim,bl_diag) + call bfineroot(dbh,ipft,canopy_trim,bfr_diag) call bsap_allom(dbh,ipft,canopy_trim,bsap_diag) call bagw_allom(dbh,ipft,bagw_diag) call bbgw_allom(dbh,ipft,bbgw_diag) @@ -345,10 +345,9 @@ end subroutine bagw_allom ! Generic diameter to maximum leaf biomass interface ! ============================================================================ - subroutine blmax_allom(d,h,ipft,blmax,dblmaxdd) + subroutine blmax_allom(d,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] @@ -423,7 +422,7 @@ end subroutine carea_allom ! ===================================================================================== - subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) + subroutine bleaf(d,ipft,canopy_trim,bl,dbldd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target bleaf @@ -433,7 +432,6 @@ 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] @@ -442,7 +440,7 @@ subroutine bleaf(d,h,ipft,canopy_trim,bl,dbldd) real(r8) :: blmax real(r8) :: dblmaxdd - call blmax_allom(d,h,ipft,blmax,dblmaxdd) + call blmax_allom(d,ipft,blmax,dblmaxdd) ! ------------------------------------------------------------------------- ! Adjust for canopies that have become so deep that their bottom layer is @@ -499,7 +497,7 @@ subroutine bsap_allom(d,ipft,canopy_trim,bsap,dbsapdd) case(1,2) !"constant","dlinear") call h_allom(d,ipft,h,dhdd) - call bleaf(d,h,ipft,canopy_trim,bl,dbldd) + call bleaf(d,ipft,canopy_trim,bl,dbldd) call bsap_dlinear(d,h,dhdd,bl,dbldd,ipft,bsap,dbsapdd) ! Perform a capping/check on total woody biomass @@ -519,7 +517,7 @@ subroutine bsap_allom(d,ipft,canopy_trim,bsap,dbsapdd) case(9) ! deprecated (9) call h_allom(d,ipft,h,dhdd) - call bleaf(d,h,ipft,canopy_trim,bl,dbldd) + call bleaf(d,ipft,canopy_trim,bl,dbldd) call bsap_deprecated(d,h,dhdd,bl,dbldd,ipft,bsap,dbsapdd) case DEFAULT @@ -564,7 +562,7 @@ end subroutine bbgw_allom ! Fine root biomass allometry wrapper ! ============================================================================ - subroutine bfineroot(d,h,ipft,canopy_trim,bfr,dbfrdd) + subroutine bfineroot(d,ipft,canopy_trim,bfr,dbfrdd) ! ------------------------------------------------------------------------- ! This subroutine calculates the actual target fineroot biomass @@ -572,7 +570,6 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfr,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(in) :: canopy_trim ! trimming function real(r8),intent(out) :: bfr ! fine root biomass [kgC] @@ -587,7 +584,7 @@ subroutine bfineroot(d,h,ipft,canopy_trim,bfr,dbfrdd) select case(int(EDPftvarcon_inst%allom_fmode(ipft))) case(1) ! "constant proportionality with bleaf" - call blmax_allom(d,h,ipft,blmax,dblmaxdd) + call blmax_allom(d,ipft,blmax,dblmaxdd) call bfrmax_const(d,blmax,dblmaxdd,ipft,bfrmax,dbfrmaxdd) bfr = bfrmax * canopy_trim if(present(dbfrdd))then @@ -608,10 +605,9 @@ end subroutine bfineroot ! Storage biomass interface ! ============================================================================ - subroutine bstore_allom(d,h,ipft,canopy_trim,bstore,dbstoredd) + subroutine bstore_allom(d,ipft,canopy_trim,bstore,dbstoredd) 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 ! Crown trimming function [0-1] real(r8),intent(out) :: bstore ! allometric target storage [kgC] @@ -630,7 +626,7 @@ subroutine bstore_allom(d,h,ipft,canopy_trim,bstore,dbstoredd) case(1) ! Storage is constant proportionality of trimmed maximum leaf ! biomass (ie cushion * bleaf) - call bleaf(d,h,ipft,canopy_trim,bl,dbldd) + call bleaf(d,ipft,canopy_trim,bl,dbldd) call bstore_blcushion(d,bl,dbldd,cushion,ipft,bstore,dbstoredd) case DEFAULT @@ -756,9 +752,9 @@ subroutine bbgw_const(d,bagw,dbagwdd,ipft,bbgw,dbbgwdd) return end subroutine bbgw_const - ! ============================================================================ - ! Specific d2bsap relationships - ! ============================================================================ + ! ============================================================================ + ! Specific d2bsap relationships + ! ============================================================================ subroutine bsap_deprecated(d,h,dhdd,bleaf,dbleafdd,ipft,bsap,dbsapdd) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 44a50d1ea7..3661bede9e 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -378,19 +378,18 @@ subroutine init_cohorts( patch_in, bc_in) ! Calculate the leaf biomass from allometry ! (calculates a maximum first, then applies canopy trim) - call bleaf(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_leaf) + call bleaf(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_leaf) ! Calculate fine root biomass from allometry ! (calculates a maximum and then trimming value) - call bfineroot(temp_cohort%dbh,temp_cohort%hite,pft,temp_cohort%canopy_trim,b_fineroot) + call bfineroot(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,pft,temp_cohort%canopy_trim,b_sapwood) call bdead_allom( b_agw, b_bgw, b_sapwood, pft, temp_cohort%bdead ) - call bstore_allom(temp_cohort%dbh,temp_cohort%hite, pft, & - temp_cohort%canopy_trim,temp_cohort%bstore) + call bstore_allom(temp_cohort%dbh, pft, temp_cohort%canopy_trim,temp_cohort%bstore) if( EDPftvarcon_inst%evergreen(pft) == 1) then diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 3dabf26060..c9bcda2b1a 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -884,18 +884,17 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! 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) + call bleaf(temp_cohort%dbh,c_pft,temp_cohort%canopy_trim,b_leaf) ! Calculate fine root biomass - call bfineroot(temp_cohort%dbh,temp_cohort%hite,c_pft,temp_cohort%canopy_trim,b_fineroot) + call bfineroot(temp_cohort%dbh,c_pft,temp_cohort%canopy_trim,b_fineroot) ! Calculate sapwood biomass call bsap_allom(temp_cohort%dbh,c_pft,temp_cohort%canopy_trim,b_sapwood) call bdead_allom( b_agw, b_bgw, b_sapwood, c_pft, temp_cohort%bdead ) - call bstore_allom(temp_cohort%dbh,temp_cohort%hite, c_pft, & - temp_cohort%canopy_trim,temp_cohort%bstore) + call bstore_allom(temp_cohort%dbh, c_pft, temp_cohort%canopy_trim,temp_cohort%bstore) if( EDPftvarcon_inst%evergreen(c_pft) == 1) then temp_cohort%laimemory = 0._r8 From c4c13716617671081ad17d05bcf20566f155d8f7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 14 Jan 2018 14:59:08 -0800 Subject: [PATCH 058/111] Made an option to remove a forced fix on plant pools that are above allometry from fusion. --- biogeochem/EDPhysiologyMod.F90 | 195 +++++++++++++++++++------------ biogeochem/FatesAllometryMod.F90 | 121 ++++++++++++------- 2 files changed, 202 insertions(+), 114 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e91ddca088..14c89937b7 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -811,6 +811,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: root_turnover_demand ! fineroot carbon that is demanded to replace maintenance turnover [kgC] real(r8) :: total_turnover_demand ! total carbon that is demanded to replace maintenance turnover [kgC] + logical :: grow_leaf + logical :: grow_froot + logical :: grow_sap + logical :: grow_store + logical :: grow_dead + ! integrator variables real(r8) :: deltaC ! trial value for substep integer :: ierr ! error flag for allometric growth step @@ -837,6 +843,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance integer , parameter :: max_substeps = 16 + logical , parameter :: no_forced_allometry = .true. + ipft = currentCohort%pft ! Initialize seed production @@ -939,43 +947,46 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! track these npp partition diagnostics. ! ----------------------------------------------------------------------------------- - leaf_below_target = bt_leaf - currentCohort%bl - froot_below_target = bt_fineroot - currentCohort%br - sap_below_target = bt_sap - currentCohort%bsw - store_below_target = bt_store - currentCohort%bstore - dead_below_target = bt_dead - currentCohort%bdead - + if( no_forced_allometry ) then - if(leaf_below_target<0.0_r8) then - carbon_balance = carbon_balance - leaf_below_target - currentCohort%bl = currentCohort%bl + leaf_below_target - currentCohort%fcfix_leaf = currentCohort%fcfix_leaf + leaf_below_target / hlm_freq_day - end if - - if(froot_below_target<0.0_r8) then - carbon_balance = carbon_balance - froot_below_target - currentCohort%br = currentCohort%br + froot_below_target - currentCohort%fcfix_fnrt = currentCohort%fcfix_fnrt + froot_below_target / hlm_freq_day - end if - - if(sap_below_target<0.0_r8) then - carbon_balance = carbon_balance - sap_below_target - currentCohort%bsw = currentCohort%bsw + sap_below_target - currentCohort%fcfix_sapw = currentCohort%fcfix_sapw + sap_below_target / hlm_freq_day - end if - - if(store_below_target<0.0_r8) then - carbon_balance = carbon_balance - store_below_target - currentCohort%bstore = currentCohort%bstore + store_below_target - currentCohort%fcfix_stor = currentCohort%fcfix_stor + store_below_target / hlm_freq_day - end if + leaf_below_target = bt_leaf - currentCohort%bl + froot_below_target = bt_fineroot - currentCohort%br + sap_below_target = bt_sap - currentCohort%bsw + store_below_target = bt_store - currentCohort%bstore + dead_below_target = bt_dead - currentCohort%bdead + + + if(leaf_below_target<0.0_r8) then + carbon_balance = carbon_balance - leaf_below_target + currentCohort%bl = currentCohort%bl + leaf_below_target + currentCohort%fcfix_leaf = currentCohort%fcfix_leaf + leaf_below_target / hlm_freq_day + end if + + if(froot_below_target<0.0_r8) then + carbon_balance = carbon_balance - froot_below_target + currentCohort%br = currentCohort%br + froot_below_target + currentCohort%fcfix_fnrt = currentCohort%fcfix_fnrt + froot_below_target / hlm_freq_day + end if + + if(sap_below_target<0.0_r8) then + carbon_balance = carbon_balance - sap_below_target + currentCohort%bsw = currentCohort%bsw + sap_below_target + currentCohort%fcfix_sapw = currentCohort%fcfix_sapw + sap_below_target / hlm_freq_day + end if + + if(store_below_target<0.0_r8) then + carbon_balance = carbon_balance - store_below_target + currentCohort%bstore = currentCohort%bstore + store_below_target + currentCohort%fcfix_stor = currentCohort%fcfix_stor + store_below_target / hlm_freq_day + end if - if(dead_below_target<0.0_r8) then - carbon_balance = carbon_balance - dead_below_target - currentCohort%bdead = currentCohort%bdead + dead_below_target - currentCohort%fcfix_dead = currentCohort%fcfix_dead + dead_below_target / hlm_freq_day + if(dead_below_target<0.0_r8) then + carbon_balance = carbon_balance - dead_below_target + currentCohort%bdead = currentCohort%bdead + dead_below_target + currentCohort%fcfix_dead = currentCohort%fcfix_dead + dead_below_target / hlm_freq_day + end if end if - + ! ----------------------------------------------------------------------------------- ! IV(a). Calculate the maintenance turnover demands @@ -1060,7 +1071,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! VI(b). Prioritize some amount of carbon to replace leaf/root turnover ! Make sure it isnt a negative payment, and either pay what is available - ! or forcefully pay from storage. + ! or forcefully pay from storage. ! ----------------------------------------------------------------------------------- leaf_turnover_demand = currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(ipft)*hlm_freq_day @@ -1071,7 +1082,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! If we are testing b4b, then we pay this even if we don't have the carbon ! Just don't pay so much carbon that storage+carbon_balance can't pay for it - + bl_flux = min(leaf_turnover_demand, (currentCohort%bstore+carbon_balance)*(leaf_turnover_demand/total_turnover_demand)) carbon_balance = carbon_balance - bl_flux @@ -1139,15 +1150,17 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! VII(e). If carbon is still available, we try to push all live - ! pools back towards allometry + ! pools back towards allometry. But only upwards, if fusion happened + ! to generate some pools above allometric target, don't reduce the pool, + ! just ignore it until the rest of the plant grows to meet it. ! ----------------------------------------------------------------------------------- if( carbon_balance 0.0_r8 .and. dead_below_target>0.0_r8) then @@ -1203,7 +1216,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! V(e). If carbon is yet still available ... - ! Our pools are now on allometry, and we can increment all pools + ! Our pools are now either on allometry or above (from fusion). + ! We we can increment those pools at or below, ! including structure and reproduction according to their rates ! Use an adaptive euler integration. If the error is not nominal, ! the carbon balance sub-step (deltaC) will be halved and tried again @@ -1211,36 +1225,57 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if( carbon_balancecalloc_abs_error) then + if( (bt_leaf - currentCohort%bl)>calloc_abs_error) then write(fates_log(),*) 'leaves are not on-allometry at the growth step' write(fates_log(),*) 'exiting',currentCohort%bl,bt_leaf,currentCohort%bl - bt_leaf call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( (currentCohort%bl - bt_leaf)>calloc_abs_error) then + ! leaf is above allometry, ignore + grow_leaf = .false. + else + grow_leaf = .true. end if - - if(abs(currentCohort%br - bt_fineroot)>calloc_abs_error) then + + if( (bt_fineroot - currentCohort%br)>calloc_abs_error) then write(fates_log(),*) 'fineroots are not on-allometry at the growth step' write(fates_log(),*) 'exiting',currentCohort%br,bt_fineroot,currentCohort%br - bt_fineroot call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( (currentCohort%br-bt_fineroot)>calloc_abs_error ) then + grow_froot = .false. + else + grow_froot = .true. end if - if(abs(currentCohort%bsw - bt_sap)>calloc_abs_error) then + if( (bt_sap - currentCohort%bsw)>calloc_abs_error) then write(fates_log(),*) 'sapwood is not on-allometry at the growth step' write(fates_log(),*) 'exiting',currentCohort%bsw,bt_sap,currentCohort%bsw - bt_sap call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( (currentCohort%bsw-bt_sap)>calloc_abs_error ) then + grow_sap = .false. + else + grow_sap = .true. end if - - if(abs(currentCohort%bdead - bt_dead)>calloc_abs_error) then + + if( (bt_dead - currentCohort%bdead)>calloc_abs_error) then write(fates_log(),*) 'dead wood is not on-allometry at the growth step' write(fates_log(),*) 'exiting',currentCohort%bdead,bt_dead,currentCohort%bdead - bt_dead call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( (currentCohort%bdead-bt_dead)>calloc_abs_error ) then + grow_dead = .false. + else + grow_dead = .true. end if - if(abs(currentCohort%bstore - bt_store)>calloc_abs_error) then + if( (bt_store - currentCohort%bstore)>calloc_abs_error) then write(fates_log(),*) 'storage is not on-allometry at the growth step' write(fates_log(),*) 'exiting',currentCohort%bstore,bt_store,currentCohort%bstore - bt_store call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( (currentCohort%bstore-bt_store)>calloc_abs_error ) then + grow_store = .false. + else + grow_store = .true. end if - + deltaC = carbon_balance nsteps = 1 ierr = 1 @@ -1275,30 +1310,45 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) end if - dbt_total_dd = dbt_leaf_dd + dbt_fineroot_dd + dbt_sap_dd + dbt_dead_dd + dbt_store_dd - - bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - brepro_flux = deltaC * repro_fraction + dbt_total_dd = 0.0_r8 - ! Take a sub-step + if (grow_leaf) dbt_total_dd = dbt_total_dd + dbt_leaf_dd + if (grow_froot) dbt_total_dd = dbt_total_dd + dbt_fineroot_dd + if (grow_sap) dbt_total_dd = dbt_total_dd + dbt_sap_dd + if (grow_dead) dbt_total_dd = dbt_total_dd + dbt_dead_dd + if (grow_store) dbt_total_dd = dbt_total_dd + dbt_store_dd - bl_sub = bl_sub + bl_flux - br_sub = br_sub + br_flux - bsw_sub = bsw_sub + bsw_flux - bstore_sub = bstore_sub + bstore_flux - bdead_sub = bdead_sub + bdead_flux + if (grow_leaf) then + bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bl_sub = bl_sub + bl_flux + end if + + if (grow_froot) then + br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + br_sub = br_sub + br_flux + end if + + if (grow_sap) then + bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bsw_sub = bsw_sub + bsw_flux + end if + + if (grow_store) then + bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bstore_sub = bstore_sub + bstore_flux + end if + + if (grow_dead) then + bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bdead_sub = bdead_sub + bdead_flux + dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd + call h_allom(dbh_sub,ipft,h_sub) + end if + + + brepro_flux = deltaC * repro_fraction brepro_sub = brepro_sub + brepro_flux - ! ----------------------------------------------------------------------------------- - ! VII. Update the diameter and height allometries if we had structural growth - ! ----------------------------------------------------------------------------------- - - dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd - call h_allom(dbh_sub,ipft,h_sub) ! ------------------------------------------------------------------------------------ ! VIII. Run a post integration test to see if our integrated quantities match @@ -1317,7 +1367,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & - bl_sub,br_sub,bsw_sub,bdead_sub,ierr) + bl_sub,br_sub,bsw_sub,bstore_sub,bdead_sub, & + grow_leaf, grow_froot, grow_sap, grow_store, grow_dead, ierr) if(ierr.eq.0 .or. nsteps > max_substeps ) then diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 781b134fd6..fc62fc94c6 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -133,7 +133,10 @@ module FatesAllometryMod ! Check to make sure Martinez-Cano height cap is not on, or explicitly allowed - subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ierr) + subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & + bl,bfr,bsap,bstore,bdead, & + grow_leaf, grow_fr, grow_sap, grow_store, grow_dead, & + ierr) ! This routine checks the error on the carbon allocation ! integration step. The integrated quantities should @@ -149,7 +152,14 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier real(r8),intent(in) :: bl ! integrated leaf biomass [kgC] real(r8),intent(in) :: bfr ! integrated fine root biomass [kgC] real(r8),intent(in) :: bsap ! integrated sapwood biomass [kgC] + real(r8),intent(in) :: bstore ! integrated storage biomass [kgC] real(r8),intent(in) :: bdead ! integrated structural biomass [kgc] + logical,intent(in) :: grow_leaf ! on-off switch for leaf growth + logical,intent(in) :: grow_fr ! on-off switch for root growth + logical,intent(in) :: grow_sap ! on-off switch for sapwood + logical,intent(in) :: grow_store! on-off switch for storage + logical,intent(in) :: grow_dead ! on-off switch for structure + integer,intent(out) :: ierr ! Error flag (0=pass, 1=fail) real(r8) :: height ! diagnosed height [m] @@ -157,6 +167,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier real(r8) :: bfr_diag ! diagnosed fine-root biomass [kgC] real(r8) :: bsap_diag ! diagnosed sapwood biomass [kgC] real(r8) :: bdead_diag ! diagnosed structural biomass [kgC] + real(r8) :: bstore_diag ! diagnosed storage biomass [kgC] real(r8) :: bagw_diag ! diagnosed agbw [kgC] real(r8) :: bbgw_diag ! diagnosed below ground wood [kgC] @@ -165,57 +176,83 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim,bl,bfr,bsap,bdead,ier ierr = 0 call h_allom(dbh,ipft,height) - call bleaf(dbh,ipft,canopy_trim,bl_diag) - call bfineroot(dbh,ipft,canopy_trim,bfr_diag) - call bsap_allom(dbh,ipft,canopy_trim,bsap_diag) - call bagw_allom(dbh,ipft,bagw_diag) - call bbgw_allom(dbh,ipft,bbgw_diag) - call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) - - if( abs(bl_diag-bl)/bl_diag > relative_err_thresh ) then - if(verbose_logging) then - write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bl (integrated): ',bl - write(fates_log(),*) 'bl (diagnosed): ',bl_diag - write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag + + + + if (grow_leaf) then + call bleaf(dbh,ipft,canopy_trim,bl_diag) + if( abs(bl_diag-bl)/bl_diag > relative_err_thresh ) then + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bl (integrated): ',bl + write(fates_log(),*) 'bl (diagnosed): ',bl_diag + write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag + end if + ierr = 1 + end if + end if + + if (grow_fr) then + call bfineroot(dbh,ipft,canopy_trim,bfr_diag) + if( abs(bfr_diag-bfr)/bfr_diag > relative_err_thresh ) then + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bfr (integrated): ',bfr + write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag + write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag + end if + ierr = 1 end if - ierr = 1 end if - if( abs(bfr_diag-bfr)/bfr_diag > relative_err_thresh ) then - if(verbose_logging) then - write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bfr (integrated): ',bfr - write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag - write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag + if (grow_sap) then + call bsap_allom(dbh,ipft,canopy_trim,bsap_diag) + if( abs(bsap_diag-bsap)/bsap_diag > relative_err_thresh ) then + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bsap (integrated): ',bsap + write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag + write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag + end if + ierr = 1 end if - ierr = 1 end if - - if( abs(bsap_diag-bsap)/bsap_diag > relative_err_thresh ) then - if(verbose_logging) then - write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bsap (integrated): ',bsap - write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag - write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag + + if (grow_store) then + call bstore_allom(dbh,ipft,canopy_trim,bstore_diag) + if( abs(bstore_diag-bstore)/bstore_diag > relative_err_thresh ) then + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed storage carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bsap (integrated): ',bstore + write(fates_log(),*) 'bsap (diagnosed): ',bstore_diag + write(fates_log(),*) 'relative error: ',abs(bstore_diag-bstore)/bstore_diag + end if + ierr = 1 end if - ierr = 1 end if - if( abs(bdead_diag-bdead)/bdead_diag > relative_err_thresh ) then - if(verbose_logging) then - write(fates_log(),*) 'disparity in integrated/diagnosed structural carbon' - write(fates_log(),*) 'resulting from the on-allometry growth integration step' - write(fates_log(),*) 'bdead (integrated): ',bdead - write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag - write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag + + if (grow_dead) then + call bsap_allom(dbh,ipft,canopy_trim,bsap_diag) + call bagw_allom(dbh,ipft,bagw_diag) + call bbgw_allom(dbh,ipft,bbgw_diag) + call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) + if( abs(bdead_diag-bdead)/bdead_diag > relative_err_thresh ) then + if(verbose_logging) then + write(fates_log(),*) 'disparity in integrated/diagnosed structural carbon' + write(fates_log(),*) 'resulting from the on-allometry growth integration step' + write(fates_log(),*) 'bdead (integrated): ',bdead + write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag + write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag + end if + ierr = 1 end if - ierr = 1 end if - + return end subroutine CheckIntegratedAllometries From bbefa2d59050c1a4ceffccaa10d44ca9632e39c4 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 18 Jan 2018 09:14:27 -0800 Subject: [PATCH 059/111] 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 f6efedabcfed05b7ffdccbbe1a1dfa229b0798ec Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 14:13:55 -0800 Subject: [PATCH 060/111] Added test to revert to bug in deriviative to check against previous results. Set a more reasonable error tolerance on the NPP partition check. --- biogeochem/FatesAllometryMod.F90 | 9 +++++++-- main/FatesHistoryInterfaceMod.F90 | 2 +- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 42f9833f0a..9d185c194c 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -118,7 +118,8 @@ module FatesAllometryMod ! 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 @@ -931,7 +932,11 @@ subroutine d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) if(present(dblmaxdd))then if( d calloc_abs_error) then + ccohort%fcfix_sapw + ccohort%fcfix_dead + ccohort%fcfix_stor)) > 1.0e-9_r8 ) then write(fates_log(),*) 'NPP Partitions are not balancing' write(fates_log(),*) 'Fractional Error: ', & abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & From 511e55cda7f0542194c18b67ee134421bbc535da Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 16:03:20 -0800 Subject: [PATCH 061/111] 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 062/111] 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 063/111] 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 064/111] 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 065/111] 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 52bfdc2e2dd59946629415d7b0d71403e9b17388 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 18:07:10 -0800 Subject: [PATCH 066/111] Removed fcfix diagnostics, fixed some line indents, updated the npp partition error check. --- biogeochem/EDCohortDynamicsMod.F90 | 30 -------- biogeochem/EDPhysiologyMod.F90 | 109 +++++++---------------------- main/EDMainMod.F90 | 6 -- main/EDTypesMod.F90 | 14 ---- main/FatesHistoryInterfaceMod.F90 | 79 +++------------------ main/FatesRestartInterfaceMod.F90 | 56 --------------- 6 files changed, 37 insertions(+), 257 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index daf82aa8d8..e30bd1830c 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -276,12 +276,6 @@ subroutine nan_cohort(cc_p) currentCohort%npp_seed = nan currentCohort%npp_stor = nan - currentCohort%fcfix_leaf = nan - currentCohort%fcfix_fnrt = nan - currentCohort%fcfix_sapw = nan - currentCohort%fcfix_dead = nan - currentCohort%fcfix_stor = nan - !RESPIRATION currentCohort%rdark = nan currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year @@ -384,12 +378,6 @@ subroutine zero_cohort(cc_p) currentCohort%npp_seed = 0._r8 currentCohort%npp_stor = 0._r8 - currentCohort%fcfix_leaf = 0._r8 - currentCohort%fcfix_fnrt = 0._r8 - currentCohort%fcfix_sapw = 0._r8 - currentCohort%fcfix_dead = 0._r8 - currentCohort%fcfix_stor = 0._r8 - end subroutine zero_cohort !-------------------------------------------------------------------------------------! @@ -782,18 +770,6 @@ subroutine fuse_cohorts(patchptr, bc_in) currentCohort%npp_stor = (currentCohort%n*currentCohort%npp_stor + nextc%n*nextc%npp_stor) & /newn - currentCohort%fcfix_leaf = (currentCohort%n*currentCohort%fcfix_leaf + nextc%n*nextc%fcfix_leaf) & - /newn - currentCohort%fcfix_fnrt = (currentCohort%n*currentCohort%fcfix_fnrt + nextc%n*nextc%fcfix_fnrt) & - /newn - currentCohort%fcfix_sapw = (currentCohort%n*currentCohort%fcfix_sapw + nextc%n*nextc%fcfix_sapw) & - /newn - currentCohort%fcfix_dead = (currentCohort%n*currentCohort%fcfix_dead + nextc%n*nextc%fcfix_dead) & - /newn - currentCohort%fcfix_stor = (currentCohort%n*currentCohort%fcfix_stor + nextc%n*nextc%fcfix_stor) & - /newn - - ! biomass and dbh tendencies currentCohort%ddbhdt = (currentCohort%n*currentCohort%ddbhdt + nextc%n*nextc%ddbhdt)/newn currentCohort%dbdeaddt = (currentCohort%n*currentCohort%dbdeaddt + nextc%n*nextc%dbdeaddt) & @@ -1129,12 +1105,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%npp_seed = o%npp_seed n%npp_stor = o%npp_stor - n%fcfix_leaf = o%fcfix_leaf - n%fcfix_fnrt = o%fcfix_fnrt - n%fcfix_sapw = o%fcfix_sapw - n%fcfix_dead = o%fcfix_dead - n%fcfix_stor = o%fcfix_stor - !RESPIRATION n%rdark = o%rdark n%resp_m = o%resp_m diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 14c89937b7..342f7c3fba 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -843,8 +843,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance integer , parameter :: max_substeps = 16 - logical , parameter :: no_forced_allometry = .true. - ipft = currentCohort%pft ! Initialize seed production @@ -858,13 +856,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%npp_seed = 0.0_r8 currentCohort%npp_sapw = 0.0_r8 - ! Initialize the diagnostic that tracks corrections from fusion redistribution - currentCohort%fcfix_leaf = 0.0_r8 - currentCohort%fcfix_fnrt = 0.0_r8 - currentCohort%fcfix_dead = 0.0_r8 - currentCohort%fcfix_stor = 0.0_r8 - currentCohort%fcfix_sapw = 0.0_r8 - ! Initialize rates of change currentCohort%dhdt = 0.0_r8 currentCohort%dbdeaddt = 0.0_r8 @@ -938,56 +929,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Target storage carbon [kgC,kgC/cm] call bstore_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) - ! ----------------------------------------------------------------------------------- - ! III. If fusion pushed a plant off allometry, we could have negatives - ! here. We allow negative deficits to push carbon downward too, and we take - ! that carbon back into the carbon flux pool - ! Note that since this is a carbon conservative process, ie has nothing to - ! do with NPP, and because the values are hopefully small, we do not - ! track these npp partition diagnostics. - ! ----------------------------------------------------------------------------------- - - if( no_forced_allometry ) then - - leaf_below_target = bt_leaf - currentCohort%bl - froot_below_target = bt_fineroot - currentCohort%br - sap_below_target = bt_sap - currentCohort%bsw - store_below_target = bt_store - currentCohort%bstore - dead_below_target = bt_dead - currentCohort%bdead - - - if(leaf_below_target<0.0_r8) then - carbon_balance = carbon_balance - leaf_below_target - currentCohort%bl = currentCohort%bl + leaf_below_target - currentCohort%fcfix_leaf = currentCohort%fcfix_leaf + leaf_below_target / hlm_freq_day - end if - - if(froot_below_target<0.0_r8) then - carbon_balance = carbon_balance - froot_below_target - currentCohort%br = currentCohort%br + froot_below_target - currentCohort%fcfix_fnrt = currentCohort%fcfix_fnrt + froot_below_target / hlm_freq_day - end if - - if(sap_below_target<0.0_r8) then - carbon_balance = carbon_balance - sap_below_target - currentCohort%bsw = currentCohort%bsw + sap_below_target - currentCohort%fcfix_sapw = currentCohort%fcfix_sapw + sap_below_target / hlm_freq_day - end if - - if(store_below_target<0.0_r8) then - carbon_balance = carbon_balance - store_below_target - currentCohort%bstore = currentCohort%bstore + store_below_target - currentCohort%fcfix_stor = currentCohort%fcfix_stor + store_below_target / hlm_freq_day - end if - - if(dead_below_target<0.0_r8) then - carbon_balance = carbon_balance - dead_below_target - currentCohort%bdead = currentCohort%bdead + dead_below_target - currentCohort%fcfix_dead = currentCohort%fcfix_dead + dead_below_target / hlm_freq_day - end if - end if - - ! ----------------------------------------------------------------------------------- ! IV(a). Calculate the maintenance turnover demands ! Pre-check, make sure phenology is mutually exclusive and at least one chosen @@ -1083,14 +1024,14 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! If we are testing b4b, then we pay this even if we don't have the carbon ! Just don't pay so much carbon that storage+carbon_balance can't pay for it - bl_flux = min(leaf_turnover_demand, (currentCohort%bstore+carbon_balance)*(leaf_turnover_demand/total_turnover_demand)) + bl_flux = min(leaf_turnover_demand,max(0.0_r8, (currentCohort%bstore+carbon_balance)*(leaf_turnover_demand/total_turnover_demand))) carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day ! If we are testing b4b, then we pay this even if we don't have the carbon - br_flux = min(root_turnover_demand, (currentCohort%bstore+carbon_balance)*(root_turnover_demand/total_turnover_demand)) + br_flux = min(root_turnover_demand,max(0.0_r8, (currentCohort%bstore+carbon_balance)*(root_turnover_demand/total_turnover_demand))) carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux @@ -1101,50 +1042,54 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- ! VI(a) if carbon balance is negative, re-coup the losses from storage ! if it is positive, give some love to storage carbon + ! NOTE: WE ARE STILL ALLOWING STORAGE CARBON TO GO NEGATIVE, AT LEAST IN THIS + ! PART OF THE CODE. ! ----------------------------------------------------------------------------------- if( carbon_balance < 0.0_r8 ) then - bstore_flux = carbon_balance - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + bstore_flux = carbon_balance + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day ! We have pushed to net-zero carbon, the rest of this routine can be ignored return else - store_below_target = max(bt_store - currentCohort%bstore,0.0_r8) - store_target_fraction = max(0.0_r8,currentCohort%bstore/bt_store) - bstore_flux = min(store_below_target,carbon_balance * & - max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + store_below_target = max(bt_store - currentCohort%bstore,0.0_r8) + store_target_fraction = max(0.0_r8,currentCohort%bstore/bt_store) + bstore_flux = min(store_below_target,carbon_balance * & + max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day end if ! ----------------------------------------------------------------------------------- ! VI(d). If carbon is still available, prioritize some allocation to replace ! the rest of the leaf/fineroot turnover demand - ! carbon balance is gauranteed to be positive beyond this point + ! carbon balance is guaranteed to be >=0 beyond this point ! ----------------------------------------------------------------------------------- - leaf_turnover_demand = currentCohort%leaf_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day - root_turnover_demand = currentCohort%root_md*(1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day + leaf_turnover_demand = currentCohort%leaf_md * & + (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day + root_turnover_demand = currentCohort%root_md * & + (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(ipft))*hlm_freq_day total_turnover_demand = leaf_turnover_demand + root_turnover_demand if(total_turnover_demand>0.0_r8)then bl_flux = min(leaf_turnover_demand, carbon_balance*(leaf_turnover_demand/total_turnover_demand)) - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day + carbon_balance = carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day br_flux = min(root_turnover_demand, carbon_balance*(root_turnover_demand/total_turnover_demand)) - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day + carbon_balance = carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day end if @@ -1347,7 +1292,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) brepro_flux = deltaC * repro_fraction - brepro_sub = brepro_sub + brepro_flux + brepro_sub = brepro_sub + brepro_flux ! ------------------------------------------------------------------------------------ diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 8a6101a1d7..c918acabb4 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -585,12 +585,6 @@ subroutine bypass_dynamics(currentSite) currentCohort%npp_seed = 0.0_r8 currentCohort%npp_stor = 0.0_r8 - currentCohort%fcfix_leaf = 0.0_r8 - currentCohort%fcfix_fnrt = 0.0_r8 - currentCohort%fcfix_sapw = 0.0_r8 - currentCohort%fcfix_dead = 0.0_r8 - currentCohort%fcfix_stor = 0.0_r8 - currentCohort%bmort = 0.0_r8 currentCohort%hmort = 0.0_r8 currentCohort%cmort = 0.0_r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e26d409972..df659eaa71 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -196,14 +196,6 @@ module EDTypesMod real(r8) :: npp_seed ! NPP into seeds: KgC/indiv/year real(r8) :: npp_stor ! NPP into storage: KgC/indiv/year - ! Fluxes due to fixing allometry breaking during fusion - real(r8) :: fcfix_leaf ! Carbon leaving leaves into carbon gain after weird fusion KgC/indiv/year - real(r8) :: fcfix_fnrt ! Carbon leaving froots into carbon gain "" KgC/indiv/year - real(r8) :: fcfix_sapw ! Carbon leaving sapwood into carbon gain "" KgC/indiv/year - real(r8) :: fcfix_dead ! Carbon leaving deadwood into carbon gain "" KgC/indiv/year - real(r8) :: fcfix_stor ! Carbon leaving storage into carbon gain "" KgC/indiv/year - - real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/s real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year @@ -750,12 +742,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%npp_seed = ', ccohort%npp_seed write(fates_log(),*) 'co%npp_stor = ', ccohort%npp_stor - write(fates_log(),*) 'co%fcfix_leaf = ', ccohort%fcfix_leaf - write(fates_log(),*) 'co%fcfix_fnrt = ', ccohort%fcfix_fnrt - write(fates_log(),*) 'co%fcfix_sapw = ', ccohort%fcfix_sapw - write(fates_log(),*) 'co%fcfix_dead = ', ccohort%fcfix_dead - write(fates_log(),*) 'co%fcfix_stor = ', ccohort%fcfix_stor - write(fates_log(),*) 'co%rdark = ', ccohort%rdark write(fates_log(),*) 'co%resp_m = ', ccohort%resp_m write(fates_log(),*) 'co%resp_g = ', ccohort%resp_g diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index c7eda07af4..ab7dd9a826 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -139,12 +139,6 @@ module FatesHistoryInterfaceMod integer, private :: ih_npp_agdw_si_scpf integer, private :: ih_npp_stor_si_scpf - integer, private :: ih_fcfix_leaf_si_scpf - integer, private :: ih_fcfix_fnrt_si_scpf - integer, private :: ih_fcfix_stor_si_scpf - integer, private :: ih_fcfix_dead_si_scpf - integer, private :: ih_fcfix_sapw_si_scpf - integer, private :: ih_bstor_canopy_si_scpf integer, private :: ih_bstor_understory_si_scpf integer, private :: ih_bleaf_canopy_si_scpf @@ -1141,6 +1135,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) real(r8) :: n_perm2 ! individuals per m2 for the whole column real(r8) :: patch_scaling_scalar ! ratio of canopy to patch area for counteracting patch scaling real(r8) :: dbh ! diameter ("at breast height") + real(r8) :: npp_partition_error ! a check that the NPP partitions sum to carbon allocation type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -1197,12 +1192,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_agdw_si_scpf => this%hvars(ih_npp_agdw_si_scpf)%r82d, & hio_npp_stor_si_scpf => this%hvars(ih_npp_stor_si_scpf)%r82d, & - hio_fcfix_leaf_si_scpf => this%hvars(ih_fcfix_leaf_si_scpf)%r82d, & - hio_fcfix_fnrt_si_scpf => this%hvars(ih_fcfix_fnrt_si_scpf)%r82d, & - hio_fcfix_stor_si_scpf => this%hvars(ih_fcfix_stor_si_scpf)%r82d, & - hio_fcfix_dead_si_scpf => this%hvars(ih_fcfix_dead_si_scpf)%r82d, & - hio_fcfix_sapw_si_scpf => this%hvars(ih_fcfix_sapw_si_scpf)%r82d, & - hio_bstor_canopy_si_scpf => this%hvars(ih_bstor_canopy_si_scpf)%r82d, & hio_bstor_understory_si_scpf => this%hvars(ih_bstor_understory_si_scpf)%r82d, & hio_bleaf_canopy_si_scpf => this%hvars(ih_bleaf_canopy_si_scpf)%r82d, & @@ -1462,41 +1451,18 @@ 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_stor*n_perm2 - ! Track carbon fluxes from fusion corrections - - hio_fcfix_leaf_si_scpf(io_si,scpf) = hio_fcfix_leaf_si_scpf(io_si,scpf)+ & - ccohort%fcfix_leaf*n_perm2 - hio_fcfix_fnrt_si_scpf(io_si,scpf) = hio_fcfix_fnrt_si_scpf(io_si,scpf)+ & - ccohort%fcfix_fnrt*n_perm2 - hio_fcfix_stor_si_scpf(io_si,scpf) = hio_fcfix_stor_si_scpf(io_si,scpf)+ & - ccohort%fcfix_stor*n_perm2 - hio_fcfix_dead_si_scpf(io_si,scpf) = hio_fcfix_dead_si_scpf(io_si,scpf)+ & - ccohort%fcfix_dead*n_perm2 - hio_fcfix_sapw_si_scpf(io_si,scpf) = hio_fcfix_sapw_si_scpf(io_si,scpf)+ & - ccohort%fcfix_sapw*n_perm2 - - - if( abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & - ccohort%npp_sapw+ccohort%npp_dead+ & - ccohort%npp_seed+ccohort%npp_stor+ & - ccohort%fcfix_leaf + ccohort%fcfix_fnrt + & - ccohort%fcfix_sapw + ccohort%fcfix_dead + ccohort%fcfix_stor)) > 1.0e-9_r8 ) then + npp_partition_error = abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & + ccohort%npp_sapw+ccohort%npp_dead+ & + ccohort%npp_seed+ccohort%npp_stor)) + if( npp_partition_error > 1.0e-9_r8 ) then write(fates_log(),*) 'NPP Partitions are not balancing' - write(fates_log(),*) 'Fractional Error: ', & - abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & - ccohort%npp_sapw+ccohort%npp_dead+ & - ccohort%npp_seed+ccohort%npp_stor+ & - ccohort%fcfix_leaf + ccohort%fcfix_fnrt + & - ccohort%fcfix_sapw + ccohort%fcfix_dead + ccohort%fcfix_stor))/ccohort%npp_acc_hold + write(fates_log(),*) 'Absolute Error [kgC/day]: ',npp_partition_error + write(fates_log(),*) 'Fractional Error: ', abs(npp_partition_error/ccohort%npp_acc_hold) write(fates_log(),*) 'Terms: ',ccohort%npp_acc_hold,ccohort%npp_leaf,ccohort%npp_fnrt, & - ccohort%npp_sapw,ccohort%npp_dead, & - ccohort%npp_seed,ccohort%npp_stor, & - ccohort%fcfix_leaf + ccohort%fcfix_fnrt + & - ccohort%fcfix_sapw + ccohort%fcfix_dead + & - ccohort%fcfix_stor + ccohort%npp_sapw,ccohort%npp_dead, & + ccohort%npp_seed,ccohort%npp_stor 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__)) + call endrun(msg=errMsg(__FILE__, __LINE__)) end if ! Woody State Variables (basal area and number density and mortality) @@ -3204,31 +3170,6 @@ 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_npp_stor_si_scpf ) - call this%set_history_var(vname = 'FCFIX_STOR_SCPF', units='kgC/m2/yr', & - long='flux into storage for fusion corrections 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_fcfix_stor_si_scpf ) - - call this%set_history_var(vname = 'FCFIX_LEAF_SCPF', units='kgC/m2/yr', & - long='flux into leaves for fusion corrections 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_fcfix_leaf_si_scpf ) - - call this%set_history_var(vname = 'FCFIX_FNRT_SCPF', units='kgC/m2/yr', & - long='flux into fine-roots for fusion corrections 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_fcfix_fnrt_si_scpf ) - - call this%set_history_var(vname = 'FCFIX_SAPW_SCPF', units='kgC/m2/yr', & - long='flux into sapwood for fusion corrections 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_fcfix_sapw_si_scpf ) - - call this%set_history_var(vname = 'FCFIX_DEAD_SCPF', units='kgC/m2/yr', & - long='flux into structure for fusion corrections 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_fcfix_dead_si_scpf ) - call this%set_history_var(vname='DDBH_SCPF', units = 'cm/yr/ha', & long='diameter growth increment by pft/size',use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 7e6585a2e2..440a3112ce 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -99,12 +99,6 @@ module FatesRestartInterfaceMod integer, private :: ir_npp_seed_co integer, private :: ir_npp_store_co - integer, private :: ir_fcfix_leaf_co - integer, private :: ir_fcfix_fnrt_co - integer, private :: ir_fcfix_sapw_co - integer, private :: ir_fcfix_dead_co - integer, private :: ir_fcfix_stor_co - integer, private :: ir_bmort_co integer, private :: ir_hmort_co integer, private :: ir_cmort_co @@ -747,32 +741,6 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_store_co ) - call this%set_restart_var(vname='fates_fcfix_stor', vtype=cohort_r8, & - long_name='ed cohort - fusion corrections sent to storage biomass', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_stor_co ) - - call this%set_restart_var(vname='fates_fcfix_sapw', vtype=cohort_r8, & - long_name='ed cohort - fusion corrections sent to sapwood biomass', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_sapw_co ) - - call this%set_restart_var(vname='fates_fcfix_fnrt', vtype=cohort_r8, & - long_name='ed cohort - fusion corrections sent to fineroot biomass', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_fnrt_co ) - - call this%set_restart_var(vname='fates_fcfix_leaf', vtype=cohort_r8, & - long_name='ed cohort - fusion corrections sent to leaf biomass', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_leaf_co ) - - call this%set_restart_var(vname='fates_fcfix_dead', vtype=cohort_r8, & - long_name='ed cohort - fusion corrections sent to storage biomass', & - units='kgC/indiv/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fcfix_dead_co ) - - call this%set_restart_var(vname='fates_bmort', vtype=cohort_r8, & long_name='ed cohort - background mortality rate', & units='/year', flushval = flushzero, & @@ -1104,12 +1072,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & - rio_fcfix_leaf_co => this%rvars(ir_fcfix_leaf_co)%r81d, & - rio_fcfix_fnrt_co => this%rvars(ir_fcfix_fnrt_co)%r81d, & - rio_fcfix_sapw_co => this%rvars(ir_fcfix_sapw_co)%r81d, & - rio_fcfix_stor_co => this%rvars(ir_fcfix_stor_co)%r81d, & - rio_fcfix_dead_co => this%rvars(ir_fcfix_dead_co)%r81d, & - rio_lmort_logging_co => this%rvars(ir_lmort_logging_co)%r81d, & rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & @@ -1231,12 +1193,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cmort_co(io_idx_co) = ccohort%cmort rio_fmort_co(io_idx_co) = ccohort%fmort - rio_fcfix_leaf_co(io_idx_co) = ccohort%fcfix_leaf - rio_fcfix_fnrt_co(io_idx_co) = ccohort%fcfix_fnrt - rio_fcfix_sapw_co(io_idx_co) = ccohort%fcfix_sapw - rio_fcfix_stor_co(io_idx_co) = ccohort%fcfix_stor - rio_fcfix_dead_co(io_idx_co) = ccohort%fcfix_dead - !Logging rio_lmort_logging_co(io_idx_co) = ccohort%lmort_logging rio_lmort_collateral_co(io_idx_co) = ccohort%lmort_collateral @@ -1702,12 +1658,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & - rio_fcfix_leaf_co => this%rvars(ir_fcfix_leaf_co)%r81d, & - rio_fcfix_fnrt_co => this%rvars(ir_fcfix_fnrt_co)%r81d, & - rio_fcfix_sapw_co => this%rvars(ir_fcfix_sapw_co)%r81d, & - rio_fcfix_stor_co => this%rvars(ir_fcfix_stor_co)%r81d, & - rio_fcfix_dead_co => this%rvars(ir_fcfix_dead_co)%r81d, & - rio_lmort_logging_co => this%rvars(ir_lmort_logging_co)%r81d, & rio_lmort_collateral_co => this%rvars(ir_lmort_collateral_co)%r81d, & rio_lmort_infra_co => this%rvars(ir_lmort_infra_co)%r81d, & @@ -1812,12 +1762,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%cmort = rio_cmort_co(io_idx_co) ccohort%fmort = rio_fmort_co(io_idx_co) - ccohort%fcfix_leaf = rio_fcfix_leaf_co(io_idx_co) - ccohort%fcfix_fnrt = rio_fcfix_fnrt_co(io_idx_co) - ccohort%fcfix_sapw = rio_fcfix_sapw_co(io_idx_co) - ccohort%fcfix_stor = rio_fcfix_stor_co(io_idx_co) - ccohort%fcfix_dead = rio_fcfix_dead_co(io_idx_co) - !Logging ccohort%lmort_logging = rio_lmort_logging_co(io_idx_co) ccohort%lmort_collateral = rio_lmort_collateral_co(io_idx_co) From 1e0e8389cd1eb2f6faddebf7372176bdc5b4d151 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 18 Jan 2018 18:28:23 -0800 Subject: [PATCH 067/111] Debugging modifications to new allometry that allow for pools to be above allometry if fusion forced such a condition. --- biogeochem/EDPhysiologyMod.F90 | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 342f7c3fba..ca0926e7e8 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1286,10 +1286,37 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if (grow_dead) then bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) bdead_sub = bdead_sub + bdead_flux + + end if + + ! Increase diameter, which is in concept fairly tied in with + ! the amount of structure. But remember it is possible that the structural pool + ! is larger than target allometry, and if so, we have to grow the dbh + ! in sync with the other growing pools until it surpases structure again. + + if(grow_dead) then dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd call h_allom(dbh_sub,ipft,h_sub) + else if(grow_froot) then + dbh_sub = dbh_sub + br_flux / dbt_fineroot_dd + call h_allom(dbh_sub,ipft,h_sub) + else if(grow_leaf) then + dbh_sub = dbh_sub + bl_flux / dbt_leaf_dd + call h_allom(dbh_sub,ipft,h_sub) + else if(grow_store) then + dbh_sub = dbh_sub + bstore_flux / dbt_store_dd + call h_allom(dbh_sub,ipft,h_sub) + else if(grow_sap) then + dbh_sub = dbh_sub + bsw_flux / dbt_sap_dd + call h_allom(dbh_sub,ipft,h_sub) + else + write(fates_log(),*) 'During plant growth, it was determined that' + write(fates_log(),*) 'enough carbon was available to grow new tissues' + write(fates_log(),*) 'yet somehow none of the pools are on-allometry' + write(fates_log(),*) 'they all appear to be above or below?' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + brepro_flux = deltaC * repro_fraction brepro_sub = brepro_sub + brepro_flux From 4217833f55557f6eac571aad361cd6706e4bc641 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 19 Jan 2018 11:16:33 -0800 Subject: [PATCH 068/111] new allocation scheme fixes, allowing for a scenario where all target pools are smaller than actual (after fusion). --- biogeochem/EDPhysiologyMod.F90 | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index ca0926e7e8..5731baba73 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1036,6 +1036,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day + end if @@ -1090,6 +1091,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day + end if @@ -1138,7 +1140,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) carbon_balance = carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - + end if ! ----------------------------------------------------------------------------------- @@ -1156,7 +1158,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) carbon_balance = carbon_balance - bdead_flux currentCohort%bdead = currentCohort%bdead + bdead_flux currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - + end if ! ----------------------------------------------------------------------------------- @@ -1221,6 +1223,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) grow_store = .true. end if + deltaC = carbon_balance nsteps = 1 ierr = 1 @@ -1310,11 +1313,21 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) dbh_sub = dbh_sub + bsw_flux / dbt_sap_dd call h_allom(dbh_sub,ipft,h_sub) else - write(fates_log(),*) 'During plant growth, it was determined that' - write(fates_log(),*) 'enough carbon was available to grow new tissues' - write(fates_log(),*) 'yet somehow none of the pools are on-allometry' - write(fates_log(),*) 'they all appear to be above or below?' - call endrun(msg=errMsg(sourcefile, __LINE__)) + ! If all other pools are larger than target, then we + ! set dbh to equal that which would generate current structure + dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd + call h_allom(dbh_sub,ipft,h_sub) + +! write(fates_log(),*) 'During plant growth, it was determined that' +! write(fates_log(),*) 'enough carbon was available to grow new tissues' +! write(fates_log(),*) 'yet somehow none of the pools are on-allometry' +! write(fates_log(),*) 'they all appear to be above or below?' +! write(fates_log(),*) grow_dead,bt_dead, currentCohort%bdead +! write(fates_log(),*) grow_froot,bt_fineroot, currentCohort%br +! write(fates_log(),*) grow_sap,bt_sap,currentCohort%bsw +! write(fates_log(),*) grow_store,bt_store,currentCohort%bstore +! write(fates_log(),*) grow_leaf,bt_leaf,currentCohort%bl +! call endrun(msg=errMsg(sourcefile, __LINE__)) end if From fc2a774295f7ba0a7b0cced05f6cddb6330a1eba Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 19 Jan 2018 11:55:59 -0800 Subject: [PATCH 069/111] 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 070/111] 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 071/111] 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 072/111] 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 073/111] 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 195ba8e546e4b5bc76de776e0d877030a5e68557 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 19 Jan 2018 18:46:35 -0800 Subject: [PATCH 074/111] Allocation debugging: fixing an initialization of cohort status with evergreen plants. --- biogeochem/EDCanopyStructureMod.F90 | 12 ++ biogeochem/EDCohortDynamicsMod.F90 | 16 +- biogeochem/EDPatchDynamicsMod.F90 | 1 - biogeochem/EDPhysiologyMod.F90 | 299 ++++++++++++++-------------- biogeochem/FatesAllometryMod.F90 | 55 ++++- main/EDTypesMod.F90 | 1 - 6 files changed, 227 insertions(+), 157 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 716b071ae1..40ef68075b 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1299,8 +1299,20 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) currentPatch%elai_profile(L,ft,iv) = currentPatch%elai_profile(L,ft,iv) / & currentPatch%canopy_area_profile(L,ft,iv) + currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv) / & currentPatch%canopy_area_profile(L,ft,iv) + + if( currentPatch%tlai_profile(L,ft,iv) currentPatch%shortest + do while(associated(currentCohort)) + print*,currentCohort%bl,currentCohort%c_area,currentCohort%NV,currentCohort%treelai,currentCohort%treesai,currentCohort%status_coh,currentCohort%lai,EDPftvarcon_inst%evergreen(ft) + currentCohort => currentCohort%taller + end do + end if + currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) & /currentPatch%tlai_profile(L,ft,iv) enddo diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index e30bd1830c..b945b6d558 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -35,6 +35,7 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : bfineroot use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : carea_allom + use FatesAllometryMod , only : StructureResetOfDH ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -677,13 +678,23 @@ subroutine fuse_cohorts(patchptr, bc_in) + nextc%n*nextc%bl)/newn currentCohort%br = (currentCohort%n*currentCohort%br & + nextc%n*nextc%br)/newn - currentCohort%hite = (currentCohort%n*currentCohort%hite & - + nextc%n*nextc%hite)/newn currentCohort%dbh = (currentCohort%n*currentCohort%dbh & + nextc%n*nextc%dbh)/newn + + call h_allom(currentCohort%dbh,currentCohort%pft,currentCohort%hite) + currentCohort%canopy_trim = (currentCohort%n*currentCohort%canopy_trim & + nextc%n*nextc%canopy_trim)/newn + ! If fusion pushed structural biomass to be larger than + ! the allometric target value derived by diameter, we + ! then increase diameter and height until the allometric + ! target matches actual bdead. (if it is the other way around + ! we then just let the carbon pools grow to fill-out allometry) + + call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & + currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) + call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & currentCohort%size_class,currentCohort%size_by_pft_class) @@ -1074,7 +1085,6 @@ subroutine copy_cohort( currentCohort,copyc ) n%nv = o%nv n%status_coh = o%status_coh n%canopy_trim = o%canopy_trim - n%status_coh = o%status_coh n%excl_weight = o%excl_weight n%prom_weight = o%prom_weight n%size_class = o%size_class diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e7cd9f8183..bfe1e36d56 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1332,7 +1332,6 @@ subroutine fuse_patches( csite, bc_in ) integer :: fuse_flag !do patches get fused (1) or not (0). !--------------------------------------------------------------------- - !maxpatch = 4 maxpatch = maxPatchesPerSite currentSite => csite diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 5731baba73..315ab79091 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -897,11 +897,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Available carbon for growth [kgC] carbon_balance = currentCohort%npp_acc - ! ----------------------------------------------------------------------------------- ! II. Calculate target size of living biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- - + + !! call GetAllometricTargets(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,bt_fineroot,bt_sapwood,bt_store,bt_dead) + ! Target leaf biomass according to allometry and trimming call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) @@ -911,6 +912,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) dbt_leaf_dd = 0.0_r8 end if + + ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) @@ -959,7 +962,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) endif - ! ----------------------------------------------------------------------------------- ! IV(b). Calculate the maintenance turnover demands ! NOTE(RGK): If branches are falling all year, even on deciduous trees, we should @@ -1161,6 +1163,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if + + ! ----------------------------------------------------------------------------------- ! V(e). If carbon is yet still available ... ! Our pools are now either on allometry or above (from fusion). @@ -1169,67 +1173,28 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Use an adaptive euler integration. If the error is not nominal, ! the carbon balance sub-step (deltaC) will be halved and tried again ! ----------------------------------------------------------------------------------- - + if( carbon_balancecalloc_abs_error) then - write(fates_log(),*) 'leaves are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',currentCohort%bl,bt_leaf,currentCohort%bl - bt_leaf - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (currentCohort%bl - bt_leaf)>calloc_abs_error) then - ! leaf is above allometry, ignore - grow_leaf = .false. - else - grow_leaf = .true. - end if - - if( (bt_fineroot - currentCohort%br)>calloc_abs_error) then - write(fates_log(),*) 'fineroots are not on-allometry at the growth step' - write(fates_log(),*) 'exiting',currentCohort%br,bt_fineroot,currentCohort%br - bt_fineroot - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (currentCohort%br-bt_fineroot)>calloc_abs_error ) then - grow_froot = .false. - else - grow_froot = .true. - end if - - if( (bt_sap - currentCohort%bsw)>calloc_abs_error) then - write(fates_log(),*) 'sapwood is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',currentCohort%bsw,bt_sap,currentCohort%bsw - bt_sap - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (currentCohort%bsw-bt_sap)>calloc_abs_error ) then - grow_sap = .false. - else - grow_sap = .true. - end if - - if( (bt_dead - currentCohort%bdead)>calloc_abs_error) then - write(fates_log(),*) 'dead wood is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',currentCohort%bdead,bt_dead,currentCohort%bdead - bt_dead - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (currentCohort%bdead-bt_dead)>calloc_abs_error ) then - grow_dead = .false. - else - grow_dead = .true. - end if - if( (bt_store - currentCohort%bstore)>calloc_abs_error) then - write(fates_log(),*) 'storage is not on-allometry at the growth step' - write(fates_log(),*) 'exiting',currentCohort%bstore,bt_store,currentCohort%bstore - bt_store - call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( (currentCohort%bstore-bt_store)>calloc_abs_error ) then - grow_store = .false. - else - grow_store = .true. - end if + ! This routine checks that actual carbon is not below that targets. It does + ! allow actual pools to be above the target, and in these cases, it sends + ! a false on the "grow_<>" flag, allowing the plant to grow into these pools + ! It also checks to make sure that structural biomass is not above the target + ! This is enforced at fusion. + call TargetAllometryCheck(currentCohort%bl,currentCohort%br,currentCohort%bsw, & + currentCohort%bstore,currentCohort%bdead, & + bt_leaf,bt_fineroot,bt_sap,bt_store,bt_dead, & + grow_leaf,grow_froot,grow_sap,grow_store,grow_dead) + deltaC = carbon_balance nsteps = 1 - ierr = 1 - + ierr = 1 + do while( ierr .ne. 0 ) - + totalC = carbon_balance dbh_sub = currentCohort%dbh h_sub = currentCohort%hite @@ -1258,99 +1223,50 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) end if - dbt_total_dd = 0.0_r8 - + dbt_total_dd = dbt_dead_dd if (grow_leaf) dbt_total_dd = dbt_total_dd + dbt_leaf_dd if (grow_froot) dbt_total_dd = dbt_total_dd + dbt_fineroot_dd if (grow_sap) dbt_total_dd = dbt_total_dd + dbt_sap_dd - if (grow_dead) dbt_total_dd = dbt_total_dd + dbt_dead_dd if (grow_store) dbt_total_dd = dbt_total_dd + dbt_store_dd + + bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bdead_sub = bdead_sub + bdead_flux + dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd + call h_allom(dbh_sub,ipft,h_sub) if (grow_leaf) then bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) bl_sub = bl_sub + bl_flux end if - + if (grow_froot) then br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) br_sub = br_sub + br_flux end if - + if (grow_sap) then bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) bsw_sub = bsw_sub + bsw_flux end if - + if (grow_store) then bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) bstore_sub = bstore_sub + bstore_flux end if - if (grow_dead) then - bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bdead_sub = bdead_sub + bdead_flux - - end if - - ! Increase diameter, which is in concept fairly tied in with - ! the amount of structure. But remember it is possible that the structural pool - ! is larger than target allometry, and if so, we have to grow the dbh - ! in sync with the other growing pools until it surpases structure again. - - if(grow_dead) then - dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd - call h_allom(dbh_sub,ipft,h_sub) - else if(grow_froot) then - dbh_sub = dbh_sub + br_flux / dbt_fineroot_dd - call h_allom(dbh_sub,ipft,h_sub) - else if(grow_leaf) then - dbh_sub = dbh_sub + bl_flux / dbt_leaf_dd - call h_allom(dbh_sub,ipft,h_sub) - else if(grow_store) then - dbh_sub = dbh_sub + bstore_flux / dbt_store_dd - call h_allom(dbh_sub,ipft,h_sub) - else if(grow_sap) then - dbh_sub = dbh_sub + bsw_flux / dbt_sap_dd - call h_allom(dbh_sub,ipft,h_sub) - else - ! If all other pools are larger than target, then we - ! set dbh to equal that which would generate current structure - dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd - call h_allom(dbh_sub,ipft,h_sub) - -! write(fates_log(),*) 'During plant growth, it was determined that' -! write(fates_log(),*) 'enough carbon was available to grow new tissues' -! write(fates_log(),*) 'yet somehow none of the pools are on-allometry' -! write(fates_log(),*) 'they all appear to be above or below?' -! write(fates_log(),*) grow_dead,bt_dead, currentCohort%bdead -! write(fates_log(),*) grow_froot,bt_fineroot, currentCohort%br -! write(fates_log(),*) grow_sap,bt_sap,currentCohort%bsw -! write(fates_log(),*) grow_store,bt_store,currentCohort%bstore -! write(fates_log(),*) grow_leaf,bt_leaf,currentCohort%bl -! call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - brepro_flux = deltaC * repro_fraction brepro_sub = brepro_sub + brepro_flux - - - ! ------------------------------------------------------------------------------------ - ! VIII. Run a post integration test to see if our integrated quantities match - ! the diagnostic quantities. (note we do not need to pass in leaf status - ! because we would not make it to this check if we were not on allometry - ! ------------------------------------------------------------------------------------ totalC = totalC - deltaC end do - if( abs(totalC)>calloc_abs_error ) then - write(fates_log(),*) 'carbon gain during allometric growth was not conserved' - write(fates_log(),*) 'exiting',totalC - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - + ! ------------------------------------------------------------------------------------ + ! VIII. Run a post integration test to see if our integrated quantities match + ! the diagnostic quantities. (note we do not need to pass in leaf status + ! because we would not make it to this check if we were not on allometry + ! ------------------------------------------------------------------------------------ + call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & bl_sub,br_sub,bsw_sub,bstore_sub,bdead_sub, & grow_leaf, grow_froot, grow_sap, grow_store, grow_dead, ierr) @@ -1360,45 +1276,45 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ierr = 0 ! Reset this value for diagnostic - totalC = carbon_balance + totalC = carbon_balance - bl_flux = bl_sub - currentCohort%bl - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day + bl_flux = bl_sub - currentCohort%bl + carbon_balance = carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - br_flux = br_sub - currentCohort%br - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day + br_flux = br_sub - currentCohort%br + carbon_balance = carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - bsw_flux = bsw_sub - currentCohort%bsw - carbon_balance = carbon_balance - bsw_flux - currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day + bsw_flux = bsw_sub - currentCohort%bsw + carbon_balance = carbon_balance - bsw_flux + currentCohort%bsw = currentCohort%bsw + bsw_flux + currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - bstore_flux = bstore_sub - currentCohort%bstore - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + bstore_flux = bstore_sub - currentCohort%bstore + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - bdead_flux = bdead_sub - currentCohort%bdead - carbon_balance = carbon_balance - bdead_flux - currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day + bdead_flux = bdead_sub - currentCohort%bdead + carbon_balance = carbon_balance - bdead_flux + currentCohort%bdead = currentCohort%bdead + bdead_flux + currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - carbon_balance = carbon_balance - brepro_sub - currentCohort%npp_seed = currentCohort%npp_seed + brepro_sub / hlm_freq_day - currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day + carbon_balance = carbon_balance - brepro_sub + currentCohort%npp_seed = currentCohort%npp_seed + brepro_sub / hlm_freq_day + currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day ! Set derivatives used as diagnostics - currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day - currentCohort%dbdeaddt = bdead_flux/hlm_freq_day - currentCohort%dbstoredt = bstore_flux/hlm_freq_day - currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day + currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day + currentCohort%dbdeaddt = bdead_flux/hlm_freq_day + currentCohort%dbstoredt = bstore_flux/hlm_freq_day + currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - currentCohort%dbh = dbh_sub - currentCohort%hite = h_sub + currentCohort%dbh = dbh_sub + currentCohort%hite = h_sub if( abs(carbon_balance)>calloc_abs_error ) then write(fates_log(),*) 'carbon conservation error while integrating pools' @@ -1425,6 +1341,84 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) return end subroutine PlantGrowth + ! ====================================================================================== + + subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & + bt_leaf,bt_froot,bt_sap,bt_store,bt_dead, & + grow_leaf,grow_froot,grow_sap,grow_store,grow_dead) + + ! Arguments + real(r8),intent(in) :: bleaf !actual + real(r8),intent(in) :: bfroot + real(r8),intent(in) :: bsap + real(r8),intent(in) :: bstore + real(r8),intent(in) :: bdead + real(r8),intent(in) :: bt_leaf !target + real(r8),intent(in) :: bt_froot + real(r8),intent(in) :: bt_sap + real(r8),intent(in) :: bt_store + real(r8),intent(in) :: bt_dead + logical,intent(out) :: grow_leaf !growth flag + logical,intent(out) :: grow_froot + logical,intent(out) :: grow_sap + logical,intent(out) :: grow_store + logical,intent(out) :: grow_dead + + if( (bt_leaf - bleaf)>calloc_abs_error) then + write(fates_log(),*) 'leaves are not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bleaf,bt_leaf + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( (bleaf - bt_leaf)>calloc_abs_error) then + ! leaf is above allometry, ignore + grow_leaf = .false. + else + grow_leaf = .true. + end if + + if( (bt_froot - bfroot)>calloc_abs_error) then + write(fates_log(),*) 'fineroots are not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bfroot, bt_froot + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( ( bfroot-bt_froot)>calloc_abs_error ) then + grow_froot = .false. + else + grow_froot = .true. + end if + + if( (bt_sap - bsap)>calloc_abs_error) then + write(fates_log(),*) 'sapwood is not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bsap, bt_sap + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( ( bsap-bt_sap)>calloc_abs_error ) then + grow_sap = .false. + else + grow_sap = .true. + end if + + if( (bt_store - bstore)>calloc_abs_error) then + write(fates_log(),*) 'storage is not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bstore,bt_store + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( ( bstore-bt_store)>calloc_abs_error ) then + grow_store = .false. + else + grow_store = .true. + end if + + if( (bt_dead - bdead)>calloc_abs_error) then + write(fates_log(),*) 'structure not on-allometry at the growth step' + write(fates_log(),*) 'exiting',bdead,bt_dead + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif( ( bdead-bt_dead)>calloc_abs_error ) then + write(fates_log(),*) 'structure is not allowed to be greater than target' + write(fates_log(),*) 'allometry during growth step, this is because DBH' + write(fates_log(),*) 'is intrinsicly tied to it' + call endrun(msg=errMsg(sourcefile, __LINE__)) + else + grow_dead = .true. + end if + end subroutine TargetAllometryCheck + ! ============================================================================ subroutine recruitment( currentSite, currentPatch, bc_in ) ! @@ -1499,6 +1493,11 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) cohortstatus = currentSite%dstatus endif + if (EDPftvarcon_inst%evergreen(ft) == 1) then + temp_cohort%laimemory = 0._r8 + cohortstatus = 2 + 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, & diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 746d50d1c6..1f7428802c 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -104,7 +104,7 @@ module FatesAllometryMod public :: bdead_allom ! Generic bdead wrapper public :: carea_allom ! Generic crown area wrapper public :: bstore_allom ! Generic maximum storage carbon wrapper - + public :: StructureResetOfDH public :: CheckIntegratedAllometries @@ -1668,7 +1668,58 @@ subroutine carea_2pwr(d,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area) end subroutine carea_2pwr - + ! ============================================================================ + ! Reverse, calculate the diameter from the structural biomass + ! ============================================================================ + + subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) + + use FatesConstantsMod , only : calloc_abs_error + ! Arguments + + real(r8),intent(in) :: bdead ! actual bdead [kgC] + integer(i4),intent(in) :: ipft ! PFT index + real(r8),intent(in) :: canopy_trim + real(r8),intent(inout) :: d ! plant diameter [cm] + real(r8),intent(out) :: h ! plant height + + ! Locals + real(r8) :: bt_sap,dbt_sap_dd ! target sap wood at current d + real(r8) :: bt_agw,dbt_agw_dd ! target AG wood at current d + real(r8) :: bt_bgw,dbt_bgw_dd ! target BG wood at current d + real(r8) :: bt_dead,dbt_dead_dd ! target struct wood at current d + real(r8) :: dd ! diameter increment for each step + + real(r8), parameter :: approx_partial_steps = 20.0_r8 + + call bsap_allom(d,ipft,canopy_trim,bt_sap,dbt_sap_dd) + call bagw_allom(d,ipft,bt_agw,dbt_agw_dd) + call bbgw_allom(d,ipft,bt_bgw,dbt_bgw_dd) + call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & + dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) + + ! This calculates a diameter increment based on the difference + ! in structural mass and the target mass, and sets it to a 10th + ! of the diameter increment + dd = (bdead - bt_dead)/(dbt_dead_dd*approx_partial_steps) + + do while( (bdead-bt_dead) > calloc_abs_error ) + d = d + dd + call h_allom(d,ipft,h) + call bsap_allom(d,ipft,canopy_trim,bt_sap,dbt_sap_dd) + call bagw_allom(d,ipft,bt_agw,dbt_agw_dd) + call bbgw_allom(d,ipft,bt_bgw,dbt_bgw_dd) + call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & + dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) + + end do + + ! At this point, the diameter, height and their target structural biomass + ! should be pretty close to and greater than actual + + return + end subroutine StructureResetofDH + ! =========================================================================== subroutine cspline(x1,x2,y1,y2,dydx1,dydx2,x,y,dydx) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index df659eaa71..547d465dce 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -721,7 +721,6 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%nv = ', ccohort%nv write(fates_log(),*) 'co%status_coh = ', ccohort%status_coh write(fates_log(),*) 'co%canopy_trim = ', ccohort%canopy_trim - write(fates_log(),*) 'co%status_coh = ', ccohort%status_coh write(fates_log(),*) 'co%excl_weight = ', ccohort%excl_weight write(fates_log(),*) 'co%prom_weight = ', ccohort%prom_weight write(fates_log(),*) 'co%size_class = ', ccohort%size_class From 3974dcc52e745d53b663391dbb018b5bf84dec2e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 19 Jan 2018 19:00:14 -0800 Subject: [PATCH 075/111] reduced some line numbers --- biogeochem/EDPhysiologyMod.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index c903505648..cf880fc9ca 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -901,7 +901,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! II. Calculate target size of living biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- - !! call GetAllometricTargets(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,bt_fineroot,bt_sapwood,bt_store,bt_dead) + !! call GetAllometricTargets(currentCohort%dbh,currentCohort%canopy_trim, & + !! bt_leaf,bt_fineroot,bt_sapwood,bt_store,bt_dead) ! Target leaf biomass according to allometry and trimming call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) @@ -1026,14 +1027,16 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! If we are testing b4b, then we pay this even if we don't have the carbon ! Just don't pay so much carbon that storage+carbon_balance can't pay for it - bl_flux = min(leaf_turnover_demand,max(0.0_r8, (currentCohort%bstore+carbon_balance)*(leaf_turnover_demand/total_turnover_demand))) + bl_flux = min(leaf_turnover_demand, & + max(0.0_r8,(currentCohort%bstore+carbon_balance)*(leaf_turnover_demand/total_turnover_demand))) carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day ! If we are testing b4b, then we pay this even if we don't have the carbon - br_flux = min(root_turnover_demand,max(0.0_r8, (currentCohort%bstore+carbon_balance)*(root_turnover_demand/total_turnover_demand))) + br_flux = min(root_turnover_demand, & + max(0.0_r8, (currentCohort%bstore+carbon_balance)*(root_turnover_demand/total_turnover_demand))) carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux From f0c9c44651afe4e282f2f555179705b5f8ac6761 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 22 Jan 2018 11:56:36 -0800 Subject: [PATCH 076/111] Allocation update: minor syntax fixes from merge. --- biogeochem/FatesAllometryMod.F90 | 1 + main/FatesHistoryInterfaceMod.F90 | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 08d4414fa2..35ed21ae7e 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -550,6 +550,7 @@ subroutine bsap_allom(d,ipft,canopy_trim,bsap,dbsapdd) if ( bsap >= bsap_cap ) then dbsapdd = max_frac*(dbagwdd+dbbgwdd) end if + end if case(9) ! deprecated (9) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index f88883ef52..ad486b77c5 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1473,7 +1473,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) npp_partition_error = abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_fnrt+ & ccohort%npp_sapw+ccohort%npp_dead+ & ccohort%npp_seed+ccohort%npp_stor)) - if( npp_partition_error > 1.0e-9_r8 ) then + if( npp_partition_error > 100.0_r8*calloc_abs_error ) then write(fates_log(),*) 'NPP Partitions are not balancing' write(fates_log(),*) 'Absolute Error [kgC/day]: ',npp_partition_error write(fates_log(),*) 'Fractional Error: ', abs(npp_partition_error/ccohort%npp_acc_hold) @@ -1518,10 +1518,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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 + ccohort%b_total() * ccohort%n * EDPftvarcon_inst%allom_agb_frac(ccohort%pft) * AREA_INV hio_biomass_si_scls(io_si,scls) = hio_biomass_si_scls(io_si,scls) + & - ccohort%b * ccohort%n * AREA_INV + ccohort%b_total() * ccohort%n * AREA_INV ! update size-class x patch-age related quantities From f1de9dbffdc61e0684515c45709034b020cd8696 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 22 Jan 2018 18:36:34 -0800 Subject: [PATCH 077/111] First pass at using a modulator integrator, which includes the RKF45. --- biogeochem/EDCohortDynamicsMod.F90 | 7 + biogeochem/EDPhysiologyMod.F90 | 485 +++++++++++++++++++++-------- biogeochem/FatesAllometryMod.F90 | 24 ++ main/EDTypesMod.F90 | 7 +- main/FatesIntegratorsMod.F90 | 162 ++++++++++ main/FatesRestartInterfaceMod.F90 | 19 +- 6 files changed, 577 insertions(+), 127 deletions(-) create mode 100644 main/FatesIntegratorsMod.F90 diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b945b6d558..61b80f76a9 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -125,6 +125,7 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%bl = bleaf new_cohort%br = bfineroot new_cohort%bsw = bsap + new_cohort%ode_opt_step = 1.0e6_r8 ! Initialize the integrator step size as super-huge call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & new_cohort%size_class,new_cohort%size_by_pft_class) @@ -317,6 +318,8 @@ subroutine nan_cohort(cc_p) currentCohort%crownfire_mort = nan ! probability of tree post-fire mortality due to crown scorch currentCohort%fire_mort = nan ! post-fire mortality from cambial and crown damage assuming two are independent + currentCohort%ode_opt_step = nan ! integrator step size + end subroutine nan_cohort !-------------------------------------------------------------------------------------! @@ -788,6 +791,10 @@ subroutine fuse_cohorts(patchptr, bc_in) currentCohort%dbstoredt = (currentCohort%n*currentCohort%dbstoredt + nextc%n*nextc%dbstoredt) & /newn + ! Integration step size + currentCohort%ode_opt_step = (currentCohort%n*currentCohort%ode_opt_step + & + nextc%n*nextc%ode_opt_step)/newn + do i=1, nlevleaf if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then currentCohort%year_net_uptake(i) = & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index cf880fc9ca..8b59fb545a 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -48,6 +48,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : CheckIntegratedAllometries + use FatesIntegratorsMod, only : RKF45 implicit none @@ -74,6 +75,14 @@ module EDPhysiologyMod character(len=*), parameter, private :: sourcefile = & __FILE__ + integer, parameter :: i_dbh = 1 ! Array index associated with dbh + integer, parameter :: i_cleaf = 2 ! Array index associated with leaf carbon + integer, parameter :: i_cfroot = 3 ! Array index associated with fine-root carbon + integer, parameter :: i_csap = 4 ! Array index associated with sapwood carbon + integer, parameter :: i_cstore = 5 ! Array index associated with storage carbon + integer, parameter :: i_cdead = 6 ! Array index associated with structural carbon + integer, parameter :: i_crepro = 7 ! Array index associated with reproductive carbon + integer, parameter :: n_cplantpools = 7 ! Size of the carbon only integration framework ! ============================================================================ @@ -811,6 +820,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: root_turnover_demand ! fineroot carbon that is demanded to replace maintenance turnover [kgC] real(r8) :: total_turnover_demand ! total carbon that is demanded to replace maintenance turnover [kgC] + real(r8),dimension(n_cplantpools) :: c_pool ! Vector of carbon pools passed to integrator + real(r8),dimension(n_cplantpools) :: c_pool_out ! Vector of carbon pools passed back from integrator + logical,dimension(n_cplantpools) :: c_mask ! Mask of active pools during integration + + logical :: rkf_err ! Did the rkf45 pass?x + logical :: grow_leaf logical :: grow_froot logical :: grow_sap @@ -843,6 +858,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance integer , parameter :: max_substeps = 16 + integer, parameter :: ODESolve = 1 ! 1=RKF45, 2=Euler + + ipft = currentCohort%pft ! Initialize seed production @@ -913,8 +931,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) dbt_leaf_dd = 0.0_r8 end if - - ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) @@ -1192,133 +1208,93 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) grow_leaf,grow_froot,grow_sap,grow_store,grow_dead) - deltaC = carbon_balance - nsteps = 1 - ierr = 1 - - do while( ierr .ne. 0 ) + if(ODESolve == 1) then + ierr = 1 totalC = carbon_balance - dbh_sub = currentCohort%dbh - h_sub = currentCohort%hite - bl_sub = currentCohort%bl - br_sub = currentCohort%br - bsw_sub = currentCohort%bsw - bstore_sub = currentCohort%bstore - bdead_sub = currentCohort%bdead - brepro_sub = 0.0_r8 - - do istep=1,nsteps + nsteps = 0 + c_pool(i_dbh) = currentCohort%dbh + c_pool(i_cleaf) = currentCohort%bl + c_pool(i_cfroot) = currentCohort%br + c_pool(i_csap) = currentCohort%bsw + c_pool(i_cstore) = currentCohort%bstore + c_pool(i_cdead) = currentCohort%bdead + c_pool(i_crepro) = 0.0_r8 + c_mask(i_dbh) = .true. ! Always increment dbh on growth step + c_mask(i_cleaf) = grow_leaf + c_mask(i_cfroot) = grow_froot + c_mask(i_csap) = grow_sap + c_mask(i_cstore) = grow_store + c_mask(i_cdead) = .true. ! Always increment dead on growth step + c_mask(i_crepro) = .true. ! Always calculate reproduction on growth + + do while( ierr .ne. 0 ) + + deltaC = min(totalC,currentCohort%ode_opt_step) - call bleaf(dbh_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) - call bfineroot(dbh_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) - call bsap_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) - call bagw_allom(dbh_sub,ipft,bt_agw,dbt_agw_dd) - call bbgw_allom(dbh_sub,ipft,bt_bgw,dbt_bgw_dd) - call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & - dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) - call bstore_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) + call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out,rkf_err) - ! fraction of carbon going towards reproduction - if (dbh_sub <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) - else - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) + nsteps = nsteps + 1 + + if (rkf_err) then ! If true, then step is accepted + totalC = totalC - deltaC + c_pool(:) = c_pool_out(:) end if - - dbt_total_dd = dbt_dead_dd - if (grow_leaf) dbt_total_dd = dbt_total_dd + dbt_leaf_dd - if (grow_froot) dbt_total_dd = dbt_total_dd + dbt_fineroot_dd - if (grow_sap) dbt_total_dd = dbt_total_dd + dbt_sap_dd - if (grow_store) dbt_total_dd = dbt_total_dd + dbt_store_dd - - bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bdead_sub = bdead_sub + bdead_flux - dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd - call h_allom(dbh_sub,ipft,h_sub) - - if (grow_leaf) then - bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bl_sub = bl_sub + bl_flux + + if(nsteps > max_substeps ) then + write(fates_log(),*) 'Plant Growth Integrator could not find' + write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (grow_froot) then - br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - br_sub = br_sub + br_flux - end if + if(totalC < calloc_abs_error)then + ierr = 0 + bl_flux = c_pool(i_cleaf) - currentCohort%bl + br_flux = c_pool(i_cfroot) - currentCohort%br + bsw_flux = c_pool(i_csap) - currentCohort%bsw + bstore_flux = c_pool(i_cstore) - currentCohort%bstore + bdead_flux = c_pool(i_cdead) - currentCohort%bdead + brepro_flux = c_pool(i_crepro) + + carbon_balance = carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day + + carbon_balance = carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - if (grow_sap) then - bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bsw_sub = bsw_sub + bsw_flux - end if + carbon_balance = carbon_balance - bsw_flux + currentCohort%bsw = currentCohort%bsw + bsw_flux + currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - if (grow_store) then - bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bstore_sub = bstore_sub + bstore_flux - end if + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + + carbon_balance = carbon_balance - bdead_flux + currentCohort%bdead = currentCohort%bdead + bdead_flux + currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day + + carbon_balance = carbon_balance - brepro_flux + currentCohort%npp_seed = currentCohort%npp_seed + brepro_flux / hlm_freq_day + currentCohort%seed_prod = currentCohort%seed_prod + brepro_flux / hlm_freq_day + + dbh_sub = c_pool(i_dbh) + call h_allom(dbh_sub,ipft,h_sub) - brepro_flux = deltaC * repro_fraction - brepro_sub = brepro_sub + brepro_flux - - totalC = totalC - deltaC - - end do + ! Set derivatives used as diagnostics + currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day + currentCohort%dbdeaddt = bdead_flux/hlm_freq_day + currentCohort%dbstoredt = bstore_flux/hlm_freq_day + currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - ! ------------------------------------------------------------------------------------ - ! VIII. Run a post integration test to see if our integrated quantities match - ! the diagnostic quantities. (note we do not need to pass in leaf status - ! because we would not make it to this check if we were not on allometry - ! ------------------------------------------------------------------------------------ + currentCohort%dbh = dbh_sub + currentCohort%hite = h_sub - call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & - bl_sub,br_sub,bsw_sub,bstore_sub,bdead_sub, & - grow_leaf, grow_froot, grow_sap, grow_store, grow_dead, ierr) - - - if(ierr.eq.0 .or. nsteps > max_substeps ) then + end if - ierr = 0 - ! Reset this value for diagnostic - totalC = carbon_balance - - bl_flux = bl_sub - currentCohort%bl - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - - br_flux = br_sub - currentCohort%br - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - - bsw_flux = bsw_sub - currentCohort%bsw - carbon_balance = carbon_balance - bsw_flux - currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - - bstore_flux = bstore_sub - currentCohort%bstore - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - - bdead_flux = bdead_sub - currentCohort%bdead - carbon_balance = carbon_balance - bdead_flux - currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - - carbon_balance = carbon_balance - brepro_sub - currentCohort%npp_seed = currentCohort%npp_seed + brepro_sub / hlm_freq_day - currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day - - ! Set derivatives used as diagnostics - currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day - currentCohort%dbdeaddt = bdead_flux/hlm_freq_day - currentCohort%dbstoredt = bstore_flux/hlm_freq_day - currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - - currentCohort%dbh = dbh_sub - currentCohort%hite = h_sub - if( abs(carbon_balance)>calloc_abs_error ) then write(fates_log(),*) 'carbon conservation error while integrating pools' write(fates_log(),*) 'along alometric curve' @@ -1327,22 +1303,283 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - else + end do + + + else + + + deltaC = carbon_balance + nsteps = 1 + ierr = 1 + + do while( ierr .ne. 0 ) - deltaC = 0.5_r8*deltaC - nsteps = nsteps*2 + totalC = carbon_balance + dbh_sub = currentCohort%dbh + h_sub = currentCohort%hite + bl_sub = currentCohort%bl + br_sub = currentCohort%br + bsw_sub = currentCohort%bsw + bstore_sub = currentCohort%bstore + bdead_sub = currentCohort%bdead + brepro_sub = 0.0_r8 - end if - - end do + do istep=1,nsteps + + call bleaf(dbh_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) + call bfineroot(dbh_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) + call bsap_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) + call bagw_allom(dbh_sub,ipft,bt_agw,dbt_agw_dd) + call bbgw_allom(dbh_sub,ipft,bt_bgw,dbt_bgw_dd) + call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & + dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) + call bstore_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) + + ! fraction of carbon going towards reproduction + if (dbh_sub <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + else + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) + end if + + dbt_total_dd = dbt_dead_dd + if (grow_leaf) dbt_total_dd = dbt_total_dd + dbt_leaf_dd + if (grow_froot) dbt_total_dd = dbt_total_dd + dbt_fineroot_dd + if (grow_sap) dbt_total_dd = dbt_total_dd + dbt_sap_dd + if (grow_store) dbt_total_dd = dbt_total_dd + dbt_store_dd + + bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bdead_sub = bdead_sub + bdead_flux + dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd + call h_allom(dbh_sub,ipft,h_sub) + + if (grow_leaf) then + bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bl_sub = bl_sub + bl_flux + end if + + if (grow_froot) then + br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + br_sub = br_sub + br_flux + end if + + if (grow_sap) then + bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bsw_sub = bsw_sub + bsw_flux + end if + + if (grow_store) then + bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) + bstore_sub = bstore_sub + bstore_flux + end if + + brepro_flux = deltaC * repro_fraction + brepro_sub = brepro_sub + brepro_flux + + totalC = totalC - deltaC + + end do + ! ------------------------------------------------------------------------------------ + ! VIII. Run a post integration test to see if our integrated quantities match + ! the diagnostic quantities. (note we do not need to pass in leaf status + ! because we would not make it to this check if we were not on allometry + ! ------------------------------------------------------------------------------------ + + call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & + bl_sub,br_sub,bsw_sub,bstore_sub,bdead_sub, & + grow_leaf, grow_froot, grow_sap, grow_store, grow_dead, ierr) + + + if(ierr.eq.0 .or. nsteps > max_substeps ) then + + ierr = 0 + ! Reset this value for diagnostic + totalC = carbon_balance + + bl_flux = bl_sub - currentCohort%bl + carbon_balance = carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day + + br_flux = br_sub - currentCohort%br + carbon_balance = carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day + + bsw_flux = bsw_sub - currentCohort%bsw + carbon_balance = carbon_balance - bsw_flux + currentCohort%bsw = currentCohort%bsw + bsw_flux + currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day + + bstore_flux = bstore_sub - currentCohort%bstore + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + + bdead_flux = bdead_sub - currentCohort%bdead + carbon_balance = carbon_balance - bdead_flux + currentCohort%bdead = currentCohort%bdead + bdead_flux + currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day + + carbon_balance = carbon_balance - brepro_sub + currentCohort%npp_seed = currentCohort%npp_seed + brepro_sub / hlm_freq_day + currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day + + ! Set derivatives used as diagnostics + currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day + currentCohort%dbdeaddt = bdead_flux/hlm_freq_day + currentCohort%dbstoredt = bstore_flux/hlm_freq_day + currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day + + currentCohort%dbh = dbh_sub + currentCohort%hite = h_sub + + if( abs(carbon_balance)>calloc_abs_error ) then + write(fates_log(),*) 'carbon conservation error while integrating pools' + write(fates_log(),*) 'along alometric curve' + write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + else + + deltaC = 0.5_r8*deltaC + nsteps = nsteps*2 + + end if + + end do + end if + ! If the cohort has grown, it is not new currentCohort%isnew=.false. - return - end subroutine PlantGrowth +end subroutine PlantGrowth + + ! ====================================================================================== + + function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) + + ! --------------------------------------------------------------------------------- + ! This function calculates the derivatives for the carbon pools + ! relative to the amount of carbon balance. + ! --------------------------------------------------------------------------------- + + ! Arguments + real(r8),intent(in), dimension(:) :: c_pools ! Vector of carbon pools + ! dbh,leaf,root,sap,store,dead + logical(r8),intent(in), dimension(:):: c_mask ! logical mask of active pools + ! some may be turned off + real(r8),intent(in) :: cbalance ! The carbon balance of the + ! partial step (independant var) + ! THIS IS A DUMMY VAR + type(ed_cohort_type),intent(in),target :: currentCohort ! Cohort derived type + + + ! Return Value + real(r8),dimension(lbound(c_pools,dim=1):ubound(c_pools,dim=1)) :: dCdx + + ! locals + integer :: ipft + real(r8) :: ct_leaf + real(r8) :: ct_froot + real(r8) :: ct_sap + real(r8) :: ct_agw + real(r8) :: ct_bgw + real(r8) :: ct_store + real(r8) :: ct_dead + + real(r8) :: ct_dleafdd + real(r8) :: ct_dfrootdd + real(r8) :: ct_dsapdd + real(r8) :: ct_dagwdd + real(r8) :: ct_dbgwdd + real(r8) :: ct_dstoredd + real(r8) :: ct_ddeaddd + real(r8) :: ct_dtotaldd + real(r8) :: repro_fraction + + + + associate( dbh => c_pools(i_dbh), & + cleaf => c_pools(i_cleaf), & + cfroot => c_pools(i_cfroot), & + csap => c_pools(i_csap), & + cstore => c_pools(i_cstore), & + cdead => c_pools(i_cdead), & + crepro => c_pools(i_crepro), & ! Unused (memoryless) + mask_dbh => c_mask(i_dbh), & ! Unused (dbh always grows) + mask_leaf => c_mask(i_cleaf), & + mask_froot=> c_mask(i_cfroot), & + mask_sap => c_mask(i_csap), & + mask_store=> c_mask(i_cstore), & + mask_dead => c_mask(i_cdead), & ! Unused (dead always grows) + mask_repro=> c_mask(i_crepro) ) ! Unused (memoryless) + + ipft = currentCohort%pft + + call bleaf(dbh,ipft,currentCohort%canopy_trim,ct_leaf,ct_dleafdd) + call bfineroot(dbh,ipft,currentCohort%canopy_trim,ct_froot,ct_dfrootdd) + call bsap_allom(dbh,ipft,currentCohort%canopy_trim,ct_sap,ct_dsapdd) + call bagw_allom(dbh,ipft,ct_agw,ct_dagwdd) + call bbgw_allom(dbh,ipft,ct_bgw,ct_dbgwdd) + call bdead_allom(ct_agw,ct_bgw, ct_sap, ipft, ct_dead, & + ct_dagwdd, ct_dbgwdd, ct_dsapdd, ct_ddeaddd) + call bstore_allom(dbh,ipft,currentCohort%canopy_trim,ct_store,ct_dstoredd) + + ! fraction of carbon going towards reproduction + if (dbh <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + else + repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) + end if + + ct_dtotaldd = ct_ddeaddd + if (mask_leaf) ct_dtotaldd = ct_dtotaldd + ct_dleafdd + if (mask_froot) ct_dtotaldd = ct_dtotaldd + ct_dfrootdd + if (mask_sap) ct_dtotaldd = ct_dtotaldd + ct_dsapdd + if (mask_store) ct_dtotaldd = ct_dtotaldd + ct_dstoredd + + dCdx(i_cdead) = (ct_ddeaddd/ct_dtotaldd)*(1.0_r8-repro_fraction) + dCdx(i_dbh) = dCdx(i_cdead) / ct_ddeaddd + + if (mask_leaf) then + dCdx(i_cleaf) = (ct_dleafdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_cleaf) = 0.0_r8 + end if + + if (mask_froot) then + dCdx(i_cfroot) = (ct_dfrootdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_cfroot) = 0.0_r8 + end if + + if (mask_sap) then + dCdx(i_csap) = (ct_dsapdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_csap) = 0.0_r8 + end if + + if (mask_store) then + dCdx(i_cstore) = (ct_dstoredd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_cstore) = 0.0_r8 + end if + + + dCdx(i_crepro) = repro_fraction + + + end associate + + return + end function AllomCGrowthDeriv ! ====================================================================================== diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 35ed21ae7e..64e55e2c44 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -132,7 +132,31 @@ module FatesAllometryMod ! functions ! Check to make sure Martinez-Cano height cap is not on, or explicitly allowed + + ! =========================================================================== + ! Helper Routines + ! =========================================================================== + + + +! subroutine GetAllometricTargets(currentCohort%dbh,currentCohort%canopy_trim, & +! bt_leaf,bt_fineroot,bt_sapwood,bt_store,bt_dead) + + ! --------------------------------------------------------------------------------- + ! This wrapper is used when all allometric targets are desired. When + ! each allometry are called independently, it is less efficient. This is because + ! there are dependencies, for instance sapwood needs to know how much leaf is + ! there, and there ends up being several redundant calls. + ! When we call all allometric targets simultaneously, we don't worry about + ! redundancy. + ! --------------------------------------------------------------------------------- + + + + + +! end subroutine GetAllometricTargets subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & bl,bfr,bsap,bstore,bdead, & diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 547d465dce..7391cdcac4 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -256,6 +256,11 @@ module EDTypesMod real(r8) :: crownfire_mort ! probability of tree post-fire mortality due to crown scorch:- real(r8) :: fire_mort ! post-fire mortality from cambial and crown damage assuming two are independent:- + ! Integration + real(r8) :: ode_opt_step ! What is the current optimum step size + ! for the integrator? (variable units, including kgC, + ! and then time when we have multiple species) + ! Hydraulics type(ed_cohort_hydr_type), pointer :: co_hydr ! All cohort hydraulics data, see FatesHydraulicsMemMod.F90 @@ -740,7 +745,7 @@ subroutine dump_cohort(ccohort) write(fates_log(),*) 'co%npp_dead = ', ccohort%npp_dead write(fates_log(),*) 'co%npp_seed = ', ccohort%npp_seed write(fates_log(),*) 'co%npp_stor = ', ccohort%npp_stor - + write(fates_log(),*) 'co%ode_opt_step = ', ccohort%ode_opt_step write(fates_log(),*) 'co%rdark = ', ccohort%rdark write(fates_log(),*) 'co%resp_m = ', ccohort%resp_m write(fates_log(),*) 'co%resp_g = ', ccohort%resp_g diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 new file mode 100644 index 0000000000..27cbc443d7 --- /dev/null +++ b/main/FatesIntegratorsMod.F90 @@ -0,0 +1,162 @@ +module FatesIntegratorsMod + + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : ed_patch_type + use EDTypesMod , only : ed_cohort_type + use FatesConstantsMod, only : r8 => fates_r8 + + implicit none + integer, parameter :: max_states = 20 + + public :: RKF45 + +contains + + subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) + + ! --------------------------------------------------------------------------------- + ! Runge-Kutta-Fehlerg 4/5 order adaptive explicit integration + ! + ! + ! --------------------------------------------------------------------------------- + + ! Arguments + + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: dx ! step size of independent variable + real(r8),intent(in) :: x ! independent variable (time?) + type(ed_cohort_type),intent(inout),target :: ccohort ! Cohort derived type + real(r8),intent(inout), dimension(:) :: Yout ! The output vector + logical,intent(out) :: l_err ! Was this a successfully step? + + ! Locals + integer :: nY ! size of Y + real(r8), dimension(max_states) :: Ytemp ! scratch space for the dependent variable + real(r8) :: xtemp + real(r8), dimension(max_states) :: K0 + real(r8), dimension(max_states) :: K1 + real(r8), dimension(max_states) :: K2 + real(r8), dimension(max_states) :: K3 + real(r8), dimension(max_states) :: K4 + real(r8), dimension(max_states) :: K5 + real(r8) :: err45 ! Estimated integrator error + + real(r8), parameter :: max_err45 = 0.001 ! maximum allowable integrator error + + real(r8), parameter :: t1 = 1.0/4.0 + real(r8), parameter :: f1_0 = 1.0/4.0 + real(r8), parameter :: t2 = 3.0/8.0 + real(r8), parameter :: f2_0 = 3.0/32.0 + real(r8), parameter :: f2_1 = 9.0/32.0 + real(r8), parameter :: t3 = 12.0/13.0 + real(r8), parameter :: f3_0 = 1932.0/2197.0 + real(r8), parameter :: f3_1 = -7200.0/2197.0 + real(r8), parameter :: f3_2 = 7296.0/2197.0 + real(r8), parameter :: t4 = 1.0 + real(r8), parameter :: f4_0 = 439.0/216.0 + real(r8), parameter :: f4_1 = -8.0 + real(r8), parameter :: f4_2 = 3680.0/513.0 + real(r8), parameter :: f4_3 = -845.0/4104.0 + real(r8), parameter :: t5 = 0.5 + real(r8), parameter :: f5_0 = -8.0/27.0 + real(r8), parameter :: f5_1 = 2.0 + real(r8), parameter :: f5_2 = -3544.0/2565.0 + real(r8), parameter :: f5_3 = 1859.0/4104.0 + real(r8), parameter :: f5_4 = -11.0/40.0 + real(r8), parameter :: y_0 = 25.0/216.0 + real(r8), parameter :: y_2 = 1408.0/2565.0 + real(r8), parameter :: y_3 = 2197.0/4104.0 + real(r8), parameter :: y_4 = -1.0/5.0 + real(r8), parameter :: z_0 = 16.0/135.0 + real(r8), parameter :: z_2 = 6656.0/12825.0 + real(r8), parameter :: z_3 = 28561.0/56430.0 + real(r8), parameter :: z_4 = -9.0/50.0 + real(r8), parameter :: z_5 = 2.0/55.0 + + ! Input Functional Argument + interface + function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : ed_patch_type + use EDTypesMod , only : ed_cohort_type + use FatesConstantsMod, only : r8 => fates_r8 + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: x ! independent variable (time?) + type(ed_cohort_type),intent(in) :: ccohort ! Cohort derived type + real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable + end function DerivFunction + end interface + + + + nY = size(Y,1) + + ! 0th Step + Ytemp(1:nY) = Y(1:nY) + xtemp = x + K0(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) + + ! 1st Step + Ytemp(1:nY) = Y(1:nY) + dx * (f1_0*K0(1:nY)) + xtemp = x + t1*dx + K1(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) + + ! 2nd Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f2_0*K0(1:nY) + f2_1*K1(1:nY) ) + xtemp = x + t2*dx + K2(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) + + ! 3rd Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f3_0*K0(1:nY) + f3_1*K1(1:nY) + f3_2*K2(1:nY)) + xtemp = x + t3*dx + K3(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) + + ! 4th Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f4_0*K0(1:nY) + f4_1*K1(1:nY) + & + f4_2*K2(1:nY) + f4_3*K3(1:nY)) + xtemp = x + t4*dx + K4(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) + + ! 5th Step + Ytemp(1:nY) = Y(1:nY) + dx * ( f5_0*K0(1:nY) + f5_1*K1(1:nY) + & + f5_2*K2(1:nY) + f5_3*K3(1:nY) + & + f5_4*K4(1:nY)) + xtemp = x + t5*dx + K5(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) + + + ! Evaluate error on the 4/5 steps + + ! 4th order + Ytemp(1:nY) = Y(1:nY) + dx * ( y_0*K0(1:nY) + y_2*K2(1:nY) + & + y_3*K3(1:nY) + y_4*K4(1:nY) ) + ! 5th order + Yout(1:nY) = Y(1:nY) + dx * ( z_0*K0(1:nY) + z_2*K2(1:nY) + & + z_3*K3(1:nY) + z_4*K4(1:nY) + & + z_5*K5(1:nY) ) + + ! Take the maximum absolute error across all variables + err45 = maxval(abs(Yout(1:nY)-Ytemp(1:nY))) + + ! -------------------------------------------------------------------------------- + ! Evaluate error and either approve/reject step. + ! + ! Update our estimate of the optimal time-step. We won't update + ! the current time-step based on this, but we will save this info + ! to help decide the starting sub-step on the next full step + ! -------------------------------------------------------------------------------- + + ccohort%ode_opt_step = dx * 0.840896 * ((max_err45 * dx)/err45)**0.25 ! Smooth recomended + + if(err45 > max_err45) then + l_err = .false. + else + l_err = .true. + end if + + return + end subroutine RKF45 + + end module FatesIntegratorsMod diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 440a3112ce..bff6409c70 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -98,6 +98,8 @@ module FatesRestartInterfaceMod integer, private :: ir_npp_dead_co integer, private :: ir_npp_seed_co integer, private :: ir_npp_store_co + + integer, private :: ir_ode_opt_step_co integer, private :: ir_bmort_co integer, private :: ir_hmort_co @@ -741,6 +743,11 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/indiv/day', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_store_co ) + call this%set_restart_var(vname='fates_ode_opt_step', vtype=cohort_r8, & + long_name='ed cohort - current ode integrator step size', & + units='-', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ode_opt_step_co) + call this%set_restart_var(vname='fates_bmort', vtype=cohort_r8, & long_name='ed cohort - background mortality rate', & units='/year', flushval = flushzero, & @@ -1067,6 +1074,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_npp_dead_co => this%rvars(ir_npp_dead_co)%r81d, & rio_npp_seed_co => this%rvars(ir_npp_seed_co)%r81d, & rio_npp_store_co => this%rvars(ir_npp_store_co)%r81d, & + + rio_ode_opt_step_co => this%rvars(ir_ode_opt_step_co)%r81d, & + 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, & @@ -1187,7 +1197,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_npp_sw_co(io_idx_co) = ccohort%npp_sapw rio_npp_dead_co(io_idx_co) = ccohort%npp_dead rio_npp_seed_co(io_idx_co) = ccohort%npp_seed - rio_npp_store_co(io_idx_co) = ccohort%npp_stor + rio_npp_store_co(io_idx_co) = ccohort%npp_stor + rio_ode_opt_step_co(io_idx_co) = ccohort%ode_opt_step rio_bmort_co(io_idx_co) = ccohort%bmort rio_hmort_co(io_idx_co) = ccohort%hmort rio_cmort_co(io_idx_co) = ccohort%cmort @@ -1652,7 +1663,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_npp_sw_co => this%rvars(ir_npp_sw_co)%r81d, & rio_npp_dead_co => this%rvars(ir_npp_dead_co)%r81d, & rio_npp_seed_co => this%rvars(ir_npp_seed_co)%r81d, & - rio_npp_store_co => this%rvars(ir_npp_store_co)%r81d, & + rio_npp_store_co => this%rvars(ir_npp_store_co)%r81d, & + + rio_ode_opt_step_co => this%rvars(ir_ode_opt_step_co)%r81d, & + 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, & @@ -1757,6 +1771,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%npp_dead = rio_npp_dead_co(io_idx_co) ccohort%npp_seed = rio_npp_seed_co(io_idx_co) ccohort%npp_stor = rio_npp_store_co(io_idx_co) + ccohort%ode_opt_step = rio_ode_opt_step_co(io_idx_co) ccohort%bmort = rio_bmort_co(io_idx_co) ccohort%hmort = rio_hmort_co(io_idx_co) ccohort%cmort = rio_cmort_co(io_idx_co) From 87f9b82652817651a77e9a60cb971166956dfbc2 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 23 Jan 2018 22:48:11 -0800 Subject: [PATCH 078/111] Syntax fixes on calling the derivative function through the RK45 integrator. --- biogeochem/EDPhysiologyMod.F90 | 2 +- main/FatesIntegratorsMod.F90 | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 8b59fb545a..e48b308a87 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1473,7 +1473,7 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) ! Arguments real(r8),intent(in), dimension(:) :: c_pools ! Vector of carbon pools ! dbh,leaf,root,sap,store,dead - logical(r8),intent(in), dimension(:):: c_mask ! logical mask of active pools + logical,intent(in), dimension(:) :: c_mask ! logical mask of active pools ! some may be turned off real(r8),intent(in) :: cbalance ! The carbon balance of the ! partial step (independant var) diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index 27cbc443d7..01ea5aee0b 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -12,7 +12,7 @@ module FatesIntegratorsMod contains - subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) + subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) ! --------------------------------------------------------------------------------- ! Runge-Kutta-Fehlerg 4/5 order adaptive explicit integration @@ -23,7 +23,7 @@ subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) ! Arguments real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) - logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on + logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on real(r8),intent(in) :: dx ! step size of independent variable real(r8),intent(in) :: x ! independent variable (time?) type(ed_cohort_type),intent(inout),target :: ccohort ! Cohort derived type @@ -81,10 +81,10 @@ function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type use FatesConstantsMod, only : r8 => fates_r8 - real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) - logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on - real(r8),intent(in) :: x ! independent variable (time?) - type(ed_cohort_type),intent(in) :: ccohort ! Cohort derived type + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: x ! independent variable (time?) + type(ed_cohort_type),intent(in),target :: ccohort ! Cohort derived type real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable end function DerivFunction end interface From fbe62eb774a269952c2dca109c0fe950cffca678 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 24 Jan 2018 16:03:10 -0800 Subject: [PATCH 079/111] Added Euler to the generic integrator --- main/FatesIntegratorsMod.F90 | 50 ++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index 27cbc443d7..c1bb16a587 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -9,6 +9,7 @@ module FatesIntegratorsMod integer, parameter :: max_states = 20 public :: RKF45 + public :: Euler contains @@ -159,4 +160,53 @@ end function DerivFunction return end subroutine RKF45 + ! =================================================================================== + + subroutine Euler(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) + + ! --------------------------------------------------------------------------------- + ! Simple Euler Integration + ! --------------------------------------------------------------------------------- + + ! Arguments + + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: dx ! step size of independent variable + real(r8),intent(in) :: x ! independent variable (time?) + type(ed_cohort_type),intent(inout),target :: ccohort ! Cohort derived type + real(r8),intent(inout), dimension(:) :: Yout ! The output vector + logical,intent(out) :: l_err ! Was this a successfully step? + + ! Locals + integer :: nY ! size of Y + real(r8), dimension(max_states) :: Ytemp ! scratch space for the dependent variable + real(r8) :: xtemp + real(r8), dimension(max_states) :: dYdx + real(r8) :: errE ! Estimated integrator error + + ! Input Functional Argument + interface + function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : ed_patch_type + use EDTypesMod , only : ed_cohort_type + use FatesConstantsMod, only : r8 => fates_r8 + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: x ! independent variable (time?) + type(ed_cohort_type),intent(in) :: ccohort ! Cohort derived type + real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable + end function DerivFunction + end interface + + + dYdx(1:nY) = DerivFunction(Y(1:nY),Ymask,x,ccohort) + Yout(1:nY) = Y(1:nY) + dx * dYdx(1:nY) + + + return + end subroutine Euler + + end module FatesIntegratorsMod From e3e56087c2a56b189210068fa28412f961ffde2d Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 24 Jan 2018 21:48:43 -0700 Subject: [PATCH 080/111] fixes to scalar logic in modify_fates_paramfile.py --- tools/modify_fates_paramfile.py | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/tools/modify_fates_paramfile.py b/tools/modify_fates_paramfile.py index 92ab14dab1..c48efdf8ce 100755 --- a/tools/modify_fates_paramfile.py +++ b/tools/modify_fates_paramfile.py @@ -58,22 +58,25 @@ def main(): ### 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 purposes of current stat eof this script, assume 1D + if ndim_file > 1: + raise ValueError('variable dimensionality is too high for this script') + if ndim_file < 1: + raise ValueError('variable dimensionality is too low for this script. FATES assumes even scalars have a 1-length dimension') for i in range(ndim_file): if var.dimensions[i] == 'fates_pft': ispftvar = True npft_file = var.shape[i] pftdim = 0 - else: + elif var.dimensions[i] == 'fates_scalar': npft_file = None pftdim = None + else: + raise ValueError('variable is not on either the PFT or scalar dimension') 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)+').') From e3e4d029e264a57d98a743575c4451ad2a7d83db Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 24 Jan 2018 22:35:36 -0700 Subject: [PATCH 081/111] changed modify_fates_paramfile.py to first write to temp file and then move that --- tools/modify_fates_paramfile.py | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/tools/modify_fates_paramfile.py b/tools/modify_fates_paramfile.py index c48efdf8ce..0f7ee15e8e 100755 --- a/tools/modify_fates_paramfile.py +++ b/tools/modify_fates_paramfile.py @@ -19,6 +19,8 @@ from scipy.io import netcdf as nc import argparse import shutil +import tempfile + # ======================================================================================== # ======================================================================================== @@ -38,20 +40,13 @@ def main(): 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) # - # check to see if output file exists - if os.path.isfile(args.outputfname): - if args.overwrite: - 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) + # work with the file in some random temprary place so that if something goes wrong nothing happens to original file and it doesn't make an output file + tempfilename = os.path.join(tempfile.mkdtemp(), 'temp_fates_param_file.nc') # - shutil.copyfile(args.inputfname, args.outputfname) + shutil.copyfile(args.inputfname, tempfilename) # - ncfile = nc.netcdf_file(args.outputfname, 'a') + ncfile = nc.netcdf_file(tempfilename, 'a') # var = ncfile.variables[args.varname] # @@ -93,6 +88,20 @@ def main(): # # ncfile.close() + # + # + # now move file from temprary location to final location + # + # check to see if output file exists + if os.path.isfile(args.outputfname): + if args.overwrite: + 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) + # + shutil.move(tempfilename, args.outputfname) From ce6ac7409bbe1bef2e5bd93c7e257b632d2c83c1 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 24 Jan 2018 22:52:50 -0700 Subject: [PATCH 082/111] added tempdir cleanup and better exception handling --- tools/modify_fates_paramfile.py | 122 +++++++++++++++++--------------- 1 file changed, 63 insertions(+), 59 deletions(-) diff --git a/tools/modify_fates_paramfile.py b/tools/modify_fates_paramfile.py index 0f7ee15e8e..53bd82decc 100755 --- a/tools/modify_fates_paramfile.py +++ b/tools/modify_fates_paramfile.py @@ -42,68 +42,72 @@ def main(): args = parser.parse_args() # # work with the file in some random temprary place so that if something goes wrong nothing happens to original file and it doesn't make an output file - tempfilename = os.path.join(tempfile.mkdtemp(), 'temp_fates_param_file.nc') + tempdir = tempfile.mkdtemp() + tempfilename = os.path.join(tempdir, 'temp_fates_param_file.nc') # - shutil.copyfile(args.inputfname, tempfilename) - # - ncfile = nc.netcdf_file(tempfilename, '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 purposes of current stat eof this script, assume 1D - if ndim_file > 1: - raise ValueError('variable dimensionality is too high for this script') - if ndim_file < 1: - raise ValueError('variable dimensionality is too low for this script. FATES assumes even scalars have a 1-length dimension') - for i in range(ndim_file): - if var.dimensions[i] == 'fates_pft': - ispftvar = True - npft_file = var.shape[i] - pftdim = 0 - elif var.dimensions[i] == 'fates_scalar': - npft_file = None - pftdim = None - else: - raise ValueError('variable is not on either the PFT or scalar dimension') - 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 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: + try: + shutil.copyfile(args.inputfname, tempfilename) + # + ncfile = nc.netcdf_file(tempfilename, '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 purposes of current stat eof this script, assume 1D + if ndim_file > 1: + raise ValueError('variable dimensionality is too high for this script') + if ndim_file < 1: + raise ValueError('variable dimensionality is too low for this script. FATES assumes even scalars have a 1-length dimension') + for i in range(ndim_file): + if var.dimensions[i] == 'fates_pft': + ispftvar = True + npft_file = var.shape[i] + pftdim = 0 + elif var.dimensions[i] == 'fates_scalar': + npft_file = None + pftdim = None + else: + raise ValueError('variable is not on either the PFT or scalar dimension') + 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 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: + 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+', 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.') - # - # - ncfile.close() - # - # - # now move file from temprary location to final location - # - # check to see if output file exists - if os.path.isfile(args.outputfname): - if args.overwrite: - if not args.silent: - print('replacing file: '+args.outputfname) - os.remove(args.outputfname) + 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('Output file already exists and overwrite flag not specified for filename: '+args.outputfname) - # - shutil.move(tempfilename, args.outputfname) - - + raise ValueError('Nothing happened somehow.') + # + # + ncfile.close() + # + # + # now move file from temprary location to final location + # + # check to see if output file exists + if os.path.isfile(args.outputfname): + if args.overwrite: + 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) + # + shutil.move(tempfilename, args.outputfname) + shutil.rmtree(tempdir, ignore_errors=True) + except: + shutil.rmtree(tempdir, ignore_errors=True) + raise # ======================================================================================= From c6d508b7f90d3ba2fd4ce5c8043686e602d914cb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 24 Jan 2018 23:10:14 -0700 Subject: [PATCH 083/111] 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 76d692ac167ced8c0d3593a905e326614a06eef4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 24 Jan 2018 22:43:20 -0800 Subject: [PATCH 084/111] Tweaks on the integrator, such as initializing the derivative to zero, exending the max steps. --- biogeochem/EDPhysiologyMod.F90 | 356 +++++++++++-------------------- biogeochem/FatesAllometryMod.F90 | 29 +-- main/FatesIntegratorsMod.F90 | 29 ++- 3 files changed, 149 insertions(+), 265 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e48b308a87..5c36d7332b 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -47,6 +47,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : CheckIntegratedAllometries + use FatesAllometryMod , only : StructureResetOfDH use FatesIntegratorsMod, only : RKF45 @@ -824,7 +825,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8),dimension(n_cplantpools) :: c_pool_out ! Vector of carbon pools passed back from integrator logical,dimension(n_cplantpools) :: c_mask ! Mask of active pools during integration - logical :: rkf_err ! Did the rkf45 pass?x + logical :: step_pass ! Did the integration step pass? logical :: grow_leaf logical :: grow_froot @@ -856,9 +857,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(r8), parameter :: background_woody_turnover = 0.0_r8 real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance - integer , parameter :: max_substeps = 16 - - integer, parameter :: ODESolve = 1 ! 1=RKF45, 2=Euler + ! non-integrator part + integer , parameter :: max_substeps = 300 + real(r8), parameter :: max_trunc_error = 0.0001 + integer, parameter :: ODESolve = 1 ! 1=RKF45, 2=Euler ipft = currentCohort%pft @@ -949,6 +951,13 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Target storage carbon [kgC,kgC/cm] call bstore_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) + ! If structure is larger than target, then we need to correct some integration errors + ! by slightly increasing dbh + if((currentCohort%bdead-bt_dead) > calloc_abs_error) then + call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & + currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) + end if + ! ----------------------------------------------------------------------------------- ! IV(a). Calculate the maintenance turnover demands ! Pre-check, make sure phenology is mutually exclusive and at least one chosen @@ -1208,92 +1217,113 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) grow_leaf,grow_froot,grow_sap,grow_store,grow_dead) - if(ODESolve == 1) then - - ierr = 1 - totalC = carbon_balance - nsteps = 0 - c_pool(i_dbh) = currentCohort%dbh - c_pool(i_cleaf) = currentCohort%bl - c_pool(i_cfroot) = currentCohort%br - c_pool(i_csap) = currentCohort%bsw - c_pool(i_cstore) = currentCohort%bstore - c_pool(i_cdead) = currentCohort%bdead - c_pool(i_crepro) = 0.0_r8 - c_mask(i_dbh) = .true. ! Always increment dbh on growth step - c_mask(i_cleaf) = grow_leaf - c_mask(i_cfroot) = grow_froot - c_mask(i_csap) = grow_sap - c_mask(i_cstore) = grow_store - c_mask(i_cdead) = .true. ! Always increment dead on growth step - c_mask(i_crepro) = .true. ! Always calculate reproduction on growth - - do while( ierr .ne. 0 ) - - deltaC = min(totalC,currentCohort%ode_opt_step) - - call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out,rkf_err) - - nsteps = nsteps + 1 - - if (rkf_err) then ! If true, then step is accepted - totalC = totalC - deltaC - c_pool(:) = c_pool_out(:) + ! Initialize the adaptive integrator arrays and flags + ! ----------------------------------------------------------------------------------- + ierr = 1 + totalC = carbon_balance + nsteps = 0 + c_pool(i_dbh) = currentCohort%dbh + c_pool(i_cleaf) = currentCohort%bl + c_pool(i_cfroot) = currentCohort%br + c_pool(i_csap) = currentCohort%bsw + c_pool(i_cstore) = currentCohort%bstore + c_pool(i_cdead) = currentCohort%bdead + c_pool(i_crepro) = 0.0_r8 + c_mask(i_dbh) = .true. ! Always increment dbh on growth step + c_mask(i_cleaf) = grow_leaf + c_mask(i_cfroot) = grow_froot + c_mask(i_csap) = grow_sap + c_mask(i_cstore) = grow_store + c_mask(i_cdead) = .true. ! Always increment dead on growth step + c_mask(i_crepro) = .true. ! Always calculate reproduction on growth + + do while( ierr .ne. 0 ) + + deltaC = min(totalC,currentCohort%ode_opt_step) + if(ODESolve == 1) then + call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort, & + max_trunc_error,c_pool_out,step_pass) +! if(step_pass) then +! currentCohort%ode_opt_step = deltaC +! else +! currentCohort%ode_opt_step = 0.5*deltaC +! end if + + elseif(ODESolve == 2) then + call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out) + call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & + c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & + c_pool_out(i_cstore), c_pool_out(i_cdead), & + c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & + c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) + if(step_pass) then + currentCohort%ode_opt_step = deltaC + else + currentCohort%ode_opt_step = 0.5*deltaC end if + end if + + nsteps = nsteps + 1 + + if (step_pass) then ! If true, then step is accepted + totalC = totalC - deltaC + c_pool(:) = c_pool_out(:) + end if + + if(nsteps > max_substeps ) then + write(fates_log(),*) 'Plant Growth Integrator could not find' + write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - if(nsteps > max_substeps ) then - write(fates_log(),*) 'Plant Growth Integrator could not find' - write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + ! TotalC should eventually be whittled down to near zero + ! At that point, update the actual states + ! -------------------------------------------------------------------------------- + if( (totalC < calloc_abs_error) .and. (step_pass) )then + ierr = 0 + bl_flux = c_pool(i_cleaf) - currentCohort%bl + br_flux = c_pool(i_cfroot) - currentCohort%br + bsw_flux = c_pool(i_csap) - currentCohort%bsw + bstore_flux = c_pool(i_cstore) - currentCohort%bstore + bdead_flux = c_pool(i_cdead) - currentCohort%bdead + brepro_flux = c_pool(i_crepro) - if(totalC < calloc_abs_error)then - ierr = 0 - bl_flux = c_pool(i_cleaf) - currentCohort%bl - br_flux = c_pool(i_cfroot) - currentCohort%br - bsw_flux = c_pool(i_csap) - currentCohort%bsw - bstore_flux = c_pool(i_cstore) - currentCohort%bstore - bdead_flux = c_pool(i_cdead) - currentCohort%bdead - brepro_flux = c_pool(i_crepro) - - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day + carbon_balance = carbon_balance - bl_flux + currentCohort%bl = currentCohort%bl + bl_flux + currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - carbon_balance = carbon_balance - bsw_flux - currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day + carbon_balance = carbon_balance - br_flux + currentCohort%br = currentCohort%br + br_flux + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - - carbon_balance = carbon_balance - bdead_flux - currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - - carbon_balance = carbon_balance - brepro_flux - currentCohort%npp_seed = currentCohort%npp_seed + brepro_flux / hlm_freq_day - currentCohort%seed_prod = currentCohort%seed_prod + brepro_flux / hlm_freq_day - - dbh_sub = c_pool(i_dbh) - call h_allom(dbh_sub,ipft,h_sub) - - ! Set derivatives used as diagnostics - currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day - currentCohort%dbdeaddt = bdead_flux/hlm_freq_day - currentCohort%dbstoredt = bstore_flux/hlm_freq_day - currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - - currentCohort%dbh = dbh_sub - currentCohort%hite = h_sub - - end if + carbon_balance = carbon_balance - bsw_flux + currentCohort%bsw = currentCohort%bsw + bsw_flux + currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day + + carbon_balance = carbon_balance - bstore_flux + currentCohort%bstore = currentCohort%bstore + bstore_flux + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + + carbon_balance = carbon_balance - bdead_flux + currentCohort%bdead = currentCohort%bdead + bdead_flux + currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day + + carbon_balance = carbon_balance - brepro_flux + currentCohort%npp_seed = currentCohort%npp_seed + brepro_flux / hlm_freq_day + currentCohort%seed_prod = currentCohort%seed_prod + brepro_flux / hlm_freq_day + + dbh_sub = c_pool(i_dbh) + call h_allom(dbh_sub,ipft,h_sub) + + ! Set derivatives used as diagnostics + currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day + currentCohort%dbdeaddt = bdead_flux/hlm_freq_day + currentCohort%dbstoredt = bstore_flux/hlm_freq_day + currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day + + currentCohort%dbh = dbh_sub + currentCohort%hite = h_sub if( abs(carbon_balance)>calloc_abs_error ) then write(fates_log(),*) 'carbon conservation error while integrating pools' @@ -1303,156 +1333,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end do - - - else - - - deltaC = carbon_balance - nsteps = 1 - ierr = 1 - - do while( ierr .ne. 0 ) - - totalC = carbon_balance - dbh_sub = currentCohort%dbh - h_sub = currentCohort%hite - bl_sub = currentCohort%bl - br_sub = currentCohort%br - bsw_sub = currentCohort%bsw - bstore_sub = currentCohort%bstore - bdead_sub = currentCohort%bdead - brepro_sub = 0.0_r8 - - do istep=1,nsteps - - call bleaf(dbh_sub,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) - call bfineroot(dbh_sub,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) - call bsap_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_sap,dbt_sap_dd) - call bagw_allom(dbh_sub,ipft,bt_agw,dbt_agw_dd) - call bbgw_allom(dbh_sub,ipft,bt_bgw,dbt_bgw_dd) - call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & - dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) - call bstore_allom(dbh_sub,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) - - ! fraction of carbon going towards reproduction - if (dbh_sub <= EDPftvarcon_inst%dbh_repro_threshold(ipft)) then ! cap on leaf biomass - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) - else - repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) - end if - - dbt_total_dd = dbt_dead_dd - if (grow_leaf) dbt_total_dd = dbt_total_dd + dbt_leaf_dd - if (grow_froot) dbt_total_dd = dbt_total_dd + dbt_fineroot_dd - if (grow_sap) dbt_total_dd = dbt_total_dd + dbt_sap_dd - if (grow_store) dbt_total_dd = dbt_total_dd + dbt_store_dd - - bdead_flux = deltaC * (dbt_dead_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bdead_sub = bdead_sub + bdead_flux - dbh_sub = dbh_sub + bdead_flux / dbt_dead_dd - call h_allom(dbh_sub,ipft,h_sub) - - if (grow_leaf) then - bl_flux = deltaC * (dbt_leaf_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bl_sub = bl_sub + bl_flux - end if - - if (grow_froot) then - br_flux = deltaC * (dbt_fineroot_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - br_sub = br_sub + br_flux - end if - - if (grow_sap) then - bsw_flux = deltaC * (dbt_sap_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bsw_sub = bsw_sub + bsw_flux - end if - - if (grow_store) then - bstore_flux = deltaC * (dbt_store_dd/dbt_total_dd)*(1.0_r8-repro_fraction) - bstore_sub = bstore_sub + bstore_flux - end if - - brepro_flux = deltaC * repro_fraction - brepro_sub = brepro_sub + brepro_flux - - totalC = totalC - deltaC - - end do + end if + end do - ! ------------------------------------------------------------------------------------ - ! VIII. Run a post integration test to see if our integrated quantities match - ! the diagnostic quantities. (note we do not need to pass in leaf status - ! because we would not make it to this check if we were not on allometry - ! ------------------------------------------------------------------------------------ - - call CheckIntegratedAllometries(dbh_sub,ipft,currentCohort%canopy_trim, & - bl_sub,br_sub,bsw_sub,bstore_sub,bdead_sub, & - grow_leaf, grow_froot, grow_sap, grow_store, grow_dead, ierr) - - - if(ierr.eq.0 .or. nsteps > max_substeps ) then - - ierr = 0 - ! Reset this value for diagnostic - totalC = carbon_balance - - bl_flux = bl_sub - currentCohort%bl - carbon_balance = carbon_balance - bl_flux - currentCohort%bl = currentCohort%bl + bl_flux - currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - - br_flux = br_sub - currentCohort%br - carbon_balance = carbon_balance - br_flux - currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - - bsw_flux = bsw_sub - currentCohort%bsw - carbon_balance = carbon_balance - bsw_flux - currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - - bstore_flux = bstore_sub - currentCohort%bstore - carbon_balance = carbon_balance - bstore_flux - currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day - - bdead_flux = bdead_sub - currentCohort%bdead - carbon_balance = carbon_balance - bdead_flux - currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day - - carbon_balance = carbon_balance - brepro_sub - currentCohort%npp_seed = currentCohort%npp_seed + brepro_sub / hlm_freq_day - currentCohort%seed_prod = currentCohort%seed_prod + brepro_sub / hlm_freq_day - - ! Set derivatives used as diagnostics - currentCohort%dhdt = (h_sub-currentCohort%hite)/hlm_freq_day - currentCohort%dbdeaddt = bdead_flux/hlm_freq_day - currentCohort%dbstoredt = bstore_flux/hlm_freq_day - currentCohort%ddbhdt = (dbh_sub-currentCohort%dbh)/hlm_freq_day - - currentCohort%dbh = dbh_sub - currentCohort%hite = h_sub - - if( abs(carbon_balance)>calloc_abs_error ) then - write(fates_log(),*) 'carbon conservation error while integrating pools' - write(fates_log(),*) 'along alometric curve' - write(fates_log(),*) 'carbon_balance = ',carbon_balance,totalC - write(fates_log(),*) 'exiting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - else - - deltaC = 0.5_r8*deltaC - nsteps = nsteps*2 - - end if - - end do - end if + ! If the cohort has grown, it is not new @@ -1538,7 +1422,9 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) else repro_fraction = EDPftvarcon_inst%seed_alloc(ipft) + EDPftvarcon_inst%clone_alloc(ipft) end if - + + dCdx = 0.0_r8 + ct_dtotaldd = ct_ddeaddd if (mask_leaf) ct_dtotaldd = ct_dtotaldd + ct_dleafdd if (mask_froot) ct_dtotaldd = ct_dtotaldd + ct_dfrootdd diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 64e55e2c44..750a2338bf 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -161,7 +161,7 @@ module FatesAllometryMod subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & bl,bfr,bsap,bstore,bdead, & grow_leaf, grow_fr, grow_sap, grow_store, grow_dead, & - ierr) + max_err, l_pass) ! This routine checks the error on the carbon allocation ! integration step. The integrated quantities should @@ -184,8 +184,9 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & logical,intent(in) :: grow_sap ! on-off switch for sapwood logical,intent(in) :: grow_store! on-off switch for storage logical,intent(in) :: grow_dead ! on-off switch for structure + real(r8),intent(in) :: max_err ! maximum allowable error - integer,intent(out) :: ierr ! Error flag (0=pass, 1=fail) + logical,intent(out) :: l_pass ! Error flag (pass=true,no-pass=false) real(r8) :: height ! diagnosed height [m] real(r8) :: bl_diag ! diagnosed leaf biomass [kgC] @@ -196,9 +197,9 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & real(r8) :: bagw_diag ! diagnosed agbw [kgC] real(r8) :: bbgw_diag ! diagnosed below ground wood [kgC] - real(r8) :: relative_err_thresh = 1.0e-4_r8 - ierr = 0 + + l_pass = .true. ! Default assumption is that step passed call h_allom(dbh,ipft,height) @@ -206,7 +207,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & if (grow_leaf) then call bleaf(dbh,ipft,canopy_trim,bl_diag) - if( abs(bl_diag-bl)/bl_diag > relative_err_thresh ) then + if( abs(bl_diag-bl) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed leaf carbon' write(fates_log(),*) 'resulting from the on-allometry growth integration step' @@ -214,13 +215,13 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & write(fates_log(),*) 'bl (diagnosed): ',bl_diag write(fates_log(),*) 'relative error: ',abs(bl_diag-bl)/bl_diag end if - ierr = 1 + l_pass = .false. end if end if if (grow_fr) then call bfineroot(dbh,ipft,canopy_trim,bfr_diag) - if( abs(bfr_diag-bfr)/bfr_diag > relative_err_thresh ) then + if( abs(bfr_diag-bfr) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed fineroot carbon' write(fates_log(),*) 'resulting from the on-allometry growth integration step' @@ -228,13 +229,13 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & write(fates_log(),*) 'bfr (diagnosed): ',bfr_diag write(fates_log(),*) 'relative error: ',abs(bfr_diag-bfr)/bfr_diag end if - ierr = 1 + l_pass = .false. end if end if if (grow_sap) then call bsap_allom(dbh,ipft,canopy_trim,bsap_diag) - if( abs(bsap_diag-bsap)/bsap_diag > relative_err_thresh ) then + if( abs(bsap_diag-bsap) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed sapwood carbon' write(fates_log(),*) 'resulting from the on-allometry growth integration step' @@ -242,13 +243,13 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & write(fates_log(),*) 'bsap (diagnosed): ',bsap_diag write(fates_log(),*) 'relative error: ',abs(bsap_diag-bsap)/bsap_diag end if - ierr = 1 + l_pass = .false. end if end if if (grow_store) then call bstore_allom(dbh,ipft,canopy_trim,bstore_diag) - if( abs(bstore_diag-bstore)/bstore_diag > relative_err_thresh ) then + if( abs(bstore_diag-bstore) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed storage carbon' write(fates_log(),*) 'resulting from the on-allometry growth integration step' @@ -256,7 +257,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & write(fates_log(),*) 'bsap (diagnosed): ',bstore_diag write(fates_log(),*) 'relative error: ',abs(bstore_diag-bstore)/bstore_diag end if - ierr = 1 + l_pass = .false. end if end if @@ -266,7 +267,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & call bagw_allom(dbh,ipft,bagw_diag) call bbgw_allom(dbh,ipft,bbgw_diag) call bdead_allom( bagw_diag, bbgw_diag, bsap_diag, ipft, bdead_diag ) - if( abs(bdead_diag-bdead)/bdead_diag > relative_err_thresh ) then + if( abs(bdead_diag-bdead) > max_err ) then if(verbose_logging) then write(fates_log(),*) 'disparity in integrated/diagnosed structural carbon' write(fates_log(),*) 'resulting from the on-allometry growth integration step' @@ -274,7 +275,7 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & write(fates_log(),*) 'bdead (diagnosed): ',bdead_diag write(fates_log(),*) 'relative error: ',abs(bdead_diag-bdead)/bdead_diag end if - ierr = 1 + l_pass = .false. end if end if diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index 330759c4bf..d30bd8d20d 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -13,7 +13,7 @@ module FatesIntegratorsMod contains - subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) + subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,max_err,Yout,l_pass) ! --------------------------------------------------------------------------------- ! Runge-Kutta-Fehlerg 4/5 order adaptive explicit integration @@ -28,8 +28,9 @@ subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) real(r8),intent(in) :: dx ! step size of independent variable real(r8),intent(in) :: x ! independent variable (time?) type(ed_cohort_type),intent(inout),target :: ccohort ! Cohort derived type + real(r8),intent(in) :: max_err ! Maximum allowable error (absolute) real(r8),intent(inout), dimension(:) :: Yout ! The output vector - logical,intent(out) :: l_err ! Was this a successfully step? + logical,intent(out) :: l_pass ! Was this a successfully step? ! Locals integer :: nY ! size of Y @@ -43,8 +44,6 @@ subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) real(r8), dimension(max_states) :: K5 real(r8) :: err45 ! Estimated integrator error - real(r8), parameter :: max_err45 = 0.001 ! maximum allowable integrator error - real(r8), parameter :: t1 = 1.0/4.0 real(r8), parameter :: f1_0 = 1.0/4.0 real(r8), parameter :: t2 = 3.0/8.0 @@ -149,12 +148,12 @@ end function DerivFunction ! to help decide the starting sub-step on the next full step ! -------------------------------------------------------------------------------- - ccohort%ode_opt_step = dx * 0.840896 * ((max_err45 * dx)/err45)**0.25 ! Smooth recomended + ccohort%ode_opt_step = dx * 0.840896 * ((max_err * dx)/err45)**0.25 ! Smooth recomended - if(err45 > max_err45) then - l_err = .false. + if(err45 > max_err) then + l_pass = .false. else - l_err = .true. + l_pass = .true. end if return @@ -162,7 +161,7 @@ end subroutine RKF45 ! =================================================================================== - subroutine Euler(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) + subroutine Euler(DerivFunction,Y,Ymask,dx,x,ccohort,Yout) ! --------------------------------------------------------------------------------- ! Simple Euler Integration @@ -171,19 +170,17 @@ subroutine Euler(DerivFunction,Y,Ymask,dx,x,ccohort,Yout,l_err) ! Arguments real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) - logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on + logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on real(r8),intent(in) :: dx ! step size of independent variable real(r8),intent(in) :: x ! independent variable (time?) type(ed_cohort_type),intent(inout),target :: ccohort ! Cohort derived type real(r8),intent(inout), dimension(:) :: Yout ! The output vector - logical,intent(out) :: l_err ! Was this a successfully step? ! Locals integer :: nY ! size of Y real(r8), dimension(max_states) :: Ytemp ! scratch space for the dependent variable real(r8) :: xtemp real(r8), dimension(max_states) :: dYdx - real(r8) :: errE ! Estimated integrator error ! Input Functional Argument interface @@ -192,10 +189,10 @@ function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type use FatesConstantsMod, only : r8 => fates_r8 - real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) - logical(r8),intent(in), dimension(:) :: Ymask ! logical mask defining what is on - real(r8),intent(in) :: x ! independent variable (time?) - type(ed_cohort_type),intent(in) :: ccohort ! Cohort derived type + real(r8),intent(in), dimension(:) :: Y ! dependent variable (array) + logical,intent(in), dimension(:) :: Ymask ! logical mask defining what is on + real(r8),intent(in) :: x ! independent variable (time?) + type(ed_cohort_type),intent(in),target :: ccohort ! Cohort derived type real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable end function DerivFunction end interface From eac687ba39bdc6ca27e8c27e134c9de56d812bac Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 Jan 2018 14:54:48 -0700 Subject: [PATCH 085/111] 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 086/111] 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 087/111] 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 485ff928f19376e5db8c66bd6c471c712c22317d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 Jan 2018 17:43:34 -0800 Subject: [PATCH 088/111] Bug fix on RKF45 integrator. Errors were getting so small in some places that they were creating overflows when calculating the next time-step. --- biogeochem/EDPhysiologyMod.F90 | 57 +++++++++++++++++----------------- main/FatesIntegratorsMod.F90 | 17 +++++++--- 2 files changed, 42 insertions(+), 32 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 5c36d7332b..e94bf27233 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -28,6 +28,7 @@ module EDPhysiologyMod use EDTypesMod , only : senes use EDTypesMod , only : maxpft use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDTypesMod , only : dump_cohort use shr_log_mod , only : errMsg => shr_log_errMsg use FatesGlobals , only : fates_log @@ -859,7 +860,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ! non-integrator part integer , parameter :: max_substeps = 300 - real(r8), parameter :: max_trunc_error = 0.0001 + real(r8), parameter :: max_trunc_error = 0.001 integer, parameter :: ODESolve = 1 ! 1=RKF45, 2=Euler @@ -1240,32 +1241,28 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) do while( ierr .ne. 0 ) deltaC = min(totalC,currentCohort%ode_opt_step) + if(ODESolve == 1) then - call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort, & - max_trunc_error,c_pool_out,step_pass) -! if(step_pass) then -! currentCohort%ode_opt_step = deltaC -! else -! currentCohort%ode_opt_step = 0.5*deltaC -! end if - - elseif(ODESolve == 2) then - call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out) - call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & - c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & - c_pool_out(i_cstore), c_pool_out(i_cdead), & - c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & - c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) - if(step_pass) then - currentCohort%ode_opt_step = deltaC - else - currentCohort%ode_opt_step = 0.5*deltaC - end if - end if - - nsteps = nsteps + 1 - - if (step_pass) then ! If true, then step is accepted + call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort, & + max_trunc_error,c_pool_out,step_pass) + + elseif(ODESolve == 2) then + call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out) + call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & + c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & + c_pool_out(i_cstore), c_pool_out(i_cdead), & + c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & + c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) + if(step_pass) then + currentCohort%ode_opt_step = deltaC + else + currentCohort%ode_opt_step = 0.5*deltaC + end if + end if + + nsteps = nsteps + 1 + + if (step_pass) then ! If true, then step is accepted totalC = totalC - deltaC c_pool(:) = c_pool_out(:) end if @@ -1274,6 +1271,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) write(fates_log(),*) 'Plant Growth Integrator could not find' write(fates_log(),*) 'a solution in less than ',max_substeps,' tries' write(fates_log(),*) 'Aborting' + write(fates_log(),*) 'carbon_balance',carbon_balance + write(fates_log(),*) 'deltaC',deltaC + write(fates_log(),*) 'totalC',totalC + call dump_cohort(currentCohort) call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1281,7 +1282,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! At that point, update the actual states ! -------------------------------------------------------------------------------- if( (totalC < calloc_abs_error) .and. (step_pass) )then - ierr = 0 + ierr = 0 bl_flux = c_pool(i_cleaf) - currentCohort%bl br_flux = c_pool(i_cfroot) - currentCohort%br bsw_flux = c_pool(i_csap) - currentCohort%bsw @@ -1432,7 +1433,7 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) if (mask_store) ct_dtotaldd = ct_dtotaldd + ct_dstoredd dCdx(i_cdead) = (ct_ddeaddd/ct_dtotaldd)*(1.0_r8-repro_fraction) - dCdx(i_dbh) = dCdx(i_cdead) / ct_ddeaddd + dCdx(i_dbh) = (1.0_r8/ct_dtotaldd)*(1.0_r8-repro_fraction) if (mask_leaf) then dCdx(i_cleaf) = (ct_dleafdd/ct_dtotaldd)*(1.0_r8-repro_fraction) diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index d30bd8d20d..38566767cc 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -46,28 +46,34 @@ subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,max_err,Yout,l_pass) real(r8), parameter :: t1 = 1.0/4.0 real(r8), parameter :: f1_0 = 1.0/4.0 + real(r8), parameter :: t2 = 3.0/8.0 real(r8), parameter :: f2_0 = 3.0/32.0 real(r8), parameter :: f2_1 = 9.0/32.0 + real(r8), parameter :: t3 = 12.0/13.0 real(r8), parameter :: f3_0 = 1932.0/2197.0 real(r8), parameter :: f3_1 = -7200.0/2197.0 real(r8), parameter :: f3_2 = 7296.0/2197.0 + real(r8), parameter :: t4 = 1.0 real(r8), parameter :: f4_0 = 439.0/216.0 real(r8), parameter :: f4_1 = -8.0 real(r8), parameter :: f4_2 = 3680.0/513.0 real(r8), parameter :: f4_3 = -845.0/4104.0 + real(r8), parameter :: t5 = 0.5 real(r8), parameter :: f5_0 = -8.0/27.0 real(r8), parameter :: f5_1 = 2.0 real(r8), parameter :: f5_2 = -3544.0/2565.0 real(r8), parameter :: f5_3 = 1859.0/4104.0 real(r8), parameter :: f5_4 = -11.0/40.0 + real(r8), parameter :: y_0 = 25.0/216.0 real(r8), parameter :: y_2 = 1408.0/2565.0 real(r8), parameter :: y_3 = 2197.0/4104.0 real(r8), parameter :: y_4 = -1.0/5.0 + real(r8), parameter :: z_0 = 16.0/135.0 real(r8), parameter :: z_2 = 6656.0/12825.0 real(r8), parameter :: z_3 = 28561.0/56430.0 @@ -88,8 +94,6 @@ function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) real(r8),dimension(lbound(Y,dim=1):ubound(Y,dim=1)) :: dYdx ! Derivative of dependent variable end function DerivFunction end interface - - nY = size(Y,1) @@ -109,7 +113,8 @@ end function DerivFunction K2(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) ! 3rd Step - Ytemp(1:nY) = Y(1:nY) + dx * ( f3_0*K0(1:nY) + f3_1*K1(1:nY) + f3_2*K2(1:nY)) + Ytemp(1:nY) = Y(1:nY) + dx * ( f3_0*K0(1:nY) + f3_1*K1(1:nY) + & + f3_2*K2(1:nY)) xtemp = x + t3*dx K3(1:nY) = DerivFunction(Ytemp(1:nY),Ymask,xtemp,ccohort) @@ -138,6 +143,7 @@ end function DerivFunction z_5*K5(1:nY) ) ! Take the maximum absolute error across all variables + ! To prevent weirdness set a nominal lower bound err45 = maxval(abs(Yout(1:nY)-Ytemp(1:nY))) ! -------------------------------------------------------------------------------- @@ -146,9 +152,12 @@ end function DerivFunction ! Update our estimate of the optimal time-step. We won't update ! the current time-step based on this, but we will save this info ! to help decide the starting sub-step on the next full step + ! The equations may be so smooth that the error estimate is so low that it creates + ! an overflow on the divide, set a lower bound based on max_err. + ! 1e-5, as an error ratio will shorten the timestep to ~5% of original ! -------------------------------------------------------------------------------- - ccohort%ode_opt_step = dx * 0.840896 * ((max_err * dx)/err45)**0.25 ! Smooth recomended + ccohort%ode_opt_step = dx * 0.840896 * (max_err/ max(err45,0.00001*max_err))**0.25 if(err45 > max_err) then l_pass = .false. From 8eb33d5b8cf8e0fd7c996f2a9da9fa33bd83f33f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 27 Jan 2018 14:37:44 -0800 Subject: [PATCH 089/111] Added a minimum step change parameter to RKF45. Some syntax indent updates. --- biogeochem/EDCohortDynamicsMod.F90 | 3 +++ biogeochem/EDPhysiologyMod.F90 | 27 ++++++++++++++++----------- main/FatesIntegratorsMod.F90 | 5 ++++- 3 files changed, 23 insertions(+), 12 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 61b80f76a9..864761c10b 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1161,6 +1161,9 @@ subroutine copy_cohort( currentCohort,copyc ) ! Flags n%isnew = o%isnew + ! Integrator memory + n%ode_opt_step = o%ode_opt_step + ! VARIABLES NEEDED FOR INTEGRATION n%dndt = o%dndt n%dhdt = o%dhdt diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e94bf27233..4d05f30645 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1156,21 +1156,21 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) bstore_flux = store_below_target end if - carbon_balance = carbon_balance - bl_flux + carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day - carbon_balance = carbon_balance - br_flux + carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux - currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day + currentCohort%npp_fnrt = currentCohort%npp_fnrt + br_flux / hlm_freq_day - carbon_balance = carbon_balance - bsw_flux + carbon_balance = carbon_balance - bsw_flux currentCohort%bsw = currentCohort%bsw + bsw_flux - currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day + currentCohort%npp_sapw = currentCohort%npp_sapw + bsw_flux / hlm_freq_day - carbon_balance = carbon_balance - bstore_flux + carbon_balance = carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux - currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day + currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day end if @@ -1185,10 +1185,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if ( carbon_balance > 0.0_r8 .and. dead_below_target>0.0_r8) then - bdead_flux = min(carbon_balance,dead_below_target) - carbon_balance = carbon_balance - bdead_flux - currentCohort%bdead = currentCohort%bdead + bdead_flux - currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day + bdead_flux = min(carbon_balance,dead_below_target) + carbon_balance = carbon_balance - bdead_flux + currentCohort%bdead = currentCohort%bdead + bdead_flux + currentCohort%npp_dead = currentCohort%npp_dead + bdead_flux / hlm_freq_day end if @@ -1274,6 +1274,11 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) write(fates_log(),*) 'carbon_balance',carbon_balance write(fates_log(),*) 'deltaC',deltaC write(fates_log(),*) 'totalC',totalC + write(fates_log(),*) 'leaf:',grow_leaf,bt_leaf,bt_leaf-currentCohort%bl + write(fates_log(),*) 'froot:',grow_froot,bt_fineroot,bt_fineroot-currentCohort%br + write(fates_log(),*) 'sap:',grow_sap,bt_sap,bt_sap-currentCohort%bsw + write(fates_log(),*) 'store:',grow_store,bt_store,bt_store-currentCohort%bstore + write(fates_log(),*) 'dead:',bt_dead,bt_dead-currentCohort%bdead call dump_cohort(currentCohort) call endrun(msg=errMsg(sourcefile, __LINE__)) end if diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index 38566767cc..90b48ef739 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -44,6 +44,8 @@ subroutine RKF45(DerivFunction,Y,Ymask,dx,x,ccohort,max_err,Yout,l_pass) real(r8), dimension(max_states) :: K5 real(r8) :: err45 ! Estimated integrator error + real(r8), parameter :: min_step_fraction = 0.25_r8 + real(r8), parameter :: t1 = 1.0/4.0 real(r8), parameter :: f1_0 = 1.0/4.0 @@ -157,7 +159,8 @@ end function DerivFunction ! 1e-5, as an error ratio will shorten the timestep to ~5% of original ! -------------------------------------------------------------------------------- - ccohort%ode_opt_step = dx * 0.840896 * (max_err/ max(err45,0.00001*max_err))**0.25 + ccohort%ode_opt_step = dx * max(min_step_fraction, & + 0.840896 * (max_err/ max(err45,0.00001*max_err))**0.25) if(err45 > max_err) then l_pass = .false. From f81a55b5fd7b655f583984a75ab342b94e5f4685 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 28 Jan 2018 13:02:27 -0800 Subject: [PATCH 090/111] Added c-balance adjustment during growth. Removed check on structure-dbh to allow for small allometry errors. --- biogeochem/EDPhysiologyMod.F90 | 20 ++++++++++++++------ biogeochem/FatesAllometryMod.F90 | 2 +- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 4d05f30645..bacfd88e1d 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -814,6 +814,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: bsw_flux ! carbon fluxing into sapwood [kgC] real(r8) :: bdead_flux ! carbon fluxing into structure [kgC] real(r8) :: brepro_flux ! carbon fluxing into reproductive tissues [kgC] + real(r8) :: flux_adj ! adjustment made to growth flux term to minimize error [kgC] real(r8) :: store_target_fraction ! ratio between storage and leaf biomass when on allometry [kgC] real(r8) :: repro_fraction ! fraction of carbon gain sent to reproduction when on-allometry @@ -953,7 +954,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call bstore_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) ! If structure is larger than target, then we need to correct some integration errors - ! by slightly increasing dbh + ! by slightly increasing dbh to match it. if((currentCohort%bdead-bt_dead) > calloc_abs_error) then call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) @@ -1288,13 +1289,25 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! -------------------------------------------------------------------------------- if( (totalC < calloc_abs_error) .and. (step_pass) )then ierr = 0 + bl_flux = c_pool(i_cleaf) - currentCohort%bl br_flux = c_pool(i_cfroot) - currentCohort%br bsw_flux = c_pool(i_csap) - currentCohort%bsw bstore_flux = c_pool(i_cstore) - currentCohort%bstore bdead_flux = c_pool(i_cdead) - currentCohort%bdead brepro_flux = c_pool(i_crepro) + + ! Make an adjustment to flux partitions to make it match remaining c balance + flux_adj = carbon_balance/(bl_flux+br_flux+bsw_flux + & + bstore_flux+bdead_flux+brepro_flux) + bl_flux = bl_flux*flux_adj + br_flux = br_flux*flux_adj + bsw_flux = bsw_flux*flux_adj + bstore_flux = bstore_flux*flux_adj + bdead_flux = bdead_flux*flux_adj + brepro_flux = brepro_flux*flux_adj + carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux currentCohort%npp_leaf = currentCohort%npp_leaf + bl_flux / hlm_freq_day @@ -1541,11 +1554,6 @@ subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & write(fates_log(),*) 'structure not on-allometry at the growth step' write(fates_log(),*) 'exiting',bdead,bt_dead call endrun(msg=errMsg(sourcefile, __LINE__)) - elseif( ( bdead-bt_dead)>calloc_abs_error ) then - write(fates_log(),*) 'structure is not allowed to be greater than target' - write(fates_log(),*) 'allometry during growth step, this is because DBH' - write(fates_log(),*) 'is intrinsicly tied to it' - call endrun(msg=errMsg(sourcefile, __LINE__)) else grow_dead = .true. end if diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 750a2338bf..3c3d2e6008 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -119,7 +119,7 @@ module FatesAllometryMod ! from the agb pool. ! Additionally, our calculation of sapwood biomass may be missing some unite conversions - logical, parameter :: test_b4b = .true. + logical, parameter :: test_b4b = .false. contains From 6c948769dd5c7483bfa2031ef2c301757d5105b2 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 28 Jan 2018 22:22:17 -0800 Subject: [PATCH 091/111] Debugging the euler integrator. --- biogeochem/EDPhysiologyMod.F90 | 15 +++++++++++---- biogeochem/FatesAllometryMod.F90 | 7 +------ main/FatesIntegratorsMod.F90 | 1 + 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index bacfd88e1d..8c9e4d9aa2 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -51,6 +51,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : StructureResetOfDH use FatesIntegratorsMod, only : RKF45 + use FatesIntegratorsMod, only : Euler implicit none @@ -861,8 +862,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ! non-integrator part integer , parameter :: max_substeps = 300 - real(r8), parameter :: max_trunc_error = 0.001 - integer, parameter :: ODESolve = 1 ! 1=RKF45, 2=Euler + real(r8), parameter :: max_trunc_error = 10.0 + integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler ipft = currentCohort%pft @@ -1238,11 +1239,13 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) c_mask(i_cstore) = grow_store c_mask(i_cdead) = .true. ! Always increment dead on growth step c_mask(i_crepro) = .true. ! Always calculate reproduction on growth - + if(ODESolve == 2) then + currentCohort%ode_opt_step = deltaC + end if + do while( ierr .ne. 0 ) deltaC = min(totalC,currentCohort%ode_opt_step) - if(ODESolve == 1) then call RKF45(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort, & max_trunc_error,c_pool_out,step_pass) @@ -1259,6 +1262,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) else currentCohort%ode_opt_step = 0.5*deltaC end if + else + write(fates_log(),*) 'An integrator was chosen that DNE' + write(fates_log(),*) 'ODESolve = ',ODESolve + call endrun(msg=errMsg(sourcefile, __LINE__)) end if nsteps = nsteps + 1 diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 3c3d2e6008..3d5adcf66b 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -108,7 +108,7 @@ module FatesAllometryMod public :: CheckIntegratedAllometries - logical , parameter :: verbose_logging = .false. + logical , parameter :: verbose_logging = .true. character(len=*), parameter :: sourcefile = __FILE__ @@ -201,10 +201,6 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & l_pass = .true. ! Default assumption is that step passed - call h_allom(dbh,ipft,height) - - - if (grow_leaf) then call bleaf(dbh,ipft,canopy_trim,bl_diag) if( abs(bl_diag-bl) > max_err ) then @@ -261,7 +257,6 @@ subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & end if end if - if (grow_dead) then call bsap_allom(dbh,ipft,canopy_trim,bsap_diag) call bagw_allom(dbh,ipft,bagw_diag) diff --git a/main/FatesIntegratorsMod.F90 b/main/FatesIntegratorsMod.F90 index 90b48ef739..df51fd6c5d 100644 --- a/main/FatesIntegratorsMod.F90 +++ b/main/FatesIntegratorsMod.F90 @@ -209,6 +209,7 @@ function DerivFunction(Y,Ymask,x,ccohort) result(dYdx) end function DerivFunction end interface + nY = size(Y,1) dYdx(1:nY) = DerivFunction(Y(1:nY),Ymask,x,ccohort) Yout(1:nY) = Y(1:nY) + dx * dYdx(1:nY) From 0eb71d9e6976c202249ef03b81daf321be0d41cc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 30 Jan 2018 01:43:30 -0700 Subject: [PATCH 092/111] 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 From 15e16de0e1cc3944b81e9a2029d7ce6cae8ffa14 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 12 Feb 2018 13:41:30 -0800 Subject: [PATCH 093/111] EDGrowthFunctions was inadvertently added back into the code base (by me), removing. --- biogeochem/EDGrowthFunctionsMod.F90 | 491 ---------------------------- 1 file changed, 491 deletions(-) delete mode 100755 biogeochem/EDGrowthFunctionsMod.F90 diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 deleted file mode 100755 index b34677b4f9..0000000000 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ /dev/null @@ -1,491 +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 FatesInterfaceMod , only : bc_in_type - - 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 - public :: mortality_rates - - logical :: DEBUG_growth = .false. - - ! ============================================================================ - ! 10/30/09: Created by Rosie Fisher - ! ============================================================================ - -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 ) - - ! ============================================================================ - ! 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 - 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 - 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 - - 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 - - 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 - - -! ============================================================================ - - 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 - -! ============================================================================ - - 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 t_water_freeze_k_1atm - - type (ed_cohort_type), intent(in) :: cohort_in - type (bc_in_type), intent(in) :: bc_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),intent(out) :: frmort ! freezing stress mortality - - real(r8) :: frac ! relativised stored carbohydrate - - real(r8) :: hf_sm_threshold ! hydraulic failure soil moisture threshold - real(r8) :: temp_dep ! Temp. function (freezing mortality) - real(r8) :: temp_in_C ! Daily averaged temperature in Celcius - real(r8),parameter :: frost_mort_scaler = 3.0_r8 ! Scaling factor for freezing mortality - real(r8),parameter :: frost_mort_buffer = 5.0_r8 ! 5deg buffer for freezing mortality - - temp_in_C = bc_in%t_veg24_si - tfrz - - - 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 - if(Bleaf(cohort_in) > 0._r8 .and. cohort_in%bstore <= Bleaf(cohort_in))then - frac = cohort_in%bstore/(Bleaf(cohort_in)) - 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 due to cold and freezing stress (frmort), based on ED2 and: - ! Albani, M.; D. Medvigy; G. C. Hurtt; P. R. Moorcroft, 2006: The contributions - ! of land-use change, CO2 fertilization, and climate variability to the - ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, - ! doi: 10.1111/j.1365-2486.2006.01254.x - - temp_dep = max(0.0,min(1.0,1.0 - (temp_in_C - EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) ) - frmort = frost_mort_scaler * temp_dep - - - !mortality_rates = bmort + hmort + cmort + frmort - - 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 - frmort = 0._r8 - endif - - end subroutine mortality_rates - -! ============================================================================ - -end module EDGrowthFunctionsMod From ab742f50976589eac8dffc8db53ef2ac8b7b96b1 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 12 Feb 2018 13:52:12 -0800 Subject: [PATCH 094/111] Removed deprecated descriptors for different mortality partitions in EDTypes. --- main/EDTypesMod.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7e9a247f13..58a7cd7c12 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -100,14 +100,6 @@ module EDTypesMod ! special mode to cause PFTs to create seed mass of all currently-existing PFTs logical, parameter :: homogenize_seed_pfts = .false. - integer, parameter :: nlevmclass_ed = 6 ! nlev "mortality" classes in ED - ! Number of ways to die - ! (background,hydraulic,carbon,impact,fire,freezing) - - character(len = 10), parameter,dimension(nlevmclass_ed) :: char_list = & - (/"background","hydraulic ","carbon ","impact ","fire ","freezing "/) - - !************************************ !** COHORT type structure ** !************************************ From 6e3cfd88dcd48afd8fdd066bc77ce9b70762039c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 13 Feb 2018 08:26:40 -0800 Subject: [PATCH 095/111] Bug fixes on initializing step-size on euler integrator. Also, some values were unititialized before being passed to error logging (trivial). --- biogeochem/EDCohortDynamicsMod.F90 | 5 +++++ biogeochem/EDPhysiologyMod.F90 | 4 ++-- biogeochem/FatesAllometryMod.F90 | 2 +- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 864761c10b..448b960f4d 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -375,6 +375,11 @@ subroutine zero_cohort(cc_p) currentCohort%lmort_logging = 0._r8 currentCohort%lmort_infra = 0._r8 currentCohort%lmort_collateral = 0._r8 + currentCohort%leaf_cost = 0._r8 + currentcohort%excl_weight = 0._r8 + currentcohort%prom_weight = 0._r8 + currentcohort%crownfire_mort = 0._r8 + currentcohort%cambial_mort = 0._r8 currentCohort%npp_leaf = 0._r8 currentCohort%npp_fnrt = 0._r8 currentCohort%npp_sapw = 0._r8 diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 8c9e4d9aa2..81a6bd1863 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -862,7 +862,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ! non-integrator part integer , parameter :: max_substeps = 300 - real(r8), parameter :: max_trunc_error = 10.0 + real(r8), parameter :: max_trunc_error = 10.0_r8 integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler @@ -1240,7 +1240,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) c_mask(i_cdead) = .true. ! Always increment dead on growth step c_mask(i_crepro) = .true. ! Always calculate reproduction on growth if(ODESolve == 2) then - currentCohort%ode_opt_step = deltaC + currentCohort%ode_opt_step = totalC end if do while( ierr .ne. 0 ) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 3d5adcf66b..3a004fa4f1 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -108,7 +108,7 @@ module FatesAllometryMod public :: CheckIntegratedAllometries - logical , parameter :: verbose_logging = .true. + logical , parameter :: verbose_logging = .false. character(len=*), parameter :: sourcefile = __FILE__ From 900ef9aa5c46453e50e414ea4c1d762b6bb44098 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Feb 2018 13:31:30 -0800 Subject: [PATCH 096/111] Allocation refactor: syntax cleaning, comments, adding in b_total() where possible. --- biogeochem/EDCanopyStructureMod.F90 | 48 +++++++++++----------- biogeochem/EDCohortDynamicsMod.F90 | 13 +----- biogeochem/EDPatchDynamicsMod.F90 | 14 ++----- biogeochem/EDPhysiologyMod.F90 | 62 ++++++++++++++--------------- 4 files changed, 59 insertions(+), 78 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 40ef68075b..f26a9835c9 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -396,7 +396,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of demoted cohort currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n - currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + currentCohort%b_total() * currentCohort%n + currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & + currentCohort%b_total() * currentCohort%n !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i_lyr+1 > nclmax)then @@ -470,7 +471,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of demoted cohort currentSite%demotion_rate(currentCohort%size_class) = & currentSite%demotion_rate(currentCohort%size_class) + currentCohort%n - currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + currentCohort%b_total() * currentCohort%n + currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + & + currentCohort%b_total() * currentCohort%n !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i_lyr+1 > nclmax)then @@ -478,10 +480,12 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) !put the litter from the terminated cohorts into the fragmenting pools do i_cwd=1,ncwd - currentPatch%CWD_AG(i_cwd) = currentPatch%CWD_AG(i_cwd) + (currentCohort%bdead+currentCohort%bsw) * & + currentPatch%CWD_AG(i_cwd) = currentPatch%CWD_AG(i_cwd) + & + (currentCohort%bdead+currentCohort%bsw) * & EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & SF_val_CWD_frac(i_cwd)*currentCohort%n/currentPatch%area - currentPatch%CWD_BG(i_cwd) = currentPatch%CWD_BG(i_cwd) + (currentCohort%bdead+currentCohort%bsw) * & + currentPatch%CWD_BG(i_cwd) = currentPatch%CWD_BG(i_cwd) + & + (currentCohort%bdead+currentCohort%bsw) * & (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & SF_val_CWD_frac(i_cwd)*currentCohort%n/currentPatch%area !litter flux per m2. @@ -622,11 +626,13 @@ 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 - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + 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 - currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + currentCohort%b_total() * currentCohort%n + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & + currentCohort%b_total() * currentCohort%n endif currentCohort => currentCohort%shorter @@ -641,7 +647,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! This is the opposite of the demotion weighting... currentCohort => currentPatch%tallest do while (associated(currentCohort)) - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + 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. @@ -713,7 +720,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! keep track of number and biomass of promoted cohort currentSite%promotion_rate(copyc%size_class) = & currentSite%promotion_rate(copyc%size_class) + copyc%n - currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + copyc%b_total() * copyc%n + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & + copyc%b_total() * copyc%n ! seperate cohorts. ! needs to be a very small number to avoid causing non-linearity issues with c_area. @@ -721,7 +729,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) currentCohort%dbh = currentCohort%dbh - 0.000000000001_r8 copyc%dbh = copyc%dbh + 0.000000000001_r8 - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + 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 ------------------------! @@ -739,12 +748,14 @@ 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. - call carea_allom(currentCohort%dbh,currentCohort%n,currentSite%spread,currentCohort%pft,currentCohort%c_area) + 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 - currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + currentCohort%b_total() * currentCohort%n + currentSite%promotion_carbonflux = currentSite%promotion_carbonflux + & + currentCohort%b_total() * currentCohort%n endif ! if(cc_gain < currentCohort%c_area)then @@ -1215,7 +1226,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) if ( DEBUG ) then write(fates_log(), *) 'calc snow 2', snow_depth_si , frac_sno_eff_si write(fates_log(), *) 'LHP', currentPatch%layer_height_profile(L,ft,iv) - write(fates_log(), *) 'EDCLMLink 1246 ', currentPatch%elai_profile(1,ft,iv) + write(fates_log(), *) 'leaf_area_profile 1229 ', currentPatch%elai_profile(1,ft,iv) end if end do @@ -1303,16 +1314,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv) / & currentPatch%canopy_area_profile(L,ft,iv) - if( currentPatch%tlai_profile(L,ft,iv) currentPatch%shortest - do while(associated(currentCohort)) - print*,currentCohort%bl,currentCohort%c_area,currentCohort%NV,currentCohort%treelai,currentCohort%treesai,currentCohort%status_coh,currentCohort%lai,EDPftvarcon_inst%evergreen(ft) - currentCohort => currentCohort%taller - end do - end if - currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) & /currentPatch%tlai_profile(L,ft,iv) enddo @@ -1607,7 +1608,8 @@ subroutine CanopyLayerArea(currentPatch,layer_index,layer_area) layer_area = 0.0_r8 currentCohort => currentPatch%tallest do while (associated(currentCohort)) - call carea_allom(currentCohort%dbh,currentCohort%n,currentPatch%siteptr%spread,currentCohort%pft,currentCohort%c_area) + 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 diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 448b960f4d..ff9bf7424a 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -469,11 +469,7 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) endif ! Total cohort biomass is negative - if ( (currentCohort%bsw + & - currentCohort%bl + & - currentCohort%br + & - currentCohort%bdead + & - currentCohort%bstore) < 0._r8) then + if ( (currentCohort%b_total()) < 0._r8) then terminate = 1 if ( DEBUG ) then write(fates_log(),*) 'terminating cohorts 4', & @@ -498,12 +494,7 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n ! currentSite%termination_carbonflux(levcan) = currentSite%termination_carbonflux(levcan) + & - currentCohort%n * & - (currentCohort%bsw + & - currentCohort%bl + & - currentCohort%br + & - currentCohort%bdead + & - currentCohort%bstore) + currentCohort%n * currentCohort%b_total() if (.not. associated(currentCohort%taller)) then currentPatch%tallest => currentCohort%shorter diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index bfe1e36d56..8a611e822c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -427,12 +427,8 @@ 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%bdead + & - currentCohort%bsw + & - currentCohort%bl + & - currentCohort%br + & - currentCohort%bstore) * g_per_kg * days_per_sec * years_per_day * ha_per_m2 - + currentCohort%b_total() * 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) @@ -551,11 +547,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%bdead + & - currentCohort%bsw + & - currentCohort%bl + & - currentCohort%br + & - currentCohort%bstore) * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + currentCohort%b_total() * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! Step 2: Apply survivor ship function based on the understory death fraction diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 81a6bd1863..cd917e1f41 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -71,9 +71,7 @@ module EDPhysiologyMod private :: seed_germination public :: flux_into_litter_pools - logical, parameter :: test_b4b = .true. ! flag used to test - ! hypothesese or just hold - ! change for later + logical, parameter :: DEBUG = .false. ! local debug flag character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -830,11 +828,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) logical :: step_pass ! Did the integration step pass? - logical :: grow_leaf - logical :: grow_froot - logical :: grow_sap - logical :: grow_store - logical :: grow_dead + logical :: grow_leaf ! Are leaves at allometric target and should be grown? + logical :: grow_froot ! Are fine-roots at allometric target and should be grown? + logical :: grow_sap ! Is sapwood at allometric target and should be grown? + logical :: grow_store ! Is storage at allometric target and should be grown? ! integrator variables real(r8) :: deltaC ! trial value for substep @@ -1217,7 +1214,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call TargetAllometryCheck(currentCohort%bl,currentCohort%br,currentCohort%bsw, & currentCohort%bstore,currentCohort%bdead, & bt_leaf,bt_fineroot,bt_sap,bt_store,bt_dead, & - grow_leaf,grow_froot,grow_sap,grow_store,grow_dead) + grow_leaf,grow_froot,grow_sap,grow_store) ! Initialize the adaptive integrator arrays and flags @@ -1369,15 +1366,17 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%isnew=.false. return -end subroutine PlantGrowth + end subroutine PlantGrowth ! ====================================================================================== - function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) + function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) ! --------------------------------------------------------------------------------- ! This function calculates the derivatives for the carbon pools - ! relative to the amount of carbon balance. + ! relative to the amount of carbon balance. This function is based completely + ! off of allometry, and assumes that there are no other species (ie nutrients) that + ! govern allocation. ! --------------------------------------------------------------------------------- ! Arguments @@ -1395,24 +1394,24 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) real(r8),dimension(lbound(c_pools,dim=1):ubound(c_pools,dim=1)) :: dCdx ! locals - integer :: ipft - real(r8) :: ct_leaf - real(r8) :: ct_froot - real(r8) :: ct_sap - real(r8) :: ct_agw - real(r8) :: ct_bgw - real(r8) :: ct_store - real(r8) :: ct_dead + integer :: ipft ! pft index + real(r8) :: ct_leaf ! target leaf biomass, dummy var (kgC) + real(r8) :: ct_froot ! target fine-root biomass, dummy var (kgC) + real(r8) :: ct_sap ! target sapwood biomass, dummy var (kgC) + real(r8) :: ct_agw ! target aboveground wood, dummy var (kgC) + real(r8) :: ct_bgw ! target belowground wood, dummy var (kgC) + real(r8) :: ct_store ! target storage, dummy var (kgC) + real(r8) :: ct_dead ! target structural biomas, dummy var (kgC) - real(r8) :: ct_dleafdd - real(r8) :: ct_dfrootdd - real(r8) :: ct_dsapdd - real(r8) :: ct_dagwdd - real(r8) :: ct_dbgwdd - real(r8) :: ct_dstoredd - real(r8) :: ct_ddeaddd - real(r8) :: ct_dtotaldd - real(r8) :: repro_fraction + real(r8) :: ct_dleafdd ! target leaf biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dfrootdd ! target fine-root biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dsapdd ! target sapwood biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dagwdd ! target AG wood biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dbgwdd ! target BG wood biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dstoredd ! target storage biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_ddeaddd ! target structural biomass derivative wrt d, (kgC/cm) + real(r8) :: ct_dtotaldd ! target total (not reproductive) biomass derivative wrt d, (kgC/cm) + real(r8) :: repro_fraction ! fraction of carbon balance directed towards reproduction (kgC/kgC) @@ -1497,7 +1496,7 @@ end function AllomCGrowthDeriv subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & bt_leaf,bt_froot,bt_sap,bt_store,bt_dead, & - grow_leaf,grow_froot,grow_sap,grow_store,grow_dead) + grow_leaf,grow_froot,grow_sap,grow_store) ! Arguments real(r8),intent(in) :: bleaf !actual @@ -1514,7 +1513,6 @@ subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & logical,intent(out) :: grow_froot logical,intent(out) :: grow_sap logical,intent(out) :: grow_store - logical,intent(out) :: grow_dead if( (bt_leaf - bleaf)>calloc_abs_error) then write(fates_log(),*) 'leaves are not on-allometry at the growth step' @@ -1561,8 +1559,6 @@ subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & write(fates_log(),*) 'structure not on-allometry at the growth step' write(fates_log(),*) 'exiting',bdead,bt_dead call endrun(msg=errMsg(sourcefile, __LINE__)) - else - grow_dead = .true. end if end subroutine TargetAllometryCheck From 1aa5ed83209c8df04bc1f9775169cba0829eb58a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Feb 2018 13:54:44 -0800 Subject: [PATCH 097/111] Allocation refactor: moved branch turnover to parameter from file. --- biogeochem/EDPhysiologyMod.F90 | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index cd917e1f41..e6a4383cda 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -850,12 +850,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Woody turnover timescale [years] - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! THIS NEEDS A PFT VARIABLE, OR LIKE OTHER POOLS COULD - ! BE HOOKED INTO THE DISTURBANCE ALGORITHM OR BE DYNAMIC - ! RGK 11-2017 - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(r8), parameter :: background_woody_turnover = 0.0_r8 real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ! non-integrator part integer , parameter :: max_substeps = 300 @@ -997,10 +991,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ! ----------------------------------------------------------------------------------- - if ( background_woody_turnover > tiny(background_woody_turnover) ) then - currentCohort%bsw_md = currentCohort%bsw / background_woody_turnover - currentCohort%bdead_md = currentCohort%bdead / background_woody_turnover - currentCohort%bstore_md = currentCohort%bstore / background_woody_turnover + if ( EDPftvarcon_inst%branch_turnover(ipft) > tiny(EDPftvarcon_inst%branch_turnover(ipft)) ) then + currentCohort%bsw_md = currentCohort%bsw / EDPftvarcon_inst%branch_turnover(ipft) + currentCohort%bdead_md = currentCohort%bdead / EDPftvarcon_inst%branch_turnover(ipft) + currentCohort%bstore_md = currentCohort%bstore / EDPftvarcon_inst%branch_turnover(ipft) else currentCohort%bsw_md = 0.0_r8 currentCohort%bdead_md = 0.0_r8 From 54df3169589fb5b4befaf7d51cb9f799a69c67e3 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Feb 2018 16:37:43 -0800 Subject: [PATCH 098/111] Allocation refactor: testing an adaptive scheme to search for the dbh that matches structure. --- biogeochem/FatesAllometryMod.F90 | 58 ++++++++++++++++++++------------ 1 file changed, 37 insertions(+), 21 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 3a004fa4f1..8f56578045 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -119,9 +119,6 @@ module FatesAllometryMod ! from the agb pool. ! Additionally, our calculation of sapwood biomass may be missing some unite conversions - logical, parameter :: test_b4b = .false. - - contains ! ============================================================================ @@ -985,11 +982,7 @@ subroutine d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) if(present(dblmaxdd))then if( d calloc_abs_error ) - d = d + dd - call h_allom(d,ipft,h) - call bsap_allom(d,ipft,canopy_trim,bt_sap,dbt_sap_dd) - call bagw_allom(d,ipft,bt_agw,dbt_agw_dd) - call bbgw_allom(d,ipft,bt_bgw,dbt_bgw_dd) - call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, & + + step_frac = step_frac0 + do while( (bdead-bt_dead) > 0.5_r8*calloc_abs_error ) + + dd = step_frac*(bdead-bt_dead)/dbt_dead_dd + d_try = d + dd + + call h_allom(d_try,ipft,h) + call bsap_allom(d_try,ipft,canopy_trim,bt_sap,dbt_sap_dd) + call bagw_allom(d_try,ipft,bt_agw,dbt_agw_dd) + call bbgw_allom(d_try,ipft,bt_bgw,dbt_bgw_dd) + call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead_try, dbt_agw_dd, & dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) + ! Prevent overshooting + if(bt_dead_try>bdead) then + step_frac = step_frac*0.5_r8 + else + step_frac = step_frac0 + d = d_try + bt_dead = bt_dead_try + end if + end do ! At this point, the diameter, height and their target structural biomass From 0dc59e8a7fa33692bef954f0b6c8dcf2fd8532d4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 16 Feb 2018 13:37:53 -0800 Subject: [PATCH 099/111] Reduced some line-lengths. These were mostly for readability, Eriks recent pass through seemed to have appeased the NAG gods --- biogeochem/EDCohortDynamicsMod.F90 | 45 +++++++++++++++--------------- biogeochem/EDPatchDynamicsMod.F90 | 26 ++++++++++------- biogeochem/EDPhysiologyMod.F90 | 24 ++++++++++------ 3 files changed, 55 insertions(+), 40 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 47d0a68bb2..c281ab9398 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -866,11 +866,11 @@ subroutine fuse_cohorts(patchptr, bc_in) currentCohort%dmort = (currentCohort%n*currentCohort%dmort + & nextc%n*nextc%dmort)/newn - currentCohort%lmort_direct = (currentCohort%n*currentCohort%lmort_direct + & + currentCohort%lmort_direct = (currentCohort%n*currentCohort%lmort_direct + & nextc%n*nextc%lmort_direct)/newn - currentCohort%lmort_infra = (currentCohort%n*currentCohort%lmort_infra + & + 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 + & @@ -894,27 +894,28 @@ subroutine fuse_cohorts(patchptr, bc_in) nextc%n*nextc%lmort_infra)/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%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 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 b8fce6e9d7..e8b5726cd9 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -764,17 +764,19 @@ subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis enddo do p = 1,numpft !move litter pool en mass into the new patch - newPatch%root_litter(p) = newPatch%root_litter(p) + currentPatch%root_litter(p) * patch_site_areadis/newPatch%area - newPatch%leaf_litter(p) = newPatch%leaf_litter(p) + currentPatch%leaf_litter(p) * patch_site_areadis/newPatch%area + newPatch%root_litter(p) = newPatch%root_litter(p) + & + currentPatch%root_litter(p) * patch_site_areadis/newPatch%area + newPatch%leaf_litter(p) = newPatch%leaf_litter(p) + & + currentPatch%leaf_litter(p) * patch_site_areadis/newPatch%area ! The fragmentation/decomposition flux from donor patches has already occured in existing patches. However ! 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 @@ -822,17 +824,21 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si !PART 1) Burn the fractions of existing litter in the new patch that were consumed by the fire. !************************************/ do c = 1,ncwd - burned_litter = new_patch%cwd_ag(c) * patch_site_areadis/new_patch%area * currentPatch%burnt_frac_litter(c+1) !kG/m2/day + burned_litter = new_patch%cwd_ag(c) * patch_site_areadis/new_patch%area * & + currentPatch%burnt_frac_litter(c+1) !kG/m2/day new_patch%cwd_ag(c) = new_patch%cwd_ag(c) - burned_litter currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day - currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + burned_litter * new_patch%area !kG/site/day + currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + & + burned_litter * new_patch%area !kG/site/day enddo do p = 1,numpft - burned_litter = new_patch%leaf_litter(p) * patch_site_areadis/new_patch%area * currentPatch%burnt_frac_litter(dl_sf) + burned_litter = new_patch%leaf_litter(p) * patch_site_areadis/new_patch%area * & + currentPatch%burnt_frac_litter(dl_sf) new_patch%leaf_litter(p) = new_patch%leaf_litter(p) - burned_litter currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day - currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + burned_litter * new_patch%area !kG/site/day + currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + & + burned_litter * new_patch%area !kG/site/day enddo !************************************/ diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 29c5a6c388..963f3a0b8b 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -219,28 +219,35 @@ subroutine trim_canopy( currentSite ) currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) currentCohort%leaf_cost = currentCohort%leaf_cost + & - 1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft) + 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) + currentCohort%leaf_cost = currentCohort%leaf_cost * & + (EDPftvarcon_inst%grperc(ipft) + 1._r8) else !evergreen costs currentCohort%leaf_cost = 1.0_r8/(EDPftvarcon_inst%slatop(ipft)* & EDPftvarcon_inst%leaf_long(ipft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 currentCohort%leaf_cost = currentCohort%leaf_cost + & - 1.0_r8/(EDPftvarcon_inst%slatop(ipft)*1000.0_r8) * bfr_per_bleaf / EDPftvarcon_inst%root_long(ipft) - currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(ipft) + 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(ipft))then if ( DEBUG ) then - write(fates_log(),*) 'trimming leaves',currentCohort%canopy_trim,currentCohort%leaf_cost + 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(ipft))then - currentCohort%canopy_trim = currentCohort%canopy_trim - EDPftvarcon_inst%trim_inc(ipft) + 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)) + currentCohort%laimemory = currentCohort%laimemory * & + (1.0_r8 - EDPftvarcon_inst%trim_inc(ipft)) endif trimmed = 1 endif @@ -1024,7 +1031,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) max(0.0_r8,currentCohort%carbon_balance*(currentCohort%leaf_md/currentCohort%md)) 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(ipft))- 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 From 33ee7ca8e9e2bde22c1da64ee99b9e4b3b131749 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 20 Feb 2018 14:31:07 -0800 Subject: [PATCH 100/111] Moved isnew flag to beginning of growth, realized that return flags get triggered before it is set, otherwise. --- biogeochem/EDPhysiologyMod.F90 | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 831c33a647..bf6ceabef9 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -883,6 +883,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%dbstoredt = 0.0_r8 currentCohort%ddbhdt = 0.0_r8 + ! If the cohort has grown, it is not new + currentCohort%isnew=.false. + ! ----------------------------------------------------------------------------------- ! I. Identify the net carbon gain for this dynamics interval ! Set the available carbon pool, identify allocation portions, and decrement @@ -960,7 +963,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if ! ----------------------------------------------------------------------------------- - ! IV(a). Calculate the maintenance turnover demands + ! III(a). Calculate the maintenance turnover demands ! Pre-check, make sure phenology is mutually exclusive and at least one chosen ! (MOVE THIS TO THE PARAMETER READ-IN SECTION) ! ----------------------------------------------------------------------------------- @@ -990,7 +993,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- - ! IV(b). Calculate the maintenance turnover demands + ! III(b). Calculate the maintenance turnover demands ! NOTE(RGK): If branches are falling all year, even on deciduous trees, we should ! be pulling some leaves with them when leaves are out... ! @@ -1025,7 +1028,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- - ! V. Remove turnover from the appropriate pools + ! IV. Remove turnover from the appropriate pools ! ! Units: kgC/year * (year/days_per_year) = kgC/day -> (day elapsed) -> kgC ! ----------------------------------------------------------------------------------- @@ -1039,7 +1042,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- - ! VI(b). Prioritize some amount of carbon to replace leaf/root turnover + ! V. Prioritize some amount of carbon to replace leaf/root turnover ! Make sure it isnt a negative payment, and either pay what is available ! or forcefully pay from storage. ! ----------------------------------------------------------------------------------- @@ -1072,7 +1075,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- - ! VI(a) if carbon balance is negative, re-coup the losses from storage + ! VI. if carbon balance is negative, re-coup the losses from storage ! if it is positive, give some love to storage carbon ! NOTE: WE ARE STILL ALLOWING STORAGE CARBON TO GO NEGATIVE, AT LEAST IN THIS ! PART OF THE CODE. @@ -1100,7 +1103,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if ! ----------------------------------------------------------------------------------- - ! VI(d). If carbon is still available, prioritize some allocation to replace + ! VII. If carbon is still available, prioritize some allocation to replace ! the rest of the leaf/fineroot turnover demand ! carbon balance is guaranteed to be >=0 beyond this point ! ----------------------------------------------------------------------------------- @@ -1127,7 +1130,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- - ! VII(e). If carbon is still available, we try to push all live + ! VIII. If carbon is still available, we try to push all live ! pools back towards allometry. But only upwards, if fusion happened ! to generate some pools above allometric target, don't reduce the pool, ! just ignore it until the rest of the plant grows to meet it. @@ -1175,7 +1178,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if ! ----------------------------------------------------------------------------------- - ! V(f). If carbon is still available, replenish the structural pool to get + ! IX. If carbon is still available, replenish the structural pool to get ! back on allometry ! ----------------------------------------------------------------------------------- @@ -1195,7 +1198,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! ----------------------------------------------------------------------------------- - ! V(e). If carbon is yet still available ... + ! X. If carbon is yet still available ... ! Our pools are now either on allometry or above (from fusion). ! We we can increment those pools at or below, ! including structure and reproduction according to their rates @@ -1359,12 +1362,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) end if end do - - - - - ! If the cohort has grown, it is not new - currentCohort%isnew=.false. return end subroutine PlantGrowth From 87aeaba2c360f8f321a31815d03eba805800ca31 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 21 Feb 2018 14:05:58 -0800 Subject: [PATCH 101/111] Added back carbon balance and dbalivedt history variables. --- main/FatesHistoryInterfaceMod.F90 | 45 +++++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 2 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 03faa78b53..d80a0cee5d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -210,10 +210,12 @@ module FatesHistoryInterfaceMod integer, private :: ih_resp_m_canopy_si_scls integer, private :: ih_leaf_md_canopy_si_scls integer, private :: ih_root_md_canopy_si_scls + integer, private :: ih_carbon_balance_canopy_si_scls integer, private :: ih_bstore_md_canopy_si_scls integer, private :: ih_bdead_md_canopy_si_scls integer, private :: ih_bsw_md_canopy_si_scls integer, private :: ih_seed_prod_canopy_si_scls + integer, private :: ih_dbalivedt_canopy_si_scls integer, private :: ih_dbdeaddt_canopy_si_scls integer, private :: ih_dbstoredt_canopy_si_scls integer, private :: ih_storage_flux_canopy_si_scls @@ -232,10 +234,12 @@ module FatesHistoryInterfaceMod integer, private :: ih_resp_m_understory_si_scls integer, private :: ih_leaf_md_understory_si_scls integer, private :: ih_root_md_understory_si_scls + integer, private :: ih_carbon_balance_understory_si_scls integer, private :: ih_bsw_md_understory_si_scls integer, private :: ih_bdead_md_understory_si_scls integer, private :: ih_bstore_md_understory_si_scls integer, private :: ih_seed_prod_understory_si_scls + integer, private :: ih_dbalivedt_understory_si_scls integer, private :: ih_dbdeaddt_understory_si_scls integer, private :: ih_dbstoredt_understory_si_scls integer, private :: ih_storage_flux_understory_si_scls @@ -1262,10 +1266,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_understory_mortality_carbonflux_si => this%hvars(ih_understory_mortality_carbonflux_si)%r81d, & hio_leaf_md_canopy_si_scls => this%hvars(ih_leaf_md_canopy_si_scls)%r82d, & hio_root_md_canopy_si_scls => this%hvars(ih_root_md_canopy_si_scls)%r82d, & + hio_carbon_balance_canopy_si_scls => this%hvars(ih_carbon_balance_canopy_si_scls)%r82d, & hio_bsw_md_canopy_si_scls => this%hvars(ih_bsw_md_canopy_si_scls)%r82d, & hio_bdead_md_canopy_si_scls => this%hvars(ih_bdead_md_canopy_si_scls)%r82d, & hio_bstore_md_canopy_si_scls => this%hvars(ih_bstore_md_canopy_si_scls)%r82d, & hio_seed_prod_canopy_si_scls => this%hvars(ih_seed_prod_canopy_si_scls)%r82d, & + hio_dbalivedt_canopy_si_scls => this%hvars(ih_dbalivedt_canopy_si_scls)%r82d, & hio_dbdeaddt_canopy_si_scls => this%hvars(ih_dbdeaddt_canopy_si_scls)%r82d, & hio_dbstoredt_canopy_si_scls => this%hvars(ih_dbstoredt_canopy_si_scls)%r82d, & hio_storage_flux_canopy_si_scls => this%hvars(ih_storage_flux_canopy_si_scls)%r82d, & @@ -1277,10 +1283,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_stor_canopy_si_scls => this%hvars(ih_npp_stor_canopy_si_scls)%r82d, & hio_leaf_md_understory_si_scls => this%hvars(ih_leaf_md_understory_si_scls)%r82d, & hio_root_md_understory_si_scls => this%hvars(ih_root_md_understory_si_scls)%r82d, & + hio_carbon_balance_understory_si_scls=> this%hvars(ih_carbon_balance_understory_si_scls)%r82d, & hio_bstore_md_understory_si_scls => this%hvars(ih_bstore_md_understory_si_scls)%r82d, & hio_bsw_md_understory_si_scls => this%hvars(ih_bsw_md_understory_si_scls)%r82d, & hio_bdead_md_understory_si_scls => this%hvars(ih_bdead_md_understory_si_scls)%r82d, & hio_seed_prod_understory_si_scls => this%hvars(ih_seed_prod_understory_si_scls)%r82d, & + hio_dbalivedt_understory_si_scls => this%hvars(ih_dbalivedt_understory_si_scls)%r82d, & hio_dbdeaddt_understory_si_scls => this%hvars(ih_dbdeaddt_understory_si_scls)%r82d, & hio_dbstoredt_understory_si_scls => this%hvars(ih_dbstoredt_understory_si_scls)%r82d, & hio_storage_flux_understory_si_scls => this%hvars(ih_storage_flux_understory_si_scls)%r82d, & @@ -1593,6 +1601,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%leaf_md * ccohort%n hio_root_md_canopy_si_scls(io_si,scls) = hio_root_md_canopy_si_scls(io_si,scls) + & ccohort%root_md * ccohort%n + + hio_carbon_balance_canopy_si_scls(io_si,scls) = hio_carbon_balance_canopy_si_scls(io_si,scls) + & + ccohort%n * ccohort%npp_acc_hold + hio_bsw_md_canopy_si_scls(io_si,scls) = hio_bsw_md_canopy_si_scls(io_si,scls) + & ccohort%bsw_md * ccohort%n hio_bstore_md_canopy_si_scls(io_si,scls) = hio_bstore_md_canopy_si_scls(io_si,scls) + & @@ -1621,6 +1633,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_stor_canopy_si_scls(io_si,scls) = hio_npp_stor_canopy_si_scls(io_si,scls) + & ccohort%npp_stor * ccohort%n + hio_dbalivedt_canopy_si_scls(io_si,scls) = hio_dbalivedt_canopy_si_scls(io_si,scls) + & + (ccohort%npp_leaf+ccohort%npp_fnrt+ccohort%npp_sapw+ccohort%npp_stor)* ccohort%n + hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n @@ -1672,7 +1687,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%b_total() * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 + & (ccohort%lmort_direct + ccohort%lmort_collateral + ccohort%lmort_infra) * ccohort%b_total() * & ccohort%n * g_per_kg * ha_per_m2 - ! + + hio_carbon_balance_understory_si_scls(io_si,scls) = hio_carbon_balance_understory_si_scls(io_si,scls) + & + ccohort%npp_acc_hold * ccohort%n + hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n hio_root_md_understory_si_scls(io_si,scls) = hio_root_md_understory_si_scls(io_si,scls) + & @@ -1705,6 +1723,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_stor_understory_si_scls(io_si,scls) = hio_npp_stor_understory_si_scls(io_si,scls) + & ccohort%npp_stor * ccohort%n + hio_dbalivedt_understory_si_scls(io_si,scls) = hio_dbalivedt_understory_si_scls(io_si,scls) + & + (ccohort%npp_leaf+ccohort%npp_fnrt+ccohort%npp_sapw+ccohort%npp_stor)* ccohort%n + hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_understory_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n @@ -3490,7 +3511,27 @@ subroutine define_history_vars(this, initialize_variables) long='freezing mortality by 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_m8_si_scls ) + + call this%set_history_var(vname='CARBON_BALANCE_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='CARBON_BALANCE 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_carbon_balance_canopy_si_scls ) + call this%set_history_var(vname='CARBON_BALANCE_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='CARBON_BALANCE 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_carbon_balance_understory_si_scls ) + + call this%set_history_var(vname='DBALIVEDT_CANOPY_SCLS', units = 'kg C / ha / yr', & + long='DBALIVEDT 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_dbalivedt_canopy_si_scls ) + + call this%set_history_var(vname='DBALIVEDT_UNDERSTORY_SCLS', units = 'kg C / ha / yr', & + long='DBALIVEDT 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_dbalivedt_understory_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='active', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & @@ -3525,7 +3566,7 @@ subroutine define_history_vars(this, initialize_variables) long='ROOT_MD 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_root_md_canopy_si_scls ) - + call this%set_history_var(vname='BSTORE_MD_CANOPY_SCLS', units = 'kg C / ha / yr', & long='BSTORE_MD for canopy plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & From ca67a6f523c6aa71471dd5beab12d4b02bb43d08 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 21 Feb 2018 14:28:49 -0800 Subject: [PATCH 102/111] Put filter so only woody plants would experience the dbh reset to structure upon fusion. --- biogeochem/EDCohortDynamicsMod.F90 | 6 ++++-- biogeochem/EDPhysiologyMod.F90 | 7 ++++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 1015d5a8f8..497cd3f761 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -691,8 +691,10 @@ subroutine fuse_cohorts(patchptr, bc_in) ! target matches actual bdead. (if it is the other way around ! we then just let the carbon pools grow to fill-out allometry) - call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & - currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) + if (EDPftvarcon_inst%woody(currentCohort%pft) == itrue) then + call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & + currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) + end if call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & currentCohort%size_class,currentCohort%size_by_pft_class) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index bf6ceabef9..e3c31a4d2d 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -956,9 +956,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call bstore_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) ! If structure is larger than target, then we need to correct some integration errors - ! by slightly increasing dbh to match it. - if((currentCohort%bdead-bt_dead) > calloc_abs_error) then - call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & + ! by slightly increasing dbh to match it. We only do this for woody vegetation + if( ((currentCohort%bdead-bt_dead) > calloc_abs_error) .and. & + (EDPftvarcon_inst%woody(ipft) == itrue) ) then + call StructureResetOfDH( currentCohort%bdead, ipft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if From 525672ccb3ea007b9d68394ae057ff7ed8bb2921 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 21 Feb 2018 15:21:39 -0800 Subject: [PATCH 103/111] Removed parameter file control on branchfall rate temporarily, as it will be introduced in a later PR. --- biogeochem/EDPhysiologyMod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e3c31a4d2d..937637c799 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -863,9 +863,15 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: max_trunc_error = 10.0_r8 integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler + real(r8), parameter :: global_branch_turnover = 0.0_r8 ! Temporary branch turnover setting + ! Branch-turnover control will be + ! introduced in a later PR + ipft = currentCohort%pft + EDPftvarcon_inst%branch_turnover(ipft) = global_branch_turnover + ! Initialize seed production currentCohort%seed_prod = 0.0_r8 From adfa8f5107d30d361bf8b06740d4e20b38f6b2dc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 23 Feb 2018 13:52:53 -0800 Subject: [PATCH 104/111] allocation refactor: adjusted tolerance on dbh reset --- biogeochem/EDPhysiologyMod.F90 | 16 ++++++------- biogeochem/FatesAllometryMod.F90 | 41 ++++++++++++-------------------- 2 files changed, 23 insertions(+), 34 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 937637c799..446ea9f313 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -756,8 +756,11 @@ subroutine seed_germination( currentSite, currentPatch ) max_germination = 1.0_r8 !this is arbitrary ! germination_timescale is being pulled to PFT parameter; units are 1/yr - ! thus the mortality rate of seed -> recruit (in units of carbon) is seed_decay_turnover(p)/germination_timescale(p) - ! and thus the mortlaity rate (in units of individuals) is the product of that times the ratio of (hypothetical) seed mass to recruit biomass + ! thus the mortality rate of seed -> recruit (in units of carbon) + ! is seed_decay_turnover(p)/germination_timescale(p) + ! and thus the mortlaity rate (in units of individuals) is the product of + ! that times the ratio of (hypothetical) seed mass to recruit biomass + do p = 1,numpft currentPatch%seed_germination(p) = min(currentSite%seed_bank(p) * & EDPftvarcon_inst%germination_timescale(p),max_germination) @@ -931,9 +934,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! II. Calculate target size of living biomass compartment for a given dbh. ! ----------------------------------------------------------------------------------- - !! call GetAllometricTargets(currentCohort%dbh,currentCohort%canopy_trim, & - !! bt_leaf,bt_fineroot,bt_sapwood,bt_store,bt_dead) - ! Target leaf biomass according to allometry and trimming call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) @@ -1218,9 +1218,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! This routine checks that actual carbon is not below that targets. It does ! allow actual pools to be above the target, and in these cases, it sends - ! a false on the "grow_<>" flag, allowing the plant to grow into these pools - ! It also checks to make sure that structural biomass is not above the target - ! This is enforced at fusion. + ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. + ! It also checks to make sure that structural biomass is not above the target. call TargetAllometryCheck(currentCohort%bl,currentCohort%br,currentCohort%bsw, & currentCohort%bstore,currentCohort%bdead, & @@ -1260,6 +1259,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) elseif(ODESolve == 2) then call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out) +! step_pass = .true. call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & c_pool_out(i_cstore), c_pool_out(i_cdead), & diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 8f56578045..398ae0bc8a 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -108,7 +108,7 @@ module FatesAllometryMod public :: CheckIntegratedAllometries - logical , parameter :: verbose_logging = .false. + logical , parameter :: verbose_logging = .true. character(len=*), parameter :: sourcefile = __FILE__ @@ -117,7 +117,7 @@ module FatesAllometryMod ! 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 + ! Additionally, our calculation of sapwood biomass may be missing some unit conversions contains @@ -135,26 +135,9 @@ module FatesAllometryMod ! Helper Routines ! =========================================================================== - - -! subroutine GetAllometricTargets(currentCohort%dbh,currentCohort%canopy_trim, & -! bt_leaf,bt_fineroot,bt_sapwood,bt_store,bt_dead) - - ! --------------------------------------------------------------------------------- - ! This wrapper is used when all allometric targets are desired. When - ! each allometry are called independently, it is less efficient. This is because - ! there are dependencies, for instance sapwood needs to know how much leaf is - ! there, and there ends up being several redundant calls. - ! When we call all allometric targets simultaneously, we don't worry about - ! redundancy. - ! --------------------------------------------------------------------------------- - - - - - -! end subroutine GetAllometricTargets - + + ! ============================================================================ + subroutine CheckIntegratedAllometries(dbh,ipft,canopy_trim, & bl,bfr,bsap,bstore,bdead, & grow_leaf, grow_fr, grow_sap, grow_store, grow_dead, & @@ -563,6 +546,7 @@ subroutine bsap_allom(d,ipft,canopy_trim,bsap,dbsapdd) ! (this comes into play typically in very small plants) bsap_cap = max_frac*(bagw+bbgw) bsap = min( bsap_cap,bsap) + if(present(dbsapdd))then if ( bsap >= bsap_cap ) then dbsapdd = max_frac*(dbagwdd+dbbgwdd) @@ -1714,6 +1698,7 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) real(r8) :: d_try ! trial diameter real(r8) :: bt_dead_try ! trial structure biomasss real(r8) :: step_frac ! step fraction + integer :: counter real(r8), parameter :: step_frac0 = 0.9_r8 call bsap_allom(d,ipft,canopy_trim,bt_sap,dbt_sap_dd) @@ -1725,9 +1710,9 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) ! This calculates a diameter increment based on the difference ! in structural mass and the target mass, and sets it to a fraction ! of the diameter increment - + counter = 0 step_frac = step_frac0 - do while( (bdead-bt_dead) > 0.5_r8*calloc_abs_error ) + do while( (bdead-bt_dead) > calloc_abs_error ) dd = step_frac*(bdead-bt_dead)/dbt_dead_dd d_try = d + dd @@ -1747,9 +1732,13 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) d = d_try bt_dead = bt_dead_try end if - + counter = counter + 1 end do - + + if(counter>10)then + write(fates_log(),*) 'dbh counter: ',counter + end if + ! At this point, the diameter, height and their target structural biomass ! should be pretty close to and greater than actual From 1c239d7d9cdfced2c1a3f536f2794b1a02e7d0c1 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 23 Feb 2018 16:56:41 -0800 Subject: [PATCH 105/111] Allocation refactor: still debugging the diameter search algorithm? --- biogeochem/EDPhysiologyMod.F90 | 2 ++ biogeochem/FatesAllometryMod.F90 | 13 +++++++------ 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 446ea9f313..755ec2d794 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1012,6 +1012,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%bsw_md = currentCohort%bsw / EDPftvarcon_inst%branch_turnover(ipft) currentCohort%bdead_md = currentCohort%bdead / EDPftvarcon_inst%branch_turnover(ipft) currentCohort%bstore_md = currentCohort%bstore / EDPftvarcon_inst%branch_turnover(ipft) + print*,"BRANCH TURNOVER SHOULD BE OFF" + stop else currentCohort%bsw_md = 0.0_r8 currentCohort%bdead_md = 0.0_r8 diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 398ae0bc8a..ef2c416914 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -1665,8 +1665,6 @@ subroutine carea_2pwr(d,spread,d2bl_p2,d2bl_ediff,d2ca_min,d2ca_max,c_area) end subroutine carea_2pwr - ! ============================================================================ - subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) @@ -1697,6 +1695,7 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) real(r8) :: dd ! diameter increment for each step real(r8) :: d_try ! trial diameter real(r8) :: bt_dead_try ! trial structure biomasss + real(r8) :: dbt_dead_dd_try ! trial structural derivative real(r8) :: step_frac ! step fraction integer :: counter real(r8), parameter :: step_frac0 = 0.9_r8 @@ -1714,27 +1713,29 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) step_frac = step_frac0 do while( (bdead-bt_dead) > calloc_abs_error ) + ! vulnerable to div0 dd = step_frac*(bdead-bt_dead)/dbt_dead_dd d_try = d + dd - call h_allom(d_try,ipft,h) call bsap_allom(d_try,ipft,canopy_trim,bt_sap,dbt_sap_dd) call bagw_allom(d_try,ipft,bt_agw,dbt_agw_dd) call bbgw_allom(d_try,ipft,bt_bgw,dbt_bgw_dd) call bdead_allom(bt_agw,bt_bgw, bt_sap, ipft, bt_dead_try, dbt_agw_dd, & - dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd) + dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd_try) ! Prevent overshooting - if(bt_dead_try>bdead) then + if(bt_dead_try > (bdead+calloc_abs_error)) then step_frac = step_frac*0.5_r8 else step_frac = step_frac0 d = d_try bt_dead = bt_dead_try + dbt_dead_dd = dbt_dead_dd_try end if counter = counter + 1 end do + call h_allom(d,ipft,h) if(counter>10)then write(fates_log(),*) 'dbh counter: ',counter end if @@ -1743,7 +1744,7 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) ! should be pretty close to and greater than actual return - end subroutine StructureResetofDH + end subroutine StructureResetOfDH ! =========================================================================== From 2cdcd90b8fbe7ea0c78438a05b597a2eb517b977 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 2 Mar 2018 15:25:40 -0800 Subject: [PATCH 106/111] Allocation bug fixes: enabled non-woody vegetation to ignore dbh resetting, which is impossible/complicated when dbh has no pool to tie to that is not allowed to have a zero derivative. Bugfix in recruitment: moved calculation of plant density to be after the phenology assessment, which was modifying bleaf after it was supposed to be used to calculate n and breaking carbon balance. Bugfix 2: cohort leaf_litter from phenology was not being zerod at the beginning of the phenology_leafonoff for drought leaf drop. --- biogeochem/EDCohortDynamicsMod.F90 | 11 +- biogeochem/EDPhysiologyMod.F90 | 207 +++++++++++++++++++---------- biogeochem/FatesAllometryMod.F90 | 16 ++- main/EDTypesMod.F90 | 8 +- 4 files changed, 156 insertions(+), 86 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 497cd3f761..00005f14f3 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -36,7 +36,7 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : StructureResetOfDH - + use FatesAllometryMod , only : LeafResetOfDH ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg ! @@ -685,15 +685,20 @@ subroutine fuse_cohorts(patchptr, bc_in) currentCohort%canopy_trim = (currentCohort%n*currentCohort%canopy_trim & + nextc%n*nextc%canopy_trim)/newn + ! ----------------------------------------------------------------- ! If fusion pushed structural biomass to be larger than ! the allometric target value derived by diameter, we ! then increase diameter and height until the allometric ! target matches actual bdead. (if it is the other way around ! we then just let the carbon pools grow to fill-out allometry) - - if (EDPftvarcon_inst%woody(currentCohort%pft) == itrue) then + ! ----------------------------------------------------------------- + + if( EDPftvarcon_inst%woody(currentCohort%pft) == itrue ) then call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) +! else if (EDPftvarcon_inst%woody(currentCohort%pft) == ifalse ) then +! call LeafResetOfDH( currentCohort%bl, currentCohort%pft, & +! currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 755ec2d794..4320dee3f2 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -49,6 +49,7 @@ module EDPhysiologyMod use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : CheckIntegratedAllometries use FatesAllometryMod , only : StructureResetOfDH + use FatesALlometryMod , only : LeafResetOfDH use FatesIntegratorsMod, only : RKF45 use FatesIntegratorsMod, only : Euler @@ -532,10 +533,12 @@ subroutine phenology_leafonoff(currentSite) currentPatch => CurrentSite%oldest_patch store_output = 0.5_r8 - + do while(associated(currentPatch)) currentCohort => currentPatch%tallest do while(associated(currentCohort)) + + currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. !COLD LEAF ON if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then @@ -564,7 +567,7 @@ subroutine phenology_leafonoff(currentSite) endif ! growing season !COLD LEAF OFF - currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. +! currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. if (currentSite%status == 1)then !past leaf drop day? Leaves still on tree? if (currentCohort%status_coh == 2)then ! leaves have not dropped currentCohort%status_coh = 1 @@ -573,7 +576,12 @@ subroutine phenology_leafonoff(currentSite) ! add lost carbon to litter currentCohort%leaf_litter = currentCohort%bl - currentCohort%bl = 0.0_r8 + currentCohort%bl = 0.0_r8 + +! write(fates_log(),*) 'cold drop kicking in' +! call endrun(msg=errMsg(sourcefile, __LINE__)) + + endif !leaf status endif !currentSite status endif !season_decid @@ -610,6 +618,10 @@ subroutine phenology_leafonoff(currentSite) ! add falling leaves to litter pools . convert to KgC/m2 currentCohort%leaf_litter = currentCohort%bl currentCohort%bl = 0.0_r8 + +! write(fates_log(),*) 'drought drop kicking in' +! call endrun(msg=errMsg(sourcefile, __LINE__)) + endif endif !status endif !drought dec. @@ -829,7 +841,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8) :: repro_fraction ! fraction of carbon gain sent to reproduction when on-allometry real(r8) :: leaf_turnover_demand ! leaf carbon that is demanded to replace maintenance turnover [kgC] - real(r8) :: root_turnover_demand ! fineroot carbon that is demanded to replace maintenance turnover [kgC] + real(r8) :: root_turnover_demand ! fineroot carbon that is demanded to replace + ! maintenance turnover [kgC] real(r8) :: total_turnover_demand ! total carbon that is demanded to replace maintenance turnover [kgC] real(r8),dimension(n_cplantpools) :: c_pool ! Vector of carbon pools passed to integrator @@ -863,9 +876,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ! non-integrator part integer , parameter :: max_substeps = 300 - real(r8), parameter :: max_trunc_error = 10.0_r8 + real(r8), parameter :: max_trunc_error = 0.1_r8 integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler - real(r8), parameter :: global_branch_turnover = 0.0_r8 ! Temporary branch turnover setting ! Branch-turnover control will be ! introduced in a later PR @@ -937,11 +949,11 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Target leaf biomass according to allometry and trimming call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) - ! If status_coh is 1, then leaves are in a dropped (off allometry) - if( currentcohort%status_coh == 1 ) then - bt_leaf = 0.0_r8 - dbt_leaf_dd = 0.0_r8 - end if +! ! If status_coh is 1, then leaves are in a dropped (off allometry) +! if( currentcohort%status_coh == 1 ) then +! bt_leaf = 0.0_r8 +! dbt_leaf_dd = 0.0_r8 +! end if ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) @@ -956,17 +968,25 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) call bbgw_allom(currentCohort%dbh,ipft,bt_bgw,dbt_bgw_dd) ! Target total dead (structrual) biomass and deriv. [kgC, kgC/cm] - call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) + call bdead_allom( bt_agw, bt_bgw, bt_sap, ipft, bt_dead, & + dbt_agw_dd, dbt_bgw_dd, dbt_sap_dd, dbt_dead_dd ) ! Target storage carbon [kgC,kgC/cm] call bstore_allom(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_store,dbt_store_dd) + ! ------------------------------------------------------------------------------------ ! If structure is larger than target, then we need to correct some integration errors - ! by slightly increasing dbh to match it. We only do this for woody vegetation + ! by slightly increasing dbh to match it. + ! For grasses, if leaf biomass is larger than target, then we reset dbh to match + ! ----------------------------------------------------------------------------------- if( ((currentCohort%bdead-bt_dead) > calloc_abs_error) .and. & (EDPftvarcon_inst%woody(ipft) == itrue) ) then call StructureResetOfDH( currentCohort%bdead, ipft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) +! else if ( ((currentCohort%bl-bt_leaf) > calloc_abs_error) .and. & +! (EDPftvarcon_inst%woody(ipft) == ifalse) ) then +! call LeafResetOfDH( currentCohort%bl, ipft, & +! currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if ! ----------------------------------------------------------------------------------- @@ -1007,17 +1027,16 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! If the turnover time-scales are zero, that means there is no turnover. ! ! ----------------------------------------------------------------------------------- + currentCohort%leaf_md = 0.0_r8 + currentCohort%bsw_md = 0.0_r8 + currentCohort%bdead_md = 0.0_r8 + currentCohort%bstore_md = 0.0_r8 + currentCohort%root_md = 0.0_r8 if ( EDPftvarcon_inst%branch_turnover(ipft) > tiny(EDPftvarcon_inst%branch_turnover(ipft)) ) then currentCohort%bsw_md = currentCohort%bsw / EDPftvarcon_inst%branch_turnover(ipft) currentCohort%bdead_md = currentCohort%bdead / EDPftvarcon_inst%branch_turnover(ipft) currentCohort%bstore_md = currentCohort%bstore / EDPftvarcon_inst%branch_turnover(ipft) - print*,"BRANCH TURNOVER SHOULD BE OFF" - stop - else - currentCohort%bsw_md = 0.0_r8 - currentCohort%bdead_md = 0.0_r8 - currentCohort%bstore_md = 0.0_r8 end if if (EDPftvarcon_inst%evergreen(ipft) == 1)then @@ -1027,15 +1046,18 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) if (EDPftvarcon_inst%season_decid(ipft) == 1)then currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(ipft) - currentCohort%leaf_md = 0._r8 endif if (EDPftvarcon_inst%stress_decid(ipft) == 1)then currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(ipft) - currentCohort%leaf_md = 0._r8 endif - + currentCohort%leaf_md = 0.0_r8 + currentCohort%bsw_md = 0.0_r8 + currentCohort%bdead_md = 0.0_r8 + currentCohort%bstore_md = 0.0_r8 + currentCohort%root_md = 0.0_r8 + ! ----------------------------------------------------------------------------------- ! IV. Remove turnover from the appropriate pools ! @@ -1064,9 +1086,9 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! If we are testing b4b, then we pay this even if we don't have the carbon ! Just don't pay so much carbon that storage+carbon_balance can't pay for it - bl_flux = min(leaf_turnover_demand, & - max(0.0_r8,(currentCohort%bstore+carbon_balance)*(leaf_turnover_demand/total_turnover_demand))) + max(0.0_r8,(currentCohort%bstore+carbon_balance)* & + (leaf_turnover_demand/total_turnover_demand))) carbon_balance = carbon_balance - bl_flux currentCohort%bl = currentCohort%bl + bl_flux @@ -1074,7 +1096,8 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! If we are testing b4b, then we pay this even if we don't have the carbon br_flux = min(root_turnover_demand, & - max(0.0_r8, (currentCohort%bstore+carbon_balance)*(root_turnover_demand/total_turnover_demand))) + max(0.0_r8, (currentCohort%bstore+carbon_balance)* & + (root_turnover_demand/total_turnover_demand))) carbon_balance = carbon_balance - br_flux currentCohort%br = currentCohort%br + br_flux @@ -1103,8 +1126,10 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) store_below_target = max(bt_store - currentCohort%bstore,0.0_r8) store_target_fraction = max(0.0_r8,currentCohort%bstore/bt_store) + bstore_flux = min(store_below_target,carbon_balance * & max(exp(-1.*store_target_fraction**4._r8) - exp( -1.0_r8 ),0.0_r8)) + carbon_balance = carbon_balance - bstore_flux currentCohort%bstore = currentCohort%bstore + bstore_flux currentCohort%npp_stor = currentCohort%npp_stor + bstore_flux / hlm_freq_day @@ -1222,11 +1247,17 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! allow actual pools to be above the target, and in these cases, it sends ! a false on the "grow_<>" flag, allowing the plant to grow into these pools. ! It also checks to make sure that structural biomass is not above the target. - - call TargetAllometryCheck(currentCohort%bl,currentCohort%br,currentCohort%bsw, & + if ( EDPftvarcon_inst%woody(ipft) == itrue ) then + call TargetAllometryCheck(currentCohort%bl,currentCohort%br,currentCohort%bsw, & currentCohort%bstore,currentCohort%bdead, & bt_leaf,bt_fineroot,bt_sap,bt_store,bt_dead, & grow_leaf,grow_froot,grow_sap,grow_store) + else + grow_leaf = .true. + grow_froot = .true. + grow_sap = .true. + grow_store = .true. + end if ! Initialize the adaptive integrator arrays and flags @@ -1261,12 +1292,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) elseif(ODESolve == 2) then call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out) -! step_pass = .true. - call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & - c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & - c_pool_out(i_cstore), c_pool_out(i_cdead), & - c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & - c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) + step_pass = .true. +! call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & +! c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & +! c_pool_out(i_cstore), c_pool_out(i_cdead), & +! c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & +! c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) if(step_pass) then currentCohort%ode_opt_step = deltaC else @@ -1463,35 +1494,57 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) if (mask_sap) ct_dtotaldd = ct_dtotaldd + ct_dsapdd if (mask_store) ct_dtotaldd = ct_dtotaldd + ct_dstoredd - dCdx(i_cdead) = (ct_ddeaddd/ct_dtotaldd)*(1.0_r8-repro_fraction) - dCdx(i_dbh) = (1.0_r8/ct_dtotaldd)*(1.0_r8-repro_fraction) + ! It is possible that with some asymptotic, or hard + ! capped allometries, that all growth rates reach zero. + ! In this case, if there is carbon, give it to reproduction - if (mask_leaf) then - dCdx(i_cleaf) = (ct_dleafdd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else - dCdx(i_cleaf) = 0.0_r8 - end if - - if (mask_froot) then - dCdx(i_cfroot) = (ct_dfrootdd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else +! repro_fraction = 0.0_r8 + + if(ct_dtotaldd<=tiny(ct_dtotaldd))then + + dCdx(i_cdead) = 0.0_r8 + dCdx(i_dbh) = 0.0_r8 + dCdx(i_cleaf) = 0.0_r8 dCdx(i_cfroot) = 0.0_r8 - end if - - if (mask_sap) then - dCdx(i_csap) = (ct_dsapdd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else - dCdx(i_csap) = 0.0_r8 - end if - - if (mask_store) then - dCdx(i_cstore) = (ct_dstoredd/ct_dtotaldd)*(1.0_r8-repro_fraction) - else + dCdx(i_csap) = 0.0_r8 dCdx(i_cstore) = 0.0_r8 - end if + dCdx(i_crepro) = 1.0_r8 + write(fates_log(),*) 'exiting because of forced seed 0' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + else - dCdx(i_crepro) = repro_fraction + dCdx(i_cdead) = (ct_ddeaddd/ct_dtotaldd)*(1.0_r8-repro_fraction) + dCdx(i_dbh) = (1.0_r8/ct_dtotaldd)*(1.0_r8-repro_fraction) + + if (mask_leaf) then + dCdx(i_cleaf) = (ct_dleafdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_cleaf) = 0.0_r8 + end if + + if (mask_froot) then + dCdx(i_cfroot) = (ct_dfrootdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_cfroot) = 0.0_r8 + end if + + if (mask_sap) then + dCdx(i_csap) = (ct_dsapdd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_csap) = 0.0_r8 + end if + + if (mask_store) then + dCdx(i_cstore) = (ct_dstoredd/ct_dtotaldd)*(1.0_r8-repro_fraction) + else + dCdx(i_cstore) = 0.0_r8 + end if + + dCdx(i_crepro) = repro_fraction + + end if end associate @@ -1614,26 +1667,14 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) call bdead_allom(b_agw,b_bgw,b_sapwood,ft,temp_cohort%bdead) call bstore_allom(temp_cohort%dbh,ft,temp_cohort%canopy_trim,temp_cohort%bstore) - 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+b_leaf+b_fineroot+b_sapwood+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 + b_leaf + b_fineroot + b_sapwood + 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 = b_leaf + b_leaf = 0.0_r8 endif if (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then temp_cohort%laimemory = b_leaf + b_leaf = 0.0_r8 endif cohortstatus = currentSite%status @@ -1646,6 +1687,21 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) cohortstatus = 2 endif + 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+b_leaf+b_fineroot+b_sapwood+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 + b_leaf + b_fineroot + b_sapwood + temp_cohort%bdead) + currentSite%flux_out = currentSite%flux_out + currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day + 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, & @@ -1719,7 +1775,7 @@ subroutine CWD_Input( currentSite, currentPatch) do c = 1,ncwd currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + & (currentCohort%bdead_md + currentCohort%bsw_md) * & - SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) + SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + & (currentCohort%bdead_md + currentCohort%bsw_md) * & SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *(1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) @@ -1747,7 +1803,12 @@ subroutine CWD_Input( currentSite, currentPatch) currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & - currentCohort%bl * dead_n + (currentCohort%bl)* dead_n + ! %n has not been updated due to mortality yet, thus + ! the litter flux has already been counted since it captured + ! the losses of live trees and those flagged for death + !(currentCohort%bl+currentCohort%leaf_litter/hlm_freq_day)* dead_n + currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & (currentCohort%br+currentCohort%bstore) * dead_n diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index ef2c416914..43b053c582 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -104,11 +104,11 @@ module FatesAllometryMod public :: bdead_allom ! Generic bdead wrapper public :: carea_allom ! Generic crown area wrapper public :: bstore_allom ! Generic maximum storage carbon wrapper - public :: StructureResetOfDH + public :: StructureResetOfDH ! Method to set DBH to sync with structure biomass public :: CheckIntegratedAllometries - logical , parameter :: verbose_logging = .true. + logical , parameter :: verbose_logging = .false. character(len=*), parameter :: sourcefile = __FILE__ @@ -966,7 +966,7 @@ subroutine d2blmax_salda(d,p1,p2,p3,rho,dbh_maxh,c2b,blmax,dblmaxdd) if(present(dblmaxdd))then if( dmax_counter) then + write(fates_log(),*) 'Having trouble converging on dbh reset' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end do call h_allom(d,ipft,h) @@ -1746,7 +1752,7 @@ subroutine StructureResetOfDH( bdead, ipft, canopy_trim, d, h ) return end subroutine StructureResetOfDH - ! =========================================================================== + ! ========================================================================= subroutine cspline(x1,x2,y1,y2,dydx1,dydx2,x,y,dydx) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5179414bc1..492dcf6ac3 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -18,7 +18,7 @@ module EDTypesMod integer, parameter :: ican_ustory = 2 ! Nominal index for understory in two-canopy system integer, parameter :: nlevleaf = 40 ! number of leaf layers in canopy layer - integer, parameter :: maxpft = 10 ! maximum number of PFTs allowed + integer, parameter :: maxpft = 15 ! maximum number of PFTs allowed ! the parameter file may determine that fewer ! are used, but this helps allocate scratch ! space and output arrays. @@ -349,8 +349,6 @@ module EDTypesMod ! PHOTOSYNTHESIS real(r8) :: psn_z(nclmax,maxpft,nlevleaf) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s -! real(r8) :: gpp ! total patch gpp: KgC/m2/year -! real(r8) :: npp ! total patch npp: KgC/m2/year ! ROOTS real(r8), allocatable :: rootfr_ft(:,:) ! root fraction of each PFT in each soil layer:- @@ -517,8 +515,8 @@ module EDTypesMod real(r8) :: water_memory(numWaterMem) ! last 10 days of soil moisture memory... !SEED BANK - real(r8) :: seed_bank(maxpft) ! seed pool in KgC/m2/year - real(r8) :: dseed_dt(maxpft) + real(r8) :: seed_bank(maxpft) ! seed pool in KgC/m2 + real(r8) :: dseed_dt(maxpft) ! change in seed pool in KgC/m2/year real(r8) :: seed_rain_flux(maxpft) ! flux of seeds from exterior KgC/m2/year (needed for C balance purposes) ! FIRE From 46c7f483ac22423e3fb6eb96a2111644546e702d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 2 Mar 2018 15:26:07 -0800 Subject: [PATCH 107/111] Small feature addition: allowed a developer toggle to turn off mortality. --- biogeochem/EDMortalityFunctionsMod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 251eef7059..4e84928361 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -65,6 +65,10 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) real(r8),parameter :: frost_mort_scaler = 3.0_r8 ! Scaling factor for freezing mortality real(r8),parameter :: frost_mort_buffer = 5.0_r8 ! 5deg buffer for freezing mortality + logical, parameter :: test_zero_mortality = .false. ! Developer test which + ! may help to debug carbon imbalances + ! and the like + if (hlm_use_ed_prescribed_phys .eq. ifalse) then ! 'Background' mortality (can vary as a function of @@ -121,6 +125,14 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort ) frmort = 0._r8 endif + if (test_zero_mortality) then + cmort = 0.0_r8 + hmort = 0.0_r8 + frmort = 0.0_r8 + bmort = 0.0_r8 + end if + + return end subroutine mortality_rates ! ============================================================================ From 45825a47651f979843960e0c1117f2c099cdde3e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 2 Mar 2018 15:27:24 -0800 Subject: [PATCH 108/111] Fixed calculation of crown layer heights. But some normalization checks in canopy layer leaf and area calculations to allow for scenarios where scenescent grasses exist but have no leaf or stem. --- biogeochem/EDCanopyStructureMod.F90 | 166 ++++++++++++---------------- 1 file changed, 73 insertions(+), 93 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index f26a9835c9..a2f241caa5 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1197,32 +1197,69 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) !Whole layers. Make a weighted average of the leaf area in each layer before dividing it by the total area. !fill up layer for whole layers. FIX(RF,032414)- for debugging jan 2012 - do iv = 1,currentCohort%NV-1 + + do iv = 1,currentCohort%NV + + ! This loop builds the arrays that define the effective (not snow covered) + ! and total (includes snow covered) area indices for leaves and stems + ! We calculate the absolute elevation of each layer to help determine if the layer + ! is obscured by snow. + ! (RGK 03-01-2018 : we are not occulding any vegetation from snow right now) + + layer_top_hite = currentCohort%hite - & + ( dble(iv-1.0)/currentCohort%NV * currentCohort%hite * EDPftvarcon_inst%crown(currentCohort%pft) ) + + layer_bottom_hite = currentCohort%hite - & + ( dble(iv)/currentCohort%NV * currentCohort%hite * EDPftvarcon_inst%crown(currentCohort%pft) ) - ! what is the height of this layer? (for snow burial purposes...) - ! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. - layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & - EDPftvarcon_inst%crown(currentCohort%pft) ) - layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & - EDPftvarcon_inst%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) + fraction_exposed = 1.0_r8 + snow_depth_avg = snow_depth_si * frac_sno_eff_si + if(snow_depth_avg > layer_top_hite)then + fraction_exposed = 0._r8 + endif + if(snow_depth_avg < layer_bottom_hite)then + fraction_exposed = 1._r8 + + endif + if(snow_depth_avg>= layer_bottom_hite.and.snow_depth_avg <= layer_top_hite)then !only partly hidden... + fraction_exposed = max(0._r8,(min(1.0_r8,(snow_depth_avg-layer_bottom_hite)/ & + (layer_top_hite-layer_bottom_hite )))) + endif + + ! =========== OVER-WRITE ================= + fraction_exposed= 1.0_r8 + ! =========== OVER-WRITE ================= + + if(iv==currentCohort%NV) then + remainder = (currentCohort%treelai + currentCohort%treesai) - (dinc_ed*dble(currentCohort%NV-1.0_r8)) + if(remainder > dinc_ed )then + write(fates_log(), *)'ED: issue with remainder',currentCohort%treelai,currentCohort%treesai,dinc_ed, & + currentCohort%NV,remainder + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + else + remainder = dinc_ed + end if + + currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv) + & + remainder * fleaf * currentCohort%c_area/currentPatch%total_canopy_area - fraction_exposed =1.0_r8 + currentPatch%elai_profile(L,ft,iv) = currentPatch%elai_profile(L,ft,iv) + & + remainder * fleaf * currentCohort%c_area/currentPatch%total_canopy_area * fraction_exposed - currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv)+ dinc_ed * fleaf * & - currentCohort%c_area/currentPatch%total_canopy_area - currentPatch%elai_profile(L,ft,iv) = currentPatch%elai_profile(L,ft,iv)+ dinc_ed * fleaf * & - currentCohort%c_area/currentPatch%total_canopy_area * fraction_exposed + currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv) + & + remainder * (1._r8 - fleaf) * currentCohort%c_area/currentPatch%total_canopy_area - currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv)+ dinc_ed * (1._r8 - fleaf) * & - currentCohort%c_area/currentPatch%total_canopy_area - currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv)+ dinc_ed * (1._r8 - fleaf) * & - currentCohort%c_area/currentPatch%total_canopy_area * fraction_exposed + currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv) + & + remainder * (1._r8 - fleaf) * currentCohort%c_area/currentPatch%total_canopy_area * fraction_exposed currentPatch%canopy_area_profile(L,ft,iv) = min(1.0_r8,currentPatch%canopy_area_profile(L,ft,iv) + & currentCohort%c_area/currentPatch%total_canopy_area) - currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) + (dinc_ed * fleaf * & - currentCohort%c_area/currentPatch%total_canopy_area *(layer_top_hite+layer_bottom_hite)/2.0_r8) !average height of layer. + currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) + & + (remainder * fleaf * currentCohort%c_area/currentPatch%total_canopy_area * & + (layer_top_hite+layer_bottom_hite)/2.0_r8) !average height of layer. + if ( DEBUG ) then write(fates_log(), *) 'calc snow 2', snow_depth_si , frac_sno_eff_si write(fates_log(), *) 'LHP', currentPatch%layer_height_profile(L,ft,iv) @@ -1230,68 +1267,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) end if end do - - !Bottom layer - iv = currentCohort%NV - ! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. - - layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & - EDPftvarcon_inst%crown(currentCohort%pft) ) - ! EDPftvarcon_inst%vertical_canopy_frac(ft)) - layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & - EDPftvarcon_inst%crown(currentCohort%pft)) - - fraction_exposed = 1.0_r8 !default. - snow_depth_avg = snow_depth_si * frac_sno_eff_si - if(snow_depth_avg > layer_top_hite)then - fraction_exposed = 0._r8 - endif - if(snow_depth_avg < layer_bottom_hite)then - fraction_exposed = 1._r8 - - endif - if(snow_depth_avg>= layer_bottom_hite.and.snow_depth_avg <= layer_top_hite)then !only partly hidden... - fraction_exposed = max(0._r8,(min(1.0_r8,(snow_depth_avg-layer_bottom_hite)/ & - (layer_top_hite-layer_bottom_hite )))) - endif - fraction_exposed= 1.0_r8 - - - remainder = (currentCohort%treelai + currentCohort%treesai) - (dinc_ed*(currentCohort%NV-1)) - if(remainder > 1.0_r8)then - write(fates_log(), *)'ED: issue with remainder',currentCohort%treelai,currentCohort%treesai,dinc_ed, & - currentCohort%NV - endif - !assumes that fleaf is unchanging FIX(RF,032414) - - currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv)+ remainder * fleaf * & - currentCohort%c_area/currentPatch%total_canopy_area - currentPatch%elai_profile(L,ft,iv) = currentPatch%elai_profile(L,ft,iv) + remainder * fleaf * & - currentCohort%c_area/currentPatch%total_canopy_area * fraction_exposed - !assumes that fleaf is unchanging FIX(RF,032414) - - currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv)+ remainder * & - (1.0_r8-fleaf) * currentCohort%c_area/currentPatch%total_canopy_area - currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv)+ remainder * & - (1.0_r8-fleaf) * currentCohort%c_area/currentPatch%total_canopy_area * fraction_exposed - - currentPatch%canopy_area_profile(L,ft,iv) = min(1.0_r8,currentPatch%canopy_area_profile(L,ft,iv) + & - currentCohort%c_area/currentPatch%total_canopy_area) - currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) + (remainder * fleaf * & - currentCohort%c_area/currentPatch%total_canopy_area*(layer_top_hite+layer_bottom_hite)/2.0_r8) - if ( DEBUG ) write(fates_log(), *) 'LHP', currentPatch%layer_height_profile(L,ft,iv) - if(currentCohort%dbh <= 0._r8.or.currentCohort%n == 0._r8)then - write(fates_log(), *) 'ED: dbh or n is zero in clmedlink', currentCohort%dbh,currentCohort%n - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then - write(fates_log(), *) 'ED: PFT or trim is zero in clmedlink',currentCohort%pft,currentCohort%canopy_trim - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - if(currentCohort%bl < 0._r8)then - write(fates_log(), *) 'ED: bl (leaf biomass) is lt zero',currentCohort%bl - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif currentCohort => currentCohort%taller @@ -1301,21 +1276,26 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) do ft = 1,numpft do iv = 1,currentPatch%nrad(L,ft) !account for total canopy area - currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv) / & - currentPatch%canopy_area_profile(L,ft,iv) - currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv) / & - currentPatch%canopy_area_profile(L,ft,iv) + if(currentPatch%canopy_area_profile(L,ft,iv) > tiny(currentPatch%canopy_area_profile(L,ft,iv)))then + + currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + + currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + + currentPatch%elai_profile(L,ft,iv) = currentPatch%elai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + + currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + end if - if ( DEBUG ) write(fates_log(), *) 'EDCLMLink 1293 ', currentPatch%elai_profile(L,ft,iv) - - currentPatch%elai_profile(L,ft,iv) = currentPatch%elai_profile(L,ft,iv) / & - currentPatch%canopy_area_profile(L,ft,iv) - - currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv) / & - currentPatch%canopy_area_profile(L,ft,iv) + if(currentPatch%tlai_profile(L,ft,iv)>tiny(currentPatch%tlai_profile(L,ft,iv)))then + currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) & + /currentPatch%tlai_profile(L,ft,iv) + end if - currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) & - /currentPatch%tlai_profile(L,ft,iv) enddo currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8 From f128a9d4b4491716d67424b867f4594e8c05e54f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 2 Mar 2018 16:56:08 -0800 Subject: [PATCH 109/111] Allocation: cleaned up call to leaf reset of dbh, which is not used now. --- biogeochem/EDCohortDynamicsMod.F90 | 4 ---- biogeochem/EDPhysiologyMod.F90 | 5 ----- 2 files changed, 9 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 00005f14f3..a5bdfb70a7 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -36,7 +36,6 @@ module EDCohortDynamicsMod use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : StructureResetOfDH - use FatesAllometryMod , only : LeafResetOfDH ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg ! @@ -696,9 +695,6 @@ subroutine fuse_cohorts(patchptr, bc_in) if( EDPftvarcon_inst%woody(currentCohort%pft) == itrue ) then call StructureResetOfDH( currentCohort%bdead, currentCohort%pft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) -! else if (EDPftvarcon_inst%woody(currentCohort%pft) == ifalse ) then -! call LeafResetOfDH( currentCohort%bl, currentCohort%pft, & -! currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 4320dee3f2..9648961923 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -49,7 +49,6 @@ module EDPhysiologyMod use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : CheckIntegratedAllometries use FatesAllometryMod , only : StructureResetOfDH - use FatesALlometryMod , only : LeafResetOfDH use FatesIntegratorsMod, only : RKF45 use FatesIntegratorsMod, only : Euler @@ -983,10 +982,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) (EDPftvarcon_inst%woody(ipft) == itrue) ) then call StructureResetOfDH( currentCohort%bdead, ipft, & currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) -! else if ( ((currentCohort%bl-bt_leaf) > calloc_abs_error) .and. & -! (EDPftvarcon_inst%woody(ipft) == ifalse) ) then -! call LeafResetOfDH( currentCohort%bl, ipft, & -! currentCohort%canopy_trim, currentCohort%dbh, currentCohort%hite ) end if ! ----------------------------------------------------------------------------------- From 2fb2f5d27b02b1ff7faac1ce93d4dc67fa0c930b Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 2 Mar 2018 17:10:05 -0800 Subject: [PATCH 110/111] Fixed error in calculation of biomass_bg_ft during export of fragmented fluxes to HLM. --- biogeochem/EDPhysiologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 9648961923..a98b95ca5c 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -2301,7 +2301,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) do while(associated(currentCohort)) biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + & ((currentCohort%bdead + currentCohort%bsw ) * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) + & - (currentCohort%br + currentCohort%bstore )) + & + (currentCohort%br + currentCohort%bstore )) * & (currentCohort%n / currentPatch%area) currentCohort => currentCohort%shorter enddo !currentCohort From 78fbc4a6cb9cdabb895acfe8842bfaf058fa7403 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 5 Mar 2018 10:56:48 -0800 Subject: [PATCH 111/111] Removed a testing artifact where non-mortality turnover was flushed to zero. --- biogeochem/EDPhysiologyMod.F90 | 49 ++++++++++------------------------ 1 file changed, 14 insertions(+), 35 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index a98b95ca5c..23f2a90a25 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -576,10 +576,6 @@ subroutine phenology_leafonoff(currentSite) ! add lost carbon to litter currentCohort%leaf_litter = currentCohort%bl currentCohort%bl = 0.0_r8 - -! write(fates_log(),*) 'cold drop kicking in' -! call endrun(msg=errMsg(sourcefile, __LINE__)) - endif !leaf status endif !currentSite status @@ -593,7 +589,9 @@ subroutine phenology_leafonoff(currentSite) if (currentCohort%laimemory <= currentCohort%bstore)then currentCohort%bl = currentCohort%laimemory !extract stored carbon to make new leaves. else - currentCohort%bl = currentCohort%bstore * store_output !we can only put on as much carbon as there is in the store... + + !we can only put on as much carbon as there is in the store. + currentCohort%bl = currentCohort%bstore * store_output endif if ( DEBUG ) write(fates_log(),*) 'EDPhysMod 3 ',currentCohort%bstore @@ -618,9 +616,6 @@ subroutine phenology_leafonoff(currentSite) currentCohort%leaf_litter = currentCohort%bl currentCohort%bl = 0.0_r8 -! write(fates_log(),*) 'drought drop kicking in' -! call endrun(msg=errMsg(sourcefile, __LINE__)) - endif endif !status endif !drought dec. @@ -875,7 +870,7 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) real(r8), parameter :: cbal_prec = 1.0e-15_r8 ! Desired precision in carbon balance ! non-integrator part integer , parameter :: max_substeps = 300 - real(r8), parameter :: max_trunc_error = 0.1_r8 + real(r8), parameter :: max_trunc_error = 1.0_r8 integer, parameter :: ODESolve = 2 ! 1=RKF45, 2=Euler real(r8), parameter :: global_branch_turnover = 0.0_r8 ! Temporary branch turnover setting ! Branch-turnover control will be @@ -948,12 +943,6 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) ! Target leaf biomass according to allometry and trimming call bleaf(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_leaf,dbt_leaf_dd) -! ! If status_coh is 1, then leaves are in a dropped (off allometry) -! if( currentcohort%status_coh == 1 ) then -! bt_leaf = 0.0_r8 -! dbt_leaf_dd = 0.0_r8 -! end if - ! Target fine-root biomass and deriv. according to allometry and trimming [kgC, kgC/cm] call bfineroot(currentCohort%dbh,ipft,currentCohort%canopy_trim,bt_fineroot,dbt_fineroot_dd) @@ -1047,23 +1036,16 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(ipft) endif - currentCohort%leaf_md = 0.0_r8 - currentCohort%bsw_md = 0.0_r8 - currentCohort%bdead_md = 0.0_r8 - currentCohort%bstore_md = 0.0_r8 - currentCohort%root_md = 0.0_r8 - ! ----------------------------------------------------------------------------------- ! IV. Remove turnover from the appropriate pools ! ! Units: kgC/year * (year/days_per_year) = kgC/day -> (day elapsed) -> kgC ! ----------------------------------------------------------------------------------- - - currentCohort%bl = currentCohort%bl - currentCohort%leaf_md*hlm_freq_day - currentcohort%br = currentcohort%br - currentCohort%root_md*hlm_freq_day - currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md*hlm_freq_day - currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md*hlm_freq_day + currentCohort%bl = currentCohort%bl - currentCohort%leaf_md*hlm_freq_day + currentcohort%br = currentcohort%br - currentCohort%root_md*hlm_freq_day + currentcohort%bsw = currentcohort%bsw - currentCohort%bsw_md*hlm_freq_day + currentCohort%bdead = currentCohort%bdead - currentCohort%bdead_md*hlm_freq_day currentCohort%bstore = currentCohort%bstore - currentCohort%bstore_md*hlm_freq_day @@ -1287,12 +1269,12 @@ subroutine PlantGrowth( currentSite, currentCohort, bc_in ) elseif(ODESolve == 2) then call Euler(AllomCGrowthDeriv,c_pool,c_mask,deltaC,totalC,currentCohort,c_pool_out) - step_pass = .true. -! call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & -! c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & -! c_pool_out(i_cstore), c_pool_out(i_cdead), & -! c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & -! c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) +! step_pass = .true. + call CheckIntegratedAllometries(c_pool_out(i_dbh),ipft,currentCohort%canopy_trim, & + c_pool_out(i_cleaf), c_pool_out(i_cfroot), c_pool_out(i_csap), & + c_pool_out(i_cstore), c_pool_out(i_cdead), & + c_mask(i_cleaf), c_mask(i_cfroot), c_mask(i_csap), & + c_mask(i_cstore),c_mask(i_cdead), max_trunc_error, step_pass) if(step_pass) then currentCohort%ode_opt_step = deltaC else @@ -1505,9 +1487,6 @@ function AllomCGrowthDeriv(c_pools,c_mask,cbalance,currentCohort) result(dCdx) dCdx(i_cstore) = 0.0_r8 dCdx(i_crepro) = 1.0_r8 - write(fates_log(),*) 'exiting because of forced seed 0' - call endrun(msg=errMsg(sourcefile, __LINE__)) - else dCdx(i_cdead) = (ct_ddeaddd/ct_dtotaldd)*(1.0_r8-repro_fraction)