From fdd35050fc051b0a3fe03c0edba23e48490e27a8 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Wed, 24 Feb 2016 16:40:29 -0700 Subject: [PATCH 1/8] Changed temporary_spitfire_switch to 1 --- components/clm/src/ED/fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index 60194c1735..f63c60c263 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -56,7 +56,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 0 + temporary_SF_switch = 1 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 From 1d4238ae0c1a597639c2d1c0dd73af37e2843595 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Fri, 7 Oct 2016 14:02:33 -0600 Subject: [PATCH 2/8] Modified two bugs in effective windspeed and in livegrass moisture found in SPITFIRE. --- components/clm/src/ED/fire/SFMainMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index f63c60c263..e907a01303 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -222,7 +222,7 @@ subroutine charecteristics_of_fuel ( currentSite ) ! average water content !is this the correct metric? timeav_swc = sum(currentSite%water_memory(1:10)) / 10._r8 ! Equation B2 in Thonicke et al. 2010 - fuel_moisture(dg_sf) = max(0.0_r8, 10.0_r8/9._r8 * timeav_swc - 1.0_r8/9.0_r8) + fuel_moisture(lg_sf) = max(0.0_r8, 10.0_r8/9._r8 * timeav_swc - 1.0_r8/9.0_r8) ! Average properties over the first four litter pools (dead leaves, twigs, s branches, l branches) currentPatch%fuel_bulkd = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * SF_val_FBD(dg_sf:lb_sf)) @@ -363,7 +363,7 @@ subroutine wind_effect ( currentSite, atm2lnd_inst) do while(associated(currentPatch)) currentPatch%total_tree_area = min(currentPatch%total_tree_area,currentPatch%area) - currentPatch%effect_wspeed = wind * (tree_fraction*0.6+grass_fraction*0.4+bare_fraction*1.0) + currentPatch%effect_wspeed = wind * (tree_fraction*0.4+(grass_fraction+bare_fraction)*0.6) currentPatch => currentPatch%younger enddo !end patch loop From a246d580651cb5a3573e4263b4248ff2848f9473 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Fri, 14 Oct 2016 10:14:45 -0600 Subject: [PATCH 3/8] turned off SPITFIRE temporary switch for testing --- components/clm/src/ED/fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index f86b006c6c..3e6606d27d 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -56,7 +56,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 1 + temporary_SF_switch = 0 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 From 32bc16a78f2204ba0363223b4d6f924b7f089a25 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Wed, 19 Oct 2016 08:22:38 -0600 Subject: [PATCH 4/8] turn temp_sf_switch on --- components/clm/src/ED/fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index 3e6606d27d..f86b006c6c 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -56,7 +56,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 0 + temporary_SF_switch = 1 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 From 824e36c99ec5f21204b9bae3997b728180d82243 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Mon, 14 Nov 2016 13:41:23 -0700 Subject: [PATCH 5/8] Altered test scripts to make spitfire off by default, and add a single SPITFIRE test into the test suite. --- components/clm/cime_config/testdefs/testlist_clm.xml | 2 +- .../testmods_dirs/clm/{edNoFire => edFire}/include_user_mods | 0 .../testmods_dirs/clm/{edNoFire => edFire}/shell_commands | 0 .../cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm | 2 ++ .../cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm | 2 -- 5 files changed, 3 insertions(+), 3 deletions(-) rename components/clm/cime_config/testdefs/testmods_dirs/clm/{edNoFire => edFire}/include_user_mods (100%) rename components/clm/cime_config/testdefs/testmods_dirs/clm/{edNoFire => edFire}/shell_commands (100%) create mode 100644 components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm delete mode 100644 components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml index 512908b01b..24c39ef75a 100644 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ b/components/clm/cime_config/testdefs/testlist_clm.xml @@ -721,7 +721,7 @@ ed - ed + ed hobart yellowstone diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/include_user_mods b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/include_user_mods similarity index 100% rename from components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/include_user_mods rename to components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/include_user_mods diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/shell_commands b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/shell_commands similarity index 100% rename from components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/shell_commands rename to components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/shell_commands diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm new file mode 100644 index 0000000000..7295965ba5 --- /dev/null +++ b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm @@ -0,0 +1,2 @@ +use_ed_spit_fire = .true. + diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm b/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm deleted file mode 100644 index 05070adc21..0000000000 --- a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm +++ /dev/null @@ -1,2 +0,0 @@ -use_ed_spit_fire = .false. - From 7ece58c53e61ad1fea001ed1c4bb9a7c5754d165 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Mon, 14 Nov 2016 13:50:12 -0700 Subject: [PATCH 6/8] Changes to namelist defaults to turn spitfire off --- .../namelist_defaults_clm4_5.xml | 2 +- .../clm/cime_config/testdefs/testlist_clm.xml | 1602 ----------------- .../ED/biogeochem/EDCanopyStructureMod.F90 | 30 +- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 57 +- .../src/ED/biogeophys/EDPhotosynthesisMod.F90 | 357 ++-- components/clm/src/ED/main/EDTypesMod.F90 | 22 +- .../clm/src/ED/main/FatesConstantsMod.F90 | 41 + .../src/ED/main/FatesHistoryDimensionMod.F90 | 92 + ...IOMod.F90 => FatesHistoryInterfaceMod.F90} | 1510 ++++++++-------- .../src/ED/main/FatesHistoryVarKindMod.F90 | 91 + .../src/ED/main/FatesHistoryVariableType.F90 | 221 +++ .../clm/src/utils/clmfates_interfaceMod.F90 | 219 +-- 12 files changed, 1589 insertions(+), 2655 deletions(-) delete mode 100644 components/clm/cime_config/testdefs/testlist_clm.xml create mode 100644 components/clm/src/ED/main/FatesHistoryDimensionMod.F90 rename components/clm/src/ED/main/{HistoryIOMod.F90 => FatesHistoryInterfaceMod.F90} (53%) create mode 100644 components/clm/src/ED/main/FatesHistoryVarKindMod.F90 create mode 100644 components/clm/src/ED/main/FatesHistoryVariableType.F90 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 2afd482e67..53348abe3a 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -1973,6 +1973,6 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_simyr1850_c160216.nc .false. .false. -.true. +.false. diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml deleted file mode 100644 index 24c39ef75a..0000000000 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ /dev/null @@ -1,1602 +0,0 @@ - - - - - - yellowstone - - - null - - - - - hobart - - - - - yellowstone - - - - - edison - yellowstone - - - edison - yellowstone - yellowstone - - - - - edison - edison - edison - hobart - hobart - janus - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - - - - - yellowstone - - - - - null - - - - - null - - - - - null - - - - - null - - - - - yellowstone - - - edison - - - - - null - - - - - null - - - - - null - - - - - null - - - - - null - - - - - - - null - - - - - hobart - - - - - hobart - - - - - yellowstone - yellowstone - - - edison - - - null - - - - - - - yellowstone - - - hobart - - - yellowstone - yellowstone - yellowstone - - - hobart - hobart - - - yellowstone - yellowstone - yellowstone - - - edison - - - yellowstone - - - yellowstone - - - - - edison - yellowstone - - - yellowstone - - - edison - hobart - yellowstone - yellowstone - - - - - - - null - - - - - edison - edison - yellowstone - yellowstone - - - hobart - - - - - - - hobart - - - - - - - null - - - - - hobart - - - - - edison - yellowstone - - - yellowstone - - - edison - - - - - yellowstone - - - - - edison - hopper - - - - - - - edison - yellowstone - - - - - null - - - - - - - null - - - - - - - yellowstone - - - - - - - null - - - - - - - null - - - - - - - hobart - janus - yellowstone - yellowstone - yellowstone - - - - - null - - - - - hobart - - - - - - - hobart - - - hobart - - - edison - yellowstone - - - - - null - - - - - edison - yellowstone - - - yellowstone - - - hobart - - - - - edison - yellowstone - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - hobart - - - - - - - null - - - - - null - - - - - janus - yellowstone - yellowstone - yellowstone - - - - - edison - - - null - - - - - - - null - - - - - null - - - - - - - null - - - - - null - - - - - yellowstone - - - - - yellowstone - - - - - yellowstone - - - - - edison - yellowstone - - - - - hobart - - - yellowstone - yellowstone - - - - - hobart - yellowstone - yellowstone - - - hobart - yellowstone - yellowstone - - - hobart - hobart - yellowstone - yellowstone - yellowstone - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - - - ed - edison - yellowstone - yellowstone - - - edison - yellowstone - yellowstone - - - yellowstone - - - - - edison - yellowstone - yellowstone - yellowstone - - - hobart - - - edison - yellowstone - yellowstone - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - edison - hobart - yellowstone - yellowstone - - - hobart - - - yellowstone - - - hobart - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - - - hobart - - - ed - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - - - - - edison - yellowstone - - - edison - yellowstone - - - yellowstone - - - yellowstone - yellowstone - - - - - edison - edison - yellowstone - - - hobart - - - yellowstone - - - yellowstone - - - - - - - yellowstone - - - yellowstone - - - hobart - - - - - yellowstone - - - - - yellowstone - - - yellowstone - - - yellowstone - - - yellowstone - yellowstone - - - edison - - - yellowstone - - - hobart - - - yellowstone - - - yellowstone - - - yellowstone - - - - - yellowstone - - - edison - - - - - - - yellowstone - - - yellowstone - - - - - yellowstone - - - edison - - - - - yellowstone - - - edison - - - - - - - yellowstone - yellowstone - - - yellowstone - - - - - - - yellowstone - - - - - - - ed - hobart - yellowstone - yellowstone - yellowstone - - - - - ed - yellowstone - - - ed - hobart - yellowstone - yellowstone - - - - - ed - yellowstone - - - - - ed - ed - hobart - yellowstone - - - ed - hobart - yellowstone - yellowstone - yellowstone - - - ed - yellowstone - yellowstone - - - - - ed - - - ed - yellowstone - yellowstone - - - - - ed - yellowstone - - - ed - yellowstone - - - - - ed - - - - - - - yellowstone - - - - - - - edison - yellowstone - - - edison - yellowstone - - - - - edison - yellowstone - - - edison - yellowstone - - - - - edison - yellowstone - - - - - - - yellowstone - - - - - - - yellowstone - - - - - hobart - - - - - edison - - - edison - - - yellowstone - - - - - - - hobart - - - edison - janus - yellowstone - yellowstone - yellowstone - yellowstone - - - - - edison - eos - hopper - titan - - - - - edison - - - yellowstone - - - - - edison - yellowstone - - - - - - - edison - - - yellowstone - - - - - - - null - - - - - - - yellowstone - - - - - edison - yellowstone - yellowstone - - - hobart - - - - - null - - - - - - - edison - hopper - janus - - - - - edison - yellowstone - - - yellowstone - - - null - - - - - - - edison - edison - yellowstone - - - - - - - edison - yellowstone - yellowstone - - - hobart - - - edison - yellowstone - yellowstone - yellowstone - - - yellowstone - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - - - hobart - hobart - hobart - hobart - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - - - edison - - - edison - - - yellowstone - yellowstone - yellowstone - - - yellowstone - yellowstone - - - - - yellowstone - - - - - - - yellowstone - - - hobart - - - yellowstone - - - - - yellowstone - - - yellowstone - - - - - - - edison - - - null - - - - - - - null - - - - - - - yellowstone - - - - - null - - - - - edison - - - yellowstone - - - yellowstone - - - edison - yellowstone - yellowstone - - - - - - - edison - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - - - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - - - - - null - - - - - - - null - - - - - - - null - - - - - null - - - - - - - yellowstone - - - - - null - - - - - - - null - - - - - - - null - - - - - - - null - - - - - hobart - - - - - - - null - - - - - null - - - - - - - null - - - - - null - - - - - - - null - - - - - edison - - - yellowstone - - - - - - - null - - - - - null - - - - - - - null - - - - - - - hobart - - - - - null - - - - - null - - - - - null - - - - - null - - - - - null - - - - - - - null - - - - - - - yellowstone - - - yellowstone - - - yellowstone - - - - - hobart - yellowstone - yellowstone - - - yellowstone - - - hobart - - - yellowstone - - - - - edison - - - - - - - yellowstone - - - yellowstone - - - - - yellowstone - - - - - - - yellowstone - - - hobart - - - - - - - edison - yellowstone - yellowstone - - - - - bluewaters - edison - eos - hopper - titan - - - - - null - - - - - - - edison - - - - - null - - - - - - - yellowstone - - - - - - - null - - - - - - - null - - - - - null - - - - - hobart - - - - - null - - - - - null - - - - - null - - - - - - - hobart - - - - - edison - yellowstone - yellowstone - - - - - - - null - - - - - null - - - - - hobart - - - - - edison - yellowstone - - - - - null - - - - - null - - - - - - - null - - - - - - - null - - - - - null - - - - - null - - - - - null - - - - - null - - - - - - - null - - - - - edison - yellowstone - - - - - - - null - - - - - - - null - - - - - null - - - - - edison - yellowstone - - - - - null - - - - - null - - - - - - - null - - - - - null - - - janus - yellowstone - yellowstone - yellowstone - - - - - edison - hobart - hobart - hopper - - - eastwind - evergreen - olympus - yellowstone - - - - - edison - hopper - janus - yellowstone - yellowstone - yellowstone - - - - - hobart - hobart - janus - janus - - - - diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index a0056056c8..5ce6d6631f 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -546,7 +546,8 @@ subroutine canopy_structure( currentSite ) enddo if(((checkarea-currentPatch%area)) > 0.0001)then - write(fates_log(),*) 'problem with canopy area', checkarea,currentPatch%area,checkarea-currentPatch%area,i,z,missing_area + write(fates_log(),*) 'problem with canopy area', checkarea, currentPatch%area, checkarea - currentPatch%area, & + i, z, missing_area currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == i)then @@ -658,6 +659,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use FatesInterfaceMod , only : bc_in_type use EDPatchDynamicsMod , only : set_patchno + use EDCohortDynamicsMod , only : size_and_type_class_index use EDGrowthFunctionsMod , only : tree_lai, c_area use EDEcophysConType , only : EDecophyscon use EDtypesMod , only : area @@ -675,7 +677,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) integer :: ft ! plant functional type integer :: ifp integer :: patchn ! identification number for each patch. - real(r8) :: coarse_wood_frac real(r8) :: canopy_leaf_area ! total amount of leaf area in the vegetated area. m2. !---------------------------------------------------------------------- @@ -710,26 +711,13 @@ subroutine canopy_summarization( nsites, sites, bc_in ) do while(associated(currentCohort)) ft = currentCohort%pft - currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) - - currentCohort%livecrootn = 0.0_r8 - - if (pftcon%woody(ft) == 1) then - coarse_wood_frac = 0.5_r8 - else - coarse_wood_frac = 0.0_r8 - end if - - if ( DEBUG ) then - write(fates_log(),*) 'canopy_summarization 724 ',currentCohort%livecrootn - write(fates_log(),*) 'canopy_summarization 725 ',currentCohort%br - write(fates_log(),*) 'canopy_summarization 726 ',coarse_wood_frac - write(fates_log(),*) 'canopy_summarization 727 ',pftcon%leafcn(ft) - endif - - currentCohort%livecrootn = currentCohort%br * coarse_wood_frac / pftcon%leafcn(ft) + - if ( DEBUG ) write(fates_log(),*) 'canopy_summarization 732 ',currentCohort%livecrootn + ! 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) + currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore currentCohort%treelai = tree_lai(currentCohort) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index fca32709d3..cdca9ec65b 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -27,7 +27,7 @@ module EDCohortDynamicsMod public :: sort_cohorts public :: copy_cohort public :: count_cohorts -! public :: countCohorts + public :: size_and_type_class_index public :: allocate_live_biomass logical, parameter :: DEBUG = .false. ! local debug flag @@ -92,6 +92,9 @@ 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) + if ( DEBUG ) write(iulog,*) 'EDCohortDyn I ',bstore if (new_cohort%dbh <= 0.0_r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 & @@ -290,6 +293,8 @@ subroutine nan_cohort(cc_p) ! ! !USES: use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use FatesConstantsMod, only : fates_unset_int + ! ! !ARGUMENTS type (ed_cohort_type), intent(inout), target :: cc_p @@ -311,11 +316,13 @@ subroutine nan_cohort(cc_p) nullify(currentCohort%siteptr) ! VEGETATION STRUCTURE - currentCohort%pft = 999 ! pft number - currentCohort%indexnumber = 999 ! unique number for each cohort. (within clump?) - currentCohort%canopy_layer = 999 ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) - currentCohort%NV = 999 ! Number of leaf layers: - - currentCohort%status_coh = 999 ! growth status of plant (2 = leaves on , 1 = leaves off) + currentCohort%pft = fates_unset_int ! pft number + currentCohort%indexnumber = fates_unset_int ! unique number for each cohort. (within clump?) + currentCohort%canopy_layer = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + currentCohort%NV = fates_unset_int ! Number of leaf layers: - + currentCohort%status_coh = fates_unset_int ! growth status of plant (2 = leaves on , 1 = leaves off) + currentCohort%size_class = fates_unset_int ! size class index + currentCohort%size_by_pft_class = fates_unset_int ! size by pft classification index currentCohort%n = nan ! number of individuals in cohort per 'area' (10000m2 default) currentCohort%dbh = nan ! 'diameter at breast height' in cm @@ -361,7 +368,7 @@ subroutine nan_cohort(cc_p) !RESPIRATION - currentCohort%rd = nan + currentCohort%rdark = nan currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year currentCohort%resp_g = nan ! Growth respiration. kGC/cohort/year currentCohort%livestem_mr = nan ! Live stem maintenance respiration. kgC/indiv/s-1 @@ -381,11 +388,6 @@ subroutine nan_cohort(cc_p) currentCohort%leaf_litter = nan ! leaf litter from phenology: KgC/m2 currentCohort%woody_turnover = nan ! amount of wood lost each day: kgC/indiv/year. Currently set to zero. - ! NITROGEN POOLS - currentCohort%livestemn = nan ! live stem nitrogen : KgN/invid - currentCohort%livecrootn = nan ! live coarse root nitrogen: KgN/invid - currentCohort%frootn = nan ! fine root nitrogen : KgN/invid - ! VARIABLES NEEDED FOR INTEGRATION currentCohort%dndt = nan ! time derivative of cohort size currentCohort%dhdt = nan ! time derivative of height @@ -423,7 +425,7 @@ subroutine zero_cohort(cc_p) currentCohort%NV = 0 currentCohort%status_coh = 0 - currentCohort%rd = 0._r8 + currentCohort%rdark = 0._r8 currentCohort%resp_m = 0._r8 currentCohort%resp_g = 0._r8 currentCohort%livestem_mr = 0._r8 @@ -1040,18 +1042,13 @@ subroutine copy_cohort( currentCohort,copyc ) n%npp_store = o%npp_store !RESPIRATION - n%rd = o%rd + n%rdark = o%rdark n%resp_m = o%resp_m n%resp_g = o%resp_g n%livestem_mr = o%livestem_mr n%livecroot_mr = o%livecroot_mr n%froot_mr = o%froot_mr - ! NITROGEN POOLS - n%livestemn = o%livestemn - n%livecrootn = o%livecrootn - n%frootn = o%frootn - ! ALLOCATION n%md = o%md n%leaf_md = o%leaf_md @@ -1137,6 +1134,28 @@ 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 + + + !-------------------------------------------------------------------------------------! ! function countCohorts( bounds, ed_allsites_inst ) result ( totNumCohorts ) ! diff --git a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 index aecc47109f..a9e6cf5049 100644 --- a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +++ b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 @@ -9,14 +9,14 @@ module EDPhotosynthesisMod ! ! !USES: ! - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun - use clm_varctl , only : iulog + + use abortutils, only : endrun + use FatesGlobals, only : fates_log + use FatesConstantsMod, only : r8 => fates_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private - ! - ! PUBLIC MEMBER FUNCTIONS: @@ -39,38 +39,55 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! a multi-layer canopy ! ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun - use clm_varcon , only : rgas, tfrz, namep - use clm_varpar , only : nlevsoi, mxpft - use clm_varctl , only : iulog - use pftconMod , only : pftcon + 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 + ! 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 EDTypesMod , only : numpft_ed, dinc_ed - use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : dinc_ed + use EDTypesMod , only : ed_patch_type + use EDTypesMod , only : ed_cohort_type + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : numpatchespercol + use EDTypesMod , only : cp_numlevsoil + use EDTypesMod , only : cp_nlevcan + use EDTypesMod , only : cp_nclmax + use EDEcophysContype , only : EDecophyscon - use FatesInterfaceMod , only : bc_in_type,bc_out_type - use EDtypesMod , only : numpatchespercol, cp_nlevcan, cp_nclmax - use EDCanopyStructureMod,only: calc_areaindex - ! + use FatesInterfaceMod , only : bc_in_type + use FatesInterfaceMod , only : bc_out_type + + use EDCanopyStructureMod, only : calc_areaindex + + use FatesConstantsMod, only : umolC_to_kgC + use FatesConstantsMod, only : g_per_kg + use FatesConstantsMod, only : mg_per_g + use FatesConstantsMod, only : sec_per_min + use FatesConstantsMod, only : umol_per_mmol + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + ! !ARGUMENTS: + ! ----------------------------------------------------------------------------------- integer,intent(in) :: nsites type(ed_site_type),intent(inout),target :: sites(nsites) type(bc_in_type),intent(in) :: bc_in(nsites) type(bc_out_type),intent(inout) :: bc_out(nsites) real(r8),intent(in) :: dtime - ! - ! !CALLED FROM: - ! subroutine CanopyFluxes - ! + ! !LOCAL VARIABLES: + ! ----------------------------------------------------------------------------------- type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort - ! + integer , parameter :: psn_type = 2 !c3 or c4. logical :: DEBUG = .false. @@ -84,8 +101,8 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) real(r8) :: lmr_z(cp_nclmax,mxpft,cp_nlevcan) ! initial slope of CO2 response curve (C4 plants) real(r8) :: rs_z(cp_nclmax,mxpft,cp_nlevcan) ! stomatal resistance s/m real(r8) :: gs_z(cp_nclmax,mxpft,cp_nlevcan) ! stomatal conductance m/s - - real(r8) :: ci(cp_nclmax,mxpft,cp_nlevcan) ! intracellular leaf CO2 (Pa) + + real(r8) :: ci ! intracellular leaf CO2 (Pa) real(r8) :: lnc(mxpft) ! leaf N concentration (gN leaf/m^2) real(r8) :: kc( numpatchespercol ) ! Michaelis-Menten constant for CO2 (Pa) @@ -148,7 +165,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) integer :: c,CL,f,s,iv,j,ps,ft,ifp ! indices integer :: NCL_p ! number of canopy layers in patch real(r8) :: cf ! s m**2/umol -> s/m - real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] + real(r8) :: gb ! leaf boundary layer conductance (m/s) real(r8) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) @@ -180,7 +197,6 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) real(r8) :: an(cp_nclmax,mxpft,cp_nlevcan) ! net leaf photosynthesis (umol CO2/m**2/s) real(r8) :: an_av(cp_nclmax,mxpft,cp_nlevcan) ! net leaf photosynthesis (umol CO2/m**2/s) averaged over sun and shade leaves. real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) - real(r8) :: laican ! canopy sum of lai_z real(r8) :: vai ! leaf and steam area in ths layer. integer :: exitloop @@ -188,15 +204,41 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) real(r8) :: tcsoi ! Temperature response function for root respiration. real(r8) :: tc ! Temperature response function for wood - real(r8) :: br ! Base rate of root respiration. (gC/gN/s) + real(r8) :: q10 ! temperature dependence of root respiration integer :: sunsha ! sun (1) or shaded (2) leaves... - real(r8) :: dr(2) real(r8) :: coarse_wood_frac ! amount of woody biomass that is coarse... real(r8) :: tree_area real(r8) :: gs_cohort real(r8) :: rscanopy real(r8) :: elai + + real(r8) :: live_stem_n ! Live stem (above-ground sapwood) nitrogen content (kgN/plant) + real(r8) :: live_croot_n ! Live coarse root (below-ground sapwood) nitrogen content (kgN/plant) + real(r8) :: froot_n ! Fine root nitrogen content (kgN/plant) + + ! Parameters + ! ----------------------------------------------------------------------- + ! Base maintenance respiration rate for plant tissues base_mr_20 + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! + ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 + ! (gC/gN/s) + ! ------------------------------------------------------------------------ + + real(r8),parameter :: base_mr_20 = 2.525e-6_r8 + + ! maximum stomatal resistance [s/m] + real(r8),parameter :: rsmax0 = 2.e4_r8 + + ! First guess on ratio between intracellular co2 and the atmosphere + ! an iterator converges on actual + real(r8),parameter :: init_a2l_co2_c3 = 0.7_r8 + real(r8),parameter :: init_a2l_co2_c4 = 0.4_r8 + associate( & c3psn => pftcon%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 @@ -205,11 +247,9 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) 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) bb_slope => EDecophyscon%BB_slope ) ! slope of BB relationship - ! Assign local pointers to derived type members (gridcell-level) - dr(1) = 0.025_r8; dr(2) = 0.015_r8 - ! Peter Thornton: 3/13/09 ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning ! to improve seasonal cycle of atmospheric CO2 concentration in global @@ -226,7 +266,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) act25 = 3.6_r8 !umol/mgRubisco/min ! Convert rubisco activity units from umol/mgRubisco/min -> umol/gRubisco/s - act25 = act25 * 1000.0_r8 / 60.0_r8 + act25 = act25 * mg_per_g / sec_per_min ! Activation energy, from: ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 @@ -371,14 +411,6 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if bbb(FT) = max (bbbopt(ps)*currentPatch%btran_ft(FT), 1._r8) - ! THIS CALL APPEARS TO BE REDUNDANT WITH LINE 650 (RGK) - if (nint(c3psn(FT)) == 1)then - ci(:,FT,:) = 0.7_r8 * bc_in(s)%cair_pa(ifp) - else - ci(:,FT,:) = 0.4_r8 * bc_in(s)%cair_pa(ifp) - end if - - ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) lnc(FT) = 1._r8 / (slatop(FT) * leafcn(FT)) @@ -390,7 +422,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Here use a factor "1.67", from Medlyn et al (2002) Plant, Cell and Environment 25:1167-1179 !RF - copied this from the CLM trunk code, but where did it come from, and how can we make these consistant? - !jmax25top(FT) = (2.59_r8 - 0.035_r8*min(max((t10(p)-tfrz),11._r8),35._r8)) * vcmax25top(FT) + !jmax25top(FT) = (2.59_r8 - 0.035_r8*min(max((t10(p)-tfrzc),11._r8),35._r8)) * vcmax25top(FT) jmax25top(FT) = 1.67_r8 * vcmax25top(FT) tpu25top(FT) = 0.167_r8 * vcmax25top(FT) @@ -409,13 +441,6 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Leaf maintenance respiration to match the base rate used in CN ! but with the new temperature functions for C3 and C4 plants. ! - ! Base rate for maintenance respiration is from: - ! M. Ryan, 1991. Effects of climate change on plant respiration. - ! Ecological Applications, 1(2), 157-167. - ! Original expression is br = 0.0106 molC/(molN h) - ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) - ! - ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 ! ! CN respiration has units: g C / g N [leaf] / s. This needs to be ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s @@ -423,7 +448,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Then scale this value at the top of the canopy for canopy depth lmr25top(FT) = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) - lmr25top(FT) = lmr25top(FT) * lnc(FT) / 12.e-06_r8 + lmr25top(FT) = lmr25top(FT) * lnc(FT) / (umolC_to_kgC * g_per_kg) end do !FT @@ -435,7 +460,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) do iv = 1, currentPatch%nrad(CL,FT) if(currentPatch%canopy_area_profile(CL,FT,iv)>0._r8.and.currentPatch%present(CL,FT) /= 1)then - write(iulog,*) 'CF: issue with present structure',CL,FT,iv, & + write(fates_log(),*) 'CF: issue with present structure',CL,FT,iv, & currentPatch%canopy_area_profile(CL,FT,iv),currentPatch%present(CL,FT), & currentPatch%nrad(CL,FT),currentPatch%ncl_p,cp_nclmax currentPatch%present(CL,FT) = 1 @@ -520,10 +545,9 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Leaf-level photosynthesis and stomatal conductance !==============================================================================! - rsmax0 = 2.e4_r8 - ! Leaf boundary layer conductance, umol/m**2/s + ! THESE HARD CODED CONVERSIONS NEED TO BE CALLED FROM GLOBAL CONSTANTS (RGK 10-13-2016) cf = bc_in(s)%forc_pbot/(rgas*1.e-3_r8*bc_in(s)%tgcm_pa(ifp))*1.e06_r8 gb = 1._r8/bc_in(s)%rb_pa(ifp) gb_mol = gb * cf @@ -542,7 +566,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if if(currentPatch%present(CL,FT) == 1)then ! are there any leaves of this pft in this layer? do iv = 1, currentPatch%nrad(CL,FT) - if ( DEBUG ) write(iulog,*) 'EDphoto 581 ',currentPatch%ed_parsun_z(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDphoto 581 ',currentPatch%ed_parsun_z(CL,ft,iv) if (currentPatch%ed_parsun_z(CL,FT,iv) <= 0._r8) then ! night time ac = 0._r8 @@ -557,12 +581,12 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) else ! day time !is there leaf area? - (NV can be larger than 0 with only stem area if deciduous) - if ( DEBUG ) write(iulog,*) 'EDphot 594 ',currentPatch%ed_laisun_z(CL,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDphot 595 ',currentPatch%ed_laisha_z(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDphot 594 ',currentPatch%ed_laisun_z(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDphot 595 ',currentPatch%ed_laisha_z(CL,ft,iv) if(currentPatch%ed_laisun_z(CL,ft,iv)+currentPatch%ed_laisha_z(cl,ft,iv) > 0._r8)then - if ( DEBUG ) write(iulog,*) '600 in laisun, laisha loop ' + if ( DEBUG ) write(fates_log(),*) '600 in laisun, laisha loop ' !Loop aroun shaded and unshaded leaves currentPatch%psn_z(CL,ft,iv) = 0._r8 ! psn is accumulated across sun and shaded leaves. @@ -605,9 +629,9 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! THIS CALL APPEARS TO BE REDUNDANT WITH LINE 423 (RGK) if (nint(c3psn(FT)) == 1)then - ci(cl,ft,iv) = 0.7_r8 * bc_in(s)%cair_pa(ifp) + ci = init_a2l_co2_c3 * bc_in(s)%cair_pa(ifp) else - ci(cl,ft,iv) = 0.4_r8 * bc_in(s)%cair_pa(ifp) + ci = init_a2l_co2_c4 * bc_in(s)%cair_pa(ifp) end if niter = 0 @@ -617,15 +641,15 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) niter = niter + 1 ! Save old ci - ciold = ci(cl,ft,iv) + ciold = ci ! Photosynthesis limitation rate calculations if (nint(c3psn(FT)) == 1)then ! C3: Rubisco-limited photosynthesis - ac = vcmax_z(cl,ft,iv) * max(ci(cl,ft,iv)-co2_cp(ifp), 0._r8) / (ci(cl,ft,iv)+kc(ifp)* & + ac = vcmax_z(cl,ft,iv) * max(ci-co2_cp(ifp), 0._r8) / (ci+kc(ifp)* & (1._r8+bc_in(s)%oair_pa(ifp)/ko(ifp))) ! C3: RuBP-limited photosynthesis - aj = je * max(ci(cl,ft,iv)-co2_cp(ifp), 0._r8) / (4._r8*ci(cl,ft,iv)+8._r8*co2_cp(ifp)) + aj = je * max(ci-co2_cp(ifp), 0._r8) / (4._r8*ci+8._r8*co2_cp(ifp)) ! C3: Product-limited photosynthesis ap = 3._r8 * tpu_z(cl,ft,iv) else @@ -649,7 +673,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if ! C4: PEP carboxylase-limited (CO2-limited) - ap = kp_z(cl,ft,iv) * max(ci(cl,ft,iv), 0._r8) / bc_in(s)%forc_pbot + ap = kp_z(cl,ft,iv) * max(ci, 0._r8) / bc_in(s)%forc_pbot end if ! Gross photosynthesis smoothing calculations. First co-limit ac and aj. Then co-limit ap aquad = theta_cj(ps) @@ -683,14 +707,14 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) gs_mol = max(r1,r2) ! Derive new estimate for ci - ci(cl,ft,iv) = bc_in(s)%cair_pa(ifp) - an(cl,ft,iv) * bc_in(s)%forc_pbot * & + ci = bc_in(s)%cair_pa(ifp) - an(cl,ft,iv) * bc_in(s)%forc_pbot * & (1.4_r8*gs_mol+1.6_r8*gb_mol) / (gb_mol*gs_mol) ! Check for ci convergence. Delta ci/pair = mol/mol. Multiply by 10**6 to ! convert to umol/mol (ppm). Exit iteration if convergence criteria of +/- 1 x 10**-6 ppm ! is met OR if at least ten iterations (niter=10) are completed - if ((abs(ci(cl,ft,iv)-ciold)/bc_in(s)%forc_pbot*1.e06_r8 <= 2.e-06_r8) .or. niter == 5) then + if ((abs(ci-ciold)/bc_in(s)%forc_pbot*1.e06_r8 <= 2.e-06_r8) .or. niter == 5) then exitloop = 1 end if end do !iteration loop @@ -703,14 +727,14 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Final estimates for cs and ci (needed for early exit of ci iteration when an < 0) cs = bc_in(s)%cair_pa(ifp) - 1.4_r8/gb_mol * an(cl,ft,iv) * bc_in(s)%forc_pbot cs = max(cs,1.e-06_r8) - ci(cl,ft,iv) = bc_in(s)%cair_pa(ifp) - & + ci = bc_in(s)%cair_pa(ifp) - & an(cl,ft,iv) * bc_in(s)%forc_pbot * (1.4_r8*gs_mol+1.6_r8*gb_mol) / (gb_mol*gs_mol) ! Convert gs_mol (umol H2O/m**2/s) to gs (m/s) and then to rs (s/m) gs = gs_mol / cf - if ( DEBUG ) write(iulog,*) 'EDPhoto 737 ', currentPatch%psn_z(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 738 ', ag(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 739 ', currentPatch%f_sun(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 737 ', currentPatch%psn_z(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 738 ', ag(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 739 ', currentPatch%f_sun(cl,ft,iv) !accumulate total photosynthesis umol/m2 ground/s-1. weight per unit sun and sha leaves. if(sunsha == 1)then !sunlit @@ -733,15 +757,15 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if - if ( DEBUG ) write(iulog,*) 'EDPhoto 758 ', currentPatch%psn_z(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 759 ', ag(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 760 ', currentPatch%f_sun(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 758 ', currentPatch%psn_z(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 759 ', ag(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 760 ', currentPatch%f_sun(cl,ft,iv) ! Make sure iterative solution is correct if (gs_mol < 0._r8) then - write (iulog,*)'Negative stomatal conductance:' - write (iulog,*)'ifp,iv,gs_mol= ',ifp,iv,gs_mol - call endrun(msg=errmsg(sourcefile, __LINE__)) + write (fates_log(),*)'Negative stomatal conductance:' + write (fates_log(),*)'ifp,iv,gs_mol= ',ifp,iv,gs_mol + call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! Compare with Ball-Berry model: gs_mol = m * an * hs/cs p + b @@ -749,8 +773,8 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) gs_mol_err = bb_slope(ft)*max(an(cl,ft,iv), 0._r8)*hs/cs*bc_in(s)%forc_pbot + bbb(FT) if (abs(gs_mol-gs_mol_err) > 1.e-01_r8) then - write (iulog,*) 'CF: Ball-Berry error check - stomatal conductance error:' - write (iulog,*) gs_mol, gs_mol_err + write (fates_log(),*) 'CF: Ball-Berry error check - stomatal conductance error:' + write (fates_log(),*) gs_mol, gs_mol_err end if enddo !sunsha loop @@ -787,7 +811,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%npp_tstep = 0.0_r8 currentCohort%resp_tstep = 0.0_r8 currentCohort%gpp_tstep = 0.0_r8 - currentCohort%rd = 0.0_r8 + currentCohort%rdark = 0.0_r8 currentCohort%resp_m = 0.0_r8 ! Select canopy layer and PFT. @@ -798,34 +822,34 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) !------------------------------------------------------------------------------ ! Convert from umolC/m2leaf/s to umolC/indiv/s ( x canopy area x 1m2 leaf area). tree_area = currentCohort%c_area/currentCohort%n - if ( DEBUG ) write(iulog,*) 'EDPhoto 816 ', currentCohort%gpp_tstep - if ( DEBUG ) write(iulog,*) 'EDPhoto 817 ', currentPatch%psn_z(cl,ft,1:currentCohort%nv-1) - if ( DEBUG ) write(iulog,*) 'EDPhoto 818 ', cl - if ( DEBUG ) write(iulog,*) 'EDPhoto 819 ', ft - if ( DEBUG ) write(iulog,*) 'EDPhoto 820 ', currentCohort%nv - if ( DEBUG ) write(iulog,*) 'EDPhoto 821 ', currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 816 ', currentCohort%gpp_tstep + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 817 ', currentPatch%psn_z(cl,ft,1:currentCohort%nv-1) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 818 ', cl + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 819 ', ft + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 820 ', currentCohort%nv + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 821 ', currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1) if (currentCohort%nv > 1) then !is there canopy, and are the leaves on? currentCohort%gpp_tstep = sum(currentPatch%psn_z(cl,ft,1:currentCohort%nv-1) * & currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1)) * tree_area - currentCohort%rd = sum(lmr_z(cl,ft,1:currentCohort%nv-1) * & + currentCohort%rdark = sum(lmr_z(cl,ft,1:currentCohort%nv-1) * & currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1)) * tree_area currentCohort%gscan = sum((1.0_r8/(rs_z(cl,ft,1:currentCohort%nv-1)+bc_in(s)%rb_pa(ifp)))) * tree_area - currentCohort%ts_net_uptake(1:currentCohort%nv) = an_av(cl,ft,1:currentCohort%nv) * 12E-9 * dtime + currentCohort%ts_net_uptake(1:currentCohort%nv) = an_av(cl,ft,1:currentCohort%nv) * umolC_to_kgC * dtime else currentCohort%gpp_tstep = 0.0_r8 - currentCohort%rd = 0.0_r8 + currentCohort%rdark = 0.0_r8 currentCohort%gscan = 0.0_r8 currentCohort%ts_net_uptake(:) = 0.0_r8 end if - if ( DEBUG ) write(iulog,*) 'EDPhoto 832 ', currentCohort%gpp_tstep + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 832 ', currentCohort%gpp_tstep laifrac = (currentCohort%treelai+currentCohort%treesai)-(currentCohort%nv-1)*dinc_ed @@ -833,104 +857,112 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%gscan = currentCohort%gscan+gs_cohort if ( DEBUG ) then - write(iulog,*) 'EDPhoto 868 ', currentCohort%gpp_tstep - write(iulog,*) 'EDPhoto 869 ', currentPatch%psn_z(cl,ft,currentCohort%nv) - write(iulog,*) 'EDPhoto 870 ', currentPatch%elai_profile(cl,ft,currentCohort%nv) - write(iulog,*) 'EDPhoto 871 ', laifrac - write(iulog,*) 'EDPhoto 872 ', tree_area - write(iulog,*) 'EDPhoto 873 ', currentCohort%nv, cl, ft + write(fates_log(),*) 'EDPhoto 868 ', currentCohort%gpp_tstep + write(fates_log(),*) 'EDPhoto 869 ', currentPatch%psn_z(cl,ft,currentCohort%nv) + write(fates_log(),*) 'EDPhoto 870 ', currentPatch%elai_profile(cl,ft,currentCohort%nv) + write(fates_log(),*) 'EDPhoto 871 ', laifrac + write(fates_log(),*) 'EDPhoto 872 ', tree_area + write(fates_log(),*) 'EDPhoto 873 ', currentCohort%nv, cl, ft endif currentCohort%gpp_tstep = currentCohort%gpp_tstep + currentPatch%psn_z(cl,ft,currentCohort%nv) * & currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area - if ( DEBUG ) write(iulog,*) 'EDPhoto 843 ', currentCohort%rd + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 843 ', currentCohort%rdark - currentCohort%rd = currentCohort%rd + lmr_z(cl,ft,currentCohort%nv) * & - currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area - !------------------------------------------------------------------------------ - ! Calculate Whole Plant Respiration (this doesn't really need to be in this iteration at all, surely?) - ! Leaf respn needs to be in the sub-layer loop to account for changing N through canopy. - ! - ! base rate for maintenance respiration is from: - ! M. Ryan, 1991. Effects of climate change on plant respiration. - ! Ecological Applications, 1(2), 157-167. - ! Original expression is br = 0.0106 molC/(molN h) - ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) - !------------------------------------------------------------------------------ + currentCohort%rdark = currentCohort%rdark + lmr_z(cl,ft,currentCohort%nv) * & + currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area - br = 2.525e-6_r8 + ! Convert dark respiration from umol/plant/s to kgC/plant/s + currentCohort%rdark = currentCohort%rdark * umolC_to_kgC leaf_frac = 1.0_r8/(currentCohort%canopy_trim + EDecophyscon%sapwood_ratio(currentCohort%pft) * & currentCohort%hite + pftcon%froot_leaf(currentCohort%pft)) - currentCohort%bsw = EDecophyscon%sapwood_ratio(currentCohort%pft) * currentCohort%hite * & - (currentCohort%balive + currentCohort%laimemory)*leaf_frac - currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) - currentCohort%livestem_mr = 0._r8 - currentCohort%livecroot_mr = 0._r8 - if ( DEBUG ) write(iulog,*) 'EDPhoto 874 ', currentCohort%livecroot_mr - if ( DEBUG ) write(iulog,*) 'EDPhoto 875 ', currentCohort%livecrootn + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! THIS CALCULATION SHOULD BE MOVED TO THE ALLOMETRY MODULE (RGK 10-8-2016) + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + currentCohort%bsw = EDecophyscon%sapwood_ratio(currentCohort%pft) * & + currentCohort%hite * (currentCohort%balive + currentCohort%laimemory)*leaf_frac - if (woody(FT) == 1) then - tc = q10**((bc_in(s)%t_veg_pa(ifp)-tfrz - 20.0_r8)/10.0_r8) - currentCohort%livestem_mr = currentCohort%livestemn * br * tc !*currentPatch%btran_ft(currentCohort%pft) - currentCohort%livecroot_mr = currentCohort%livecrootn * br * tc !*currentPatch%btran_ft(currentCohort%pft) + ! Calculate the amount of nitrogen in the above and below ground + ! stem and root pools, used for maint resp + ! We are using the fine-root C:N ratio as an approximation for + ! the sapwood pools. + ! Units are in (kgN/plant) + ! ------------------------------------------------------------------ + live_stem_n = ED_val_ag_biomass * currentCohort%bsw / & + frootcn(currentCohort%pft) + live_croot_n = (1.0_r8-ED_val_ag_biomass) * currentCohort%bsw / & + frootcn(currentCohort%pft) + froot_n = currentCohort%br / frootcn(currentCohort%pft) + + + !------------------------------------------------------------------------------ + ! Calculate Whole Plant Respiration (this doesn't really need to be in this iteration at all, surely?) + ! Leaf respn needs to be in the sub-layer loop to account for changing N through canopy. + !------------------------------------------------------------------------------ - !convert from gC /indiv/s-1 to kgC/indiv/s-1 - ! TODO: CHANGE THAT 1000 to 1000.0_r8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - currentCohort%livestem_mr = currentCohort%livestem_mr /1000 - currentCohort%livecroot_mr = currentCohort%livecroot_mr /1000 + ! Live stem MR (kgC/plant/s) (above ground sapwood) + ! ------------------------------------------------------------------ + if (woody(ft) == 1) then + tc = q10**((bc_in(s)%t_veg_pa(ifp)-tfrz - 20.0_r8)/10.0_r8) + ! kgC/s = kgN * kgC/kgN/s + currentCohort%livestem_mr = live_stem_n * base_mr_20 * tc else - tc = 1.0_r8 currentCohort%livestem_mr = 0._r8 - currentCohort%livecroot_mr = 0._r8 end if - if (pftcon%woody(currentCohort%pft) == 1) then - coarse_wood_frac = 0.5_r8 - else - coarse_wood_frac = 0.0_r8 - end if - ! Soil temperature. + ! Fine Root MR (kgC/plant/s) + ! ------------------------------------------------------------------ currentCohort%froot_mr = 0._r8 - - do j = 1,nlevsoi + do j = 1,cp_numlevsoil tcsoi = q10**((bc_in(s)%t_soisno_gl(j)-tfrz - 20.0_r8)/10.0_r8) - !fine root respn. - currentCohort%froot_mr = currentCohort%froot_mr + (1.0_r8 - coarse_wood_frac) * & - currentCohort%br*br*tcsoi * currentPatch%rootfr_ft(ft,j)/leafcn(currentCohort%pft) - ! convert from gC/indiv/s-1 to kgC/indiv/s-1 - currentCohort%froot_mr = currentCohort%froot_mr /1000.0_r8 + currentCohort%froot_mr = currentCohort%froot_mr + & + froot_n * base_mr_20 * tcsoi * currentPatch%rootfr_ft(ft,j) enddo - ! convert gpp and resp from umol/indiv/s-1 to kgC/indiv/s-1 = X * 12 *10-6 * 10-3 - !currentCohort%resp_m = currentCohort%rd * 12.0E-9 + ! Coarse Root MR (kgC/plant/s) (below ground sapwood) + ! ------------------------------------------------------------------ + if (woody(ft) == 1) then + currentCohort%livecroot_mr = 0._r8 + do j = 1,cp_numlevsoil + ! Soil temperature used to adjust base rate of MR + tcsoi = q10**((bc_in(s)%t_soisno_gl(j)-tfrz - 20.0_r8)/10.0_r8) + currentCohort%livecroot_mr = currentCohort%livecroot_mr + & + live_croot_n * base_mr_20 * tcsoi * & + currentPatch%rootfr_ft(ft,j) + enddo + else + currentCohort%livecroot_mr = 0._r8 + end if - if ( DEBUG ) write(iulog,*) 'EDPhoto 904 ', currentCohort%resp_m - if ( DEBUG ) write(iulog,*) 'EDPhoto 905 ', currentCohort%rd - if ( DEBUG ) write(iulog,*) 'EDPhoto 906 ', currentCohort%livestem_mr - if ( DEBUG ) write(iulog,*) 'EDPhoto 907 ', currentCohort%livecroot_mr - if ( DEBUG ) write(iulog,*) 'EDPhoto 908 ', currentCohort%froot_mr + ! convert gpp from umol/indiv/s-1 to kgC/indiv/s-1 = X * 12 *10-6 * 10-3 - currentCohort%gpp_tstep = currentCohort%gpp_tstep * 12.0E-9 + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 904 ', currentCohort%resp_m + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 905 ', currentCohort%rdark + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 906 ', currentCohort%livestem_mr + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 907 ', currentCohort%livecroot_mr + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 908 ', currentCohort%froot_mr + + currentCohort%gpp_tstep = currentCohort%gpp_tstep * umolC_to_kgC ! add on whole plant respiration values in kgC/indiv/s-1 currentCohort%resp_m = currentCohort%livestem_mr + currentCohort%livecroot_mr + currentCohort%froot_mr ! no drought response * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft)*pftcon%resp_drought_response(FT)) - currentCohort%resp_m = currentCohort%resp_m + currentCohort%rd * 12.0E-9 !this was already corrected fo BTRAN + currentCohort%resp_m = currentCohort%resp_m + currentCohort%rdark ! convert from kgC/indiv/s to kgC/indiv/timestep currentCohort%resp_m = currentCohort%resp_m * dtime currentCohort%gpp_tstep = currentCohort%gpp_tstep * dtime - if ( DEBUG ) write(iulog,*) 'EDPhoto 911 ', currentCohort%gpp_tstep - if ( DEBUG ) write(iulog,*) 'EDPhoto 912 ', currentCohort%resp_tstep - if ( DEBUG ) write(iulog,*) 'EDPhoto 913 ', currentCohort%resp_m + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 911 ', currentCohort%gpp_tstep + 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(1) * (max(0._r8,currentCohort%gpp_tstep - currentCohort%resp_m)) + currentCohort%resp_g = ED_val_grperc(ft) * (max(0._r8,currentCohort%gpp_tstep - currentCohort%resp_m)) currentCohort%resp_tstep = currentCohort%resp_m + currentCohort%resp_g ! kgC/indiv/ts currentCohort%npp_tstep = currentCohort%gpp_tstep - currentCohort%resp_tstep ! kgC/indiv/ts @@ -949,7 +981,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%gscan = 0._r8 end if else !pft<0 n<0 - write(iulog,*) 'CF: pft 0 or n 0',currentCohort%pft,currentCohort%n,currentCohort%indexnumber + write(fates_log(),*) 'CF: pft 0 or n 0',currentCohort%pft,currentCohort%n,currentCohort%indexnumber currentCohort%gpp_tstep = 0._r8 currentCohort%resp_m = 0._r8 currentCohort%gscan = 0._r8 @@ -979,7 +1011,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if bc_out(s)%rssun_pa(ifp) = rscanopy bc_out(s)%rssha_pa(ifp) = rscanopy - bc_out(s)%gccanopy_pa(ifp) = 1.0_r8/rscanopy*cf/1000 !convert into umol m02 s-1 then mmol m-2 s-1. + bc_out(s)%gccanopy_pa(ifp) = 1.0_r8/rscanopy*cf/umol_per_mmol !convert into umol m-2 s-1 then mmol m-2 s-1. end if currentPatch => currentPatch%younger @@ -1004,7 +1036,8 @@ function ft1_f(tl, ha) result(ans) ! 7/23/16: Copied over from CLM by Ryan Knox ! !!USES - use clm_varcon , only : rgas, tfrz + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm ! ! !ARGUMENTS: real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) @@ -1030,7 +1063,9 @@ function fth_f(tl,hd,se,scaleFactor) result(ans) ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 ! 7/23/16: Copied over from CLM by Ryan Knox ! - use clm_varcon , only : rgas, tfrz + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + ! ! !ARGUMENTS: real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) @@ -1058,8 +1093,11 @@ function fth25_f(hd,se)result(ans) ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 ! 7/23/16: Copied over from CLM by Ryan Knox ! - !!USES - use clm_varcon , only : rgas, tfrz + !!USES + + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + ! ! !ARGUMENTS: real(r8), intent(in) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) @@ -1090,7 +1128,6 @@ subroutine quadratic_f (a, b, c, r1, r2) ! 7/23/16: Copied over from CLM by Ryan Knox ! ! !USES: - implicit none ! ! !ARGUMENTS: real(r8), intent(in) :: a,b,c ! Terms for quadratic equation @@ -1101,8 +1138,8 @@ subroutine quadratic_f (a, b, c, r1, r2) !------------------------------------------------------------------------------ if (a == 0._r8) then - write (iulog,*) 'Quadratic solution error: a = ',a - call endrun(msg=errmsg(sourcefile, __LINE__)) + write (fates_log(),*) 'Quadratic solution error: a = ',a + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if (b >= 0._r8) then diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 9f64aefa17..d02891cb28 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -189,6 +189,14 @@ module EDTypesMod real(r8) :: treesai ! stem area index of tree (total stem area (m2) / canopy area (m2) logical :: isnew ! flag to signify a new cohort, new cohorts have not experienced ! npp or mortality and should therefore not be fused or averaged + integer :: size_class ! An index that indicates which diameter size bin the cohort currently resides in + ! this is used for history output. We maintain this in the main cohort memory + ! because we don't want to continually re-calculate the cohort's position when + ! performing size diagnostics at high-frequency calls + integer :: size_by_pft_class ! An index that indicates the cohorts position of the joint size-class x functional + ! type classification. We also maintain this in the main cohort memory + ! because we don't want to continually re-calculate the cohort's position when + ! performing size diagnostics at high-frequency calls ! CARBON FLUXES real(r8) :: gpp ! GPP: kgC/indiv/year @@ -212,11 +220,13 @@ module EDTypesMod real(r8) :: year_net_uptake(cp_nlevcan) ! Net uptake of leaf layers: kgC/m2/year ! RESPIRATION COMPONENTS - real(r8) :: rd ! Dark respiration: umol/indiv/s + real(r8) :: rdark ! Dark respiration: kgC/indiv/s real(r8) :: resp_g ! Growth respiration: kgC/indiv/timestep real(r8) :: resp_m ! Maintenance respiration: kgC/indiv/timestep real(r8) :: livestem_mr ! Live stem maintenance respiration: kgC/indiv/s - real(r8) :: livecroot_mr ! Live coarse root maintenance respiration: kgC/indiv/s + ! (Above ground) + real(r8) :: livecroot_mr ! Live stem maintenance respiration: kgC/indiv/s + ! (below ground) real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s ! ALLOCATION @@ -239,9 +249,11 @@ module EDTypesMod real(r8) :: fmort ! fire mortality n/year ! NITROGEN POOLS - real(r8) :: livestemn ! live stem nitrogen : KgN/invid - real(r8) :: livecrootn ! live coarse root nitrogen: KgN/invid - real(r8) :: frootn ! fine root nitrogen : KgN/invid + ! ---------------------------------------------------------------------------------- + ! Nitrogen pools are not prognostic in the current implementation. + ! They are diagnosed during photosynthesis using a simple C2N parameter. Local values + ! used in that routine. + ! ---------------------------------------------------------------------------------- ! GROWTH DERIVIATIVES real(r8) :: dndt ! time derivative of cohort size : n/year diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90 index 244f6f6505..3df36d6b56 100644 --- a/components/clm/src/ED/main/FatesConstantsMod.F90 +++ b/components/clm/src/ED/main/FatesConstantsMod.F90 @@ -14,4 +14,45 @@ module FatesConstantsMod integer, parameter :: fates_short_string_length = 32 integer, parameter :: fates_long_string_length = 199 + ! Unset and various other 'special' values + integer, parameter :: fates_unset_int = -9999 + + ! Unit conversion constants: + + ! Conversion factor umols of Carbon -> kg of Carbon (1 mol = 12g) + ! We do not use umolC_per_kg because it is a non-terminating decimal + real(fates_r8), parameter :: umolC_to_kgC = 12.0E-9_fates_r8 + + ! Conversion factor: grams per kilograms + real(fates_r8), parameter :: g_per_kg = 1000.0_fates_r8 + + ! Conversion factor: miligrams per grams + real(fates_r8), parameter :: mg_per_g = 1000.0_fates_r8 + + ! Conversion factor: micromoles per milimole + real(fates_r8), parameter :: umol_per_mmol = 1000.0_fates_r8 + + ! Conversion factor: milimoles per mole + real(fates_r8), parameter :: mmol_per_mol = 1000.0_fates_r8 + + ! Conversion factor: micromoles per mole + real(fates_r8), parameter :: umol_per_mol = 1.0E6_fates_r8 + + + ! Conversion: secons per minute + real(fates_r8), parameter :: sec_per_min = 60.0_fates_r8 + + + ! Physical constants + + ! universal gas constant [J/K/kmol] + real(fates_r8), parameter :: rgas_J_K_kmol = 8314.4598_fates_r8 + + ! freezing point of water at 1 atm (K) + real(fates_r8), parameter :: t_water_freeze_k_1atm = 273.15_fates_r8 + + ! freezing point of water at triple point (K) + real(fates_r8), parameter :: t_water_freeze_k_triple = 273.16_fates_r8 + + end module FatesConstantsMod diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 new file mode 100644 index 0000000000..d980f84093 --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 @@ -0,0 +1,92 @@ +module FatesHistoryDimensionMod + + use FatesConstantsMod, only : fates_short_string_length + + implicit none + + ! FIXME(bja, 2016-10) do these need to be strings, or can they be integer enumerations? + character(*), parameter :: patch_r8 = 'PA_R8' + character(*), parameter :: patch_ground_r8 = 'PA_GRND_R8' + character(*), parameter :: patch_size_pft_r8 = 'PA_SCPF_R8' + character(*), parameter :: site_r8 = 'SI_R8' + character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' + character(*), parameter :: site_size_pft_r8 = 'SI_SCPF_R8' + character(*), parameter :: patch_int = 'PA_INT' + + integer, parameter :: fates_num_dimension_types = 4 + character(*), parameter :: patch = 'patch' + character(*), parameter :: column = 'column' + character(*), parameter :: levgrnd = 'levgrnd' + character(*), parameter :: levscpf = 'levscpf' + + ! patch = This is a structure that records where FATES patch boundaries + ! on each thread point to in the host IO array, this structure + ! is allocated by number of threads + + ! column = This is a structure that records where FATES column boundaries + ! on each thread point to in the host IO array, this structure + ! is allocated by number of threads + + ! ground = This is a structure that records the boundaries for the + ! ground level (includes rock) dimension + + ! levscpf = This is a structure that records the boundaries for the + ! number of size-class x pft dimension + + + ! This structure is not allocated by thread, but the upper and lower boundaries + ! of the dimension for each thread is saved in the clump_ entry + type fates_history_dimension_type + character(len=fates_short_string_length) :: name + integer :: lower_bound + integer :: upper_bound + integer, allocatable :: clump_lower_bound(:) ! lower bound of thread's portion of HIO array + integer, allocatable :: clump_upper_bound(:) ! upper bound of thread's portion of HIO array + contains + procedure, public :: Init + procedure, public :: SetThreadBounds + end type fates_history_dimension_type + +contains + + ! ===================================================================================== + subroutine Init(this, name, num_threads, lower_bound, upper_bound) + + implicit none + + ! arguments + class(fates_history_dimension_type), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: num_threads + integer, intent(in) :: lower_bound + integer, intent(in) :: upper_bound + + this%name = trim(name) + this%lower_bound = lower_bound + this%upper_bound = upper_bound + + allocate(this%clump_lower_bound(num_threads)) + this%clump_lower_bound(:) = -1 + + allocate(this%clump_upper_bound(num_threads)) + this%clump_upper_bound(:) = -1 + + end subroutine Init + + ! ===================================================================================== + + subroutine SetThreadBounds(this, thread_index, lower_bound, upper_bound) + + implicit none + + class(fates_history_dimension_type), intent(inout) :: this + integer, intent(in) :: thread_index + integer, intent(in) :: lower_bound + integer, intent(in) :: upper_bound + + this%clump_lower_bound(thread_index) = lower_bound + this%clump_upper_bound(thread_index) = upper_bound + + end subroutine SetThreadBounds + +end module FatesHistoryDimensionMod diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 similarity index 53% rename from components/clm/src/ED/main/HistoryIOMod.F90 rename to components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b21edabe18..77aace9d47 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1,10 +1,17 @@ -Module HistoryIOMod +module FatesHistoryInterfaceMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : fates_avg_flag_length, fates_short_string_length, fates_long_string_length use FatesGlobals , only : fates_log + + use FatesHistoryDimensionMod, only : fates_history_dimension_type, fates_num_dimension_types + use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type + use FatesHistoryVariableType, only : fates_history_variable_type + use EDTypesMod , only : cp_hio_ignore_val + + ! FIXME(bja, 2016-10) need to remove CLM dependancy use pftconMod , only : pftcon implicit none @@ -120,21 +127,27 @@ Module HistoryIOMod integer, private :: ih_m4_si_scpf integer, private :: ih_m5_si_scpf + integer, private :: ih_ar_si_scpf + integer, private :: ih_ar_grow_si_scpf + integer, private :: ih_ar_maint_si_scpf + integer, private :: ih_ar_darkm_si_scpf + integer, private :: ih_ar_agsapm_si_scpf + integer, private :: ih_ar_crootm_si_scpf + integer, private :: ih_ar_frootm_si_scpf ! The number of variable dim/kind types we have defined (static) - integer, parameter :: n_iovar_dk = 6 - - - ! This structure is not allocated by thread, but the upper and lower boundaries - ! of the dimension for each thread is saved in the clump_ entry - type iovar_dim_type - character(fates_short_string_length) :: name ! This should match the name of the dimension - integer :: lb ! lower bound - integer :: ub ! upper bound - integer,allocatable :: clump_lb(:) ! lower bound of thread's portion of HIO array - integer,allocatable :: clump_ub(:) ! upper bound of thread's portion of HIO array - end type iovar_dim_type - + integer, parameter :: fates_num_dim_kinds = 6 + + type, public :: fates_bounds_type + integer :: patch_begin + integer :: patch_end + integer :: column_begin + integer :: column_end + integer :: ground_begin + integer :: ground_end + integer :: pft_class_begin + integer :: pft_class_end + end type fates_bounds_type ! This structure is allocated by thread, and must be calculated after the FATES @@ -148,105 +161,394 @@ Module HistoryIOMod end type iovar_map_type - - ! This structure is not multi-threaded - type iovar_dimkind_type - character(fates_short_string_length) :: name ! String labelling this IO type - integer :: ndims ! number of dimensions in this IO type - integer, allocatable :: dimsize(:) ! The size of each dimension - logical :: active - type(iovar_dim_type), pointer :: dim1_ptr - type(iovar_dim_type), pointer :: dim2_ptr - end type iovar_dimkind_type - - - - ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) - type iovar_def_type - character(len=fates_short_string_length) :: vname - character(len=fates_short_string_length) :: units - character(len=fates_long_string_length) :: long - character(len=fates_short_string_length) :: use_default ! States whether a variable should be turned - ! on the output files by default (active/inactive) - ! It is a good idea to set inactive for very large - ! or infrequently used output datasets - character(len=fates_short_string_length) :: vtype - character(len=fates_avg_flag_length) :: avgflag - integer :: upfreq ! Update frequency (this is for checks and flushing) - ! 1 = dynamics "dyn" (daily) - ! 2 = production "prod" (prob model tstep) - real(r8) :: flushval - type(iovar_dimkind_type),pointer :: iovar_dk_ptr - ! Pointers (only one of these is allocated per variable) - real(r8), pointer :: r81d(:) - real(r8), pointer :: r82d(:,:) - real(r8), pointer :: r83d(:,:,:) - integer, pointer :: int1d(:) - integer, pointer :: int2d(:,:) - integer, pointer :: int3d(:,:,:) - end type iovar_def_type - - - type, public :: fates_hio_interface_type + type, public :: fates_history_interface_type ! Instance of the list of history output varialbes - type(iovar_def_type), pointer :: hvars(:) - integer :: n_hvars + type(fates_history_variable_type), allocatable :: hvars(:) + integer, private :: num_history_vars_ ! Instanteat one registry of the different dimension/kinds (dk) ! All output variables will have a pointer to one of these dk's - type(iovar_dimkind_type), pointer :: iovar_dk(:) + type(fates_history_variable_kind_type) :: dim_kinds(fates_num_dim_kinds) ! This is a structure that explains where FATES patch boundaries - ! on each thread point to in the host IO array, this structure - ! is allocated by number of threads - type(iovar_dim_type) :: iopa_dim + ! on each thread point to in the host IO array, this structure is + ! allocated by number of threads. This could be dynamically + ! allocated, but is unlikely to change...? + type(fates_history_dimension_type) :: dim_bounds(fates_num_dimension_types) - ! This is a structure that explains where FATES patch boundaries - ! on each thread point to in the host IO array, this structure - ! is allocated by number of threads - type(iovar_dim_type) :: iosi_dim - - ! This is a structure that contains the boundaries for the - ! ground level (includes rock) dimension - type(iovar_dim_type) :: iogrnd_dim - - ! This is a structure that contains the boundaries for the - ! number of size-class x pft dimension - type(iovar_dim_type) :: ioscpf_dim - - type(iovar_map_type), pointer :: iovar_map(:) - + + integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ contains + procedure, public :: Init + procedure, public :: SetThreadBounds + procedure, public :: initialize_history_vars + procedure, public :: assemble_valid_output_types + procedure, public :: update_history_dyn procedure, public :: update_history_prod procedure, public :: update_history_cbal - procedure, public :: define_history_vars - procedure, public :: set_history_var - procedure, public :: init_iovar_dk_maps - procedure, public :: iotype_index - procedure, public :: set_dim_ptrs - procedure, public :: get_hvar_bounds - procedure, public :: dim_init - procedure, public :: set_dim_thread_bounds + + ! 'get' methods used by external callers to access private read only data + procedure, public :: num_history_vars + procedure, public :: patch_index + procedure, public :: column_index + procedure, public :: levgrnd_index + procedure, public :: levscpf_index + + ! private work functions + procedure, private :: define_history_vars + procedure, private :: set_history_var + procedure, private :: init_dim_kinds_maps + procedure, private :: set_dim_indices procedure, private :: flush_hvars - end type fates_hio_interface_type + procedure, private :: set_patch_index + procedure, private :: set_column_index + procedure, private :: set_levgrnd_index + procedure, private :: set_levscpf_index + + end type fates_history_interface_type contains - ! =================================================================================== + ! ====================================================================== + + subroutine Init(this, num_threads, fates_bounds) + + use FatesHistoryDimensionMod, only : patch, column, levgrnd, levscpf + + implicit none + + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: num_threads + type(fates_bounds_type), intent(in) :: fates_bounds + + integer :: dim_count = 0 + + dim_count = dim_count + 1 + call this%set_patch_index(dim_count) + call this%dim_bounds(dim_count)%Init(patch, num_threads, & + fates_bounds%patch_begin, fates_bounds%patch_end) + + dim_count = dim_count + 1 + call this%set_column_index(dim_count) + call this%dim_bounds(dim_count)%Init(column, num_threads, & + fates_bounds%column_begin, fates_bounds%column_end) + + dim_count = dim_count + 1 + call this%set_levgrnd_index(dim_count) + call this%dim_bounds(dim_count)%Init(levgrnd, num_threads, & + fates_bounds%ground_begin, fates_bounds%ground_end) + + dim_count = dim_count + 1 + call this%set_levscpf_index(dim_count) + call this%dim_bounds(dim_count)%Init(levscpf, num_threads, & + fates_bounds%pft_class_begin, fates_bounds%pft_class_end) + ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) + + ! Allocate the mapping between FATES indices and the IO indices + allocate(this%iovar_map(num_threads)) + + end subroutine Init + + ! ====================================================================== + subroutine SetThreadBounds(this, thread_index, thread_bounds) + + implicit none + + class(fates_history_interface_type), intent(inout) :: this + + integer, intent(in) :: thread_index + type(fates_bounds_type), intent(in) :: thread_bounds + + integer :: index + + index = this%patch_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%patch_begin, thread_bounds%patch_end) + + index = this%column_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%column_begin, thread_bounds%column_end) + + index = this%levgrnd_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%ground_begin, thread_bounds%ground_end) + + index = this%levscpf_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%pft_class_begin, thread_bounds%pft_class_end) + + end subroutine SetThreadBounds - subroutine update_history_cbal(this,nc,nsites,sites) + ! =================================================================================== + subroutine assemble_valid_output_types(this) + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8 + + implicit none + + class(fates_history_interface_type), intent(inout) :: this + + call this%init_dim_kinds_maps() + + call this%set_dim_indices(patch_r8, 1, this%patch_index()) + + call this%set_dim_indices(site_r8, 1, this%column_index()) + + call this%set_dim_indices(patch_ground_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_ground_r8, 2, this%levgrnd_index()) + + call this%set_dim_indices(site_ground_r8, 1, this%column_index()) + call this%set_dim_indices(site_ground_r8, 2, this%levgrnd_index()) + + call this%set_dim_indices(patch_size_pft_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_size_pft_r8, 2, this%levscpf_index()) + + call this%set_dim_indices(site_size_pft_r8, 1, this%column_index()) + call this%set_dim_indices(site_size_pft_r8, 2, this%levscpf_index()) + + end subroutine assemble_valid_output_types + + ! =================================================================================== + + subroutine set_dim_indices(this, dk_name, idim, dim_index) + + use FatesHistoryVariableKindMod , only : iotype_index + + implicit none + + ! arguments + class(fates_history_interface_type), intent(inout) :: this + character(len=*), intent(in) :: dk_name + integer, intent(in) :: idim ! dimension index + integer, intent(in) :: dim_index + + + ! local + integer :: ityp + + ityp = iotype_index(trim(dk_name), fates_num_dim_kinds, this%dim_kinds) + + ! First check to see if the dimension is allocated + if (this%dim_kinds(ityp)%ndims < idim) then + write(fates_log(), *) 'Trying to define dimension size to a dim-type structure' + write(fates_log(), *) 'but the dimension index does not exist' + write(fates_log(), *) 'type: ',dk_name,' ndims: ',this%dim_kinds(ityp)%ndims,' input dim:',idim + stop + !end_run + end if + + if (idim == 1) then + this%dim_kinds(ityp)%dim1_index = dim_index + else if (idim == 2) then + this%dim_kinds(ityp)%dim2_index = dim_index + end if + + ! With the map, we can set the dimension size + this%dim_kinds(ityp)%dimsize(idim) = this%dim_bounds(dim_index)%upper_bound - & + this%dim_bounds(dim_index)%lower_bound + 1 + + end subroutine set_dim_indices + + ! ======================================================================= + subroutine set_patch_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%patch_index_ = index + end subroutine set_patch_index + + integer function patch_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + patch_index = this%patch_index_ + end function patch_index + + ! ======================================================================= + subroutine set_column_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%column_index_ = index + end subroutine set_column_index + + integer function column_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + column_index = this%column_index_ + end function column_index + + ! ======================================================================= + subroutine set_levgrnd_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levgrnd_index_ = index + end subroutine set_levgrnd_index + + integer function levgrnd_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levgrnd_index = this%levgrnd_index_ + end function levgrnd_index + + ! ======================================================================= + subroutine set_levscpf_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levscpf_index_ = index + end subroutine set_levscpf_index + + integer function levscpf_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levscpf_index = this%levscpf_index_ + end function levscpf_index + + ! ====================================================================================== + + subroutine flush_hvars(this,nc,upfreq_in) + + class(fates_history_interface_type) :: this + integer,intent(in) :: nc + integer,intent(in) :: upfreq_in + + integer :: ivar + type(fates_history_variable_type),pointer :: hvar + integer :: lb1,ub1,lb2,ub2 + + do ivar=1,ubound(this%hvars,1) + associate( hvar => this%hvars(ivar) ) + if (hvar%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step + call hvar%Flush(nc, this%dim_bounds, this%dim_kinds) + end if + end associate + end do + + end subroutine flush_hvars + + + ! ===================================================================================== + + subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype, & + hlms, flushval, upfreq, ivar, initialize, index) + + use FatesUtilsMod, only : check_hlm_list + use EDTypesMod, only : cp_hlm_name + + implicit none + + ! arguments + class(fates_history_interface_type), intent(inout) :: this + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: use_default + character(len=*), intent(in) :: avgflag + character(len=*), intent(in) :: vtype + character(len=*), intent(in) :: hlms + real(r8), intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT + integer, intent(in) :: upfreq + logical, intent(in) :: initialize + integer, intent(inout) :: ivar + integer, intent(inout) :: index ! This is the index for the variable of + ! interest that is associated with an + ! explict name (for fast reference during update) + ! A zero is passed back when the variable is + ! not used + + ! locals + type(fates_history_variable_type), pointer :: hvar + integer :: ub1, lb1, ub2, lb2 ! Bounds for allocating the var + integer :: ityp + + logical :: write_var + + write_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) + if( write_var ) then + ivar = ivar+1 + index = ivar + + if (initialize) then + call this%hvars(ivar)%Init(vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, fates_num_dim_kinds, this%dim_kinds, & + this%dim_bounds) + end if + else + index = 0 + end if + + return + end subroutine set_history_var + + ! ==================================================================================== + + subroutine init_dim_kinds_maps(this) + + ! ---------------------------------------------------------------------------------- + ! This subroutine simply initializes the structures that define the different + ! array and type formats for different IO variables + ! + ! PA_R8 : 1D patch scale 8-byte reals + ! SI_R8 : 1D site scale 8-byte reals + ! + ! The allocation on the structures is not dynamic and should only add up to the + ! number of entries listed here. + ! + ! ---------------------------------------------------------------------------------- + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 + + implicit none + + ! Arguments + class(fates_history_interface_type), intent(inout) :: this + + + integer :: index + + ! 1d Patch + index = 1 + call this%dim_kinds(index)%Init(patch_r8, 1) + + ! 1d Site + index = index + 1 + call this%dim_kinds(index)%Init(site_r8, 1) + + ! patch x ground + index = index + 1 + call this%dim_kinds(index)%Init(patch_ground_r8, 2) + + ! patch x size-class/pft + index = index + 1 + call this%dim_kinds(index)%Init(patch_size_pft_r8, 2) + + ! site x ground + index = index + 1 + call this%dim_kinds(index)%Init(site_ground_r8, 2) + + ! site x size-class/pft + index = index + 1 + call this%dim_kinds(index)%Init(site_size_pft_r8, 2) + + ! FIXME(bja, 2016-10) assert(index == fates_num_dim_kinds) + end subroutine init_dim_kinds_maps + + ! ======================================================================= + subroutine update_history_cbal(this,nc,nsites,sites) use EDtypesMod , only : ed_site_type ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -314,7 +616,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDParamsMod , only : ED_val_ag_biomass ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -329,15 +631,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index - integer :: scpf ! index of the size-class x pft bin - integer :: sc ! index of the size-class bin 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 real(r8) :: dbh ! diameter ("at breast height") - type(iovar_def_type),pointer :: hvar + type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -490,75 +790,76 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! ------------------------------------------------------------------------ dbh = ccohort%dbh !-0.5*(1./365.25)*ccohort%ddbhdt - sc = count(dbh-sclass_ed.ge.0.0) - scpf = (ft-1)*nlevsclass_ed+sc ! Flux Variables (cohorts must had experienced a day before any of these values ! have any meaning, otherwise they are just inialization values if( .not.(ccohort%isnew) ) then - hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & - n_perm2*ccohort%gpp ! [kgC/m2/yr] - hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & - ccohort%npp*n_perm2 - hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & - ccohort%npp_leaf*n_perm2 - hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & - ccohort%npp_froot*n_perm2 - hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & - ccohort%npp_bsw*(1._r8-ED_val_ag_biomass)*n_perm2 - hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & - ccohort%npp_bsw*ED_val_ag_biomass*n_perm2 - hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & - ccohort%npp_bdead*(1._r8-ED_val_ag_biomass)*n_perm2 - hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & - ccohort%npp_bdead*ED_val_ag_biomass*n_perm2 - hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & - ccohort%npp_bseed*n_perm2 - hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & - ccohort%npp_store*n_perm2 - - if( abs(ccohort%npp-(ccohort%npp_leaf+ccohort%npp_froot+ & - ccohort%npp_bsw+ccohort%npp_bdead+ & - ccohort%npp_bseed+ccohort%npp_store))>1.e-9) then - write(fates_log(),*) 'NPP Partitions are not balancing' - write(fates_log(),*) 'Fractional Error: ', & - abs(ccohort%npp-(ccohort%npp_leaf+ccohort%npp_froot+ & - ccohort%npp_bsw+ccohort%npp_bdead+ & - ccohort%npp_bseed+ccohort%npp_store))/ccohort%npp - write(fates_log(),*) 'Terms: ',ccohort%npp,ccohort%npp_leaf,ccohort%npp_froot, & - ccohort%npp_bsw,ccohort%npp_bdead, & - ccohort%npp_bseed,ccohort%npp_store - write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance ' - stop ! we need termination control for FATES!!! - ! call endrun(msg=errMsg(__FILE__, __LINE__)) - end if + associate( scpf => ccohort%size_by_pft_class ) + + hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & + n_perm2*ccohort%gpp ! [kgC/m2/yr] + hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & + ccohort%npp*n_perm2 + hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & + ccohort%npp_leaf*n_perm2 + hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & + ccohort%npp_froot*n_perm2 + hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & + ccohort%npp_bsw*(1._r8-ED_val_ag_biomass)*n_perm2 + hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & + ccohort%npp_bsw*ED_val_ag_biomass*n_perm2 + hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & + ccohort%npp_bdead*(1._r8-ED_val_ag_biomass)*n_perm2 + hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & + ccohort%npp_bdead*ED_val_ag_biomass*n_perm2 + hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & + ccohort%npp_bseed*n_perm2 + hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & + ccohort%npp_store*n_perm2 + + if( abs(ccohort%npp-(ccohort%npp_leaf+ccohort%npp_froot+ & + ccohort%npp_bsw+ccohort%npp_bdead+ & + ccohort%npp_bseed+ccohort%npp_store))>1.e-9) then + write(fates_log(),*) 'NPP Partitions are not balancing' + write(fates_log(),*) 'Fractional Error: ', & + abs(ccohort%npp-(ccohort%npp_leaf+ccohort%npp_froot+ & + ccohort%npp_bsw+ccohort%npp_bdead+ & + ccohort%npp_bseed+ccohort%npp_store))/ccohort%npp + write(fates_log(),*) 'Terms: ',ccohort%npp,ccohort%npp_leaf,ccohort%npp_froot, & + ccohort%npp_bsw,ccohort%npp_bdead, & + ccohort%npp_bseed,ccohort%npp_store + write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance ' + stop ! we need termination control for FATES!!! + ! call endrun(msg=errMsg(__FILE__, __LINE__)) + end if - ! Woody State Variables (basal area and number density and mortality) - if (pftcon%woody(ft) == 1) then - - hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*n_perm2*AREA - hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*n_perm2*AREA - hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA - hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + ccohort%imort*n_perm2*AREA - hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*n_perm2*AREA - - ! basal area [m2/ha] - hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & - 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*n_perm2*AREA - - ! number density [/ha] - hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + AREA*n_perm2 - - ! Growth Incrments must have NaN check and woody check - if(ccohort%ddbhdt == ccohort%ddbhdt) then - hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & - ccohort%ddbhdt*n_perm2*AREA - else - hio_ddbh_si_scpf(io_si,scpf) = -999.9 - end if - end if - + ! Woody State Variables (basal area and number density and mortality) + if (pftcon%woody(ft) == 1) then + + hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*n_perm2*AREA + hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*n_perm2*AREA + hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA + hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + ccohort%imort*n_perm2*AREA + hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*n_perm2*AREA + + ! basal area [m2/ha] + hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & + 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*n_perm2*AREA + + ! number density [/ha] + hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + AREA*n_perm2 + + ! Growth Incrments must have NaN check and woody check + if(ccohort%ddbhdt == ccohort%ddbhdt) then + hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & + ccohort%ddbhdt*n_perm2*AREA + else + hio_ddbh_si_scpf(io_si,scpf) = -999.9 + end if + end if + + end associate end if ccohort => ccohort%taller @@ -628,9 +929,11 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) use EDtypesMod , only : ed_site_type, & ed_cohort_type, & ed_patch_type, & - AREA + AREA, & + sclass_ed, & + nlevsclass_ed ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -645,11 +948,11 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) integer :: io_soipa integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector - + integer :: ft ! functional type index real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column - type(iovar_def_type),pointer :: hvar + type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -661,7 +964,15 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_aresp_pa => this%hvars(ih_aresp_pa)%r81d, & hio_maint_resp_pa => this%hvars(ih_maint_resp_pa)%r81d, & hio_growth_resp_pa => this%hvars(ih_growth_resp_pa)%r81d, & - hio_npp_si => this%hvars(ih_npp_si)%r81d ) + hio_npp_si => this%hvars(ih_npp_si)%r81d, & + hio_ar_si_scpf => this%hvars(ih_ar_si_scpf)%r82d, & + hio_ar_grow_si_scpf => this%hvars(ih_ar_grow_si_scpf)%r82d, & + hio_ar_maint_si_scpf => this%hvars(ih_ar_maint_si_scpf)%r82d, & + hio_ar_agsapm_si_scpf => this%hvars(ih_ar_agsapm_si_scpf)%r82d, & + hio_ar_darkm_si_scpf => this%hvars(ih_ar_darkm_si_scpf)%r82d, & + hio_ar_crootm_si_scpf => this%hvars(ih_ar_crootm_si_scpf)%r82d, & + hio_ar_frootm_si_scpf => this%hvars(ih_ar_frootm_si_scpf)%r82d ) + ! Flush the relevant history variables call this%flush_hvars(nc,upfreq_in=2) @@ -691,7 +1002,10 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) endif if ( .not. ccohort%isnew ) then - + + ! Calculate index for the scpf class + associate( scpf => ccohort%size_by_pft_class ) + ! 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 @@ -707,6 +1021,37 @@ subroutine update_history_prod(this,nc,nsites,sites,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 + + ! 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 + + ! 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 + + ! 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 + + ! 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 + + ! (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 + + ! (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 + + ! (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 + + end associate endif ccohort => ccohort%taller @@ -721,51 +1066,40 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) end subroutine update_history_prod - ! ====================================================================================== + ! ==================================================================================== + integer function num_history_vars(this) - subroutine flush_hvars(this,nc,upfreq_in) - - class(fates_hio_interface_type) :: this - integer,intent(in) :: nc - integer,intent(in) :: upfreq_in + implicit none - integer :: ivar - type(iovar_def_type),pointer :: hvar - integer :: lb1,ub1,lb2,ub2 + class(fates_history_interface_type), intent(in) :: this + num_history_vars = this%num_history_vars_ + + end function num_history_vars + + ! ==================================================================================== + + subroutine initialize_history_vars(this) - do ivar=1,ubound(this%hvars,1) - hvar => this%hvars(ivar) - if (hvar%upfreq==upfreq_in) then ! Only flush variables with update on dynamics step - call this%get_hvar_bounds(hvar,nc,lb1,ub1,lb2,ub2) - select case(trim(hvar%iovar_dk_ptr%name)) - case('PA_R8') - hvar%r81d(lb1:ub1) = hvar%flushval - case('SI_R8') - hvar%r81d(lb1:ub1) = hvar%flushval - case('PA_GRND_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('PA_SCPF_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('SI_GRND_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('SI_SCPF_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('PA_INT') - hvar%int1d(lb1:ub1) = nint(hvar%flushval) - case default - write(fates_log(),*) 'iotyp undefined while flushing history variables' - stop - !end_run - end select - end if - end do - - end subroutine flush_hvars + implicit none + + class(fates_history_interface_type), intent(inout) :: this - ! ==================================================================================== + ! Determine how many of the history IO variables registered in FATES + ! are going to be allocated + call this%define_history_vars(initialize_variables=.false.) + + ! Allocate the list of history output variable objects + allocate(this%hvars(this%num_history_vars())) + + ! construct the object that defines all of the IO variables + call this%define_history_vars(initialize_variables=.true.) + + end subroutine initialize_history_vars + + ! ==================================================================================== - subroutine define_history_vars(this,callstep,nvar) + subroutine define_history_vars(this, initialize_variables) ! --------------------------------------------------------------------------------- ! @@ -793,727 +1127,427 @@ subroutine define_history_vars(this,callstep,nvar) ! If your HLM makes use of, and you want, INTEGER OUTPUT, pass the flushval as ! a real. The applied flush value will use the NINT() intrinsic function ! --------------------------------------------------------------------------------- + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 + implicit none - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: callstep ! are we 'count'ing or 'initializ'ing? - integer,optional,intent(out) :: nvar - integer :: ivar - - if(.not. (trim(callstep).eq.'count' .or. trim(callstep).eq.'initialize') ) then - write(fates_log(),*) 'defining history variables in FATES requires callstep count or initialize' - ! end_run('MESSAGE') - end if + class(fates_history_interface_type), intent(inout) :: this + logical, intent(in) :: initialize_variables ! are we 'count'ing or 'initializ'ing? + + integer :: ivar ivar=0 ! Site level counting variables - call this%set_history_var(vname='ED_NPATCHES',units='none', & + call this%set_history_var(vname='ED_NPATCHES', units='none', & long='Total number of ED patches per site', use_default='active', & - avgflag='A',vtype='SI_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_npatches_si) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_npatches_si) - call this%set_history_var(vname='ED_NCOHORTS',units='none', & + call this%set_history_var(vname='ED_NCOHORTS', units='none', & long='Total number of ED cohorts per site', use_default='active', & - avgflag='A',vtype='SI_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_ncohorts_si) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_ncohorts_si) ! Patch variables - call this%set_history_var(vname='TRIMMING',units='none', & + call this%set_history_var(vname='TRIMMING', units='none', & long='Degree to which canopy expansion is limited by leaf economics', & use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_trimming_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_trimming_pa) - call this%set_history_var(vname='AREA_PLANT',units='m2', & + call this%set_history_var(vname='AREA_PLANT', units='m2', & long='area occupied by all plants', use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_area_plant_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_area_plant_pa) - call this%set_history_var(vname='AREA_TREES',units='m2', & + call this%set_history_var(vname='AREA_TREES', units='m2', & long='area occupied by woody plants', use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_area_treespread_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_area_treespread_pa) - call this%set_history_var(vname='CANOPY_SPREAD',units='0-1', & + call this%set_history_var(vname='CANOPY_SPREAD', units='0-1', & long='Scaling factor between tree basal area and canopy area', & use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_canopy_spread_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_canopy_spread_pa) - call this%set_history_var(vname='PFTbiomass',units='gC/m2', & + call this%set_history_var(vname='PFTbiomass', units='gC/m2', & long='total PFT level biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_biomass_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_biomass_pa_pft ) call this%set_history_var(vname='PFTleafbiomass', units='gC/m2', & long='total PFT level leaf biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_leafbiomass_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_leafbiomass_pa_pft ) call this%set_history_var(vname='PFTstorebiomass', units='gC/m2', & long='total PFT level stored biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_storebiomass_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storebiomass_pa_pft ) call this%set_history_var(vname='PFTnindivs', units='indiv / m2', & long='total PFT level number of individuals', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_nindivs_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_nindivs_pa_pft ) ! Fire Variables call this%set_history_var(vname='FIRE_NESTEROV_INDEX', units='none', & long='nesterov_fire_danger index', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_nesterov_fire_danger_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_nesterov_fire_danger_pa) call this%set_history_var(vname='FIRE_ROS', units='m/min', & long='fire rate of spread m/min', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_spitfire_ROS_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_spitfire_ROS_pa) call this%set_history_var(vname='EFFECT_WSPEED', units='none', & long ='effective windspeed for fire spread', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_effect_wspeed_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_effect_wspeed_pa ) call this%set_history_var(vname='FIRE_TFC_ROS', units='none', & long ='total fuel consumed', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_TFC_ROS_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_TFC_ROS_pa ) call this%set_history_var(vname='FIRE_INTENSITY', units='kJ/m/s', & long='spitfire fire intensity: kJ/m/s', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_intensity_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_intensity_pa ) call this%set_history_var(vname='FIRE_AREA', units='fraction', & long='spitfire fire area:m2', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_area_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_area_pa ) call this%set_history_var(vname='SCORCH_HEIGHT', units='m', & long='spitfire fire area:m2', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_scorch_height_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_scorch_height_pa ) call this%set_history_var(vname='fire_fuel_mef', units='m', & long='spitfire fuel moisture', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_mef_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_mef_pa ) call this%set_history_var(vname='fire_fuel_bulkd', units='m', & long='spitfire fuel bulk density', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_bulkd_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_bulkd_pa ) call this%set_history_var(vname='FIRE_FUEL_EFF_MOIST', units='m', & long='spitfire fuel moisture', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_eff_moist_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_eff_moist_pa ) call this%set_history_var(vname='fire_fuel_sav', units='m', & long='spitfire fuel surface/volume ', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_sav_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_sav_pa ) call this%set_history_var(vname='SUM_FUEL', units='gC m-2', & long='total ground fuel related to ros (omits 1000hr fuels)', & use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_sum_fuel_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_sum_fuel_pa ) ! Litter Variables call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & long='Litter flux in leaves', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_litter_in_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_in_pa ) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & long='Litter flux out leaves', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_litter_out_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_out_pa ) call this%set_history_var(vname='SEED_BANK', units='gC m-2', & long='Total Seed Mass of all PFTs', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_bank_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_bank_si ) call this%set_history_var(vname='SEEDS_IN', units='gC m-2 s-1', & long='Seed Production Rate', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seeds_in_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seeds_in_pa ) call this%set_history_var(vname='SEED_GERMINATION', units='gC m-2 s-1', & long='Seed mass converted into new cohorts', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_germination_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_germination_pa ) call this%set_history_var(vname='SEED_DECAY', units='gC m-2 s-1', & long='Seed mass decay', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_decay_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_decay_pa ) call this%set_history_var(vname='ED_bstore', units='gC m-2', & long='Storage biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bstore_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bstore_pa ) call this%set_history_var(vname='ED_bdead', units='gC m-2', & long='Dead (structural) biomass (live trees, not CWD)', & use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bdead_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bdead_pa ) call this%set_history_var(vname='ED_balive', units='gC m-2', & long='Live biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_balive_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_balive_pa ) call this%set_history_var(vname='ED_bleaf', units='gC m-2', & long='Leaf biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bleaf_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bleaf_pa ) call this%set_history_var(vname='ED_biomass', units='gC m-2', & long='Total biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_btotal_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_btotal_pa ) ! Ecosystem Carbon Fluxes (updated rapidly, upfreq=2) call this%set_history_var(vname='NPP_column', units='gC/m^2/s', & long='net primary production on the site', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_npp_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_npp_si ) call this%set_history_var(vname='GPP', units='gC/m^2/s', & long='gross primary production', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_gpp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_gpp_pa ) call this%set_history_var(vname='NPP', units='gC/m^2/s', & long='net primary production', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_npp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_npp_pa ) call this%set_history_var(vname='AR', units='gC/m^2/s', & long='autotrophic respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_aresp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_aresp_pa ) call this%set_history_var(vname='GROWTH_RESP', units='gC/m^2/s', & long='growth respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_growth_resp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_growth_resp_pa ) call this%set_history_var(vname='MAINT_RESP', units='gC/m^2/s', & long='maintenance respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_maint_resp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_maint_resp_pa ) ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! ! (BECAUSE THEY TAKE UP SPACE!!! ! =================================================================================== - call this%set_history_var(vname='GPP_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='GPP_SCPF', units='kgC/m2/yr', & long='gross primary production', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_gpp_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_gpp_si_scpf ) - call this%set_history_var(vname='NPP_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_SCPF', units='kgC/m2/yr', & long='total net primary production', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_totl_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_totl_si_scpf ) - call this%set_history_var(vname='NPP_LEAF_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & long='NPP flux into leaves', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_leaf_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_si_scpf ) - call this%set_history_var(vname='NPP_SEED_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & long='NPP flux into seeds', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_seed_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_si_scpf ) - call this%set_history_var(vname='NPP_FNRT_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & long='NPP flux into fine roots', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_fnrt_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_si_scpf ) - call this%set_history_var(vname='NPP_BGSW_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & long='NPP flux into below-ground sapwood', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_bgsw_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgsw_si_scpf ) - call this%set_history_var(vname='NPP_BGDW_SCPF',units='kgC/m2/yr', & - long='NPP flux into below-ground deadwood', use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_bgdw_si_scpf ) + call this%set_history_var(vname='NPP_BGDW_SCPF', units='kgC/m2/yr', & + long='NPP flux into below-ground deadwood', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgdw_si_scpf ) - call this%set_history_var(vname='NPP_AGSW_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & long='NPP flux into above-ground sapwood', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_agsw_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agsw_si_scpf ) call this%set_history_var(vname = 'NPP_AGDW_SCPF', units='kgC/m2/yr', & - long='NPP flux into above-ground deadwood', use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_agdw_si_scpf ) + long='NPP flux into above-ground deadwood', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agdw_si_scpf ) call this%set_history_var(vname = 'NPP_STOR_SCPF', units='kgC/m2/yr', & long='NPP flux into storage', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_stor_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_si_scpf ) call this%set_history_var(vname='DDBH_SCPF', units = 'cm/yr/ha', & - long='diameter growth increment and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_ddbh_si_scpf ) + long='diameter growth increment and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_scpf ) - call this%set_history_var(vname='BA_SCPF',units = 'm2/ha', & + call this%set_history_var(vname='BA_SCPF', units = 'm2/ha', & long='basal area by patch and pft/size', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_ba_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ba_si_scpf ) - call this%set_history_var(vname='NPLANT_SCPF',units = 'N/ha', & + call this%set_history_var(vname='NPLANT_SCPF', units = 'N/ha', & long='stem number density by patch and pft/size', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_nplant_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scpf ) - call this%set_history_var(vname='M1_SCPF',units = 'N/ha/yr', & - long='background mortality count by patch and pft/size', use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m1_si_scpf ) + call this%set_history_var(vname='M1_SCPF', units = 'N/ha/yr', & + long='background mortality count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m1_si_scpf ) - call this%set_history_var(vname='M2_SCPF',units = 'N/ha/yr', & - long='hydraulic mortality count by patch and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m2_si_scpf ) - - call this%set_history_var(vname='M3_SCPF',units = 'N/ha/yr', & - long='carbon starvation mortality count by patch and pft/size',use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m3_si_scpf ) - - call this%set_history_var(vname='M4_SCPF',units = 'N/ha/yr', & - long='impact mortality count by patch and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m4_si_scpf ) + call this%set_history_var(vname='M2_SCPF', units = 'N/ha/yr', & + long='hydraulic mortality count by patch and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m2_si_scpf ) + + call this%set_history_var(vname='M3_SCPF', units = 'N/ha/yr', & + long='carbon starvation mortality count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_scpf ) + + call this%set_history_var(vname='M4_SCPF', units = 'N/ha/yr', & + long='impact mortality count by patch and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m4_si_scpf ) + + call this%set_history_var(vname='M5_SCPF', units = 'N/ha/yr', & + long='fire mortality count by patch and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m5_si_scpf ) + + ! Size structured diagnostics that require rapid updates (upfreq=2) + + call this%set_history_var(vname='AR_SCPF',units = 'kgC/m2/yr', & + long='total autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_si_scpf ) + + call this%set_history_var(vname='AR_GROW_SCPF',units = 'kgC/m2/yr', & + long='growth autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_grow_si_scpf ) + + call this%set_history_var(vname='AR_MAINT_SCPF',units = 'kgC/m2/yr', & + long='maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_maint_si_scpf ) + + call this%set_history_var(vname='AR_DARKM_SCPF',units = 'kgC/m2/yr', & + long='dark portion of maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_darkm_si_scpf ) + + call this%set_history_var(vname='AR_AGSAPM_SCPF',units = 'kgC/m2/yr', & + long='above-ground sapwood maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_agsapm_si_scpf ) + + call this%set_history_var(vname='AR_CROOTM_SCPF',units = 'kgC/m2/yr', & + long='below-ground sapwood maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_crootm_si_scpf ) - call this%set_history_var(vname='M5_SCPF',units = 'N/ha/yr', & - long='fire mortality count by patch and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m5_si_scpf ) + call this%set_history_var(vname='AR_FROOTM_SCPF',units = 'kgC/m2/yr', & + long='fine root maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_frootm_si_scpf ) ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS call this%set_history_var(vname='NEP', units='gC/m^2/s', & long='net ecosystem production', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_nep_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_nep_si ) call this%set_history_var(vname='Fire_Closs', units='gC/m^2/s', & long='ED/SPitfire Carbon loss to atmosphere', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_fire_c_to_atm_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_fire_c_to_atm_si ) call this%set_history_var(vname='NBP', units='gC/m^2/s', & long='net biosphere production', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_nbp_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_nbp_si ) call this%set_history_var(vname='TOTECOSYSC', units='gC/m^2', & long='total ecosystem carbon', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_totecosysc_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_totecosysc_si ) call this%set_history_var(vname='CBALANCE_ERROR_ED', units='gC/m^2/s', & long='total carbon balance error on ED side', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_fates_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_fates_si ) call this%set_history_var(vname='CBALANCE_ERROR_BGC', units='gC/m^2/s', & long='total carbon balance error on HLMs BGC side', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_bgc_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_bgc_si ) call this%set_history_var(vname='CBALANCE_ERROR_TOTAL', units='gC/m^2/s', & long='total carbon balance error total', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_tot_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_tot_si ) call this%set_history_var(vname='BIOMASS_STOCK_COL', units='gC/m^2', & long='total ED biomass carbon at the column level', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_biomass_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_biomass_stock_si ) call this%set_history_var(vname='ED_LITTER_STOCK_COL', units='gC/m^2', & long='total ED litter carbon at the column level', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_litter_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_litter_stock_si ) call this%set_history_var(vname='CWD_STOCK_COL', units='gC/m^2', & long='total CWD carbon at the column level', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cwd_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cwd_stock_si ) ! Must be last thing before return - if(present(nvar)) nvar = ivar - - return + this%num_history_vars_ = ivar end subroutine define_history_vars - - ! ===================================================================================== - - subroutine set_history_var(this,vname,units,long,use_default,avgflag,vtype,hlms, & - flushval,upfreq,ivar,callstep,index) - - - use FatesUtilsMod, only : check_hlm_list - use EDTypesMod, only : cp_hlm_name - - ! arguments - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: vname - character(len=*),intent(in) :: units - character(len=*),intent(in) :: long - character(len=*),intent(in) :: use_default - character(len=*),intent(in) :: avgflag - character(len=*),intent(in) :: vtype - character(len=*),intent(in) :: hlms - real(r8),intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT - integer,intent(in) :: upfreq - character(len=*),intent(in) :: callstep - integer, intent(inout) :: ivar - integer, intent(inout) :: index ! This is the index for the variable of - ! interest that is associated with an - ! explict name (for fast reference during update) - ! A zero is passed back when the variable is - ! not used - - ! locals - type(iovar_def_type),pointer :: hvar - integer :: ub1,lb1,ub2,lb2 ! Bounds for allocating the var - integer :: ityp - - if( check_hlm_list(trim(hlms),trim(cp_hlm_name)) ) then - - ivar = ivar+1 - index = ivar - - if(trim(callstep).eq.'initialize')then - - hvar => this%hvars(ivar) - hvar%vname = vname - hvar%units = units - hvar%long = long - hvar%use_default = use_default - hvar%vtype = vtype - hvar%avgflag = avgflag - hvar%flushval = flushval - hvar%upfreq = upfreq - ityp=this%iotype_index(trim(vtype)) - hvar%iovar_dk_ptr => this%iovar_dk(ityp) - this%iovar_dk(ityp)%active = .true. - - nullify(hvar%r81d) - nullify(hvar%r82d) - nullify(hvar%r83d) - nullify(hvar%int1d) - nullify(hvar%int2d) - nullify(hvar%int3d) - - call this%get_hvar_bounds(hvar,0,lb1,ub1,lb2,ub2) - - ! currently, all array spaces are flushed each time - ! the update is called. The flush here on the initialization - ! may be redundant, but will prevent issues in the future - ! if we have host models where not all threads are updating - ! the HIO array spaces. (RGK:09-2016) - - select case(trim(vtype)) - case('PA_R8') - allocate(hvar%r81d(lb1:ub1));hvar%r81d(:)=flushval - case('SI_R8') - allocate(hvar%r81d(lb1:ub1));hvar%r81d(:)=flushval - case('PA_GRND_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('PA_SCPF_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('SI_GRND_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('SI_SCPF_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case default - write(fates_log(),*) 'Incompatible vtype passed to set_history_var' - write(fates_log(),*) 'vtype = ',trim(vtype),' ?' - stop - ! end_run - end select - - end if - else - - index = 0 - end if - - return - end subroutine set_history_var - - ! ===================================================================================== - - subroutine get_hvar_bounds(this,hvar,thread,lb1,ub1,lb2,ub2) - - class(fates_hio_interface_type) :: this - type(iovar_def_type),target,intent(in) :: hvar - integer,intent(in) :: thread - integer,intent(out) :: lb1 - integer,intent(out) :: ub1 - integer,intent(out) :: lb2 - integer,intent(out) :: ub2 - - ! local - integer :: ndims - - lb1 = 0 - ub1 = 0 - lb2 = 0 - ub2 = 0 - - ndims = hvar%iovar_dk_ptr%ndims - - ! The thread = 0 case is the boundaries for the whole proc/node - if (thread==0) then - lb1 = hvar%iovar_dk_ptr%dim1_ptr%lb - ub1 = hvar%iovar_dk_ptr%dim1_ptr%ub - if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%lb - ub2 = hvar%iovar_dk_ptr%dim2_ptr%ub - end if - else - lb1 = hvar%iovar_dk_ptr%dim1_ptr%clump_lb(thread) - ub1 = hvar%iovar_dk_ptr%dim1_ptr%clump_ub(thread) - if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%clump_lb(thread) - ub2 = hvar%iovar_dk_ptr%dim2_ptr%clump_ub(thread) - end if - end if - - return - end subroutine get_hvar_bounds - - - ! ==================================================================================== - - subroutine init_iovar_dk_maps(this) - - ! ---------------------------------------------------------------------------------- - ! This subroutine simply initializes the structures that define the different - ! array and type formats for different IO variables - ! - ! PA_R8 : 1D patch scale 8-byte reals - ! SI_R8 : 1D site scale 8-byte reals - ! - ! The allocation on the structures is not dynamic and should only add up to the - ! number of entries listed here. - ! - ! note (RGK) %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 - ! dimensioning specifications from the host, but we currently arent using those - ! passing functions.. - ! ---------------------------------------------------------------------------------- - - ! Arguments - class(fates_hio_interface_type) :: this - - ! Locals - integer :: ityp - integer, parameter :: unset_int = -999 - - allocate(this%iovar_dk(n_iovar_dk)) - - ! 1d Patch - ityp = 1 - this%iovar_dk(ityp)%name = 'PA_R8' - this%iovar_dk(ityp)%ndims = 1 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! 1d Site - ityp = 2 - this%iovar_dk(ityp)%name = 'SI_R8' - this%iovar_dk(ityp)%ndims = 1 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! patch x ground - ityp = 3 - this%iovar_dk(ityp)%name = 'PA_GRND_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! patch x size-class/pft - ityp = 4 - this%iovar_dk(ityp)%name = 'PA_SCPF_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! site x ground - ityp = 5 - this%iovar_dk(ityp)%name = 'SI_GRND_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! site x size-class/pft - ityp = 6 - this%iovar_dk(ityp)%name = 'SI_SCPF_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - - - - - - return - end subroutine init_iovar_dk_maps - - ! =================================================================================== - - subroutine set_dim_ptrs(this,dk_name,idim,dim_target) - - ! arguments - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: dk_name - integer,intent(in) :: idim ! dimension index - type(iovar_dim_type),target :: dim_target - - - ! local - integer :: ityp - - ityp = this%iotype_index(trim(dk_name)) - - ! First check to see if the dimension is allocated - if(this%iovar_dk(ityp)%ndims dim_target - elseif(idim==2) then - this%iovar_dk(ityp)%dim2_ptr => dim_target - end if - - ! With the map, we can set the dimension size - this%iovar_dk(ityp)%dimsize(idim) = dim_target%ub - dim_target%lb + 1 - - - return - end subroutine set_dim_ptrs - - ! ==================================================================================== - - function iotype_index(this,iotype_name) result(ityp) - - ! argument - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: iotype_name - - ! local - integer :: ityp - - do ityp=1,n_iovar_dk - if(trim(iotype_name).eq.trim(this%iovar_dk(ityp)%name))then - return - end if - end do - write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' - !end_run - - end function iotype_index - - ! ===================================================================================== - - subroutine dim_init(this,iovar_dim,dim_name,nthreads,lb_in,ub_in) - - ! arguments - class(fates_hio_interface_type) :: this - type(iovar_dim_type),target :: iovar_dim - character(len=*),intent(in) :: dim_name - integer,intent(in) :: nthreads - integer,intent(in) :: lb_in - integer,intent(in) :: ub_in - - allocate(iovar_dim%clump_lb(nthreads)) - allocate(iovar_dim%clump_ub(nthreads)) - - iovar_dim%name = trim(dim_name) - iovar_dim%lb = lb_in - iovar_dim%ub = ub_in - - return - end subroutine dim_init - - ! ===================================================================================== - - subroutine set_dim_thread_bounds(this,iovar_dim,nc,lb_in,ub_in) - - class(fates_hio_interface_type) :: this - type(iovar_dim_type),target :: iovar_dim - integer,intent(in) :: nc ! Thread index - integer,intent(in) :: lb_in - integer,intent(in) :: ub_in - - iovar_dim%clump_lb(nc) = lb_in - iovar_dim%clump_ub(nc) = ub_in - - return - end subroutine set_dim_thread_bounds ! ==================================================================================== ! DEPRECATED, TRANSITIONAL OR FUTURE CODE SECTION ! ==================================================================================== - !subroutine set_fates_hio_str(tag,iotype_name,iostr_val) + !subroutine set_fates_hio_str(tag,iotype_name, iostr_val) ! ! Arguments -! character(len=*),intent(in) :: tag -! character(len=*), optional,intent(in) :: iotype_name +! character(len=*), intent(in) :: tag +! character(len=*), optional, intent(in) :: iotype_name ! integer, optional, intent(in) :: iostr_val ! ! local variables @@ -1524,32 +1558,32 @@ end subroutine set_dim_thread_bounds ! select case (trim(tag)) ! case('flush_to_unset') -! write(*,*) '' -! write(*,*) 'Flushing FATES IO types prior to transfer from host' -! do ityp=1,ubound(iovar_str,1) +! write(*, *) '' +! write(*, *) 'Flushing FATES IO types prior to transfer from host' +! do ityp=1,ubound(iovar_str, 1) ! iovar_str(ityp)%dimsize = unset_int ! iovar_str(ityp)%active = .false. ! end do ! case('check_allset') -! do ityp=1,ubound(iovar_str,1) -! write(*,*) 'Checking to see if ',iovar_str(ityp)%name,' IO communicators were sent to FATES' +! do ityp=1,ubound(iovar_str, 1) +! write(*, *) 'Checking to see if ',iovar_str(ityp)%name, ' IO communicators were sent to FATES' ! if(iovar_str(ityp)%active)then ! if(iovar_str(ityp)%offset .eq. unset_int) then -! write(*,*) 'FATES offset information of IO type:',iovar_str(ityp)%name -! write(*,*) 'was never set' +! write(*, *) 'FATES offset information of IO type:', iovar_str(ityp)%name +! write(*, *) 'was never set' ! ! end_run('MESSAGE') ! end if -! do idim=1,iovar_str(ityp)%ndims +! do idim=1, iovar_str(ityp)%ndims ! if(iovar_str(ityp)%dimsize(idim) .eq. unset_int) then -! write(*,*) 'FATES dimension information of IO type:',iovar_str(ityp)%name -! write(*,*) 'was never set' +! write(*, *) 'FATES dimension information of IO type:', iovar_str(ityp)%name +! write(*, *) 'was never set' ! ! end_run('MESSAGE') ! end if ! end do ! end if ! end do -! write(*,*) 'Checked. All history IO specifications properly sent to FATES.' +! write(*, *) 'Checked. All history IO specifications properly sent to FATES.' ! case default ! ! Must have two arguments if this is not a check or flush @@ -1561,39 +1595,39 @@ end subroutine set_dim_thread_bounds ! case('offset') ! ityp=iotype_index(trim(iotype_name)) ! iovar_str(ityp)%offset = iostr_val -! write(*,*) 'Transfering offset for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering offset for IOTYPE',iotype_name, ' to FATES' ! case('dimsize1') ! ityp=iotype_index(trim(iotype_name)) ! iovar_str(ityp)%dimsize(1) = iostr_val -! write(*,*) 'Transfering 1st dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 1st dimension size for IOTYPE',iotype_name, ' to FATES' ! case('dimsize2') ! ityp=iotype_index(trim(iotype_name)) -! if(ubound(iovar_str(ityp)%dimsize,1)==1)then -! write(fates_log(),*) 'Transfering second dimensional bound to unallocated space' -! write(fates_log(),*) 'type:',iotype_name +! if(ubound(iovar_str(ityp)%dimsize, 1)==1)then +! write(fates_log(), *) 'Transfering second dimensional bound to unallocated space' +! write(fates_log(), *) 'type:', iotype_name ! ! end_run ! end if ! iovar_str(ityp)%dimsize(2) = iostr_val -! write(*,*) 'Transfering 2nd dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 2nd dimension size for IOTYPE',iotype_name, ' to FATES' ! case('dimsize3') ! ityp=iotype_index(trim(iotype_name)) -! if(ubound(iovar_str(ityp)%dimsize,1)<3)then -! write(fates_log(),*) 'Transfering third dimensional bound to unallocated space' -! write(fates_log(),*) 'type:',iotype_name +! if(ubound(iovar_str(ityp)%dimsize, 1)<3)then +! write(fates_log(), *) 'Transfering third dimensional bound to unallocated space' +! write(fates_log(), *) 'type:', iotype_name ! ! end_run ! end if ! iovar_str(ityp)%dimsize(3) = iostr_val -! write(*,*) 'Transfering 3rd dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 3rd dimension size for IOTYPE',iotype_name, ' to FATES' ! case default -! write(*,*) 'IO parameter not recognized:',trim(tag) +! write(*, *) 'IO parameter not recognized:', trim(tag) ! ! end_run ! end select ! else -! write(*,*) 'no value was provided for the tag' +! write(*, *) 'no value was provided for the tag' ! end if ! ! end select @@ -1602,4 +1636,4 @@ end subroutine set_dim_thread_bounds -end module HistoryIOMod +end module FatesHistoryInterfaceMod diff --git a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 new file mode 100644 index 0000000000..fd8bd7a871 --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 @@ -0,0 +1,91 @@ +module FatesHistoryVariableKindMod + + use FatesConstantsMod, only : fates_long_string_length + use FatesGlobals, only : fates_log + use FatesHistoryDimensionMod, only : fates_history_dimension_type + + implicit none + + ! 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 + ! dimensioning specifications from the host, but we currently arent using those + ! passing functions.. + + ! This structure is not multi-threaded + type fates_history_variable_kind_type + character(len=fates_long_string_length) :: name ! String labelling this IO type + integer :: ndims ! number of dimensions in this IO type + integer, allocatable :: dimsize(:) ! The size of each dimension + logical, private :: active_ + integer :: dim1_index + integer :: dim2_index + + contains + + procedure, public :: Init + procedure, public :: set_active + procedure, public :: is_active + + end type fates_history_variable_kind_type + + + +contains + + ! =================================================================================== + subroutine Init(this, name, num_dims) + + use FatesConstantsMod, only : fates_unset_int + + implicit none + + class(fates_history_variable_kind_type), intent(inout) :: this + character(*), intent(in) :: name + integer, intent(in) :: num_dims + + this%name = trim(name) + this%ndims = num_dims + allocate(this%dimsize(this%ndims)) + this%dimsize(:) = fates_unset_int + this%active_ = .false. + this%dim1_index = fates_unset_int + this%dim2_index = fates_unset_int + + end subroutine Init + + ! ======================================================================= + subroutine set_active(this) + implicit none + class(fates_history_variable_kind_type), intent(inout) :: this + this%active_ = .true. + end subroutine set_active + + logical function is_active(this) + implicit none + class(fates_history_variable_kind_type), intent(in) :: this + is_active = this%active_ + end function is_active + + ! ==================================================================================== + + function iotype_index(iotype_name, num_dim_kinds, dim_kinds) result(dk_index) + + ! argument + character(len=*), intent(in) :: iotype_name + integer, intent(in) :: num_dim_kinds + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) + + ! local + integer :: dk_index + + do dk_index=1, num_dim_kinds + if (trim(iotype_name) .eq. trim(dim_kinds(dk_index)%name)) then + return + end if + end do + write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' + !end_run + + end function iotype_index + +end module FatesHistoryVariableKindMod diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 new file mode 100644 index 0000000000..218950432f --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -0,0 +1,221 @@ +module FatesHistoryVariableType + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_log + use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type + + implicit none + + ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) + + type fates_history_variable_type + character(len=32) :: vname + character(len=24) :: units + character(len=128) :: long + character(len=24) :: use_default ! States whether a variable should be turned + ! on the output files by default (active/inactive) + ! It is a good idea to set inactive for very large + ! or infrequently used output datasets + character(len=24) :: vtype + character(len=1) :: avgflag + integer :: upfreq ! Update frequency (this is for checks and flushing) + ! 1 = dynamics "dyn" (daily) + ! 2 = production "prod" (prob model tstep) + real(r8) :: flushval + integer :: dim_kinds_index + ! Pointers (only one of these is allocated per variable) + real(r8), pointer :: r81d(:) + real(r8), pointer :: r82d(:,:) + real(r8), pointer :: r83d(:,:,:) + integer, pointer :: int1d(:) + integer, pointer :: int2d(:,:) + integer, pointer :: int3d(:,:,:) + contains + procedure, public :: Init + procedure, public :: Flush + procedure, private :: GetBounds + end type fates_history_variable_type + +contains + + subroutine Init(this, vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, num_dim_kinds, dim_kinds, dim_bounds) + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8 + + use FatesHistoryVariableKindMod, only : iotype_index + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: use_default + character(len=*), intent(in) :: vtype + character(len=*), intent(in) :: avgflag + real(r8), intent(in) :: flushval ! If the type is an int we will round with nint + integer, intent(in) :: upfreq + integer, intent(in) :: num_dim_kinds + type(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(inout) :: dim_kinds(:) + + integer :: dk_index + integer :: lb1, ub1, lb2, ub2 + + this%vname = vname + this%units = units + this%long = long + this%use_default = use_default + this%vtype = vtype + this%avgflag = avgflag + this%flushval = flushval + this%upfreq = upfreq + + nullify(this%r81d) + nullify(this%r82d) + nullify(this%r83d) + nullify(this%int1d) + nullify(this%int2d) + nullify(this%int3d) + + dk_index = iotype_index(trim(vtype), num_dim_kinds, dim_kinds) + this%dim_kinds_index = dk_index + call dim_kinds(dk_index)%set_active() + + call this%GetBounds(0, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) + + ! NOTE(rgk, 2016-09) currently, all array spaces are flushed each + ! time the update is called. The flush here on the initialization + ! may be redundant, but will prevent issues in the future if we + ! have host models where not all threads are updating the HHistory + ! array spaces. + + select case(trim(vtype)) + case(patch_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(site_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(patch_ground_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(patch_size_pft_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_ground_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_size_pft_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),' ?' + stop + ! end_run + end select + + end subroutine Init + + ! ===================================================================================== + + subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + integer, intent(in) :: thread + class(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) + integer, intent(out) :: lb1 + integer, intent(out) :: ub1 + integer, intent(out) :: lb2 + integer, intent(out) :: ub2 + + ! local + integer :: ndims + integer :: d_index + + lb1 = 0 + ub1 = 0 + lb2 = 0 + ub2 = 0 + + ndims = dim_kinds(this%dim_kinds_index)%ndims + + ! The thread = 0 case is the boundaries for the whole proc/node + if (thread==0) then + d_index = dim_kinds(this%dim_kinds_index)%dim1_index + lb1 = dim_bounds(d_index)%lower_bound + ub1 = dim_bounds(d_index)%upper_bound + if(ndims>1)then + d_index = dim_kinds(this%dim_kinds_index)%dim2_index + lb2 = dim_bounds(d_index)%lower_bound + ub2 = dim_bounds(d_index)%upper_bound + end if + else + d_index = dim_kinds(this%dim_kinds_index)%dim1_index + lb1 = dim_bounds(d_index)%clump_lower_bound(thread) + ub1 = dim_bounds(d_index)%clump_upper_bound(thread) + if(ndims>1)then + d_index = dim_kinds(this%dim_kinds_index)%dim2_index + lb2 = dim_bounds(d_index)%clump_lower_bound(thread) + ub2 = dim_bounds(d_index)%clump_upper_bound(thread) + end if + end if + + end subroutine GetBounds + + subroutine Flush(this, thread, dim_bounds, dim_kinds) + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + integer, intent(in) :: thread + type(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) + + integer :: lb1, ub1, lb2, ub2 + + call this%GetBounds(thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) + + select case(trim(dim_kinds(this%dim_kinds_index)%name)) + case(patch_r8) + this%r81d(lb1:ub1) = this%flushval + case(site_r8) + this%r81d(lb1:ub1) = this%flushval + case(patch_ground_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(patch_size_pft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_ground_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_size_pft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(patch_int) + this%int1d(lb1:ub1) = nint(this%flushval) + case default + write(fates_log(),*) 'fates history variable type undefined while flushing history variables' + stop + !end_run + end select + + end subroutine Flush + +end module FatesHistoryVariableType diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 86fd070b4b..963d013e37 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -81,8 +81,8 @@ module CLMFatesInterfaceMod set_fates_ctrlparms, & allocate_bcin, & allocate_bcout - - use HistoryIOMod , only : fates_hio_interface_type + + use FatesHistoryInterfaceMod, only : fates_history_interface_type use ChecksBalancesMod , only : SummarizeNetFluxes, FATES_BGC_Carbon_BalanceCheck use EDTypesMod , only : udata @@ -139,7 +139,7 @@ module CLMFatesInterfaceMod type(f2hmap_type), allocatable :: f2hmap(:) ! fates_hio is the interface class for the history output - type(fates_hio_interface_type) :: fates_hio + type(fates_history_interface_type) :: fates_hist contains @@ -172,7 +172,7 @@ module CLMFatesInterfaceMod ! ==================================================================================== - subroutine init(this,bounds_proc, use_ed) + subroutine init(this, bounds_proc, use_ed) ! --------------------------------------------------------------------------------- ! This initializes the dlm_fates_interface_type @@ -255,8 +255,7 @@ subroutine init(this,bounds_proc, use_ed) write(iulog,*) 'clm_fates%init(): allocating for ',nclumps,' threads' end if - return - end subroutine init + end subroutine init ! ==================================================================================== @@ -414,8 +413,6 @@ subroutine check_hlm_active(this, nc, bounds_clump) end if end do - - end subroutine check_hlm_active ! ------------------------------------------------------------------------------------ @@ -510,7 +507,7 @@ subroutine dynamics_driv(this, nc, bounds_clump, & ! --------------------------------------------------------------------------------- ! Update history IO fields that depend on ecosystem dynamics ! --------------------------------------------------------------------------------- - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -635,7 +632,6 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & end do end associate - return end subroutine wrap_update_hlmfates_dyn ! ------------------------------------------------------------------------------------ @@ -681,7 +677,7 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) ! ------------------------------------------------------------------------ ! Update history IO fields that depend on ecosystem dynamics ! ------------------------------------------------------------------------ - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -691,8 +687,7 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) end do !$OMP END PARALLEL DO - - return + end subroutine init_restart ! ==================================================================================== @@ -749,14 +744,14 @@ subroutine init_coldstart(this, waterstate_inst, canopystate_inst) ! ------------------------------------------------------------------------ ! Update history IO fields that depend on ecosystem dynamics ! ------------------------------------------------------------------------ - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) end if end do !$OMP END PARALLEL DO - return + end subroutine init_coldstart ! ====================================================================================== @@ -847,7 +842,7 @@ subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) end do end associate - return + end subroutine wrap_sunfrac ! =================================================================================== @@ -1044,7 +1039,7 @@ subroutine wrap_btran(this,nc,fn,filterc,soilstate_inst, waterstate_inst, & end do end do end associate - return + end subroutine wrap_btran ! ==================================================================================== @@ -1063,7 +1058,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 EDParamsMod , only : ED_val_grperc 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, numPatchesPerCol @@ -1174,7 +1168,7 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & end associate call t_stopf('edpsn') - return + end subroutine wrap_photosynthesis ! ====================================================================================== @@ -1210,13 +1204,11 @@ subroutine wrap_accumulatefluxes(this, nc, fn, filterp) dtime) - call this%fates_hio%update_history_prod(nc, & + call this%fates_hist%update_history_prod(nc, & this%fates(nc)%nsites, & this%fates(nc)%sites, & dtime) - return - end subroutine wrap_accumulatefluxes ! ====================================================================================== @@ -1303,7 +1295,6 @@ subroutine wrap_canopy_radiation(this, bounds_clump, nc, & end associate - return end subroutine wrap_canopy_radiation ! ====================================================================================== @@ -1344,7 +1335,6 @@ subroutine wrap_litter_fluxout(this, nc, bounds_clump, canopystate_inst, soilbio soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lig_c_col(c,:) = this%fates(nc)%bc_out(s)%FATES_c_to_litr_lig_c_col(:) end do - end subroutine wrap_litter_fluxout ! ====================================================================================== @@ -1397,13 +1387,12 @@ subroutine wrap_bgc_summary(this, nc, soilbiogeochem_carbonflux_inst, & ! Update history variables that track these variables - call this%fates_hio%update_history_cbal(nc, & + call this%fates_hist%update_history_cbal(nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) end associate - return end subroutine wrap_bgc_summary ! ====================================================================================== @@ -1411,8 +1400,12 @@ end subroutine wrap_bgc_summary subroutine init_history_io(this,bounds_proc) use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp - use EDtypesMod , only : nlevsclass_ed - use clm_varpar , only : mxpft, nlevgrnd + + use FatesConstantsMod, only : fates_short_string_length, fates_long_string_length + use FatesHistoryInterfaceMod, only : fates_bounds_type + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 + ! Arguments class(hlm_fates_interface_type), intent(inout) :: this @@ -1427,15 +1420,20 @@ subroutine init_history_io(this,bounds_proc) integer :: nclumps ! number of threads on this proc integer :: s ! FATES site index integer :: c ! ALM/CLM column index - character(len=32) :: dim2name + character(len=fates_short_string_length) :: dim2name + character(len=fates_long_string_length) :: ioname + integer :: d_index, dk_index + type(fates_bounds_type) :: fates_bounds + type(fates_bounds_type) :: fates_clump + ! This routine initializes the types of output variables ! not the variables themselves, just the types ! --------------------------------------------------------------------------------- if(.not.use_ed) return - !associate(hio => this%fates_hio) + !associate(hio => this%fates_hist) nclumps = get_proc_clumps() @@ -1444,11 +1442,11 @@ subroutine init_history_io(this,bounds_proc) ! ! ------------------------------------------------------------------------------- ! Those who wish add variables that require new dimensions, please - ! see FATES: HistoryIOMod.F90. Dimension types are defined at the top of the + ! see FATES: FatesHistoryInterfaceMod.F90. Dimension types are defined at the top of the ! module, and a new explicitly named instance of that type should be created. ! With this new dimension, a new output type/kind can contain that dimension. - ! A new type/kind can be added to the iovar_dk structure, which defines its members - ! in created in init_iovar_dk_maps(). Make sure to increase the size of n_iovar_dk. + ! A new type/kind can be added to the dim_kinds structure, which defines its members + ! in created in init_dim_kinds_maps(). Make sure to increase the size of fates_num_dim_kinds. ! A type/kind of output is defined by the data type (ie r8,int,..) ! and the dimensions. Keep in mind that 3D variables (or 4D if you include time) ! are not really supported in CLM/ALM right now. There are ways around this @@ -1456,38 +1454,42 @@ subroutine init_history_io(this,bounds_proc) ! "scpf" ! ------------------------------------------------------------------------------------ - call this%fates_hio%dim_init(this%fates_hio%iopa_dim,'patch',nclumps,bounds_proc%begp,bounds_proc%endp) - call this%fates_hio%dim_init(this%fates_hio%iosi_dim,'column',nclumps,bounds_proc%begc,bounds_proc%endc) - call this%fates_hio%dim_init(this%fates_hio%iogrnd_dim,'levgrnd',nclumps,1,nlevgrnd) - call this%fates_hio%dim_init(this%fates_hio%ioscpf_dim,'levscpf',nclumps,1,nlevsclass_ed*mxpft) + call hlm_bounds_to_fates_bounds(bounds_proc, fates_bounds) - ! Allocate the mapping between FATES indices and the IO indices - allocate(this%fates_hio%iovar_map(nclumps)) + call this%fates_hist%Init(nclumps, fates_bounds) - ! Define the bounds on the first dimension for each thread - !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,s,c) + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) ! thread bounds for patch - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iopa_dim,nc,bounds_clump%begp,bounds_clump%endp) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iosi_dim,nc,bounds_clump%begc,bounds_clump%endc) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iogrnd_dim,nc,1,nlevgrnd) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%ioscpf_dim,nc,1,nlevsclass_ed*mxpft) + call hlm_bounds_to_fates_bounds(bounds_clump, fates_clump) + call this%fates_hist%SetThreadBounds(nc, fates_clump) + end do + !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------------------ - ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH - ! ------------------------------------------------------------------------------------ + ! ------------------------------------------------------------------------------------ + ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH + ! ------------------------------------------------------------------------------------ - allocate(this%fates_hio%iovar_map(nc)%site_index(this%fates(nc)%nsites)) - allocate(this%fates_hio%iovar_map(nc)%patch1_index(this%fates(nc)%nsites)) + ! Allocate the mapping between FATES indices and the IO indices + allocate(this%fates_hist%iovar_map(nclumps)) + + + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c) + do nc = 1,nclumps + + call get_clump_bounds(nc, bounds_clump) + + allocate(this%fates_hist%iovar_map(nc)%site_index(this%fates(nc)%nsites)) + allocate(this%fates_hist%iovar_map(nc)%patch1_index(this%fates(nc)%nsites)) do s=1,this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - this%fates_hio%iovar_map(nc)%site_index(s) = c - this%fates_hio%iovar_map(nc)%patch1_index(s) = col%patchi(c)+1 + this%fates_hist%iovar_map(nc)%site_index(s) = c + this%fates_hist%iovar_map(nc)%patch1_index(s) = col%patchi(c)+1 end do end do @@ -1497,100 +1499,76 @@ subroutine init_history_io(this,bounds_proc) ! PART II: USE THE JUST DEFINED DIMENSIONS TO ASSEMBLE THE VALID IO TYPES ! INTERF-TODO: THESE CAN ALL BE EMBEDDED INTO A SUBROUTINE IN HISTORYIOMOD ! ------------------------------------------------------------------------------------ - - call this%fates_hio%init_iovar_dk_maps() - - call this%fates_hio%set_dim_ptrs(dk_name='PA_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='SI_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='PA_GRND_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_GRND_R8',idim=2,dim_target=this%fates_hio%iogrnd_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='SI_GRND_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_GRND_R8',idim=2,dim_target=this%fates_hio%iogrnd_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='PA_SCPF_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_SCPF_R8',idim=2,dim_target=this%fates_hio%ioscpf_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='SI_SCPF_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_SCPF_R8',idim=2,dim_target=this%fates_hio%ioscpf_dim) - + call this%fates_hist%assemble_valid_output_types() ! ------------------------------------------------------------------------------------ ! PART III: DEFINE THE LIST OF OUTPUT VARIABLE OBJECTS, AND REGISTER THEM WITH THE ! HLM ACCORDING TO THEIR TYPES ! ------------------------------------------------------------------------------------ + call this%fates_hist%initialize_history_vars() + nvar = this%fates_hist%num_history_vars() - ! Determine how many of the history IO variables registered in FATES - ! are going to be allocated - - call this%fates_hio%define_history_vars('count',nvar) - this%fates_hio%n_hvars = nvar - - ! Allocate the list of history output variable objects - allocate(this%fates_hio%hvars(nvar)) - - ! construct the object that defines all of the IO variables - call this%fates_hio%define_history_vars('initialize') - - do ivar = 1,nvar + do ivar = 1, nvar - associate( vname => this%fates_hio%hvars(ivar)%vname, & - vunits => this%fates_hio%hvars(ivar)%units, & - vlong => this%fates_hio%hvars(ivar)%long, & - vdefault => this%fates_hio%hvars(ivar)%use_default, & - vavgflag => this%fates_hio%hvars(ivar)%avgflag, & - ioname => this%fates_hio%hvars(ivar)%iovar_dk_ptr%name ) - - + associate( vname => this%fates_hist%hvars(ivar)%vname, & + vunits => this%fates_hist%hvars(ivar)%units, & + vlong => this%fates_hist%hvars(ivar)%long, & + vdefault => this%fates_hist%hvars(ivar)%use_default, & + vavgflag => this%fates_hist%hvars(ivar)%avgflag) + + dk_index = this%fates_hist%hvars(ivar)%dim_kinds_index + ioname = trim(this%fates_hist%dim_kinds(dk_index)%name) select case(trim(ioname)) - case('PA_R8') + case(patch_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r81d, & + ptr_patch=this%fates_hist%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_R8') + case(site_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_col=this%fates_hio%hvars(ivar)%r81d, & + ptr_col=this%fates_hist%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('PA_GRND_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(patch_ground_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), & ! <--- addfld2d type2d=trim(dim2name), & ! <--- type2d avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r82d, & + ptr_patch=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('PA_SCPF_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(patch_size_pft_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_patch=this%fates_hio%hvars(ivar)%r82d, & + ptr_patch=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_GRND_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(site_ground_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_hio%hvars(ivar)%r82d, & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_SCPF_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(site_size_pft_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_hio%hvars(ivar)%r82d, & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) @@ -1602,8 +1580,31 @@ subroutine init_history_io(this,bounds_proc) end associate end do - return end subroutine init_history_io + subroutine hlm_bounds_to_fates_bounds(hlm, fates) + + use FatesHistoryInterfaceMod, only : fates_bounds_type + use EDtypesMod, only : nlevsclass_ed + use clm_varpar, only : mxpft, nlevgrnd + + implicit none + + type(bounds_type), intent(in) :: hlm + type(fates_bounds_type), intent(out) :: fates + + fates%patch_begin = hlm%begp + fates%patch_end = hlm%endp + + fates%column_begin = hlm%begc + fates%column_end = hlm%endc + + fates%ground_begin = 1 + fates%ground_end = nlevgrnd + + fates%pft_class_begin = 1 + fates%pft_class_end = nlevsclass_ed * mxpft + + end subroutine hlm_bounds_to_fates_bounds end module CLMFatesInterfaceMod From 525f30922bce9bc0581a78be0d91297a72d51b7e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 28 Nov 2016 23:26:38 -0800 Subject: [PATCH 7/8] Swapped out the EdNoFire for EdFire test. --- components/clm/cime_config/testdefs/testlist_clm.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml index e56c1f7667..238eb3e001 100644 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ b/components/clm/cime_config/testdefs/testlist_clm.xml @@ -694,8 +694,8 @@ ed - hobart hobart + hobart yellowstone yellowstone yellowstone @@ -709,8 +709,8 @@ ed - hobart hobart + hobart yellowstone yellowstone @@ -724,15 +724,15 @@ ed - hobart - ed + ed hobart + hobart yellowstone ed - hobart hobart + hobart yellowstone yellowstone yellowstone From dcd00dcaac3d359f4b87206f316fb2213e1c08a4 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 1 Dec 2016 11:59:29 -0700 Subject: [PATCH 8/8] Remove temporary_SF_switch Remove temporary_SF_switch. Spitfire is runtime configurable via name list and is now off by default. This switch was only used to disable spitfire at compile time. Fixes: 140 User interface changes?: spitfire configured at runtime instead of compile time. Code review: self Test suite: SMS_D_Mmpi-serial_Ld5.5x5_amazon.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 2ac7960 Test namelist changes: none Test answer changes: bit for bit Test summary: pass --- components/clm/src/ED/fire/SFMainMod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index f86b006c6c..be53100a71 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -52,11 +52,8 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) type (ed_patch_type), pointer :: currentPatch - integer temporary_SF_switch - !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 1 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 @@ -68,7 +65,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) write(iulog,*) 'use_ed_spit_fire',use_ed_spit_fire endif - if(use_ed_spit_fire.and.temporary_SF_switch==1)then + if(use_ed_spit_fire)then call fire_danger_index(currentSite, temperature_inst, atm2lnd_inst) call wind_effect(currentSite, atm2lnd_inst) call charecteristics_of_fuel(currentSite)