From a651a4ff2e0abadde4822a1f48ac9565b851cbdb Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 12 Jan 2017 15:19:13 -0700 Subject: [PATCH 01/46] Update ed parameter file. In summer 2016, the clm-ed and clm parameter files diverged wrt the fnitr parameter. This points to a new default clm-ed parameter file with fnitr the same as the clm values. This is necessary to ensure future refactoring is bit for bit when the clm and ed parameters are moved into separate files. Fixes: [NGT-ED Github issue #] User interface changes?: Yes. New default parameter file for clm-ed runs. This will primarily affect testing. Science users with their own parameter files should not see differences. Code review: andre Test suite: ed - yellowstone gnu, intel, pgi Test baseline: ed-clm-d116008 Test namelist changes: yes, new default parameterfile when ed is on Test answer changes: yes, when ed is on. clm should be unchanged Test summary: all functionality tests pass. answer changing for ed tests. Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test namelist changes: no Test answer changes: no, bit for bit for clm compsets without ed Test summary: all functionality tests pass bit for bit. --- components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 53348abe3a..ebc6d6712b 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -242,7 +242,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/paramdata/clm5_params.c160713.nc lnd/clm2/paramdata/clm_params.c160713.nc -lnd/clm2/paramdata/clm_params_ed.c160808.nc +lnd/clm2/paramdata/clm_params_ed.c170112.nc From 1a3b8cb9f53613ca0144602f8e5042dc4d3cb5a6 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 18 Jan 2017 12:55:46 -0700 Subject: [PATCH 02/46] Read fates parameters from their own file. The fates parameter file is now specified via a separate namelist fates_paramfile. This variable may or may not point to the same netcdf file as the host parameter file. All fates parameters are read from this file, including the pft level variables, which are now stored in EDpftvarcon instead of pftcon. Note that some parameters are shared between the host and fates. These are 'host' parameters, not fates parameters and are read from the host file. Work for NGT-ED Github issue #155 User interface changes?: Yes. Users who have custom parameter files will need to set namelist varible 'fates_paramfile' to point to their file instead. Host parameters are still read from the file specified by namelist variable 'paramfile'. If users have modified host parameters in addition to fates parameters, they will need to update both namelist variables. Code review: andre Test suite: clm_short Test baseline: clm4_5_12_r195 Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass Test suite: ed - yellowstone gnu, intel, pgi Test baseline: a651a4f Test namelist changes: yes, new namilest var fates_paramfile Test answer changes: bit for bit Test summary: all tests pass --- components/clm/bld/CLMBuildNamelist.pm | 3 +- .../namelist_defaults_clm4_5.xml | 7 +- .../namelist_definition_clm4_5.xml | 5 + .../ED/biogeochem/EDCanopyStructureMod.F90 | 16 +-- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 30 ++-- .../ED/biogeochem/EDGrowthFunctionsMod.F90 | 10 +- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 10 +- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 98 ++++++------- .../clm/src/ED/biogeophys/EDBtranMod.F90 | 6 +- .../src/ED/biogeophys/EDPhotosynthesisMod.F90 | 22 +-- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 12 +- components/clm/src/ED/fire/SFMainMod.F90 | 16 +-- components/clm/src/ED/main/EDInitMod.F90 | 10 +- components/clm/src/ED/main/EDPftvarcon.F90 | 129 +++++++++++++++++- components/clm/src/ED/main/EDTypesMod.F90 | 10 +- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 4 +- .../src/ED/main/FatesRestartInterfaceMod.F90 | 4 +- components/clm/src/main/clm_varctl.F90 | 5 + components/clm/src/main/controlMod.F90 | 10 +- components/clm/src/main/pftconMod.F90 | 37 +++-- components/clm/src/main/readParamsMod.F90 | 54 ++++++-- 21 files changed, 350 insertions(+), 148 deletions(-) diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm index 9abafbe81b..cec94ef1cf 100755 --- a/components/clm/bld/CLMBuildNamelist.pm +++ b/components/clm/bld/CLMBuildNamelist.pm @@ -1976,7 +1976,7 @@ sub setup_logic_params_file { if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'paramfile', - 'use_ed'=>$nl_flags->{'use_ed'}, 'phys'=>$nl_flags->{'phys'}, + 'phys'=>$nl_flags->{'phys'}, 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); } else { add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fpftcon'); @@ -3367,6 +3367,7 @@ sub setup_logic_ed { if ($physv->as_long() >= $physv->as_long("clm4_5") && value_is_true( $nl_flags->{'use_ed'}) ) { add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_ed_spit_fire', 'use_ed'=>$nl_flags->{'use_ed'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fates_paramfile', 'phys'=>$nl_flags->{'phys'}); } } diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml index ebc6d6712b..e843003601 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -240,9 +240,10 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/clm5_params.c160713.nc -lnd/clm2/paramdata/clm_params.c160713.nc -lnd/clm2/paramdata/clm_params_ed.c170112.nc +lnd/clm2/paramdata/clm5_params.c160713.nc +lnd/clm2/paramdata/clm_params.c160713.nc + +lnd/clm2/paramdata/clm_params_ed.c170112.nc diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml index 4ff011bfc8..9239b9ead5 100644 --- a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml @@ -510,6 +510,11 @@ Full pathname datafile with plant function type (PFT) constants combined with constants for biogeochem modules + +Full pathname datafile with fates parameters + + Full pathname of surface data file. diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index f5419cedd7..e91e4608d5 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -7,7 +7,7 @@ module EDCanopyStructureMod use shr_kind_mod , only : r8 => shr_kind_r8; use FatesGlobals , only : fates_log - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDGrowthFunctionsMod , only : c_area use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd @@ -617,7 +617,7 @@ subroutine canopy_spread( currentSite ) currentCohort => currentPatch%tallest do while (associated(currentCohort)) currentCohort%c_area = c_area(currentCohort) - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer) + currentCohort%c_area endif currentCohort => currentCohort%shorter @@ -663,7 +663,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use EDGrowthFunctionsMod , only : tree_lai, c_area use EDEcophysConType , only : EDecophyscon use EDtypesMod , only : area - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst ! !ARGUMENTS integer , intent(in) :: nsites @@ -727,7 +727,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) if(currentCohort%canopy_layer==1)then currentPatch%total_canopy_area = currentPatch%total_canopy_area + currentCohort%c_area - if(pftcon%woody(ft)==1)then + if(EDPftvarcon_inst%woody(ft)==1)then currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area endif endif @@ -989,11 +989,11 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) do iv = 1,currentCohort%NV-1 ! what is the height of this layer? (for snow burial purposes...) - ! pftcon%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + ! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & EDecophyscon%crown(currentCohort%pft) ) layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & - EDecophyscon%crown(currentCohort%pft)) ! pftcon%vertical_canopy_frac(ft)) + EDecophyscon%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) fraction_exposed =1.0_r8 @@ -1022,10 +1022,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) !Bottom layer iv = currentCohort%NV - ! pftcon%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + ! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & EDecophyscon%crown(currentCohort%pft) ) - ! pftcon%vertical_canopy_frac(ft)) + ! EDPftvarcon_inst%vertical_canopy_frac(ft)) layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & EDecophyscon%crown(currentCohort%pft)) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 2ccea2cad1..d468c03d78 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -8,7 +8,7 @@ module EDCohortDynamicsMod use FatesGlobals , only : fates_log use FatesConstantsMod , only : r8 => fates_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use EDGrowthFunctionsMod , only : c_area, tree_lai use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type @@ -114,11 +114,11 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & call endrun(msg=errMsg(sourcefile, __LINE__)) endif - if (new_cohort%siteptr%status==2 .and. pftcon%season_decid(pft) == 1) then + if (new_cohort%siteptr%status==2 .and. EDPftvarcon_inst%season_decid(pft) == 1) then new_cohort%laimemory = 0.0_r8 endif - if (new_cohort%siteptr%dstatus==2 .and. pftcon%stress_decid(pft) == 1) then + if (new_cohort%siteptr%dstatus==2 .and. EDPftvarcon_inst%stress_decid(pft) == 1) then new_cohort%laimemory = 0.0_r8 endif @@ -191,27 +191,27 @@ subroutine allocate_live_biomass(cc_p,mode) currentCohort => cc_p ft = currentcohort%pft - leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + pftcon%froot_leaf(ft)) + leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + EDPftvarcon_inst%froot_leaf(ft)) !currentcohort%bl = currentcohort%balive*leaf_frac !for deciduous trees, there are no leaves - if (pftcon%evergreen(ft) == 1) then + if (EDPftvarcon_inst%evergreen(ft) == 1) then currentcohort%laimemory = 0._r8 currentcohort%status_coh = 2 endif ! iagnore the root and stem biomass from the functional balance hypothesis. This is used when the leaves are !fully on. - !currentcohort%br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + !currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac !currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & ! currentcohort%laimemory)*leaf_frac leaves_off_switch = 0 - if (currentcohort%status_coh == 1.and.pftcon%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves + if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves leaves_off_switch = 1 !drought decid endif - if (currentcohort%status_coh == 1.and.pftcon%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves + if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves leaves_off_switch = 1 !cold decid endif @@ -232,8 +232,8 @@ subroutine allocate_live_biomass(cc_p,mode) if(mode==1)then currentcohort%npp_froot = currentcohort%npp_froot + & - max(0._r8,pftcon%froot_leaf(ft)*(currentcohort%balive+currentcohort%laimemory)*leaf_frac - currentcohort%br) / & - udata%deltat + max(0._r8, EDPftvarcon_inst%froot_leaf(ft)*(currentcohort%balive+currentcohort%laimemory)*leaf_frac - & + currentcohort%br) / udata%deltat currentcohort%npp_bsw = max(0._r8,EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & currentcohort%laimemory)*leaf_frac - currentcohort%bsw)/udata%deltat @@ -242,7 +242,7 @@ subroutine allocate_live_biomass(cc_p,mode) end if - currentcohort%br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & currentcohort%laimemory)*leaf_frac @@ -257,9 +257,9 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%bl = 0.0_r8 - ideal_balive = currentcohort%laimemory * pftcon%froot_leaf(ft) + & + ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%froot_leaf(ft) + & currentcohort%laimemory* EDecophyscon%sapwood_ratio(ft) * currentcohort%hite - currentcohort%br = pftcon%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * leaf_frac + currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * leaf_frac currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(ideal_balive + & currentcohort%laimemory)*leaf_frac @@ -271,7 +271,7 @@ subroutine allocate_live_biomass(cc_p,mode) if(mode==1)then currentcohort%npp_froot = currentcohort%npp_froot + & - max(0.0_r8,pftcon%froot_leaf(ft)*(ideal_balive + & + max(0.0_r8,EDPftvarcon_inst%froot_leaf(ft)*(ideal_balive + & currentcohort%laimemory)*leaf_frac*ratio_balive-currentcohort%br)/udata%deltat currentcohort%npp_bsw = max(0.0_r8,EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(ideal_balive + & @@ -289,7 +289,7 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%status_coh,currentcohort%balive write(fates_log(),*) 'actual vs predicted balive',ideal_balive,currentcohort%balive ,ratio_balive,leaf_frac write(fates_log(),*) 'leaf,root,stem',currentcohort%bl,currentcohort%br,currentcohort%bsw - write(fates_log(),*) 'pft',ft,pftcon%evergreen(ft),pftcon%season_decid(ft),leaves_off_switch + write(fates_log(),*) 'pft',ft,EDPftvarcon_inst%evergreen(ft),EDPftvarcon_inst%season_decid(ft),leaves_off_switch endif currentCohort%b = currentCohort%bdead + currentCohort%balive diff --git a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 index a400f46ab9..a3fc06ceac 100755 --- a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 @@ -8,7 +8,7 @@ module EDGrowthFunctionsMod use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : iulog - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use EDTypesMod , only : ed_cohort_type, cp_nlevcan, dinc_ed @@ -114,7 +114,7 @@ real(r8) function Bleaf( cohort_in ) else bleaf = 0.0419_r8 * (EDecophyscon%max_dbh(cohort_in%pft)**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 endif - slascaler = 0.03_r8/pftcon%slatop(cohort_in%pft) + slascaler = 0.03_r8/EDPftvarcon_inst%slatop(cohort_in%pft) bleaf = bleaf * slascaler !write(iulog,*) 'bleaf',bleaf, slascaler,cohort_in%pft @@ -145,7 +145,7 @@ real(r8) function tree_lai( cohort_in ) endif if( cohort_in%status_coh == 2 ) then ! are the leaves on? - slat = 1000.0_r8 * pftcon%slatop(cohort_in%pft) ! m2/g to m2/kg + slat = 1000.0_r8 * EDPftvarcon_inst%slatop(cohort_in%pft) ! m2/g to m2/kg cohort_in%c_area = c_area(cohort_in) ! call the tree area leafc_per_unitarea = cohort_in%bl/(cohort_in%c_area/cohort_in%n) !KgC/m2 if(leafc_per_unitarea > 0.0_r8)then @@ -225,7 +225,7 @@ real(r8) function c_area( cohort_in ) if (DEBUG_growth) then write(iulog,*) 'z_area 1',cohort_in%dbh,cohort_in%pft write(iulog,*) 'z_area 2',EDecophyscon%max_dbh - write(iulog,*) 'z_area 3',pftcon%woody + write(iulog,*) 'z_area 3',EDPftvarcon_inst%woody write(iulog,*) 'z_area 4',cohort_in%n write(iulog,*) 'z_area 5',cohort_in%patchptr%spread write(iulog,*) 'z_area 6',cohort_in%canopy_layer @@ -233,7 +233,7 @@ real(r8) function c_area( cohort_in ) end if dbh = min(cohort_in%dbh,EDecophyscon%max_dbh(cohort_in%pft)) - if(pftcon%woody(cohort_in%pft) == 1)then + if(EDPftvarcon_inst%woody(cohort_in%pft) == 1)then c_area = 3.142_r8 * cohort_in%n * & (cohort_in%patchptr%spread(cohort_in%canopy_layer)*dbh)**1.56_r8 else diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 5fae1a783f..fe44705e5b 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -7,7 +7,7 @@ module EDPatchDynamicsMod use shr_kind_mod , only : r8 => shr_kind_r8; use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varctl , only : iulog - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, maxPatchesPerCol use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, udata @@ -281,7 +281,7 @@ subroutine spawn_patches( currentSite ) nc%imort = nan else ! small trees - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then ! Number of trees in the understory of new patch, before we impose impact mortality and survivorship nc%n = currentCohort%n * patch_site_areadis/currentPatch%area @@ -566,7 +566,7 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) currentCohort => currentPatch%shortest do while(associated(currentCohort)) p = currentCohort%pft - if(pftcon%woody(p) == 1)then !DEAD (FROM FIRE) TREES + if(EDPftvarcon_inst%woody(p) == 1)then !DEAD (FROM FIRE) TREES !************************************/ ! Number of trees that died because of the fire, per m2 of ground. ! Divide their litter into the four litter streams, and spread evenly across ground surface. @@ -649,7 +649,7 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) do while(associated(currentCohort)) currentCohort%c_area = c_area(currentCohort) - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentCohort%cfa else burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentPatch%burnt_frac_litter(6) @@ -726,7 +726,7 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread canopy_dead*(currentCohort%br+currentCohort%bstore) else - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then understorey_dead = ED_val_understorey_death * currentCohort%n * (patch_site_areadis/currentPatch%area) !kgC/site/day currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + & diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index fccd8c0843..b2e51f09bb 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -12,7 +12,7 @@ module EDPhysiologyMod use TemperatureType , only : temperature_type use SoilStateType , only : soilstate_type use WaterstateType , only : waterstate_type - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -185,16 +185,19 @@ subroutine trim_canopy( currentSite ) if (currentCohort%year_net_uptake(z) /= 999._r8)then !there was activity this year in this leaf layer. !Leaf Cost kgC/m2/year-1 !decidous costs. - if (pftcon%season_decid(currentCohort%pft) == 1.or.pftcon%stress_decid(currentCohort%pft) == 1)then - currentCohort%leaf_cost = 1._r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) - currentCohort%leaf_cost = currentCohort%leaf_cost + 1.0_r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) * & - pftcon%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1.or. & + EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then + currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) + currentCohort%leaf_cost = currentCohort%leaf_cost + & + 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & + EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) else !evergreen costs - currentCohort%leaf_cost = 1.0_r8/(pftcon%slatop(currentCohort%pft)* & - pftcon%leaf_long(currentCohort%pft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 - currentCohort%leaf_cost = currentCohort%leaf_cost + 1.0_r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) * & - pftcon%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + currentCohort%leaf_cost = 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)* & + EDPftvarcon_inst%leaf_long(currentCohort%pft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 + currentCohort%leaf_cost = currentCohort%leaf_cost + & + 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & + EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then @@ -207,7 +210,7 @@ subroutine trim_canopy( currentSite ) ! keep trimming until none of the canopy is in negative carbon balance. if (currentCohort%hite > EDecophyscon%hgt_min(currentCohort%pft))then currentCohort%canopy_trim = currentCohort%canopy_trim - inc - if (pftcon%evergreen(currentCohort%pft) /= 1)then + if (EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - inc) endif trimmed = 1 @@ -494,7 +497,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) !LEAF OFF: DROUGHT DECIDUOUS LIFESPAN - if the leaf gets to the end of its useful life. A*, E* if (currentSite%dstatus == 2.and.t >= 10)then !D* !Are the leaves at the end of their lives? !FIX(RF,0401014)- this is hardwiring.... - if (timesincedleafon > 365.0*pftcon%leaf_long(7))then + if (timesincedleafon > 365.0*EDPftvarcon_inst%leaf_long(7))then currentSite%dstatus = 1 !alter status of site to 'leaves on' currentSite%dleafoffdate = t !record leaf on date endif @@ -542,7 +545,7 @@ subroutine phenology_leafonoff(currentSite) do while(associated(currentCohort)) !COLD LEAF ON - if (pftcon%season_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then if (currentSite%status == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !Are the leaves currently off? currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. @@ -586,7 +589,7 @@ subroutine phenology_leafonoff(currentSite) endif !season_decid !DROUGHT LEAF ON - if (pftcon%stress_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then if (currentSite%dstatus == 2)then !we have just moved to leaves being on . if (currentCohort%status_coh == 1)then !is it the leaf-on day? Are the leaves currently off? currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. @@ -778,11 +781,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort) call allocate_live_biomass(currentCohort,0) ! calculate target size of living biomass compartment for a given dbh. - target_balive = Bleaf(currentCohort) * (1.0_r8 + pftcon%froot_leaf(currentCohort%pft) + & + target_balive = Bleaf(currentCohort) * (1.0_r8 + EDPftvarcon_inst%froot_leaf(currentCohort%pft) + & EDecophyscon%sapwood_ratio(currentCohort%pft)*h) !target balive without leaves. if (currentCohort%status_coh == 1)then - target_balive = Bleaf(currentCohort) * (pftcon%froot_leaf(currentCohort%pft) + & + target_balive = Bleaf(currentCohort) * (EDPftvarcon_inst%froot_leaf(currentCohort%pft) + & EDecophyscon%sapwood_ratio(currentCohort%pft) * h) endif @@ -796,8 +799,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort) currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n ! Maintenance demands - if (pftcon%evergreen(currentCohort%pft) == 1)then !grass and EBT - currentCohort%leaf_md = currentCohort%bl / pftcon%leaf_long(currentCohort%pft) + if (EDPftvarcon_inst%evergreen(currentCohort%pft) == 1)then !grass and EBT + currentCohort%leaf_md = currentCohort%bl / EDPftvarcon_inst%leaf_long(currentCohort%pft) currentCohort%root_md = currentCohort%br / EDecophyscon%root_long(currentCohort%pft) currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif @@ -807,22 +810,22 @@ subroutine Growth_Derivatives( currentSite, currentCohort) !with which I am not especially comfortable, particularly as the concept of sapwood turnover is unclear for trees that !are still in an expansion phase. - if (pftcon%season_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (pftcon%stress_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (pftcon%stress_decid(currentCohort%pft) /= 1.and.pftcon%season_decid(currentCohort%pft) /= 1.and. & - pftcon%evergreen(currentCohort%pft) /= 1)then - write(iulog,*) 'problem with phenology definitions',currentCohort%pft,pftcon%stress_decid(currentCohort%pft), & - pftcon%season_decid(currentCohort%pft),pftcon%evergreen(currentCohort%pft) + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) /= 1.and.EDPftvarcon_inst%season_decid(currentCohort%pft) /= 1.and. & + EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then + write(iulog,*) 'problem with phenology definitions',currentCohort%pft,EDPftvarcon_inst%stress_decid(currentCohort%pft), & + EDPftvarcon_inst%season_decid(currentCohort%pft),EDPftvarcon_inst%evergreen(currentCohort%pft) endif ! FIX(RF,032414) -turned off for now as it makes balive go negative.... @@ -911,7 +914,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort) ! fraction of carbon going into active vs structural carbon if (currentCohort%dbh <= EDecophyscon%max_dbh(currentCohort%pft))then ! cap on leaf biomass dbldbd = dDbhdBd(currentCohort)/dDbhdBl(currentCohort) - dbrdbd = pftcon%froot_leaf(currentCohort%pft) * dbldbd + dbrdbd = EDPftvarcon_inst%froot_leaf(currentCohort%pft) * dbldbd dhdbd_fn = dhdbd(currentCohort) dbswdbd = EDecophyscon%sapwood_ratio(currentCohort%pft) * (h*dbldbd + currentCohort%bl*dhdbd_fn) u = 1.0_r8 / (dbldbd + dbrdbd + dbswdbd) @@ -1011,9 +1014,9 @@ subroutine recruitment( t, currentSite, currentPatch ) temp_cohort%hite = EDecophyscon%hgt_min(ft) temp_cohort%dbh = Dbh(temp_cohort) temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + pftcon%froot_leaf(ft) & + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) & + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite) - temp_cohort%bstore = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + pftcon%froot_leaf(ft) & + temp_cohort%bstore = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) & + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite)) temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*udata%deltat & / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) @@ -1026,17 +1029,17 @@ subroutine recruitment( t, currentSite, currentPatch ) endif temp_cohort%laimemory = 0.0_r8 - if (pftcon%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + pftcon%froot_leaf(ft) + & + if (EDPftvarcon_inst%season_decid(temp_cohort%pft) == 1.and.currentSite%status == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) + & EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite))*temp_cohort%balive endif - if (pftcon%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then - temp_cohort%laimemory = (1.0_r8/(1.0_r8 + pftcon%froot_leaf(ft) + & + if (EDPftvarcon_inst%stress_decid(temp_cohort%pft) == 1.and.currentSite%dstatus == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) + & EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite))*temp_cohort%balive endif cohortstatus = currentSite%status - if (pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + if (EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. cohortstatus = currentSite%dstatus endif @@ -1294,7 +1297,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) !use EDCLMLinkMod, only: cwd_fcel_ed, cwd_flig - use pftconMod, only : pftcon + use EDPftvarcon, only : EDPftvarcon_inst use shr_const_mod, only: SHR_CONST_CDAY use clm_varcon, only : zisoi, dzsoi_decomp, zsoi use EDParamsMod, only : ED_val_ag_biomass @@ -1404,8 +1407,9 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! use beta distribution parameter from Jackson et al., 1996 do ft = 1, numpft_ed do j = 1, cp_numlevdecomp - cinput_rootfr(ft,j) = ( pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j-1)*100._r8) - & - pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j)*100._r8) ) & + cinput_rootfr(ft,j) = ( & + EDPftvarcon_inst%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j-1)*100._r8) - & + EDPftvarcon_inst%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j)*100._r8) ) & / dzsoi_decomp(j) end do end do @@ -1415,10 +1419,10 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) do j = 1, cp_numlevdecomp ! use standard CLM root fraction profiles; cinput_rootfr(ft,j) = ( .5_r8*( & - exp(-pftcon%roota_par(ft) * zisoi(j-1)) & - + exp(-pftcon%rootb_par(ft) * zisoi(j-1)) & - - exp(-pftcon%roota_par(ft) * zisoi(j)) & - - exp(-pftcon%rootb_par(ft) * zisoi(j)))) / dzsoi_decomp(j) + exp(-EDPftvarcon_inst%roota_par(ft) * zisoi(j-1)) & + + exp(-EDPftvarcon_inst%rootb_par(ft) * zisoi(j-1)) & + - exp(-EDPftvarcon_inst%roota_par(ft) * zisoi(j)) & + - exp(-EDPftvarcon_inst%rootb_par(ft) * zisoi(j)))) / dzsoi_decomp(j) end do end do endif @@ -1606,26 +1610,26 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) do ft = 1,numpft_ed do j = 1, cp_numlevdecomp bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) ! bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_flab(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flab(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_flig(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flig(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) ! !! and seed_decay too. for now, use the same lability fractions as for leaf litter bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) ! enddo end do diff --git a/components/clm/src/ED/biogeophys/EDBtranMod.F90 b/components/clm/src/ED/biogeophys/EDBtranMod.F90 index 8ac4a51b36..bc9d541359 100644 --- a/components/clm/src/ED/biogeophys/EDBtranMod.F90 +++ b/components/clm/src/ED/biogeophys/EDBtranMod.F90 @@ -5,7 +5,7 @@ module EDBtranMod ! ! ------------------------------------------------------------------------------------ - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use clm_varcon , only : tfrz use EDTypesMod , only : ed_site_type, & ed_patch_type, & @@ -111,8 +111,8 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) !------------------------------------------------------------------------------ associate( & - smpsc => pftcon%smpsc , & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS - smpso => pftcon%smpso & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS + smpsc => EDPftvarcon_inst%smpsc , & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS + smpso => EDPftvarcon_inst%smpso & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS ) do s = 1,nsites diff --git a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 index 7e55aee9a4..c8970fdcf4 100644 --- a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +++ b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 @@ -43,7 +43,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) use abortutils , only : endrun use clm_varpar , only : mxpft ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) - use pftconMod , only : pftcon ! THIS WILL BE DEPRECATED WHEN PARAMETER + use EDPftvarcon , only : EDPftvarcon_inst ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) use EDParamsMod , only : ED_val_grperc use EDParamsMod , only : ED_val_ag_biomass @@ -241,13 +241,13 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) associate( & - c3psn => pftcon%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 - slatop => pftcon%slatop , & ! specific leaf area at top of canopy, projected area basis [m^2/gC] - flnr => pftcon%flnr , & ! fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) - woody => pftcon%woody , & ! Is vegetation woody or not? - fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-) - leafcn => pftcon%leafcn , & ! leaf C:N (gC/gN) - frootcn => pftcon%frootcn , & ! froot C:N (gc/gN) + c3psn => EDPftvarcon_inst%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 + slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, projected area basis [m^2/gC] + flnr => EDPftvarcon_inst%flnr , & ! fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) + woody => EDPftvarcon_inst%woody , & ! Is vegetation woody or not? + fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-) + leafcn => EDPftvarcon_inst%leafcn , & ! leaf C:N (gC/gN) + frootcn => EDPftvarcon_inst%frootcn , & ! froot C:N (gc/gN) bb_slope => EDecophyscon%BB_slope ) ! slope of BB relationship ! Peter Thornton: 3/13/09 @@ -533,7 +533,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) vcmax_z(CL,FT,iv) = vcmax_z(CL,FT,iv) * currentPatch%btran_ft(FT) ! completely removed respiration drought response - ! - (lmr_z(CL,FT,iv) * (1.0_r8-currentPatch%btran_ft(FT)) *pftcon%resp_drought_response(FT)) + ! - (lmr_z(CL,FT,iv) * (1.0_r8-currentPatch%btran_ft(FT)) *EDPftvarcon_inst%resp_drought_response(FT)) lmr_z(CL,FT,iv) = lmr_z(CL,FT,iv) end do ! iv @@ -878,7 +878,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%rdark = currentCohort%rdark * umolC_to_kgC leaf_frac = 1.0_r8/(currentCohort%canopy_trim + EDecophyscon%sapwood_ratio(currentCohort%pft) * & - currentCohort%hite + pftcon%froot_leaf(currentCohort%pft)) + currentCohort%hite + EDPftvarcon_inst%froot_leaf(currentCohort%pft)) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -951,7 +951,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%gpp_tstep = currentCohort%gpp_tstep * umolC_to_kgC ! add on whole plant respiration values in kgC/indiv/s-1 currentCohort%resp_m = currentCohort%livestem_mr + currentCohort%livecroot_mr + currentCohort%froot_mr - ! no drought response * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft)*pftcon%resp_drought_response(FT)) + ! no drought response * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft)*EDPftvarcon_inst%resp_drought_response(FT)) currentCohort%resp_m = currentCohort%resp_m + currentCohort%rdark ! convert from kgC/indiv/s to kgC/indiv/timestep diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index d76695916c..ce19f602b0 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -46,7 +46,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! ! !USES: use clm_varctl , only : iulog - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDtypesMod , only : ed_patch_type, numpft_ed, cp_nlevcan use EDTypesMod , only : ed_site_type @@ -113,11 +113,11 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) !----------------------------------------------------------------------- associate(& - rhol => pftcon%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir - rhos => pftcon%rhos , & ! Input: [real(r8) (:) ] stem reflectance: 1=vis, 2=nir - taul => pftcon%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir - taus => pftcon%taus , & ! Input: [real(r8) (:) ] stem transmittance: 1=vis, 2=nir - xl => pftcon%xl) ! Input: [real(r8) (:) ] ecophys const - leaf/stem orientation index + rhol => EDPftvarcon_inst%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir + rhos => EDPftvarcon_inst%rhos , & ! Input: [real(r8) (:) ] stem reflectance: 1=vis, 2=nir + taul => EDPftvarcon_inst%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir + taus => EDPftvarcon_inst%taus , & ! Input: [real(r8) (:) ] stem transmittance: 1=vis, 2=nir + xl => EDPftvarcon_inst%xl) ! Input: [real(r8) (:) ] ecophys const - leaf/stem orientation index ! albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) (USED IN LND2ATM,BALANCE_CHECK) ! albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) (LND2ATM,BALANCE_CHECK) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index be53100a71..47c96c3015 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -10,7 +10,7 @@ module SFMainMod use clm_varctl , only : iulog use atm2lndType , only : atm2lnd_type use TemperatureType , only : temperature_type - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysconType , only : EDecophyscon use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, AREA, DG_SF, FIRE_THRESHOLD use EDtypesMod , only : LB_SF, LG_SF, NCWD, TR_SF @@ -158,7 +158,7 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%livegrass = 0.0_r8 currentCohort => currentPatch%tallest do while(associated(currentCohort)) - if(pftcon%woody(currentCohort%pft) == 0)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 0)then currentPatch%livegrass = currentPatch%livegrass + currentCohort%bl*currentCohort%n/currentPatch%area endif currentCohort => currentCohort%shorter @@ -329,7 +329,7 @@ subroutine wind_effect ( currentSite, atm2lnd_inst) do while(associated(currentCohort)) write(iulog,*) 'SF currentCohort%c_area ',currentCohort%c_area - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area else total_grass_area = total_grass_area + currentCohort%c_area @@ -751,7 +751,7 @@ subroutine crown_scorching ( currentSite ) if (currentPatch%fire == 1) then currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if (pftcon%woody(currentCohort%pft) == 1) then !trees only + if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only tree_ag_biomass = tree_ag_biomass+(currentCohort%bl+ED_val_ag_biomass* & (currentCohort%bsw + currentCohort%bdead))*currentCohort%n endif !trees only @@ -766,7 +766,7 @@ subroutine crown_scorching ( currentSite ) currentPatch%SH = 0.0_r8 currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if (pftcon%woody(currentCohort%pft) == 1.and.(tree_ag_biomass > 0.0_r8)) then !trees only + if (EDPftvarcon_inst%woody(currentCohort%pft) == 1.and.(tree_ag_biomass > 0.0_r8)) then !trees only f_ag_bmass = ((currentCohort%bl+ED_val_ag_biomass*(currentCohort%bsw + & currentCohort%bdead))*currentCohort%n)/tree_ag_biomass !equation 16 in Thonicke et al. 2010 @@ -806,7 +806,7 @@ subroutine crown_damage ( currentSite ) do while(associated(currentCohort)) currentCohort%cfa = 0.0_r8 - if (pftcon%woody(currentCohort%pft) == 1) then !trees only + if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only ! Flames lower than bottom of canopy. ! c%hite is height of cohort if (currentPatch%SH < (currentCohort%hite-currentCohort%hite*EDecophyscon%crown(currentCohort%pft))) then @@ -867,7 +867,7 @@ subroutine cambial_damage_kill ( currentSite ) if (currentPatch%fire == 1) then currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if (pftcon%woody(currentCohort%pft) == 1) then !trees only + if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then !trees only ! Equation 21 in Thonicke et al 2010 bt = EDecophyscon%bark_scaler(currentCohort%pft)*currentCohort%dbh ! bark thickness. ! Equation 20 in Thonicke et al. 2010. @@ -919,7 +919,7 @@ subroutine post_fire_mortality ( currentSite ) do while(associated(currentCohort)) currentCohort%fire_mort = 0.0_r8 currentCohort%crownfire_mort = 0.0_r8 - if (pftcon%woody(currentCohort%pft) == 1) then + if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then ! Equation 22 in Thonicke et al. 2010. currentCohort%crownfire_mort = EDecophyscon%crown_kill(currentCohort%pft)*currentCohort%cfa**3.0_r8 ! Equation 18 in Thonicke et al. 2010. diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index e8830e4161..fb1e7ea275 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -14,7 +14,7 @@ module EDInitMod use CanopyStateType , only : canopystate_type use WaterStateType , only : waterstate_type use GridcellType , only : grc - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysConType , only : EDecophyscon use EDGrowthFunctionsMod , only : bdead, bleaf, dbh use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -252,17 +252,17 @@ subroutine init_cohorts( patch_in ) temp_cohort%dbh = Dbh(temp_cohort) ! FIX(RF, 090314) - comment out addition of ' + 0.0001_r8*pft ' - seperate out PFTs a little bit... temp_cohort%canopy_trim = 1.0_r8 temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + pftcon%froot_leaf(pft) & + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%froot_leaf(pft) & + EDecophyscon%sapwood_ratio(temp_cohort%pft)*temp_cohort%hite) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead - if( pftcon%evergreen(pft) == 1) then + if( EDPftvarcon_inst%evergreen(pft) == 1) then temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) temp_cohort%laimemory = 0._r8 cstatus = 2 endif - if( pftcon%season_decid(pft) == 1 ) then !for dorment places + if( EDPftvarcon_inst%season_decid(pft) == 1 ) then !for dorment places temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) !stored carbon in new seedlings. if(patch_in%siteptr%status == 2)then temp_cohort%laimemory = 0.0_r8 @@ -274,7 +274,7 @@ subroutine init_cohorts( patch_in ) cstatus = patch_in%siteptr%status endif - if ( pftcon%stress_decid(pft) == 1 ) then + if ( EDPftvarcon_inst%stress_decid(pft) == 1 ) then temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) temp_cohort%laimemory = Bleaf(temp_cohort) temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index 475ee7b1bb..1ac59074d3 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -6,7 +6,7 @@ module EDPftvarcon ! read and initialize vegetation (PFT) constants. ! ! !USES: - use clm_varpar , only : mxpft + use clm_varpar , only : mxpft, numrad, ivis, inir, nvariants use shr_kind_mod, only : r8 => shr_kind_r8 ! @@ -39,10 +39,40 @@ module EDPftvarcon real(r8) :: seed_alloc (0:mxpft) ! fraction of carbon balance allocated to seeds. real(r8) :: sapwood_ratio (0:mxpft) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m real(r8) :: dbh2h_m (0:mxpft) ! allocation parameter m from dbh to height + real(r8) :: woody(0:mxpft) + real(r8) :: stress_decid(0:mxpft) + real(r8) :: season_decid(0:mxpft) + real(r8) :: evergreen(0:mxpft) + real(r8) :: froot_leaf(0:mxpft) + real(r8) :: slatop(0:mxpft) + real(r8) :: leaf_long(0:mxpft) + real(r8) :: rootprof_beta(0:mxpft,nvariants) + real(r8) :: roota_par(0:mxpft) + real(r8) :: rootb_par(0:mxpft) + real(r8) :: lf_flab(0:mxpft) + real(r8) :: lf_fcel(0:mxpft) + real(r8) :: lf_flig(0:mxpft) + real(r8) :: fr_flab(0:mxpft) + real(r8) :: fr_fcel(0:mxpft) + real(r8) :: fr_flig(0:mxpft) + real(r8) :: rhol(0:mxpft, numrad) + real(r8) :: rhos(0:mxpft, numrad) + real(r8) :: taul(0:mxpft, numrad) + real(r8) :: taus(0:mxpft, numrad) + real(r8) :: xl(0:mxpft) + real(r8) :: c3psn(0:mxpft) + real(r8) :: flnr(0:mxpft) + real(r8) :: fnitr(0:mxpft) + real(r8) :: leafcn(0:mxpft) + real(r8) :: frootcn(0:mxpft) + real(r8) :: smpso(0:mxpft) + real(r8) :: smpsc(0:mxpft) end type EDPftvarcon_type type(EDPftvarcon_type), public :: EDPftvarcon_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ ! ! !PUBLIC MEMBER FUNCTIONS: public :: EDpftconrd ! Read and initialize vegetation (PFT) constants @@ -59,6 +89,7 @@ subroutine EDpftconrd( ncid ) ! !USES: use ncdio_pio , only : file_desc_t, ncd_io use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg ! ! !ARGUMENTS: implicit none @@ -133,6 +164,102 @@ subroutine EDpftconrd( ncid ) call ncd_io('sapwood_ratio',EDPftvarcon_inst%sapwood_ratio, 'read', ncid, readvar=readv) if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + call ncd_io('woody', EDPftvarcon_inst%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('stress_decid', EDPftvarcon_inst%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('season_decid', EDPftvarcon_inst%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('evergreen', EDPftvarcon_inst%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('froot_leaf', EDPftvarcon_inst%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('slatop', EDPftvarcon_inst%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('leaf_long', EDPftvarcon_inst%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rootprof_beta', EDPftvarcon_inst%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('roota_par', EDPftvarcon_inst%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rootb_par', EDPftvarcon_inst%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('lf_flab', EDPftvarcon_inst%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('lf_fcel', EDPftvarcon_inst%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('lf_flig', EDPftvarcon_inst%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fr_flab', EDPftvarcon_inst%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fr_fcel', EDPftvarcon_inst%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fr_flig', EDPftvarcon_inst%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rholvis', EDPftvarcon_inst%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rholnir', EDPftvarcon_inst%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rhosvis', EDPftvarcon_inst%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('rhosnir', EDPftvarcon_inst% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('taulvis', EDPftvarcon_inst%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('taulnir', EDPftvarcon_inst%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('tausvis', EDPftvarcon_inst%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('tausnir', EDPftvarcon_inst%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('xl', EDPftvarcon_inst%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('c3psn', EDPftvarcon_inst%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('flnr', EDPftvarcon_inst%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('fnitr', EDPftvarcon_inst%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('leafcn', EDPftvarcon_inst%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('frootcn', EDPftvarcon_inst%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('smpso', EDPftvarcon_inst%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('smpsc', EDPftvarcon_inst%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + ! HOLDING ON SEW ENSITIVITY-ANALYSIS PARAMETERS UNTIL MACHINE CONFIGS SET RGK/CX ! call ncd_io('dbh2h_m',EDPftvarcon_inst%dbh2h_m, 'read', ncid, readvar=readv) ! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 3419386adf..ce686880e5 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -634,7 +634,7 @@ subroutine set_root_fraction( this , depth_gl) ! ! !USES: use PatchType , only : clmpatch => patch - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst ! ! !ARGUMENTS class(ed_patch_type) :: this @@ -651,10 +651,10 @@ subroutine set_root_fraction( this , depth_gl) do lev = 1, cp_numlevsoil-1 this%rootfr_ft(ft,lev) = .5_r8*( & - exp(-pftcon%roota_par(ft) * depth_gl(lev-1)) & - + exp(-pftcon%rootb_par(ft) * depth_gl(lev-1)) & - - exp(-pftcon%roota_par(ft) * depth_gl(lev)) & - - exp(-pftcon%rootb_par(ft) * depth_gl(lev))) + exp(-EDPftvarcon_inst%roota_par(ft) * depth_gl(lev-1)) & + + exp(-EDPftvarcon_inst%rootb_par(ft) * depth_gl(lev-1)) & + - exp(-EDPftvarcon_inst%roota_par(ft) * depth_gl(lev)) & + - exp(-EDPftvarcon_inst%rootb_par(ft) * depth_gl(lev))) end do end do diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b2b090b24a..662ead47bc 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -11,7 +11,7 @@ module FatesHistoryInterfaceMod use EDTypesMod , only : cp_hio_ignore_val ! FIXME(bja, 2016-10) need to remove CLM dependancy - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst implicit none @@ -829,7 +829,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if ! Woody State Variables (basal area and number density and mortality) - if (pftcon%woody(ft) == 1) then + if (EDPftvarcon_inst%woody(ft) == 1) then hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*n_perm2*AREA hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*n_perm2*AREA diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index 18b77bc6cf..f906ca1c40 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -1286,7 +1286,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) use EDInitMod, only : zero_site use EDParamsMod, only : ED_val_maxspread use EDPatchDynamicsMod, only : create_patch - use pftconMod, only : pftcon + use EDPftvarcon, only : EDPftvarcon_inst ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this @@ -1396,7 +1396,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) cohortstatus = newp%siteptr%status - if(pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + if(EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. cohortstatus = newp%siteptr%dstatus endif diff --git a/components/clm/src/main/clm_varctl.F90 b/components/clm/src/main/clm_varctl.F90 index 894c796bfa..b056dae5e4 100644 --- a/components/clm/src/main/clm_varctl.F90 +++ b/components/clm/src/main/clm_varctl.F90 @@ -310,6 +310,11 @@ module clm_varctl ! namelist: write CH4 extra diagnostic output logical, public :: hist_wrtch4diag = .false. + !---------------------------------------------------------- + ! ED/FATES + !---------------------------------------------------------- + character(len=fname_len), public :: fates_paramfile = ' ' + !---------------------------------------------------------- ! Migration of CPP variables !---------------------------------------------------------- diff --git a/components/clm/src/main/controlMod.F90 b/components/clm/src/main/controlMod.F90 index 4ff851a52b..d1bb34a749 100644 --- a/components/clm/src/main/controlMod.F90 +++ b/components/clm/src/main/controlMod.F90 @@ -203,7 +203,7 @@ subroutine control_init( ) namelist /clm_inparm/ use_c13, use_c14 - namelist /clm_inparm/ use_ed, use_ed_spit_fire + namelist /clm_inparm/ fates_paramfile, use_ed, use_ed_spit_fire ! CLM 5.0 nitrogen flags namelist /clm_inparm/ use_flexibleCN, use_luna @@ -576,6 +576,7 @@ subroutine control_spmd() call mpi_bcast (use_ed, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_ed_spit_fire, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (fates_paramfile, len(fates_paramfile) , MPI_CHARACTER, 0, mpicom, ier) ! flexibleCN nitrogen model call mpi_bcast (use_flexibleCN, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -910,6 +911,13 @@ subroutine control_print () write(iulog, *) ' carbon_resp_opt = ', carbon_resp_opt end if write(iulog, *) ' use_luna = ', use_luna + + write(iulog, *) ' ED/FATES: ' + write(iulog, *) ' use_ed = ', use_ed + if (use_ed) then + write(iulog, *) ' use_ed_spit_fire = ', use_ed_spit_fire + write(iulog, *) ' fates_paramfile = ', fates_paramfile + end if end subroutine control_print diff --git a/components/clm/src/main/pftconMod.F90 b/components/clm/src/main/pftconMod.F90 index 4bbd9978ae..5c47279a6a 100644 --- a/components/clm/src/main/pftconMod.F90 +++ b/components/clm/src/main/pftconMod.F90 @@ -465,7 +465,6 @@ subroutine InitRead(this) use ncdio_pio , only : ncd_inqdid, ncd_inqdlen use clm_varctl , only : paramfile, use_ed, use_flexibleCN, use_dynroot use spmdMod , only : masterproc - use EDPftvarcon , only : EDpftconrd ! ! !ARGUMENTS: class(pftcon_type) :: this @@ -975,13 +974,6 @@ subroutine InitRead(this) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) end if - ! - ! ED variables - ! - if ( use_ed ) then - ! The following sets the module variable EDpftcon_inst in EDPftcon - call EDpftconrd ( ncid ) - endif ! ! Dynamic Root variables for crops ! @@ -992,6 +984,8 @@ subroutine InitRead(this) call ncd_pio_closefile(ncid) + call readFatesParametersPFT() + do i = 0, mxpft if (.not. use_ed)then if ( trim(adjustl(pftname(i))) /= trim(expected_pftnames(i)) )then @@ -1359,5 +1353,32 @@ subroutine Clean(this) end subroutine Clean + subroutine readFatesParametersPFT() + + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t + use ncdio_pio , only : ncd_inqdid, ncd_inqdlen + use clm_varctl , only : fates_paramfile, use_ed + use EDPftvarcon , only : EDpftconrd + + implicit none + + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: npft ! number of pfts on pft-physiology file + + if ( use_ed ) then + call getfil (fates_paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdid(ncid, 'pft', dimid) + call ncd_inqdlen(ncid, dimid, npft) + ! The following sets the module variable EDpftcon_inst in EDPftcon + call EDpftconrd ( ncid ) + call ncd_pio_closefile(ncid) + endif + + end subroutine readFatesParametersPFT + end module pftconMod diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index 5f16421700..cf08c83d89 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -17,6 +17,7 @@ module readParamsMod private ! public :: readParameters + private :: readFatesParameters !----------------------------------------------------------------------- contains @@ -25,9 +26,6 @@ module readParamsMod subroutine readParameters (nutrient_competition_method, photosyns_inst) ! ! ! USES: - use EDSharedParamsMod , only : EDParamsReadShared - use EDParamsMod , only : EDParamsRead - use SFParamsMod , only : SFParamsRead use CNSharedParamsMod , only : CNParamsReadShared use CNGapMortalityMod , only : readCNGapMortParams => readParams use CNMRespMod , only : readCNMRespParams => readParams @@ -45,6 +43,7 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type + use EDSharedParamsMod , only : EDParamsReadShared ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst @@ -67,15 +66,6 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) call ncd_inqdid(ncid,'pft',dimid) call ncd_inqdlen(ncid,dimid,npft) - ! - ! Ecosystem Dynamics model - ! - if (use_ed) then - call EDParamsReadShared(ncid) - call EDParamsRead(ncid) - call SFParamsRead(ncid) - end if - ! ! Above ground biogeochemistry... ! @@ -101,6 +91,10 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) call readSoilBiogeochemPotentialParams(ncid) call CNParamsReadShared(ncid, NLFilename_in) ! this is called CN params but really is for the soil biogeochem parameters + ! FIXME(bja, 2017-01) ED shared params must be read from the + ! host file, not the fates file to be consistent with the host. + call EDParamsReadShared(ncid) + call readCH4Params (ncid) end if @@ -113,6 +107,42 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) ! call ncd_pio_closefile(ncid) + call readFatesParameters() + end subroutine readParameters + !----------------------------------------------------------------------- + subroutine readFatesParameters() + + use clm_varctl , only : fates_paramfile + + use EDParamsMod , only : EDParamsRead + use SFParamsMod , only : SFParamsRead + + implicit none + + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: npft ! number of pfts on pft-physiology file + character(len=32) :: subname = 'readFatesParameters' + + if (use_ed) then + if (masterproc) then + write(iulog,*) 'paramMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' parameters ' + end if + + call getfil (fates_paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdid(ncid, 'pft', dimid) + call ncd_inqdlen(ncid, dimid, npft) + + call EDParamsRead(ncid) + call SFParamsRead(ncid) + + call ncd_pio_closefile(ncid) + end if + + end subroutine readFatesParameters + end module readParamsMod From 5bdbd35a46a05237a75c962f55cdeb4273c52227 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 19 Jan 2017 13:36:00 -0700 Subject: [PATCH 03/46] First pass at FatesParametersInterface First implementation of FatesParametersInterface to allow fates to request a parameter set be read by the host. Implementation is used for scalar parameters. Initial implementation of 1d and 2d arrays is done, but not used (and not expected to work) until further refinement of array dimension bounds is implemented. User interface changes?: No Code review: andre Test suite: ed - yellowstone gnu, intel, pgi Test baseline: a651a4f Test namelist changes: yes, addition of fates_paramfile Test answer changes: bit for bit Test summary: all tests pass Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_1_r195 Test namelist changes: no Test answer changes: bit for bit Test summary: all tests pass --- components/clm/src/ED/main/EDParamsMod.F90 | 260 +++++++++++++----- .../src/ED/main/FatesParametersInterface.F90 | 249 +++++++++++++++++ components/clm/src/main/readParamsMod.F90 | 46 +++- 3 files changed, 486 insertions(+), 69 deletions(-) create mode 100644 components/clm/src/ED/main/FatesParametersInterface.F90 diff --git a/components/clm/src/ED/main/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90 index 16e2f2f577..44be691eb3 100644 --- a/components/clm/src/ED/main/EDParamsMod.F90 +++ b/components/clm/src/ED/main/EDParamsMod.F90 @@ -4,7 +4,8 @@ module EDParamsMod ! use shr_kind_mod , only: r8 => shr_kind_r8 use EDtypesMod , only: maxPft - + use FatesParametersInterface, only : param_string_length + implicit none save ! private - if we allow this module to be private, it does not allow the protected values below to be @@ -13,6 +14,7 @@ module EDParamsMod ! ! this is what the user can use for the actual values ! + real(r8),protected :: ED_val_grass_spread real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort @@ -26,20 +28,23 @@ module EDParamsMod real(r8),protected :: ED_val_profile_tol real(r8),protected :: ED_val_ag_biomass - character(len=20),parameter :: ED_name_grass_spread = "grass_spread" - character(len=20),parameter :: ED_name_comp_excln = "comp_excln" - character(len=20),parameter :: ED_name_stress_mort = "stress_mort" - character(len=20),parameter :: ED_name_dispersal = "dispersal" - character(len=20),parameter :: ED_name_grperc = "grperc" - character(len=20),parameter :: ED_name_maxspread = "maxspread" - character(len=20),parameter :: ED_name_minspread = "minspread" - character(len=20),parameter :: ED_name_init_litter = "init_litter" - character(len=20),parameter :: ED_name_nfires = "nfires" - character(len=20),parameter :: ED_name_understorey_death = "understorey_death" - character(len=20),parameter :: ED_name_profile_tol = "profile_tol" - character(len=20),parameter :: ED_name_ag_biomass= "ag_biomass" + character(len=param_string_length),parameter :: ED_name_grass_spread = "grass_spread" + character(len=param_string_length),parameter :: ED_name_comp_excln = "comp_excln" + character(len=param_string_length),parameter :: ED_name_stress_mort = "stress_mort" + character(len=param_string_length),parameter :: ED_name_dispersal = "dispersal" + character(len=param_string_length),parameter :: ED_name_grperc = "grperc" + character(len=param_string_length),parameter :: ED_name_maxspread = "maxspread" + character(len=param_string_length),parameter :: ED_name_minspread = "minspread" + character(len=param_string_length),parameter :: ED_name_init_litter = "init_litter" + character(len=param_string_length),parameter :: ED_name_nfires = "nfires" + character(len=param_string_length),parameter :: ED_name_understorey_death = "understorey_death" + character(len=param_string_length),parameter :: ED_name_profile_tol = "profile_tol" + character(len=param_string_length),parameter :: ED_name_ag_biomass= "ag_biomass" public :: EDParamsRead + public :: FatesParamsInit + public :: FatesRegisterParams + public :: FatesReceiveParams contains @@ -57,11 +62,34 @@ subroutine EDParamsRead(ncid) ! arguments type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + call FatesParamsInit() call EDParamsReadLocal(ncid) end subroutine EDParamsRead + !----------------------------------------------------------------------- + subroutine FatesParamsInit() + ! Initialize all parameters to nan to ensure that we get valid + ! values back from the host. + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + + implicit none + ED_val_grass_spread = nan + ED_val_comp_excln = nan + ED_val_stress_mort = nan + ED_val_dispersal = nan + ED_val_grperc(:) = nan + ED_val_maxspread = nan + ED_val_minspread = nan + ED_val_init_litter = nan + ED_val_nfires = nan + ED_val_understorey_death = nan + ED_val_profile_tol = nan + ED_val_ag_biomass = nan + + end subroutine FatesParamsInit !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- @@ -84,67 +112,171 @@ subroutine EDParamsReadLocal(ncid) ! call read function ! - call readNcdio(ncid = ncid, & - varName=ED_name_grass_spread, & - callingName=subname, & - retVal=ED_val_grass_spread) - - call readNcdio(ncid = ncid, & - varName=ED_name_comp_excln, & - callingName=subname, & - retVal=ED_val_comp_excln) + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_grass_spread, & + !X! callingName=subname, & + !X! retVal=ED_val_grass_spread) - call readNcdio(ncid = ncid, & - varName=ED_name_stress_mort, & - callingName=subname, & - retVal=ED_val_stress_mort) + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_comp_excln, & + !X! callingName=subname, & + !X! retVal=ED_val_comp_excln) - call readNcdio(ncid = ncid, & - varName=ED_name_dispersal, & - callingName=subname, & - retVal=ED_val_dispersal) + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_stress_mort, & + !X! callingName=subname, & + !X! retVal=ED_val_stress_mort) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_dispersal, & + !X! callingName=subname, & + !X! retVal=ED_val_dispersal) call readNcdio(ncid = ncid, & varName=ED_name_grperc, & callingName=subname, & retVal=ED_val_grperc) - call readNcdio(ncid = ncid, & - varName=ED_name_maxspread, & - callingName=subname, & - retVal=ED_val_maxspread) - - call readNcdio(ncid = ncid, & - varName=ED_name_minspread, & - callingName=subname, & - retVal=ED_val_minspread) - - call readNcdio(ncid = ncid, & - varName=ED_name_init_litter, & - callingName=subname, & - retVal=ED_val_init_litter) - - call readNcdio(ncid = ncid, & - varName=ED_name_nfires, & - callingName=subname, & - retVal=ED_val_nfires) - - call readNcdio(ncid = ncid, & - varName=ED_name_understorey_death, & - callingName=subname, & - retVal=ED_val_understorey_death) - - call readNcdio(ncid = ncid, & - varName=ED_name_profile_tol, & - callingName=subname, & - retVal=ED_val_profile_tol) - - call readNcdio(ncid = ncid, & - varName=ED_name_ag_biomass, & - callingName=subname, & - retVal=ED_val_ag_biomass) + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_maxspread, & + !X! callingName=subname, & + !X! retVal=ED_val_maxspread) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_minspread, & + !X! callingName=subname, & + !X! retVal=ED_val_minspread) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_init_litter, & + !X! callingName=subname, & + !X! retVal=ED_val_init_litter) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_nfires, & + !X! callingName=subname, & + !X! retVal=ED_val_nfires) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_understorey_death, & + !X! callingName=subname, & + !X! retVal=ED_val_understorey_death) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_profile_tol, & + !X! callingName=subname, & + !X! retVal=ED_val_profile_tol) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=ED_name_ag_biomass, & + !X! callingName=subname, & + !X! retVal=ED_val_ag_biomass) end subroutine EDParamsReadLocal + !----------------------------------------------------------------------- + subroutine FatesRegisterParams(fates_params) + ! Register the parameters we want the host to provide, and + ! indicate whether they are fates parameters or host parameters + ! that need to be synced with host values. + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) + + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_stress_mort, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_dispersal, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_maxspread, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_minspread, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_init_litter, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_nfires, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_profile_tol, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_ag_biomass, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + end subroutine FatesRegisterParams + + !----------------------------------------------------------------------- + subroutine FatesReceiveParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call fates_params%RetreiveParameter(name=ED_name_grass_spread, & + data=ED_val_grass_spread) + + call fates_params%RetreiveParameter(name=ED_name_comp_excln, & + data=ED_val_comp_excln) + + call fates_params%RetreiveParameter(name=ED_name_grass_spread, & + data=ED_val_grass_spread) + + call fates_params%RetreiveParameter(name=ED_name_comp_excln, & + data=ED_val_comp_excln) + + call fates_params%RetreiveParameter(name=ED_name_stress_mort, & + data=ED_val_stress_mort) + + call fates_params%RetreiveParameter(name=ED_name_dispersal, & + data=ED_val_dispersal) + + call fates_params%RetreiveParameter(name=ED_name_maxspread, & + data=ED_val_maxspread) + + call fates_params%RetreiveParameter(name=ED_name_minspread, & + data=ED_val_minspread) + + call fates_params%RetreiveParameter(name=ED_name_init_litter, & + data=ED_val_init_litter) + + call fates_params%RetreiveParameter(name=ED_name_nfires, & + data=ED_val_nfires) + + call fates_params%RetreiveParameter(name=ED_name_understorey_death, & + data=ED_val_understorey_death) + + call fates_params%RetreiveParameter(name=ED_name_profile_tol, & + data=ED_val_profile_tol) + + call fates_params%RetreiveParameter(name=ED_name_ag_biomass, & + data=ED_val_ag_biomass) + + end subroutine FatesReceiveParams + end module EDParamsMod diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 new file mode 100644 index 0000000000..1e21e64b24 --- /dev/null +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -0,0 +1,249 @@ +module FatesParametersInterface + ! NOTE(bja, 2017-01) this is part of the interface between fates and + ! the host model. To avoid circular dependancies, it should not + ! depend on any host modules. + + use FatesConstantsMod, only : r8 => fates_r8 + + implicit none + + integer, parameter, public :: max_params = 250 + integer, parameter, public :: max_dimensions = 2 + integer, parameter, public :: param_string_length = 40 + integer, parameter, public :: dimension_shape_scalar = 0 + integer, parameter, public :: dimension_shape_1d = 1 + integer, parameter, public :: dimension_shape_2d = 2 + + ! FIXME(bja, 2017-01) these strings need to be changed to 'fates_' + ! to namespace dimonsions and prevent name collisions if someone + ! wants to write a single netcdf file containing host and fates + ! parameters. Can't be done easily until this framework is being + ! used to read variables. + character(len=*), parameter, public :: dimension_name_scalar = 'scalar' + character(len=*), parameter, public :: dimension_name_pft = 'pft' + character(len=*), parameter, public :: dimension_name_segment = 'segment' + + type, private :: parameter_type + character(len=param_string_length) :: name + logical :: host_parameter + integer :: dimension_shape + character(len=param_string_length) :: dimension_names(max_dimensions) + real(r8), allocatable :: data(:, :) + end type parameter_type + + type, public :: fates_parameters_type + integer, private :: num_parameters + type(parameter_type), private :: parameters(max_params) + + contains + procedure, public :: Init + procedure, public :: RegisterParameter + generic, public :: RetreiveParameter => RetreiveParameterScalar, RetreiveParameter1D, RetreiveParameter2D + generic, public :: SetData => SetDataScalar, SetData1D, SetData2D + procedure, public :: GetMetaData + procedure, public :: num_params + procedure, private :: RetreiveParameterScalar + procedure, private :: RetreiveParameter1D + procedure, private :: RetreiveParameter2D + procedure, private :: SetDataScalar + procedure, private :: SetData1D + procedure, private :: SetData2D + procedure, private :: FindIndex + + end type fates_parameters_type + +contains + + !----------------------------------------------------------------------- + subroutine Init(this) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + + this%num_parameters = 0 + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine RegisterParameter(this, name, dimension_shape, dimension_names, host_parameter) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + integer, intent(in) :: dimension_shape + character(len=param_string_length) :: dimension_names(1:) + logical, intent(in), optional :: host_parameter + + integer :: i, n, num_names + + this%num_parameters = this%num_parameters + 1 + i = this%num_parameters + ! FIXME(bja, 2017-01) assert(i <= max_params) + this%parameters(i)%name = name + this%parameters(i)%dimension_shape = dimension_shape + ! FIXME(bja, 2017-01) assert(size(dimension_names, 1) <= max_dimensions) + num_names = min(max_dimensions, size(dimension_names, 1)) + do n = 1, num_names + this%parameters(i)%dimension_names(n) = dimension_names(n) + end do + this%parameters(i)%host_parameter = .false. + if (present(host_parameter)) then + this%parameters(i)%host_parameter = .true. + end if + + end subroutine RegisterParameter + + !----------------------------------------------------------------------- + subroutine RetreiveParameterScalar(this, name, data) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out) :: data + + integer :: i + + i = this%FindIndex(name) + ! assert(size(data) == size(this%parameters(i)%data)) + data = this%parameters(i)%data(1, 1) + + end subroutine RetreiveParameterScalar + + !----------------------------------------------------------------------- + subroutine RetreiveParameter1D(this, name, data) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out) :: data(:) + + integer :: i + + i = this%FindIndex(name) + ! assert(size(data) == size(this%parameters(i)%data)) + data = this%parameters(i)%data(:, 1) + + end subroutine RetreiveParameter1D + + !----------------------------------------------------------------------- + subroutine RetreiveParameter2D(this, name, data) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out) :: data(:, :) + + integer :: i + + i = this%FindIndex(name) + ! assert(size(data) == size(this%parameters(i)%data)) + data = this%parameters(i)%data + + end subroutine RetreiveParameter2D + + !----------------------------------------------------------------------- + function FindIndex(this, name) result(i) + + implicit none + + class(fates_parameters_type), intent(in) :: this + character(len=param_string_length), intent(in) :: name + + integer :: i + + do i = 1, this%num_parameters + if (trim(this%parameters(i)%name) == trim(name)) then + exit + end if + end do + if (i > this%num_parameters) then + ! error, parameter name not found. + end if + + end function FindIndex + + !----------------------------------------------------------------------- + integer function num_params(this) + + implicit none + + class(fates_parameters_type), intent(in) :: this + + num_params = this%num_parameters + + end function num_params + + !----------------------------------------------------------------------- + subroutine GetMetaData(this, index, name, dimension_shape) + + implicit none + + class(fates_parameters_type), intent(in) :: this + integer, intent(in) :: index + character(len=param_string_length), intent(out) :: name + integer, intent(out) :: dimension_shape + + name = this%parameters(index)%name + dimension_shape = this%parameters(index)%dimension_shape + + end subroutine GetMetaData + + !----------------------------------------------------------------------- + subroutine SetDataScalar(this, index, data) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(in) :: index + real(r8), intent(in) :: data + + allocate(this%parameters(index)%data(1, 1)) + this%parameters(index)%data(1, 1) = data + + end subroutine SetDataScalar + + !----------------------------------------------------------------------- + subroutine SetData1D(this, index, data) + ! FIXME(bja, 2017-01) this is broken, needs data dimensions to work correctly! + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(in) :: index + real(r8), intent(in) :: data(:) + + allocate(this%parameters(index)%data(size(data), 1)) + this%parameters(index)%data(:, 1) = data + + end subroutine SetData1D + + !----------------------------------------------------------------------- + subroutine SetData2D(this, index, data) + ! FIXME(bja, 2017-01) this is broken, needs data dimensions to work correctly! + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(in) :: index + real(r8), intent(in) :: data(:, :) + + ! NOTE(bja, 2017-01) This should work for fortran 2003? Or 2008? + ! Either way, it works with intel and pgi being used in 2017-01, + ! but is broken in gfortran 5.2 and earlier. That would copy the + ! data as well.... + + !X! allocate(this%parameters(index)%data, source=data) + + allocate(this%parameters(index)%data(size(data, 1), size(data, 2))) + this%parameters(index)%data = data + + end subroutine SetData2D +end module FatesParametersInterface + + + diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index cf08c83d89..5ee449f694 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -111,13 +111,19 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) end subroutine readParameters - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- subroutine readFatesParameters() - use clm_varctl , only : fates_paramfile + use clm_varctl, only : fates_paramfile + use shr_kind_mod, only: r8 => shr_kind_r8 + use paramUtilMod, only : readNcdio - use EDParamsMod , only : EDParamsRead - use SFParamsMod , only : SFParamsRead + use EDParamsMod, only : EDParamsRead, FatesRegisterParams, FatesReceiveParams + use SFParamsMod, only : SFParamsRead + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length + use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d + use FatesParametersInterface, only : dimension_name_pft implicit none @@ -126,6 +132,10 @@ subroutine readFatesParameters() integer :: dimid ! netCDF dimension id integer :: npft ! number of pfts on pft-physiology file character(len=32) :: subname = 'readFatesParameters' + class(fates_parameters_type), allocatable :: fates_params + integer :: i, num_params, dimension_shape + real(r8), allocatable :: data(:, :) + character(len=param_string_length) :: name if (use_ed) then if (masterproc) then @@ -134,12 +144,38 @@ subroutine readFatesParameters() call getfil (fates_paramfile, locfn, 0) call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_inqdid(ncid, 'pft', dimid) + call ncd_inqdid(ncid, dimension_name_pft, dimid) call ncd_inqdlen(ncid, dimid, npft) + ! read using the old infrastrructure call EDParamsRead(ncid) call SFParamsRead(ncid) + ! read parameters with new fates parammeter infrastructure + allocate(fates_params) + allocate(data(npft, npft)) ! FIXME(bja, 2017-01) correct? maxpft? + call fates_params%Init() + call FatesRegisterParams(fates_params) + num_params = fates_params%num_params() + do i = 1, num_params + call fates_params%GetMetaData(i, name, dimension_shape) + select case(dimension_shape) + case(dimension_shape_scalar) + call readNcdio(ncid, name, subname, data(1, 1)) + call fates_params%SetData(i, data(1, 1)) + case(dimension_shape_1d) + call readNcdio(ncid, name, subname, data(:, 1)) + call fates_params%SetData(i, data(:, 1)) + case(dimension_shape_2d) + call readNcdio(ncid, name, subname, data(:, :)) + call fates_params%SetData(i, data(:, :)) + case default + ! error, unsupported number of dimensions + end select + end do + call FatesReceiveParams(fates_params) + deallocate(data) + deallocate(fates_params) call ncd_pio_closefile(ncid) end if From 7c0fa285cefa40dcda4caae06bb82abbd57074cd Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 20 Jan 2017 10:27:21 -0700 Subject: [PATCH 04/46] Move grperc parameter into EDPftvarcon EDParams is primarily scalar values, grperc was the only pft parameter. This moves grperc into EDPftvarcon with the other pft parameters. User interface changes?: No Code review: andre Test suite: ed - yellowstone gnu, intel, pgi Test baseline: a651a4f Test namelist changes: yes, addition of fates_paramfile Test answer changes: bit for bit Test summary: all tests pass --- components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 5 ++--- components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 | 4 ++-- components/clm/src/ED/main/EDParamsMod.F90 | 8 -------- components/clm/src/ED/main/EDPftvarcon.F90 | 4 ++++ 4 files changed, 8 insertions(+), 13 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index b2e51f09bb..8e99378d0e 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -146,7 +146,6 @@ subroutine trim_canopy( currentSite ) ! ! !USES: ! - use EDParamsMod, only : ED_val_grperc use EDGrowthFunctionsMod, only : tree_lai ! ! !ARGUMENTS @@ -191,14 +190,14 @@ subroutine trim_canopy( currentSite ) currentCohort%leaf_cost = currentCohort%leaf_cost + & 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) - currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) + currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) else !evergreen costs currentCohort%leaf_cost = 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)* & EDPftvarcon_inst%leaf_long(currentCohort%pft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 currentCohort%leaf_cost = currentCohort%leaf_cost + & 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) - currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) + currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then if (currentCohort%canopy_trim > trim_limit)then diff --git a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 index c8970fdcf4..8fd3a3d8ec 100644 --- a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +++ b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 @@ -45,7 +45,6 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! READS ARE REFACTORED (RGK 10-13-2016) use EDPftvarcon , only : EDPftvarcon_inst ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) - use EDParamsMod , only : ED_val_grperc use EDParamsMod , only : ED_val_ag_biomass use EDSharedParamsMod , only : EDParamsShareInst use EDTypesMod , only : numpft_ed @@ -962,7 +961,8 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) if ( DEBUG ) write(fates_log(),*) 'EDPhoto 912 ', currentCohort%resp_tstep if ( DEBUG ) write(fates_log(),*) 'EDPhoto 913 ', currentCohort%resp_m - currentCohort%resp_g = ED_val_grperc(ft) * (max(0._r8,currentCohort%gpp_tstep - currentCohort%resp_m)) + currentCohort%resp_g = EDPftvarcon_inst%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 diff --git a/components/clm/src/ED/main/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90 index 44be691eb3..a7f132beea 100644 --- a/components/clm/src/ED/main/EDParamsMod.F90 +++ b/components/clm/src/ED/main/EDParamsMod.F90 @@ -19,7 +19,6 @@ module EDParamsMod real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort real(r8),protected :: ED_val_dispersal - real(r8),protected :: ED_val_grperc(maxPft) real(r8),protected :: ED_val_maxspread real(r8),protected :: ED_val_minspread real(r8),protected :: ED_val_init_litter @@ -32,7 +31,6 @@ module EDParamsMod character(len=param_string_length),parameter :: ED_name_comp_excln = "comp_excln" character(len=param_string_length),parameter :: ED_name_stress_mort = "stress_mort" character(len=param_string_length),parameter :: ED_name_dispersal = "dispersal" - character(len=param_string_length),parameter :: ED_name_grperc = "grperc" character(len=param_string_length),parameter :: ED_name_maxspread = "maxspread" character(len=param_string_length),parameter :: ED_name_minspread = "minspread" character(len=param_string_length),parameter :: ED_name_init_litter = "init_litter" @@ -80,7 +78,6 @@ subroutine FatesParamsInit() ED_val_comp_excln = nan ED_val_stress_mort = nan ED_val_dispersal = nan - ED_val_grperc(:) = nan ED_val_maxspread = nan ED_val_minspread = nan ED_val_init_litter = nan @@ -132,11 +129,6 @@ subroutine EDParamsReadLocal(ncid) !X! callingName=subname, & !X! retVal=ED_val_dispersal) - call readNcdio(ncid = ncid, & - varName=ED_name_grperc, & - callingName=subname, & - retVal=ED_val_grperc) - !X! call readNcdio(ncid = ncid, & !X! varName=ED_name_maxspread, & !X! callingName=subname, & diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index 1ac59074d3..7a8a032eeb 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -67,6 +67,7 @@ module EDPftvarcon real(r8) :: frootcn(0:mxpft) real(r8) :: smpso(0:mxpft) real(r8) :: smpsc(0:mxpft) + real(r8) :: grperc(0:mxpft) ! NOTE(bja, 2017-01) moved from EDParamsMod, was allocated as (maxPft=79), not (0:mxpft=78)! end type EDPftvarcon_type type(EDPftvarcon_type), public :: EDPftvarcon_inst @@ -260,6 +261,9 @@ subroutine EDpftconrd( ncid ) call ncd_io('smpsc', EDPftvarcon_inst%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('grperc', EDPftvarcon_inst%grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + ! HOLDING ON SEW ENSITIVITY-ANALYSIS PARAMETERS UNTIL MACHINE CONFIGS SET RGK/CX ! call ncd_io('dbh2h_m',EDPftvarcon_inst%dbh2h_m, 'read', ncid, readvar=readv) ! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') From 08182c344b26a4812eb7e18e196729d16203b030 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 20 Jan 2017 12:56:19 -0700 Subject: [PATCH 05/46] Start reading spit fire scalar parameters with new infrastructure. User interface changes?: no Test: ERS_D_Ld5.f10_f10.ICLM45ED.yellowstone_gnu.clm-edFire Test baseline: a651a4f Test namelist changes: fates_paramfile Test answer changes: bit for bit Test summary: pass --- components/clm/src/ED/fire/SFParamsMod.F90 | 264 +++++++++++++++------ components/clm/src/ED/main/EDParamsMod.F90 | 100 +------- components/clm/src/main/readParamsMod.F90 | 9 +- 3 files changed, 201 insertions(+), 172 deletions(-) diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 index 3caa526a01..38897382ec 100644 --- a/components/clm/src/ED/fire/SFParamsMod.F90 +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -4,6 +4,7 @@ module SFParamsMod ! use shr_kind_mod , only: r8 => shr_kind_r8 use EDtypesMod , only: NLSC,NFSC,NCWD + use FatesParametersInterface, only : param_string_length implicit none save @@ -35,31 +36,153 @@ module SFParamsMod real(r8),protected :: SF_val_mid_moisture_C(NFSC) real(r8),protected :: SF_val_mid_moisture_S(NFSC) - character(len=20),parameter :: SF_name_fdi_a = "fdi_a" - character(len=20),parameter :: SF_name_fdi_b = "fdi_b" - character(len=20),parameter :: SF_name_fdi_alpha = "fdi_alpha" - character(len=20),parameter :: SF_name_miner_total = "miner_total" - character(len=20),parameter :: SF_name_fuel_energy = "fuel_energy" - character(len=20),parameter :: SF_name_part_dens = "part_dens" - character(len=20),parameter :: SF_name_miner_damp = "miner_damp" - character(len=20),parameter :: SF_name_max_durat = "max_durat" - character(len=20),parameter :: SF_name_durat_slope = "durat_slope" - character(len=20),parameter :: SF_name_alpha_SH = "alpha_SH" - character(len=20),parameter :: SF_name_alpha_FMC = "alpha_FMC" - character(len=20),parameter :: SF_name_CWD_frac = "CWD_frac" - character(len=20),parameter :: SF_name_max_decomp = "max_decomp" - character(len=20),parameter :: SF_name_SAV = "SAV" - character(len=20),parameter :: SF_name_FBD = "FBD" - character(len=20),parameter :: SF_name_min_moisture = "min_moisture" - character(len=20),parameter :: SF_name_mid_moisture = "mid_moisture" - character(len=20),parameter :: SF_name_low_moisture_C = "low_moisture_C" - character(len=20),parameter :: SF_name_low_moisture_S = "low_moisture_S" - character(len=20),parameter :: SF_name_mid_moisture_C = "mid_moisture_C" - character(len=20),parameter :: SF_name_mid_moisture_S = "mid_moisture_S" + character(len=param_string_length),parameter :: SF_name_fdi_a = "fdi_a" + character(len=param_string_length),parameter :: SF_name_fdi_b = "fdi_b" + character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fdi_alpha" + character(len=param_string_length),parameter :: SF_name_miner_total = "miner_total" + character(len=param_string_length),parameter :: SF_name_fuel_energy = "fuel_energy" + character(len=param_string_length),parameter :: SF_name_part_dens = "part_dens" + character(len=param_string_length),parameter :: SF_name_miner_damp = "miner_damp" + character(len=param_string_length),parameter :: SF_name_max_durat = "max_durat" + character(len=param_string_length),parameter :: SF_name_durat_slope = "durat_slope" + character(len=param_string_length),parameter :: SF_name_alpha_SH = "alpha_SH" + character(len=param_string_length),parameter :: SF_name_alpha_FMC = "alpha_FMC" + character(len=param_string_length),parameter :: SF_name_CWD_frac = "CWD_frac" + character(len=param_string_length),parameter :: SF_name_max_decomp = "max_decomp" + character(len=param_string_length),parameter :: SF_name_SAV = "SAV" + character(len=param_string_length),parameter :: SF_name_FBD = "FBD" + character(len=param_string_length),parameter :: SF_name_min_moisture = "min_moisture" + character(len=param_string_length),parameter :: SF_name_mid_moisture = "mid_moisture" + character(len=param_string_length),parameter :: SF_name_low_moisture_C = "low_moisture_C" + character(len=param_string_length),parameter :: SF_name_low_moisture_S = "low_moisture_S" + character(len=param_string_length),parameter :: SF_name_mid_moisture_C = "mid_moisture_C" + character(len=param_string_length),parameter :: SF_name_mid_moisture_S = "mid_moisture_S" public :: SFParamsRead + public :: SpitFireParamsInit + public :: SpitFireRegisterParams + public :: SpitFireReceiveParams contains + !----------------------------------------------------------------------- + subroutine SpitFireParamsInit() + ! Initialize all parameters to nan to ensure that we get valid + ! values back from the host. + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + + implicit none + + SF_val_fdi_a = nan + SF_val_fdi_b = nan + SF_val_fdi_alpha = nan + SF_val_miner_total = nan + SF_val_fuel_energy = nan + SF_val_part_dens = nan + SF_val_miner_damp = nan + SF_val_max_durat = nan + SF_val_durat_slope = nan + SF_val_alpha_SH = nan + SF_val_alpha_FMC(:) = nan + SF_val_CWD_frac(:) = nan + SF_val_max_decomp(:) = nan + SF_val_SAV(:) = nan + SF_val_FBD(:) = nan + SF_val_min_moisture(:) = nan + SF_val_mid_moisture(:) = nan + SF_val_low_moisture_C(:) = nan + SF_val_low_moisture_S(:) = nan + SF_val_mid_moisture_C(:) = nan + SF_val_mid_moisture_S(:) = nan + + end subroutine SpitFireParamsInit + !----------------------------------------------------------------------- + subroutine SpitFireRegisterParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) + + !call SpitFireParamsInit() + + + call fates_params%RegisterParameter(name=SF_name_fdi_a, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_fdi_b, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_fdi_alpha, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_miner_total, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_fuel_energy, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_part_dens, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_miner_damp, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_max_durat, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_durat_slope, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_alpha_SH, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + end subroutine SpitFireRegisterParams + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + + call fates_params%RetreiveParameter(name=SF_name_fdi_a, & + data=SF_val_fdi_a) + + call fates_params%RetreiveParameter(name=SF_name_fdi_b, & + data=SF_val_fdi_b) + + call fates_params%RetreiveParameter(name=SF_name_fdi_alpha, & + data=SF_val_fdi_alpha) + + call fates_params%RetreiveParameter(name=SF_name_miner_total, & + data=SF_val_miner_total) + + call fates_params%RetreiveParameter(name=SF_name_fuel_energy, & + data=SF_val_fuel_energy) + + call fates_params%RetreiveParameter(name=SF_name_part_dens, & + data=SF_val_part_dens) + + call fates_params%RetreiveParameter(name=SF_name_miner_damp, & + data=SF_val_miner_damp) + + call fates_params%RetreiveParameter(name=SF_name_max_durat, & + data=SF_val_max_durat) + + call fates_params%RetreiveParameter(name=SF_name_durat_slope, & + data=SF_val_durat_slope) + + call fates_params%RetreiveParameter(name=SF_name_alpha_SH, & + data=SF_val_alpha_SH) + + end subroutine SpitFireReceiveParams !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- @@ -74,6 +197,7 @@ subroutine SFParamsRead(ncid) ! arguments type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + call SpitFireParamsInit() call SFParamsReadLocal(ncid) end subroutine SFParamsRead @@ -101,55 +225,55 @@ subroutine SFParamsReadLocal(ncid) ! call read function ! - call readNcdio(ncid = ncid, & - varName=SF_name_fdi_a, & - callingName=subname, & - retVal=SF_val_fdi_a) - - call readNcdio(ncid = ncid, & - varName=SF_name_fdi_b, & - callingName=subname, & - retVal=SF_val_fdi_b) - - call readNcdio(ncid = ncid, & - varName=SF_name_fdi_alpha, & - callingName=subname, & - retVal=SF_val_fdi_alpha) - - call readNcdio(ncid = ncid, & - varName=SF_name_miner_total, & - callingName=subname, & - retVal=SF_val_miner_total) - - call readNcdio(ncid = ncid, & - varName=SF_name_fuel_energy, & - callingName=subname, & - retVal=SF_val_fuel_energy) - - call readNcdio(ncid = ncid, & - varName=SF_name_part_dens, & - callingName=subname, & - retVal=SF_val_part_dens) - - call readNcdio(ncid = ncid, & - varName=SF_name_miner_damp, & - callingName=subname, & - retVal=SF_val_miner_damp) - - call readNcdio(ncid = ncid, & - varName=SF_name_max_durat, & - callingName=subname, & - retVal=SF_val_max_durat) - - call readNcdio(ncid = ncid, & - varName=SF_name_durat_slope, & - callingName=subname, & - retVal=SF_val_durat_slope) - - call readNcdio(ncid = ncid, & - varName=SF_name_alpha_SH, & - callingName=subname, & - retVal=SF_val_alpha_SH) + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_fdi_a, & + !X! callingName=subname, & + !X! retVal=SF_val_fdi_a) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_fdi_b, & + !X! callingName=subname, & + !X! retVal=SF_val_fdi_b) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_fdi_alpha, & + !X! callingName=subname, & + !X! retVal=SF_val_fdi_alpha) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_miner_total, & + !X! callingName=subname, & + !X! retVal=SF_val_miner_total) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_fuel_energy, & + !X! callingName=subname, & + !X! retVal=SF_val_fuel_energy) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_part_dens, & + !X! callingName=subname, & + !X! retVal=SF_val_part_dens) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_miner_damp, & + !X! callingName=subname, & + !X! retVal=SF_val_miner_damp) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_max_durat, & + !X! callingName=subname, & + !X! retVal=SF_val_max_durat) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_durat_slope, & + !X! callingName=subname, & + !X! retVal=SF_val_durat_slope) + !X! + !X! call readNcdio(ncid = ncid, & + !X! varName=SF_name_alpha_SH, & + !X! callingName=subname, & + !X! retVal=SF_val_alpha_SH) call readNcdio(ncid = ncid, & varName=SF_name_alpha_FMC, & diff --git a/components/clm/src/ED/main/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90 index a7f132beea..344cf91606 100644 --- a/components/clm/src/ED/main/EDParamsMod.F90 +++ b/components/clm/src/ED/main/EDParamsMod.F90 @@ -39,32 +39,12 @@ module EDParamsMod character(len=param_string_length),parameter :: ED_name_profile_tol = "profile_tol" character(len=param_string_length),parameter :: ED_name_ag_biomass= "ag_biomass" - public :: EDParamsRead public :: FatesParamsInit public :: FatesRegisterParams public :: FatesReceiveParams contains - !----------------------------------------------------------------------- - ! - !----------------------------------------------------------------------- - subroutine EDParamsRead(ncid) - ! - ! calls to initialize parameter instance and do ncdio read - ! - use ncdio_pio , only : file_desc_t - - implicit none - - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - - call FatesParamsInit() - call EDParamsReadLocal(ncid) - - end subroutine EDParamsRead - !----------------------------------------------------------------------- subroutine FatesParamsInit() ! Initialize all parameters to nan to ensure that we get valid @@ -87,84 +67,6 @@ subroutine FatesParamsInit() ED_val_ag_biomass = nan end subroutine FatesParamsInit - !----------------------------------------------------------------------- - ! - !----------------------------------------------------------------------- - subroutine EDParamsReadLocal(ncid) - ! - ! read the netcdf file and populate internalInstScalar - ! - use ncdio_pio , only : file_desc_t - use paramUtilMod , only : readNcdio - - implicit none - - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - - ! local vars - character(len=32) :: subname = 'EDParamsReadLocal::' - - ! - ! call read function - ! - - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_grass_spread, & - !X! callingName=subname, & - !X! retVal=ED_val_grass_spread) - - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_comp_excln, & - !X! callingName=subname, & - !X! retVal=ED_val_comp_excln) - - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_stress_mort, & - !X! callingName=subname, & - !X! retVal=ED_val_stress_mort) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_dispersal, & - !X! callingName=subname, & - !X! retVal=ED_val_dispersal) - - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_maxspread, & - !X! callingName=subname, & - !X! retVal=ED_val_maxspread) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_minspread, & - !X! callingName=subname, & - !X! retVal=ED_val_minspread) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_init_litter, & - !X! callingName=subname, & - !X! retVal=ED_val_init_litter) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_nfires, & - !X! callingName=subname, & - !X! retVal=ED_val_nfires) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_understorey_death, & - !X! callingName=subname, & - !X! retVal=ED_val_understorey_death) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_profile_tol, & - !X! callingName=subname, & - !X! retVal=ED_val_profile_tol) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=ED_name_ag_biomass, & - !X! callingName=subname, & - !X! retVal=ED_val_ag_biomass) - - end subroutine EDParamsReadLocal !----------------------------------------------------------------------- subroutine FatesRegisterParams(fates_params) @@ -180,6 +82,8 @@ subroutine FatesRegisterParams(fates_params) character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) + call FatesParamsInit() + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index 5ee449f694..3226156905 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -118,8 +118,8 @@ subroutine readFatesParameters() use shr_kind_mod, only: r8 => shr_kind_r8 use paramUtilMod, only : readNcdio - use EDParamsMod, only : EDParamsRead, FatesRegisterParams, FatesReceiveParams - use SFParamsMod, only : SFParamsRead + use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams + use SFParamsMod, only : SFParamsRead, SpitFireRegisterParams, SpitFireReceiveParams use FatesParametersInterface, only : fates_parameters_type use FatesParametersInterface, only : param_string_length use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d @@ -148,14 +148,14 @@ subroutine readFatesParameters() call ncd_inqdlen(ncid, dimid, npft) ! read using the old infrastrructure - call EDParamsRead(ncid) call SFParamsRead(ncid) ! read parameters with new fates parammeter infrastructure allocate(fates_params) - allocate(data(npft, npft)) ! FIXME(bja, 2017-01) correct? maxpft? + allocate(data(npft, npft)) ! FIXME(bja, 2017-01) correct? maxpft? needs to be max of all dimensions expected to receive! call fates_params%Init() call FatesRegisterParams(fates_params) + call SpitFireRegisterParams(fates_params) num_params = fates_params%num_params() do i = 1, num_params call fates_params%GetMetaData(i, name, dimension_shape) @@ -174,6 +174,7 @@ subroutine readFatesParameters() end select end do call FatesReceiveParams(fates_params) + call SpitFireReceiveParams(fates_params) deallocate(data) deallocate(fates_params) call ncd_pio_closefile(ncid) From d4c80ef55e6d53caabbbbcb1547120ae7d1843e2 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 26 Jan 2017 10:00:25 -0700 Subject: [PATCH 06/46] New infrastructure to read fates array parameters. Register and receive array parameters in fates with the host reading. Host allocates the data buffer based on the size of the largest used parameter dimension. Tested with spitfire array parameters. Some error checking of dimension sizes read from file vs memory size that fates is expecting. User interface changes?: no Test suite: ed - yellowstone gnu, intel, pgi Test baseline: a651a4f Test namelist changes: fates_paramfile Test answer changes: bit for bit Test summary: all tests pass Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass --- components/clm/src/ED/fire/SFParamsMod.F90 | 341 ++++++++++-------- .../src/ED/main/FatesParametersInterface.F90 | 162 ++++++++- components/clm/src/main/readParamsMod.F90 | 93 ++++- 3 files changed, 421 insertions(+), 175 deletions(-) diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 index 38897382ec..2f2de2eb81 100644 --- a/components/clm/src/ED/fire/SFParamsMod.F90 +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -24,9 +24,12 @@ module SFParamsMod real(r8),protected :: SF_val_max_durat real(r8),protected :: SF_val_durat_slope real(r8),protected :: SF_val_alpha_SH - real(r8),protected :: SF_val_alpha_FMC(NLSC) + real(r8),protected :: SF_val_CWD_frac(NCWD) + + real(r8),protected :: SF_val_alpha_FMC(NLSC) real(r8),protected :: SF_val_max_decomp(NLSC) + real(r8),protected :: SF_val_SAV(NFSC) real(r8),protected :: SF_val_FBD(NFSC) real(r8),protected :: SF_val_min_moisture(NFSC) @@ -58,10 +61,21 @@ module SFParamsMod character(len=param_string_length),parameter :: SF_name_mid_moisture_C = "mid_moisture_C" character(len=param_string_length),parameter :: SF_name_mid_moisture_S = "mid_moisture_S" - public :: SFParamsRead - public :: SpitFireParamsInit public :: SpitFireRegisterParams public :: SpitFireReceiveParams + + private :: SpitFireParamsInit + private :: SpitFireRegisterScalars + private :: SpitFireReceiveScalars + + private :: SpitFireRegisterNCWD + private :: SpitFireReceiveNCWD + + private :: SpitFireRegisterNLSC + private :: SpitFireReceiveNLSC + + private :: SpitFireRegisterNFSC + private :: SpitFireReceiveNFSC contains !----------------------------------------------------------------------- @@ -83,9 +97,12 @@ subroutine SpitFireParamsInit() SF_val_max_durat = nan SF_val_durat_slope = nan SF_val_alpha_SH = nan - SF_val_alpha_FMC(:) = nan + SF_val_CWD_frac(:) = nan + + SF_val_alpha_FMC(:) = nan SF_val_max_decomp(:) = nan + SF_val_SAV(:) = nan SF_val_FBD(:) = nan SF_val_min_moisture(:) = nan @@ -96,6 +113,7 @@ subroutine SpitFireParamsInit() SF_val_mid_moisture_S(:) = nan end subroutine SpitFireParamsInit + !----------------------------------------------------------------------- subroutine SpitFireRegisterParams(fates_params) @@ -105,10 +123,40 @@ subroutine SpitFireRegisterParams(fates_params) class(fates_parameters_type), intent(inout) :: fates_params - character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) + call SpitFireParamsInit() + call SpitFireRegisterScalars(fates_params) + call SpitFireRegisterNCWD(fates_params) + call SpitFireRegisterNLSC(fates_params) + call SpitFireRegisterNFSC(fates_params) - !call SpitFireParamsInit() + end subroutine SpitFireRegisterParams + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call SpitFireReceiveScalars(fates_params) + call SpitFireReceiveNCWD(fates_params) + call SpitFireReceiveNLSC(fates_params) + call SpitFireReceiveNFSC(fates_params) + end subroutine SpitFireReceiveParams + + !----------------------------------------------------------------------- + subroutine SpitFireRegisterScalars(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) call fates_params%RegisterParameter(name=SF_name_fdi_a, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -140,17 +188,16 @@ subroutine SpitFireRegisterParams(fates_params) call fates_params%RegisterParameter(name=SF_name_alpha_SH, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - end subroutine SpitFireRegisterParams + end subroutine SpitFireRegisterScalars !----------------------------------------------------------------------- - subroutine SpitFireReceiveParams(fates_params) + subroutine SpitFireReceiveScalars(fates_params) use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar implicit none class(fates_parameters_type), intent(inout) :: fates_params - call fates_params%RetreiveParameter(name=SF_name_fdi_a, & data=SF_val_fdi_a) @@ -182,155 +229,147 @@ subroutine SpitFireReceiveParams(fates_params) call fates_params%RetreiveParameter(name=SF_name_alpha_SH, & data=SF_val_alpha_SH) - end subroutine SpitFireReceiveParams - !----------------------------------------------------------------------- - ! + end subroutine SpitFireReceiveScalars + !----------------------------------------------------------------------- - subroutine SFParamsRead(ncid) - ! - ! calls to initialize parameter instance and do ncdio read - ! - use ncdio_pio , only : file_desc_t - - implicit none + subroutine SpitFireRegisterNCWD(fates_params) - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + use FatesParametersInterface, only : fates_parameters_type, dimension_name_cwd, dimension_shape_1d - call SpitFireParamsInit() - call SFParamsReadLocal(ncid) + implicit none - end subroutine SFParamsRead - !----------------------------------------------------------------------- + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names_cwd(1) = (/dimension_name_cwd/) + + call fates_params%RegisterParameter(name=SF_name_CWD_frac, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_cwd) + + end subroutine SpitFireRegisterNCWD + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveNCWD(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call fates_params%RetreiveParameter(name=SF_name_CWD_frac, & + data=SF_val_CWD_frac) + + end subroutine SpitFireReceiveNCWD !----------------------------------------------------------------------- - ! + subroutine SpitFireRegisterNLSC(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_lsc, dimension_shape_1d + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_lsc/) + + call fates_params%RegisterParameter(name=SF_name_alpha_FMC, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_max_decomp, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + end subroutine SpitFireRegisterNLSC + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveNLSC(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call fates_params%RetreiveParameter(name=SF_name_alpha_FMC, & + data=SF_val_alpha_FMC) + + call fates_params%RetreiveParameter(name=SF_name_max_decomp, & + data=SF_val_max_decomp) + + end subroutine SpitFireReceiveNLSC + !----------------------------------------------------------------------- - subroutine SFParamsReadLocal(ncid) - ! - ! read the netcdf file and populate internalInstScalar - ! - use ncdio_pio , only : file_desc_t - use paramUtilMod , only : readNcdio - - implicit none - - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - - ! local vars - character(len=32) :: subname = 'SFParamsReadLocal::' - - ! - ! call read function - ! - - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_fdi_a, & - !X! callingName=subname, & - !X! retVal=SF_val_fdi_a) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_fdi_b, & - !X! callingName=subname, & - !X! retVal=SF_val_fdi_b) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_fdi_alpha, & - !X! callingName=subname, & - !X! retVal=SF_val_fdi_alpha) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_miner_total, & - !X! callingName=subname, & - !X! retVal=SF_val_miner_total) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_fuel_energy, & - !X! callingName=subname, & - !X! retVal=SF_val_fuel_energy) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_part_dens, & - !X! callingName=subname, & - !X! retVal=SF_val_part_dens) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_miner_damp, & - !X! callingName=subname, & - !X! retVal=SF_val_miner_damp) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_max_durat, & - !X! callingName=subname, & - !X! retVal=SF_val_max_durat) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_durat_slope, & - !X! callingName=subname, & - !X! retVal=SF_val_durat_slope) - !X! - !X! call readNcdio(ncid = ncid, & - !X! varName=SF_name_alpha_SH, & - !X! callingName=subname, & - !X! retVal=SF_val_alpha_SH) - - call readNcdio(ncid = ncid, & - varName=SF_name_alpha_FMC, & - callingName=subname, & - retVal=SF_val_alpha_FMC) - - call readNcdio(ncid = ncid, & - varName=SF_name_CWD_frac, & - callingName=subname, & - retVal=SF_val_CWD_frac) - - call readNcdio(ncid = ncid, & - varName=SF_name_max_decomp, & - callingName=subname, & - retVal=SF_val_max_decomp) - - call readNcdio(ncid = ncid, & - varName=SF_name_SAV, & - callingName=subname, & - retVal=SF_val_SAV) - - call readNcdio(ncid = ncid, & - varName=SF_name_FBD, & - callingName=subname, & - retVal=SF_val_FBD) - - call readNcdio(ncid = ncid, & - varName=SF_name_min_moisture, & - callingName=subname, & - retVal=SF_val_min_moisture) - - call readNcdio(ncid = ncid, & - varName=SF_name_mid_moisture, & - callingName=subname, & - retVal=SF_val_mid_moisture) - - call readNcdio(ncid = ncid, & - varName=SF_name_low_moisture_C, & - callingName=subname, & - retVal=SF_val_low_moisture_C) - - call readNcdio(ncid = ncid, & - varName=SF_name_low_moisture_S, & - callingName=subname, & - retVal=SF_val_low_moisture_S) - - call readNcdio(ncid = ncid, & - varName=SF_name_mid_moisture_C, & - callingName=subname, & - retVal=SF_val_mid_moisture_C) - - call readNcdio(ncid = ncid, & - varName=SF_name_mid_moisture_S, & - callingName=subname, & - retVal=SF_val_mid_moisture_S) - - end subroutine SFParamsReadLocal + subroutine SpitFireRegisterNFSC(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_fsc, dimension_shape_1d + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_fsc/) + + call fates_params%RegisterParameter(name=SF_name_SAV, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_FBD, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_min_moisture, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_mid_moisture, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_low_moisture_C, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_low_moisture_S, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_mid_moisture_C, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_mid_moisture_S, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + end subroutine SpitFireRegisterNFSC + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveNFSC(fates_params) + + use FatesParametersInterface, only : fates_parameters_type + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + + call fates_params%RetreiveParameter(name=SF_name_SAV, & + data=SF_val_SAV) + + call fates_params%RetreiveParameter(name=SF_name_FBD, & + data=SF_val_FBD) + + call fates_params%RetreiveParameter(name=SF_name_min_moisture, & + data=SF_val_min_moisture) + + call fates_params%RetreiveParameter(name=SF_name_mid_moisture, & + data=SF_val_mid_moisture) + + call fates_params%RetreiveParameter(name=SF_name_low_moisture_C, & + data=SF_val_low_moisture_C) + + call fates_params%RetreiveParameter(name=SF_name_low_moisture_S, & + data=SF_val_low_moisture_S) + + call fates_params%RetreiveParameter(name=SF_name_mid_moisture_C, & + data=SF_val_mid_moisture_C) + + call fates_params%RetreiveParameter(name=SF_name_mid_moisture_S, & + data=SF_val_mid_moisture_S) + + end subroutine SpitFireReceiveNFSC !----------------------------------------------------------------------- + end module SFParamsMod diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 index 1e21e64b24..cb034cdfa7 100644 --- a/components/clm/src/ED/main/FatesParametersInterface.F90 +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -4,11 +4,13 @@ module FatesParametersInterface ! depend on any host modules. use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_log implicit none integer, parameter, public :: max_params = 250 integer, parameter, public :: max_dimensions = 2 + integer, parameter, public :: max_used_dimensions = 25 integer, parameter, public :: param_string_length = 40 integer, parameter, public :: dimension_shape_scalar = 0 integer, parameter, public :: dimension_shape_1d = 1 @@ -19,14 +21,19 @@ module FatesParametersInterface ! wants to write a single netcdf file containing host and fates ! parameters. Can't be done easily until this framework is being ! used to read variables. - character(len=*), parameter, public :: dimension_name_scalar = 'scalar' + ! FIXME(bja, 2017-01) change 'param' to 'scalar'! + character(len=*), parameter, public :: dimension_name_scalar = 'param' character(len=*), parameter, public :: dimension_name_pft = 'pft' character(len=*), parameter, public :: dimension_name_segment = 'segment' + character(len=*), parameter, public :: dimension_name_cwd = 'NCWD' + character(len=*), parameter, public :: dimension_name_lsc = 'litterclass' + character(len=*), parameter, public :: dimension_name_fsc = 'litterclass' type, private :: parameter_type character(len=param_string_length) :: name logical :: host_parameter integer :: dimension_shape + integer :: dimension_sizes(max_dimensions) character(len=param_string_length) :: dimension_names(max_dimensions) real(r8), allocatable :: data(:, :) end type parameter_type @@ -37,11 +44,16 @@ module FatesParametersInterface contains procedure, public :: Init + procedure, public :: Destroy procedure, public :: RegisterParameter generic, public :: RetreiveParameter => RetreiveParameterScalar, RetreiveParameter1D, RetreiveParameter2D generic, public :: SetData => SetDataScalar, SetData1D, SetData2D + procedure, public :: GetUsedDimensions + procedure, public :: SetDimensionSizes + procedure, public :: GetMaxDimensionSize procedure, public :: GetMetaData procedure, public :: num_params + procedure, private :: RetreiveParameterScalar procedure, private :: RetreiveParameter1D procedure, private :: RetreiveParameter2D @@ -65,6 +77,20 @@ subroutine Init(this) end subroutine Init + !----------------------------------------------------------------------- + subroutine Destroy(this) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + + integer :: n + do n = 1, this%num_parameters + deallocate(this%parameters(n)%data) + end do + + end subroutine Destroy + !----------------------------------------------------------------------- subroutine RegisterParameter(this, name, dimension_shape, dimension_names, host_parameter) @@ -83,8 +109,10 @@ subroutine RegisterParameter(this, name, dimension_shape, dimension_names, host_ ! FIXME(bja, 2017-01) assert(i <= max_params) this%parameters(i)%name = name this%parameters(i)%dimension_shape = dimension_shape + this%parameters(i)%dimension_sizes(:) = 0 ! FIXME(bja, 2017-01) assert(size(dimension_names, 1) <= max_dimensions) num_names = min(max_dimensions, size(dimension_names, 1)) + this%parameters(i)%dimension_names(:) = '' do n = 1, num_names this%parameters(i)%dimension_names(n) = dimension_names(n) end do @@ -115,16 +143,28 @@ end subroutine RetreiveParameterScalar !----------------------------------------------------------------------- subroutine RetreiveParameter1D(this, name, data) + use abortutils, only : endrun + implicit none class(fates_parameters_type), intent(inout) :: this character(len=param_string_length), intent(in) :: name real(r8), intent(out) :: data(:) - integer :: i + integer :: i, d, size_dim_1 i = this%FindIndex(name) - ! assert(size(data) == size(this%parameters(i)%data)) + if (size(data) /= size(this%parameters(i)%data(:, 1))) then + write(fates_log(), *) 'ERROR : retreiveparameter1d : ', name, ' size inconsistent.' + write(fates_log(), *) 'ERROR : size expected size = ', size(data) + write(fates_log(), *) 'ERROR : data size received from file = ', size(this%parameters(i)%data(:, 1)) + write(fates_log(), *) 'ERROR : dimesions received from file' + write(fates_log(), *) 'ERROR : names size' + do d = 1, max_dimensions + write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d) + end do + call endrun(msg='size error retreiving 1d parameter.') + end if data = this%parameters(i)%data(:, 1) end subroutine RetreiveParameter1D @@ -179,7 +219,78 @@ integer function num_params(this) end function num_params !----------------------------------------------------------------------- - subroutine GetMetaData(this, index, name, dimension_shape) + subroutine GetUsedDimensions(this, num_used_dimensions, used_dimensions) + ! Construct a list of the unique dimension names used by the + ! parameters. + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(out) :: num_used_dimensions + character(len=param_string_length), intent(out) :: used_dimensions(max_used_dimensions) + + integer :: p, d, i + character(len=param_string_length) :: dim_name + + num_used_dimensions = 0 + do p = 1, this%num_parameters + do d = 1, max_dimensions + dim_name = this%parameters(p)%dimension_names(d) + if (len_trim(dim_name) /= 0) then + ! non-empty dimension name, check if it needs to be added to the list. + do i = 1, num_used_dimensions + if (used_dimensions(i) == dim_name) then + ! dimension is already in list. can stop searching + exit + end if + end do + + if (i > num_used_dimensions) then + ! dimension name was not in the list, add it. + num_used_dimensions = num_used_dimensions + 1 + used_dimensions(num_used_dimensions) = dim_name + end if + end if + end do + end do + + end subroutine GetUsedDimensions + + !----------------------------------------------------------------------- + subroutine SetDimensionSizes(this, num_used_dimensions, dimension_names, dimension_sizes) + ! Construct a list of the unique dimension names used by the + ! parameters. + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(in) :: num_used_dimensions + character(len=param_string_length), intent(in) :: dimension_names(max_used_dimensions) + integer, intent(in) :: dimension_sizes(max_used_dimensions) + + integer :: p, d, i + character(len=param_string_length) :: dim_name + + do p = 1, this%num_parameters + do d = 1, max_dimensions + dim_name = this%parameters(p)%dimension_names(d) + if (len_trim(dim_name) /= 0) then + ! non-empty dimension name, set the size + do i = 1, num_used_dimensions + if (trim(dimension_names(i)) == trim(dim_name)) then + !write(*, *) '--> ', trim(this%parameters(p)%name), ' setting ', trim(dim_name), ' d = ', d, 'size = ', dimension_sizes(i) + this%parameters(p)%dimension_sizes(d) = dimension_sizes(i) + exit + end if + end do + end if + end do + end do + + end subroutine SetDimensionSizes + + !----------------------------------------------------------------------- + subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes) implicit none @@ -187,12 +298,33 @@ subroutine GetMetaData(this, index, name, dimension_shape) integer, intent(in) :: index character(len=param_string_length), intent(out) :: name integer, intent(out) :: dimension_shape + integer, intent(out) :: dimension_sizes(max_dimensions) name = this%parameters(index)%name dimension_shape = this%parameters(index)%dimension_shape + dimension_sizes = this%parameters(index)%dimension_sizes end subroutine GetMetaData + !----------------------------------------------------------------------- + function GetMaxDimensionSize(this) result(max_dim_size) + + implicit none + + class(fates_parameters_type), intent(in) :: this + + integer :: p, d, max_dim_size + + max_dim_size = 0 + + do p = 1, this%num_params() + do d = 1, max_dimensions + max_dim_size = max(max_dim_size, this%parameters(p)%dimension_sizes(d)) + end do + end do + + end function GetMaxDimensionSize + !----------------------------------------------------------------------- subroutine SetDataScalar(this, index, data) @@ -209,16 +341,32 @@ end subroutine SetDataScalar !----------------------------------------------------------------------- subroutine SetData1D(this, index, data) - ! FIXME(bja, 2017-01) this is broken, needs data dimensions to work correctly! + use abortutils, only : endrun + implicit none class(fates_parameters_type), intent(inout) :: this integer, intent(in) :: index real(r8), intent(in) :: data(:) - allocate(this%parameters(index)%data(size(data), 1)) - this%parameters(index)%data(:, 1) = data + integer :: size_dim_1, d + + size_dim_1 = this%parameters(index)%dimension_sizes(1) + if (size(data) /= size_dim_1) then + write(fates_log(), *) 'ERROR : setdata1d : ', this%parameters(index)%name, ' size inconsistent.' + write(fates_log(), *) 'ERROR : expected size = ', size(data) + write(fates_log(), *) 'ERROR : data size received from file = ', size_dim_1 + write(fates_log(), *) 'ERROR : dimesions received from file' + write(fates_log(), *) 'ERROR : names size' + do d = 1, max_dimensions + write(fates_log(), *) this%parameters(index)%dimension_names(d), ', ', this%parameters(index)%dimension_sizes(d) + end do + call endrun(msg='size error setting 1d parameter.') + end if + + allocate(this%parameters(index)%data(size_dim_1, 1)) + this%parameters(index)%data(:, 1) = data(:) end subroutine SetData1D diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index 3226156905..5b2ee3af89 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -117,11 +117,13 @@ subroutine readFatesParameters() use clm_varctl, only : fates_paramfile use shr_kind_mod, only: r8 => shr_kind_r8 use paramUtilMod, only : readNcdio + use abortutils, only : endrun use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams - use SFParamsMod, only : SFParamsRead, SpitFireRegisterParams, SpitFireReceiveParams + use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams + use FatesParametersInterface, only : fates_parameters_type - use FatesParametersInterface, only : param_string_length + use FatesParametersInterface, only : param_string_length, max_dimensions, max_used_dimensions use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d use FatesParametersInterface, only : dimension_name_pft @@ -130,12 +132,14 @@ subroutine readFatesParameters() character(len=256) :: locfn ! local file name type(file_desc_t) :: ncid ! pio netCDF file id integer :: dimid ! netCDF dimension id - integer :: npft ! number of pfts on pft-physiology file character(len=32) :: subname = 'readFatesParameters' class(fates_parameters_type), allocatable :: fates_params integer :: i, num_params, dimension_shape + integer :: max_dim_size real(r8), allocatable :: data(:, :) character(len=param_string_length) :: name + integer :: dimension_sizes(max_dimensions) + integer :: size_dim_1, size_dim_2 if (use_ed) then if (masterproc) then @@ -144,42 +148,97 @@ subroutine readFatesParameters() call getfil (fates_paramfile, locfn, 0) call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_inqdid(ncid, dimension_name_pft, dimid) - call ncd_inqdlen(ncid, dimid, npft) - - ! read using the old infrastrructure - call SFParamsRead(ncid) ! read parameters with new fates parammeter infrastructure allocate(fates_params) - allocate(data(npft, npft)) ! FIXME(bja, 2017-01) correct? maxpft? needs to be max of all dimensions expected to receive! call fates_params%Init() call FatesRegisterParams(fates_params) call SpitFireRegisterParams(fates_params) + + call set_parameter_dimensions(ncid, fates_params) + max_dim_size = fates_params%GetMaxDimensionSize() + allocate(data(max_dim_size, max_dim_size)) + num_params = fates_params%num_params() do i = 1, num_params - call fates_params%GetMetaData(i, name, dimension_shape) + call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes) select case(dimension_shape) case(dimension_shape_scalar) - call readNcdio(ncid, name, subname, data(1, 1)) - call fates_params%SetData(i, data(1, 1)) + size_dim_1 = 1 + size_dim_2 = 1 case(dimension_shape_1d) - call readNcdio(ncid, name, subname, data(:, 1)) - call fates_params%SetData(i, data(:, 1)) + size_dim_1 = dimension_sizes(1) + size_dim_2 = 1 case(dimension_shape_2d) - call readNcdio(ncid, name, subname, data(:, :)) - call fates_params%SetData(i, data(:, :)) + size_dim_1 = dimension_sizes(1) + size_dim_2 = dimension_sizes(2) case default - ! error, unsupported number of dimensions + call endrun(msg='unsupported number of dimensions reading parameters.') end select + call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) + call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) end do call FatesReceiveParams(fates_params) call SpitFireReceiveParams(fates_params) deallocate(data) + + call fates_params%Destroy() deallocate(fates_params) call ncd_pio_closefile(ncid) end if end subroutine readFatesParameters + !----------------------------------------------------------------------- + subroutine set_parameter_dimensions(ncid, fates_params) + ! Get the list of dimensions used by the fates parameters, + ! retreive them from the parameter file, then give the information + ! back to fates. + use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions + + implicit none + + type(file_desc_t), intent(inout) :: ncid + class(fates_parameters_type), intent(inout) :: fates_params + + integer :: num_used_dimensions + character(len=param_string_length) :: used_dimension_names(max_used_dimensions) + integer :: used_dimension_sizes(max_used_dimensions) + + call fates_params%GetUsedDimensions(num_used_dimensions, used_dimension_names) + + call get_used_dimension_sizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes) + + call fates_params%SetDimensionSizes(num_used_dimensions, used_dimension_names, used_dimension_sizes) + + end subroutine set_parameter_dimensions + + !----------------------------------------------------------------------- + subroutine get_used_dimension_sizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) + + use FatesParametersInterface, only : param_string_length + + implicit none + + type(file_desc_t), intent(inout) :: ncid + integer, intent(in) :: num_used_dimensions + character(len=param_string_length), intent(in) :: dimension_names(:) + integer, intent(out) :: dimension_sizes(:) + + integer :: d, max_dim_size, num_dims + integer :: dim_len, dim_id + + + dimension_sizes(:) = 0 + max_dim_size = 0 + + do d = 1, num_used_dimensions + call ncd_inqdid(ncid, dimension_names(d), dim_id) + call ncd_inqdlen(ncid, dim_id, dim_len) + dimension_sizes(d) = dim_len + write(*, *) '--> ', trim(dimension_names(d)), ' setting size ', dimension_sizes(d) + end do + + end subroutine get_used_dimension_sizes + end module readParamsMod From 73df6dc64798687919149242fe670860dd96f6bc Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 27 Jan 2017 13:58:14 -0700 Subject: [PATCH 07/46] Move fates parameters read into clmfates_interface infrastructure. Move control logic for read of fates parameters out of readParamsMod into clm_fates_interfacemod so that it can be reused for pft reads. User interface changes?: no Test: SMS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: a651a4f Test namelist changes: addition of fates_paramfile Test answer changes: bit for bit Test summary: pass --- components/clm/src/main/readParamsMod.F90 | 136 +------------ .../clm/src/utils/clmfates_interfaceMod.F90 | 185 ++++++++++++++++++ 2 files changed, 189 insertions(+), 132 deletions(-) diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index 5b2ee3af89..d7abf38ac9 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -17,7 +17,7 @@ module readParamsMod private ! public :: readParameters - private :: readFatesParameters + !----------------------------------------------------------------------- contains @@ -43,6 +43,8 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type + + use CLMFatesInterfaceMod , only : FatesReadParameters use EDSharedParamsMod , only : EDParamsReadShared ! ! !ARGUMENTS: @@ -107,138 +109,8 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) ! call ncd_pio_closefile(ncid) - call readFatesParameters() + call FatesReadParameters() end subroutine readParameters - !----------------------------------------------------------------------- - subroutine readFatesParameters() - - use clm_varctl, only : fates_paramfile - use shr_kind_mod, only: r8 => shr_kind_r8 - use paramUtilMod, only : readNcdio - use abortutils, only : endrun - - use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams - use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams - - use FatesParametersInterface, only : fates_parameters_type - use FatesParametersInterface, only : param_string_length, max_dimensions, max_used_dimensions - use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d - use FatesParametersInterface, only : dimension_name_pft - - implicit none - - character(len=256) :: locfn ! local file name - type(file_desc_t) :: ncid ! pio netCDF file id - integer :: dimid ! netCDF dimension id - character(len=32) :: subname = 'readFatesParameters' - class(fates_parameters_type), allocatable :: fates_params - integer :: i, num_params, dimension_shape - integer :: max_dim_size - real(r8), allocatable :: data(:, :) - character(len=param_string_length) :: name - integer :: dimension_sizes(max_dimensions) - integer :: size_dim_1, size_dim_2 - - if (use_ed) then - if (masterproc) then - write(iulog,*) 'paramMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' parameters ' - end if - - call getfil (fates_paramfile, locfn, 0) - call ncd_pio_openfile (ncid, trim(locfn), 0) - - ! read parameters with new fates parammeter infrastructure - allocate(fates_params) - call fates_params%Init() - call FatesRegisterParams(fates_params) - call SpitFireRegisterParams(fates_params) - - call set_parameter_dimensions(ncid, fates_params) - max_dim_size = fates_params%GetMaxDimensionSize() - allocate(data(max_dim_size, max_dim_size)) - - num_params = fates_params%num_params() - do i = 1, num_params - call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes) - select case(dimension_shape) - case(dimension_shape_scalar) - size_dim_1 = 1 - size_dim_2 = 1 - case(dimension_shape_1d) - size_dim_1 = dimension_sizes(1) - size_dim_2 = 1 - case(dimension_shape_2d) - size_dim_1 = dimension_sizes(1) - size_dim_2 = dimension_sizes(2) - case default - call endrun(msg='unsupported number of dimensions reading parameters.') - end select - call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) - call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) - end do - call FatesReceiveParams(fates_params) - call SpitFireReceiveParams(fates_params) - deallocate(data) - - call fates_params%Destroy() - deallocate(fates_params) - call ncd_pio_closefile(ncid) - end if - - end subroutine readFatesParameters - - !----------------------------------------------------------------------- - subroutine set_parameter_dimensions(ncid, fates_params) - ! Get the list of dimensions used by the fates parameters, - ! retreive them from the parameter file, then give the information - ! back to fates. - use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions - - implicit none - - type(file_desc_t), intent(inout) :: ncid - class(fates_parameters_type), intent(inout) :: fates_params - - integer :: num_used_dimensions - character(len=param_string_length) :: used_dimension_names(max_used_dimensions) - integer :: used_dimension_sizes(max_used_dimensions) - - call fates_params%GetUsedDimensions(num_used_dimensions, used_dimension_names) - - call get_used_dimension_sizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes) - - call fates_params%SetDimensionSizes(num_used_dimensions, used_dimension_names, used_dimension_sizes) - - end subroutine set_parameter_dimensions - - !----------------------------------------------------------------------- - subroutine get_used_dimension_sizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) - - use FatesParametersInterface, only : param_string_length - - implicit none - - type(file_desc_t), intent(inout) :: ncid - integer, intent(in) :: num_used_dimensions - character(len=param_string_length), intent(in) :: dimension_names(:) - integer, intent(out) :: dimension_sizes(:) - - integer :: d, max_dim_size, num_dims - integer :: dim_len, dim_id - - - dimension_sizes(:) = 0 - max_dim_size = 0 - - do d = 1, num_used_dimensions - call ncd_inqdid(ncid, dimension_names(d), dim_id) - call ncd_inqdlen(ncid, dim_id, dim_len) - dimension_sizes(d) = dim_len - write(*, *) '--> ', trim(dimension_names(d)), ' setting size ', dimension_sizes(d) - end do - - end subroutine get_used_dimension_sizes - end module readParamsMod diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 2f1b9797ff..449be5c05f 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -165,6 +165,14 @@ module CLMFatesInterfaceMod end type hlm_fates_interface_type + ! NOTE(bja, 2017-01) these methods can NOT be part of the interface + ! type because they are called before the instance is initialized. + public :: FatesReadParameters + public :: FatesReadPFTs + private :: ParametersFromNetCDF + private :: SetParameterDimensions + private :: GetUsedDimensionSizes + logical :: DEBUG = .false. character(len=*), parameter, private :: sourcefile = & @@ -1809,4 +1817,181 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) end subroutine hlm_bounds_to_fates_bounds + !----------------------------------------------------------------------- + subroutine FatesReadParameters() + + use clm_varctl, only : fates_paramfile + + use FatesParametersInterface, only : fates_parameters_type + + use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams + use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams + + implicit none + + character(len=32) :: subname = 'FatesReadParameters' + class(fates_parameters_type), allocatable :: fates_params + + if (use_ed) then + if (masterproc) then + write(iulog,*) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' parameters ' + end if + + allocate(fates_params) + call fates_params%Init() + call FatesRegisterParams(fates_params) + call SpitFireRegisterParams(fates_params) + + call ParametersFromNetCDF(fates_params) + + call FatesReceiveParams(fates_params) + call SpitFireReceiveParams(fates_params) + + call fates_params%Destroy() + deallocate(fates_params) + end if + + end subroutine FatesReadParameters + + !----------------------------------------------------------------------- + subroutine FatesReadPFTs() + + use clm_varctl, only : fates_paramfile + + use FatesParametersInterface, only : fates_parameters_type + + implicit none + + character(len=32) :: subname = 'FatesReadPFTs' + class(fates_parameters_type), allocatable :: fates_params + + if (use_ed) then + if (masterproc) then + write(iulog,*) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' PFTs ' + end if + + allocate(fates_params) + call fates_params%Init() + + call ParametersFromNetCDF(fates_params) + + call fates_params%Destroy() + deallocate(fates_params) + end if + + end subroutine FatesReadPFTs + + !----------------------------------------------------------------------- + subroutine SetParameterDimensions(ncid, fates_params) + ! Get the list of dimensions used by the fates parameters, + ! retreive them from the parameter file, then give the information + ! back to fates. + use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions + + implicit none + + type(file_desc_t), intent(inout) :: ncid + class(fates_parameters_type), intent(inout) :: fates_params + + integer :: num_used_dimensions + character(len=param_string_length) :: used_dimension_names(max_used_dimensions) + integer :: used_dimension_sizes(max_used_dimensions) + + call fates_params%GetUsedDimensions(num_used_dimensions, used_dimension_names) + + call GetUsedDimensionSizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes) + + call fates_params%SetDimensionSizes(num_used_dimensions, used_dimension_names, used_dimension_sizes) + + end subroutine SetParameterDimensions + + !----------------------------------------------------------------------- + subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) + + use ncdio_pio , only : ncd_inqdid, ncd_inqdlen + use FatesParametersInterface, only : param_string_length + + implicit none + + type(file_desc_t), intent(inout) :: ncid + integer, intent(in) :: num_used_dimensions + character(len=param_string_length), intent(in) :: dimension_names(:) + integer, intent(out) :: dimension_sizes(:) + + integer :: d, max_dim_size, num_dims + integer :: dim_len, dim_id + + + dimension_sizes(:) = 0 + max_dim_size = 0 + + do d = 1, num_used_dimensions + call ncd_inqdid(ncid, dimension_names(d), dim_id) + call ncd_inqdlen(ncid, dim_id, dim_len) + dimension_sizes(d) = dim_len + !write(*, *) '--> ', trim(dimension_names(d)), ' setting size ', dimension_sizes(d) + end do + + end subroutine GetUsedDimensionSizes + + !----------------------------------------------------------------------- + subroutine ParametersFromNetCDF(fates_params) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils, only : endrun + use clm_varctl, only : fates_paramfile + use fileutils , only : getfil + use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile + use paramUtilMod, only : readNcdio + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length, max_dimensions, max_used_dimensions + use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=32) :: subname = 'clmfates_interface::ReadParameters' + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: i, num_params, dimension_shape + integer :: max_dim_size + real(r8), allocatable :: data(:, :) + character(len=param_string_length) :: name + integer :: dimension_sizes(max_dimensions) + integer :: size_dim_1, size_dim_2 + + call getfil (fates_paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + call SetParameterDimensions(ncid, fates_params) + max_dim_size = fates_params%GetMaxDimensionSize() + allocate(data(max_dim_size, max_dim_size)) + + num_params = fates_params%num_params() + do i = 1, num_params + call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes) + select case(dimension_shape) + case(dimension_shape_scalar) + size_dim_1 = 1 + size_dim_2 = 1 + case(dimension_shape_1d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = 1 + case(dimension_shape_2d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = dimension_sizes(2) + case default + call endrun(msg='unsupported number of dimensions reading parameters.') + end select + call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) + call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) + end do + deallocate(data) + call ncd_pio_closefile(ncid) + end subroutine ParametersFromNetCDF + !----------------------------------------------------------------------- + end module CLMFatesInterfaceMod From d8ddde42af2c7c4d45c68b35b33a58fa5297ac0b Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 27 Jan 2017 14:46:22 -0700 Subject: [PATCH 08/46] Add hooks to read host parameters used by fates from the host file. Add logical flags to read infrastructure to distinguish between host files and fates files. Host and fates parameters are read from the correct file to avoid read errors with invalid dimension ids. Read EDSharedParams with new infrastructure. User interface changes?: no Test: SMS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: a651a4f Test namelist changes: addition of fates_paramfile Test answer changes: bit for bit Test summary: pass --- .../src/ED/biogeochem/EDSharedParamsMod.F90 | 137 ++++++++++++++---- .../src/ED/main/FatesParametersInterface.F90 | 91 ++++++------ components/clm/src/main/readParamsMod.F90 | 5 - .../clm/src/utils/clmfates_interfaceMod.F90 | 72 +++++---- 4 files changed, 201 insertions(+), 104 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 index c4111c124f..a6aaa26d9b 100644 --- a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 @@ -13,10 +13,16 @@ module EDSharedParamsMod type, public :: EDParamsShareType real(r8) :: Q10 ! temperature dependence real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates + contains + procedure, public :: RegisterParams + procedure, public :: ReceiveParams + procedure, private :: Init + procedure, private :: RegisterParamsScalar + procedure, private :: ReceiveParamsScalar end type EDParamsShareType - type(EDParamsShareType), protected :: EDParamsShareInst - + type(EDParamsShareType), public :: EDParamsShareInst + character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -24,34 +30,103 @@ module EDSharedParamsMod contains + subroutine Init(this) + ! Initialize all parameters to nan to ensure that we get valid + ! values back from the host. + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + + implicit none + + class(EDParamsShareType), intent(inout) :: this + + this%Q10 = nan + this%froz_q10 = nan + + end subroutine Init + !----------------------------------------------------------------------- - subroutine EDParamsReadShared(ncid) - ! - use ncdio_pio , only : file_desc_t,ncd_io - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - ! - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - character(len=32) :: subname = 'EDParamsReadShared' - character(len=100) :: errCode = '-Error reading in ED shared params file. Var:' - logical :: readv ! has variable been read in or not - real(r8) :: tempr ! temporary to read in parameter - character(len=100) :: tString ! temp. var for reading - !----------------------------------------------------------------------- - ! - ! netcdf read here - ! - tString='q10_mr' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - EDParamsShareInst%Q10=tempr - - tString='froz_q10' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - EDParamsShareInst%froz_q10=tempr - - end subroutine EDParamsReadShared - + subroutine RegisterParams(this, fates_params) + ! Register the parameters we want the host to provide, and + ! indicate whether they are fates parameters or host parameters + ! that need to be synced with host values. + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_scalar, dimension_shape_scalar + + implicit none + + class(EDParamsShareType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%Init() + call this%RegisterParamsScalar(fates_params) + + end subroutine RegisterParams + + !----------------------------------------------------------------------- + subroutine ReceiveParams(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none + + class(EDParamsShareType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%ReceiveParamsScalar(fates_params) + + end subroutine ReceiveParams + + !----------------------------------------------------------------------- + subroutine RegisterParamsScalar(this, fates_params) + ! Register the parameters we want the host to provide, and + ! indicate whether they are fates parameters or host parameters + ! that need to be synced with host values. + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_allpfts, dimension_shape_scalar + + implicit none + + class(EDParamsShareType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_allpfts/) + character(len=param_string_length) :: name + + call this%Init() + + name = 'q10_mr' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names, sync_with_host=.true.) + + name = 'froz_q10' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names, sync_with_host=.true.) + + end subroutine RegisterParamsScalar + + !----------------------------------------------------------------------- + subroutine ReceiveParamsScalar(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none + + class(EDParamsShareType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + name = 'q10_mr' + call fates_params%RetreiveParameter(name=name, & + data=this%Q10) + + name = 'froz_q10' + call fates_params%RetreiveParameter(name=name, & + data=this%froz_q10) + + end subroutine ReceiveParamsScalar + end module EDSharedParamsMod diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 index cb034cdfa7..6ebadce23a 100644 --- a/components/clm/src/ED/main/FatesParametersInterface.F90 +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -28,10 +28,11 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_cwd = 'NCWD' character(len=*), parameter, public :: dimension_name_lsc = 'litterclass' character(len=*), parameter, public :: dimension_name_fsc = 'litterclass' + character(len=*), parameter, public :: dimension_name_allpfts = 'allpfts' type, private :: parameter_type character(len=param_string_length) :: name - logical :: host_parameter + logical :: sync_with_host integer :: dimension_shape integer :: dimension_sizes(max_dimensions) character(len=param_string_length) :: dimension_names(max_dimensions) @@ -92,7 +93,7 @@ subroutine Destroy(this) end subroutine Destroy !----------------------------------------------------------------------- - subroutine RegisterParameter(this, name, dimension_shape, dimension_names, host_parameter) + subroutine RegisterParameter(this, name, dimension_shape, dimension_names, sync_with_host) implicit none @@ -100,7 +101,7 @@ subroutine RegisterParameter(this, name, dimension_shape, dimension_names, host_ character(len=param_string_length), intent(in) :: name integer, intent(in) :: dimension_shape character(len=param_string_length) :: dimension_names(1:) - logical, intent(in), optional :: host_parameter + logical, intent(in), optional :: sync_with_host integer :: i, n, num_names @@ -116,9 +117,9 @@ subroutine RegisterParameter(this, name, dimension_shape, dimension_names, host_ do n = 1, num_names this%parameters(i)%dimension_names(n) = dimension_names(n) end do - this%parameters(i)%host_parameter = .false. - if (present(host_parameter)) then - this%parameters(i)%host_parameter = .true. + this%parameters(i)%sync_with_host = .false. + if (present(sync_with_host)) then + this%parameters(i)%sync_with_host = sync_with_host end if end subroutine RegisterParameter @@ -219,13 +220,14 @@ integer function num_params(this) end function num_params !----------------------------------------------------------------------- - subroutine GetUsedDimensions(this, num_used_dimensions, used_dimensions) + subroutine GetUsedDimensions(this, is_host_file, num_used_dimensions, used_dimensions) ! Construct a list of the unique dimension names used by the ! parameters. implicit none class(fates_parameters_type), intent(inout) :: this + logical, intent(in) :: is_host_file integer, intent(out) :: num_used_dimensions character(len=param_string_length), intent(out) :: used_dimensions(max_used_dimensions) @@ -234,36 +236,39 @@ subroutine GetUsedDimensions(this, num_used_dimensions, used_dimensions) num_used_dimensions = 0 do p = 1, this%num_parameters - do d = 1, max_dimensions - dim_name = this%parameters(p)%dimension_names(d) - if (len_trim(dim_name) /= 0) then - ! non-empty dimension name, check if it needs to be added to the list. - do i = 1, num_used_dimensions - if (used_dimensions(i) == dim_name) then - ! dimension is already in list. can stop searching - exit + if (is_host_file .eqv. this%parameters(p)%sync_with_host) then + do d = 1, max_dimensions + dim_name = this%parameters(p)%dimension_names(d) + if (len_trim(dim_name) /= 0) then + ! non-empty dimension name, check if it needs to be added to the list. + do i = 1, num_used_dimensions + if (used_dimensions(i) == dim_name) then + ! dimension is already in list. can stop searching + exit + end if + end do + + if (i > num_used_dimensions) then + ! dimension name was not in the list, add it. + num_used_dimensions = num_used_dimensions + 1 + used_dimensions(num_used_dimensions) = dim_name end if - end do - - if (i > num_used_dimensions) then - ! dimension name was not in the list, add it. - num_used_dimensions = num_used_dimensions + 1 - used_dimensions(num_used_dimensions) = dim_name - end if - end if - end do - end do + end if ! if dim_name + end do ! do d + end if ! if host_param + end do ! do p end subroutine GetUsedDimensions !----------------------------------------------------------------------- - subroutine SetDimensionSizes(this, num_used_dimensions, dimension_names, dimension_sizes) + subroutine SetDimensionSizes(this, is_host_file, num_used_dimensions, dimension_names, dimension_sizes) ! Construct a list of the unique dimension names used by the ! parameters. implicit none class(fates_parameters_type), intent(inout) :: this + logical, intent(in) :: is_host_file integer, intent(in) :: num_used_dimensions character(len=param_string_length), intent(in) :: dimension_names(max_used_dimensions) integer, intent(in) :: dimension_sizes(max_used_dimensions) @@ -272,25 +277,27 @@ subroutine SetDimensionSizes(this, num_used_dimensions, dimension_names, dimensi character(len=param_string_length) :: dim_name do p = 1, this%num_parameters - do d = 1, max_dimensions - dim_name = this%parameters(p)%dimension_names(d) - if (len_trim(dim_name) /= 0) then - ! non-empty dimension name, set the size - do i = 1, num_used_dimensions - if (trim(dimension_names(i)) == trim(dim_name)) then - !write(*, *) '--> ', trim(this%parameters(p)%name), ' setting ', trim(dim_name), ' d = ', d, 'size = ', dimension_sizes(i) - this%parameters(p)%dimension_sizes(d) = dimension_sizes(i) - exit - end if - end do - end if - end do - end do + if (is_host_file .eqv. this%parameters(p)%sync_with_host) then + do d = 1, max_dimensions + dim_name = this%parameters(p)%dimension_names(d) + if (len_trim(dim_name) /= 0) then + ! non-empty dimension name, set the size + do i = 1, num_used_dimensions + if (trim(dimension_names(i)) == trim(dim_name)) then + !write(*, *) '--> ', trim(this%parameters(p)%name), ' setting ', trim(dim_name), ' d = ', d, 'size = ', dimension_sizes(i) + this%parameters(p)%dimension_sizes(d) = dimension_sizes(i) + exit + end if + end do + end if ! if dim_name + end do ! do dim + end if ! if host_param + end do ! do param end subroutine SetDimensionSizes !----------------------------------------------------------------------- - subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes) + subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes, is_host_param) implicit none @@ -299,10 +306,12 @@ subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes) character(len=param_string_length), intent(out) :: name integer, intent(out) :: dimension_shape integer, intent(out) :: dimension_sizes(max_dimensions) + logical, intent(out) :: is_host_param name = this%parameters(index)%name dimension_shape = this%parameters(index)%dimension_shape dimension_sizes = this%parameters(index)%dimension_sizes + is_host_param = this%parameters(index)%sync_with_host end subroutine GetMetaData diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index d7abf38ac9..35faac640b 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -45,7 +45,6 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use PhotosynthesisMod , only : photosyns_type use CLMFatesInterfaceMod , only : FatesReadParameters - use EDSharedParamsMod , only : EDParamsReadShared ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst @@ -93,10 +92,6 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) call readSoilBiogeochemPotentialParams(ncid) call CNParamsReadShared(ncid, NLFilename_in) ! this is called CN params but really is for the soil biogeochem parameters - ! FIXME(bja, 2017-01) ED shared params must be read from the - ! host file, not the fates file to be consistent with the host. - call EDParamsReadShared(ncid) - call readCH4Params (ncid) end if diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 449be5c05f..e1b888d598 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1820,17 +1820,19 @@ end subroutine hlm_bounds_to_fates_bounds !----------------------------------------------------------------------- subroutine FatesReadParameters() - use clm_varctl, only : fates_paramfile + use clm_varctl, only : paramfile, fates_paramfile use FatesParametersInterface, only : fates_parameters_type use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams + use EDSharedParamsMod, only : EDParamsShareInst implicit none character(len=32) :: subname = 'FatesReadParameters' class(fates_parameters_type), allocatable :: fates_params + logical :: is_host_file if (use_ed) then if (masterproc) then @@ -1841,11 +1843,17 @@ subroutine FatesReadParameters() call fates_params%Init() call FatesRegisterParams(fates_params) call SpitFireRegisterParams(fates_params) + call EDParamsShareInst%RegisterParams(fates_params) - call ParametersFromNetCDF(fates_params) + is_host_file = .false. + call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) + + is_host_file = .true. + call ParametersFromNetCDF(paramfile, is_host_file, fates_params) call FatesReceiveParams(fates_params) call SpitFireReceiveParams(fates_params) + call EDParamsShareInst%ReceiveParams(fates_params) call fates_params%Destroy() deallocate(fates_params) @@ -1856,7 +1864,7 @@ end subroutine FatesReadParameters !----------------------------------------------------------------------- subroutine FatesReadPFTs() - use clm_varctl, only : fates_paramfile + use clm_varctl, only : paramfile, fates_paramfile use FatesParametersInterface, only : fates_parameters_type @@ -1864,6 +1872,7 @@ subroutine FatesReadPFTs() character(len=32) :: subname = 'FatesReadPFTs' class(fates_parameters_type), allocatable :: fates_params + logical :: is_host_file if (use_ed) then if (masterproc) then @@ -1873,7 +1882,11 @@ subroutine FatesReadPFTs() allocate(fates_params) call fates_params%Init() - call ParametersFromNetCDF(fates_params) + is_host_file = .false. + call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) + + is_host_file = .true. + call ParametersFromNetCDF(paramfile, is_host_file, fates_params) call fates_params%Destroy() deallocate(fates_params) @@ -1882,7 +1895,7 @@ subroutine FatesReadPFTs() end subroutine FatesReadPFTs !----------------------------------------------------------------------- - subroutine SetParameterDimensions(ncid, fates_params) + subroutine SetParameterDimensions(ncid, is_host_file, fates_params) ! Get the list of dimensions used by the fates parameters, ! retreive them from the parameter file, then give the information ! back to fates. @@ -1891,17 +1904,18 @@ subroutine SetParameterDimensions(ncid, fates_params) implicit none type(file_desc_t), intent(inout) :: ncid + logical, intent(in) :: is_host_file class(fates_parameters_type), intent(inout) :: fates_params integer :: num_used_dimensions character(len=param_string_length) :: used_dimension_names(max_used_dimensions) integer :: used_dimension_sizes(max_used_dimensions) - call fates_params%GetUsedDimensions(num_used_dimensions, used_dimension_names) + call fates_params%GetUsedDimensions(is_host_file, num_used_dimensions, used_dimension_names) call GetUsedDimensionSizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes) - call fates_params%SetDimensionSizes(num_used_dimensions, used_dimension_names, used_dimension_sizes) + call fates_params%SetDimensionSizes(is_host_file, num_used_dimensions, used_dimension_names, used_dimension_sizes) end subroutine SetParameterDimensions @@ -1935,11 +1949,10 @@ subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dim end subroutine GetUsedDimensionSizes !----------------------------------------------------------------------- - subroutine ParametersFromNetCDF(fates_params) + subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) use shr_kind_mod, only: r8 => shr_kind_r8 use abortutils, only : endrun - use clm_varctl, only : fates_paramfile use fileutils , only : getfil use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile use paramUtilMod, only : readNcdio @@ -1950,6 +1963,8 @@ subroutine ParametersFromNetCDF(fates_params) implicit none + character(len=*), intent(in) :: filename + logical, intent(in) :: is_host_file class(fates_parameters_type), intent(inout) :: fates_params character(len=32) :: subname = 'clmfates_interface::ReadParameters' @@ -1962,32 +1977,35 @@ subroutine ParametersFromNetCDF(fates_params) character(len=param_string_length) :: name integer :: dimension_sizes(max_dimensions) integer :: size_dim_1, size_dim_2 + logical :: is_host_param - call getfil (fates_paramfile, locfn, 0) + call getfil (filename, locfn, 0) call ncd_pio_openfile (ncid, trim(locfn), 0) - call SetParameterDimensions(ncid, fates_params) + call SetParameterDimensions(ncid, is_host_file, fates_params) max_dim_size = fates_params%GetMaxDimensionSize() allocate(data(max_dim_size, max_dim_size)) num_params = fates_params%num_params() do i = 1, num_params - call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes) - select case(dimension_shape) - case(dimension_shape_scalar) - size_dim_1 = 1 - size_dim_2 = 1 - case(dimension_shape_1d) - size_dim_1 = dimension_sizes(1) - size_dim_2 = 1 - case(dimension_shape_2d) - size_dim_1 = dimension_sizes(1) - size_dim_2 = dimension_sizes(2) - case default - call endrun(msg='unsupported number of dimensions reading parameters.') - end select - call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) - call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) + call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, is_host_param) + if (is_host_file .eqv. is_host_param) then + select case(dimension_shape) + case(dimension_shape_scalar) + size_dim_1 = 1 + size_dim_2 = 1 + case(dimension_shape_1d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = 1 + case(dimension_shape_2d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = dimension_sizes(2) + case default + call endrun(msg='unsupported number of dimensions reading parameters.') + end select + call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) + call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) + end if end do deallocate(data) call ncd_pio_closefile(ncid) From 2ef7e631f043e24d6f305894e617d23b6d70b986 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Sat, 28 Jan 2017 15:53:41 -0700 Subject: [PATCH 09/46] Move clm-fates parameter interface code into standalone module to avoid circular depencies with pftcon. User interface changes?: No Test: SMS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: ed-clm-a651a4 Test namelist changes: add fates_paramfile Test answer changes: bit for bit Test summary: pass --- components/clm/src/main/readParamsMod.F90 | 2 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 204 ---------------- .../src/utils/clmfates_paraminterfaceMod.F90 | 226 ++++++++++++++++++ 3 files changed, 227 insertions(+), 205 deletions(-) create mode 100644 components/clm/src/utils/clmfates_paraminterfaceMod.F90 diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index 35faac640b..b43009fb09 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -44,7 +44,7 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type - use CLMFatesInterfaceMod , only : FatesReadParameters + use CLMFatesParamInterfaceMod , only : FatesReadParameters ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index e1b888d598..bd124668bc 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -164,15 +164,6 @@ module CLMFatesInterfaceMod end type hlm_fates_interface_type - - ! NOTE(bja, 2017-01) these methods can NOT be part of the interface - ! type because they are called before the instance is initialized. - public :: FatesReadParameters - public :: FatesReadPFTs - private :: ParametersFromNetCDF - private :: SetParameterDimensions - private :: GetUsedDimensionSizes - logical :: DEBUG = .false. character(len=*), parameter, private :: sourcefile = & @@ -1817,199 +1808,4 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) end subroutine hlm_bounds_to_fates_bounds - !----------------------------------------------------------------------- - subroutine FatesReadParameters() - - use clm_varctl, only : paramfile, fates_paramfile - - use FatesParametersInterface, only : fates_parameters_type - - use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams - use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams - use EDSharedParamsMod, only : EDParamsShareInst - - implicit none - - character(len=32) :: subname = 'FatesReadParameters' - class(fates_parameters_type), allocatable :: fates_params - logical :: is_host_file - - if (use_ed) then - if (masterproc) then - write(iulog,*) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' parameters ' - end if - - allocate(fates_params) - call fates_params%Init() - call FatesRegisterParams(fates_params) - call SpitFireRegisterParams(fates_params) - call EDParamsShareInst%RegisterParams(fates_params) - - is_host_file = .false. - call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) - - is_host_file = .true. - call ParametersFromNetCDF(paramfile, is_host_file, fates_params) - - call FatesReceiveParams(fates_params) - call SpitFireReceiveParams(fates_params) - call EDParamsShareInst%ReceiveParams(fates_params) - - call fates_params%Destroy() - deallocate(fates_params) - end if - - end subroutine FatesReadParameters - - !----------------------------------------------------------------------- - subroutine FatesReadPFTs() - - use clm_varctl, only : paramfile, fates_paramfile - - use FatesParametersInterface, only : fates_parameters_type - - implicit none - - character(len=32) :: subname = 'FatesReadPFTs' - class(fates_parameters_type), allocatable :: fates_params - logical :: is_host_file - - if (use_ed) then - if (masterproc) then - write(iulog,*) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' PFTs ' - end if - - allocate(fates_params) - call fates_params%Init() - - is_host_file = .false. - call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) - - is_host_file = .true. - call ParametersFromNetCDF(paramfile, is_host_file, fates_params) - - call fates_params%Destroy() - deallocate(fates_params) - end if - - end subroutine FatesReadPFTs - - !----------------------------------------------------------------------- - subroutine SetParameterDimensions(ncid, is_host_file, fates_params) - ! Get the list of dimensions used by the fates parameters, - ! retreive them from the parameter file, then give the information - ! back to fates. - use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions - - implicit none - - type(file_desc_t), intent(inout) :: ncid - logical, intent(in) :: is_host_file - class(fates_parameters_type), intent(inout) :: fates_params - - integer :: num_used_dimensions - character(len=param_string_length) :: used_dimension_names(max_used_dimensions) - integer :: used_dimension_sizes(max_used_dimensions) - - call fates_params%GetUsedDimensions(is_host_file, num_used_dimensions, used_dimension_names) - - call GetUsedDimensionSizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes) - - call fates_params%SetDimensionSizes(is_host_file, num_used_dimensions, used_dimension_names, used_dimension_sizes) - - end subroutine SetParameterDimensions - - !----------------------------------------------------------------------- - subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) - - use ncdio_pio , only : ncd_inqdid, ncd_inqdlen - use FatesParametersInterface, only : param_string_length - - implicit none - - type(file_desc_t), intent(inout) :: ncid - integer, intent(in) :: num_used_dimensions - character(len=param_string_length), intent(in) :: dimension_names(:) - integer, intent(out) :: dimension_sizes(:) - - integer :: d, max_dim_size, num_dims - integer :: dim_len, dim_id - - - dimension_sizes(:) = 0 - max_dim_size = 0 - - do d = 1, num_used_dimensions - call ncd_inqdid(ncid, dimension_names(d), dim_id) - call ncd_inqdlen(ncid, dim_id, dim_len) - dimension_sizes(d) = dim_len - !write(*, *) '--> ', trim(dimension_names(d)), ' setting size ', dimension_sizes(d) - end do - - end subroutine GetUsedDimensionSizes - - !----------------------------------------------------------------------- - subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) - - use shr_kind_mod, only: r8 => shr_kind_r8 - use abortutils, only : endrun - use fileutils , only : getfil - use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile - use paramUtilMod, only : readNcdio - - use FatesParametersInterface, only : fates_parameters_type - use FatesParametersInterface, only : param_string_length, max_dimensions, max_used_dimensions - use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d - - implicit none - - character(len=*), intent(in) :: filename - logical, intent(in) :: is_host_file - class(fates_parameters_type), intent(inout) :: fates_params - - character(len=32) :: subname = 'clmfates_interface::ReadParameters' - character(len=256) :: locfn ! local file name - type(file_desc_t) :: ncid ! pio netCDF file id - integer :: dimid ! netCDF dimension id - integer :: i, num_params, dimension_shape - integer :: max_dim_size - real(r8), allocatable :: data(:, :) - character(len=param_string_length) :: name - integer :: dimension_sizes(max_dimensions) - integer :: size_dim_1, size_dim_2 - logical :: is_host_param - - call getfil (filename, locfn, 0) - call ncd_pio_openfile (ncid, trim(locfn), 0) - - call SetParameterDimensions(ncid, is_host_file, fates_params) - max_dim_size = fates_params%GetMaxDimensionSize() - allocate(data(max_dim_size, max_dim_size)) - - num_params = fates_params%num_params() - do i = 1, num_params - call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, is_host_param) - if (is_host_file .eqv. is_host_param) then - select case(dimension_shape) - case(dimension_shape_scalar) - size_dim_1 = 1 - size_dim_2 = 1 - case(dimension_shape_1d) - size_dim_1 = dimension_sizes(1) - size_dim_2 = 1 - case(dimension_shape_2d) - size_dim_1 = dimension_sizes(1) - size_dim_2 = dimension_sizes(2) - case default - call endrun(msg='unsupported number of dimensions reading parameters.') - end select - call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) - call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) - end if - end do - deallocate(data) - call ncd_pio_closefile(ncid) - end subroutine ParametersFromNetCDF - !----------------------------------------------------------------------- - end module CLMFatesInterfaceMod diff --git a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 new file mode 100644 index 0000000000..48dceb348f --- /dev/null +++ b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 @@ -0,0 +1,226 @@ +module CLMFatesParamInterfaceMod + ! NOTE(bja, 2017-01) this code can not go into the main clm-fates + ! interface module because of circular dependancies with pftvarcon. + + use FatesGlobals, only : fates_log + + implicit none + + ! NOTE(bja, 2017-01) these methods can NOT be part of the clmi-fates + ! nterface type because they are called before the instance is + ! initialized. + public :: FatesReadParameters + public :: FatesReadPFTs + private :: ParametersFromNetCDF + private :: SetParameterDimensions + private :: GetUsedDimensionSizes + + logical :: DEBUG = .false. + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine FatesReadParameters() + + use clm_varctl, only : use_ed, paramfile, fates_paramfile + use spmdMod, only : masterproc + + use FatesParametersInterface, only : fates_parameters_type + + use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams + use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams + use EDSharedParamsMod, only : EDParamsShareInst + + implicit none + + character(len=32) :: subname = 'FatesReadParameters' + class(fates_parameters_type), allocatable :: fates_params + logical :: is_host_file + + if (use_ed) then + if (masterproc) then + write(fates_log(), *) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' parameters ' + end if + + allocate(fates_params) + call fates_params%Init() + call FatesRegisterParams(fates_params) + call SpitFireRegisterParams(fates_params) + call EDParamsShareInst%RegisterParams(fates_params) + + is_host_file = .false. + call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) + + is_host_file = .true. + call ParametersFromNetCDF(paramfile, is_host_file, fates_params) + + call FatesReceiveParams(fates_params) + call SpitFireReceiveParams(fates_params) + call EDParamsShareInst%ReceiveParams(fates_params) + + call fates_params%Destroy() + deallocate(fates_params) + end if + + end subroutine FatesReadParameters + + !----------------------------------------------------------------------- + subroutine FatesReadPFTs() + + use clm_varctl, only : use_ed, paramfile, fates_paramfile + use spmdMod, only : masterproc + + use FatesParametersInterface, only : fates_parameters_type + + implicit none + + character(len=32) :: subname = 'FatesReadPFTs' + class(fates_parameters_type), allocatable :: fates_params + logical :: is_host_file + + if (use_ed) then + if (masterproc) then + write(fates_log(), *) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' PFTs ' + end if + + allocate(fates_params) + call fates_params%Init() + + is_host_file = .false. + call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) + + is_host_file = .true. + call ParametersFromNetCDF(paramfile, is_host_file, fates_params) + + call fates_params%Destroy() + deallocate(fates_params) + end if + + end subroutine FatesReadPFTs + + !----------------------------------------------------------------------- + subroutine SetParameterDimensions(ncid, is_host_file, fates_params) + ! Get the list of dimensions used by the fates parameters, + ! retreive them from the parameter file, then give the information + ! back to fates. + use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions + + use ncdio_pio, only : file_desc_t + + implicit none + + type(file_desc_t), intent(inout) :: ncid + logical, intent(in) :: is_host_file + class(fates_parameters_type), intent(inout) :: fates_params + + integer :: num_used_dimensions + character(len=param_string_length) :: used_dimension_names(max_used_dimensions) + integer :: used_dimension_sizes(max_used_dimensions) + + call fates_params%GetUsedDimensions(is_host_file, num_used_dimensions, used_dimension_names) + + call GetUsedDimensionSizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes) + + call fates_params%SetDimensionSizes(is_host_file, num_used_dimensions, used_dimension_names, used_dimension_sizes) + + end subroutine SetParameterDimensions + + !----------------------------------------------------------------------- + subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) + + use ncdio_pio , only : ncd_inqdid, ncd_inqdlen + use FatesParametersInterface, only : param_string_length + use ncdio_pio, only : file_desc_t + + + implicit none + + type(file_desc_t), intent(inout) :: ncid + integer, intent(in) :: num_used_dimensions + character(len=param_string_length), intent(in) :: dimension_names(:) + integer, intent(out) :: dimension_sizes(:) + + integer :: d, max_dim_size, num_dims + integer :: dim_len, dim_id + + + dimension_sizes(:) = 0 + max_dim_size = 0 + + do d = 1, num_used_dimensions + call ncd_inqdid(ncid, dimension_names(d), dim_id) + call ncd_inqdlen(ncid, dim_id, dim_len) + dimension_sizes(d) = dim_len + !write(*, *) '--> ', trim(dimension_names(d)), ' setting size ', dimension_sizes(d) + end do + + end subroutine GetUsedDimensionSizes + + !----------------------------------------------------------------------- + subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils, only : endrun + use fileutils , only : getfil + use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile + use paramUtilMod, only : readNcdio + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length, max_dimensions, max_used_dimensions + use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d + + implicit none + + character(len=*), intent(in) :: filename + logical, intent(in) :: is_host_file + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=32) :: subname = 'clmfates_interface::ReadParameters' + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: i, num_params, dimension_shape + integer :: max_dim_size + real(r8), allocatable :: data(:, :) + character(len=param_string_length) :: name + integer :: dimension_sizes(max_dimensions) + integer :: size_dim_1, size_dim_2 + logical :: is_host_param + + call getfil (filename, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + call SetParameterDimensions(ncid, is_host_file, fates_params) + max_dim_size = fates_params%GetMaxDimensionSize() + allocate(data(max_dim_size, max_dim_size)) + + num_params = fates_params%num_params() + do i = 1, num_params + call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, is_host_param) + if (is_host_file .eqv. is_host_param) then + select case(dimension_shape) + case(dimension_shape_scalar) + size_dim_1 = 1 + size_dim_2 = 1 + case(dimension_shape_1d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = 1 + case(dimension_shape_2d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = dimension_sizes(2) + case default + call endrun(msg='unsupported number of dimensions reading parameters.') + end select + call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) + call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) + end if + end do + deallocate(data) + call ncd_pio_closefile(ncid) + end subroutine ParametersFromNetCDF + !----------------------------------------------------------------------- + +end module CLMFatesParamInterfaceMod From 189acf90d7e58f4b054562325a69f13fb806bd88 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Sat, 28 Jan 2017 14:58:20 -0700 Subject: [PATCH 10/46] Convert ed pftvarcon to use new parameter interface. Test suite: ed - yellowstone gnu, intel, pgi Test baseline: a651a4f Test namelist changes: fates_paramfile Test answer changes: bit for bit Test summary: all tests pass Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass --- components/clm/src/ED/main/EDPftvarcon.F90 | 921 +++++++++++++++--- .../src/ED/main/FatesParametersInterface.F90 | 23 +- components/clm/src/main/pftconMod.F90 | 31 +- .../src/utils/clmfates_paraminterfaceMod.F90 | 24 +- 4 files changed, 836 insertions(+), 163 deletions(-) diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index 7a8a032eeb..c9f42e7b22 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -9,6 +9,7 @@ module EDPftvarcon use clm_varpar , only : mxpft, numrad, ivis, inir, nvariants use shr_kind_mod, only : r8 => shr_kind_r8 + use FatesGlobals, only : fates_log ! ! !PUBLIC TYPES: implicit none @@ -68,6 +69,16 @@ module EDPftvarcon real(r8) :: smpso(0:mxpft) real(r8) :: smpsc(0:mxpft) real(r8) :: grperc(0:mxpft) ! NOTE(bja, 2017-01) moved from EDParamsMod, was allocated as (maxPft=79), not (0:mxpft=78)! + contains + procedure, public :: Init => EDpftconInit + procedure, public :: Register + procedure, public :: Receive + procedure, private :: Register_PFT + procedure, private :: Receive_PFT + procedure, private :: Register_PFT_nvariants + procedure, private :: Receive_PFT_nvariants + procedure, private :: Register_PFT_numrad + procedure, private :: Receive_PFT_numrad end type EDPftvarcon_type type(EDPftvarcon_type), public :: EDPftvarcon_inst @@ -77,196 +88,850 @@ module EDPftvarcon ! ! !PUBLIC MEMBER FUNCTIONS: public :: EDpftconrd ! Read and initialize vegetation (PFT) constants + !----------------------------------------------------------------------- contains !----------------------------------------------------------------------- - subroutine EDpftconrd( ncid ) - ! - ! !DESCRIPTION: - ! Read and initialize vegetation (PFT) constants - ! - ! !USES: - use ncdio_pio , only : file_desc_t, ncd_io - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - ! - ! !ARGUMENTS: + subroutine EDpftconInit(this) + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + implicit none - ! - type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id - ! !LOCAL VARIABLES: + class(EDPftvarcon_type), intent(inout) :: this + + this%max_dbh(:) = nan + this%freezetol(:) = nan + this%wood_density(:) = nan + this%alpha_stem(:) = nan + this%hgt_min(:) = nan + this%cushion(:) = nan + this%leaf_stor_priority(:) = nan + this%leafwatermax(:) = nan + this%rootresist(:) = nan + this%soilbeta(:) = nan + this%crown(:) = nan + this%bark_scaler(:) = nan + this%crown_kill(:) = nan + this%initd(:) = nan + this%sd_mort(:) = nan + this%seed_rain(:) = nan + this%BB_slope(:) = nan + this%root_long(:) = nan + this%clone_alloc(:) = nan + this%seed_alloc(:) = nan + this%sapwood_ratio(:) = nan + this%dbh2h_m(:) = nan + this%woody(:) = nan + this%stress_decid(:) = nan + this%season_decid(:) = nan + this%evergreen(:) = nan + this%froot_leaf(:) = nan + this%slatop(:) = nan + this%leaf_long(:) = nan + this%roota_par(:) = nan + this%rootb_par(:) = nan + this%lf_flab(:) = nan + this%lf_fcel(:) = nan + this%lf_flig(:) = nan + this%fr_flab(:) = nan + this%fr_fcel(:) = nan + this%fr_flig(:) = nan + this%xl(:) = nan + this%c3psn(:) = nan + this%flnr(:) = nan + this%fnitr(:) = nan + this%leafcn(:) = nan + this%frootcn(:) = nan + this%smpso(:) = nan + this%smpsc(:) = nan + this%grperc(:) = nan + + this%rootprof_beta(:, :) = nan + this%rhol(:, :) = nan + this%rhos(:, :) = nan + this%taul(:, :) = nan + this%taus(:, :) = nan + + end subroutine EDpftconInit - logical :: readv ! read variable in or not - character(len=32) :: subname = 'EDpftconrd' ! subroutine name + !----------------------------------------------------------------------- + subroutine Register(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%Register_PFT(fates_params) + call this%Register_PFT_numrad(fates_params) + call this%Register_PFT_nvariants(fates_params) + + end subroutine Register + + !----------------------------------------------------------------------- + subroutine Receive(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%Receive_PFT(fates_params) + call this%Receive_PFT_numrad(fates_params) + call this%Receive_PFT_nvariants(fates_params) + + end subroutine Receive + + !----------------------------------------------------------------------- + subroutine Register_PFT(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/) + + character(len=param_string_length) :: name + + !X! name = '' + !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + !X! dimension_names=dim_names) - call ncd_io('max_dbh',EDPftvarcon_inst%max_dbh, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'max_dbh' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('freezetol',EDPftvarcon_inst%freezetol, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'freezetol' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('wood_density',EDPftvarcon_inst%wood_density, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'wood_density' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('alpha_stem',EDPftvarcon_inst%alpha_stem, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'alpha_stem' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('hgt_min',EDPftvarcon_inst%hgt_min, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'hgt_min' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('cushion',EDPftvarcon_inst%cushion, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'cushion' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('leaf_stor_priority',EDPftvarcon_inst%leaf_stor_priority, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'leaf_stor_priority' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('leafwatermax',EDPftvarcon_inst%leafwatermax, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'leafwatermax' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('rootresist',EDPftvarcon_inst%rootresist,'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'rootresist' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call ncd_io('soilbeta',EDPftvarcon_inst%soilbeta,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'soilbeta' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'crown' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'bark_scaler' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'crown_kill' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'initd' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'sd_mort' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'seed_rain' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'BB_slope' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'root_long' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'clone_alloc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'seed_alloc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'sapwood_ratio' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'woody' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'stress_decid' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'season_decid' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'evergreen' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'froot_leaf' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'slatop' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'leaf_long' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'roota_par' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'rootb_par' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'lf_flab' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'lf_fcel' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'lf_flig' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fr_flab' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fr_fcel' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fr_flig' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'xl' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'c3psn' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'flnr' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fnitr' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'leafcn' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'frootcn' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'smpso' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'smpsc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'grperc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + + end subroutine Register_PFT + + !----------------------------------------------------------------------- + subroutine Receive_PFT(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none - call ncd_io('crown',EDPftvarcon_inst%crown,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params - call ncd_io('bark_scaler',EDPftvarcon_inst%bark_scaler,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + character(len=param_string_length) :: name - call ncd_io('crown_kill',EDPftvarcon_inst%crown_kill,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! name = '' + !X! call fates_params%RetreiveParameter(name=name, & + !X! data=this%) - call ncd_io('initd',EDPftvarcon_inst%initd,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'max_dbh' + call fates_params%RetreiveParameter(name=name, & + data=this%max_dbh) - call ncd_io('sd_mort',EDPftvarcon_inst%sd_mort,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'freezetol' + call fates_params%RetreiveParameter(name=name, & + data=this%freezetol) - call ncd_io('seed_rain',EDPftvarcon_inst%seed_rain,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'wood_density' + call fates_params%RetreiveParameter(name=name, & + data=this%wood_density) - call ncd_io('BB_slope',EDPftvarcon_inst%BB_slope,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'alpha_stem' + call fates_params%RetreiveParameter(name=name, & + data=this%alpha_stem) - call ncd_io('root_long',EDPftvarcon_inst%root_long, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'hgt_min' + call fates_params%RetreiveParameter(name=name, & + data=this%hgt_min) - call ncd_io('seed_alloc',EDPftvarcon_inst%seed_alloc, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'cushion' + call fates_params%RetreiveParameter(name=name, & + data=this%cushion) - call ncd_io('clone_alloc',EDPftvarcon_inst%clone_alloc, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'leaf_stor_priority' + call fates_params%RetreiveParameter(name=name, & + data=this%leaf_stor_priority) - call ncd_io('sapwood_ratio',EDPftvarcon_inst%sapwood_ratio, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - - call ncd_io('woody', EDPftvarcon_inst%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'leafwatermax' + call fates_params%RetreiveParameter(name=name, & + data=this%leafwatermax) - call ncd_io('stress_decid', EDPftvarcon_inst%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'rootresist' + call fates_params%RetreiveParameter(name=name, & + data=this%rootresist) - call ncd_io('season_decid', EDPftvarcon_inst%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'soilbeta' + call fates_params%RetreiveParameter(name=name, & + data=this%soilbeta) - call ncd_io('evergreen', EDPftvarcon_inst%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'crown' + call fates_params%RetreiveParameter(name=name, & + data=this%crown) - call ncd_io('froot_leaf', EDPftvarcon_inst%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'bark_scaler' + call fates_params%RetreiveParameter(name=name, & + data=this%bark_scaler) - call ncd_io('slatop', EDPftvarcon_inst%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'crown_kill' + call fates_params%RetreiveParameter(name=name, & + data=this%crown_kill) - call ncd_io('leaf_long', EDPftvarcon_inst%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'initd' + call fates_params%RetreiveParameter(name=name, & + data=this%initd) - call ncd_io('rootprof_beta', EDPftvarcon_inst%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'sd_mort' + call fates_params%RetreiveParameter(name=name, & + data=this%sd_mort) - call ncd_io('roota_par', EDPftvarcon_inst%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'seed_rain' + call fates_params%RetreiveParameter(name=name, & + data=this%seed_rain) - call ncd_io('rootb_par', EDPftvarcon_inst%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'BB_slope' + call fates_params%RetreiveParameter(name=name, & + data=this%BB_slope) - call ncd_io('lf_flab', EDPftvarcon_inst%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'root_long' + call fates_params%RetreiveParameter(name=name, & + data=this%root_long) - call ncd_io('lf_fcel', EDPftvarcon_inst%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'clone_alloc' + call fates_params%RetreiveParameter(name=name, & + data=this%clone_alloc) - call ncd_io('lf_flig', EDPftvarcon_inst%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'seed_alloc' + call fates_params%RetreiveParameter(name=name, & + data=this%seed_alloc) - call ncd_io('fr_flab', EDPftvarcon_inst%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'sapwood_ratio' + call fates_params%RetreiveParameter(name=name, & + data=this%sapwood_ratio) - call ncd_io('fr_fcel', EDPftvarcon_inst%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'woody' + call fates_params%RetreiveParameter(name=name, & + data=this%woody) - call ncd_io('fr_flig', EDPftvarcon_inst%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'stress_decid' + call fates_params%RetreiveParameter(name=name, & + data=this%stress_decid) - call ncd_io('rholvis', EDPftvarcon_inst%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'season_decid' + call fates_params%RetreiveParameter(name=name, & + data=this%season_decid) - call ncd_io('rholnir', EDPftvarcon_inst%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'evergreen' + call fates_params%RetreiveParameter(name=name, & + data=this%evergreen) - call ncd_io('rhosvis', EDPftvarcon_inst%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'froot_leaf' + call fates_params%RetreiveParameter(name=name, & + data=this%froot_leaf) - call ncd_io('rhosnir', EDPftvarcon_inst% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'slatop' + call fates_params%RetreiveParameter(name=name, & + data=this%slatop) - call ncd_io('taulvis', EDPftvarcon_inst%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'leaf_long' + call fates_params%RetreiveParameter(name=name, & + data=this%leaf_long) - call ncd_io('taulnir', EDPftvarcon_inst%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'roota_par' + call fates_params%RetreiveParameter(name=name, & + data=this%roota_par) - call ncd_io('tausvis', EDPftvarcon_inst%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'rootb_par' + call fates_params%RetreiveParameter(name=name, & + data=this%rootb_par) - call ncd_io('tausnir', EDPftvarcon_inst%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'lf_flab' + call fates_params%RetreiveParameter(name=name, & + data=this%lf_flab) - call ncd_io('xl', EDPftvarcon_inst%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'lf_fcel' + call fates_params%RetreiveParameter(name=name, & + data=this%lf_fcel) - call ncd_io('c3psn', EDPftvarcon_inst%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'lf_flig' + call fates_params%RetreiveParameter(name=name, & + data=this%lf_flig) - call ncd_io('flnr', EDPftvarcon_inst%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'fr_flab' + call fates_params%RetreiveParameter(name=name, & + data=this%fr_flab) - call ncd_io('fnitr', EDPftvarcon_inst%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'fr_fcel' + call fates_params%RetreiveParameter(name=name, & + data=this%fr_fcel) - call ncd_io('leafcn', EDPftvarcon_inst%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'fr_flig' + call fates_params%RetreiveParameter(name=name, & + data=this%fr_flig) - call ncd_io('frootcn', EDPftvarcon_inst%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'xl' + call fates_params%RetreiveParameter(name=name, & + data=this%xl) - call ncd_io('smpso', EDPftvarcon_inst%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'c3psn' + call fates_params%RetreiveParameter(name=name, & + data=this%c3psn) - call ncd_io('smpsc', EDPftvarcon_inst%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'flnr' + call fates_params%RetreiveParameter(name=name, & + data=this%flnr) - call ncd_io('grperc', EDPftvarcon_inst%grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + name = 'fnitr' + call fates_params%RetreiveParameter(name=name, & + data=this%fnitr) + + name = 'leafcn' + call fates_params%RetreiveParameter(name=name, & + data=this%leafcn) + + name = 'frootcn' + call fates_params%RetreiveParameter(name=name, & + data=this%frootcn) + + name = 'smpso' + call fates_params%RetreiveParameter(name=name, & + data=this%smpso) + + name = 'smpsc' + call fates_params%RetreiveParameter(name=name, & + data=this%smpsc) + + name = 'grperc' + call fates_params%RetreiveParameter(name=name, & + data=this%grperc) + + end subroutine Receive_PFT + + !----------------------------------------------------------------------- + subroutine Register_PFT_numrad(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/) + + character(len=param_string_length) :: name + + !X! name = '' + !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + !X! dimension_names=dim_names) + + name = 'rholvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'rholnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'rhosvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'rhosnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'taulvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'taulnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'tausvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'tausnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + + end subroutine Register_PFT_numrad + + !----------------------------------------------------------------------- + subroutine Receive_PFT_numrad(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + !X! name = '' + !X! call fates_params%RetreiveParameter(name=name, & + !X! data=this%) + + name = 'rholvis' + call fates_params%RetreiveParameter(name=name, & + data=this%rhol(:,ivis)) + + name = 'rholnir' + call fates_params%RetreiveParameter(name=name, & + data=this%rhol(:,inir)) + + name = 'rhosvis' + call fates_params%RetreiveParameter(name=name, & + data=this%rhos(:,ivis)) + + name = 'rhosnir' + call fates_params%RetreiveParameter(name=name, & + data=this%rhos(:,inir)) + + name = 'taulvis' + call fates_params%RetreiveParameter(name=name, & + data=this%taul(:,ivis)) + + name = 'taulnir' + call fates_params%RetreiveParameter(name=name, & + data=this%taul(:,inir)) + + name = 'tausvis' + call fates_params%RetreiveParameter(name=name, & + data=this%taus(:,ivis)) + + name = 'tausnir' + call fates_params%RetreiveParameter(name=name, & + data=this%taus(:,inir)) + + end subroutine Receive_PFT_numrad + + !----------------------------------------------------------------------- + subroutine Register_PFT_nvariants(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : max_dimensions, dimension_name_variants, dimension_name_pft, dimension_shape_2d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: dim_names(2) + character(len=param_string_length) :: name + + ! NOTE(bja, 2017-01) initialization doesn't seem to work correctly + ! if dim_names has a paramater qualifier. + dim_names(1) = dimension_name_pft + dim_names(2) = dimension_name_variants + + !X! name = '' + !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + !X! dimension_names=dim_names) + + name = 'rootprof_beta' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names) + + end subroutine Register_PFT_nvariants + + !----------------------------------------------------------------------- + subroutine Receive_PFT_nvariants(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + !X! name = '' + !X! call fates_params%RetreiveParameter(name=name, & + !X! data=this%) + + name = 'rootprof_beta' + call fates_params%RetreiveParameter(name=name, & + data=this%rootprof_beta) + + end subroutine Receive_PFT_nvariants + + !----------------------------------------------------------------------- + subroutine EDpftconrd( ncid ) + ! + ! !DESCRIPTION: + ! Read and initialize vegetation (PFT) constants + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_io + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + implicit none + ! + type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id + + ! !LOCAL VARIABLES: + + logical :: readv ! read variable in or not + character(len=32) :: subname = 'EDpftconrd' ! subroutine name -! HOLDING ON SEW ENSITIVITY-ANALYSIS PARAMETERS UNTIL MACHINE CONFIGS SET RGK/CX -! call ncd_io('dbh2h_m',EDPftvarcon_inst%dbh2h_m, 'read', ncid, readvar=readv) -! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! call ncd_io('max_dbh',EDPftvarcon_inst%max_dbh, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + !X! call ncd_io('freezetol',EDPftvarcon_inst%freezetol, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('wood_density',EDPftvarcon_inst%wood_density, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('alpha_stem',EDPftvarcon_inst%alpha_stem, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('hgt_min',EDPftvarcon_inst%hgt_min, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('cushion',EDPftvarcon_inst%cushion, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('leaf_stor_priority',EDPftvarcon_inst%leaf_stor_priority, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('leafwatermax',EDPftvarcon_inst%leafwatermax, 'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('rootresist',EDPftvarcon_inst%rootresist,'read', ncid, readvar=readv) + !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + !X! + !X! call ncd_io('soilbeta',EDPftvarcon_inst%soilbeta,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('crown',EDPftvarcon_inst%crown,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('bark_scaler',EDPftvarcon_inst%bark_scaler,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('crown_kill',EDPftvarcon_inst%crown_kill,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('initd',EDPftvarcon_inst%initd,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('sd_mort',EDPftvarcon_inst%sd_mort,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('seed_rain',EDPftvarcon_inst%seed_rain,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('BB_slope',EDPftvarcon_inst%BB_slope,'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('root_long',EDPftvarcon_inst%root_long, 'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('seed_alloc',EDPftvarcon_inst%seed_alloc, 'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('clone_alloc',EDPftvarcon_inst%clone_alloc, 'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('sapwood_ratio',EDPftvarcon_inst%sapwood_ratio, 'read', ncid, readvar=readv) + !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! + !X! call ncd_io('woody', EDPftvarcon_inst%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('stress_decid', EDPftvarcon_inst%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('season_decid', EDPftvarcon_inst%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('evergreen', EDPftvarcon_inst%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('froot_leaf', EDPftvarcon_inst%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('slatop', EDPftvarcon_inst%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('leaf_long', EDPftvarcon_inst%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + !X! call ncd_io('rootprof_beta', EDPftvarcon_inst%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + !X! call ncd_io('roota_par', EDPftvarcon_inst%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('rootb_par', EDPftvarcon_inst%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('lf_flab', EDPftvarcon_inst%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('lf_fcel', EDPftvarcon_inst%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('lf_flig', EDPftvarcon_inst%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('fr_flab', EDPftvarcon_inst%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('fr_fcel', EDPftvarcon_inst%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('fr_flig', EDPftvarcon_inst%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + !X! call ncd_io('rholvis', EDPftvarcon_inst%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('rholnir', EDPftvarcon_inst%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('rhosvis', EDPftvarcon_inst%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('rhosnir', EDPftvarcon_inst% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('taulvis', EDPftvarcon_inst%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('taulnir', EDPftvarcon_inst%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('tausvis', EDPftvarcon_inst%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('tausnir', EDPftvarcon_inst%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + !X! call ncd_io('xl', EDPftvarcon_inst%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('c3psn', EDPftvarcon_inst%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('flnr', EDPftvarcon_inst%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('fnitr', EDPftvarcon_inst%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('leafcn', EDPftvarcon_inst%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('frootcn', EDPftvarcon_inst%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('smpso', EDPftvarcon_inst%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('smpsc', EDPftvarcon_inst%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + !X! + !X! call ncd_io('grperc', EDPftvarcon_inst%grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + ! HOLDING ON SEW ENSITIVITY-ANALYSIS PARAMETERS UNTIL MACHINE CONFIGS SET RGK/CX + ! call ncd_io('dbh2h_m',EDPftvarcon_inst%dbh2h_m, 'read', ncid, readvar=readv) + ! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') end subroutine EDpftconrd diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 index 6ebadce23a..60bae8eb57 100644 --- a/components/clm/src/ED/main/FatesParametersInterface.F90 +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -29,6 +29,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_lsc = 'litterclass' character(len=*), parameter, public :: dimension_name_fsc = 'litterclass' character(len=*), parameter, public :: dimension_name_allpfts = 'allpfts' + character(len=*), parameter, public :: dimension_name_variants = 'variants' type, private :: parameter_type character(len=param_string_length) :: name @@ -157,7 +158,7 @@ subroutine RetreiveParameter1D(this, name, data) i = this%FindIndex(name) if (size(data) /= size(this%parameters(i)%data(:, 1))) then write(fates_log(), *) 'ERROR : retreiveparameter1d : ', name, ' size inconsistent.' - write(fates_log(), *) 'ERROR : size expected size = ', size(data) + write(fates_log(), *) 'ERROR : expected size = ', size(data) write(fates_log(), *) 'ERROR : data size received from file = ', size(this%parameters(i)%data(:, 1)) write(fates_log(), *) 'ERROR : dimesions received from file' write(fates_log(), *) 'ERROR : names size' @@ -173,16 +174,32 @@ end subroutine RetreiveParameter1D !----------------------------------------------------------------------- subroutine RetreiveParameter2D(this, name, data) + use abortutils, only : endrun + implicit none class(fates_parameters_type), intent(inout) :: this character(len=param_string_length), intent(in) :: name real(r8), intent(out) :: data(:, :) - integer :: i + integer :: i, d i = this%FindIndex(name) - ! assert(size(data) == size(this%parameters(i)%data)) + if (size(data, 1) /= size(this%parameters(i)%data, 1) .and. & + size(data, 2) /= size(this%parameters(i)%data, 2)) then + write(fates_log(), *) 'ERROR : retreiveparameter2d : ', name, ' size inconsistent.' + write(fates_log(), *) 'ERROR : expected shape = ', shape(data) + write(fates_log(), *) 'ERROR : dim 1 expected size = ', size(data, 1) + write(fates_log(), *) 'ERROR : dim 2 expected size = ', size(data, 2) + write(fates_log(), *) 'ERROR : dim 1 data size received from file = ', size(this%parameters(i)%data, 1) + write(fates_log(), *) 'ERROR : dim 2 data size received from file = ', size(this%parameters(i)%data, 2) + write(fates_log(), *) 'ERROR : dimesions received from file' + write(fates_log(), *) 'ERROR : names size' + do d = 1, max_dimensions + write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d) + end do + call endrun(msg='size error retreiving 2d parameter.') + end if data = this%parameters(i)%data end subroutine RetreiveParameter2D diff --git a/components/clm/src/main/pftconMod.F90 b/components/clm/src/main/pftconMod.F90 index 5c47279a6a..902ae462fa 100644 --- a/components/clm/src/main/pftconMod.F90 +++ b/components/clm/src/main/pftconMod.F90 @@ -465,6 +465,7 @@ subroutine InitRead(this) use ncdio_pio , only : ncd_inqdid, ncd_inqdlen use clm_varctl , only : paramfile, use_ed, use_flexibleCN, use_dynroot use spmdMod , only : masterproc + use CLMFatesParamInterfaceMod, only : FatesReadPFTs ! ! !ARGUMENTS: class(pftcon_type) :: this @@ -984,7 +985,7 @@ subroutine InitRead(this) call ncd_pio_closefile(ncid) - call readFatesParametersPFT() + call FatesReadPFTs() do i = 0, mxpft if (.not. use_ed)then @@ -1352,33 +1353,5 @@ subroutine Clean(this) end subroutine Clean - - subroutine readFatesParametersPFT() - - use fileutils , only : getfil - use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t - use ncdio_pio , only : ncd_inqdid, ncd_inqdlen - use clm_varctl , only : fates_paramfile, use_ed - use EDPftvarcon , only : EDpftconrd - - implicit none - - character(len=256) :: locfn ! local file name - type(file_desc_t) :: ncid ! pio netCDF file id - integer :: dimid ! netCDF dimension id - integer :: npft ! number of pfts on pft-physiology file - - if ( use_ed ) then - call getfil (fates_paramfile, locfn, 0) - call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_inqdid(ncid, 'pft', dimid) - call ncd_inqdlen(ncid, dimid, npft) - ! The following sets the module variable EDpftcon_inst in EDPftcon - call EDpftconrd ( ncid ) - call ncd_pio_closefile(ncid) - endif - - end subroutine readFatesParametersPFT - end module pftconMod diff --git a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 index 48dceb348f..07fc107f06 100644 --- a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 +++ b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 @@ -74,6 +74,10 @@ subroutine FatesReadPFTs() use spmdMod, only : masterproc use FatesParametersInterface, only : fates_parameters_type + use EDPftvarcon , only : EDpftconrd, EDPftvarcon_inst + + use fileutils , only : getfil + use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile implicit none @@ -81,6 +85,9 @@ subroutine FatesReadPFTs() class(fates_parameters_type), allocatable :: fates_params logical :: is_host_file + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + if (use_ed) then if (masterproc) then write(fates_log(), *) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' PFTs ' @@ -88,6 +95,17 @@ subroutine FatesReadPFTs() allocate(fates_params) call fates_params%Init() + call EDPftvarcon_inst%Init() + + ! FIXME(bja, 2017-01) old style read for some parameters, remove + ! when all pfts are read with new infrastructure. + !X! call getfil (fates_paramfile, locfn, 0) + !X! call ncd_pio_openfile (ncid, trim(locfn), 0) + !X! call EDpftconrd ( ncid ) + !X! call ncd_pio_closefile(ncid) + + call EDPftvarcon_inst%Register(fates_params) + is_host_file = .false. call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) @@ -95,6 +113,8 @@ subroutine FatesReadPFTs() is_host_file = .true. call ParametersFromNetCDF(paramfile, is_host_file, fates_params) + call EDPftvarcon_inst%Receive(fates_params) + call fates_params%Destroy() deallocate(fates_params) end if @@ -107,8 +127,7 @@ subroutine SetParameterDimensions(ncid, is_host_file, fates_params) ! retreive them from the parameter file, then give the information ! back to fates. use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions - - use ncdio_pio, only : file_desc_t + use ncdio_pio , only : file_desc_t implicit none @@ -146,7 +165,6 @@ subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dim integer :: d, max_dim_size, num_dims integer :: dim_len, dim_id - dimension_sizes(:) = 0 max_dim_size = 0 From 829fa2430a137899b2ae731eae5fc886c5ab2b3f Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 8 Feb 2017 14:54:28 -0700 Subject: [PATCH 11/46] Update some fates scalar parameter representations. The fates input file has two ways of indicating scalars, true scalars and 1-D arays with length 1. Inorder to check dimensions and compare code expectations vs what is on the file, we need to more clearly distinguish between these two ways or represeting scalars. Test suite: SMS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: a651a4f Test namelist changes: addition of fates_paramfile Test answer changes: bit for bit Test summary: pass --- .../src/ED/biogeochem/EDSharedParamsMod.F90 | 7 +-- components/clm/src/ED/main/EDParamsMod.F90 | 56 +++++++++---------- .../src/ED/main/FatesParametersInterface.F90 | 3 +- 3 files changed, 33 insertions(+), 33 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 index a6aaa26d9b..c3610b0553 100644 --- a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 @@ -52,7 +52,6 @@ subroutine RegisterParams(this, fates_params) ! that need to be synced with host values. use FatesParametersInterface, only : fates_parameters_type, param_string_length - use FatesParametersInterface, only : dimension_name_scalar, dimension_shape_scalar implicit none @@ -85,7 +84,7 @@ subroutine RegisterParamsScalar(this, fates_params) ! that need to be synced with host values. use FatesParametersInterface, only : fates_parameters_type, param_string_length - use FatesParametersInterface, only : dimension_name_allpfts, dimension_shape_scalar + use FatesParametersInterface, only : dimension_name_allpfts, dimension_shape_1d implicit none @@ -98,11 +97,11 @@ subroutine RegisterParamsScalar(this, fates_params) call this%Init() name = 'q10_mr' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_scalar, & + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, sync_with_host=.true.) name = 'froz_q10' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_scalar, & + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, sync_with_host=.true.) end subroutine RegisterParamsScalar diff --git a/components/clm/src/ED/main/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90 index 344cf91606..dc67ebd869 100644 --- a/components/clm/src/ED/main/EDParamsMod.F90 +++ b/components/clm/src/ED/main/EDParamsMod.F90 @@ -74,54 +74,54 @@ subroutine FatesRegisterParams(fates_params) ! indicate whether they are fates parameters or host parameters ! that need to be synced with host values. - use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_scalar + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar1d, dimension_shape_1d implicit none class(fates_parameters_type), intent(inout) :: fates_params - character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_scalar1d/) call FatesParamsInit() - call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_stress_mort, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_stress_mort, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_dispersal, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_dispersal, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_maxspread, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_maxspread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_minspread, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_minspread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_init_litter, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_init_litter, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_nfires, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_nfires, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_profile_tol, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_profile_tol, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) - call fates_params%RegisterParameter(name=ED_name_ag_biomass, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_ag_biomass, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) end subroutine FatesRegisterParams diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 index 60bae8eb57..cfebf64f7f 100644 --- a/components/clm/src/ED/main/FatesParametersInterface.F90 +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -22,7 +22,8 @@ module FatesParametersInterface ! parameters. Can't be done easily until this framework is being ! used to read variables. ! FIXME(bja, 2017-01) change 'param' to 'scalar'! - character(len=*), parameter, public :: dimension_name_scalar = 'param' + character(len=*), parameter, public :: dimension_name_scalar = '' + character(len=*), parameter, public :: dimension_name_scalar1d = 'param' character(len=*), parameter, public :: dimension_name_pft = 'pft' character(len=*), parameter, public :: dimension_name_segment = 'segment' character(len=*), parameter, public :: dimension_name_cwd = 'NCWD' From 435b3bcc8a9574aa7283a0768cc8ae145490772b Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 8 Feb 2017 15:06:16 -0700 Subject: [PATCH 12/46] Check fates parameter dimensions when reading from file. Automatically check the number of dimensions and their names when reading fates parameters from the file. Compare the data on file against what is expected by the code. Test suite: ed - yellowstone gnu, intel, pgi Test baseline: a651a4f Test namelist changes: add fates_paramfile Test answer changes: bit for bit Test summary: all tests pass --- .../src/ED/main/FatesParametersInterface.F90 | 4 +- components/clm/src/main/paramUtilMod.F90 | 160 ++++++++++++++++++ .../src/utils/clmfates_paraminterfaceMod.F90 | 5 +- 3 files changed, 166 insertions(+), 3 deletions(-) diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 index cfebf64f7f..5da9bd7eff 100644 --- a/components/clm/src/ED/main/FatesParametersInterface.F90 +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -315,7 +315,7 @@ subroutine SetDimensionSizes(this, is_host_file, num_used_dimensions, dimension_ end subroutine SetDimensionSizes !----------------------------------------------------------------------- - subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes, is_host_param) + subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes, dimension_names, is_host_param) implicit none @@ -324,11 +324,13 @@ subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes, is_h character(len=param_string_length), intent(out) :: name integer, intent(out) :: dimension_shape integer, intent(out) :: dimension_sizes(max_dimensions) + character(len=param_string_length), intent(out) :: dimension_names(max_dimensions) logical, intent(out) :: is_host_param name = this%parameters(index)%name dimension_shape = this%parameters(index)%dimension_shape dimension_sizes = this%parameters(index)%dimension_sizes + dimension_names = this%parameters(index)%dimension_names is_host_param = this%parameters(index)%sync_with_host end subroutine GetMetaData diff --git a/components/clm/src/main/paramUtilMod.F90 b/components/clm/src/main/paramUtilMod.F90 index 75a85e3e6c..96c95440e7 100644 --- a/components/clm/src/main/paramUtilMod.F90 +++ b/components/clm/src/main/paramUtilMod.F90 @@ -11,14 +11,22 @@ module paramUtilMod module procedure readNcdioScalar module procedure readNcdioArray1d module procedure readNcdioArray2d + module procedure readNcdioScalarCheckDimensions + module procedure readNcdioArray1dCheckDimensions + module procedure readNcdioArray2dCheckDimensions end interface public :: readNcdioScalar public :: readNcdioArray1d public :: readNcdioArray2d + public :: readNcdioScalarCheckDimensions + public :: readNcdioArray1dCheckDimensions + public :: readNcdioArray2dCheckDimensions public :: readNcdio + private :: checkDimensions + contains !----------------------------------------------------------------------- ! @@ -128,4 +136,156 @@ subroutine readNcdioArray2d(ncid, varName, callingName, retVal) end subroutine readNcdioArray2d !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioScalarCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioScalarCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray1dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal( 1: ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioArray1dCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray2dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal(1:, : ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioArray2dCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine checkDimensions(ncid, varName, expected_numDims, expected_dimNames, callingName) + ! + ! Assert that the expected number of dimensions and dimension + ! names for a variable match the actual names on the file. + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, var_desc_t, check_var, ncd_inqvdname, ncd_inqvdims + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims ! number of expected dimensions on the variable + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension names + character(len=*), intent(in) :: callingName ! calling routine + integer :: error_num + + ! local vars + character(len=32) :: subname = 'checkDimensions::' + type(Var_desc_t) :: var_desc ! variable descriptor + logical :: readvar ! whether the variable was found + character(len=100) :: received_dimName + integer :: d, num_dims + character(len=256) :: msg + + call check_var(ncid, varName, var_desc, readvar) + if (readvar) then + call ncd_inqvdims(ncid, num_dims, var_desc) + if (num_dims /= expected_numDims) then + write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: expected number of dimensions = ", & + expected_numDims, " num dimensions received from file = ", num_dims + call endrun(msg) + end if + do d = 1, num_dims + received_dimName = '' + call ncd_inqvdname(ncid, varname=trim(varName), dimnum=d, dname=received_dimName, err_code=error_num) + if (trim(expected_dimNames(d)) /= trim(received_dimName)) then + write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: dimension ", d, & + " expected dimension name '"//trim(expected_dimNames(d))//& + "' dimension name received from file '"//trim(received_dimName)//"'." + call endrun(msg) + end if + end do + end if + + end subroutine checkDimensions + !----------------------------------------------------------------------- + end module paramUtilMod diff --git a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 index 07fc107f06..0db35d1939 100644 --- a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 +++ b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 @@ -205,6 +205,7 @@ subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) real(r8), allocatable :: data(:, :) character(len=param_string_length) :: name integer :: dimension_sizes(max_dimensions) + character(len=param_string_length) :: dimension_names(max_dimensions) integer :: size_dim_1, size_dim_2 logical :: is_host_param @@ -217,7 +218,7 @@ subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) num_params = fates_params%num_params() do i = 1, num_params - call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, is_host_param) + call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, dimension_names, is_host_param) if (is_host_file .eqv. is_host_param) then select case(dimension_shape) case(dimension_shape_scalar) @@ -232,7 +233,7 @@ subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) case default call endrun(msg='unsupported number of dimensions reading parameters.') end select - call readNcdio(ncid, name, subname, data(1:size_dim_1, 1:size_dim_2)) + call readNcdio(ncid, name, dimension_shape, dimension_names, subname, data(1:size_dim_1, 1:size_dim_2)) call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) end if end do From 87cf419ece5bda06e2be2ef1a2e1cefb7bbb0be5 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 9 Feb 2017 16:13:19 -0700 Subject: [PATCH 13/46] Dynamic allocation of fates pft parameters. Dynamically allocate pft parameters based on the input data size from the parameter file instead of a hard coded dimension size.. Test suite: ed - yellowstone gnu, intel, pgi - hobart nag Test baseline: a651a4f Test namelist changes: add fates_paramfile Test answer changes: bit for bit Test summary: all tests pass. Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass. --- components/clm/src/ED/main/EDPftvarcon.F90 | 431 +++++++++--------- .../src/ED/main/FatesParametersInterface.F90 | 70 ++- 2 files changed, 286 insertions(+), 215 deletions(-) diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index c9f42e7b22..b5eb1ff96f 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -16,59 +16,62 @@ module EDPftvarcon save private + integer, parameter, public :: lower_bound_pft = 0 + integer, parameter, public :: lower_bound_general = 1 + !ED specific variables. type, public :: EDPftvarcon_type - real(r8) :: max_dbh (0:mxpft) ! maximum dbh at which height growth ceases... - real(r8) :: freezetol (0:mxpft) ! minimum temperature tolerance... - real(r8) :: wood_density (0:mxpft) ! wood density g cm^-3 ... - real(r8) :: alpha_stem (0:mxpft) ! live stem turnover rate. y-1 - real(r8) :: hgt_min (0:mxpft) ! sapling height m - real(r8) :: cushion (0:mxpft) ! labile carbon storage target as multiple of leaf pool. - real(r8) :: leaf_stor_priority (0:mxpft) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). - real(r8) :: leafwatermax (0:mxpft) ! degree to which respiration is limited by btran if btran = 0 - real(r8) :: rootresist (0:mxpft) - real(r8) :: soilbeta (0:mxpft) - real(r8) :: crown (0:mxpft) - real(r8) :: bark_scaler (0:mxpft) - real(r8) :: crown_kill (0:mxpft) - real(r8) :: initd (0:mxpft) - real(r8) :: sd_mort (0:mxpft) - real(r8) :: seed_rain (0:mxpft) - real(r8) :: BB_slope (0:mxpft) - real(r8) :: root_long (0:mxpft) ! root longevity (yrs) - real(r8) :: clone_alloc (0:mxpft) ! fraction of carbon balance allocated to clonal reproduction. - real(r8) :: seed_alloc (0:mxpft) ! fraction of carbon balance allocated to seeds. - real(r8) :: sapwood_ratio (0:mxpft) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m - real(r8) :: dbh2h_m (0:mxpft) ! allocation parameter m from dbh to height - real(r8) :: woody(0:mxpft) - real(r8) :: stress_decid(0:mxpft) - real(r8) :: season_decid(0:mxpft) - real(r8) :: evergreen(0:mxpft) - real(r8) :: froot_leaf(0:mxpft) - real(r8) :: slatop(0:mxpft) - real(r8) :: leaf_long(0:mxpft) - real(r8) :: rootprof_beta(0:mxpft,nvariants) - real(r8) :: roota_par(0:mxpft) - real(r8) :: rootb_par(0:mxpft) - real(r8) :: lf_flab(0:mxpft) - real(r8) :: lf_fcel(0:mxpft) - real(r8) :: lf_flig(0:mxpft) - real(r8) :: fr_flab(0:mxpft) - real(r8) :: fr_fcel(0:mxpft) - real(r8) :: fr_flig(0:mxpft) - real(r8) :: rhol(0:mxpft, numrad) - real(r8) :: rhos(0:mxpft, numrad) - real(r8) :: taul(0:mxpft, numrad) - real(r8) :: taus(0:mxpft, numrad) - real(r8) :: xl(0:mxpft) - real(r8) :: c3psn(0:mxpft) - real(r8) :: flnr(0:mxpft) - real(r8) :: fnitr(0:mxpft) - real(r8) :: leafcn(0:mxpft) - real(r8) :: frootcn(0:mxpft) - real(r8) :: smpso(0:mxpft) - real(r8) :: smpsc(0:mxpft) - real(r8) :: grperc(0:mxpft) ! NOTE(bja, 2017-01) moved from EDParamsMod, was allocated as (maxPft=79), not (0:mxpft=78)! + real(r8), allocatable :: max_dbh (:) ! maximum dbh at which height growth ceases... + real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance... + real(r8), allocatable :: wood_density (:) ! wood density g cm^-3 ... + real(r8), allocatable :: alpha_stem (:) ! live stem turnover rate. y-1 + real(r8), allocatable :: hgt_min (:) ! sapling height m + real(r8), allocatable :: cushion (:) ! labile carbon storage target as multiple of leaf pool. + real(r8), allocatable :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). + real(r8), allocatable :: leafwatermax (:) ! degree to which respiration is limited by btran if btran = 0 + real(r8), allocatable :: rootresist (:) + real(r8), allocatable :: soilbeta (:) + real(r8), allocatable :: crown (:) + real(r8), allocatable :: bark_scaler (:) + real(r8), allocatable :: crown_kill (:) + real(r8), allocatable :: initd (:) + real(r8), allocatable :: sd_mort (:) + real(r8), allocatable :: seed_rain (:) + real(r8), allocatable :: BB_slope (:) + real(r8), allocatable :: root_long (:) ! root longevity (yrs) + real(r8), allocatable :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. + real(r8), allocatable :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. + real(r8), allocatable :: sapwood_ratio (:) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m + real(r8), allocatable :: dbh2h_m (:) ! allocation parameter m from dbh to height + real(r8), allocatable :: woody(:) + real(r8), allocatable :: stress_decid(:) + real(r8), allocatable :: season_decid(:) + real(r8), allocatable :: evergreen(:) + real(r8), allocatable :: froot_leaf(:) + real(r8), allocatable :: slatop(:) + real(r8), allocatable :: leaf_long(:) + real(r8), allocatable :: roota_par(:) + real(r8), allocatable :: rootb_par(:) + real(r8), allocatable :: lf_flab(:) + real(r8), allocatable :: lf_fcel(:) + real(r8), allocatable :: lf_flig(:) + real(r8), allocatable :: fr_flab(:) + real(r8), allocatable :: fr_fcel(:) + real(r8), allocatable :: fr_flig(:) + real(r8), allocatable :: xl(:) + real(r8), allocatable :: c3psn(:) + real(r8), allocatable :: flnr(:) + real(r8), allocatable :: fnitr(:) + real(r8), allocatable :: leafcn(:) + real(r8), allocatable :: frootcn(:) + real(r8), allocatable :: smpso(:) + real(r8), allocatable :: smpsc(:) + real(r8), allocatable :: grperc(:) ! NOTE(bja, 2017-01) moved from EDParamsMod, was allocated as (maxPft=79), not (0:mxpft=78)! + real(r8), allocatable :: rhol(:, :) + real(r8), allocatable :: rhos(:, :) + real(r8), allocatable :: taul(:, :) + real(r8), allocatable :: taus(:, :) + real(r8), allocatable :: rootprof_beta(:, :) contains procedure, public :: Init => EDpftconInit procedure, public :: Register @@ -102,59 +105,6 @@ subroutine EDpftconInit(this) class(EDPftvarcon_type), intent(inout) :: this - this%max_dbh(:) = nan - this%freezetol(:) = nan - this%wood_density(:) = nan - this%alpha_stem(:) = nan - this%hgt_min(:) = nan - this%cushion(:) = nan - this%leaf_stor_priority(:) = nan - this%leafwatermax(:) = nan - this%rootresist(:) = nan - this%soilbeta(:) = nan - this%crown(:) = nan - this%bark_scaler(:) = nan - this%crown_kill(:) = nan - this%initd(:) = nan - this%sd_mort(:) = nan - this%seed_rain(:) = nan - this%BB_slope(:) = nan - this%root_long(:) = nan - this%clone_alloc(:) = nan - this%seed_alloc(:) = nan - this%sapwood_ratio(:) = nan - this%dbh2h_m(:) = nan - this%woody(:) = nan - this%stress_decid(:) = nan - this%season_decid(:) = nan - this%evergreen(:) = nan - this%froot_leaf(:) = nan - this%slatop(:) = nan - this%leaf_long(:) = nan - this%roota_par(:) = nan - this%rootb_par(:) = nan - this%lf_flab(:) = nan - this%lf_fcel(:) = nan - this%lf_flig(:) = nan - this%fr_flab(:) = nan - this%fr_fcel(:) = nan - this%fr_flig(:) = nan - this%xl(:) = nan - this%c3psn(:) = nan - this%flnr(:) = nan - this%fnitr(:) = nan - this%leafcn(:) = nan - this%frootcn(:) = nan - this%smpso(:) = nan - this%smpsc(:) = nan - this%grperc(:) = nan - - this%rootprof_beta(:, :) = nan - this%rhol(:, :) = nan - this%rhos(:, :) = nan - this%taul(:, :) = nan - this%taus(:, :) = nan - end subroutine EDpftconInit !----------------------------------------------------------------------- @@ -202,191 +152,193 @@ subroutine Register_PFT(this, fates_params) character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/) + integer, parameter :: dim_lower_bound(1) = (/ lower_bound_pft /) + character(len=param_string_length) :: name !X! name = '' !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - !X! dimension_names=dim_names) + !X! dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'max_dbh' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'freezetol' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'wood_density' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'alpha_stem' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'hgt_min' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'cushion' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'leaf_stor_priority' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'leafwatermax' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'rootresist' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'soilbeta' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'crown' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'bark_scaler' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'crown_kill' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'initd' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'sd_mort' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'seed_rain' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'BB_slope' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'root_long' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'clone_alloc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'seed_alloc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'sapwood_ratio' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'woody' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'stress_decid' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'season_decid' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'evergreen' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'froot_leaf' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'slatop' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'leaf_long' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'roota_par' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'rootb_par' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'lf_flab' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'lf_fcel' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'lf_flig' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'fr_flab' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'fr_fcel' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'fr_flig' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'xl' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'c3psn' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'flnr' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'fnitr' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'leafcn' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'frootcn' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'smpso' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'smpsc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'grperc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) end subroutine Register_PFT @@ -408,190 +360,193 @@ subroutine Receive_PFT(this, fates_params) !X! data=this%) name = 'max_dbh' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%max_dbh) name = 'freezetol' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%freezetol) name = 'wood_density' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%wood_density) name = 'alpha_stem' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%alpha_stem) name = 'hgt_min' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%hgt_min) name = 'cushion' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%cushion) name = 'leaf_stor_priority' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%leaf_stor_priority) name = 'leafwatermax' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%leafwatermax) name = 'rootresist' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%rootresist) name = 'soilbeta' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%soilbeta) name = 'crown' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%crown) name = 'bark_scaler' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%bark_scaler) name = 'crown_kill' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%crown_kill) name = 'initd' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%initd) name = 'sd_mort' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%sd_mort) name = 'seed_rain' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_rain) name = 'BB_slope' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%BB_slope) name = 'root_long' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%root_long) name = 'clone_alloc' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%clone_alloc) name = 'seed_alloc' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_alloc) name = 'sapwood_ratio' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%sapwood_ratio) name = 'woody' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%woody) name = 'stress_decid' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%stress_decid) name = 'season_decid' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%season_decid) name = 'evergreen' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%evergreen) name = 'froot_leaf' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%froot_leaf) name = 'slatop' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%slatop) name = 'leaf_long' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%leaf_long) name = 'roota_par' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%roota_par) name = 'rootb_par' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%rootb_par) name = 'lf_flab' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%lf_flab) name = 'lf_fcel' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%lf_fcel) name = 'lf_flig' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%lf_flig) name = 'fr_flab' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%fr_flab) name = 'fr_fcel' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%fr_fcel) name = 'fr_flig' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%fr_flig) name = 'xl' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%xl) name = 'c3psn' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%c3psn) name = 'flnr' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%flnr) name = 'fnitr' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%fnitr) name = 'leafcn' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%leafcn) name = 'frootcn' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%frootcn) name = 'smpso' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%smpso) name = 'smpsc' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%smpsc) name = 'grperc' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%grperc) end subroutine Receive_PFT !----------------------------------------------------------------------- subroutine Register_PFT_numrad(this, fates_params) - + ! NOTE(bja, 2017-02) these are 2-d parameters, but they are + ! currently stored in the parameter file as separate 1-d + ! arrays. We have to register the parameters as 1-d arrays as they + ! are on the parameter file. We store them as 2-d in the receive step. use FatesParametersInterface, only : fates_parameters_type, param_string_length use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d @@ -601,7 +556,7 @@ subroutine Register_PFT_numrad(this, fates_params) class(fates_parameters_type), intent(inout) :: fates_params character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/) - + integer, parameter :: dim_lower_bound(1) = (/ lower_bound_pft /) character(len=param_string_length) :: name !X! name = '' @@ -645,9 +600,15 @@ end subroutine Register_PFT_numrad !----------------------------------------------------------------------- subroutine Receive_PFT_numrad(this, fates_params) - + ! NOTE(bja, 2017-02) these are 2-d parameters, but they are + ! currently stored in the parameter file as separate 1-d arrays. + ! We can't allocate slices of arrays separately, so we have to + ! manually allocate the memory here, retreive into a dummy array, + ! and copy. All parameters in this subroutine are sized the same, + ! so we can reused the dummy array. If someone wants to cleanup + ! the input file, all this complexity can be removed. use FatesParametersInterface, only : fates_parameters_type - use FatesParametersInterface, only : param_string_length + use FatesParametersInterface, only : param_string_length, max_dimensions implicit none @@ -660,37 +621,86 @@ subroutine Receive_PFT_numrad(this, fates_params) !X! call fates_params%RetreiveParameter(name=name, & !X! data=this%) + integer :: index + integer :: dimension_shape + integer :: dimension_sizes(max_dimensions) + character(len=param_string_length) :: dimension_names(max_dimensions) + logical :: is_host_param + + integer :: lower_bound_1, upper_bound_1, lower_bound_2, upper_bound_2 + real(r8), allocatable :: dummy_data(:) + + ! Fetch metadata from a representative variable. All variables + ! called by this subroutine must be dimensioned the same way! + name = 'rholvis' + index = fates_params%FindIndex(name) + call fates_params%GetMetaData(index, name, dimension_shape, dimension_sizes, dimension_names, is_host_param) + lower_bound_1 = lower_bound_pft + upper_bound_1 = lower_bound_pft + dimension_sizes(1) - 1 + lower_bound_2 = lower_bound_general + upper_bound_2 = numrad + + allocate(dummy_data(lower_bound_1:upper_bound_1)) + + ! + ! received rhol data + ! + allocate(this%rhol(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + name = 'rholvis' call fates_params%RetreiveParameter(name=name, & - data=this%rhol(:,ivis)) + data=dummy_data) + this%rhol(lower_bound_1:upper_bound_1, ivis) = dummy_data name = 'rholnir' call fates_params%RetreiveParameter(name=name, & - data=this%rhol(:,inir)) + data=dummy_data) + this%rhol(lower_bound_1:upper_bound_1, inir) = dummy_data + ! + ! received rhos data + ! + allocate(this%rhos(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + name = 'rhosvis' call fates_params%RetreiveParameter(name=name, & - data=this%rhos(:,ivis)) + data=dummy_data) + this%rhos(lower_bound_1:upper_bound_1, ivis) = dummy_data name = 'rhosnir' call fates_params%RetreiveParameter(name=name, & - data=this%rhos(:,inir)) + data=dummy_data) + this%rhos(lower_bound_1:upper_bound_1, inir) = dummy_data + ! + ! received taul data + ! + allocate(this%taul(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + name = 'taulvis' call fates_params%RetreiveParameter(name=name, & - data=this%taul(:,ivis)) + data=dummy_data) + this%taul(lower_bound_1:upper_bound_1, ivis) = dummy_data name = 'taulnir' call fates_params%RetreiveParameter(name=name, & - data=this%taul(:,inir)) + data=dummy_data) + this%taul(lower_bound_1:upper_bound_1, inir) = dummy_data + ! + ! received taus data + ! + allocate(this%taus(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + name = 'tausvis' call fates_params%RetreiveParameter(name=name, & - data=this%taus(:,ivis)) + data=dummy_data) + this%taus(lower_bound_1:upper_bound_1, ivis) = dummy_data name = 'tausnir' call fates_params%RetreiveParameter(name=name, & - data=this%taus(:,inir)) + data=dummy_data) + this%taus(lower_bound_1:upper_bound_1, inir) = dummy_data end subroutine Receive_PFT_numrad @@ -705,11 +715,12 @@ subroutine Register_PFT_nvariants(this, fates_params) class(EDPftvarcon_type), intent(inout) :: this class(fates_parameters_type), intent(inout) :: fates_params + integer, parameter :: dim_lower_bound(2) = (/ lower_bound_pft, lower_bound_general /) character(len=param_string_length) :: dim_names(2) character(len=param_string_length) :: name ! NOTE(bja, 2017-01) initialization doesn't seem to work correctly - ! if dim_names has a paramater qualifier. + ! if dim_names has a parameter qualifier. dim_names(1) = dimension_name_pft dim_names(2) = dimension_name_variants @@ -719,7 +730,7 @@ subroutine Register_PFT_nvariants(this, fates_params) name = 'rootprof_beta' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & - dimension_names=dim_names) + dimension_names=dim_names, lower_bounds=dim_lower_bound) end subroutine Register_PFT_nvariants @@ -741,7 +752,7 @@ subroutine Receive_PFT_nvariants(this, fates_params) !X! data=this%) name = 'rootprof_beta' - call fates_params%RetreiveParameter(name=name, & + call fates_params%RetreiveParameterAllocate(name=name, & data=this%rootprof_beta) end subroutine Receive_PFT_nvariants diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 index 5da9bd7eff..9daef59a93 100644 --- a/components/clm/src/ED/main/FatesParametersInterface.F90 +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -12,6 +12,8 @@ module FatesParametersInterface integer, parameter, public :: max_dimensions = 2 integer, parameter, public :: max_used_dimensions = 25 integer, parameter, public :: param_string_length = 40 + ! NOTE(bja, 2017-02) these are the values returned from netcdf after + ! inquiring about the number of dimensions integer, parameter, public :: dimension_shape_scalar = 0 integer, parameter, public :: dimension_shape_1d = 1 integer, parameter, public :: dimension_shape_2d = 2 @@ -38,6 +40,7 @@ module FatesParametersInterface integer :: dimension_shape integer :: dimension_sizes(max_dimensions) character(len=param_string_length) :: dimension_names(max_dimensions) + integer :: dimension_lower_bound(max_dimensions) real(r8), allocatable :: data(:, :) end type parameter_type @@ -50,20 +53,23 @@ module FatesParametersInterface procedure, public :: Destroy procedure, public :: RegisterParameter generic, public :: RetreiveParameter => RetreiveParameterScalar, RetreiveParameter1D, RetreiveParameter2D + generic, public :: RetreiveParameterAllocate => RetreiveParameter1DAllocate, RetreiveParameter2DAllocate generic, public :: SetData => SetDataScalar, SetData1D, SetData2D procedure, public :: GetUsedDimensions procedure, public :: SetDimensionSizes procedure, public :: GetMaxDimensionSize procedure, public :: GetMetaData procedure, public :: num_params + procedure, public :: FindIndex procedure, private :: RetreiveParameterScalar procedure, private :: RetreiveParameter1D procedure, private :: RetreiveParameter2D + procedure, private :: RetreiveParameter1DAllocate + procedure, private :: RetreiveParameter2DAllocate procedure, private :: SetDataScalar procedure, private :: SetData1D procedure, private :: SetData2D - procedure, private :: FindIndex end type fates_parameters_type @@ -95,8 +101,9 @@ subroutine Destroy(this) end subroutine Destroy !----------------------------------------------------------------------- - subroutine RegisterParameter(this, name, dimension_shape, dimension_names, sync_with_host) - + subroutine RegisterParameter(this, name, dimension_shape, dimension_names, & + sync_with_host, lower_bounds) + implicit none class(fates_parameters_type), intent(inout) :: this @@ -104,8 +111,9 @@ subroutine RegisterParameter(this, name, dimension_shape, dimension_names, sync_ integer, intent(in) :: dimension_shape character(len=param_string_length) :: dimension_names(1:) logical, intent(in), optional :: sync_with_host + integer, intent(in), optional :: lower_bounds(1:) - integer :: i, n, num_names + integer :: i, n, num_names, num_bounds this%num_parameters = this%num_parameters + 1 i = this%num_parameters @@ -123,7 +131,15 @@ subroutine RegisterParameter(this, name, dimension_shape, dimension_names, sync_ if (present(sync_with_host)) then this%parameters(i)%sync_with_host = sync_with_host end if - + ! allocate as a standard 1-based array unless otherwise specified + ! by the caller. + this%parameters(i)%dimension_lower_bound = (/ 1, 1 /) + if (present(lower_bounds)) then + num_bounds = min(max_dimensions, size(lower_bounds, 1)) + do n = 1, num_bounds + this%parameters(i)%dimension_lower_bound(n) = lower_bounds(n) + end do + endif end subroutine RegisterParameter !----------------------------------------------------------------------- @@ -205,6 +221,50 @@ subroutine RetreiveParameter2D(this, name, data) end subroutine RetreiveParameter2D + !----------------------------------------------------------------------- + subroutine RetreiveParameter1DAllocate(this, name, data) + + use abortutils, only : endrun + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out), allocatable :: data(:) + + integer :: i, lower_bound, upper_bound + + i = this%FindIndex(name) + lower_bound = this%parameters(i)%dimension_lower_bound(1) + upper_bound = lower_bound + this%parameters(i)%dimension_sizes(1) - 1 + allocate(data(lower_bound:upper_bound)) + data(lower_bound:upper_bound) = this%parameters(i)%data(:, 1) + + end subroutine RetreiveParameter1DAllocate + + !----------------------------------------------------------------------- + subroutine RetreiveParameter2DAllocate(this, name, data) + + use abortutils, only : endrun + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out), allocatable :: data(:, :) + + integer :: i, lb_1, ub_1, lb_2, ub_2 + + i = this%FindIndex(name) + lb_1 = this%parameters(i)%dimension_lower_bound(1) + ub_1 = lb_1 + this%parameters(i)%dimension_sizes(1) - 1 + lb_2 = this%parameters(i)%dimension_lower_bound(2) + ub_2 = lb_2 + this%parameters(i)%dimension_sizes(2) - 1 + allocate(data(lb_1:ub_1, lb_2:ub_2)) + data(lb_1:ub_1, lb_2:ub_2) = this%parameters(i)%data + + end subroutine RetreiveParameter2DAllocate + !----------------------------------------------------------------------- function FindIndex(this, name) result(i) From 509fafa32655ecc93a27947a879a95e1370bcf7e Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Fri, 10 Feb 2017 13:12:07 -0700 Subject: [PATCH 14/46] Apply fates_ namespace to fates parameters. Fates parameters and dimensions have are now namespaced with 'fates_' in the input parameter file. This allows fates and clm to share an input file without name collisions. Update to new default parameter file with proper namespace. User interface changes?: yes, all fates input via the netcdf input parameter file must be namespaced with 'fates_' for both parameter and dimension names. Test suite: ed - yellowstone gnu, intel, pgi - hobart nag Test baseline: a651a4f Test namelist changes: yes, add fates_paramfile Test answer changes: bit for bit Test summary: all tests pass Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass --- .../namelist_defaults_clm4_5.xml | 2 +- .../src/ED/biogeochem/EDSharedParamsMod.F90 | 4 +- components/clm/src/ED/fire/SFParamsMod.F90 | 42 ++-- components/clm/src/ED/main/EDParamsMod.F90 | 22 +- components/clm/src/ED/main/EDPftvarcon.F90 | 218 +++++++++--------- .../src/ED/main/FatesParametersInterface.F90 | 26 +-- 6 files changed, 156 insertions(+), 158 deletions(-) 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 e843003601..8268d26dba 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -243,7 +243,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/paramdata/clm5_params.c160713.nc lnd/clm2/paramdata/clm_params.c160713.nc -lnd/clm2/paramdata/clm_params_ed.c170112.nc +lnd/clm2/paramdata/fates_params.c170209.nc diff --git a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 index c3610b0553..fb0f6c6c63 100644 --- a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 @@ -84,14 +84,14 @@ subroutine RegisterParamsScalar(this, fates_params) ! that need to be synced with host values. use FatesParametersInterface, only : fates_parameters_type, param_string_length - use FatesParametersInterface, only : dimension_name_allpfts, dimension_shape_1d + use FatesParametersInterface, only : dimension_name_host_allpfts, dimension_shape_1d implicit none class(EDParamsShareType), intent(inout) :: this class(fates_parameters_type), intent(inout) :: fates_params - character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_allpfts/) + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_host_allpfts/) character(len=param_string_length) :: name call this%Init() diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 index 2f2de2eb81..0677a9f79e 100644 --- a/components/clm/src/ED/fire/SFParamsMod.F90 +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -39,27 +39,27 @@ module SFParamsMod real(r8),protected :: SF_val_mid_moisture_C(NFSC) real(r8),protected :: SF_val_mid_moisture_S(NFSC) - character(len=param_string_length),parameter :: SF_name_fdi_a = "fdi_a" - character(len=param_string_length),parameter :: SF_name_fdi_b = "fdi_b" - character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fdi_alpha" - character(len=param_string_length),parameter :: SF_name_miner_total = "miner_total" - character(len=param_string_length),parameter :: SF_name_fuel_energy = "fuel_energy" - character(len=param_string_length),parameter :: SF_name_part_dens = "part_dens" - character(len=param_string_length),parameter :: SF_name_miner_damp = "miner_damp" - character(len=param_string_length),parameter :: SF_name_max_durat = "max_durat" - character(len=param_string_length),parameter :: SF_name_durat_slope = "durat_slope" - character(len=param_string_length),parameter :: SF_name_alpha_SH = "alpha_SH" - character(len=param_string_length),parameter :: SF_name_alpha_FMC = "alpha_FMC" - character(len=param_string_length),parameter :: SF_name_CWD_frac = "CWD_frac" - character(len=param_string_length),parameter :: SF_name_max_decomp = "max_decomp" - character(len=param_string_length),parameter :: SF_name_SAV = "SAV" - character(len=param_string_length),parameter :: SF_name_FBD = "FBD" - character(len=param_string_length),parameter :: SF_name_min_moisture = "min_moisture" - character(len=param_string_length),parameter :: SF_name_mid_moisture = "mid_moisture" - character(len=param_string_length),parameter :: SF_name_low_moisture_C = "low_moisture_C" - character(len=param_string_length),parameter :: SF_name_low_moisture_S = "low_moisture_S" - character(len=param_string_length),parameter :: SF_name_mid_moisture_C = "mid_moisture_C" - character(len=param_string_length),parameter :: SF_name_mid_moisture_S = "mid_moisture_S" + character(len=param_string_length),parameter :: SF_name_fdi_a = "fates_fdi_a" + character(len=param_string_length),parameter :: SF_name_fdi_b = "fates_fdi_b" + character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fates_fdi_alpha" + character(len=param_string_length),parameter :: SF_name_miner_total = "fates_miner_total" + character(len=param_string_length),parameter :: SF_name_fuel_energy = "fates_fuel_energy" + character(len=param_string_length),parameter :: SF_name_part_dens = "fates_part_dens" + character(len=param_string_length),parameter :: SF_name_miner_damp = "fates_miner_damp" + character(len=param_string_length),parameter :: SF_name_max_durat = "fates_max_durat" + character(len=param_string_length),parameter :: SF_name_durat_slope = "fates_durat_slope" + character(len=param_string_length),parameter :: SF_name_alpha_SH = "fates_alpha_SH" + character(len=param_string_length),parameter :: SF_name_alpha_FMC = "fates_alpha_FMC" + character(len=param_string_length),parameter :: SF_name_CWD_frac = "fates_CWD_frac" + character(len=param_string_length),parameter :: SF_name_max_decomp = "fates_max_decomp" + character(len=param_string_length),parameter :: SF_name_SAV = "fates_SAV" + character(len=param_string_length),parameter :: SF_name_FBD = "fates_FBD" + character(len=param_string_length),parameter :: SF_name_min_moisture = "fates_min_moisture" + character(len=param_string_length),parameter :: SF_name_mid_moisture = "fates_mid_moisture" + character(len=param_string_length),parameter :: SF_name_low_moisture_C = "fates_low_moisture_C" + character(len=param_string_length),parameter :: SF_name_low_moisture_S = "fates_low_moisture_S" + character(len=param_string_length),parameter :: SF_name_mid_moisture_C = "fates_mid_moisture_C" + character(len=param_string_length),parameter :: SF_name_mid_moisture_S = "fates_mid_moisture_S" public :: SpitFireRegisterParams public :: SpitFireReceiveParams diff --git a/components/clm/src/ED/main/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90 index dc67ebd869..eda22e0b2e 100644 --- a/components/clm/src/ED/main/EDParamsMod.F90 +++ b/components/clm/src/ED/main/EDParamsMod.F90 @@ -27,17 +27,17 @@ module EDParamsMod real(r8),protected :: ED_val_profile_tol real(r8),protected :: ED_val_ag_biomass - character(len=param_string_length),parameter :: ED_name_grass_spread = "grass_spread" - character(len=param_string_length),parameter :: ED_name_comp_excln = "comp_excln" - character(len=param_string_length),parameter :: ED_name_stress_mort = "stress_mort" - character(len=param_string_length),parameter :: ED_name_dispersal = "dispersal" - character(len=param_string_length),parameter :: ED_name_maxspread = "maxspread" - character(len=param_string_length),parameter :: ED_name_minspread = "minspread" - character(len=param_string_length),parameter :: ED_name_init_litter = "init_litter" - character(len=param_string_length),parameter :: ED_name_nfires = "nfires" - character(len=param_string_length),parameter :: ED_name_understorey_death = "understorey_death" - character(len=param_string_length),parameter :: ED_name_profile_tol = "profile_tol" - character(len=param_string_length),parameter :: ED_name_ag_biomass= "ag_biomass" + character(len=param_string_length),parameter :: ED_name_grass_spread = "fates_grass_spread" + character(len=param_string_length),parameter :: ED_name_comp_excln = "fates_comp_excln" + character(len=param_string_length),parameter :: ED_name_stress_mort = "fates_stress_mort" + character(len=param_string_length),parameter :: ED_name_dispersal = "fates_dispersal" + character(len=param_string_length),parameter :: ED_name_maxspread = "fates_maxspread" + character(len=param_string_length),parameter :: ED_name_minspread = "fates_minspread" + character(len=param_string_length),parameter :: ED_name_init_litter = "fates_init_litter" + character(len=param_string_length),parameter :: ED_name_nfires = "fates_nfires" + character(len=param_string_length),parameter :: ED_name_understorey_death = "fates_understorey_death" + character(len=param_string_length),parameter :: ED_name_profile_tol = "fates_profile_tol" + character(len=param_string_length),parameter :: ED_name_ag_biomass= "fates_ag_biomass" public :: FatesParamsInit public :: FatesRegisterParams diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index b5eb1ff96f..ea53b660cf 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -160,183 +160,183 @@ subroutine Register_PFT(this, fates_params) !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & !X! dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'max_dbh' + name = 'fates_max_dbh' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'freezetol' + name = 'fates_freezetol' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'wood_density' + name = 'fates_wood_density' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'alpha_stem' + name = 'fates_alpha_stem' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'hgt_min' + name = 'fates_hgt_min' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'cushion' + name = 'fates_cushion' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'leaf_stor_priority' + name = 'fates_leaf_stor_priority' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'leafwatermax' + name = 'fates_leafwatermax' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'rootresist' + name = 'fates_rootresist' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'soilbeta' + name = 'fates_soilbeta' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'crown' + name = 'fates_crown' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'bark_scaler' + name = 'fates_bark_scaler' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'crown_kill' + name = 'fates_crown_kill' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'initd' + name = 'fates_initd' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'sd_mort' + name = 'fates_sd_mort' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'seed_rain' + name = 'fates_seed_rain' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'BB_slope' + name = 'fates_BB_slope' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'root_long' + name = 'fates_root_long' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'clone_alloc' + name = 'fates_clone_alloc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'seed_alloc' + name = 'fates_seed_alloc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'sapwood_ratio' + name = 'fates_sapwood_ratio' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'woody' + name = 'fates_woody' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'stress_decid' + name = 'fates_stress_decid' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'season_decid' + name = 'fates_season_decid' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'evergreen' + name = 'fates_evergreen' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'froot_leaf' + name = 'fates_froot_leaf' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'slatop' + name = 'fates_slatop' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'leaf_long' + name = 'fates_leaf_long' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'roota_par' + name = 'fates_roota_par' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'rootb_par' + name = 'fates_rootb_par' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'lf_flab' + name = 'fates_lf_flab' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'lf_fcel' + name = 'fates_lf_fcel' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'lf_flig' + name = 'fates_lf_flig' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fr_flab' + name = 'fates_fr_flab' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fr_fcel' + name = 'fates_fr_fcel' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fr_flig' + name = 'fates_fr_flig' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'xl' + name = 'fates_xl' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'c3psn' + name = 'fates_c3psn' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'flnr' + name = 'fates_flnr' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fnitr' + name = 'fates_fnitr' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'leafcn' + name = 'fates_leafcn' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'frootcn' + name = 'fates_frootcn' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'smpso' + name = 'fates_smpso' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'smpsc' + name = 'fates_smpsc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'grperc' + name = 'fates_grperc' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -359,183 +359,183 @@ subroutine Receive_PFT(this, fates_params) !X! call fates_params%RetreiveParameter(name=name, & !X! data=this%) - name = 'max_dbh' + name = 'fates_max_dbh' call fates_params%RetreiveParameterAllocate(name=name, & data=this%max_dbh) - name = 'freezetol' + name = 'fates_freezetol' call fates_params%RetreiveParameterAllocate(name=name, & data=this%freezetol) - name = 'wood_density' + name = 'fates_wood_density' call fates_params%RetreiveParameterAllocate(name=name, & data=this%wood_density) - name = 'alpha_stem' + name = 'fates_alpha_stem' call fates_params%RetreiveParameterAllocate(name=name, & data=this%alpha_stem) - name = 'hgt_min' + name = 'fates_hgt_min' call fates_params%RetreiveParameterAllocate(name=name, & data=this%hgt_min) - name = 'cushion' + name = 'fates_cushion' call fates_params%RetreiveParameterAllocate(name=name, & data=this%cushion) - name = 'leaf_stor_priority' + name = 'fates_leaf_stor_priority' call fates_params%RetreiveParameterAllocate(name=name, & data=this%leaf_stor_priority) - name = 'leafwatermax' + name = 'fates_leafwatermax' call fates_params%RetreiveParameterAllocate(name=name, & data=this%leafwatermax) - name = 'rootresist' + name = 'fates_rootresist' call fates_params%RetreiveParameterAllocate(name=name, & data=this%rootresist) - name = 'soilbeta' + name = 'fates_soilbeta' call fates_params%RetreiveParameterAllocate(name=name, & data=this%soilbeta) - name = 'crown' + name = 'fates_crown' call fates_params%RetreiveParameterAllocate(name=name, & data=this%crown) - name = 'bark_scaler' + name = 'fates_bark_scaler' call fates_params%RetreiveParameterAllocate(name=name, & data=this%bark_scaler) - name = 'crown_kill' + name = 'fates_crown_kill' call fates_params%RetreiveParameterAllocate(name=name, & data=this%crown_kill) - name = 'initd' + name = 'fates_initd' call fates_params%RetreiveParameterAllocate(name=name, & data=this%initd) - name = 'sd_mort' + name = 'fates_sd_mort' call fates_params%RetreiveParameterAllocate(name=name, & data=this%sd_mort) - name = 'seed_rain' + name = 'fates_seed_rain' call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_rain) - name = 'BB_slope' + name = 'fates_BB_slope' call fates_params%RetreiveParameterAllocate(name=name, & data=this%BB_slope) - name = 'root_long' + name = 'fates_root_long' call fates_params%RetreiveParameterAllocate(name=name, & data=this%root_long) - name = 'clone_alloc' + name = 'fates_clone_alloc' call fates_params%RetreiveParameterAllocate(name=name, & data=this%clone_alloc) - name = 'seed_alloc' + name = 'fates_seed_alloc' call fates_params%RetreiveParameterAllocate(name=name, & data=this%seed_alloc) - name = 'sapwood_ratio' + name = 'fates_sapwood_ratio' call fates_params%RetreiveParameterAllocate(name=name, & data=this%sapwood_ratio) - name = 'woody' + name = 'fates_woody' call fates_params%RetreiveParameterAllocate(name=name, & data=this%woody) - name = 'stress_decid' + name = 'fates_stress_decid' call fates_params%RetreiveParameterAllocate(name=name, & data=this%stress_decid) - name = 'season_decid' + name = 'fates_season_decid' call fates_params%RetreiveParameterAllocate(name=name, & data=this%season_decid) - name = 'evergreen' + name = 'fates_evergreen' call fates_params%RetreiveParameterAllocate(name=name, & data=this%evergreen) - name = 'froot_leaf' + name = 'fates_froot_leaf' call fates_params%RetreiveParameterAllocate(name=name, & data=this%froot_leaf) - name = 'slatop' + name = 'fates_slatop' call fates_params%RetreiveParameterAllocate(name=name, & data=this%slatop) - name = 'leaf_long' + name = 'fates_leaf_long' call fates_params%RetreiveParameterAllocate(name=name, & data=this%leaf_long) - name = 'roota_par' + name = 'fates_roota_par' call fates_params%RetreiveParameterAllocate(name=name, & data=this%roota_par) - name = 'rootb_par' + name = 'fates_rootb_par' call fates_params%RetreiveParameterAllocate(name=name, & data=this%rootb_par) - name = 'lf_flab' + name = 'fates_lf_flab' call fates_params%RetreiveParameterAllocate(name=name, & data=this%lf_flab) - name = 'lf_fcel' + name = 'fates_lf_fcel' call fates_params%RetreiveParameterAllocate(name=name, & data=this%lf_fcel) - name = 'lf_flig' + name = 'fates_lf_flig' call fates_params%RetreiveParameterAllocate(name=name, & data=this%lf_flig) - name = 'fr_flab' + name = 'fates_fr_flab' call fates_params%RetreiveParameterAllocate(name=name, & data=this%fr_flab) - name = 'fr_fcel' + name = 'fates_fr_fcel' call fates_params%RetreiveParameterAllocate(name=name, & data=this%fr_fcel) - name = 'fr_flig' + name = 'fates_fr_flig' call fates_params%RetreiveParameterAllocate(name=name, & data=this%fr_flig) - name = 'xl' + name = 'fates_xl' call fates_params%RetreiveParameterAllocate(name=name, & data=this%xl) - name = 'c3psn' + name = 'fates_c3psn' call fates_params%RetreiveParameterAllocate(name=name, & data=this%c3psn) - name = 'flnr' + name = 'fates_flnr' call fates_params%RetreiveParameterAllocate(name=name, & data=this%flnr) - name = 'fnitr' + name = 'fates_fnitr' call fates_params%RetreiveParameterAllocate(name=name, & data=this%fnitr) - name = 'leafcn' + name = 'fates_leafcn' call fates_params%RetreiveParameterAllocate(name=name, & data=this%leafcn) - name = 'frootcn' + name = 'fates_frootcn' call fates_params%RetreiveParameterAllocate(name=name, & data=this%frootcn) - name = 'smpso' + name = 'fates_smpso' call fates_params%RetreiveParameterAllocate(name=name, & data=this%smpso) - name = 'smpsc' + name = 'fates_smpsc' call fates_params%RetreiveParameterAllocate(name=name, & data=this%smpsc) - name = 'grperc' + name = 'fates_grperc' call fates_params%RetreiveParameterAllocate(name=name, & data=this%grperc) @@ -563,35 +563,35 @@ subroutine Register_PFT_numrad(this, fates_params) !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & !X! dimension_names=dim_names) - name = 'rholvis' + name = 'fates_rholvis' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - name = 'rholnir' + name = 'fates_rholnir' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - name = 'rhosvis' + name = 'fates_rhosvis' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - name = 'rhosnir' + name = 'fates_rhosnir' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - name = 'taulvis' + name = 'fates_taulvis' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - name = 'taulnir' + name = 'fates_taulnir' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - name = 'tausvis' + name = 'fates_tausvis' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) - name = 'tausnir' + name = 'fates_tausnir' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) @@ -632,7 +632,7 @@ subroutine Receive_PFT_numrad(this, fates_params) ! Fetch metadata from a representative variable. All variables ! called by this subroutine must be dimensioned the same way! - name = 'rholvis' + name = 'fates_rholvis' index = fates_params%FindIndex(name) call fates_params%GetMetaData(index, name, dimension_shape, dimension_sizes, dimension_names, is_host_param) lower_bound_1 = lower_bound_pft @@ -647,12 +647,12 @@ subroutine Receive_PFT_numrad(this, fates_params) ! allocate(this%rhol(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) - name = 'rholvis' + name = 'fates_rholvis' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%rhol(lower_bound_1:upper_bound_1, ivis) = dummy_data - name = 'rholnir' + name = 'fates_rholnir' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%rhol(lower_bound_1:upper_bound_1, inir) = dummy_data @@ -662,12 +662,12 @@ subroutine Receive_PFT_numrad(this, fates_params) ! allocate(this%rhos(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) - name = 'rhosvis' + name = 'fates_rhosvis' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%rhos(lower_bound_1:upper_bound_1, ivis) = dummy_data - name = 'rhosnir' + name = 'fates_rhosnir' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%rhos(lower_bound_1:upper_bound_1, inir) = dummy_data @@ -677,12 +677,12 @@ subroutine Receive_PFT_numrad(this, fates_params) ! allocate(this%taul(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) - name = 'taulvis' + name = 'fates_taulvis' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%taul(lower_bound_1:upper_bound_1, ivis) = dummy_data - name = 'taulnir' + name = 'fates_taulnir' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%taul(lower_bound_1:upper_bound_1, inir) = dummy_data @@ -692,12 +692,12 @@ subroutine Receive_PFT_numrad(this, fates_params) ! allocate(this%taus(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) - name = 'tausvis' + name = 'fates_tausvis' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%taus(lower_bound_1:upper_bound_1, ivis) = dummy_data - name = 'tausnir' + name = 'fates_tausnir' call fates_params%RetreiveParameter(name=name, & data=dummy_data) this%taus(lower_bound_1:upper_bound_1, inir) = dummy_data @@ -728,7 +728,7 @@ subroutine Register_PFT_nvariants(this, fates_params) !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & !X! dimension_names=dim_names) - name = 'rootprof_beta' + name = 'fates_rootprof_beta' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -751,7 +751,7 @@ subroutine Receive_PFT_nvariants(this, fates_params) !X! call fates_params%RetreiveParameter(name=name, & !X! data=this%) - name = 'rootprof_beta' + name = 'fates_rootprof_beta' call fates_params%RetreiveParameterAllocate(name=name, & data=this%rootprof_beta) diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 index 9daef59a93..007dd78d71 100644 --- a/components/clm/src/ED/main/FatesParametersInterface.F90 +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -18,21 +18,19 @@ module FatesParametersInterface integer, parameter, public :: dimension_shape_1d = 1 integer, parameter, public :: dimension_shape_2d = 2 - ! FIXME(bja, 2017-01) these strings need to be changed to 'fates_' - ! to namespace dimonsions and prevent name collisions if someone - ! wants to write a single netcdf file containing host and fates - ! parameters. Can't be done easily until this framework is being - ! used to read variables. - ! FIXME(bja, 2017-01) change 'param' to 'scalar'! + ! Dimensions in the fates namespace: character(len=*), parameter, public :: dimension_name_scalar = '' - character(len=*), parameter, public :: dimension_name_scalar1d = 'param' - character(len=*), parameter, public :: dimension_name_pft = 'pft' - character(len=*), parameter, public :: dimension_name_segment = 'segment' - character(len=*), parameter, public :: dimension_name_cwd = 'NCWD' - character(len=*), parameter, public :: dimension_name_lsc = 'litterclass' - character(len=*), parameter, public :: dimension_name_fsc = 'litterclass' - character(len=*), parameter, public :: dimension_name_allpfts = 'allpfts' - character(len=*), parameter, public :: dimension_name_variants = 'variants' + character(len=*), parameter, public :: dimension_name_scalar1d = 'fates_scalar' + character(len=*), parameter, public :: dimension_name_pft = 'fates_pft' + character(len=*), parameter, public :: dimension_name_segment = 'fates_segment' + character(len=*), parameter, public :: dimension_name_cwd = 'fates_NCWD' + character(len=*), parameter, public :: dimension_name_lsc = 'fates_litterclass' + character(len=*), parameter, public :: dimension_name_fsc = 'fates_litterclass' + character(len=*), parameter, public :: dimension_name_allpfts = 'fates_allpfts' + character(len=*), parameter, public :: dimension_name_variants = 'fates_variants' + + ! Dimensions in the host namespace: + character(len=*), parameter, public :: dimension_name_host_allpfts = 'allpfts' type, private :: parameter_type character(len=param_string_length) :: name From db6b32d3fcae29342803ec3e18d1c5af9b8bbb05 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 22 Feb 2017 13:46:24 -0700 Subject: [PATCH 15/46] Dead code removal of edpftconrd EDpftconrd was commented out in a previous commit, but it is no longer needed and should have been completely removed. Test suite: ed - yellowstone gnu, intel, pgi Test baseline: ed-clm-3f3f16f Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass --- components/clm/src/ED/main/EDPftvarcon.F90 | 190 ------------------ .../src/utils/clmfates_paraminterfaceMod.F90 | 10 +- 2 files changed, 1 insertion(+), 199 deletions(-) diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index ea53b660cf..b60586c8c1 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -90,7 +90,6 @@ module EDPftvarcon __FILE__ ! ! !PUBLIC MEMBER FUNCTIONS: - public :: EDpftconrd ! Read and initialize vegetation (PFT) constants !----------------------------------------------------------------------- @@ -757,194 +756,5 @@ subroutine Receive_PFT_nvariants(this, fates_params) end subroutine Receive_PFT_nvariants - !----------------------------------------------------------------------- - subroutine EDpftconrd( ncid ) - ! - ! !DESCRIPTION: - ! Read and initialize vegetation (PFT) constants - ! - ! !USES: - use ncdio_pio , only : file_desc_t, ncd_io - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - ! - ! !ARGUMENTS: - implicit none - ! - type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id - - ! !LOCAL VARIABLES: - - logical :: readv ! read variable in or not - character(len=32) :: subname = 'EDpftconrd' ! subroutine name - - !X! call ncd_io('max_dbh',EDPftvarcon_inst%max_dbh, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - - !X! call ncd_io('freezetol',EDPftvarcon_inst%freezetol, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('wood_density',EDPftvarcon_inst%wood_density, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('alpha_stem',EDPftvarcon_inst%alpha_stem, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('hgt_min',EDPftvarcon_inst%hgt_min, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('cushion',EDPftvarcon_inst%cushion, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('leaf_stor_priority',EDPftvarcon_inst%leaf_stor_priority, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('leafwatermax',EDPftvarcon_inst%leafwatermax, 'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('rootresist',EDPftvarcon_inst%rootresist,'read', ncid, readvar=readv) - !X! if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) - !X! - !X! call ncd_io('soilbeta',EDPftvarcon_inst%soilbeta,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('crown',EDPftvarcon_inst%crown,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('bark_scaler',EDPftvarcon_inst%bark_scaler,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('crown_kill',EDPftvarcon_inst%crown_kill,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('initd',EDPftvarcon_inst%initd,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('sd_mort',EDPftvarcon_inst%sd_mort,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('seed_rain',EDPftvarcon_inst%seed_rain,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('BB_slope',EDPftvarcon_inst%BB_slope,'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('root_long',EDPftvarcon_inst%root_long, 'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('seed_alloc',EDPftvarcon_inst%seed_alloc, 'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('clone_alloc',EDPftvarcon_inst%clone_alloc, 'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('sapwood_ratio',EDPftvarcon_inst%sapwood_ratio, 'read', ncid, readvar=readv) - !X! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - !X! - !X! call ncd_io('woody', EDPftvarcon_inst%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('stress_decid', EDPftvarcon_inst%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('season_decid', EDPftvarcon_inst%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('evergreen', EDPftvarcon_inst%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('froot_leaf', EDPftvarcon_inst%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('slatop', EDPftvarcon_inst%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('leaf_long', EDPftvarcon_inst%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - - !X! call ncd_io('rootprof_beta', EDPftvarcon_inst%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - - !X! call ncd_io('roota_par', EDPftvarcon_inst%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('rootb_par', EDPftvarcon_inst%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('lf_flab', EDPftvarcon_inst%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('lf_fcel', EDPftvarcon_inst%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('lf_flig', EDPftvarcon_inst%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('fr_flab', EDPftvarcon_inst%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('fr_fcel', EDPftvarcon_inst%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('fr_flig', EDPftvarcon_inst%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - - !X! call ncd_io('rholvis', EDPftvarcon_inst%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('rholnir', EDPftvarcon_inst%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('rhosvis', EDPftvarcon_inst%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('rhosnir', EDPftvarcon_inst% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('taulvis', EDPftvarcon_inst%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('taulnir', EDPftvarcon_inst%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('tausvis', EDPftvarcon_inst%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('tausnir', EDPftvarcon_inst%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - - !X! call ncd_io('xl', EDPftvarcon_inst%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('c3psn', EDPftvarcon_inst%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('flnr', EDPftvarcon_inst%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('fnitr', EDPftvarcon_inst%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('leafcn', EDPftvarcon_inst%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('frootcn', EDPftvarcon_inst%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('smpso', EDPftvarcon_inst%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('smpsc', EDPftvarcon_inst%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - !X! - !X! call ncd_io('grperc', EDPftvarcon_inst%grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !X! if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - - ! HOLDING ON SEW ENSITIVITY-ANALYSIS PARAMETERS UNTIL MACHINE CONFIGS SET RGK/CX - ! call ncd_io('dbh2h_m',EDPftvarcon_inst%dbh2h_m, 'read', ncid, readvar=readv) - ! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - - end subroutine EDpftconrd - end module EDPftvarcon diff --git a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 index 0db35d1939..847a96da1e 100644 --- a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 +++ b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 @@ -74,7 +74,7 @@ subroutine FatesReadPFTs() use spmdMod, only : masterproc use FatesParametersInterface, only : fates_parameters_type - use EDPftvarcon , only : EDpftconrd, EDPftvarcon_inst + use EDPftvarcon , only : EDPftvarcon_inst use fileutils , only : getfil use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile @@ -97,16 +97,8 @@ subroutine FatesReadPFTs() call fates_params%Init() call EDPftvarcon_inst%Init() - ! FIXME(bja, 2017-01) old style read for some parameters, remove - ! when all pfts are read with new infrastructure. - !X! call getfil (fates_paramfile, locfn, 0) - !X! call ncd_pio_openfile (ncid, trim(locfn), 0) - !X! call EDpftconrd ( ncid ) - !X! call ncd_pio_closefile(ncid) - call EDPftvarcon_inst%Register(fates_params) - is_host_file = .false. call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) From 85f37e3603d52b72a861ae60c5415b45e084f048 Mon Sep 17 00:00:00 2001 From: ckoven Date: Sat, 4 Mar 2017 14:22:11 -0800 Subject: [PATCH 16/46] new dimensions for fuel and cwd, with new vars and code cleanup --- components/clm/src/ED/fire/SFMainMod.F90 | 17 +-- components/clm/src/ED/fire/SFParamsMod.F90 | 6 +- components/clm/src/ED/main/EDTypesMod.F90 | 24 +++- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 117 +++++++++++++++++- .../src/ED/main/FatesHistoryVariableType.F90 | 14 +++ .../clm/src/ED/main/FatesIODimensionsMod.F90 | 12 ++ .../src/ED/main/FatesIOVariableKindMod.F90 | 2 + components/clm/src/main/histFileMod.F90 | 14 +++ .../clm/src/utils/clmfates_interfaceMod.F90 | 26 ++++ 9 files changed, 210 insertions(+), 22 deletions(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index b6ff07c79a..e562f0098d 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -23,6 +23,7 @@ module SFMainMod use EDtypesMod , only : LB_SF use EDtypesMod , only : LG_SF use EDtypesMod , only : NCWD + use EDtypesMod , only : NFSC use EDtypesMod , only : TR_SF implicit none @@ -152,8 +153,8 @@ subroutine charecteristics_of_fuel ( currentSite ) type(ed_cohort_type), pointer :: currentCohort real(r8) timeav_swc - real(r8) fuel_moisture(ncwd+2) ! Scaled moisture content of small litter fuels. - real(r8) MEF(ncwd+2) ! Moisture extinction factor of fuels integer n + real(r8) fuel_moisture(nfsc) ! Scaled moisture content of small litter fuels. + real(r8) MEF(nfsc) ! Moisture extinction factor of fuels integer n fuel_moisture(:) = 0.0_r8 @@ -210,7 +211,7 @@ subroutine charecteristics_of_fuel ( currentSite ) endif currentPatch%fuel_frac(lg_sf) = currentPatch%livegrass / currentPatch%sum_fuel - MEF(1:ncwd+2) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:ncwd+2)) + MEF(1:nfsc) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:nfsc)) !Equation 6 in Thonicke et al. 2010. fuel_moisture(dg_sf+1:tr_sf) = exp(-1.0_r8 * SF_val_alpha_FMC(dg_sf+1:tr_sf) * currentSite%acc_NI) @@ -264,7 +265,7 @@ subroutine charecteristics_of_fuel ( currentSite ) sum(currentPatch%cwd_bg),sum(currentPatch%leaf_litter) endif - currentPatch%fuel_sav = sum(SF_val_SAV(1:ncwd+2))/(ncwd+2) ! make average sav to avoid crashing code. + currentPatch%fuel_sav = sum(SF_val_SAV(1:nfsc))/(nfsc) ! make average sav to avoid crashing code. if ( cp_masterproc == 1 ) write(fates_log(),*) 'problem with spitfire fuel averaging' @@ -508,8 +509,8 @@ subroutine ground_fuel_consumption ( currentSite ) type(ed_patch_type), pointer :: currentPatch real(r8) :: moist !effective fuel moisture - real(r8) :: tau_b(ncwd+2) !lethal heating rates for each fuel class (min) - real(r8) :: fc_ground(ncwd+2) !propn of fuel consumed + real(r8) :: tau_b(nfsc) !lethal heating rates for each fuel class (min) + real(r8) :: fc_ground(nfsc) !propn of fuel consumed integer :: c @@ -519,7 +520,7 @@ subroutine ground_fuel_consumption ( currentSite ) currentPatch%burnt_frac_litter = 1.0_r8 ! Calculate fraction of litter is burnt for all classes. ! Equation B1 in Thonicke et al. 2010--- - do c = 1, ncwd+2 !work out the burnt fraction for all pools, even if those pools dont exist. + do c = 1, nfsc !work out the burnt fraction for all pools, even if those pools dont exist. moist = currentPatch%litter_moisture(c) ! 1. Very dry litter if (moist <= SF_val_min_moisture(c)) then @@ -560,7 +561,7 @@ subroutine ground_fuel_consumption ( currentSite ) ! taul is the duration of the lethal heating. ! The /10 is to convert from kgC/m2 into gC/cm2, as in the Peterson and Ryan paper #Rosie,Jun 2013 - do c = 1,ncwd+2 + do c = 1,nfsc tau_b(c) = 39.4_r8 *(currentPatch%fuel_frac(c)*currentPatch%sum_fuel/0.45_r8/10._r8)* & (1.0_r8-((1.0_r8-currentPatch%burnt_frac_litter(c))**0.5_r8)) enddo diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 index 3caa526a01..4e3a6a429b 100644 --- a/components/clm/src/ED/fire/SFParamsMod.F90 +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -3,7 +3,7 @@ module SFParamsMod ! module that deals with reading the SF parameter file ! use shr_kind_mod , only: r8 => shr_kind_r8 - use EDtypesMod , only: NLSC,NFSC,NCWD + use EDtypesMod , only: NFSC,NCWD implicit none save @@ -23,9 +23,9 @@ module SFParamsMod real(r8),protected :: SF_val_max_durat real(r8),protected :: SF_val_durat_slope real(r8),protected :: SF_val_alpha_SH - real(r8),protected :: SF_val_alpha_FMC(NLSC) + real(r8),protected :: SF_val_alpha_FMC(NFSC) real(r8),protected :: SF_val_CWD_frac(NCWD) - real(r8),protected :: SF_val_max_decomp(NLSC) + real(r8),protected :: SF_val_max_decomp(NFSC) real(r8),protected :: SF_val_SAV(NFSC) real(r8),protected :: SF_val_FBD(NFSC) real(r8),protected :: SF_val_min_moisture(NFSC) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 326126a5b3..b28d68c982 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -45,10 +45,8 @@ module EDTypesMod ! SPITFIRE - integer , parameter :: NLSC = 6 ! number carbon compartments in above ground litter array - integer , parameter :: NFSC = 6 ! number fuel size classes - integer , parameter :: N_EF = 7 ! number of emission factors. One per trace gas or aerosol species. integer, parameter :: NCWD = 4 ! number of coarse woody debris pools + integer , parameter :: NFSC = NCWD+2 ! number fuel size classes (really this is a mix of cwd size classes, leaf litter, and grass types) integer, parameter :: lg_sf = 6 ! array index of live grass pool for spitfire integer, parameter :: dg_sf = 1 ! array index of dead grass pool for spitfire integer, parameter :: tr_sf = 5 ! array index of dead trunk pool for spitfire @@ -114,6 +112,8 @@ module EDTypesMod integer , allocatable :: scls_levscpf_ed(:) real(r8), allocatable :: levage_ed(:) integer , allocatable :: levpft_ed(:) + integer , allocatable :: levfuel_ed(:) + integer , allocatable :: levcwdsc_ed(:) ! Control Parameters (cp_) @@ -442,7 +442,7 @@ module EDTypesMod !FUEL CHARECTERISTICS real(r8) :: sum_fuel ! total ground fuel related to ros (omits 1000hr fuels): KgC/m2 - real(r8) :: fuel_frac(ncwd+2) ! fraction of each litter class in the ros_fuel:-. + real(r8) :: fuel_frac(nfsc) ! fraction of each litter class in the ros_fuel:-. real(r8) :: livegrass ! total aboveground grass biomass in patch. KgC/m2 real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel ! (incl. live grasses. omits 1000hr fuels). KgC/m3 @@ -452,7 +452,7 @@ module EDTypesMod ! of the ground fuel (incl. live grasses. omits 1000hr fuels). real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel ! (incl. live grasses. omits 1000hr fuels) - real(r8) :: litter_moisture(ncwd+2) + real(r8) :: litter_moisture(nfsc) ! FIRE SPREAD real(r8) :: ros_front ! rate of forward spread of fire: m/min @@ -598,11 +598,15 @@ subroutine ed_hist_scpfmaps integer :: i integer :: isc integer :: ipft + integer :: icwd + integer :: ifuel allocate( levsclass_ed(1:nlevsclass_ed )) allocate( pft_levscpf_ed(1:nlevsclass_ed*mxpft)) allocate(scls_levscpf_ed(1:nlevsclass_ed*mxpft)) allocate( levpft_ed(1:mxpft )) + allocate( levfuel_ed(1:NFSC )) + allocate( levcwdsc_ed(1:NCWD )) allocate( levage_ed(1:nlevage_ed )) ! Fill the IO array of plant size classes @@ -617,6 +621,16 @@ subroutine ed_hist_scpfmaps levpft_ed(ipft) = ipft end do + ! make fuel array + do ifuel=1,NFSC + levfuel_ed(ifuel) = ifuel + end do + + ! make cwd array + do icwd=1,NCWD + levcwdsc_ed(icwd) = icwd + end do + ! Fill the IO arrays that match pft and size class to their combined array i=0 do ipft=1,mxpft diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 4892de2d6b..077244f83c 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -216,9 +216,16 @@ module FatesHistoryInterfaceMod integer, private :: ih_ncl_si_age integer, private :: ih_npatches_si_age + ! indices to (site x fuel class) variables + integer, private :: ih_litter_moisture_si_fuel + + ! indices to (site x cwd size class) variables + integer, private :: ih_cwd_ag_si_cwdsc + integer, private :: ih_cwd_bg_si_cwdsc + ! The number of variable dim/kind types we have defined (static) - integer, parameter :: fates_history_num_dimensions = 7 - integer, parameter :: fates_history_num_dim_kinds = 9 + integer, parameter :: fates_history_num_dimensions = 9 + integer, parameter :: fates_history_num_dim_kinds = 11 @@ -253,6 +260,7 @@ module FatesHistoryInterfaceMod integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ integer, private :: levscls_index_, levpft_index_, levage_index_ + integer, private :: levfuel_index_, levcwdsc_index_ contains procedure, public :: Init @@ -273,6 +281,8 @@ module FatesHistoryInterfaceMod procedure, public :: levscls_index procedure, public :: levpft_index procedure, public :: levage_index + procedure, public :: levfuel_index + procedure, public :: levcwdsc_index ! private work functions procedure, private :: define_history_vars @@ -288,6 +298,8 @@ module FatesHistoryInterfaceMod procedure, private :: set_levscls_index procedure, private :: set_levpft_index procedure, private :: set_levage_index + procedure, private :: set_levfuel_index + procedure, private :: set_levcwdsc_index end type fates_history_interface_type @@ -301,6 +313,7 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf use FatesIODimensionsMod, only : levscls, levpft, levage + use FatesIODimensionsMod, only : levfuel, levcwdsc use FatesIODimensionsMod, only : fates_bounds_type implicit none @@ -345,6 +358,17 @@ subroutine Init(this, num_threads, fates_bounds) call this%set_levage_index(dim_count) call this%dim_bounds(dim_count)%Init(levage, num_threads, & fates_bounds%age_class_begin, fates_bounds%age_class_end) + + dim_count = dim_count + 1 + call this%set_levfuel_index(dim_count) + call this%dim_bounds(dim_count)%Init(levfuel, num_threads, & + fates_bounds%fuel_begin, fates_bounds%fuel_end) + + dim_count = dim_count + 1 + call this%set_levcwdsc_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcwdsc, num_threads, & + fates_bounds%cwdsc_begin, fates_bounds%cwdsc_end) + ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) ! Allocate the mapping between FATES indices and the IO indices @@ -394,6 +418,14 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%age_class_begin, thread_bounds%age_class_end) + index = this%levfuel_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%fuel_begin, thread_bounds%fuel_end) + + index = this%levcwdsc_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cwdsc_begin, thread_bounds%cwdsc_end) + end subroutine SetThreadBoundsEach ! =================================================================================== @@ -402,6 +434,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 implicit none @@ -434,6 +467,12 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_age_r8, 1, this%column_index()) call this%set_dim_indices(site_age_r8, 2, this%levage_index()) + call this%set_dim_indices(site_fuel_r8, 1, this%column_index()) + call this%set_dim_indices(site_fuel_r8, 2, this%levfuel_index()) + + call this%set_dim_indices(site_cwdsc_r8, 1, this%column_index()) + call this%set_dim_indices(site_cwdsc_r8, 2, this%levcwdsc_index()) + end subroutine assemble_history_output_types ! =================================================================================== @@ -575,6 +614,34 @@ integer function levage_index(this) levage_index = this%levage_index_ end function levage_index + ! ======================================================================= + subroutine set_levfuel_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levfuel_index_ = index + end subroutine set_levfuel_index + + integer function levfuel_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levfuel_index = this%levfuel_index_ + end function levfuel_index + + ! ======================================================================= + subroutine set_levcwdsc_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcwdsc_index_ = index + end subroutine set_levcwdsc_index + + integer function levcwdsc_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcwdsc_index = this%levcwdsc_index_ + end function levcwdsc_index + ! ====================================================================================== subroutine flush_hvars(this,nc,upfreq_in) @@ -669,6 +736,7 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 implicit none @@ -710,10 +778,18 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_pft_r8, 2) - ! site x patch-age clase + ! site x patch-age class index = index + 1 call this%dim_kinds(index)%Init(site_age_r8, 2) + ! site x fuel size class + index = index + 1 + call this%dim_kinds(index)%Init(site_fuel_r8, 2) + + ! site x cwd size class class + index = index + 1 + call this%dim_kinds(index)%Init(site_cwdsc_r8, 2) + ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps @@ -791,7 +867,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) levage_ed, & nlevage_ed, & mxpft, & - levpft_ed + levpft_ed, & + nfsc, & + ncwd use EDParamsMod , only : ED_val_ag_biomass ! Arguments @@ -811,6 +889,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index integer :: i_scpf,i_pft,i_scls ! iterators for scpf, pft, and scls dims + integer :: i_cwd,i_fuel ! iterators for cwd and fuel dims real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column @@ -940,7 +1019,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & hio_ncl_si_age => this%hvars(ih_ncl_si_age)%r82d, & - hio_npatches_si_age => this%hvars(ih_npatches_si_age)%r82d) + hio_npatches_si_age => this%hvars(ih_npatches_si_age)%r82d, & + hio_litter_moisture_si_fuel => this%hvars(ih_litter_moisture_si_fuel)%r82d, & + hio_cwd_ag_si_cwdsc => this%hvars(ih_cwd_ag_si_cwdsc)%r82d, & + hio_cwd_bg_si_cwdsc => this%hvars(ih_cwd_bg_si_cwdsc)%r82d) ! --------------------------------------------------------------------------------- @@ -1263,6 +1345,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_fire_fuel_mef_pa(io_pa) = cpatch%fuel_mef hio_sum_fuel_pa(io_pa) = cpatch%sum_fuel * 1.e3_r8 * patch_scaling_scalar + do i_fuel = 1,nfsc + hio_litter_moisture_si_fuel(io_si, i_fuel) = cpatch%litter_moisture(i_fuel) * cpatch%area/AREA + end do + ! Update Litter Flux Variables hio_litter_in_pa(io_pa) = (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in)) & * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar @@ -1279,7 +1365,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_spread_pa(io_pa) = cpatch%spread(1) - + do i_cwd = 1, ncwd + hio_cwd_ag_si_cwdsc(io_si, i_cwd) = cpatch%CWD_AG_out(i_cwd)*cpatch%area/AREA * 1e3 + hio_cwd_bg_si_cwdsc(io_si, i_cwd) = cpatch%CWD_BG_out(i_cwd)*cpatch%area/AREA * 1e3 + end do + ipa = ipa + 1 cpatch => cpatch%younger end do !patch loop @@ -1656,6 +1746,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1818,6 +1909,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_sum_fuel_pa ) + call this%set_history_var(vname='FUEL_MOISTURE_NFSC', units='-', & + long='spitfire size-resolved fuel moisture', use_default='active', & + avgflag='A', vtype=site_fuel_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_moisture_si_fuel ) + ! Litter Variables call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & @@ -2143,6 +2239,15 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scpf ) + call this%set_history_var(vname='CWD_AG_CWDSC', units='gC/m^2', & + long='size-resolved AG CWD stocks', use_default='active', & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_si_cwdsc ) + + call this%set_history_var(vname='CWD_BG_CWDSC', units='gC/m^2', & + long='size-resolved BG CWD stocks', use_default='active', & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_si_cwdsc ) ! Size structured diagnostics that require rapid updates (upfreq=2) diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 index 20abd41f89..f6b2011d44 100644 --- a/components/clm/src/ED/main/FatesHistoryVariableType.F90 +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -46,6 +46,7 @@ subroutine Init(this, vname, units, long, use_default, & use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 use FatesIOVariableKindMod, only : iotype_index implicit none @@ -131,6 +132,14 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_fuel_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_cwdsc_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' @@ -197,6 +206,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 implicit none @@ -228,6 +238,10 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_age_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_fuel_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_cwdsc_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) case default diff --git a/components/clm/src/ED/main/FatesIODimensionsMod.F90 b/components/clm/src/ED/main/FatesIODimensionsMod.F90 index 83b2475aad..a14a013476 100644 --- a/components/clm/src/ED/main/FatesIODimensionsMod.F90 +++ b/components/clm/src/ED/main/FatesIODimensionsMod.F90 @@ -12,6 +12,8 @@ module FatesIODimensionsMod character(*), parameter :: levscls = 'levscls' character(*), parameter :: levpft = 'levpft' character(*), parameter :: levage = 'levage' + character(*), parameter :: levfuel = 'levfuel' + character(*), parameter :: levcwdsc = 'levcwdsc' ! patch = This is a structure that records where FATES patch boundaries ! on each thread point to in the host IO array, this structure @@ -36,6 +38,12 @@ module FatesIODimensionsMod ! levage = This is a structure that records the boundaries for the ! number of patch-age-class dimension + ! levfuel = This is a structure that records the boundaries for the + ! number of fuel-size-class dimension + + ! levcwdsc = This is a structure that records the boundaries for the + ! number of coarse-woody-debris-size-class dimension + type, public :: fates_bounds_type integer :: patch_begin @@ -54,6 +62,10 @@ module FatesIODimensionsMod integer :: pft_class_end integer :: age_class_begin integer :: age_class_end + integer :: fuel_begin + integer :: fuel_end + integer :: cwdsc_begin + integer :: cwdsc_end end type fates_bounds_type diff --git a/components/clm/src/ED/main/FatesIOVariableKindMod.F90 b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 index 2c8eb98216..71d1ab9865 100644 --- a/components/clm/src/ED/main/FatesIOVariableKindMod.F90 +++ b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 @@ -22,6 +22,8 @@ module FatesIOVariableKindMod character(*), parameter :: cohort_int = 'CO_INT' character(*), parameter :: site_pft_r8 = 'SI_PFT_R8' character(*), parameter :: site_age_r8 = 'SI_AGE_R8' + character(*), parameter :: site_fuel_r8 = 'SI_FUEL_R8' + character(*), parameter :: site_cwdsc_r8 = 'SI_CWDSC_R8' ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index d4b7f1e679..30c0e804cf 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -22,6 +22,7 @@ module histFileMod use PatchType , only : patch use ncdio_pio use EDtypesMod , only : nlevsclass_ed, nlevage_ed + use EDtypesMod , only : nfsc, ncwd use clm_varpar , only : mxpft ! implicit none @@ -1852,6 +1853,8 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'levscls', nlevsclass_ed, dimid) call ncd_defdim(lnfid, 'levpft', mxpft, dimid) call ncd_defdim(lnfid, 'levage', nlevage_ed, dimid) + call ncd_defdim(lnfid, 'levfuel', nfsc, dimid) + call ncd_defdim(lnfid, 'levcwdsc', ncwd, dimid) call ncd_defdim(lnfid, 'levscpf', nlevsclass_ed*mxpft, dimid) end if @@ -2269,6 +2272,7 @@ subroutine htape_timeconst(t, mode) use clm_time_manager, only : get_ref_date, get_calendar, NO_LEAP_C, GREGORIAN_C use EDTypesMod, only : levsclass_ed, pft_levscpf_ed, scls_levscpf_ed use EDTypesMod, only : levage_ed, levpft_ed + use EDTypesMod, only : levfuel_ed, levcwdsc_ed ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index @@ -2330,6 +2334,10 @@ subroutine htape_timeconst(t, mode) long_name='FATES patch age (yr)', ncid=nfid(t)) call ncd_defvar(varname='levpft',xtype=ncd_int, dim1name='levpft', & long_name='FATES pft number', ncid=nfid(t)) + call ncd_defvar(varname='levfuel',xtype=ncd_int, dim1name='levfuel', & + long_name='FATES fuel index', ncid=nfid(t)) + call ncd_defvar(varname='levcwdsc',xtype=ncd_int, dim1name='levcwdsc', & + long_name='FATES cwd size class', ncid=nfid(t)) end if elseif (mode == 'write') then @@ -2348,6 +2356,8 @@ subroutine htape_timeconst(t, mode) call ncd_io(varname='scls_levscpf',data=scls_levscpf_ed, ncid=nfid(t), flag='write') call ncd_io(varname='levage',data=levage_ed, ncid=nfid(t), flag='write') call ncd_io(varname='levpft',data=levpft_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='levfuel',data=levfuel_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='levcwdsc',data=levcwdsc_ed, ncid=nfid(t), flag='write') end if endif @@ -4453,6 +4463,10 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, num2d = mxpft case ('levage') num2d = nlevage_ed + case ('levfuel') + num2d = nfsc + case ('levcwdsc') + num2d = ncwd case ('levscpf') num2d = nlevsclass_ed*mxpft case('ltype') diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 77f9667e74..75438ef1f0 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1637,6 +1637,7 @@ subroutine init_history_io(this,bounds_proc) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 use FatesIODimensionsMod, only : fates_bounds_type @@ -1825,6 +1826,24 @@ subroutine init_history_io(this,bounds_proc) ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) + case(site_fuel_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name + call hist_addfld2d(fname=trim(vname),units=trim(vunits), & + type2d=trim(dim2name), & + avgflag=trim(vavgflag),long_name=trim(vlong), & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & + default=trim(vdefault), & + set_lake=0._r8,set_urb=0._r8) + case(site_cwdsc_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name + call hist_addfld2d(fname=trim(vname),units=trim(vunits), & + type2d=trim(dim2name), & + avgflag=trim(vavgflag),long_name=trim(vlong), & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & + default=trim(vdefault), & + set_lake=0._r8,set_urb=0._r8) case default write(iulog,*) 'A FATES iotype was created that was not registerred' @@ -1840,6 +1859,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) use FatesIODimensionsMod, only : fates_bounds_type use EDtypesMod, only : nlevsclass_ed, nlevage_ed + use EDtypesMod, only : nfsc, ncwd use clm_varpar, only : mxpft, nlevgrnd implicit none @@ -1871,6 +1891,12 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%age_class_begin = 1 fates%age_class_end = nlevage_ed + fates%fuel_begin = 1 + fates%fuel_end = nfsc + + fates%cwdsc_begin = 1 + fates%cwdsc_end = ncwd + end subroutine hlm_bounds_to_fates_bounds end module CLMFatesInterfaceMod From 768dffe4d05f16f3197c44428ebf9b25df6019b0 Mon Sep 17 00:00:00 2001 From: ckoven Date: Sat, 4 Mar 2017 22:27:17 -0800 Subject: [PATCH 17/46] first attempt to put in canopy, canopy*leaf, & canopy*leaf*pft dimensions --- components/clm/src/ED/main/EDTypesMod.F90 | 41 +++++++ .../src/ED/main/FatesHistoryInterfaceMod.F90 | 112 +++++++++++++++++- .../src/ED/main/FatesHistoryVariableType.F90 | 20 ++++ .../clm/src/ED/main/FatesIODimensionsMod.F90 | 18 +++ .../src/ED/main/FatesIOVariableKindMod.F90 | 4 +- components/clm/src/main/histFileMod.F90 | 31 +++++ .../clm/src/utils/clmfates_interfaceMod.F90 | 38 ++++++ 7 files changed, 260 insertions(+), 4 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index b28d68c982..ee30de4278 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -114,6 +114,12 @@ module EDTypesMod integer , allocatable :: levpft_ed(:) integer , allocatable :: levfuel_ed(:) integer , allocatable :: levcwdsc_ed(:) + integer , allocatable :: levcan_ed(:) + integer , allocatable :: can_levcnlf_ed(:) + integer , allocatable :: lf_levcnlf_ed(:) + integer , allocatable :: can_levcnlfpft_ed(:) + integer , allocatable :: lf_levcnlfpft_ed(:) + integer , allocatable :: pft_levcnlfpft_ed(:) ! Control Parameters (cp_) @@ -600,6 +606,8 @@ subroutine ed_hist_scpfmaps integer :: ipft integer :: icwd integer :: ifuel + integer :: ican + integer :: ileaf allocate( levsclass_ed(1:nlevsclass_ed )) allocate( pft_levscpf_ed(1:nlevsclass_ed*mxpft)) @@ -609,6 +617,13 @@ subroutine ed_hist_scpfmaps allocate( levcwdsc_ed(1:NCWD )) allocate( levage_ed(1:nlevage_ed )) + allocate(levcan_ed(cp_nlevcan)) + allocate(can_levcnlf_ed(cp_nlevcan*cp_nclmax)) + allocate(lf_levcnlf_ed(cp_nlevcan*cp_nclmax)) + allocate(can_levcnlfpft_ed(cp_nlevcan*cp_nclmax*numpft_ed)) + allocate(lf_levcnlfpft_ed(cp_nlevcan*cp_nclmax*numpft_ed)) + allocate(pft_levcnlfpft_ed(cp_nlevcan*cp_nclmax*numpft_ed)) + ! Fill the IO array of plant size classes ! For some reason the history files did not like ! a hard allocation of sclass_ed @@ -631,6 +646,11 @@ subroutine ed_hist_scpfmaps levcwdsc_ed(icwd) = icwd end do + ! make canopy array + do ican = 1,cp_nlevcan + levcan_ed(ican) = ican + end do + ! Fill the IO arrays that match pft and size class to their combined array i=0 do ipft=1,mxpft @@ -641,6 +661,27 @@ subroutine ed_hist_scpfmaps end do end do + i=0 + do ican=1,cp_nlevcan + do ileaf=1,cp_nclmax + i=i+1 + can_levcnlf_ed(i) = ican + lf_levcnlf_ed(i) = ileaf + end do + end do + + i=0 + do ican=1,cp_nlevcan + do ileaf=1,cp_nclmax + do ipft=1,numpft_ed + i=i+1 + can_levcnlfpft_ed(i) = ican + lf_levcnlfpft_ed(i) = ileaf + pft_levcnlfpft_ed(i) = ipft + end do + end do + end do + end subroutine ed_hist_scpfmaps !-------------------------------------------------------------------------------------! diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 077244f83c..e53d4e9b63 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -223,9 +223,15 @@ module FatesHistoryInterfaceMod integer, private :: ih_cwd_ag_si_cwdsc integer, private :: ih_cwd_bg_si_cwdsc + ! indices to (site x [canopy layer x leaf layer]) variables + + ! indices to (site x [canopy layer x leaf layer x pft]) variables + + ! indices to (site x canopy layer) variables + ! The number of variable dim/kind types we have defined (static) - integer, parameter :: fates_history_num_dimensions = 9 - integer, parameter :: fates_history_num_dim_kinds = 11 + integer, parameter :: fates_history_num_dimensions = 12 + integer, parameter :: fates_history_num_dim_kinds = 14 @@ -261,6 +267,7 @@ module FatesHistoryInterfaceMod integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ integer, private :: levscls_index_, levpft_index_, levage_index_ integer, private :: levfuel_index_, levcwdsc_index_ + integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_ contains procedure, public :: Init @@ -283,6 +290,9 @@ module FatesHistoryInterfaceMod procedure, public :: levage_index procedure, public :: levfuel_index procedure, public :: levcwdsc_index + procedure, public :: levcan_index + procedure, public :: levcnlf_index + procedure, public :: levcnlfpft_index ! private work functions procedure, private :: define_history_vars @@ -300,6 +310,9 @@ module FatesHistoryInterfaceMod procedure, private :: set_levage_index procedure, private :: set_levfuel_index procedure, private :: set_levcwdsc_index + procedure, private :: set_levcan_index + procedure, private :: set_levcnlf_index + procedure, private :: set_levcnlfpft_index end type fates_history_interface_type @@ -314,6 +327,7 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf use FatesIODimensionsMod, only : levscls, levpft, levage use FatesIODimensionsMod, only : levfuel, levcwdsc + use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft use FatesIODimensionsMod, only : fates_bounds_type implicit none @@ -369,6 +383,21 @@ subroutine Init(this, num_threads, fates_bounds) call this%dim_bounds(dim_count)%Init(levcwdsc, num_threads, & fates_bounds%cwdsc_begin, fates_bounds%cwdsc_end) + dim_count = dim_count + 1 + call this%set_levcan_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcan, num_threads, & + fates_bounds%can_begin, fates_bounds%can_end) + + dim_count = dim_count + 1 + call this%set_levcnlf_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcnlf, num_threads, & + fates_bounds%cnlf_begin, fates_bounds%cnlf_end) + + dim_count = dim_count + 1 + call this%set_levcnlfpft_index(dim_count) + call this%dim_bounds(dim_count)%Init(levcnlfpft, num_threads, & + fates_bounds%cnlfpft_begin, fates_bounds%cnlfpft_end) + ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) ! Allocate the mapping between FATES indices and the IO indices @@ -426,6 +455,18 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%cwdsc_begin, thread_bounds%cwdsc_end) + index = this%levcan_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%can_begin, thread_bounds%can_end) + + index = this%levcnlf_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cnlf_begin, thread_bounds%cnlf_end) + + index = this%levcnlfpft_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cnlfpft_begin, thread_bounds%cnlfpft_end) + end subroutine SetThreadBoundsEach ! =================================================================================== @@ -435,6 +476,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none @@ -473,6 +515,15 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_cwdsc_r8, 1, this%column_index()) call this%set_dim_indices(site_cwdsc_r8, 2, this%levcwdsc_index()) + call this%set_dim_indices(site_can_r8, 1, this%column_index()) + call this%set_dim_indices(site_can_r8, 2, this%levcan_index()) + + call this%set_dim_indices(site_cnlf_r8, 1, this%column_index()) + call this%set_dim_indices(site_cnlf_r8, 2, this%levcnlf_index()) + + call this%set_dim_indices(site_cnlfpft_r8, 1, this%column_index()) + call this%set_dim_indices(site_cnlfpft_r8, 2, this%levcnlfpft_index()) + end subroutine assemble_history_output_types ! =================================================================================== @@ -642,6 +693,47 @@ integer function levcwdsc_index(this) levcwdsc_index = this%levcwdsc_index_ end function levcwdsc_index + ! ======================================================================= + subroutine set_levcan_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcan_index_ = index + end subroutine set_levcan_index + + integer function levcan_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcan_index = this%levcan_index_ + end function levcan_index + + ! ======================================================================= + subroutine set_levcnlf_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcnlf_index_ = index + end subroutine set_levcnlf_index + + integer function levcnlf_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcnlf_index = this%levcnlf_index_ + end function levcnlf_index + + ! ======================================================================= + subroutine set_levcnlfpft_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levcnlfpft_index_ = index + end subroutine set_levcnlfpft_index + + integer function levcnlfpft_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levcnlfpft_index = this%levcnlfpft_index_ + end function levcnlfpft_index ! ====================================================================================== subroutine flush_hvars(this,nc,upfreq_in) @@ -737,6 +829,7 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none @@ -786,10 +879,22 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_fuel_r8, 2) - ! site x cwd size class class + ! site x cwd size class index = index + 1 call this%dim_kinds(index)%Init(site_cwdsc_r8, 2) + ! site x can class + index = index + 1 + call this%dim_kinds(index)%Init(site_can_r8, 2) + + ! site x cnlf class + index = index + 1 + call this%dim_kinds(index)%Init(site_cnlf_r8, 2) + + ! site x cnlfpft class + index = index + 1 + call this%dim_kinds(index)%Init(site_cnlfpft_r8, 2) + ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps @@ -1747,6 +1852,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none class(fates_history_interface_type), intent(inout) :: this diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 index f6b2011d44..cbcc25b863 100644 --- a/components/clm/src/ED/main/FatesHistoryVariableType.F90 +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -47,6 +47,7 @@ subroutine Init(this, vname, units, long, use_default, & use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : iotype_index implicit none @@ -140,6 +141,18 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_can_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_cnlf_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_cnlfpft_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' @@ -207,6 +220,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none @@ -242,6 +256,12 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cwdsc_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_can_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_cnlf_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_cnlfpft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) case default diff --git a/components/clm/src/ED/main/FatesIODimensionsMod.F90 b/components/clm/src/ED/main/FatesIODimensionsMod.F90 index a14a013476..c118849d5a 100644 --- a/components/clm/src/ED/main/FatesIODimensionsMod.F90 +++ b/components/clm/src/ED/main/FatesIODimensionsMod.F90 @@ -14,6 +14,9 @@ module FatesIODimensionsMod character(*), parameter :: levage = 'levage' character(*), parameter :: levfuel = 'levfuel' character(*), parameter :: levcwdsc = 'levcwdsc' + character(*), parameter :: levcan = 'levcan' + character(*), parameter :: levcnlf = 'levcnlf' + character(*), parameter :: levcnlfpft = 'lvcnlfpf' ! patch = This is a structure that records where FATES patch boundaries ! on each thread point to in the host IO array, this structure @@ -44,6 +47,15 @@ module FatesIODimensionsMod ! levcwdsc = This is a structure that records the boundaries for the ! number of coarse-woody-debris-size-class dimension + ! levcan = This is a structure that records the boundaries for the + ! number of canopy layer dimension + + ! levcnlf = This is a structure that records the boundaries for the + ! number of cnanopy layer x leaf layer dimension + + ! levcnlfpft = This is a structure that records the boundaries for the + ! number of canopy layer x leaf layer x pft dimension + type, public :: fates_bounds_type integer :: patch_begin @@ -66,6 +78,12 @@ module FatesIODimensionsMod integer :: fuel_end integer :: cwdsc_begin integer :: cwdsc_end + integer :: can_begin + integer :: can_end + integer :: cnlf_begin + integer :: cnlf_end + integer :: cnlfpft_begin + integer :: cnlfpft_end end type fates_bounds_type diff --git a/components/clm/src/ED/main/FatesIOVariableKindMod.F90 b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 index 71d1ab9865..3261c35d89 100644 --- a/components/clm/src/ED/main/FatesIOVariableKindMod.F90 +++ b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 @@ -24,7 +24,9 @@ module FatesIOVariableKindMod character(*), parameter :: site_age_r8 = 'SI_AGE_R8' character(*), parameter :: site_fuel_r8 = 'SI_FUEL_R8' character(*), parameter :: site_cwdsc_r8 = 'SI_CWDSC_R8' - + character(*), parameter :: site_can_r8 = 'SI_CAN_R8' + character(*), parameter :: site_cnlf_r8 = 'SI_CNLF_R8' + character(*), parameter :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES ! control parameter passing to ensure all active dimension types received all diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index 30c0e804cf..ea1f50e233 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -23,6 +23,7 @@ module histFileMod use ncdio_pio use EDtypesMod , only : nlevsclass_ed, nlevage_ed use EDtypesMod , only : nfsc, ncwd + use EDtypesMod , only : cp_nlevcan, cp_nclmax, numpft_ed use clm_varpar , only : mxpft ! implicit none @@ -1856,6 +1857,9 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'levfuel', nfsc, dimid) call ncd_defdim(lnfid, 'levcwdsc', ncwd, dimid) call ncd_defdim(lnfid, 'levscpf', nlevsclass_ed*mxpft, dimid) + call ncd_defdim(lnfid, 'levcan', cp_nlevcan, dimid) + call ncd_defdim(lnfid, 'levcnlf', cp_nlevcan * cp_nclmax, dimid) + call ncd_defdim(lnfid, 'lvcnlfpf', cp_nlevcan * cp_nclmax * numpft_ed, dimid) end if if ( .not. lhistrest )then @@ -2273,6 +2277,8 @@ subroutine htape_timeconst(t, mode) use EDTypesMod, only : levsclass_ed, pft_levscpf_ed, scls_levscpf_ed use EDTypesMod, only : levage_ed, levpft_ed use EDTypesMod, only : levfuel_ed, levcwdsc_ed + use EDTypesMod, only : levcan_ed, can_levcnlf_ed, lf_levcnlf_ed + use EDTypesMod, only : can_levcnlfpft_ed, lf_levcnlfpft_ed, pft_levcnlfpft_ed ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index @@ -2338,8 +2344,21 @@ subroutine htape_timeconst(t, mode) long_name='FATES fuel index', ncid=nfid(t)) call ncd_defvar(varname='levcwdsc',xtype=ncd_int, dim1name='levcwdsc', & long_name='FATES cwd size class', ncid=nfid(t)) + call ncd_defvar(varname='levcan',xtype=ncd_int, dim1name='levcan', & + long_name='FATES canopy level', ncid=nfid(t)) + call ncd_defvar(varname='can_levcnlf',xtype=ncd_int, dim1name='levcnlf', & + long_name='FATES canopy level of combined canopy-leaf dimension', ncid=nfid(t)) + call ncd_defvar(varname='lf_levcnlf',xtype=ncd_int, dim1name='levcnlf', & + long_name='FATES leaf level of combined canopy-leaf dimension', ncid=nfid(t)) + call ncd_defvar(varname='can_levcnlfpft',xtype=ncd_int, dim1name='lvcnlfpf', & + long_name='FATES canopy level of combined canopy x leaf x pft dimension', ncid=nfid(t)) + call ncd_defvar(varname='lf_levcnlfpft',xtype=ncd_int, dim1name='lvcnlfpf', & + long_name='FATES leaf level of combined canopy x leaf x pft dimension', ncid=nfid(t)) + call ncd_defvar(varname='pft_levcnlfpft',xtype=ncd_int, dim1name='lvcnlfpf', & + long_name='FATES PFT level of combined canopy x leaf x pft dimension', ncid=nfid(t)) end if + elseif (mode == 'write') then if ( masterproc ) write(iulog, *) ' zsoi:',zsoi call ncd_io(varname='levgrnd', data=zsoi, ncid=nfid(t), flag='write') @@ -2358,6 +2377,12 @@ subroutine htape_timeconst(t, mode) call ncd_io(varname='levpft',data=levpft_ed, ncid=nfid(t), flag='write') call ncd_io(varname='levfuel',data=levfuel_ed, ncid=nfid(t), flag='write') call ncd_io(varname='levcwdsc',data=levcwdsc_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='levcan',data=levcan_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='can_levcnlf',data=can_levcnlf_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='lf_levcnlf',data=lf_levcnlf_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='can_levcnlfpft',data=can_levcnlfpft_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='lf_levcnlfpft',data=lf_levcnlfpft_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='pft_levcnlfpft',data=pft_levcnlfpft_ed, ncid=nfid(t), flag='write') end if endif @@ -4469,6 +4494,12 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, num2d = ncwd case ('levscpf') num2d = nlevsclass_ed*mxpft + case ('levcan') + num2d = cp_nlevcan + case ('levcnlf') + num2d = cp_nlevcan * cp_nclmax + case ('lvcnlfpf') + num2d = cp_nlevcan * cp_nclmax * numpft_ed case('ltype') num2d = max_lunit case('natpft') diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 75438ef1f0..b38284d401 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1638,6 +1638,7 @@ subroutine init_history_io(this,bounds_proc) use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIODimensionsMod, only : fates_bounds_type @@ -1844,6 +1845,33 @@ subroutine init_history_io(this,bounds_proc) ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) + case(site_can_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name + call hist_addfld2d(fname=trim(vname),units=trim(vunits), & + type2d=trim(dim2name), & + avgflag=trim(vavgflag),long_name=trim(vlong), & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & + default=trim(vdefault), & + set_lake=0._r8,set_urb=0._r8) + case(site_cnlf_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name + call hist_addfld2d(fname=trim(vname),units=trim(vunits), & + type2d=trim(dim2name), & + avgflag=trim(vavgflag),long_name=trim(vlong), & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & + default=trim(vdefault), & + set_lake=0._r8,set_urb=0._r8) + case(site_cnlfpft_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name + call hist_addfld2d(fname=trim(vname),units=trim(vunits), & + type2d=trim(dim2name), & + avgflag=trim(vavgflag),long_name=trim(vlong), & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & + default=trim(vdefault), & + set_lake=0._r8,set_urb=0._r8) case default write(iulog,*) 'A FATES iotype was created that was not registerred' @@ -1860,6 +1888,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) use FatesIODimensionsMod, only : fates_bounds_type use EDtypesMod, only : nlevsclass_ed, nlevage_ed use EDtypesMod, only : nfsc, ncwd + use EDtypesMod, only : cp_nlevcan, cp_nclmax, numpft_ed use clm_varpar, only : mxpft, nlevgrnd implicit none @@ -1897,6 +1926,15 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%cwdsc_begin = 1 fates%cwdsc_end = ncwd + fates%can_begin = 1 + fates%can_end = cp_nlevcan + + fates%cnlf_begin = 1 + fates%cnlf_end = cp_nlevcan * cp_nclmax + + fates%cnlfpft_begin = 1 + fates%cnlfpft_end = cp_nlevcan * cp_nclmax * numpft_ed + end subroutine hlm_bounds_to_fates_bounds end module CLMFatesInterfaceMod From f2e85e589be3078390a5483460dbe0743ff016e6 Mon Sep 17 00:00:00 2001 From: ckoven Date: Sun, 5 Mar 2017 11:06:19 -0800 Subject: [PATCH 18/46] added vars on new canopy vertical radiation dimensions --- components/clm/src/ED/main/EDTypesMod.F90 | 14 +- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 160 +++++++++++++++++- components/clm/src/main/histFileMod.F90 | 4 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 2 +- 4 files changed, 168 insertions(+), 12 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index ee30de4278..69cc974d33 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -617,7 +617,7 @@ subroutine ed_hist_scpfmaps allocate( levcwdsc_ed(1:NCWD )) allocate( levage_ed(1:nlevage_ed )) - allocate(levcan_ed(cp_nlevcan)) + allocate(levcan_ed(cp_nclmax)) allocate(can_levcnlf_ed(cp_nlevcan*cp_nclmax)) allocate(lf_levcnlf_ed(cp_nlevcan*cp_nclmax)) allocate(can_levcnlfpft_ed(cp_nlevcan*cp_nclmax*numpft_ed)) @@ -647,7 +647,7 @@ subroutine ed_hist_scpfmaps end do ! make canopy array - do ican = 1,cp_nlevcan + do ican = 1,cp_nclmax levcan_ed(ican) = ican end do @@ -662,8 +662,8 @@ subroutine ed_hist_scpfmaps end do i=0 - do ican=1,cp_nlevcan - do ileaf=1,cp_nclmax + do ican=1,cp_nclmax + do ileaf=1,cp_nlevcan i=i+1 can_levcnlf_ed(i) = ican lf_levcnlf_ed(i) = ileaf @@ -671,9 +671,9 @@ subroutine ed_hist_scpfmaps end do i=0 - do ican=1,cp_nlevcan - do ileaf=1,cp_nclmax - do ipft=1,numpft_ed + do ipft=1,numpft_ed + do ican=1,cp_nclmax + do ileaf=1,cp_nlevcan i=i+1 can_levcnlfpft_ed(i) = ican lf_levcnlfpft_ed(i) = ileaf diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index e53d4e9b63..129ccdd394 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -224,10 +224,24 @@ module FatesHistoryInterfaceMod integer, private :: ih_cwd_bg_si_cwdsc ! indices to (site x [canopy layer x leaf layer]) variables + integer, private :: ih_parsun_z_si_cnlf + integer, private :: ih_parsha_z_si_cnlf + integer, private :: ih_laisun_z_si_cnlf + integer, private :: ih_laisha_z_si_cnlf ! indices to (site x [canopy layer x leaf layer x pft]) variables + integer, private :: ih_parsun_z_si_cnlfpft + integer, private :: ih_parsha_z_si_cnlfpft + integer, private :: ih_laisun_z_si_cnlfpft + integer, private :: ih_laisha_z_si_cnlfpft + integer, private :: ih_fabd_sun_si_cnlfpft + integer, private :: ih_fabd_sha_si_cnlfpft + integer, private :: ih_fabi_sun_si_cnlfpft + integer, private :: ih_fabi_sha_si_cnlfpft ! indices to (site x canopy layer) variables + integer, private :: ih_parsuntop_si_can + integer, private :: ih_parshatop_si_can ! The number of variable dim/kind types we have defined (static) integer, parameter :: fates_history_num_dimensions = 12 @@ -1570,6 +1584,8 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) nlevage_ed, & sclass_ed, & nlevsclass_ed + use EDTypesMod, only : numpft_ed, cp_nclmax, cp_nlevcan + ! ! Arguments class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index @@ -1592,7 +1608,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) real(r8) :: patch_area_by_age(nlevage_ed) ! patch area in each bin for normalizing purposes real(r8), parameter :: tiny = 1.e-5_r8 ! some small number integer :: ipa2 ! patch incrementer - + integer :: cnlfpft_indx, cnlf_indx, ipft, ican, ileaf ! more iterators and indices type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -1630,7 +1646,21 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_resp_g_understory_si_scls => this%hvars(ih_resp_g_understory_si_scls)%r82d, & hio_resp_m_understory_si_scls => this%hvars(ih_resp_m_understory_si_scls)%r82d, & hio_gpp_si_age => this%hvars(ih_gpp_si_age)%r82d, & - hio_npp_si_age => this%hvars(ih_npp_si_age)%r82d & + hio_npp_si_age => this%hvars(ih_npp_si_age)%r82d, & + hio_parsun_z_si_cnlf => this%hvars(ih_parsun_z_si_cnlf)%r82d, & + hio_parsha_z_si_cnlf => this%hvars(ih_parsha_z_si_cnlf)%r82d, & + hio_parsun_z_si_cnlfpft => this%hvars(ih_parsun_z_si_cnlfpft)%r82d, & + hio_parsha_z_si_cnlfpft => this%hvars(ih_parsha_z_si_cnlfpft)%r82d, & + hio_laisun_z_si_cnlf => this%hvars(ih_laisun_z_si_cnlf)%r82d, & + hio_laisha_z_si_cnlf => this%hvars(ih_laisha_z_si_cnlf)%r82d, & + hio_laisun_z_si_cnlfpft => this%hvars(ih_laisun_z_si_cnlfpft)%r82d, & + hio_laisha_z_si_cnlfpft => this%hvars(ih_laisha_z_si_cnlfpft)%r82d, & + hio_fabd_sun_si_cnlfpft => this%hvars(ih_fabd_sun_si_cnlfpft)%r82d, & + hio_fabd_sha_si_cnlfpft => this%hvars(ih_fabd_sha_si_cnlfpft)%r82d, & + hio_fabi_sun_si_cnlfpft => this%hvars(ih_fabi_sun_si_cnlfpft)%r82d, & + hio_fabi_sha_si_cnlfpft => this%hvars(ih_fabi_sha_si_cnlfpft)%r82d, & + hio_parsuntop_si_can => this%hvars(ih_parsuntop_si_can)%r82d, & + hio_parshatop_si_can => this%hvars(ih_parshatop_si_can)%r82d & ) @@ -1766,6 +1796,47 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ccohort => ccohort%taller enddo ! cohort loop + + ! summarize radiation profiles through the canopy + do ipft=1,numpft_ed + do ican=1,cp_nclmax + do ileaf=1,cp_nlevcan + ! calculate where we are on multiplexed dimensions + cnlfpft_indx = ileaf + (ican-1) * cp_nlevcan + (ipft-1) * cp_nlevcan * cp_nclmax + cnlf_indx = ileaf + (ican-1) * cp_nlevcan + ! + hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area/AREA + ! + hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area/AREA + ! + hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + ! + ! summarize across all PFTs + hio_parsun_z_si_cnlf(io_si,cnlf_indx) = hio_parsun_z_si_cnlf(io_si,cnlf_indx) + & + cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_parsha_z_si_cnlf(io_si,cnlf_indx) = hio_parsha_z_si_cnlf(io_si,cnlf_indx) + & + cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area/AREA + ! + hio_laisun_z_si_cnlf(io_si,cnlf_indx) = hio_laisun_z_si_cnlf(io_si,cnlf_indx) + & + cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_laisha_z_si_cnlf(io_si,cnlf_indx) = hio_laisha_z_si_cnlf(io_si,cnlf_indx) + & + cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area/AREA + end do + ! + ! summarize just the top leaf level across all PFTs, for each canopy level + hio_parsuntop_si_can(io_si,ican) = hio_parsuntop_si_can(io_si,ican) + & + cpatch%ed_parsun_z(ican,ipft,1) * cpatch%area/AREA + hio_parshatop_si_can(io_si,ican) = hio_parshatop_si_can(io_si,ican) + & + cpatch%ed_parsha_z(ican,ipft,1) * cpatch%area/AREA + end do + end do + + ipa = ipa + 1 cpatch => cpatch%younger end do !patch loop @@ -2153,6 +2224,91 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_ar_understory_pa ) + ! fast radiative fluxes resolved through the canopy + call this%set_history_var(vname='PARSUN_Z_CNLF', units='fraction', & + long='PAR absorbed in the sun by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlf ) + + call this%set_history_var(vname='PARSHA_Z_CNLF', units='fraction', & + long='PAR absorbed in the shade by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlf ) + + call this%set_history_var(vname='PARSUN_Z_CNLFPFT', units='fraction', & + long='PAR absorbed in the sun by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlfpft ) + + call this%set_history_var(vname='PARSHA_Z_CNLFPFT', units='fraction', & + long='PAR absorbed in the shade by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlfpft ) + + call this%set_history_var(vname='PARSUN_Z_CAN', units='fraction', & + long='PAR absorbed in the sun by top leaf layer in each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_parsuntop_si_can ) + + call this%set_history_var(vname='PARSHA_Z_CAN', units='fraction', & + long='PAR absorbed in the shade by top leaf layer in each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_parshatop_si_can ) + + call this%set_history_var(vname='LAISUN_Z_CNLF', units='fraction', & + long='LAI in the sun by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlf ) + + call this%set_history_var(vname='LAISHA_Z_CNLF', units='fraction', & + long='LAI in the shade by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_laisha_z_si_cnlf ) + + call this%set_history_var(vname='LAISUN_Z_CNLFPFT', units='fraction', & + long='LAI in the sun by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlfpft ) + + call this%set_history_var(vname='LAISHA_Z_CNLFPFT', units='fraction', & + long='LAI in the shade by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_laisha_z_si_cnlfpft ) + + call this%set_history_var(vname='FABD_SUN_CNLFPFT', units='fraction', & + long='sun fraction of direct light absorbed by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_si_cnlfpft ) + + call this%set_history_var(vname='FABD_SHA_CNLFPFT', units='fraction', & + long='shade fraction of direct light absorbed by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_si_cnlfpft ) + + call this%set_history_var(vname='FABI_SUN_CNLFPFT', units='fraction', & + long='sun fraction of indirect light absorbed by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_si_cnlfpft ) + + call this%set_history_var(vname='FABI_SHA_CNLFPFT', units='fraction', & + long='shade fraction of indirect light absorbed by each canopy, leaf, and PFT', & + use_default='active', & + avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_si_cnlfpft ) + ! slow carbon fluxes associated with mortality from or transfer betweeen canopy and understory call this%set_history_var(vname='DEMOTION_CARBONFLUX', units = 'gC/m2/s', & long='demotion-associated biomass carbon flux from canopy to understory', use_default='active', & diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index ea1f50e233..014c7f94ec 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -1857,7 +1857,7 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'levfuel', nfsc, dimid) call ncd_defdim(lnfid, 'levcwdsc', ncwd, dimid) call ncd_defdim(lnfid, 'levscpf', nlevsclass_ed*mxpft, dimid) - call ncd_defdim(lnfid, 'levcan', cp_nlevcan, dimid) + call ncd_defdim(lnfid, 'levcan', cp_nclmax, dimid) call ncd_defdim(lnfid, 'levcnlf', cp_nlevcan * cp_nclmax, dimid) call ncd_defdim(lnfid, 'lvcnlfpf', cp_nlevcan * cp_nclmax * numpft_ed, dimid) end if @@ -4495,7 +4495,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, case ('levscpf') num2d = nlevsclass_ed*mxpft case ('levcan') - num2d = cp_nlevcan + num2d = cp_nclmax case ('levcnlf') num2d = cp_nlevcan * cp_nclmax case ('lvcnlfpf') diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index b38284d401..c04c87a3d0 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1927,7 +1927,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%cwdsc_end = ncwd fates%can_begin = 1 - fates%can_end = cp_nlevcan + fates%can_end = cp_nclmax fates%cnlf_begin = 1 fates%cnlf_end = cp_nlevcan * cp_nclmax From ae960b1cf953c06720ed41a9d1d9286ced0c69b1 Mon Sep 17 00:00:00 2001 From: ckoven Date: Sun, 5 Mar 2017 14:38:46 -0800 Subject: [PATCH 19/46] bugfixes to loop over patches correctly and also a variable definition --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 33 ++++++++++++------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 129ccdd394..1d37a968c6 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1465,7 +1465,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_sum_fuel_pa(io_pa) = cpatch%sum_fuel * 1.e3_r8 * patch_scaling_scalar do i_fuel = 1,nfsc - hio_litter_moisture_si_fuel(io_si, i_fuel) = cpatch%litter_moisture(i_fuel) * cpatch%area/AREA + hio_litter_moisture_si_fuel(io_si, i_fuel) = hio_litter_moisture_si_fuel(io_si, i_fuel) + & + cpatch%litter_moisture(i_fuel) * cpatch%area/AREA end do ! Update Litter Flux Variables @@ -1485,8 +1486,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_canopy_spread_pa(io_pa) = cpatch%spread(1) do i_cwd = 1, ncwd - hio_cwd_ag_si_cwdsc(io_si, i_cwd) = cpatch%CWD_AG_out(i_cwd)*cpatch%area/AREA * 1e3 - hio_cwd_bg_si_cwdsc(io_si, i_cwd) = cpatch%CWD_BG_out(i_cwd)*cpatch%area/AREA * 1e3 + hio_cwd_ag_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_si_cwdsc(io_si, i_cwd) + & + cpatch%CWD_AG(i_cwd)*cpatch%area/AREA * 1e3 + hio_cwd_bg_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_si_cwdsc(io_si, i_cwd) + & + cpatch%CWD_BG(i_cwd)*cpatch%area/AREA * 1e3 end do ipa = ipa + 1 @@ -1805,16 +1808,24 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) cnlfpft_indx = ileaf + (ican-1) * cp_nlevcan + (ipft-1) * cp_nlevcan * cp_nclmax cnlf_indx = ileaf + (ican-1) * cp_nlevcan ! - hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA - hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area/AREA ! - hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area/AREA - hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area/AREA ! - hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area/AREA - hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area/AREA - hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area/AREA - hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) = cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) + & + cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area/AREA ! ! summarize across all PFTs hio_parsun_z_si_cnlf(io_si,cnlf_indx) = hio_parsun_z_si_cnlf(io_si,cnlf_indx) + & From 809975abdac73891a3966622bbd5a090743bf423 Mon Sep 17 00:00:00 2001 From: ckoven Date: Sun, 5 Mar 2017 17:06:38 -0800 Subject: [PATCH 20/46] fix to units and history updating --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 1d37a968c6..bb76f24473 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -2236,61 +2236,61 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_ar_understory_pa ) ! fast radiative fluxes resolved through the canopy - call this%set_history_var(vname='PARSUN_Z_CNLF', units='fraction', & + call this%set_history_var(vname='PARSUN_Z_CNLF', units='W/m2', & long='PAR absorbed in the sun by each canopy and leaf layer', & use_default='active', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlf ) - call this%set_history_var(vname='PARSHA_Z_CNLF', units='fraction', & + call this%set_history_var(vname='PARSHA_Z_CNLF', units='W/m2', & long='PAR absorbed in the shade by each canopy and leaf layer', & use_default='active', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlf ) - call this%set_history_var(vname='PARSUN_Z_CNLFPFT', units='fraction', & + call this%set_history_var(vname='PARSUN_Z_CNLFPFT', units='W/m2', & long='PAR absorbed in the sun by each canopy, leaf, and PFT', & use_default='active', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlfpft ) - call this%set_history_var(vname='PARSHA_Z_CNLFPFT', units='fraction', & + call this%set_history_var(vname='PARSHA_Z_CNLFPFT', units='W/m2', & long='PAR absorbed in the shade by each canopy, leaf, and PFT', & use_default='active', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlfpft ) - call this%set_history_var(vname='PARSUN_Z_CAN', units='fraction', & + call this%set_history_var(vname='PARSUN_Z_CAN', units='W/m2', & long='PAR absorbed in the sun by top leaf layer in each canopy layer', & use_default='active', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsuntop_si_can ) - call this%set_history_var(vname='PARSHA_Z_CAN', units='fraction', & + call this%set_history_var(vname='PARSHA_Z_CAN', units='W/m2', & long='PAR absorbed in the shade by top leaf layer in each canopy layer', & use_default='active', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parshatop_si_can ) - call this%set_history_var(vname='LAISUN_Z_CNLF', units='fraction', & + call this%set_history_var(vname='LAISUN_Z_CNLF', units='m2/m2', & long='LAI in the sun by each canopy and leaf layer', & use_default='active', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlf ) - call this%set_history_var(vname='LAISHA_Z_CNLF', units='fraction', & + call this%set_history_var(vname='LAISHA_Z_CNLF', units='m2/m2', & long='LAI in the shade by each canopy and leaf layer', & use_default='active', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisha_z_si_cnlf ) - call this%set_history_var(vname='LAISUN_Z_CNLFPFT', units='fraction', & + call this%set_history_var(vname='LAISUN_Z_CNLFPFT', units='m2/m2', & long='LAI in the sun by each canopy, leaf, and PFT', & use_default='active', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlfpft ) - call this%set_history_var(vname='LAISHA_Z_CNLFPFT', units='fraction', & + call this%set_history_var(vname='LAISHA_Z_CNLFPFT', units='m2/m2', & long='LAI in the shade by each canopy, leaf, and PFT', & use_default='active', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & @@ -2514,12 +2514,12 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='CWD_AG_CWDSC', units='gC/m^2', & long='size-resolved AG CWD stocks', use_default='active', & - avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_si_cwdsc ) call this%set_history_var(vname='CWD_BG_CWDSC', units='gC/m^2', & long='size-resolved BG CWD stocks', use_default='active', & - avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_si_cwdsc ) ! Size structured diagnostics that require rapid updates (upfreq=2) From a7bd51fdd2ab07d708291e773a3399953dc8e11c Mon Sep 17 00:00:00 2001 From: ckoven Date: Sun, 5 Mar 2017 19:46:25 -0800 Subject: [PATCH 21/46] added more cwd vars to understand size-resolved fluxes & turnovers --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 38 ++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index bb76f24473..88e57ec526 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -222,6 +222,10 @@ module FatesHistoryInterfaceMod ! indices to (site x cwd size class) variables integer, private :: ih_cwd_ag_si_cwdsc integer, private :: ih_cwd_bg_si_cwdsc + integer, private :: ih_cwd_ag_in_si_cwdsc + integer, private :: ih_cwd_bg_in_si_cwdsc + integer, private :: ih_cwd_ag_out_si_cwdsc + integer, private :: ih_cwd_bg_out_si_cwdsc ! indices to (site x [canopy layer x leaf layer]) variables integer, private :: ih_parsun_z_si_cnlf @@ -1141,7 +1145,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npatches_si_age => this%hvars(ih_npatches_si_age)%r82d, & hio_litter_moisture_si_fuel => this%hvars(ih_litter_moisture_si_fuel)%r82d, & hio_cwd_ag_si_cwdsc => this%hvars(ih_cwd_ag_si_cwdsc)%r82d, & - hio_cwd_bg_si_cwdsc => this%hvars(ih_cwd_bg_si_cwdsc)%r82d) + hio_cwd_bg_si_cwdsc => this%hvars(ih_cwd_bg_si_cwdsc)%r82d, & + hio_cwd_ag_in_si_cwdsc => this%hvars(ih_cwd_ag_in_si_cwdsc)%r82d, & + hio_cwd_bg_in_si_cwdsc => this%hvars(ih_cwd_bg_in_si_cwdsc)%r82d, & + hio_cwd_ag_out_si_cwdsc => this%hvars(ih_cwd_ag_out_si_cwdsc)%r82d, & + hio_cwd_bg_out_si_cwdsc => this%hvars(ih_cwd_bg_out_si_cwdsc)%r82d) ! --------------------------------------------------------------------------------- @@ -1490,6 +1498,14 @@ subroutine update_history_dyn(this,nc,nsites,sites) cpatch%CWD_AG(i_cwd)*cpatch%area/AREA * 1e3 hio_cwd_bg_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_si_cwdsc(io_si, i_cwd) + & cpatch%CWD_BG(i_cwd)*cpatch%area/AREA * 1e3 + hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + & + cpatch%CWD_AG_IN(i_cwd)*cpatch%area/AREA * 1e3 + hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & + cpatch%CWD_BG_IN(i_cwd)*cpatch%area/AREA * 1e3 + hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) + & + cpatch%CWD_AG_OUT(i_cwd)*cpatch%area/AREA * 1e3 + hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) + & + cpatch%CWD_BG_OUT(i_cwd)*cpatch%area/AREA * 1e3 end do ipa = ipa + 1 @@ -2522,6 +2538,26 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_si_cwdsc ) + call this%set_history_var(vname='CWD_AG_IN_CWDSC', units='kgC/m^2/y', & + long='size-resolved AG CWD input', use_default='active', & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_in_si_cwdsc ) + + call this%set_history_var(vname='CWD_BG_IN_CWDSC', units='kgC/m^2/y', & + long='size-resolved BG CWD input', use_default='active', & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_in_si_cwdsc ) + + call this%set_history_var(vname='CWD_AG_OUT_CWDSC', units='kgC/m^2/y', & + long='size-resolved AG CWD output', use_default='active', & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_out_si_cwdsc ) + + call this%set_history_var(vname='CWD_BG_OUT_CWDSC', units='kgC/m^2/y', & + long='size-resolved BG CWD output', use_default='active', & + avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_out_si_cwdsc ) + ! Size structured diagnostics that require rapid updates (upfreq=2) call this%set_history_var(vname='AR_SCPF',units = 'kgC/m2/yr', & From 91d938365a95af74abaf199a5f683d4f7a1c81bf Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Mon, 6 Mar 2017 14:48:21 -0800 Subject: [PATCH 22/46] resolved some naming conflicts from merge of Ryans PR --- components/clm/src/ED/main/EDTypesMod.F90 | 22 +++++++++---------- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 10 ++++----- components/clm/src/main/histFileMod.F90 | 14 ++++++------ .../clm/src/utils/clmfates_interfaceMod.F90 | 8 +++---- 4 files changed, 27 insertions(+), 27 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 4381fc6037..246ff6b797 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -551,12 +551,12 @@ subroutine ed_hist_scpfmaps allocate( levcwdsc_ed(1:NCWD )) allocate( levage_ed(1:nlevage_ed )) - allocate(levcan_ed(cp_nclmax)) - allocate(can_levcnlf_ed(cp_nlevcan*cp_nclmax)) - allocate(lf_levcnlf_ed(cp_nlevcan*cp_nclmax)) - allocate(can_levcnlfpft_ed(cp_nlevcan*cp_nclmax*numpft_ed)) - allocate(lf_levcnlfpft_ed(cp_nlevcan*cp_nclmax*numpft_ed)) - allocate(pft_levcnlfpft_ed(cp_nlevcan*cp_nclmax*numpft_ed)) + allocate(levcan_ed(nclmax)) + allocate(can_levcnlf_ed(nlevcan*nclmax)) + allocate(lf_levcnlf_ed(nlevcan*nclmax)) + allocate(can_levcnlfpft_ed(nlevcan*nclmax*numpft_ed)) + allocate(lf_levcnlfpft_ed(nlevcan*nclmax*numpft_ed)) + allocate(pft_levcnlfpft_ed(nlevcan*nclmax*numpft_ed)) ! Fill the IO array of plant size classes ! For some reason the history files did not like @@ -581,7 +581,7 @@ subroutine ed_hist_scpfmaps end do ! make canopy array - do ican = 1,cp_nclmax + do ican = 1,nclmax levcan_ed(ican) = ican end do @@ -596,8 +596,8 @@ subroutine ed_hist_scpfmaps end do i=0 - do ican=1,cp_nclmax - do ileaf=1,cp_nlevcan + do ican=1,nclmax + do ileaf=1,nlevcan i=i+1 can_levcnlf_ed(i) = ican lf_levcnlf_ed(i) = ileaf @@ -606,8 +606,8 @@ subroutine ed_hist_scpfmaps i=0 do ipft=1,numpft_ed - do ican=1,cp_nclmax - do ileaf=1,cp_nlevcan + do ican=1,nclmax + do ileaf=1,nlevcan i=i+1 can_levcnlfpft_ed(i) = ican lf_levcnlfpft_ed(i) = ileaf diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 5ad97fe723..10926fde70 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1603,7 +1603,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) nlevage_ed, & sclass_ed, & nlevsclass_ed - use EDTypesMod, only : numpft_ed, cp_nclmax, cp_nlevcan + use EDTypesMod, only : numpft_ed, nclmax, nlevcan ! ! Arguments class(fates_history_interface_type) :: this @@ -1818,11 +1818,11 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! summarize radiation profiles through the canopy do ipft=1,numpft_ed - do ican=1,cp_nclmax - do ileaf=1,cp_nlevcan + do ican=1,nclmax + do ileaf=1,nlevcan ! calculate where we are on multiplexed dimensions - cnlfpft_indx = ileaf + (ican-1) * cp_nlevcan + (ipft-1) * cp_nlevcan * cp_nclmax - cnlf_indx = ileaf + (ican-1) * cp_nlevcan + cnlfpft_indx = ileaf + (ican-1) * nlevcan + (ipft-1) * nlevcan * nclmax + cnlf_indx = ileaf + (ican-1) * nlevcan ! hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) + & cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index 014c7f94ec..f6183aea00 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -23,7 +23,7 @@ module histFileMod use ncdio_pio use EDtypesMod , only : nlevsclass_ed, nlevage_ed use EDtypesMod , only : nfsc, ncwd - use EDtypesMod , only : cp_nlevcan, cp_nclmax, numpft_ed + use EDtypesMod , only : nlevcan, nclmax, numpft_ed use clm_varpar , only : mxpft ! implicit none @@ -1857,9 +1857,9 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'levfuel', nfsc, dimid) call ncd_defdim(lnfid, 'levcwdsc', ncwd, dimid) call ncd_defdim(lnfid, 'levscpf', nlevsclass_ed*mxpft, dimid) - call ncd_defdim(lnfid, 'levcan', cp_nclmax, dimid) - call ncd_defdim(lnfid, 'levcnlf', cp_nlevcan * cp_nclmax, dimid) - call ncd_defdim(lnfid, 'lvcnlfpf', cp_nlevcan * cp_nclmax * numpft_ed, dimid) + call ncd_defdim(lnfid, 'levcan', nclmax, dimid) + call ncd_defdim(lnfid, 'levcnlf', nlevcan * nclmax, dimid) + call ncd_defdim(lnfid, 'lvcnlfpf', nlevcan * nclmax * numpft_ed, dimid) end if if ( .not. lhistrest )then @@ -4495,11 +4495,11 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, case ('levscpf') num2d = nlevsclass_ed*mxpft case ('levcan') - num2d = cp_nclmax + num2d = nclmax case ('levcnlf') - num2d = cp_nlevcan * cp_nclmax + num2d = nlevcan * nclmax case ('lvcnlfpf') - num2d = cp_nlevcan * cp_nclmax * numpft_ed + num2d = nlevcan * nclmax * numpft_ed case('ltype') num2d = max_lunit case('natpft') diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 973e9fdc36..746c025b15 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1875,7 +1875,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) use FatesIODimensionsMod, only : fates_bounds_type use EDtypesMod, only : nlevsclass_ed, nlevage_ed use EDtypesMod, only : nfsc, ncwd - use EDtypesMod, only : cp_nlevcan, cp_nclmax, numpft_ed + use EDtypesMod, only : nlevcan, nclmax, numpft_ed use clm_varpar, only : mxpft, nlevgrnd implicit none @@ -1916,13 +1916,13 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%cwdsc_end = ncwd fates%can_begin = 1 - fates%can_end = cp_nclmax + fates%can_end = nclmax fates%cnlf_begin = 1 - fates%cnlf_end = cp_nlevcan * cp_nclmax + fates%cnlf_end = nlevcan * nclmax fates%cnlfpft_begin = 1 - fates%cnlfpft_end = cp_nlevcan * cp_nclmax * numpft_ed + fates%cnlfpft_end = nlevcan * nclmax * numpft_ed end subroutine hlm_bounds_to_fates_bounds From 8bce3f832a382f074d07bbeed614bccc189f349d Mon Sep 17 00:00:00 2001 From: ckoven Date: Mon, 6 Mar 2017 20:37:37 -0800 Subject: [PATCH 23/46] fixed unit error in CWD flux variables --- components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 10926fde70..29d4074fe8 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -2538,22 +2538,22 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_si_cwdsc ) - call this%set_history_var(vname='CWD_AG_IN_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_AG_IN_CWDSC', units='gC/m^2/y', & long='size-resolved AG CWD input', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_in_si_cwdsc ) - call this%set_history_var(vname='CWD_BG_IN_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_BG_IN_CWDSC', units='gC/m^2/y', & long='size-resolved BG CWD input', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_in_si_cwdsc ) - call this%set_history_var(vname='CWD_AG_OUT_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_AG_OUT_CWDSC', units='gC/m^2/y', & long='size-resolved AG CWD output', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_out_si_cwdsc ) - call this%set_history_var(vname='CWD_BG_OUT_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_BG_OUT_CWDSC', units='gC/m^2/y', & long='size-resolved BG CWD output', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_out_si_cwdsc ) From dc80d99083369509ab4abc427f6671bb1a98041a Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 7 Mar 2017 16:41:33 -0800 Subject: [PATCH 24/46] added site-level variables to track CWD_in from disturbance --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 65 ++++++++++++++---- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 26 ++++++- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 68 +++++++++++++++---- components/clm/src/ED/main/EDInitMod.F90 | 6 ++ components/clm/src/ED/main/EDTypesMod.F90 | 12 ++-- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 44 ++++++++---- 6 files changed, 173 insertions(+), 48 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 23368746c9..903627d735 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -14,7 +14,9 @@ module EDCanopyStructureMod use EDTypesMod , only : nclmax use EDTypesMod , only : nlevcan use EDTypesMod , only : numpft_ed + use EDtypesMod , only : AREA use FatesGlobals , only : endrun => fates_endrun + use FatesInterfaceMod , only : hlm_days_per_year ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -229,14 +231,31 @@ subroutine canopy_structure( currentSite ) enddo - currentPatch%leaf_litter(currentCohort%pft) = & - currentPatch%leaf_litter(currentCohort%pft) + (currentCohort%bl)* & - currentCohort%n/currentPatch%area ! leaf litter flux per m2. - - currentPatch%root_litter(currentCohort%pft) = & - currentPatch%root_litter(currentCohort%pft) + & - (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area - + currentPatch%leaf_litter(currentCohort%pft) = & + currentPatch%leaf_litter(currentCohort%pft) + (currentCohort%bl)* & + currentCohort%n/currentPatch%area ! leaf litter flux per m2. + + currentPatch%root_litter(currentCohort%pft) = & + currentPatch%root_litter(currentCohort%pft) + & + (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area + + ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr) + do c=1,ncwd + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA + enddo + + currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & + currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + & + currentCohort%n * (currentCohort%bl) * hlm_days_per_year / AREA + currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) = & + currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & + currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA + currentCohort%n = 0.0_r8 currentCohort%c_area = 0._r8 else @@ -280,13 +299,31 @@ subroutine canopy_structure( currentSite ) enddo - currentPatch%leaf_litter(currentCohort%pft) = & - currentPatch%leaf_litter(currentCohort%pft) + currentCohort%bl* & - currentCohort%n/currentPatch%area ! leaf litter flux per m2. + currentPatch%leaf_litter(currentCohort%pft) = & + currentPatch%leaf_litter(currentCohort%pft) + currentCohort%bl* & + currentCohort%n/currentPatch%area ! leaf litter flux per m2. + + currentPatch%root_litter(currentCohort%pft) = & + currentPatch%root_litter(currentCohort%pft) + & + (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area + + ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr) + do c=1,ncwd + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA + enddo + + currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & + currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + & + currentCohort%n * (currentCohort%bl) * hlm_days_per_year / AREA + currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) = & + currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & + currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA - currentPatch%root_litter(currentCohort%pft) = & - currentPatch%root_litter(currentCohort%pft) + & - (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area currentCohort%n = 0.0_r8 currentCohort%c_area = 0._r8 diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 1ff9971d82..a709336a88 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -9,6 +9,7 @@ module EDCohortDynamicsMod use FatesInterfaceMod , only : hlm_freq_day use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_unset_int + use FatesInterfaceMod , only : hlm_days_per_year use pftconMod , only : pftcon use EDEcophysContype , only : EDecophyscon use EDGrowthFunctionsMod , only : c_area, tree_lai @@ -498,6 +499,7 @@ subroutine terminate_cohorts( patchptr ) type (ed_patch_type), intent(inout), target :: patchptr ! ! !LOCAL VARIABLES: + type (ed_site_type) , pointer :: currentSite type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort type (ed_cohort_type) , pointer :: nextc @@ -508,6 +510,7 @@ subroutine terminate_cohorts( patchptr ) currentPatch => patchptr currentCohort => currentPatch%tallest + currentSite => currentPatch%siteptr do while (associated(currentCohort)) nextc => currentCohort%shorter @@ -571,10 +574,10 @@ subroutine terminate_cohorts( patchptr ) else levcan = 2 endif - currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = & - currentPatch%siteptr%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n + currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) = & + currentSite%terminated_nindivs(currentCohort%size_class,currentCohort%pft,levcan) + currentCohort%n ! - currentPatch%siteptr%termination_carbonflux(levcan) = currentPatch%siteptr%termination_carbonflux(levcan) + & + currentSite%termination_carbonflux(levcan) = currentSite%termination_carbonflux(levcan) + & currentCohort%n * currentCohort%b if (.not. associated(currentCohort%taller)) then currentPatch%tallest => currentCohort%shorter @@ -604,6 +607,23 @@ subroutine terminate_cohorts( patchptr ) currentPatch%root_litter(currentCohort%pft) = currentPatch%root_litter(currentCohort%pft) + currentCohort%n* & (currentCohort%br+currentCohort%bstore)/currentPatch%area + ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr) + do c=1,ncwd + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA + enddo + + currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) = & + currentSite%leaf_litter_diagnostic_input_carbonflux(currentCohort%pft) + & + currentCohort%n * (currentCohort%bl) * hlm_days_per_year / AREA + currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) = & + currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + & + currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA + deallocate(currentCohort) endif endif diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 237c831af5..694c547e5b 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -17,6 +17,7 @@ module EDPatchDynamicsMod use FatesInterfaceMod , only : hlm_numlevgrnd use FatesInterfaceMod , only : hlm_numlevsoil use FatesInterfaceMod , only : hlm_numSWb + use FatesInterfaceMod , only : hlm_days_per_year use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 @@ -600,11 +601,24 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) (currentCohort%bl) * (1.0_r8-currentCohort%cfa) currentPatch%root_litter(p) = currentPatch%root_litter(p) + dead_tree_density * & (currentCohort%br+currentCohort%bstore) + + ! track as diagnostic fluxes + currentSite%leaf_litter_diagnostic_input_carbonflux(p) = currentSite%leaf_litter_diagnostic_input_carbonflux(p) + & + (currentCohort%bl) * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * currentCohort%n * & + hlm_days_per_year / AREA + currentSite%root_litter_diagnostic_input_carbonflux(p) = currentSite%root_litter_diagnostic_input_carbonflux(p) + & + (currentCohort%br+currentCohort%bstore) * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * & + currentCohort%n * hlm_days_per_year / AREA ! below ground coarse woody debris from burned trees do c = 1,ncwd new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot + + ! track as diagnostic fluxes + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) + & + SF_val_CWD_frac(c) * bcroot * currentCohort%fire_mort * currentCohort%n * & + hlm_days_per_year / AREA enddo ! above ground coarse woody debris from unburned twigs and small branches @@ -613,12 +627,22 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) * (1.0_r8-currentCohort%cfa) currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * & bstem * (1.0_r8-currentCohort%cfa) + + ! track as diagnostic fluxes + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & + SF_val_CWD_frac(c) * bstem * (1.0_r8-currentCohort%cfa) * currentCohort%fire_mort * currentCohort%n * & + hlm_days_per_year / AREA enddo ! above ground coarse woody debris from large branches and stems: these do not burn in crown fires. do c = 3,4 new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem + + ! track as diagnostic fluxes + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & + SF_val_CWD_frac(c) * bstem * currentCohort%fire_mort * currentCohort%n * & + hlm_days_per_year / AREA enddo ! Burned parts of dead tree pool. @@ -705,6 +729,7 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread ! !LOCAL VARIABLES: real(r8) :: cwd_litter_density real(r8) :: litter_area ! area over which to distribute this litter. + type(ed_site_type) , pointer :: currentSite type(ed_cohort_type), pointer :: currentCohort type(ed_patch_type) , pointer :: currentPatch type(ed_patch_type) , pointer :: new_patch @@ -712,13 +737,17 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread real(r8) :: canopy_dead !Number of individual dead from the understorey layer /day real(r8) :: np_mult !Fraction of the new patch which came from the current patch (and so needs the same litter) integer :: p,c + real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/day + real(r8) :: canopy_mortality_leaf_litter(numpft_ed) ! flux in to leaf litter from tree death: KgC/m2/day + real(r8) :: canopy_mortality_root_litter(numpft_ed) ! flux in to froot litter from tree death: KgC/m2/day !--------------------------------------------------------------------- currentPatch => cp_target + currentSite => currentPatch%siteptr new_patch => new_patch_target - currentPatch%canopy_mortality_woody_litter = 0.0_r8 ! mortality generated litter. KgC/m2/day - currentPatch%canopy_mortality_leaf_litter(:) = 0.0_r8 - currentPatch%canopy_mortality_root_litter(:) = 0.0_r8 + canopy_mortality_woody_litter = 0.0_r8 ! mortality generated litter. KgC/m2/day + canopy_mortality_leaf_litter(:) = 0.0_r8 + canopy_mortality_root_litter(:) = 0.0_r8 currentCohort => currentPatch%shortest do while(associated(currentCohort)) @@ -730,22 +759,22 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread !not right to recalcualte dmort here. canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * hlm_freq_day) - currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + & + canopy_mortality_woody_litter = canopy_mortality_woody_litter + & canopy_dead*(currentCohort%bdead+currentCohort%bsw) - currentPatch%canopy_mortality_leaf_litter(p) = currentPatch%canopy_mortality_leaf_litter(p)+ & + canopy_mortality_leaf_litter(p) = canopy_mortality_leaf_litter(p)+ & canopy_dead*(currentCohort%bl) - currentPatch%canopy_mortality_root_litter(p) = currentPatch%canopy_mortality_root_litter(p)+ & + canopy_mortality_root_litter(p) = canopy_mortality_root_litter(p)+ & canopy_dead*(currentCohort%br+currentCohort%bstore) else if(pftcon%woody(currentCohort%pft) == 1)then understorey_dead = ED_val_understorey_death * currentCohort%n * (patch_site_areadis/currentPatch%area) !kgC/site/day - currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + & + canopy_mortality_woody_litter = canopy_mortality_woody_litter + & understorey_dead*(currentCohort%bdead+currentCohort%bsw) - currentPatch%canopy_mortality_leaf_litter(p)= currentPatch%canopy_mortality_leaf_litter(p)+ & + canopy_mortality_leaf_litter(p)= canopy_mortality_leaf_litter(p)+ & understorey_dead* currentCohort%bl - currentPatch%canopy_mortality_root_litter(p)= currentPatch%canopy_mortality_root_litter(p)+ & + canopy_mortality_root_litter(p)= canopy_mortality_root_litter(p)+ & understorey_dead*(currentCohort%br+currentCohort%bstore) ! FIX(SPM,040114) - clarify this comment @@ -777,22 +806,33 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread ! so we need to multiply by patch_areadis/np%area do c = 1,ncwd - cwd_litter_density = SF_val_CWD_frac(c) * currentPatch%canopy_mortality_woody_litter / litter_area + cwd_litter_density = SF_val_CWD_frac(c) * canopy_mortality_woody_litter / litter_area new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + ED_val_ag_biomass * cwd_litter_density * np_mult currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + ED_val_ag_biomass * cwd_litter_density new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + (1._r8-ED_val_ag_biomass) * cwd_litter_density * np_mult currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + (1._r8-ED_val_ag_biomass) * cwd_litter_density + ! track as diagnostic fluxes + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) + & + SF_val_CWD_frac(c) * canopy_mortality_woody_litter * hlm_days_per_year * ED_val_ag_biomass/ AREA + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) + & + SF_val_CWD_frac(c) * canopy_mortality_woody_litter * hlm_days_per_year * (1.0_r8 - ED_val_ag_biomass) / AREA enddo do p = 1,numpft_ed - new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + currentPatch%canopy_mortality_leaf_litter(p) / litter_area * np_mult - new_patch%root_litter(p) = new_patch%root_litter(p) + currentPatch%canopy_mortality_root_litter(p) / litter_area * np_mult - currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + currentPatch%canopy_mortality_leaf_litter(p) / litter_area - currentPatch%root_litter(p) = currentPatch%root_litter(p) + currentPatch%canopy_mortality_root_litter(p) / litter_area + new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + canopy_mortality_leaf_litter(p) / litter_area * np_mult + new_patch%root_litter(p) = new_patch%root_litter(p) + canopy_mortality_root_litter(p) / litter_area * np_mult + currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + canopy_mortality_leaf_litter(p) / litter_area + currentPatch%root_litter(p) = currentPatch%root_litter(p) + canopy_mortality_root_litter(p) / litter_area + ! track as diagnostic fluxes + currentSite%leaf_litter_diagnostic_input_carbonflux(p) = currentSite%leaf_litter_diagnostic_input_carbonflux(p) + & + canopy_mortality_leaf_litter(p) * hlm_days_per_year / AREA + + currentSite%root_litter_diagnostic_input_carbonflux(p) = currentSite%root_litter_diagnostic_input_carbonflux(p) + & + canopy_mortality_root_litter(p) * hlm_days_per_year / AREA enddo end subroutine mortality_litter_fluxes diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 4f949ba76e..5519c45276 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -92,6 +92,12 @@ subroutine zero_site( site_in ) site_in%promotion_rate(:) = 0._r8 site_in%promotion_carbonflux = 0._r8 + ! diagnostic site-level cwd and litter fluxes + site_in%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8 + site_in%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8 + site_in%leaf_litter_diagnostic_input_carbonflux(:) = 0._r8 + site_in%root_litter_diagnostic_input_carbonflux(:) = 0._r8 + end subroutine zero_site ! ============================================================================ diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 246ff6b797..2636e1eeb9 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -390,10 +390,6 @@ module EDTypesMod real(r8) :: dleaf_litter_dt(numpft_ed) ! rate of change of leaf litter in each size class: KgC/m2/year. real(r8) :: droot_litter_dt(numpft_ed) ! rate of change of root litter in each size class: KgC/m2/year. - real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/year - real(r8) :: canopy_mortality_leaf_litter(numpft_ed) ! flux in to leaf litter from tree death: KgC/m2/year - real(r8) :: canopy_mortality_root_litter(numpft_ed) ! flux in to froot litter from tree death: KgC/m2/year - real(r8) :: repro(numpft_ed) ! allocation to reproduction per PFT : KgC/m2 !FUEL CHARECTERISTICS @@ -513,7 +509,7 @@ module EDTypesMod real(r8) :: cwd_ag_burned(ncwd) real(r8) :: leaf_litter_burned(numpft_ed) - ! TERMINATION, RECRUITMENT, AND DEMOTION + ! TERMINATION, RECRUITMENT, DEMOTION, and DISTURBANCE real(r8) :: terminated_nindivs(1:nlevsclass_ed,1:mxpft,2) ! number of individuals that were in cohorts which were terminated this timestep, on size x pft x canopy array. real(r8) :: termination_carbonflux(2) ! carbon flux from live to dead pools associated with termination mortality, per canopy level real(r8) :: recruitment_rate(1:mxpft) ! number of individuals that were recruited into new cohorts @@ -522,6 +518,12 @@ module EDTypesMod real(r8) :: promotion_rate(1:nlevsclass_ed) ! rate of individuals promoted from understory to canopy per FATES timestep real(r8) :: promotion_carbonflux ! biomass of promoted individuals from understory to canopy [kgC/ha/day] + ! some diagnostic-only (i.e. not resolved by ODE solver) flux of carbon to CWD and litter pools from termination and canopy mortality + real(r8) :: CWD_AG_diagnostic_input_carbonflux(1:ncwd) ! diagnostic flux to AG CWD [kg C / m2 / yr] + real(r8) :: CWD_BG_diagnostic_input_carbonflux(1:ncwd) ! diagnostic flux to BG CWD [kg C / m2 / yr] + real(r8) :: leaf_litter_diagnostic_input_carbonflux(1:mxpft) ! diagnostic flux to AG litter [kg C / m2 / yr] + real(r8) :: root_litter_diagnostic_input_carbonflux(1:mxpft) ! diagnostic flux to BG litter [kg C / m2 / yr] + end type ed_site_type public :: ed_hist_scpfmaps diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 10926fde70..25a12b2db6 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -39,7 +39,7 @@ module FatesHistoryInterfaceMod integer, private :: ih_fire_fuel_sav_pa integer, private :: ih_fire_fuel_mef_pa integer, private :: ih_sum_fuel_pa - integer, private :: ih_litter_in_pa + integer, private :: ih_litter_in_si integer, private :: ih_litter_out_pa integer, private :: ih_efpot_pa ! NA @@ -1051,7 +1051,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_fire_fuel_sav_pa => this%hvars(ih_fire_fuel_sav_pa)%r81d, & hio_fire_fuel_mef_pa => this%hvars(ih_fire_fuel_mef_pa)%r81d, & hio_sum_fuel_pa => this%hvars(ih_sum_fuel_pa)%r81d, & - hio_litter_in_pa => this%hvars(ih_litter_in_pa)%r81d, & + hio_litter_in_si => this%hvars(ih_litter_in_si)%r81d, & hio_litter_out_pa => this%hvars(ih_litter_out_pa)%r81d, & hio_seed_bank_si => this%hvars(ih_seed_bank_si)%r81d, & hio_seeds_in_pa => this%hvars(ih_seeds_in_pa)%r81d, & @@ -1478,9 +1478,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do ! Update Litter Flux Variables - hio_litter_in_pa(io_pa) = (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in)) & - * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar - hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out)) & + ! put litter_in flux onto site level variable so as to be able to append site-level distubance-related input flux after patch loop + hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & + (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in) + sum(cpatch%root_litter_in)) & + * 1.e3_r8 * 365.0_r8 * daysecs * cpatch%area/AREA + ! keep litter_out at patch level + hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out) & + + sum(cpatch%root_litter_out)) & * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar hio_seeds_in_pa(io_pa) = sum(cpatch%seeds_in) * & @@ -1579,7 +1583,23 @@ subroutine update_history_dyn(this,nc,nsites,sites) sites(s)%termination_carbonflux(2) * 1e3 / (1e4 * daysecs) ! and zero the site-level termination carbon flux variable sites(s)%termination_carbonflux(:) = 0._r8 - + ! + ! add the site-level disturbance-associated cwd and litter input fluxes to thir respective flux fields + do i_cwd = 1, ncwd + hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + & + sites(s)%CWD_AG_diagnostic_input_carbonflux(i_cwd) * 1e3 + hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & + sites(s)%CWD_BG_diagnostic_input_carbonflux(i_cwd) * 1e3 + end do + hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & + (sum(sites(s)%leaf_litter_diagnostic_input_carbonflux) + & + sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * 1e3 + ! and reset the disturbance-related field buffers + sites(s)%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8 + sites(s)%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8 + sites(s)%leaf_litter_diagnostic_input_carbonflux(:) = 0._r8 + sites(s)%root_litter_diagnostic_input_carbonflux(:) = 0._r8 + enddo ! site loop end associate @@ -2122,8 +2142,8 @@ subroutine define_history_vars(this, initialize_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=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_litter_in_pa ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_in_si ) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & long='Litter flux out leaves', use_default='active', & @@ -2538,22 +2558,22 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_si_cwdsc ) - call this%set_history_var(vname='CWD_AG_IN_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_AG_IN_CWDSC', units='gC/m^2/y', & long='size-resolved AG CWD input', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_in_si_cwdsc ) - call this%set_history_var(vname='CWD_BG_IN_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_BG_IN_CWDSC', units='gC/m^2/y', & long='size-resolved BG CWD input', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_in_si_cwdsc ) - call this%set_history_var(vname='CWD_AG_OUT_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_AG_OUT_CWDSC', units='gC/m^2/y', & long='size-resolved AG CWD output', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_out_si_cwdsc ) - call this%set_history_var(vname='CWD_BG_OUT_CWDSC', units='kgC/m^2/y', & + call this%set_history_var(vname='CWD_BG_OUT_CWDSC', units='gC/m^2/y', & long='size-resolved BG CWD output', use_default='active', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_out_si_cwdsc ) From 8aa29b1aa40e1fdf2826df4c1ff3c4e02ecbd05b Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 7 Mar 2017 18:23:49 -0800 Subject: [PATCH 25/46] changed nlevcan to nlevleaf to avoid a name conflict with CLM's own different nlevcan --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 18 +++---- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 4 +- .../ED/biogeochem/EDGrowthFunctionsMod.F90 | 14 ++--- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 8 +-- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 24 ++++----- .../FatesPlantRespPhotosynthMod.F90 | 10 ++-- components/clm/src/ED/main/EDTypesMod.F90 | 52 +++++++++---------- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 8 +-- .../clm/src/ED/main/FatesInterfaceMod.F90 | 4 +- .../src/ED/main/FatesRestartInterfaceMod.F90 | 12 ++--- components/clm/src/main/histFileMod.F90 | 10 ++-- .../clm/src/utils/clmfates_interfaceMod.F90 | 6 +-- 12 files changed, 85 insertions(+), 85 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 23368746c9..7302c7bde5 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -12,7 +12,7 @@ module EDCanopyStructureMod use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd use EDTypesMod , only : nclmax - use EDTypesMod , only : nlevcan + use EDTypesMod , only : nlevleaf use EDTypesMod , only : numpft_ed use FatesGlobals , only : endrun => fates_endrun @@ -96,10 +96,10 @@ subroutine canopy_structure( currentSite ) real(r8) :: cc_loss real(r8) :: lossarea real(r8) :: newarea - real(r8) :: arealayer(nlevcan) ! Amount of plant area currently in each canopy layer - real(r8) :: sumdiff(nlevcan) ! The total of the exclusion weights for all cohorts in layer z + real(r8) :: arealayer(nlevleaf) ! Amount of plant area currently in each canopy layer + real(r8) :: sumdiff(nlevleaf) ! The total of the exclusion weights for all cohorts in layer z real(r8) :: weight ! The amount of the total lost area that comes from this cohort - real(r8) :: sum_weights(nlevcan) + real(r8) :: sum_weights(nlevleaf) real(r8) :: new_total_area_check real(r8) :: missing_area, promarea,cc_gain,sumgain integer :: promswitch,lower_cohort_switch @@ -640,7 +640,7 @@ subroutine canopy_spread( currentSite ) ! !LOCAL VARIABLES: type (ed_cohort_type), pointer :: currentCohort type (ed_patch_type) , pointer :: currentPatch - real(r8) :: arealayer(nlevcan) ! Amount of canopy in each layer. + real(r8) :: arealayer(nlevleaf) ! Amount of canopy in each layer. real(r8) :: inc ! Arbitrary daily incremental change in canopy area integer :: z !---------------------------------------------------------------------- @@ -1141,10 +1141,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) /currentPatch%tlai_profile(L,ft,iv) enddo - currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 - currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 - currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 - currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8 + currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8 + currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8 + currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8 + currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevleaf) = 0._r8 enddo enddo diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 1ff9971d82..a3c64b4691 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -619,7 +619,7 @@ subroutine fuse_cohorts(patchptr) ! Join similar cohorts to reduce total number ! ! !USES: - use EDTypesMod , only : nlevcan + use EDTypesMod , only : nlevleaf ! ! !ARGUMENTS type (ed_patch_type), intent(inout), target :: patchptr @@ -774,7 +774,7 @@ subroutine fuse_cohorts(patchptr) ! recent canopy history currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + nextc%n*nextc%canopy_layer_yesterday)/newn - do i=1, nlevcan + do i=1, nlevleaf if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then currentCohort%year_net_uptake(i) = min(nextc%year_net_uptake(i),currentCohort%year_net_uptake(i)) else diff --git a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 index cd330f1c8b..3059b7b40b 100755 --- a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 @@ -10,7 +10,7 @@ module EDGrowthFunctionsMod use FatesGlobals , only : fates_log use pftconMod , only : pftcon use EDEcophysContype , only : EDecophyscon - use EDTypesMod , only : ed_cohort_type, nlevcan, dinc_ed + use EDTypesMod , only : ed_cohort_type, nlevleaf, dinc_ed implicit none private @@ -159,10 +159,10 @@ real(r8) function tree_lai( cohort_in ) cohort_in%treelai = tree_lai ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it - ! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a + ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a ! huge error - if(cohort_in%treelai > nlevcan*dinc_ed)then - write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevcan * dinc_ed + if(cohort_in%treelai > nlevleaf*dinc_ed)then + write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevleaf * dinc_ed endif return @@ -196,10 +196,10 @@ real(r8) function tree_sai( cohort_in ) cohort_in%treesai = tree_sai ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it - ! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a + ! at the moments nlevleaf default is 40, which is very large, so exceeding this would clearly illustrate a ! huge error - if(cohort_in%treesai > nlevcan*dinc_ed)then - write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevcan * dinc_ed + if(cohort_in%treesai > nlevleaf*dinc_ed)then + write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevleaf * dinc_ed endif return diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index 0cdd239021..ae264b7b40 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -21,7 +21,7 @@ module EDPhysiologyMod use EDTypesMod , only : dg_sf, dinc_ed use EDTypesMod , only : external_recruitment use EDTypesMod , only : ncwd - use EDTypesMod , only : nlevcan + use EDTypesMod , only : nlevleaf use EDTypesMod , only : numpft_ed use EDTypesMod , only : senes use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type @@ -183,13 +183,13 @@ subroutine trim_canopy( currentSite ) trimmed = 0 currentCohort%treelai = tree_lai(currentCohort) currentCohort%nv = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed) - if (currentCohort%nv > nlevcan)then - write(fates_log(),*) 'nv > nlevcan',currentCohort%nv,currentCohort%treelai,currentCohort%treesai, & + if (currentCohort%nv > nlevleaf)then + write(fates_log(),*) 'nv > nlevleaf',currentCohort%nv,currentCohort%treelai,currentCohort%treesai, & currentCohort%c_area,currentCohort%n,currentCohort%bl endif !Leaf cost vs netuptake for each leaf layer. - do z = 1,nlevcan + do z = 1,nlevleaf if (currentCohort%year_net_uptake(z) /= 999._r8)then !there was activity this year in this leaf layer. !Leaf Cost kgC/m2/year-1 !decidous costs. diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index 130b093da0..c44000411f 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -20,7 +20,7 @@ module EDSurfaceRadiationMod use EDTypesMod , only : maxSWb use EDTypesMod , only : nclmax use EDTypesMod , only : numpft_ed - use EDTypesMod , only : nlevcan + use EDTypesMod , only : nlevleaf use EDCanopyStructureMod, only: calc_areaindex use FatesGlobals , only : fates_log @@ -74,10 +74,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: sb real(r8) :: error ! Error check real(r8) :: down_rad, up_rad ! Iterative solution do Dif_dn and Dif_up - real(r8) :: ftweight(nclmax,numpft_ed,nlevcan) + real(r8) :: ftweight(nclmax,numpft_ed,nlevleaf) real(r8) :: k_dir(numpft_ed) ! Direct beam extinction coefficient - real(r8) :: tr_dir_z(nclmax,numpft_ed,nlevcan) ! Exponential transmittance of direct beam radiation through a single layer - real(r8) :: tr_dif_z(nclmax,numpft_ed,nlevcan) ! Exponential transmittance of diffuse radiation through a single layer + real(r8) :: tr_dir_z(nclmax,numpft_ed,nlevleaf) ! Exponential transmittance of direct beam radiation through a single layer + real(r8) :: tr_dif_z(nclmax,numpft_ed,nlevleaf) ! Exponential transmittance of diffuse radiation through a single layer real(r8) :: forc_dir(maxPatchesPerSite,maxSWb) real(r8) :: forc_dif(maxPatchesPerSite,maxSWb) real(r8) :: weighted_dir_tr(nclmax) @@ -85,15 +85,15 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: weighted_dif_ratio(nclmax,maxSWb) real(r8) :: weighted_dif_down(nclmax) real(r8) :: weighted_dif_up(nclmax) - real(r8) :: refl_dif(nclmax,numpft_ed,nlevcan,maxSWb) ! Term for diffuse radiation reflected by laye - real(r8) :: tran_dif(nclmax,numpft_ed,nlevcan,maxSWb) ! Term for diffuse radiation transmitted by layer - real(r8) :: dif_ratio(nclmax,numpft_ed,nlevcan,maxSWb) ! Ratio of upward to forward diffuse fluxes - real(r8) :: Dif_dn(nclmax,numpft_ed,nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) - real(r8) :: Dif_up(nclmax,numpft_ed,nlevcan) ! Upward diffuse flux above canopy layer J (W/m**2 ground area) - real(r8) :: lai_change(nclmax,numpft_ed,nlevcan) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + real(r8) :: refl_dif(nclmax,numpft_ed,nlevleaf,maxSWb) ! Term for diffuse radiation reflected by laye + real(r8) :: tran_dif(nclmax,numpft_ed,nlevleaf,maxSWb) ! Term for diffuse radiation transmitted by layer + real(r8) :: dif_ratio(nclmax,numpft_ed,nlevleaf,maxSWb) ! Ratio of upward to forward diffuse fluxes + real(r8) :: Dif_dn(nclmax,numpft_ed,nlevleaf) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + real(r8) :: Dif_up(nclmax,numpft_ed,nlevleaf) ! Upward diffuse flux above canopy layer J (W/m**2 ground area) + real(r8) :: lai_change(nclmax,numpft_ed,nlevleaf) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) real(r8) :: f_not_abs(numpft_ed,maxSWb) ! Fraction reflected + transmitted. 1-absorbtion. - real(r8) :: Abs_dir_z(numpft_ed,nlevcan) - real(r8) :: Abs_dif_z(numpft_ed,nlevcan) + real(r8) :: Abs_dir_z(numpft_ed,nlevleaf) + real(r8) :: Abs_dif_z(numpft_ed,nlevleaf) real(r8) :: abs_rad(maxSWb) !radiation absorbed by soil real(r8) :: tr_soili ! Radiation transmitted to the soil surface. real(r8) :: tr_soild ! Radiation transmitted to the soil surface. diff --git a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 index 6dd2592c24..17f9d599f1 100644 --- a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -25,7 +25,7 @@ module FATESPlantRespPhotosynthMod use FatesConstantsMod, only : r8 => fates_r8 use EDTypesMod, only : use_fates_plant_hydro use EDTypesMod, only : numpft_ed - use EDTypesMod, only : nlevcan + use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax ! CIME Globals @@ -116,17 +116,17 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! ----------------------------------------------------------------------------------- ! leaf maintenance (dark) respiration (umol CO2/m**2/s) Double check this - real(r8) :: lmr_z(nlevcan,mxpft,nclmax) + real(r8) :: lmr_z(nlevleaf,mxpft,nclmax) ! stomatal resistance s/m - real(r8) :: rs_z(nlevcan,mxpft,nclmax) + real(r8) :: rs_z(nlevleaf,mxpft,nclmax) ! net leaf photosynthesis averaged over sun and shade leaves. (umol CO2/m**2/s) - real(r8) :: anet_av_z(nlevcan,mxpft,nclmax) + real(r8) :: anet_av_z(nlevleaf,mxpft,nclmax) ! Mask used to determine which leaf-layer biophysical rates have been ! used already - logical :: rate_mask_z(nlevcan,mxpft,nclmax) + logical :: rate_mask_z(nlevleaf,mxpft,nclmax) real(r8) :: vcmax_z ! leaf layer maximum rate of carboxylation ! (umol co2/m**2/s) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 246ff6b797..25c3020101 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -10,7 +10,7 @@ module EDTypesMod integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site integer, parameter :: maxCohortsPerPatch = 160 ! maximum number of cohorts to live on a patch integer, parameter :: nclmax = 2 ! Maximum number of canopy layers - integer, parameter :: nlevcan = 40 ! number of leaf layers in canopy layer + integer, parameter :: nlevleaf = 40 ! number of leaf layers in canopy layer integer, parameter :: maxpft = 10 ! maximum number of PFTs allowed ! the parameter file may determine that fewer ! are used, but this helps allocate scratch @@ -213,8 +213,8 @@ module EDTypesMod real(r8) :: npp_bseed ! NPP into seeds: KgC/indiv/year real(r8) :: npp_store ! NPP into storage: KgC/indiv/year - real(r8) :: ts_net_uptake(nlevcan) ! Net uptake of leaf layers: kgC/m2/s - real(r8) :: year_net_uptake(nlevcan) ! Net uptake of leaf layers: kgC/m2/year + real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/s + real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year ! RESPIRATION COMPONENTS real(r8) :: rdark ! Dark respiration: kgC/indiv/s @@ -302,33 +302,33 @@ module EDTypesMod real(r8) :: bare_frac_area ! bare soil in this patch expressed as a fraction of the total soil surface. real(r8) :: lai ! leaf area index of patch - real(r8) :: tlai_profile(nclmax,numpft_ed,nlevcan) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: elai_profile(nclmax,numpft_ed,nlevcan) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: tsai_profile(nclmax,numpft_ed,nlevcan) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: esai_profile(nclmax,numpft_ed,nlevcan) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2 - real(r8) :: layer_height_profile(nclmax,numpft_ed,nlevcan) - real(r8) :: canopy_area_profile(nclmax,numpft_ed,nlevcan) ! fraction of canopy in each canopy + real(r8) :: tlai_profile(nclmax,numpft_ed,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: elai_profile(nclmax,numpft_ed,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: tsai_profile(nclmax,numpft_ed,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: esai_profile(nclmax,numpft_ed,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: layer_height_profile(nclmax,numpft_ed,nlevleaf) + real(r8) :: canopy_area_profile(nclmax,numpft_ed,nlevleaf) ! fraction of canopy in each canopy ! layer, pft, and leaf layer:- integer :: present(nclmax,numpft_ed) ! is there any of this pft in this canopy layer? integer :: nrad(nclmax,numpft_ed) ! number of exposed leaf layers for each canopy layer and pft integer :: ncan(nclmax,numpft_ed) ! number of total leaf layers for each canopy layer and pft !RADIATION FLUXES - real(r8) :: fabd_sun_z(nclmax,numpft_ed,nlevcan) ! sun fraction of direct light absorbed by each canopy + real(r8) :: fabd_sun_z(nclmax,numpft_ed,nlevleaf) ! sun fraction of direct light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabd_sha_z(nclmax,numpft_ed,nlevcan) ! shade fraction of direct light absorbed by each canopy + real(r8) :: fabd_sha_z(nclmax,numpft_ed,nlevleaf) ! shade fraction of direct light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabi_sun_z(nclmax,numpft_ed,nlevcan) ! sun fraction of indirect light absorbed by each canopy + real(r8) :: fabi_sun_z(nclmax,numpft_ed,nlevleaf) ! sun fraction of indirect light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: fabi_sha_z(nclmax,numpft_ed,nlevcan) ! shade fraction of indirect light absorbed by each canopy + real(r8) :: fabi_sha_z(nclmax,numpft_ed,nlevleaf) ! shade fraction of indirect light absorbed by each canopy ! layer, pft, and leaf layer:- - real(r8) :: ed_laisun_z(nclmax,numpft_ed,nlevcan) ! amount of LAI in the sun in each canopy layer, + real(r8) :: ed_laisun_z(nclmax,numpft_ed,nlevleaf) ! amount of LAI in the sun in each canopy layer, ! pft, and leaf layer. m2/m2 - real(r8) :: ed_laisha_z(nclmax,numpft_ed,nlevcan) ! amount of LAI in the shade in each canopy layer, - real(r8) :: ed_parsun_z(nclmax,numpft_ed,nlevcan) ! PAR absorbed in the sun in each canopy layer, - real(r8) :: ed_parsha_z(nclmax,numpft_ed,nlevcan) ! PAR absorbed in the shade in each canopy layer, - real(r8) :: f_sun(nclmax,numpft_ed,nlevcan) ! fraction of leaves in the sun in each canopy layer, pft, + real(r8) :: ed_laisha_z(nclmax,numpft_ed,nlevleaf) ! amount of LAI in the shade in each canopy layer, + real(r8) :: ed_parsun_z(nclmax,numpft_ed,nlevleaf) ! PAR absorbed in the sun in each canopy layer, + real(r8) :: ed_parsha_z(nclmax,numpft_ed,nlevleaf) ! PAR absorbed in the shade in each canopy layer, + real(r8) :: f_sun(nclmax,numpft_ed,nlevleaf) ! fraction of leaves in the sun in each canopy layer, pft, ! and leaf layer. m2/m2 real(r8),allocatable :: tr_soil_dir(:) ! fraction of incoming direct radiation that (cm_numSWb) @@ -351,7 +351,7 @@ module EDTypesMod ! PHOTOSYNTHESIS - real(r8) :: psn_z(nclmax,numpft_ed,nlevcan) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s + real(r8) :: psn_z(nclmax,numpft_ed,nlevleaf) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s ! real(r8) :: gpp ! total patch gpp: KgC/m2/year ! real(r8) :: npp ! total patch npp: KgC/m2/year @@ -552,11 +552,11 @@ subroutine ed_hist_scpfmaps allocate( levage_ed(1:nlevage_ed )) allocate(levcan_ed(nclmax)) - allocate(can_levcnlf_ed(nlevcan*nclmax)) - allocate(lf_levcnlf_ed(nlevcan*nclmax)) - allocate(can_levcnlfpft_ed(nlevcan*nclmax*numpft_ed)) - allocate(lf_levcnlfpft_ed(nlevcan*nclmax*numpft_ed)) - allocate(pft_levcnlfpft_ed(nlevcan*nclmax*numpft_ed)) + allocate(can_levcnlf_ed(nlevleaf*nclmax)) + allocate(lf_levcnlf_ed(nlevleaf*nclmax)) + allocate(can_levcnlfpft_ed(nlevleaf*nclmax*numpft_ed)) + allocate(lf_levcnlfpft_ed(nlevleaf*nclmax*numpft_ed)) + allocate(pft_levcnlfpft_ed(nlevleaf*nclmax*numpft_ed)) ! Fill the IO array of plant size classes ! For some reason the history files did not like @@ -597,7 +597,7 @@ subroutine ed_hist_scpfmaps i=0 do ican=1,nclmax - do ileaf=1,nlevcan + do ileaf=1,nlevleaf i=i+1 can_levcnlf_ed(i) = ican lf_levcnlf_ed(i) = ileaf @@ -607,7 +607,7 @@ subroutine ed_hist_scpfmaps i=0 do ipft=1,numpft_ed do ican=1,nclmax - do ileaf=1,nlevcan + do ileaf=1,nlevleaf i=i+1 can_levcnlfpft_ed(i) = ican lf_levcnlfpft_ed(i) = ileaf diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 29d4074fe8..ee2a48abd9 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1603,7 +1603,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) nlevage_ed, & sclass_ed, & nlevsclass_ed - use EDTypesMod, only : numpft_ed, nclmax, nlevcan + use EDTypesMod, only : numpft_ed, nclmax, nlevleaf ! ! Arguments class(fates_history_interface_type) :: this @@ -1819,10 +1819,10 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! summarize radiation profiles through the canopy do ipft=1,numpft_ed do ican=1,nclmax - do ileaf=1,nlevcan + do ileaf=1,nlevleaf ! calculate where we are on multiplexed dimensions - cnlfpft_indx = ileaf + (ican-1) * nlevcan + (ipft-1) * nlevcan * nclmax - cnlf_indx = ileaf + (ican-1) * nlevcan + cnlfpft_indx = ileaf + (ican-1) * nlevleaf + (ipft-1) * nlevleaf * nclmax + cnlf_indx = ileaf + (ican-1) * nlevleaf ! hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) + & cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 79279454d7..3a1e257665 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -14,7 +14,7 @@ module FatesInterfaceMod use EDTypesMod , only : maxCohortsPerPatch use EDTypesMod , only : maxSWb use EDTypesMod , only : nclmax - use EDTypesMod , only : nlevcan + use EDTypesMod , only : nlevleaf use EDTypesMod , only : numpft_ed use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : fates_global_verbose @@ -646,7 +646,7 @@ subroutine set_fates_global_elements(use_fates) if (use_fates) then fates_maxElementsPerPatch = max(maxCohortsPerPatch, & - numpft_ed * nclmax * nlevcan) + numpft_ed * nclmax * nlevleaf) fates_maxElementsPerSite = maxPatchesPerSite * fates_maxElementsPerPatch diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index f15ff350d1..d8aa0e8c13 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -929,7 +929,7 @@ end subroutine set_restart_var subroutine set_restart_vectors(this,nc,nsites,sites) use EDTypesMod, only : nclmax - use EDTypesMod, only : nlevcan + use EDTypesMod, only : nlevleaf use FatesInterfaceMod, only : fates_maxElementsPerPatch use EDTypesMod, only : numpft_ed use EDTypesMod, only : ed_site_type @@ -1206,9 +1206,9 @@ subroutine set_restart_vectors(this,nc,nsites,sites) if ( DEBUG ) write(fates_log(),*) 'CLTV io_idx_pa_sunz 1 ',io_idx_pa_sunz - if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',nlevcan,numpft_ed,nclmax + if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',nlevleaf,numpft_ed,nclmax - do k = 1,nlevcan ! nlevcan currently 40 + do k = 1,nlevleaf ! nlevleaf currently 40 do j = 1,numpft_ed ! numpft_ed currently 2 do i = 1,nclmax ! nclmax currently 2 rio_fsun_paclftls(io_idx_pa_sunz) = cpatch%f_sun(i,j,k) @@ -1304,7 +1304,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type use EDTypesMod, only : ncwd - use EDTypesMod, only : nlevcan + use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax use FatesInterfaceMod, only : fates_maxElementsPerPatch use EDTypesMod, only : numpft_ed @@ -1501,7 +1501,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : ed_patch_type use EDTypesMod, only : numpft_ed use EDTypesMod, only : ncwd - use EDTypesMod, only : nlevcan + use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax use FatesInterfaceMod, only : fates_maxElementsPerPatch use EDTypesMod, only : numWaterMem @@ -1765,7 +1765,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) if ( DEBUG ) write(fates_log(),*) 'CVTL io_idx_pa_sunz 1 ',io_idx_pa_sunz - do k = 1,nlevcan ! nlevcan currently 40 + do k = 1,nlevleaf ! nlevleaf currently 40 do j = 1,numpft_ed ! numpft_ed currently 2 do i = 1,nclmax ! nclmax currently 2 cpatch%f_sun(i,j,k) = rio_fsun_paclftls(io_idx_pa_sunz) diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index f6183aea00..a937f5b69c 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -23,7 +23,7 @@ module histFileMod use ncdio_pio use EDtypesMod , only : nlevsclass_ed, nlevage_ed use EDtypesMod , only : nfsc, ncwd - use EDtypesMod , only : nlevcan, nclmax, numpft_ed + use EDtypesMod , only : nlevleaf, nclmax, numpft_ed use clm_varpar , only : mxpft ! implicit none @@ -1858,8 +1858,8 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'levcwdsc', ncwd, dimid) call ncd_defdim(lnfid, 'levscpf', nlevsclass_ed*mxpft, dimid) call ncd_defdim(lnfid, 'levcan', nclmax, dimid) - call ncd_defdim(lnfid, 'levcnlf', nlevcan * nclmax, dimid) - call ncd_defdim(lnfid, 'lvcnlfpf', nlevcan * nclmax * numpft_ed, dimid) + call ncd_defdim(lnfid, 'levcnlf', nlevleaf * nclmax, dimid) + call ncd_defdim(lnfid, 'lvcnlfpf', nlevleaf * nclmax * numpft_ed, dimid) end if if ( .not. lhistrest )then @@ -4497,9 +4497,9 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, case ('levcan') num2d = nclmax case ('levcnlf') - num2d = nlevcan * nclmax + num2d = nlevleaf * nclmax case ('lvcnlfpf') - num2d = nlevcan * nclmax * numpft_ed + num2d = nlevleaf * nclmax * numpft_ed case('ltype') num2d = max_lunit case('natpft') diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 746c025b15..9f75ad66c5 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1875,7 +1875,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) use FatesIODimensionsMod, only : fates_bounds_type use EDtypesMod, only : nlevsclass_ed, nlevage_ed use EDtypesMod, only : nfsc, ncwd - use EDtypesMod, only : nlevcan, nclmax, numpft_ed + use EDtypesMod, only : nlevleaf, nclmax, numpft_ed use clm_varpar, only : mxpft, nlevgrnd implicit none @@ -1919,10 +1919,10 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%can_end = nclmax fates%cnlf_begin = 1 - fates%cnlf_end = nlevcan * nclmax + fates%cnlf_end = nlevleaf * nclmax fates%cnlfpft_begin = 1 - fates%cnlfpft_end = nlevcan * nclmax * numpft_ed + fates%cnlfpft_end = nlevleaf * nclmax * numpft_ed end subroutine hlm_bounds_to_fates_bounds From e97b23814b1c0fb5beb264e1cf289d9a4780b7d0 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 7 Mar 2017 20:19:56 -0800 Subject: [PATCH 26/46] assorted unit fixes --- .../clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 30f727e9e6..3444835d51 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1481,18 +1481,18 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! put litter_in flux onto site level variable so as to be able to append site-level distubance-related input flux after patch loop hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in) + sum(cpatch%root_litter_in)) & - * 1.e3_r8 * 365.0_r8 * daysecs * cpatch%area/AREA + * 1.e3_r8 * cpatch%area / ( AREA * 365.0_r8 * daysecs ) ! keep litter_out at patch level hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out) & + sum(cpatch%root_litter_out)) & - * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar + * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) hio_seeds_in_pa(io_pa) = sum(cpatch%seeds_in) * & - 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar + 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) hio_seed_decay_pa(io_pa) = sum(cpatch%seed_decay) & - * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar + * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) hio_seed_germination_pa(io_pa) = sum(cpatch%seed_germination) & - * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar + * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) hio_canopy_spread_pa(io_pa) = cpatch%spread(1) @@ -1593,7 +1593,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & (sum(sites(s)%leaf_litter_diagnostic_input_carbonflux) + & - sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * 1e3 + sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * 1e3 / ( daysecs * yeardays ) ! and reset the disturbance-related field buffers sites(s)%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8 sites(s)%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8 @@ -2141,12 +2141,12 @@ subroutine define_history_vars(this, initialize_variables) ! Litter Variables call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & - long='Litter flux in leaves', use_default='active', & + long='FATES litter flux in', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_litter_in_si ) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & - long='Litter flux out leaves', use_default='active', & + long='FATES litter flux out', use_default='active', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_litter_out_pa ) From 5e6ecdcdb98913b83ea099cc87e109297c95c6ea Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 7 Mar 2017 20:26:05 -0800 Subject: [PATCH 27/46] reverted changes to litter_in and litter_out variables so as to pass tests --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 33 +++++++++++-------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 3444835d51..5467aecafb 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1476,16 +1476,21 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_litter_moisture_si_fuel(io_si, i_fuel) = hio_litter_moisture_si_fuel(io_si, i_fuel) + & cpatch%litter_moisture(i_fuel) * cpatch%area/AREA end do - + !!! +++ cdk +++ commenting out the below changes to revert for bit-for-bit passing !!! ! Update Litter Flux Variables - ! put litter_in flux onto site level variable so as to be able to append site-level distubance-related input flux after patch loop - hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & - (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in) + sum(cpatch%root_litter_in)) & - * 1.e3_r8 * cpatch%area / ( AREA * 365.0_r8 * daysecs ) - ! keep litter_out at patch level - hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out) & - + sum(cpatch%root_litter_out)) & - * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) + ! ! put litter_in flux onto site level variable so as to be able to append site-level distubance-related input flux after patch loop + ! hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & + ! (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in) + sum(cpatch%root_litter_in)) & + ! * 1.e3_r8 * cpatch%area / ( AREA * 365.0_r8 * daysecs ) + ! ! keep litter_out at patch level + ! hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out) & + ! + sum(cpatch%root_litter_out)) & + ! * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) + !!! --- cdk --- !!! + hio_litter_in_si(io_pa) = (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in)) & + * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar + hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out)) & + !!! --- cdk --- !!! hio_seeds_in_pa(io_pa) = sum(cpatch%seeds_in) * & 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) @@ -1591,9 +1596,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & sites(s)%CWD_BG_diagnostic_input_carbonflux(i_cwd) * 1e3 end do - hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & - (sum(sites(s)%leaf_litter_diagnostic_input_carbonflux) + & - sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * 1e3 / ( daysecs * yeardays ) + !!! cdk comment out below line for bit-for-bitness + ! hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & + ! (sum(sites(s)%leaf_litter_diagnostic_input_carbonflux) + & + ! sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * 1e3 / ( daysecs * yeardays ) ! and reset the disturbance-related field buffers sites(s)%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8 sites(s)%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8 @@ -2142,7 +2148,8 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & long='FATES litter flux in', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + !!! cdk reverted to pass bit-for-bitness avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_litter_in_si ) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & From 6dc5d919b649d1926d9f3b1ac10c3667a488fdc1 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 7 Mar 2017 20:51:26 -0800 Subject: [PATCH 28/46] bugfix on the prior --- components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 5467aecafb..7f84e0ff8c 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1490,6 +1490,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_litter_in_si(io_pa) = (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in)) & * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out)) & + * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar !!! --- cdk --- !!! hio_seeds_in_pa(io_pa) = sum(cpatch%seeds_in) * & From 47af51b88e5adc75e494cf4bffd2363650358470 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 8 Mar 2017 19:04:30 -0700 Subject: [PATCH 29/46] Update default fates parameter file Update to new parameter file with the fnitr values reverted to the values in clm_params_ed.c160808.nc Test: SMS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: ed-clm-cdb9db7 Test: status - answer changing --- components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 8268d26dba..23cc75e7dd 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -243,7 +243,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/paramdata/clm5_params.c160713.nc lnd/clm2/paramdata/clm_params.c160713.nc -lnd/clm2/paramdata/fates_params.c170209.nc +lnd/clm2/paramdata/fates_params.c170308.nc From f7158f87a007a0d6ab30c0bbbec92c12bb4b744c Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 8 Mar 2017 20:06:21 -0800 Subject: [PATCH 30/46] fixed some patch%siteptr by replacing with actual currentsite insts --- .../clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 | 12 ++++++------ components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 237c831af5..02217e7688 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -254,9 +254,9 @@ subroutine spawn_patches( currentSite ) call average_patch_properties(currentPatch, new_patch, patch_site_areadis) ! MAY BE REDUNDANT CALL if (currentSite%disturbance_mortality > currentSite%disturbance_fire) then !mortality is dominant disturbance - call mortality_litter_fluxes(currentPatch, new_patch, patch_site_areadis) + call mortality_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) else - call fire_litter_fluxes(currentPatch, new_patch, patch_site_areadis) + call fire_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) endif !INSERT SURVIVORS FROM DISTURBANCE INTO NEW PATCH @@ -513,7 +513,7 @@ subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis end subroutine average_patch_properties ! ============================================================================ - subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) + subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_site_areadis) ! ! !DESCRIPTION: ! CWD pool burned by a fire. @@ -528,12 +528,12 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) use EDtypesMod , only : dg_sf ! ! !ARGUMENTS: + type(ed_site_type) , intent(inout), target :: currentSite type(ed_patch_type) , intent(inout), target :: cp_target type(ed_patch_type) , intent(inout), target :: new_patch_target real(r8) , intent(inout) :: patch_site_areadis ! ! !LOCAL VARIABLES: - type(ed_site_type) , pointer :: currentSite type(ed_patch_type) , pointer :: currentPatch type(ed_patch_type) , pointer :: new_patch type(ed_cohort_type), pointer :: currentCohort @@ -551,7 +551,6 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) if ( currentPatch%fire == 1 ) then !only do this if there was a fire in this actual patch. patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate ! how much land is disturbed in this donor patch? - currentSite => currentPatch%siteptr !************************************/ !PART 1) Burn the fractions of existing litter in the new patch that were consumed by the fire. @@ -688,7 +687,7 @@ subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) end subroutine fire_litter_fluxes ! ============================================================================ - subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) + subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, patch_site_areadis) ! ! !DESCRIPTION: ! Carbon going from ongoing mortality into CWD pools. @@ -698,6 +697,7 @@ subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_aread use SFParamsMod, only : SF_val_cwd_frac ! ! !ARGUMENTS: + type(ed_site_type) , intent(inout), target :: currentSite type(ed_patch_type) , intent(inout), target :: cp_target type(ed_patch_type) , intent(inout), target :: new_patch_target real(r8) , intent(in) :: patch_site_areadis diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index ae264b7b40..f1bee2b6b8 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -1081,7 +1081,7 @@ subroutine recruitment( t, currentSite, currentPatch ) temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p) ! keep track of how many individuals were recruited for passing to history - currentPatch%siteptr%recruitment_rate(ft) = currentPatch%siteptr%recruitment_rate(ft) + temp_cohort%n + currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n endif enddo !pft loop From 5756b44896499c57b8284c38d7b6d79e429afe75 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 8 Mar 2017 20:29:13 -0800 Subject: [PATCH 31/46] bugfixes on prior --- components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 | 1 - components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 | 2 -- 2 files changed, 3 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index faa92a0821..3874df9900 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -500,7 +500,6 @@ subroutine terminate_cohorts( currentSite, patchptr ) type (ed_patch_type), intent(inout), target :: patchptr ! ! !LOCAL VARIABLES: - type (ed_site_type) , pointer :: currentSite type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort type (ed_cohort_type) , pointer :: nextc diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 9ee6a84e33..bad5cfc723 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -729,7 +729,6 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat ! !LOCAL VARIABLES: real(r8) :: cwd_litter_density real(r8) :: litter_area ! area over which to distribute this litter. - type(ed_site_type) , pointer :: currentSite type(ed_cohort_type), pointer :: currentCohort type(ed_patch_type) , pointer :: currentPatch type(ed_patch_type) , pointer :: new_patch @@ -743,7 +742,6 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat !--------------------------------------------------------------------- currentPatch => cp_target - currentSite => currentPatch%siteptr new_patch => new_patch_target canopy_mortality_woody_litter = 0.0_r8 ! mortality generated litter. KgC/m2/day canopy_mortality_leaf_litter(:) = 0.0_r8 From 85ad7abd793ec1919e0836603e5b84431b69cd7e Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 9 Mar 2017 13:45:11 -0800 Subject: [PATCH 32/46] fixed line length issues --- .../clm/src/ED/biogeochem/EDCanopyStructureMod.F90 | 12 ++++++++---- .../clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 7 ++++--- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 9935661d6a..8bf53962e1 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -241,10 +241,12 @@ subroutine canopy_structure( currentSite ) ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr) do c=1,ncwd - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = & + currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA - currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = & + currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA enddo @@ -309,10 +311,12 @@ subroutine canopy_structure( currentSite ) ! keep track of the above fluxes at the site level as a CWD/litter input flux (in kg / site-m2 / yr) do c=1,ncwd - currentSite%CWD_AG_diagnostic_input_carbonflux(c) = currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + currentSite%CWD_AG_diagnostic_input_carbonflux(c) = & + currentSite%CWD_AG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & SF_val_CWD_frac(c) * ED_val_ag_biomass * hlm_days_per_year / AREA - currentSite%CWD_BG_diagnostic_input_carbonflux(c) = currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + currentSite%CWD_BG_diagnostic_input_carbonflux(c) = & + currentSite%CWD_BG_diagnostic_input_carbonflux(c) & + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) * & SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) * hlm_days_per_year / AREA enddo diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b19aaf54f2..f7ccb64da6 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1136,8 +1136,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_bdead_understory_si_scls => this%hvars(ih_npp_bdead_understory_si_scls)%r82d, & hio_npp_bseed_understory_si_scls => this%hvars(ih_npp_bseed_understory_si_scls)%r82d, & hio_npp_store_understory_si_scls => this%hvars(ih_npp_store_understory_si_scls)%r82d, & - hio_yesterdaycanopylevel_canopy_si_scls => this%hvars(ih_yesterdaycanopylevel_canopy_si_scls)%r82d, & - hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, & + hio_yesterdaycanopylevel_canopy_si_scls => this%hvars(ih_yesterdaycanopylevel_canopy_si_scls)%r82d, & + hio_yesterdaycanopylevel_understory_si_scls => this%hvars(ih_yesterdaycanopylevel_understory_si_scls)%r82d, & hio_area_si_age => this%hvars(ih_area_si_age)%r82d, & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & hio_canopy_area_si_age => this%hvars(ih_canopy_area_si_age)%r82d, & @@ -1382,7 +1382,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%npp_bseed * ccohort%n hio_npp_store_canopy_si_scls(io_si,scls) = hio_npp_store_canopy_si_scls(io_si,scls) + & ccohort%npp_store * ccohort%n - hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & + hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & + hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n else hio_bstor_understory_si_scpf(io_si,scpf) = hio_bstor_understory_si_scpf(io_si,scpf) + & From 3e25ba9878b237957266bee19854180bc4e5646c Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 9 Mar 2017 15:07:14 -0700 Subject: [PATCH 33/46] Bugfix in FatesParameterDerivedMod FatesParameterderivedMod was introduced during a merge, and was using the host verison of fnitr from pftcon. It needed no be updated to point to the fates version in EDPftvarcon. Testing: Manual testing of fates_params_c170308.nc in an SMS_D_Ld5.f10_f10.ICLM45ED.yellowstone_intel.clm-edTest is bit for bit with cdb9db7. --- components/clm/src/ED/main/FatesParameterDerivedMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/clm/src/ED/main/FatesParameterDerivedMod.F90 b/components/clm/src/ED/main/FatesParameterDerivedMod.F90 index 41641d754e..f1000ad11f 100644 --- a/components/clm/src/ED/main/FatesParameterDerivedMod.F90 +++ b/components/clm/src/ED/main/FatesParameterDerivedMod.F90 @@ -53,7 +53,7 @@ end subroutine InitAllocate subroutine Init(this,maxpft) - use pftconMod , only: pftcon + use EDPftvarcon, only: EDPftvarcon_inst class(param_derived_type), intent(inout) :: this integer, intent(in) :: maxpft @@ -63,10 +63,10 @@ subroutine Init(this,maxpft) real(r8) :: lnc ! leaf N concentration (gN leaf/m^2) associate( & - slatop => pftcon%slatop , & ! specific leaf area at top of canopy, + slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, ! projected area basis [m^2/gC] - fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-) - leafcn => pftcon%leafcn ) ! leaf C:N (gC/gN) + fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-) + leafcn => EDPftvarcon_inst%leafcn ) ! leaf C:N (gC/gN) call this%InitAllocate(maxpft) From 6fd72fa7ffe6e82bf1b00b986bcfb702ae03bddd Mon Sep 17 00:00:00 2001 From: ckoven Date: Mon, 13 Mar 2017 11:14:40 -0700 Subject: [PATCH 34/46] added same set of vars for each canopy dimension and moved all vars on cnlfpft dimension to be default-off --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 138 ++++++++++++++++-- 1 file changed, 122 insertions(+), 16 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index f7ccb64da6..e932f3a6bf 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -232,6 +232,10 @@ module FatesHistoryInterfaceMod integer, private :: ih_parsha_z_si_cnlf integer, private :: ih_laisun_z_si_cnlf integer, private :: ih_laisha_z_si_cnlf + integer, private :: ih_fabd_sun_si_cnlf + integer, private :: ih_fabd_sha_si_cnlf + integer, private :: ih_fabi_sun_si_cnlf + integer, private :: ih_fabi_sha_si_cnlf ! indices to (site x [canopy layer x leaf layer x pft]) variables integer, private :: ih_parsun_z_si_cnlfpft @@ -244,8 +248,14 @@ module FatesHistoryInterfaceMod integer, private :: ih_fabi_sha_si_cnlfpft ! indices to (site x canopy layer) variables - integer, private :: ih_parsuntop_si_can - integer, private :: ih_parshatop_si_can + integer, private :: ih_parsun_top_si_can + integer, private :: ih_parsha_top_si_can + integer, private :: ih_laisun_top_si_can + integer, private :: ih_laisha_top_si_can + integer, private :: ih_fabd_sun_top_si_can + integer, private :: ih_fabd_sha_top_si_can + integer, private :: ih_fabi_sun_top_si_can + integer, private :: ih_fabi_sha_top_si_can ! The number of variable dim/kind types we have defined (static) integer, parameter :: fates_history_num_dimensions = 12 @@ -1703,12 +1713,22 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_laisha_z_si_cnlf => this%hvars(ih_laisha_z_si_cnlf)%r82d, & hio_laisun_z_si_cnlfpft => this%hvars(ih_laisun_z_si_cnlfpft)%r82d, & hio_laisha_z_si_cnlfpft => this%hvars(ih_laisha_z_si_cnlfpft)%r82d, & + hio_laisun_top_si_can => this%hvars(ih_laisun_top_si_can)%r82d, & + hio_laisha_top_si_can => this%hvars(ih_laisha_top_si_can)%r82d, & hio_fabd_sun_si_cnlfpft => this%hvars(ih_fabd_sun_si_cnlfpft)%r82d, & hio_fabd_sha_si_cnlfpft => this%hvars(ih_fabd_sha_si_cnlfpft)%r82d, & hio_fabi_sun_si_cnlfpft => this%hvars(ih_fabi_sun_si_cnlfpft)%r82d, & hio_fabi_sha_si_cnlfpft => this%hvars(ih_fabi_sha_si_cnlfpft)%r82d, & - hio_parsuntop_si_can => this%hvars(ih_parsuntop_si_can)%r82d, & - hio_parshatop_si_can => this%hvars(ih_parshatop_si_can)%r82d & + hio_fabd_sun_si_cnlf => this%hvars(ih_fabd_sun_si_cnlf)%r82d, & + hio_fabd_sha_si_cnlf => this%hvars(ih_fabd_sha_si_cnlf)%r82d, & + hio_fabi_sun_si_cnlf => this%hvars(ih_fabi_sun_si_cnlf)%r82d, & + hio_fabi_sha_si_cnlf => this%hvars(ih_fabi_sha_si_cnlf)%r82d, & + hio_fabd_sun_top_si_can => this%hvars(ih_fabd_sun_top_si_can)%r82d, & + hio_fabd_sha_top_si_can => this%hvars(ih_fabd_sha_top_si_can)%r82d, & + hio_fabi_sun_top_si_can => this%hvars(ih_fabi_sun_top_si_can)%r82d, & + hio_fabi_sha_top_si_can => this%hvars(ih_fabi_sha_top_si_can)%r82d, & + hio_parsun_top_si_can => this%hvars(ih_parsun_top_si_can)%r82d, & + hio_parsha_top_si_can => this%hvars(ih_parsha_top_si_can)%r82d & ) @@ -1853,6 +1873,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) cnlfpft_indx = ileaf + (ican-1) * nlevleaf + (ipft-1) * nlevleaf * nclmax cnlf_indx = ileaf + (ican-1) * nlevleaf ! + ! first do all the canopy x leaf x pft calculations hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) + & cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) + & @@ -1882,13 +1903,38 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area/AREA hio_laisha_z_si_cnlf(io_si,cnlf_indx) = hio_laisha_z_si_cnlf(io_si,cnlf_indx) + & cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area/AREA + ! + hio_fabd_sun_si_cnlf(io_si,cnlf_indx) = hio_fabd_sun_si_cnlf(io_si,cnlf_indx) + & + cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabd_sha_si_cnlf(io_si,cnlf_indx) = hio_fabd_sha_si_cnlf(io_si,cnlf_indx) + & + cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabi_sun_si_cnlf(io_si,cnlf_indx) = hio_fabi_sun_si_cnlf(io_si,cnlf_indx) + & + cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + hio_fabi_sha_si_cnlf(io_si,cnlf_indx) = hio_fabi_sha_si_cnlf(io_si,cnlf_indx) + & + cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + end do ! ! summarize just the top leaf level across all PFTs, for each canopy level - hio_parsuntop_si_can(io_si,ican) = hio_parsuntop_si_can(io_si,ican) + & + hio_parsun_top_si_can(io_si,ican) = hio_parsun_top_si_can(io_si,ican) + & cpatch%ed_parsun_z(ican,ipft,1) * cpatch%area/AREA - hio_parshatop_si_can(io_si,ican) = hio_parshatop_si_can(io_si,ican) + & + hio_parsha_top_si_can(io_si,ican) = hio_parsha_top_si_can(io_si,ican) + & cpatch%ed_parsha_z(ican,ipft,1) * cpatch%area/AREA + ! + hio_laisun_top_si_can(io_si,ican) = hio_laisun_top_si_can(io_si,ican) + & + cpatch%ed_laisun_z(ican,ipft,1) * cpatch%area/AREA + hio_laisha_top_si_can(io_si,ican) = hio_laisha_top_si_can(io_si,ican) + & + cpatch%ed_laisha_z(ican,ipft,1) * cpatch%area/AREA + ! + hio_fabd_sun_top_si_can(io_si,ican) = hio_fabd_sun_top_si_can(io_si,ican) + & + cpatch%fabd_sun_z(ican,ipft,1) * cpatch%area/AREA + hio_fabd_sha_top_si_can(io_si,ican) = hio_fabd_sha_top_si_can(io_si,ican) + & + cpatch%fabd_sha_z(ican,ipft,1) * cpatch%area/AREA + hio_fabi_sun_top_si_can(io_si,ican) = hio_fabi_sun_top_si_can(io_si,ican) + & + cpatch%fabi_sun_z(ican,ipft,1) * cpatch%area/AREA + hio_fabi_sha_top_si_can(io_si,ican) = hio_fabi_sha_top_si_can(io_si,ican) + & + cpatch%fabi_sha_z(ican,ipft,1) * cpatch%area/AREA + ! end do end do @@ -2296,13 +2342,13 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='PARSUN_Z_CNLFPFT', units='W/m2', & long='PAR absorbed in the sun by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlfpft ) call this%set_history_var(vname='PARSHA_Z_CNLFPFT', units='W/m2', & long='PAR absorbed in the shade by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlfpft ) @@ -2310,13 +2356,13 @@ subroutine define_history_vars(this, initialize_variables) long='PAR absorbed in the sun by top leaf layer in each canopy layer', & use_default='active', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, initialize=initialize_variables, index = ih_parsuntop_si_can ) + ivar=ivar, initialize=initialize_variables, index = ih_parsun_top_si_can ) call this%set_history_var(vname='PARSHA_Z_CAN', units='W/m2', & long='PAR absorbed in the shade by top leaf layer in each canopy layer', & use_default='active', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & - ivar=ivar, initialize=initialize_variables, index = ih_parshatop_si_can ) + ivar=ivar, initialize=initialize_variables, index = ih_parsha_top_si_can ) call this%set_history_var(vname='LAISUN_Z_CNLF', units='m2/m2', & long='LAI in the sun by each canopy and leaf layer', & @@ -2332,40 +2378,100 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='LAISUN_Z_CNLFPFT', units='m2/m2', & long='LAI in the sun by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlfpft ) call this%set_history_var(vname='LAISHA_Z_CNLFPFT', units='m2/m2', & long='LAI in the shade by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisha_z_si_cnlfpft ) + call this%set_history_var(vname='LAISUN_TOP_CAN', units='m2/m2', & + long='LAI in the sun by the top leaf layer of each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_laisun_top_si_can ) + + call this%set_history_var(vname='LAISHA_TOP_CAN', units='m2/m2', & + long='LAI in the shade by the top leaf layer of each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_laisha_top_si_can ) + call this%set_history_var(vname='FABD_SUN_CNLFPFT', units='fraction', & long='sun fraction of direct light absorbed by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_si_cnlfpft ) call this%set_history_var(vname='FABD_SHA_CNLFPFT', units='fraction', & long='shade fraction of direct light absorbed by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_si_cnlfpft ) call this%set_history_var(vname='FABI_SUN_CNLFPFT', units='fraction', & long='sun fraction of indirect light absorbed by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_si_cnlfpft ) call this%set_history_var(vname='FABI_SHA_CNLFPFT', units='fraction', & long='shade fraction of indirect light absorbed by each canopy, leaf, and PFT', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlfpft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_si_cnlfpft ) + call this%set_history_var(vname='FABD_SUN_CNLF', units='fraction', & + long='sun fraction of direct light absorbed by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_si_cnlf ) + + call this%set_history_var(vname='FABD_SHA_CNLF', units='fraction', & + long='shade fraction of direct light absorbed by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_si_cnlf ) + + call this%set_history_var(vname='FABI_SUN_CNLF', units='fraction', & + long='sun fraction of indirect light absorbed by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_si_cnlf ) + + call this%set_history_var(vname='FABI_SHA_CNLF', units='fraction', & + long='shade fraction of indirect light absorbed by each canopy and leaf layer', & + use_default='active', & + avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_si_cnlf ) + + call this%set_history_var(vname='FABD_SUN_TOPLF_BYCANLAYER', units='fraction', & + long='sun fraction of direct light absorbed by the top leaf layer of each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_top_si_can ) + + call this%set_history_var(vname='FABD_SHA_TOPLF_BYCANLAYER', units='fraction', & + long='shade fraction of direct light absorbed by the top leaf layer of each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_top_si_can ) + + call this%set_history_var(vname='FABI_SUN_TOPLF_BYCANLAYER', units='fraction', & + long='sun fraction of indirect light absorbed by the top leaf layer of each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_top_si_can ) + + call this%set_history_var(vname='FABI_SHA_TOPLF_BYCANLAYER', units='fraction', & + long='shade fraction of indirect light absorbed by the top leaf layer of each canopy layer', & + use_default='active', & + avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_top_si_can ) + ! slow carbon fluxes associated with mortality from or transfer betweeen canopy and understory call this%set_history_var(vname='DEMOTION_CARBONFLUX', units = 'gC/m2/s', & long='demotion-associated biomass carbon flux from canopy to understory', use_default='active', & From 7afeecc4d545fcd071dcd2e15d740b744171f4ed Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 14 Mar 2017 16:42:10 -0600 Subject: [PATCH 35/46] Rename EDSharedParams to FatesSynchronizedParam Test suite: ed - yellowstone gnu, intel, pgi hobart nag Test baseline: ed-clm-cdb9db7 Test namelist changes: add fates_paramfile Test answer changes: bit for bit Test summary: all tests pass Test suite: clm_short - yellowstone gnu, intel, pgi Test baseline: clm4_5_12_r195 Test namelist changes: none Test answer changes: bit for bit Test summary: all tests pass --- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 6 ++--- .../FatesPlantRespPhotosynthMod.F90 | 4 ++-- .../FatesSynchronizedParamsMod.F90} | 22 +++++++++---------- .../clm/src/utils/clmfates_interfaceMod.F90 | 1 - .../src/utils/clmfates_paraminterfaceMod.F90 | 6 ++--- 5 files changed, 19 insertions(+), 20 deletions(-) rename components/clm/src/ED/{biogeochem/EDSharedParamsMod.F90 => main/FatesSynchronizedParamsMod.F90} (85%) diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index 1bb570d486..f0e285dea6 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -1140,7 +1140,7 @@ subroutine fragmentation_scaler( currentPatch, bc_in) ! ! !USES: - use EDSharedParamsMod , only : EDParamsShareInst + use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesConstantsMod, only : pi => pi_const ! @@ -1169,8 +1169,8 @@ subroutine fragmentation_scaler( currentPatch, bc_in) ifp = currentPatch%patchno ! set "froz_q10" parameter - froz_q10 = EDParamsShareInst%froz_q10 - Q10 = EDParamsShareInst%Q10 + froz_q10 = FatesSynchronizedParamsInst%froz_q10 + Q10 = FatesSynchronizedParamsInst%Q10 if ( .not. use_century_tfunc ) then !calculate rate constant scalar for soil temperature,assuming that the base rate constants diff --git a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 index 8f530d5444..c30db942f0 100644 --- a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -61,7 +61,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use EDPftvarcon , only : EDPftvarcon_inst ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) use EDParamsMod , only : ED_val_ag_biomass - use EDSharedParamsMod , only : EDParamsShareInst + use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_site_type @@ -205,7 +205,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-) leafcn => EDPftvarcon_inst%leafcn , & ! leaf C:N (gC/gN) frootcn => EDPftvarcon_inst%frootcn, & ! froot C:N (gc/gN) ! slope of BB relationship - q10 => EDParamsShareInst%Q10 ) + q10 => FatesSynchronizedParamsInst%Q10 ) do s = 1,nsites diff --git a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 b/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90 similarity index 85% rename from components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 rename to components/clm/src/ED/main/FatesSynchronizedParamsMod.F90 index fb0f6c6c63..33e50a11f5 100644 --- a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 +++ b/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90 @@ -1,4 +1,4 @@ -module EDSharedParamsMod +module FatesSynchronizedParamsMod !----------------------------------------------------------------------- ! @@ -6,11 +6,11 @@ module EDSharedParamsMod use shr_kind_mod , only: r8 => shr_kind_r8 implicit none - ! EDParamsShareInst. PGI wants the type decl. public but the instance + ! FatesSynchronizedParamsInst. PGI wants the type decl. public but the instance ! is indeed protected. A generic private statement at the start of the module ! overrides the protected functionality with PGI - type, public :: EDParamsShareType + type, public :: FatesSynchronizedParamsType real(r8) :: Q10 ! temperature dependence real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates contains @@ -19,9 +19,9 @@ module EDSharedParamsMod procedure, private :: Init procedure, private :: RegisterParamsScalar procedure, private :: ReceiveParamsScalar - end type EDParamsShareType + end type FatesSynchronizedParamsType - type(EDParamsShareType), public :: EDParamsShareInst + type(FatesSynchronizedParamsType), public :: FatesSynchronizedParamsInst character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -38,7 +38,7 @@ subroutine Init(this) implicit none - class(EDParamsShareType), intent(inout) :: this + class(FatesSynchronizedParamsType), intent(inout) :: this this%Q10 = nan this%froz_q10 = nan @@ -55,7 +55,7 @@ subroutine RegisterParams(this, fates_params) implicit none - class(EDParamsShareType), intent(inout) :: this + class(FatesSynchronizedParamsType), intent(inout) :: this class(fates_parameters_type), intent(inout) :: fates_params call this%Init() @@ -70,7 +70,7 @@ subroutine ReceiveParams(this, fates_params) implicit none - class(EDParamsShareType), intent(inout) :: this + class(FatesSynchronizedParamsType), intent(inout) :: this class(fates_parameters_type), intent(inout) :: fates_params call this%ReceiveParamsScalar(fates_params) @@ -88,7 +88,7 @@ subroutine RegisterParamsScalar(this, fates_params) implicit none - class(EDParamsShareType), intent(inout) :: this + class(FatesSynchronizedParamsType), intent(inout) :: this class(fates_parameters_type), intent(inout) :: fates_params character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_host_allpfts/) @@ -113,7 +113,7 @@ subroutine ReceiveParamsScalar(this, fates_params) implicit none - class(EDParamsShareType), intent(inout) :: this + class(FatesSynchronizedParamsType), intent(inout) :: this class(fates_parameters_type), intent(inout) :: fates_params character(len=param_string_length) :: name @@ -128,4 +128,4 @@ subroutine ReceiveParamsScalar(this, fates_params) end subroutine ReceiveParamsScalar -end module EDSharedParamsMod +end module FatesSynchronizedParamsMod diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index b31dd572ad..668296a065 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1329,7 +1329,6 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & use perf_mod , only : t_startf, t_stopf use PatchType , only : patch use quadraticMod , only : quadratic - use EDSharedParamsMod , only : EDParamsShareInst use EDTypesMod , only : numpft_ed, dinc_ed use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed use EDEcophysContype , only : EDecophyscon diff --git a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 index 847a96da1e..2d9ac58bb5 100644 --- a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 +++ b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 @@ -32,7 +32,7 @@ subroutine FatesReadParameters() use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams - use EDSharedParamsMod, only : EDParamsShareInst + use FatesSynchronizedParamsMod, only : FatesSynchronizedParamsInst implicit none @@ -49,7 +49,7 @@ subroutine FatesReadParameters() call fates_params%Init() call FatesRegisterParams(fates_params) call SpitFireRegisterParams(fates_params) - call EDParamsShareInst%RegisterParams(fates_params) + call FatesSynchronizedParamsInst%RegisterParams(fates_params) is_host_file = .false. call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) @@ -59,7 +59,7 @@ subroutine FatesReadParameters() call FatesReceiveParams(fates_params) call SpitFireReceiveParams(fates_params) - call EDParamsShareInst%ReceiveParams(fates_params) + call FatesSynchronizedParamsInst%ReceiveParams(fates_params) call fates_params%Destroy() deallocate(fates_params) From 3967c6f9158f04ac6b7eddfdc8d0b58054ef0b5a Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 15 Mar 2017 22:15:35 -0700 Subject: [PATCH 36/46] bugfix on merge; needed to register heretofore-NLSC-dimensioned parameters --- components/clm/src/ED/fire/SFParamsMod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 index e159150fce..514c58e12b 100644 --- a/components/clm/src/ED/fire/SFParamsMod.F90 +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -288,6 +288,12 @@ subroutine SpitFireRegisterNFSC(fates_params) call fates_params%RegisterParameter(name=SF_name_mid_moisture_S, dimension_shape=dimension_shape_1d, & dimension_names=dim_names) + call fates_params%RegisterParameter(name=SF_name_alpha_FMC, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_max_decomp, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + end subroutine SpitFireRegisterNFSC !----------------------------------------------------------------------- @@ -324,6 +330,12 @@ subroutine SpitFireReceiveNFSC(fates_params) call fates_params%RetreiveParameter(name=SF_name_mid_moisture_S, & data=SF_val_mid_moisture_S) + call fates_params%RetreiveParameter(name=SF_name_alpha_FMC, & + data=SF_val_alpha_FMC) + + call fates_params%RetreiveParameter(name=SF_name_max_decomp, & + data=SF_val_max_decomp) + end subroutine SpitFireReceiveNFSC !----------------------------------------------------------------------- From a6564bde9e389f1dbd8b78f951fa744c9daf530a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 16 Mar 2017 13:06:17 -0700 Subject: [PATCH 37/46] Converted a list of hard-coded numbers to defined parameters. Likewise, pre-divided parameters when possible. --- components/clm/src/ED/main/EDTypesMod.F90 | 5 + .../clm/src/ED/main/FatesConstantsMod.F90 | 16 +- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 233 +++++++++--------- 3 files changed, 142 insertions(+), 112 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index ce525aac6a..d9621b6729 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -10,6 +10,9 @@ module EDTypesMod integer, parameter :: maxPatchesPerSite = 10 ! maximum number of patches to live on a site integer, parameter :: maxCohortsPerPatch = 160 ! maximum number of cohorts to live on a patch integer, parameter :: nclmax = 2 ! Maximum number of canopy layers + integer, parameter :: ican_upper = 1 ! Nominal index for the upper canopy + integer, parameter :: ican_ustory = 2 ! Nominal index for understory in two-canopy system + integer, parameter :: nlevleaf = 40 ! number of leaf layers in canopy layer integer, parameter :: maxpft = 10 ! maximum number of PFTs allowed ! the parameter file may determine that fewer @@ -35,6 +38,8 @@ module EDTypesMod ! MODEL PARAMETERS real(r8), parameter :: AREA = 10000.0_r8 ! Notional area of simulated forest m2 + real(r8), parameter :: AREA_INV = 1.0e-4_r8 ! Inverse of the notion area (faster math) + integer, parameter :: numWaterMem = 10 ! watermemory saved as site level var ! BIOLOGY/BIOGEOCHEMISTRY diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90 index 9a9896d206..d48dee8d0c 100644 --- a/components/clm/src/ED/main/FatesConstantsMod.F90 +++ b/components/clm/src/ED/main/FatesConstantsMod.F90 @@ -37,15 +37,29 @@ module FatesConstantsMod ! Conversion factor: micromoles per mole real(fates_r8), parameter :: umol_per_mol = 1.0E6_fates_r8 - + + ! Conversion factor: m2 per ha + real(fates_r8), parameter :: m2_per_ha = 1.0e4_fates_r8 + + ! Conversion factor :: ha per m2 + real(fates_r8), parameter :: ha_per_m2 = 1.0e-4_fates_r8 ! Conversion: seconds per minute real(fates_r8), parameter :: sec_per_min = 60.0_fates_r8 ! Conversion: seconds per day real(fates_r8), parameter :: sec_per_day = 86400.0_fates_r8 + + ! Conversion: days per second + real(fates_r8), parameter :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8 + + ! Conversion: days per year + real(fates_r8), parameter :: days_per_year = 365.25_fates_r8 + ! Conversion: years per day + real(fates_r8), parameter :: years_per_day = 1.0_fates_r8/365.25_fates_r8 + ! Physical constants ! universal gas constant [J/K/kmol] diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 9616babaf1..ea1808c532 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -13,6 +13,13 @@ module FatesHistoryInterfaceMod ! FIXME(bja, 2016-10) need to remove CLM dependancy use EDPftvarcon , only : EDPftvarcon_inst + use FatesConstantsMod, only : g_per_kg + use FatesConstantsMod, only : ha_per_m2 + use FatesConstantsMod, only : days_per_sec + use FatesConstantsMod, only : sec_per_day + use FatesConstantsMod, only : days_per_year + use FatesConstantsMod, only : years_per_day + implicit none ! These variables hold the index of the history output structure so we don't @@ -995,6 +1002,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ed_cohort_type, & ed_patch_type, & AREA, & + AREA_INV, & sclass_ed, & nlevsclass_ed, & levage_ed, & @@ -1002,7 +1010,10 @@ subroutine update_history_dyn(this,nc,nsites,sites) mxpft, & levpft_ed, & nfsc, & - ncwd + ncwd, & + ican_upper, & + ican_ustory + use EDParamsMod , only : ED_val_ag_biomass ! Arguments @@ -1033,8 +1044,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort - real(r8), parameter :: daysecs = 86400.0_r8 ! What modeler doesn't recognize 86400? - real(r8), parameter :: yeardays = 365.0_r8 ! ALM/CLM do not use leap-years real(r8), parameter :: tiny = 1.e-5_r8 ! some small number associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & @@ -1182,7 +1191,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_trimming_pa(io_soipa) = 1.0_r8 ! The seed bank is a site level variable - hio_seed_bank_si(io_si) = sum(sites(s)%seed_bank) * 1.e3_r8 + hio_seed_bank_si(io_si) = sum(sites(s)%seed_bank) * g_per_kg ipa = 0 cpatch => sites(s)%oldest_patch @@ -1195,7 +1204,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! Increment the fractional area in each age class bin hio_area_si_age(io_si,cpatch%age_class) = hio_area_si_age(io_si,cpatch%age_class) & - + cpatch%area/AREA + + cpatch%area * AREA_INV ! Increment some patch-age-resolved diagnostics hio_lai_si_age(io_si,cpatch%age_class) = hio_lai_si_age(io_si,cpatch%age_class) & @@ -1221,7 +1230,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! for quantities that are natively at column level, calculate plant ! density using whole area - n_perm2 = ccohort%n/AREA + n_perm2 = ccohort%n * AREA_INV else n_density = 0.0_r8 @@ -1244,27 +1253,27 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if hio_canopy_area_si_age(io_si,cpatch%age_class) = hio_canopy_area_si_age(io_si,cpatch%age_class) & - + ccohort%c_area/AREA + + ccohort%c_area * AREA_INV ! Update biomass components - hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * 1.e3_r8 - hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * 1.e3_r8 - hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b * 1.e3_r8 - hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * ccohort%bdead * 1.e3_r8 - hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * ccohort%balive * 1.e3_r8 + hio_bleaf_pa(io_pa) = hio_bleaf_pa(io_pa) + n_density * ccohort%bl * g_per_kg + hio_bstore_pa(io_pa) = hio_bstore_pa(io_pa) + n_density * ccohort%bstore * g_per_kg + hio_btotal_pa(io_pa) = hio_btotal_pa(io_pa) + n_density * ccohort%b * g_per_kg + hio_bdead_pa(io_pa) = hio_bdead_pa(io_pa) + n_density * ccohort%bdead * g_per_kg + hio_balive_pa(io_pa) = hio_balive_pa(io_pa) + n_density * ccohort%balive * g_per_kg ! Update PFT partitioned biomass components hio_leafbiomass_si_pft(io_si,ft) = hio_leafbiomass_si_pft(io_si,ft) + & - (ccohort%n / AREA) * ccohort%bl * 1.e3_r8 + (ccohort%n * AREA_INV) * ccohort%bl * g_per_kg hio_storebiomass_si_pft(io_si,ft) = hio_storebiomass_si_pft(io_si,ft) + & - (ccohort%n / AREA) * ccohort%bstore * 1.e3_r8 + (ccohort%n * AREA_INV) * ccohort%bstore * g_per_kg hio_nindivs_si_pft(io_si,ft) = hio_nindivs_si_pft(io_si,ft) + & - ccohort%n / AREA + ccohort%n * AREA_INV hio_biomass_si_pft(io_si, ft) = hio_biomass_si_pft(io_si, ft) + & - (ccohort%n / AREA) * ccohort%b * 1.e3_r8 + (ccohort%n * AREA_INV) * ccohort%b * g_per_kg ! Site by Size-Class x PFT (SCPF) ! ------------------------------------------------------------------------ @@ -1345,7 +1354,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bstore * ccohort%n hio_bleaf_canopy_si_scpf(io_si,scpf) = hio_bleaf_canopy_si_scpf(io_si,scpf) + & ccohort%bl * ccohort%n - hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8 + hio_canopy_biomass_pa(io_pa) = hio_canopy_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg hio_mortality_canopy_si_scpf(io_si,scpf) = hio_mortality_canopy_si_scpf(io_si,scpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n hio_nplant_canopy_si_scpf(io_si,scpf) = hio_nplant_canopy_si_scpf(io_si,scpf) + ccohort%n @@ -1362,7 +1371,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & - ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays) + ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! hio_leaf_md_canopy_si_scls(io_si,scls) = hio_leaf_md_canopy_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n @@ -1400,7 +1409,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%bstore * ccohort%n hio_bleaf_understory_si_scpf(io_si,scpf) = hio_bleaf_understory_si_scpf(io_si,scpf) + & ccohort%bl * ccohort%n - hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * 1.e3_r8 + hio_understory_biomass_pa(io_pa) = hio_understory_biomass_pa(io_pa) + n_density * ccohort%b * g_per_kg hio_mortality_understory_si_scpf(io_si,scpf) = hio_mortality_understory_si_scpf(io_si,scpf)+ & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n hio_nplant_understory_si_scpf(io_si,scpf) = hio_nplant_understory_si_scpf(io_si,scpf) + ccohort%n @@ -1417,7 +1426,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * ccohort%n hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & (ccohort%bmort + ccohort%hmort + ccohort%cmort + ccohort%imort + ccohort%fmort) * & - ccohort%b * ccohort%n * 1e3 / (1e4 * daysecs * yeardays) + ccohort%b * ccohort%n * g_per_kg * days_per_sec * years_per_day * ha_per_m2 ! hio_leaf_md_understory_si_scls(io_si,scls) = hio_leaf_md_understory_si_scls(io_si,scls) + & ccohort%leaf_md * ccohort%n @@ -1482,52 +1491,52 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_fire_fuel_eff_moist_pa(io_pa) = cpatch%fuel_eff_moist hio_fire_fuel_sav_pa(io_pa) = cpatch%fuel_sav hio_fire_fuel_mef_pa(io_pa) = cpatch%fuel_mef - hio_sum_fuel_pa(io_pa) = cpatch%sum_fuel * 1.e3_r8 * patch_scaling_scalar + hio_sum_fuel_pa(io_pa) = cpatch%sum_fuel * g_per_kg * patch_scaling_scalar do i_fuel = 1,nfsc hio_litter_moisture_si_fuel(io_si, i_fuel) = hio_litter_moisture_si_fuel(io_si, i_fuel) + & - cpatch%litter_moisture(i_fuel) * cpatch%area/AREA + cpatch%litter_moisture(i_fuel) * cpatch%area * AREA_INV end do !!! +++ cdk +++ commenting out the below changes to revert for bit-for-bit passing !!! ! Update Litter Flux Variables ! ! put litter_in flux onto site level variable so as to be able to append site-level distubance-related input flux after patch loop ! hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & ! (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in) + sum(cpatch%root_litter_in)) & - ! * 1.e3_r8 * cpatch%area / ( AREA * 365.0_r8 * daysecs ) + ! * 1.e3_r8 * cpatch%area / ( AREA * 365.0_r8 * sec_per_day ) ! ! keep litter_out at patch level ! hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out) & ! + sum(cpatch%root_litter_out)) & - ! * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) + ! * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * sec_per_day ) !!! --- cdk --- !!! hio_litter_in_si(io_pa) = (sum(cpatch%CWD_AG_in) +sum(cpatch%leaf_litter_in)) & - * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar + * g_per_kg * days_per_year * sec_per_day * patch_scaling_scalar hio_litter_out_pa(io_pa) = (sum(cpatch%CWD_AG_out)+sum(cpatch%leaf_litter_out)) & - * 1.e3_r8 * 365.0_r8 * daysecs * patch_scaling_scalar + * g_per_kg * days_per_year * sec_per_day * patch_scaling_scalar !!! --- cdk --- !!! hio_seeds_in_pa(io_pa) = sum(cpatch%seeds_in) * & - 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) - hio_seed_decay_pa(io_pa) = sum(cpatch%seed_decay) & - * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) - hio_seed_germination_pa(io_pa) = sum(cpatch%seed_germination) & - * 1.e3_r8 * patch_scaling_scalar / ( 365.0_r8 * daysecs ) + g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec + hio_seed_decay_pa(io_pa) = sum(cpatch%seed_decay) * & + g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec + hio_seed_germination_pa(io_pa) = sum(cpatch%seed_germination) * & + g_per_kg * patch_scaling_scalar * years_per_day * days_per_sec hio_canopy_spread_pa(io_pa) = cpatch%spread(1) do i_cwd = 1, ncwd hio_cwd_ag_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_AG(i_cwd)*cpatch%area/AREA * 1e3 + cpatch%CWD_AG(i_cwd)*cpatch%area * AREA_INV * g_per_kg hio_cwd_bg_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_BG(i_cwd)*cpatch%area/AREA * 1e3 + cpatch%CWD_BG(i_cwd)*cpatch%area * AREA_INV * g_per_kg hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_AG_IN(i_cwd)*cpatch%area/AREA * 1e3 + cpatch%CWD_AG_IN(i_cwd)*cpatch%area * AREA_INV * g_per_kg hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_BG_IN(i_cwd)*cpatch%area/AREA * 1e3 + cpatch%CWD_BG_IN(i_cwd)*cpatch%area * AREA_INV * g_per_kg hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_out_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_AG_OUT(i_cwd)*cpatch%area/AREA * 1e3 + cpatch%CWD_AG_OUT(i_cwd)*cpatch%area * AREA_INV * g_per_kg hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_out_si_cwdsc(io_si, i_cwd) + & - cpatch%CWD_BG_OUT(i_cwd)*cpatch%area/AREA * 1e3 + cpatch%CWD_BG_OUT(i_cwd)*cpatch%area * AREA_INV * g_per_kg end do ipa = ipa + 1 @@ -1551,22 +1560,22 @@ subroutine update_history_dyn(this,nc,nsites,sites) do i_scls = 1,nlevsclass_ed i_scpf = (i_pft-1)*nlevsclass_ed + i_scls hio_m6_si_scpf(io_si,i_scpf) = (sites(s)%terminated_nindivs(i_scls,i_pft,1) + & - sites(s)%terminated_nindivs(i_scls,i_pft,2)) * yeardays + sites(s)%terminated_nindivs(i_scls,i_pft,2)) * days_per_year hio_mortality_canopy_si_scls(io_si,i_scls) = hio_mortality_canopy_si_scls(io_si,i_scls) + & - sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays + sites(s)%terminated_nindivs(i_scls,i_pft,1) * days_per_year hio_mortality_understory_si_scls(io_si,i_scls) = hio_mortality_understory_si_scls(io_si,i_scls) + & - sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays + sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year hio_mortality_canopy_si_scpf(io_si,i_scpf) = hio_mortality_canopy_si_scpf(io_si,i_scpf) + & - sites(s)%terminated_nindivs(i_scls,i_pft,1) * yeardays + sites(s)%terminated_nindivs(i_scls,i_pft,1) * days_per_year hio_mortality_understory_si_scpf(io_si,i_scpf) = hio_mortality_understory_si_scpf(io_si,i_scpf) + & - sites(s)%terminated_nindivs(i_scls,i_pft,2) * yeardays + sites(s)%terminated_nindivs(i_scls,i_pft,2) * days_per_year end do end do sites(s)%terminated_nindivs(:,:,:) = 0._r8 ! pass the recruitment rate as a flux to the history, and then reset the recruitment buffer do i_pft = 1, mxpft - hio_recruitment_si_pft(io_si,i_pft) = sites(s)%recruitment_rate(i_pft) * yeardays + hio_recruitment_si_pft(io_si,i_pft) = sites(s)%recruitment_rate(i_pft) * days_per_year end do sites(s)%recruitment_rate(:) = 0._r8 @@ -1586,33 +1595,34 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! pass demotion rates and associated carbon fluxes to history do i_scls = 1,nlevsclass_ed - hio_demotion_rate_si_scls(io_si,i_scls) = sites(s)%demotion_rate(i_scls) * yeardays - hio_promotion_rate_si_scls(io_si,i_scls) = sites(s)%promotion_rate(i_scls) * yeardays + hio_demotion_rate_si_scls(io_si,i_scls) = sites(s)%demotion_rate(i_scls) * days_per_year + hio_promotion_rate_si_scls(io_si,i_scls) = sites(s)%promotion_rate(i_scls) * days_per_year end do ! ! convert kg C / ha / day to gc / m2 / sec - hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * 1e3 / (1e4 * daysecs) - hio_promotion_carbonflux_si(io_si) = sites(s)%promotion_carbonflux * 1e3 / (1e4 * daysecs) + hio_demotion_carbonflux_si(io_si) = sites(s)%demotion_carbonflux * g_per_kg * ha_per_m2 * days_per_sec + hio_promotion_carbonflux_si(io_si) = sites(s)%promotion_carbonflux * g_per_kg * ha_per_m2 * days_per_sec ! ! mortality-associated carbon fluxes + hio_canopy_mortality_carbonflux_si(io_si) = hio_canopy_mortality_carbonflux_si(io_si) + & - sites(s)%termination_carbonflux(1) * 1e3 / (1e4 * daysecs) + sites(s)%termination_carbonflux(ican_upper) * g_per_kg * days_per_sec * ha_per_m2 hio_understory_mortality_carbonflux_si(io_si) = hio_understory_mortality_carbonflux_si(io_si) + & - sites(s)%termination_carbonflux(2) * 1e3 / (1e4 * daysecs) + sites(s)%termination_carbonflux(ican_ustory) * g_per_kg * days_per_sec * ha_per_m2 ! and zero the site-level termination carbon flux variable sites(s)%termination_carbonflux(:) = 0._r8 ! ! add the site-level disturbance-associated cwd and litter input fluxes to thir respective flux fields do i_cwd = 1, ncwd hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) = hio_cwd_ag_in_si_cwdsc(io_si, i_cwd) + & - sites(s)%CWD_AG_diagnostic_input_carbonflux(i_cwd) * 1e3 + sites(s)%CWD_AG_diagnostic_input_carbonflux(i_cwd) * g_per_kg hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) = hio_cwd_bg_in_si_cwdsc(io_si, i_cwd) + & - sites(s)%CWD_BG_diagnostic_input_carbonflux(i_cwd) * 1e3 + sites(s)%CWD_BG_diagnostic_input_carbonflux(i_cwd) * g_per_kg end do !!! cdk comment out below line for bit-for-bitness ! hio_litter_in_si(io_si) = hio_litter_in_si(io_si) + & ! (sum(sites(s)%leaf_litter_diagnostic_input_carbonflux) + & - ! sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * 1e3 / ( daysecs * yeardays ) + ! sum(sites(s)%root_litter_diagnostic_input_carbonflux)) * g_per_kg / ( sec_per_day * days_per_year ) ! and reset the disturbance-related field buffers sites(s)%CWD_AG_diagnostic_input_carbonflux(:) = 0._r8 sites(s)%CWD_BG_diagnostic_input_carbonflux(:) = 0._r8 @@ -1639,6 +1649,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ed_cohort_type, & ed_patch_type, & AREA, & + AREA_INV, & nlevage_ed, & sclass_ed, & nlevsclass_ed @@ -1670,10 +1681,8 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort + real(r8) :: per_dt_tstep ! Time step in frequency units (/s) - real(r8), parameter :: daysecs = 86400.0_r8 ! What modeler doesn't recognize 86400? - real(r8), parameter :: yeardays = 365.0_r8 ! Should this be 365.25? - associate( hio_gpp_pa => this%hvars(ih_gpp_pa)%r81d, & hio_npp_pa => this%hvars(ih_npp_pa)%r81d, & hio_aresp_pa => this%hvars(ih_aresp_pa)%r81d, & @@ -1735,6 +1744,8 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! Flush the relevant history variables call this%flush_hvars(nc,upfreq_in=2) + per_dt_tstep = 1.0_r8/dt_tstep + do s = 1,nsites io_si = this%iovar_map(nc)%site_index(s) @@ -1758,7 +1769,7 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! TODO: we need a standardized logical function on this (used lots, RGK) if ((cpatch%area .gt. 0._r8) .and. (cpatch%total_canopy_area .gt. 0._r8)) then n_density = ccohort%n/min(cpatch%area,cpatch%total_canopy_area) - n_perm2 = ccohort%n/AREA + n_perm2 = ccohort%n * AREA_INV else n_density = 0.0_r8 n_perm2 = 0.0_r8 @@ -1772,92 +1783,92 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! scale up cohort fluxes to their patches hio_npp_pa(io_pa) = hio_npp_pa(io_pa) + & - ccohort%npp_tstep * 1.e3_r8 * n_density / dt_tstep + ccohort%npp_tstep * g_per_kg * n_density * per_dt_tstep hio_gpp_pa(io_pa) = hio_gpp_pa(io_pa) + & - ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep + ccohort%gpp_tstep * g_per_kg * n_density * per_dt_tstep hio_aresp_pa(io_pa) = hio_aresp_pa(io_pa) + & - ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep + ccohort%resp_tstep * g_per_kg * n_density * per_dt_tstep hio_growth_resp_pa(io_pa) = hio_growth_resp_pa(io_pa) + & - ccohort%resp_g * 1.e3_r8 * n_density / dt_tstep + ccohort%resp_g * g_per_kg * n_density * per_dt_tstep hio_maint_resp_pa(io_pa) = hio_maint_resp_pa(io_pa) + & - ccohort%resp_m * 1.e3_r8 * n_density / dt_tstep + ccohort%resp_m * g_per_kg * n_density * per_dt_tstep ! map ed cohort-level npp fluxes to clm column fluxes - hio_npp_si(io_si) = hio_npp_si(io_si) + ccohort%npp_tstep * n_perm2 * 1.e3_r8 /dt_tstep + hio_npp_si(io_si) = hio_npp_si(io_si) + ccohort%npp_tstep * n_perm2 * g_per_kg * per_dt_tstep ! Total AR (kgC/m2/yr) = (kgC/plant/step) / (s/step) * (plant/m2) * (s/yr) hio_ar_si_scpf(io_si,scpf) = hio_ar_si_scpf(io_si,scpf) + & - (ccohort%resp_tstep/dt_tstep) * n_perm2 * daysecs * yeardays + (ccohort%resp_tstep/dt_tstep) * n_perm2 * sec_per_day * days_per_year ! Growth AR (kgC/m2/yr) hio_ar_grow_si_scpf(io_si,scpf) = hio_ar_grow_si_scpf(io_si,scpf) + & - (ccohort%resp_g/dt_tstep) * n_perm2 * daysecs * yeardays + (ccohort%resp_g/dt_tstep) * n_perm2 * sec_per_day * days_per_year ! Maint AR (kgC/m2/yr) hio_ar_maint_si_scpf(io_si,scpf) = hio_ar_maint_si_scpf(io_si,scpf) + & - (ccohort%resp_m/dt_tstep) * n_perm2 * daysecs * yeardays + (ccohort%resp_m/dt_tstep) * n_perm2 * sec_per_day * days_per_year ! Maintenance AR partition variables are stored as rates (kgC/plant/s) ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) hio_ar_agsapm_si_scpf(io_si,scpf) = hio_ar_agsapm_si_scpf(io_si,scpf) + & - ccohort%livestem_mr * n_perm2 * daysecs * yeardays + ccohort%livestem_mr * n_perm2 * sec_per_day * days_per_year ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) hio_ar_darkm_si_scpf(io_si,scpf) = hio_ar_darkm_si_scpf(io_si,scpf) + & - ccohort%rdark * n_perm2 * daysecs * yeardays + ccohort%rdark * n_perm2 * sec_per_day * days_per_year ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) hio_ar_crootm_si_scpf(io_si,scpf) = hio_ar_crootm_si_scpf(io_si,scpf) + & - ccohort%livecroot_mr * n_perm2 * daysecs * yeardays + ccohort%livecroot_mr * n_perm2 * sec_per_day * days_per_year ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) hio_ar_frootm_si_scpf(io_si,scpf) = hio_ar_frootm_si_scpf(io_si,scpf) + & - ccohort%froot_mr * n_perm2 * daysecs * yeardays + ccohort%froot_mr * n_perm2 * sec_per_day * days_per_year ! accumulate fluxes per patch age bin hio_gpp_si_age(io_si,cpatch%age_class) = hio_gpp_si_age(io_si,cpatch%age_class) & - + ccohort%gpp_tstep * ccohort%n * 1.e3_r8 / dt_tstep + + ccohort%gpp_tstep * ccohort%n * g_per_kg * per_dt_tstep hio_npp_si_age(io_si,cpatch%age_class) = hio_npp_si_age(io_si,cpatch%age_class) & - + ccohort%npp_tstep * ccohort%n * 1.e3_r8 / dt_tstep + + ccohort%npp_tstep * ccohort%n * g_per_kg * per_dt_tstep ! accumulate fluxes on canopy- and understory- separated fluxes if (ccohort%canopy_layer .eq. 1) then hio_gpp_canopy_pa(io_pa) = hio_gpp_canopy_pa(io_pa) + & - ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep + ccohort%gpp_tstep * g_per_kg * n_density * per_dt_tstep hio_ar_canopy_pa(io_pa) = hio_ar_canopy_pa(io_pa) + & - ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep + ccohort%resp_tstep * g_per_kg * n_density * per_dt_tstep ! hio_rdark_canopy_si_scls(io_si,scls) = hio_rdark_canopy_si_scls(io_si,scls) + & - ccohort%rdark * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%rdark * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_livestem_mr_canopy_si_scls(io_si,scls) = hio_livestem_mr_canopy_si_scls(io_si,scls) + & - ccohort%livestem_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%livestem_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_livecroot_mr_canopy_si_scls(io_si,scls) = hio_livecroot_mr_canopy_si_scls(io_si,scls) + & - ccohort%livecroot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%livecroot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_froot_mr_canopy_si_scls(io_si,scls) = hio_froot_mr_canopy_si_scls(io_si,scls) + & - ccohort%froot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%froot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_resp_g_canopy_si_scls(io_si,scls) = hio_resp_g_canopy_si_scls(io_si,scls) + & - ccohort%resp_g * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep + ccohort%resp_g * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep hio_resp_m_canopy_si_scls(io_si,scls) = hio_resp_m_canopy_si_scls(io_si,scls) + & - ccohort%resp_m * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep + ccohort%resp_m * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep else hio_gpp_understory_pa(io_pa) = hio_gpp_understory_pa(io_pa) + & - ccohort%gpp_tstep * 1.e3_r8 * n_density / dt_tstep + ccohort%gpp_tstep * g_per_kg * n_density * per_dt_tstep hio_ar_understory_pa(io_pa) = hio_ar_understory_pa(io_pa) + & - ccohort%resp_tstep * 1.e3_r8 * n_density / dt_tstep + ccohort%resp_tstep * g_per_kg * n_density * per_dt_tstep ! hio_rdark_understory_si_scls(io_si,scls) = hio_rdark_understory_si_scls(io_si,scls) + & - ccohort%rdark * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%rdark * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_livestem_mr_understory_si_scls(io_si,scls) = hio_livestem_mr_understory_si_scls(io_si,scls) + & - ccohort%livestem_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%livestem_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_livecroot_mr_understory_si_scls(io_si,scls) = hio_livecroot_mr_understory_si_scls(io_si,scls) + & - ccohort%livecroot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%livecroot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_froot_mr_understory_si_scls(io_si,scls) = hio_froot_mr_understory_si_scls(io_si,scls) + & - ccohort%froot_mr * 1.e3_r8 * ccohort%n * daysecs * yeardays + ccohort%froot_mr * g_per_kg * ccohort%n * sec_per_day * days_per_year hio_resp_g_understory_si_scls(io_si,scls) = hio_resp_g_understory_si_scls(io_si,scls) + & - ccohort%resp_g * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep + ccohort%resp_g * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep hio_resp_m_understory_si_scls(io_si,scls) = hio_resp_m_understory_si_scls(io_si,scls) + & - ccohort%resp_m * 1.e3_r8 * ccohort%n * daysecs * yeardays / dt_tstep + ccohort%resp_m * g_per_kg * ccohort%n * sec_per_day * days_per_year * per_dt_tstep endif end associate endif @@ -1875,65 +1886,65 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! ! first do all the canopy x leaf x pft calculations hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsun_z_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_parsha_z_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV ! hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_laisun_z_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) = hio_laisha_z_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV ! hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabd_sun_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabd_sha_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabi_sun_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) = hio_fabi_sha_si_cnlfpft(io_si,cnlfpft_indx) + & - cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV ! ! summarize across all PFTs hio_parsun_z_si_cnlf(io_si,cnlf_indx) = hio_parsun_z_si_cnlf(io_si,cnlf_indx) + & - cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_parsun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_parsha_z_si_cnlf(io_si,cnlf_indx) = hio_parsha_z_si_cnlf(io_si,cnlf_indx) + & - cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_parsha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV ! hio_laisun_z_si_cnlf(io_si,cnlf_indx) = hio_laisun_z_si_cnlf(io_si,cnlf_indx) + & - cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_laisun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_laisha_z_si_cnlf(io_si,cnlf_indx) = hio_laisha_z_si_cnlf(io_si,cnlf_indx) + & - cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%ed_laisha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV ! hio_fabd_sun_si_cnlf(io_si,cnlf_indx) = hio_fabd_sun_si_cnlf(io_si,cnlf_indx) + & - cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabd_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_fabd_sha_si_cnlf(io_si,cnlf_indx) = hio_fabd_sha_si_cnlf(io_si,cnlf_indx) + & - cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabd_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_fabi_sun_si_cnlf(io_si,cnlf_indx) = hio_fabi_sun_si_cnlf(io_si,cnlf_indx) + & - cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabi_sun_z(ican,ipft,ileaf) * cpatch%area * AREA_INV hio_fabi_sha_si_cnlf(io_si,cnlf_indx) = hio_fabi_sha_si_cnlf(io_si,cnlf_indx) + & - cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area/AREA + cpatch%fabi_sha_z(ican,ipft,ileaf) * cpatch%area * AREA_INV end do ! ! summarize just the top leaf level across all PFTs, for each canopy level hio_parsun_top_si_can(io_si,ican) = hio_parsun_top_si_can(io_si,ican) + & - cpatch%ed_parsun_z(ican,ipft,1) * cpatch%area/AREA + cpatch%ed_parsun_z(ican,ipft,1) * cpatch%area * AREA_INV hio_parsha_top_si_can(io_si,ican) = hio_parsha_top_si_can(io_si,ican) + & - cpatch%ed_parsha_z(ican,ipft,1) * cpatch%area/AREA + cpatch%ed_parsha_z(ican,ipft,1) * cpatch%area * AREA_INV ! hio_laisun_top_si_can(io_si,ican) = hio_laisun_top_si_can(io_si,ican) + & - cpatch%ed_laisun_z(ican,ipft,1) * cpatch%area/AREA + cpatch%ed_laisun_z(ican,ipft,1) * cpatch%area * AREA_INV hio_laisha_top_si_can(io_si,ican) = hio_laisha_top_si_can(io_si,ican) + & - cpatch%ed_laisha_z(ican,ipft,1) * cpatch%area/AREA + cpatch%ed_laisha_z(ican,ipft,1) * cpatch%area * AREA_INV ! hio_fabd_sun_top_si_can(io_si,ican) = hio_fabd_sun_top_si_can(io_si,ican) + & - cpatch%fabd_sun_z(ican,ipft,1) * cpatch%area/AREA + cpatch%fabd_sun_z(ican,ipft,1) * cpatch%area * AREA_INV hio_fabd_sha_top_si_can(io_si,ican) = hio_fabd_sha_top_si_can(io_si,ican) + & - cpatch%fabd_sha_z(ican,ipft,1) * cpatch%area/AREA + cpatch%fabd_sha_z(ican,ipft,1) * cpatch%area * AREA_INV hio_fabi_sun_top_si_can(io_si,ican) = hio_fabi_sun_top_si_can(io_si,ican) + & - cpatch%fabi_sun_z(ican,ipft,1) * cpatch%area/AREA + cpatch%fabi_sun_z(ican,ipft,1) * cpatch%area * AREA_INV hio_fabi_sha_top_si_can(io_si,ican) = hio_fabi_sha_top_si_can(io_si,ican) + & - cpatch%fabi_sha_z(ican,ipft,1) * cpatch%area/AREA + cpatch%fabi_sha_z(ican,ipft,1) * cpatch%area * AREA_INV ! end do end do From 3e3ecfbb6f944fa5fd3e620e41ca751b19e22e83 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 16 Mar 2017 16:45:41 -0700 Subject: [PATCH 38/46] Renamed dimensions for fates history output. Also renamed some fates-side dimension arrays. --- components/clm/src/ED/main/EDTypesMod.F90 | 91 ++++++------ .../src/ED/main/FatesHistoryInterfaceMod.F90 | 2 - .../clm/src/ED/main/FatesIODimensionsMod.F90 | 29 ++-- components/clm/src/main/histFileMod.F90 | 140 +++++++++--------- 4 files changed, 134 insertions(+), 128 deletions(-) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index d9621b6729..5bdbe5b70f 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -108,23 +108,28 @@ module EDTypesMod (/"background","hydraulic ","carbon ","impact ","fire "/) + ! ------------------------------------------------------------------------------------- ! These vectors are used for history output mapping - real(r8) ,allocatable :: levsclass_ed(:) ! The lower bound on size classes for ED trees. This - ! is used really for IO into the - ! history tapes. It gets copied from - ! the parameter array sclass_ed. - integer , allocatable :: pft_levscpf_ed(:) - integer , allocatable :: scls_levscpf_ed(:) - real(r8), allocatable :: levage_ed(:) - integer , allocatable :: levpft_ed(:) - integer , allocatable :: levfuel_ed(:) - integer , allocatable :: levcwdsc_ed(:) - integer , allocatable :: levcan_ed(:) - integer , allocatable :: can_levcnlf_ed(:) - integer , allocatable :: lf_levcnlf_ed(:) - integer , allocatable :: can_levcnlfpft_ed(:) - integer , allocatable :: lf_levcnlfpft_ed(:) - integer , allocatable :: pft_levcnlfpft_ed(:) + ! CLM/ALM have limited support for multi-dimensional history output arrays. + ! FATES structure and composition is multi-dimensional, so we end up "multi-plexing" + ! multiple dimensions into one dimension. These new dimensions need definitions, + ! mapping to component dimensions, and definitions for those component dimensions as + ! well. + ! ------------------------------------------------------------------------------------- + + real(r8) ,allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension + integer , allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension + integer , allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension + real(r8), allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension + integer , allocatable :: fates_hdim_levpft(:) ! plant pft dimension + integer , allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension + integer , allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension + integer , allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension + integer , allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dimension + integer , allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the canopy-layer x leaf-layer dimension + integer , allocatable :: fates_hdim_canmap_levcnlfpf(:) ! canopy-layer map into the canopy-layer x pft x leaf-layer dimension + integer , allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the canopy-layer x pft x leaf-layer dimension + integer , allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dimension !************************************ @@ -547,46 +552,46 @@ subroutine ed_hist_scpfmaps integer :: ican integer :: ileaf - allocate( levsclass_ed(1:nlevsclass_ed )) - allocate( pft_levscpf_ed(1:nlevsclass_ed*mxpft)) - allocate(scls_levscpf_ed(1:nlevsclass_ed*mxpft)) - allocate( levpft_ed(1:mxpft )) - allocate( levfuel_ed(1:NFSC )) - allocate( levcwdsc_ed(1:NCWD )) - allocate( levage_ed(1:nlevage_ed )) - - allocate(levcan_ed(nclmax)) - allocate(can_levcnlf_ed(nlevleaf*nclmax)) - allocate(lf_levcnlf_ed(nlevleaf*nclmax)) - allocate(can_levcnlfpft_ed(nlevleaf*nclmax*numpft_ed)) - allocate(lf_levcnlfpft_ed(nlevleaf*nclmax*numpft_ed)) - allocate(pft_levcnlfpft_ed(nlevleaf*nclmax*numpft_ed)) + allocate( fates_hdim_levsclass(1:nlevsclass_ed )) + allocate( fates_hdim_pfmap_levscpf(1:nlevsclass_ed*mxpft)) + allocate( fates_hdim_scmap_levscpf(1:nlevsclass_ed*mxpft)) + allocate( fates_hdim_levpft(1:mxpft )) + allocate( fates_hdim_levfuel(1:NFSC )) + allocate( fates_hdim_levcwdsc(1:NCWD )) + allocate( fates_hdim_levage(1:nlevage_ed )) + + allocate( fates_hdim_levcan(nclmax)) + allocate( fates_hdim_canmap_levcnlf(nlevleaf*nclmax)) + allocate( fates_hdim_lfmap_levcnlf(nlevleaf*nclmax)) + allocate( fates_hdim_canmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) + allocate( fates_hdim_lfmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) + allocate( fates_hdim_pftmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) ! Fill the IO array of plant size classes ! For some reason the history files did not like ! a hard allocation of sclass_ed - levsclass_ed(:) = sclass_ed(:) + fates_hdim_levsclass(:) = sclass_ed(:) - levage_ed(:) = ageclass_ed(:) + fates_hdim_levage(:) = ageclass_ed(:) ! make pft array do ipft=1,mxpft - levpft_ed(ipft) = ipft + fates_hdim_levpft(ipft) = ipft end do ! make fuel array do ifuel=1,NFSC - levfuel_ed(ifuel) = ifuel + fates_hdim_levfuel(ifuel) = ifuel end do ! make cwd array do icwd=1,NCWD - levcwdsc_ed(icwd) = icwd + fates_hdim_levcwdsc(icwd) = icwd end do ! make canopy array do ican = 1,nclmax - levcan_ed(ican) = ican + fates_hdim_levcan(ican) = ican end do ! Fill the IO arrays that match pft and size class to their combined array @@ -594,8 +599,8 @@ subroutine ed_hist_scpfmaps do ipft=1,mxpft do isc=1,nlevsclass_ed i=i+1 - pft_levscpf_ed(i) = ipft - scls_levscpf_ed(i) = isc + fates_hdim_pfmap_levscpf(i) = ipft + fates_hdim_scmap_levscpf(i) = isc end do end do @@ -603,8 +608,8 @@ subroutine ed_hist_scpfmaps do ican=1,nclmax do ileaf=1,nlevleaf i=i+1 - can_levcnlf_ed(i) = ican - lf_levcnlf_ed(i) = ileaf + fates_hdim_canmap_levcnlf(i) = ican + fates_hdim_lfmap_levcnlf(i) = ileaf end do end do @@ -613,9 +618,9 @@ subroutine ed_hist_scpfmaps do ican=1,nclmax do ileaf=1,nlevleaf i=i+1 - can_levcnlfpft_ed(i) = ican - lf_levcnlfpft_ed(i) = ileaf - pft_levcnlfpft_ed(i) = ipft + fates_hdim_canmap_levcnlfpf(i) = ican + fates_hdim_lfmap_levcnlfpf(i) = ileaf + fates_hdim_pftmap_levcnlfpf(i) = ipft end do end do end do diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index ea1808c532..93513a9ab7 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1005,10 +1005,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) AREA_INV, & sclass_ed, & nlevsclass_ed, & - levage_ed, & nlevage_ed, & mxpft, & - levpft_ed, & nfsc, & ncwd, & ican_upper, & diff --git a/components/clm/src/ED/main/FatesIODimensionsMod.F90 b/components/clm/src/ED/main/FatesIODimensionsMod.F90 index c118849d5a..b6b4e48d9a 100644 --- a/components/clm/src/ED/main/FatesIODimensionsMod.F90 +++ b/components/clm/src/ED/main/FatesIODimensionsMod.F90 @@ -4,19 +4,22 @@ module FatesIODimensionsMod implicit none - character(*), parameter :: cohort = 'cohort' - character(*), parameter :: patch = 'patch' - character(*), parameter :: column = 'column' - character(*), parameter :: levgrnd = 'levgrnd' - character(*), parameter :: levscpf = 'levscpf' - character(*), parameter :: levscls = 'levscls' - character(*), parameter :: levpft = 'levpft' - character(*), parameter :: levage = 'levage' - character(*), parameter :: levfuel = 'levfuel' - character(*), parameter :: levcwdsc = 'levcwdsc' - character(*), parameter :: levcan = 'levcan' - character(*), parameter :: levcnlf = 'levcnlf' - character(*), parameter :: levcnlfpft = 'lvcnlfpf' + ! The following dimension names must be replicated in + ! CLM/ALMs histFileMod.F90 and + + character(*), parameter :: cohort = 'cohort' ! matches clm_varcon + character(*), parameter :: patch = 'patch' ! matches clm_varcon + character(*), parameter :: column = 'column' ! matches clm_varcon + character(*), parameter :: levgrnd = 'levgrnd' ! matches clm_varcon + character(*), parameter :: levscpf = 'fates_levscpf' ! matches histFileMod + character(*), parameter :: levscls = 'fates_levscls' ! matches histFileMod + character(*), parameter :: levpft = 'fates_levpft' ! matches histFileMod + character(*), parameter :: levage = 'fates_levage' ! matches histFileMod + character(*), parameter :: levfuel = 'fates_levfuel' ! matches histFileMod + character(*), parameter :: levcwdsc = 'fates_levcwdsc' ! matches histFileMod + character(*), parameter :: levcan = 'fates_levcan' ! matches histFileMod + character(*), parameter :: levcnlf = 'fates_levcnlf' ! matches histFileMod + character(*), parameter :: levcnlfpft = 'fates_levcnlfpf' ! matches histFileMod ! patch = This is a structure that records where FATES patch boundaries ! on each thread point to in the host IO array, this structure diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index a937f5b69c..783dfb39a3 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -161,9 +161,9 @@ module histFileMod character(len=max_namlen) :: name ! field name character(len=max_chars) :: long_name ! long name character(len=max_chars) :: units ! units - character(len=8) :: type1d ! pointer to first dimension type from data type (nameg, etc) - character(len=8) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) - character(len=8) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] + character(len=16) :: type1d ! pointer to first dimension type from data type (nameg, etc) + character(len=16) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) + character(len=16) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] integer :: beg1d ! on-node 1d clm pointer start index integer :: end1d ! on-node 1d clm pointer end index integer :: num1d ! size of clm pointer first dimension (all nodes) @@ -821,8 +821,8 @@ subroutine htape_addfld (t, f, avgflag) ! ! !LOCAL VARIABLES: integer :: n ! field index on defined tape - character(len=8) :: type1d ! clm pointer 1d type - character(len=8) :: type1d_out ! history buffer 1d type + character(len=16) :: type1d ! clm pointer 1d type + character(len=16) :: type1d_out ! history buffer 1d type integer :: numa ! total number of atm cells across all processors integer :: numg ! total number of gridcells across all processors integer :: numl ! total number of landunits across all processors @@ -969,7 +969,7 @@ subroutine hist_update_hbuf(bounds) integer :: f ! field index integer :: num2d ! size of second dimension (e.g. number of vertical levels) character(len=*),parameter :: subname = 'hist_update_hbuf' - character(len=8) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] + character(len=16) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] !----------------------------------------------------------------------- do t = 1,ntapes @@ -1013,8 +1013,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -1253,8 +1253,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -1851,15 +1851,15 @@ subroutine htape_create (t, histrest) call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid) if(use_ed)then - call ncd_defdim(lnfid, 'levscls', nlevsclass_ed, dimid) - call ncd_defdim(lnfid, 'levpft', mxpft, dimid) - call ncd_defdim(lnfid, 'levage', nlevage_ed, dimid) - call ncd_defdim(lnfid, 'levfuel', nfsc, dimid) - call ncd_defdim(lnfid, 'levcwdsc', ncwd, dimid) - call ncd_defdim(lnfid, 'levscpf', nlevsclass_ed*mxpft, dimid) - call ncd_defdim(lnfid, 'levcan', nclmax, dimid) - call ncd_defdim(lnfid, 'levcnlf', nlevleaf * nclmax, dimid) - call ncd_defdim(lnfid, 'lvcnlfpf', nlevleaf * nclmax * numpft_ed, dimid) + call ncd_defdim(lnfid, 'fates_levscls', nlevsclass_ed, dimid) + call ncd_defdim(lnfid, 'fates_levpft', mxpft, dimid) + call ncd_defdim(lnfid, 'fates_levage', nlevage_ed, dimid) + call ncd_defdim(lnfid, 'fates_levfuel', nfsc, dimid) + call ncd_defdim(lnfid, 'fates_levcwdsc', ncwd, dimid) + call ncd_defdim(lnfid, 'fates_levscpf', nlevsclass_ed*mxpft, dimid) + call ncd_defdim(lnfid, 'fates_levcan', nclmax, dimid) + call ncd_defdim(lnfid, 'fates_levcnlf', nlevleaf * nclmax, dimid) + call ncd_defdim(lnfid, 'fates_levcnlfpf', nlevleaf * nclmax * numpft_ed, dimid) end if if ( .not. lhistrest )then @@ -2274,11 +2274,11 @@ subroutine htape_timeconst(t, mode) use domainMod , only : ldomain, lon1d, lat1d use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time use clm_time_manager, only : get_ref_date, get_calendar, NO_LEAP_C, GREGORIAN_C - use EDTypesMod, only : levsclass_ed, pft_levscpf_ed, scls_levscpf_ed - use EDTypesMod, only : levage_ed, levpft_ed - use EDTypesMod, only : levfuel_ed, levcwdsc_ed - use EDTypesMod, only : levcan_ed, can_levcnlf_ed, lf_levcnlf_ed - use EDTypesMod, only : can_levcnlfpft_ed, lf_levcnlfpft_ed, pft_levcnlfpft_ed + use EDTypesMod, only : fates_hdim_levsclass, fates_hdim_pfmap_levscpf, fates_hdim_scmap_levscpf + use EDTypesMod, only : fates_hdim_levage, fates_hdim_levpft + use EDTypesMod, only : fates_hdim_levfuel, fates_hdim_levcwdsc + use EDTypesMod, only : fates_hdim_levcan, fates_hdim_canmap_levcnlf, fates_hdim_lfmap_levcnlf + use EDTypesMod, only : fates_hdim_canmap_levcnlfpf, fates_hdim_lfmap_levcnlfpf, fates_hdim_pftmap_levcnlfpf ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index @@ -2330,31 +2330,31 @@ subroutine htape_timeconst(t, mode) long_name='coordinate soil levels', units='m', ncid=nfid(t)) if(use_ed)then - call ncd_defvar(varname='levscls', xtype=tape(t)%ncprec, dim1name='levscls', & + call ncd_defvar(varname='fates_levscls', xtype=tape(t)%ncprec, dim1name='fates_levscls', & long_name='FATES diameter size class lower bound', units='cm', ncid=nfid(t)) - call ncd_defvar(varname='pft_levscpf',xtype=ncd_int, dim1name='levscpf', & + call ncd_defvar(varname='fates_pftmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', & long_name='FATES pft index of the combined pft-size class dimension', units='-', ncid=nfid(t)) - call ncd_defvar(varname='scls_levscpf',xtype=ncd_int, dim1name='levscpf', & + call ncd_defvar(varname='fates_scmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', & long_name='FATES size index of the combined pft-size class dimension', units='-', ncid=nfid(t)) - call ncd_defvar(varname='levage',xtype=tape(t)%ncprec, dim1name='levage', & + call ncd_defvar(varname='fates_levage',xtype=tape(t)%ncprec, dim1name='fates_levage', & long_name='FATES patch age (yr)', ncid=nfid(t)) - call ncd_defvar(varname='levpft',xtype=ncd_int, dim1name='levpft', & + call ncd_defvar(varname='fates_levpft',xtype=ncd_int, dim1name='fates_levpft', & long_name='FATES pft number', ncid=nfid(t)) - call ncd_defvar(varname='levfuel',xtype=ncd_int, dim1name='levfuel', & + call ncd_defvar(varname='fates_levfuel',xtype=ncd_int, dim1name='fates_levfuel', & long_name='FATES fuel index', ncid=nfid(t)) - call ncd_defvar(varname='levcwdsc',xtype=ncd_int, dim1name='levcwdsc', & + call ncd_defvar(varname='fates_levcwdsc',xtype=ncd_int, dim1name='fates_levcwdsc', & long_name='FATES cwd size class', ncid=nfid(t)) - call ncd_defvar(varname='levcan',xtype=ncd_int, dim1name='levcan', & + call ncd_defvar(varname='fates_levcan',xtype=ncd_int, dim1name='fates_levcan', & long_name='FATES canopy level', ncid=nfid(t)) - call ncd_defvar(varname='can_levcnlf',xtype=ncd_int, dim1name='levcnlf', & + call ncd_defvar(varname='fates_canmap_levcnlf',xtype=ncd_int, dim1name='fates_levcnlf', & long_name='FATES canopy level of combined canopy-leaf dimension', ncid=nfid(t)) - call ncd_defvar(varname='lf_levcnlf',xtype=ncd_int, dim1name='levcnlf', & + call ncd_defvar(varname='fates_lfmap_levcnlf',xtype=ncd_int, dim1name='fates_levcnlf', & long_name='FATES leaf level of combined canopy-leaf dimension', ncid=nfid(t)) - call ncd_defvar(varname='can_levcnlfpft',xtype=ncd_int, dim1name='lvcnlfpf', & + call ncd_defvar(varname='fates_canmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', & long_name='FATES canopy level of combined canopy x leaf x pft dimension', ncid=nfid(t)) - call ncd_defvar(varname='lf_levcnlfpft',xtype=ncd_int, dim1name='lvcnlfpf', & + call ncd_defvar(varname='fates_lfmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', & long_name='FATES leaf level of combined canopy x leaf x pft dimension', ncid=nfid(t)) - call ncd_defvar(varname='pft_levcnlfpft',xtype=ncd_int, dim1name='lvcnlfpf', & + call ncd_defvar(varname='fates_pftmap_levcnlfpf',xtype=ncd_int, dim1name='fates_levcnlfpf', & long_name='FATES PFT level of combined canopy x leaf x pft dimension', ncid=nfid(t)) end if @@ -2370,19 +2370,19 @@ subroutine htape_timeconst(t, mode) call ncd_io(varname='levdcmp', data=zsoi_1d, ncid=nfid(t), flag='write') end if if(use_ed)then - call ncd_io(varname='levscls',data=levsclass_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='pft_levscpf',data=pft_levscpf_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='scls_levscpf',data=scls_levscpf_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='levage',data=levage_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='levpft',data=levpft_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='levfuel',data=levfuel_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='levcwdsc',data=levcwdsc_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='levcan',data=levcan_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='can_levcnlf',data=can_levcnlf_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='lf_levcnlf',data=lf_levcnlf_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='can_levcnlfpft',data=can_levcnlfpft_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='lf_levcnlfpft',data=lf_levcnlfpft_ed, ncid=nfid(t), flag='write') - call ncd_io(varname='pft_levcnlfpft',data=pft_levcnlfpft_ed, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_levscls',data=fates_hdim_levsclass, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_pftmap_levscpf',data=fates_hdim_pfmap_levscpf, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_scmap_levscpf',data=fates_hdim_scmap_levscpf, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_levage',data=fates_hdim_levage, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_levpft',data=fates_hdim_levpft, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_levfuel',data=fates_hdim_levfuel, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_levcwdsc',data=fates_hdim_levcwdsc, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_levcan',data=fates_hdim_levcan, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_canmap_levcnlf',data=fates_hdim_canmap_levcnlf, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_lfmap_levcnlf',data=fates_hdim_lfmap_levcnlf, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_canmap_levcnlfpf',data=fates_hdim_canmap_levcnlfpf, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_lfmap_levcnlfpf',data=fates_hdim_lfmap_levcnlfpf, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_pftmap_levcnlfpf',data=fates_hdim_pftmap_levcnlfpf, ncid=nfid(t), flag='write') end if endif @@ -2605,8 +2605,8 @@ subroutine hfields_write(t, mode) character(len=max_chars) :: units ! units character(len=max_namlen):: varname ! variable name character(len=32) :: avgstr ! time averaging type - character(len=8) :: type1d_out ! history output 1d type - character(len=8) :: type2d ! history output 2d type + character(len=16) :: type1d_out ! history output 1d type + character(len=16) :: type2d ! history output 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary real(r8), pointer :: histo(:,:) ! temporary @@ -3317,9 +3317,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) integer :: start(2) character(len=1) :: hnum ! history file index - character(len=8) :: type1d ! clm pointer 1d type - character(len=8) :: type1d_out ! history buffer 1d type - character(len=8) :: type2d ! history buffer 2d type + character(len=16) :: type1d ! clm pointer 1d type + character(len=16) :: type1d_out ! history buffer 1d type + character(len=16) :: type2d ! history buffer 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary type(var_desc_t) :: name_desc ! variable descriptor for name @@ -4209,8 +4209,8 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! !LOCAL VARIABLES: integer :: p,c,l,g ! indices integer :: hpindex ! history buffer pointer index - character(len=8) :: l_type1d ! 1d data type - character(len=8) :: l_type1d_out ! 1d output type + character(len=16) :: l_type1d ! 1d data type + character(len=16) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells @@ -4435,8 +4435,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, integer :: p,c,l,g ! indices integer :: num2d ! size of second dimension (e.g. number of vertical levels) integer :: hpindex ! history buffer index - character(len=8) :: l_type1d ! 1d data type - character(len=8) :: l_type1d_out ! 1d output type + character(len=16) :: l_type1d ! 1d data type + character(len=16) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells @@ -4482,27 +4482,27 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, num2d = numrad case ('levdcmp') num2d = nlevdecomp_full - case ('levscls') + case ('fates_levscls') num2d = nlevsclass_ed - case ('levpft') + case ('fates_levpft') num2d = mxpft - case ('levage') + case ('fates_levage') num2d = nlevage_ed - case ('levfuel') + case ('fates_levfuel') num2d = nfsc - case ('levcwdsc') + case ('fates_levcwdsc') num2d = ncwd - case ('levscpf') + case ('fates_levscpf') num2d = nlevsclass_ed*mxpft - case ('levcan') + case ('fates_levcan') num2d = nclmax - case ('levcnlf') + case ('fates_levcnlf') num2d = nlevleaf * nclmax - case ('lvcnlfpf') + case ('fates_levcnlfpf') num2d = nlevleaf * nclmax * numpft_ed - case('ltype') + case ('ltype') num2d = max_lunit - case('natpft') + case ('natpft') num2d = natpft_size case('cft') if (cft_size > 0) then From 22f1d23ab3eb5de92e96445320ad83c55c1f6521 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 16 Mar 2017 19:14:42 -0700 Subject: [PATCH 39/46] Added in the size x age dimension. Moved around and added functions that help identify size, age and type classes. --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 18 +++-- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 25 +----- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 8 +- components/clm/src/ED/main/EDMainMod.F90 | 3 +- components/clm/src/ED/main/EDTypesMod.F90 | 76 ++++++++++++++++++- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 76 +++++++++++++++---- .../src/ED/main/FatesHistoryVariableType.F90 | 10 ++- .../clm/src/ED/main/FatesIODimensionsMod.F90 | 6 ++ .../src/ED/main/FatesIOVariableKindMod.F90 | 1 + components/clm/src/main/histFileMod.F90 | 11 +++ .../clm/src/utils/clmfates_interfaceMod.F90 | 15 +++- 11 files changed, 197 insertions(+), 52 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 6e3f34e0c3..7ff3b8e0a1 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -735,7 +735,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use FatesInterfaceMod , only : bc_in_type use EDPatchDynamicsMod , only : set_patchno use EDPatchDYnamicsMod , only : set_root_fraction - use EDCohortDynamicsMod , only : size_and_type_class_index + use EDTypesMod , only : sizetype_class_index use EDGrowthFunctionsMod , only : tree_lai, c_area use EDEcophysConType , only : EDecophyscon use EDtypesMod , only : area @@ -791,8 +791,8 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ! Update the cohort's index within the size bin classes ! Update the cohort's index within the SCPF classification system - call size_and_type_class_index(currentCohort%dbh,currentCohort%pft, & - currentCohort%size_class,currentCohort%size_by_pft_class) + call sizetype_class_index(currentCohort%dbh,currentCohort%pft, & + currentCohort%size_class,currentCohort%size_by_pft_class) currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore @@ -810,13 +810,16 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ! Check for erroneous zero values. if(currentCohort%dbh <= 0._r8 .or. currentCohort%n == 0._r8)then - write(fates_log(),*) 'ED: dbh or n is zero in canopy_summarization', currentCohort%dbh,currentCohort%n + write(fates_log(),*) 'ED: dbh or n is zero in canopy_summarization', & + currentCohort%dbh,currentCohort%n endif if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then - write(fates_log(),*) 'ED: PFT or trim is zero in canopy_summarization',currentCohort%pft,currentCohort%canopy_trim + write(fates_log(),*) 'ED: PFT or trim is zero in canopy_summarization', & + currentCohort%pft,currentCohort%canopy_trim endif if(currentCohort%balive <= 0._r8)then - write(fates_log(),*) 'ED: balive is zero in canopy_summarization',currentCohort%balive + write(fates_log(),*) 'ED: balive is zero in canopy_summarization', & + currentCohort%balive endif currentCohort => currentCohort%taller @@ -824,7 +827,8 @@ subroutine canopy_summarization( nsites, sites, bc_in ) enddo ! ends 'do while(associated(currentCohort)) if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then - write(fates_log(),*) 'ED: canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area + write(fates_log(),*) 'ED: canopy area bigger than area', & + currentPatch%total_canopy_area ,currentPatch%area currentPatch%total_canopy_area = currentPatch%area endif diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 274202a138..74cf8c3e02 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -21,6 +21,7 @@ module EDCohortDynamicsMod use EDTypesMod , only : sclass_ed,nlevsclass_ed,AREA use EDTypesMod , only : min_npm2, min_nppatch use EDTypesMod , only : min_n_safemath + use EDTypesMod , only : sizetype_class_index ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg ! @@ -36,7 +37,6 @@ module EDCohortDynamicsMod public :: sort_cohorts public :: copy_cohort public :: count_cohorts - public :: size_and_type_class_index public :: allocate_live_biomass logical, parameter :: DEBUG = .false. ! local debug flag @@ -105,8 +105,8 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%balive = balive new_cohort%bstore = bstore - call size_and_type_class_index(new_cohort%dbh,new_cohort%pft, & - new_cohort%size_class,new_cohort%size_by_pft_class) + call sizetype_class_index(new_cohort%dbh,new_cohort%pft, & + new_cohort%size_class,new_cohort%size_by_pft_class) if ( DEBUG ) write(fates_log(),*) 'EDCohortDyn I ',bstore @@ -1196,25 +1196,6 @@ function count_cohorts( currentPatch ) result ( backcount ) end function count_cohorts - ! ===================================================================================== - - subroutine size_and_type_class_index(dbh,pft,size_class,size_by_pft_class) - - use EDTypesMod, only: sclass_ed - use EDTypesMod, only: nlevsclass_ed - - ! Arguments - real(r8),intent(in) :: dbh - integer,intent(in) :: pft - integer,intent(out) :: size_class - integer,intent(out) :: size_by_pft_class - - size_class = count(dbh-sclass_ed.ge.0.0_r8) - - size_by_pft_class = (pft-1)*nlevsclass_ed+size_class - - return - end subroutine size_and_type_class_index diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 502d4880ee..dff9daeb78 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -37,7 +37,6 @@ module EDPatchDynamicsMod public :: check_patch_area public :: set_patchno public :: set_root_fraction - private:: fuse_2_patches @@ -1197,7 +1196,7 @@ subroutine fuse_2_patches(dp, rp) ! associated with the secnd patch ! ! !USES: - use EDTypesMod, only: ageclass_ed + use EDTypesMod, only: get_age_class_index ! ! !ARGUMENTS: type (ed_patch_type) , intent(inout), pointer :: dp ! Donor Patch @@ -1217,7 +1216,7 @@ subroutine fuse_2_patches(dp, rp) !area weighted average of ages & litter rp%age = (dp%age * dp%area + rp%age * rp%area)/(dp%area + rp%area) - rp%age_class = count(rp%age-ageclass_ed.ge.0.0_r8) + rp%age_class = get_age_class_index(rp%age) do p = 1,numpft_ed rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area)/(rp%area + dp%area) @@ -1586,5 +1585,4 @@ subroutine set_root_fraction( cpatch , depth_gl ) end subroutine set_root_fraction - -end module EDPatchDynamicsMod + end module EDPatchDynamicsMod diff --git a/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90 index 780787e2df..aed9edc5af 100755 --- a/components/clm/src/ED/main/EDMainMod.F90 +++ b/components/clm/src/ED/main/EDMainMod.F90 @@ -22,6 +22,7 @@ module EDMainMod use EDPatchDynamicsMod , only : fuse_patches use EDPatchDynamicsMod , only : spawn_patches use EDPatchDynamicsMod , only : terminate_patches + use EDTypesMod , only : get_age_class_index use EDPhysiologyMod , only : canopy_derivs use EDPhysiologyMod , only : non_canopy_derivs use EDPhysiologyMod , only : phenology @@ -190,7 +191,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) endif ! check to see if the patch has moved to the next age class - currentPatch%age_class = count(currentPatch%age-ageclass_ed.ge.0.0_r8) + currentPatch%age_class = get_age_class_index(currentPatch%age) ! Find the derivatives of the growth and litter processes. call canopy_derivs(currentSite, currentPatch, bc_in) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 5bdbe5b70f..c150970a03 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -130,7 +130,8 @@ module EDTypesMod integer , allocatable :: fates_hdim_canmap_levcnlfpf(:) ! canopy-layer map into the canopy-layer x pft x leaf-layer dimension integer , allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the canopy-layer x pft x leaf-layer dimension integer , allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dimension - + integer , allocatable :: fates_hdim_scmap_levscag(:) ! map of size-class into size-class x patch age dimension + integer , allocatable :: fates_hdim_agmap_levscag(:) ! map of patch-age into size-class x patch age dimension !************************************ !** COHORT type structure ** @@ -551,6 +552,7 @@ subroutine ed_hist_scpfmaps integer :: ifuel integer :: ican integer :: ileaf + integer :: iage allocate( fates_hdim_levsclass(1:nlevsclass_ed )) allocate( fates_hdim_pfmap_levscpf(1:nlevsclass_ed*mxpft)) @@ -566,6 +568,8 @@ subroutine ed_hist_scpfmaps allocate( fates_hdim_canmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) allocate( fates_hdim_lfmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) allocate( fates_hdim_pftmap_levcnlfpf(nlevleaf*nclmax*numpft_ed)) + allocate( fates_hdim_scmap_levscag(nlevsclass_ed * nlevage_ed )) + allocate( fates_hdim_agmap_levscag(nlevsclass_ed * nlevage_ed )) ! Fill the IO array of plant size classes ! For some reason the history files did not like @@ -613,6 +617,15 @@ subroutine ed_hist_scpfmaps end do end do + i=0 + do iage=1,nlevage_ed + do isc=1,nlevsclass_ed + i=i+1 + fates_hdim_scmap_levscag(i) = isc + fates_hdim_agmap_levscag(i) = iage + end do + end do + i=0 do ipft=1,numpft_ed do ican=1,nclmax @@ -627,4 +640,65 @@ subroutine ed_hist_scpfmaps end subroutine ed_hist_scpfmaps + ! ===================================================================================== + + function get_age_class_index(age) result( patch_age_class ) + + real(r8), intent(in) :: age + + integer :: patch_age_class + + patch_age_class = count(age-ageclass_ed.ge.0.0_r8) + + end function get_age_class_index + + ! ===================================================================================== + + function get_sizeage_class_index(dbh,age) result(size_by_age_class) + + ! Arguments + real(r8),intent(in) :: dbh + real(r8),intent(in) :: age + + integer :: size_class + integer :: age_class + integer :: size_by_age_class + + size_class = get_size_class_index(dbh) + + age_class = get_age_class_index(age) + + size_by_age_class = (age_class-1)*nlevage_ed + size_class + + end function get_sizeage_class_index + + ! ===================================================================================== + + subroutine sizetype_class_index(dbh,pft,size_class,size_by_pft_class) + + ! Arguments + real(r8),intent(in) :: dbh + integer,intent(in) :: pft + integer,intent(out) :: size_class + integer,intent(out) :: size_by_pft_class + + size_class = get_size_class_index(dbh) + + size_by_pft_class = (pft-1)*nlevsclass_ed+size_class + + return + end subroutine sizetype_class_index + + ! ===================================================================================== + + function get_size_class_index(dbh) result(cohort_size_class) + + real(r8), intent(in) :: dbh + + integer :: cohort_size_class + + cohort_size_class = count(dbh-sclass_ed.ge.0.0_r8) + + end function get_size_class_index + end module EDTypesMod diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 93513a9ab7..098ef3a7c5 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -76,6 +76,9 @@ module FatesHistoryInterfaceMod integer, private :: ih_canopy_biomass_pa integer, private :: ih_understory_biomass_pa + ! Indices to site by size-class by pft variables + integer, private :: ih_nplant_si_scag + ! Indices to (site) variables integer, private :: ih_nep_si integer, private :: ih_nep_timeintegrated_si @@ -265,8 +268,8 @@ module FatesHistoryInterfaceMod integer, private :: ih_fabi_sha_top_si_can ! The number of variable dim/kind types we have defined (static) - integer, parameter :: fates_history_num_dimensions = 12 - integer, parameter :: fates_history_num_dim_kinds = 14 + integer, parameter :: fates_history_num_dimensions = 13 + integer, parameter :: fates_history_num_dim_kinds = 15 @@ -301,7 +304,7 @@ module FatesHistoryInterfaceMod integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ integer, private :: levscls_index_, levpft_index_, levage_index_ - integer, private :: levfuel_index_, levcwdsc_index_ + integer, private :: levfuel_index_, levcwdsc_index_, levscag_index_ integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_ contains @@ -328,6 +331,7 @@ module FatesHistoryInterfaceMod procedure, public :: levcan_index procedure, public :: levcnlf_index procedure, public :: levcnlfpft_index + procedure, public :: levscag_index ! private work functions procedure, private :: define_history_vars @@ -348,6 +352,7 @@ module FatesHistoryInterfaceMod procedure, private :: set_levcan_index procedure, private :: set_levcnlf_index procedure, private :: set_levcnlfpft_index + procedure, private :: set_levscag_index end type fates_history_interface_type @@ -361,7 +366,7 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf use FatesIODimensionsMod, only : levscls, levpft, levage - use FatesIODimensionsMod, only : levfuel, levcwdsc + use FatesIODimensionsMod, only : levfuel, levcwdsc, levscag use FatesIODimensionsMod, only : levcan, levcnlf, levcnlfpft use FatesIODimensionsMod, only : fates_bounds_type @@ -433,6 +438,12 @@ subroutine Init(this, num_threads, fates_bounds) call this%dim_bounds(dim_count)%Init(levcnlfpft, num_threads, & fates_bounds%cnlfpft_begin, fates_bounds%cnlfpft_end) + dim_count = dim_count + 1 + call this%set_levscag_index(dim_count) + call this%dim_bounds(dim_count)%Init(levscag, num_threads, & + fates_bounds%sizeage_class_begin, fates_bounds%sizeage_class_end) + + ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) ! Allocate the mapping between FATES indices and the IO indices @@ -500,7 +511,11 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) index = this%levcnlfpft_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & - thread_bounds%cnlfpft_begin, thread_bounds%cnlfpft_end) + thread_bounds%cnlfpft_begin, thread_bounds%cnlfpft_end) + + index = this%levscag_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%sizeage_class_begin, thread_bounds%sizeage_class_end) end subroutine SetThreadBoundsEach @@ -510,7 +525,7 @@ subroutine assemble_history_output_types(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none @@ -559,6 +574,9 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_cnlfpft_r8, 1, this%column_index()) call this%set_dim_indices(site_cnlfpft_r8, 2, this%levcnlfpft_index()) + call this%set_dim_indices(site_scag_r8, 1, this%column_index()) + call this%set_dim_indices(site_scag_r8, 2, this%levscag_index()) + end subroutine assemble_history_output_types ! =================================================================================== @@ -769,7 +787,22 @@ integer function levcnlfpft_index(this) class(fates_history_interface_type), intent(in) :: this levcnlfpft_index = this%levcnlfpft_index_ end function levcnlfpft_index + ! ====================================================================================== + subroutine set_levscag_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levscag_index_ = index + end subroutine set_levscag_index + + integer function levscag_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levscag_index = this%levscag_index_ + end function levscag_index + ! ====================================================================================== + subroutine flush_hvars(this,nc,upfreq_in) @@ -863,7 +896,7 @@ subroutine init_dim_kinds_maps(this) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none @@ -930,6 +963,10 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_cnlfpft_r8, 2) + ! site x size-class x age class + index = index + 1 + call this%dim_kinds(index)%Init(site_scag_r8, 2) + ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps @@ -1003,7 +1040,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) ed_patch_type, & AREA, & AREA_INV, & - sclass_ed, & nlevsclass_ed, & nlevage_ed, & mxpft, & @@ -1012,7 +1048,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) ican_upper, & ican_ustory - use EDParamsMod , only : ED_val_ag_biomass + use EDParamsMod , only : ED_val_ag_biomass + use EDTypesMod , only : get_sizeage_class_index ! Arguments class(fates_history_interface_type) :: this @@ -1032,7 +1069,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: ft ! functional type index integer :: i_scpf,i_pft,i_scls ! iterators for scpf, pft, and scls dims integer :: i_cwd,i_fuel ! iterators for cwd and fuel dims - + integer :: iscag ! size-class x age index + real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column real(r8) :: patch_scaling_scalar ! ratio of canopy to patch area for counteracting patch scaling @@ -1166,7 +1204,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_cwd_ag_in_si_cwdsc => this%hvars(ih_cwd_ag_in_si_cwdsc)%r82d, & hio_cwd_bg_in_si_cwdsc => this%hvars(ih_cwd_bg_in_si_cwdsc)%r82d, & hio_cwd_ag_out_si_cwdsc => this%hvars(ih_cwd_ag_out_si_cwdsc)%r82d, & - hio_cwd_bg_out_si_cwdsc => this%hvars(ih_cwd_bg_out_si_cwdsc)%r82d) + hio_cwd_bg_out_si_cwdsc => this%hvars(ih_cwd_bg_out_si_cwdsc)%r82d, & + hio_nplant_si_scag => this%hvars(ih_nplant_si_scag)%r82d) ! --------------------------------------------------------------------------------- @@ -1346,6 +1385,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) ccohort%ddbhdt*ccohort%n end if + ! update size-class x patch-age related quantities + + iscag = get_sizeage_class_index(ccohort%dbh,cpatch%age) + + hio_nplant_si_scag(io_si,iscag) = hio_nplant_si_scag(io_si,iscag) + ccohort%n + ! update SCPF/SCLS- and canopy/subcanopy- partitioned quantities if (ccohort%canopy_layer .eq. 1) then hio_bstor_canopy_si_scpf(io_si,scpf) = hio_bstor_canopy_si_scpf(io_si,scpf) + & @@ -1649,7 +1694,6 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) AREA, & AREA_INV, & nlevage_ed, & - sclass_ed, & nlevsclass_ed use EDTypesMod, only : numpft_ed, nclmax, nlevleaf ! @@ -2033,7 +2077,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none @@ -2503,6 +2547,12 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_understory_mortality_carbonflux_si ) + call this%set_history_var(vname='NPLANT_SCAG',units = 'plants/ha', & + long='number of plants per hectare in each size x age class', use_default='active', & + avgflag='A', vtype=site_scag_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scag ) + + ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! ! (BECAUSE THEY TAKE UP SPACE!!! ! =================================================================================== diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 index cbcc25b863..eca19a316c 100644 --- a/components/clm/src/ED/main/FatesHistoryVariableType.F90 +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -46,7 +46,7 @@ subroutine Init(this, vname, units, long, use_default, & use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIOVariableKindMod, only : iotype_index @@ -153,6 +153,10 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_scag_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' @@ -219,7 +223,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 implicit none @@ -262,6 +266,8 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_cnlfpft_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_scag_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(patch_int) this%int1d(lb1:ub1) = nint(this%flushval) case default diff --git a/components/clm/src/ED/main/FatesIODimensionsMod.F90 b/components/clm/src/ED/main/FatesIODimensionsMod.F90 index b6b4e48d9a..1dd5cce0b9 100644 --- a/components/clm/src/ED/main/FatesIODimensionsMod.F90 +++ b/components/clm/src/ED/main/FatesIODimensionsMod.F90 @@ -11,6 +11,7 @@ module FatesIODimensionsMod character(*), parameter :: patch = 'patch' ! matches clm_varcon character(*), parameter :: column = 'column' ! matches clm_varcon character(*), parameter :: levgrnd = 'levgrnd' ! matches clm_varcon + character(*), parameter :: levscag = 'fates_levscag' ! matches histFileMod character(*), parameter :: levscpf = 'fates_levscpf' ! matches histFileMod character(*), parameter :: levscls = 'fates_levscls' ! matches histFileMod character(*), parameter :: levpft = 'fates_levpft' ! matches histFileMod @@ -59,6 +60,9 @@ module FatesIODimensionsMod ! levcnlfpft = This is a structure that records the boundaries for the ! number of canopy layer x leaf layer x pft dimension + ! levscag = This is a strcture that records the boundaries for the + ! number of size-classes x patch age + type, public :: fates_bounds_type integer :: patch_begin @@ -69,6 +73,8 @@ module FatesIODimensionsMod integer :: column_end ! we call this a "site" (rgk 11-2016) integer :: ground_begin integer :: ground_end + integer :: sizeage_class_begin + integer :: sizeage_class_end integer :: sizepft_class_begin integer :: sizepft_class_end integer :: size_class_begin diff --git a/components/clm/src/ED/main/FatesIOVariableKindMod.F90 b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 index 3261c35d89..25e2f2bc78 100644 --- a/components/clm/src/ED/main/FatesIOVariableKindMod.F90 +++ b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 @@ -27,6 +27,7 @@ module FatesIOVariableKindMod character(*), parameter :: site_can_r8 = 'SI_CAN_R8' character(*), parameter :: site_cnlf_r8 = 'SI_CNLF_R8' character(*), parameter :: site_cnlfpft_r8 = 'SI_CNLFPFT_R8' + character(*), parameter :: site_scag_r8 = 'SI_SCAG_R8' ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES ! control parameter passing to ensure all active dimension types received all diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index 783dfb39a3..e3dad0a0af 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -1851,6 +1851,7 @@ subroutine htape_create (t, histrest) call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid) if(use_ed)then + call ncd_defdim(lnfid, 'fates_levscag', nlevsclass_ed * nlevage_ed, dimid) call ncd_defdim(lnfid, 'fates_levscls', nlevsclass_ed, dimid) call ncd_defdim(lnfid, 'fates_levpft', mxpft, dimid) call ncd_defdim(lnfid, 'fates_levage', nlevage_ed, dimid) @@ -2276,6 +2277,7 @@ subroutine htape_timeconst(t, mode) use clm_time_manager, only : get_ref_date, get_calendar, NO_LEAP_C, GREGORIAN_C use EDTypesMod, only : fates_hdim_levsclass, fates_hdim_pfmap_levscpf, fates_hdim_scmap_levscpf use EDTypesMod, only : fates_hdim_levage, fates_hdim_levpft + use EDTypesMod, only : fates_hdim_scmap_levscag, fates_hdim_agmap_levscag use EDTypesMod, only : fates_hdim_levfuel, fates_hdim_levcwdsc use EDTypesMod, only : fates_hdim_levcan, fates_hdim_canmap_levcnlf, fates_hdim_lfmap_levcnlf use EDTypesMod, only : fates_hdim_canmap_levcnlfpf, fates_hdim_lfmap_levcnlfpf, fates_hdim_pftmap_levcnlfpf @@ -2330,8 +2332,13 @@ subroutine htape_timeconst(t, mode) long_name='coordinate soil levels', units='m', ncid=nfid(t)) if(use_ed)then + call ncd_defvar(varname='fates_levscls', xtype=tape(t)%ncprec, dim1name='fates_levscls', & long_name='FATES diameter size class lower bound', units='cm', ncid=nfid(t)) + call ncd_defvar(varname='fates_scmap_levscag', xtype=ncd_int, dim1name='fates_levscag', & + long_name='FATES size-class map into size x patch age', units='-', ncid=nfid(t)) + call ncd_defvar(varname='fates_agmap_levscag', xtype=ncd_int, dim1name='fates_levscag', & + long_name='FATES age-class map into size x patch age', units='-', ncid=nfid(t)) call ncd_defvar(varname='fates_pftmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', & long_name='FATES pft index of the combined pft-size class dimension', units='-', ncid=nfid(t)) call ncd_defvar(varname='fates_scmap_levscpf',xtype=ncd_int, dim1name='fates_levscpf', & @@ -2370,6 +2377,8 @@ subroutine htape_timeconst(t, mode) call ncd_io(varname='levdcmp', data=zsoi_1d, ncid=nfid(t), flag='write') end if if(use_ed)then + call ncd_io(varname='fates_scmap_levscag',data=fates_hdim_scmap_levscag, ncid=nfid(t), flag='write') + call ncd_io(varname='fates_agmap_levscag',data=fates_hdim_agmap_levscag, ncid=nfid(t), flag='write') call ncd_io(varname='fates_levscls',data=fates_hdim_levsclass, ncid=nfid(t), flag='write') call ncd_io(varname='fates_pftmap_levscpf',data=fates_hdim_pfmap_levscpf, ncid=nfid(t), flag='write') call ncd_io(varname='fates_scmap_levscpf',data=fates_hdim_scmap_levscpf, ncid=nfid(t), flag='write') @@ -4494,6 +4503,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, num2d = ncwd case ('fates_levscpf') num2d = nlevsclass_ed*mxpft + case ('fates_levscag') + num2d = nlevsclass_ed*nlevage_ed case ('fates_levcan') num2d = nclmax case ('fates_levcnlf') diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 314a7f6453..5f66645579 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -1622,7 +1622,7 @@ subroutine init_history_io(this,bounds_proc) use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8 + use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 use FatesIODimensionsMod, only : fates_bounds_type @@ -1857,6 +1857,16 @@ subroutine init_history_io(this,bounds_proc) ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) + case(site_scag_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name + call hist_addfld2d(fname=trim(vname),units=trim(vunits), & + type2d=trim(dim2name), & + avgflag=trim(vavgflag),long_name=trim(vlong), & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & + default=trim(vdefault), & + set_lake=0._r8,set_urb=0._r8) + case default write(iulog,*) 'A FATES iotype was created that was not registerred' @@ -1906,6 +1916,9 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%age_class_begin = 1 fates%age_class_end = nlevage_ed + + fates%sizeage_class_begin = 1 + fates%sizeage_class_end = nlevsclass_ed * nlevage_ed fates%fuel_begin = 1 fates%fuel_end = nfsc From 1f79c7c960da83e6d17130730b6233c833534765 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 16 Mar 2017 19:21:48 -0700 Subject: [PATCH 40/46] Some bug fixes for the new dimension addition. Also set all multi-plexed dimensions to defautl inactive. --- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 67 ++++++++++--------- 1 file changed, 34 insertions(+), 33 deletions(-) diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 098ef3a7c5..02e5ad51e9 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -2350,12 +2350,12 @@ subroutine define_history_vars(this, initialize_variables) ! fast fluxes by age bin call this%set_history_var(vname='NPP_BY_AGE', units='gC/m^2/s', & - long='net primary productivity by age bin', use_default='active', & + long='net primary productivity by age bin', use_default='inactive', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_npp_si_age ) call this%set_history_var(vname='GPP_BY_AGE', units='gC/m^2/s', & - long='gross primary productivity by age bin', use_default='active', & + long='gross primary productivity by age bin', use_default='inactive', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_gpp_si_age ) @@ -2371,7 +2371,7 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_ar_canopy_pa ) call this%set_history_var(vname='GPP_UNDERSTORY', units='gC/m^2/s', & - long='gross primary production of understory plants', use_default='active', & + long='gross primary production of understory plants', use_default='inactive', & avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_gpp_understory_pa ) @@ -2380,16 +2380,17 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_ar_understory_pa ) + ! fast radiative fluxes resolved through the canopy call this%set_history_var(vname='PARSUN_Z_CNLF', units='W/m2', & long='PAR absorbed in the sun by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsun_z_si_cnlf ) call this%set_history_var(vname='PARSHA_Z_CNLF', units='W/m2', & long='PAR absorbed in the shade by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsha_z_si_cnlf ) @@ -2407,25 +2408,25 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='PARSUN_Z_CAN', units='W/m2', & long='PAR absorbed in the sun by top leaf layer in each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsun_top_si_can ) call this%set_history_var(vname='PARSHA_Z_CAN', units='W/m2', & long='PAR absorbed in the shade by top leaf layer in each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_parsha_top_si_can ) call this%set_history_var(vname='LAISUN_Z_CNLF', units='m2/m2', & long='LAI in the sun by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisun_z_si_cnlf ) call this%set_history_var(vname='LAISHA_Z_CNLF', units='m2/m2', & long='LAI in the shade by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisha_z_si_cnlf ) @@ -2443,13 +2444,13 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='LAISUN_TOP_CAN', units='m2/m2', & long='LAI in the sun by the top leaf layer of each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisun_top_si_can ) call this%set_history_var(vname='LAISHA_TOP_CAN', units='m2/m2', & long='LAI in the shade by the top leaf layer of each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_laisha_top_si_can ) @@ -2479,49 +2480,49 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FABD_SUN_CNLF', units='fraction', & long='sun fraction of direct light absorbed by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_si_cnlf ) call this%set_history_var(vname='FABD_SHA_CNLF', units='fraction', & long='shade fraction of direct light absorbed by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_si_cnlf ) call this%set_history_var(vname='FABI_SUN_CNLF', units='fraction', & long='sun fraction of indirect light absorbed by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_si_cnlf ) call this%set_history_var(vname='FABI_SHA_CNLF', units='fraction', & long='shade fraction of indirect light absorbed by each canopy and leaf layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_cnlf_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_si_cnlf ) call this%set_history_var(vname='FABD_SUN_TOPLF_BYCANLAYER', units='fraction', & long='sun fraction of direct light absorbed by the top leaf layer of each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabd_sun_top_si_can ) call this%set_history_var(vname='FABD_SHA_TOPLF_BYCANLAYER', units='fraction', & long='shade fraction of direct light absorbed by the top leaf layer of each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabd_sha_top_si_can ) call this%set_history_var(vname='FABI_SUN_TOPLF_BYCANLAYER', units='fraction', & long='sun fraction of indirect light absorbed by the top leaf layer of each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabi_sun_top_si_can ) call this%set_history_var(vname='FABI_SHA_TOPLF_BYCANLAYER', units='fraction', & long='shade fraction of indirect light absorbed by the top leaf layer of each canopy layer', & - use_default='active', & + use_default='inactive', & avgflag='A', vtype=site_can_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & ivar=ivar, initialize=initialize_variables, index = ih_fabi_sha_top_si_can ) @@ -2548,7 +2549,7 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='NPLANT_SCAG',units = 'plants/ha', & - long='number of plants per hectare in each size x age class', use_default='active', & + long='number of plants per hectare in each size x age class', use_default='inactive', & avgflag='A', vtype=site_scag_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scag ) @@ -2724,32 +2725,32 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scpf ) call this%set_history_var(vname='CWD_AG_CWDSC', units='gC/m^2', & - long='size-resolved AG CWD stocks', use_default='active', & + long='size-resolved AG CWD stocks', use_default='inactive', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_si_cwdsc ) call this%set_history_var(vname='CWD_BG_CWDSC', units='gC/m^2', & - long='size-resolved BG CWD stocks', use_default='active', & + long='size-resolved BG CWD stocks', use_default='inactive', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_si_cwdsc ) call this%set_history_var(vname='CWD_AG_IN_CWDSC', units='gC/m^2/y', & - long='size-resolved AG CWD input', use_default='active', & + long='size-resolved AG CWD input', use_default='inactive', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_in_si_cwdsc ) call this%set_history_var(vname='CWD_BG_IN_CWDSC', units='gC/m^2/y', & - long='size-resolved BG CWD input', use_default='active', & + long='size-resolved BG CWD input', use_default='inactive', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_in_si_cwdsc ) call this%set_history_var(vname='CWD_AG_OUT_CWDSC', units='gC/m^2/y', & - long='size-resolved AG CWD output', use_default='active', & + long='size-resolved AG CWD output', use_default='inactive', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_ag_out_si_cwdsc ) call this%set_history_var(vname='CWD_BG_OUT_CWDSC', units='gC/m^2/y', & - long='size-resolved BG CWD output', use_default='active', & + long='size-resolved BG CWD output', use_default='inactive', & avgflag='A', vtype=site_cwdsc_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_cwd_bg_out_si_cwdsc ) @@ -2803,37 +2804,37 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_yesterdaycanopylevel_understory_si_scls ) call this%set_history_var(vname='BA_SCLS', units = 'm2/ha', & - long='basal area by size class', use_default='active', & + long='basal area by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ba_si_scls ) call this%set_history_var(vname='DEMOTION_RATE_SCLS', units = 'indiv/ha/yr', & - long='demotion rate from canopy to understory by size class', use_default='active', & + long='demotion rate from canopy to understory by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_demotion_rate_si_scls ) call this%set_history_var(vname='PROMOTION_RATE_SCLS', units = 'indiv/ha/yr', & - long='promotion rate from understory to canopy by size class', use_default='active', & + long='promotion rate from understory to canopy by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_promotion_rate_si_scls ) call this%set_history_var(vname='NPLANT_CANOPY_SCLS', units = 'indiv/ha', & - long='number of canopy plants by size class', use_default='active', & + long='number of canopy plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_canopy_si_scls ) call this%set_history_var(vname='MORTALITY_CANOPY_SCLS', units = 'indiv/ha/yr', & - long='total mortality of canopy trees by size class', use_default='active', & + long='total mortality of canopy trees by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_canopy_si_scls ) call this%set_history_var(vname='NPLANT_UNDERSTORY_SCLS', units = 'indiv/ha', & - long='number of understory plants by size class', use_default='active', & + long='number of understory plants by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_understory_si_scls ) call this%set_history_var(vname='MORTALITY_UNDERSTORY_SCLS', units = 'indiv/ha/yr', & - long='total mortality of understory trees by size class', use_default='active', & + long='total mortality of understory trees by size class', use_default='inactive', & avgflag='A', vtype=site_size_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_mortality_understory_si_scls ) From 61fbb0a7c916da0fc116523f4d7b7edc2df98a85 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 17 Mar 2017 14:22:09 -0700 Subject: [PATCH 41/46] Updated string lengths on type2d components of the field_info structure of historyfilemod to accept 16 character lengths. Also increased the size of requisit scratch space with it. --- components/clm/src/main/histFileMod.F90 | 32 ++++++++++++------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index e3dad0a0af..ed6ce0fece 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -161,8 +161,8 @@ module histFileMod character(len=max_namlen) :: name ! field name character(len=max_chars) :: long_name ! long name character(len=max_chars) :: units ! units - character(len=16) :: type1d ! pointer to first dimension type from data type (nameg, etc) - character(len=16) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) + character(len=8) :: type1d ! pointer to first dimension type from data type (nameg, etc) + character(len=8) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) character(len=16) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] integer :: beg1d ! on-node 1d clm pointer start index integer :: end1d ! on-node 1d clm pointer end index @@ -821,8 +821,8 @@ subroutine htape_addfld (t, f, avgflag) ! ! !LOCAL VARIABLES: integer :: n ! field index on defined tape - character(len=16) :: type1d ! clm pointer 1d type - character(len=16) :: type1d_out ! history buffer 1d type + character(len=8) :: type1d ! clm pointer 1d type + character(len=8) :: type1d_out ! history buffer 1d type integer :: numa ! total number of atm cells across all processors integer :: numg ! total number of gridcells across all processors integer :: numl ! total number of landunits across all processors @@ -1013,8 +1013,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -1253,8 +1253,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -2614,7 +2614,7 @@ subroutine hfields_write(t, mode) character(len=max_chars) :: units ! units character(len=max_namlen):: varname ! variable name character(len=32) :: avgstr ! time averaging type - character(len=16) :: type1d_out ! history output 1d type + character(len=8) :: type1d_out ! history output 1d type character(len=16) :: type2d ! history output 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary @@ -3318,7 +3318,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) character(len=max_namlen),allocatable :: tname(:) character(len=max_chars), allocatable :: tunits(:),tlongname(:) - character(len=8), allocatable :: tmpstr(:,:) + character(len=16), allocatable :: tmpstr(:,:) character(len=scale_type_strlen), allocatable :: p2c_scale_type(:) character(len=scale_type_strlen), allocatable :: c2l_scale_type(:) character(len=scale_type_strlen), allocatable :: l2g_scale_type(:) @@ -3326,8 +3326,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) integer :: start(2) character(len=1) :: hnum ! history file index - character(len=16) :: type1d ! clm pointer 1d type - character(len=16) :: type1d_out ! history buffer 1d type + character(len=8) :: type1d ! clm pointer 1d type + character(len=8) :: type1d_out ! history buffer 1d type character(len=16) :: type2d ! history buffer 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary @@ -4218,8 +4218,8 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! !LOCAL VARIABLES: integer :: p,c,l,g ! indices integer :: hpindex ! history buffer pointer index - character(len=16) :: l_type1d ! 1d data type - character(len=16) :: l_type1d_out ! 1d output type + character(len=8) :: l_type1d ! 1d data type + character(len=8) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells @@ -4444,8 +4444,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, integer :: p,c,l,g ! indices integer :: num2d ! size of second dimension (e.g. number of vertical levels) integer :: hpindex ! history buffer index - character(len=16) :: l_type1d ! 1d data type - character(len=16) :: l_type1d_out ! 1d output type + character(len=8) :: l_type1d ! 1d data type + character(len=8) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells From 77b1145b5948c6df98411f86deaf07a5dc762e2a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 17 Mar 2017 16:01:40 -0700 Subject: [PATCH 42/46] Had to increase the size of the string length dimension sent to the restart history files. --- components/clm/src/main/histFileMod.F90 | 32 ++++++++++++------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index ed6ce0fece..12968e0564 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -161,8 +161,8 @@ module histFileMod character(len=max_namlen) :: name ! field name character(len=max_chars) :: long_name ! long name character(len=max_chars) :: units ! units - character(len=8) :: type1d ! pointer to first dimension type from data type (nameg, etc) - character(len=8) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) + character(len=16) :: type1d ! pointer to first dimension type from data type (nameg, etc) + character(len=16) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) character(len=16) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] integer :: beg1d ! on-node 1d clm pointer start index integer :: end1d ! on-node 1d clm pointer end index @@ -821,8 +821,8 @@ subroutine htape_addfld (t, f, avgflag) ! ! !LOCAL VARIABLES: integer :: n ! field index on defined tape - character(len=8) :: type1d ! clm pointer 1d type - character(len=8) :: type1d_out ! history buffer 1d type + character(len=16) :: type1d ! clm pointer 1d type + character(len=16) :: type1d_out ! history buffer 1d type integer :: numa ! total number of atm cells across all processors integer :: numg ! total number of gridcells across all processors integer :: numl ! total number of landunits across all processors @@ -1013,8 +1013,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -1253,8 +1253,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -1846,7 +1846,7 @@ subroutine htape_create (t, histrest) do n = 1,num_subs call ncd_defdim(lnfid, subs_name(n), subs_dim(n), dimid) end do - call ncd_defdim(lnfid, 'string_length', 8, strlen_dimid) + call ncd_defdim(lnfid, 'string_length', 16, strlen_dimid) call ncd_defdim(lnfid, 'scale_type_string_length', scale_type_strlen, dimid) call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid) @@ -2614,7 +2614,7 @@ subroutine hfields_write(t, mode) character(len=max_chars) :: units ! units character(len=max_namlen):: varname ! variable name character(len=32) :: avgstr ! time averaging type - character(len=8) :: type1d_out ! history output 1d type + character(len=16) :: type1d_out ! history output 1d type character(len=16) :: type2d ! history output 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary @@ -3326,8 +3326,8 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) integer :: start(2) character(len=1) :: hnum ! history file index - character(len=8) :: type1d ! clm pointer 1d type - character(len=8) :: type1d_out ! history buffer 1d type + character(len=16) :: type1d ! clm pointer 1d type + character(len=16) :: type1d_out ! history buffer 1d type character(len=16) :: type2d ! history buffer 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary @@ -4218,8 +4218,8 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! !LOCAL VARIABLES: integer :: p,c,l,g ! indices integer :: hpindex ! history buffer pointer index - character(len=8) :: l_type1d ! 1d data type - character(len=8) :: l_type1d_out ! 1d output type + character(len=16) :: l_type1d ! 1d data type + character(len=16) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells @@ -4444,8 +4444,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, integer :: p,c,l,g ! indices integer :: num2d ! size of second dimension (e.g. number of vertical levels) integer :: hpindex ! history buffer index - character(len=8) :: l_type1d ! 1d data type - character(len=8) :: l_type1d_out ! 1d output type + character(len=16) :: l_type1d ! 1d data type + character(len=16) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells From 07734e1b18e6db2d7b20ebb5c0e41be391dac19b Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 17 Mar 2017 17:35:55 -0700 Subject: [PATCH 43/46] Addressed leap-year issue with the days-per-year constant. CLM/ALM have not leap day, corrected accordingly. --- components/clm/src/ED/main/FatesConstantsMod.F90 | 9 +++++++-- components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 | 4 ++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90 index d48dee8d0c..e126c469b7 100644 --- a/components/clm/src/ED/main/FatesConstantsMod.F90 +++ b/components/clm/src/ED/main/FatesConstantsMod.F90 @@ -54,11 +54,16 @@ module FatesConstantsMod real(fates_r8), parameter :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8 ! Conversion: days per year - real(fates_r8), parameter :: days_per_year = 365.25_fates_r8 + real(fates_r8), parameter :: days_per_year_noleap = 365.00_fates_r8 ! Conversion: years per day - real(fates_r8), parameter :: years_per_day = 1.0_fates_r8/365.25_fates_r8 + real(fates_r8), parameter :: years_per_day_noleap = 1.0_fates_r8/365.00_fates_r8 + ! Conversion: days per year + real(fates_r8), parameter :: days_per_year_leap = 365.25_fates_r8 + + ! Conversion: years per day + real(fates_r8), parameter :: years_per_day_leap = 1.0_fates_r8/365.25_fates_r8 ! Physical constants diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 02e5ad51e9..d48e639272 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -17,8 +17,8 @@ module FatesHistoryInterfaceMod use FatesConstantsMod, only : ha_per_m2 use FatesConstantsMod, only : days_per_sec use FatesConstantsMod, only : sec_per_day - use FatesConstantsMod, only : days_per_year - use FatesConstantsMod, only : years_per_day + use FatesConstantsMod, only : days_per_year => days_per_year_noleap + use FatesConstantsMod, only : years_per_day => years_per_day_noleap implicit none From 4e41ec623f823ddf00ec2261e9a8a11eb919b708 Mon Sep 17 00:00:00 2001 From: ckoven Date: Mon, 20 Mar 2017 15:05:32 -0700 Subject: [PATCH 44/46] got rid of leap_year calendar constant and also gave the dim-name character length a proper name --- .../clm/src/ED/main/FatesConstantsMod.F90 | 14 ++----- .../src/ED/main/FatesHistoryInterfaceMod.F90 | 4 +- components/clm/src/main/histFileMod.F90 | 39 ++++++++++--------- 3 files changed, 26 insertions(+), 31 deletions(-) diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90 index e126c469b7..414bc5ff0b 100644 --- a/components/clm/src/ED/main/FatesConstantsMod.F90 +++ b/components/clm/src/ED/main/FatesConstantsMod.F90 @@ -53,18 +53,12 @@ module FatesConstantsMod ! Conversion: days per second real(fates_r8), parameter :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8 - ! Conversion: days per year - real(fates_r8), parameter :: days_per_year_noleap = 365.00_fates_r8 + ! Conversion: days per year. assume HLM uses 365 day calendar. If we need to link to 365.25-day-calendared HLM, rewire to pass through interface + real(fates_r8), parameter :: days_per_year = 365.00_fates_r8 - ! Conversion: years per day - real(fates_r8), parameter :: years_per_day_noleap = 1.0_fates_r8/365.00_fates_r8 + ! Conversion: years per day. assume HLM uses 365 day calendar. If we need to link to 365.25-day-calendared HLM, rewire to pass through interface + real(fates_r8), parameter :: years_per_day = 1.0_fates_r8/365.00_fates_r8 - ! Conversion: days per year - real(fates_r8), parameter :: days_per_year_leap = 365.25_fates_r8 - - ! Conversion: years per day - real(fates_r8), parameter :: years_per_day_leap = 1.0_fates_r8/365.25_fates_r8 - ! Physical constants ! universal gas constant [J/K/kmol] diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index d48e639272..02e5ad51e9 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -17,8 +17,8 @@ module FatesHistoryInterfaceMod use FatesConstantsMod, only : ha_per_m2 use FatesConstantsMod, only : days_per_sec use FatesConstantsMod, only : sec_per_day - use FatesConstantsMod, only : days_per_year => days_per_year_noleap - use FatesConstantsMod, only : years_per_day => years_per_day_noleap + use FatesConstantsMod, only : days_per_year + use FatesConstantsMod, only : years_per_day implicit none diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index 12968e0564..744ecf7c0f 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -39,6 +39,7 @@ module histFileMod integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name integer , public, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types integer , private, parameter :: avgflag_strlen = 3 ! maximum number of characters for avgflag + integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names ! Possible ways to treat multi-layer snow fields at times when no snow is present in a ! given layer. Note that the public parameters are the only ones that can be used by @@ -161,9 +162,9 @@ module histFileMod character(len=max_namlen) :: name ! field name character(len=max_chars) :: long_name ! long name character(len=max_chars) :: units ! units - character(len=16) :: type1d ! pointer to first dimension type from data type (nameg, etc) - character(len=16) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) - character(len=16) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] + character(len=hist_dim_name_length) :: type1d ! pointer to first dimension type from data type (nameg, etc) + character(len=hist_dim_name_length) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) + character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] integer :: beg1d ! on-node 1d clm pointer start index integer :: end1d ! on-node 1d clm pointer end index integer :: num1d ! size of clm pointer first dimension (all nodes) @@ -821,8 +822,8 @@ subroutine htape_addfld (t, f, avgflag) ! ! !LOCAL VARIABLES: integer :: n ! field index on defined tape - character(len=16) :: type1d ! clm pointer 1d type - character(len=16) :: type1d_out ! history buffer 1d type + character(len=hist_dim_name_length) :: type1d ! clm pointer 1d type + character(len=hist_dim_name_length) :: type1d_out ! history buffer 1d type integer :: numa ! total number of atm cells across all processors integer :: numg ! total number of gridcells across all processors integer :: numl ! total number of landunits across all processors @@ -969,7 +970,7 @@ subroutine hist_update_hbuf(bounds) integer :: f ! field index integer :: num2d ! size of second dimension (e.g. number of vertical levels) character(len=*),parameter :: subname = 'hist_update_hbuf' - character(len=16) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] + character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] !----------------------------------------------------------------------- do t = 1,ntapes @@ -1013,8 +1014,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -1253,8 +1254,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) logical :: valid ! true => history operation is valid logical :: map2gcell ! true => map clm pointer field to gridcell - character(len=16) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] - character(len=16) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits @@ -1846,7 +1847,7 @@ subroutine htape_create (t, histrest) do n = 1,num_subs call ncd_defdim(lnfid, subs_name(n), subs_dim(n), dimid) end do - call ncd_defdim(lnfid, 'string_length', 16, strlen_dimid) + call ncd_defdim(lnfid, 'string_length', hist_dim_name_length, strlen_dimid) call ncd_defdim(lnfid, 'scale_type_string_length', scale_type_strlen, dimid) call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid) @@ -2614,8 +2615,8 @@ subroutine hfields_write(t, mode) character(len=max_chars) :: units ! units character(len=max_namlen):: varname ! variable name character(len=32) :: avgstr ! time averaging type - character(len=16) :: type1d_out ! history output 1d type - character(len=16) :: type2d ! history output 2d type + character(len=hist_dim_name_length) :: type1d_out ! history output 1d type + character(len=hist_dim_name_length) :: type2d ! history output 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary real(r8), pointer :: histo(:,:) ! temporary @@ -3318,7 +3319,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) character(len=max_namlen),allocatable :: tname(:) character(len=max_chars), allocatable :: tunits(:),tlongname(:) - character(len=16), allocatable :: tmpstr(:,:) + character(len=hist_dim_name_length), allocatable :: tmpstr(:,:) character(len=scale_type_strlen), allocatable :: p2c_scale_type(:) character(len=scale_type_strlen), allocatable :: c2l_scale_type(:) character(len=scale_type_strlen), allocatable :: l2g_scale_type(:) @@ -3326,9 +3327,9 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate) integer :: start(2) character(len=1) :: hnum ! history file index - character(len=16) :: type1d ! clm pointer 1d type - character(len=16) :: type1d_out ! history buffer 1d type - character(len=16) :: type2d ! history buffer 2d type + character(len=hist_dim_name_length) :: type1d ! clm pointer 1d type + character(len=hist_dim_name_length) :: type1d_out ! history buffer 1d type + character(len=hist_dim_name_length) :: type2d ! history buffer 2d type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary type(var_desc_t) :: name_desc ! variable descriptor for name @@ -4218,8 +4219,8 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! !LOCAL VARIABLES: integer :: p,c,l,g ! indices integer :: hpindex ! history buffer pointer index - character(len=16) :: l_type1d ! 1d data type - character(len=16) :: l_type1d_out ! 1d output type + character(len=hist_dim_name_length) :: l_type1d ! 1d data type + character(len=hist_dim_name_length) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells From c88bd4de6f97364461088d978f251c9915e5a1a9 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 21 Mar 2017 08:38:31 -0700 Subject: [PATCH 45/46] fixed another thing --- components/clm/src/main/histFileMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index 744ecf7c0f..58526d0ffd 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -4445,8 +4445,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, integer :: p,c,l,g ! indices integer :: num2d ! size of second dimension (e.g. number of vertical levels) integer :: hpindex ! history buffer index - character(len=16) :: l_type1d ! 1d data type - character(len=16) :: l_type1d_out ! 1d output type + character(len=scale_type_strlen) :: l_type1d ! 1d data type + character(len=scale_type_strlen) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells From 11473c4cd15cdb2bd9b7b0faa7af89eb054955f3 Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 21 Mar 2017 09:04:06 -0700 Subject: [PATCH 46/46] fixed that same thing again, but correctly i think this time --- components/clm/src/main/histFileMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index 58526d0ffd..c8adb4ba73 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -4445,8 +4445,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, integer :: p,c,l,g ! indices integer :: num2d ! size of second dimension (e.g. number of vertical levels) integer :: hpindex ! history buffer index - character(len=scale_type_strlen) :: l_type1d ! 1d data type - character(len=scale_type_strlen) :: l_type1d_out ! 1d output type + character(len=hist_dim_name_length) :: l_type1d ! 1d data type + character(len=hist_dim_name_length) :: l_type1d_out ! 1d output type character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells