From a651a4ff2e0abadde4822a1f48ac9565b851cbdb Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 12 Jan 2017 15:19:13 -0700 Subject: [PATCH 01/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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 47af51b88e5adc75e494cf4bffd2363650358470 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Wed, 8 Mar 2017 19:04:30 -0700 Subject: [PATCH 16/18] 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 3e25ba9878b237957266bee19854180bc4e5646c Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 9 Mar 2017 15:07:14 -0700 Subject: [PATCH 17/18] 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 7afeecc4d545fcd071dcd2e15d740b744171f4ed Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Tue, 14 Mar 2017 16:42:10 -0600 Subject: [PATCH 18/18] 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)