From 60422418658fc286fbc15d9fa02a596a2857ea11 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 18 Jan 2017 12:55:46 -0700 Subject: [PATCH] Read fates parameters from their own file. The fates parameter file is now specified via a separate namelist fates_paramfile. This variable may or may not point to the same netcdf file as the host parameter file. All fates parameters are read from this file, including the pft level variables, which are now stored in EDpftvarcon instead of pftcon. Note that some parameters are shared between the host and fates. These are 'host' parameters, not fates parameters and are read from the host file. Work for NGT-ED Github issue #155 User interface changes?: Yes. Users who have custom parameter files will need to set namelist varible 'fates_paramfile' to point to their file instead. Host parameters are still read from the file specified by namelist variable 'paramfile'. If users have modified host parameters in addition to fates parameters, they will need to update both namelist variables. Code review: andre Test suite: clm_short Test baseline: clm4_5_12_r195 Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass Test suite: ed - yellowstone gnu, intel, pgi Test baseline: a651a4f Test namelist changes: yes, new namilest var fates_paramfile Test answer changes: bit for bit Test summary: all tests pass --- biogeochem/EDCanopyStructureMod.F90 | 16 ++-- biogeochem/EDCohortDynamicsMod.F90 | 30 +++---- biogeochem/EDGrowthFunctionsMod.F90 | 10 +-- biogeochem/EDPatchDynamicsMod.F90 | 10 +-- biogeochem/EDPhysiologyMod.F90 | 98 +++++++++++---------- biogeophys/EDBtranMod.F90 | 6 +- biogeophys/EDPhotosynthesisMod.F90 | 22 ++--- biogeophys/EDSurfaceAlbedoMod.F90 | 12 +-- fire/SFMainMod.F90 | 16 ++-- main/EDInitMod.F90 | 10 +-- main/EDPftvarcon.F90 | 129 +++++++++++++++++++++++++++- main/EDTypesMod.F90 | 10 +-- main/FatesHistoryInterfaceMod.F90 | 4 +- main/FatesRestartInterfaceMod.F90 | 4 +- 14 files changed, 254 insertions(+), 123 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index f5419cedd7..e91e4608d5 100755 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -7,7 +7,7 @@ module EDCanopyStructureMod use shr_kind_mod , only : r8 => shr_kind_r8; use FatesGlobals , only : fates_log - use pftconMod , only : pftcon + 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 @@ -617,7 +617,7 @@ subroutine canopy_spread( currentSite ) currentCohort => currentPatch%tallest do while (associated(currentCohort)) currentCohort%c_area = c_area(currentCohort) - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer) + currentCohort%c_area endif currentCohort => currentCohort%shorter @@ -663,7 +663,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use EDGrowthFunctionsMod , only : tree_lai, c_area use EDEcophysConType , only : EDecophyscon use EDtypesMod , only : area - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst ! !ARGUMENTS integer , intent(in) :: nsites @@ -727,7 +727,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) if(currentCohort%canopy_layer==1)then currentPatch%total_canopy_area = currentPatch%total_canopy_area + currentCohort%c_area - if(pftcon%woody(ft)==1)then + if(EDPftvarcon_inst%woody(ft)==1)then currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area endif endif @@ -989,11 +989,11 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) do iv = 1,currentCohort%NV-1 ! what is the height of this layer? (for snow burial purposes...) - ! pftcon%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + ! 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) ) layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & - EDecophyscon%crown(currentCohort%pft)) ! pftcon%vertical_canopy_frac(ft)) + EDecophyscon%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) fraction_exposed =1.0_r8 @@ -1022,10 +1022,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) !Bottom layer iv = currentCohort%NV - ! pftcon%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + ! 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) ) - ! pftcon%vertical_canopy_frac(ft)) + ! EDPftvarcon_inst%vertical_canopy_frac(ft)) layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & EDecophyscon%crown(currentCohort%pft)) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 2ccea2cad1..d468c03d78 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -8,7 +8,7 @@ module EDCohortDynamicsMod use FatesGlobals , only : fates_log use FatesConstantsMod , only : r8 => fates_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use pftconMod , only : pftcon + 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 @@ -114,11 +114,11 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & call endrun(msg=errMsg(sourcefile, __LINE__)) endif - if (new_cohort%siteptr%status==2 .and. pftcon%season_decid(pft) == 1) then + if (new_cohort%siteptr%status==2 .and. EDPftvarcon_inst%season_decid(pft) == 1) then new_cohort%laimemory = 0.0_r8 endif - if (new_cohort%siteptr%dstatus==2 .and. pftcon%stress_decid(pft) == 1) then + if (new_cohort%siteptr%dstatus==2 .and. EDPftvarcon_inst%stress_decid(pft) == 1) then new_cohort%laimemory = 0.0_r8 endif @@ -191,27 +191,27 @@ 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 + pftcon%froot_leaf(ft)) + leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + EDPftvarcon_inst%froot_leaf(ft)) !currentcohort%bl = currentcohort%balive*leaf_frac !for deciduous trees, there are no leaves - if (pftcon%evergreen(ft) == 1) then + if (EDPftvarcon_inst%evergreen(ft) == 1) then currentcohort%laimemory = 0._r8 currentcohort%status_coh = 2 endif ! iagnore the root and stem biomass from the functional balance hypothesis. This is used when the leaves are !fully on. - !currentcohort%br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + !currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac !currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & ! currentcohort%laimemory)*leaf_frac leaves_off_switch = 0 - if (currentcohort%status_coh == 1.and.pftcon%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves + if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves leaves_off_switch = 1 !drought decid endif - if (currentcohort%status_coh == 1.and.pftcon%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves + if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves leaves_off_switch = 1 !cold decid endif @@ -232,8 +232,8 @@ subroutine allocate_live_biomass(cc_p,mode) if(mode==1)then currentcohort%npp_froot = currentcohort%npp_froot + & - max(0._r8,pftcon%froot_leaf(ft)*(currentcohort%balive+currentcohort%laimemory)*leaf_frac - currentcohort%br) / & - udata%deltat + max(0._r8, EDPftvarcon_inst%froot_leaf(ft)*(currentcohort%balive+currentcohort%laimemory)*leaf_frac - & + currentcohort%br) / udata%deltat currentcohort%npp_bsw = max(0._r8,EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & currentcohort%laimemory)*leaf_frac - currentcohort%bsw)/udata%deltat @@ -242,7 +242,7 @@ subroutine allocate_live_biomass(cc_p,mode) end if - currentcohort%br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & currentcohort%laimemory)*leaf_frac @@ -257,9 +257,9 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%bl = 0.0_r8 - ideal_balive = currentcohort%laimemory * pftcon%froot_leaf(ft) + & + ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%froot_leaf(ft) + & currentcohort%laimemory* EDecophyscon%sapwood_ratio(ft) * currentcohort%hite - currentcohort%br = pftcon%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * leaf_frac + currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * leaf_frac currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(ideal_balive + & currentcohort%laimemory)*leaf_frac @@ -271,7 +271,7 @@ subroutine allocate_live_biomass(cc_p,mode) if(mode==1)then currentcohort%npp_froot = currentcohort%npp_froot + & - max(0.0_r8,pftcon%froot_leaf(ft)*(ideal_balive + & + max(0.0_r8,EDPftvarcon_inst%froot_leaf(ft)*(ideal_balive + & currentcohort%laimemory)*leaf_frac*ratio_balive-currentcohort%br)/udata%deltat currentcohort%npp_bsw = max(0.0_r8,EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(ideal_balive + & @@ -289,7 +289,7 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%status_coh,currentcohort%balive write(fates_log(),*) 'actual vs predicted balive',ideal_balive,currentcohort%balive ,ratio_balive,leaf_frac write(fates_log(),*) 'leaf,root,stem',currentcohort%bl,currentcohort%br,currentcohort%bsw - write(fates_log(),*) 'pft',ft,pftcon%evergreen(ft),pftcon%season_decid(ft),leaves_off_switch + write(fates_log(),*) 'pft',ft,EDPftvarcon_inst%evergreen(ft),EDPftvarcon_inst%season_decid(ft),leaves_off_switch endif currentCohort%b = currentCohort%bdead + currentCohort%balive diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index a400f46ab9..a3fc06ceac 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -8,7 +8,7 @@ module EDGrowthFunctionsMod use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : iulog - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use EDTypesMod , only : ed_cohort_type, cp_nlevcan, dinc_ed @@ -114,7 +114,7 @@ real(r8) function Bleaf( cohort_in ) else bleaf = 0.0419_r8 * (EDecophyscon%max_dbh(cohort_in%pft)**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 endif - slascaler = 0.03_r8/pftcon%slatop(cohort_in%pft) + slascaler = 0.03_r8/EDPftvarcon_inst%slatop(cohort_in%pft) bleaf = bleaf * slascaler !write(iulog,*) 'bleaf',bleaf, slascaler,cohort_in%pft @@ -145,7 +145,7 @@ real(r8) function tree_lai( cohort_in ) endif if( cohort_in%status_coh == 2 ) then ! are the leaves on? - slat = 1000.0_r8 * pftcon%slatop(cohort_in%pft) ! m2/g to m2/kg + slat = 1000.0_r8 * EDPftvarcon_inst%slatop(cohort_in%pft) ! m2/g to m2/kg cohort_in%c_area = c_area(cohort_in) ! call the tree area leafc_per_unitarea = cohort_in%bl/(cohort_in%c_area/cohort_in%n) !KgC/m2 if(leafc_per_unitarea > 0.0_r8)then @@ -225,7 +225,7 @@ real(r8) function c_area( cohort_in ) if (DEBUG_growth) then write(iulog,*) 'z_area 1',cohort_in%dbh,cohort_in%pft write(iulog,*) 'z_area 2',EDecophyscon%max_dbh - write(iulog,*) 'z_area 3',pftcon%woody + write(iulog,*) 'z_area 3',EDPftvarcon_inst%woody write(iulog,*) 'z_area 4',cohort_in%n write(iulog,*) 'z_area 5',cohort_in%patchptr%spread write(iulog,*) 'z_area 6',cohort_in%canopy_layer @@ -233,7 +233,7 @@ real(r8) function c_area( cohort_in ) end if dbh = min(cohort_in%dbh,EDecophyscon%max_dbh(cohort_in%pft)) - if(pftcon%woody(cohort_in%pft) == 1)then + if(EDPftvarcon_inst%woody(cohort_in%pft) == 1)then c_area = 3.142_r8 * cohort_in%n * & (cohort_in%patchptr%spread(cohort_in%canopy_layer)*dbh)**1.56_r8 else diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 5fae1a783f..fe44705e5b 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -7,7 +7,7 @@ module EDPatchDynamicsMod use shr_kind_mod , only : r8 => shr_kind_r8; use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varctl , only : iulog - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, maxPatchesPerCol use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, udata @@ -281,7 +281,7 @@ subroutine spawn_patches( currentSite ) nc%imort = nan else ! small trees - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then ! Number of trees in the understory of new patch, before we impose impact mortality and survivorship nc%n = currentCohort%n * patch_site_areadis/currentPatch%area @@ -566,7 +566,7 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) currentCohort => currentPatch%shortest do while(associated(currentCohort)) p = currentCohort%pft - if(pftcon%woody(p) == 1)then !DEAD (FROM FIRE) TREES + if(EDPftvarcon_inst%woody(p) == 1)then !DEAD (FROM FIRE) TREES !************************************/ ! Number of trees that died because of the fire, per m2 of ground. ! Divide their litter into the four litter streams, and spread evenly across ground surface. @@ -649,7 +649,7 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) do while(associated(currentCohort)) currentCohort%c_area = c_area(currentCohort) - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentCohort%cfa else burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentPatch%burnt_frac_litter(6) @@ -726,7 +726,7 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread canopy_dead*(currentCohort%br+currentCohort%bstore) else - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then understorey_dead = ED_val_understorey_death * currentCohort%n * (patch_site_areadis/currentPatch%area) !kgC/site/day currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + & diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index fccd8c0843..b2e51f09bb 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -12,7 +12,7 @@ module EDPhysiologyMod use TemperatureType , only : temperature_type use SoilStateType , only : soilstate_type use WaterstateType , only : waterstate_type - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -185,16 +185,19 @@ subroutine trim_canopy( currentSite ) if (currentCohort%year_net_uptake(z) /= 999._r8)then !there was activity this year in this leaf layer. !Leaf Cost kgC/m2/year-1 !decidous costs. - if (pftcon%season_decid(currentCohort%pft) == 1.or.pftcon%stress_decid(currentCohort%pft) == 1)then - currentCohort%leaf_cost = 1._r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) - currentCohort%leaf_cost = currentCohort%leaf_cost + 1.0_r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) * & - pftcon%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1.or. & + EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then + currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) + 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) currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) else !evergreen costs - currentCohort%leaf_cost = 1.0_r8/(pftcon%slatop(currentCohort%pft)* & - pftcon%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/(pftcon%slatop(currentCohort%pft)*1000.0_r8) * & - pftcon%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + 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) currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then @@ -207,7 +210,7 @@ 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 - if (pftcon%evergreen(currentCohort%pft) /= 1)then + if (EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - inc) endif trimmed = 1 @@ -494,7 +497,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) !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*pftcon%leaf_long(7))then + if (timesincedleafon > 365.0*EDPftvarcon_inst%leaf_long(7))then currentSite%dstatus = 1 !alter status of site to 'leaves on' currentSite%dleafoffdate = t !record leaf on date endif @@ -542,7 +545,7 @@ subroutine phenology_leafonoff(currentSite) do while(associated(currentCohort)) !COLD LEAF ON - if (pftcon%season_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then if (currentSite%status == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !Are the leaves currently off? currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. @@ -586,7 +589,7 @@ subroutine phenology_leafonoff(currentSite) endif !season_decid !DROUGHT LEAF ON - if (pftcon%stress_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then if (currentSite%dstatus == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !is it the leaf-on day? Are the leaves currently off? currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. @@ -778,11 +781,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort) call allocate_live_biomass(currentCohort,0) ! calculate target size of living biomass compartment for a given dbh. - target_balive = Bleaf(currentCohort) * (1.0_r8 + pftcon%froot_leaf(currentCohort%pft) + & + target_balive = Bleaf(currentCohort) * (1.0_r8 + EDPftvarcon_inst%froot_leaf(currentCohort%pft) + & EDecophyscon%sapwood_ratio(currentCohort%pft)*h) !target balive without leaves. if (currentCohort%status_coh == 1)then - target_balive = Bleaf(currentCohort) * (pftcon%froot_leaf(currentCohort%pft) + & + target_balive = Bleaf(currentCohort) * (EDPftvarcon_inst%froot_leaf(currentCohort%pft) + & EDecophyscon%sapwood_ratio(currentCohort%pft) * h) endif @@ -796,8 +799,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort) currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n ! Maintenance demands - if (pftcon%evergreen(currentCohort%pft) == 1)then !grass and EBT - currentCohort%leaf_md = currentCohort%bl / pftcon%leaf_long(currentCohort%pft) + 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%md = currentCohort%root_md + currentCohort%leaf_md endif @@ -807,22 +810,22 @@ subroutine Growth_Derivatives( currentSite, currentCohort) !with which I am not especially comfortable, particularly as the concept of sapwood turnover is unclear for trees that !are still in an expansion phase. - if (pftcon%season_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (pftcon%stress_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (pftcon%stress_decid(currentCohort%pft) /= 1.and.pftcon%season_decid(currentCohort%pft) /= 1.and. & - pftcon%evergreen(currentCohort%pft) /= 1)then - write(iulog,*) 'problem with phenology definitions',currentCohort%pft,pftcon%stress_decid(currentCohort%pft), & - pftcon%season_decid(currentCohort%pft),pftcon%evergreen(currentCohort%pft) + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) /= 1.and.EDPftvarcon_inst%season_decid(currentCohort%pft) /= 1.and. & + EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then + write(iulog,*) 'problem with phenology definitions',currentCohort%pft,EDPftvarcon_inst%stress_decid(currentCohort%pft), & + EDPftvarcon_inst%season_decid(currentCohort%pft),EDPftvarcon_inst%evergreen(currentCohort%pft) endif ! FIX(RF,032414) -turned off for now as it makes balive go negative.... @@ -911,7 +914,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort) ! 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 = pftcon%froot_leaf(currentCohort%pft) * dbldbd + dbrdbd = EDPftvarcon_inst%froot_leaf(currentCohort%pft) * dbldbd dhdbd_fn = dhdbd(currentCohort) dbswdbd = EDecophyscon%sapwood_ratio(currentCohort%pft) * (h*dbldbd + currentCohort%bl*dhdbd_fn) u = 1.0_r8 / (dbldbd + dbrdbd + dbswdbd) @@ -1011,9 +1014,9 @@ subroutine recruitment( t, currentSite, currentPatch ) 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 + pftcon%froot_leaf(ft) & + 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 + pftcon%froot_leaf(ft) & + 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%n = currentPatch%area * currentPatch%seed_germination(ft)*udata%deltat & / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) @@ -1026,17 +1029,17 @@ subroutine recruitment( t, currentSite, currentPatch ) endif temp_cohort%laimemory = 0.0_r8 - if (pftcon%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + pftcon%froot_leaf(ft) + & + 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 endif - if (pftcon%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + pftcon%froot_leaf(ft) + & + 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 endif cohortstatus = currentSite%status - if (pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + if (EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. cohortstatus = currentSite%dstatus endif @@ -1294,7 +1297,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) !use EDCLMLinkMod, only: cwd_fcel_ed, cwd_flig - use pftconMod, only : pftcon + use EDPftvarcon, only : EDPftvarcon_inst use shr_const_mod, only: SHR_CONST_CDAY use clm_varcon, only : zisoi, dzsoi_decomp, zsoi use EDParamsMod, only : ED_val_ag_biomass @@ -1404,8 +1407,9 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! use beta distribution parameter from Jackson et al., 1996 do ft = 1, numpft_ed do j = 1, cp_numlevdecomp - cinput_rootfr(ft,j) = ( pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j-1)*100._r8) - & - pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j)*100._r8) ) & + cinput_rootfr(ft,j) = ( & + EDPftvarcon_inst%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j-1)*100._r8) - & + EDPftvarcon_inst%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j)*100._r8) ) & / dzsoi_decomp(j) end do end do @@ -1415,10 +1419,10 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) do j = 1, cp_numlevdecomp ! use standard CLM root fraction profiles; cinput_rootfr(ft,j) = ( .5_r8*( & - exp(-pftcon%roota_par(ft) * zisoi(j-1)) & - + exp(-pftcon%rootb_par(ft) * zisoi(j-1)) & - - exp(-pftcon%roota_par(ft) * zisoi(j)) & - - exp(-pftcon%rootb_par(ft) * zisoi(j)))) / dzsoi_decomp(j) + exp(-EDPftvarcon_inst%roota_par(ft) * zisoi(j-1)) & + + exp(-EDPftvarcon_inst%rootb_par(ft) * zisoi(j-1)) & + - exp(-EDPftvarcon_inst%roota_par(ft) * zisoi(j)) & + - exp(-EDPftvarcon_inst%rootb_par(ft) * zisoi(j)))) / dzsoi_decomp(j) end do end do endif @@ -1606,26 +1610,26 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) do ft = 1,numpft_ed do j = 1, cp_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) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) ! bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_flab(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flab(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_flig(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flig(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) ! !! and seed_decay too. for now, use the same lability fractions as for leaf litter bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) ! enddo end do diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 8ac4a51b36..bc9d541359 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -5,7 +5,7 @@ module EDBtranMod ! ! ------------------------------------------------------------------------------------ - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use clm_varcon , only : tfrz use EDTypesMod , only : ed_site_type, & ed_patch_type, & @@ -111,8 +111,8 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) !------------------------------------------------------------------------------ associate( & - smpsc => pftcon%smpsc , & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS - smpso => pftcon%smpso & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS + smpsc => EDPftvarcon_inst%smpsc , & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS + smpso => EDPftvarcon_inst%smpso & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS ) do s = 1,nsites diff --git a/biogeophys/EDPhotosynthesisMod.F90 b/biogeophys/EDPhotosynthesisMod.F90 index 7e55aee9a4..c8970fdcf4 100644 --- a/biogeophys/EDPhotosynthesisMod.F90 +++ b/biogeophys/EDPhotosynthesisMod.F90 @@ -43,7 +43,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) use abortutils , only : endrun use clm_varpar , only : mxpft ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) - use pftconMod , only : pftcon ! THIS WILL BE DEPRECATED WHEN PARAMETER + use EDPftvarcon , only : EDPftvarcon_inst ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) use EDParamsMod , only : ED_val_grperc use EDParamsMod , only : ED_val_ag_biomass @@ -241,13 +241,13 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) associate( & - c3psn => pftcon%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 - slatop => pftcon%slatop , & ! specific leaf area at top of canopy, projected area basis [m^2/gC] - flnr => pftcon%flnr , & ! fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) - woody => pftcon%woody , & ! Is vegetation woody or not? - fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-) - leafcn => pftcon%leafcn , & ! leaf C:N (gC/gN) - frootcn => pftcon%frootcn , & ! froot C:N (gc/gN) + c3psn => EDPftvarcon_inst%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 + 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) + 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) bb_slope => EDecophyscon%BB_slope ) ! slope of BB relationship ! Peter Thornton: 3/13/09 @@ -533,7 +533,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) vcmax_z(CL,FT,iv) = vcmax_z(CL,FT,iv) * currentPatch%btran_ft(FT) ! completely removed respiration drought response - ! - (lmr_z(CL,FT,iv) * (1.0_r8-currentPatch%btran_ft(FT)) *pftcon%resp_drought_response(FT)) + ! - (lmr_z(CL,FT,iv) * (1.0_r8-currentPatch%btran_ft(FT)) *EDPftvarcon_inst%resp_drought_response(FT)) lmr_z(CL,FT,iv) = lmr_z(CL,FT,iv) end do ! iv @@ -878,7 +878,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%rdark = currentCohort%rdark * umolC_to_kgC leaf_frac = 1.0_r8/(currentCohort%canopy_trim + EDecophyscon%sapwood_ratio(currentCohort%pft) * & - currentCohort%hite + pftcon%froot_leaf(currentCohort%pft)) + currentCohort%hite + EDPftvarcon_inst%froot_leaf(currentCohort%pft)) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -951,7 +951,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%gpp_tstep = currentCohort%gpp_tstep * umolC_to_kgC ! add on whole plant respiration values in kgC/indiv/s-1 currentCohort%resp_m = currentCohort%livestem_mr + currentCohort%livecroot_mr + currentCohort%froot_mr - ! no drought response * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft)*pftcon%resp_drought_response(FT)) + ! no drought response * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft)*EDPftvarcon_inst%resp_drought_response(FT)) currentCohort%resp_m = currentCohort%resp_m + currentCohort%rdark ! convert from kgC/indiv/s to kgC/indiv/timestep diff --git a/biogeophys/EDSurfaceAlbedoMod.F90 b/biogeophys/EDSurfaceAlbedoMod.F90 index d76695916c..ce19f602b0 100644 --- a/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/biogeophys/EDSurfaceAlbedoMod.F90 @@ -46,7 +46,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! ! !USES: use clm_varctl , only : iulog - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDtypesMod , only : ed_patch_type, numpft_ed, cp_nlevcan use EDTypesMod , only : ed_site_type @@ -113,11 +113,11 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) !----------------------------------------------------------------------- associate(& - rhol => pftcon%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir - rhos => pftcon%rhos , & ! Input: [real(r8) (:) ] stem reflectance: 1=vis, 2=nir - taul => pftcon%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir - taus => pftcon%taus , & ! Input: [real(r8) (:) ] stem transmittance: 1=vis, 2=nir - xl => pftcon%xl) ! Input: [real(r8) (:) ] ecophys const - leaf/stem orientation index + rhol => EDPftvarcon_inst%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir + rhos => EDPftvarcon_inst%rhos , & ! Input: [real(r8) (:) ] stem reflectance: 1=vis, 2=nir + taul => EDPftvarcon_inst%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir + taus => EDPftvarcon_inst%taus , & ! Input: [real(r8) (:) ] stem transmittance: 1=vis, 2=nir + xl => EDPftvarcon_inst%xl) ! Input: [real(r8) (:) ] ecophys const - leaf/stem orientation index ! albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) (USED IN LND2ATM,BALANCE_CHECK) ! albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) (LND2ATM,BALANCE_CHECK) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index be53100a71..47c96c3015 100755 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -10,7 +10,7 @@ module SFMainMod use clm_varctl , only : iulog use atm2lndType , only : atm2lnd_type use TemperatureType , only : temperature_type - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysconType , only : EDecophyscon use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, AREA, DG_SF, FIRE_THRESHOLD use EDtypesMod , only : LB_SF, LG_SF, NCWD, TR_SF @@ -158,7 +158,7 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%livegrass = 0.0_r8 currentCohort => currentPatch%tallest do while(associated(currentCohort)) - if(pftcon%woody(currentCohort%pft) == 0)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 0)then currentPatch%livegrass = currentPatch%livegrass + currentCohort%bl*currentCohort%n/currentPatch%area endif currentCohort => currentCohort%shorter @@ -329,7 +329,7 @@ subroutine wind_effect ( currentSite, atm2lnd_inst) do while(associated(currentCohort)) write(iulog,*) 'SF currentCohort%c_area ',currentCohort%c_area - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area else total_grass_area = total_grass_area + currentCohort%c_area @@ -751,7 +751,7 @@ subroutine crown_scorching ( currentSite ) if (currentPatch%fire == 1) then currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if (pftcon%woody(currentCohort%pft) == 1) then !trees only + if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only tree_ag_biomass = tree_ag_biomass+(currentCohort%bl+ED_val_ag_biomass* & (currentCohort%bsw + currentCohort%bdead))*currentCohort%n endif !trees only @@ -766,7 +766,7 @@ subroutine crown_scorching ( currentSite ) currentPatch%SH = 0.0_r8 currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if (pftcon%woody(currentCohort%pft) == 1.and.(tree_ag_biomass > 0.0_r8)) then !trees only + 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 + & currentCohort%bdead))*currentCohort%n)/tree_ag_biomass !equation 16 in Thonicke et al. 2010 @@ -806,7 +806,7 @@ subroutine crown_damage ( currentSite ) do while(associated(currentCohort)) currentCohort%cfa = 0.0_r8 - if (pftcon%woody(currentCohort%pft) == 1) then !trees only + 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 @@ -867,7 +867,7 @@ subroutine cambial_damage_kill ( currentSite ) if (currentPatch%fire == 1) then currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if (pftcon%woody(currentCohort%pft) == 1) then !trees only + 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. ! Equation 20 in Thonicke et al. 2010. @@ -919,7 +919,7 @@ subroutine post_fire_mortality ( currentSite ) do while(associated(currentCohort)) currentCohort%fire_mort = 0.0_r8 currentCohort%crownfire_mort = 0.0_r8 - if (pftcon%woody(currentCohort%pft) == 1) then + 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 ! Equation 18 in Thonicke et al. 2010. diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index e8830e4161..fb1e7ea275 100755 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -14,7 +14,7 @@ module EDInitMod use CanopyStateType , only : canopystate_type use WaterStateType , only : waterstate_type use GridcellType , only : grc - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysConType , only : EDecophyscon use EDGrowthFunctionsMod , only : bdead, bleaf, dbh use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -252,17 +252,17 @@ subroutine init_cohorts( patch_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 + pftcon%froot_leaf(pft) & + 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%b = temp_cohort%balive + temp_cohort%bdead - if( pftcon%evergreen(pft) == 1) then + if( EDPftvarcon_inst%evergreen(pft) == 1) then temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) temp_cohort%laimemory = 0._r8 cstatus = 2 endif - if( pftcon%season_decid(pft) == 1 ) then !for dorment places + 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. if(patch_in%siteptr%status == 2)then temp_cohort%laimemory = 0.0_r8 @@ -274,7 +274,7 @@ subroutine init_cohorts( patch_in ) cstatus = patch_in%siteptr%status endif - if ( pftcon%stress_decid(pft) == 1 ) then + if ( EDPftvarcon_inst%stress_decid(pft) == 1 ) then temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) temp_cohort%laimemory = Bleaf(temp_cohort) temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 475ee7b1bb..1ac59074d3 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -6,7 +6,7 @@ module EDPftvarcon ! read and initialize vegetation (PFT) constants. ! ! !USES: - use clm_varpar , only : mxpft + use clm_varpar , only : mxpft, numrad, ivis, inir, nvariants use shr_kind_mod, only : r8 => shr_kind_r8 ! @@ -39,10 +39,40 @@ module EDPftvarcon real(r8) :: seed_alloc (0:mxpft) ! fraction of carbon balance allocated to seeds. real(r8) :: sapwood_ratio (0:mxpft) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m real(r8) :: dbh2h_m (0:mxpft) ! allocation parameter m from dbh to height + real(r8) :: woody(0:mxpft) + real(r8) :: stress_decid(0:mxpft) + real(r8) :: season_decid(0:mxpft) + real(r8) :: evergreen(0:mxpft) + real(r8) :: froot_leaf(0:mxpft) + real(r8) :: slatop(0:mxpft) + real(r8) :: leaf_long(0:mxpft) + real(r8) :: rootprof_beta(0:mxpft,nvariants) + real(r8) :: roota_par(0:mxpft) + real(r8) :: rootb_par(0:mxpft) + real(r8) :: lf_flab(0:mxpft) + real(r8) :: lf_fcel(0:mxpft) + real(r8) :: lf_flig(0:mxpft) + real(r8) :: fr_flab(0:mxpft) + real(r8) :: fr_fcel(0:mxpft) + real(r8) :: fr_flig(0:mxpft) + real(r8) :: rhol(0:mxpft, numrad) + real(r8) :: rhos(0:mxpft, numrad) + real(r8) :: taul(0:mxpft, numrad) + real(r8) :: taus(0:mxpft, numrad) + real(r8) :: xl(0:mxpft) + real(r8) :: c3psn(0:mxpft) + real(r8) :: flnr(0:mxpft) + real(r8) :: fnitr(0:mxpft) + real(r8) :: leafcn(0:mxpft) + real(r8) :: frootcn(0:mxpft) + real(r8) :: smpso(0:mxpft) + real(r8) :: smpsc(0:mxpft) end type EDPftvarcon_type type(EDPftvarcon_type), public :: EDPftvarcon_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ ! ! !PUBLIC MEMBER FUNCTIONS: public :: EDpftconrd ! Read and initialize vegetation (PFT) constants @@ -59,6 +89,7 @@ subroutine EDpftconrd( ncid ) ! !USES: use ncdio_pio , only : file_desc_t, ncd_io use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg ! ! !ARGUMENTS: implicit none @@ -133,6 +164,102 @@ subroutine EDpftconrd( ncid ) call ncd_io('sapwood_ratio',EDPftvarcon_inst%sapwood_ratio, 'read', ncid, readvar=readv) if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + call ncd_io('woody', EDPftvarcon_inst%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('stress_decid', EDPftvarcon_inst%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('season_decid', EDPftvarcon_inst%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('evergreen', EDPftvarcon_inst%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('froot_leaf', EDPftvarcon_inst%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('slatop', EDPftvarcon_inst%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('leaf_long', EDPftvarcon_inst%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rootprof_beta', EDPftvarcon_inst%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('roota_par', EDPftvarcon_inst%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rootb_par', EDPftvarcon_inst%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('lf_flab', EDPftvarcon_inst%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('lf_fcel', EDPftvarcon_inst%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('lf_flig', EDPftvarcon_inst%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fr_flab', EDPftvarcon_inst%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fr_fcel', EDPftvarcon_inst%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fr_flig', EDPftvarcon_inst%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rholvis', EDPftvarcon_inst%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rholnir', EDPftvarcon_inst%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rhosvis', EDPftvarcon_inst%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rhosnir', EDPftvarcon_inst% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('taulvis', EDPftvarcon_inst%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('taulnir', EDPftvarcon_inst%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('tausvis', EDPftvarcon_inst%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('tausnir', EDPftvarcon_inst%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('xl', EDPftvarcon_inst%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('c3psn', EDPftvarcon_inst%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('flnr', EDPftvarcon_inst%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fnitr', EDPftvarcon_inst%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('leafcn', EDPftvarcon_inst%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('frootcn', EDPftvarcon_inst%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('smpso', EDPftvarcon_inst%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('smpsc', EDPftvarcon_inst%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + ! HOLDING ON SEW ENSITIVITY-ANALYSIS PARAMETERS UNTIL MACHINE CONFIGS SET RGK/CX ! call ncd_io('dbh2h_m',EDPftvarcon_inst%dbh2h_m, 'read', ncid, readvar=readv) ! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 3419386adf..ce686880e5 100755 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -634,7 +634,7 @@ subroutine set_root_fraction( this , depth_gl) ! ! !USES: use PatchType , only : clmpatch => patch - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst ! ! !ARGUMENTS class(ed_patch_type) :: this @@ -651,10 +651,10 @@ subroutine set_root_fraction( this , depth_gl) do lev = 1, cp_numlevsoil-1 this%rootfr_ft(ft,lev) = .5_r8*( & - exp(-pftcon%roota_par(ft) * depth_gl(lev-1)) & - + exp(-pftcon%rootb_par(ft) * depth_gl(lev-1)) & - - exp(-pftcon%roota_par(ft) * depth_gl(lev)) & - - exp(-pftcon%rootb_par(ft) * depth_gl(lev))) + exp(-EDPftvarcon_inst%roota_par(ft) * depth_gl(lev-1)) & + + exp(-EDPftvarcon_inst%rootb_par(ft) * depth_gl(lev-1)) & + - exp(-EDPftvarcon_inst%roota_par(ft) * depth_gl(lev)) & + - exp(-EDPftvarcon_inst%rootb_par(ft) * depth_gl(lev))) end do end do diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index b2b090b24a..662ead47bc 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -11,7 +11,7 @@ module FatesHistoryInterfaceMod use EDTypesMod , only : cp_hio_ignore_val ! FIXME(bja, 2016-10) need to remove CLM dependancy - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst implicit none @@ -829,7 +829,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if ! Woody State Variables (basal area and number density and mortality) - if (pftcon%woody(ft) == 1) then + if (EDPftvarcon_inst%woody(ft) == 1) then hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*n_perm2*AREA hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*n_perm2*AREA diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 18b77bc6cf..f906ca1c40 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1286,7 +1286,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) use EDInitMod, only : zero_site use EDParamsMod, only : ED_val_maxspread use EDPatchDynamicsMod, only : create_patch - use pftconMod, only : pftcon + use EDPftvarcon, only : EDPftvarcon_inst ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this @@ -1396,7 +1396,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) cohortstatus = newp%siteptr%status - if(pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + if(EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. cohortstatus = newp%siteptr%dstatus endif