diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm
index 8f939585d7..dccefd64b0 100755
--- a/components/clm/bld/CLMBuildNamelist.pm
+++ b/components/clm/bld/CLMBuildNamelist.pm
@@ -1976,7 +1976,7 @@ sub setup_logic_params_file {
if ( $physv->as_long() >= $physv->as_long("clm4_5") ) {
add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'paramfile',
- 'use_ed'=>$nl_flags->{'use_ed'}, 'phys'=>$nl_flags->{'phys'},
+ 'phys'=>$nl_flags->{'phys'},
'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
} else {
add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fpftcon');
@@ -3367,6 +3367,7 @@ sub setup_logic_ed {
if ($physv->as_long() >= $physv->as_long("clm4_5") && value_is_true( $nl_flags->{'use_ed'}) ) {
add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_ed_spitfire', 'use_ed'=>$nl_flags->{'use_ed'} );
+ add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fates_paramfile', 'phys'=>$nl_flags->{'phys'});
}
}
diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml
index dc4f68d969..f6b77d1cad 100644
--- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml
+++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml
@@ -240,9 +240,10 @@ attributes from the config_cache.xml file (with keys converted to upper-case).
-lnd/clm2/paramdata/clm5_params.c160713.nc
-lnd/clm2/paramdata/clm_params.c160713.nc
-lnd/clm2/paramdata/clm_params_ed.c160808.nc
+lnd/clm2/paramdata/clm5_params.c160713.nc
+lnd/clm2/paramdata/clm_params.c160713.nc
+
+lnd/clm2/paramdata/fates_params.c170308.nc
diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml
index 0c2e5cf309..636f9391b1 100644
--- a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml
+++ b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml
@@ -510,6 +510,11 @@ Full pathname datafile with plant function type (PFT) constants combined with
constants for biogeochem modules
+
+Full pathname datafile with fates parameters
+
+
Full pathname of surface data file.
diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90
index f156ed869f..7ff3b8e0a1 100755
--- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90
+++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90
@@ -7,14 +7,16 @@ module EDCanopyStructureMod
use FatesConstantsMod , only : r8 => fates_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
use EDTypesMod , only : nclmax
- use EDTypesMod , only : nlevcan
+ 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
! CIME Globals
use shr_log_mod , only : errMsg => shr_log_errMsg
@@ -96,10 +98,10 @@ subroutine canopy_structure( currentSite )
real(r8) :: cc_loss
real(r8) :: lossarea
real(r8) :: newarea
- real(r8) :: arealayer(nlevcan) ! Amount of plant area currently in each canopy layer
- real(r8) :: sumdiff(nlevcan) ! The total of the exclusion weights for all cohorts in layer z
+ real(r8) :: arealayer(nlevleaf) ! Amount of plant area currently in each canopy layer
+ real(r8) :: sumdiff(nlevleaf) ! The total of the exclusion weights for all cohorts in layer z
real(r8) :: weight ! The amount of the total lost area that comes from this cohort
- real(r8) :: sum_weights(nlevcan)
+ real(r8) :: sum_weights(nlevleaf)
real(r8) :: new_total_area_check
real(r8) :: missing_area, promarea,cc_gain,sumgain
integer :: promswitch,lower_cohort_switch
@@ -229,14 +231,33 @@ subroutine canopy_structure( currentSite )
enddo
- currentPatch%leaf_litter(currentCohort%pft) = &
- currentPatch%leaf_litter(currentCohort%pft) + (currentCohort%bl)* &
- currentCohort%n/currentPatch%area ! leaf litter flux per m2.
-
- currentPatch%root_litter(currentCohort%pft) = &
- currentPatch%root_litter(currentCohort%pft) + &
- (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area
-
+ currentPatch%leaf_litter(currentCohort%pft) = &
+ currentPatch%leaf_litter(currentCohort%pft) + (currentCohort%bl)* &
+ currentCohort%n/currentPatch%area ! leaf litter flux per m2.
+
+ currentPatch%root_litter(currentCohort%pft) = &
+ currentPatch%root_litter(currentCohort%pft) + &
+ (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area
+
+ ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr)
+ 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
+ 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
+ enddo
+
+ currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = &
+ currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + &
+ currentCohort%n * (currentCohort%bl) * hlm_days_per_year / AREA
+ 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
@@ -280,13 +301,33 @@ subroutine canopy_structure( currentSite )
enddo
- currentPatch%leaf_litter(currentCohort%pft) = &
- currentPatch%leaf_litter(currentCohort%pft) + currentCohort%bl* &
- currentCohort%n/currentPatch%area ! leaf litter flux per m2.
+ currentPatch%leaf_litter(currentCohort%pft) = &
+ currentPatch%leaf_litter(currentCohort%pft) + currentCohort%bl* &
+ currentCohort%n/currentPatch%area ! leaf litter flux per m2.
+
+ currentPatch%root_litter(currentCohort%pft) = &
+ currentPatch%root_litter(currentCohort%pft) + &
+ (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area
+
+ ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr)
+ 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
+ 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
+ enddo
+
+ currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = &
+ currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + &
+ currentCohort%n * (currentCohort%bl) * hlm_days_per_year / AREA
+ 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
- currentPatch%root_litter(currentCohort%pft) = &
- currentPatch%root_litter(currentCohort%pft) + &
- (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area
currentCohort%n = 0.0_r8
currentCohort%c_area = 0._r8
@@ -635,7 +676,7 @@ subroutine canopy_spread( currentSite )
! !LOCAL VARIABLES:
type (ed_cohort_type), pointer :: currentCohort
type (ed_patch_type) , pointer :: currentPatch
- real(r8) :: arealayer(nlevcan) ! Amount of canopy in each layer.
+ real(r8) :: arealayer(nlevleaf) ! Amount of canopy in each layer.
real(r8) :: inc ! Arbitrary daily incremental change in canopy area
integer :: z
!----------------------------------------------------------------------
@@ -651,7 +692,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
@@ -694,11 +735,11 @@ subroutine canopy_summarization( nsites, sites, bc_in )
use FatesInterfaceMod , only : bc_in_type
use EDPatchDynamicsMod , only : set_patchno
use EDPatchDYnamicsMod , only : set_root_fraction
- use EDCohortDynamicsMod , only : size_and_type_class_index
+ use EDTypesMod , only : sizetype_class_index
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
@@ -750,8 +791,8 @@ subroutine canopy_summarization( nsites, sites, bc_in )
! Update the cohort's index within the size bin classes
! Update the cohort's index within the SCPF classification system
- call size_and_type_class_index(currentCohort%dbh,currentCohort%pft, &
- currentCohort%size_class,currentCohort%size_by_pft_class)
+ call sizetype_class_index(currentCohort%dbh,currentCohort%pft, &
+ currentCohort%size_class,currentCohort%size_by_pft_class)
currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore
@@ -762,20 +803,23 @@ 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
! Check for erroneous zero values.
if(currentCohort%dbh <= 0._r8 .or. currentCohort%n == 0._r8)then
- write(fates_log(),*) 'ED: dbh or n is zero in canopy_summarization', currentCohort%dbh,currentCohort%n
+ write(fates_log(),*) 'ED: dbh or n is zero in canopy_summarization', &
+ currentCohort%dbh,currentCohort%n
endif
if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then
- write(fates_log(),*) 'ED: PFT or trim is zero in canopy_summarization',currentCohort%pft,currentCohort%canopy_trim
+ write(fates_log(),*) 'ED: PFT or trim is zero in canopy_summarization', &
+ currentCohort%pft,currentCohort%canopy_trim
endif
if(currentCohort%balive <= 0._r8)then
- write(fates_log(),*) 'ED: balive is zero in canopy_summarization',currentCohort%balive
+ write(fates_log(),*) 'ED: balive is zero in canopy_summarization', &
+ currentCohort%balive
endif
currentCohort => currentCohort%taller
@@ -783,7 +827,8 @@ subroutine canopy_summarization( nsites, sites, bc_in )
enddo ! ends 'do while(associated(currentCohort))
if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then
- write(fates_log(),*) 'ED: canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area
+ write(fates_log(),*) 'ED: canopy area bigger than area', &
+ currentPatch%total_canopy_area ,currentPatch%area
currentPatch%total_canopy_area = currentPatch%area
endif
@@ -1024,11 +1069,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
@@ -1057,10 +1102,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))
@@ -1136,10 +1181,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
/currentPatch%tlai_profile(L,ft,iv)
enddo
- currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8
- currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8
- currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8
- currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8
+ currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8
+ currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8
+ currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8
+ currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8
enddo
enddo
diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90
index f1bbdde262..74cf8c3e02 100755
--- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90
+++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90
@@ -9,7 +9,8 @@ module EDCohortDynamicsMod
use FatesInterfaceMod , only : hlm_freq_day
use FatesConstantsMod , only : r8 => fates_r8
use FatesConstantsMod , only : fates_unset_int
- use pftconMod , only : pftcon
+ 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
@@ -20,6 +21,7 @@ module EDCohortDynamicsMod
use EDTypesMod , only : sclass_ed,nlevsclass_ed,AREA
use EDTypesMod , only : min_npm2, min_nppatch
use EDTypesMod , only : min_n_safemath
+ use EDTypesMod , only : sizetype_class_index
! CIME globals
use shr_log_mod , only : errMsg => shr_log_errMsg
!
@@ -35,7 +37,6 @@ module EDCohortDynamicsMod
public :: sort_cohorts
public :: copy_cohort
public :: count_cohorts
- public :: size_and_type_class_index
public :: allocate_live_biomass
logical, parameter :: DEBUG = .false. ! local debug flag
@@ -104,8 +105,8 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, &
new_cohort%balive = balive
new_cohort%bstore = bstore
- call size_and_type_class_index(new_cohort%dbh,new_cohort%pft, &
- new_cohort%size_class,new_cohort%size_by_pft_class)
+ call sizetype_class_index(new_cohort%dbh,new_cohort%pft, &
+ new_cohort%size_class,new_cohort%size_by_pft_class)
if ( DEBUG ) write(fates_log(),*) 'EDCohortDyn I ',bstore
@@ -121,11 +122,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
@@ -201,27 +202,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
@@ -230,7 +231,7 @@ subroutine allocate_live_biomass(cc_p,mode)
new_bl = currentcohort%balive*leaf_frac
- new_br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac
+ new_br = EDpftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac
new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + &
currentcohort%laimemory)*leaf_frac
@@ -255,7 +256,6 @@ subroutine allocate_live_biomass(cc_p,mode)
currentcohort%br = new_br
currentcohort%bsw = new_bsw
-
else ! Leaves are off (leaves_off_switch==1)
!the purpose of this section is to figure out the root and stem biomass when the leaves are off
@@ -265,11 +265,11 @@ 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 * pftcon%froot_leaf(ft) + &
+ ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%froot_leaf(ft) + &
currentcohort%laimemory* EDecophyscon%sapwood_ratio(ft) * currentcohort%hite
ratio_balive = currentcohort%balive / ideal_balive
- new_br = pftcon%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * &
+ new_br = EDpftvarcon_inst%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * &
leaf_frac * ratio_balive
new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite * &
(ideal_balive + currentcohort%laimemory) * leaf_frac * ratio_balive
@@ -298,7 +298,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
@@ -485,7 +485,7 @@ subroutine zero_cohort(cc_p)
end subroutine zero_cohort
!-------------------------------------------------------------------------------------!
- subroutine terminate_cohorts( siteptr, patchptr )
+ subroutine terminate_cohorts( currentSite, patchptr )
!
! !DESCRIPTION:
! terminates cohorts when they get too small
@@ -495,7 +495,7 @@ subroutine terminate_cohorts( siteptr, patchptr )
use SFParamsMod, only : SF_val_CWD_frac
!
! !ARGUMENTS
- type (ed_site_type), intent(inout), target :: siteptr
+ type (ed_site_type) , intent(inout), target :: currentSite
type (ed_patch_type), intent(inout), target :: patchptr
!
! !LOCAL VARIABLES:
@@ -572,10 +572,10 @@ subroutine terminate_cohorts( siteptr, patchptr )
else
levcan = 2
endif
- siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = &
- siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n
+ currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = &
+ currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n
!
- siteptr%termination_carbonflux(levcan) = siteptr%termination_carbonflux(levcan) + &
+ currentSite%termination_carbonflux(levcan) = currentSite%termination_carbonflux(levcan) + &
currentCohort%n * currentCohort%b
if (.not. associated(currentCohort%taller)) then
currentPatch%tallest => currentCohort%shorter
@@ -605,6 +605,23 @@ subroutine terminate_cohorts( siteptr, patchptr )
currentPatch%root_litter(currentCohort%pft) = currentPatch%root_litter(currentCohort%pft) + currentCohort%n* &
(currentCohort%br+currentCohort%bstore)/currentPatch%area
+ ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr)
+ 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
+ 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
+ enddo
+
+ currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = &
+ currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + &
+ currentCohort%n * (currentCohort%bl) * hlm_days_per_year / AREA
+ 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
+
deallocate(currentCohort)
endif
endif
@@ -620,7 +637,7 @@ subroutine fuse_cohorts(patchptr)
! Join similar cohorts to reduce total number
!
! !USES:
- use EDTypesMod , only : nlevcan
+ use EDTypesMod , only : nlevleaf
!
! !ARGUMENTS
type (ed_patch_type), intent(inout), target :: patchptr
@@ -776,7 +793,7 @@ subroutine fuse_cohorts(patchptr)
currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + &
nextc%n*nextc%canopy_layer_yesterday)/newn
- do i=1, nlevcan
+ do i=1, nlevleaf
if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then
currentCohort%year_net_uptake(i) = min(nextc%year_net_uptake(i),currentCohort%year_net_uptake(i))
else
@@ -1179,25 +1196,6 @@ function count_cohorts( currentPatch ) result ( backcount )
end function count_cohorts
- ! =====================================================================================
-
- subroutine size_and_type_class_index(dbh,pft,size_class,size_by_pft_class)
-
- use EDTypesMod, only: sclass_ed
- use EDTypesMod, only: nlevsclass_ed
-
- ! Arguments
- real(r8),intent(in) :: dbh
- integer,intent(in) :: pft
- integer,intent(out) :: size_class
- integer,intent(out) :: size_by_pft_class
-
- size_class = count(dbh-sclass_ed.ge.0.0_r8)
-
- size_by_pft_class = (pft-1)*nlevsclass_ed+size_class
-
- return
- end subroutine size_and_type_class_index
diff --git a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90
index cd330f1c8b..ec65f8913d 100755
--- a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90
+++ b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90
@@ -8,9 +8,9 @@ module EDGrowthFunctionsMod
use FatesConstantsMod, only : r8 => fates_r8
use FatesGlobals , only : fates_log
- use pftconMod , only : pftcon
+ use EDPftvarcon , only : EDPftvarcon_inst
use EDEcophysContype , only : EDecophyscon
- use EDTypesMod , only : ed_cohort_type, nlevcan, dinc_ed
+ use EDTypesMod , only : ed_cohort_type, nlevleaf, dinc_ed
implicit none
private
@@ -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(fates_log(),*) '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
@@ -159,10 +159,10 @@ real(r8) function tree_lai( cohort_in )
cohort_in%treelai = tree_lai
! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it
- ! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a
+ ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a
! huge error
- if(cohort_in%treelai > nlevcan*dinc_ed)then
- write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevcan * dinc_ed
+ if(cohort_in%treelai > nlevleaf*dinc_ed)then
+ write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevleaf * dinc_ed
endif
return
@@ -196,10 +196,10 @@ real(r8) function tree_sai( cohort_in )
cohort_in%treesai = tree_sai
! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it
- ! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a
+ ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a
! huge error
- if(cohort_in%treesai > nlevcan*dinc_ed)then
- write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevcan * dinc_ed
+ if(cohort_in%treesai > nlevleaf*dinc_ed)then
+ write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevleaf * dinc_ed
endif
return
@@ -225,7 +225,7 @@ real(r8) function c_area( cohort_in )
if (DEBUG_growth) then
write(fates_log(),*) 'z_area 1',cohort_in%dbh,cohort_in%pft
write(fates_log(),*) 'z_area 2',EDecophyscon%max_dbh
- write(fates_log(),*) 'z_area 3',pftcon%woody
+ write(fates_log(),*) 'z_area 3',EDPftvarcon_inst%woody
write(fates_log(),*) 'z_area 4',cohort_in%n
write(fates_log(),*) 'z_area 5',cohort_in%patchptr%spread
write(fates_log(),*) '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/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90
index 3632141ad6..820e7d8f1a 100755
--- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90
+++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90
@@ -3,10 +3,9 @@ module EDPatchDynamicsMod
! ============================================================================
! Controls formation, creation, fusing and termination of patch level processes.
! ============================================================================
-
use FatesGlobals , only : fates_log
use FatesInterfaceMod , only : hlm_freq_day
- 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, area, dbhmax
use EDTypesMod , only : numpft_ed
@@ -17,6 +16,7 @@ module EDPatchDynamicsMod
use FatesInterfaceMod , only : hlm_numlevgrnd
use FatesInterfaceMod , only : hlm_numlevsoil
use FatesInterfaceMod , only : hlm_numSWb
+ use FatesInterfaceMod , only : hlm_days_per_year
use FatesGlobals , only : endrun => fates_endrun
use FatesConstantsMod , only : r8 => fates_r8
@@ -37,7 +37,6 @@ module EDPatchDynamicsMod
public :: check_patch_area
public :: set_patchno
public :: set_root_fraction
-
private:: fuse_2_patches
@@ -254,9 +253,9 @@ subroutine spawn_patches( currentSite )
call average_patch_properties(currentPatch, new_patch, patch_site_areadis) ! MAY BE REDUNDANT CALL
if (currentSite%disturbance_mortality > currentSite%disturbance_fire) then !mortality is dominant disturbance
- call mortality_litter_fluxes(currentPatch, new_patch, patch_site_areadis)
+ call mortality_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis)
else
- call fire_litter_fluxes(currentPatch, new_patch, patch_site_areadis)
+ call fire_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis)
endif
!INSERT SURVIVORS FROM DISTURBANCE INTO NEW PATCH
@@ -293,7 +292,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
@@ -513,7 +512,7 @@ subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis
end subroutine average_patch_properties
! ============================================================================
- subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis)
+ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_site_areadis)
!
! !DESCRIPTION:
! CWD pool burned by a fire.
@@ -528,12 +527,12 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis)
use EDtypesMod , only : dl_sf
!
! !ARGUMENTS:
+ type(ed_site_type) , intent(inout), target :: currentSite
type(ed_patch_type) , intent(inout), target :: cp_target
type(ed_patch_type) , intent(inout), target :: new_patch_target
real(r8) , intent(inout) :: patch_site_areadis
!
! !LOCAL VARIABLES:
- type(ed_site_type) , pointer :: currentSite
type(ed_patch_type) , pointer :: currentPatch
type(ed_patch_type) , pointer :: new_patch
type(ed_cohort_type), pointer :: currentCohort
@@ -551,7 +550,6 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis)
if ( currentPatch%fire == 1 ) then !only do this if there was a fire in this actual patch.
patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate ! how much land is disturbed in this donor patch?
- currentSite => currentPatch%siteptr
!************************************/
!PART 1) Burn the fractions of existing litter in the new patch that were consumed by the fire.
@@ -578,7 +576,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.
@@ -600,11 +598,24 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis)
(currentCohort%bl) * (1.0_r8-currentCohort%cfa)
currentPatch%root_litter(p) = currentPatch%root_litter(p) + dead_tree_density * &
(currentCohort%br+currentCohort%bstore)
+
+ ! track as diagnostic fluxes
+ currentSite%leaf_litter_diagnostic_input_carbonflux(p) = currentSite%leaf_litter_diagnostic_input_carbonflux(p) + &
+ (currentCohort%bl) * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * currentCohort%n * &
+ hlm_days_per_year / AREA
+ currentSite%root_litter_diagnostic_input_carbonflux(p) = currentSite%root_litter_diagnostic_input_carbonflux(p) + &
+ (currentCohort%br+currentCohort%bstore) * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * &
+ currentCohort%n * hlm_days_per_year / AREA
! below ground coarse woody debris from burned trees
do c = 1,ncwd
new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot
currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot
+
+ ! track as diagnostic fluxes
+ currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) + &
+ SF_val_CWD_frac(c) * bcroot * currentCohort%fire_mort * currentCohort%n * &
+ hlm_days_per_year / AREA
enddo
! above ground coarse woody debris from unburned twigs and small branches
@@ -613,12 +624,22 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis)
* (1.0_r8-currentCohort%cfa)
currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * &
bstem * (1.0_r8-currentCohort%cfa)
+
+ ! track as diagnostic fluxes
+ currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + &
+ SF_val_CWD_frac(c) * bstem * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * currentCohort%n * &
+ hlm_days_per_year / AREA
enddo
! above ground coarse woody debris from large branches and stems: these do not burn in crown fires.
do c = 3,4
new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem
currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem
+
+ ! track as diagnostic fluxes
+ currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + &
+ SF_val_CWD_frac(c) * bstem * currentCohort%fire_mort * currentCohort%n * &
+ hlm_days_per_year / AREA
enddo
! Burned parts of dead tree pool.
@@ -661,7 +682,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)
@@ -688,7 +709,7 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis)
end subroutine fire_litter_fluxes
! ============================================================================
- subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_areadis)
+ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, patch_site_areadis)
!
! !DESCRIPTION:
! Carbon going from ongoing mortality into CWD pools.
@@ -698,6 +719,7 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread
use SFParamsMod, only : SF_val_cwd_frac
!
! !ARGUMENTS:
+ type(ed_site_type) , intent(inout), target :: currentSite
type(ed_patch_type) , intent(inout), target :: cp_target
type(ed_patch_type) , intent(inout), target :: new_patch_target
real(r8) , intent(in) :: patch_site_areadis
@@ -712,13 +734,16 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread
real(r8) :: canopy_dead !Number of individual dead from the understorey layer /day
real(r8) :: np_mult !Fraction of the new patch which came from the current patch (and so needs the same litter)
integer :: p,c
+ real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/day
+ real(r8) :: canopy_mortality_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
!---------------------------------------------------------------------
currentPatch => cp_target
new_patch => new_patch_target
- currentPatch%canopy_mortality_woody_litter = 0.0_r8 ! mortality generated litter. KgC/m2/day
- currentPatch%canopy_mortality_leaf_litter(:) = 0.0_r8
- currentPatch%canopy_mortality_root_litter(:) = 0.0_r8
+ canopy_mortality_woody_litter = 0.0_r8 ! mortality generated litter. KgC/m2/day
+ canopy_mortality_leaf_litter(:) = 0.0_r8
+ canopy_mortality_root_litter(:) = 0.0_r8
currentCohort => currentPatch%shortest
do while(associated(currentCohort))
@@ -730,22 +755,22 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread
!not right to recalcualte dmort here.
canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * hlm_freq_day)
- currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + &
+ canopy_mortality_woody_litter = canopy_mortality_woody_litter + &
canopy_dead*(currentCohort%bdead+currentCohort%bsw)
- currentPatch%canopy_mortality_leaf_litter(p) = currentPatch%canopy_mortality_leaf_litter(p)+ &
+ canopy_mortality_leaf_litter(p) = canopy_mortality_leaf_litter(p)+ &
canopy_dead*(currentCohort%bl)
- currentPatch%canopy_mortality_root_litter(p) = currentPatch%canopy_mortality_root_litter(p)+ &
+ canopy_mortality_root_litter(p) = canopy_mortality_root_litter(p)+ &
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 + &
+ canopy_mortality_woody_litter = canopy_mortality_woody_litter + &
understorey_dead*(currentCohort%bdead+currentCohort%bsw)
- currentPatch%canopy_mortality_leaf_litter(p)= currentPatch%canopy_mortality_leaf_litter(p)+ &
+ canopy_mortality_leaf_litter(p)= canopy_mortality_leaf_litter(p)+ &
understorey_dead* currentCohort%bl
- currentPatch%canopy_mortality_root_litter(p)= currentPatch%canopy_mortality_root_litter(p)+ &
+ canopy_mortality_root_litter(p)= canopy_mortality_root_litter(p)+ &
understorey_dead*(currentCohort%br+currentCohort%bstore)
! FIX(SPM,040114) - clarify this comment
@@ -777,22 +802,33 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread
! so we need to multiply by patch_areadis/np%area
do c = 1,ncwd
- cwd_litter_density = SF_val_CWD_frac(c) * currentPatch%canopy_mortality_woody_litter / litter_area
+ 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
+ ! 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
+ 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
enddo
do p = 1,numpft_ed
- new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + currentPatch%canopy_mortality_leaf_litter(p) / litter_area * np_mult
- new_patch%root_litter(p) = new_patch%root_litter(p) + currentPatch%canopy_mortality_root_litter(p) / litter_area * np_mult
- currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + currentPatch%canopy_mortality_leaf_litter(p) / litter_area
- currentPatch%root_litter(p) = currentPatch%root_litter(p) + currentPatch%canopy_mortality_root_litter(p) / litter_area
+ 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
+ currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + canopy_mortality_leaf_litter(p) / litter_area
+ currentPatch%root_litter(p) = currentPatch%root_litter(p) + canopy_mortality_root_litter(p) / litter_area
+ ! track as diagnostic fluxes
+ currentSite%leaf_litter_diagnostic_input_carbonflux(p) = currentSite%leaf_litter_diagnostic_input_carbonflux(p) + &
+ canopy_mortality_leaf_litter(p) * hlm_days_per_year / AREA
+
+ currentSite%root_litter_diagnostic_input_carbonflux(p) = currentSite%root_litter_diagnostic_input_carbonflux(p) + &
+ canopy_mortality_root_litter(p) * hlm_days_per_year / AREA
enddo
end subroutine mortality_litter_fluxes
@@ -1160,7 +1196,7 @@ subroutine fuse_2_patches(dp, rp)
! associated with the secnd patch
!
! !USES:
- use EDTypesMod, only: ageclass_ed
+ use EDTypesMod, only: get_age_class_index
!
! !ARGUMENTS:
type (ed_patch_type) , intent(inout), pointer :: dp ! Donor Patch
@@ -1180,7 +1216,7 @@ subroutine fuse_2_patches(dp, rp)
!area weighted average of ages & litter
rp%age = (dp%age * dp%area + rp%age * rp%area)/(dp%area + rp%area)
- rp%age_class = count(rp%age-ageclass_ed.ge.0.0_r8)
+ rp%age_class = get_age_class_index(rp%age)
do p = 1,numpft_ed
rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area)/(rp%area + dp%area)
@@ -1523,7 +1559,7 @@ subroutine set_root_fraction( cpatch , depth_gl )
! Calculates the fractions of the root biomass in each layer for each pft.
!
! !USES:
- use pftconMod , only : pftcon
+
!
! !ARGUMENTS
type(ed_patch_type),intent(inout), target :: cpatch
@@ -1540,14 +1576,13 @@ subroutine set_root_fraction( cpatch , depth_gl )
do lev = 1, hlm_numlevsoil-1
cpatch%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
end subroutine set_root_fraction
-
-end module EDPatchDynamicsMod
+ end module EDPatchDynamicsMod
diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90
index 33dc65bd0c..7a7de34948 100755
--- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90
+++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90
@@ -12,7 +12,8 @@ module EDPhysiologyMod
use FatesInterfaceMod, only : hlm_freq_day
use FatesInterfaceMod, only : hlm_day_of_year
use FatesConstantsMod, only : r8 => fates_r8
- use pftconMod , only : pftcon
+ 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
@@ -22,7 +23,7 @@ module EDPhysiologyMod
use EDTypesMod , only : dl_sf, dinc_ed
use EDTypesMod , only : external_recruitment
use EDTypesMod , only : ncwd
- use EDTypesMod , only : nlevcan
+ use EDTypesMod , only : nlevleaf
use EDTypesMod , only : numpft_ed
use EDTypesMod , only : senes
use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type
@@ -155,7 +156,6 @@ subroutine trim_canopy( currentSite )
!
! !USES:
!
- use EDParamsMod, only : ED_val_grperc
use EDGrowthFunctionsMod, only : tree_lai
!
! !ARGUMENTS
@@ -184,27 +184,30 @@ subroutine trim_canopy( currentSite )
trimmed = 0
currentCohort%treelai = tree_lai(currentCohort)
currentCohort%nv = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed)
- if (currentCohort%nv > nlevcan)then
- write(fates_log(),*) 'nv > nlevcan',currentCohort%nv,currentCohort%treelai,currentCohort%treesai, &
+ if (currentCohort%nv > nlevleaf)then
+ write(fates_log(),*) 'nv > nlevleaf',currentCohort%nv,currentCohort%treelai,currentCohort%treesai, &
currentCohort%c_area,currentCohort%n,currentCohort%bl
endif
!Leaf cost vs netuptake for each leaf layer.
- do z = 1,nlevcan
+ do z = 1,nlevleaf
if (currentCohort%year_net_uptake(z) /= 999._r8)then !there was activity this year in this leaf layer.
!Leaf Cost kgC/m2/year-1
!decidous costs.
- if (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)
- currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8)
+ 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 * (EDPftvarcon_inst%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 = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8)
+ 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 * (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
@@ -216,7 +219,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
@@ -479,7 +482,7 @@ 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*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
@@ -528,7 +531,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.
@@ -572,7 +575,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.
@@ -808,11 +811,11 @@ 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 + 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
@@ -828,8 +831,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in)
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
@@ -839,22 +842,23 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in)
!with which I am not especially comfortable, particularly as the concept of sapwood turnover is unclear for trees that
!are still in an expansion phase.
- if (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(fates_log(),*) '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(fates_log(),*) 'problem with phenology definitions',currentCohort%pft, &
+ EDPftvarcon_inst%stress_decid(currentCohort%pft), &
+ EDPftvarcon_inst%season_decid(currentCohort%pft),EDPftvarcon_inst%evergreen(currentCohort%pft)
endif
! FIX(RF,032414) -turned off for now as it makes balive go negative....
@@ -948,7 +952,7 @@ 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 = 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)
@@ -1046,9 +1050,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)*hlm_freq_day &
/ (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore)
@@ -1061,17 +1065,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
@@ -1187,7 +1191,7 @@ subroutine fragmentation_scaler( currentPatch, bc_in)
!
! !USES:
- use EDSharedParamsMod , only : EDParamsShareInst
+ use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst
use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm
use FatesConstantsMod, only : pi => pi_const
!
@@ -1216,8 +1220,8 @@ subroutine fragmentation_scaler( currentPatch, bc_in)
ifp = currentPatch%patchno
! set "froz_q10" parameter
- froz_q10 = EDParamsShareInst%froz_q10
- Q10 = EDParamsShareInst%Q10
+ froz_q10 = FatesSynchronizedParamsInst%froz_q10
+ Q10 = FatesSynchronizedParamsInst%Q10
if ( .not. use_century_tfunc ) then
!calculate rate constant scalar for soil temperature,assuming that the base rate constants
@@ -1336,7 +1340,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out)
use FatesInterfaceMod, only : hlm_numlevdecomp_full
use FatesInterfaceMod, only : hlm_numlevdecomp
use SoilBiogeochemVerticalProfileMod, only: surfprof_exp
- use pftconMod, only : pftcon
+ use EDPftvarcon, only : EDPftvarcon_inst
use FatesConstantsMod, only : sec_per_day
use clm_varcon, only : zisoi, dzsoi_decomp, zsoi
use EDParamsMod, only : ED_val_ag_biomass
@@ -1450,8 +1454,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, hlm_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
@@ -1461,10 +1466,10 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out)
do j = 1, hlm_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
@@ -1652,26 +1657,26 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out)
do ft = 1,numpft_ed
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) * 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/components/clm/src/ED/biogeophys/EDBtranMod.F90 b/components/clm/src/ED/biogeophys/EDBtranMod.F90
index d44da0d1c8..5e868eb0ed 100644
--- a/components/clm/src/ED/biogeophys/EDBtranMod.F90
+++ b/components/clm/src/ED/biogeophys/EDBtranMod.F90
@@ -5,7 +5,7 @@ module EDBtranMod
!
! ------------------------------------------------------------------------------------
- use pftconMod , only : pftcon
+ use EDPftvarcon , only : EDPftvarcon_inst
use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm
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/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90
index 130b093da0..9ab4392c56 100644
--- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90
+++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90
@@ -20,7 +20,7 @@ module EDSurfaceRadiationMod
use EDTypesMod , only : maxSWb
use EDTypesMod , only : nclmax
use EDTypesMod , only : numpft_ed
- use EDTypesMod , only : nlevcan
+ use EDTypesMod , only : nlevleaf
use EDCanopyStructureMod, only: calc_areaindex
use FatesGlobals , only : fates_log
@@ -50,7 +50,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
!
! !USES:
- use pftconMod , only : pftcon
+ use EDPftvarcon , only : EDPftvarcon_inst
use EDtypesMod , only : ed_patch_type
use EDTypesMod , only : ed_site_type
@@ -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,nlevcan)
+ 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,nlevcan) ! Exponential transmittance of direct beam radiation through a single layer
- real(r8) :: tr_dif_z(nclmax,numpft_ed,nlevcan) ! Exponential transmittance of diffuse radiation through a single layer
+ 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) :: forc_dir(maxPatchesPerSite,maxSWb)
real(r8) :: forc_dif(maxPatchesPerSite,maxSWb)
real(r8) :: weighted_dir_tr(nclmax)
@@ -85,15 +85,15 @@ 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,nlevcan,maxSWb) ! Term for diffuse radiation reflected by laye
- real(r8) :: tran_dif(nclmax,numpft_ed,nlevcan,maxSWb) ! Term for diffuse radiation transmitted by layer
- real(r8) :: dif_ratio(nclmax,numpft_ed,nlevcan,maxSWb) ! Ratio of upward to forward diffuse fluxes
- real(r8) :: Dif_dn(nclmax,numpft_ed,nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area)
- real(r8) :: Dif_up(nclmax,numpft_ed,nlevcan) ! Upward diffuse flux above canopy layer J (W/m**2 ground area)
- real(r8) :: lai_change(nclmax,numpft_ed,nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area)
+ 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,nlevcan)
- real(r8) :: Abs_dif_z(numpft_ed,nlevcan)
+ real(r8) :: Abs_dir_z(numpft_ed,nlevleaf)
+ real(r8) :: Abs_dif_z(numpft_ed,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.
@@ -117,11 +117,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/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90
index 6dd2592c24..affdf592da 100644
--- a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90
+++ b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90
@@ -25,7 +25,7 @@ module FATESPlantRespPhotosynthMod
use FatesConstantsMod, only : r8 => fates_r8
use EDTypesMod, only : use_fates_plant_hydro
use EDTypesMod, only : numpft_ed
- use EDTypesMod, only : nlevcan
+ use EDTypesMod, only : nlevleaf
use EDTypesMod, only : nclmax
! CIME Globals
@@ -63,11 +63,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
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
- use EDSharedParamsMod , only : EDParamsShareInst
+ use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst
use EDTypesMod , only : ed_patch_type
use EDTypesMod , only : ed_cohort_type
use EDTypesMod , only : ed_site_type
@@ -116,17 +115,17 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
! -----------------------------------------------------------------------------------
! leaf maintenance (dark) respiration (umol CO2/m**2/s) Double check this
- real(r8) :: lmr_z(nlevcan,mxpft,nclmax)
+ real(r8) :: lmr_z(nlevleaf,mxpft,nclmax)
! stomatal resistance s/m
- real(r8) :: rs_z(nlevcan,mxpft,nclmax)
+ real(r8) :: rs_z(nlevleaf,mxpft,nclmax)
! net leaf photosynthesis averaged over sun and shade leaves. (umol CO2/m**2/s)
- real(r8) :: anet_av_z(nlevcan,mxpft,nclmax)
+ real(r8) :: anet_av_z(nlevleaf,mxpft,nclmax)
! Mask used to determine which leaf-layer biophysical rates have been
! used already
- logical :: rate_mask_z(nlevcan,mxpft,nclmax)
+ logical :: rate_mask_z(nlevleaf,mxpft,nclmax)
real(r8) :: vcmax_z ! leaf layer maximum rate of carboxylation
! (umol co2/m**2/s)
@@ -200,16 +199,16 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
associate( &
- c3psn => pftcon%c3psn , &
- slatop => pftcon%slatop , & ! specific leaf area at top of canopy,
+ c3psn => EDPftvarcon_inst%c3psn , &
+ slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy,
! projected area basis [m^2/gC]
- flnr => pftcon%flnr , & ! fraction of leaf N in the Rubisco
+ flnr => EDPftvarcon_inst%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) ! slope of BB relationship
- q10 => EDParamsShareInst%Q10 )
+ 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 )
do s = 1,nsites
@@ -500,7 +499,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
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))
currentCohort%bsw = EDecophyscon%sapwood_ratio(currentCohort%pft) * &
@@ -586,7 +585,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
! no drought response right now.. something like:
! resp_m = resp_m * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft) * &
- ! pftcon%resp_drought_response(ft))
+ ! EDPftvarcon_inst%resp_drought_response(ft))
currentCohort%resp_m = currentCohort%resp_m + currentCohort%rdark
@@ -599,7 +598,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
if ( DEBUG ) write(fates_log(),*) 'EDPhoto 912 ', currentCohort%resp_tstep
if ( DEBUG ) write(fates_log(),*) 'EDPhoto 913 ', currentCohort%resp_m
- currentCohort%resp_g = ED_val_grperc(ft) * &
+ currentCohort%resp_g = EDPftvarcon_inst%grperc(ft) * &
(max(0._r8,currentCohort%gpp_tstep - &
currentCohort%resp_m))
currentCohort%resp_tstep = currentCohort%resp_m + &
@@ -688,7 +687,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in
! ------------------------------------------------------------------------------------
use EDEcophysContype , only : EDecophyscon
- use pftconMod , only : pftcon
+ use EDPftvarcon , only : EDPftvarcon_inst
! Arguments
! ------------------------------------------------------------------------------------
@@ -784,7 +783,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in
associate( bb_slope => EDecophyscon%BB_slope ) ! slope of BB relationship
- if (nint(pftcon%c3psn(ft)) == 1) then! photosynthetic pathway: 0. = c4, 1. = c3
+ if (nint(EDPftvarcon_inst%c3psn(ft)) == 1) then! photosynthetic pathway: 0. = c4, 1. = c3
pp_type = 1
init_co2_intra_c = init_a2l_co2_c3 * can_co2_ppress
else
@@ -1476,8 +1475,8 @@ subroutine LeafLayerMaintenanceRespiration(lmr25top_ft, &
lmr)
use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm
- use pftconMod , only : pftcon
-
+ use EDPftvarcon , only : EDPftvarcon_inst
+
! Arguments
real(r8), intent(in) :: lmr25top_ft ! canopy top leaf maint resp rate at 25C
! for this pft (umol CO2/m**2/s)
@@ -1500,7 +1499,7 @@ subroutine LeafLayerMaintenanceRespiration(lmr25top_ft, &
! ----------------------------------------------------------------------------------
lmr25 = lmr25top_ft * nscaler
- if ( nint(pftcon%c3psn(ft)) == 1)then
+ if ( nint(EDpftvarcon_inst%c3psn(ft)) == 1)then
lmr = lmr25 * ft1_f(veg_tempk, lmrha) * &
fth_f(veg_tempk, lmrhd, lmrse, lmrc)
else
@@ -1543,7 +1542,7 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, &
! co2_rcurve_islope: initial slope of CO2 response curve (C4 plants)
! ---------------------------------------------------------------------------------
- use pftconMod , only : pftcon
+ use EDPftvarcon , only : EDPftvarcon_inst
use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm
! Arguments
@@ -1616,7 +1615,7 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, &
jmax = jmax25 * ft1_f(veg_tempk, jmaxha) * fth_f(veg_tempk, jmaxhd, jmaxse, jmaxc)
tpu = tpu25 * ft1_f(veg_tempk, tpuha) * fth_f(veg_tempk, tpuhd, tpuse, tpuc)
- if (nint(pftcon%c3psn(ft)) /= 1) then
+ if (nint(EDPftvarcon_inst%c3psn(ft)) /= 1) then
vcmax = vcmax25 * 2._r8**((veg_tempk-(tfrz+25._r8))/10._r8)
vcmax = vcmax / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-veg_tempk ) ))
vcmax = vcmax / (1._r8 + exp( 0.3_r8*(veg_tempk-(tfrz+40._r8)) ))
diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90
index 40e909c5f2..013b663dd7 100755
--- a/components/clm/src/ED/fire/SFMainMod.F90
+++ b/components/clm/src/ED/fire/SFMainMod.F90
@@ -13,6 +13,7 @@ module SFMainMod
use FatesInterfaceMod , only : bc_in_type
use pftconMod , only : pftcon
+ use EDPftvarcon , only : EDPftvarcon_inst
use EDEcophysconType , only : EDecophyscon
use EDtypesMod , only : ed_site_type
@@ -24,6 +25,7 @@ module SFMainMod
use EDtypesMod , only : LB_SF
use EDtypesMod , only : LG_SF
use EDtypesMod , only : NCWD
+ use EDtypesMod , only : NFSC
use EDtypesMod , only : TR_SF
implicit none
@@ -153,8 +155,8 @@ subroutine charecteristics_of_fuel ( currentSite )
type(ed_cohort_type), pointer :: currentCohort
real(r8) timeav_swc
- real(r8) fuel_moisture(ncwd+2) ! Scaled moisture content of small litter fuels.
- real(r8) MEF(ncwd+2) ! Moisture extinction factor of fuels integer n
+ real(r8) fuel_moisture(nfsc) ! Scaled moisture content of small litter fuels.
+ real(r8) MEF(nfsc) ! Moisture extinction factor of fuels integer n
fuel_moisture(:) = 0.0_r8
@@ -164,7 +166,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
@@ -211,7 +213,7 @@ subroutine charecteristics_of_fuel ( currentSite )
endif
currentPatch%fuel_frac(lg_sf) = currentPatch%livegrass / currentPatch%sum_fuel
- MEF(1:ncwd+2) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:ncwd+2))
+ MEF(1:nfsc) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:nfsc))
!--- weighted average of relative moisture content---
! Equation 6 in Thonicke et al. 2010.
@@ -268,7 +270,7 @@ subroutine charecteristics_of_fuel ( currentSite )
sum(currentPatch%cwd_bg),sum(currentPatch%leaf_litter)
endif
- currentPatch%fuel_sav = sum(SF_val_SAV(1:ncwd+2))/(ncwd+2) ! make average sav to avoid crashing code.
+ currentPatch%fuel_sav = sum(SF_val_SAV(1:nfsc))/(nfsc) ! make average sav to avoid crashing code.
if ( hlm_masterproc == 1 ) write(fates_log(),*) 'problem with spitfire fuel averaging'
@@ -340,7 +342,7 @@ subroutine wind_effect ( currentSite, bc_in)
do while(associated(currentCohort))
write(fates_log(),*) '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
@@ -538,8 +540,8 @@ subroutine ground_fuel_consumption ( currentSite )
type(ed_patch_type), pointer :: currentPatch
real(r8) :: moist !effective fuel moisture
- real(r8) :: tau_b(ncwd+2) !lethal heating rates for each fuel class (min)
- real(r8) :: fc_ground(ncwd+2) !propn of fuel consumed
+ real(r8) :: tau_b(nfsc) !lethal heating rates for each fuel class (min)
+ real(r8) :: fc_ground(nfsc) !propn of fuel consumed
integer :: c
@@ -549,7 +551,7 @@ subroutine ground_fuel_consumption ( currentSite )
currentPatch%burnt_frac_litter = 1.0_r8
! Calculate fraction of litter is burnt for all classes.
! Equation B1 in Thonicke et al. 2010---
- do c = 1, ncwd+2 !work out the burnt fraction for all pools, even if those pools dont exist.
+ do c = 1, nfsc !work out the burnt fraction for all pools, even if those pools dont exist.
moist = currentPatch%litter_moisture(c)
! 1. Very dry litter
if (moist <= SF_val_min_moisture(c)) then
@@ -590,7 +592,7 @@ subroutine ground_fuel_consumption ( currentSite )
! taul is the duration of the lethal heating.
! The /10 is to convert from kgC/m2 into gC/cm2, as in the Peterson and Ryan paper #Rosie,Jun 2013
- do c = 1,ncwd+2
+ do c = 1,nfsc
tau_b(c) = 39.4_r8 *(currentPatch%fuel_frac(c)*currentPatch%sum_fuel/0.45_r8/10._r8)* &
(1.0_r8-((1.0_r8-currentPatch%burnt_frac_litter(c))**0.5_r8))
enddo
@@ -789,7 +791,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
@@ -804,7 +806,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
@@ -844,7 +846,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
@@ -905,7 +907,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.
@@ -957,7 +959,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/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90
index 978ac5f9a2..514c58e12b 100644
--- a/components/clm/src/ED/fire/SFParamsMod.F90
+++ b/components/clm/src/ED/fire/SFParamsMod.F90
@@ -3,7 +3,8 @@ module SFParamsMod
! module that deals with reading the SF parameter file
!
use FatesConstantsMod , only: r8 => fates_r8
- use EDtypesMod , only: NLSC,NFSC,NCWD
+ use EDtypesMod , only: NFSC,NCWD
+ use FatesParametersInterface, only : param_string_length
implicit none
save
@@ -23,9 +24,9 @@ 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_alpha_FMC(NLSC)
+ real(r8),protected :: SF_val_alpha_FMC(NFSC)
real(r8),protected :: SF_val_CWD_frac(NCWD)
- real(r8),protected :: SF_val_max_decomp(NLSC)
+ real(r8),protected :: SF_val_max_decomp(NFSC)
real(r8),protected :: SF_val_SAV(NFSC)
real(r8),protected :: SF_val_FBD(NFSC)
real(r8),protected :: SF_val_min_moisture(NFSC)
@@ -35,178 +36,308 @@ module SFParamsMod
real(r8),protected :: SF_val_mid_moisture_C(NFSC)
real(r8),protected :: SF_val_mid_moisture_S(NFSC)
- character(len=20),parameter :: SF_name_fdi_a = "fdi_a"
- character(len=20),parameter :: SF_name_fdi_b = "fdi_b"
- character(len=20),parameter :: SF_name_fdi_alpha = "fdi_alpha"
- character(len=20),parameter :: SF_name_miner_total = "miner_total"
- character(len=20),parameter :: SF_name_fuel_energy = "fuel_energy"
- character(len=20),parameter :: SF_name_part_dens = "part_dens"
- character(len=20),parameter :: SF_name_miner_damp = "miner_damp"
- character(len=20),parameter :: SF_name_max_durat = "max_durat"
- character(len=20),parameter :: SF_name_durat_slope = "durat_slope"
- character(len=20),parameter :: SF_name_alpha_SH = "alpha_SH"
- character(len=20),parameter :: SF_name_alpha_FMC = "alpha_FMC"
- character(len=20),parameter :: SF_name_CWD_frac = "CWD_frac"
- character(len=20),parameter :: SF_name_max_decomp = "max_decomp"
- character(len=20),parameter :: SF_name_SAV = "SAV"
- character(len=20),parameter :: SF_name_FBD = "FBD"
- character(len=20),parameter :: SF_name_min_moisture = "min_moisture"
- character(len=20),parameter :: SF_name_mid_moisture = "mid_moisture"
- character(len=20),parameter :: SF_name_low_moisture_C = "low_moisture_C"
- character(len=20),parameter :: SF_name_low_moisture_S = "low_moisture_S"
- character(len=20),parameter :: SF_name_mid_moisture_C = "mid_moisture_C"
- character(len=20),parameter :: SF_name_mid_moisture_S = "mid_moisture_S"
-
- public :: SFParamsRead
+ 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"
+ character(len=param_string_length),parameter :: SF_name_miner_total = "fates_miner_total"
+ character(len=param_string_length),parameter :: SF_name_fuel_energy = "fates_fuel_energy"
+ character(len=param_string_length),parameter :: SF_name_part_dens = "fates_part_dens"
+ 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"
+ character(len=param_string_length),parameter :: SF_name_SAV = "fates_SAV"
+ 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"
+
+ public :: SpitFireRegisterParams
+ public :: SpitFireReceiveParams
+
+ private :: SpitFireParamsInit
+ private :: SpitFireRegisterScalars
+ private :: SpitFireReceiveScalars
+
+ private :: SpitFireRegisterNCWD
+ private :: SpitFireReceiveNCWD
+
+ private :: SpitFireRegisterNFSC
+ private :: SpitFireReceiveNFSC
contains
!-----------------------------------------------------------------------
- !
+ subroutine SpitFireParamsInit()
+ ! Initialize all parameters to nan to ensure that we get valid
+ ! values back from the host.
+
+ use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
+
+ implicit none
+
+ SF_val_fdi_a = nan
+ SF_val_fdi_b = nan
+ SF_val_fdi_alpha = nan
+ SF_val_miner_total = nan
+ SF_val_fuel_energy = nan
+ SF_val_part_dens = nan
+ SF_val_miner_damp = nan
+ SF_val_max_durat = nan
+ SF_val_durat_slope = nan
+ SF_val_alpha_SH = nan
+
+ SF_val_CWD_frac(:) = nan
+
+ SF_val_alpha_FMC(:) = nan
+ SF_val_max_decomp(:) = nan
+
+ SF_val_SAV(:) = nan
+ 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
+
+ end subroutine SpitFireParamsInit
+
!-----------------------------------------------------------------------
- subroutine SFParamsRead(ncid)
- !
- ! calls to initialize parameter instance and do ncdio read
- !
- use ncdio_pio , only : file_desc_t
-
- implicit none
+ subroutine SpitFireRegisterParams(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_scalar
+
+ implicit none
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ class(fates_parameters_type), intent(inout) :: fates_params
- call SFParamsReadLocal(ncid)
+ call SpitFireParamsInit()
+ call SpitFireRegisterScalars(fates_params)
+ call SpitFireRegisterNCWD(fates_params)
+ call SpitFireRegisterNFSC(fates_params)
+
+ end subroutine SpitFireRegisterParams
+
+ !-----------------------------------------------------------------------
+ subroutine SpitFireReceiveParams(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call SpitFireReceiveScalars(fates_params)
+ call SpitFireReceiveNCWD(fates_params)
+ call SpitFireReceiveNFSC(fates_params)
+
+ end subroutine SpitFireReceiveParams
- end subroutine SFParamsRead
!-----------------------------------------------------------------------
+ subroutine SpitFireRegisterScalars(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_scalar
+
+ implicit none
+
+ 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_fdi_a, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ call fates_params%RegisterParameter(name=SF_name_fdi_b, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ call fates_params%RegisterParameter(name=SF_name_fdi_alpha, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ call fates_params%RegisterParameter(name=SF_name_miner_total, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ call fates_params%RegisterParameter(name=SF_name_fuel_energy, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ call fates_params%RegisterParameter(name=SF_name_part_dens, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ call fates_params%RegisterParameter(name=SF_name_miner_damp, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ call fates_params%RegisterParameter(name=SF_name_max_durat, dimension_shape=dimension_shape_scalar, &
+ dimension_names=dim_names_scalar)
+
+ 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
+
+ !-----------------------------------------------------------------------
+ subroutine SpitFireReceiveScalars(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call fates_params%RetreiveParameter(name=SF_name_fdi_a, &
+ data=SF_val_fdi_a)
+
+ call fates_params%RetreiveParameter(name=SF_name_fdi_b, &
+ data=SF_val_fdi_b)
+
+ call fates_params%RetreiveParameter(name=SF_name_fdi_alpha, &
+ data=SF_val_fdi_alpha)
+
+ call fates_params%RetreiveParameter(name=SF_name_miner_total, &
+ data=SF_val_miner_total)
+
+ call fates_params%RetreiveParameter(name=SF_name_fuel_energy, &
+ data=SF_val_fuel_energy)
+
+ call fates_params%RetreiveParameter(name=SF_name_part_dens, &
+ data=SF_val_part_dens)
+
+ call fates_params%RetreiveParameter(name=SF_name_miner_damp, &
+ data=SF_val_miner_damp)
+
+ call fates_params%RetreiveParameter(name=SF_name_max_durat, &
+ data=SF_val_max_durat)
+
+ 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
!-----------------------------------------------------------------------
- !
+ subroutine SpitFireRegisterNCWD(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_cwd, dimension_shape_1d
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ character(len=param_string_length), parameter :: dim_names_cwd(1) = (/dimension_name_cwd/)
+
+ call fates_params%RegisterParameter(name=SF_name_CWD_frac, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names_cwd)
+
+ end subroutine SpitFireRegisterNCWD
+
+ !-----------------------------------------------------------------------
+ subroutine SpitFireReceiveNCWD(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call fates_params%RetreiveParameter(name=SF_name_CWD_frac, &
+ data=SF_val_CWD_frac)
+
+ end subroutine SpitFireReceiveNCWD
+
!-----------------------------------------------------------------------
- subroutine SFParamsReadLocal(ncid)
- !
- ! read the netcdf file and populate internalInstScalar
- !
- use ncdio_pio , only : file_desc_t
- use paramUtilMod , only : readNcdio
+ subroutine SpitFireRegisterNFSC(fates_params)
- implicit none
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_fsc, dimension_shape_1d
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ implicit none
- ! local vars
- character(len=32) :: subname = 'SFParamsReadLocal::'
+ class(fates_parameters_type), intent(inout) :: fates_params
- !
- ! call read function
- !
+ character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_fsc/)
- call readNcdio(ncid = ncid, &
- varName=SF_name_fdi_a, &
- callingName=subname, &
- retVal=SF_val_fdi_a)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_fdi_b, &
- callingName=subname, &
- retVal=SF_val_fdi_b)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_fdi_alpha, &
- callingName=subname, &
- retVal=SF_val_fdi_alpha)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_miner_total, &
- callingName=subname, &
- retVal=SF_val_miner_total)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_fuel_energy, &
- callingName=subname, &
- retVal=SF_val_fuel_energy)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_part_dens, &
- callingName=subname, &
- retVal=SF_val_part_dens)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_miner_damp, &
- callingName=subname, &
- retVal=SF_val_miner_damp)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_max_durat, &
- callingName=subname, &
- retVal=SF_val_max_durat)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_durat_slope, &
- callingName=subname, &
- retVal=SF_val_durat_slope)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_alpha_SH, &
- callingName=subname, &
- retVal=SF_val_alpha_SH)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_alpha_FMC, &
- callingName=subname, &
- retVal=SF_val_alpha_FMC)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_CWD_frac, &
- callingName=subname, &
- retVal=SF_val_CWD_frac)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_max_decomp, &
- callingName=subname, &
- retVal=SF_val_max_decomp)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_SAV, &
- callingName=subname, &
- retVal=SF_val_SAV)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_FBD, &
- callingName=subname, &
- retVal=SF_val_FBD)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_min_moisture, &
- callingName=subname, &
- retVal=SF_val_min_moisture)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_mid_moisture, &
- callingName=subname, &
- retVal=SF_val_mid_moisture)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_low_moisture_C, &
- callingName=subname, &
- retVal=SF_val_low_moisture_C)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_low_moisture_S, &
- callingName=subname, &
- retVal=SF_val_low_moisture_S)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_mid_moisture_C, &
- callingName=subname, &
- retVal=SF_val_mid_moisture_C)
-
- call readNcdio(ncid = ncid, &
- varName=SF_name_mid_moisture_S, &
- callingName=subname, &
- retVal=SF_val_mid_moisture_S)
-
- end subroutine SFParamsReadLocal
+ call fates_params%RegisterParameter(name=SF_name_SAV, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=SF_name_FBD, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=SF_name_min_moisture, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ 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, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=SF_name_low_moisture_S, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=SF_name_mid_moisture_C, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=SF_name_mid_moisture_S, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=SF_name_alpha_FMC, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=SF_name_max_decomp, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ end subroutine SpitFireRegisterNFSC
+
+ !-----------------------------------------------------------------------
+ subroutine SpitFireReceiveNFSC(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+
+ call fates_params%RetreiveParameter(name=SF_name_SAV, &
+ data=SF_val_SAV)
+
+ call fates_params%RetreiveParameter(name=SF_name_FBD, &
+ data=SF_val_FBD)
+
+ call fates_params%RetreiveParameter(name=SF_name_min_moisture, &
+ data=SF_val_min_moisture)
+
+ 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_S, &
+ data=SF_val_low_moisture_S)
+
+ 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_S, &
+ data=SF_val_mid_moisture_S)
+
+ call fates_params%RetreiveParameter(name=SF_name_alpha_FMC, &
+ data=SF_val_alpha_FMC)
+
+ call fates_params%RetreiveParameter(name=SF_name_max_decomp, &
+ data=SF_val_max_decomp)
+
+ end subroutine SpitFireReceiveNFSC
!-----------------------------------------------------------------------
+
end module SFParamsMod
diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90
index 91bd94b224..d5c5c2967d 100755
--- a/components/clm/src/ED/main/EDInitMod.F90
+++ b/components/clm/src/ED/main/EDInitMod.F90
@@ -10,7 +10,7 @@ module EDInitMod
use FatesGlobals , only : fates_log
use clm_varctl , only : use_ed_spitfire
use clm_time_manager , only : is_restart
- 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
@@ -92,6 +92,12 @@ subroutine zero_site( site_in )
site_in%promotion_rate(:) = 0._r8
site_in%promotion_carbonflux = 0._r8
+ ! diagnostic site-level cwd and litter fluxes
+ site_in%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8
+ site_in%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8
+ site_in%leaf_litter_diagnostic_input_carbonflux(:) = 0._r8
+ site_in%root_litter_diagnostic_input_carbonflux(:) = 0._r8
+
end subroutine zero_site
! ============================================================================
@@ -261,17 +267,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
@@ -283,7 +289,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/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90
index 780787e2df..aed9edc5af 100755
--- a/components/clm/src/ED/main/EDMainMod.F90
+++ b/components/clm/src/ED/main/EDMainMod.F90
@@ -22,6 +22,7 @@ module EDMainMod
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
@@ -190,7 +191,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in )
endif
! check to see if the patch has moved to the next age class
- currentPatch%age_class = count(currentPatch%age-ageclass_ed.ge.0.0_r8)
+ currentPatch%age_class = get_age_class_index(currentPatch%age)
! Find the derivatives of the growth and litter processes.
call canopy_derivs(currentSite, currentPatch, bc_in)
diff --git a/components/clm/src/ED/main/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90
index 634eaadec0..f6b2daa664 100644
--- a/components/clm/src/ED/main/EDParamsMod.F90
+++ b/components/clm/src/ED/main/EDParamsMod.F90
@@ -4,7 +4,8 @@ module EDParamsMod
!
use shr_kind_mod , only: r8 => shr_kind_r8
use EDtypesMod , only: maxPft
-
+ use FatesParametersInterface, only : param_string_length
+
implicit none
save
! private - if we allow this module to be private, it does not allow the protected values below to be
@@ -13,11 +14,11 @@ module EDParamsMod
!
! this is what the user can use for the actual values
!
+
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_grperc(maxPft)
real(r8),protected :: ED_val_maxspread
real(r8),protected :: ED_val_minspread
real(r8),protected :: ED_val_init_litter
@@ -26,125 +27,153 @@ module EDParamsMod
real(r8),protected :: ED_val_profile_tol
real(r8),protected :: ED_val_ag_biomass
- character(len=20),parameter :: ED_name_grass_spread = "grass_spread"
- character(len=20),parameter :: ED_name_comp_excln = "comp_excln"
- character(len=20),parameter :: ED_name_stress_mort = "stress_mort"
- character(len=20),parameter :: ED_name_dispersal = "dispersal"
- character(len=20),parameter :: ED_name_grperc = "grperc"
- character(len=20),parameter :: ED_name_maxspread = "maxspread"
- character(len=20),parameter :: ED_name_minspread = "minspread"
- character(len=20),parameter :: ED_name_init_litter = "init_litter"
- character(len=20),parameter :: ED_name_nfires = "nfires"
- character(len=20),parameter :: ED_name_understorey_death = "understorey_death"
- character(len=20),parameter :: ED_name_profile_tol = "profile_tol"
- character(len=20),parameter :: ED_name_ag_biomass= "ag_biomass"
+ 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_understorey_death = "fates_understorey_death"
+ character(len=param_string_length),parameter :: ED_name_profile_tol = "fates_profile_tol"
+ character(len=param_string_length),parameter :: ED_name_ag_biomass= "fates_ag_biomass"
- public :: EDParamsRead
+ public :: FatesParamsInit
+ public :: FatesRegisterParams
+ public :: FatesReceiveParams
contains
!-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine EDParamsRead(ncid)
- !
- ! calls to initialize parameter instance and do ncdio read
- !
- use ncdio_pio , only : file_desc_t
-
- implicit none
+ subroutine FatesParamsInit()
+ ! Initialize all parameters to nan to ensure that we get valid
+ ! values back from the host.
+
+ use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ implicit none
- call EDParamsReadLocal(ncid)
+ 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
+ ED_val_nignitions = nan
+ ED_val_understorey_death = nan
+ ED_val_profile_tol = nan
+ ED_val_ag_biomass = nan
- end subroutine EDParamsRead
- !-----------------------------------------------------------------------
+ end subroutine FatesParamsInit
!-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine EDParamsReadLocal(ncid)
- !
- ! read the netcdf file and populate internalInstScalar
- !
- use ncdio_pio , only : file_desc_t
- use paramUtilMod , only : readNcdio
+ subroutine FatesRegisterParams(fates_params)
+ ! Register the parameters we want the host to provide, and
+ ! indicate whether they are fates parameters or host parameters
+ ! that need to be synced with host values.
- implicit none
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar1d, dimension_shape_1d
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ implicit none
- ! local vars
- character(len=32) :: subname = 'EDParamsReadLocal::'
+ class(fates_parameters_type), intent(inout) :: fates_params
- !
- ! call read function
- !
+ character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_scalar1d/)
+
+ call FatesParamsInit()
+
+ call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=ED_name_comp_excln, 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)
+
+ call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ 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)
+
+ call fates_params%RegisterParameter(name=ED_name_minspread, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=ED_name_init_litter, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ call fates_params%RegisterParameter(name=ED_name_nignitions, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ 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_profile_tol, 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)
+
+ end subroutine FatesRegisterParams
- call readNcdio(ncid = ncid, &
- varName=ED_name_grass_spread, &
- callingName=subname, &
- retVal=ED_val_grass_spread)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_comp_excln, &
- callingName=subname, &
- retVal=ED_val_comp_excln)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_stress_mort, &
- callingName=subname, &
- retVal=ED_val_stress_mort)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_dispersal, &
- callingName=subname, &
- retVal=ED_val_dispersal)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_grperc, &
- callingName=subname, &
- retVal=ED_val_grperc)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_maxspread, &
- callingName=subname, &
- retVal=ED_val_maxspread)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_minspread, &
- callingName=subname, &
- retVal=ED_val_minspread)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_init_litter, &
- callingName=subname, &
- retVal=ED_val_init_litter)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_nfires, &
- callingName=subname, &
- retVal=ED_val_nignitions)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_understorey_death, &
- callingName=subname, &
- retVal=ED_val_understorey_death)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_profile_tol, &
- callingName=subname, &
- retVal=ED_val_profile_tol)
-
- call readNcdio(ncid = ncid, &
- varName=ED_name_ag_biomass, &
- callingName=subname, &
- retVal=ED_val_ag_biomass)
- end subroutine EDParamsReadLocal
!-----------------------------------------------------------------------
+ subroutine FatesReceiveParams(fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call fates_params%RetreiveParameter(name=ED_name_grass_spread, &
+ data=ED_val_grass_spread)
+
+ call fates_params%RetreiveParameter(name=ED_name_comp_excln, &
+ data=ED_val_comp_excln)
+ call fates_params%RetreiveParameter(name=ED_name_grass_spread, &
+ data=ED_val_grass_spread)
+
+ call fates_params%RetreiveParameter(name=ED_name_comp_excln, &
+ data=ED_val_comp_excln)
+
+ 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)
+
+ call fates_params%RetreiveParameter(name=ED_name_minspread, &
+ data=ED_val_minspread)
+
+ call fates_params%RetreiveParameter(name=ED_name_init_litter, &
+ data=ED_val_init_litter)
+
+ call fates_params%RetreiveParameter(name=ED_name_nignitions, &
+ data=ED_val_nignitions)
+
+ call fates_params%RetreiveParameter(name=ED_name_understorey_death, &
+ data=ED_val_understorey_death)
+
+ call fates_params%RetreiveParameter(name=ED_name_profile_tol, &
+ data=ED_val_profile_tol)
+
+ call fates_params%RetreiveParameter(name=ED_name_ag_biomass, &
+ data=ED_val_ag_biomass)
+
+ end subroutine FatesReceiveParams
+
end module EDParamsMod
diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90
index 0961e71adb..b60586c8c1 100644
--- a/components/clm/src/ED/main/EDPftvarcon.F90
+++ b/components/clm/src/ED/main/EDPftvarcon.F90
@@ -6,138 +6,755 @@ 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
+ use FatesGlobals, only : fates_log
!
! !PUBLIC TYPES:
implicit none
save
private
+ integer, parameter, public :: lower_bound_pft = 0
+ integer, parameter, public :: lower_bound_general = 1
+
!ED specific variables.
type, public :: EDPftvarcon_type
- real(r8) :: max_dbh (0:mxpft) ! maximum dbh at which height growth ceases...
- real(r8) :: freezetol (0:mxpft) ! minimum temperature tolerance...
- real(r8) :: wood_density (0:mxpft) ! wood density g cm^-3 ...
- real(r8) :: alpha_stem (0:mxpft) ! live stem turnover rate. y-1
- real(r8) :: hgt_min (0:mxpft) ! sapling height m
- real(r8) :: cushion (0:mxpft) ! labile carbon storage target as multiple of leaf pool.
- real(r8) :: leaf_stor_priority (0:mxpft) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store).
- real(r8) :: leafwatermax (0:mxpft) ! degree to which respiration is limited by btran if btran = 0
- real(r8) :: rootresist (0:mxpft)
- real(r8) :: soilbeta (0:mxpft)
- real(r8) :: crown (0:mxpft)
- real(r8) :: bark_scaler (0:mxpft)
- real(r8) :: crown_kill (0:mxpft)
- real(r8) :: initd (0:mxpft)
- real(r8) :: sd_mort (0:mxpft)
- real(r8) :: seed_rain (0:mxpft)
- real(r8) :: BB_slope (0:mxpft)
- real(r8) :: root_long (0:mxpft) ! root longevity (yrs)
- real(r8) :: clone_alloc (0:mxpft) ! fraction of carbon balance allocated to clonal reproduction.
- 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), 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 :: 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 (:)
+ real(r8), allocatable :: bark_scaler (:)
+ real(r8), allocatable :: crown_kill (:)
+ real(r8), allocatable :: initd (:)
+ real(r8), allocatable :: sd_mort (:)
+ 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 :: dbh2h_m (:) ! allocation parameter m from dbh to height
+ 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(:)
+ real(r8), allocatable :: rootb_par(:)
+ real(r8), allocatable :: lf_flab(:)
+ real(r8), allocatable :: lf_fcel(:)
+ real(r8), allocatable :: lf_flig(:)
+ real(r8), allocatable :: fr_flab(:)
+ real(r8), allocatable :: fr_fcel(:)
+ real(r8), allocatable :: fr_flig(:)
+ real(r8), allocatable :: xl(:)
+ real(r8), allocatable :: c3psn(:)
+ real(r8), allocatable :: flnr(:)
+ real(r8), allocatable :: fnitr(:)
+ real(r8), allocatable :: leafcn(:)
+ 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 :: rhol(:, :)
+ real(r8), allocatable :: rhos(:, :)
+ real(r8), allocatable :: taul(:, :)
+ real(r8), allocatable :: taus(:, :)
+ real(r8), allocatable :: rootprof_beta(:, :)
+ contains
+ procedure, public :: Init => EDpftconInit
+ procedure, public :: Register
+ procedure, public :: Receive
+ procedure, private :: Register_PFT
+ procedure, private :: Receive_PFT
+ procedure, private :: Register_PFT_nvariants
+ procedure, private :: Receive_PFT_nvariants
+ procedure, private :: Register_PFT_numrad
+ procedure, private :: Receive_PFT_numrad
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
+
!-----------------------------------------------------------------------
contains
!-----------------------------------------------------------------------
- subroutine EDpftconrd( ncid )
- !
- ! !DESCRIPTION:
- ! Read and initialize vegetation (PFT) constants
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t, ncd_io
- use FatesGlobals, only : endrun => fates_endrun
- !
- ! !ARGUMENTS:
+ subroutine EDpftconInit(this)
+
+ use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
+
implicit none
- !
- type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id
- ! !LOCAL VARIABLES:
+ class(EDPftvarcon_type), intent(inout) :: this
+
+ end subroutine EDpftconInit
+
+ !-----------------------------------------------------------------------
+ subroutine Register(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type
+
+ implicit none
+
+ class(EDPftvarcon_type), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call this%Register_PFT(fates_params)
+ call this%Register_PFT_numrad(fates_params)
+ call this%Register_PFT_nvariants(fates_params)
+
+ end subroutine Register
+
+ !-----------------------------------------------------------------------
+ subroutine Receive(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type
+
+ implicit none
+
+ class(EDPftvarcon_type), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call this%Receive_PFT(fates_params)
+ call this%Receive_PFT_numrad(fates_params)
+ call this%Receive_PFT_nvariants(fates_params)
+
+ end subroutine Receive
+
+ !-----------------------------------------------------------------------
+ subroutine Register_PFT(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length
+ use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d
+
+ implicit none
+
+ class(EDPftvarcon_type), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/)
+
+ integer, parameter :: dim_lower_bound(1) = (/ lower_bound_pft /)
+
+ character(len=param_string_length) :: name
+
+ !X! name = ''
+ !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ !X! 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)
+
+ name = 'fates_freezetol'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_wood_density'
+ 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)
+
+ name = 'fates_cushion'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_leaf_stor_priority'
+ 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)
+
+ 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'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_bark_scaler'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_crown_kill'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_initd'
+ 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)
+
+ name = 'fates_BB_slope'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_root_long'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_clone_alloc'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_seed_alloc'
+ 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)
+
+ name = 'fates_stress_decid'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_season_decid'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_evergreen'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_froot_leaf'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_slatop'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_leaf_long'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_roota_par'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_rootb_par'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_lf_flab'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_lf_fcel'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_lf_flig'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_fr_flab'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_fr_fcel'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_fr_flig'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_xl'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_c3psn'
+ 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_fnitr'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_leafcn'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_frootcn'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_smpso'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_smpsc'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ name = 'fates_grperc'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+
+ end subroutine Register_PFT
+
+ !-----------------------------------------------------------------------
+ subroutine Receive_PFT(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, 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
- logical :: readv ! read variable in or not
- character(len=32) :: subname = 'EDpftconrd' ! subroutine name
+ !X! name = ''
+ !X! call fates_params%RetreiveParameter(name=name, &
+ !X! data=this%)
- call ncd_io('max_dbh',EDPftvarcon_inst%max_dbh, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_max_dbh'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%max_dbh)
- call ncd_io('freezetol',EDPftvarcon_inst%freezetol, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_freezetol'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%freezetol)
- call ncd_io('wood_density',EDPftvarcon_inst%wood_density, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_wood_density'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%wood_density)
- call ncd_io('alpha_stem',EDPftvarcon_inst%alpha_stem, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_alpha_stem'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%alpha_stem)
- call ncd_io('hgt_min',EDPftvarcon_inst%hgt_min, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_hgt_min'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%hgt_min)
- call ncd_io('cushion',EDPftvarcon_inst%cushion, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_cushion'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%cushion)
- call ncd_io('leaf_stor_priority',EDPftvarcon_inst%leaf_stor_priority, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_leaf_stor_priority'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%leaf_stor_priority)
- call ncd_io('leafwatermax',EDPftvarcon_inst%leafwatermax, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_leafwatermax'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%leafwatermax)
- call ncd_io('rootresist',EDPftvarcon_inst%rootresist,'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' )
+ name = 'fates_rootresist'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%rootresist)
- call ncd_io('soilbeta',EDPftvarcon_inst%soilbeta,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_soilbeta'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%soilbeta)
- call ncd_io('crown',EDPftvarcon_inst%crown,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_crown'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%crown)
- call ncd_io('bark_scaler',EDPftvarcon_inst%bark_scaler,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_bark_scaler'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%bark_scaler)
- call ncd_io('crown_kill',EDPftvarcon_inst%crown_kill,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_crown_kill'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%crown_kill)
- call ncd_io('initd',EDPftvarcon_inst%initd,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_initd'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%initd)
- call ncd_io('sd_mort',EDPftvarcon_inst%sd_mort,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_sd_mort'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%sd_mort)
- call ncd_io('seed_rain',EDPftvarcon_inst%seed_rain,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_seed_rain'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%seed_rain)
- call ncd_io('BB_slope',EDPftvarcon_inst%BB_slope,'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ name = 'fates_BB_slope'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%BB_slope)
+
+ name = 'fates_root_long'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%root_long)
+
+ name = 'fates_clone_alloc'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%clone_alloc)
+
+ name = 'fates_seed_alloc'
+ 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)
+
+ name = 'fates_stress_decid'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%stress_decid)
+
+ name = 'fates_season_decid'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%season_decid)
+
+ name = 'fates_evergreen'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%evergreen)
+
+ name = 'fates_froot_leaf'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%froot_leaf)
+
+ name = 'fates_slatop'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%slatop)
+
+ name = 'fates_leaf_long'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%leaf_long)
+
+ name = 'fates_roota_par'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%roota_par)
+
+ name = 'fates_rootb_par'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%rootb_par)
+
+ name = 'fates_lf_flab'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%lf_flab)
+
+ name = 'fates_lf_fcel'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%lf_fcel)
+
+ name = 'fates_lf_flig'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%lf_flig)
+
+ name = 'fates_fr_flab'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%fr_flab)
+
+ name = 'fates_fr_fcel'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%fr_fcel)
+
+ name = 'fates_fr_flig'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%fr_flig)
+
+ name = 'fates_xl'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%xl)
+
+ name = 'fates_c3psn'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%c3psn)
+
+ name = 'fates_flnr'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%flnr)
+
+ name = 'fates_fnitr'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%fnitr)
+
+ name = 'fates_leafcn'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%leafcn)
+
+ name = 'fates_frootcn'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%frootcn)
+
+ name = 'fates_smpso'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%smpso)
+
+ name = 'fates_smpsc'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%smpsc)
+
+ name = 'fates_grperc'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%grperc)
+
+ end subroutine Receive_PFT
+
+ !-----------------------------------------------------------------------
+ subroutine Register_PFT_numrad(this, fates_params)
+ ! NOTE(bja, 2017-02) these are 2-d parameters, but they are
+ ! currently stored in the parameter file as separate 1-d
+ ! arrays. We have to register the parameters as 1-d arrays as they
+ ! are on the parameter file. We store them as 2-d in the receive step.
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length
+ use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d
+
+ implicit none
+
+ class(EDPftvarcon_type), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/)
+ integer, parameter :: dim_lower_bound(1) = (/ lower_bound_pft /)
+ character(len=param_string_length) :: name
+
+ !X! name = ''
+ !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ !X! dimension_names=dim_names)
+
+ name = 'fates_rholvis'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ name = 'fates_rholnir'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ name = 'fates_rhosvis'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ name = 'fates_rhosnir'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ name = 'fates_taulvis'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ name = 'fates_taulnir'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ name = 'fates_tausvis'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+ name = 'fates_tausnir'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names)
+
+
+ end subroutine Register_PFT_numrad
+
+ !-----------------------------------------------------------------------
+ subroutine Receive_PFT_numrad(this, fates_params)
+ ! NOTE(bja, 2017-02) these are 2-d parameters, but they are
+ ! currently stored in the parameter file as separate 1-d arrays.
+ ! We can't allocate slices of arrays separately, so we have to
+ ! manually allocate the memory here, retreive into a dummy array,
+ ! and copy. All parameters in this subroutine are sized the same,
+ ! so we can reused the dummy array. If someone wants to cleanup
+ ! the input file, all this complexity can be removed.
+ use FatesParametersInterface, only : fates_parameters_type
+ use FatesParametersInterface, only : param_string_length, max_dimensions
+
+ implicit none
+
+ class(EDPftvarcon_type), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ character(len=param_string_length) :: name
+
+ !X! name = ''
+ !X! call fates_params%RetreiveParameter(name=name, &
+ !X! data=this%)
+
+ integer :: index
+ integer :: dimension_shape
+ integer :: dimension_sizes(max_dimensions)
+ character(len=param_string_length) :: dimension_names(max_dimensions)
+ logical :: is_host_param
+
+ integer :: lower_bound_1, upper_bound_1, lower_bound_2, upper_bound_2
+ real(r8), allocatable :: dummy_data(:)
+
+ ! Fetch metadata from a representative variable. All variables
+ ! called by this subroutine must be dimensioned the same way!
+ name = 'fates_rholvis'
+ index = fates_params%FindIndex(name)
+ call fates_params%GetMetaData(index, name, dimension_shape, dimension_sizes, dimension_names, is_host_param)
+ lower_bound_1 = lower_bound_pft
+ upper_bound_1 = lower_bound_pft + dimension_sizes(1) - 1
+ lower_bound_2 = lower_bound_general
+ upper_bound_2 = numrad
+
+ allocate(dummy_data(lower_bound_1:upper_bound_1))
+
+ !
+ ! received rhol data
+ !
+ allocate(this%rhol(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2))
+
+ name = 'fates_rholvis'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%rhol(lower_bound_1:upper_bound_1, ivis) = dummy_data
+
+ name = 'fates_rholnir'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%rhol(lower_bound_1:upper_bound_1, inir) = dummy_data
+
+ !
+ ! received rhos data
+ !
+ allocate(this%rhos(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2))
+
+ name = 'fates_rhosvis'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%rhos(lower_bound_1:upper_bound_1, ivis) = dummy_data
+
+ name = 'fates_rhosnir'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%rhos(lower_bound_1:upper_bound_1, inir) = dummy_data
+
+ !
+ ! received taul data
+ !
+ allocate(this%taul(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2))
+
+ name = 'fates_taulvis'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%taul(lower_bound_1:upper_bound_1, ivis) = dummy_data
+
+ name = 'fates_taulnir'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%taul(lower_bound_1:upper_bound_1, inir) = dummy_data
+
+ !
+ ! received taus data
+ !
+ allocate(this%taus(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2))
+
+ name = 'fates_tausvis'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%taus(lower_bound_1:upper_bound_1, ivis) = dummy_data
+
+ name = 'fates_tausnir'
+ call fates_params%RetreiveParameter(name=name, &
+ data=dummy_data)
+ this%taus(lower_bound_1:upper_bound_1, inir) = dummy_data
+
+ end subroutine Receive_PFT_numrad
+
+ !-----------------------------------------------------------------------
+ subroutine Register_PFT_nvariants(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length
+ use FatesParametersInterface, only : max_dimensions, dimension_name_variants, 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_variants
+
+ !X! name = ''
+ !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, &
+ !X! dimension_names=dim_names)
+
+ name = 'fates_rootprof_beta'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, &
+ dimension_names=dim_names, lower_bounds=dim_lower_bound)
+
+ end subroutine Register_PFT_nvariants
+
+ !-----------------------------------------------------------------------
+ subroutine Receive_PFT_nvariants(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type
+ use FatesParametersInterface, only : param_string_length
+
+ implicit none
- call ncd_io('root_long',EDPftvarcon_inst%root_long, 'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ class(EDPftvarcon_type), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
- call ncd_io('seed_alloc',EDPftvarcon_inst%seed_alloc, 'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ character(len=param_string_length) :: name
- call ncd_io('clone_alloc',EDPftvarcon_inst%clone_alloc, 'read', ncid, readvar=readv)
- if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data')
+ !X! name = ''
+ !X! call fates_params%RetreiveParameter(name=name, &
+ !X! data=this%)
- 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')
-
-! 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')
+ name = 'fates_rootprof_beta'
+ call fates_params%RetreiveParameterAllocate(name=name, &
+ data=this%rootprof_beta)
- end subroutine EDpftconrd
+ end subroutine Receive_PFT_nvariants
end module EDPftvarcon
diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90
index 5b6a5e8d77..c69e3bbe87 100755
--- a/components/clm/src/ED/main/EDTypesMod.F90
+++ b/components/clm/src/ED/main/EDTypesMod.F90
@@ -10,7 +10,10 @@ module EDTypesMod
integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site
integer, parameter :: maxCohortsPerPatch = 160 ! maximum number of cohorts to live on a patch
integer, parameter :: nclmax = 2 ! Maximum number of canopy layers
- integer, parameter :: nlevcan = 40 ! number of leaf layers in canopy layer
+ 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 :: maxpft = 10 ! maximum number of PFTs allowed
! the parameter file may determine that fewer
! are used, but this helps allocate scratch
@@ -35,6 +38,8 @@ module EDTypesMod
! MODEL PARAMETERS
real(r8), parameter :: AREA = 10000.0_r8 ! Notional area of simulated forest m2
+ real(r8), parameter :: AREA_INV = 1.0e-4_r8 ! Inverse of the notion area (faster math)
+
integer, parameter :: numWaterMem = 10 ! watermemory saved as site level var
! BIOLOGY/BIOGEOCHEMISTRY
@@ -45,10 +50,8 @@ module EDTypesMod
! SPITFIRE
- integer , parameter :: NLSC = 6 ! number carbon compartments in above ground litter array
- integer , parameter :: NFSC = 6 ! number fuel size classes
- integer , parameter :: N_EF = 7 ! number of emission factors. One per trace gas or aerosol species.
integer, parameter :: NCWD = 4 ! number of coarse woody debris pools
+ integer , parameter :: NFSC = NCWD+2 ! number fuel size classes (really this is a mix of cwd size classes, leaf litter, and grass types)
integer, parameter :: lg_sf = 6 ! array index of live grass pool for spitfire
integer, parameter :: dl_sf = 1 ! array index of dead leaf pool for spitfire (dead grass and dead leaves)
integer, parameter :: tr_sf = 5 ! array index of dead trunk pool for spitfire
@@ -105,16 +108,30 @@ module EDTypesMod
(/"background","hydraulic ","carbon ","impact ","fire "/)
+ ! -------------------------------------------------------------------------------------
! These vectors are used for history output mapping
- real(r8) ,allocatable :: levsclass_ed(:) ! The lower bound on size classes for ED trees. This
- ! is used really for IO into the
- ! history tapes. It gets copied from
- ! the parameter array sclass_ed.
- integer , allocatable :: pft_levscpf_ed(:)
- integer , allocatable :: scls_levscpf_ed(:)
- real(r8), allocatable :: levage_ed(:)
- integer , allocatable :: levpft_ed(:)
-
+ ! 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 **
@@ -204,8 +221,8 @@ module EDTypesMod
real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/year
real(r8) :: npp_store ! NPP into storage: KgC/indiv/year
- real(r8) :: ts_net_uptake(nlevcan) ! Net uptake of leaf layers: kgC/m2/s
- real(r8) :: year_net_uptake(nlevcan) ! Net uptake of leaf layers: kgC/m2/year
+ real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/s
+ real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year
! RESPIRATION COMPONENTS
real(r8) :: rdark ! Dark respiration: kgC/indiv/s
@@ -293,33 +310,33 @@ module EDTypesMod
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) :: tlai_profile(nclmax,numpft_ed,nlevcan) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2
- real(r8) :: elai_profile(nclmax,numpft_ed,nlevcan) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2
- real(r8) :: tsai_profile(nclmax,numpft_ed,nlevcan) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2
- real(r8) :: esai_profile(nclmax,numpft_ed,nlevcan) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2
- real(r8) :: layer_height_profile(nclmax,numpft_ed,nlevcan)
- real(r8) :: canopy_area_profile(nclmax,numpft_ed,nlevcan) ! fraction of canopy in each canopy
+ 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
+ real(r8) :: tsai_profile(nclmax,numpft_ed,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2
+ real(r8) :: esai_profile(nclmax,numpft_ed,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2
+ real(r8) :: layer_height_profile(nclmax,numpft_ed,nlevleaf)
+ real(r8) :: canopy_area_profile(nclmax,numpft_ed,nlevleaf) ! fraction of canopy in each canopy
! layer, pft, and leaf layer:-
integer :: present(nclmax,numpft_ed) ! is there any of this pft in this canopy layer?
integer :: nrad(nclmax,numpft_ed) ! number of exposed leaf layers for each canopy layer and pft
integer :: ncan(nclmax,numpft_ed) ! number of total leaf layers for each canopy layer and pft
!RADIATION FLUXES
- real(r8) :: fabd_sun_z(nclmax,numpft_ed,nlevcan) ! sun fraction of direct light absorbed by each canopy
+ real(r8) :: fabd_sun_z(nclmax,numpft_ed,nlevleaf) ! sun fraction of direct light absorbed by each canopy
! layer, pft, and leaf layer:-
- real(r8) :: fabd_sha_z(nclmax,numpft_ed,nlevcan) ! shade fraction of direct light absorbed by each canopy
+ real(r8) :: fabd_sha_z(nclmax,numpft_ed,nlevleaf) ! shade fraction of direct light absorbed by each canopy
! layer, pft, and leaf layer:-
- real(r8) :: fabi_sun_z(nclmax,numpft_ed,nlevcan) ! sun fraction of indirect light absorbed by each canopy
+ real(r8) :: fabi_sun_z(nclmax,numpft_ed,nlevleaf) ! sun fraction of indirect light absorbed by each canopy
! layer, pft, and leaf layer:-
- real(r8) :: fabi_sha_z(nclmax,numpft_ed,nlevcan) ! shade fraction of indirect light absorbed by each canopy
+ real(r8) :: fabi_sha_z(nclmax,numpft_ed,nlevleaf) ! shade fraction of indirect light absorbed by each canopy
! layer, pft, and leaf layer:-
- real(r8) :: ed_laisun_z(nclmax,numpft_ed,nlevcan) ! amount of LAI in the sun in each canopy layer,
+ real(r8) :: ed_laisun_z(nclmax,numpft_ed,nlevleaf) ! amount of LAI in the sun in each canopy layer,
! pft, and leaf layer. m2/m2
- real(r8) :: ed_laisha_z(nclmax,numpft_ed,nlevcan) ! amount of LAI in the shade in each canopy layer,
- real(r8) :: ed_parsun_z(nclmax,numpft_ed,nlevcan) ! PAR absorbed in the sun in each canopy layer,
- real(r8) :: ed_parsha_z(nclmax,numpft_ed,nlevcan) ! PAR absorbed in the shade in each canopy layer,
- real(r8) :: f_sun(nclmax,numpft_ed,nlevcan) ! fraction of leaves in the sun in each canopy layer, pft,
+ real(r8) :: ed_laisha_z(nclmax,numpft_ed,nlevleaf) ! amount of LAI in the shade in each canopy layer,
+ real(r8) :: ed_parsun_z(nclmax,numpft_ed,nlevleaf) ! PAR absorbed in the sun in each canopy layer,
+ real(r8) :: ed_parsha_z(nclmax,numpft_ed,nlevleaf) ! PAR absorbed in the shade in each canopy layer,
+ real(r8) :: f_sun(nclmax,numpft_ed,nlevleaf) ! fraction of leaves in the sun in each canopy layer, pft,
! and leaf layer. m2/m2
real(r8),allocatable :: tr_soil_dir(:) ! fraction of incoming direct radiation that (cm_numSWb)
@@ -342,7 +359,7 @@ module EDTypesMod
! PHOTOSYNTHESIS
- real(r8) :: psn_z(nclmax,numpft_ed,nlevcan) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s
+ real(r8) :: psn_z(nclmax,numpft_ed,nlevleaf) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s
! real(r8) :: gpp ! total patch gpp: KgC/m2/year
! real(r8) :: npp ! total patch npp: KgC/m2/year
@@ -381,15 +398,11 @@ module EDTypesMod
real(r8) :: dleaf_litter_dt(numpft_ed) ! rate of change of leaf litter in each size class: KgC/m2/year.
real(r8) :: droot_litter_dt(numpft_ed) ! rate of change of root litter in each size class: KgC/m2/year.
- real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/year
- real(r8) :: canopy_mortality_leaf_litter(numpft_ed) ! flux in to leaf litter from tree death: KgC/m2/year
- real(r8) :: canopy_mortality_root_litter(numpft_ed) ! flux in to froot litter from tree death: KgC/m2/year
-
real(r8) :: repro(numpft_ed) ! allocation to reproduction per PFT : KgC/m2
!FUEL CHARECTERISTICS
real(r8) :: sum_fuel ! total ground fuel related to ros (omits 1000hr fuels): KgC/m2
- real(r8) :: fuel_frac(ncwd+2) ! fraction of each litter class in the ros_fuel:-.
+ real(r8) :: fuel_frac(nfsc) ! fraction of each litter class in the ros_fuel:-.
real(r8) :: livegrass ! total aboveground grass biomass in patch. KgC/m2
real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel
! (incl. live grasses. omits 1000hr fuels). KgC/m3
@@ -399,7 +412,7 @@ module EDTypesMod
! of the ground fuel (incl. live grasses. omits 1000hr fuels).
real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel
! (incl. live grasses. omits 1000hr fuels)
- real(r8) :: litter_moisture(ncwd+2)
+ real(r8) :: litter_moisture(nfsc)
! FIRE SPREAD
real(r8) :: ros_front ! rate of forward spread of fire: m/min
@@ -504,7 +517,7 @@ module EDTypesMod
real(r8) :: cwd_ag_burned(ncwd)
real(r8) :: leaf_litter_burned(numpft_ed)
- ! TERMINATION, RECRUITMENT, AND DEMOTION
+ ! TERMINATION, RECRUITMENT, DEMOTION, and DISTURBANCE
real(r8) :: terminated_nindivs(1:nlevsclass_ed,1:mxpft,2) ! number of individuals that were in cohorts which were terminated this timestep, on size x pft x canopy array.
real(r8) :: termination_carbonflux(2) ! carbon flux from live to dead pools associated with termination mortality, per canopy level
real(r8) :: recruitment_rate(1:mxpft) ! number of individuals that were recruited into new cohorts
@@ -513,6 +526,12 @@ module EDTypesMod
real(r8) :: promotion_rate(1:nlevsclass_ed) ! rate of individuals promoted from understory to canopy per FATES timestep
real(r8) :: promotion_carbonflux ! biomass of promoted individuals from understory to canopy [kgC/ha/day]
+ ! some diagnostic-only (i.e. not resolved by ODE solver) flux of carbon to CWD and litter pools from termination and canopy mortality
+ real(r8) :: CWD_AG_diagnostic_input_carbonflux(1:ncwd) ! diagnostic flux to AG CWD [kg C / m2 / yr]
+ real(r8) :: CWD_BG_diagnostic_input_carbonflux(1:ncwd) ! diagnostic flux to BG CWD [kg C / m2 / yr]
+ real(r8) :: leaf_litter_diagnostic_input_carbonflux(1:mxpft) ! diagnostic flux to AG litter [kg C / m2 / yr]
+ real(r8) :: root_litter_diagnostic_input_carbonflux(1:mxpft) ! diagnostic flux to BG litter [kg C / m2 / yr]
+
end type ed_site_type
public :: ed_hist_scpfmaps
@@ -529,23 +548,54 @@ subroutine ed_hist_scpfmaps
integer :: i
integer :: isc
integer :: ipft
-
- allocate( levsclass_ed(1:nlevsclass_ed ))
- allocate( pft_levscpf_ed(1:nlevsclass_ed*mxpft))
- allocate(scls_levscpf_ed(1:nlevsclass_ed*mxpft))
- allocate( levpft_ed(1:mxpft ))
- allocate( levage_ed(1:nlevage_ed ))
+ 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*mxpft))
+ allocate( fates_hdim_scmap_levscpf(1:nlevsclass_ed*mxpft))
+ allocate( fates_hdim_levpft(1:mxpft ))
+ 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
- levsclass_ed(:) = sclass_ed(:)
+ fates_hdim_levsclass(:) = sclass_ed(:)
- levage_ed(:) = ageclass_ed(:)
+ fates_hdim_levage(:) = ageclass_ed(:)
! make pft array
do ipft=1,mxpft
- levpft_ed(ipft) = ipft
+ 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
@@ -553,13 +603,102 @@ subroutine ed_hist_scpfmaps
do ipft=1,mxpft
do isc=1,nlevsclass_ed
i=i+1
- pft_levscpf_ed(i) = ipft
- scls_levscpf_ed(i) = isc
+ 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 )
+
+ real(r8), intent(in) :: age
+
+ integer :: patch_age_class
+
+ patch_age_class = count(age-ageclass_ed.ge.0.0_r8)
+
+ end function get_age_class_index
+ ! =====================================================================================
+
+ function get_sizeage_class_index(dbh,age) result(size_by_age_class)
+
+ ! Arguments
+ real(r8),intent(in) :: dbh
+ real(r8),intent(in) :: age
+
+ integer :: size_class
+ integer :: age_class
+ integer :: size_by_age_class
+
+ size_class = get_size_class_index(dbh)
+
+ age_class = get_age_class_index(age)
+
+ size_by_age_class = (age_class-1)*nlevage_ed + size_class
+ end function get_sizeage_class_index
+
+ ! =====================================================================================
+
+ subroutine sizetype_class_index(dbh,pft,size_class,size_by_pft_class)
+
+ ! Arguments
+ real(r8),intent(in) :: dbh
+ integer,intent(in) :: pft
+ integer,intent(out) :: size_class
+ integer,intent(out) :: size_by_pft_class
+
+ size_class = get_size_class_index(dbh)
+
+ size_by_pft_class = (pft-1)*nlevsclass_ed+size_class
+
+ return
+ end subroutine sizetype_class_index
+
+ ! =====================================================================================
+
+ function get_size_class_index(dbh) result(cohort_size_class)
+
+ real(r8), intent(in) :: dbh
+
+ integer :: cohort_size_class
+
+ cohort_size_class = count(dbh-sclass_ed.ge.0.0_r8)
+
+ end function get_size_class_index
+
end module EDTypesMod
diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90
index 9a9896d206..414bc5ff0b 100644
--- a/components/clm/src/ED/main/FatesConstantsMod.F90
+++ b/components/clm/src/ED/main/FatesConstantsMod.F90
@@ -37,14 +37,27 @@ module FatesConstantsMod
! Conversion factor: micromoles per mole
real(fates_r8), parameter :: umol_per_mol = 1.0E6_fates_r8
-
+
+ ! Conversion factor: m2 per ha
+ real(fates_r8), parameter :: m2_per_ha = 1.0e4_fates_r8
+
+ ! Conversion factor :: ha per m2
+ real(fates_r8), parameter :: ha_per_m2 = 1.0e-4_fates_r8
! Conversion: seconds per minute
real(fates_r8), parameter :: sec_per_min = 60.0_fates_r8
! Conversion: seconds per day
real(fates_r8), parameter :: sec_per_day = 86400.0_fates_r8
+
+ ! Conversion: days per second
+ real(fates_r8), parameter :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8
+
+ ! Conversion: days per year. assume HLM uses 365 day calendar. If we need to link to 365.25-day-calendared HLM, rewire to pass through interface
+ real(fates_r8), parameter :: days_per_year = 365.00_fates_r8
+ ! Conversion: years per day. assume HLM uses 365 day calendar. If we need to link to 365.25-day-calendared HLM, rewire to pass through interface
+ real(fates_r8), parameter :: years_per_day = 1.0_fates_r8/365.00_fates_r8
! Physical constants
diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90
index d7aa01ec11..02e5ad51e9 100644
--- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90
+++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90
@@ -11,7 +11,14 @@ module FatesHistoryInterfaceMod
use FatesInterfaceMod, only : hlm_hio_ignore_val
! FIXME(bja, 2016-10) need to remove CLM dependancy
- use pftconMod , only : pftcon
+ use EDPftvarcon , only : EDPftvarcon_inst
+
+ 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
@@ -39,7 +46,7 @@ module FatesHistoryInterfaceMod
integer, private :: ih_fire_fuel_sav_pa
integer, private :: ih_fire_fuel_mef_pa
integer, private :: ih_sum_fuel_pa
- integer, private :: ih_litter_in_pa
+ integer, private :: ih_litter_in_si
integer, private :: ih_litter_out_pa
integer, private :: ih_efpot_pa ! NA
@@ -69,6 +76,9 @@ module FatesHistoryInterfaceMod
integer, private :: ih_canopy_biomass_pa
integer, private :: ih_understory_biomass_pa
+ ! Indices to site by size-class by pft variables
+ integer, private :: ih_nplant_si_scag
+
! Indices to (site) variables
integer, private :: ih_nep_si
integer, private :: ih_nep_timeintegrated_si
@@ -216,9 +226,50 @@ module FatesHistoryInterfaceMod
integer, private :: ih_ncl_si_age
integer, private :: ih_npatches_si_age
+ ! indices to (site x fuel class) variables
+ integer, private :: ih_litter_moisture_si_fuel
+
+ ! indices to (site x cwd size class) variables
+ integer, private :: ih_cwd_ag_si_cwdsc
+ integer, private :: ih_cwd_bg_si_cwdsc
+ integer, private :: ih_cwd_ag_in_si_cwdsc
+ integer, private :: ih_cwd_bg_in_si_cwdsc
+ integer, private :: ih_cwd_ag_out_si_cwdsc
+ integer, private :: ih_cwd_bg_out_si_cwdsc
+
+ ! indices to (site x [canopy layer x leaf layer]) variables
+ integer, private :: ih_parsun_z_si_cnlf
+ integer, private :: ih_parsha_z_si_cnlf
+ integer, private :: ih_laisun_z_si_cnlf
+ integer, private :: ih_laisha_z_si_cnlf
+ integer, private :: ih_fabd_sun_si_cnlf
+ integer, private :: ih_fabd_sha_si_cnlf
+ integer, private :: ih_fabi_sun_si_cnlf
+ integer, private :: ih_fabi_sha_si_cnlf
+
+ ! indices to (site x [canopy layer x leaf layer x pft]) variables
+ integer, private :: ih_parsun_z_si_cnlfpft
+ integer, private :: ih_parsha_z_si_cnlfpft
+ integer, private :: ih_laisun_z_si_cnlfpft
+ integer, private :: ih_laisha_z_si_cnlfpft
+ integer, private :: ih_fabd_sun_si_cnlfpft
+ integer, private :: ih_fabd_sha_si_cnlfpft
+ integer, private :: ih_fabi_sun_si_cnlfpft
+ integer, private :: ih_fabi_sha_si_cnlfpft
+
+ ! indices to (site x canopy layer) variables
+ integer, private :: ih_parsun_top_si_can
+ integer, private :: ih_parsha_top_si_can
+ integer, private :: ih_laisun_top_si_can
+ integer, private :: ih_laisha_top_si_can
+ integer, private :: ih_fabd_sun_top_si_can
+ integer, private :: ih_fabd_sha_top_si_can
+ integer, private :: ih_fabi_sun_top_si_can
+ integer, private :: ih_fabi_sha_top_si_can
+
! The number of variable dim/kind types we have defined (static)
- integer, parameter :: fates_history_num_dimensions = 7
- integer, parameter :: fates_history_num_dim_kinds = 9
+ integer, parameter :: fates_history_num_dimensions = 13
+ integer, parameter :: fates_history_num_dim_kinds = 15
@@ -253,6 +304,8 @@ module FatesHistoryInterfaceMod
integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_
integer, private :: levscls_index_, levpft_index_, levage_index_
+ integer, private :: levfuel_index_, levcwdsc_index_, levscag_index_
+ integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_
contains
procedure, public :: Init
@@ -273,6 +326,12 @@ module FatesHistoryInterfaceMod
procedure, public :: levscls_index
procedure, public :: levpft_index
procedure, public :: levage_index
+ procedure, public :: levfuel_index
+ procedure, public :: levcwdsc_index
+ procedure, public :: levcan_index
+ procedure, public :: levcnlf_index
+ procedure, public :: levcnlfpft_index
+ procedure, public :: levscag_index
! private work functions
procedure, private :: define_history_vars
@@ -288,6 +347,12 @@ module FatesHistoryInterfaceMod
procedure, private :: set_levscls_index
procedure, private :: set_levpft_index
procedure, private :: set_levage_index
+ procedure, private :: set_levfuel_index
+ procedure, private :: set_levcwdsc_index
+ procedure, private :: set_levcan_index
+ procedure, private :: set_levcnlf_index
+ procedure, private :: set_levcnlfpft_index
+ procedure, private :: set_levscag_index
end type fates_history_interface_type
@@ -301,6 +366,8 @@ subroutine Init(this, num_threads, fates_bounds)
use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf
use FatesIODimensionsMod, only : levscls, levpft, levage
+ use FatesIODimensionsMod, only : levfuel, levcwdsc, levscag
+ use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft
use FatesIODimensionsMod, only : fates_bounds_type
implicit none
@@ -345,6 +412,38 @@ subroutine Init(this, num_threads, fates_bounds)
call this%set_levage_index(dim_count)
call this%dim_bounds(dim_count)%Init(levage, num_threads, &
fates_bounds%age_class_begin, fates_bounds%age_class_end)
+
+ dim_count = dim_count + 1
+ call this%set_levfuel_index(dim_count)
+ call this%dim_bounds(dim_count)%Init(levfuel, num_threads, &
+ fates_bounds%fuel_begin, fates_bounds%fuel_end)
+
+ dim_count = dim_count + 1
+ call this%set_levcwdsc_index(dim_count)
+ call this%dim_bounds(dim_count)%Init(levcwdsc, num_threads, &
+ fates_bounds%cwdsc_begin, fates_bounds%cwdsc_end)
+
+ dim_count = dim_count + 1
+ call this%set_levcan_index(dim_count)
+ call this%dim_bounds(dim_count)%Init(levcan, num_threads, &
+ fates_bounds%can_begin, fates_bounds%can_end)
+
+ dim_count = dim_count + 1
+ call this%set_levcnlf_index(dim_count)
+ call this%dim_bounds(dim_count)%Init(levcnlf, num_threads, &
+ fates_bounds%cnlf_begin, fates_bounds%cnlf_end)
+
+ dim_count = dim_count + 1
+ call this%set_levcnlfpft_index(dim_count)
+ call this%dim_bounds(dim_count)%Init(levcnlfpft, num_threads, &
+ fates_bounds%cnlfpft_begin, fates_bounds%cnlfpft_end)
+
+ dim_count = dim_count + 1
+ call this%set_levscag_index(dim_count)
+ call this%dim_bounds(dim_count)%Init(levscag, num_threads, &
+ fates_bounds%sizeage_class_begin, fates_bounds%sizeage_class_end)
+
+
! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types)
! Allocate the mapping between FATES indices and the IO indices
@@ -394,6 +493,30 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds)
call this%dim_bounds(index)%SetThreadBounds(thread_index, &
thread_bounds%age_class_begin, thread_bounds%age_class_end)
+ index = this%levfuel_index()
+ call this%dim_bounds(index)%SetThreadBounds(thread_index, &
+ thread_bounds%fuel_begin, thread_bounds%fuel_end)
+
+ index = this%levcwdsc_index()
+ call this%dim_bounds(index)%SetThreadBounds(thread_index, &
+ thread_bounds%cwdsc_begin, thread_bounds%cwdsc_end)
+
+ index = this%levcan_index()
+ call this%dim_bounds(index)%SetThreadBounds(thread_index, &
+ thread_bounds%can_begin, thread_bounds%can_end)
+
+ index = this%levcnlf_index()
+ call this%dim_bounds(index)%SetThreadBounds(thread_index, &
+ thread_bounds%cnlf_begin, thread_bounds%cnlf_end)
+
+ index = this%levcnlfpft_index()
+ call this%dim_bounds(index)%SetThreadBounds(thread_index, &
+ thread_bounds%cnlfpft_begin, thread_bounds%cnlfpft_end)
+
+ index = this%levscag_index()
+ call this%dim_bounds(index)%SetThreadBounds(thread_index, &
+ thread_bounds%sizeage_class_begin, thread_bounds%sizeage_class_end)
+
end subroutine SetThreadBoundsEach
! ===================================================================================
@@ -402,6 +525,8 @@ subroutine assemble_history_output_types(this)
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 FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
+ use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
implicit none
@@ -434,6 +559,24 @@ subroutine assemble_history_output_types(this)
call this%set_dim_indices(site_age_r8, 1, this%column_index())
call this%set_dim_indices(site_age_r8, 2, this%levage_index())
+ call this%set_dim_indices(site_fuel_r8, 1, this%column_index())
+ call this%set_dim_indices(site_fuel_r8, 2, this%levfuel_index())
+
+ call this%set_dim_indices(site_cwdsc_r8, 1, this%column_index())
+ call this%set_dim_indices(site_cwdsc_r8, 2, this%levcwdsc_index())
+
+ call this%set_dim_indices(site_can_r8, 1, this%column_index())
+ call this%set_dim_indices(site_can_r8, 2, this%levcan_index())
+
+ call this%set_dim_indices(site_cnlf_r8, 1, this%column_index())
+ call this%set_dim_indices(site_cnlf_r8, 2, this%levcnlf_index())
+
+ call this%set_dim_indices(site_cnlfpft_r8, 1, this%column_index())
+ call this%set_dim_indices(site_cnlfpft_r8, 2, this%levcnlfpft_index())
+
+ call this%set_dim_indices(site_scag_r8, 1, this%column_index())
+ call this%set_dim_indices(site_scag_r8, 2, this%levscag_index())
+
end subroutine assemble_history_output_types
! ===================================================================================
@@ -575,8 +718,92 @@ integer function levage_index(this)
levage_index = this%levage_index_
end function levage_index
+ ! =======================================================================
+ subroutine set_levfuel_index(this, index)
+ implicit none
+ class(fates_history_interface_type), intent(inout) :: this
+ integer, intent(in) :: index
+ this%levfuel_index_ = index
+ end subroutine set_levfuel_index
+
+ integer function levfuel_index(this)
+ implicit none
+ class(fates_history_interface_type), intent(in) :: this
+ levfuel_index = this%levfuel_index_
+ end function levfuel_index
+
+ ! =======================================================================
+ subroutine set_levcwdsc_index(this, index)
+ implicit none
+ class(fates_history_interface_type), intent(inout) :: this
+ integer, intent(in) :: index
+ this%levcwdsc_index_ = index
+ end subroutine set_levcwdsc_index
+
+ integer function levcwdsc_index(this)
+ implicit none
+ class(fates_history_interface_type), intent(in) :: this
+ levcwdsc_index = this%levcwdsc_index_
+ end function levcwdsc_index
+
+ ! =======================================================================
+ subroutine set_levcan_index(this, index)
+ implicit none
+ class(fates_history_interface_type), intent(inout) :: this
+ integer, intent(in) :: index
+ this%levcan_index_ = index
+ end subroutine set_levcan_index
+
+ integer function levcan_index(this)
+ implicit none
+ class(fates_history_interface_type), intent(in) :: this
+ levcan_index = this%levcan_index_
+ end function levcan_index
+
+ ! =======================================================================
+ subroutine set_levcnlf_index(this, index)
+ implicit none
+ class(fates_history_interface_type), intent(inout) :: this
+ integer, intent(in) :: index
+ this%levcnlf_index_ = index
+ end subroutine set_levcnlf_index
+
+ integer function levcnlf_index(this)
+ implicit none
+ class(fates_history_interface_type), intent(in) :: this
+ levcnlf_index = this%levcnlf_index_
+ end function levcnlf_index
+
+ ! =======================================================================
+ subroutine set_levcnlfpft_index(this, index)
+ implicit none
+ class(fates_history_interface_type), intent(inout) :: this
+ integer, intent(in) :: index
+ this%levcnlfpft_index_ = index
+ end subroutine set_levcnlfpft_index
+
+ integer function levcnlfpft_index(this)
+ implicit none
+ class(fates_history_interface_type), intent(in) :: this
+ levcnlfpft_index = this%levcnlfpft_index_
+ end function levcnlfpft_index
+
+ ! ======================================================================================
+ subroutine set_levscag_index(this, index)
+ implicit none
+ class(fates_history_interface_type), intent(inout) :: this
+ integer, intent(in) :: index
+ this%levscag_index_ = index
+ end subroutine set_levscag_index
+
+ integer function levscag_index(this)
+ implicit none
+ class(fates_history_interface_type), intent(in) :: this
+ levscag_index = this%levscag_index_
+ end function levscag_index
! ======================================================================================
+
subroutine flush_hvars(this,nc,upfreq_in)
class(fates_history_interface_type) :: this
@@ -669,6 +896,8 @@ subroutine init_dim_kinds_maps(this)
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 FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
+ use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
implicit none
@@ -710,10 +939,34 @@ subroutine init_dim_kinds_maps(this)
index = index + 1
call this%dim_kinds(index)%Init(site_pft_r8, 2)
- ! site x patch-age clase
+ ! site x patch-age class
index = index + 1
call this%dim_kinds(index)%Init(site_age_r8, 2)
+ ! site x fuel size class
+ index = index + 1
+ call this%dim_kinds(index)%Init(site_fuel_r8, 2)
+
+ ! site x cwd size class
+ index = index + 1
+ call this%dim_kinds(index)%Init(site_cwdsc_r8, 2)
+
+ ! site x can class
+ index = index + 1
+ call this%dim_kinds(index)%Init(site_can_r8, 2)
+
+ ! site x cnlf class
+ index = index + 1
+ call this%dim_kinds(index)%Init(site_cnlf_r8, 2)
+
+ ! site x cnlfpft class
+ index = index + 1
+ call this%dim_kinds(index)%Init(site_cnlfpft_r8, 2)
+
+ ! site x size-class x age class
+ index = index + 1
+ call this%dim_kinds(index)%Init(site_scag_r8, 2)
+
! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds)
end subroutine init_dim_kinds_maps
@@ -786,13 +1039,17 @@ subroutine update_history_dyn(this,nc,nsites,sites)
ed_cohort_type, &
ed_patch_type, &
AREA, &
- sclass_ed, &
+ AREA_INV, &
nlevsclass_ed, &
- levage_ed, &
nlevage_ed, &
mxpft, &
- levpft_ed
- use EDParamsMod , only : ED_val_ag_biomass
+ nfsc, &
+ ncwd, &
+ ican_upper, &
+ ican_ustory
+
+ use EDParamsMod , only : ED_val_ag_biomass
+ use EDTypesMod , only : get_sizeage_class_index
! Arguments
class(fates_history_interface_type) :: this
@@ -811,7 +1068,9 @@ subroutine update_history_dyn(this,nc,nsites,sites)
integer :: ivar ! index of IO variable object vector
integer :: ft ! functional type index
integer :: i_scpf,i_pft,i_scls ! iterators for scpf, pft, and scls dims
-
+ integer :: i_cwd,i_fuel ! iterators for cwd and fuel dims
+ integer :: iscag ! size-class x age index
+
real(r8) :: n_density ! individual of cohort per m2.
real(r8) :: n_perm2 ! individuals per m2 for the whole column
real(r8) :: patch_scaling_scalar ! ratio of canopy to patch area for counteracting patch scaling
@@ -821,8 +1080,6 @@ subroutine update_history_dyn(this,nc,nsites,sites)
type(ed_patch_type),pointer :: cpatch
type(ed_cohort_type),pointer :: ccohort
- real(r8), parameter :: daysecs = 86400.0_r8 ! What modeler doesn't recognize 86400?
- real(r8), parameter :: yeardays = 365.0_r8 ! ALM/CLM do not use leap-years
real(r8), parameter :: tiny = 1.e-5_r8 ! some small number
associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, &
@@ -849,7 +1106,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
hio_fire_fuel_sav_pa => this%hvars(ih_fire_fuel_sav_pa)%r81d, &
hio_fire_fuel_mef_pa => this%hvars(ih_fire_fuel_mef_pa)%r81d, &
hio_sum_fuel_pa => this%hvars(ih_sum_fuel_pa)%r81d, &
- hio_litter_in_pa => this%hvars(ih_litter_in_pa)%r81d, &
+ hio_litter_in_si => this%hvars(ih_litter_in_si)%r81d, &
hio_litter_out_pa => this%hvars(ih_litter_out_pa)%r81d, &
hio_seed_bank_si => this%hvars(ih_seed_bank_si)%r81d, &
hio_seeds_in_pa => this%hvars(ih_seeds_in_pa)%r81d, &
@@ -934,13 +1191,21 @@ subroutine update_history_dyn(this,nc,nsites,sites)
hio_npp_bdead_understory_si_scls => this%hvars(ih_npp_bdead_understory_si_scls)%r82d, &
hio_npp_bseed_understory_si_scls => this%hvars(ih_npp_bseed_understory_si_scls)%r82d, &
hio_npp_store_understory_si_scls => this%hvars(ih_npp_store_understory_si_scls)%r82d, &
- hio_yesterdaycanopylevel_canopy_si_scls => this%hvars(ih_yesterdaycanopylevel_canopy_si_scls)%r82d, &
- hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, &
+ hio_yesterdaycanopylevel_canopy_si_scls => this%hvars(ih_yesterdaycanopylevel_canopy_si_scls)%r82d, &
+ hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, &
hio_area_si_age => this%hvars(ih_area_si_age)%r82d, &
hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, &
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_npatches_si_age => this%hvars(ih_npatches_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, &
+ hio_cwd_ag_in_si_cwdsc => this%hvars(ih_cwd_ag_in_si_cwdsc)%r82d, &
+ hio_cwd_bg_in_si_cwdsc => this%hvars(ih_cwd_bg_in_si_cwdsc)%r82d, &
+ hio_cwd_ag_out_si_cwdsc => this%hvars(ih_cwd_ag_out_si_cwdsc)%r82d, &
+ hio_cwd_bg_out_si_cwdsc => this%hvars(ih_cwd_bg_out_si_cwdsc)%r82d, &
+ hio_nplant_si_scag => this%hvars(ih_nplant_si_scag)%r82d)
! ---------------------------------------------------------------------------------
@@ -963,7 +1228,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
hio_trimming_pa(io_soipa) = 1.0_r8
! The seed bank is a site level variable
- hio_seed_bank_si(io_si) = sum(sites(s)%seed_bank) * 1.e3_r8
+ hio_seed_bank_si(io_si) = sum(sites(s)%seed_bank) * g_per_kg
ipa = 0
cpatch => sites(s)%oldest_patch
@@ -976,7 +1241,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
! Increment the fractional area in each age class bin
hio_area_si_age(io_si,cpatch%age_class) = hio_area_si_age(io_si,cpatch%age_class) &
- + cpatch%area/AREA
+ + cpatch%area * AREA_INV
! Increment some patch-age-resolved diagnostics
hio_lai_si_age(io_si,cpatch%age_class) = hio_lai_si_age(io_si,cpatch%age_class) &
@@ -1002,7 +1267,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
! for quantities that are natively at column level, calculate plant
! density using whole area
- n_perm2 = ccohort%n/AREA
+ n_perm2 = ccohort%n * AREA_INV
else
n_density = 0.0_r8
@@ -1025,27 +1290,27 @@ subroutine update_history_dyn(this,nc,nsites,sites)
end if
hio_canopy_area_si_age(io_si,cpatch%age_class) = hio_canopy_area_si_age(io_si,cpatch%age_class) &
- + ccohort%c_area/AREA
+ + ccohort%c_area * AREA_INV
! Update biomass components
- hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * 1.e3_r8
- hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * 1.e3_r8
- hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b * 1.e3_r8
- hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * ccohort%bdead * 1.e3_r8
- hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * ccohort%balive * 1.e3_r8
+ hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * g_per_kg
+ hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * g_per_kg
+ hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b * g_per_kg
+ hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * ccohort%bdead * g_per_kg
+ hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * ccohort%balive * g_per_kg
! Update PFT partitioned biomass components
hio_leafbiomass_si_pft(io_si,ft) = hio_leafbiomass_si_pft(io_si,ft) + &
- (ccohort%n / AREA) * ccohort%bl * 1.e3_r8
+ (ccohort%n * AREA_INV) * ccohort%bl * g_per_kg
hio_storebiomass_si_pft(io_si,ft) = hio_storebiomass_si_pft(io_si,ft) + &
- (ccohort%n / AREA) * ccohort%bstore * 1.e3_r8
+ (ccohort%n * AREA_INV) * ccohort%bstore * g_per_kg
hio_nindivs_si_pft(io_si,ft) = hio_nindivs_si_pft(io_si,ft) + &
- ccohort%n / AREA
+ ccohort%n * AREA_INV
hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + &
- (ccohort%n / AREA) * ccohort%b * 1.e3_r8
+ (ccohort%n * AREA_INV) * ccohort%b * g_per_kg
! Site by Size-Class x PFT (SCPF)
! ------------------------------------------------------------------------
@@ -1097,7 +1362,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*ccohort%n
hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*ccohort%n
@@ -1120,13 +1385,19 @@ subroutine update_history_dyn(this,nc,nsites,sites)
ccohort%ddbhdt*ccohort%n
end if
+ ! update size-class x patch-age related quantities
+
+ iscag = get_sizeage_class_index(ccohort%dbh,cpatch%age)
+
+ hio_nplant_si_scag(io_si,iscag) = hio_nplant_si_scag(io_si,iscag) + ccohort%n
+
! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities
if (ccohort%canopy_layer .eq. 1) then
hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + &
ccohort%bstore * ccohort%n
hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + &
ccohort%bl * ccohort%n
- hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8
+ hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg
hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ &
(ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n
hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + ccohort%n
@@ -1143,7 +1414,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
(ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n
hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + &
(ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * &
- ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays)
+ ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2
!
hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + &
ccohort%leaf_md * ccohort%n
@@ -1173,14 +1444,15 @@ subroutine update_history_dyn(this,nc,nsites,sites)
ccohort%npp_bseed * ccohort%n
hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + &
ccohort%npp_store * ccohort%n
- hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + &
+ hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = &
+ hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + &
ccohort%canopy_layer_yesterday * ccohort%n
else
hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + &
ccohort%bstore * ccohort%n
hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + &
ccohort%bl * ccohort%n
- hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8
+ hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg
hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ &
(ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n
hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n
@@ -1197,7 +1469,7 @@ subroutine update_history_dyn(this,nc,nsites,sites)
(ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n
hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + &
(ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * &
- ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays)
+ ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2
!
hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + &
ccohort%leaf_md * ccohort%n
@@ -1262,25 +1534,54 @@ subroutine update_history_dyn(this,nc,nsites,sites)
hio_fire_fuel_eff_moist_pa(io_pa) = cpatch%fuel_eff_moist
hio_fire_fuel_sav_pa(io_pa) = cpatch%fuel_sav
hio_fire_fuel_mef_pa(io_pa) = cpatch%fuel_mef
- hio_sum_fuel_pa(io_pa) = cpatch%sum_fuel * 1.e3_r8 * patch_scaling_scalar
+ hio_sum_fuel_pa(io_pa) = cpatch%sum_fuel * g_per_kg * patch_scaling_scalar
+ do i_fuel = 1,nfsc
+ hio_litter_moisture_si_fuel(io_si, i_fuel) = hio_litter_moisture_si_fuel(io_si, i_fuel) + &
+ cpatch%litter_moisture(i_fuel) * cpatch%area * AREA_INV
+ end do
+ !!! +++ cdk +++ commenting out the below changes to revert for bit-for-bit passing !!!
! Update Litter Flux Variables
- hio_litter_in_pa(io_pa) = (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in)) &
- * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar
+ ! ! put litter_in flux onto site level variable so as to be able to append site-level distubance-related input flux after patch loop
+ ! hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + &
+ ! (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in) + sum(cpatch%root_litter_in)) &
+ ! * 1.e3_r8 * cpatch%area / ( AREA * 365.0_r8 * sec_per_day )
+ ! ! keep litter_out at patch level
+ ! hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out) &
+ ! + sum(cpatch%root_litter_out)) &
+ ! * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * sec_per_day )
+ !!! --- cdk --- !!!
+ hio_litter_in_si(io_pa) = (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in)) &
+ * g_per_kg * days_per_year * sec_per_day * patch_scaling_scalar
hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out)) &
- * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar
+ * g_per_kg * days_per_year * sec_per_day * patch_scaling_scalar
+ !!! --- cdk --- !!!
hio_seeds_in_pa(io_pa) = sum(cpatch%seeds_in) * &
- 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar
- hio_seed_decay_pa(io_pa) = sum(cpatch%seed_decay) &
- * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar
- hio_seed_germination_pa(io_pa) = sum(cpatch%seed_germination) &
- * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar
+ g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec
+ hio_seed_decay_pa(io_pa) = sum(cpatch%seed_decay) * &
+ g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec
+ hio_seed_germination_pa(io_pa) = sum(cpatch%seed_germination) * &
+ g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec
hio_canopy_spread_pa(io_pa) = cpatch%spread(1)
-
+ do i_cwd = 1, ncwd
+ hio_cwd_ag_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_si_cwdsc(io_si, i_cwd) + &
+ cpatch%CWD_AG(i_cwd)*cpatch%area * AREA_INV * g_per_kg
+ hio_cwd_bg_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_si_cwdsc(io_si, i_cwd) + &
+ cpatch%CWD_BG(i_cwd)*cpatch%area * AREA_INV * g_per_kg
+ hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + &
+ cpatch%CWD_AG_IN(i_cwd)*cpatch%area * AREA_INV * g_per_kg
+ hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + &
+ cpatch%CWD_BG_IN(i_cwd)*cpatch%area * AREA_INV * g_per_kg
+ hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) + &
+ cpatch%CWD_AG_OUT(i_cwd)*cpatch%area * AREA_INV * g_per_kg
+ hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) + &
+ cpatch%CWD_BG_OUT(i_cwd)*cpatch%area * AREA_INV * g_per_kg
+ end do
+
ipa = ipa + 1
cpatch => cpatch%younger
end do !patch loop
@@ -1302,22 +1603,22 @@ subroutine update_history_dyn(this,nc,nsites,sites)
do i_scls = 1,nlevsclass_ed
i_scpf = (i_pft-1)*nlevsclass_ed + i_scls
hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%terminated_nindivs(i_scls,i_pft,1) + &
- sites(s)%terminated_nindivs(i_scls,i_pft,2)) * yeardays
+ sites(s)%terminated_nindivs(i_scls,i_pft,2)) * days_per_year
hio_mortality_canopy_si_scls(io_si,i_scls) = hio_mortality_canopy_si_scls(io_si,i_scls) + &
- sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays
+ sites(s)%terminated_nindivs(i_scls,i_pft,1) * days_per_year
hio_mortality_understory_si_scls(io_si,i_scls) = hio_mortality_understory_si_scls(io_si,i_scls) + &
- sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays
+ sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year
hio_mortality_canopy_si_scpf(io_si,i_scpf) = hio_mortality_canopy_si_scpf(io_si,i_scpf) + &
- sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays
+ sites(s)%terminated_nindivs(i_scls,i_pft,1) * days_per_year
hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf) + &
- sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays
+ sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year
end do
end do
sites(s)%terminated_nindivs(:,:,:) = 0._r8
! pass the recruitment rate as a flux to the history, and then reset the recruitment buffer
do i_pft = 1, mxpft
- hio_recruitment_si_pft(io_si,i_pft) = sites(s)%recruitment_rate(i_pft) * yeardays
+ hio_recruitment_si_pft(io_si,i_pft) = sites(s)%recruitment_rate(i_pft) * days_per_year
end do
sites(s)%recruitment_rate(:) = 0._r8
@@ -1337,22 +1638,40 @@ subroutine update_history_dyn(this,nc,nsites,sites)
! pass demotion rates and associated carbon fluxes to history
do i_scls = 1,nlevsclass_ed
- hio_demotion_rate_si_scls(io_si,i_scls) = sites(s)%demotion_rate(i_scls) * yeardays
- hio_promotion_rate_si_scls(io_si,i_scls) = sites(s)%promotion_rate(i_scls) * yeardays
+ hio_demotion_rate_si_scls(io_si,i_scls) = sites(s)%demotion_rate(i_scls) * days_per_year
+ hio_promotion_rate_si_scls(io_si,i_scls) = sites(s)%promotion_rate(i_scls) * days_per_year
end do
!
! convert kg C / ha / day to gc / m2 / sec
- hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * 1e3 / (1e4 * daysecs)
- hio_promotion_carbonflux_si(io_si) = sites(s)%promotion_carbonflux * 1e3 / (1e4 * daysecs)
+ hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * g_per_kg * ha_per_m2 * days_per_sec
+ hio_promotion_carbonflux_si(io_si) = sites(s)%promotion_carbonflux * g_per_kg * ha_per_m2 * days_per_sec
!
! mortality-associated carbon fluxes
+
hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + &
- sites(s)%termination_carbonflux(1) * 1e3 / (1e4 * daysecs)
+ sites(s)%termination_carbonflux(ican_upper) * g_per_kg * days_per_sec * ha_per_m2
hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + &
- sites(s)%termination_carbonflux(2) * 1e3 / (1e4 * daysecs)
+ sites(s)%termination_carbonflux(ican_ustory) * g_per_kg * days_per_sec * ha_per_m2
! and zero the site-level termination carbon flux variable
sites(s)%termination_carbonflux(:) = 0._r8
-
+ !
+ ! add the site-level disturbance-associated cwd and litter input fluxes to thir respective flux fields
+ do i_cwd = 1, ncwd
+ hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + &
+ sites(s)%CWD_AG_diagnostic_input_carbonflux(i_cwd) * g_per_kg
+ hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + &
+ sites(s)%CWD_BG_diagnostic_input_carbonflux(i_cwd) * g_per_kg
+ end do
+ !!! cdk comment out below line for bit-for-bitness
+ ! hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + &
+ ! (sum(sites(s)%leaf_litter_diagnostic_input_carbonflux) + &
+ ! sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * g_per_kg / ( sec_per_day * days_per_year )
+ ! and reset the disturbance-related field buffers
+ sites(s)%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8
+ sites(s)%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8
+ sites(s)%leaf_litter_diagnostic_input_carbonflux(:) = 0._r8
+ sites(s)%root_litter_diagnostic_input_carbonflux(:) = 0._r8
+
enddo ! site loop
end associate
@@ -1373,9 +1692,11 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep)
ed_cohort_type, &
ed_patch_type, &
AREA, &
+ AREA_INV, &
nlevage_ed, &
- sclass_ed, &
nlevsclass_ed
+ use EDTypesMod, only : numpft_ed, nclmax, nlevleaf
+ !
! Arguments
class(fates_history_interface_type) :: this
integer , intent(in) :: nc ! clump index
@@ -1398,14 +1719,12 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep)
real(r8) :: patch_area_by_age(nlevage_ed) ! patch area in each bin for normalizing purposes
real(r8), parameter :: tiny = 1.e-5_r8 ! some small number
integer :: ipa2 ! patch incrementer
-
+ integer :: cnlfpft_indx, cnlf_indx, ipft, ican, ileaf ! more iterators and indices
type(fates_history_variable_type),pointer :: hvar
type(ed_patch_type),pointer :: cpatch
type(ed_cohort_type),pointer :: ccohort
+ real(r8) :: per_dt_tstep ! Time step in frequency units (/s)
- 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?
-
associate( hio_gpp_pa => this%hvars(ih_gpp_pa)%r81d, &
hio_npp_pa => this%hvars(ih_npp_pa)%r81d, &
hio_aresp_pa => this%hvars(ih_aresp_pa)%r81d, &
@@ -1436,13 +1755,39 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep)
hio_resp_g_understory_si_scls => this%hvars(ih_resp_g_understory_si_scls)%r82d, &
hio_resp_m_understory_si_scls => this%hvars(ih_resp_m_understory_si_scls)%r82d, &
hio_gpp_si_age => this%hvars(ih_gpp_si_age)%r82d, &
- hio_npp_si_age => this%hvars(ih_npp_si_age)%r82d &
+ hio_npp_si_age => this%hvars(ih_npp_si_age)%r82d, &
+ hio_parsun_z_si_cnlf => this%hvars(ih_parsun_z_si_cnlf)%r82d, &
+ hio_parsha_z_si_cnlf => this%hvars(ih_parsha_z_si_cnlf)%r82d, &
+ hio_parsun_z_si_cnlfpft => this%hvars(ih_parsun_z_si_cnlfpft)%r82d, &
+ hio_parsha_z_si_cnlfpft => this%hvars(ih_parsha_z_si_cnlfpft)%r82d, &
+ hio_laisun_z_si_cnlf => this%hvars(ih_laisun_z_si_cnlf)%r82d, &
+ hio_laisha_z_si_cnlf => this%hvars(ih_laisha_z_si_cnlf)%r82d, &
+ hio_laisun_z_si_cnlfpft => this%hvars(ih_laisun_z_si_cnlfpft)%r82d, &
+ hio_laisha_z_si_cnlfpft => this%hvars(ih_laisha_z_si_cnlfpft)%r82d, &
+ hio_laisun_top_si_can => this%hvars(ih_laisun_top_si_can)%r82d, &
+ hio_laisha_top_si_can => this%hvars(ih_laisha_top_si_can)%r82d, &
+ hio_fabd_sun_si_cnlfpft => this%hvars(ih_fabd_sun_si_cnlfpft)%r82d, &
+ hio_fabd_sha_si_cnlfpft => this%hvars(ih_fabd_sha_si_cnlfpft)%r82d, &
+ hio_fabi_sun_si_cnlfpft => this%hvars(ih_fabi_sun_si_cnlfpft)%r82d, &
+ hio_fabi_sha_si_cnlfpft => this%hvars(ih_fabi_sha_si_cnlfpft)%r82d, &
+ hio_fabd_sun_si_cnlf => this%hvars(ih_fabd_sun_si_cnlf)%r82d, &
+ hio_fabd_sha_si_cnlf => this%hvars(ih_fabd_sha_si_cnlf)%r82d, &
+ hio_fabi_sun_si_cnlf => this%hvars(ih_fabi_sun_si_cnlf)%r82d, &
+ hio_fabi_sha_si_cnlf => this%hvars(ih_fabi_sha_si_cnlf)%r82d, &
+ hio_fabd_sun_top_si_can => this%hvars(ih_fabd_sun_top_si_can)%r82d, &
+ hio_fabd_sha_top_si_can => this%hvars(ih_fabd_sha_top_si_can)%r82d, &
+ hio_fabi_sun_top_si_can => this%hvars(ih_fabi_sun_top_si_can)%r82d, &
+ hio_fabi_sha_top_si_can => this%hvars(ih_fabi_sha_top_si_can)%r82d, &
+ hio_parsun_top_si_can => this%hvars(ih_parsun_top_si_can)%r82d, &
+ hio_parsha_top_si_can => this%hvars(ih_parsha_top_si_can)%r82d &
)
! Flush the relevant history variables
call this%flush_hvars(nc,upfreq_in=2)
+ per_dt_tstep = 1.0_r8/dt_tstep
+
do s = 1,nsites
io_si = this%iovar_map(nc)%site_index(s)
@@ -1466,7 +1811,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep)
! TODO: we need a standardized logical function on this (used lots, RGK)
if ((cpatch%area .gt. 0._r8) .and. (cpatch%total_canopy_area .gt. 0._r8)) then
n_density = ccohort%n/min(cpatch%area,cpatch%total_canopy_area)
- n_perm2 = ccohort%n/AREA
+ n_perm2 = ccohort%n * AREA_INV
else
n_density = 0.0_r8
n_perm2 = 0.0_r8
@@ -1480,98 +1825,173 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep)
! scale up cohort fluxes to their patches
hio_npp_pa(io_pa) = hio_npp_pa(io_pa) + &
- ccohort%npp_tstep * 1.e3_r8 * n_density / dt_tstep
+ ccohort%npp_tstep * g_per_kg * n_density * per_dt_tstep
hio_gpp_pa(io_pa) = hio_gpp_pa(io_pa) + &
- ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep
+ ccohort%gpp_tstep * g_per_kg * n_density * per_dt_tstep
hio_aresp_pa(io_pa) = hio_aresp_pa(io_pa) + &
- ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep
+ ccohort%resp_tstep * g_per_kg * n_density * per_dt_tstep
hio_growth_resp_pa(io_pa) = hio_growth_resp_pa(io_pa) + &
- ccohort%resp_g * 1.e3_r8 * n_density / dt_tstep
+ ccohort%resp_g * g_per_kg * n_density * per_dt_tstep
hio_maint_resp_pa(io_pa) = hio_maint_resp_pa(io_pa) + &
- ccohort%resp_m * 1.e3_r8 * n_density / dt_tstep
+ ccohort%resp_m * g_per_kg * n_density * per_dt_tstep
! map ed cohort-level npp fluxes to clm column fluxes
- hio_npp_si(io_si) = hio_npp_si(io_si) + ccohort%npp_tstep * n_perm2 * 1.e3_r8 /dt_tstep
+ hio_npp_si(io_si) = hio_npp_si(io_si) + ccohort%npp_tstep * n_perm2 * g_per_kg * per_dt_tstep
! Total AR (kgC/m2/yr) = (kgC/plant/step) / (s/step) * (plant/m2) * (s/yr)
hio_ar_si_scpf(io_si,scpf) = hio_ar_si_scpf(io_si,scpf) + &
- (ccohort%resp_tstep/dt_tstep) * n_perm2 * daysecs * yeardays
+ (ccohort%resp_tstep/dt_tstep) * n_perm2 * sec_per_day * days_per_year
! Growth AR (kgC/m2/yr)
hio_ar_grow_si_scpf(io_si,scpf) = hio_ar_grow_si_scpf(io_si,scpf) + &
- (ccohort%resp_g/dt_tstep) * n_perm2 * daysecs * yeardays
+ (ccohort%resp_g/dt_tstep) * n_perm2 * sec_per_day * days_per_year
! Maint AR (kgC/m2/yr)
hio_ar_maint_si_scpf(io_si,scpf) = hio_ar_maint_si_scpf(io_si,scpf) + &
- (ccohort%resp_m/dt_tstep) * n_perm2 * daysecs * yeardays
+ (ccohort%resp_m/dt_tstep) * n_perm2 * sec_per_day * days_per_year
! Maintenance AR partition variables are stored as rates (kgC/plant/s)
! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr)
hio_ar_agsapm_si_scpf(io_si,scpf) = hio_ar_agsapm_si_scpf(io_si,scpf) + &
- ccohort%livestem_mr * n_perm2 * daysecs * yeardays
+ ccohort%livestem_mr * n_perm2 * sec_per_day * days_per_year
! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr)
hio_ar_darkm_si_scpf(io_si,scpf) = hio_ar_darkm_si_scpf(io_si,scpf) + &
- ccohort%rdark * n_perm2 * daysecs * yeardays
+ ccohort%rdark * n_perm2 * sec_per_day * days_per_year
! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr)
hio_ar_crootm_si_scpf(io_si,scpf) = hio_ar_crootm_si_scpf(io_si,scpf) + &
- ccohort%livecroot_mr * n_perm2 * daysecs * yeardays
+ ccohort%livecroot_mr * n_perm2 * sec_per_day * days_per_year
! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr)
hio_ar_frootm_si_scpf(io_si,scpf) = hio_ar_frootm_si_scpf(io_si,scpf) + &
- ccohort%froot_mr * n_perm2 * daysecs * yeardays
+ ccohort%froot_mr * n_perm2 * sec_per_day * days_per_year
! accumulate fluxes per patch age bin
hio_gpp_si_age(io_si,cpatch%age_class) = hio_gpp_si_age(io_si,cpatch%age_class) &
- + ccohort%gpp_tstep * ccohort%n * 1.e3_r8 / dt_tstep
+ + ccohort%gpp_tstep * ccohort%n * g_per_kg * per_dt_tstep
hio_npp_si_age(io_si,cpatch%age_class) = hio_npp_si_age(io_si,cpatch%age_class) &
- + ccohort%npp_tstep * ccohort%n * 1.e3_r8 / dt_tstep
+ + ccohort%npp_tstep * ccohort%n * g_per_kg * per_dt_tstep
! accumulate fluxes on canopy- and understory- separated fluxes
if (ccohort%canopy_layer .eq. 1) then
hio_gpp_canopy_pa(io_pa) = hio_gpp_canopy_pa(io_pa) + &
- ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep
+ ccohort%gpp_tstep * g_per_kg * n_density * per_dt_tstep
hio_ar_canopy_pa(io_pa) = hio_ar_canopy_pa(io_pa) + &
- ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep
+ ccohort%resp_tstep * g_per_kg * n_density * per_dt_tstep
!
hio_rdark_canopy_si_scls(io_si,scls) = hio_rdark_canopy_si_scls(io_si,scls) + &
- ccohort%rdark * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%rdark * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_livestem_mr_canopy_si_scls(io_si,scls) = hio_livestem_mr_canopy_si_scls(io_si,scls) + &
- ccohort%livestem_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%livestem_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_livecroot_mr_canopy_si_scls(io_si,scls) = hio_livecroot_mr_canopy_si_scls(io_si,scls) + &
- ccohort%livecroot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%livecroot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_froot_mr_canopy_si_scls(io_si,scls) = hio_froot_mr_canopy_si_scls(io_si,scls) + &
- ccohort%froot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%froot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_resp_g_canopy_si_scls(io_si,scls) = hio_resp_g_canopy_si_scls(io_si,scls) + &
- ccohort%resp_g * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep
+ ccohort%resp_g * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep
hio_resp_m_canopy_si_scls(io_si,scls) = hio_resp_m_canopy_si_scls(io_si,scls) + &
- ccohort%resp_m * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep
+ ccohort%resp_m * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep
else
hio_gpp_understory_pa(io_pa) = hio_gpp_understory_pa(io_pa) + &
- ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep
+ ccohort%gpp_tstep * g_per_kg * n_density * per_dt_tstep
hio_ar_understory_pa(io_pa) = hio_ar_understory_pa(io_pa) + &
- ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep
+ ccohort%resp_tstep * g_per_kg * n_density * per_dt_tstep
!
hio_rdark_understory_si_scls(io_si,scls) = hio_rdark_understory_si_scls(io_si,scls) + &
- ccohort%rdark * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%rdark * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_livestem_mr_understory_si_scls(io_si,scls) = hio_livestem_mr_understory_si_scls(io_si,scls) + &
- ccohort%livestem_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%livestem_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_livecroot_mr_understory_si_scls(io_si,scls) = hio_livecroot_mr_understory_si_scls(io_si,scls) + &
- ccohort%livecroot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%livecroot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_froot_mr_understory_si_scls(io_si,scls) = hio_froot_mr_understory_si_scls(io_si,scls) + &
- ccohort%froot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays
+ ccohort%froot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year
hio_resp_g_understory_si_scls(io_si,scls) = hio_resp_g_understory_si_scls(io_si,scls) + &
- ccohort%resp_g * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep
+ ccohort%resp_g * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep
hio_resp_m_understory_si_scls(io_si,scls) = hio_resp_m_understory_si_scls(io_si,scls) + &
- ccohort%resp_m * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep
+ ccohort%resp_m * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep
endif
end associate
endif
ccohort => ccohort%taller
enddo ! cohort loop
+
+ ! summarize radiation profiles through the canopy
+ do ipft=1,numpft_ed
+ do ican=1,nclmax
+ do ileaf=1,nlevleaf
+ ! calculate where we are on multiplexed dimensions
+ cnlfpft_indx = ileaf + (ican-1) * nlevleaf + (ipft-1) * nlevleaf * nclmax
+ cnlf_indx = ileaf + (ican-1) * nlevleaf
+ !
+ ! first do all the canopy x leaf x pft calculations
+ hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ !
+ hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ !
+ hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) + &
+ cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ !
+ ! summarize across all PFTs
+ hio_parsun_z_si_cnlf(io_si,cnlf_indx) = hio_parsun_z_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_parsha_z_si_cnlf(io_si,cnlf_indx) = hio_parsha_z_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ !
+ hio_laisun_z_si_cnlf(io_si,cnlf_indx) = hio_laisun_z_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_laisha_z_si_cnlf(io_si,cnlf_indx) = hio_laisha_z_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ !
+ hio_fabd_sun_si_cnlf(io_si,cnlf_indx) = hio_fabd_sun_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_fabd_sha_si_cnlf(io_si,cnlf_indx) = hio_fabd_sha_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_fabi_sun_si_cnlf(io_si,cnlf_indx) = hio_fabi_sun_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+ hio_fabi_sha_si_cnlf(io_si,cnlf_indx) = hio_fabi_sha_si_cnlf(io_si,cnlf_indx) + &
+ cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV
+
+ end do
+ !
+ ! summarize just the top leaf level across all PFTs, for each canopy level
+ hio_parsun_top_si_can(io_si,ican) = hio_parsun_top_si_can(io_si,ican) + &
+ cpatch%ed_parsun_z(ican,ipft,1) * cpatch%area * AREA_INV
+ hio_parsha_top_si_can(io_si,ican) = hio_parsha_top_si_can(io_si,ican) + &
+ cpatch%ed_parsha_z(ican,ipft,1) * cpatch%area * AREA_INV
+ !
+ hio_laisun_top_si_can(io_si,ican) = hio_laisun_top_si_can(io_si,ican) + &
+ cpatch%ed_laisun_z(ican,ipft,1) * cpatch%area * AREA_INV
+ hio_laisha_top_si_can(io_si,ican) = hio_laisha_top_si_can(io_si,ican) + &
+ cpatch%ed_laisha_z(ican,ipft,1) * cpatch%area * AREA_INV
+ !
+ hio_fabd_sun_top_si_can(io_si,ican) = hio_fabd_sun_top_si_can(io_si,ican) + &
+ cpatch%fabd_sun_z(ican,ipft,1) * cpatch%area * AREA_INV
+ hio_fabd_sha_top_si_can(io_si,ican) = hio_fabd_sha_top_si_can(io_si,ican) + &
+ cpatch%fabd_sha_z(ican,ipft,1) * cpatch%area * AREA_INV
+ hio_fabi_sun_top_si_can(io_si,ican) = hio_fabi_sun_top_si_can(io_si,ican) + &
+ cpatch%fabi_sun_z(ican,ipft,1) * cpatch%area * AREA_INV
+ hio_fabi_sha_top_si_can(io_si,ican) = hio_fabi_sha_top_si_can(io_si,ican) + &
+ cpatch%fabi_sha_z(ican,ipft,1) * cpatch%area * AREA_INV
+ !
+ end do
+ end do
+
+
ipa = ipa + 1
cpatch => cpatch%younger
end do !patch loop
@@ -1657,6 +2077,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 FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
+ use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
implicit none
class(fates_history_interface_type), intent(inout) :: this
@@ -1819,15 +2241,21 @@ subroutine define_history_vars(this, initialize_variables)
avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, &
ivar=ivar, initialize=initialize_variables, index = ih_sum_fuel_pa )
+ call this%set_history_var(vname='FUEL_MOISTURE_NFSC', units='-', &
+ long='spitfire size-resolved fuel moisture', use_default='active', &
+ avgflag='A', vtype=site_fuel_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, &
+ ivar=ivar, initialize=initialize_variables, index = ih_litter_moisture_si_fuel )
+
! Litter Variables
call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', &
- long='Litter flux in leaves', use_default='active', &
+ long='FATES litter flux in', use_default='active', &
avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, &
- ivar=ivar, initialize=initialize_variables, index = ih_litter_in_pa )
+ !!! cdk reverted to pass bit-for-bitness avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, &
+ ivar=ivar, initialize=initialize_variables, index = ih_litter_in_si )
call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', &
- long='Litter flux out leaves', use_default='active', &
+ long='FATES litter flux out', use_default='active', &
avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, &
ivar=ivar, initialize=initialize_variables, index = ih_litter_out_pa )
@@ -1922,12 +2350,12 @@ subroutine define_history_vars(this, initialize_variables)
! fast fluxes by age bin
call this%set_history_var(vname='NPP_BY_AGE', units='gC/m^2/s', &
- long='net primary productivity by age bin', use_default='active', &
+ long='net primary productivity by age bin', use_default='inactive', &
avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
ivar=ivar, initialize=initialize_variables, index = ih_npp_si_age )
call this%set_history_var(vname='GPP_BY_AGE', units='gC/m^2/s', &
- long='gross primary productivity by age bin', use_default='active', &
+ long='gross primary productivity by age bin', use_default='inactive', &
avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
ivar=ivar, initialize=initialize_variables, index = ih_gpp_si_age )
@@ -1943,7 +2371,7 @@ subroutine define_history_vars(this, initialize_variables)
ivar=ivar, initialize=initialize_variables, index = ih_ar_canopy_pa )
call this%set_history_var(vname='GPP_UNDERSTORY', units='gC/m^2/s', &
- long='gross primary production of understory plants', use_default='active', &
+ long='gross primary production of understory plants', use_default='inactive', &
avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
ivar=ivar, initialize=initialize_variables, index = ih_gpp_understory_pa )
@@ -1952,6 +2380,152 @@ subroutine define_history_vars(this, initialize_variables)
avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
ivar=ivar, initialize=initialize_variables, index = ih_ar_understory_pa )
+
+ ! fast radiative fluxes resolved through the canopy
+ call this%set_history_var(vname='PARSUN_Z_CNLF', units='W/m2', &
+ long='PAR absorbed in the sun by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlf )
+
+ call this%set_history_var(vname='PARSHA_Z_CNLF', units='W/m2', &
+ long='PAR absorbed in the shade by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlf )
+
+ call this%set_history_var(vname='PARSUN_Z_CNLFPFT', units='W/m2', &
+ long='PAR absorbed in the sun by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlfpft )
+
+ call this%set_history_var(vname='PARSHA_Z_CNLFPFT', units='W/m2', &
+ long='PAR absorbed in the shade by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlfpft )
+
+ call this%set_history_var(vname='PARSUN_Z_CAN', units='W/m2', &
+ long='PAR absorbed in the sun by top leaf layer in each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_parsun_top_si_can )
+
+ call this%set_history_var(vname='PARSHA_Z_CAN', units='W/m2', &
+ long='PAR absorbed in the shade by top leaf layer in each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_parsha_top_si_can )
+
+ call this%set_history_var(vname='LAISUN_Z_CNLF', units='m2/m2', &
+ long='LAI in the sun by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlf )
+
+ call this%set_history_var(vname='LAISHA_Z_CNLF', units='m2/m2', &
+ long='LAI in the shade by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_laisha_z_si_cnlf )
+
+ call this%set_history_var(vname='LAISUN_Z_CNLFPFT', units='m2/m2', &
+ long='LAI in the sun by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlfpft )
+
+ call this%set_history_var(vname='LAISHA_Z_CNLFPFT', units='m2/m2', &
+ long='LAI in the shade by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_laisha_z_si_cnlfpft )
+
+ call this%set_history_var(vname='LAISUN_TOP_CAN', units='m2/m2', &
+ long='LAI in the sun by the top leaf layer of each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_laisun_top_si_can )
+
+ call this%set_history_var(vname='LAISHA_TOP_CAN', units='m2/m2', &
+ long='LAI in the shade by the top leaf layer of each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_laisha_top_si_can )
+
+ call this%set_history_var(vname='FABD_SUN_CNLFPFT', units='fraction', &
+ long='sun fraction of direct light absorbed by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_si_cnlfpft )
+
+ call this%set_history_var(vname='FABD_SHA_CNLFPFT', units='fraction', &
+ long='shade fraction of direct light absorbed by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_si_cnlfpft )
+
+ call this%set_history_var(vname='FABI_SUN_CNLFPFT', units='fraction', &
+ long='sun fraction of indirect light absorbed by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_si_cnlfpft )
+
+ call this%set_history_var(vname='FABI_SHA_CNLFPFT', units='fraction', &
+ long='shade fraction of indirect light absorbed by each canopy, leaf, and PFT', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_si_cnlfpft )
+
+ call this%set_history_var(vname='FABD_SUN_CNLF', units='fraction', &
+ long='sun fraction of direct light absorbed by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_si_cnlf )
+
+ call this%set_history_var(vname='FABD_SHA_CNLF', units='fraction', &
+ long='shade fraction of direct light absorbed by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_si_cnlf )
+
+ call this%set_history_var(vname='FABI_SUN_CNLF', units='fraction', &
+ long='sun fraction of indirect light absorbed by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_si_cnlf )
+
+ call this%set_history_var(vname='FABI_SHA_CNLF', units='fraction', &
+ long='shade fraction of indirect light absorbed by each canopy and leaf layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_si_cnlf )
+
+ call this%set_history_var(vname='FABD_SUN_TOPLF_BYCANLAYER', units='fraction', &
+ long='sun fraction of direct light absorbed by the top leaf layer of each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_top_si_can )
+
+ call this%set_history_var(vname='FABD_SHA_TOPLF_BYCANLAYER', units='fraction', &
+ long='shade fraction of direct light absorbed by the top leaf layer of each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_top_si_can )
+
+ call this%set_history_var(vname='FABI_SUN_TOPLF_BYCANLAYER', units='fraction', &
+ long='sun fraction of indirect light absorbed by the top leaf layer of each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_top_si_can )
+
+ call this%set_history_var(vname='FABI_SHA_TOPLF_BYCANLAYER', units='fraction', &
+ long='shade fraction of indirect light absorbed by the top leaf layer of each canopy layer', &
+ use_default='inactive', &
+ avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, &
+ ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_top_si_can )
+
! slow carbon fluxes associated with mortality from or transfer betweeen canopy and understory
call this%set_history_var(vname='DEMOTION_CARBONFLUX', units = 'gC/m2/s', &
long='demotion-associated biomass carbon flux from canopy to understory', use_default='active', &
@@ -1974,6 +2548,12 @@ subroutine define_history_vars(this, initialize_variables)
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_understory_mortality_carbonflux_si )
+ call this%set_history_var(vname='NPLANT_SCAG',units = 'plants/ha', &
+ long='number of plants per hectare in each size x age class', use_default='inactive', &
+ avgflag='A', vtype=site_scag_r8, hlms='CLM:ALM', flushval=0.0_r8, &
+ upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scag )
+
+
! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!!
! (BECAUSE THEY TAKE UP SPACE!!!
! ===================================================================================
@@ -2144,6 +2724,35 @@ subroutine define_history_vars(this, initialize_variables)
avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scpf )
+ call this%set_history_var(vname='CWD_AG_CWDSC', units='gC/m^2', &
+ long='size-resolved AG CWD stocks', use_default='inactive', &
+ avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, &
+ upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_si_cwdsc )
+
+ call this%set_history_var(vname='CWD_BG_CWDSC', units='gC/m^2', &
+ long='size-resolved BG CWD stocks', use_default='inactive', &
+ avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, &
+ upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_si_cwdsc )
+
+ call this%set_history_var(vname='CWD_AG_IN_CWDSC', units='gC/m^2/y', &
+ long='size-resolved AG CWD input', use_default='inactive', &
+ avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, &
+ upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_in_si_cwdsc )
+
+ call this%set_history_var(vname='CWD_BG_IN_CWDSC', units='gC/m^2/y', &
+ long='size-resolved BG CWD input', use_default='inactive', &
+ avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, &
+ upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_in_si_cwdsc )
+
+ call this%set_history_var(vname='CWD_AG_OUT_CWDSC', units='gC/m^2/y', &
+ long='size-resolved AG CWD output', use_default='inactive', &
+ avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, &
+ upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_out_si_cwdsc )
+
+ call this%set_history_var(vname='CWD_BG_OUT_CWDSC', units='gC/m^2/y', &
+ long='size-resolved BG CWD output', use_default='inactive', &
+ avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, &
+ upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_out_si_cwdsc )
! Size structured diagnostics that require rapid updates (upfreq=2)
@@ -2195,37 +2804,37 @@ subroutine define_history_vars(this, initialize_variables)
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_yesterdaycanopylevel_understory_si_scls )
call this%set_history_var(vname='BA_SCLS', units = 'm2/ha', &
- long='basal area by size class', use_default='active', &
+ long='basal area by size class', use_default='inactive', &
avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ba_si_scls )
call this%set_history_var(vname='DEMOTION_RATE_SCLS', units = 'indiv/ha/yr', &
- long='demotion rate from canopy to understory by size class', use_default='active', &
+ long='demotion rate from canopy to understory by size class', use_default='inactive', &
avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_rate_si_scls )
call this%set_history_var(vname='PROMOTION_RATE_SCLS', units = 'indiv/ha/yr', &
- long='promotion rate from understory to canopy by size class', use_default='active', &
+ long='promotion rate from understory to canopy by size class', use_default='inactive', &
avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_rate_si_scls )
call this%set_history_var(vname='NPLANT_CANOPY_SCLS', units = 'indiv/ha', &
- long='number of canopy plants by size class', use_default='active', &
+ long='number of canopy plants by size class', use_default='inactive', &
avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_scls )
call this%set_history_var(vname='MORTALITY_CANOPY_SCLS', units = 'indiv/ha/yr', &
- long='total mortality of canopy trees by size class', use_default='active', &
+ long='total mortality of canopy trees by size class', use_default='inactive', &
avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scls )
call this%set_history_var(vname='NPLANT_UNDERSTORY_SCLS', units = 'indiv/ha', &
- long='number of understory plants by size class', use_default='active', &
+ long='number of understory plants by size class', use_default='inactive', &
avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scls )
call this%set_history_var(vname='MORTALITY_UNDERSTORY_SCLS', units = 'indiv/ha/yr', &
- long='total mortality of understory trees by size class', use_default='active', &
+ long='total mortality of understory trees by size class', use_default='inactive', &
avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, &
upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scls )
diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90
index 20abd41f89..eca19a316c 100644
--- a/components/clm/src/ED/main/FatesHistoryVariableType.F90
+++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90
@@ -46,6 +46,8 @@ subroutine Init(this, vname, units, long, use_default, &
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 FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
+ use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
use FatesIOVariableKindMod, only : iotype_index
implicit none
@@ -131,6 +133,30 @@ subroutine Init(this, vname, units, long, use_default, &
allocate(this%r82d(lb1:ub1, lb2:ub2))
this%r82d(:,:) = flushval
+ case(site_fuel_r8)
+ allocate(this%r82d(lb1:ub1, lb2:ub2))
+ this%r82d(:,:) = flushval
+
+ case(site_cwdsc_r8)
+ allocate(this%r82d(lb1:ub1, lb2:ub2))
+ this%r82d(:,:) = flushval
+
+ case(site_can_r8)
+ allocate(this%r82d(lb1:ub1, lb2:ub2))
+ this%r82d(:,:) = flushval
+
+ case(site_cnlf_r8)
+ allocate(this%r82d(lb1:ub1, lb2:ub2))
+ this%r82d(:,:) = flushval
+
+ case(site_cnlfpft_r8)
+ allocate(this%r82d(lb1:ub1, lb2:ub2))
+ this%r82d(:,:) = flushval
+
+ case(site_scag_r8)
+ allocate(this%r82d(lb1:ub1, lb2:ub2))
+ this%r82d(:,:) = flushval
+
case default
write(fates_log(),*) 'Incompatible vtype passed to set_history_var'
write(fates_log(),*) 'vtype = ',trim(vtype),' ?'
@@ -197,6 +223,8 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds)
use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8
use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int
use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8
+ use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
+ use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
implicit none
@@ -228,6 +256,18 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds)
this%r82d(lb1:ub1, lb2:ub2) = this%flushval
case(site_age_r8)
this%r82d(lb1:ub1, lb2:ub2) = this%flushval
+ case(site_fuel_r8)
+ this%r82d(lb1:ub1, lb2:ub2) = this%flushval
+ case(site_cwdsc_r8)
+ this%r82d(lb1:ub1, lb2:ub2) = this%flushval
+ case(site_can_r8)
+ this%r82d(lb1:ub1, lb2:ub2) = this%flushval
+ case(site_cnlf_r8)
+ this%r82d(lb1:ub1, lb2:ub2) = this%flushval
+ case(site_cnlfpft_r8)
+ this%r82d(lb1:ub1, lb2:ub2) = this%flushval
+ case(site_scag_r8)
+ this%r82d(lb1:ub1, lb2:ub2) = this%flushval
case(patch_int)
this%int1d(lb1:ub1) = nint(this%flushval)
case default
diff --git a/components/clm/src/ED/main/FatesIODimensionsMod.F90 b/components/clm/src/ED/main/FatesIODimensionsMod.F90
index 83b2475aad..1dd5cce0b9 100644
--- a/components/clm/src/ED/main/FatesIODimensionsMod.F90
+++ b/components/clm/src/ED/main/FatesIODimensionsMod.F90
@@ -4,14 +4,23 @@ module FatesIODimensionsMod
implicit none
- character(*), parameter :: cohort = 'cohort'
- character(*), parameter :: patch = 'patch'
- character(*), parameter :: column = 'column'
- character(*), parameter :: levgrnd = 'levgrnd'
- character(*), parameter :: levscpf = 'levscpf'
- character(*), parameter :: levscls = 'levscls'
- character(*), parameter :: levpft = 'levpft'
- character(*), parameter :: levage = 'levage'
+ ! The following dimension names must be replicated in
+ ! CLM/ALMs histFileMod.F90 and
+
+ character(*), parameter :: cohort = 'cohort' ! matches clm_varcon
+ character(*), parameter :: patch = 'patch' ! matches clm_varcon
+ character(*), parameter :: column = 'column' ! matches clm_varcon
+ character(*), parameter :: levgrnd = 'levgrnd' ! matches clm_varcon
+ character(*), parameter :: levscag = 'fates_levscag' ! matches histFileMod
+ character(*), parameter :: levscpf = 'fates_levscpf' ! matches histFileMod
+ character(*), parameter :: levscls = 'fates_levscls' ! matches histFileMod
+ character(*), parameter :: levpft = 'fates_levpft' ! matches histFileMod
+ character(*), parameter :: levage = 'fates_levage' ! matches histFileMod
+ character(*), parameter :: levfuel = 'fates_levfuel' ! matches histFileMod
+ character(*), parameter :: levcwdsc = 'fates_levcwdsc' ! matches histFileMod
+ character(*), parameter :: levcan = 'fates_levcan' ! matches histFileMod
+ character(*), parameter :: levcnlf = 'fates_levcnlf' ! matches histFileMod
+ character(*), parameter :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod
! patch = This is a structure that records where FATES patch boundaries
! on each thread point to in the host IO array, this structure
@@ -36,6 +45,24 @@ module FatesIODimensionsMod
! levage = This is a structure that records the boundaries for the
! number of patch-age-class dimension
+ ! levfuel = This is a structure that records the boundaries for the
+ ! number of fuel-size-class dimension
+
+ ! levcwdsc = This is a structure that records the boundaries for the
+ ! number of coarse-woody-debris-size-class dimension
+
+ ! levcan = This is a structure that records the boundaries for the
+ ! number of canopy layer dimension
+
+ ! levcnlf = This is a structure that records the boundaries for the
+ ! number of cnanopy layer x leaf layer dimension
+
+ ! levcnlfpft = This is a structure that records the boundaries for the
+ ! number of canopy layer x leaf layer x pft dimension
+
+ ! levscag = This is a strcture that records the boundaries for the
+ ! number of size-classes x patch age
+
type, public :: fates_bounds_type
integer :: patch_begin
@@ -46,6 +73,8 @@ module FatesIODimensionsMod
integer :: column_end ! we call this a "site" (rgk 11-2016)
integer :: ground_begin
integer :: ground_end
+ integer :: sizeage_class_begin
+ integer :: sizeage_class_end
integer :: sizepft_class_begin
integer :: sizepft_class_end
integer :: size_class_begin
@@ -54,6 +83,16 @@ module FatesIODimensionsMod
integer :: pft_class_end
integer :: age_class_begin
integer :: age_class_end
+ integer :: fuel_begin
+ integer :: fuel_end
+ integer :: cwdsc_begin
+ integer :: cwdsc_end
+ integer :: can_begin
+ integer :: can_end
+ integer :: cnlf_begin
+ integer :: cnlf_end
+ integer :: cnlfpft_begin
+ integer :: cnlfpft_end
end type fates_bounds_type
diff --git a/components/clm/src/ED/main/FatesIOVariableKindMod.F90 b/components/clm/src/ED/main/FatesIOVariableKindMod.F90
index 2c8eb98216..25e2f2bc78 100644
--- a/components/clm/src/ED/main/FatesIOVariableKindMod.F90
+++ b/components/clm/src/ED/main/FatesIOVariableKindMod.F90
@@ -22,7 +22,12 @@ module FatesIOVariableKindMod
character(*), parameter :: cohort_int = 'CO_INT'
character(*), parameter :: site_pft_r8 = 'SI_PFT_R8'
character(*), parameter :: site_age_r8 = 'SI_AGE_R8'
-
+ character(*), parameter :: site_fuel_r8 = 'SI_FUEL_R8'
+ character(*), parameter :: site_cwdsc_r8 = 'SI_CWDSC_R8'
+ character(*), parameter :: site_can_r8 = 'SI_CAN_R8'
+ character(*), parameter :: site_cnlf_r8 = 'SI_CNLF_R8'
+ character(*), parameter :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8'
+ character(*), parameter :: site_scag_r8 = 'SI_SCAG_R8'
! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES
! control parameter passing to ensure all active dimension types received all
diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90
index 79279454d7..3a1e257665 100644
--- a/components/clm/src/ED/main/FatesInterfaceMod.F90
+++ b/components/clm/src/ED/main/FatesInterfaceMod.F90
@@ -14,7 +14,7 @@ module FatesInterfaceMod
use EDTypesMod , only : maxCohortsPerPatch
use EDTypesMod , only : maxSWb
use EDTypesMod , only : nclmax
- use EDTypesMod , only : nlevcan
+ use EDTypesMod , only : nlevleaf
use EDTypesMod , only : numpft_ed
use FatesConstantsMod , only : r8 => fates_r8
use FatesGlobals , only : fates_global_verbose
@@ -646,7 +646,7 @@ subroutine set_fates_global_elements(use_fates)
if (use_fates) then
fates_maxElementsPerPatch = max(maxCohortsPerPatch, &
- numpft_ed * nclmax * nlevcan)
+ numpft_ed * nclmax * nlevleaf)
fates_maxElementsPerSite = maxPatchesPerSite * fates_maxElementsPerPatch
diff --git a/components/clm/src/ED/main/FatesParameterDerivedMod.F90 b/components/clm/src/ED/main/FatesParameterDerivedMod.F90
index 41641d754e..f1000ad11f 100644
--- a/components/clm/src/ED/main/FatesParameterDerivedMod.F90
+++ b/components/clm/src/ED/main/FatesParameterDerivedMod.F90
@@ -53,7 +53,7 @@ end subroutine InitAllocate
subroutine Init(this,maxpft)
- use pftconMod , only: pftcon
+ use EDPftvarcon, only: EDPftvarcon_inst
class(param_derived_type), intent(inout) :: this
integer, intent(in) :: maxpft
@@ -63,10 +63,10 @@ subroutine Init(this,maxpft)
real(r8) :: lnc ! leaf N concentration (gN leaf/m^2)
associate( &
- slatop => pftcon%slatop , & ! specific leaf area at top of canopy,
+ slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy,
! projected area basis [m^2/gC]
- fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-)
- leafcn => pftcon%leafcn ) ! leaf C:N (gC/gN)
+ fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-)
+ leafcn => EDPftvarcon_inst%leafcn ) ! leaf C:N (gC/gN)
call this%InitAllocate(maxpft)
diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90
new file mode 100644
index 0000000000..007dd78d71
--- /dev/null
+++ b/components/clm/src/ED/main/FatesParametersInterface.F90
@@ -0,0 +1,484 @@
+module FatesParametersInterface
+ ! NOTE(bja, 2017-01) this is part of the interface between fates and
+ ! the host model. To avoid circular dependancies, it should not
+ ! depend on any host modules.
+
+ use FatesConstantsMod, only : r8 => fates_r8
+ use FatesGlobals, only : fates_log
+
+ implicit none
+
+ integer, parameter, public :: max_params = 250
+ integer, parameter, public :: max_dimensions = 2
+ integer, parameter, public :: max_used_dimensions = 25
+ integer, parameter, public :: param_string_length = 40
+ ! NOTE(bja, 2017-02) these are the values returned from netcdf after
+ ! inquiring about the number of dimensions
+ integer, parameter, public :: dimension_shape_scalar = 0
+ integer, parameter, public :: dimension_shape_1d = 1
+ integer, parameter, public :: dimension_shape_2d = 2
+
+ ! Dimensions in the fates namespace:
+ character(len=*), parameter, public :: dimension_name_scalar = ''
+ character(len=*), parameter, public :: dimension_name_scalar1d = 'fates_scalar'
+ character(len=*), parameter, public :: dimension_name_pft = 'fates_pft'
+ character(len=*), parameter, public :: dimension_name_segment = 'fates_segment'
+ character(len=*), parameter, public :: dimension_name_cwd = 'fates_NCWD'
+ character(len=*), parameter, public :: dimension_name_lsc = 'fates_litterclass'
+ 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'
+
+ ! Dimensions in the host namespace:
+ character(len=*), parameter, public :: dimension_name_host_allpfts = 'allpfts'
+
+ type, private :: parameter_type
+ character(len=param_string_length) :: name
+ logical :: sync_with_host
+ integer :: dimension_shape
+ integer :: dimension_sizes(max_dimensions)
+ character(len=param_string_length) :: dimension_names(max_dimensions)
+ integer :: dimension_lower_bound(max_dimensions)
+ real(r8), allocatable :: data(:, :)
+ end type parameter_type
+
+ type, public :: fates_parameters_type
+ integer, private :: num_parameters
+ type(parameter_type), private :: parameters(max_params)
+
+ contains
+ procedure, public :: Init
+ procedure, public :: Destroy
+ procedure, public :: RegisterParameter
+ generic, public :: RetreiveParameter => RetreiveParameterScalar, RetreiveParameter1D, RetreiveParameter2D
+ generic, public :: RetreiveParameterAllocate => RetreiveParameter1DAllocate, RetreiveParameter2DAllocate
+ generic, public :: SetData => SetDataScalar, SetData1D, SetData2D
+ procedure, public :: GetUsedDimensions
+ procedure, public :: SetDimensionSizes
+ procedure, public :: GetMaxDimensionSize
+ procedure, public :: GetMetaData
+ procedure, public :: num_params
+ procedure, public :: FindIndex
+
+ procedure, private :: RetreiveParameterScalar
+ procedure, private :: RetreiveParameter1D
+ procedure, private :: RetreiveParameter2D
+ procedure, private :: RetreiveParameter1DAllocate
+ procedure, private :: RetreiveParameter2DAllocate
+ procedure, private :: SetDataScalar
+ procedure, private :: SetData1D
+ procedure, private :: SetData2D
+
+ end type fates_parameters_type
+
+contains
+
+ !-----------------------------------------------------------------------
+ subroutine Init(this)
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+
+ this%num_parameters = 0
+
+ end subroutine Init
+
+ !-----------------------------------------------------------------------
+ subroutine Destroy(this)
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+
+ integer :: n
+ do n = 1, this%num_parameters
+ deallocate(this%parameters(n)%data)
+ end do
+
+ end subroutine Destroy
+
+ !-----------------------------------------------------------------------
+ subroutine RegisterParameter(this, name, dimension_shape, dimension_names, &
+ sync_with_host, lower_bounds)
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ character(len=param_string_length), intent(in) :: name
+ integer, intent(in) :: dimension_shape
+ character(len=param_string_length) :: dimension_names(1:)
+ logical, intent(in), optional :: sync_with_host
+ integer, intent(in), optional :: lower_bounds(1:)
+
+ integer :: i, n, num_names, num_bounds
+
+ this%num_parameters = this%num_parameters + 1
+ i = this%num_parameters
+ ! FIXME(bja, 2017-01) assert(i <= max_params)
+ this%parameters(i)%name = name
+ this%parameters(i)%dimension_shape = dimension_shape
+ this%parameters(i)%dimension_sizes(:) = 0
+ ! FIXME(bja, 2017-01) assert(size(dimension_names, 1) <= max_dimensions)
+ num_names = min(max_dimensions, size(dimension_names, 1))
+ this%parameters(i)%dimension_names(:) = ''
+ do n = 1, num_names
+ this%parameters(i)%dimension_names(n) = dimension_names(n)
+ end do
+ this%parameters(i)%sync_with_host = .false.
+ if (present(sync_with_host)) then
+ this%parameters(i)%sync_with_host = sync_with_host
+ end if
+ ! allocate as a standard 1-based array unless otherwise specified
+ ! by the caller.
+ this%parameters(i)%dimension_lower_bound = (/ 1, 1 /)
+ if (present(lower_bounds)) then
+ num_bounds = min(max_dimensions, size(lower_bounds, 1))
+ do n = 1, num_bounds
+ this%parameters(i)%dimension_lower_bound(n) = lower_bounds(n)
+ end do
+ endif
+ end subroutine RegisterParameter
+
+ !-----------------------------------------------------------------------
+ subroutine RetreiveParameterScalar(this, name, data)
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ character(len=param_string_length), intent(in) :: name
+ real(r8), intent(out) :: data
+
+ integer :: i
+
+ i = this%FindIndex(name)
+ ! assert(size(data) == size(this%parameters(i)%data))
+ data = this%parameters(i)%data(1, 1)
+
+ end subroutine RetreiveParameterScalar
+
+ !-----------------------------------------------------------------------
+ subroutine RetreiveParameter1D(this, name, data)
+
+ use abortutils, only : endrun
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ character(len=param_string_length), intent(in) :: name
+ real(r8), intent(out) :: data(:)
+
+ integer :: i, d, size_dim_1
+
+ i = this%FindIndex(name)
+ if (size(data) /= size(this%parameters(i)%data(:, 1))) then
+ write(fates_log(), *) 'ERROR : retreiveparameter1d : ', name, ' size inconsistent.'
+ write(fates_log(), *) 'ERROR : expected size = ', size(data)
+ write(fates_log(), *) 'ERROR : data size received from file = ', size(this%parameters(i)%data(:, 1))
+ write(fates_log(), *) 'ERROR : dimesions received from file'
+ write(fates_log(), *) 'ERROR : names size'
+ do d = 1, max_dimensions
+ write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d)
+ end do
+ call endrun(msg='size error retreiving 1d parameter.')
+ end if
+ data = this%parameters(i)%data(:, 1)
+
+ end subroutine RetreiveParameter1D
+
+ !-----------------------------------------------------------------------
+ subroutine RetreiveParameter2D(this, name, data)
+
+ use abortutils, only : endrun
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ character(len=param_string_length), intent(in) :: name
+ real(r8), intent(out) :: data(:, :)
+
+ integer :: i, d
+
+ i = this%FindIndex(name)
+ if (size(data, 1) /= size(this%parameters(i)%data, 1) .and. &
+ size(data, 2) /= size(this%parameters(i)%data, 2)) then
+ write(fates_log(), *) 'ERROR : retreiveparameter2d : ', name, ' size inconsistent.'
+ write(fates_log(), *) 'ERROR : expected shape = ', shape(data)
+ write(fates_log(), *) 'ERROR : dim 1 expected size = ', size(data, 1)
+ write(fates_log(), *) 'ERROR : dim 2 expected size = ', size(data, 2)
+ write(fates_log(), *) 'ERROR : dim 1 data size received from file = ', size(this%parameters(i)%data, 1)
+ write(fates_log(), *) 'ERROR : dim 2 data size received from file = ', size(this%parameters(i)%data, 2)
+ write(fates_log(), *) 'ERROR : dimesions received from file'
+ write(fates_log(), *) 'ERROR : names size'
+ do d = 1, max_dimensions
+ write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d)
+ end do
+ call endrun(msg='size error retreiving 2d parameter.')
+ end if
+ data = this%parameters(i)%data
+
+ end subroutine RetreiveParameter2D
+
+ !-----------------------------------------------------------------------
+ subroutine RetreiveParameter1DAllocate(this, name, data)
+
+ use abortutils, only : endrun
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ character(len=param_string_length), intent(in) :: name
+ real(r8), intent(out), allocatable :: data(:)
+
+ integer :: i, lower_bound, upper_bound
+
+ i = this%FindIndex(name)
+ lower_bound = this%parameters(i)%dimension_lower_bound(1)
+ upper_bound = lower_bound + this%parameters(i)%dimension_sizes(1) - 1
+ allocate(data(lower_bound:upper_bound))
+ data(lower_bound:upper_bound) = this%parameters(i)%data(:, 1)
+
+ end subroutine RetreiveParameter1DAllocate
+
+ !-----------------------------------------------------------------------
+ subroutine RetreiveParameter2DAllocate(this, name, data)
+
+ use abortutils, only : endrun
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ character(len=param_string_length), intent(in) :: name
+ real(r8), intent(out), allocatable :: data(:, :)
+
+ integer :: i, lb_1, ub_1, lb_2, ub_2
+
+ i = this%FindIndex(name)
+ lb_1 = this%parameters(i)%dimension_lower_bound(1)
+ ub_1 = lb_1 + this%parameters(i)%dimension_sizes(1) - 1
+ lb_2 = this%parameters(i)%dimension_lower_bound(2)
+ ub_2 = lb_2 + this%parameters(i)%dimension_sizes(2) - 1
+ allocate(data(lb_1:ub_1, lb_2:ub_2))
+ data(lb_1:ub_1, lb_2:ub_2) = this%parameters(i)%data
+
+ end subroutine RetreiveParameter2DAllocate
+
+ !-----------------------------------------------------------------------
+ function FindIndex(this, name) result(i)
+
+ implicit none
+
+ class(fates_parameters_type), intent(in) :: this
+ character(len=param_string_length), intent(in) :: name
+
+ integer :: i
+
+ do i = 1, this%num_parameters
+ if (trim(this%parameters(i)%name) == trim(name)) then
+ exit
+ end if
+ end do
+ if (i > this%num_parameters) then
+ ! error, parameter name not found.
+ end if
+
+ end function FindIndex
+
+ !-----------------------------------------------------------------------
+ integer function num_params(this)
+
+ implicit none
+
+ class(fates_parameters_type), intent(in) :: this
+
+ num_params = this%num_parameters
+
+ end function num_params
+
+ !-----------------------------------------------------------------------
+ subroutine GetUsedDimensions(this, is_host_file, num_used_dimensions, used_dimensions)
+ ! Construct a list of the unique dimension names used by the
+ ! parameters.
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ logical, intent(in) :: is_host_file
+ integer, intent(out) :: num_used_dimensions
+ character(len=param_string_length), intent(out) :: used_dimensions(max_used_dimensions)
+
+ integer :: p, d, i
+ character(len=param_string_length) :: dim_name
+
+ num_used_dimensions = 0
+ do p = 1, this%num_parameters
+ if (is_host_file .eqv. this%parameters(p)%sync_with_host) then
+ do d = 1, max_dimensions
+ dim_name = this%parameters(p)%dimension_names(d)
+ if (len_trim(dim_name) /= 0) then
+ ! non-empty dimension name, check if it needs to be added to the list.
+ do i = 1, num_used_dimensions
+ if (used_dimensions(i) == dim_name) then
+ ! dimension is already in list. can stop searching
+ exit
+ end if
+ end do
+
+ if (i > num_used_dimensions) then
+ ! dimension name was not in the list, add it.
+ num_used_dimensions = num_used_dimensions + 1
+ used_dimensions(num_used_dimensions) = dim_name
+ end if
+ end if ! if dim_name
+ end do ! do d
+ end if ! if host_param
+ end do ! do p
+
+ end subroutine GetUsedDimensions
+
+ !-----------------------------------------------------------------------
+ subroutine SetDimensionSizes(this, is_host_file, num_used_dimensions, dimension_names, dimension_sizes)
+ ! Construct a list of the unique dimension names used by the
+ ! parameters.
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ logical, intent(in) :: is_host_file
+ integer, intent(in) :: num_used_dimensions
+ character(len=param_string_length), intent(in) :: dimension_names(max_used_dimensions)
+ integer, intent(in) :: dimension_sizes(max_used_dimensions)
+
+ integer :: p, d, i
+ character(len=param_string_length) :: dim_name
+
+ do p = 1, this%num_parameters
+ if (is_host_file .eqv. this%parameters(p)%sync_with_host) then
+ do d = 1, max_dimensions
+ dim_name = this%parameters(p)%dimension_names(d)
+ if (len_trim(dim_name) /= 0) then
+ ! non-empty dimension name, set the size
+ do i = 1, num_used_dimensions
+ if (trim(dimension_names(i)) == trim(dim_name)) then
+ !write(*, *) '--> ', trim(this%parameters(p)%name), ' setting ', trim(dim_name), ' d = ', d, 'size = ', dimension_sizes(i)
+ this%parameters(p)%dimension_sizes(d) = dimension_sizes(i)
+ exit
+ end if
+ end do
+ end if ! if dim_name
+ end do ! do dim
+ end if ! if host_param
+ end do ! do param
+
+ end subroutine SetDimensionSizes
+
+ !-----------------------------------------------------------------------
+ subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes, dimension_names, is_host_param)
+
+ implicit none
+
+ class(fates_parameters_type), intent(in) :: this
+ integer, intent(in) :: index
+ character(len=param_string_length), intent(out) :: name
+ integer, intent(out) :: dimension_shape
+ integer, intent(out) :: dimension_sizes(max_dimensions)
+ character(len=param_string_length), intent(out) :: dimension_names(max_dimensions)
+ logical, intent(out) :: is_host_param
+
+ name = this%parameters(index)%name
+ dimension_shape = this%parameters(index)%dimension_shape
+ dimension_sizes = this%parameters(index)%dimension_sizes
+ dimension_names = this%parameters(index)%dimension_names
+ is_host_param = this%parameters(index)%sync_with_host
+
+ end subroutine GetMetaData
+
+ !-----------------------------------------------------------------------
+ function GetMaxDimensionSize(this) result(max_dim_size)
+
+ implicit none
+
+ class(fates_parameters_type), intent(in) :: this
+
+ integer :: p, d, max_dim_size
+
+ max_dim_size = 0
+
+ do p = 1, this%num_params()
+ do d = 1, max_dimensions
+ max_dim_size = max(max_dim_size, this%parameters(p)%dimension_sizes(d))
+ end do
+ end do
+
+ end function GetMaxDimensionSize
+
+ !-----------------------------------------------------------------------
+ subroutine SetDataScalar(this, index, data)
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ integer, intent(in) :: index
+ real(r8), intent(in) :: data
+
+ allocate(this%parameters(index)%data(1, 1))
+ this%parameters(index)%data(1, 1) = data
+
+ end subroutine SetDataScalar
+
+ !-----------------------------------------------------------------------
+ subroutine SetData1D(this, index, data)
+
+ use abortutils, only : endrun
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ integer, intent(in) :: index
+ real(r8), intent(in) :: data(:)
+
+ integer :: size_dim_1, d
+
+ size_dim_1 = this%parameters(index)%dimension_sizes(1)
+ if (size(data) /= size_dim_1) then
+ write(fates_log(), *) 'ERROR : setdata1d : ', this%parameters(index)%name, ' size inconsistent.'
+ write(fates_log(), *) 'ERROR : expected size = ', size(data)
+ write(fates_log(), *) 'ERROR : data size received from file = ', size_dim_1
+ write(fates_log(), *) 'ERROR : dimesions received from file'
+ write(fates_log(), *) 'ERROR : names size'
+ do d = 1, max_dimensions
+ write(fates_log(), *) this%parameters(index)%dimension_names(d), ', ', this%parameters(index)%dimension_sizes(d)
+ end do
+ call endrun(msg='size error setting 1d parameter.')
+ end if
+
+ allocate(this%parameters(index)%data(size_dim_1, 1))
+ this%parameters(index)%data(:, 1) = data(:)
+
+ end subroutine SetData1D
+
+ !-----------------------------------------------------------------------
+ subroutine SetData2D(this, index, data)
+ ! FIXME(bja, 2017-01) this is broken, needs data dimensions to work correctly!
+
+ implicit none
+
+ class(fates_parameters_type), intent(inout) :: this
+ integer, intent(in) :: index
+ real(r8), intent(in) :: data(:, :)
+
+ ! NOTE(bja, 2017-01) This should work for fortran 2003? Or 2008?
+ ! Either way, it works with intel and pgi being used in 2017-01,
+ ! but is broken in gfortran 5.2 and earlier. That would copy the
+ ! data as well....
+
+ !X! allocate(this%parameters(index)%data, source=data)
+
+ allocate(this%parameters(index)%data(size(data, 1), size(data, 2)))
+ this%parameters(index)%data = data
+
+ end subroutine SetData2D
+end module FatesParametersInterface
+
+
+
diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90
index f15ff350d1..cb26ac4bd3 100644
--- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90
+++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90
@@ -929,7 +929,7 @@ end subroutine set_restart_var
subroutine set_restart_vectors(this,nc,nsites,sites)
use EDTypesMod, only : nclmax
- use EDTypesMod, only : nlevcan
+ use EDTypesMod, only : nlevleaf
use FatesInterfaceMod, only : fates_maxElementsPerPatch
use EDTypesMod, only : numpft_ed
use EDTypesMod, only : ed_site_type
@@ -1206,9 +1206,9 @@ 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 ',nlevcan,numpft_ed,nclmax
+ if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',nlevleaf,numpft_ed,nclmax
- do k = 1,nlevcan ! nlevcan currently 40
+ do k = 1,nlevleaf ! nlevleaf currently 40
do j = 1,numpft_ed ! numpft_ed currently 2
do i = 1,nclmax ! nclmax currently 2
rio_fsun_paclftls(io_idx_pa_sunz) = cpatch%f_sun(i,j,k)
@@ -1304,7 +1304,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites )
use EDTypesMod, only : ed_cohort_type
use EDTypesMod, only : ed_patch_type
use EDTypesMod, only : ncwd
- use EDTypesMod, only : nlevcan
+ use EDTypesMod, only : nlevleaf
use EDTypesMod, only : nclmax
use FatesInterfaceMod, only : fates_maxElementsPerPatch
use EDTypesMod, only : numpft_ed
@@ -1315,7 +1315,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
@@ -1426,7 +1426,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
@@ -1501,7 +1501,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites)
use EDTypesMod, only : ed_patch_type
use EDTypesMod, only : numpft_ed
use EDTypesMod, only : ncwd
- use EDTypesMod, only : nlevcan
+ use EDTypesMod, only : nlevleaf
use EDTypesMod, only : nclmax
use FatesInterfaceMod, only : fates_maxElementsPerPatch
use EDTypesMod, only : numWaterMem
@@ -1765,7 +1765,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,nlevcan ! nlevcan currently 40
+ do k = 1,nlevleaf ! nlevleaf currently 40
do j = 1,numpft_ed ! numpft_ed currently 2
do i = 1,nclmax ! nclmax currently 2
cpatch%f_sun(i,j,k) = rio_fsun_paclftls(io_idx_pa_sunz)
diff --git a/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90 b/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90
new file mode 100644
index 0000000000..57c6143934
--- /dev/null
+++ b/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90
@@ -0,0 +1,131 @@
+module FatesSynchronizedParamsMod
+
+ !-----------------------------------------------------------------------
+ !
+ ! !USES:
+ use FatesConstantsMod, only : r8 => fates_r8
+ implicit none
+
+ ! FatesSynchronizedParamsInst. PGI wants the type decl. public but the instance
+ ! is indeed protected. A generic private statement at the start of the module
+ ! overrides the protected functionality with PGI
+
+ type, public :: FatesSynchronizedParamsType
+ real(r8) :: Q10 ! temperature dependence
+ real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates
+ contains
+ procedure, public :: RegisterParams
+ procedure, public :: ReceiveParams
+ procedure, private :: Init
+ procedure, private :: RegisterParamsScalar
+ procedure, private :: ReceiveParamsScalar
+ end type FatesSynchronizedParamsType
+
+ type(FatesSynchronizedParamsType), public :: FatesSynchronizedParamsInst
+
+ character(len=*), parameter, private :: sourcefile = &
+ __FILE__
+
+ !-----------------------------------------------------------------------
+
+contains
+
+ subroutine Init(this)
+ ! Initialize all parameters to nan to ensure that we get valid
+ ! values back from the host.
+
+ use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
+
+ implicit none
+
+ class(FatesSynchronizedParamsType), intent(inout) :: this
+
+ this%Q10 = nan
+ this%froz_q10 = nan
+
+ end subroutine Init
+
+ !-----------------------------------------------------------------------
+ subroutine RegisterParams(this, fates_params)
+ ! Register the parameters we want the host to provide, and
+ ! indicate whether they are fates parameters or host parameters
+ ! that need to be synced with host values.
+
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length
+
+ implicit none
+
+ class(FatesSynchronizedParamsType), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call this%Init()
+ call this%RegisterParamsScalar(fates_params)
+
+ end subroutine RegisterParams
+
+ !-----------------------------------------------------------------------
+ subroutine ReceiveParams(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length
+
+ implicit none
+
+ class(FatesSynchronizedParamsType), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ call this%ReceiveParamsScalar(fates_params)
+
+ end subroutine ReceiveParams
+
+ !-----------------------------------------------------------------------
+ subroutine RegisterParamsScalar(this, fates_params)
+ ! Register the parameters we want the host to provide, and
+ ! indicate whether they are fates parameters or host parameters
+ ! that need to be synced with host values.
+
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length
+ use FatesParametersInterface, only : dimension_name_host_allpfts, dimension_shape_1d
+
+ implicit none
+
+ class(FatesSynchronizedParamsType), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_host_allpfts/)
+ character(len=param_string_length) :: name
+
+ call this%Init()
+
+ name = 'q10_mr'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, sync_with_host=.true.)
+
+ name = 'froz_q10'
+ call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, &
+ dimension_names=dim_names, sync_with_host=.true.)
+
+ end subroutine RegisterParamsScalar
+
+ !-----------------------------------------------------------------------
+ subroutine ReceiveParamsScalar(this, fates_params)
+
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length
+
+ implicit none
+
+ class(FatesSynchronizedParamsType), intent(inout) :: this
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ character(len=param_string_length) :: name
+
+ name = 'q10_mr'
+ call fates_params%RetreiveParameter(name=name, &
+ data=this%Q10)
+
+ name = 'froz_q10'
+ call fates_params%RetreiveParameter(name=name, &
+ data=this%froz_q10)
+
+ end subroutine ReceiveParamsScalar
+
+end module FatesSynchronizedParamsMod
diff --git a/components/clm/src/main/clm_varctl.F90 b/components/clm/src/main/clm_varctl.F90
index 04974fa025..c1378260cd 100644
--- a/components/clm/src/main/clm_varctl.F90
+++ b/components/clm/src/main/clm_varctl.F90
@@ -310,6 +310,11 @@ module clm_varctl
! namelist: write CH4 extra diagnostic output
logical, public :: hist_wrtch4diag = .false.
+ !----------------------------------------------------------
+ ! ED/FATES
+ !----------------------------------------------------------
+ character(len=fname_len), public :: fates_paramfile = ' '
+
!----------------------------------------------------------
! Migration of CPP variables
!----------------------------------------------------------
diff --git a/components/clm/src/main/controlMod.F90 b/components/clm/src/main/controlMod.F90
index d25849b4aa..a1735d44ab 100644
--- a/components/clm/src/main/controlMod.F90
+++ b/components/clm/src/main/controlMod.F90
@@ -203,7 +203,8 @@ subroutine control_init( )
namelist /clm_inparm/ use_c13, use_c14
- namelist /clm_inparm/ use_ed, use_ed_spitfire
+
+ namelist /clm_inparm/ fates_paramfile, use_ed, use_ed_spitfire
! CLM 5.0 nitrogen flags
namelist /clm_inparm/ use_flexibleCN, use_luna
@@ -575,7 +576,9 @@ subroutine control_spmd()
call mpi_bcast (use_c14, 1, MPI_LOGICAL, 0, mpicom, ier)
call mpi_bcast (use_ed, 1, MPI_LOGICAL, 0, mpicom, ier)
+
call mpi_bcast (use_ed_spitfire, 1, MPI_LOGICAL, 0, mpicom, ier)
+ call mpi_bcast (fates_paramfile, len(fates_paramfile) , MPI_CHARACTER, 0, mpicom, ier)
! flexibleCN nitrogen model
call mpi_bcast (use_flexibleCN, 1, MPI_LOGICAL, 0, mpicom, ier)
@@ -910,6 +913,13 @@ subroutine control_print ()
write(iulog, *) ' carbon_resp_opt = ', carbon_resp_opt
end if
write(iulog, *) ' use_luna = ', use_luna
+
+ write(iulog, *) ' ED/FATES: '
+ write(iulog, *) ' use_ed = ', use_ed
+ if (use_ed) then
+ write(iulog, *) ' use_ed_spitfire = ', use_ed_spitfire
+ write(iulog, *) ' fates_paramfile = ', fates_paramfile
+ end if
end subroutine control_print
diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90
index d4b7f1e679..c8adb4ba73 100644
--- a/components/clm/src/main/histFileMod.F90
+++ b/components/clm/src/main/histFileMod.F90
@@ -22,6 +22,8 @@ module histFileMod
use PatchType , only : patch
use ncdio_pio
use EDtypesMod , only : nlevsclass_ed, nlevage_ed
+ use EDtypesMod , only : nfsc, ncwd
+ use EDtypesMod , only : nlevleaf, nclmax, numpft_ed
use clm_varpar , only : mxpft
!
implicit none
@@ -37,6 +39,7 @@ module histFileMod
integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name
integer , public, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types
integer , private, parameter :: avgflag_strlen = 3 ! maximum number of characters for avgflag
+ integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names
! Possible ways to treat multi-layer snow fields at times when no snow is present in a
! given layer. Note that the public parameters are the only ones that can be used by
@@ -159,9 +162,9 @@ module histFileMod
character(len=max_namlen) :: name ! field name
character(len=max_chars) :: long_name ! long name
character(len=max_chars) :: units ! units
- character(len=8) :: type1d ! pointer to first dimension type from data type (nameg, etc)
- character(len=8) :: type1d_out ! hbuf first dimension type from data type (nameg, etc)
- character(len=8) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"]
+ character(len=hist_dim_name_length) :: type1d ! pointer to first dimension type from data type (nameg, etc)
+ character(len=hist_dim_name_length) :: type1d_out ! hbuf first dimension type from data type (nameg, etc)
+ character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"]
integer :: beg1d ! on-node 1d clm pointer start index
integer :: end1d ! on-node 1d clm pointer end index
integer :: num1d ! size of clm pointer first dimension (all nodes)
@@ -819,8 +822,8 @@ subroutine htape_addfld (t, f, avgflag)
!
! !LOCAL VARIABLES:
integer :: n ! field index on defined tape
- character(len=8) :: type1d ! clm pointer 1d type
- character(len=8) :: type1d_out ! history buffer 1d type
+ character(len=hist_dim_name_length) :: type1d ! clm pointer 1d type
+ character(len=hist_dim_name_length) :: type1d_out ! history buffer 1d type
integer :: numa ! total number of atm cells across all processors
integer :: numg ! total number of gridcells across all processors
integer :: numl ! total number of landunits across all processors
@@ -967,7 +970,7 @@ subroutine hist_update_hbuf(bounds)
integer :: f ! field index
integer :: num2d ! size of second dimension (e.g. number of vertical levels)
character(len=*),parameter :: subname = 'hist_update_hbuf'
- character(len=8) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"]
+ character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"]
!-----------------------------------------------------------------------
do t = 1,ntapes
@@ -1011,8 +1014,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active)
logical :: valid ! true => history operation is valid
logical :: map2gcell ! true => map clm pointer field to gridcell
- character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"]
- character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"]
+ character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"]
+ character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"]
character(len=avgflag_strlen) :: avgflag ! time averaging flag
character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column
character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits
@@ -1251,8 +1254,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active)
logical :: valid ! true => history operation is valid
logical :: map2gcell ! true => map clm pointer field to gridcell
- character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"]
- character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"]
+ character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"]
+ character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"]
character(len=avgflag_strlen) :: avgflag ! time averaging flag
character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column
character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits
@@ -1844,15 +1847,21 @@ subroutine htape_create (t, histrest)
do n = 1,num_subs
call ncd_defdim(lnfid, subs_name(n), subs_dim(n), dimid)
end do
- call ncd_defdim(lnfid, 'string_length', 8, strlen_dimid)
+ call ncd_defdim(lnfid, 'string_length', hist_dim_name_length, strlen_dimid)
call ncd_defdim(lnfid, 'scale_type_string_length', scale_type_strlen, dimid)
call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid)
if(use_ed)then
- call ncd_defdim(lnfid, 'levscls', nlevsclass_ed, dimid)
- call ncd_defdim(lnfid, 'levpft', mxpft, dimid)
- call ncd_defdim(lnfid, 'levage', nlevage_ed, dimid)
- call ncd_defdim(lnfid, 'levscpf', nlevsclass_ed*mxpft, dimid)
+ call ncd_defdim(lnfid, 'fates_levscag', nlevsclass_ed * nlevage_ed, dimid)
+ call ncd_defdim(lnfid, 'fates_levscls', nlevsclass_ed, dimid)
+ call ncd_defdim(lnfid, 'fates_levpft', mxpft, dimid)
+ call ncd_defdim(lnfid, 'fates_levage', nlevage_ed, dimid)
+ call ncd_defdim(lnfid, 'fates_levfuel', nfsc, dimid)
+ call ncd_defdim(lnfid, 'fates_levcwdsc', ncwd, dimid)
+ call ncd_defdim(lnfid, 'fates_levscpf', nlevsclass_ed*mxpft, dimid)
+ call ncd_defdim(lnfid, 'fates_levcan', nclmax, dimid)
+ call ncd_defdim(lnfid, 'fates_levcnlf', nlevleaf * nclmax, dimid)
+ call ncd_defdim(lnfid, 'fates_levcnlfpf', nlevleaf * nclmax * numpft_ed, dimid)
end if
if ( .not. lhistrest )then
@@ -2267,8 +2276,12 @@ subroutine htape_timeconst(t, mode)
use domainMod , only : ldomain, lon1d, lat1d
use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time
use clm_time_manager, only : get_ref_date, get_calendar, NO_LEAP_C, GREGORIAN_C
- use EDTypesMod, only : levsclass_ed, pft_levscpf_ed, scls_levscpf_ed
- use EDTypesMod, only : levage_ed, levpft_ed
+ use EDTypesMod, only : fates_hdim_levsclass, fates_hdim_pfmap_levscpf, fates_hdim_scmap_levscpf
+ use EDTypesMod, only : fates_hdim_levage, fates_hdim_levpft
+ use EDTypesMod, only : fates_hdim_scmap_levscag, fates_hdim_agmap_levscag
+ use EDTypesMod, only : fates_hdim_levfuel, fates_hdim_levcwdsc
+ use EDTypesMod, only : fates_hdim_levcan, fates_hdim_canmap_levcnlf, fates_hdim_lfmap_levcnlf
+ use EDTypesMod, only : fates_hdim_canmap_levcnlfpf, fates_hdim_lfmap_levcnlfpf, fates_hdim_pftmap_levcnlfpf
!
! !ARGUMENTS:
integer, intent(in) :: t ! tape index
@@ -2320,18 +2333,40 @@ subroutine htape_timeconst(t, mode)
long_name='coordinate soil levels', units='m', ncid=nfid(t))
if(use_ed)then
- call ncd_defvar(varname='levscls', xtype=tape(t)%ncprec, dim1name='levscls', &
+
+ call ncd_defvar(varname='fates_levscls', xtype=tape(t)%ncprec, dim1name='fates_levscls', &
long_name='FATES diameter size class lower bound', units='cm', ncid=nfid(t))
- call ncd_defvar(varname='pft_levscpf',xtype=ncd_int, dim1name='levscpf', &
+ call ncd_defvar(varname='fates_scmap_levscag', xtype=ncd_int, dim1name='fates_levscag', &
+ long_name='FATES size-class map into size x patch age', units='-', ncid=nfid(t))
+ call ncd_defvar(varname='fates_agmap_levscag', xtype=ncd_int, dim1name='fates_levscag', &
+ long_name='FATES age-class map into size x patch age', units='-', ncid=nfid(t))
+ call ncd_defvar(varname='fates_pftmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', &
long_name='FATES pft index of the combined pft-size class dimension', units='-', ncid=nfid(t))
- call ncd_defvar(varname='scls_levscpf',xtype=ncd_int, dim1name='levscpf', &
+ call ncd_defvar(varname='fates_scmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', &
long_name='FATES size index of the combined pft-size class dimension', units='-', ncid=nfid(t))
- call ncd_defvar(varname='levage',xtype=tape(t)%ncprec, dim1name='levage', &
+ call ncd_defvar(varname='fates_levage',xtype=tape(t)%ncprec, dim1name='fates_levage', &
long_name='FATES patch age (yr)', ncid=nfid(t))
- call ncd_defvar(varname='levpft',xtype=ncd_int, dim1name='levpft', &
+ call ncd_defvar(varname='fates_levpft',xtype=ncd_int, dim1name='fates_levpft', &
long_name='FATES pft number', ncid=nfid(t))
+ call ncd_defvar(varname='fates_levfuel',xtype=ncd_int, dim1name='fates_levfuel', &
+ long_name='FATES fuel index', ncid=nfid(t))
+ call ncd_defvar(varname='fates_levcwdsc',xtype=ncd_int, dim1name='fates_levcwdsc', &
+ long_name='FATES cwd size class', ncid=nfid(t))
+ call ncd_defvar(varname='fates_levcan',xtype=ncd_int, dim1name='fates_levcan', &
+ long_name='FATES canopy level', ncid=nfid(t))
+ call ncd_defvar(varname='fates_canmap_levcnlf',xtype=ncd_int, dim1name='fates_levcnlf', &
+ long_name='FATES canopy level of combined canopy-leaf dimension', ncid=nfid(t))
+ call ncd_defvar(varname='fates_lfmap_levcnlf',xtype=ncd_int, dim1name='fates_levcnlf', &
+ long_name='FATES leaf level of combined canopy-leaf dimension', ncid=nfid(t))
+ call ncd_defvar(varname='fates_canmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', &
+ long_name='FATES canopy level of combined canopy x leaf x pft dimension', ncid=nfid(t))
+ call ncd_defvar(varname='fates_lfmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', &
+ long_name='FATES leaf level of combined canopy x leaf x pft dimension', ncid=nfid(t))
+ call ncd_defvar(varname='fates_pftmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', &
+ long_name='FATES PFT level of combined canopy x leaf x pft dimension', ncid=nfid(t))
end if
+
elseif (mode == 'write') then
if ( masterproc ) write(iulog, *) ' zsoi:',zsoi
call ncd_io(varname='levgrnd', data=zsoi, ncid=nfid(t), flag='write')
@@ -2343,11 +2378,21 @@ subroutine htape_timeconst(t, mode)
call ncd_io(varname='levdcmp', data=zsoi_1d, ncid=nfid(t), flag='write')
end if
if(use_ed)then
- call ncd_io(varname='levscls',data=levsclass_ed, ncid=nfid(t), flag='write')
- call ncd_io(varname='pft_levscpf',data=pft_levscpf_ed, ncid=nfid(t), flag='write')
- call ncd_io(varname='scls_levscpf',data=scls_levscpf_ed, ncid=nfid(t), flag='write')
- call ncd_io(varname='levage',data=levage_ed, ncid=nfid(t), flag='write')
- call ncd_io(varname='levpft',data=levpft_ed, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_scmap_levscag',data=fates_hdim_scmap_levscag, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_agmap_levscag',data=fates_hdim_agmap_levscag, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_levscls',data=fates_hdim_levsclass, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_pftmap_levscpf',data=fates_hdim_pfmap_levscpf, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_scmap_levscpf',data=fates_hdim_scmap_levscpf, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_levage',data=fates_hdim_levage, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_levpft',data=fates_hdim_levpft, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_levfuel',data=fates_hdim_levfuel, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_levcwdsc',data=fates_hdim_levcwdsc, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_levcan',data=fates_hdim_levcan, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_canmap_levcnlf',data=fates_hdim_canmap_levcnlf, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_lfmap_levcnlf',data=fates_hdim_lfmap_levcnlf, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_canmap_levcnlfpf',data=fates_hdim_canmap_levcnlfpf, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_lfmap_levcnlfpf',data=fates_hdim_lfmap_levcnlfpf, ncid=nfid(t), flag='write')
+ call ncd_io(varname='fates_pftmap_levcnlfpf',data=fates_hdim_pftmap_levcnlfpf, ncid=nfid(t), flag='write')
end if
endif
@@ -2570,8 +2615,8 @@ subroutine hfields_write(t, mode)
character(len=max_chars) :: units ! units
character(len=max_namlen):: varname ! variable name
character(len=32) :: avgstr ! time averaging type
- character(len=8) :: type1d_out ! history output 1d type
- character(len=8) :: type2d ! history output 2d type
+ character(len=hist_dim_name_length) :: type1d_out ! history output 1d type
+ character(len=hist_dim_name_length) :: type2d ! history output 2d type
character(len=32) :: dim1name ! temporary
character(len=32) :: dim2name ! temporary
real(r8), pointer :: histo(:,:) ! temporary
@@ -3274,7 +3319,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
character(len=max_namlen),allocatable :: tname(:)
character(len=max_chars), allocatable :: tunits(:),tlongname(:)
- character(len=8), allocatable :: tmpstr(:,:)
+ character(len=hist_dim_name_length), allocatable :: tmpstr(:,:)
character(len=scale_type_strlen), allocatable :: p2c_scale_type(:)
character(len=scale_type_strlen), allocatable :: c2l_scale_type(:)
character(len=scale_type_strlen), allocatable :: l2g_scale_type(:)
@@ -3282,9 +3327,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
integer :: start(2)
character(len=1) :: hnum ! history file index
- character(len=8) :: type1d ! clm pointer 1d type
- character(len=8) :: type1d_out ! history buffer 1d type
- character(len=8) :: type2d ! history buffer 2d type
+ character(len=hist_dim_name_length) :: type1d ! clm pointer 1d type
+ character(len=hist_dim_name_length) :: type1d_out ! history buffer 1d type
+ character(len=hist_dim_name_length) :: type2d ! history buffer 2d type
character(len=32) :: dim1name ! temporary
character(len=32) :: dim2name ! temporary
type(var_desc_t) :: name_desc ! variable descriptor for name
@@ -4174,8 +4219,8 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, &
! !LOCAL VARIABLES:
integer :: p,c,l,g ! indices
integer :: hpindex ! history buffer pointer index
- character(len=8) :: l_type1d ! 1d data type
- character(len=8) :: l_type1d_out ! 1d output type
+ character(len=hist_dim_name_length) :: l_type1d ! 1d data type
+ character(len=hist_dim_name_length) :: l_type1d_out ! 1d output type
character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column
character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits
character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells
@@ -4400,8 +4445,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
integer :: p,c,l,g ! indices
integer :: num2d ! size of second dimension (e.g. number of vertical levels)
integer :: hpindex ! history buffer index
- character(len=8) :: l_type1d ! 1d data type
- character(len=8) :: l_type1d_out ! 1d output type
+ character(len=hist_dim_name_length) :: l_type1d ! 1d data type
+ character(len=hist_dim_name_length) :: l_type1d_out ! 1d output type
character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column
character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits
character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells
@@ -4447,17 +4492,29 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
num2d = numrad
case ('levdcmp')
num2d = nlevdecomp_full
- case ('levscls')
+ case ('fates_levscls')
num2d = nlevsclass_ed
- case ('levpft')
+ case ('fates_levpft')
num2d = mxpft
- case ('levage')
+ case ('fates_levage')
num2d = nlevage_ed
- case ('levscpf')
+ case ('fates_levfuel')
+ num2d = nfsc
+ case ('fates_levcwdsc')
+ num2d = ncwd
+ case ('fates_levscpf')
num2d = nlevsclass_ed*mxpft
- case('ltype')
+ case ('fates_levscag')
+ num2d = nlevsclass_ed*nlevage_ed
+ case ('fates_levcan')
+ num2d = nclmax
+ case ('fates_levcnlf')
+ num2d = nlevleaf * nclmax
+ case ('fates_levcnlfpf')
+ num2d = nlevleaf * nclmax * numpft_ed
+ case ('ltype')
num2d = max_lunit
- case('natpft')
+ case ('natpft')
num2d = natpft_size
case('cft')
if (cft_size > 0) then
diff --git a/components/clm/src/main/paramUtilMod.F90 b/components/clm/src/main/paramUtilMod.F90
index 75a85e3e6c..96c95440e7 100644
--- a/components/clm/src/main/paramUtilMod.F90
+++ b/components/clm/src/main/paramUtilMod.F90
@@ -11,14 +11,22 @@ module paramUtilMod
module procedure readNcdioScalar
module procedure readNcdioArray1d
module procedure readNcdioArray2d
+ module procedure readNcdioScalarCheckDimensions
+ module procedure readNcdioArray1dCheckDimensions
+ module procedure readNcdioArray2dCheckDimensions
end interface
public :: readNcdioScalar
public :: readNcdioArray1d
public :: readNcdioArray2d
+ public :: readNcdioScalarCheckDimensions
+ public :: readNcdioArray1dCheckDimensions
+ public :: readNcdioArray2dCheckDimensions
public :: readNcdio
+ private :: checkDimensions
+
contains
!-----------------------------------------------------------------------
!
@@ -128,4 +136,156 @@ subroutine readNcdioArray2d(ncid, varName, callingName, retVal)
end subroutine readNcdioArray2d
!-----------------------------------------------------------------------
+ !-----------------------------------------------------------------------
+ !
+ !-----------------------------------------------------------------------
+ subroutine readNcdioScalarCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, &
+ callingName, retVal)
+ !
+ ! read the netcdf file...generic, could be used for any parameter read
+ !
+ use abortutils , only : endrun
+ use ncdio_pio , only : file_desc_t
+
+ implicit none
+
+ ! arguments
+ type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ character(len=*), intent(in) :: varName ! variable we are reading
+ integer, intent(in) :: expected_numDims
+ character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name
+ character(len=*), intent(in) :: callingName ! calling routine
+ real(r8), intent(inout) :: retVal
+
+ ! local vars
+ character(len=32) :: subname = 'readNcdio::'
+ character(len=100) :: errCode = ' - Error reading. Var: '
+
+ !
+ ! netcdf read here
+ !
+ call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname)
+ call readNcdio(ncid, varName, callingName, retVal)
+
+ end subroutine readNcdioScalarCheckDimensions
+ !-----------------------------------------------------------------------
+
+ !-----------------------------------------------------------------------
+ !
+ !-----------------------------------------------------------------------
+ subroutine readNcdioArray1dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, &
+ callingName, retVal)
+ !
+ ! read the netcdf file...generic, could be used for any parameter read
+ !
+ use abortutils , only : endrun
+ use ncdio_pio , only : file_desc_t
+
+ implicit none
+
+ ! arguments
+ type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ character(len=*), intent(in) :: varName ! variable we are reading
+ integer, intent(in) :: expected_numDims
+ character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name
+ character(len=*), intent(in) :: callingName ! calling routine
+ real(r8), intent(inout) :: retVal( 1: )
+
+ ! local vars
+ character(len=32) :: subname = 'readNcdio::'
+ character(len=100) :: errCode = ' - Error reading. Var: '
+ !
+ ! netcdf read here
+ !
+ call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname)
+ call readNcdio(ncid, varName, callingName, retVal)
+
+ end subroutine readNcdioArray1dCheckDimensions
+ !-----------------------------------------------------------------------
+
+ !-----------------------------------------------------------------------
+ !
+ !-----------------------------------------------------------------------
+ subroutine readNcdioArray2dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, &
+ callingName, retVal)
+ !
+ ! read the netcdf file...generic, could be used for any parameter read
+ !
+ use abortutils , only : endrun
+ use ncdio_pio , only : file_desc_t
+
+ implicit none
+
+ ! arguments
+ type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ character(len=*), intent(in) :: varName ! variable we are reading
+ integer, intent(in) :: expected_numDims
+ character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name
+ character(len=*), intent(in) :: callingName ! calling routine
+ real(r8), intent(inout) :: retVal(1:, : )
+
+ ! local vars
+ character(len=32) :: subname = 'readNcdio::'
+ character(len=100) :: errCode = ' - Error reading. Var: '
+ !
+ ! netcdf read here
+ !
+ call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname)
+ call readNcdio(ncid, varName, callingName, retVal)
+
+ end subroutine readNcdioArray2dCheckDimensions
+ !-----------------------------------------------------------------------
+
+ !-----------------------------------------------------------------------
+ !
+ !-----------------------------------------------------------------------
+ subroutine checkDimensions(ncid, varName, expected_numDims, expected_dimNames, callingName)
+ !
+ ! Assert that the expected number of dimensions and dimension
+ ! names for a variable match the actual names on the file.
+ !
+ use abortutils , only : endrun
+ use ncdio_pio , only : file_desc_t, var_desc_t, check_var, ncd_inqvdname, ncd_inqvdims
+
+ implicit none
+
+ ! arguments
+ type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
+ character(len=*), intent(in) :: varName ! variable we are reading
+ integer, intent(in) :: expected_numDims ! number of expected dimensions on the variable
+ character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension names
+ character(len=*), intent(in) :: callingName ! calling routine
+ integer :: error_num
+
+ ! local vars
+ character(len=32) :: subname = 'checkDimensions::'
+ type(Var_desc_t) :: var_desc ! variable descriptor
+ logical :: readvar ! whether the variable was found
+ character(len=100) :: received_dimName
+ integer :: d, num_dims
+ character(len=256) :: msg
+
+ call check_var(ncid, varName, var_desc, readvar)
+ if (readvar) then
+ call ncd_inqvdims(ncid, num_dims, var_desc)
+ if (num_dims /= expected_numDims) then
+ write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: expected number of dimensions = ", &
+ expected_numDims, " num dimensions received from file = ", num_dims
+ call endrun(msg)
+ end if
+ do d = 1, num_dims
+ received_dimName = ''
+ call ncd_inqvdname(ncid, varname=trim(varName), dimnum=d, dname=received_dimName, err_code=error_num)
+ if (trim(expected_dimNames(d)) /= trim(received_dimName)) then
+ write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: dimension ", d, &
+ " expected dimension name '"//trim(expected_dimNames(d))//&
+ "' dimension name received from file '"//trim(received_dimName)//"'."
+ call endrun(msg)
+ end if
+ end do
+ end if
+
+ end subroutine checkDimensions
+ !-----------------------------------------------------------------------
+
end module paramUtilMod
diff --git a/components/clm/src/main/pftconMod.F90 b/components/clm/src/main/pftconMod.F90
index 4bbd9978ae..902ae462fa 100644
--- a/components/clm/src/main/pftconMod.F90
+++ b/components/clm/src/main/pftconMod.F90
@@ -465,7 +465,7 @@ subroutine InitRead(this)
use ncdio_pio , only : ncd_inqdid, ncd_inqdlen
use clm_varctl , only : paramfile, use_ed, use_flexibleCN, use_dynroot
use spmdMod , only : masterproc
- use EDPftvarcon , only : EDpftconrd
+ use CLMFatesParamInterfaceMod, only : FatesReadPFTs
!
! !ARGUMENTS:
class(pftcon_type) :: this
@@ -975,13 +975,6 @@ subroutine InitRead(this)
if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
end if
- !
- ! ED variables
- !
- if ( use_ed ) then
- ! The following sets the module variable EDpftcon_inst in EDPftcon
- call EDpftconrd ( ncid )
- endif
!
! Dynamic Root variables for crops
!
@@ -992,6 +985,8 @@ subroutine InitRead(this)
call ncd_pio_closefile(ncid)
+ call FatesReadPFTs()
+
do i = 0, mxpft
if (.not. use_ed)then
if ( trim(adjustl(pftname(i))) /= trim(expected_pftnames(i)) )then
@@ -1358,6 +1353,5 @@ subroutine Clean(this)
end subroutine Clean
-
end module pftconMod
diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90
index 5f16421700..b43009fb09 100644
--- a/components/clm/src/main/readParamsMod.F90
+++ b/components/clm/src/main/readParamsMod.F90
@@ -17,6 +17,7 @@ module readParamsMod
private
!
public :: readParameters
+
!-----------------------------------------------------------------------
contains
@@ -25,9 +26,6 @@ module readParamsMod
subroutine readParameters (nutrient_competition_method, photosyns_inst)
!
! ! USES:
- use EDSharedParamsMod , only : EDParamsReadShared
- use EDParamsMod , only : EDParamsRead
- use SFParamsMod , only : SFParamsRead
use CNSharedParamsMod , only : CNParamsReadShared
use CNGapMortalityMod , only : readCNGapMortParams => readParams
use CNMRespMod , only : readCNMRespParams => readParams
@@ -45,6 +43,8 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst)
use NutrientCompetitionMethodMod , only : nutrient_competition_method_type
use clm_varctl, only : NLFilename_in
use PhotosynthesisMod , only : photosyns_type
+
+ use CLMFatesParamInterfaceMod , only : FatesReadParameters
!
! !ARGUMENTS:
type(photosyns_type) , intent(in) :: photosyns_inst
@@ -67,15 +67,6 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst)
call ncd_inqdid(ncid,'pft',dimid)
call ncd_inqdlen(ncid,dimid,npft)
- !
- ! Ecosystem Dynamics model
- !
- if (use_ed) then
- call EDParamsReadShared(ncid)
- call EDParamsRead(ncid)
- call SFParamsRead(ncid)
- end if
-
!
! Above ground biogeochemistry...
!
@@ -113,6 +104,8 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst)
!
call ncd_pio_closefile(ncid)
+ call FatesReadParameters()
+
end subroutine readParameters
end module readParamsMod
diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90
index 5034c355fd..5f66645579 100644
--- a/components/clm/src/utils/clmfates_interfaceMod.F90
+++ b/components/clm/src/utils/clmfates_interfaceMod.F90
@@ -163,7 +163,6 @@ module CLMFatesInterfaceMod
end type hlm_fates_interface_type
-
logical :: DEBUG = .false.
character(len=*), parameter, private :: sourcefile = &
@@ -1309,7 +1308,6 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, &
use perf_mod , only : t_startf, t_stopf
use PatchType , only : patch
use quadraticMod , only : quadratic
- use EDSharedParamsMod , only : EDParamsShareInst
use EDTypesMod , only : numpft_ed, dinc_ed
use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed
use EDEcophysContype , only : EDecophyscon
@@ -1624,6 +1622,8 @@ subroutine init_history_io(this,bounds_proc)
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 FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8
+ use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8
use FatesIODimensionsMod, only : fates_bounds_type
@@ -1812,6 +1812,61 @@ subroutine init_history_io(this,bounds_proc)
ptr_col=this%fates_hist%hvars(ivar)%r82d, &
default=trim(vdefault), &
set_lake=0._r8,set_urb=0._r8)
+ case(site_fuel_r8)
+ d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index
+ dim2name = this%fates_hist%dim_bounds(d_index)%name
+ call hist_addfld2d(fname=trim(vname),units=trim(vunits), &
+ type2d=trim(dim2name), &
+ avgflag=trim(vavgflag),long_name=trim(vlong), &
+ ptr_col=this%fates_hist%hvars(ivar)%r82d, &
+ default=trim(vdefault), &
+ set_lake=0._r8,set_urb=0._r8)
+ case(site_cwdsc_r8)
+ d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index
+ dim2name = this%fates_hist%dim_bounds(d_index)%name
+ call hist_addfld2d(fname=trim(vname),units=trim(vunits), &
+ type2d=trim(dim2name), &
+ avgflag=trim(vavgflag),long_name=trim(vlong), &
+ ptr_col=this%fates_hist%hvars(ivar)%r82d, &
+ default=trim(vdefault), &
+ set_lake=0._r8,set_urb=0._r8)
+ case(site_can_r8)
+ d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index
+ dim2name = this%fates_hist%dim_bounds(d_index)%name
+ call hist_addfld2d(fname=trim(vname),units=trim(vunits), &
+ type2d=trim(dim2name), &
+ avgflag=trim(vavgflag),long_name=trim(vlong), &
+ ptr_col=this%fates_hist%hvars(ivar)%r82d, &
+ default=trim(vdefault), &
+ set_lake=0._r8,set_urb=0._r8)
+ case(site_cnlf_r8)
+ d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index
+ dim2name = this%fates_hist%dim_bounds(d_index)%name
+ call hist_addfld2d(fname=trim(vname),units=trim(vunits), &
+ type2d=trim(dim2name), &
+ avgflag=trim(vavgflag),long_name=trim(vlong), &
+ ptr_col=this%fates_hist%hvars(ivar)%r82d, &
+ default=trim(vdefault), &
+ set_lake=0._r8,set_urb=0._r8)
+ case(site_cnlfpft_r8)
+ d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index
+ dim2name = this%fates_hist%dim_bounds(d_index)%name
+ call hist_addfld2d(fname=trim(vname),units=trim(vunits), &
+ type2d=trim(dim2name), &
+ avgflag=trim(vavgflag),long_name=trim(vlong), &
+ ptr_col=this%fates_hist%hvars(ivar)%r82d, &
+ default=trim(vdefault), &
+ set_lake=0._r8,set_urb=0._r8)
+ case(site_scag_r8)
+ d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index
+ dim2name = this%fates_hist%dim_bounds(d_index)%name
+ call hist_addfld2d(fname=trim(vname),units=trim(vunits), &
+ type2d=trim(dim2name), &
+ avgflag=trim(vavgflag),long_name=trim(vlong), &
+ ptr_col=this%fates_hist%hvars(ivar)%r82d, &
+ default=trim(vdefault), &
+ set_lake=0._r8,set_urb=0._r8)
+
case default
write(iulog,*) 'A FATES iotype was created that was not registerred'
@@ -1827,6 +1882,8 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates)
use FatesIODimensionsMod, only : fates_bounds_type
use EDtypesMod, only : nlevsclass_ed, nlevage_ed
+ use EDtypesMod, only : nfsc, ncwd
+ use EDtypesMod, only : nlevleaf, nclmax, numpft_ed
use clm_varpar, only : mxpft, nlevgrnd
implicit none
@@ -1859,6 +1916,24 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates)
fates%age_class_begin = 1
fates%age_class_end = nlevage_ed
+
+ fates%sizeage_class_begin = 1
+ fates%sizeage_class_end = nlevsclass_ed * nlevage_ed
+
+ fates%fuel_begin = 1
+ fates%fuel_end = nfsc
+
+ fates%cwdsc_begin = 1
+ fates%cwdsc_end = ncwd
+
+ fates%can_begin = 1
+ fates%can_end = nclmax
+
+ fates%cnlf_begin = 1
+ fates%cnlf_end = nlevleaf * nclmax
+
+ fates%cnlfpft_begin = 1
+ fates%cnlfpft_end = nlevleaf * nclmax * numpft_ed
end subroutine hlm_bounds_to_fates_bounds
diff --git a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 b/components/clm/src/utils/clmfates_paraminterfaceMod.F90
new file mode 100644
index 0000000000..2d9ac58bb5
--- /dev/null
+++ b/components/clm/src/utils/clmfates_paraminterfaceMod.F90
@@ -0,0 +1,237 @@
+module CLMFatesParamInterfaceMod
+ ! NOTE(bja, 2017-01) this code can not go into the main clm-fates
+ ! interface module because of circular dependancies with pftvarcon.
+
+ use FatesGlobals, only : fates_log
+
+ implicit none
+
+ ! NOTE(bja, 2017-01) these methods can NOT be part of the clmi-fates
+ ! nterface type because they are called before the instance is
+ ! initialized.
+ public :: FatesReadParameters
+ public :: FatesReadPFTs
+ private :: ParametersFromNetCDF
+ private :: SetParameterDimensions
+ private :: GetUsedDimensionSizes
+
+ logical :: DEBUG = .false.
+
+ character(len=*), parameter, private :: sourcefile = &
+ __FILE__
+
+contains
+
+ !-----------------------------------------------------------------------
+ subroutine FatesReadParameters()
+
+ use clm_varctl, only : use_ed, paramfile, fates_paramfile
+ use spmdMod, only : masterproc
+
+ use FatesParametersInterface, only : fates_parameters_type
+
+ use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams
+ use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams
+ use FatesSynchronizedParamsMod, only : FatesSynchronizedParamsInst
+
+ implicit none
+
+ character(len=32) :: subname = 'FatesReadParameters'
+ class(fates_parameters_type), allocatable :: fates_params
+ logical :: is_host_file
+
+ if (use_ed) then
+ if (masterproc) then
+ write(fates_log(), *) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' parameters '
+ end if
+
+ allocate(fates_params)
+ call fates_params%Init()
+ call FatesRegisterParams(fates_params)
+ call SpitFireRegisterParams(fates_params)
+ call FatesSynchronizedParamsInst%RegisterParams(fates_params)
+
+ is_host_file = .false.
+ call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params)
+
+ is_host_file = .true.
+ call ParametersFromNetCDF(paramfile, is_host_file, fates_params)
+
+ call FatesReceiveParams(fates_params)
+ call SpitFireReceiveParams(fates_params)
+ call FatesSynchronizedParamsInst%ReceiveParams(fates_params)
+
+ call fates_params%Destroy()
+ deallocate(fates_params)
+ end if
+
+ end subroutine FatesReadParameters
+
+ !-----------------------------------------------------------------------
+ subroutine FatesReadPFTs()
+
+ use clm_varctl, only : use_ed, paramfile, fates_paramfile
+ use spmdMod, only : masterproc
+
+ use FatesParametersInterface, only : fates_parameters_type
+ use EDPftvarcon , only : EDPftvarcon_inst
+
+ use fileutils , only : getfil
+ use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile
+
+ implicit none
+
+ character(len=32) :: subname = 'FatesReadPFTs'
+ class(fates_parameters_type), allocatable :: fates_params
+ logical :: is_host_file
+
+ character(len=256) :: locfn ! local file name
+ type(file_desc_t) :: ncid ! pio netCDF file id
+
+ if (use_ed) then
+ if (masterproc) then
+ write(fates_log(), *) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' PFTs '
+ end if
+
+ allocate(fates_params)
+ call fates_params%Init()
+ call EDPftvarcon_inst%Init()
+
+ call EDPftvarcon_inst%Register(fates_params)
+
+ is_host_file = .false.
+ call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params)
+
+ is_host_file = .true.
+ call ParametersFromNetCDF(paramfile, is_host_file, fates_params)
+
+ call EDPftvarcon_inst%Receive(fates_params)
+
+ call fates_params%Destroy()
+ deallocate(fates_params)
+ end if
+
+ end subroutine FatesReadPFTs
+
+ !-----------------------------------------------------------------------
+ subroutine SetParameterDimensions(ncid, is_host_file, fates_params)
+ ! Get the list of dimensions used by the fates parameters,
+ ! retreive them from the parameter file, then give the information
+ ! back to fates.
+ use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions
+ use ncdio_pio , only : file_desc_t
+
+ implicit none
+
+ type(file_desc_t), intent(inout) :: ncid
+ logical, intent(in) :: is_host_file
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ integer :: num_used_dimensions
+ character(len=param_string_length) :: used_dimension_names(max_used_dimensions)
+ integer :: used_dimension_sizes(max_used_dimensions)
+
+ call fates_params%GetUsedDimensions(is_host_file, num_used_dimensions, used_dimension_names)
+
+ call GetUsedDimensionSizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes)
+
+ call fates_params%SetDimensionSizes(is_host_file, num_used_dimensions, used_dimension_names, used_dimension_sizes)
+
+ end subroutine SetParameterDimensions
+
+ !-----------------------------------------------------------------------
+ subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dimension_sizes)
+
+ use ncdio_pio , only : ncd_inqdid, ncd_inqdlen
+ use FatesParametersInterface, only : param_string_length
+ use ncdio_pio, only : file_desc_t
+
+
+ implicit none
+
+ type(file_desc_t), intent(inout) :: ncid
+ integer, intent(in) :: num_used_dimensions
+ character(len=param_string_length), intent(in) :: dimension_names(:)
+ integer, intent(out) :: dimension_sizes(:)
+
+ integer :: d, max_dim_size, num_dims
+ integer :: dim_len, dim_id
+
+ dimension_sizes(:) = 0
+ max_dim_size = 0
+
+ do d = 1, num_used_dimensions
+ call ncd_inqdid(ncid, dimension_names(d), dim_id)
+ call ncd_inqdlen(ncid, dim_id, dim_len)
+ dimension_sizes(d) = dim_len
+ !write(*, *) '--> ', trim(dimension_names(d)), ' setting size ', dimension_sizes(d)
+ end do
+
+ end subroutine GetUsedDimensionSizes
+
+ !-----------------------------------------------------------------------
+ subroutine ParametersFromNetCDF(filename, is_host_file, fates_params)
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use abortutils, only : endrun
+ use fileutils , only : getfil
+ use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile
+ use paramUtilMod, only : readNcdio
+
+ use FatesParametersInterface, only : fates_parameters_type
+ use FatesParametersInterface, only : param_string_length, max_dimensions, max_used_dimensions
+ use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d
+
+ implicit none
+
+ character(len=*), intent(in) :: filename
+ logical, intent(in) :: is_host_file
+ class(fates_parameters_type), intent(inout) :: fates_params
+
+ character(len=32) :: subname = 'clmfates_interface::ReadParameters'
+ character(len=256) :: locfn ! local file name
+ type(file_desc_t) :: ncid ! pio netCDF file id
+ integer :: dimid ! netCDF dimension id
+ integer :: i, num_params, dimension_shape
+ integer :: max_dim_size
+ real(r8), allocatable :: data(:, :)
+ character(len=param_string_length) :: name
+ integer :: dimension_sizes(max_dimensions)
+ character(len=param_string_length) :: dimension_names(max_dimensions)
+ integer :: size_dim_1, size_dim_2
+ logical :: is_host_param
+
+ call getfil (filename, locfn, 0)
+ call ncd_pio_openfile (ncid, trim(locfn), 0)
+
+ call SetParameterDimensions(ncid, is_host_file, fates_params)
+ max_dim_size = fates_params%GetMaxDimensionSize()
+ allocate(data(max_dim_size, max_dim_size))
+
+ num_params = fates_params%num_params()
+ do i = 1, num_params
+ call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, dimension_names, is_host_param)
+ if (is_host_file .eqv. is_host_param) then
+ select case(dimension_shape)
+ case(dimension_shape_scalar)
+ size_dim_1 = 1
+ size_dim_2 = 1
+ case(dimension_shape_1d)
+ size_dim_1 = dimension_sizes(1)
+ size_dim_2 = 1
+ case(dimension_shape_2d)
+ size_dim_1 = dimension_sizes(1)
+ size_dim_2 = dimension_sizes(2)
+ case default
+ call endrun(msg='unsupported number of dimensions reading parameters.')
+ end select
+ call readNcdio(ncid, name, dimension_shape, dimension_names, subname, data(1:size_dim_1, 1:size_dim_2))
+ call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2))
+ end if
+ end do
+ deallocate(data)
+ call ncd_pio_closefile(ncid)
+ end subroutine ParametersFromNetCDF
+ !-----------------------------------------------------------------------
+
+end module CLMFatesParamInterfaceMod