From 82ea563ab3cdc5fef702ac422900cf15d06e230b Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 18 Jul 2017 16:26:12 -0700 Subject: [PATCH 01/23] pulled just the strict PPA logic from the prescribed physiology branch --- biogeochem/EDCanopyStructureMod.F90 | 165 ++++++++++++++++++++-------- biogeochem/EDPatchDynamicsMod.F90 | 2 + main/EDTypesMod.F90 | 1 + main/FatesHistoryInterfaceMod.F90 | 21 +++- 4 files changed, 141 insertions(+), 48 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index d042fa78db..e924d15889 100755 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -110,6 +110,7 @@ subroutine canopy_structure( currentSite , bc_in ) integer :: promswitch,lower_cohort_switch real(r8) :: sumloss,excess_area integer :: count_mi + real(r8) :: rankordered_area_sofar ! the amount of total canopy area occupied by cohorts upto this point !---------------------------------------------------------------------- currentPatch => currentSite%oldest_patch @@ -162,11 +163,24 @@ subroutine canopy_structure( currentSite , bc_in ) sumloss = 0.0_r8 new_total_area_check = 0.0_r8 sumdiff(i) = 0.0_r8 + rankordered_area_sofar = 0.0_r8 currentCohort => currentPatch%tallest do while (associated(currentCohort)) currentCohort%c_area = c_area(currentCohort) if(arealayer(i) > currentPatch%area.and.currentCohort%canopy_layer == i)then + if (ED_val_comp_excln .ge. 0) then + ! normal (stochastic) case. weight cohort demotion by inverse size to a constant power currentCohort%excl_weight = 1.0_r8/(currentCohort%dbh**ED_val_comp_excln) + else + ! deterministic ranking case. only demote cohorts in smallest size classes + if ( (rankordered_area_sofar + currentCohort%c_area) .gt. currentPatch%area ) then + currentCohort%excl_weight = min(currentCohort%c_area, & + rankordered_area_sofar + currentCohort%c_area - currentPatch%area) + else + currentCohort%excl_weight = 0.0_r8 + endif + rankordered_area_sofar = rankordered_area_sofar + currentCohort%c_area + endif sumdiff(i) = sumdiff(i) + currentCohort%excl_weight endif currentCohort => currentCohort%shorter @@ -177,6 +191,7 @@ subroutine canopy_structure( currentSite , bc_in ) currentCohort => currentPatch%tallest !start from the tallest cohort ! Correct the demoted cohorts for + if (ED_val_comp_excln .ge. 0) then do while (associated(currentCohort)) if(currentCohort%canopy_layer == i) then weight = currentCohort%excl_weight/sumdiff(i) @@ -185,55 +200,62 @@ subroutine canopy_structure( currentSite , bc_in ) endif currentCohort => currentCohort%shorter enddo + endif currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == i)then !All the trees in this layer need to lose some area... - weight = currentCohort%excl_weight/sum_weights(i) - cc_loss = lossarea*weight !what this cohort has to lose. + if (ED_val_comp_excln .ge. 0) then + weight = currentCohort%excl_weight/sum_weights(i) + cc_loss = lossarea*weight !what this cohort has to lose. + else + ! in deterministic ranking mode, cohort loss is not renormalized + cc_loss = currentCohort%excl_weight + endif + if (cc_loss > 0._r8) then !-----------Split and copy boundary cohort-----------------! if(cc_loss < currentCohort%c_area)then allocate(copyc) - + call copy_cohort(currentCohort, copyc) !makes an identical copy... ! n.b this needs to happen BEFORE the cohort goes into the new layer, ! otherwise currentPatch%spread(i+1) will be higher and the area will change...!!! sumloss = sumloss + cc_loss - + newarea = currentCohort%c_area - cc_loss copyc%n = currentCohort%n*newarea/currentCohort%c_area ! currentCohort%n = currentCohort%n - (currentCohort%n*newarea/currentCohort%c_area) ! - + copyc%canopy_layer = i !the taller cohort is the copy currentCohort%canopy_layer = i + 1 !demote the current cohort to the understory. ! seperate cohorts. ! - 0.000000000001_r8 !needs to be a very small number to avoid ! causing non-linearity issues with c_area. is this really required? - currentCohort%dbh = currentCohort%dbh + currentCohort%dbh = currentCohort%dbh copyc%dbh = copyc%dbh !+ 0.000000000001_r8 - + ! 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 - + !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i+1 > nclmax)then - !put the litter from the terminated cohorts into the fragmenting pools - ! write(fates_log(),*) '3rd canopy layer' + !put the litter from the terminated cohorts into the fragmenting pools + ! write(fates_log(),*) '3rd canopy layer' do c=1,ncwd - + currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + (currentCohort%bdead+currentCohort%bsw) * & ED_val_ag_biomass * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area - + currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + (currentCohort%bdead+currentCohort%bsw) * & (1.0_r8-ED_val_ag_biomass) * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area !litter flux per m2. - + enddo - + currentPatch%leaf_litter(currentCohort%pft) = & currentPatch%leaf_litter(currentCohort%pft) + (currentCohort%bl)* & currentCohort%n/currentPatch%area ! leaf litter flux per m2. @@ -260,7 +282,7 @@ subroutine canopy_structure( currentSite , bc_in ) currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) = & currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA - + currentCohort%n = 0.0_r8 currentCohort%c_area = 0._r8 else @@ -268,7 +290,7 @@ subroutine canopy_structure( currentSite , bc_in ) endif copyc%c_area = c_area(copyc) new_total_area_check = new_total_area_check+copyc%c_area - + !----------- Insert copy into linked list ------------------------! copyc%shorter => currentCohort if(associated(currentCohort%taller))then @@ -282,28 +304,28 @@ subroutine canopy_structure( currentSite , bc_in ) else currentCohort%canopy_layer = i + 1 !the whole cohort becomes demoted sumloss = sumloss + currentCohort%c_area - + ! 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 - + !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) if(i+1 > nclmax)then - - !put the litter from the terminated cohorts into the fragmenting pools + + !put the litter from the terminated cohorts into the fragmenting pools do c=1,ncwd - + currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + (currentCohort%bdead+currentCohort%bsw) * & ED_val_ag_biomass * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + (currentCohort%bdead+currentCohort%bsw) * & (1.0_r8-ED_val_ag_biomass) * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area !litter flux per m2. - + enddo - + currentPatch%leaf_litter(currentCohort%pft) = & currentPatch%leaf_litter(currentCohort%pft) + currentCohort%bl* & currentCohort%n/currentPatch%area ! leaf litter flux per m2. @@ -330,17 +352,18 @@ subroutine canopy_structure( currentSite , bc_in ) currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) = & currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA - + currentCohort%n = 0.0_r8 currentCohort%c_area = 0._r8 - + else currentCohort%c_area = c_area(currentCohort) endif - + !write(fates_log(),*) 'demoting whole cohort', currentCohort%c_area,cc_loss, & - !currentCohort%canopy_layer,currentCohort%dbh - + !currentCohort%canopy_layer,currentCohort%dbh + + endif endif !----------- End of cohort splitting ------------------------------! @@ -452,13 +475,26 @@ subroutine canopy_structure( currentSite , bc_in ) lower_cohort_switch = 0 sumgain = 0.0_r8 sumdiff(i) = 0.0_r8 + rankordered_area_sofar = 0.0_r8 ! figure out with what weighting we need to promote cohorts. ! This is the opposite of the demotion weighting... currentCohort => currentPatch%tallest do while (associated(currentCohort)) currentCohort%c_area = c_area(currentCohort) if(currentCohort%canopy_layer == i+1)then !look at the cohorts in the canopy layer below... + if (ED_val_comp_excln .ge. 0) then + ! normal (stochastic) case, as above. currentCohort%prom_weight = currentCohort%dbh**ED_val_comp_excln !as opposed to 1/(dbh^C_e) + else + ! deterministic case, as above, but inverse, so only take tallest cohorts from i+1 canopy layer + if ( rankordered_area_sofar .lt. currentPatch%area - arealayer(i) ) then + currentCohort%prom_weight = max(min(currentCohort%c_area, & + currentPatch%area - arealayer(i) - rankordered_area_sofar ), 0._r8) + else + currentCohort%prom_weight = 0.0_r8 + endif + rankordered_area_sofar = rankordered_area_sofar + currentCohort%c_area + endif sumdiff(i) = sumdiff(i) + currentCohort%prom_weight endif currentCohort => currentCohort%shorter @@ -468,6 +504,7 @@ subroutine canopy_structure( currentSite , bc_in ) sum_weights(i) = 0.0_r8 currentCohort => currentPatch%tallest !start from the tallest cohort + if (ED_val_comp_excln .ge. 0) then do while (associated(currentCohort)) if(currentCohort%canopy_layer == i+1) then !still looking at the layer beneath. weight = currentCohort%prom_weight/sumdiff(i) @@ -480,46 +517,54 @@ subroutine canopy_structure( currentSite , bc_in ) endif currentCohort => currentCohort%shorter enddo + endif currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == i+1)then !All the trees in this layer need to promote some area upwards... lower_cohort_switch = 1 - weight = currentCohort%prom_weight/sum_weights(i) - cc_gain = promarea*weight !what this cohort has to promote. + if (ED_val_comp_excln .ge. 0) then + ! normal mode, renormalize areas + weight = currentCohort%prom_weight/sum_weights(i) + cc_gain = promarea*weight !what this cohort has to promote. + else + ! in deterministic ranking mode, cohort loss is not renormalized + cc_gain = currentCohort%prom_weight + endif + if ( cc_gain > 0._r8 ) then !-----------Split and copy boundary cohort-----------------! if(cc_gain < currentCohort%c_area)then allocate(copyc) - + call copy_cohort(currentCohort, copyc) !makes an identical copy... ! n.b this needs to happen BEFORE the cohort goes into the new layer, otherwise currentPatch ! %spread(+1) will be higher and the area will change...!!! sumgain = sumgain + cc_gain - - + + newarea = currentCohort%c_area - cc_gain !new area of existing cohort copyc%n = currentCohort%n*cc_gain/currentCohort%c_area !number of individuals in promoted cohort. ! number of individuals in cohort remaining in understorey currentCohort%n = currentCohort%n - (currentCohort%n*cc_gain/currentCohort%c_area) - + currentCohort%canopy_layer = i+1 !keep current cohort in the understory. copyc%canopy_layer = i ! promote copy to the higher canopy layer. - + ! 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 - + ! seperate cohorts. ! needs to be a very small number to avoid causing non-linearity issues with c_area. ! is this really required? 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) - + !----------- Insert copy into linked list ------------------------! copyc%shorter => currentCohort if(associated(currentCohort%taller))then @@ -536,30 +581,30 @@ subroutine canopy_structure( currentSite , bc_in ) ! 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) - + ! 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 - + promswitch = 1 - - ! write(fates_log(),*) 'promoting whole cohort', currentCohort%c_area,cc_gain,currentCohort%canopy_layer, & - !currentCohort%pft,currentPatch%patchno - + + ! write(fates_log(),*) 'promoting whole cohort', currentCohort%c_area,cc_gain,currentCohort%canopy_layer, & + !currentCohort%pft,currentPatch%patchno + endif if(promswitch == 1)then - ! write(fates_log(),*) 'cohort loop',currentCohort%pft,currentPatch%patchno + ! write(fates_log(),*) 'cohort loop',currentCohort%pft,currentPatch%patchno endif !----------- End of cohort splitting ------------------------------! + endif else if(promswitch == 1)then ! write(fates_log(),*) 'cohort list',currentCohort%pft, & - ! currentCohort%canopy_layer,currentCohort%c_area + ! currentCohort%canopy_layer,currentCohort%c_area endif endif - currentCohort => currentCohort%shorter enddo !currentCohort arealayer(i) = arealayer(i) + sumgain @@ -672,6 +717,32 @@ subroutine canopy_structure( currentSite , bc_in ) ! write(fates_log(),*) 'end canopy structure',currentSite%clmgcell endif + if ( ED_val_comp_excln .lt. 0._r8) then + ! if we are using "strict PPA", then calculate a z_star value as the height of the smallest tree in the canopy + currentPatch => currentSite%oldest_patch + do while (associated(currentPatch)) ! Patch loop + + ! default to zero in the event that canopy_closure has not yet occurred + currentPatch%zstar = 0._r8 + + ! loop from top to bottom and locate the shortest cohort in level 1 whose shorter neighbor is in level 2 + ! set zstar as the ehight of that shortest level 1 cohort + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + if(currentCohort%canopy_layer .eq. 2)then + if (associated(currentCohort%taller)) then + if (currentCohort%taller%canopy_layer .eq. 1 ) then + currentPatch%zstar = currentCohort%taller%hite + endif + endif + endif + currentCohort => currentCohort%shorter + enddo + + currentPatch => currentPatch%younger + enddo !currentPatch + endif + end subroutine canopy_structure ! ============================================================================ diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ffbf8da915..96864d56fc 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1064,6 +1064,7 @@ subroutine zero_patch(cp_p) currentPatch%fab(:) = 0.0_r8 currentPatch%sabs_dir(:) = 0.0_r8 currentPatch%sabs_dif(:) = 0.0_r8 + currentPatch%zstar = 0.0_r8 end subroutine zero_patch @@ -1298,6 +1299,7 @@ subroutine fuse_2_patches(dp, rp) rp%frac_burnt = (dp%frac_burnt*dp%area + rp%frac_burnt*rp%area) * inv_sum_area rp%burnt_frac_litter(:) = (dp%burnt_frac_litter(:)*dp%area + rp%burnt_frac_litter(:)*rp%area) * inv_sum_area rp%btran_ft(:) = (dp%btran_ft(:)*dp%area + rp%btran_ft(:)*rp%area) * inv_sum_area + rp%zstar = (dp%zstar*dp%area + rp%zstar*rp%area) * inv_sum_area rp%area = rp%area + dp%area !THIS MUST COME AT THE END! diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index bd874869f9..cc02f5e80d 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -337,6 +337,7 @@ module EDTypesMod real(r8) :: canopy_area ! area that is covered by vegetation : m2 (is this different to total_canopy_area? real(r8) :: bare_frac_area ! bare soil in this patch expressed as a fraction of the total soil surface. real(r8) :: lai ! leaf area index of patch + real(r8) :: zstar ! height of smallest canopy tree -- only meaningful in "strict PPA" mode real(r8) :: tlai_profile(nclmax,numpft_ed,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2 real(r8) :: elai_profile(nclmax,numpft_ed,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 8c73b95642..947d70aa68 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -10,6 +10,7 @@ module FatesHistoryInterfaceMod use FatesIOVariableKindMod, only : fates_io_variable_kind_type use FatesHistoryVariableType, only : fates_history_variable_type use FatesInterfaceMod, only : hlm_hio_ignore_val + use EDParamsMod, only : ED_val_comp_excln ! FIXME(bja, 2016-10) need to remove CLM dependancy use EDPftvarcon , only : EDPftvarcon_inst @@ -233,6 +234,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_npp_si_age integer, private :: ih_ncl_si_age integer, private :: ih_npatches_si_age + integer, private :: ih_zstar_si_age ! Indices to hydraulics variables @@ -1249,6 +1251,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & hio_ncl_si_age => this%hvars(ih_ncl_si_age)%r82d, & hio_npatches_si_age => this%hvars(ih_npatches_si_age)%r82d, & + hio_zstar_si_age => this%hvars(ih_zstar_si_age)%r82d, & hio_litter_moisture_si_fuel => this%hvars(ih_litter_moisture_si_fuel)%r82d, & hio_cwd_ag_si_cwdsc => this%hvars(ih_cwd_ag_si_cwdsc)%r82d, & hio_cwd_bg_si_cwdsc => this%hvars(ih_cwd_bg_si_cwdsc)%r82d, & @@ -1306,6 +1309,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ncl_si_age(io_si,cpatch%age_class) = hio_ncl_si_age(io_si,cpatch%age_class) & + cpatch%ncl_p * cpatch%area hio_npatches_si_age(io_si,cpatch%age_class) = hio_npatches_si_age(io_si,cpatch%age_class) + 1._r8 + if ( ED_val_comp_excln .lt. 0._r8 ) then ! only valid when "strict ppa" enabled + hio_zstar_si_age(io_si,cpatch%age_class) = hio_zstar_si_age(io_si,cpatch%age_class) & + + cpatch%zstar * cpatch%area + endif ccohort => cpatch%shortest do while(associated(ccohort)) @@ -2420,6 +2427,7 @@ subroutine define_history_vars(this, initialize_variables) logical, intent(in) :: initialize_variables ! are we 'count'ing or 'initializ'ing? integer :: ivar + character(len=10) :: tempstring ivar=0 @@ -2509,10 +2517,21 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_ncl_si_age ) call this%set_history_var(vname='NPATCH_BY_AGE', units='--', & - long='number of patches by age bin', use_default='active', & + long='number of patches by age bin', use_default='inactive', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_npatches_si_age ) + if ( ED_val_comp_excln .lt. 0._r8 ) then ! only valid when "strict ppa" enabled + tempstring = 'active' + else + tempstring = 'inactive' + endif + call this%set_history_var(vname='ZSTAR_BY_AGE', units='m', & + long='product of zstar and patch area by age bin (divide by PATCH_AREA_BY_AGE to get mean zstar)', & + use_default=trim(tempstring), & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_zstar_si_age ) + ! Fire Variables call this%set_history_var(vname='FIRE_NESTEROV_INDEX', units='none', & From c4ebadb6d68852abb3ea433738bb395eba5d062d Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 19 Jul 2017 09:05:03 -0700 Subject: [PATCH 02/23] unit fix on zstar metric --- main/FatesHistoryInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 947d70aa68..217cfe8928 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1311,7 +1311,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npatches_si_age(io_si,cpatch%age_class) = hio_npatches_si_age(io_si,cpatch%age_class) + 1._r8 if ( ED_val_comp_excln .lt. 0._r8 ) then ! only valid when "strict ppa" enabled hio_zstar_si_age(io_si,cpatch%age_class) = hio_zstar_si_age(io_si,cpatch%age_class) & - + cpatch%zstar * cpatch%area + + cpatch%zstar * cpatch%area * AREA_INV endif ccohort => cpatch%shortest From a2a52cb93f22dbd45c48f01cec2903d4ebf2c12f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 6 Jul 2017 15:11:27 -0700 Subject: [PATCH 03/23] Removed unused parameters: alpha_stem, leafwatermax, ED_name_dispersal. Changed fates_fnitr (parameter name in file) to fates_vcmax25top, and fates_crown to fates_crown_depth_frac, and fates_nfires to fates_nignitions. Shifted the pft read index to be based on index 1, no ground included. --- main/EDEcophysConType.F90 | 12 +++--------- main/EDParamsMod.F90 | 15 +++------------ main/EDPftvarcon.F90 | 28 +++++----------------------- main/EDTypesMod.F90 | 2 +- 4 files changed, 12 insertions(+), 45 deletions(-) diff --git a/main/EDEcophysConType.F90 b/main/EDEcophysConType.F90 index 974b7b9699..64d03a7eaf 100644 --- a/main/EDEcophysConType.F90 +++ b/main/EDEcophysConType.F90 @@ -38,18 +38,16 @@ module EDEcophysConType real(r8), pointer :: max_dbh (:) ! maximum dbh at which height growth ceases... real(r8), pointer :: freezetol (:) ! minimum temperature tolerance... real(r8), pointer :: wood_density (:) ! wood density g cm^-3 ... - real(r8), pointer :: alpha_stem (:) ! live stem turnover rate. y-1 real(r8), pointer :: hgt_min (:) ! sapling height m real(r8), pointer :: cushion (:) ! labile carbon storage target as multiple of leaf pool. real(r8), pointer :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. ! (1=lose leaves, 0=use store). - real(r8), pointer :: leafwatermax (:) ! amount of water allowed on leaf surfaces - real(r8), pointer :: rootresist (:) - real(r8), pointer :: soilbeta (:) + real(r8), pointer :: rootresist (:) ! SPA parameter (NOT USED) + real(r8), pointer :: soilbeta (:) ! SPA parameter (NOT USED) real(r8), pointer :: crown (:) ! fraction of the height of the plant that is occupied by crown. For fire model. real(r8), pointer :: bark_scaler (:) ! scaler from dbh to bark thickness. For fire model. real(r8), pointer :: crown_kill (:) ! scaler on fire death. For fire model. real(r8), pointer :: initd (:) ! initial seedling density - real(r8), pointer :: sd_mort (:) ! rate of death of seeds produced from reproduction. + real(r8), pointer :: sd_mort (:) ! rate of death of seeds produced from reproduction (NOT USED). real(r8), pointer :: seed_rain (:) ! seeds that come from outside the gridbox. real(r8), pointer :: BB_slope (:) ! ball berry slope parameter real(r8), pointer :: root_long (:) ! root longevity (yrs) @@ -142,11 +140,9 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) allocate( EDecophyscon%max_dbh (0:numpft)); EDecophyscon%max_dbh (:) = nan allocate( EDecophyscon%freezetol (0:numpft)); EDecophyscon%freezetol (:) = nan allocate( EDecophyscon%wood_density (0:numpft)); EDecophyscon%wood_density (:) = nan - allocate( EDecophyscon%alpha_stem (0:numpft)); EDecophyscon%alpha_stem (:) = nan allocate( EDecophyscon%hgt_min (0:numpft)); EDecophyscon%hgt_min (:) = nan allocate( EDecophyscon%cushion (0:numpft)); EDecophyscon%cushion (:) = nan allocate( EDecophyscon%leaf_stor_priority (0:numpft)); EDecophyscon%leaf_stor_priority (:) = nan - allocate( EDecophyscon%leafwatermax (0:numpft)); EDecophyscon%leafwatermax (:) = nan allocate( EDecophyscon%rootresist (0:numpft)); EDecophyscon%rootresist (:) = nan allocate( EDecophyscon%soilbeta (0:numpft)); EDecophyscon%soilbeta (:) = nan allocate( EDecophyscon%crown (0:numpft)); EDecophyscon%crown (:) = nan @@ -165,11 +161,9 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) EDecophyscon%max_dbh(m) = EDPftvarcon_inst%max_dbh(m) EDecophyscon%freezetol(m) = EDPftvarcon_inst%freezetol(m) EDecophyscon%wood_density(m) = EDPftvarcon_inst%wood_density(m) - EDecophyscon%alpha_stem(m) = EDPftvarcon_inst%alpha_stem(m) EDecophyscon%hgt_min(m) = EDPftvarcon_inst%hgt_min(m) EDecophyscon%cushion(m) = EDPftvarcon_inst%cushion(m) EDecophyscon%leaf_stor_priority(m) = EDPftvarcon_inst%leaf_stor_priority(m) - EDecophyscon%leafwatermax(m) = EDPftvarcon_inst%leafwatermax(m) EDecophyscon%rootresist(m) = EDPftvarcon_inst%rootresist(m) EDecophyscon%soilbeta(m) = EDPftvarcon_inst%soilbeta(m) EDecophyscon%crown(m) = EDPftvarcon_inst%crown(m) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index eb99476625..f3d5fbc920 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -18,9 +18,8 @@ module EDParamsMod real(r8),protected :: ED_val_grass_spread real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort - real(r8),protected :: ED_val_dispersal - real(r8),protected :: ED_val_maxspread - real(r8),protected :: ED_val_minspread + real(r8),protected :: ED_val_maxspread ! maximum ratio of dbh to canopy area (cm/m2) + real(r8),protected :: ED_val_minspread ! minimum ratio of dbh to canopy area (cm/m2) real(r8),protected :: ED_val_init_litter real(r8),protected :: ED_val_nignitions real(r8),protected :: ED_val_understorey_death @@ -45,11 +44,10 @@ module EDParamsMod character(len=param_string_length),parameter :: ED_name_grass_spread = "fates_grass_spread" character(len=param_string_length),parameter :: ED_name_comp_excln = "fates_comp_excln" character(len=param_string_length),parameter :: ED_name_stress_mort = "fates_stress_mort" - character(len=param_string_length),parameter :: ED_name_dispersal = "fates_dispersal" character(len=param_string_length),parameter :: ED_name_maxspread = "fates_maxspread" character(len=param_string_length),parameter :: ED_name_minspread = "fates_minspread" character(len=param_string_length),parameter :: ED_name_init_litter = "fates_init_litter" - character(len=param_string_length),parameter :: ED_name_nignitions = "fates_nfires" + character(len=param_string_length),parameter :: ED_name_nignitions = "fates_nignitions" character(len=param_string_length),parameter :: ED_name_understorey_death = "fates_understorey_death" character(len=param_string_length),parameter :: ED_name_ag_biomass= "fates_ag_biomass" character(len=param_string_length),parameter :: ED_name_cwd_fcel= "fates_cwd_fcel" @@ -89,7 +87,6 @@ subroutine FatesParamsInit() ED_val_grass_spread = nan ED_val_comp_excln = nan ED_val_stress_mort = nan - ED_val_dispersal = nan ED_val_maxspread = nan ED_val_minspread = nan ED_val_init_litter = nan @@ -146,9 +143,6 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_stress_mort, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_dispersal, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_maxspread, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) @@ -242,9 +236,6 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_stress_mort, & data=ED_val_stress_mort) - call fates_params%RetreiveParameter(name=ED_name_dispersal, & - data=ED_val_dispersal) - call fates_params%RetreiveParameter(name=ED_name_maxspread, & data=ED_val_maxspread) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 1a81ccf2f2..4812468e96 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -16,7 +16,7 @@ module EDPftvarcon save private - integer, parameter, public :: lower_bound_pft = 0 + integer, parameter, public :: lower_bound_pft = 1 integer, parameter, public :: lower_bound_general = 1 !ED specific variables. @@ -24,14 +24,12 @@ module EDPftvarcon real(r8), allocatable :: max_dbh (:) ! maximum dbh at which height growth ceases... real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance... real(r8), allocatable :: wood_density (:) ! wood density g cm^-3 ... - real(r8), allocatable :: alpha_stem (:) ! live stem turnover rate. y-1 real(r8), allocatable :: hgt_min (:) ! sapling height m real(r8), allocatable :: dleaf (:) ! leaf characteristic dimension length (m) real(r8), allocatable :: z0mr (:) ! ratio of roughness length of vegetation to height (-) real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-) real(r8), allocatable :: cushion (:) ! labile carbon storage target as multiple of leaf pool. real(r8), allocatable :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). - real(r8), allocatable :: leafwatermax (:) ! degree to which respiration is limited by btran if btran = 0 real(r8), allocatable :: rootresist (:) real(r8), allocatable :: soilbeta (:) real(r8), allocatable :: crown (:) @@ -198,10 +196,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_alpha_stem' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_hgt_min' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -214,10 +208,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_leafwatermax' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_rootresist' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -226,7 +216,7 @@ 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_crown' + name = 'fates_crown_depth_frac' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -342,7 +332,7 @@ 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_fnitr' + name = 'fates_vcmax25top' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -510,10 +500,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%wood_density) - name = 'fates_alpha_stem' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%alpha_stem) - name = 'fates_hgt_min' call fates_params%RetreiveParameterAllocate(name=name, & data=this%hgt_min) @@ -526,10 +512,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%leaf_stor_priority) - name = 'fates_leafwatermax' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%leafwatermax) - name = 'fates_rootresist' call fates_params%RetreiveParameterAllocate(name=name, & data=this%rootresist) @@ -538,7 +520,7 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%soilbeta) - name = 'fates_crown' + name = 'fates_crown_depth_frac' call fates_params%RetreiveParameterAllocate(name=name, & data=this%crown) @@ -654,7 +636,7 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%flnr) - name = 'fates_fnitr' + name = 'fates_vcmax25top' call fates_params%RetreiveParameterAllocate(name=name, & data=this%fnitr) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 349ffc3abb..966415fe2f 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -15,7 +15,7 @@ module EDTypesMod integer, parameter :: ican_upper = 1 ! Nominal index for the upper canopy 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 :: nlevleaf = 40 ! number of leaf layers in canopy layer integer, parameter :: maxpft = 10 ! maximum number of PFTs allowed ! the parameter file may determine that fewer ! are used, but this helps allocate scratch From 496766443e70167eefd52f78b3eec98f6a08125c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 7 Jul 2017 13:15:32 -0700 Subject: [PATCH 04/23] Added new variable to parameter file fates_do_inventory_init, with valid values 0 or 1 to optionally not-use or use an inventory intitialization on cold start. --- main/EDInitMod.F90 | 11 ++++++++--- main/EDParamsMod.F90 | 12 +++++++++++- 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 709c99c53b..3a8d2f1019 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -12,6 +12,7 @@ module EDInitMod use FatesGlobals , only : fates_log use FatesInterfaceMod , only : hlm_is_restart use EDPftvarcon , only : EDPftvarcon_inst + use EDParamsMod , only : ED_do_inventory_init use EDEcophysConType , only : EDecophyscon use EDGrowthFunctionsMod , only : bdead, bleaf, dbh use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -31,8 +32,6 @@ module EDInitMod logical :: DEBUG = .false. - integer, parameter :: do_inv_init = ifalse - character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -237,7 +236,13 @@ subroutine init_patches( nsites, sites, bc_in) ! Two primary options, either a Near Bear Ground (NBG) or Inventory based cold-start ! --------------------------------------------------------------------------------------------- - if (do_inv_init .eq. itrue) then + if ( int(ED_do_inventory_init) < 0 .or. int(ED_do_inventory_init) > 1 ) then + write(fates_log(), *) 'Flag to turn on or off inventory initialization is out of bounds' + write(fates_log(), *) 'ED_do_inv_init = ',ED_do_inventory_init + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if ( int(ED_do_inventory_init) .eq. itrue) then call initialize_sites_by_inventory(nsites,sites,bc_in) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index f3d5fbc920..71e6d346c8 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -15,6 +15,8 @@ module EDParamsMod ! this is what the user can use for the actual values ! + real(r8),protected :: ED_do_inventory_init ! flag to turn on or off inventory initialization + ! 0 is false, 1 is true real(r8),protected :: ED_val_grass_spread real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort @@ -40,7 +42,8 @@ module EDParamsMod real(r8),protected :: ED_val_phen_coldtemp real(r8),protected :: ED_val_cohort_fusion_tol real(r8),protected :: ED_val_patch_fusion_tol - + + character(len=param_string_length),parameter :: ED_name_do_inventory_init = "fates_do_inventory_init" character(len=param_string_length),parameter :: ED_name_grass_spread = "fates_grass_spread" character(len=param_string_length),parameter :: ED_name_comp_excln = "fates_comp_excln" character(len=param_string_length),parameter :: ED_name_stress_mort = "fates_stress_mort" @@ -84,6 +87,7 @@ subroutine FatesParamsInit() implicit none + ED_do_inventory_init = nan ED_val_grass_spread = nan ED_val_comp_excln = nan ED_val_stress_mort = nan @@ -128,6 +132,9 @@ subroutine FatesRegisterParams(fates_params) call FatesParamsInit() + call fates_params%RegisterParameter(name=ED_name_do_inventory_init, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) @@ -221,6 +228,9 @@ subroutine FatesReceiveParams(fates_params) class(fates_parameters_type), intent(inout) :: fates_params + call fates_params%RetreiveParameter(name=ED_name_do_inventory_init, & + data=ED_do_inventory_init) + call fates_params%RetreiveParameter(name=ED_name_grass_spread, & data=ED_val_grass_spread) From 92f4e5365b6f98016a43aebd2325b469efb9875c Mon Sep 17 00:00:00 2001 From: rgknox Date: Sun, 9 Jul 2017 16:30:56 -0700 Subject: [PATCH 05/23] Bug fixes to accomodate arbitrary sized parameter files. One bug fix required a very band-aid like fix, where we were calling leaf-longevity from pft 7. --- biogeochem/EDPhysiologyMod.F90 | 11 +++++++++-- main/EDEcophysConType.F90 | 10 +++++++++- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index b147372260..8adfac4e02 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -289,6 +289,11 @@ subroutine phenology( currentSite, bc_in ) integer :: gddstart ! beginning of counting period for growing degree days. real(r8) :: temp_in_C ! daily averaged temperature in celcius + real(r8), parameter :: canopy_leaf_lifespan = 365.0_r8 ! Mean lifespan canopy leaves + ! FIX(RGK 07/10/17) + ! This is a band-aid on unusual code + + ! Parameter of drought decid leaf loss in mm in top layer...FIX(RF,032414) ! - this is arbitrary and poorly understood. Needs work. ED_ @@ -470,8 +475,10 @@ subroutine phenology( currentSite, bc_in ) !LEAF OFF: DROUGHT DECIDUOUS LIFESPAN - if the leaf gets to the end of its useful life. A*, E* if (currentSite%dstatus == 2.and.t >= 10)then !D* - !Are the leaves at the end of their lives? !FIX(RF,0401014)- this is hardwiring.... - if (timesincedleafon > 365.0*EDPftvarcon_inst%leaf_long(7))then + !Are the leaves at the end of their lives? + !FIX(RF,0401014)- this is hardwiring.... + !FIX(RGK:changed from hard-coded pft 7 leaf lifespan to labeled constant (1 year) + if ( timesincedleafon > canopy_leaf_lifespan )then currentSite%dstatus = 1 !alter status of site to 'leaves on' currentSite%dleafoffdate = t !record leaf on date endif diff --git a/main/EDEcophysConType.F90 b/main/EDEcophysConType.F90 index 64d03a7eaf..4065b37d2a 100644 --- a/main/EDEcophysConType.F90 +++ b/main/EDEcophysConType.F90 @@ -135,8 +135,16 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) ! ! !LOCAL VARIABLES: integer :: m, ib, n, k + integer :: lb !------------------------------------------------------------------------ + + if( lbound(EDPftvarcon_inst%max_dbh,dim=1) .eq. 0) then + lb = 0 + else + lb = 1 + end if + allocate( EDecophyscon%max_dbh (0:numpft)); EDecophyscon%max_dbh (:) = nan allocate( EDecophyscon%freezetol (0:numpft)); EDecophyscon%freezetol (:) = nan allocate( EDecophyscon%wood_density (0:numpft)); EDecophyscon%wood_density (:) = nan @@ -157,7 +165,7 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) allocate( EDecophyscon%clone_alloc (0:numpft)); EDecophyscon%clone_alloc (:) = nan allocate( EDecophyscon%sapwood_ratio (0:numpft)); EDecophyscon%sapwood_ratio (:) = nan - do m = 0,numpft + do m = lb,numpft EDecophyscon%max_dbh(m) = EDPftvarcon_inst%max_dbh(m) EDecophyscon%freezetol(m) = EDPftvarcon_inst%freezetol(m) EDecophyscon%wood_density(m) = EDPftvarcon_inst%wood_density(m) From b5b160540e1756130a7fb747bf730482146c84aa Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 21 Jul 2017 11:58:25 -0700 Subject: [PATCH 06/23] Added trim_limit, trim_inc. Added some text to explain parameters. Removed instances of fnitr in the model code. --- biogeochem/EDPhysiologyMod.F90 | 14 +++----- biogeophys/FatesPlantRespPhotosynthMod.F90 | 9 ++--- main/EDPftvarcon.F90 | 39 +++++++++++++--------- main/FatesParameterDerivedMod.F90 | 19 ++++------- 4 files changed, 38 insertions(+), 43 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 8adfac4e02..915f59776c 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -165,15 +165,9 @@ subroutine trim_canopy( currentSite ) type (ed_cohort_type) , pointer :: currentCohort type (ed_patch_type) , pointer :: currentPatch - real(r8) :: inc ! rate at which canopy acclimates to uptake - real(r8) :: trim_limit ! this is the limit of the canopy trimming routine, so that trees - ! can't just lose all their leaves and have no reproductive costs. integer :: z ! leaf layer integer :: trimmed ! was this layer trimmed in this year? If not expand the canopy. - trim_limit = 0.3_r8 ! Arbitrary limit to reductions in leaf area with stress. Without this nothing ever dies. - inc = 0.03_r8 ! Arbitrary incremental change in trimming function. Controls - ! rate at which leaves are optimised to their environment. !---------------------------------------------------------------------- currentPatch => currentSite%youngest_patch @@ -210,7 +204,7 @@ subroutine trim_canopy( currentSite ) currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then - if (currentCohort%canopy_trim > trim_limit)then + if (currentCohort%canopy_trim > EDPftvarcon_inst%trim_limit(currentCohort%pft))then if ( DEBUG ) then write(fates_log(),*) 'trimming leaves',currentCohort%canopy_trim,currentCohort%leaf_cost @@ -218,9 +212,9 @@ subroutine trim_canopy( currentSite ) ! keep trimming until none of the canopy is in negative carbon balance. if (currentCohort%hite > EDecophyscon%hgt_min(currentCohort%pft))then - currentCohort%canopy_trim = currentCohort%canopy_trim - inc + 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 - inc) + currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - EDPftvarcon_inst%trim_inc(currentCohort%pft)) endif trimmed = 1 endif @@ -236,7 +230,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 + inc + currentCohort%canopy_trim = currentCohort%canopy_trim + EDPftvarcon_inst%trim_inc(currentCohort%pft) endif if ( DEBUG ) then diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 06ae3d4f02..479198256d 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -196,11 +196,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) associate( & c3psn => EDPftvarcon_inst%c3psn , & slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, - ! projected area basis [m^2/gC] - flnr => EDPftvarcon_inst%flnr , & ! fraction of leaf N in the Rubisco - ! enzyme (gN Rubisco / gN leaf) + ! projected area basis [m^2/gC] woody => EDPftvarcon_inst%woody , & ! Is vegetation woody or not? - fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-) leafcn => EDPftvarcon_inst%leafcn , & ! leaf C:N (gC/gN) frootcn => EDPftvarcon_inst%frootcn, & ! froot C:N (gc/gN) ! slope of BB relationship q10 => FatesSynchronizedParamsInst%Q10 ) @@ -285,7 +282,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) if (bc_in(s)%dayl_factor_pa(ifp) == 0._r8) then kn(ft) = 0._r8 else - kn(ft) = exp(0.00963_r8 * param_derived%vcmax25top(ft) - 2.43_r8) + kn(ft) = exp(0.00963_r8 * EDPftvarcon_inst%vcmax25top(ft) - 2.43_r8) end if end do !ft @@ -394,7 +391,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) call LeafLayerBiophysicalRates(currentPatch%ed_parsun_z(cl,ft,iv), & ! in ft, & ! in - param_derived%vcmax25top(ft), & ! in + EDPftvarcon_inst%vcmax25top(ft), & ! in param_derived%jmax25top(ft), & ! in param_derived%tpu25top(ft), & ! in param_derived%kp25top(ft), & ! in diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 4812468e96..1de5a86558 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -22,7 +22,7 @@ module EDPftvarcon !ED specific variables. type, public :: EDPftvarcon_type real(r8), allocatable :: max_dbh (:) ! maximum dbh at which height growth ceases... - real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance... + real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance (NOT CURRENTY USED) real(r8), allocatable :: wood_density (:) ! wood density g cm^-3 ... real(r8), allocatable :: hgt_min (:) ! sapling height m real(r8), allocatable :: dleaf (:) ! leaf characteristic dimension length (m) @@ -30,13 +30,13 @@ module EDPftvarcon real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-) real(r8), allocatable :: cushion (:) ! labile carbon storage target as multiple of leaf pool. real(r8), allocatable :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). - real(r8), allocatable :: rootresist (:) - real(r8), allocatable :: soilbeta (:) + real(r8), allocatable :: rootresist (:) ! root resistance used in SPA (NOT CURRENTLY USED) + real(r8), allocatable :: soilbeta (:) ! parameter used in SPA (NOT CURRENTLY USED) real(r8), allocatable :: crown (:) real(r8), allocatable :: bark_scaler (:) real(r8), allocatable :: crown_kill (:) real(r8), allocatable :: initd (:) - real(r8), allocatable :: sd_mort (:) + real(r8), allocatable :: sd_mort (:) ! rate of death of seeds (NOT CURRENTLY USED) real(r8), allocatable :: seed_rain (:) real(r8), allocatable :: BB_slope (:) real(r8), allocatable :: root_long (:) ! root longevity (yrs) @@ -60,8 +60,7 @@ module EDPftvarcon real(r8), allocatable :: fr_flig(:) real(r8), allocatable :: xl(:) real(r8), allocatable :: c3psn(:) - real(r8), allocatable :: flnr(:) - real(r8), allocatable :: fnitr(:) + real(r8), allocatable :: vcmax25top(:) real(r8), allocatable :: leafcn(:) real(r8), allocatable :: frootcn(:) real(r8), allocatable :: smpso(:) @@ -92,6 +91,8 @@ module EDPftvarcon real(r8), allocatable :: tpuse(:) real(r8), allocatable :: germination_timescale(:) real(r8), allocatable :: seed_decay_turnover(:) + real(r8), allocatable :: trim_limit(:) ! Limit to reductions in leaf area w stress (m2/m2) + real(r8), allocatable :: trim_inc(:) ! Incremental change in trimming function (m2/m2) real(r8), allocatable :: rhol(:, :) real(r8), allocatable :: rhos(:, :) real(r8), allocatable :: taul(:, :) @@ -328,10 +329,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_flnr' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_vcmax25top' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -456,6 +453,14 @@ 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_trim_limit' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_trim_inc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_dleaf' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -632,13 +637,9 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%c3psn) - name = 'fates_flnr' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%flnr) - name = 'fates_vcmax25top' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%fnitr) + data=this%vcmax25top) name = 'fates_leafcn' call fates_params%RetreiveParameterAllocate(name=name, & @@ -760,6 +761,14 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_decay_turnover) + name = 'fates_trim_limit' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%trim_limit) + + name = 'fates_trim_inc' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%trim_inc) + name = 'fates_dleaf' call fates_params%RetreiveParameterAllocate(name=name, & data=this%dleaf) diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index c72e70d79f..cfdab6bbcd 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -64,10 +64,10 @@ subroutine Init(this,maxpft) associate( & - slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, - ! projected area basis [m^2/gC] - fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-) - leafcn => EDPftvarcon_inst%leafcn ) ! leaf C:N (gC/gN) + vcmax25top => EDPftvarcon_inst%vcmax25top, & ! + slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, + ! projected area basis [m^2/gC] + leafcn => EDPftvarcon_inst%leafcn ) ! leaf C:N (gC/gN) call this%InitAllocate(maxpft) @@ -76,11 +76,6 @@ subroutine Init(this,maxpft) ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) lnc = 1._r8 / (slatop(ft) * leafcn(ft)) - ! at the moment in ED we assume that there is no active N cycle. - ! This should change, of course. FIX(RF,032414) Sep2011. - ! fudge - shortcut using fnitr as a proxy for vcmax... - this%vcmax25top(ft) = fnitr(ft) - ! Parameters derived from vcmax25top. ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 ! used jmax25 = 1.97 vcmax25, from Wullschleger (1993) Journal of @@ -92,9 +87,9 @@ subroutine Init(this,maxpft) ! jmax25top(ft) = & ! (2.59_r8 - 0.035_r8*min(max((t10(p)-tfrzc),11._r8),35._r8)) * vcmax25top(ft) - this%jmax25top(ft) = 1.67_r8 * this%vcmax25top(ft) - this%tpu25top(ft) = 0.167_r8 * this%vcmax25top(ft) - this%kp25top(ft) = 20000._r8 * this%vcmax25top(ft) + this%jmax25top(ft) = 1.67_r8 * vcmax25top(ft) + this%tpu25top(ft) = 0.167_r8 * vcmax25top(ft) + this%kp25top(ft) = 20000._r8 * vcmax25top(ft) ! Leaf maintenance respiration to match the base rate used in CN ! but with the new temperature functions for C3 and C4 plants. From 67c2430dff734fb82027f82bf253834568219859 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 21 Jul 2017 13:21:10 -0700 Subject: [PATCH 07/23] Added size diagnostic scale switch to the parameter file. --- main/EDParamsMod.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 71e6d346c8..9407d00a84 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -17,6 +17,8 @@ module EDParamsMod real(r8),protected :: ED_do_inventory_init ! flag to turn on or off inventory initialization ! 0 is false, 1 is true + real(r8),protected :: ED_size_diagnostic_scale ! Flag to switch between a linear and exponential + ! scale on the plant size axis in diagnostics (NOT USED YET) real(r8),protected :: ED_val_grass_spread real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort @@ -44,6 +46,7 @@ module EDParamsMod real(r8),protected :: ED_val_patch_fusion_tol character(len=param_string_length),parameter :: ED_name_do_inventory_init = "fates_do_inventory_init" + character(len=param_string_length),parameter :: ED_name_size_diagnostic_scale = "fates_size_diagnostic_scale" character(len=param_string_length),parameter :: ED_name_grass_spread = "fates_grass_spread" character(len=param_string_length),parameter :: ED_name_comp_excln = "fates_comp_excln" character(len=param_string_length),parameter :: ED_name_stress_mort = "fates_stress_mort" @@ -88,6 +91,7 @@ subroutine FatesParamsInit() implicit none ED_do_inventory_init = nan + ED_size_diagnostic_scale = nan ED_val_grass_spread = nan ED_val_comp_excln = nan ED_val_stress_mort = nan @@ -134,6 +138,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_do_inventory_init, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_size_diagnostic_scale, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) @@ -231,6 +238,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_do_inventory_init, & data=ED_do_inventory_init) + call fates_params%RetreiveParameter(name=ED_name_size_diagnostic_scale, & + data=ED_size_diagnostic_scale) + call fates_params%RetreiveParameter(name=ED_name_grass_spread, & data=ED_val_grass_spread) From a674222b59928aa6a8f95b20eba54e8dfbc05673 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 21 Jul 2017 13:51:14 -0700 Subject: [PATCH 08/23] Added fates_mort_disturb_frac to parameter reads. --- main/EDParamsMod.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 9407d00a84..fe72905323 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -19,6 +19,7 @@ module EDParamsMod ! 0 is false, 1 is true real(r8),protected :: ED_size_diagnostic_scale ! Flag to switch between a linear and exponential ! scale on the plant size axis in diagnostics (NOT USED YET) + real(r8),protected :: ED_mort_disturb_frac ! the fraction of canopy mortality that results in disturbance real(r8),protected :: ED_val_grass_spread real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort @@ -47,6 +48,7 @@ module EDParamsMod character(len=param_string_length),parameter :: ED_name_do_inventory_init = "fates_do_inventory_init" character(len=param_string_length),parameter :: ED_name_size_diagnostic_scale = "fates_size_diagnostic_scale" + character(len=param_string_length),parameter :: ED_name_mort_disturb_frac = "fates_mort_disturb_frac" character(len=param_string_length),parameter :: ED_name_grass_spread = "fates_grass_spread" character(len=param_string_length),parameter :: ED_name_comp_excln = "fates_comp_excln" character(len=param_string_length),parameter :: ED_name_stress_mort = "fates_stress_mort" @@ -92,6 +94,7 @@ subroutine FatesParamsInit() ED_do_inventory_init = nan ED_size_diagnostic_scale = nan + ED_mort_disturb_frac = nan ED_val_grass_spread = nan ED_val_comp_excln = nan ED_val_stress_mort = nan @@ -142,6 +145,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_size_diagnostic_scale, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_mort_disturb_frac, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) @@ -241,6 +247,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_size_diagnostic_scale, & data=ED_size_diagnostic_scale) + call fates_params%RetreiveParameter(name=ED_name_mort_disturb_frac, & + data=ED_mort_disturb_frac) + call fates_params%RetreiveParameter(name=ED_name_grass_spread, & data=ED_val_grass_spread) From 1b063a5c1967279a053acb65a30572b364e7fa72 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 25 Jul 2017 18:37:17 -0700 Subject: [PATCH 09/23] Overhaul of allometry parameters. Changed naming convention, added parameters. --- biogeochem/EDCanopyStructureMod.F90 | 22 +-- biogeochem/EDCohortDynamicsMod.F90 | 27 ++-- biogeochem/EDGrowthFunctionsMod.F90 | 76 ++++----- biogeochem/EDPatchDynamicsMod.F90 | 23 +-- biogeochem/EDPhysiologyMod.F90 | 48 +++--- biogeophys/FatesPlantRespPhotosynthMod.F90 | 11 +- fire/SFMainMod.F90 | 5 +- main/EDEcophysConType.F90 | 5 - main/EDInitMod.F90 | 4 +- main/EDParamsMod.F90 | 5 - main/EDPftvarcon.F90 | 170 ++++++++++++++------- main/FatesHistoryInterfaceMod.F90 | 14 +- main/FatesInventoryInitMod.F90 | 5 +- 13 files changed, 240 insertions(+), 175 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 4b8cbd953c..f9bbfb29dc 100755 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -81,7 +81,7 @@ subroutine canopy_structure( currentSite , bc_in ) ! ! !USES: - use EDParamsMod, only : ED_val_comp_excln, ED_val_ag_biomass + use EDParamsMod, only : ED_val_comp_excln use SFParamsMod, only : SF_val_cwd_frac use EDtypesMod , only : ncwd, min_patch_area use FatesInterfaceMod, only : bc_in_type @@ -225,11 +225,11 @@ subroutine canopy_structure( currentSite , bc_in ) do c=1,ncwd currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + (currentCohort%bdead+currentCohort%bsw) * & - ED_val_ag_biomass * & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + (currentCohort%bdead+currentCohort%bsw) * & - (1.0_r8-ED_val_ag_biomass) * & + (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area !litter flux per m2. enddo @@ -247,11 +247,13 @@ subroutine canopy_structure( currentSite , bc_in ) currentSite%CWD_AG_diagnostic_input_carbonflux(c) = & currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA + SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) & + * hlm_days_per_year / AREA currentSite%CWD_BG_diagnostic_input_carbonflux(c) = & currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA + SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) & + * hlm_days_per_year / AREA enddo currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & @@ -296,10 +298,10 @@ subroutine canopy_structure( currentSite , bc_in ) do c=1,ncwd currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + (currentCohort%bdead+currentCohort%bsw) * & - ED_val_ag_biomass * & + EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + (currentCohort%bdead+currentCohort%bsw) * & - (1.0_r8-ED_val_ag_biomass) * & + (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * & SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area !litter flux per m2. enddo @@ -317,11 +319,13 @@ subroutine canopy_structure( currentSite , bc_in ) currentSite%CWD_AG_diagnostic_input_carbonflux(c) = & currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA + SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) & + * hlm_days_per_year / AREA currentSite%CWD_BG_diagnostic_input_carbonflux(c) = & currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA + SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) & + * hlm_days_per_year / AREA enddo currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 46f297da68..44a55e28cd 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -216,7 +216,7 @@ subroutine allocate_live_biomass(cc_p,mode) currentCohort => cc_p ft = currentcohort%pft - leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + EDPftvarcon_inst%froot_leaf(ft)) + leaf_frac = 1.0_r8/(1.0_r8 + EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite + EDPftvarcon_inst%allom_l2fr(ft)) !currentcohort%bl = currentcohort%balive*leaf_frac !for deciduous trees, there are no leaves @@ -228,8 +228,8 @@ subroutine allocate_live_biomass(cc_p,mode) ! iagnore the root and stem biomass from the functional balance hypothesis. This is used when the leaves are !fully on. - !currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac - !currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & + !currentcohort%br = EDPftvarcon_inst%allom_l2fr(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + !currentcohort%bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite *(currentcohort%balive + & ! currentcohort%laimemory)*leaf_frac leaves_off_switch = 0 @@ -245,9 +245,9 @@ subroutine allocate_live_biomass(cc_p,mode) new_bl = currentcohort%balive*leaf_frac - new_br = EDpftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + new_br = EDpftvarcon_inst%allom_l2fr(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac - new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & + new_bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite *(currentcohort%balive + & currentcohort%laimemory)*leaf_frac !diagnose the root and stem biomass from the functional balance hypothesis. This is used when the leaves are @@ -279,13 +279,13 @@ subroutine allocate_live_biomass(cc_p,mode) !not have enough live biomass to support the hypothesized root mass !thus, we use 'ratio_balive' to adjust br and bsw. Apologies that this is so complicated! RF - ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%froot_leaf(ft) + & - currentcohort%laimemory* EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%allom_l2fr(ft) + & + currentcohort%laimemory* EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite ratio_balive = currentcohort%balive / ideal_balive - new_br = EDpftvarcon_inst%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * & + new_br = EDpftvarcon_inst%allom_l2fr(ft) * (ideal_balive + currentcohort%laimemory) * & leaf_frac * ratio_balive - new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite * & + new_bsw = EDpftvarcon_inst%allom_latosa_int(ft) * currentcohort%hite * & (ideal_balive + currentcohort%laimemory) * leaf_frac * ratio_balive ! Diagnostics @@ -505,7 +505,6 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) ! terminates cohorts when they get too small ! ! !USES: - use EDParamsMod, only : ED_val_ag_biomass use SFParamsMod, only : SF_val_CWD_frac ! ! !ARGUMENTS @@ -618,10 +617,10 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) / & currentPatch%area & - * SF_val_CWD_frac(c) * ED_val_ag_biomass + * SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) / & currentPatch%area & - * SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) + * SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) enddo currentPatch%leaf_litter(currentCohort%pft) = currentPatch%leaf_litter(currentCohort%pft) + currentCohort%n* & @@ -633,10 +632,10 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) do c=1,ncwd currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA + SF_val_CWD_frac(c) * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * hlm_days_per_year / AREA currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA + SF_val_CWD_frac(c) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * hlm_days_per_year / AREA enddo currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index e0abb08626..635946e068 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -44,11 +44,11 @@ real(r8) function Dbh( cohort_in ) type(ed_cohort_type), intent(in) :: cohort_in !FIX(SPM,040214) - move to param file - real(r8) :: m !parameter of allometric equation (needs to not be hardwired... - real(r8) :: c !parameter of allometric equation (needs to not be hardwired... + real(r8) :: m ! parameter of allometric equation + real(r8) :: c ! parameter of allometric equation - m = EDPftvarcon_inst%dbh2h_m(cohort_in%pft) - c = EDPftvarcon_inst%dbh2h_c(cohort_in%pft) + m = EDPftvarcon_inst%allom_d2h1(cohort_in%pft) + c = EDPftvarcon_inst%allom_d2h2(cohort_in%pft) dbh = (10.0_r8**((log10(cohort_in%hite) - c)/m)) @@ -71,8 +71,8 @@ real(r8) function Hite( cohort_in ) real(r8) :: c real(r8) :: h - m = EDPftvarcon_inst%dbh2h_m(cohort_in%pft) - c = EDPftvarcon_inst%dbh2h_c(cohort_in%pft) + m = EDPftvarcon_inst%allom_d2h1(cohort_in%pft) + c = EDPftvarcon_inst%allom_d2h2(cohort_in%pft) if(cohort_in%dbh <= 0._r8)then write(fates_log(),*) 'ED: dbh less than zero problem!' @@ -107,10 +107,11 @@ real(r8) function Bleaf( cohort_in ) real(r8) :: dbh2bl_b real(r8) :: dbh2bl_c real(r8) :: slascaler ! changes the target biomass according to the SLA - - dbh2bl_a = EDPftvarcon_inst%dbh2bl_a(cohort_in%pft) - dbh2bl_b = EDPftvarcon_inst%dbh2bl_b(cohort_in%pft) - dbh2bl_c = EDPftvarcon_inst%dbh2bl_c(cohort_in%pft) + + dbh2bl_a = EDPftvarcon_inst%allom_d2bl1(cohort_in%pft) + dbh2bl_b = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft) + dbh2bl_c = EDPftvarcon_inst%allom_d2bl3(cohort_in%pft) + slascaler = EDPftvarcon_inst%dbh2bl_slascaler(cohort_in%pft)/EDPftvarcon_inst%slatop(cohort_in%pft) if(cohort_in%dbh < 0._r8.or.cohort_in%pft == 0.or.cohort_in%dbh > 1000.0_r8)then @@ -234,10 +235,10 @@ real(r8) function c_area( cohort_in ) integer :: can_layer_index ! default is to use the same exponent as the dbh to bleaf exponent so that per-plant canopy depth remains invariant during growth, - ! but allowed to vary via the dbh2bl_dbh2carea_expnt_diff term (which has default value of zero) - crown_area_to_dbh_exponent = EDPftvarcon_inst%dbh2bl_b(cohort_in%pft) + & - EDPftvarcon_inst%dbh2bl_dbh2carea_expnt_diff(cohort_in%pft) - + ! but allowed to vary via the allom_blca_expnt_diff term (which has default value of zero) + crown_area_to_dbh_exponent = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft) + & + EDPftvarcon_inst%allom_blca_expnt_diff(cohort_in%pft) + if (DEBUG_growth) then write(fates_log(),*) 'z_area 1',cohort_in%dbh,cohort_in%pft write(fates_log(),*) 'z_area 2',EDPftvarcon_inst%max_dbh @@ -247,7 +248,7 @@ real(r8) function c_area( cohort_in ) write(fates_log(),*) 'z_area 6',cohort_in%canopy_layer write(fates_log(),*) 'z_area 7',ED_val_grass_spread end if - + dbh = min(cohort_in%dbh,EDPftvarcon_inst%max_dbh(cohort_in%pft)) ! ---------------------------------------------------------------------------------- @@ -278,7 +279,12 @@ real(r8) function Bdead( cohort_in ) ! ============================================================================ ! Calculate stem biomass from height(m) dbh(cm) and wood density(g/cm3) ! default params using allometry of J.G. Saldarriaga et al 1988 - Rio Negro - ! Journal of Ecology vol 76 p938-958 + ! Journal of Ecology vol 76 p938-958 + ! + ! NOTE (RGK 07-2017) Various other biomass allometries calculate above ground + ! biomass, and it appear Saldariagga may be an outlier that calculates total + ! biomass (these parameters will have to be a placeholder for both) + ! ! ============================================================================ type(ed_cohort_type), intent(in) :: cohort_in @@ -288,10 +294,10 @@ real(r8) function Bdead( cohort_in ) real(r8) :: dbh2bd_c real(r8) :: dbh2bd_d - dbh2bd_a = EDPftvarcon_inst%dbh2bd_a(cohort_in%pft) - dbh2bd_b = EDPftvarcon_inst%dbh2bd_b(cohort_in%pft) - dbh2bd_c = EDPftvarcon_inst%dbh2bd_c(cohort_in%pft) - dbh2bd_d = EDPftvarcon_inst%dbh2bd_d(cohort_in%pft) + dbh2bd_a = EDPftvarcon_inst%allom_agb1(cohort_in%pft) + dbh2bd_b = EDPftvarcon_inst%allom_agb2(cohort_in%pft) + dbh2bd_c = EDPftvarcon_inst%allom_agb3(cohort_in%pft) + dbh2bd_d = EDPftvarcon_inst%allom_agb4(cohort_in%pft) bdead = dbh2bd_a*(cohort_in%hite**dbh2bd_b)*(cohort_in%dbh**dbh2bd_c)* & (EDPftvarcon_inst%wood_density(cohort_in%pft)** dbh2bd_d) @@ -315,10 +321,10 @@ real(r8) function dHdBd( cohort_in ) real(r8) :: dbh2bd_c real(r8) :: dbh2bd_d - dbh2bd_a = EDPftvarcon_inst%dbh2bd_a(cohort_in%pft) - dbh2bd_b = EDPftvarcon_inst%dbh2bd_b(cohort_in%pft) - dbh2bd_c = EDPftvarcon_inst%dbh2bd_c(cohort_in%pft) - dbh2bd_d = EDPftvarcon_inst%dbh2bd_d(cohort_in%pft) + dbh2bd_a = EDPftvarcon_inst%allom_agb1(cohort_in%pft) + dbh2bd_b = EDPftvarcon_inst%allom_agb2(cohort_in%pft) + dbh2bd_c = EDPftvarcon_inst%allom_agb3(cohort_in%pft) + dbh2bd_d = EDPftvarcon_inst%allom_agb4(cohort_in%pft) dbddh = dbh2bd_a*dbh2bd_b*(cohort_in%hite**(dbh2bd_b-1.0_r8))*(cohort_in%dbh**dbh2bd_c)* & (EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bd_d) @@ -347,14 +353,14 @@ real(r8) function dDbhdBd( cohort_in ) real(r8) :: dbh2bd_b real(r8) :: dbh2bd_c real(r8) :: dbh2bd_d + + m = EDPftvarcon_inst%allom_d2h1(cohort_in%pft) + c = EDPftvarcon_inst%allom_d2h2(cohort_in%pft) - m = EDPftvarcon_inst%dbh2h_m(cohort_in%pft) - c = EDPftvarcon_inst%dbh2h_c(cohort_in%pft) - - dbh2bd_a = EDPftvarcon_inst%dbh2bd_a(cohort_in%pft) - dbh2bd_b = EDPftvarcon_inst%dbh2bd_b(cohort_in%pft) - dbh2bd_c = EDPftvarcon_inst%dbh2bd_c(cohort_in%pft) - dbh2bd_d = EDPftvarcon_inst%dbh2bd_d(cohort_in%pft) + dbh2bd_a = EDPftvarcon_inst%allom_agb1(cohort_in%pft) + dbh2bd_b = EDPftvarcon_inst%allom_agb1(cohort_in%pft) + dbh2bd_c = EDPftvarcon_inst%allom_agb1(cohort_in%pft) + dbh2bd_d = EDPftvarcon_inst%allom_agb1(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) @@ -387,9 +393,11 @@ real(r8) function dDbhdBl( cohort_in ) real(r8) :: dbh2bl_b real(r8) :: dbh2bl_c - dbh2bl_a = EDPftvarcon_inst%dbh2bl_a(cohort_in%pft) - dbh2bl_b = EDPftvarcon_inst%dbh2bl_b(cohort_in%pft) - dbh2bl_c = EDPftvarcon_inst%dbh2bl_c(cohort_in%pft) + dbh2bl_a = EDPftvarcon_inst%allom_d2bl1(cohort_in%pft) + dbh2bl_b = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft) + dbh2bl_c = EDPftvarcon_inst%allom_d2bl3(cohort_in%pft) + + dblddbh = dbh2bl_b*dbh2bl_a*(cohort_in%dbh**dbh2bl_b)*(EDPftvarcon_inst%wood_density(cohort_in%pft)**dbh2bl_c) dblddbh = dblddbh*cohort_in%canopy_trim diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 501ffba6cd..042c2975ac 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -549,7 +549,6 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si ! Burn live grasses and kill them. ! ! !USES: - use EDParamsMod, only : ED_val_ag_biomass use SFParamsMod, only : SF_VAL_CWD_FRAC use EDGrowthFunctionsMod, only : c_area use EDtypesMod , only : dl_sf @@ -610,9 +609,9 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si ! Divide their litter into the four litter streams, and spread evenly across ground surface. !************************************/ ! stem biomass per tree - bstem = (currentCohort%bsw + currentCohort%bdead) * ED_val_ag_biomass + bstem = (currentCohort%bsw + currentCohort%bdead) * EDPftvarcon_inst%allom_agb_frac(p) ! coarse root biomass per tree - bcroot = (currentCohort%bsw + currentCohort%bdead) * (1.0_r8 - ED_val_ag_biomass) + bcroot = (currentCohort%bsw + currentCohort%bdead) * (1.0_r8 - EDPftvarcon_inst%allom_agb_frac(p) ) ! density of dead trees per m2. dead_tree_density = (currentCohort%fire_mort * currentCohort%n*patch_site_areadis/currentPatch%area) / AREA @@ -743,7 +742,7 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat ! Carbon going from ongoing mortality into CWD pools. ! ! !USES: - use EDParamsMod, only : ED_val_ag_biomass, ED_val_understorey_death + use EDParamsMod, only : ED_val_understorey_death use SFParamsMod, only : SF_val_cwd_frac ! ! !ARGUMENTS: @@ -765,6 +764,7 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/day real(r8) :: canopy_mortality_leaf_litter(numpft_ed) ! flux in to leaf litter from tree death: KgC/m2/day real(r8) :: canopy_mortality_root_litter(numpft_ed) ! 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 @@ -828,20 +828,23 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat ! (currentPatch%area-patch_site_areadis) +patch_site_areadis... ! 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_ed))/dble(numpft_ed) + 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) + ED_val_ag_biomass * cwd_litter_density * np_mult - currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + ED_val_ag_biomass * cwd_litter_density - new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + (1._r8-ED_val_ag_biomass) * cwd_litter_density * np_mult - currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + (1._r8-ED_val_ag_biomass) * cwd_litter_density + 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 * ED_val_ag_biomass/ AREA + 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 - ED_val_ag_biomass) / AREA + 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_ed diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 915f59776c..24b37794b3 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -12,8 +12,8 @@ module EDPhysiologyMod use FatesInterfaceMod, only : hlm_freq_day use FatesInterfaceMod, only : hlm_day_of_year use FatesConstantsMod, only : r8 => fates_r8 - use EDEcophysContype , only : EDecophyscon - use EDPftvarcon , only : EDPftvarcon_inst + use EDEcophysContype , only : EDecophyscon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use FatesInterfaceMod, only : bc_in_type use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort @@ -193,14 +193,14 @@ subroutine trim_canopy( currentSite ) currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) currentCohort%leaf_cost = currentCohort%leaf_cost + & 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & - EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + EDPftvarcon_inst%allom_l2fr(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 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 = currentCohort%leaf_cost + & 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & - EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + EDPftvarcon_inst%allom_l2fr(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then @@ -804,12 +804,12 @@ 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%froot_leaf(currentCohort%pft) + & - EDecophyscon%sapwood_ratio(currentCohort%pft)*h) + target_balive = Bleaf(currentCohort) * (1.0_r8 + EDPftvarcon_inst%allom_l2fr(currentCohort%pft) + & + EDpftvarcon_inst%allom_latosa_int(currentCohort%pft)*h) !target balive without leaves. if (currentCohort%status_coh == 1)then - target_balive = Bleaf(currentCohort) * (EDPftvarcon_inst%froot_leaf(currentCohort%pft) + & - EDecophyscon%sapwood_ratio(currentCohort%pft) * h) + target_balive = Bleaf(currentCohort) * (EDPftvarcon_inst%allom_l2fr(currentCohort%pft) + & + EDpftvarcon_inst%allom_latosa_int(currentCohort%pft) * h) endif ! NPP @@ -945,9 +945,9 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! fraction of carbon going into active vs structural carbon if (currentCohort%dbh <= EDecophyscon%max_dbh(currentCohort%pft))then ! cap on leaf biomass dbldbd = dDbhdBd(currentCohort)/dDbhdBl(currentCohort) - dbrdbd = EDPftvarcon_inst%froot_leaf(currentCohort%pft) * dbldbd + dbrdbd = EDPftvarcon_inst%allom_l2fr(currentCohort%pft) * dbldbd dhdbd_fn = dhdbd(currentCohort) - dbswdbd = EDecophyscon%sapwood_ratio(currentCohort%pft) * (h*dbldbd + currentCohort%bl*dhdbd_fn) + dbswdbd = EDpftvarcon_inst%allom_latosa_int(currentCohort%pft) * (h*dbldbd + currentCohort%bl*dhdbd_fn) u = 1.0_r8 / (dbldbd + dbrdbd + dbswdbd) va = 1.0_r8 / (1.0_r8 + u) vs = u / (1.0_r8 + u) @@ -1044,10 +1044,10 @@ subroutine recruitment( t, currentSite, currentPatch, bc_in ) temp_cohort%hite = EDecophyscon%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%froot_leaf(ft) & - + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite) - temp_cohort%bstore = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) & - + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite)) + 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 = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & + + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite)) temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) @@ -1060,12 +1060,12 @@ subroutine recruitment( t, 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%froot_leaf(ft) + & - EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite))*temp_cohort%balive + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive endif if (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) + & - EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite))*temp_cohort%balive + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) + & + EDpftvarcon_inst%allom_latosa_int(ft)*temp_cohort%hite))*temp_cohort%balive endif cohortstatus = currentSite%status @@ -1099,7 +1099,6 @@ subroutine CWD_Input( currentPatch) ! ! !USES: use SFParamsMod , only : SF_val_CWD_frac - use EDParamsMod , only : ED_val_ag_biomass ! ! !ARGUMENTS @@ -1136,9 +1135,9 @@ subroutine CWD_Input( currentPatch) 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 *ED_val_ag_biomass + 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-ED_val_ag_biomass) + 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 @@ -1155,9 +1154,9 @@ subroutine CWD_Input( currentPatch) do c = 1,ncwd currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + (currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * dead_n * ED_val_ag_biomass + SF_val_CWD_frac(c) * dead_n * EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + (currentCohort%bdead+currentCohort%bsw) * & - SF_val_CWD_frac(c) * dead_n * (1.0_r8-ED_val_ag_biomass) + SF_val_CWD_frac(c) * dead_n * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) if (currentPatch%cwd_AG_in(c) < 0.0_r8)then write(fates_log(),*) 'negative CWD in flux',currentPatch%cwd_AG_in(c), & @@ -1337,7 +1336,6 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) use FatesInterfaceMod, only : hlm_numlevdecomp use EDPftvarcon, only : EDPftvarcon_inst use FatesConstantsMod, only : sec_per_day - use EDParamsMod, only : ED_val_ag_biomass use FatesInterfaceMod, only : bc_in_type, bc_out_type use FatesInterfaceMod, only : hlm_use_vertsoilc use FatesConstantsMod, only : itrue @@ -1589,7 +1587,7 @@ 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-ED_val_ag_biomass) + currentCohort%b * (currentCohort%n / currentPatch%area) * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) currentCohort => currentCohort%shorter enddo !currentCohort ! diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 479198256d..32bb9f76ac 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -63,7 +63,6 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use EDPftvarcon , only : EDPftvarcon_inst - use EDParamsMod , only : ED_val_ag_biomass use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type @@ -493,11 +492,11 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! ------------------------------------------------------------------ leaf_frac = 1.0_r8/(currentCohort%canopy_trim + & - EDPftvarcon_inst%sapwood_ratio(currentCohort%pft) * & - currentCohort%hite + EDPftvarcon_inst%froot_leaf(currentCohort%pft)) + EDPftvarcon_inst%allom_latosa_int(currentCohort%pft) * & + currentCohort%hite + EDPftvarcon_inst%allom_l2fr(currentCohort%pft)) - currentCohort%bsw = EDPftvarcon_inst%sapwood_ratio(currentCohort%pft) * & + currentCohort%bsw = EDPftvarcon_inst%allom_latosa_int(currentCohort%pft) * & currentCohort%hite * & (currentCohort%balive + currentCohort%laimemory)*leaf_frac @@ -508,9 +507,9 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! the sapwood pools. ! Units are in (kgN/plant) ! ------------------------------------------------------------------ - live_stem_n = ED_val_ag_biomass * currentCohort%bsw / & + live_stem_n = EDPftvarcon_inst%allom_agb_frac(currentCohort%pft) * currentCohort%bsw / & frootcn(currentCohort%pft) - live_croot_n = (1.0_r8-ED_val_ag_biomass) * currentCohort%bsw / & + live_croot_n = (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)) * currentCohort%bsw / & frootcn(currentCohort%pft) froot_n = currentCohort%br / frootcn(currentCohort%pft) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 8a5ab94168..a595bcfe2f 100755 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -804,7 +804,6 @@ subroutine crown_scorching ( currentSite ) !currentPatch%FI average fire intensity of flaming front during day. kW/m. use SFParamsMod, only : SF_val_alpha_SH - use EDParamsMod, only : ED_val_ag_biomass type(ed_site_type), intent(in), target :: currentSite @@ -823,7 +822,7 @@ subroutine crown_scorching ( currentSite ) currentCohort => currentPatch%tallest; do while(associated(currentCohort)) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only - tree_ag_biomass = tree_ag_biomass+(currentCohort%bl+ED_val_ag_biomass* & + tree_ag_biomass = tree_ag_biomass+(currentCohort%bl+EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)* & (currentCohort%bsw + currentCohort%bdead))*currentCohort%n endif !trees only @@ -839,7 +838,7 @@ subroutine crown_scorching ( currentSite ) do while(associated(currentCohort)) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1 & .and. (tree_ag_biomass > 0.0_r8)) then !trees only - f_ag_bmass = ((currentCohort%bl+ED_val_ag_biomass*(currentCohort%bsw + & + f_ag_bmass = ((currentCohort%bl+EDPftvarcon_inst%allom_agb_frac(currentCohort%pft)*(currentCohort%bsw + & currentCohort%bdead))*currentCohort%n)/tree_ag_biomass !equation 16 in Thonicke et al. 2010 if(write_SF == itrue)then diff --git a/main/EDEcophysConType.F90 b/main/EDEcophysConType.F90 index 4065b37d2a..7333911207 100644 --- a/main/EDEcophysConType.F90 +++ b/main/EDEcophysConType.F90 @@ -53,9 +53,6 @@ module EDEcophysConType real(r8), pointer :: root_long (:) ! root longevity (yrs) real(r8), pointer :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. real(r8), pointer :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. - real(r8), pointer :: sapwood_ratio (:) ! amount of sapwood per unit leaf carbon and m height - - ! pft parameters for plant hydraulics (PFT) real(r8), pointer :: wd (:) ! wood density (distinct from wood_density for testing) [g m-3] @@ -163,7 +160,6 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) allocate( EDecophyscon%root_long (0:numpft)); EDecophyscon%root_long (:) = nan allocate( EDecophyscon%seed_alloc (0:numpft)); EDecophyscon%seed_alloc (:) = nan allocate( EDecophyscon%clone_alloc (0:numpft)); EDecophyscon%clone_alloc (:) = nan - allocate( EDecophyscon%sapwood_ratio (0:numpft)); EDecophyscon%sapwood_ratio (:) = nan do m = lb,numpft EDecophyscon%max_dbh(m) = EDPftvarcon_inst%max_dbh(m) @@ -184,7 +180,6 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) EDecophyscon%root_long(m) = EDPftvarcon_inst%root_long(m) EDecophyscon%seed_alloc(m) = EDPftvarcon_inst%seed_alloc(m) EDecophyscon%clone_alloc(m) = EDPftvarcon_inst%clone_alloc(m) - EDecophyscon%sapwood_ratio(m) = EDPftvarcon_inst%sapwood_ratio(m) end do diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 3a8d2f1019..a2e95582c4 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -322,8 +322,8 @@ subroutine init_cohorts( patch_in, bc_in) temp_cohort%dbh = Dbh(temp_cohort) ! FIX(RF, 090314) - comment out addition of ' + 0.0001_r8*pft ' - seperate out PFTs a little bit... temp_cohort%canopy_trim = 1.0_r8 temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%froot_leaf(pft) & - + EDecophyscon%sapwood_ratio(temp_cohort%pft)*temp_cohort%hite) + 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) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead if( EDPftvarcon_inst%evergreen(pft) == 1) then diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index fe72905323..7b0b47733d 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -28,7 +28,6 @@ module EDParamsMod real(r8),protected :: ED_val_init_litter real(r8),protected :: ED_val_nignitions real(r8),protected :: ED_val_understorey_death - real(r8),protected :: ED_val_ag_biomass real(r8),protected :: ED_val_cwd_fcel real(r8),protected :: ED_val_cwd_flig real(r8),protected :: ED_val_bbopt_c3 @@ -103,7 +102,6 @@ subroutine FatesParamsInit() ED_val_init_litter = nan ED_val_nignitions = nan ED_val_understorey_death = nan - ED_val_ag_biomass = nan ED_val_cwd_fcel = nan ED_val_cwd_flig = nan ED_val_bbopt_c3 = nan @@ -280,9 +278,6 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_understorey_death, & data=ED_val_understorey_death) - call fates_params%RetreiveParameter(name=ED_name_ag_biomass, & - data=ED_val_ag_biomass) - call fates_params%RetreiveParameter(name=ED_name_cwd_fcel, & data=ED_val_cwd_fcel) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 1de5a86558..6dcb3fd772 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -42,12 +42,11 @@ module EDPftvarcon real(r8), allocatable :: root_long (:) ! root longevity (yrs) real(r8), allocatable :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. real(r8), allocatable :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. - real(r8), allocatable :: sapwood_ratio (:) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m +! real(r8), allocatable :: sapwood_ratio (:) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m real(r8), allocatable :: woody(:) real(r8), allocatable :: stress_decid(:) real(r8), allocatable :: season_decid(:) real(r8), allocatable :: evergreen(:) - real(r8), allocatable :: froot_leaf(:) real(r8), allocatable :: slatop(:) real(r8), allocatable :: leaf_long(:) real(r8), allocatable :: roota_par(:) @@ -66,18 +65,8 @@ module EDPftvarcon real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) real(r8), allocatable :: grperc(:) ! NOTE(bja, 2017-01) moved from EDParamsMod, was allocated as (maxPft=79), not (0:mxpft=78)! - real(r8), allocatable :: dbh2h_m(:) - real(r8), allocatable :: dbh2h_c(:) - real(r8), allocatable :: dbh2bl_a(:) - real(r8), allocatable :: dbh2bl_b(:) - real(r8), allocatable :: dbh2bl_dbh2carea_expnt_diff(:) - real(r8), allocatable :: dbh2bl_c(:) real(r8), allocatable :: dbh2bl_slascaler(:) real(r8), allocatable :: sai_scaler(:) - real(r8), allocatable :: dbh2bd_a(:) - real(r8), allocatable :: dbh2bd_b(:) - real(r8), allocatable :: dbh2bd_c(:) - real(r8), allocatable :: dbh2bd_d(:) real(r8), allocatable :: bmort(:) real(r8), allocatable :: hf_sm_threshold(:) real(r8), allocatable :: vcmaxha(:) @@ -98,6 +87,33 @@ module EDPftvarcon real(r8), allocatable :: taul(:, :) real(r8), allocatable :: taus(:, :) real(r8), allocatable :: rootprof_beta(:, :) + + ! Allometry Parameters + ! -------------------------------------------------------------------------------------------- + real(r8), allocatable :: allom_hmode(:) ! height allometry function type + real(r8), allocatable :: allom_lmode(:) ! maximum leaf allometry function type + real(r8), allocatable :: allom_fmode(:) ! maximum root allometry function type + 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_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] + real(r8), allocatable :: allom_l2fr(:) ! Fine root biomass per leaf biomass ratio [kgC/kgC] + real(r8), allocatable :: allom_agb_frac(:) ! Fraction of stem above ground [-] + real(r8), allocatable :: allom_d2h1(:) ! Parameter 1 for d2h allometry (intercept, or "c") + real(r8), allocatable :: allom_d2h2(:) ! Parameter 2 for d2h allometry (slope, or "m") + real(r8), allocatable :: allom_d2h3(:) ! Parameter 3 for d2h allometry (optional) + real(r8), allocatable :: allom_d2bl1(:) ! Parameter 1 for d2bl allometry (intercept) + real(r8), allocatable :: allom_d2bl2(:) ! Parameter 2 for d2bl allometry (slope) + real(r8), allocatable :: allom_d2bl3(:) ! Parameter 3 for d2bl allometry (optional) + real(r8), allocatable :: allom_blca_expnt_diff(:) ! Any difference in the exponent between the leaf + ! biomass and crown area scaling + 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 + contains procedure, public :: Init => EDpftconInit procedure, public :: Register @@ -257,10 +273,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_sapwood_ratio' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_woody' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -277,7 +289,7 @@ 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_froot_leaf' + name = 'fates_allom_l2fr' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -353,27 +365,55 @@ 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_dbh2h_m' + name = 'fates_allom_hmode' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_lmode' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_fmode' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_amode' + 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) + + name = 'fates_allom_smode' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_agb_frac' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_d2h1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2h_c' + name = 'fates_allom_d2h2' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bl_a' + name = 'fates_allom_d2bl1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bl_b' + name = 'fates_allom_d2bl2' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bl_dbh2carea_expnt_diff' + name = 'fates_allom_blca_expnt_diff' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bl_c' + name = 'fates_allom_d2bl3' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -385,19 +425,19 @@ 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_dbh2bd_a' + name = 'fates_allom_agb1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bd_b' + name = 'fates_allom_agb2' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bd_c' + name = 'fates_allom_agb3' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bd_d' + name = 'fates_allom_agb4' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -565,10 +605,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_alloc) - name = 'fates_sapwood_ratio' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%sapwood_ratio) - name = 'fates_woody' call fates_params%RetreiveParameterAllocate(name=name, & data=this%woody) @@ -585,9 +621,9 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%evergreen) - name = 'fates_froot_leaf' + name = 'fates_allom_l2fr' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%froot_leaf) + data=this%allom_l2fr) name = 'fates_slatop' call fates_params%RetreiveParameterAllocate(name=name, & @@ -661,29 +697,57 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%grperc) - name = 'fates_dbh2h_m' + name = 'fates_allom_hmode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_hmode) + + name = 'fates_allom_lmode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_lmode) + + name = 'fates_allom_fmode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_fmode) + + name = 'fates_allom_amode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_amode) + + name = 'fates_allom_cmode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_cmode) + + name = 'fates_allom_smode' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_smode) + + name = 'fates_allom_agb_frac' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_agb_frac) + + name = 'fates_allom_d2h1' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2h_m) + data=this%allom_d2h1) - name = 'fates_dbh2h_c' + name = 'fates_allom_d2h2' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2h_c) + data=this%allom_d2h2) - name = 'fates_dbh2bl_a' + name = 'fates_allom_d2bl1' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bl_a) + data=this%allom_d2bl1) - name = 'fates_dbh2bl_b' + name = 'fates_allom_d2bl2' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bl_b) + data=this%allom_d2bl2) - name = 'fates_dbh2bl_dbh2carea_expnt_diff' + name = 'fates_allom_blca_expnt_diff' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bl_dbh2carea_expnt_diff) + data=this%allom_blca_expnt_diff) - name = 'fates_dbh2bl_c' + name = 'fates_allom_d2bl3' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bl_c) + data=this%allom_d2bl3) name = 'fates_dbh2bl_slascaler' call fates_params%RetreiveParameterAllocate(name=name, & @@ -693,21 +757,21 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%sai_scaler) - name = 'fates_dbh2bd_a' + name = 'fates_allom_agb1' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bd_a) + data=this%allom_agb1) - name = 'fates_dbh2bd_b' + name = 'fates_allom_agb2' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bd_b) + data=this%allom_agb2) - name = 'fates_dbh2bd_c' + name = 'fates_allom_agb3' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bd_c) + data=this%allom_agb3) - name = 'fates_dbh2bd_d' + name = 'fates_allom_agb4' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bd_d) + data=this%allom_agb4) name = 'fates_bmort' call fates_params%RetreiveParameterAllocate(name=name, & diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 740955d798..8fad9c4643 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1100,8 +1100,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDtypesMod , only : ican_upper use EDtypesMod , only : ican_ustory use EDTypesMod , only : maxpft - - use EDParamsMod , only : ED_val_ag_biomass use EDTypesMod , only : get_sizeage_class_index use EDTypesMod , only : nlevleaf @@ -1406,13 +1404,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) 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*(1._r8-ED_val_ag_biomass)*n_perm2 + 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*ED_val_ag_biomass*n_perm2 + 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*(1._r8-ED_val_ag_biomass)*n_perm2 + 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*ED_val_ag_biomass*n_perm2 + 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) + & diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 28ab8dd232..dfd7d7d10f 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -649,7 +649,6 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name use EDTypesMod, only: numpft_ed use EDTypesMod, only: ncwd use SFParamsMod , only : SF_val_CWD_frac - use EDParamsMod , only : ED_val_ag_biomass ! Arguments type(ed_patch_type),intent(inout), target :: newpatch ! Patch structure @@ -875,8 +874,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & 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%froot_leaf(c_pft) & - + EDecophyscon%sapwood_ratio(c_pft)*temp_cohort%hite) + 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) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead if( EDPftvarcon_inst%evergreen(c_pft) == 1) then From b35feebc9e1496538b5ff70e7b2fd01eca0b11ff Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 26 Jul 2017 11:03:35 -0700 Subject: [PATCH 10/23] Some bug fixes related to allocation reading of new allometry parameters. --- main/EDParamsMod.F90 | 4 ---- main/EDPftvarcon.F90 | 24 ++++++++++++++++++++---- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 7b0b47733d..63cef4ce3b 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -56,7 +56,6 @@ module EDParamsMod character(len=param_string_length),parameter :: ED_name_init_litter = "fates_init_litter" character(len=param_string_length),parameter :: ED_name_nignitions = "fates_nignitions" character(len=param_string_length),parameter :: ED_name_understorey_death = "fates_understorey_death" - character(len=param_string_length),parameter :: ED_name_ag_biomass= "fates_ag_biomass" character(len=param_string_length),parameter :: ED_name_cwd_fcel= "fates_cwd_fcel" character(len=param_string_length),parameter :: ED_name_cwd_flig= "fates_cwd_flig" character(len=param_string_length),parameter :: ED_name_bbopt_c3= "fates_bbopt_c3" @@ -176,9 +175,6 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_ag_biomass, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_cwd_fcel, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 6dcb3fd772..f94315ee51 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -389,6 +389,14 @@ 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_allom_latosa_int' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_latosa_slp' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_allom_agb_frac' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -621,10 +629,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%evergreen) - name = 'fates_allom_l2fr' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%allom_l2fr) - name = 'fates_slatop' call fates_params%RetreiveParameterAllocate(name=name, & data=this%slatop) @@ -721,6 +725,18 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_smode) + name = 'fates_allom_latosa_int' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_latosa_int) + + name = 'fates_allom_latosa_slp' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_latosa_slp) + + name = 'fates_allom_l2fr' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_l2fr) + name = 'fates_allom_agb_frac' call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_agb_frac) From a78f8cf1a7fb698b975b566dfa933beabbf439a2 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 27 Jul 2017 14:58:35 -0700 Subject: [PATCH 11/23] Removal of some unused parameters, name changes and bug-fix on agb allometry (bug fix on this implementation) --- biogeochem/EDGrowthFunctionsMod.F90 | 17 +++--- main/EDEcophysConType.F90 | 9 --- main/EDPftvarcon.F90 | 95 +++++++++++++++-------------- 3 files changed, 57 insertions(+), 64 deletions(-) diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index 635946e068..47bbb9591c 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -108,11 +108,10 @@ real(r8) function Bleaf( cohort_in ) real(r8) :: dbh2bl_c real(r8) :: slascaler ! changes the target biomass according to the SLA - dbh2bl_a = EDPftvarcon_inst%allom_d2bl1(cohort_in%pft) - dbh2bl_b = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft) - dbh2bl_c = EDPftvarcon_inst%allom_d2bl3(cohort_in%pft) - - slascaler = EDPftvarcon_inst%dbh2bl_slascaler(cohort_in%pft)/EDPftvarcon_inst%slatop(cohort_in%pft) + dbh2bl_a = EDPftvarcon_inst%allom_d2bl1(cohort_in%pft) + dbh2bl_b = EDPftvarcon_inst%allom_d2bl2(cohort_in%pft) + dbh2bl_c = EDPftvarcon_inst%allom_d2bl3(cohort_in%pft) + slascaler = EDPftvarcon_inst%allom_d2bl_slascaler(cohort_in%pft)/EDPftvarcon_inst%slatop(cohort_in%pft) if(cohort_in%dbh < 0._r8.or.cohort_in%pft == 0.or.cohort_in%dbh > 1000.0_r8)then write(fates_log(),*) 'problems in bleaf',cohort_in%dbh,cohort_in%pft @@ -192,7 +191,7 @@ real(r8) function tree_sai( cohort_in ) real(r8) :: bdead_per_unitarea ! KgC of leaf per m2 area of ground. real(r8) :: sai_scaler - sai_scaler = EDPftvarcon_inst%sai_scaler(cohort_in%pft) + sai_scaler = EDPftvarcon_inst%allom_sai_scaler(cohort_in%pft) if( cohort_in%bdead < 0._r8 .or. cohort_in%pft == 0 ) then write(fates_log(),*) 'problem in treesai',cohort_in%bdead,cohort_in%pft @@ -358,9 +357,9 @@ real(r8) function dDbhdBd( cohort_in ) c = EDPftvarcon_inst%allom_d2h2(cohort_in%pft) dbh2bd_a = EDPftvarcon_inst%allom_agb1(cohort_in%pft) - dbh2bd_b = EDPftvarcon_inst%allom_agb1(cohort_in%pft) - dbh2bd_c = EDPftvarcon_inst%allom_agb1(cohort_in%pft) - dbh2bd_d = 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) diff --git a/main/EDEcophysConType.F90 b/main/EDEcophysConType.F90 index 7333911207..c06d16bb7e 100644 --- a/main/EDEcophysConType.F90 +++ b/main/EDEcophysConType.F90 @@ -41,13 +41,10 @@ module EDEcophysConType real(r8), pointer :: hgt_min (:) ! sapling height m real(r8), pointer :: cushion (:) ! labile carbon storage target as multiple of leaf pool. real(r8), pointer :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. ! (1=lose leaves, 0=use store). - real(r8), pointer :: rootresist (:) ! SPA parameter (NOT USED) - real(r8), pointer :: soilbeta (:) ! SPA parameter (NOT USED) real(r8), pointer :: crown (:) ! fraction of the height of the plant that is occupied by crown. For fire model. real(r8), pointer :: bark_scaler (:) ! scaler from dbh to bark thickness. For fire model. real(r8), pointer :: crown_kill (:) ! scaler on fire death. For fire model. real(r8), pointer :: initd (:) ! initial seedling density - real(r8), pointer :: sd_mort (:) ! rate of death of seeds produced from reproduction (NOT USED). real(r8), pointer :: seed_rain (:) ! seeds that come from outside the gridbox. real(r8), pointer :: BB_slope (:) ! ball berry slope parameter real(r8), pointer :: root_long (:) ! root longevity (yrs) @@ -148,13 +145,10 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) allocate( EDecophyscon%hgt_min (0:numpft)); EDecophyscon%hgt_min (:) = nan allocate( EDecophyscon%cushion (0:numpft)); EDecophyscon%cushion (:) = nan allocate( EDecophyscon%leaf_stor_priority (0:numpft)); EDecophyscon%leaf_stor_priority (:) = nan - allocate( EDecophyscon%rootresist (0:numpft)); EDecophyscon%rootresist (:) = nan - allocate( EDecophyscon%soilbeta (0:numpft)); EDecophyscon%soilbeta (:) = nan allocate( EDecophyscon%crown (0:numpft)); EDecophyscon%crown (:) = nan allocate( EDecophyscon%bark_scaler (0:numpft)); EDecophyscon%bark_scaler (:) = nan allocate( EDecophyscon%crown_kill (0:numpft)); EDecophyscon%crown_kill (:) = nan allocate( EDecophyscon%initd (0:numpft)); EDecophyscon%initd (:) = nan - allocate( EDecophyscon%sd_mort (0:numpft)); EDecophyscon%sd_mort (:) = nan allocate( EDecophyscon%seed_rain (0:numpft)); EDecophyscon%seed_rain (:) = nan allocate( EDecophyscon%BB_slope (0:numpft)); EDecophyscon%BB_slope (:) = nan allocate( EDecophyscon%root_long (0:numpft)); EDecophyscon%root_long (:) = nan @@ -168,13 +162,10 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) EDecophyscon%hgt_min(m) = EDPftvarcon_inst%hgt_min(m) EDecophyscon%cushion(m) = EDPftvarcon_inst%cushion(m) EDecophyscon%leaf_stor_priority(m) = EDPftvarcon_inst%leaf_stor_priority(m) - EDecophyscon%rootresist(m) = EDPftvarcon_inst%rootresist(m) - EDecophyscon%soilbeta(m) = EDPftvarcon_inst%soilbeta(m) EDecophyscon%crown(m) = EDPftvarcon_inst%crown(m) EDecophyscon%bark_scaler(m) = EDPftvarcon_inst%bark_scaler(m) EDecophyscon%crown_kill(m) = EDPftvarcon_inst%crown_kill(m) EDecophyscon%initd(m) = EDPftvarcon_inst%initd(m) - EDecophyscon%sd_mort(m) = EDPftvarcon_inst%sd_mort(m) EDecophyscon%seed_rain(m) = EDPftvarcon_inst%seed_rain(m) EDecophyscon%bb_slope(m) = EDPftvarcon_inst%bb_slope(m) EDecophyscon%root_long(m) = EDPftvarcon_inst%root_long(m) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index f94315ee51..4495b650f7 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -21,6 +21,7 @@ module EDPftvarcon !ED specific variables. type, public :: EDPftvarcon_type + real(r8), allocatable :: pft_used (:) ! Switch to turn on and off PFTs real(r8), allocatable :: max_dbh (:) ! maximum dbh at which height growth ceases... real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance (NOT CURRENTY USED) real(r8), allocatable :: wood_density (:) ! wood density g cm^-3 ... @@ -29,20 +30,17 @@ module EDPftvarcon real(r8), allocatable :: z0mr (:) ! ratio of roughness length of vegetation to height (-) real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-) real(r8), allocatable :: cushion (:) ! labile carbon storage target as multiple of leaf pool. - real(r8), allocatable :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). - real(r8), allocatable :: rootresist (:) ! root resistance used in SPA (NOT CURRENTLY USED) - real(r8), allocatable :: soilbeta (:) ! parameter used in SPA (NOT CURRENTLY USED) + real(r8), allocatable :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation + ! (1 = lose leaves, 0 = use store). real(r8), allocatable :: crown (:) real(r8), allocatable :: bark_scaler (:) real(r8), allocatable :: crown_kill (:) real(r8), allocatable :: initd (:) - real(r8), allocatable :: sd_mort (:) ! rate of death of seeds (NOT CURRENTLY USED) real(r8), allocatable :: seed_rain (:) real(r8), allocatable :: BB_slope (:) real(r8), allocatable :: root_long (:) ! root longevity (yrs) real(r8), allocatable :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. real(r8), allocatable :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. -! real(r8), allocatable :: sapwood_ratio (:) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m real(r8), allocatable :: woody(:) real(r8), allocatable :: stress_decid(:) real(r8), allocatable :: season_decid(:) @@ -64,9 +62,9 @@ module EDPftvarcon real(r8), allocatable :: frootcn(:) real(r8), allocatable :: smpso(:) real(r8), allocatable :: smpsc(:) - real(r8), allocatable :: grperc(:) ! NOTE(bja, 2017-01) moved from EDParamsMod, was allocated as (maxPft=79), not (0:mxpft=78)! - real(r8), allocatable :: dbh2bl_slascaler(:) - real(r8), allocatable :: sai_scaler(:) + real(r8), allocatable :: grperc(:) + + real(r8), allocatable :: bmort(:) real(r8), allocatable :: hf_sm_threshold(:) real(r8), allocatable :: vcmaxha(:) @@ -80,6 +78,7 @@ module EDPftvarcon real(r8), allocatable :: tpuse(:) real(r8), allocatable :: germination_timescale(:) real(r8), allocatable :: seed_decay_turnover(:) + real(r8), allocatable :: branch_turnover(:) ! Turnover time for branchfall on live trees [yr-1] real(r8), allocatable :: trim_limit(:) ! Limit to reductions in leaf area w stress (m2/m2) real(r8), allocatable :: trim_inc(:) ! Incremental change in trimming function (m2/m2) real(r8), allocatable :: rhol(:, :) @@ -87,6 +86,7 @@ module EDPftvarcon real(r8), allocatable :: taul(:, :) real(r8), allocatable :: taus(:, :) real(r8), allocatable :: rootprof_beta(:, :) + ! Allometry Parameters ! -------------------------------------------------------------------------------------------- @@ -106,14 +106,17 @@ module EDPftvarcon real(r8), allocatable :: allom_d2h3(:) ! Parameter 3 for d2h allometry (optional) real(r8), allocatable :: allom_d2bl1(:) ! Parameter 1 for d2bl allometry (intercept) real(r8), allocatable :: allom_d2bl2(:) ! Parameter 2 for d2bl allometry (slope) - real(r8), allocatable :: allom_d2bl3(:) ! Parameter 3 for d2bl allometry (optional) + real(r8), allocatable :: allom_d2bl3(:) ! Parameter 3 for d2bl allometry (optional) + real(r8), allocatable :: allom_sai_scaler(:) ! + real(r8), allocatable :: allom_d2bl_slascaler(:) ! real(r8), allocatable :: allom_blca_expnt_diff(:) ! Any difference in the exponent between the leaf ! biomass and crown area scaling 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 - + + contains procedure, public :: Init => EDpftconInit procedure, public :: Register @@ -201,6 +204,10 @@ subroutine Register_PFT(this, fates_params) !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & !X! dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_pft_used' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_max_dbh' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -225,14 +232,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_rootresist' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - - name = 'fates_soilbeta' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_crown_depth_frac' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -249,10 +248,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_sd_mort' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_seed_rain' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -409,6 +404,10 @@ 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_allom_d2h3' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_allom_d2bl1' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -417,19 +416,19 @@ 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_allom_blca_expnt_diff' + name = 'fates_allom_d2bl3' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_allom_d2bl3' + name = 'fates_allom_blca_expnt_diff' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_dbh2bl_slascaler' + name = 'fates_allom_d2bl_slascaler' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_sai_scaler' + name = 'fates_allom_sai_scaler' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -501,6 +500,10 @@ 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_branch_turnover' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_trim_limit' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -541,6 +544,10 @@ subroutine Receive_PFT(this, fates_params) !X! call fates_params%RetreiveParameter(name=name, & !X! data=this%) + name = 'fates_pft_used' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%pft_used) + name = 'fates_max_dbh' call fates_params%RetreiveParameterAllocate(name=name, & data=this%max_dbh) @@ -565,14 +572,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%leaf_stor_priority) - name = 'fates_rootresist' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%rootresist) - - name = 'fates_soilbeta' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%soilbeta) - name = 'fates_crown_depth_frac' call fates_params%RetreiveParameterAllocate(name=name, & data=this%crown) @@ -589,10 +588,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%initd) - name = 'fates_sd_mort' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%sd_mort) - name = 'fates_seed_rain' call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_rain) @@ -749,6 +744,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_d2h2) + name = 'fates_allom_d2h3' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_d2h3) + name = 'fates_allom_d2bl1' call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_d2bl1) @@ -757,21 +756,21 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_d2bl2) - name = 'fates_allom_blca_expnt_diff' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%allom_blca_expnt_diff) - name = 'fates_allom_d2bl3' call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_d2bl3) - name = 'fates_dbh2bl_slascaler' + name = 'fates_allom_blca_expnt_diff' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%allom_blca_expnt_diff) + + name = 'fates_allom_d2bl_slascaler' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%dbh2bl_slascaler) + data=this%allom_d2bl_slascaler) - name = 'fates_sai_scaler' + name = 'fates_allom_sai_scaler' call fates_params%RetreiveParameterAllocate(name=name, & - data=this%sai_scaler) + data=this%allom_sai_scaler) name = 'fates_allom_agb1' call fates_params%RetreiveParameterAllocate(name=name, & @@ -841,6 +840,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_decay_turnover) + name = 'fates_branch_turnover' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%branch_turnover) + name = 'fates_trim_limit' call fates_params%RetreiveParameterAllocate(name=name, & data=this%trim_limit) From 4b97df3f47b2c6273f641a6c2f2d63df4ea16171 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 1 Aug 2017 15:11:00 -0700 Subject: [PATCH 12/23] Migrated several module switches to the CLM/ALM namelist. --- biogeochem/EDCohortDynamicsMod.F90 | 13 +- biogeochem/EDPatchDynamicsMod.F90 | 9 +- biogeophys/EDBtranMod.F90 | 7 +- biogeophys/FatesPlantHydraulicsMod.F90 | 1 - biogeophys/FatesPlantRespPhotosynthMod.F90 | 9 +- main/EDEcophysConType.F90 | 6 +- main/EDInitMod.F90 | 16 +-- main/EDMainMod.F90 | 106 +++++++-------- main/EDParamsMod.F90 | 10 -- main/EDTypesMod.F90 | 9 +- main/FatesHistoryInterfaceMod.F90 | 53 ++++---- main/FatesHistoryVariableType.F90 | 2 +- main/FatesHydraulicsMemMod.F90 | 3 +- main/FatesInterfaceMod.F90 | 150 ++++++++++++++++++--- main/FatesInventoryInitMod.F90 | 10 +- 15 files changed, 247 insertions(+), 157 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 44a55e28cd..2fbf2be010 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -10,6 +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 FatesInterfaceMod , only : hlm_days_per_year use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon @@ -21,7 +22,7 @@ module EDCohortDynamicsMod use EDTypesMod , only : sclass_ed,nlevsclass_ed,AREA use EDTypesMod , only : min_npm2, min_nppatch use EDTypesMod , only : min_n_safemath - use EDTypesMod , only : use_fates_plant_hydro + use FatesInterfaceMod , only : hlm_use_planthydro use FatesPlantHydraulicsMod, only : FuseCohortHydraulics use FatesPlantHydraulicsMod, only : CopyCohortHydraulics use FatesPlantHydraulicsMod, only : updateSizeDepTreeHydProps @@ -172,7 +173,7 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & ! growth, disturbance and mortality. new_cohort%isnew = .true. - if( use_fates_plant_hydro ) then + if( hlm_use_planthydro.eq.itrue ) then call InitHydrCohort(new_cohort) call updateSizeDepTreeHydProps(new_cohort, bc_in) call initTreeHydStates(new_cohort, bc_in) @@ -645,7 +646,7 @@ subroutine terminate_cohorts( currentSite, patchptr, level ) currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA - if (use_fates_plant_hydro) call DeallocateHydrCohort(currentCohort) + if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort) deallocate(currentCohort) endif @@ -798,7 +799,7 @@ subroutine fuse_cohorts(patchptr, bc_in) call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & currentCohort%size_class,currentCohort%size_by_pft_class) - if(use_fates_plant_hydro) call FuseCohortHydraulics(currentCohort,nextc,bc_in,newn) + if(hlm_use_planthydro.eq.itrue) call FuseCohortHydraulics(currentCohort,nextc,bc_in,newn) ! recent canopy history currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + & @@ -887,7 +888,7 @@ subroutine fuse_cohorts(patchptr, bc_in) endif if (associated(nextc)) then - if(use_fates_plant_hydro) call DeallocateHydrCohort(nextc) + if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nextc) deallocate(nextc) endif @@ -1245,7 +1246,7 @@ subroutine copy_cohort( currentCohort,copyc ) ! Plant Hydraulics - if( use_fates_plant_hydro ) call CopyCohortHydraulics(n,o) + if( hlm_use_planthydro.eq.itrue ) call CopyCohortHydraulics(n,o) ! indices for binning n%size_class = o%size_class diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 042c2975ac..e1c792402d 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -13,7 +13,7 @@ module EDPatchDynamicsMod use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : min_patch_area use EDTypesMod , only : nclmax - use EDTypesMod , only : use_fates_plant_hydro + use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_numlevgrnd use FatesInterfaceMod , only : hlm_numlevsoil use FatesInterfaceMod , only : hlm_numSWb @@ -21,6 +21,7 @@ module EDPatchDynamicsMod use FatesInterfaceMod , only : hlm_days_per_year use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : itrue use FatesPlantHydraulicsMod, only : InitHydrCohort use FatesPlantHydraulicsMod, only : DeallocateHydrCohort use EDParamsMod , only : fates_mortality_disturbance_fraction @@ -271,7 +272,7 @@ subroutine spawn_patches( currentSite, bc_in) do while(associated(currentCohort)) allocate(nc) - if(use_fates_plant_hydro) call InitHydrCohort(nc) + if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(nc) call zero_cohort(nc) ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort @@ -389,7 +390,7 @@ subroutine spawn_patches( currentSite, bc_in) new_patch%tallest => storebigcohort new_patch%shortest => storesmallcohort else - if(use_fates_plant_hydro) call DeallocateHydrCohort(nc) + if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nc) deallocate(nc) !get rid of the new memory. endif @@ -1479,7 +1480,7 @@ subroutine dealloc_patch(cpatch) do while(associated(ccohort)) ncohort => ccohort%taller - if(use_fates_plant_hydro) call DeallocateHydrCohort(ccohort) + if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(ccohort) deallocate(ccohort) ccohort => ncohort diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 229008b64e..602df3fe3e 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -7,6 +7,7 @@ module EDBtranMod use EDPftvarcon , only : EDPftvarcon_inst use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm + use FatesConstantsMod , only : itrue,ifalse use EDTypesMod , only : ed_site_type, & ed_patch_type, & ed_cohort_type, & @@ -15,7 +16,7 @@ module EDBtranMod use shr_kind_mod , only : r8 => shr_kind_r8 use FatesInterfaceMod , only : bc_in_type, & bc_out_type - use EDTypesMod , only : use_fates_plant_hydro + use FatesInterfaceMod , only : hlm_use_planthydro use FatesGlobals , only : fates_log ! @@ -202,7 +203,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) ! used only for diagnostics. If plant hydraulics is turned off ! we are using the patchxpft level btran calculation - if(.not.use_fates_plant_hydro) then + if(hlm_use_planthydro.eq.ifalse) then !weight patch level output BTRAN for the bc_out(s)%btran_pa(ifp) = 0.0_r8 do ft = 1,numpft_ed @@ -229,7 +230,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) end do - if(use_fates_plant_hydro) then + if(hlm_use_planthydro.eq.itrue) then call BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) end if diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 688117f2e9..dbc863ced8 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -16,7 +16,6 @@ module FatesPlantHydraulicsMod use FatesConstantsMod, only : denh2o => dens_fresh_liquid_water use FatesConstantsMod, only : grav => grav_earth - use EDTypesMod, only : use_fates_plant_hydro use EDTypesMod , only : ed_site_type use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 32bb9f76ac..4901ac30a4 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -23,7 +23,8 @@ module FATESPlantRespPhotosynthMod use FatesGlobals, only : endrun => fates_endrun use FatesGlobals, only : fates_log use FatesConstantsMod, only : r8 => fates_r8 - use EDTypesMod, only : use_fates_plant_hydro + use FatesConstantsMod, only : itrue + use FatesInterfaceMod, only : hlm_use_planthydro use EDTypesMod, only : numpft_ed use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax @@ -342,10 +343,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! not been done yet. ! ------------------------------------------------------------ - if ( .not.rate_mask_z(iv,ft,cl) .or. use_fates_plant_hydro ) then + if ( .not.rate_mask_z(iv,ft,cl) .or. (hlm_use_planthydro.eq.itrue) ) then - if (use_fates_plant_hydro) then -! write(fates_log(),*) 'use_fates_plant_hydro in EDTypes' + if (hlm_use_planthydro.eq.itrue) then +! write(fates_log(),*) 'hlm_use_planthydro' ! write(fates_log(),*) 'has been set to true. You have inadvertently' ! write(fates_log(),*) 'turned on a future feature that is not in the' ! write(fates_log(),*) 'FATES codeset yet. Please set this to' diff --git a/main/EDEcophysConType.F90 b/main/EDEcophysConType.F90 index c06d16bb7e..8c405ed987 100644 --- a/main/EDEcophysConType.F90 +++ b/main/EDEcophysConType.F90 @@ -18,8 +18,8 @@ module EDEcophysConType use FatesHydraulicsMemMod , only : npool_stem use FatesHydraulicsMemMod , only : npool_aroot use FatesHydraulicsMemMod , only : npool_troot - - use EDTypesMod, only : use_fates_plant_hydro + use FatesConstantsMod, only : itrue,ifalse + use FatesInterfaceMod, only : hlm_use_planthydro ! implicit none @@ -174,7 +174,7 @@ subroutine EDecophysconInit(EDpftvarcon_inst, numpft) end do - if (use_fates_plant_hydro) then + if (hlm_use_planthydro.eq.itrue) then allocate( EDecophyscon%wd (0:numpft) ); EDecophyscon%wd (:) = nan allocate( EDecophyscon%lma (0:numpft) ); EDecophyscon%lma (:) = nan allocate( EDecophyscon%n (0:numpft) ); EDecophyscon%n (:) = nan diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index a2e95582c4..811151023f 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 EDParamsMod , only : ED_do_inventory_init use EDEcophysConType , only : EDecophyscon use EDGrowthFunctionsMod , only : bdead, bleaf, dbh use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -22,7 +21,8 @@ module EDInitMod use EDTypesMod , only : nuMWaterMem use EDTypesMod , only : numpft_ed use FatesInterfaceMod , only : bc_in_type - use EDTypesMod , only : use_fates_plant_hydro + use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceMod , only : hlm_use_inventory_init ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -236,18 +236,12 @@ subroutine init_patches( nsites, sites, bc_in) ! Two primary options, either a Near Bear Ground (NBG) or Inventory based cold-start ! --------------------------------------------------------------------------------------------- - if ( int(ED_do_inventory_init) < 0 .or. int(ED_do_inventory_init) > 1 ) then - write(fates_log(), *) 'Flag to turn on or off inventory initialization is out of bounds' - write(fates_log(), *) 'ED_do_inv_init = ',ED_do_inventory_init - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - if ( int(ED_do_inventory_init) .eq. itrue) then + if ( hlm_use_inventory_init.eq.itrue ) then call initialize_sites_by_inventory(nsites,sites,bc_in) do s = 1, nsites - if (use_fates_plant_hydro) then + if (hlm_use_planthydro.eq.itrue) then call updateSizeDepRhizHydProps(sites(s), bc_in(s)) end if enddo @@ -277,7 +271,7 @@ subroutine init_patches( nsites, sites, bc_in) ! This sets the rhizosphere shells based on the plant initialization ! The initialization of the plant-relevant hydraulics variables ! were set from a call inside of the init_cohorts()->create_cohort() subroutine - if (use_fates_plant_hydro) then + if (hlm_use_planthydro.eq.itrue) then call updateSizeDepRhizHydProps(sites(s), bc_in(s)) end if diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 4ab507efa1..1db955f715 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -4,51 +4,50 @@ module EDMainMod ! Main ED module. ! ============================================================================ - use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_kind_mod , only : r8 => shr_kind_r8 + + use FatesGlobals , only : fates_log + use FatesInterfaceMod , only : hlm_freq_day + use FatesInterfaceMod , only : hlm_day_of_year + use FatesInterfaceMod , only : hlm_days_per_year + use FatesInterfaceMod , only : hlm_current_year + use FatesInterfaceMod , only : hlm_current_month + use FatesInterfaceMod , only : hlm_current_day + use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceMod , only : hlm_use_ed_st3 + use FatesInterfaceMod , only : bc_in_type + use FatesInterfaceMod , only : hlm_masterproc + use EDCohortDynamicsMod , only : allocate_live_biomass + use EDCohortDynamicsMod , only : terminate_cohorts + use EDCohortDynamicsMod , only : fuse_cohorts + use EDCohortDynamicsMod , only : sort_cohorts + use EDCohortDynamicsMod , only : count_cohorts + use EDPatchDynamicsMod , only : disturbance_rates + use EDPatchDynamicsMod , only : fuse_patches + use EDPatchDynamicsMod , only : spawn_patches + use EDPatchDynamicsMod , only : terminate_patches + use EDPhysiologyMod , only : canopy_derivs + use EDPhysiologyMod , only : non_canopy_derivs + use EDPhysiologyMod , only : phenology + use EDPhysiologyMod , only : recruitment + use EDPhysiologyMod , only : trim_canopy + use SFMainMod , only : fire_model + use EDTypesMod , only : get_age_class_index + use EDtypesMod , only : ncwd + use EDTypesMod , only : numpft_ed + use EDtypesMod , only : ed_site_type + use EDtypesMod , only : ed_patch_type + use EDtypesMod , only : ed_cohort_type + use EDTypesMod , only : do_ed_phenology + use FatesConstantsMod , only : itrue,ifalse + use FatesPlantHydraulicsMod , only : do_growthrecruiteffects + use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydProps + use FatesPlantHydraulicsMod , only : updateSizeDepTreeHydStates + use FatesPlantHydraulicsMod , only : initTreeHydStates + use FatesPlantHydraulicsMod , only : updateSizeDepRhizHydProps +! use FatesPlantHydraulicsMod , only : updateSizeDepRhizHydStates + - use FatesGlobals , only : fates_log - use FatesInterfaceMod , only : hlm_freq_day - use FatesInterfaceMod , only : hlm_day_of_year - use FatesInterfaceMod , only : hlm_days_per_year - use FatesInterfaceMod , only : hlm_current_year - use FatesInterfaceMod , only : hlm_current_month - use FatesInterfaceMod , only : hlm_current_day - use EDCohortDynamicsMod , only : allocate_live_biomass - use EDCohortDynamicsMod , only : terminate_cohorts - use EDCohortDynamicsMod , only : fuse_cohorts - use EDCohortDynamicsMod , only : sort_cohorts - use EDCohortDynamicsMod , only : count_cohorts - use EDPatchDynamicsMod , only : disturbance_rates - use EDPatchDynamicsMod , only : fuse_patches - use EDPatchDynamicsMod , only : spawn_patches - use EDPatchDynamicsMod , only : terminate_patches - use EDTypesMod , only : get_age_class_index - use EDPhysiologyMod , only : canopy_derivs - use EDPhysiologyMod , only : non_canopy_derivs - use EDPhysiologyMod , only : phenology - use EDPhysiologyMod , only : recruitment - use EDPhysiologyMod , only : trim_canopy - use SFMainMod , only : fire_model - use EDtypesMod , only : ncwd - use EDTypesMod , only : numpft_ed - use EDtypesMod , only : ed_site_type - use EDtypesMod , only : ed_patch_type - use EDtypesMod , only : ed_cohort_type - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_masterproc - use FatesConstantsMod , only : itrue - use FatesPlantHydraulicsMod, only : do_growthrecruiteffects - use FatesPlantHydraulicsMod, only : updateSizeDepTreeHydProps - use FatesPlantHydraulicsMod, only : updateSizeDepTreeHydStates - use FatesPlantHydraulicsMod, only : initTreeHydStates - use FatesPlantHydraulicsMod, only : updateSizeDepRhizHydProps -! use FatesPlantHydraulicsMod, only : updateSizeDepRhizHydStates - use EDTypesMod , only : use_fates_plant_hydro - use EDTypesMod , only : do_ed_phenology -! use EDTypesMod , only : do_ed_growth -! use EDTypesMod , only : do_ed_recruitment -! use EDTypesMod , only : do_ed_mort_dist - use EDTypesMod , only : do_ed_dynamics implicit none private @@ -101,17 +100,16 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) call phenology(currentSite, bc_in ) end if - if (do_ed_dynamics) then + if (hlm_use_ed_st3.eq.ifalse) then ! Bypass if ST3 call fire_model(currentSite, bc_in) ! Calculate disturbance and mortality based on previous timestep vegetation. call disturbance_rates(currentSite) end if - if (do_ed_dynamics) then + if (hlm_use_ed_st3.eq.ifalse) then ! Integrate state variables from annual rates to daily timestep call ed_integrate_state_variables(currentSite, bc_in ) - else ! ed_intergrate_state_variables is where the new cohort flag ! is set. This flag designates wether a cohort has @@ -127,7 +125,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) ! Reproduction, Recruitment and Cohort Dynamics : controls cohort organisation !****************************************************************************** - if(do_ed_dynamics) then + if(hlm_use_ed_st3.eq.ifalse) then currentPatch => currentSite%oldest_patch do while (associated(currentPatch)) @@ -141,7 +139,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) call ed_total_balance_check(currentSite,1) - if( do_ed_dynamics ) then + if( hlm_use_ed_st3.eq.ifalse ) then currentPatch => currentSite%oldest_patch do while (associated(currentPatch)) @@ -169,21 +167,21 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) !********************************************************************************* ! make new patches from disturbed land - if ( do_ed_dynamics ) then + if ( hlm_use_ed_st3.eq.ifalse ) then call spawn_patches(currentSite, bc_in) end if call ed_total_balance_check(currentSite,3) ! fuse on the spawned patches. - if ( do_ed_dynamics ) then + if ( hlm_use_ed_st3.eq.ifalse ) then call fuse_patches(currentSite, bc_in ) ! If using BC FATES hydraulics, update the rhizosphere geometry ! based on the new cohort-patch structure ! 'rhizosphere geometry' (column-level root biomass + rootfr --> root length ! density --> node radii and volumes) - if(use_fates_plant_hydro .and. do_growthrecruiteffects) then + if( (hlm_use_planthydro.eq.itrue) .and. do_growthrecruiteffects) then call updateSizeDepRhizHydProps(currentSite, bc_in) ! call updateSizeDepRhizHydStates(currentSite, bc_in) ! if(nshell > 1) then (THIS BEING CHECKED INSIDE OF the update) @@ -196,7 +194,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in) call ed_total_balance_check(currentSite,4) ! kill patches that are too small - if ( do_ed_dynamics ) then + if ( hlm_use_ed_st3.eq.ifalse ) then call terminate_patches(currentSite) end if @@ -292,7 +290,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! BOC...update tree 'hydraulic geometry' ! (size --> heights of elements --> hydraulic path lengths --> ! maximum node-to-node conductances) - if(use_fates_plant_hydro .and. do_growthrecruiteffects) then + if( (hlm_use_planthydro.eq.itrue) .and. do_growthrecruiteffects) then call updateSizeDepTreeHydProps(currentCohort, bc_in) call updateSizeDepTreeHydStates(currentCohort) end if diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 63cef4ce3b..c3621923c0 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -15,8 +15,6 @@ module EDParamsMod ! this is what the user can use for the actual values ! - real(r8),protected :: ED_do_inventory_init ! flag to turn on or off inventory initialization - ! 0 is false, 1 is true real(r8),protected :: ED_size_diagnostic_scale ! Flag to switch between a linear and exponential ! scale on the plant size axis in diagnostics (NOT USED YET) real(r8),protected :: ED_mort_disturb_frac ! the fraction of canopy mortality that results in disturbance @@ -45,7 +43,6 @@ module EDParamsMod real(r8),protected :: ED_val_cohort_fusion_tol real(r8),protected :: ED_val_patch_fusion_tol - character(len=param_string_length),parameter :: ED_name_do_inventory_init = "fates_do_inventory_init" character(len=param_string_length),parameter :: ED_name_size_diagnostic_scale = "fates_size_diagnostic_scale" character(len=param_string_length),parameter :: ED_name_mort_disturb_frac = "fates_mort_disturb_frac" character(len=param_string_length),parameter :: ED_name_grass_spread = "fates_grass_spread" @@ -90,7 +87,6 @@ subroutine FatesParamsInit() implicit none - ED_do_inventory_init = nan ED_size_diagnostic_scale = nan ED_mort_disturb_frac = nan ED_val_grass_spread = nan @@ -136,9 +132,6 @@ subroutine FatesRegisterParams(fates_params) call FatesParamsInit() - call fates_params%RegisterParameter(name=ED_name_do_inventory_init, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_size_diagnostic_scale, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) @@ -235,9 +228,6 @@ subroutine FatesReceiveParams(fates_params) class(fates_parameters_type), intent(inout) :: fates_params - call fates_params%RetreiveParameter(name=ED_name_do_inventory_init, & - data=ED_do_inventory_init) - call fates_params%RetreiveParameter(name=ED_name_size_diagnostic_scale, & data=ED_size_diagnostic_scale) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 966415fe2f..789d4727af 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -45,12 +45,6 @@ module EDTypesMod ! files. This will be compared with ! the HLM's expectation in FatesInterfaceMod - ! Module switches (this will be read in one day) - ! This variable only exists now to serve as a place holder - !!!!!!!!!! THIS SHOULD NOT BE SET TO TRUE !!!!!!!!!!!!!!!!! - logical,parameter :: use_fates_plant_hydro = .false. - - ! Switches that turn on/off ED dynamics process (names are self explanatory) ! IMPORTANT NOTE!!! THESE SWITCHES ARE EXPERIMENTAL. ! THEY SHOULD CORRECTLY TURN OFF OR ON THE PROCESS, BUT.. THERE ARE VARIOUS @@ -60,8 +54,7 @@ module EDTypesMod ! WAS OUTSIDE THE SCOPE OF THE VERY LARGE CHANGESET WHERE THESE WERE FIRST ! INTRODUCED (RGK 03-2017) logical, parameter :: do_ed_phenology = .true. - logical, parameter :: do_ed_dynamics = .true. - + ! MODEL PARAMETERS real(r8), parameter :: AREA = 10000.0_r8 ! Notional area of simulated forest m2 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 8fad9c4643..f665cdc447 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1,28 +1,31 @@ module FatesHistoryInterfaceMod - use FatesConstantsMod, only : r8 => fates_r8 - use FatesConstantsMod, only : fates_avg_flag_length, fates_short_string_length, fates_long_string_length - use FatesGlobals , only : fates_log - use FatesGlobals, only : endrun => fates_endrun - - use FatesIODimensionsMod, only : fates_io_dimension_type - use FatesIOVariableKindMod, only : fates_io_variable_kind_type - use FatesHistoryVariableType, only : fates_history_variable_type - use FatesInterfaceMod, only : hlm_hio_ignore_val + 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 FatesGlobals , only : fates_log + use FatesGlobals , only : endrun => fates_endrun + + use FatesIODimensionsMod , only : fates_io_dimension_type + use FatesIOVariableKindMod , only : fates_io_variable_kind_type + use FatesHistoryVariableType , only : fates_history_variable_type + use FatesInterfaceMod , only : hlm_hio_ignore_val + use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceMod , only : hlm_use_ed_st3 ! FIXME(bja, 2016-10) need to remove CLM dependancy - use EDPftvarcon , only : EDPftvarcon_inst + use EDPftvarcon , only : EDPftvarcon_inst ! CIME Globals - use shr_log_mod , only : errMsg => shr_log_errMsg - use shr_infnan_mod , only : isnan => shr_infnan_isnan - use FatesConstantsMod, only : g_per_kg - use FatesConstantsMod, only : ha_per_m2 - use FatesConstantsMod, only : days_per_sec - use FatesConstantsMod, only : sec_per_day - use FatesConstantsMod, only : days_per_year - use FatesConstantsMod, only : years_per_day + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : isnan => shr_infnan_isnan + use FatesConstantsMod , only : g_per_kg + use FatesConstantsMod , only : ha_per_m2 + use FatesConstantsMod , only : days_per_sec + use FatesConstantsMod , only : sec_per_day + use FatesConstantsMod , only : days_per_year + use FatesConstantsMod , only : years_per_day implicit none @@ -1094,7 +1097,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDtypesMod , only : AREA_INV use EDtypesMod , only : nlevsclass_ed use EDtypesMod , only : nlevage_ed - use EDtypesMod , only : do_ed_dynamics use EDtypesMod , only : nfsc use EDtypesMod , only : ncwd use EDtypesMod , only : ican_upper @@ -1283,7 +1285,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! If we don't have dynamics turned on, we just abort these diagnostics - if (.not.do_ed_dynamics) return + if (hlm_use_ed_st3.eq.itrue) return ! --------------------------------------------------------------------------------- ! Loop through the FATES scale hierarchy and fill the history IO arrays @@ -2160,10 +2162,8 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,dt_tstep) nlevsclass_ed use FatesHydraulicsMemMod, only : ed_cohort_hydr_type - use EDTypesMod , only : use_fates_plant_hydro use FatesHydraulicsMemMod, only : nlevsoi_hyd use EDTypesMod , only : nlevsclass_ed - use EDTypesMod , only : do_ed_dynamics use EDTypesMod , only : maxpft ! Arguments @@ -2199,7 +2199,7 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,dt_tstep) real(r8), parameter :: daysecs = 86400.0_r8 ! What modeler doesn't recognize 86400? real(r8), parameter :: yeardays = 365.0_r8 ! Should this be 365.25? - if(.not.use_fates_plant_hydro) return + if(hlm_use_planthydro.eq.ifalse) return associate( hio_errh2o_scpf => this%hvars(ih_errh2o_scpf)%r82d, & hio_tran_scpf => this%hvars(ih_tran_scpf)%r82d, & @@ -2373,7 +2373,7 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,dt_tstep) cpatch => cpatch%younger end do !patch loop - if(do_ed_dynamics) then + if(hlm_use_ed_st3.eq.ifalse) then do scpf=1,nlevsclass_ed*maxpft if( abs(hio_nplant_si_scpf(io_si, scpf)-ncohort_scpf(scpf)) > 1.0E-8_r8 ) then write(fates_log(),*) 'nplant check on hio_nplant_si_scpf fails during hydraulics history updates' @@ -2453,7 +2453,8 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use EDTypesMod , only : use_fates_plant_hydro + use FatesInterfaceMod , only : hlm_use_planthydro + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 @@ -3556,7 +3557,7 @@ subroutine define_history_vars(this, initialize_variables) ! PLANT HYDRAULICS - if(use_fates_plant_hydro) then + if(hlm_use_planthydro.eq.itrue) then call this%set_history_var(vname='FATES_ERRH2O_SCPF', units='kg/indiv/s', & long='mean individual water balance error', use_default='active', & diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index eca19a316c..e76531062c 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -276,6 +276,6 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) !end_run end select - end subroutine Flush + end subroutine Flush end module FatesHistoryVariableType diff --git a/main/FatesHydraulicsMemMod.F90 b/main/FatesHydraulicsMemMod.F90 index 71f921a7f6..e966a25532 100644 --- a/main/FatesHydraulicsMemMod.F90 +++ b/main/FatesHydraulicsMemMod.F90 @@ -5,8 +5,7 @@ module FatesHydraulicsMemMod implicit none - integer,parameter :: nlevsoi_hyd = 10 ! use_fates_plant_hydro parameter: - ! Number of soil layers for indexing + integer,parameter :: nlevsoi_hyd = 10 ! Number of soil layers for indexing ! cohort fine root quanitities diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 669a73b354..f6f70f75fa 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -19,9 +19,9 @@ module FatesInterfaceMod use EDTypesMod , only : nlevleaf use EDTypesMod , only : numpft_ed use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : itrue use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log - use EDTypesMod , only : use_fates_plant_hydro use FatesGlobals , only : endrun => fates_endrun ! CIME Globals @@ -104,11 +104,47 @@ module FatesInterfaceMod ! soil carbon ! 1 = TRUE, 0 = FALSE - ! SOON TO BE DEPRECATED, WILL BE READ IN VIA - ! FATES NL OR PARAM FILE. integer, protected :: hlm_use_spitfire ! This flag signals whether or not to use SPITFIRE ! 1 = TRUE, 0 = FALSE + integer, protected :: hlm_use_planthydro ! This flag signals whether or not to use + ! plant hydraulics (bchristo/xu methods) + ! 1 = TRUE, 0 = FALSE + ! THIS IS CURRENTLY NOT SUPPORTED + + integer, protected :: hlm_use_ed_st3 ! This flag signals whether or not to use + ! (ST)atic (ST)and (ST)ructure mode (ST3) + ! Essentially, this gives us the ability + ! to turn off "dynamics", ie growth, disturbance + ! recruitment and mortality. + ! (EXPERIMENTAL!!!!! - RGK 07-2017) + ! 1 = TRUE, 0 = FALSE + ! default should be FALSE (dynamics on) + ! cannot be true with prescribed_phys + + integer, protected :: hlm_use_ed_prescribed_phys ! This flag signals whether or not to use + ! prescribed physiology, somewhat the opposite + ! to ST3, in this case can turn off + ! fast processes like photosynthesis and respiration + ! and prescribe NPP + ! (NOT CURRENTLY IMPLEMENTED - PLACEHOLDER) + ! 1 = TRUE, 0 = FALSE + ! default should be FALSE (biophysics on) + ! cannot be true with st3 mode + + integer, protected :: hlm_use_inventory_init ! Initialize this simulation from + ! an inventory file. If this is toggled on + ! an inventory control file must be specified + ! as well. + ! 1 = TRUE, 0 = FALSE + + character(len=256), protected :: hlm_inventory_ctrl_file ! This is the full path to the + ! inventory control file that + ! specifieds the availabel inventory datasets + ! there locations and their formats + ! This need only be defined when + ! hlm_use_inventory_init = 1 + ! ------------------------------------------------------------------------------------- ! Parameters that are dictated by FATES and known to be required knowledge ! needed by the HLMs @@ -579,7 +615,7 @@ subroutine allocate_bcin(bc_in) allocate(bc_in%albgr_dif_rb(hlm_numSWb)) ! Plant-Hydro BC's - if (use_fates_plant_hydro) then + if (hlm_use_planthydro.eq.itrue) then allocate(bc_in%qflx_transp_pa(maxPatchesPerSite)) allocate(bc_in%swrad_net_pa(maxPatchesPerSite)) @@ -650,7 +686,7 @@ subroutine allocate_bcout(bc_out) allocate(bc_out%frac_veg_nosno_alb_pa(maxPatchesPerSite)) ! Plant-Hydro BC's - if (use_fates_plant_hydro) then + if (hlm_use_planthydro.eq.itrue) then allocate(bc_out%qflx_soil2root_sisl(hlm_numlevsoil)) end if @@ -695,7 +731,7 @@ subroutine zero_bcs(this,s) this%bc_in(s)%snow_depth_si = 0.0_r8 this%bc_in(s)%frac_sno_eff_si = 0.0_r8 - if (use_fates_plant_hydro) then + if (hlm_use_planthydro.eq.itrue) then this%bc_in(s)%qflx_transp_pa(:) = 0.0_r8 this%bc_in(s)%swrad_net_pa(:) = 0.0_r8 @@ -744,7 +780,7 @@ subroutine zero_bcs(this,s) this%bc_out(s)%canopy_fraction_pa(:) = 0.0_r8 this%bc_out(s)%frac_veg_nosno_alb_pa(:) = 0.0_r8 - if (use_fates_plant_hydro) then + if (hlm_use_planthydro.eq.itrue) then this%bc_out(s)%qflx_soil2root_sisl(:) = 0.0_r8 end if this%bc_out(s)%plant_stored_h2o_si = 0.0_r8 @@ -874,6 +910,11 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_ipedof = unset_int hlm_use_vertsoilc = unset_int hlm_use_spitfire = unset_int + hlm_use_planthydro = unset_int + hlm_use_ed_st3 = unset_int + hlm_use_ed_prescribed_phys = unset_int + hlm_use_inventory_init = unset_int + hlm_inventory_ctrl_file = 'unset' case('check_allset') @@ -903,11 +944,54 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if + + if ( .not.((hlm_use_planthydro.eq.1).or.(hlm_use_planthydro.eq.0)) ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'The FATES namelist planthydro flag must be 0 or 1, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if ( .not.((hlm_use_ed_st3.eq.1).or.(hlm_use_ed_st3.eq.0)) ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'The FATES namelist stand structure flag must be 0 or 1, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if ( .not.((hlm_use_ed_prescribed_phys.eq.1).or.(hlm_use_ed_prescribed_phys.eq.0)) ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'The FATES namelist prescribed physiology flag must be 0 or 1, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if ( hlm_use_ed_prescribed_phys.eq.1 .and. hlm_use_ed_st3.eq.1 ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'FATES ST3 and prescribed physiology cannot both be turned on.' + write(fates_log(), *) 'Review the namelist entries, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if ( .not.((hlm_use_inventory_init.eq.1).or.(hlm_use_inventory_init.eq.0)) ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'The FATES NL inventory flag must be 0 or 1, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if(trim(hlm_inventory_ctrl_file) .eq. 'unset') then + if (fates_global_verbose()) then + write(fates_log(),*) 'namelist entry for fates inventory control file is unset, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if if(hlm_ivis .ne. ivis) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES assumption about the index of visible shortwave' - write(fates_log(), *) 'radiation is different from the HLM' + write(fates_log(), *) 'radiation is different from the HLM, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -915,49 +999,49 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if(hlm_inir .ne. inir) then if (fates_global_verbose()) then write(fates_log(), *) 'FATES assumption about the index of NIR shortwave' - write(fates_log(), *) 'radiation is different from the HLM' + write(fates_log(), *) 'radiation is different from the HLM, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_is_restart .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'FATES parameter unset: hlm_is_restart' + write(fates_log(), *) 'FATES parameter unset: hlm_is_restart, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_numlevgrnd .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'FATES dimension/parameter unset: numlevground' + write(fates_log(), *) 'FATES dimension/parameter unset: numlevground, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_numlevsoil .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'FATES dimension/parameter unset: numlevground' + write(fates_log(), *) 'FATES dimension/parameter unset: numlevground, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_numlevdecomp_full .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'FATES dimension/parameter unset: numlevdecomp_full' + write(fates_log(), *) 'FATES dimension/parameter unset: numlevdecomp_full, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_numlevdecomp .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'FATES dimension/parameter unset: numlevdecomp' + write(fates_log(), *) 'FATES dimension/parameter unset: numlevdecomp, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(trim(hlm_name) .eq. 'unset') then if (fates_global_verbose()) then - write(fates_log(),*) 'FATES dimension/parameter unset: hlm_name' + write(fates_log(),*) 'FATES dimension/parameter unset: hlm_name, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -971,21 +1055,21 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if(hlm_ipedof .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'index for the HLMs pedotransfer function unset: hlm_ipedof' + write(fates_log(), *) 'index for the HLMs pedotransfer function unset: hlm_ipedof, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_use_vertsoilc .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc' + write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_use_spitfire .eq. unset_int) then if (fates_global_verbose()) then - write(fates_log(), *) 'switch for SPITFIRE unset: hlm_use_spitfire' + write(fates_log(), *) 'switch for SPITFIRE unset: hlm_use_spitfire, exiting' end if call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1071,6 +1155,30 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hlm_use_spitfire= ',ival,' to FATES' end if + + case('use_planthydro') + hlm_use_planthydro = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_planthydro= ',ival,' to FATES' + end if + + case('use_ed_st3') + hlm_use_ed_st3 = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_ed_st3= ',ival,' to FATES' + end if + + case('use_ed_prescribed_phys') + hlm_use_ed_prescribed_phys = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_ed_prescribed_phys= ',ival,' to FATES' + end if + + case('use_inventory_init') + hlm_use_inventory_init = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_inventory_init= ',ival,' to FATES' + end if case default if (fates_global_verbose()) then @@ -1105,6 +1213,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering the HLM name = ',trim(cval) end if + case('inventory_ctrl_file') + hlm_inventory_ctrl_file = trim(cval) + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering the name of the inventory control file = ',trim(cval) + end if + case default if (fates_global_verbose()) then write(fates_log(),*) 'tag not recognized:',trim(tag) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index dfd7d7d10f..634a0e9ad9 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -28,6 +28,7 @@ module FatesInventoryInitMod use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use FatesInterfaceMod, only : bc_in_type + use FatesInterfaceMod, only : hlm_inventory_ctrl_file use EDTypesMod , only : ed_site_type use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type @@ -47,9 +48,6 @@ module FatesInventoryInitMod type(ed_patch_type), pointer :: cpatch end type pp_array - ! For now we will use a hard-coded file name for the inventory file list - character(len=*), parameter :: inv_file_list = 'inventory_file_list.txt' - character(len=*), parameter, private :: sourcefile = __FILE__ logical, parameter :: debug_inv = .false. ! Debug flag for devs @@ -137,10 +135,10 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! ------------------------------------------------------------------------------------------ sitelist_file_unit = shr_file_getUnit() - inquire(file=trim(inv_file_list),exist=lexist,opened=lopen) + inquire(file=trim(hlm_inventory_ctrl_file),exist=lexist,opened=lopen) if( .not.lexist ) then ! The inventory file list DNE write(fates_log(), *) 'An inventory Initialization was requested.' - write(fates_log(), *) 'However the inventory file: ',trim(inv_file_list),' DNE' + write(fates_log(), *) 'However the inventory file: ',trim(hlm_inventory_ctrl_file),' DNE' write(fates_log(), *) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -150,7 +148,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - open(unit=sitelist_file_unit,file=trim(inv_file_list),status='OLD',action='READ',form='FORMATTED') + open(unit=sitelist_file_unit,file=trim(hlm_inventory_ctrl_file),status='OLD',action='READ',form='FORMATTED') rewind(sitelist_file_unit) ! There should be at least 1 line From 039c432cd603800c16be1be9c324a8da203228c5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 3 Aug 2017 15:03:18 -0700 Subject: [PATCH 13/23] Changed fire parameter names. Connected the mortality disturbance fraction parameter with the value that is read in. --- fire/SFMainMod.F90 | 12 +++++------ fire/SFParamsMod.F90 | 48 ++++++++++++++++++++++---------------------- main/EDParamsMod.F90 | 11 +++++----- 3 files changed, 35 insertions(+), 36 deletions(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index a595bcfe2f..013cf75c26 100755 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -555,8 +555,8 @@ subroutine ground_fuel_consumption ( currentSite ) !returns the the hypothetic fuel consumed by the fire use SFParamsMod, only : SF_val_miner_total, SF_val_min_moisture, & - SF_val_mid_moisture, SF_val_low_moisture_C, SF_val_low_moisture_S, & - SF_val_mid_moisture_C, SF_val_mid_moisture_S + SF_val_mid_moisture, SF_val_low_moisture_Coeff, SF_val_low_moisture_Slope, & + SF_val_mid_moisture_Coeff, SF_val_mid_moisture_Slope type(ed_site_type) , intent(in), target :: currentSite @@ -582,13 +582,13 @@ subroutine ground_fuel_consumption ( currentSite ) endif ! 2. Low to medium moistures if (moist > SF_val_min_moisture(c).and.moist <= SF_val_mid_moisture(c)) then - currentPatch%burnt_frac_litter(c) = max(0.0_r8,min(1.0_r8,SF_val_low_moisture_C(c)- & - SF_val_low_moisture_S(c)*moist)) + currentPatch%burnt_frac_litter(c) = max(0.0_r8,min(1.0_r8,SF_val_low_moisture_Coeff(c)- & + SF_val_low_moisture_Slope(c)*moist)) else ! For medium to high moistures. if (moist > SF_val_mid_moisture(c).and.moist <= 1.0_r8) then - currentPatch%burnt_frac_litter(c) = max(0.0_r8,min(1.0_r8,SF_val_mid_moisture_C(c)- & - SF_val_mid_moisture_S(c)*moist)) + currentPatch%burnt_frac_litter(c) = max(0.0_r8,min(1.0_r8,SF_val_mid_moisture_Coeff(c)- & + SF_val_mid_moisture_Slope(c)*moist)) endif endif diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index 514c58e12b..e2641b8885 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -31,10 +31,10 @@ module SFParamsMod real(r8),protected :: SF_val_FBD(NFSC) real(r8),protected :: SF_val_min_moisture(NFSC) real(r8),protected :: SF_val_mid_moisture(NFSC) - real(r8),protected :: SF_val_low_moisture_C(NFSC) - real(r8),protected :: SF_val_low_moisture_S(NFSC) - real(r8),protected :: SF_val_mid_moisture_C(NFSC) - real(r8),protected :: SF_val_mid_moisture_S(NFSC) + real(r8),protected :: SF_val_low_moisture_Coeff(NFSC) + real(r8),protected :: SF_val_low_moisture_Slope(NFSC) + real(r8),protected :: SF_val_mid_moisture_Coeff(NFSC) + real(r8),protected :: SF_val_mid_moisture_Slope(NFSC) character(len=param_string_length),parameter :: SF_name_fdi_a = "fates_fdi_a" character(len=param_string_length),parameter :: SF_name_fdi_b = "fates_fdi_b" @@ -53,10 +53,10 @@ module SFParamsMod character(len=param_string_length),parameter :: SF_name_FBD = "fates_FBD" character(len=param_string_length),parameter :: SF_name_min_moisture = "fates_min_moisture" character(len=param_string_length),parameter :: SF_name_mid_moisture = "fates_mid_moisture" - character(len=param_string_length),parameter :: SF_name_low_moisture_C = "fates_low_moisture_C" - character(len=param_string_length),parameter :: SF_name_low_moisture_S = "fates_low_moisture_S" - character(len=param_string_length),parameter :: SF_name_mid_moisture_C = "fates_mid_moisture_C" - character(len=param_string_length),parameter :: SF_name_mid_moisture_S = "fates_mid_moisture_S" + character(len=param_string_length),parameter :: SF_name_low_moisture_Coeff = "fates_low_moisture_Coeff" + character(len=param_string_length),parameter :: SF_name_low_moisture_Slope = "fates_low_moisture_Slope" + character(len=param_string_length),parameter :: SF_name_mid_moisture_Coeff = "fates_mid_moisture_Coeff" + character(len=param_string_length),parameter :: SF_name_mid_moisture_Slope = "fates_mid_moisture_Slope" public :: SpitFireRegisterParams public :: SpitFireReceiveParams @@ -101,10 +101,10 @@ subroutine SpitFireParamsInit() SF_val_FBD(:) = nan SF_val_min_moisture(:) = nan SF_val_mid_moisture(:) = nan - SF_val_low_moisture_C(:) = nan - SF_val_low_moisture_S(:) = nan - SF_val_mid_moisture_C(:) = nan - SF_val_mid_moisture_S(:) = nan + SF_val_low_moisture_Coeff(:) = nan + SF_val_low_moisture_Slope(:) = nan + SF_val_mid_moisture_Coeff(:) = nan + SF_val_mid_moisture_Slope(:) = nan end subroutine SpitFireParamsInit @@ -276,16 +276,16 @@ subroutine SpitFireRegisterNFSC(fates_params) call fates_params%RegisterParameter(name=SF_name_mid_moisture, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=SF_name_low_moisture_C, dimension_shape=dimension_shape_1d, & + call fates_params%RegisterParameter(name=SF_name_low_moisture_Coeff, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=SF_name_low_moisture_S, dimension_shape=dimension_shape_1d, & + call fates_params%RegisterParameter(name=SF_name_low_moisture_Slope, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=SF_name_mid_moisture_C, dimension_shape=dimension_shape_1d, & + call fates_params%RegisterParameter(name=SF_name_mid_moisture_Coeff, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=SF_name_mid_moisture_S, dimension_shape=dimension_shape_1d, & + call fates_params%RegisterParameter(name=SF_name_mid_moisture_Slope, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) call fates_params%RegisterParameter(name=SF_name_alpha_FMC, dimension_shape=dimension_shape_1d, & @@ -318,17 +318,17 @@ subroutine SpitFireReceiveNFSC(fates_params) call fates_params%RetreiveParameter(name=SF_name_mid_moisture, & data=SF_val_mid_moisture) - call fates_params%RetreiveParameter(name=SF_name_low_moisture_C, & - data=SF_val_low_moisture_C) + call fates_params%RetreiveParameter(name=SF_name_low_moisture_Coeff, & + data=SF_val_low_moisture_Coeff) - call fates_params%RetreiveParameter(name=SF_name_low_moisture_S, & - data=SF_val_low_moisture_S) + call fates_params%RetreiveParameter(name=SF_name_low_moisture_Slope, & + data=SF_val_low_moisture_Slope) - call fates_params%RetreiveParameter(name=SF_name_mid_moisture_C, & - data=SF_val_mid_moisture_C) + call fates_params%RetreiveParameter(name=SF_name_mid_moisture_Coeff, & + data=SF_val_mid_moisture_Coeff) - call fates_params%RetreiveParameter(name=SF_name_mid_moisture_S, & - data=SF_val_mid_moisture_S) + call fates_params%RetreiveParameter(name=SF_name_mid_moisture_Slope, & + data=SF_val_mid_moisture_Slope) call fates_params%RetreiveParameter(name=SF_name_alpha_FMC, & data=SF_val_alpha_FMC) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index c3621923c0..fc41c5ba9a 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -15,9 +15,9 @@ module EDParamsMod ! this is what the user can use for the actual values ! - real(r8),protected :: ED_size_diagnostic_scale ! Flag to switch between a linear and exponential - ! scale on the plant size axis in diagnostics (NOT USED YET) - real(r8),protected :: ED_mort_disturb_frac ! the fraction of canopy mortality that results in disturbance + real(r8),protected :: ED_size_diagnostic_scale ! Flag to switch between a linear and exponential + ! scale on the plant size axis in diagnostics (NOT USED YET) + real(r8),protected :: fates_mortality_disturbance_fraction ! the fraction of canopy mortality that results in disturbance real(r8),protected :: ED_val_grass_spread real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort @@ -74,7 +74,6 @@ module EDParamsMod public :: FatesRegisterParams public :: FatesReceiveParams - real(r8), protected :: fates_mortality_disturbance_fraction = 1.0_r8 ! the fraction of canopy mortality that results in disturbance (i.e. transfer of area from new to old patch) contains @@ -88,7 +87,7 @@ subroutine FatesParamsInit() implicit none ED_size_diagnostic_scale = nan - ED_mort_disturb_frac = nan + fates_mortality_disturbance_fraction = nan ED_val_grass_spread = nan ED_val_comp_excln = nan ED_val_stress_mort = nan @@ -232,7 +231,7 @@ subroutine FatesReceiveParams(fates_params) data=ED_size_diagnostic_scale) call fates_params%RetreiveParameter(name=ED_name_mort_disturb_frac, & - data=ED_mort_disturb_frac) + data=fates_mortality_disturbance_fraction) call fates_params%RetreiveParameter(name=ED_name_grass_spread, & data=ED_val_grass_spread) From dd96bc8e96825f2a56df2c58b5610f43d872d403 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 8 Aug 2017 16:20:49 -0700 Subject: [PATCH 14/23] Added hydraulics parameters and wind_max parameter to fire. --- fire/SFMainMod.F90 | 10 ++- fire/SFParamsMod.F90 | 11 ++- main/EDPftvarcon.F90 | 134 +++++++++++++++++++++++++++++- main/FatesParametersInterface.F90 | 1 + 4 files changed, 149 insertions(+), 7 deletions(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 013cf75c26..1c0d967ae7 100755 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -391,8 +391,11 @@ subroutine rate_of_spread ( currentSite ) !Routine called daily from within ED within a site loop. !Returns the updated currentPatch%ROS_front value for each patch. - use SFParamsMod, only : SF_val_miner_total, SF_val_part_dens, & - SF_val_miner_damp, SF_val_fuel_energy + use SFParamsMod, only : SF_val_miner_total, & + SF_val_part_dens, & + SF_val_miner_damp, & + SF_val_fuel_energy, & + SF_val_wind_max use FatesInterfaceMod, only : hlm_current_day, hlm_current_month type(ed_site_type), intent(in), target :: currentSite @@ -409,7 +412,6 @@ subroutine rate_of_spread ( currentSite ) real(r8) beta_ratio ! ratio of beta/beta_op real(r8) a_beta ! dummy variable for product of a* beta_ratio for react_v_opt equation real(r8) a,b,c,e ! function of fuel sav - real(r8),parameter::wind_max = 45.718_r8 !max wind speed (m/min)=150 ft/min per Lasslop etal 2014 real(r8) wind_elev_fire !wind speed (m/min) at elevevation relevant for fire logical,parameter :: debug_windspeed = .false. !for debugging @@ -479,7 +481,7 @@ subroutine rate_of_spread ( currentSite ) ! convert wind_elev_fire from m/min to ft/min for Rothermel ROS eqn ! wind max per Lasslop et al 2014 to linearly reduce ROS for high wind speeds !OLD! phi_wind = c * ((3.281_r8*currentPatch%effect_wspeed)**b)*(beta_ratio**(-e)) - if (currentPatch%effect_wspeed .le. wind_max) then + if (currentPatch%effect_wspeed .le. SF_val_wind_max) then wind_elev_fire = currentPatch%effect_wspeed phi_wind = c * ((3.281_r8*wind_elev_fire)**b)*(beta_ratio**(-e)) if (debug_windspeed) write(fates_log(),*) 'SF wind LESS max ', currentPatch%effect_wspeed diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index e2641b8885..7de8b5861d 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -24,6 +24,7 @@ module SFParamsMod real(r8),protected :: SF_val_max_durat real(r8),protected :: SF_val_durat_slope real(r8),protected :: SF_val_alpha_SH + real(r8),protected :: SF_val_wind_max ! Maximum wind speed expected by fire model (m/min) real(r8),protected :: SF_val_alpha_FMC(NFSC) real(r8),protected :: SF_val_CWD_frac(NCWD) real(r8),protected :: SF_val_max_decomp(NFSC) @@ -57,6 +58,7 @@ module SFParamsMod character(len=param_string_length),parameter :: SF_name_low_moisture_Slope = "fates_low_moisture_Slope" character(len=param_string_length),parameter :: SF_name_mid_moisture_Coeff = "fates_mid_moisture_Coeff" character(len=param_string_length),parameter :: SF_name_mid_moisture_Slope = "fates_mid_moisture_Slope" + character(len=param_string_length),parameter :: SF_name_wind_max = "fates_fire_wind_max" public :: SpitFireRegisterParams public :: SpitFireReceiveParams @@ -91,6 +93,7 @@ subroutine SpitFireParamsInit() SF_val_max_durat = nan SF_val_durat_slope = nan SF_val_alpha_SH = nan + SF_val_wind_max = nan SF_val_CWD_frac(:) = nan @@ -149,6 +152,9 @@ subroutine SpitFireRegisterScalars(fates_params) class(fates_parameters_type), intent(inout) :: fates_params character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) + + call fates_params%RegisterParameter(name=SF_name_wind_max, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) call fates_params%RegisterParameter(name=SF_name_fdi_a, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -190,7 +196,10 @@ subroutine SpitFireReceiveScalars(fates_params) implicit none class(fates_parameters_type), intent(inout) :: fates_params - + + call fates_params%RetreiveParameter(name=SF_name_wind_max, & + data=SF_val_wind_max) + call fates_params%RetreiveParameter(name=SF_name_fdi_a, & data=SF_val_fdi_a) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 4495b650f7..313512d4f5 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -116,7 +116,26 @@ module EDPftvarcon real(r8), allocatable :: allom_agb3(:) ! Parameter 3 for agb allometry real(r8), allocatable :: allom_agb4(:) ! Parameter 3 for agb allometry - + ! Plant Hydraulic Parameters + ! --------------------------------------------------------------------------------------------- + + ! PFT Dimension + real(r8), allocatable :: hydr_p_taper(:) ! xylem taper exponent + real(r8), allocatable :: hydr_rs2(:) ! absorbing root radius (mm) + real(r8), allocatable :: hydr_srl(:) ! specific root length (m g-1) + real(r8), allocatable :: hydr_rfrac_stem(:) ! fraction of total tree resistance from troot to canopy + real(r8), allocatable :: hydr_kmax_stem(:) ! maximum xylem conductivity per unit sapwood area (kg m-1 s-1 MPa) + real(r8), allocatable :: hydr_avuln_gs(:) ! + real(r8), allocatable :: hydr_p50_gs(:) ! + + ! PFT x Organ Dimension (organs are: 1=leaf, 2=stem, 3=transporting root, 4=absorbing root) + real(r8), allocatable :: hydr_avuln_node(:,:) ! xylem vulernability curve shape parameter + real(r8), allocatable :: hydr_p50_node(:,:) ! xylem water potential at 50% conductivity loss (MPa) + real(r8), allocatable :: hydr_thetas_node(:,:) ! saturated water content (cm3/cm3) + real(r8), allocatable :: hydr_epsil_node(:,:) ! bulk elastic modulus (MPa) + real(r8), allocatable :: hydr_pitlp_node(:,:) ! turgor loss point (MPa) + real(r8), allocatable :: hydr_resid_node(:,:) ! residual fraction (fraction) + contains procedure, public :: Init => EDpftconInit procedure, public :: Register @@ -125,6 +144,8 @@ module EDPftvarcon procedure, private :: Receive_PFT procedure, private :: Register_PFT_nvariants procedure, private :: Receive_PFT_nvariants + procedure, private :: Register_PFT_hydr_organs + procedure, private :: Receive_PFT_hydr_organs procedure, private :: Register_PFT_numrad procedure, private :: Receive_PFT_numrad end type EDPftvarcon_type @@ -155,6 +176,7 @@ end subroutine EDpftconInit subroutine Register(this, fates_params) use FatesParametersInterface, only : fates_parameters_type + use FatesInterfaceMod , only : hlm_use_planthydro implicit none @@ -164,7 +186,8 @@ subroutine Register(this, fates_params) call this%Register_PFT(fates_params) call this%Register_PFT_numrad(fates_params) call this%Register_PFT_nvariants(fates_params) - + call this%Register_PFT_hydr_organs(fates_params) + end subroutine Register !----------------------------------------------------------------------- @@ -180,6 +203,7 @@ subroutine Receive(this, fates_params) call this%Receive_PFT(fates_params) call this%Receive_PFT_numrad(fates_params) call this%Receive_PFT_nvariants(fates_params) + call this%Receive_PFT_hydr_organs(fates_params) end subroutine Receive @@ -448,6 +472,34 @@ 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_hydr_p_taper' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_rs2' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_srl' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_rfrac_stem' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_kmax_stem' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_avuln_gs' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_p50_gs' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_bmort' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -788,6 +840,34 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_agb4) + name = 'fates_hydr_p_taper' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_p_taper) + + name = 'fates_hydr_rs2' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_rs2) + + name = 'fates_hydr_srl' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_srl) + + name = 'fates_hydr_rfrac_stem' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_rfrac_stem) + + name = 'fates_hydr_kmax_stem' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_kmax_stem) + + name = 'fates_hydr_avuln_gs' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_avuln_gs) + + name = 'fates_hydr_p50_gs' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_p50_gs) + name = 'fates_bmort' call fates_params%RetreiveParameterAllocate(name=name, & data=this%bmort) @@ -1085,5 +1165,55 @@ subroutine Receive_PFT_nvariants(this, fates_params) end subroutine Receive_PFT_nvariants + ! ----------------------------------------------------------------------- + + subroutine Register_PFT_hydr_organs(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : max_dimensions, dimension_name_hydr_organs + use FatesParametersInterface, only : dimension_name_pft, dimension_shape_2d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + integer, parameter :: dim_lower_bound(2) = (/ lower_bound_pft, lower_bound_general /) + character(len=param_string_length) :: dim_names(2) + character(len=param_string_length) :: name + + ! NOTE(bja, 2017-01) initialization doesn't seem to work correctly + ! if dim_names has a parameter qualifier. + dim_names(1) = dimension_name_pft + dim_names(2) = dimension_name_hydr_organs + + name = 'fates_hydr_avuln_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + end subroutine Register_PFT_hydr_organs + + !----------------------------------------------------------------------- + + subroutine Receive_PFT_hydr_organs(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + name = 'fates_hydr_avuln_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_avuln_node) + + end subroutine Receive_PFT_hydr_organs + + + end module EDPftvarcon diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index 007dd78d71..bb0cc1f795 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -28,6 +28,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_fsc = 'fates_litterclass' character(len=*), parameter, public :: dimension_name_allpfts = 'fates_allpfts' character(len=*), parameter, public :: dimension_name_variants = 'fates_variants' + character(len=*), parameter, public :: dimension_name_hydr_organs = 'fates_hydr_organs' ! Dimensions in the host namespace: character(len=*), parameter, public :: dimension_name_host_allpfts = 'allpfts' From 2bfe750f1c4798b4224bda8f5d1ad52a81ff3f3c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 9 Aug 2017 18:20:16 -0700 Subject: [PATCH 15/23] Updated hydraulics parameters. Added logging parameters. Added calls to report parameter values to the log file. --- main/EDParamsMod.F90 | 186 +++++++++++++++++++++++----- main/EDPftvarcon.F90 | 199 +++++++++++++++++++++++++++--- main/FatesInterfaceMod.F90 | 21 ++++ main/FatesParameterDerivedMod.F90 | 1 + 4 files changed, 361 insertions(+), 46 deletions(-) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index fc41c5ba9a..05f5618b98 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -2,10 +2,16 @@ module EDParamsMod ! ! module that deals with reading the ED parameter file ! - use shr_kind_mod , only: r8 => shr_kind_r8 + use EDtypesMod , only: maxPft use FatesParametersInterface, only : param_string_length - + use FatesGlobals , only : fates_log + use FatesGlobals , only : endrun => fates_endrun + + ! CIME Globals + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none save ! private - if we allow this module to be private, it does not allow the protected values below to be @@ -69,11 +75,36 @@ module EDParamsMod character(len=param_string_length),parameter :: ED_name_phen_coldtemp= "fates_phen_coldtemp" character(len=param_string_length),parameter :: ED_name_cohort_fusion_tol= "fates_cohort_fusion_tol" character(len=param_string_length),parameter :: ED_name_patch_fusion_tol= "fates_patch_fusion_tol" + + ! Hydraulics Control Parameters (ONLY RELEVANT WHEN USE_FATES_HYDR = TRUE) + ! ---------------------------------------------------------------------------------------------- + real(r8),protected :: hydr_psi0 ! sapwood water potential at saturation (MPa) + character(len=param_string_length),parameter :: hydr_name_psi0 = "fates_hydr_psi0" + + real(r8),protected :: hydr_psicap ! sapwood water potential at which capillary reserves exhausted (MPa) + character(len=param_string_length),parameter :: hydr_name_psicap = "fates_hydr_psicap" + + + ! Logging Control Parameters (ONLY RELEVANT WHEN USE_FATES_LOGGING = TRUE) + ! ---------------------------------------------------------------------------------------------- + + real(r8),protected :: logging_dbhmin ! Minimum dbh at which logging is applied (cm) + character(len=param_string_length),parameter :: logging_name_dbhmin = "fates_logging_dbhmin" + + real(r8),protected :: logging_collateral_ratio ! Ratio of collateral mortality to direct logging mortality + character(len=param_string_length),parameter :: logging_name_collateral_ratio = "fates_logging_collateral_ratio" + + real(r8),protected :: logging_per_event_fraction ! Fraction of stems logged per event + character(len=param_string_length),parameter :: logging_name_per_event_fraction = "fates_logging_per_event_fraction" + + real(r8),protected :: logging_event_code ! Code that options how logging events are structured + character(len=param_string_length),parameter :: logging_name_event_code = "fates_logging_event_code" + public :: FatesParamsInit public :: FatesRegisterParams public :: FatesReceiveParams - + public :: FatesReportParams contains @@ -86,32 +117,40 @@ subroutine FatesParamsInit() implicit none - ED_size_diagnostic_scale = nan - fates_mortality_disturbance_fraction = nan - ED_val_grass_spread = nan - ED_val_comp_excln = nan - ED_val_stress_mort = nan - ED_val_maxspread = nan - ED_val_minspread = nan - ED_val_init_litter = nan - ED_val_nignitions = nan - ED_val_understorey_death = nan - ED_val_cwd_fcel = nan - ED_val_cwd_flig = nan - ED_val_bbopt_c3 = nan - ED_val_bbopt_c4 = nan - ED_val_base_mr_20 = nan - ED_val_phen_drought_threshold = nan - ED_val_phen_doff_time = nan - ED_val_phen_a = nan - ED_val_phen_b = nan - ED_val_phen_c = nan - ED_val_phen_chiltemp = nan - ED_val_phen_mindayson = nan - ED_val_phen_ncolddayslim = nan - ED_val_phen_coldtemp = nan - ED_val_cohort_fusion_tol = nan - ED_val_patch_fusion_tol = nan + ED_size_diagnostic_scale = nan + fates_mortality_disturbance_fraction = nan + ED_val_grass_spread = nan + ED_val_comp_excln = nan + ED_val_stress_mort = nan + ED_val_maxspread = nan + ED_val_minspread = nan + ED_val_init_litter = nan + ED_val_nignitions = nan + ED_val_understorey_death = nan + ED_val_cwd_fcel = nan + ED_val_cwd_flig = nan + ED_val_bbopt_c3 = nan + ED_val_bbopt_c4 = nan + ED_val_base_mr_20 = nan + ED_val_phen_drought_threshold = nan + ED_val_phen_doff_time = nan + ED_val_phen_a = nan + ED_val_phen_b = nan + ED_val_phen_c = nan + ED_val_phen_chiltemp = nan + ED_val_phen_mindayson = nan + ED_val_phen_ncolddayslim = nan + ED_val_phen_coldtemp = nan + ED_val_cohort_fusion_tol = nan + ED_val_patch_fusion_tol = nan + + hydr_psi0 = nan + hydr_psicap = nan + + logging_dbhmin = nan + logging_collateral_ratio = nan + logging_per_event_fraction = nan + logging_event_code = nan end subroutine FatesParamsInit @@ -215,6 +254,25 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_patch_fusion_tol, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) + call fates_params%RegisterParameter(name=hydr_name_psi0, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=hydr_name_psicap, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=logging_name_dbhmin, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=logging_name_collateral_ratio, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=logging_name_per_event_fraction, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=logging_name_event_code, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + end subroutine FatesRegisterParams @@ -310,7 +368,77 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=ED_name_patch_fusion_tol, & data=ED_val_patch_fusion_tol) + + call fates_params%RetreiveParameter(name=hydr_name_psi0, & + data=hydr_psi0) + + call fates_params%RetreiveParameter(name=hydr_name_psicap, & + data=hydr_psicap) + + call fates_params%RetreiveParameter(name=logging_name_dbhmin, & + data=logging_dbhmin) + + call fates_params%RetreiveParameter(name=logging_name_collateral_ratio, & + data=logging_collateral_ratio) + + call fates_params%RetreiveParameter(name=logging_name_per_event_fraction, & + data=logging_per_event_fraction) + + call fates_params%RetreiveParameter(name=logging_name_event_code, & + data=logging_event_code) end subroutine FatesReceiveParams + ! ===================================================================================== + + subroutine FatesReportParams(is_master) + + logical,intent(in) :: is_master + + logical, parameter :: debug_report = .true. + + if(debug_report .and. is_master) then + + write(fates_log(),*) '----------- FATES Scalar Parameters -----------------' + write(fates_log(),*) 'ED_size_diagnostic_scale = ',ED_size_diagnostic_scale + write(fates_log(),*) 'fates_mortality_disturbance_fraction = ',fates_mortality_disturbance_fraction + write(fates_log(),*) 'ED_val_grass_spread = ',ED_val_grass_spread + write(fates_log(),*) 'ED_val_comp_excln = ',ED_val_comp_excln + write(fates_log(),*) 'ED_val_grass_spread = ',ED_val_grass_spread + write(fates_log(),*) 'ED_val_comp_excln = ', ED_val_comp_excln + write(fates_log(),*) 'ED_val_stress_mort = ',ED_val_stress_mort + write(fates_log(),*) 'ED_val_maxspread = ',ED_val_maxspread + write(fates_log(),*) 'ED_val_minspread = ',ED_val_minspread + write(fates_log(),*) 'ED_val_init_litter = ',ED_val_init_litter + write(fates_log(),*) 'ED_val_nignitions = ',ED_val_nignitions + write(fates_log(),*) 'ED_val_understorey_death = ',ED_val_understorey_death + write(fates_log(),*) 'ED_val_cwd_fcel = ',ED_val_cwd_fcel + write(fates_log(),*) 'ED_val_cwd_flig = ',ED_val_cwd_flig + write(fates_log(),*) 'ED_val_bbopt_c3 = ',ED_val_bbopt_c3 + write(fates_log(),*) 'ED_val_bbopt_c4 = ',ED_val_bbopt_c4 + write(fates_log(),*) 'ED_val_base_mr_20 = ', ED_val_base_mr_20 + write(fates_log(),*) 'ED_val_phen_drought_threshold = ',ED_val_phen_drought_threshold + write(fates_log(),*) 'ED_val_phen_doff_time = ',ED_val_phen_doff_time + write(fates_log(),*) 'ED_val_phen_a = ',ED_val_phen_a + write(fates_log(),*) 'ED_val_phen_b = ',ED_val_phen_b + write(fates_log(),*) 'ED_val_phen_c = ',ED_val_phen_c + write(fates_log(),*) 'ED_val_phen_chiltemp = ',ED_val_phen_chiltemp + write(fates_log(),*) 'ED_val_phen_mindayson = ',ED_val_phen_mindayson + write(fates_log(),*) 'ED_val_phen_ncolddayslim = ',ED_val_phen_ncolddayslim + write(fates_log(),*) 'ED_val_phen_coldtemp = ',ED_val_phen_coldtemp + write(fates_log(),*) 'ED_val_cohort_fusion_tol = ',ED_val_cohort_fusion_tol + write(fates_log(),*) 'ED_val_patch_fusion_tol = ',ED_val_patch_fusion_tol + write(fates_log(),*) 'hydr_psi0 = ',hydr_psi0 + write(fates_log(),*) 'hydr_psicap = ',hydr_psicap + write(fates_log(),*) 'logging_dbhmin = ',logging_dbhmin + write(fates_log(),*) 'logging_collateral_ratio = ',logging_collateral_ratio + write(fates_log(),*) 'logging_per_event_fraction = ',logging_per_event_fraction + write(fates_log(),*) 'logging_event_code = ',logging_event_code + write(fates_log(),*) '------------------------------------------------------' + + end if + + end subroutine FatesReportParams + + end module EDParamsMod diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 313512d4f5..342375d661 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -6,10 +6,14 @@ module EDPftvarcon ! read and initialize vegetation (PFT) constants. ! ! !USES: - use EDTypesMod , only : maxSWb, ivis, inir - use shr_kind_mod, only : r8 => shr_kind_r8 + use EDTypesMod , only : maxSWb, ivis, inir + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_log + use FatesGlobals, only : endrun => fates_endrun - use FatesGlobals, only : fates_log + ! CIME Globals + use shr_log_mod , only : errMsg => shr_log_errMsg + ! ! !PUBLIC TYPES: implicit none @@ -124,9 +128,8 @@ module EDPftvarcon real(r8), allocatable :: hydr_rs2(:) ! absorbing root radius (mm) real(r8), allocatable :: hydr_srl(:) ! specific root length (m g-1) real(r8), allocatable :: hydr_rfrac_stem(:) ! fraction of total tree resistance from troot to canopy - real(r8), allocatable :: hydr_kmax_stem(:) ! maximum xylem conductivity per unit sapwood area (kg m-1 s-1 MPa) - real(r8), allocatable :: hydr_avuln_gs(:) ! - real(r8), allocatable :: hydr_p50_gs(:) ! + real(r8), allocatable :: hydr_avuln_gs(:) ! shape parameter for stomatal control of water vapor exiting leaf + real(r8), allocatable :: hydr_p50_gs(:) ! water potential at 50% loss of stomatal conductance ! PFT x Organ Dimension (organs are: 1=leaf, 2=stem, 3=transporting root, 4=absorbing root) real(r8), allocatable :: hydr_avuln_node(:,:) ! xylem vulernability curve shape parameter @@ -135,6 +138,8 @@ module EDPftvarcon real(r8), allocatable :: hydr_epsil_node(:,:) ! bulk elastic modulus (MPa) real(r8), allocatable :: hydr_pitlp_node(:,:) ! turgor loss point (MPa) real(r8), allocatable :: hydr_resid_node(:,:) ! residual fraction (fraction) + real(r8), allocatable :: hydr_fcap_node(:,:) ! fraction of (1-resid_node) that is capillary in source + real(r8), allocatable :: hydr_pinot_node(:,:) ! osmotic potential at full turgor contains procedure, public :: Init => EDpftconInit @@ -156,7 +161,7 @@ module EDPftvarcon __FILE__ ! ! !PUBLIC MEMBER FUNCTIONS: - + public :: FatesReportPFTParams !----------------------------------------------------------------------- contains @@ -176,7 +181,6 @@ end subroutine EDpftconInit subroutine Register(this, fates_params) use FatesParametersInterface, only : fates_parameters_type - use FatesInterfaceMod , only : hlm_use_planthydro implicit none @@ -488,10 +492,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_hydr_kmax_stem' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_hydr_avuln_gs' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -856,10 +856,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%hydr_rfrac_stem) - name = 'fates_hydr_kmax_stem' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%hydr_kmax_stem) - name = 'fates_hydr_avuln_gs' call fates_params%RetreiveParameterAllocate(name=name, & data=this%hydr_avuln_gs) @@ -1191,6 +1187,35 @@ subroutine Register_PFT_hydr_organs(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_hydr_p50_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_thetas_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_epsil_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_pitlp_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_resid_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_fcap_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_pinot_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + end subroutine Register_PFT_hydr_organs !----------------------------------------------------------------------- @@ -1211,9 +1236,149 @@ subroutine Receive_PFT_hydr_organs(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%hydr_avuln_node) - end subroutine Receive_PFT_hydr_organs + name = 'fates_hydr_p50_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_p50_node) + + name = 'fates_hydr_thetas_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_thetas_node) + + name = 'fates_hydr_epsil_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_epsil_node) + + name = 'fates_hydr_pitlp_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_pitlp_node) + + name = 'fates_hydr_resid_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_resid_node) + + name = 'fates_hydr_fcap_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_fcap_node) + + end subroutine Receive_PFT_hydr_organs + ! =============================================================================================== + + subroutine FatesReportPFTParams(is_master) + + ! Argument + logical, intent(in) :: is_master ! Only log if this is the master proc + + logical, parameter :: debug_report = .true. + + if(debug_report .and. is_master) then + + write(fates_log(),*) '----------- FATES PFT Parameters -----------------' + write(fates_log(),*) 'pft_used = ',EDPftvarcon_inst%pft_used + write(fates_log(),*) 'max_dbh = ',EDPftvarcon_inst%max_dbh + write(fates_log(),*) 'freezetol = ',EDPftvarcon_inst%freezetol + write(fates_log(),*) 'wood_density = ',EDPftvarcon_inst%wood_density + write(fates_log(),*) 'hgt_min = ',EDPftvarcon_inst%hgt_min + write(fates_log(),*) 'dleaf = ',EDPftvarcon_inst%dleaf + write(fates_log(),*) 'z0mr = ',EDPftvarcon_inst%z0mr + write(fates_log(),*) 'displar = ',EDPftvarcon_inst%displar + write(fates_log(),*) 'cushion = ',EDPftvarcon_inst%cushion + write(fates_log(),*) 'leaf_stor_priority = ',EDPftvarcon_inst%leaf_stor_priority + write(fates_log(),*) 'crown = ',EDPftvarcon_inst%crown + write(fates_log(),*) 'bark_scaler = ',EDPftvarcon_inst%bark_scaler + write(fates_log(),*) 'crown_kill = ',EDPftvarcon_inst%crown_kill + write(fates_log(),*) 'initd = ',EDPftvarcon_inst%initd + write(fates_log(),*) 'seed_rain = ',EDPftvarcon_inst%seed_rain + write(fates_log(),*) 'BB_slope = ',EDPftvarcon_inst%BB_slope + write(fates_log(),*) 'root_long = ',EDPftvarcon_inst%root_long + write(fates_log(),*) 'clone_alloc = ',EDPftvarcon_inst%clone_alloc + write(fates_log(),*) 'seed_alloc = ',EDPftvarcon_inst%seed_alloc + write(fates_log(),*) 'woody = ',EDPftvarcon_inst%woody + write(fates_log(),*) 'stress_decid = ',EDPftvarcon_inst%stress_decid + write(fates_log(),*) 'season_decid = ',EDPftvarcon_inst%season_decid + write(fates_log(),*) 'evergreen = ',EDPftvarcon_inst%evergreen + write(fates_log(),*) 'slatop = ',EDPftvarcon_inst%slatop + write(fates_log(),*) 'leaf_long = ',EDPftvarcon_inst%leaf_long + write(fates_log(),*) 'roota_par = ',EDPftvarcon_inst%roota_par + write(fates_log(),*) 'rootb_par = ',EDPftvarcon_inst%rootb_par + write(fates_log(),*) 'lf_flab = ',EDPftvarcon_inst%lf_flab + write(fates_log(),*) 'lf_fcel = ',EDPftvarcon_inst%lf_fcel + write(fates_log(),*) 'lf_flig = ',EDPftvarcon_inst%lf_flig + write(fates_log(),*) 'fr_flab = ',EDPftvarcon_inst%fr_flab + write(fates_log(),*) 'fr_fcel = ',EDPftvarcon_inst%fr_fcel + write(fates_log(),*) 'fr_flig = ',EDPftvarcon_inst%fr_flig + write(fates_log(),*) 'xl = ',EDPftvarcon_inst%xl + write(fates_log(),*) 'c3psn = ',EDPftvarcon_inst%c3psn + write(fates_log(),*) 'vcmax25top = ',EDPftvarcon_inst%vcmax25top + write(fates_log(),*) 'leafcn = ',EDPftvarcon_inst%leafcn + write(fates_log(),*) 'frootcn = ',EDPftvarcon_inst%frootcn + write(fates_log(),*) 'smpso = ',EDPftvarcon_inst%smpso + write(fates_log(),*) 'smpsc = ',EDPftvarcon_inst%smpsc + write(fates_log(),*) 'grperc = ',EDPftvarcon_inst%grperc + write(fates_log(),*) 'bmort = ',EDPftvarcon_inst%bmort + write(fates_log(),*) 'hf_sm_threshold = ',EDPftvarcon_inst%hf_sm_threshold + write(fates_log(),*) 'vcmaxha = ',EDPftvarcon_inst%vcmaxha + write(fates_log(),*) 'jmaxha = ',EDPftvarcon_inst%jmaxha + write(fates_log(),*) 'tpuha = ',EDPftvarcon_inst%tpuha + write(fates_log(),*) 'vcmaxhd = ',EDPftvarcon_inst%vcmaxhd + write(fates_log(),*) 'jmaxhd = ',EDPftvarcon_inst%jmaxhd + write(fates_log(),*) 'tpuhd = ',EDPftvarcon_inst%tpuhd + write(fates_log(),*) 'vcmaxse = ',EDPftvarcon_inst%vcmaxse + write(fates_log(),*) 'jmaxse = ',EDPftvarcon_inst%jmaxse + write(fates_log(),*) 'tpuse = ',EDPftvarcon_inst%tpuse + write(fates_log(),*) 'germination_timescale = ',EDPftvarcon_inst%germination_timescale + write(fates_log(),*) 'seed_decay_turnover = ',EDPftvarcon_inst%seed_decay_turnover + write(fates_log(),*) 'branch_turnover = ',EDPftvarcon_inst%branch_turnover + write(fates_log(),*) 'trim_limit = ',EDPftvarcon_inst%trim_limit + write(fates_log(),*) 'trim_inc = ',EDPftvarcon_inst%trim_inc + write(fates_log(),*) 'rhol = ',EDPftvarcon_inst%rhol + write(fates_log(),*) 'rhos = ',EDPftvarcon_inst%rhos + write(fates_log(),*) 'taul = ',EDPftvarcon_inst%taul + write(fates_log(),*) 'taus = ',EDPftvarcon_inst%taus + write(fates_log(),*) 'rootprof_beta = ',EDPftvarcon_inst%rootprof_beta + write(fates_log(),*) 'allom_hmode = ',EDPftvarcon_inst%allom_hmode + write(fates_log(),*) 'allom_lmode = ',EDPftvarcon_inst%allom_lmode + write(fates_log(),*) 'allom_fmode = ',EDPftvarcon_inst%allom_fmode + write(fates_log(),*) 'allom_amode = ',EDPftvarcon_inst%allom_amode + write(fates_log(),*) 'allom_cmode = ',EDPftvarcon_inst%allom_cmode + write(fates_log(),*) 'allom_smode = ',EDPftvarcon_inst%allom_smode + write(fates_log(),*) 'allom_latosa_int = ',EDPftvarcon_inst%allom_latosa_int + write(fates_log(),*) 'allom_latosa_slp = ',EDPftvarcon_inst%allom_latosa_slp + write(fates_log(),*) 'allom_l2fr = ',EDPftvarcon_inst%allom_l2fr + write(fates_log(),*) 'allom_agb_frac = ',EDPftvarcon_inst%allom_agb_frac + write(fates_log(),*) 'allom_d2h1 = ',EDPftvarcon_inst%allom_d2h1 + write(fates_log(),*) 'allom_d2h2 = ',EDPftvarcon_inst%allom_d2h2 + write(fates_log(),*) 'allom_d2h3 = ',EDPftvarcon_inst%allom_d2h3 + write(fates_log(),*) 'allom_d2bl1 = ',EDPftvarcon_inst%allom_d2bl1 + write(fates_log(),*) 'allom_d2bl2 = ',EDPftvarcon_inst%allom_d2bl2 + write(fates_log(),*) 'allom_d2bl3 = ',EDPftvarcon_inst%allom_d2bl3 + write(fates_log(),*) 'allom_sai_scaler = ',EDPftvarcon_inst%allom_sai_scaler + write(fates_log(),*) 'allom_d2bl_slascaler = ',EDPftvarcon_inst%allom_d2bl_slascaler + write(fates_log(),*) 'allom_blca_expnt_diff = ',EDPftvarcon_inst%allom_blca_expnt_diff + write(fates_log(),*) 'allom_agb1 = ',EDPftvarcon_inst%allom_agb1 + write(fates_log(),*) 'allom_agb2 = ',EDPftvarcon_inst%allom_agb2 + write(fates_log(),*) 'allom_agb3 = ',EDPftvarcon_inst%allom_agb3 + write(fates_log(),*) 'allom_agb4 = ',EDPftvarcon_inst%allom_agb4 + write(fates_log(),*) 'hydr_p_taper = ',EDPftvarcon_inst%hydr_p_taper + write(fates_log(),*) 'hydr_rs2 = ',EDPftvarcon_inst%hydr_rs2 + write(fates_log(),*) 'hydr_srl = ',EDPftvarcon_inst%hydr_srl + write(fates_log(),*) 'hydr_rfrac_stem = ',EDPftvarcon_inst%hydr_rfrac_stem + write(fates_log(),*) 'hydr_avuln_gs = ',EDPftvarcon_inst%hydr_avuln_gs + write(fates_log(),*) 'hydr_p50_gs = ',EDPftvarcon_inst%hydr_p50_gs + write(fates_log(),*) 'hydr_avuln_node = ',EDPftvarcon_inst%hydr_avuln_node + write(fates_log(),*) 'hydr_p50_node = ',EDPftvarcon_inst%hydr_p50_node + write(fates_log(),*) 'hydr_thetas_node = ',EDPftvarcon_inst%hydr_thetas_node + write(fates_log(),*) 'hydr_epsil_node = ',EDPftvarcon_inst%hydr_epsil_node + write(fates_log(),*) 'hydr_pitlp_node = ',EDPftvarcon_inst%hydr_pitlp_node + write(fates_log(),*) 'hydr_resid_node = ',EDPftvarcon_inst%hydr_resid_node + write(fates_log(),*) 'hydr_fcap_node = ',EDPftvarcon_inst%hydr_fcap_node + write(fates_log(),*) 'hydr_pinot_node = ',EDPftvarcon_inst%hydr_pinot_node + write(fates_log(),*) '-------------------------------------------------' + + end if + + end subroutine FatesReportPFTParams end module EDPftvarcon diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index f6f70f75fa..876358f560 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -23,6 +23,9 @@ module FatesInterfaceMod use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun + use EDPftvarcon , only : FatesReportPFTParams + use EDParamsMod , only : FatesReportParams + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -34,6 +37,7 @@ module FatesInterfaceMod public :: set_fates_ctrlparms public :: SetFatesTime public :: set_fates_global_elements + public :: FatesReportParameters character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -1231,6 +1235,23 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) return end subroutine set_fates_ctrlparms + + ! ==================================================================================== + + subroutine FatesReportParameters(masterproc) + + ! ----------------------------------------------------- + ! Simple parameter reporting functions + ! A debug like print flag is contained in each routine + ! ----------------------------------------------------- + logical,intent(in) :: masterproc + + call FatesReportPFTParams(masterproc) + call FatesReportParams(masterproc) + + + return + end subroutine FatesReportParameters end module FatesInterfaceMod diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index cfdab6bbcd..bd177af2b5 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -6,6 +6,7 @@ module FatesParameterDerivedMod ! and are based off of simple relationships from parameters that the user can ! vary. This should be called once, and early in the model initialization call ! sequence immediately after FATES parameters are read in. + ! ! ------------------------------------------------------------------------------------- use FatesConstantsMod, only : r8 => fates_r8 From 5362f34a15396a4e9acb18c3b100cff82da272ae Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 10 Aug 2017 14:24:34 -0700 Subject: [PATCH 16/23] Migrated spitfire alpha_SH parameter to pft dimension. Fixed naming conventions of the new logging parameters. Added some missing parameter read for hydr_pinot_node, and missing entry for hydr_kmax_node. --- fire/SFMainMod.F90 | 6 +- fire/SFParamsMod.F90 | 11 +- main/EDParamsMod.F90 | 104 ++++++++++--------- main/EDPftvarcon.F90 | 239 +++++++++++++++++++++++++------------------ 4 files changed, 201 insertions(+), 159 deletions(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 1c0d967ae7..fe51009cd1 100755 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -805,8 +805,6 @@ subroutine crown_scorching ( currentSite ) !currentPatch%SH !average scorch height for the patch(m) !currentPatch%FI average fire intensity of flaming front during day. kW/m. - use SFParamsMod, only : SF_val_alpha_SH - type(ed_site_type), intent(in), target :: currentSite type(ed_patch_type), pointer :: currentPatch @@ -847,7 +845,9 @@ subroutine crown_scorching ( currentSite ) if ( hlm_masterproc == itrue ) write(fates_log(),*) 'currentPatch%SH',currentPatch%SH,f_ag_bmass endif !2/3 Byram (1959) - currentPatch%SH = currentPatch%SH + f_ag_bmass * SF_val_alpha_SH * (currentPatch%FI**0.667_r8) + currentPatch%SH = currentPatch%SH + f_ag_bmass * & + EDPftvarcon_inst%fire_alpha_SH(currentCohort%pft) * (currentPatch%FI**0.667_r8) + endif !trees only currentCohort=>currentCohort%shorter; enddo !end cohort loop diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index 7de8b5861d..a8556577fa 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -23,7 +23,6 @@ module SFParamsMod real(r8),protected :: SF_val_miner_damp real(r8),protected :: SF_val_max_durat real(r8),protected :: SF_val_durat_slope - real(r8),protected :: SF_val_alpha_SH real(r8),protected :: SF_val_wind_max ! Maximum wind speed expected by fire model (m/min) real(r8),protected :: SF_val_alpha_FMC(NFSC) real(r8),protected :: SF_val_CWD_frac(NCWD) @@ -36,7 +35,7 @@ module SFParamsMod real(r8),protected :: SF_val_low_moisture_Slope(NFSC) real(r8),protected :: SF_val_mid_moisture_Coeff(NFSC) real(r8),protected :: SF_val_mid_moisture_Slope(NFSC) - + character(len=param_string_length),parameter :: SF_name_fdi_a = "fates_fdi_a" character(len=param_string_length),parameter :: SF_name_fdi_b = "fates_fdi_b" character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fates_fdi_alpha" @@ -46,7 +45,6 @@ module SFParamsMod character(len=param_string_length),parameter :: SF_name_miner_damp = "fates_miner_damp" character(len=param_string_length),parameter :: SF_name_max_durat = "fates_max_durat" character(len=param_string_length),parameter :: SF_name_durat_slope = "fates_durat_slope" - character(len=param_string_length),parameter :: SF_name_alpha_SH = "fates_alpha_SH" character(len=param_string_length),parameter :: SF_name_alpha_FMC = "fates_alpha_FMC" character(len=param_string_length),parameter :: SF_name_CWD_frac = "fates_CWD_frac" character(len=param_string_length),parameter :: SF_name_max_decomp = "fates_max_decomp" @@ -92,7 +90,6 @@ subroutine SpitFireParamsInit() SF_val_miner_damp = nan SF_val_max_durat = nan SF_val_durat_slope = nan - SF_val_alpha_SH = nan SF_val_wind_max = nan SF_val_CWD_frac(:) = nan @@ -183,9 +180,6 @@ subroutine SpitFireRegisterScalars(fates_params) call fates_params%RegisterParameter(name=SF_name_durat_slope, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=SF_name_alpha_SH, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) - end subroutine SpitFireRegisterScalars !----------------------------------------------------------------------- @@ -227,9 +221,6 @@ subroutine SpitFireReceiveScalars(fates_params) call fates_params%RetreiveParameter(name=SF_name_durat_slope, & data=SF_val_durat_slope) - call fates_params%RetreiveParameter(name=SF_name_alpha_SH, & - data=SF_val_alpha_SH) - end subroutine SpitFireReceiveScalars !----------------------------------------------------------------------- diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 05f5618b98..05497b80cc 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -91,11 +91,14 @@ module EDParamsMod real(r8),protected :: logging_dbhmin ! Minimum dbh at which logging is applied (cm) character(len=param_string_length),parameter :: logging_name_dbhmin = "fates_logging_dbhmin" - real(r8),protected :: logging_collateral_ratio ! Ratio of collateral mortality to direct logging mortality - character(len=param_string_length),parameter :: logging_name_collateral_ratio = "fates_logging_collateral_ratio" + real(r8),protected :: logging_collateral_frac ! Ratio of collateral mortality to direct logging mortality + character(len=param_string_length),parameter :: logging_name_collateral_frac = "fates_logging_collateral_frac" - real(r8),protected :: logging_per_event_fraction ! Fraction of stems logged per event - character(len=param_string_length),parameter :: logging_name_per_event_fraction = "fates_logging_per_event_fraction" + real(r8),protected :: logging_direct_frac ! Fraction of stems logged per event + character(len=param_string_length),parameter :: logging_name_direct_frac = "fates_logging_direct_frac" + + real(r8),protected :: logging_mechanical_frac ! Fraction of stems logged per event + character(len=param_string_length),parameter :: logging_name_mechanical_frac = "fates_logging_mechanical_frac" real(r8),protected :: logging_event_code ! Code that options how logging events are structured character(len=param_string_length),parameter :: logging_name_event_code = "fates_logging_event_code" @@ -148,8 +151,9 @@ subroutine FatesParamsInit() hydr_psicap = nan logging_dbhmin = nan - logging_collateral_ratio = nan - logging_per_event_fraction = nan + logging_collateral_frac = nan + logging_direct_frac = nan + logging_mechanical_frac = nan logging_event_code = nan end subroutine FatesParamsInit @@ -263,10 +267,13 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=logging_name_dbhmin, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=logging_name_collateral_ratio, dimension_shape=dimension_shape_1d, & + call fates_params%RegisterParameter(name=logging_name_collateral_frac, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=logging_name_direct_frac, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - call fates_params%RegisterParameter(name=logging_name_per_event_fraction, dimension_shape=dimension_shape_1d, & + call fates_params%RegisterParameter(name=logging_name_mechanical_frac, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) call fates_params%RegisterParameter(name=logging_name_event_code, dimension_shape=dimension_shape_1d, & @@ -378,11 +385,14 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=logging_name_dbhmin, & data=logging_dbhmin) - call fates_params%RetreiveParameter(name=logging_name_collateral_ratio, & - data=logging_collateral_ratio) + call fates_params%RetreiveParameter(name=logging_name_collateral_frac, & + data=logging_collateral_frac) + + call fates_params%RetreiveParameter(name=logging_name_direct_frac, & + data=logging_direct_frac) - call fates_params%RetreiveParameter(name=logging_name_per_event_fraction, & - data=logging_per_event_fraction) + call fates_params%RetreiveParameter(name=logging_name_mechanical_frac, & + data=logging_mechanical_frac) call fates_params%RetreiveParameter(name=logging_name_event_code, & data=logging_event_code) @@ -395,45 +405,47 @@ subroutine FatesReportParams(is_master) logical,intent(in) :: is_master + character(len=32),parameter :: fmt0 = '(a,(F12.4))' logical, parameter :: debug_report = .true. if(debug_report .and. is_master) then write(fates_log(),*) '----------- FATES Scalar Parameters -----------------' - write(fates_log(),*) 'ED_size_diagnostic_scale = ',ED_size_diagnostic_scale - write(fates_log(),*) 'fates_mortality_disturbance_fraction = ',fates_mortality_disturbance_fraction - write(fates_log(),*) 'ED_val_grass_spread = ',ED_val_grass_spread - write(fates_log(),*) 'ED_val_comp_excln = ',ED_val_comp_excln - write(fates_log(),*) 'ED_val_grass_spread = ',ED_val_grass_spread - write(fates_log(),*) 'ED_val_comp_excln = ', ED_val_comp_excln - write(fates_log(),*) 'ED_val_stress_mort = ',ED_val_stress_mort - write(fates_log(),*) 'ED_val_maxspread = ',ED_val_maxspread - write(fates_log(),*) 'ED_val_minspread = ',ED_val_minspread - write(fates_log(),*) 'ED_val_init_litter = ',ED_val_init_litter - write(fates_log(),*) 'ED_val_nignitions = ',ED_val_nignitions - write(fates_log(),*) 'ED_val_understorey_death = ',ED_val_understorey_death - write(fates_log(),*) 'ED_val_cwd_fcel = ',ED_val_cwd_fcel - write(fates_log(),*) 'ED_val_cwd_flig = ',ED_val_cwd_flig - write(fates_log(),*) 'ED_val_bbopt_c3 = ',ED_val_bbopt_c3 - write(fates_log(),*) 'ED_val_bbopt_c4 = ',ED_val_bbopt_c4 - write(fates_log(),*) 'ED_val_base_mr_20 = ', ED_val_base_mr_20 - write(fates_log(),*) 'ED_val_phen_drought_threshold = ',ED_val_phen_drought_threshold - write(fates_log(),*) 'ED_val_phen_doff_time = ',ED_val_phen_doff_time - write(fates_log(),*) 'ED_val_phen_a = ',ED_val_phen_a - write(fates_log(),*) 'ED_val_phen_b = ',ED_val_phen_b - write(fates_log(),*) 'ED_val_phen_c = ',ED_val_phen_c - write(fates_log(),*) 'ED_val_phen_chiltemp = ',ED_val_phen_chiltemp - write(fates_log(),*) 'ED_val_phen_mindayson = ',ED_val_phen_mindayson - write(fates_log(),*) 'ED_val_phen_ncolddayslim = ',ED_val_phen_ncolddayslim - write(fates_log(),*) 'ED_val_phen_coldtemp = ',ED_val_phen_coldtemp - write(fates_log(),*) 'ED_val_cohort_fusion_tol = ',ED_val_cohort_fusion_tol - write(fates_log(),*) 'ED_val_patch_fusion_tol = ',ED_val_patch_fusion_tol - write(fates_log(),*) 'hydr_psi0 = ',hydr_psi0 - write(fates_log(),*) 'hydr_psicap = ',hydr_psicap - write(fates_log(),*) 'logging_dbhmin = ',logging_dbhmin - write(fates_log(),*) 'logging_collateral_ratio = ',logging_collateral_ratio - write(fates_log(),*) 'logging_per_event_fraction = ',logging_per_event_fraction - write(fates_log(),*) 'logging_event_code = ',logging_event_code + write(fates_log(),fmt0) 'ED_size_diagnostic_scale = ',ED_size_diagnostic_scale + write(fates_log(),fmt0) 'fates_mortality_disturbance_fraction = ',fates_mortality_disturbance_fraction + write(fates_log(),fmt0) 'ED_val_grass_spread = ',ED_val_grass_spread + write(fates_log(),fmt0) 'ED_val_comp_excln = ',ED_val_comp_excln + write(fates_log(),fmt0) 'ED_val_grass_spread = ',ED_val_grass_spread + write(fates_log(),fmt0) 'ED_val_comp_excln = ', ED_val_comp_excln + write(fates_log(),fmt0) 'ED_val_stress_mort = ',ED_val_stress_mort + write(fates_log(),fmt0) 'ED_val_maxspread = ',ED_val_maxspread + write(fates_log(),fmt0) 'ED_val_minspread = ',ED_val_minspread + write(fates_log(),fmt0) 'ED_val_init_litter = ',ED_val_init_litter + write(fates_log(),fmt0) 'ED_val_nignitions = ',ED_val_nignitions + write(fates_log(),fmt0) 'ED_val_understorey_death = ',ED_val_understorey_death + write(fates_log(),fmt0) 'ED_val_cwd_fcel = ',ED_val_cwd_fcel + write(fates_log(),fmt0) 'ED_val_cwd_flig = ',ED_val_cwd_flig + write(fates_log(),fmt0) 'ED_val_bbopt_c3 = ',ED_val_bbopt_c3 + write(fates_log(),fmt0) 'ED_val_bbopt_c4 = ',ED_val_bbopt_c4 + write(fates_log(),fmt0) 'ED_val_base_mr_20 = ', ED_val_base_mr_20 + write(fates_log(),fmt0) 'ED_val_phen_drought_threshold = ',ED_val_phen_drought_threshold + write(fates_log(),fmt0) 'ED_val_phen_doff_time = ',ED_val_phen_doff_time + write(fates_log(),fmt0) 'ED_val_phen_a = ',ED_val_phen_a + write(fates_log(),fmt0) 'ED_val_phen_b = ',ED_val_phen_b + write(fates_log(),fmt0) 'ED_val_phen_c = ',ED_val_phen_c + write(fates_log(),fmt0) 'ED_val_phen_chiltemp = ',ED_val_phen_chiltemp + write(fates_log(),fmt0) 'ED_val_phen_mindayson = ',ED_val_phen_mindayson + write(fates_log(),fmt0) 'ED_val_phen_ncolddayslim = ',ED_val_phen_ncolddayslim + write(fates_log(),fmt0) 'ED_val_phen_coldtemp = ',ED_val_phen_coldtemp + write(fates_log(),fmt0) 'ED_val_cohort_fusion_tol = ',ED_val_cohort_fusion_tol + write(fates_log(),fmt0) 'ED_val_patch_fusion_tol = ',ED_val_patch_fusion_tol + write(fates_log(),fmt0) 'hydr_psi0 = ',hydr_psi0 + 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_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 write(fates_log(),*) '------------------------------------------------------' end if diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 342375d661..831afa1e44 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -90,7 +90,12 @@ module EDPftvarcon real(r8), allocatable :: taul(:, :) real(r8), allocatable :: taus(:, :) real(r8), allocatable :: rootprof_beta(:, :) - + + ! Fire Parameters (No PFT vector capabilities in their own routines) + ! See fire/SFParamsMod.F90 for bulk of fire parameters + ! ------------------------------------------------------------------------------------------- + real(r8), allocatable :: fire_alpha_SH(:) ! spitfire parameter, alpha scorch height + ! Equation 16 Thonicke et al 2010 ! Allometry Parameters ! -------------------------------------------------------------------------------------------- @@ -140,6 +145,7 @@ module EDPftvarcon real(r8), allocatable :: hydr_resid_node(:,:) ! residual fraction (fraction) real(r8), allocatable :: hydr_fcap_node(:,:) ! fraction of (1-resid_node) that is capillary in source real(r8), allocatable :: hydr_pinot_node(:,:) ! osmotic potential at full turgor + real(r8), allocatable :: hydr_kmax_node(:,:) ! maximum xylem conductivity per unit conducting xylem area contains procedure, public :: Init => EDpftconInit @@ -388,6 +394,10 @@ 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_alpha_SH' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_allom_hmode' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -748,6 +758,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%grperc) + name = 'fates_alpha_SH' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%fire_alpha_SH) + name = 'fates_allom_hmode' call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_hmode) @@ -1215,6 +1229,10 @@ subroutine Register_PFT_hydr_organs(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_hydr_kmax_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + end subroutine Register_PFT_hydr_organs @@ -1260,6 +1278,13 @@ subroutine Receive_PFT_hydr_organs(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%hydr_fcap_node) + name = 'fates_hydr_pinot_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_pinot_node) + + name = 'fates_hydr_kmax_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_kmax_node) end subroutine Receive_PFT_hydr_organs @@ -1271,109 +1296,123 @@ subroutine FatesReportPFTParams(is_master) logical, intent(in) :: is_master ! Only log if this is the master proc logical, parameter :: debug_report = .true. + character(len=32),parameter :: fmt0 = '(a,100(F12.4,1X))' + integer :: npft,ipft + + npft = size(EDPftvarcon_inst%pft_used,1) + if(debug_report .and. is_master) then + if(npft>100)then + write(fates_log(),*) 'you are trying to report pft parameters during initialization' + write(fates_log(),*) 'but you have so many that it is over-running the format spec' + write(fates_log(),*) 'simply bump up the muptiplier in parameter fmt0 shown above' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + write(fates_log(),*) '----------- FATES PFT Parameters -----------------' - write(fates_log(),*) 'pft_used = ',EDPftvarcon_inst%pft_used - write(fates_log(),*) 'max_dbh = ',EDPftvarcon_inst%max_dbh - write(fates_log(),*) 'freezetol = ',EDPftvarcon_inst%freezetol - write(fates_log(),*) 'wood_density = ',EDPftvarcon_inst%wood_density - write(fates_log(),*) 'hgt_min = ',EDPftvarcon_inst%hgt_min - write(fates_log(),*) 'dleaf = ',EDPftvarcon_inst%dleaf - write(fates_log(),*) 'z0mr = ',EDPftvarcon_inst%z0mr - write(fates_log(),*) 'displar = ',EDPftvarcon_inst%displar - write(fates_log(),*) 'cushion = ',EDPftvarcon_inst%cushion - write(fates_log(),*) 'leaf_stor_priority = ',EDPftvarcon_inst%leaf_stor_priority - write(fates_log(),*) 'crown = ',EDPftvarcon_inst%crown - write(fates_log(),*) 'bark_scaler = ',EDPftvarcon_inst%bark_scaler - write(fates_log(),*) 'crown_kill = ',EDPftvarcon_inst%crown_kill - write(fates_log(),*) 'initd = ',EDPftvarcon_inst%initd - write(fates_log(),*) 'seed_rain = ',EDPftvarcon_inst%seed_rain - write(fates_log(),*) 'BB_slope = ',EDPftvarcon_inst%BB_slope - write(fates_log(),*) 'root_long = ',EDPftvarcon_inst%root_long - write(fates_log(),*) 'clone_alloc = ',EDPftvarcon_inst%clone_alloc - write(fates_log(),*) 'seed_alloc = ',EDPftvarcon_inst%seed_alloc - write(fates_log(),*) 'woody = ',EDPftvarcon_inst%woody - write(fates_log(),*) 'stress_decid = ',EDPftvarcon_inst%stress_decid - write(fates_log(),*) 'season_decid = ',EDPftvarcon_inst%season_decid - write(fates_log(),*) 'evergreen = ',EDPftvarcon_inst%evergreen - write(fates_log(),*) 'slatop = ',EDPftvarcon_inst%slatop - write(fates_log(),*) 'leaf_long = ',EDPftvarcon_inst%leaf_long - write(fates_log(),*) 'roota_par = ',EDPftvarcon_inst%roota_par - write(fates_log(),*) 'rootb_par = ',EDPftvarcon_inst%rootb_par - write(fates_log(),*) 'lf_flab = ',EDPftvarcon_inst%lf_flab - write(fates_log(),*) 'lf_fcel = ',EDPftvarcon_inst%lf_fcel - write(fates_log(),*) 'lf_flig = ',EDPftvarcon_inst%lf_flig - write(fates_log(),*) 'fr_flab = ',EDPftvarcon_inst%fr_flab - write(fates_log(),*) 'fr_fcel = ',EDPftvarcon_inst%fr_fcel - write(fates_log(),*) 'fr_flig = ',EDPftvarcon_inst%fr_flig - write(fates_log(),*) 'xl = ',EDPftvarcon_inst%xl - write(fates_log(),*) 'c3psn = ',EDPftvarcon_inst%c3psn - write(fates_log(),*) 'vcmax25top = ',EDPftvarcon_inst%vcmax25top - write(fates_log(),*) 'leafcn = ',EDPftvarcon_inst%leafcn - write(fates_log(),*) 'frootcn = ',EDPftvarcon_inst%frootcn - write(fates_log(),*) 'smpso = ',EDPftvarcon_inst%smpso - write(fates_log(),*) 'smpsc = ',EDPftvarcon_inst%smpsc - write(fates_log(),*) 'grperc = ',EDPftvarcon_inst%grperc - write(fates_log(),*) 'bmort = ',EDPftvarcon_inst%bmort - write(fates_log(),*) 'hf_sm_threshold = ',EDPftvarcon_inst%hf_sm_threshold - write(fates_log(),*) 'vcmaxha = ',EDPftvarcon_inst%vcmaxha - write(fates_log(),*) 'jmaxha = ',EDPftvarcon_inst%jmaxha - write(fates_log(),*) 'tpuha = ',EDPftvarcon_inst%tpuha - write(fates_log(),*) 'vcmaxhd = ',EDPftvarcon_inst%vcmaxhd - write(fates_log(),*) 'jmaxhd = ',EDPftvarcon_inst%jmaxhd - write(fates_log(),*) 'tpuhd = ',EDPftvarcon_inst%tpuhd - write(fates_log(),*) 'vcmaxse = ',EDPftvarcon_inst%vcmaxse - write(fates_log(),*) 'jmaxse = ',EDPftvarcon_inst%jmaxse - write(fates_log(),*) 'tpuse = ',EDPftvarcon_inst%tpuse - write(fates_log(),*) 'germination_timescale = ',EDPftvarcon_inst%germination_timescale - write(fates_log(),*) 'seed_decay_turnover = ',EDPftvarcon_inst%seed_decay_turnover - write(fates_log(),*) 'branch_turnover = ',EDPftvarcon_inst%branch_turnover - write(fates_log(),*) 'trim_limit = ',EDPftvarcon_inst%trim_limit - write(fates_log(),*) 'trim_inc = ',EDPftvarcon_inst%trim_inc - write(fates_log(),*) 'rhol = ',EDPftvarcon_inst%rhol - write(fates_log(),*) 'rhos = ',EDPftvarcon_inst%rhos - write(fates_log(),*) 'taul = ',EDPftvarcon_inst%taul - write(fates_log(),*) 'taus = ',EDPftvarcon_inst%taus - write(fates_log(),*) 'rootprof_beta = ',EDPftvarcon_inst%rootprof_beta - write(fates_log(),*) 'allom_hmode = ',EDPftvarcon_inst%allom_hmode - write(fates_log(),*) 'allom_lmode = ',EDPftvarcon_inst%allom_lmode - write(fates_log(),*) 'allom_fmode = ',EDPftvarcon_inst%allom_fmode - write(fates_log(),*) 'allom_amode = ',EDPftvarcon_inst%allom_amode - write(fates_log(),*) 'allom_cmode = ',EDPftvarcon_inst%allom_cmode - write(fates_log(),*) 'allom_smode = ',EDPftvarcon_inst%allom_smode - write(fates_log(),*) 'allom_latosa_int = ',EDPftvarcon_inst%allom_latosa_int - write(fates_log(),*) 'allom_latosa_slp = ',EDPftvarcon_inst%allom_latosa_slp - write(fates_log(),*) 'allom_l2fr = ',EDPftvarcon_inst%allom_l2fr - write(fates_log(),*) 'allom_agb_frac = ',EDPftvarcon_inst%allom_agb_frac - write(fates_log(),*) 'allom_d2h1 = ',EDPftvarcon_inst%allom_d2h1 - write(fates_log(),*) 'allom_d2h2 = ',EDPftvarcon_inst%allom_d2h2 - write(fates_log(),*) 'allom_d2h3 = ',EDPftvarcon_inst%allom_d2h3 - write(fates_log(),*) 'allom_d2bl1 = ',EDPftvarcon_inst%allom_d2bl1 - write(fates_log(),*) 'allom_d2bl2 = ',EDPftvarcon_inst%allom_d2bl2 - write(fates_log(),*) 'allom_d2bl3 = ',EDPftvarcon_inst%allom_d2bl3 - write(fates_log(),*) 'allom_sai_scaler = ',EDPftvarcon_inst%allom_sai_scaler - write(fates_log(),*) 'allom_d2bl_slascaler = ',EDPftvarcon_inst%allom_d2bl_slascaler - write(fates_log(),*) 'allom_blca_expnt_diff = ',EDPftvarcon_inst%allom_blca_expnt_diff - write(fates_log(),*) 'allom_agb1 = ',EDPftvarcon_inst%allom_agb1 - write(fates_log(),*) 'allom_agb2 = ',EDPftvarcon_inst%allom_agb2 - write(fates_log(),*) 'allom_agb3 = ',EDPftvarcon_inst%allom_agb3 - write(fates_log(),*) 'allom_agb4 = ',EDPftvarcon_inst%allom_agb4 - write(fates_log(),*) 'hydr_p_taper = ',EDPftvarcon_inst%hydr_p_taper - write(fates_log(),*) 'hydr_rs2 = ',EDPftvarcon_inst%hydr_rs2 - write(fates_log(),*) 'hydr_srl = ',EDPftvarcon_inst%hydr_srl - write(fates_log(),*) 'hydr_rfrac_stem = ',EDPftvarcon_inst%hydr_rfrac_stem - write(fates_log(),*) 'hydr_avuln_gs = ',EDPftvarcon_inst%hydr_avuln_gs - write(fates_log(),*) 'hydr_p50_gs = ',EDPftvarcon_inst%hydr_p50_gs - write(fates_log(),*) 'hydr_avuln_node = ',EDPftvarcon_inst%hydr_avuln_node - write(fates_log(),*) 'hydr_p50_node = ',EDPftvarcon_inst%hydr_p50_node - write(fates_log(),*) 'hydr_thetas_node = ',EDPftvarcon_inst%hydr_thetas_node - write(fates_log(),*) 'hydr_epsil_node = ',EDPftvarcon_inst%hydr_epsil_node - write(fates_log(),*) 'hydr_pitlp_node = ',EDPftvarcon_inst%hydr_pitlp_node - write(fates_log(),*) 'hydr_resid_node = ',EDPftvarcon_inst%hydr_resid_node - write(fates_log(),*) 'hydr_fcap_node = ',EDPftvarcon_inst%hydr_fcap_node - write(fates_log(),*) 'hydr_pinot_node = ',EDPftvarcon_inst%hydr_pinot_node + write(fates_log(),fmt0) 'pft_used = ',EDPftvarcon_inst%pft_used + write(fates_log(),fmt0) 'max_dbh = ',EDPftvarcon_inst%max_dbh + write(fates_log(),fmt0) 'freezetol = ',EDPftvarcon_inst%freezetol + write(fates_log(),fmt0) 'wood_density = ',EDPftvarcon_inst%wood_density + write(fates_log(),fmt0) 'hgt_min = ',EDPftvarcon_inst%hgt_min + write(fates_log(),fmt0) 'dleaf = ',EDPftvarcon_inst%dleaf + write(fates_log(),fmt0) 'z0mr = ',EDPftvarcon_inst%z0mr + write(fates_log(),fmt0) 'displar = ',EDPftvarcon_inst%displar + write(fates_log(),fmt0) 'cushion = ',EDPftvarcon_inst%cushion + write(fates_log(),fmt0) 'leaf_stor_priority = ',EDPftvarcon_inst%leaf_stor_priority + write(fates_log(),fmt0) 'crown = ',EDPftvarcon_inst%crown + write(fates_log(),fmt0) 'bark_scaler = ',EDPftvarcon_inst%bark_scaler + write(fates_log(),fmt0) 'crown_kill = ',EDPftvarcon_inst%crown_kill + write(fates_log(),fmt0) 'initd = ',EDPftvarcon_inst%initd + write(fates_log(),fmt0) 'seed_rain = ',EDPftvarcon_inst%seed_rain + write(fates_log(),fmt0) 'BB_slope = ',EDPftvarcon_inst%BB_slope + 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) 'woody = ',EDPftvarcon_inst%woody + write(fates_log(),fmt0) 'stress_decid = ',EDPftvarcon_inst%stress_decid + write(fates_log(),fmt0) 'season_decid = ',EDPftvarcon_inst%season_decid + write(fates_log(),fmt0) 'evergreen = ',EDPftvarcon_inst%evergreen + write(fates_log(),fmt0) 'slatop = ',EDPftvarcon_inst%slatop + write(fates_log(),fmt0) 'leaf_long = ',EDPftvarcon_inst%leaf_long + write(fates_log(),fmt0) 'roota_par = ',EDPftvarcon_inst%roota_par + write(fates_log(),fmt0) 'rootb_par = ',EDPftvarcon_inst%rootb_par + write(fates_log(),fmt0) 'lf_flab = ',EDPftvarcon_inst%lf_flab + write(fates_log(),fmt0) 'lf_fcel = ',EDPftvarcon_inst%lf_fcel + write(fates_log(),fmt0) 'lf_flig = ',EDPftvarcon_inst%lf_flig + write(fates_log(),fmt0) 'fr_flab = ',EDPftvarcon_inst%fr_flab + write(fates_log(),fmt0) 'fr_fcel = ',EDPftvarcon_inst%fr_fcel + write(fates_log(),fmt0) 'fr_flig = ',EDPftvarcon_inst%fr_flig + write(fates_log(),fmt0) 'xl = ',EDPftvarcon_inst%xl + write(fates_log(),fmt0) 'c3psn = ',EDPftvarcon_inst%c3psn + write(fates_log(),fmt0) 'vcmax25top = ',EDPftvarcon_inst%vcmax25top + write(fates_log(),fmt0) 'leafcn = ',EDPftvarcon_inst%leafcn + write(fates_log(),fmt0) 'frootcn = ',EDPftvarcon_inst%frootcn + write(fates_log(),fmt0) 'smpso = ',EDPftvarcon_inst%smpso + write(fates_log(),fmt0) 'smpsc = ',EDPftvarcon_inst%smpsc + write(fates_log(),fmt0) 'grperc = ',EDPftvarcon_inst%grperc + write(fates_log(),fmt0) 'bmort = ',EDPftvarcon_inst%bmort + write(fates_log(),fmt0) 'hf_sm_threshold = ',EDPftvarcon_inst%hf_sm_threshold + write(fates_log(),fmt0) 'vcmaxha = ',EDPftvarcon_inst%vcmaxha + write(fates_log(),fmt0) 'jmaxha = ',EDPftvarcon_inst%jmaxha + write(fates_log(),fmt0) 'tpuha = ',EDPftvarcon_inst%tpuha + write(fates_log(),fmt0) 'vcmaxhd = ',EDPftvarcon_inst%vcmaxhd + write(fates_log(),fmt0) 'jmaxhd = ',EDPftvarcon_inst%jmaxhd + write(fates_log(),fmt0) 'tpuhd = ',EDPftvarcon_inst%tpuhd + write(fates_log(),fmt0) 'vcmaxse = ',EDPftvarcon_inst%vcmaxse + write(fates_log(),fmt0) 'jmaxse = ',EDPftvarcon_inst%jmaxse + write(fates_log(),fmt0) 'tpuse = ',EDPftvarcon_inst%tpuse + write(fates_log(),fmt0) 'germination_timescale = ',EDPftvarcon_inst%germination_timescale + write(fates_log(),fmt0) 'seed_decay_turnover = ',EDPftvarcon_inst%seed_decay_turnover + write(fates_log(),fmt0) 'branch_turnover = ',EDPftvarcon_inst%branch_turnover + write(fates_log(),fmt0) 'trim_limit = ',EDPftvarcon_inst%trim_limit + write(fates_log(),fmt0) 'trim_inc = ',EDPftvarcon_inst%trim_inc + write(fates_log(),fmt0) 'rhol = ',EDPftvarcon_inst%rhol + write(fates_log(),fmt0) 'rhos = ',EDPftvarcon_inst%rhos + write(fates_log(),fmt0) 'taul = ',EDPftvarcon_inst%taul + write(fates_log(),fmt0) 'taus = ',EDPftvarcon_inst%taus + write(fates_log(),fmt0) 'rootprof_beta = ',EDPftvarcon_inst%rootprof_beta + write(fates_log(),fmt0) 'fire_alpha_SH = ',EDPftvarcon_inst%fire_alpha_SH + write(fates_log(),fmt0) 'allom_hmode = ',EDPftvarcon_inst%allom_hmode + write(fates_log(),fmt0) 'allom_lmode = ',EDPftvarcon_inst%allom_lmode + write(fates_log(),fmt0) 'allom_fmode = ',EDPftvarcon_inst%allom_fmode + write(fates_log(),fmt0) 'allom_amode = ',EDPftvarcon_inst%allom_amode + write(fates_log(),fmt0) 'allom_cmode = ',EDPftvarcon_inst%allom_cmode + write(fates_log(),fmt0) 'allom_smode = ',EDPftvarcon_inst%allom_smode + write(fates_log(),fmt0) 'allom_latosa_int = ',EDPftvarcon_inst%allom_latosa_int + write(fates_log(),fmt0) 'allom_latosa_slp = ',EDPftvarcon_inst%allom_latosa_slp + write(fates_log(),fmt0) 'allom_l2fr = ',EDPftvarcon_inst%allom_l2fr + write(fates_log(),fmt0) 'allom_agb_frac = ',EDPftvarcon_inst%allom_agb_frac + write(fates_log(),fmt0) 'allom_d2h1 = ',EDPftvarcon_inst%allom_d2h1 + write(fates_log(),fmt0) 'allom_d2h2 = ',EDPftvarcon_inst%allom_d2h2 + write(fates_log(),fmt0) 'allom_d2h3 = ',EDPftvarcon_inst%allom_d2h3 + write(fates_log(),fmt0) 'allom_d2bl1 = ',EDPftvarcon_inst%allom_d2bl1 + write(fates_log(),fmt0) 'allom_d2bl2 = ',EDPftvarcon_inst%allom_d2bl2 + write(fates_log(),fmt0) 'allom_d2bl3 = ',EDPftvarcon_inst%allom_d2bl3 + write(fates_log(),fmt0) 'allom_sai_scaler = ',EDPftvarcon_inst%allom_sai_scaler + write(fates_log(),fmt0) 'allom_d2bl_slascaler = ',EDPftvarcon_inst%allom_d2bl_slascaler + write(fates_log(),fmt0) 'allom_blca_expnt_diff = ',EDPftvarcon_inst%allom_blca_expnt_diff + write(fates_log(),fmt0) 'allom_agb1 = ',EDPftvarcon_inst%allom_agb1 + write(fates_log(),fmt0) 'allom_agb2 = ',EDPftvarcon_inst%allom_agb2 + write(fates_log(),fmt0) 'allom_agb3 = ',EDPftvarcon_inst%allom_agb3 + write(fates_log(),fmt0) 'allom_agb4 = ',EDPftvarcon_inst%allom_agb4 + write(fates_log(),fmt0) 'hydr_p_taper = ',EDPftvarcon_inst%hydr_p_taper + write(fates_log(),fmt0) 'hydr_rs2 = ',EDPftvarcon_inst%hydr_rs2 + write(fates_log(),fmt0) 'hydr_srl = ',EDPftvarcon_inst%hydr_srl + write(fates_log(),fmt0) 'hydr_rfrac_stem = ',EDPftvarcon_inst%hydr_rfrac_stem + write(fates_log(),fmt0) 'hydr_avuln_gs = ',EDPftvarcon_inst%hydr_avuln_gs + write(fates_log(),fmt0) 'hydr_p50_gs = ',EDPftvarcon_inst%hydr_p50_gs + write(fates_log(),fmt0) 'hydr_avuln_node = ',EDPftvarcon_inst%hydr_avuln_node + write(fates_log(),fmt0) 'hydr_p50_node = ',EDPftvarcon_inst%hydr_p50_node + write(fates_log(),fmt0) 'hydr_thetas_node = ',EDPftvarcon_inst%hydr_thetas_node + write(fates_log(),fmt0) 'hydr_epsil_node = ',EDPftvarcon_inst%hydr_epsil_node + write(fates_log(),fmt0) 'hydr_pitlp_node = ',EDPftvarcon_inst%hydr_pitlp_node + write(fates_log(),fmt0) 'hydr_resid_node = ',EDPftvarcon_inst%hydr_resid_node + write(fates_log(),fmt0) 'hydr_fcap_node = ',EDPftvarcon_inst%hydr_fcap_node + write(fates_log(),fmt0) 'hydr_pinot_node = ',EDPftvarcon_inst%hydr_pinot_node + write(fates_log(),fmt0) 'hydr_kmax_node = ',EDPftvarcon_inst%hydr_kmax_node write(fates_log(),*) '-------------------------------------------------' end if From 932113dd756efa7b8d4d9bf3ce2857eefd885acd Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 10 Aug 2017 15:00:18 -0700 Subject: [PATCH 17/23] Changing debug flag on parameter printing to off. --- main/EDParamsMod.F90 | 2 +- main/EDPftvarcon.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 05497b80cc..de274e5ac3 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -406,7 +406,7 @@ subroutine FatesReportParams(is_master) logical,intent(in) :: is_master character(len=32),parameter :: fmt0 = '(a,(F12.4))' - logical, parameter :: debug_report = .true. + logical, parameter :: debug_report = .false. if(debug_report .and. is_master) then diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 831afa1e44..cfadc1ee0c 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -1295,7 +1295,7 @@ subroutine FatesReportPFTParams(is_master) ! Argument logical, intent(in) :: is_master ! Only log if this is the master proc - logical, parameter :: debug_report = .true. + logical, parameter :: debug_report = .false. character(len=32),parameter :: fmt0 = '(a,100(F12.4,1X))' integer :: npft,ipft From 7404be796ba3b7c87a7fed72f11909f32a64d134 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 8 Jul 2017 13:57:08 -0700 Subject: [PATCH 18/23] Cherry-picked changes from a deprecated branch onto a rebased branch. Anyway, had to resolve a conflict. --- main/EDTypesMod.F90 | 130 +---------------------- main/FatesIODimensionsMod.F90 | 4 + main/FatesInterfaceMod.F90 | 194 +++++++++++++++++++++++++++++++++- 3 files changed, 194 insertions(+), 134 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index b60d31108c..3bd65aaa35 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -125,30 +125,7 @@ module EDTypesMod (/"background","hydraulic ","carbon ","impact ","fire "/) - ! ------------------------------------------------------------------------------------- - ! These vectors are used for history output mapping - ! CLM/ALM have limited support for multi-dimensional history output arrays. - ! FATES structure and composition is multi-dimensional, so we end up "multi-plexing" - ! multiple dimensions into one dimension. These new dimensions need definitions, - ! mapping to component dimensions, and definitions for those component dimensions as - ! well. - ! ------------------------------------------------------------------------------------- - - real(r8) ,allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension - integer , allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension - integer , allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension - real(r8), allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension - integer , allocatable :: fates_hdim_levpft(:) ! plant pft dimension - integer , allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension - integer , allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension - integer , allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension - integer , allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dimension - integer , allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the canopy-layer x leaf-layer dimension - integer , allocatable :: fates_hdim_canmap_levcnlfpf(:) ! canopy-layer map into the canopy-layer x pft x leaf-layer dimension - integer , allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the canopy-layer x pft x leaf-layer dimension - integer , allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dimension - integer , allocatable :: fates_hdim_scmap_levscag(:) ! map of size-class into size-class x patch age dimension - integer , allocatable :: fates_hdim_agmap_levscag(:) ! map of patch-age into size-class x patch age dimension + !************************************ !** COHORT type structure ** @@ -565,113 +542,8 @@ module EDTypesMod end type ed_site_type - public :: ed_hist_scpfmaps - contains - - !-------------------------------------------------------------------------------------! - subroutine ed_hist_scpfmaps - ! This subroutine allocates and populates the variables - ! that define the mapping of variables in history files in the "scpf" format - ! back to - ! its respective size-class "sc" and pft "pf" - - integer :: i - integer :: isc - integer :: ipft - integer :: icwd - integer :: ifuel - integer :: ican - integer :: ileaf - integer :: iage - - allocate( fates_hdim_levsclass(1:nlevsclass_ed )) - allocate( fates_hdim_pfmap_levscpf(1:nlevsclass_ed*maxpft)) - allocate( fates_hdim_scmap_levscpf(1:nlevsclass_ed*maxpft)) - allocate( fates_hdim_levpft(1:maxpft )) - allocate( fates_hdim_levfuel(1:NFSC )) - allocate( fates_hdim_levcwdsc(1:NCWD )) - allocate( fates_hdim_levage(1:nlevage_ed )) - - allocate( fates_hdim_levcan(nclmax)) - allocate( fates_hdim_canmap_levcnlf(nlevleaf*nclmax)) - allocate( fates_hdim_lfmap_levcnlf(nlevleaf*nclmax)) - allocate( fates_hdim_canmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) - allocate( fates_hdim_lfmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) - allocate( fates_hdim_pftmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) - allocate( fates_hdim_scmap_levscag(nlevsclass_ed * nlevage_ed )) - allocate( fates_hdim_agmap_levscag(nlevsclass_ed * nlevage_ed )) - - ! Fill the IO array of plant size classes - ! For some reason the history files did not like - ! a hard allocation of sclass_ed - fates_hdim_levsclass(:) = sclass_ed(:) - - fates_hdim_levage(:) = ageclass_ed(:) - - ! make pft array - do ipft=1,maxpft - fates_hdim_levpft(ipft) = ipft - end do - - ! make fuel array - do ifuel=1,NFSC - fates_hdim_levfuel(ifuel) = ifuel - end do - - ! make cwd array - do icwd=1,NCWD - fates_hdim_levcwdsc(icwd) = icwd - end do - - ! make canopy array - do ican = 1,nclmax - fates_hdim_levcan(ican) = ican - end do - - ! Fill the IO arrays that match pft and size class to their combined array - i=0 - do ipft=1,maxpft - do isc=1,nlevsclass_ed - i=i+1 - fates_hdim_pfmap_levscpf(i) = ipft - fates_hdim_scmap_levscpf(i) = isc - end do - end do - - i=0 - do ican=1,nclmax - do ileaf=1,nlevleaf - i=i+1 - fates_hdim_canmap_levcnlf(i) = ican - fates_hdim_lfmap_levcnlf(i) = ileaf - end do - end do - - i=0 - do iage=1,nlevage_ed - do isc=1,nlevsclass_ed - i=i+1 - fates_hdim_scmap_levscag(i) = isc - fates_hdim_agmap_levscag(i) = iage - end do - end do - - i=0 - do ipft=1,numpft_ed - do ican=1,nclmax - do ileaf=1,nlevleaf - i=i+1 - fates_hdim_canmap_levcnlfpf(i) = ican - fates_hdim_lfmap_levcnlfpf(i) = ileaf - fates_hdim_pftmap_levcnlfpf(i) = ipft - end do - end do - end do - - end subroutine ed_hist_scpfmaps - ! ===================================================================================== function get_age_class_index(age) result( patch_age_class ) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index 1dd5cce0b9..3d2e4bee0a 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -110,6 +110,10 @@ module FatesIODimensionsMod procedure, public :: SetThreadBounds end type fates_io_dimension_type + + + + contains ! ===================================================================================== diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 876358f560..2243471cfe 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -170,7 +170,30 @@ module FatesInterfaceMod ! data as some fields are arrays where each array is ! associated with one cohort - + ! ------------------------------------------------------------------------------------- + ! These vectors are used for history output mapping + ! CLM/ALM have limited support for multi-dimensional history output arrays. + ! FATES structure and composition is multi-dimensional, so we end up "multi-plexing" + ! multiple dimensions into one dimension. These new dimensions need definitions, + ! mapping to component dimensions, and definitions for those component dimensions as + ! well. + ! ------------------------------------------------------------------------------------- + + real(r8), protected, allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension + integer , protected, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension + integer , protected, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension + real(r8), protected, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension + integer , protected, allocatable :: fates_hdim_levpft(:) ! plant pft dimension + integer , protected, allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension + integer , protected, allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension + integer , protected, allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension + integer , protected, allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dim + integer , protected, allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the can-layer x leaf-layer dimension + integer , protected, allocatable :: fates_hdim_canmap_levcnlfpf(:) ! can-layer map into the can-layer x pft x leaf-layer dim + integer , protected, allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the can-layer x pft x leaf-layer dim + integer , protected, allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dim + integer , protected, allocatable :: fates_hdim_scmap_levscag(:) ! map of size-class into size-class x patch age dimension + integer , protected, allocatable :: fates_hdim_agmap_levscag(:) ! map of patch-age into size-class x patch age dimension ! ------------------------------------------------------------------------------------ ! DYNAMIC BOUNDARY CONDITIONS @@ -209,10 +232,6 @@ module FatesInterfaceMod ! _rb means radiation band ! ------------------------------------------------------------------------------------ - - - - type, public :: bc_in_type ! The actual number of FATES' ED patches @@ -796,17 +815,65 @@ end subroutine zero_bcs ! =================================================================================== subroutine set_fates_global_elements(use_fates) + + ! -------------------------------------------------------------------------------- + ! + ! This subroutine is called directly from the HLM, and is the first FATES routine + ! that is called. + ! + ! This subroutine MUST BE CALLED AFTER the FATES parameter file has been read in, + ! and the EDPftvarcon_inst structure has been made. + ! This subroutine must ALSO BE CALLED BEFORE the history file dimensions + ! are set. + ! + ! This routine requires no information from the HLM. This routine is responsible + ! for generating the globals that are required by the HLM that are entirely + ! FATES derived. + ! + ! -------------------------------------------------------------------------------- + + implicit none logical,intent(in) :: use_fates ! Is fates turned on? if (use_fates) then + ! Identify the number of PFTs by evaluating a pft array + ! Using wood density as that is not expected to be deprecated any time soon + + if(lbound(EDPftvarcon_inst%wood_density(:),dim=1) .eq. 0 ) then + numpft = size(EDPftvarcon_inst%wood_density,dim=1)-1 + elseif(lbound(EDPftvarcon_inst%wood_density(:),dim=1) .eq. 1 ) then + numpft = size(EDPftvarcon_inst%wood_density,dim=1) + else + write(fates_log(), *) 'While assessing the number of FATES PFTs,' + write(fates_log(), *) 'it was found that the lower bound was neither 0 or 1?' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if(numpft>maxpft) then + write(fates_log(), *) 'The number of PFTs dictated by the FATES parameter file' + write(fates_log(), *) 'is larger than the maximum allowed. Increase the parameter constant:' + write(fates_log(), *) 'FatesInterfaceMod.F90:maxpft accordingly' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + + ! These values are used to define the restart file allocations and general structure + ! of memory for the cohort arrays + fates_maxElementsPerPatch = max(maxCohortsPerPatch, & numpft_ed * nclmax * nlevleaf) fates_maxElementsPerSite = maxPatchesPerSite * fates_maxElementsPerPatch + + ! Set Various Mapping Arrays used in history output as well + ! These will not be used if use_ed or use_fates is false + call fates_history_maps() + + else ! If we are not using FATES, the cohort dimension is still ! going to be initialized, lets set it to the smallest value @@ -822,6 +889,123 @@ subroutine set_fates_global_elements(use_fates) end subroutine set_fates_global_elements + !============================================================================================== + + subroutine fates_history_maps + + use EDTypesMod, only : nlevsclass_ed + use EDTypesMod, only : NFSC + use EDTypesMod, only : NCWD + use EDTypesMod, only : nlevage_ed + use EDTypesMod, only : nlevsclass_ed + use EDTypesMod, only : nclmax + use EDTypesMod, only : nlevleaf + use EDTypesMod, only : sclass_ed + use EDTypesMod, only : ageclass_ed + + ! ------------------------------------------------------------------------------------------ + ! This subroutine allocates and populates the variables + ! that define the mapping of variables in history files in multiplexed dimensions liked + ! the "scpf" format + ! back to + ! their respective single component dimensions, like size-class "sc" and pft "pf" + ! ------------------------------------------------------------------------------------------ + + integer :: i + integer :: isc + integer :: ipft + integer :: icwd + integer :: ifuel + integer :: ican + integer :: ileaf + integer :: iage + + allocate( fates_hdim_levsclass(1:nlevsclass_ed )) + allocate( fates_hdim_pfmap_levscpf(1:nlevsclass_ed*numpft)) + allocate( fates_hdim_scmap_levscpf(1:nlevsclass_ed*numpft)) + allocate( fates_hdim_levpft(1:numpft )) + allocate( fates_hdim_levfuel(1:NFSC )) + allocate( fates_hdim_levcwdsc(1:NCWD )) + allocate( fates_hdim_levage(1:nlevage_ed )) + + allocate( fates_hdim_levcan(nclmax)) + allocate( fates_hdim_canmap_levcnlf(nlevleaf*nclmax)) + allocate( fates_hdim_lfmap_levcnlf(nlevleaf*nclmax)) + allocate( fates_hdim_canmap_levcnlfpf(nlevleaf*nclmax*numpft)) + allocate( fates_hdim_lfmap_levcnlfpf(nlevleaf*nclmax*numpft)) + allocate( fates_hdim_pftmap_levcnlfpf(nlevleaf*nclmax*numpft)) + allocate( fates_hdim_scmap_levscag(nlevsclass_ed * nlevage_ed )) + allocate( fates_hdim_agmap_levscag(nlevsclass_ed * nlevage_ed )) + + ! Fill the IO array of plant size classes + ! For some reason the history files did not like + ! a hard allocation of sclass_ed + fates_hdim_levsclass(:) = sclass_ed(:) + + fates_hdim_levage(:) = ageclass_ed(:) + + ! make pft array + do ipft=1,numpft + fates_hdim_levpft(ipft) = ipft + end do + + ! make fuel array + do ifuel=1,NFSC + fates_hdim_levfuel(ifuel) = ifuel + end do + + ! make cwd array + do icwd=1,NCWD + fates_hdim_levcwdsc(icwd) = icwd + end do + + ! make canopy array + do ican = 1,nclmax + fates_hdim_levcan(ican) = ican + end do + + ! Fill the IO arrays that match pft and size class to their combined array + i=0 + do ipft=1,numpft + do isc=1,nlevsclass_ed + i=i+1 + fates_hdim_pfmap_levscpf(i) = ipft + fates_hdim_scmap_levscpf(i) = isc + end do + end do + + i=0 + do ican=1,nclmax + do ileaf=1,nlevleaf + i=i+1 + fates_hdim_canmap_levcnlf(i) = ican + fates_hdim_lfmap_levcnlf(i) = ileaf + end do + end do + + i=0 + do iage=1,nlevage_ed + do isc=1,nlevsclass_ed + i=i+1 + fates_hdim_scmap_levscag(i) = isc + fates_hdim_agmap_levscag(i) = iage + end do + end do + + i=0 + do ipft=1,numpft + do ican=1,nclmax + do ileaf=1,nlevleaf + i=i+1 + fates_hdim_canmap_levcnlfpf(i) = ican + fates_hdim_lfmap_levcnlfpf(i) = ileaf + fates_hdim_pftmap_levcnlfpf(i) = ipft + end do + end do + end do + + end subroutine fates_history_maps + ! =================================================================================== subroutine SetFatesTime(current_year_in, current_month_in, & From 91f2078f1593ece6ddc7e55e171519590a3b8225 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 31 Jul 2017 13:21:08 -0700 Subject: [PATCH 19/23] Removed protected status from dimension mapping tables in FatesInterface, for some reason it was confusing as an argument passed to nc_io routines. --- main/FatesInterfaceMod.F90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 2243471cfe..efd5f4f732 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -179,21 +179,21 @@ module FatesInterfaceMod ! well. ! ------------------------------------------------------------------------------------- - real(r8), protected, allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension - integer , protected, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension - integer , protected, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension - real(r8), protected, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension - integer , protected, allocatable :: fates_hdim_levpft(:) ! plant pft dimension - integer , protected, allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension - integer , protected, allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension - integer , protected, allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension - integer , protected, allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dim - integer , protected, allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the can-layer x leaf-layer dimension - integer , protected, allocatable :: fates_hdim_canmap_levcnlfpf(:) ! can-layer map into the can-layer x pft x leaf-layer dim - integer , protected, allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the can-layer x pft x leaf-layer dim - integer , protected, allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dim - integer , protected, allocatable :: fates_hdim_scmap_levscag(:) ! map of size-class into size-class x patch age dimension - integer , protected, allocatable :: fates_hdim_agmap_levscag(:) ! map of patch-age into size-class x patch age dimension + real(r8), allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension + integer , allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension + integer , allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension + real(r8), allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension + integer , allocatable :: fates_hdim_levpft(:) ! plant pft dimension + integer , allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension + integer , allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension + integer , allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension + integer , allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dim + integer , allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the can-layer x leaf-layer dimension + integer , allocatable :: fates_hdim_canmap_levcnlfpf(:) ! can-layer map into the can-layer x pft x leaf-layer dim + integer , allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the can-layer x pft x leaf-layer dim + integer , allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dim + integer , allocatable :: fates_hdim_scmap_levscag(:) ! map of size-class into size-class x patch age dimension + integer , allocatable :: fates_hdim_agmap_levscag(:) ! map of patch-age into size-class x patch age dimension ! ------------------------------------------------------------------------------------ ! DYNAMIC BOUNDARY CONDITIONS From a12d2f8233ff5e91c492296f287eba110cbc0b55 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 14 Aug 2017 19:13:31 -0700 Subject: [PATCH 20/23] Removed static numpft_ed from FATES. First pass and check of removal. For static allocations, we now use maxpft exclusively. A check exists to see if the dynamic numpft is lower than max. All loops are now on numpft (dynamic parameter in FatesInterfaceMod). --- biogeochem/EDCanopyStructureMod.F90 | 36 +++--- biogeochem/EDCohortDynamicsMod.F90 | 4 +- biogeochem/EDPatchDynamicsMod.F90 | 37 +++--- biogeochem/EDPhysiologyMod.F90 | 69 ++++++----- biogeophys/EDBtranMod.F90 | 129 ++------------------- biogeophys/EDSurfaceAlbedoMod.F90 | 88 +++++++------- biogeophys/FatesPlantRespPhotosynthMod.F90 | 9 +- main/EDInitMod.F90 | 9 +- main/EDMainMod.F90 | 14 +-- main/EDTypesMod.F90 | 78 ++++++------- main/FatesHistoryInterfaceMod.F90 | 14 ++- main/FatesInterfaceMod.F90 | 21 +++- main/FatesInventoryInitMod.F90 | 22 ++-- main/FatesRestartInterfaceMod.F90 | 34 +++--- 14 files changed, 228 insertions(+), 336 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 6847a37867..36d923972d 100755 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -13,10 +13,10 @@ module EDCanopyStructureMod use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf - use EDTypesMod , only : numpft_ed use EDtypesMod , only : AREA use FatesGlobals , only : endrun => fates_endrun use FatesInterfaceMod , only : hlm_days_per_year + use FatesInterfaceMod , only : numpft ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -1111,7 +1111,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) currentCohort => currentCohort%taller enddo !currentCohort lai = 0.0_r8 - do ft = 1,numpft_ed + do ft = 1,numpft lai = lai+ sum(currentPatch%tlai_profile(1,ft,:)) enddo @@ -1251,7 +1251,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) enddo !cohort do L = 1,currentPatch%NCL_p - do ft = 1,numpft_ed + 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) / & @@ -1279,7 +1279,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) currentPatch%nrad = currentPatch%ncan do L = 1,currentPatch%NCL_p - do ft = 1,numpft_ed + do ft = 1,numpft if(currentPatch%nrad(L,ft) > 30)then write(fates_log(), *) 'ED: issue w/ nrad' endif @@ -1291,24 +1291,24 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) end do !iv enddo !ft - if ( L == 1 .and. abs(sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1))) < 0.99999 & + if ( L == 1 .and. abs(sum(currentPatch%canopy_area_profile(1,1:numpft,1))) < 0.99999 & .and. currentPatch%NCL_p > 1 ) then - write(fates_log(), *) 'ED: canopy area too small',sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1)) - write(fates_log(), *) 'ED: cohort areas', currentPatch%canopy_area_profile(1,1:numpft_ed,:) + write(fates_log(), *) 'ED: canopy area too small',sum(currentPatch%canopy_area_profile(1,1:numpft,1)) + write(fates_log(), *) 'ED: cohort areas', currentPatch%canopy_area_profile(1,1:numpft,:) endif if (L == 1 .and. currentPatch%NCL_p > 1 .and. & - abs(sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1))) < 0.99999) then + abs(sum(currentPatch%canopy_area_profile(1,1:numpft,1))) < 0.99999) then write(fates_log(), *) 'ED: not enough area in the top canopy', & - sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1)), & - currentPatch%canopy_area_profile(L,1:numpft_ed,1) + sum(currentPatch%canopy_area_profile(L,1:numpft,1)), & + currentPatch%canopy_area_profile(L,1:numpft,1) endif - if(abs(sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1))) > 1.00001)then + if(abs(sum(currentPatch%canopy_area_profile(L,1:numpft,1))) > 1.00001)then write(fates_log(), *) 'ED: canopy-area-profile wrong', & - sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1)), & + sum(currentPatch%canopy_area_profile(L,1:numpft,1)), & currentPatch%patchno, L - write(fates_log(), *) 'ED: areas',currentPatch%canopy_area_profile(L,1:numpft_ed,1),currentPatch%patchno + write(fates_log(), *) 'ED: areas',currentPatch%canopy_area_profile(L,1:numpft,1),currentPatch%patchno currentCohort => currentPatch%shortest @@ -1328,7 +1328,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) enddo ! loop over L do L = 1,currentPatch%NCL_p - do ft = 1,numpft_ed + do ft = 1,numpft if(currentPatch%present(L,FT) > 1)then write(fates_log(), *) 'ED: present issue',L,ft,currentPatch%present(L,FT) currentPatch%present(L,ft) = 1 @@ -1500,28 +1500,28 @@ function calc_areaindex(cpatch,ai_type) result(ai) ai = 0._r8 if (trim(ai_type) == 'elai') then do cl = 1,cpatch%NCL_p - do ft = 1,numpft_ed + do ft = 1,numpft ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * & cpatch%elai_profile(cl,ft,1:cpatch%nrad(cl,ft))) enddo enddo elseif (trim(ai_type) == 'tlai') then do cl = 1,cpatch%NCL_p - do ft = 1,numpft_ed + do ft = 1,numpft ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * & cpatch%tlai_profile(cl,ft,1:cpatch%nrad(cl,ft))) enddo enddo elseif (trim(ai_type) == 'esai') then do cl = 1,cpatch%NCL_p - do ft = 1,numpft_ed + do ft = 1,numpft ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * & cpatch%esai_profile(cl,ft,1:cpatch%nrad(cl,ft))) enddo enddo elseif (trim(ai_type) == 'tsai') then do cl = 1,cpatch%NCL_p - do ft = 1,numpft_ed + do ft = 1,numpft ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * & cpatch%tsai_profile(cl,ft,1:cpatch%nrad(cl,ft))) enddo diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 2fbf2be010..d6b022c6ac 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -676,8 +676,8 @@ subroutine fuse_cohorts(patchptr, bc_in) type (ed_cohort_type) , pointer :: currentCohort, nextc, nextnextc integer :: i integer :: fusion_took_place - integer :: maxcohorts !maximum total no of cohorts. Needs to be >numpft_edx2 - integer :: iterate !do we need to keep fusing to get below maxcohorts? + integer :: maxcohorts ! maximum total no of cohorts. + integer :: iterate ! do we need to keep fusing to get below maxcohorts? integer :: nocohorts real(r8) :: newn real(r8) :: diff diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 2a19bf51b2..533073b0b8 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -8,17 +8,18 @@ module EDPatchDynamicsMod use EDPftvarcon , only : EDPftvarcon_inst use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort use EDtypesMod , only : ncwd, n_dbh_bins, ntol, area, dbhmax - use EDTypesMod , only : numpft_ed use EDTypesMod , only : maxPatchesPerSite use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : min_patch_area use EDTypesMod , only : nclmax + use EDTypesMod , only : maxpft use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_numlevgrnd use FatesInterfaceMod , only : hlm_numlevsoil use FatesInterfaceMod , only : hlm_numSWb use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : hlm_days_per_year + use FatesInterfaceMod , only : numpft use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue @@ -206,8 +207,8 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: age ! notional age of this patch in years integer :: tnull ! is there a tallest cohort? integer :: snull ! is there a shortest cohort? - real(r8) :: root_litter_local(numpft_ed) ! initial value of root litter. KgC/m2 - real(r8) :: leaf_litter_local(numpft_ed) ! initial value of leaf litter. KgC/m2 + real(r8) :: root_litter_local(maxpft) ! initial value of root litter. KgC/m2 + real(r8) :: leaf_litter_local(maxpft) ! initial value of leaf litter. KgC/m2 real(r8) :: cwd_ag_local(ncwd) ! initial value of above ground coarse woody debris. KgC/m2 real(r8) :: cwd_bg_local(ncwd) ! initial value of below ground coarse woody debris. KgC/m2 real(r8) :: spread_local(nclmax) ! initial value of canopy spread parameter.no units @@ -523,7 +524,7 @@ subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis newPatch%cwd_bg(c) = newPatch%cwd_bg(c) + currentPatch%cwd_bg(c) * patch_site_areadis/newPatch%area enddo - do p = 1,numpft_ed !move litter pool en mass into the new patch + 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 @@ -589,7 +590,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si 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_ed + do p = 1,numpft 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 @@ -684,7 +685,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si enddo !burned leaves. - do p = 1,numpft_ed + do p = 1,numpft currentSite%leaf_litter_burned(p) = currentSite%leaf_litter_burned(p) + & dead_tree_density * currentCohort%bl * currentCohort%cfa @@ -763,8 +764,8 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat 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_leaf_litter(numpft_ed) ! flux in to leaf litter from tree death: KgC/m2/day - real(r8) :: canopy_mortality_root_litter(numpft_ed) ! flux in to froot litter from tree death: 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) !--------------------------------------------------------------------- @@ -830,7 +831,7 @@ 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_ed))/dble(numpft_ed) + mean_agb_frac = sum(EDPftvarcon_inst%allom_agb_frac(1:numpft))/dble(numpft) do c = 1,ncwd @@ -848,7 +849,7 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat 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_ed + do p = 1,numpft 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 @@ -897,8 +898,8 @@ subroutine create_patch(currentSite, new_patch, age, areap, spread_local,cwd_ag_ allocate(new_patch%fabi(hlm_numSWb)) allocate(new_patch%sabs_dir(hlm_numSWb)) allocate(new_patch%sabs_dif(hlm_numSWb)) - allocate(new_patch%rootfr_ft(numpft_ed,hlm_numlevgrnd)) - allocate(new_patch%rootr_ft(numpft_ed,hlm_numlevgrnd)) + allocate(new_patch%rootfr_ft(numpft,hlm_numlevgrnd)) + allocate(new_patch%rootr_ft(numpft,hlm_numlevgrnd)) call zero_patch(new_patch) !The nan value in here is not working?? @@ -1152,7 +1153,7 @@ subroutine fuse_patches( csite, bc_in ) !---------------------------------------------------------------------! ! Calculate the difference criteria for each pft and dbh class ! !---------------------------------------------------------------------! - do ft = 1,numpft_ed ! loop over pfts + do ft = 1,numpft ! loop over pfts do z = 1,n_dbh_bins ! loop over hgt bins !is there biomass in this category? if(currentPatch%pft_agb_profile(ft,z) > 0.0_r8.or.tpp%pft_agb_profile(ft,z) > 0.0_r8)then @@ -1268,7 +1269,7 @@ subroutine fuse_2_patches(dp, rp) rp%cwd_bg(c) = (dp%cwd_bg(c)*dp%area + rp%cwd_bg(c)*rp%area) * inv_sum_area enddo - do p = 1,numpft_ed + do p = 1,numpft rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area) * inv_sum_area rp%seed_decay(p) = (rp%seed_decay(p)*rp%area + dp%seed_decay(p)*dp%area) * inv_sum_area rp%seed_germination(p) = (rp%seed_germination(p)*rp%area + dp%seed_germination(p)*dp%area) * inv_sum_area @@ -1531,11 +1532,7 @@ subroutine patch_pft_size_profile(cp_pnt) delta_dbh = (DBHMAX/N_DBH_BINS) - do p = 1,numpft_ed - do j = 1,N_DBH_BINS - currentPatch%pft_agb_profile(p,j) = 0.0_r8 - enddo - enddo + currentPatch%pft_agb_profile(:,:) = 0.0_r8 do j = 1,N_DBH_BINS if (j == 1) then @@ -1617,7 +1614,7 @@ subroutine set_root_fraction( cpatch , zi ) integer :: lev,p,c,ft !---------------------------------------------------------------------- - do ft = 1,numpft_ed + do ft = 1,numpft do lev = 1, hlm_numlevgrnd cpatch%rootfr_ft(ft,lev) = 0._r8 enddo diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 24b37794b3..7effa6c197 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -11,6 +11,7 @@ module EDPhysiologyMod use FatesInterfaceMod, only : hlm_model_day use FatesInterfaceMod, only : hlm_freq_day use FatesInterfaceMod, only : hlm_day_of_year + use FatesInterfaceMod, only : numpft use FatesConstantsMod, only : r8 => fates_r8 use EDEcophysContype , only : EDecophyscon use EDPftvarcon , only : EDPftvarcon_inst @@ -24,8 +25,8 @@ module EDPhysiologyMod use EDTypesMod , only : external_recruitment use EDTypesMod , only : ncwd use EDTypesMod , only : nlevleaf - use EDTypesMod , only : numpft_ed use EDTypesMod , only : senes + use EDTypesMod , only : maxpft use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use shr_log_mod , only : errMsg => shr_log_errMsg @@ -128,7 +129,7 @@ subroutine non_canopy_derivs( currentSite, currentPatch, bc_in ) call cwd_input(currentPatch) call cwd_out( currentSite, currentPatch, bc_in) - do p = 1,numpft_ed + do p = 1,numpft currentSite%dseed_dt(p) = currentSite%dseed_dt(p) + & (currentPatch%seeds_in(p) - currentPatch%seed_decay(p) - & currentPatch%seed_germination(p)) * currentPatch%area/AREA @@ -139,7 +140,7 @@ subroutine non_canopy_derivs( currentSite, currentPatch, bc_in ) currentPatch%dcwd_BG_dt(c) = currentPatch%cwd_BG_in(c) - currentPatch%cwd_BG_out(c) enddo - do p = 1,numpft_ed + do p = 1,numpft currentPatch%dleaf_litter_dt(p) = currentPatch%leaf_litter_in(p) - & currentPatch%leaf_litter_out(p) currentPatch%droot_litter_dt(p) = currentPatch%root_litter_in(p) - & @@ -630,7 +631,7 @@ subroutine seeds_in( currentSite, cp_pnt ) type(ed_patch_type), pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort integer :: p - logical :: pft_present(numpft_ed) + logical :: pft_present(maxpft) real(r8) :: npfts_present !---------------------------------------------------------------------- @@ -661,7 +662,7 @@ subroutine seeds_in( currentSite, cp_pnt ) currentPatch => cp_pnt currentCohort => currentPatch%tallest do while (associated(currentCohort)) - do p = 1, numpft_ed + do p = 1, numpft if (pft_present(p)) then currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + currentCohort%seed_prod * currentCohort%n / & (currentPatch%area * npfts_present) @@ -686,7 +687,7 @@ subroutine seeds_in( currentSite, cp_pnt ) do while(associated(currentPatch)) if (external_recruitment == 1) then !external seed rain - needed to prevent extinction - do p = 1,numpft_ed + do p = 1,numpft currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + & EDecophyscon%seed_rain(p) !KgC/m2/year currentSite%seed_rain_flux(p) = currentSite%seed_rain_flux(p) + & @@ -718,7 +719,7 @@ subroutine seed_decay( currentSite, currentPatch ) ! default value from Liscke and Loffler 2006 ; making this a PFT-specific parameter ! decays the seed pool according to exponential model ! seed_decay_turnover is in yr-1 - do p = 1,numpft_ed + do p = 1,numpft currentPatch%seed_decay(p) = currentSite%seed_bank(p) * EDPftvarcon_inst%seed_decay_turnover(p) enddo @@ -747,7 +748,7 @@ subroutine seed_germination( currentSite, currentPatch ) ! 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 - do p = 1,numpft_ed + do p = 1,numpft currentPatch%seed_germination(p) = min(currentSite%seed_bank(p) * & EDPftvarcon_inst%germination_timescale(p),max_germination) enddo @@ -1037,7 +1038,7 @@ subroutine recruitment( t, currentSite, currentPatch, bc_in ) allocate(temp_cohort) ! create temporary cohort call zero_cohort(temp_cohort) - do ft = 1,numpft_ed + do ft = 1,numpft temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded temp_cohort%pft = ft @@ -1170,7 +1171,7 @@ subroutine CWD_Input( currentPatch) enddo ! end loop over cohorts - do p = 1,numpft_ed + do p = 1,numpft currentPatch%leaf_litter_in(p) = currentPatch%leaf_litter_in(p) + currentPatch%seed_decay(p) !KgC/m2/yr enddo @@ -1238,7 +1239,7 @@ subroutine fragmentation_scaler( currentPatch, bc_in) !BTRAN APPROACH - is quite simple, but max's out decomp at all unstressed !soil moisture values, which is not realistic. !litter decomp is proportional to water limitation on average... - w_scalar = sum(currentPatch%btran_ft(1:numpft_ed))/numpft_ed + w_scalar = sum(currentPatch%btran_ft(1:numpft))/numpft currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,t_scalar * w_scalar)) @@ -1274,8 +1275,8 @@ subroutine cwd_out( currentSite, currentPatch, bc_in ) currentPatch%cwd_ag_out(1:ncwd) = 0.0_r8 currentPatch%cwd_bg_out(1:ncwd) = 0.0_r8 - currentPatch%leaf_litter_out(1:numpft_ed) = 0.0_r8 - currentPatch%root_litter_out(1:numpft_ed) = 0.0_r8 + currentPatch%leaf_litter_out(:) = 0.0_r8 + currentPatch%root_litter_out(:) = 0.0_r8 do c = 1,ncwd currentPatch%cwd_ag_out(c) = max(0.0_r8, currentPatch%cwd_ag(c) * & @@ -1289,7 +1290,7 @@ subroutine cwd_out( currentSite, currentPatch, bc_in ) ! thick leaves can dry out before they are decomposed, for example. ! this section needs further scientific input. - do ft = 1,numpft_ed + do ft = 1,numpft currentPatch%leaf_litter_out(ft) = max(0.0_r8,currentPatch%leaf_litter(ft)* SF_val_max_decomp(dl_sf) * & currentPatch%fragmentation_scaler ) currentPatch%root_litter_out(ft) = max(0.0_r8,currentPatch%root_litter(ft)* SF_val_max_decomp(dl_sf) * & @@ -1331,7 +1332,6 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) use EDTypesMod, only : AREA - use EDTypesMod, only : numpft_ed use FatesInterfaceMod, only : hlm_numlevdecomp_full use FatesInterfaceMod, only : hlm_numlevdecomp use EDPftvarcon, only : EDPftvarcon_inst @@ -1361,11 +1361,11 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) integer :: begp,endp integer :: begc,endc !bounds !------------------------------------------------------------------------ - real(r8) :: cinput_rootfr(1:numpft_ed, 1:hlm_numlevdecomp_full) ! column by pft root fraction used for calculating inputs + real(r8) :: cinput_rootfr(1:maxpft, 1:hlm_numlevdecomp_full) ! column by pft root fraction used for calculating inputs real(r8) :: croot_prof_perpatch(1:hlm_numlevdecomp_full) real(r8) :: surface_prof(1:hlm_numlevdecomp_full) integer :: ft - real(r8) :: rootfr_tot(1:numpft_ed), biomass_bg_ft(1:numpft_ed) + real(r8) :: rootfr_tot(1:maxpft), biomass_bg_ft(1:maxpft) real(r8) :: surface_prof_tot, leaf_prof_sum, stem_prof_sum, froot_prof_sum, biomass_bg_tot real(r8) :: delta @@ -1392,7 +1392,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) integer, parameter :: rooting_profile_varindex_water = 1 real(r8) :: leaf_prof(1:nsites, 1:hlm_numlevdecomp) - real(r8) :: froot_prof(1:nsites, 1:numpft_ed, 1:hlm_numlevdecomp) + real(r8) :: froot_prof(1:nsites, 1:maxpft, 1:hlm_numlevdecomp) real(r8) :: croot_prof(1:nsites, 1:hlm_numlevdecomp) real(r8) :: stem_prof(1:nsites, 1:hlm_numlevdecomp) @@ -1418,7 +1418,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! initialize profiles to zero leaf_prof(1:nsites, :) = 0._r8 - froot_prof(1:nsites, 1:numpft_ed, :) = 0._r8 + froot_prof(1:nsites, 1:maxpft, :) = 0._r8 stem_prof(1:nsites, :) = 0._r8 do s = 1,nsites @@ -1428,20 +1428,20 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) surface_prof(j) = exp(-surfprof_exp * bc_in(s)%z_sisl(j)) / bc_in(s)%dz_decomp_sisl(j) end do - cinput_rootfr(1:numpft_ed, :) = 0._r8 + cinput_rootfr(1:numpft, :) = 0._r8 ! calculate pft-specific rooting profiles in the absence of permafrost or bedrock limitations if ( exponential_rooting_profile ) then if ( .not. pftspecific_rootingprofile ) then ! define rooting profile from exponential parameters - do ft = 1, numpft_ed + do ft = 1, numpft do j = 1, hlm_numlevdecomp cinput_rootfr(ft,j) = exp(-rootprof_exp * bc_in(s)%z_sisl(j)) / bc_in(s)%dz_decomp_sisl(j) end do end do else ! use beta distribution parameter from Jackson et al., 1996 - do ft = 1, numpft_ed + do ft = 1, numpft do j = 1, hlm_numlevdecomp cinput_rootfr(ft,j) = & ( EDPftvarcon_inst%rootprof_beta(ft, rooting_profile_varindex_water) ** & @@ -1453,7 +1453,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) end do endif else - do ft = 1,numpft_ed + do ft = 1,numpft do j = 1, hlm_numlevdecomp ! use standard CLM root fraction profiles; cinput_rootfr(ft,j) = ( .5_r8*( & @@ -1469,22 +1469,21 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! ! now add permafrost constraint: integrate rootfr over active layer of soil site, ! truncate below permafrost or bedrock table where present, and rescale so that integral = 1 - do ft = 1,numpft_ed - rootfr_tot(ft) = 0._r8 - end do + rootfr_tot(:) = 0._r8 + surface_prof_tot = 0._r8 ! do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), hlm_numlevdecomp) surface_prof_tot = surface_prof_tot + surface_prof(j) * bc_in(s)%dz_decomp_sisl(j) end do - do ft = 1,numpft_ed + do ft = 1,numpft do j = 1, min(max(bc_in(s)%max_rooting_depth_index_col, 1), hlm_numlevdecomp) rootfr_tot(ft) = rootfr_tot(ft) + cinput_rootfr(ft,j) * bc_in(s)%dz_decomp_sisl(j) end do end do ! ! rescale the fine root profile - do ft = 1,numpft_ed + do ft = 1,numpft if ( (bc_in(s)%max_rooting_depth_index_col > 0) .and. (rootfr_tot(ft) > 0._r8) ) then ! where there is not permafrost extending to the surface, integrate the profiles over the active layer ! this is equivalent to integrating over all soil layers outside of permafrost regions @@ -1521,7 +1520,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! for one layer decomposition model, set profiles to unity leaf_prof(1:nsites, :) = 1._r8 - froot_prof(1:nsites, 1:numpft_ed, :) = 1._r8 + froot_prof(1:nsites, 1:numpft, :) = 1._r8 stem_prof(1:nsites, :) = 1._r8 end if @@ -1546,7 +1545,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) call endrun(msg=errMsg(sourcefile, __LINE__)) endif ! now check each fine root profile - do ft = 1,numpft_ed + do ft = 1,numpft froot_prof_sum = 0._r8 do j = 1, hlm_numlevdecomp froot_prof_sum = froot_prof_sum + froot_prof(s,ft,j) * bc_in(s)%dz_decomp_sisl(j) @@ -1583,7 +1582,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! the CWD pools lose information about which PFT they came from; for the stems this doesn't matter as they all have the same profile, ! however for the coarse roots they may have different profiles. to approximately recover this information, loop over all cohorts in patch ! to calculate the total root biomass in that patch of each pft, and then rescale the croot_prof as the weighted average of the froot_prof - biomass_bg_ft(1:numpft_ed) = 0._r8 + biomass_bg_ft(:) = 0._r8 currentCohort => currentPatch%tallest do while(associated(currentCohort)) biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + & @@ -1592,7 +1591,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) enddo !currentCohort ! biomass_bg_tot = 0._r8 - do ft = 1,numpft_ed + do ft = 1,numpft biomass_bg_tot = biomass_bg_tot + biomass_bg_ft(ft) end do ! @@ -1602,7 +1601,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) end do ! if ( biomass_bg_tot .gt. 0._r8) then - do ft = 1,numpft_ed + do ft = 1,numpft do j = 1, hlm_numlevdecomp croot_prof_perpatch(j) = croot_prof_perpatch(j) + froot_prof(s,ft,j) * biomass_bg_ft(ft) / biomass_bg_tot end do @@ -1623,7 +1622,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! write(fates_log(),*)'cdk CWD_AG_out', c, currentpatch%CWD_AG_out(c), ED_val_cwd_fcel, currentpatch%area/AREA ! write(fates_log(),*)'cdk CWD_BG_out', c, currentpatch%CWD_BG_out(c), ED_val_cwd_fcel, currentpatch%area/AREA ! end do - ! do ft = 1,numpft_ed + ! do ft = 1,numpft ! write(fates_log(),*)'cdk leaf_litter_out', ft, currentpatch%leaf_litter_out(ft), ED_val_cwd_fcel, currentpatch%area/AREA ! write(fates_log(),*)'cdk root_litter_out', ft, currentpatch%root_litter_out(ft), ED_val_cwd_fcel, currentpatch%area/AREA ! end do @@ -1644,7 +1643,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) end do ! leaf and fine root pools. - do ft = 1,numpft_ed + do ft = 1,numpft do j = 1, hlm_numlevdecomp bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 602df3fe3e..236e8611b0 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -11,11 +11,12 @@ module EDBtranMod use EDTypesMod , only : ed_site_type, & ed_patch_type, & ed_cohort_type, & - numpft_ed + maxpft use FatesInterfaceMod , only : hlm_numlevgrnd use shr_kind_mod , only : r8 => shr_kind_r8 use FatesInterfaceMod , only : bc_in_type, & - bc_out_type + bc_out_type, & + numpft use FatesInterfaceMod , only : hlm_use_planthydro use FatesGlobals , only : fates_log @@ -111,7 +112,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) real(r8) :: smp_node ! matrix potential real(r8) :: rresis ! suction limitation to transpiration independent ! of root density - real(r8) :: pftgs(numpft_ed) ! pft weighted stomatal conductance s/m + real(r8) :: pftgs(maxpft) ! pft weighted stomatal conductance s/m real(r8) :: temprootr real(r8) :: balive_patch !------------------------------------------------------------------------------ @@ -132,7 +133,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) ! THIS SHOULD REALLY BE A COHORT LOOP ONCE WE HAVE rootfr_ft FOR COHORTS (RGK) - do ft = 1,numpft_ed + do ft = 1,numpft cpatch%btran_ft(ft) = 0.0_r8 do j = 1,hlm_numlevgrnd @@ -187,14 +188,14 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) do j = 1,hlm_numlevgrnd bc_out(s)%rootr_pagl(ifp,j) = 0._r8 - do ft = 1,numpft_ed + do ft = 1,numpft if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail !bit-retart test as a result? FIX(RF,032414) bc_out(s)%rootr_pagl(ifp,j) = bc_out(s)%rootr_pagl(ifp,j) + & cpatch%rootr_ft(ft,j) * pftgs(ft)/sum(pftgs) else bc_out(s)%rootr_pagl(ifp,j) = bc_out(s)%rootr_pagl(ifp,j) + & - cpatch%rootr_ft(ft,j) * 1./numpft_ed + cpatch%rootr_ft(ft,j) * 1./numpft end if enddo enddo @@ -206,12 +207,12 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) if(hlm_use_planthydro.eq.ifalse) then !weight patch level output BTRAN for the bc_out(s)%btran_pa(ifp) = 0.0_r8 - do ft = 1,numpft_ed + do ft = 1,numpft if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail !bit-retart test as a result? FIX(RF,032414) bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + cpatch%btran_ft(ft) * pftgs(ft)/sum(pftgs) else - bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + cpatch%btran_ft(ft) * 1./numpft_ed + bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + cpatch%btran_ft(ft) * 1./numpft end if enddo end if @@ -238,117 +239,5 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) end subroutine btran_ed - ! ========================================================================================= - - !--------------------------------------------------------------------------------------- - ! SPA based recalculation of BTRAN and water uptake. - !--------------------------------------------------------------------------------------- - -! if (SPA_soil) then ! normal case don't run this. -! rootr(p,:) = 0._r8 -! do FT = 1,numpft_ed - -! ! Soil Physics -! do j = 1,nlevgrnd -! ! CLM water retention curve. Clapp and Hornberger equation. -! s1 = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) -! s1 = min(1.0_r8,s1) -! smp_node = -sucsat(c,j)*s1**(-bsw(c,j)) -! swp_mpa(j) = smp_node *10.0_r8/1000000.0_r8 !convert from mm to Mpa - -! ! CLM hydraulic conductivity curve. -! ! As opposed to the Richard's equation solution in SoilHydrology.Mod -! ! the conductivity here is defined in the middle of the layer in question, not at the edge... -! xksat = 0.0070556_r8 * (10._r8**(-0.884_r8+0.0153_r8*sand(p)) ) -! hk(j) = xksat*s1**(2._r8*bsw(c,j)+2._r8) !removed the ice from here to avoid 1st ts crashing -! enddo - -! ! Root resistance -! rootxsecarea=3.14159*rootrad**2 -! do j = 1,nlevgrnd -! rootmass(j) = EDecophyscon%soilbeta(FT) * cpatch%rootfr_ft(FT,j) -! rootlength(j) = rootmass(j)/(rootdens*rootxsecarea) !m m-3 soil -! Lsoil(j) = hk(j)/1000/head !converts from mms-1 to ms-1 and then to m2 s-1 MPa-1 -! if(Lsoil(j) < 1e-35_r8.or.cpatch%rootfr_ft(ft,j) <= 0.0_r8)then !prevent floating point error -! soilr_z(j) = 1e35_r8 -! soilr2(j) = 1e35_r8 -! else -! ! Soil-to-root water uptake from Newman (1969). -! rs = sqrt (1._r8 / (rootlength(j) * pi)) -! soilr1(j) = log(rs/rootrad) / (2.0_r8 * pi * rootlength(j) * Lsoil(j) * dz(c,j)) -! ! convert from MPa s m2 m-3 to MPa s m2 mmol-1 -! soilr1(j) = soilr1(j) * 1E-6_r8 * 18_r8 * 0.001_r8 -! ! second component of below ground resistance is related to root hydraulics -! soilr2(j) = EDecophyscon%rootresist(FT)/(rootmass(j)*dz(c,j)) -! soilr_z(j) = soilr1(j)+soilr2(j) -! end if -! enddo - - ! Aggregate soil layers -! totestevap=0._r8 -! weighted_SWP=0._r8 -! estevap=0._r8 -! fraction_uptake=0._r8 -! canopy_soil_resistance=0._r8 !Reset Counters -! totmaxevap = 0._r8 - - ! Estimated max transpiration from LWP gradient / soil resistance -! do j = 1,nlevgrnd -! estevap(j) = (swp_mpa(j) - minlwp)/(soilr_z(j)) -! estevap(j) = max(0._r8,estevap(j)) ! no negative uptake -! maxevap(j) = (0.0_r8 - minlwp)/(soilr2(j)) -! enddo -! totestevap = sum(estevap) -! totmaxevap = sum(maxevap) - - ! Weighted soil water potential -! do j = 1,nlevgrnd -! if(totestevap > 0._r8)then -! fraction_uptake(j) = estevap(j)/totestevap !Fraction of total ET taken from this soil layer -! else -! estevap(j) = 0._r8 -! fraction_uptake(j)=1._r8/nlevgrnd -! end if -! weighted_SWP = weighted_SWP + swp_mpa(j) * estevap(j) -! enddo - -! if(totestevap > 0._r8)then -! weighted_swp = weighted_swp/totestevap -! ! weight SWP for the total evaporation -! else -! write(fates_log(),*) 'empty soil', totestevap -! ! error check -! weighted_swp = minlwp -! end if - - ! Weighted soil-root resistance. Aggregate the conductances (1/soilR) for each soil layer -! do iv = 1,nv !leaf layers -! fleaf = 1.0_r8/nv -! do j = 1,nlevgrnd !root layers -! ! Soil resistance for each canopy layer is related to leaf area -! ! The conductance of the root system to the -! ! whole canopy is reduced by the fraction of leaves in this layer... -! canopy_soil_resistance(iv) = canopy_soil_resistance(iv)+fleaf * 1.0_r8/(soilr_z(j)) -! enddo -! ! Turn aggregated conductance back into resistance. mmol MPa-1 s-1 m-2 to MPa s m2 mmol-1 -! canopy_soil_resistance(iv) = 1./canopy_soil_resistance(iv) -! enddo -! -! cpatch%btran_ft(FT) = totestevap/totmaxevap -! do j = 1,nlevgrnd -! if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail -! !bit-retart test as a result? FIX(RF,032414) -! rootr(p,j) = rootr(p,j) + fraction_uptake(j) * pftgs(ft)/sum(pftgs) -! else -! rootr(p,j) = rootr(p,j) + fraction_uptake(j) * 1./numpft_ed -! end if -! enddo -! enddo !pft loop -! end if ! - !--------------------------------------------------------------------------------------- - ! end of SPA based recalculation of BTRAN and water uptake. - !--------------------------------------------------------------------------------------- - - end module EDBtranMod diff --git a/biogeophys/EDSurfaceAlbedoMod.F90 b/biogeophys/EDSurfaceAlbedoMod.F90 index 6da2a28040..ceac148d72 100644 --- a/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/biogeophys/EDSurfaceAlbedoMod.F90 @@ -11,15 +11,15 @@ module EDSurfaceRadiationMod #include "shr_assert.h" use EDTypesMod , only : ed_patch_type, ed_site_type - use EDTypesMod , only : numpft_ed use EDTypesMod , only : maxPatchesPerSite + use EDTypesMod , only : maxpft use FatesConstantsMod , only : r8 => fates_r8 use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : bc_out_type use FatesInterfaceMod , only : hlm_numSWb + use FatesInterfaceMod , only : numpft use EDTypesMod , only : maxSWb use EDTypesMod , only : nclmax - use EDTypesMod , only : numpft_ed use EDTypesMod , only : nlevleaf use EDCanopyStructureMod, only: calc_areaindex use FatesGlobals , only : fates_log @@ -74,10 +74,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: sb real(r8) :: error ! Error check real(r8) :: down_rad, up_rad ! Iterative solution do Dif_dn and Dif_up - real(r8) :: ftweight(nclmax,numpft_ed,nlevleaf) - real(r8) :: k_dir(numpft_ed) ! Direct beam extinction coefficient - real(r8) :: tr_dir_z(nclmax,numpft_ed,nlevleaf) ! Exponential transmittance of direct beam radiation through a single layer - real(r8) :: tr_dif_z(nclmax,numpft_ed,nlevleaf) ! Exponential transmittance of diffuse radiation through a single layer + real(r8) :: ftweight(nclmax,maxpft,nlevleaf) + real(r8) :: k_dir(maxpft) ! Direct beam extinction coefficient + real(r8) :: tr_dir_z(nclmax,maxpft,nlevleaf) ! Exponential transmittance of direct beam radiation through a single layer + real(r8) :: tr_dif_z(nclmax,maxpft,nlevleaf) ! Exponential transmittance of diffuse radiation through a single layer real(r8) :: forc_dir(maxPatchesPerSite,maxSWb) real(r8) :: forc_dif(maxPatchesPerSite,maxSWb) real(r8) :: weighted_dir_tr(nclmax) @@ -85,20 +85,20 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: weighted_dif_ratio(nclmax,maxSWb) real(r8) :: weighted_dif_down(nclmax) real(r8) :: weighted_dif_up(nclmax) - real(r8) :: refl_dif(nclmax,numpft_ed,nlevleaf,maxSWb) ! Term for diffuse radiation reflected by laye - real(r8) :: tran_dif(nclmax,numpft_ed,nlevleaf,maxSWb) ! Term for diffuse radiation transmitted by layer - real(r8) :: dif_ratio(nclmax,numpft_ed,nlevleaf,maxSWb) ! Ratio of upward to forward diffuse fluxes - real(r8) :: Dif_dn(nclmax,numpft_ed,nlevleaf) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) - real(r8) :: Dif_up(nclmax,numpft_ed,nlevleaf) ! Upward diffuse flux above canopy layer J (W/m**2 ground area) - real(r8) :: lai_change(nclmax,numpft_ed,nlevleaf) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) - real(r8) :: f_not_abs(numpft_ed,maxSWb) ! Fraction reflected + transmitted. 1-absorbtion. - real(r8) :: Abs_dir_z(numpft_ed,nlevleaf) - real(r8) :: Abs_dif_z(numpft_ed,nlevleaf) + real(r8) :: refl_dif(nclmax,maxpft,nlevleaf,maxSWb) ! Term for diffuse radiation reflected by laye + real(r8) :: tran_dif(nclmax,maxpft,nlevleaf,maxSWb) ! Term for diffuse radiation transmitted by layer + real(r8) :: dif_ratio(nclmax,maxpft,nlevleaf,maxSWb) ! Ratio of upward to forward diffuse fluxes + real(r8) :: Dif_dn(nclmax,maxpft,nlevleaf) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + real(r8) :: Dif_up(nclmax,maxpft,nlevleaf) ! Upward diffuse flux above canopy layer J (W/m**2 ground area) + real(r8) :: lai_change(nclmax,maxpft,nlevleaf) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + real(r8) :: f_not_abs(maxpft,maxSWb) ! Fraction reflected + transmitted. 1-absorbtion. + real(r8) :: Abs_dir_z(maxpft,nlevleaf) + real(r8) :: Abs_dif_z(maxpft,nlevleaf) real(r8) :: abs_rad(maxSWb) !radiation absorbed by soil real(r8) :: tr_soili ! Radiation transmitted to the soil surface. real(r8) :: tr_soild ! Radiation transmitted to the soil surface. - real(r8) :: phi1b(maxPatchesPerSite,numpft_ed) ! Radiation transmitted to the soil surface. - real(r8) :: phi2b(maxPatchesPerSite,numpft_ed) + real(r8) :: phi1b(maxPatchesPerSite,maxpft) ! Radiation transmitted to the soil surface. + real(r8) :: phi2b(maxPatchesPerSite,maxpft) real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) real(r8) :: angle @@ -192,7 +192,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! Is this pft/canopy layer combination present in this patch? do L = 1,nclmax - do ft = 1,numpft_ed + do ft = 1,numpft currentPatch%present(L,ft) = 0 do iv = 1, currentPatch%nrad(L,ft) if (currentPatch%canopy_area_profile(L,ft,iv) > 0._r8)then @@ -219,7 +219,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) !Extract information that needs to be provided by ED into local array. ftweight(:,:,:) = 0._r8 do L = 1,currentPatch%NCL_p - do ft = 1,numpft_ed + do ft = 1,numpft do iv = 1, currentPatch%nrad(L,ft) !this is already corrected for area in CLAP ftweight(L,ft,iv) = currentPatch%canopy_area_profile(L,ft,iv) @@ -237,7 +237,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! Direct beam extinction coefficient, k_dir. PFT specific. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! cosz = max(0.001_r8, bc_in(s)%coszen_pa(ifp)) !copied from previous radiation code... - do ft = 1,numpft_ed + do ft = 1,numpft sb = (90._r8 - (acos(cosz)*180/pi)) * (pi / 180._r8) chil(ifp) = xl(ft) !min(max(xl(ft), -0.4_r8), 0.6_r8 ) if (abs(chil(ifp)) <= 0.01_r8) then @@ -255,7 +255,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) weighted_fsun(L) = 0._r8 weighted_dif_ratio(L,1:hlm_numSWb) = 0._r8 !Each canopy layer (canopy, understorey) has multiple 'parallel' pft's - do ft =1,numpft_ed + do ft =1,numpft if (currentPatch%present(L,ft) == 1)then !only do calculation if there are the appropriate leaves. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! ! Diffuse transmittance, tr_dif, do each layer with thickness elai_z. @@ -387,7 +387,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) end do !L do L = currentPatch%NCL_p,1, -1 !start at the bottom and work up. - do ft = 1,numpft_ed + do ft = 1,numpft if (currentPatch%present(L,ft) == 1)then !==============================================================================! ! Iterative solution do scattering @@ -445,7 +445,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) Dif_up(:,:,:) = 0.00_r8 do L = 1, currentPatch%NCL_p !work down from the top of the canopy. weighted_dif_down(L) = 0._r8 - do ft = 1, numpft_ed + do ft = 1, numpft if (currentPatch%present(L,ft) == 1)then !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! ! First estimates do downward and upward diffuse flux @@ -501,7 +501,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) do L = currentPatch%NCL_p,1 ,-1 !work up from the bottom. weighted_dif_up(L) = 0._r8 - do ft = 1, numpft_ed + do ft = 1, numpft if (currentPatch%present(L,ft) == 1)then !Bounce diffuse radiation off soil surface. iv = currentPatch%nrad(L,ft) + 1 @@ -557,7 +557,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) irep = 0 do L = 1,currentPatch%NCL_p !working from the top down weighted_dif_down(L) = 0._r8 - do ft =1,numpft_ed + do ft =1,numpft if (currentPatch%present(L,ft) == 1)then ! forward diffuse flux within the canopy and at soil, working forward through canopy ! with Dif_up -from previous iteration-. Dif_dn(1) is the forward diffuse flux onto the canopy. @@ -612,7 +612,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) do L = 1, currentPatch%NCL_p ! working from the top down. weighted_dif_up(L) = 0._r8 - do ft =1,numpft_ed + do ft =1,numpft if (currentPatch%present(L,ft) == 1)then ! Upward diffuse flux at soil or from lower canopy (forward diffuse and unscattered direct beam) iv = currentPatch%nrad(L,ft) + 1 @@ -664,7 +664,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) do L = 1, currentPatch%NCL_p !working from the top down. abs_dir_z(:,:) = 0._r8 abs_dif_z(:,:) = 0._r8 - do ft =1,numpft_ed + do ft =1,numpft if (currentPatch%present(L,ft) == 1)then !==============================================================================! ! Compute absorbed flux densities @@ -820,7 +820,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) endif lai_reduction(:) = 0.0_r8 do L = 1, currentPatch%NCL_p - do ft =1,numpft_ed + do ft =1,numpft if (currentPatch%present(L,ft) == 1)then do iv = 1, currentPatch%nrad(L,ft) if (lai_change(L,ft,iv) > 0.0_r8)then @@ -866,10 +866,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) write(fates_log(),*) 'Large Dir Radn consvn error',error ,ifp,ib write(fates_log(),*) 'diags', bc_out(s)%albd_parb(ifp,ib), bc_out(s)%ftdd_parb(ifp,ib), & bc_out(s)%ftid_parb(ifp,ib), bc_out(s)%fabd_parb(ifp,ib) - write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft_ed,1:4) - write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft_ed,1:4) - write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft_ed,1:4) - write(fates_log(),*) 'ftweight',ftweight(1,1:numpft_ed,1:4) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:4) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:4) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:4) + write(fates_log(),*) 'ftweight',ftweight(1,1:numpft,1:4) write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno write(fates_log(),*) 'bc_in(s)%albgr_dir_rb(ib)',bc_in(s)%albgr_dir_rb(ib) @@ -885,16 +885,16 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) write(fates_log(),*) '>5% Dif Radn consvn error',error ,ifp,ib write(fates_log(),*) 'diags', bc_out(s)%albi_parb(ifp,ib), bc_out(s)%ftii_parb(ifp,ib), & bc_out(s)%fabi_parb(ifp,ib) - write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft_ed,1:4) - write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft_ed,1:4) - write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft_ed,1:4) - write(fates_log(),*) 'ftweight',ftweight(currentpatch%ncl_p,1:numpft_ed,1:4) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:4) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:4) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:4) + write(fates_log(),*) 'ftweight',ftweight(currentpatch%ncl_p,1:numpft,1:4) write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno write(fates_log(),*) 'bc_in(s)%albgr_dif_rb(ib)',bc_in(s)%albgr_dif_rb(ib) - write(fates_log(),*) 'rhol',rhol(1:numpft_ed,:) - write(fates_log(),*) 'ftw',sum(ftweight(1,:,1)),ftweight(1,1:numpft_ed,1) - write(fates_log(),*) 'present',currentPatch%present(1,1:numpft_ed) - write(fates_log(),*) 'CAP',currentPatch%canopy_area_profile(1,1:numpft_ed,1) + write(fates_log(),*) 'rhol',rhol(1:numpft,:) + write(fates_log(),*) 'ftw',sum(ftweight(1,:,1)),ftweight(1,1:numpft,1) + write(fates_log(),*) 'present',currentPatch%present(1,1:numpft) + write(fates_log(),*) 'CAP',currentPatch%canopy_area_profile(1,1:numpft,1) bc_out(s)%albi_parb(ifp,ib) = bc_out(s)%albi_parb(ifp,ib) + error end if @@ -961,7 +961,7 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) ifp=ifp+1 - if( DEBUG ) write(fates_log(),*) 'edsurfRad_5600',ifp,s,cpatch%NCL_p,numpft_ed + if( DEBUG ) write(fates_log(),*) 'edsurfRad_5600',ifp,s,cpatch%NCL_p,numpft ! zero out various datas cpatch%ed_parsun_z(:,:,:) = 0._r8 @@ -982,7 +982,7 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) ! cpatch%f_sun is calculated in the surface_albedo routine... do CL = 1, cpatch%NCL_p - do FT = 1,numpft_ed + do FT = 1,numpft if( DEBUG ) write(fates_log(),*) 'edsurfRad_5601',CL,FT,cpatch%nrad(CL,ft) @@ -1029,10 +1029,10 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) ! If sun/shade big leaf code, nrad=1 and fluxes from SurfaceAlbedo ! are canopy integrated so that layer values equal big leaf values. - if ( DEBUG ) write(fates_log(),*) 'edsurfRad 645 ',cpatch%NCL_p,numpft_ed + if ( DEBUG ) write(fates_log(),*) 'edsurfRad 645 ',cpatch%NCL_p,numpft do CL = 1, cpatch%NCL_p - do FT = 1,numpft_ed + do FT = 1,numpft if ( DEBUG ) write(fates_log(),*) 'edsurfRad 649 ',cpatch%nrad(CL,ft) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 4901ac30a4..0cfd778323 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -25,7 +25,8 @@ module FATESPlantRespPhotosynthMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : itrue use FatesInterfaceMod, only : hlm_use_planthydro - use EDTypesMod, only : numpft_ed + use FatesInterfaceMod, only : numpft + use EDTypesMod, only : maxpft use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax @@ -272,7 +273,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! but not environmentally dependent ! ------------------------------------------------------------------------ - do ft = 1,numpft_ed + do ft = 1,numpft ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 used ! kn = 0.11. Here, derive kn from vcmax25 as in Lloyd et al @@ -308,7 +309,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! NOTE: Only need to flush mask on the number of used pfts, not the whole ! scratch space. ! ------------------------------------------------------------------------ - rate_mask_z(:,1:numpft_ed,:) = .false. + rate_mask_z(:,1:numpft,:) = .false. if(currentPatch%countcohorts > 0.0)then ! Ignore empty patches @@ -1343,7 +1344,7 @@ subroutine UpdateCanopyNCanNRadPresent(currentPatch) ! Now loop through and identify which layer and pft combo has scattering elements do cl = 1,nclmax - do ft = 1,numpft_ed + do ft = 1,numpft currentPatch%present(cl,ft) = 0 do iv = 1, currentPatch%nrad(cl,ft); if(currentPatch%canopy_area_profile(cl,ft,iv) > 0._r8)then diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 811151023f..6056fb16f0 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -19,10 +19,11 @@ module EDInitMod use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, area use EDTypesMod , only : ncwd use EDTypesMod , only : nuMWaterMem - use EDTypesMod , only : numpft_ed + use EDTypesMod , only : maxpft use FatesInterfaceMod , only : bc_in_type use FatesInterfaceMod , only : hlm_use_planthydro use FatesInterfaceMod , only : hlm_use_inventory_init + use FatesInterfaceMod , only : numpft ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -216,8 +217,8 @@ subroutine init_patches( nsites, sites, bc_in) real(r8) :: cwd_ag_local(ncwd) real(r8) :: cwd_bg_local(ncwd) real(r8) :: spread_local(nclmax) - real(r8) :: leaf_litter_local(numpft_ed) - real(r8) :: root_litter_local(numpft_ed) + real(r8) :: leaf_litter_local(maxpft) + real(r8) :: root_litter_local(maxpft) real(r8) :: age !notional age of this patch type(ed_patch_type), pointer :: newp @@ -302,7 +303,7 @@ subroutine init_cohorts( patch_in, bc_in) patch_in%tallest => null() patch_in%shortest => null() - do pft = 1,numpft_ed !FIX(RF,032414) - turning off veg dynamics + do pft = 1,numpft if(EDecophyscon%initd(pft)>1.0E-7) then diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 1db955f715..a2a204454f 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -17,6 +17,7 @@ module EDMainMod use FatesInterfaceMod , only : hlm_use_ed_st3 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 @@ -34,7 +35,6 @@ module EDMainMod use SFMainMod , only : fire_model use EDTypesMod , only : get_age_class_index use EDtypesMod , only : ncwd - use EDTypesMod , only : numpft_ed use EDtypesMod , only : ed_site_type use EDtypesMod , only : ed_patch_type use EDtypesMod , only : ed_cohort_type @@ -228,9 +228,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) small_no = 0.0000000000_r8 ! Obviously, this is arbitrary. RF - changed to zero - do ft = 1,numpft_ed - currentSite%dseed_dt(ft) = 0._r8 ! zero the dseed_dt at the site level before looping through patches and adding the fluxes from each patch - end do + currentSite%dseed_dt(:) = 0._r8 currentSite%seed_rain_flux(:) = 0._r8 currentPatch => currentSite%youngest_patch @@ -309,7 +307,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + currentPatch%dcwd_bg_dt(c)* hlm_freq_day enddo - do ft = 1,numpft_ed + do ft = 1,numpft currentPatch%leaf_litter(ft) = currentPatch%leaf_litter(ft) + currentPatch%dleaf_litter_dt(ft)* hlm_freq_day currentPatch%root_litter(ft) = currentPatch%root_litter(ft) + currentPatch%droot_litter_dt(ft)* hlm_freq_day enddo @@ -325,7 +323,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) endif enddo - do ft = 1,numpft_ed + do ft = 1,numpft if(currentPatch%leaf_litter(ft) 1.0E-8_r8 ) then write(fates_log(),*) 'nplant check on hio_nplant_si_scpf fails during hydraulics history updates' call endrun(msg=errMsg(sourcefile, __LINE__)) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index efd5f4f732..4d7a9abd34 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -17,13 +17,14 @@ module FatesInterfaceMod use EDTypesMod , only : inir use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf - use EDTypesMod , only : numpft_ed + use EDTypesMod , only : maxpft use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use EDPftvarcon , only : FatesReportPFTParams + use EDPftvarcon , only : EDPftvarcon_inst use EDParamsMod , only : FatesReportParams @@ -218,6 +219,16 @@ module FatesInterfaceMod real(r8), protected :: hlm_freq_day ! fraction of year for daily time-step ! (1/days_per_year_, this is a frequency + + ! ------------------------------------------------------------------------------------- + ! + ! Constant parameters that are dictated by the fates parameter file + ! + ! ------------------------------------------------------------------------------------- + + integer, protected :: numpft ! The total number of PFTs defined in the simulation + + ! ------------------------------------------------------------------------------------- ! Structured Boundary Conditions (SITE/PATCH SCALE) ! For floating point arrays, it is sometimes the convention to define the arrays as @@ -854,7 +865,7 @@ subroutine set_fates_global_elements(use_fates) if(numpft>maxpft) then write(fates_log(), *) 'The number of PFTs dictated by the FATES parameter file' - write(fates_log(), *) 'is larger than the maximum allowed. Increase the parameter constant:' + write(fates_log(), *) 'is larger than the maximum allowed. Increase the FATES parameter constant' write(fates_log(), *) 'FatesInterfaceMod.F90:maxpft accordingly' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -862,10 +873,10 @@ subroutine set_fates_global_elements(use_fates) ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays - + fates_maxElementsPerPatch = max(maxCohortsPerPatch, & - numpft_ed * nclmax * nlevleaf) - + numpft * nclmax * nlevleaf) + fates_maxElementsPerSite = maxPatchesPerSite * fates_maxElementsPerPatch diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 634a0e9ad9..fb6f61b809 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -76,7 +76,6 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) use shr_file_mod, only : shr_file_getUnit use shr_file_mod, only : shr_file_freeUnit use EDTypesMod, only : nclmax - use EDTypesMod, only : numpft_ed use EDTypesMod, only : maxpft use EDTypesMod, only : ncwd use EDParamsMod, only : ED_val_maxspread @@ -252,12 +251,12 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) spread_init(:) = ED_val_maxspread cwd_ag_init(:) = 0.0_r8 cwd_bg_init(:) = 0.0_r8 - leaf_litter_init(1:numpft_ed) = 0.0_r8 - root_litter_init(1:numpft_ed) = 0.0_r8 + leaf_litter_init(:) = 0.0_r8 + root_litter_init(:) = 0.0_r8 call create_patch(sites(s), newpatch, age_init, area_init, spread_init, & cwd_ag_init, cwd_bg_init, & - leaf_litter_init(1:numpft_ed), root_litter_init(1:numpft_ed) ) + leaf_litter_init, root_litter_init ) if( inv_format_list(invsite) == 1 ) then call set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) @@ -644,7 +643,6 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name use EDTypesMod, only: get_age_class_index use EDtypesMod, only: AREA - use EDTypesMod, only: numpft_ed use EDTypesMod, only: ncwd use SFParamsMod , only : SF_val_CWD_frac @@ -719,10 +717,10 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name newpatch%cwd_bg(icwd) = 0.0_r8 end do - do ipft = 1, numpft_ed - newpatch%leaf_litter(ipft) = 0.0_r8 - newpatch%root_litter(ipft) = 0.0_r8 - end do + + newpatch%leaf_litter(:) = 0.0_r8 + newpatch%root_litter(:) = 0.0_r8 + return end subroutine set_inventory_edpatch_type1 @@ -754,11 +752,11 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! avgRG (cm/yr?) Average Radial Growth (NOT USED) ! -------------------------------------------------------------------------------------------- - use EDTypesMod , only : numpft_ed use EDGrowthFunctionsMod, only : hite use EDGrowthFunctionsMod, only : bleaf use EDGrowthFunctionsMod, only : bdead use EDCohortDynamicsMod , only : create_cohort + use FatesInterfaceMod , only : numpft ! Arguments type(ed_site_type),intent(inout), target :: csite ! current site @@ -824,10 +822,10 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! pft, nplant and dbh are the critical ones in this format specification ! ------------------------------------------------------------------------------------------- - if (c_pft > numpft_ed ) then + if (c_pft > numpft ) then write(fates_log(), *) 'inventory pft: ',c_pft write(fates_log(), *) 'An inventory cohort file specified a pft index' - write(fates_log(), *) 'greater than the maximum specified pfts ed_numpft' + write(fates_log(), *) 'greater than the maximum specified pfts numpft' call endrun(msg=errMsg(sourcefile, __LINE__)) end if diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 12b1d6bc9b..347bfc9052 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -932,7 +932,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) use EDTypesMod, only : nclmax use EDTypesMod, only : nlevleaf use FatesInterfaceMod, only : fates_maxElementsPerPatch - use EDTypesMod, only : numpft_ed + use FatesInterfaceMod, only : numpft use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type @@ -1083,7 +1083,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_pa_sunz = io_idx_co_1st ! write seed_bank info(site-level, but PFT-resolved) - do i = 1,numpft_ed + do i = 1,numpft rio_seed_bank_sift(io_idx_co_1st+i-1) = sites(s)%seed_bank(i) end do @@ -1184,9 +1184,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! ! deal with patch level fields of arrays here ! - ! these are arrays of length numpft_ed, each patch contains one + ! these are arrays of length numpft, each patch contains one ! vector so we increment - do i = 1,numpft_ed + do i = 1,numpft rio_leaf_litter_paft(io_idx_pa_pft) = cpatch%leaf_litter(i) rio_root_litter_paft(io_idx_pa_pft) = cpatch%root_litter(i) rio_leaf_litter_in_paft(io_idx_pa_pft) = cpatch%leaf_litter_in(i) @@ -1207,10 +1207,10 @@ subroutine set_restart_vectors(this,nc,nsites,sites) if ( DEBUG ) write(fates_log(),*) 'CLTV io_idx_pa_sunz 1 ',io_idx_pa_sunz - if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',nlevleaf,numpft_ed,nclmax + if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',nlevleaf,numpft,nclmax - do k = 1,nlevleaf ! nlevleaf currently 40 - do j = 1,numpft_ed ! numpft_ed currently 2 + do k = 1,nlevleaf ! nlevleaf currently 40 + do j = 1,numpft ! dependent on parameter file do i = 1,nclmax ! nclmax currently 2 rio_fsun_paclftls(io_idx_pa_sunz) = cpatch%f_sun(i,j,k) rio_fabd_sun_z_paclftls(io_idx_pa_sunz) = cpatch%fabd_sun_z(i,j,k) @@ -1229,9 +1229,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! by the maximum number of cohorts per patch io_idx_co_1st = io_idx_co_1st + fates_maxElementsPerPatch - ! reset counters so that they are all advanced evenly. Currently - ! the offset is 10, the max of numpft_ed, ncwd, nclmax, - ! io_idx_si_wmem and the number of allowed cohorts per patch + ! reset counters so that they are all advanced evenly. io_idx_pa_pft = io_idx_co_1st io_idx_pa_cwd = io_idx_co_1st io_idx_pa_cl = io_idx_co_1st @@ -1308,7 +1306,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax use FatesInterfaceMod, only : fates_maxElementsPerPatch - use EDTypesMod, only : numpft_ed + use EDTypesMod, only : maxpft use EDTypesMod, only : area use EDPatchDynamicsMod, only : zero_patch use EDGrowthFunctionsMod, only : Dbh @@ -1332,8 +1330,8 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) real(r8) :: cwd_ag_local(ncwd) real(r8) :: cwd_bg_local(ncwd) real(r8) :: spread_local(nclmax) - real(r8) :: leaf_litter_local(numpft_ed) - real(r8) :: root_litter_local(numpft_ed) + real(r8) :: leaf_litter_local(maxpft) + real(r8) :: root_litter_local(maxpft) real(r8) :: patch_age integer :: cohortstatus integer :: s ! site index @@ -1503,10 +1501,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : numpft_ed use EDTypesMod, only : ncwd use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax + use FatesInterfaceMod, only : numpft use FatesInterfaceMod, only : fates_maxElementsPerPatch use EDTypesMod, only : numWaterMem @@ -1644,7 +1642,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_wmem = io_idx_co_1st ! read seed_bank info(site-level, but PFT-resolved) - do i = 1,numpft_ed + do i = 1,numpft sites(s)%seed_bank(i) = rio_seed_bank_sift(io_idx_co_1st+i-1) enddo @@ -1745,10 +1743,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! ! deal with patch level fields of arrays here ! - ! these are arrays of length numpft_ed, each patch contains one + ! these are arrays of length numpft, each patch contains one ! vector so we increment - do i = 1,numpft_ed + do i = 1,numpft cpatch%leaf_litter(i) = rio_leaf_litter_paft(io_idx_pa_pft) cpatch%root_litter(i) = rio_root_litter_paft(io_idx_pa_pft) cpatch%leaf_litter_in(i) = rio_leaf_litter_in_paft(io_idx_pa_pft) @@ -1770,7 +1768,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) if ( DEBUG ) write(fates_log(),*) 'CVTL io_idx_pa_sunz 1 ',io_idx_pa_sunz do k = 1,nlevleaf ! nlevleaf currently 40 - do j = 1,numpft_ed ! numpft_ed currently 2 + do j = 1,numpft do i = 1,nclmax ! nclmax currently 2 cpatch%f_sun(i,j,k) = rio_fsun_paclftls(io_idx_pa_sunz) cpatch%fabd_sun_z(i,j,k) = rio_fabd_sun_z_paclftls(io_idx_pa_sunz) From da330551badd5539c773c4cfb8d44233b38e7b85 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 15 Aug 2017 15:23:01 -0700 Subject: [PATCH 21/23] Some small modifications on zeroing out some static arrays with pft indices. Exending the zeroing range to include maxpft instead of numpft where appropriate. --- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeophys/EDBtranMod.F90 | 14 ++++--- biogeophys/EDSurfaceAlbedoMod.F90 | 64 ++++++++++++------------------- main/EDParamsMod.F90 | 1 - main/FatesHistoryInterfaceMod.F90 | 1 - main/FatesParameterDerivedMod.F90 | 22 +++++------ 6 files changed, 45 insertions(+), 59 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 7effa6c197..5faf7a873b 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1428,7 +1428,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) surface_prof(j) = exp(-surfprof_exp * bc_in(s)%z_sisl(j)) / bc_in(s)%dz_decomp_sisl(j) end do - cinput_rootfr(1:numpft, :) = 0._r8 + cinput_rootfr(:,:) = 0._r8 ! calculate pft-specific rooting profiles in the absence of permafrost or bedrock limitations if ( exponential_rooting_profile ) then diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 236e8611b0..47a70b16df 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -115,6 +115,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) real(r8) :: pftgs(maxpft) ! pft weighted stomatal conductance s/m real(r8) :: temprootr real(r8) :: balive_patch + real(r8) :: sum_pftgs ! sum of weighted conductances (for normalization) !------------------------------------------------------------------------------ associate( & @@ -185,14 +186,15 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) ! sink term across the different layers in driver/host. Photosynthesis will ! pass the host a total transpiration for the patch. This needs rootr to be ! distributed over the soil layers. - + sum_pftgs = sum(pftgs(1:numpft)) + do j = 1,hlm_numlevgrnd bc_out(s)%rootr_pagl(ifp,j) = 0._r8 do ft = 1,numpft - if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail + if( sum_pftgs > 0._r8)then !prevent problem with the first timestep - might fail !bit-retart test as a result? FIX(RF,032414) bc_out(s)%rootr_pagl(ifp,j) = bc_out(s)%rootr_pagl(ifp,j) + & - cpatch%rootr_ft(ft,j) * pftgs(ft)/sum(pftgs) + cpatch%rootr_ft(ft,j) * pftgs(ft)/sum_pftgs else bc_out(s)%rootr_pagl(ifp,j) = bc_out(s)%rootr_pagl(ifp,j) + & cpatch%rootr_ft(ft,j) * 1./numpft @@ -208,9 +210,9 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) !weight patch level output BTRAN for the bc_out(s)%btran_pa(ifp) = 0.0_r8 do ft = 1,numpft - if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail + if( sum_pftgs > 0._r8)then !prevent problem with the first timestep - might fail !bit-retart test as a result? FIX(RF,032414) - bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + cpatch%btran_ft(ft) * pftgs(ft)/sum(pftgs) + bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + cpatch%btran_ft(ft) * pftgs(ft)/sum_pftgs else bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + cpatch%btran_ft(ft) * 1./numpft end if @@ -220,7 +222,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) temprootr = sum(bc_out(s)%rootr_pagl(ifp,1:hlm_numlevgrnd)) if(abs(1.0_r8-temprootr) > 1.0e-10_r8 .and. temprootr > 1.0e-10_r8)then - write(fates_log(),*) 'error with rootr in canopy fluxes',temprootr,sum(pftgs) + write(fates_log(),*) 'error with rootr in canopy fluxes',temprootr,sum_pftgs do j = 1,hlm_numlevgrnd bc_out(s)%rootr_pagl(ifp,j) = bc_out(s)%rootr_pagl(ifp,j)/temprootr enddo diff --git a/biogeophys/EDSurfaceAlbedoMod.F90 b/biogeophys/EDSurfaceAlbedoMod.F90 index ceac148d72..7ee743cba1 100644 --- a/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/biogeophys/EDSurfaceAlbedoMod.F90 @@ -105,6 +105,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8),parameter :: tolerance = 0.000000001_r8 real(r8), parameter :: pi = 3.141592654 ! PI + + integer, parameter :: max_diag_nlevleaf = 4 + integer, parameter :: diag_nlevleaf = min(nlevleaf,max_diag_nlevleaf) ! for diagnostics, write a small number of leaf layers + real(r8) :: denom real(r8) :: lai_reduction(2) @@ -535,11 +539,11 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) if (L == currentPatch%NCL_p.and.currentPatch%NCL_p > 1)then !is this the (incomplete) understorey? !Add on the radiation coming up through the canopy gaps. !diffuse to diffuse - weighted_dif_up(L) = weighted_dif_up(L) +(1.0-sum(ftweight(L,:,1))) * & + weighted_dif_up(L) = weighted_dif_up(L) +(1.0-sum(ftweight(L,1:numpft,1))) * & weighted_dif_down(L-1) * bc_in(s)%albgr_dif_rb(ib) !direct to diffuse weighted_dif_up(L) = weighted_dif_up(L) + forc_dir(ifp,ib) * & - weighted_dir_tr(L-1) * (1.0-sum(ftweight(L,:,1)))*bc_in(s)%albgr_dir_rb(ib) + weighted_dir_tr(L-1) * (1.0-sum(ftweight(L,1:numpft,1)))*bc_in(s)%albgr_dir_rb(ib) endif end do !L !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! @@ -606,7 +610,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) endif !present end do!ft if (L == currentPatch%NCL_p.and.currentPatch%NCL_p > 1)then !is this the (incomplete) understorey? - weighted_dif_down(L) = weighted_dif_down(L) + weighted_dif_down(L-1)*(1.0-sum(ftweight(L,:,1))) + weighted_dif_down(L) = weighted_dif_down(L) + weighted_dif_down(L-1) * & + (1.0-sum(ftweight(L,1:numpft,1))) end if end do ! do L loop @@ -650,10 +655,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) if (L == currentPatch%NCL_p.and.currentPatch%NCL_p > 1)then !is this the (incomplete) understorey? !Add on the radiation coming up through the canopy gaps. - weighted_dif_up(L) = weighted_dif_up(L) +(1.0_r8-sum(ftweight(L,:,1))) * & + weighted_dif_up(L) = weighted_dif_up(L) +(1.0_r8-sum(ftweight(L,1:numpft,1))) * & weighted_dif_down(L-1) * bc_in(s)%albgr_dif_rb(ib) weighted_dif_up(L) = weighted_dif_up(L) + forc_dir(ifp,ib) * & - weighted_dir_tr(L-1) * (1.0_r8-sum(ftweight(L,:,1)))*bc_in(s)%albgr_dir_rb(ib) + weighted_dir_tr(L-1) * (1.0_r8-sum(ftweight(L,1:numpft,1)))*bc_in(s)%albgr_dir_rb(ib) end if end do!L end do ! do while over iter @@ -758,11 +763,11 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) !radiation absorbed from fluxes through unfilled part of lower canopy. if (currentPatch%NCL_p > 1.and.L == currentPatch%NCL_p)then abs_rad(ib) = abs_rad(ib) + weighted_dif_down(L-1) * & - (1.0_r8-sum(ftweight(L,:,1)))*(1.0_r8-bc_in(s)%albgr_dif_rb(ib)) + (1.0_r8-sum(ftweight(L,1:numpft,1)))*(1.0_r8-bc_in(s)%albgr_dif_rb(ib)) abs_rad(ib) = abs_rad(ib) + forc_dir(ifp,ib) * weighted_dir_tr(L-1) * & - (1.0_r8-sum(ftweight(L,:,1)))*(1.0_r8-bc_in(s)%albgr_dir_rb(ib)) - tr_soili = tr_soili + weighted_dif_down(L-1) * (1.0_r8-sum(ftweight(L,:,1))) - tr_soild = tr_soild + forc_dir(ifp,ib) * weighted_dir_tr(L-1) * (1.0_r8-sum(ftweight(L,:,1))) + (1.0_r8-sum(ftweight(L,1:numpft,1)))*(1.0_r8-bc_in(s)%albgr_dir_rb(ib)) + tr_soili = tr_soili + weighted_dif_down(L-1) * (1.0_r8-sum(ftweight(L,1:numpft,1))) + tr_soild = tr_soild + forc_dir(ifp,ib) * weighted_dir_tr(L-1) * (1.0_r8-sum(ftweight(L,1:numpft,1))) endif if (radtype == 1)then @@ -792,7 +797,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) if ( abs(error) > 0.0001)then write(fates_log(),*)'dir ground absorption error',ifp,s,error,currentPatch%sabs_dir(ib), & currentPatch%tr_soil_dir(ib)* & - (1.0_r8-bc_in(s)%albgr_dir_rb(ib)),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) + (1.0_r8-bc_in(s)%albgr_dir_rb(ib)),currentPatch%NCL_p,ib,sum(ftweight(1,1:numpft,1)) write(fates_log(),*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), & (1.0_r8-bc_in(s)%albgr_dir_rb(ib)),currentPatch%lai @@ -807,7 +812,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) (1.0_r8-bc_in(s)%albgr_dif_rb(ib)))) > 0.0001)then write(fates_log(),*)'dif ground absorption error',ifp,s,currentPatch%sabs_dif(ib) , & (currentPatch%tr_soil_dif(ib)* & - (1.0_r8-bc_in(s)%albgr_dif_rb(ib))),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) + (1.0_r8-bc_in(s)%albgr_dif_rb(ib))),currentPatch%NCL_p,ib,sum(ftweight(1,1:numpft,1)) endif endif @@ -831,25 +836,6 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) enddo enddo - if (lai_change(1,2,1).gt.0.0.and.lai_change(1,2,2).gt.0.0)then - ! write(fates_log(),*) 'lai_change(1,2,12)',lai_change(1,2,1:4) - endif - if (lai_change(1,2,2).gt.0.0.and.lai_change(1,2,3).gt.0.0)then - ! write(fates_log(),*) ' lai_change (1,2,23)',lai_change(1,2,1:4) - endif - if (lai_change(1,1,3).gt.0.0.and.lai_change(1,1,2).gt.0.0)then - ! NO-OP - ! write(fates_log(),*) 'first layer of lai_change 2 3',lai_change(1,1,1:3) - endif - if (lai_change(1,1,3).gt.0.0.and.lai_change(1,1,4).gt.0.0)then - ! NO-OP - ! write(fates_log(),*) 'first layer of lai_change 3 4',lai_change(1,1,1:4) - endif - if (lai_change(1,1,4).gt.0.0.and.lai_change(1,1,5).gt.0.0)then - ! NO-OP - ! write(fates_log(),*) 'first layer of lai_change 4 5',lai_change(1,1,1:5) - endif - if (radtype == 1)then !here we are adding a within-ED radiation scheme tolerance, and then adding the diffrence onto the albedo !it is important that the lower boundary for this is ~1000 times smaller than the tolerance in surface albedo. @@ -866,10 +852,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) write(fates_log(),*) 'Large Dir Radn consvn error',error ,ifp,ib write(fates_log(),*) 'diags', bc_out(s)%albd_parb(ifp,ib), bc_out(s)%ftdd_parb(ifp,ib), & bc_out(s)%ftid_parb(ifp,ib), bc_out(s)%fabd_parb(ifp,ib) - write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:4) - write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:4) - write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:4) - write(fates_log(),*) 'ftweight',ftweight(1,1:numpft,1:4) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'ftweight',ftweight(1,1:numpft,1:diag_nlevleaf) write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno write(fates_log(),*) 'bc_in(s)%albgr_dir_rb(ib)',bc_in(s)%albgr_dir_rb(ib) @@ -885,14 +871,14 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) write(fates_log(),*) '>5% Dif Radn consvn error',error ,ifp,ib write(fates_log(),*) 'diags', bc_out(s)%albi_parb(ifp,ib), bc_out(s)%ftii_parb(ifp,ib), & bc_out(s)%fabi_parb(ifp,ib) - write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:4) - write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:4) - write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:4) - write(fates_log(),*) 'ftweight',ftweight(currentpatch%ncl_p,1:numpft,1:4) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'ftweight',ftweight(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno write(fates_log(),*) 'bc_in(s)%albgr_dif_rb(ib)',bc_in(s)%albgr_dif_rb(ib) write(fates_log(),*) 'rhol',rhol(1:numpft,:) - write(fates_log(),*) 'ftw',sum(ftweight(1,:,1)),ftweight(1,1:numpft,1) + write(fates_log(),*) 'ftw',sum(ftweight(1,1:numpft,1)),ftweight(1,1:numpft,1) write(fates_log(),*) 'present',currentPatch%present(1,1:numpft) write(fates_log(),*) 'CAP',currentPatch%canopy_area_profile(1,1:numpft,1) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index de274e5ac3..34e4cfa807 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -3,7 +3,6 @@ module EDParamsMod ! module that deals with reading the ED parameter file ! - use EDtypesMod , only: maxPft use FatesParametersInterface, only : param_string_length use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7434c190b7..0f93936e2b 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1103,7 +1103,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDtypesMod , only : ncwd use EDtypesMod , only : ican_upper use EDtypesMod , only : ican_ustory - use EDTypesMod , only : maxpft use EDTypesMod , only : get_sizeage_class_index use EDTypesMod , only : nlevleaf diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index bd177af2b5..ee1ebbd8b7 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -36,28 +36,28 @@ module FatesParameterDerivedMod contains - subroutine InitAllocate(this,maxpft) + subroutine InitAllocate(this,numpft) class(param_derived_type), intent(inout) :: this - integer, intent(in) :: maxpft + integer, intent(in) :: numpft - allocate(this%vcmax25top(maxpft)) - allocate(this%jmax25top(maxpft)) - allocate(this%tpu25top(maxpft)) - allocate(this%kp25top(maxpft)) - allocate(this%lmr25top(maxpft)) + allocate(this%vcmax25top(numpft)) + allocate(this%jmax25top(numpft)) + allocate(this%tpu25top(numpft)) + allocate(this%kp25top(numpft)) + allocate(this%lmr25top(numpft)) return end subroutine InitAllocate ! ===================================================================================== - subroutine Init(this,maxpft) + subroutine Init(this,numpft) use EDPftvarcon, only: EDPftvarcon_inst class(param_derived_type), intent(inout) :: this - integer, intent(in) :: maxpft + integer, intent(in) :: numpft ! local variables integer :: ft ! pft index @@ -70,9 +70,9 @@ subroutine Init(this,maxpft) ! projected area basis [m^2/gC] leafcn => EDPftvarcon_inst%leafcn ) ! leaf C:N (gC/gN) - call this%InitAllocate(maxpft) + call this%InitAllocate(numpft) - do ft = 1,maxpft + do ft = 1,numpft ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) lnc = 1._r8 / (slatop(ft) * leafcn(ft)) From 4667f15c5db7d143f82745dfd1684787015fcf36 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 15 Aug 2017 16:27:11 -0700 Subject: [PATCH 22/23] Added the passing of the hosts cap on how many patches it can accomodate. --- main/FatesInterfaceMod.F90 | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 4d7a9abd34..ba4597fd8d 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -103,6 +103,15 @@ module FatesInterfaceMod ! between the pedotransfer functions of the HLM ! and how it moves and stores water in its ! rhizosphere shells + + integer, protected :: hlm_max_patch_per_site ! The HLM needs to exchange some patch + ! level quantities with FATES + ! FATES does not dictate those allocations + ! since it happens pretty early in + ! the model initialization sequence. + ! So we want to at least query it, + ! compare it to our maxpatchpersite, + ! and gracefully halt if we are over-allocating integer, protected :: hlm_use_vertsoilc ! This flag signals whether or not the ! host model is using vertically discretized @@ -1107,6 +1116,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_hio_ignore_val = unset_double hlm_masterproc = unset_int hlm_ipedof = unset_int + hlm_max_patch_per_site = unset_int hlm_use_vertsoilc = unset_int hlm_use_spitfire = unset_int hlm_use_planthydro = unset_int @@ -1259,6 +1269,21 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if(hlm_max_patch_per_site .eq. unset_int ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'the number of patch-space per site unset: hlm_max_patch_per_site, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + elseif(hlm_max_patch_per_site < maxPatchesPerSite ) then + if (fates_global_verbose()) then + write(fates_log(), *) 'FATES is trying to allocate space for more patches per site, than the HLM has space for.' + write(fates_log(), *) 'hlm_max_patch_per_site (HLM side): ', hlm_max_patch_per_site + write(fates_log(), *) 'maxPatchesPerSite (FATES side): ', maxPatchesPerSite + write(fates_log(), *) + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if(hlm_use_vertsoilc .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc, exiting' @@ -1343,6 +1368,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_ipedof = ',ival,' to FATES' end if + case('max_patch_per_site') + hlm_max_patch_per_site = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_max_patch_per_site = ',ival,' to FATES' + end if + case('use_vertsoilc') hlm_use_vertsoilc = ival if (fates_global_verbose()) then From 59c7c8d038ee97d383f2a76c07872f99e5afd1f1 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 15 Aug 2017 17:12:09 -0700 Subject: [PATCH 23/23] Removal of deprecated parameter structure EDecophyscon --- biogeochem/EDCanopyStructureMod.F90 | 20 +-- biogeochem/EDCohortDynamicsMod.F90 | 1 - biogeochem/EDPhysiologyMod.F90 | 50 +++--- biogeophys/FatesPlantHydraulicsMod.F90 | 6 +- fire/SFMainMod.F90 | 13 +- main/EDEcophysConType.F90 | 236 ------------------------- main/EDInitMod.F90 | 17 +- main/EDPftvarcon.F90 | 12 +- main/FatesInventoryInitMod.F90 | 7 +- 9 files changed, 58 insertions(+), 304 deletions(-) delete mode 100644 main/EDEcophysConType.F90 diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 36d923972d..ddab8e74af 100755 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -7,7 +7,7 @@ module EDCanopyStructureMod use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : fates_log - use EDPftvarcon , only : EDPftvarcon_inst + use EDPftvarcon , only : EDPftvarcon_inst use EDGrowthFunctionsMod , only : c_area use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd @@ -825,7 +825,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use EDPatchDynamicsMod , only : set_root_fraction use EDTypesMod , only : sizetype_class_index use EDGrowthFunctionsMod , only : tree_lai, c_area - use EDEcophysConType , only : EDecophyscon use EDtypesMod , only : area use EDPftvarcon , only : EDPftvarcon_inst @@ -941,7 +940,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) use EDGrowthFunctionsMod , only : tree_lai, tree_sai, c_area use EDtypesMod , only : area, dinc_ed, hitemax, n_hite_bins - use EDEcophysConType , only : EDecophyscon ! ! !ARGUMENTS @@ -1051,19 +1049,19 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) currentCohort => currentPatch%shortest do while(associated(currentCohort)) ft = currentCohort%pft - min_chite = currentCohort%hite - currentCohort%hite * EDecophyscon%crown(ft) + min_chite = currentCohort%hite - currentCohort%hite * EDPftvarcon_inst%crown(ft) max_chite = currentCohort%hite do iv = 1,N_HITE_BINS frac_canopy(iv) = 0.0_r8 ! this layer is in the middle of the canopy if(max_chite > maxh(iv).and.min_chite < minh(iv))then - frac_canopy(iv)= min(1.0_r8,dh / (currentCohort%hite*EDecophyscon%crown(ft))) + frac_canopy(iv)= min(1.0_r8,dh / (currentCohort%hite*EDPftvarcon_inst%crown(ft))) ! this is the layer with the bottom of the canopy in it. elseif(min_chite < maxh(iv).and.min_chite > minh(iv).and.max_chite > maxh(iv))then - frac_canopy(iv) = (maxh(iv) -min_chite ) / (currentCohort%hite*EDecophyscon%crown(ft)) + frac_canopy(iv) = (maxh(iv) -min_chite ) / (currentCohort%hite*EDPftvarcon_inst%crown(ft)) ! this is the layer with the top of the canopy in it. elseif(max_chite > minh(iv).and.max_chite < maxh(iv).and.min_chite < minh(iv))then - frac_canopy(iv) = (max_chite - minh(iv)) / (currentCohort%hite*EDecophyscon%crown(ft)) + frac_canopy(iv) = (max_chite - minh(iv)) / (currentCohort%hite*EDPftvarcon_inst%crown(ft)) elseif(max_chite < maxh(iv).and.min_chite > minh(iv))then !the whole cohort is within this layer. frac_canopy(iv) = 1.0_r8 endif @@ -1159,9 +1157,9 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! 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 * & - EDecophyscon%crown(currentCohort%pft) ) + EDPftvarcon_inst%crown(currentCohort%pft) ) layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & - EDecophyscon%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) + EDPftvarcon_inst%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) fraction_exposed =1.0_r8 @@ -1192,10 +1190,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) 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 * & - EDecophyscon%crown(currentCohort%pft) ) + EDPftvarcon_inst%crown(currentCohort%pft) ) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & - EDecophyscon%crown(currentCohort%pft)) + EDPftvarcon_inst%crown(currentCohort%pft)) fraction_exposed = 1.0_r8 !default. snow_depth_avg = snow_depth_si * frac_sno_eff_si diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index d6b022c6ac..4dccf83b20 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -13,7 +13,6 @@ module EDCohortDynamicsMod use FatesConstantsMod , only : itrue use FatesInterfaceMod , only : hlm_days_per_year use EDPftvarcon , only : EDPftvarcon_inst - use EDEcophysContype , only : EDecophyscon use EDGrowthFunctionsMod , only : c_area, tree_lai use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : nclmax diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 5faf7a873b..7bc59ec483 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -13,9 +13,7 @@ module EDPhysiologyMod use FatesInterfaceMod, only : hlm_day_of_year use FatesInterfaceMod, only : numpft use FatesConstantsMod, only : r8 => fates_r8 - use EDEcophysContype , only : EDecophyscon use EDPftvarcon , only : EDPftvarcon_inst - use EDEcophysContype , only : EDecophyscon use FatesInterfaceMod, only : bc_in_type use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort use EDCohortDynamicsMod , only : create_cohort, sort_cohorts @@ -194,14 +192,14 @@ subroutine trim_canopy( currentSite ) currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*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) / EDecophyscon%root_long(currentCohort%pft) + 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) 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 = currentCohort%leaf_cost + & 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & - EDPftvarcon_inst%allom_l2fr(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + 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) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then @@ -212,7 +210,7 @@ subroutine trim_canopy( currentSite ) endif ! keep trimming until none of the canopy is in negative carbon balance. - if (currentCohort%hite > EDecophyscon%hgt_min(currentCohort%pft))then + 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)) @@ -689,9 +687,9 @@ subroutine seeds_in( currentSite, cp_pnt ) if (external_recruitment == 1) then !external seed rain - needed to prevent extinction do p = 1,numpft currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + & - EDecophyscon%seed_rain(p) !KgC/m2/year + EDPftvarcon_inst%seed_rain(p) !KgC/m2/year currentSite%seed_rain_flux(p) = currentSite%seed_rain_flux(p) + & - EDecophyscon%seed_rain(p) * currentPatch%area/AREA !KgC/m2/year + EDPftvarcon_inst%seed_rain(p) * currentPatch%area/AREA !KgC/m2/year enddo endif currentPatch => currentPatch%younger @@ -827,7 +825,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! 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 / EDecophyscon%root_long(currentCohort%pft) + currentCohort%root_md = currentCohort%br / EDPftvarcon_inst%root_long(currentCohort%pft) currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif @@ -837,13 +835,13 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !are still in an expansion phase. if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then - currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) + currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(currentCohort%pft) 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 /EDecophyscon%root_long(currentCohort%pft) + currentCohort%root_md = currentCohort%br /EDPftvarcon_inst%root_long(currentCohort%pft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif @@ -865,17 +863,17 @@ 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, & - EDecophyscon%leaf_stor_priority(currentCohort%pft) + EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft) currentCohort%carbon_balance = currentCohort%npp_acc_hold - & - currentCohort%md * EDecophyscon%leaf_stor_priority(currentCohort%pft) + currentCohort%md * EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft) ! 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*EDecophyscon%leaf_stor_priority(currentCohort%pft))) + currentCohort%leaf_md*EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft))) currentCohort%npp_froot = max(0.0_r8,min(currentCohort%npp_acc_hold*currentCohort%root_md/currentCohort%md, & - currentCohort%root_md*EDecophyscon%leaf_stor_priority(currentCohort%pft))) + currentCohort%root_md*EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft))) if (Bleaf(currentCohort) > 0._r8)then @@ -884,7 +882,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) 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) * EDecophyscon%cushion(currentCohort%pft))) + frac = max(0.0_r8,currentCohort%bstore/(Bleaf(currentCohort) * EDPftvarcon_inst%cushion(currentCohort%pft))) ! 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? @@ -916,14 +914,14 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !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- EDecophyscon%leaf_stor_priority(currentCohort%pft)))then ! Yes... + if (currentCohort%carbon_balance > currentCohort%md*(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)))then ! Yes... currentCohort%carbon_balance = currentCohort%carbon_balance - currentCohort%md * (1.0_r8 - & - EDecophyscon%leaf_stor_priority(currentCohort%pft)) + EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) currentCohort%npp_leaf = currentCohort%npp_leaf + & - currentCohort%leaf_md * (1.0_r8-EDecophyscon%leaf_stor_priority(currentCohort%pft)) + currentCohort%leaf_md * (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) currentCohort%npp_froot = currentCohort%npp_froot + & - currentCohort%root_md * (1.0_r8-EDecophyscon%leaf_stor_priority(currentCohort%pft)) + currentCohort%root_md * (1.0_r8-EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) else ! we can't maintain constant leaf area and root area. Balive is reduced @@ -932,7 +930,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- EDecophyscon%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 @@ -944,7 +942,7 @@ 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 <= EDecophyscon%max_dbh(currentCohort%pft))then ! cap on leaf biomass + if (currentCohort%dbh <= EDPftvarcon_inst%max_dbh(currentCohort%pft))then ! cap on leaf biomass dbldbd = dDbhdBd(currentCohort)/dDbhdBl(currentCohort) dbrdbd = EDPftvarcon_inst%allom_l2fr(currentCohort%pft) * dbldbd dhdbd_fn = dhdbd(currentCohort) @@ -952,12 +950,12 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) u = 1.0_r8 / (dbldbd + dbrdbd + dbswdbd) va = 1.0_r8 / (1.0_r8 + u) vs = u / (1.0_r8 + u) - gr_fract = 1.0_r8 - EDecophyscon%seed_alloc(currentCohort%pft) + gr_fract = 1.0_r8 - EDPftvarcon_inst%seed_alloc(currentCohort%pft) else dbldbd = 0._r8; dbrdbd = 0._r8 ;dbswdbd = 0._r8 va = 0.0_r8 vs = 1.0_r8 - gr_fract = 1.0_r8 - (EDecophyscon%seed_alloc(currentCohort%pft) + EDecophyscon%clone_alloc(currentCohort%pft)) + gr_fract = 1.0_r8 - (EDPftvarcon_inst%seed_alloc(currentCohort%pft) + EDPftvarcon_inst%clone_alloc(currentCohort%pft)) endif !FIX(RF,032414) - to fix high bl's. needed to prevent numerical errors without the ODEINT. @@ -987,7 +985,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) 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 * & - EDecophyscon%leaf_stor_priority(currentCohort%pft) + EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft) write(fates_log(),*) 'proxies' ,target_balive,currentCohort%balive,currentCohort%dbh,va,vs,gr_fract endif @@ -1042,12 +1040,12 @@ subroutine recruitment( t, 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 = EDecophyscon%hgt_min(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 = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%allom_l2fr(ft) & + 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)) temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index dbc863ced8..e68291057a 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -24,8 +24,6 @@ module FatesPlantHydraulicsMod use FatesInterfaceMod , only : bc_out_type use FatesInterfaceMod , only : hlm_numlevsoil - use EDEcophysconType, only : EDecophyscon - use FatesHydraulicsMemMod, only: ed_site_hydr_type use FatesHydraulicsMemMod, only: ed_patch_hydr_type use FatesHydraulicsMemMod, only: ed_cohort_hydr_type @@ -42,6 +40,8 @@ module FatesPlantHydraulicsMod use FatesHydraulicsMemMod, only: porous_media use FatesHydraulicsMemMod, only: nlevsoi_hyd + use EDPftvarcon, only : EDPftvarcon_inst + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : isnan => shr_infnan_isnan @@ -125,7 +125,6 @@ subroutine initTreeHydStates(cc_p, bc_in) ! !DESCRIPTION: ! ! !USES: - use EDEcophysConType , only : EDecophyscon ! !ARGUMENTS: type(ed_cohort_type), intent(inout), target :: cc_p ! current cohort pointer @@ -146,7 +145,6 @@ subroutine updateSizeDepTreeHydProps(cc_p,bc_in) ! ! !USES: use FatesConstantsMod , only : pi_const - use EDEcophysConType , only : EDecophyscon use shr_sys_mod , only : shr_sys_abort ! ! !ARGUMENTS: diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index fe51009cd1..b47740d1f1 100755 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -14,7 +14,6 @@ module SFMainMod use FatesInterfaceMod , only : bc_in_type use EDPftvarcon , only : EDPftvarcon_inst - use EDEcophysconType , only : EDecophyscon use EDtypesMod , only : ed_site_type use EDtypesMod , only : ed_patch_type @@ -882,18 +881,18 @@ subroutine crown_damage ( currentSite ) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only ! Flames lower than bottom of canopy. ! c%hite is height of cohort - if (currentPatch%SH < (currentCohort%hite-currentCohort%hite*EDecophyscon%crown(currentCohort%pft))) then + if (currentPatch%SH < (currentCohort%hite-currentCohort%hite*EDPftvarcon_inst%crown(currentCohort%pft))) then currentCohort%cfa = 0.0_r8 else ! Flames part of way up canopy. ! Equation 17 in Thonicke et al. 2010. ! flames over bottom of canopy but not over top. if ((currentCohort%hite > 0.0_r8).and.(currentPatch%SH >= & - (currentCohort%hite-currentCohort%hite*EDecophyscon%crown(currentCohort%pft)))) then + (currentCohort%hite-currentCohort%hite*EDPftvarcon_inst%crown(currentCohort%pft)))) then currentCohort%cfa = (currentPatch%SH-currentCohort%hite*(1- & - EDecophyscon%crown(currentCohort%pft)))/(currentCohort%hite* & - EDecophyscon%crown(currentCohort%pft)) + EDPftvarcon_inst%crown(currentCohort%pft)))/(currentCohort%hite* & + EDPftvarcon_inst%crown(currentCohort%pft)) else ! Flames over top of canopy. @@ -942,7 +941,7 @@ subroutine cambial_damage_kill ( currentSite ) do while(associated(currentCohort)) if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only ! Equation 21 in Thonicke et al 2010 - bt = EDecophyscon%bark_scaler(currentCohort%pft)*currentCohort%dbh ! bark thickness. + bt = EDPftvarcon_inst%bark_scaler(currentCohort%pft)*currentCohort%dbh ! bark thickness. ! Equation 20 in Thonicke et al. 2010. tau_c = 2.9_r8*bt**2.0_r8 !calculate time it takes to kill cambium (min) ! Equation 19 in Thonicke et al. 2010 @@ -994,7 +993,7 @@ subroutine post_fire_mortality ( currentSite ) currentCohort%crownfire_mort = 0.0_r8 if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then ! Equation 22 in Thonicke et al. 2010. - currentCohort%crownfire_mort = EDecophyscon%crown_kill(currentCohort%pft)*currentCohort%cfa**3.0_r8 + currentCohort%crownfire_mort = EDPftvarcon_inst%crown_kill(currentCohort%pft)*currentCohort%cfa**3.0_r8 ! Equation 18 in Thonicke et al. 2010. currentCohort%fire_mort = currentCohort%crownfire_mort+currentCohort%cambial_mort- & (currentCohort%crownfire_mort*currentCohort%cambial_mort) !joint prob. diff --git a/main/EDEcophysConType.F90 b/main/EDEcophysConType.F90 deleted file mode 100644 index 8c405ed987..0000000000 --- a/main/EDEcophysConType.F90 +++ /dev/null @@ -1,236 +0,0 @@ -module EDEcophysConType - - !---------------------------------------------------- - ! ED ecophysiological constants - !---------------------------------------------------- - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - use shr_log_mod , only : errMsg => shr_log_errMsg - use FatesGlobals, only : endrun => fates_endrun - use FatesGlobals, only : fates_log - - use FatesHydraulicsMemMod , only : n_porous_media - use FatesHydraulicsMemMod , only : porous_media - use FatesHydraulicsMemMod , only : npool_tot - use FatesHydraulicsMemMod , only : npool_leaf - use FatesHydraulicsMemMod , only : npool_stem - use FatesHydraulicsMemMod , only : npool_aroot - use FatesHydraulicsMemMod , only : npool_troot - use FatesConstantsMod, only : itrue,ifalse - use FatesInterfaceMod, only : hlm_use_planthydro - - ! - implicit none - save - private - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - - ! - ! !PUBLIC MEMBER FUNCTIONS: - public :: EDecophysconInit - ! - ! !PUBLIC TYPES: - type, public :: EDecophyscon_type - real(r8), pointer :: max_dbh (:) ! maximum dbh at which height growth ceases... - real(r8), pointer :: freezetol (:) ! minimum temperature tolerance... - real(r8), pointer :: wood_density (:) ! wood density g cm^-3 ... - real(r8), pointer :: hgt_min (:) ! sapling height m - real(r8), pointer :: cushion (:) ! labile carbon storage target as multiple of leaf pool. - real(r8), pointer :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. ! (1=lose leaves, 0=use store). - real(r8), pointer :: crown (:) ! fraction of the height of the plant that is occupied by crown. For fire model. - real(r8), pointer :: bark_scaler (:) ! scaler from dbh to bark thickness. For fire model. - real(r8), pointer :: crown_kill (:) ! scaler on fire death. For fire model. - real(r8), pointer :: initd (:) ! initial seedling density - real(r8), pointer :: seed_rain (:) ! seeds that come from outside the gridbox. - real(r8), pointer :: BB_slope (:) ! ball berry slope parameter - real(r8), pointer :: root_long (:) ! root longevity (yrs) - real(r8), pointer :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. - real(r8), pointer :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. - - ! pft parameters for plant hydraulics (PFT) - real(r8), pointer :: wd (:) ! wood density (distinct from wood_density for testing) [g m-3] - real(r8), pointer :: lma (:) ! leaf mass per area [g m-2] - ! ~ 90 for tropical angiosperms, cf Patino et al. 2012 - ! (existing param 'slatop' is biased high) - real(r8), pointer :: n (:) ! leaf nitrogen [mg g-1] - real(r8), pointer :: p (:) ! leaf phosphorus [mg g-1] - real(r8), pointer :: ldmc (:) ! leaf dry matter content [g g-1] - real(r8), pointer :: lmv (:) ! leaf mass per volume [g m-3] - real(r8), pointer :: psi0 (:) ! sapwood water potential at saturation [MPa] - real(r8), pointer :: psicap (:) ! sapwood water potential at rwcft [MPa] - ! BOC...rhoc, rint_petiole, rint_jansenchoat, ccontent and (maybe) - ! rs2 and rfrac_stem should really be global constants, not pft parameters - real(r8), pointer :: rhoc (:) ! dry matter (or cell wall) density of wood [g cm-3] Siau 1984 - real(r8), pointer :: rint_petiole (:) ! radius of xylem conduits in petioles [um] - real(r8), pointer :: rint_jansenchoat (:) ! average radius of xylem conduits where ks mmts were made [um] - ! taken from choat & jansen XFT database for tropical angiosperms only - real(r8), pointer :: Amaxh (:) ! light-saturated photosynthesis rate [umol m-2 s-1] - real(r8), pointer :: rs2 (:) ! mean absorbing fine root radius [m] ~ 0.001 m? - real(r8), pointer :: srl (:) ! specific root length [m kg-1] - ! ~ 15000 for tropical angiosperms, cf Metcalfe et al. 2008 Plant Soil Fig. 2b; - ! rootdens = 500 kg m-3 is biased high by an order of magnitude - ! (cf Comas et al. 2002 Oecologia); SPA rootdens implies a SRL of only 637 m kg-1. - real(r8), pointer :: ccontent (:) ! carbon content (fraction of dry mass) [-] - ! ~ 0.47 for tropical angiosperms, cf Thomas & Martin (2012) Forests - real(r8), pointer :: latosa (:) ! leaf to sapwood area ratio [m2 m-2] - ! ~ 8000 for tropical angiosperms, cf Patino et al. 2012 - real(r8), pointer :: rfrac_stem (:) ! fraction of total tree resistance (under well-watered conditions) - ! from troot to canopy (i.e., aboveground) [-] ~ 0.625 for tropical angiosperms, - ! cf BC re-analysis of Fisher et al. 2006 - real(r8), pointer :: rootshoot (:) ! root:shoot ratio (belowground-to-aboveground biomass) [-] - ! ~ 0.20 for tropical forests (see Houghton et al. 2001 Table 3, - ! Cairns et al. 1997 Table 2, Jackson et al. 1996 Table 3) - real(r8), pointer :: avuln_gs (:) ! stomata PLC: vulnerability curve shape parameter [-] - real(r8), pointer :: p50_gs (:) ! stomata PLC: water potential at 50% loss of conductivity [Pa] - - ! pft parameters for plant hydraulics (PFT x tissue type (leaf, stem, troot, aroot)) - real(r8), pointer :: kmax_node (:,:) ! xylem PLC: maximum xylem hydraulic conductivity [kg m-1 s-1 Pa-1] - real(r8), pointer :: avuln_node (:,:) ! xylem PLC: vulnerability curve shape parameter [-] - real(r8), pointer :: p50_node (:,:) ! xylem PLC: water potential at 50% loss of conductivity [Pa] - real(r8), pointer :: thetas_node (:,:) ! P-V curve: saturated volumetric water content for node [m3 m-3] - real(r8), pointer :: epsil_node (:,:) ! P-V curve: bulk elastic modulus [MPa] - real(r8), pointer :: pinot_node (:,:) ! P-V curve: osmotic potential at full turgor [MPa] - real(r8), pointer :: pitlp_node (:,:) ! P-V curve: osmotic potential at turgor loss [MPa] - real(r8), pointer :: resid_node (:,:) ! P-V curve: residual fraction [-] - real(r8), pointer :: rwctlp_node (:,:) ! P-V curve: total relative water content at turgor loss [g or m3 H2O / g or m3 H2O, sat] - real(r8), pointer :: fcap_node (:,:) ! P-V curve: fraction of (1-resid_node) that is capillary in source [-] - real(r8), pointer :: rwcft_node (:,:) ! P-V curve: total RWC @ which elastic drainage begins [-] - real(r8), pointer :: rwccap_node (:,:) ! P-V curve: total RWC @ which capillary reserves exhausted - real(r8), pointer :: slp_node (:,:) ! P-V curve: slope of capillary region of curve (sapwood only) - real(r8), pointer :: intercept_node (:,:) ! P-V curve: intercept of capillary region of curve (sapwood only) - real(r8), pointer :: corrInt_node (:,:) ! P-V curve: correction for nonzero psi0 - - - - end type EDecophyscon_type - - type(EDecophyscon_type), public :: EDecophyscon ! ED ecophysiological constants structure - !------------------------------------------------------------------------ - - - - - -contains - - !------------------------------------------------------------------------ - subroutine EDecophysconInit(EDpftvarcon_inst, numpft) - ! - ! !USES: - use EDPftvarcon, only : EDPftvarcon_type - ! - ! !ARGUMENTS: - type(EDpftVarCon_type) , intent(in) :: EDpftvarcon_inst - integer , intent(in) :: numpft - ! - ! !LOCAL VARIABLES: - integer :: m, ib, n, k - integer :: lb - !------------------------------------------------------------------------ - - - if( lbound(EDPftvarcon_inst%max_dbh,dim=1) .eq. 0) then - lb = 0 - else - lb = 1 - end if - - allocate( EDecophyscon%max_dbh (0:numpft)); EDecophyscon%max_dbh (:) = nan - allocate( EDecophyscon%freezetol (0:numpft)); EDecophyscon%freezetol (:) = nan - allocate( EDecophyscon%wood_density (0:numpft)); EDecophyscon%wood_density (:) = nan - allocate( EDecophyscon%hgt_min (0:numpft)); EDecophyscon%hgt_min (:) = nan - allocate( EDecophyscon%cushion (0:numpft)); EDecophyscon%cushion (:) = nan - allocate( EDecophyscon%leaf_stor_priority (0:numpft)); EDecophyscon%leaf_stor_priority (:) = nan - allocate( EDecophyscon%crown (0:numpft)); EDecophyscon%crown (:) = nan - allocate( EDecophyscon%bark_scaler (0:numpft)); EDecophyscon%bark_scaler (:) = nan - allocate( EDecophyscon%crown_kill (0:numpft)); EDecophyscon%crown_kill (:) = nan - allocate( EDecophyscon%initd (0:numpft)); EDecophyscon%initd (:) = nan - allocate( EDecophyscon%seed_rain (0:numpft)); EDecophyscon%seed_rain (:) = nan - allocate( EDecophyscon%BB_slope (0:numpft)); EDecophyscon%BB_slope (:) = nan - allocate( EDecophyscon%root_long (0:numpft)); EDecophyscon%root_long (:) = nan - allocate( EDecophyscon%seed_alloc (0:numpft)); EDecophyscon%seed_alloc (:) = nan - allocate( EDecophyscon%clone_alloc (0:numpft)); EDecophyscon%clone_alloc (:) = nan - - do m = lb,numpft - EDecophyscon%max_dbh(m) = EDPftvarcon_inst%max_dbh(m) - EDecophyscon%freezetol(m) = EDPftvarcon_inst%freezetol(m) - EDecophyscon%wood_density(m) = EDPftvarcon_inst%wood_density(m) - EDecophyscon%hgt_min(m) = EDPftvarcon_inst%hgt_min(m) - EDecophyscon%cushion(m) = EDPftvarcon_inst%cushion(m) - EDecophyscon%leaf_stor_priority(m) = EDPftvarcon_inst%leaf_stor_priority(m) - EDecophyscon%crown(m) = EDPftvarcon_inst%crown(m) - EDecophyscon%bark_scaler(m) = EDPftvarcon_inst%bark_scaler(m) - EDecophyscon%crown_kill(m) = EDPftvarcon_inst%crown_kill(m) - EDecophyscon%initd(m) = EDPftvarcon_inst%initd(m) - EDecophyscon%seed_rain(m) = EDPftvarcon_inst%seed_rain(m) - EDecophyscon%bb_slope(m) = EDPftvarcon_inst%bb_slope(m) - EDecophyscon%root_long(m) = EDPftvarcon_inst%root_long(m) - EDecophyscon%seed_alloc(m) = EDPftvarcon_inst%seed_alloc(m) - EDecophyscon%clone_alloc(m) = EDPftvarcon_inst%clone_alloc(m) - end do - - - if (hlm_use_planthydro.eq.itrue) then - allocate( EDecophyscon%wd (0:numpft) ); EDecophyscon%wd (:) = nan - allocate( EDecophyscon%lma (0:numpft) ); EDecophyscon%lma (:) = nan - allocate( EDecophyscon%n (0:numpft) ); EDecophyscon%n (:) = nan - allocate( EDecophyscon%p (0:numpft) ); EDecophyscon%p (:) = nan - allocate( EDecophyscon%ldmc (0:numpft) ); EDecophyscon%ldmc (:) = nan - allocate( EDecophyscon%lmv (0:numpft) ); EDecophyscon%lmv (:) = nan - allocate( EDecophyscon%psi0 (0:numpft) ); EDecophyscon%psi0 (:) = nan - allocate( EDecophyscon%psicap (0:numpft) ); EDecophyscon%psicap (:) = nan - allocate( EDecophyscon%rhoc (0:numpft) ); EDecophyscon%rhoc (:) = nan - allocate( EDecophyscon%rint_petiole (0:numpft) ); EDecophyscon%rint_petiole (:) = nan - allocate( EDecophyscon%rint_jansenchoat (0:numpft) ); EDecophyscon%rint_jansenchoat (:) = nan - allocate( EDecophyscon%Amaxh (0:numpft) ); EDecophyscon%Amaxh (:) = nan - allocate( EDecophyscon%rs2 (0:numpft) ); EDecophyscon%rs2 (:) = nan - allocate( EDecophyscon%srl (0:numpft) ); EDecophyscon%srl (:) = nan - allocate( EDecophyscon%ccontent (0:numpft) ); EDecophyscon%ccontent (:) = nan - allocate( EDecophyscon%latosa (0:numpft) ); EDecophyscon%latosa (:) = nan - allocate( EDecophyscon%rfrac_stem (0:numpft) ); EDecophyscon%rfrac_stem (:) = nan - allocate( EDecophyscon%rootshoot (0:numpft) ); EDecophyscon%rootshoot (:) = nan - allocate( EDecophyscon%avuln_gs (0:numpft) ); EDecophyscon%avuln_gs (:) = nan - allocate( EDecophyscon%p50_gs (0:numpft) ); EDecophyscon%p50_gs (:) = nan - - allocate( EDecophyscon%kmax_node (0:numpft,1:n_porous_media) ); EDecophyscon%kmax_node (:,:) = nan - allocate( EDecophyscon%avuln_node (0:numpft,1:n_porous_media) ); EDecophyscon%avuln_node (:,:) = nan - allocate( EDecophyscon%p50_node (0:numpft,1:n_porous_media) ); EDecophyscon%p50_node (:,:) = nan - allocate( EDecophyscon%thetas_node (0:numpft,1:n_porous_media) ); EDecophyscon%thetas_node (:,:) = nan - allocate( EDecophyscon%epsil_node (0:numpft,1:n_porous_media) ); EDecophyscon%epsil_node (:,:) = nan - allocate( EDecophyscon%pinot_node (0:numpft,1:n_porous_media) ); EDecophyscon%pinot_node (:,:) = nan - allocate( EDecophyscon%pitlp_node (0:numpft,1:n_porous_media) ); EDecophyscon%pitlp_node (:,:) = nan - allocate( EDecophyscon%resid_node (0:numpft,1:n_porous_media) ); EDecophyscon%resid_node (:,:) = nan - allocate( EDecophyscon%rwctlp_node (0:numpft,1:n_porous_media) ); EDecophyscon%rwctlp_node (:,:) = nan - allocate( EDecophyscon%fcap_node (0:numpft,1:n_porous_media) ); EDecophyscon%fcap_node (:,:) = nan - allocate( EDecophyscon%rwcft_node (0:numpft,1:n_porous_media) ); EDecophyscon%rwcft_node (:,:) = nan - allocate( EDecophyscon%rwccap_node (0:numpft,1:n_porous_media) ); EDecophyscon%rwccap_node (:,:) = nan - allocate( EDecophyscon%slp_node (0:numpft,1:n_porous_media) ); EDecophyscon%slp_node (:,:) = nan - allocate( EDecophyscon%intercept_node (0:numpft,1:n_porous_media) ); EDecophyscon%intercept_node (:,:) = nan - allocate( EDecophyscon%corrInt_node (0:numpft,1:n_porous_media) ); EDecophyscon%corrInt_node (:,:) = nan - - ! ------------------------------------------------------------------------------------------------ - ! Until the hydraulics parameter are added to the parameter file, they need a location to be set. - ! This happens here until further notice. - ! ------------------------------------------------------------------------------------------------ - call SetHydraulicsTestingParams(EDecophyscon) - - end if - - end subroutine EDecophysconInit - - subroutine SetHydraulicsTestingParams(EDEcophyscon) - - ! Arguments - type(EDecophyscon_type), intent(inout) :: EDEcophyscon - - write(fates_log(),*) 'FATES Plant Hydraulics is still under development, ending run.' - call endrun(msg=errMsg(sourcefile, __LINE__)) - - - end subroutine SetHydraulicsTestingParams - -end module EDEcophysConType diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 6056fb16f0..73bda67f5d 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 EDEcophysConType , only : EDecophyscon use EDGrowthFunctionsMod , only : bdead, bleaf, dbh use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts use EDPatchDynamicsMod , only : create_patch @@ -305,15 +304,15 @@ subroutine init_cohorts( patch_in, bc_in) do pft = 1,numpft - if(EDecophyscon%initd(pft)>1.0E-7) then + if(EDPftvarcon_inst%initd(pft)>1.0E-7) then allocate(temp_cohort) ! temporary cohort temp_cohort%pft = pft - temp_cohort%n = EDecophyscon%initd(pft) * patch_in%area - temp_cohort%hite = EDecophyscon%hgt_min(pft) - !temp_cohort%n = 0.5_r8 * 0.0028_r8 * patch_in%area ! BOC for fixed size runs EDecophyscon%initd(pft) * patch_in%area - !temp_cohort%hite = 28.65_r8 ! BOC translates to DBH of 50cm. EDecophyscon%hgt_min(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... temp_cohort%canopy_trim = 1.0_r8 temp_cohort%bdead = Bdead(temp_cohort) @@ -322,13 +321,13 @@ subroutine init_cohorts( patch_in, bc_in) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead if( EDPftvarcon_inst%evergreen(pft) == 1) then - temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) + temp_cohort%bstore = Bleaf(temp_cohort) * 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) * EDecophyscon%cushion(pft) !stored carbon in new seedlings. + temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(pft) !stored carbon in new seedlings. if(patch_in%siteptr%status == 2)then temp_cohort%laimemory = 0.0_r8 else @@ -340,7 +339,7 @@ subroutine init_cohorts( patch_in, bc_in) endif if ( EDPftvarcon_inst%stress_decid(pft) == 1 ) then - temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) + temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(pft) temp_cohort%laimemory = Bleaf(temp_cohort) temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory cstatus = patch_in%siteptr%dstatus diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index cfadc1ee0c..d4b9fdf18a 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -36,12 +36,12 @@ module EDPftvarcon real(r8), allocatable :: cushion (:) ! labile carbon storage target as multiple of leaf pool. real(r8), allocatable :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation ! (1 = lose leaves, 0 = use store). - real(r8), allocatable :: crown (:) - real(r8), allocatable :: bark_scaler (:) - real(r8), allocatable :: crown_kill (:) - real(r8), allocatable :: initd (:) - real(r8), allocatable :: seed_rain (:) - real(r8), allocatable :: BB_slope (:) + real(r8), allocatable :: crown (:) ! fraction of the height of the plant that is occupied by crown. For fire model. + real(r8), allocatable :: bark_scaler (:) ! scaler from dbh to bark thickness. For fire model. + real(r8), allocatable :: crown_kill (:) ! scaler on fire death. For fire model. + real(r8), allocatable :: initd (:) ! initial seedling density + real(r8), allocatable :: seed_rain (:) ! seeds that come from outside the gridbox. + real(r8), allocatable :: BB_slope (:) ! ball berry slope parameter real(r8), allocatable :: root_long (:) ! root longevity (yrs) real(r8), allocatable :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. real(r8), allocatable :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index fb6f61b809..52a75e480c 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -34,7 +34,6 @@ module FatesInventoryInitMod use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : area use EDPftvarcon , only : EDPftvarcon_inst - use EDEcophysConType , only : EDecophyscon implicit none private @@ -875,13 +874,13 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & temp_cohort%b = temp_cohort%balive + temp_cohort%bdead if( EDPftvarcon_inst%evergreen(c_pft) == 1) then - temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(c_pft) + temp_cohort%bstore = Bleaf(temp_cohort) * 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) * EDecophyscon%cushion(c_pft) !stored carbon in new seedlings. + temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(c_pft) !stored carbon in new seedlings. if(csite%status == 2)then temp_cohort%laimemory = 0.0_r8 else @@ -893,7 +892,7 @@ 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) * EDecophyscon%cushion(c_pft) + temp_cohort%bstore = Bleaf(temp_cohort) * EDPftvarcon_inst%cushion(c_pft) temp_cohort%laimemory = Bleaf(temp_cohort) temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory cstatus = csite%dstatus