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 53348abe3a..23cc75e7dd 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -240,9 +240,10 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/clm5_params.c160713.nc -lnd/clm2/paramdata/clm_params.c160713.nc -lnd/clm2/paramdata/clm_params_ed.c160808.nc +lnd/clm2/paramdata/clm5_params.c160713.nc +lnd/clm2/paramdata/clm_params.c160713.nc + +lnd/clm2/paramdata/fates_params.c170308.nc diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml index 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 f156ed869f..0e004d3822 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -7,7 +7,7 @@ module EDCanopyStructureMod use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : fates_log - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDGrowthFunctionsMod , only : c_area use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd @@ -651,7 +651,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 @@ -698,7 +698,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 @@ -762,7 +762,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 @@ -1024,11 +1024,11 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) do iv = 1,currentCohort%NV-1 ! what is the height of this layer? (for snow burial purposes...) - ! pftcon%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + ! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & EDecophyscon%crown(currentCohort%pft) ) layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & - EDecophyscon%crown(currentCohort%pft)) ! pftcon%vertical_canopy_frac(ft)) + EDecophyscon%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft)) fraction_exposed =1.0_r8 @@ -1057,10 +1057,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 f1bbdde262..b7aafda47b 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -9,7 +9,7 @@ module EDCohortDynamicsMod use FatesInterfaceMod , only : hlm_freq_day use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_unset_int - use pftconMod , only : pftcon + use 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 @@ -121,11 +121,11 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & call endrun(msg=errMsg(sourcefile, __LINE__)) endif - if (new_cohort%siteptr%status==2 .and. pftcon%season_decid(pft) == 1) then + if (new_cohort%siteptr%status==2 .and. EDPftvarcon_inst%season_decid(pft) == 1) then new_cohort%laimemory = 0.0_r8 endif - if (new_cohort%siteptr%dstatus==2 .and. pftcon%stress_decid(pft) == 1) then + if (new_cohort%siteptr%dstatus==2 .and. EDPftvarcon_inst%stress_decid(pft) == 1) then new_cohort%laimemory = 0.0_r8 endif @@ -201,27 +201,27 @@ subroutine allocate_live_biomass(cc_p,mode) currentCohort => cc_p ft = currentcohort%pft - leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + pftcon%froot_leaf(ft)) + leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + EDPftvarcon_inst%froot_leaf(ft)) !currentcohort%bl = currentcohort%balive*leaf_frac !for deciduous trees, there are no leaves - if (pftcon%evergreen(ft) == 1) then + if (EDPftvarcon_inst%evergreen(ft) == 1) then currentcohort%laimemory = 0._r8 currentcohort%status_coh = 2 endif ! iagnore the root and stem biomass from the functional balance hypothesis. This is used when the leaves are !fully on. - !currentcohort%br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + !currentcohort%br = EDPftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac !currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & ! currentcohort%laimemory)*leaf_frac leaves_off_switch = 0 - if (currentcohort%status_coh == 1.and.pftcon%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves + if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves leaves_off_switch = 1 !drought decid endif - if (currentcohort%status_coh == 1.and.pftcon%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves + if (currentcohort%status_coh == 1.and.EDPftvarcon_inst%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves leaves_off_switch = 1 !cold decid endif @@ -230,7 +230,7 @@ subroutine allocate_live_biomass(cc_p,mode) new_bl = currentcohort%balive*leaf_frac - new_br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + new_br = EDpftvarcon_inst%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & currentcohort%laimemory)*leaf_frac @@ -255,7 +255,6 @@ subroutine allocate_live_biomass(cc_p,mode) currentcohort%br = new_br currentcohort%bsw = new_bsw - else ! Leaves are off (leaves_off_switch==1) !the purpose of this section is to figure out the root and stem biomass when the leaves are off @@ -265,11 +264,11 @@ subroutine allocate_live_biomass(cc_p,mode) !not have enough live biomass to support the hypothesized root mass !thus, we use 'ratio_balive' to adjust br and bsw. Apologies that this is so complicated! RF - ideal_balive = currentcohort%laimemory * pftcon%froot_leaf(ft) + & + ideal_balive = currentcohort%laimemory * EDPftvarcon_inst%froot_leaf(ft) + & currentcohort%laimemory* EDecophyscon%sapwood_ratio(ft) * currentcohort%hite ratio_balive = currentcohort%balive / ideal_balive - new_br = pftcon%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * & + new_br = EDpftvarcon_inst%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * & leaf_frac * ratio_balive new_bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite * & (ideal_balive + currentcohort%laimemory) * leaf_frac * ratio_balive @@ -298,7 +297,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 cd330f1c8b..2b713dbe4a 100755 --- a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 @@ -8,7 +8,7 @@ module EDGrowthFunctionsMod use FatesConstantsMod, only : r8 => fates_r8 use FatesGlobals , only : fates_log - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use EDTypesMod , only : ed_cohort_type, nlevcan, dinc_ed @@ -114,7 +114,7 @@ real(r8) function Bleaf( cohort_in ) else bleaf = 0.0419_r8 * (EDecophyscon%max_dbh(cohort_in%pft)**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 endif - slascaler = 0.03_r8/pftcon%slatop(cohort_in%pft) + slascaler = 0.03_r8/EDPftvarcon_inst%slatop(cohort_in%pft) bleaf = bleaf * slascaler !write(fates_log(),*) 'bleaf',bleaf, slascaler,cohort_in%pft @@ -145,7 +145,7 @@ real(r8) function tree_lai( cohort_in ) endif if( cohort_in%status_coh == 2 ) then ! are the leaves on? - slat = 1000.0_r8 * pftcon%slatop(cohort_in%pft) ! m2/g to m2/kg + slat = 1000.0_r8 * EDPftvarcon_inst%slatop(cohort_in%pft) ! m2/g to m2/kg cohort_in%c_area = c_area(cohort_in) ! call the tree area leafc_per_unitarea = cohort_in%bl/(cohort_in%c_area/cohort_in%n) !KgC/m2 if(leafc_per_unitarea > 0.0_r8)then @@ -225,7 +225,7 @@ real(r8) function c_area( cohort_in ) if (DEBUG_growth) then write(fates_log(),*) 'z_area 1',cohort_in%dbh,cohort_in%pft write(fates_log(),*) 'z_area 2',EDecophyscon%max_dbh - write(fates_log(),*) 'z_area 3',pftcon%woody + write(fates_log(),*) 'z_area 3',EDPftvarcon_inst%woody write(fates_log(),*) 'z_area 4',cohort_in%n write(fates_log(),*) 'z_area 5',cohort_in%patchptr%spread write(fates_log(),*) 'z_area 6',cohort_in%canopy_layer @@ -233,7 +233,7 @@ real(r8) function c_area( cohort_in ) end if dbh = min(cohort_in%dbh,EDecophyscon%max_dbh(cohort_in%pft)) - if(pftcon%woody(cohort_in%pft) == 1)then + if(EDPftvarcon_inst%woody(cohort_in%pft) == 1)then c_area = 3.142_r8 * cohort_in%n * & (cohort_in%patchptr%spread(cohort_in%canopy_layer)*dbh)**1.56_r8 else diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index fd5423eeec..8aec2ca09c 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -3,10 +3,9 @@ module EDPatchDynamicsMod ! ============================================================================ ! Controls formation, creation, fusing and termination of patch level processes. ! ============================================================================ - use FatesGlobals , only : fates_log use FatesInterfaceMod , only : hlm_freq_day - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort use EDtypesMod , only : ncwd, n_dbh_bins, ntol, area, dbhmax use EDTypesMod , only : numpft_ed @@ -293,7 +292,7 @@ subroutine spawn_patches( currentSite ) nc%imort = nan else ! small trees - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then ! Number of trees in the understory of new patch, before we impose impact mortality and survivorship nc%n = currentCohort%n * patch_site_areadis/currentPatch%area @@ -578,7 +577,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. @@ -661,7 +660,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) @@ -738,7 +737,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 + & @@ -1523,7 +1522,7 @@ subroutine set_root_fraction( cpatch , depth_gl ) ! Calculates the fractions of the root biomass in each layer for each pft. ! ! !USES: - use pftconMod , only : pftcon + ! ! !ARGUMENTS type(ed_patch_type),intent(inout), target :: cpatch @@ -1540,10 +1539,10 @@ subroutine set_root_fraction( cpatch , depth_gl ) do lev = 1, hlm_numlevsoil-1 cpatch%rootfr_ft(ft,lev) = .5_r8*( & - exp(-pftcon%roota_par(ft) * depth_gl(lev-1)) & - + exp(-pftcon%rootb_par(ft) * depth_gl(lev-1)) & - - exp(-pftcon%roota_par(ft) * depth_gl(lev)) & - - exp(-pftcon%rootb_par(ft) * depth_gl(lev))) + exp(-EDPftvarcon_inst%roota_par(ft) * depth_gl(lev-1)) & + + exp(-EDPftvarcon_inst%rootb_par(ft) * depth_gl(lev-1)) & + - exp(-EDPftvarcon_inst%roota_par(ft) * depth_gl(lev)) & + - exp(-EDPftvarcon_inst%rootb_par(ft) * depth_gl(lev))) end do end do diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index f2ffc055e9..a8d9abc54b 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -12,7 +12,8 @@ module EDPhysiologyMod use FatesInterfaceMod, only : hlm_freq_day use FatesInterfaceMod, only : hlm_day_of_year use FatesConstantsMod, only : r8 => fates_r8 - use pftconMod , only : pftcon + use EDEcophysContype , only : EDecophyscon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysContype , only : EDecophyscon use FatesInterfaceMod, only : bc_in_type use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort @@ -154,7 +155,6 @@ subroutine trim_canopy( currentSite ) ! ! !USES: ! - use EDParamsMod, only : ED_val_grperc use EDGrowthFunctionsMod, only : tree_lai ! ! !ARGUMENTS @@ -193,17 +193,20 @@ 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) - currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1.or. & + EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then + currentCohort%leaf_cost = 1._r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) + currentCohort%leaf_cost = currentCohort%leaf_cost + & + 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & + EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) else !evergreen costs - currentCohort%leaf_cost = 1.0_r8/(pftcon%slatop(currentCohort%pft)* & - pftcon%leaf_long(currentCohort%pft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 - currentCohort%leaf_cost = currentCohort%leaf_cost + 1.0_r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) * & - pftcon%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) - currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc(currentCohort%pft) + 1._r8) + currentCohort%leaf_cost = 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)* & + EDPftvarcon_inst%leaf_long(currentCohort%pft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 + currentCohort%leaf_cost = currentCohort%leaf_cost + & + 1.0_r8/(EDPftvarcon_inst%slatop(currentCohort%pft)*1000.0_r8) * & + EDPftvarcon_inst%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + currentCohort%leaf_cost = currentCohort%leaf_cost * (EDPftvarcon_inst%grperc(currentCohort%pft) + 1._r8) endif if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then if (currentCohort%canopy_trim > trim_limit)then @@ -215,7 +218,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 @@ -478,7 +481,7 @@ subroutine phenology( currentSite, bc_in ) !LEAF OFF: DROUGHT DECIDUOUS LIFESPAN - if the leaf gets to the end of its useful life. A*, E* if (currentSite%dstatus == 2.and.t >= 10)then !D* !Are the leaves at the end of their lives? !FIX(RF,0401014)- this is hardwiring.... - if (timesincedleafon > 365.0*pftcon%leaf_long(7))then + if (timesincedleafon > 365.0*EDPftvarcon_inst%leaf_long(7))then currentSite%dstatus = 1 !alter status of site to 'leaves on' currentSite%dleafoffdate = t !record leaf on date endif @@ -527,7 +530,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. @@ -571,7 +574,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. @@ -807,11 +810,11 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) call allocate_live_biomass(currentCohort,0) ! calculate target size of living biomass compartment for a given dbh. - target_balive = Bleaf(currentCohort) * (1.0_r8 + pftcon%froot_leaf(currentCohort%pft) + & + target_balive = Bleaf(currentCohort) * (1.0_r8 + EDPftvarcon_inst%froot_leaf(currentCohort%pft) + & EDecophyscon%sapwood_ratio(currentCohort%pft)*h) !target balive without leaves. if (currentCohort%status_coh == 1)then - target_balive = Bleaf(currentCohort) * (pftcon%froot_leaf(currentCohort%pft) + & + target_balive = Bleaf(currentCohort) * (EDPftvarcon_inst%froot_leaf(currentCohort%pft) + & EDecophyscon%sapwood_ratio(currentCohort%pft) * h) endif @@ -827,8 +830,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n ! Maintenance demands - if (pftcon%evergreen(currentCohort%pft) == 1)then !grass and EBT - currentCohort%leaf_md = currentCohort%bl / pftcon%leaf_long(currentCohort%pft) + if (EDPftvarcon_inst%evergreen(currentCohort%pft) == 1)then !grass and EBT + currentCohort%leaf_md = currentCohort%bl / EDPftvarcon_inst%leaf_long(currentCohort%pft) currentCohort%root_md = currentCohort%br / EDecophyscon%root_long(currentCohort%pft) currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif @@ -838,22 +841,23 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) !with which I am not especially comfortable, particularly as the concept of sapwood turnover is unclear for trees that !are still in an expansion phase. - if (pftcon%season_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%season_decid(currentCohort%pft) == 1)then currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (pftcon%stress_decid(currentCohort%pft) == 1)then + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) == 1)then currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) currentCohort%leaf_md = 0._r8 currentCohort%md = currentCohort%root_md + currentCohort%leaf_md endif - if (pftcon%stress_decid(currentCohort%pft) /= 1.and.pftcon%season_decid(currentCohort%pft) /= 1.and. & - pftcon%evergreen(currentCohort%pft) /= 1)then - write(fates_log(),*) 'problem with phenology definitions',currentCohort%pft,pftcon%stress_decid(currentCohort%pft), & - pftcon%season_decid(currentCohort%pft),pftcon%evergreen(currentCohort%pft) + if (EDPftvarcon_inst%stress_decid(currentCohort%pft) /= 1.and.EDPftvarcon_inst%season_decid(currentCohort%pft) /= 1.and. & + EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then + write(fates_log(),*) 'problem with phenology definitions',currentCohort%pft, & + EDPftvarcon_inst%stress_decid(currentCohort%pft), & + EDPftvarcon_inst%season_decid(currentCohort%pft),EDPftvarcon_inst%evergreen(currentCohort%pft) endif ! FIX(RF,032414) -turned off for now as it makes balive go negative.... @@ -947,7 +951,7 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in) ! fraction of carbon going into active vs structural carbon if (currentCohort%dbh <= EDecophyscon%max_dbh(currentCohort%pft))then ! cap on leaf biomass dbldbd = dDbhdBd(currentCohort)/dDbhdBl(currentCohort) - dbrdbd = pftcon%froot_leaf(currentCohort%pft) * dbldbd + dbrdbd = EDPftvarcon_inst%froot_leaf(currentCohort%pft) * dbldbd dhdbd_fn = dhdbd(currentCohort) dbswdbd = EDecophyscon%sapwood_ratio(currentCohort%pft) * (h*dbldbd + currentCohort%bl*dhdbd_fn) u = 1.0_r8 / (dbldbd + dbrdbd + dbswdbd) @@ -1045,9 +1049,9 @@ subroutine recruitment( t, currentSite, currentPatch ) temp_cohort%hite = EDecophyscon%hgt_min(ft) temp_cohort%dbh = Dbh(temp_cohort) temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + pftcon%froot_leaf(ft) & + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) & + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite) - temp_cohort%bstore = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + pftcon%froot_leaf(ft) & + temp_cohort%bstore = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + EDPftvarcon_inst%froot_leaf(ft) & + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite)) temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*hlm_freq_day & / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) @@ -1060,17 +1064,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 @@ -1186,7 +1190,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 ! @@ -1215,8 +1219,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 @@ -1335,7 +1339,7 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) use FatesInterfaceMod, only : hlm_numlevdecomp_full use FatesInterfaceMod, only : hlm_numlevdecomp use SoilBiogeochemVerticalProfileMod, only: surfprof_exp - use pftconMod, only : pftcon + use EDPftvarcon, only : EDPftvarcon_inst use FatesConstantsMod, only : sec_per_day use clm_varcon, only : zisoi, dzsoi_decomp, zsoi use EDParamsMod, only : ED_val_ag_biomass @@ -1449,8 +1453,9 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) ! use beta distribution parameter from Jackson et al., 1996 do ft = 1, numpft_ed do j = 1, hlm_numlevdecomp - cinput_rootfr(ft,j) = ( pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j-1)*100._r8) - & - pftcon%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j)*100._r8) ) & + cinput_rootfr(ft,j) = & + ( EDPftvarcon_inst%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j-1)*100._r8) - & + EDPftvarcon_inst%rootprof_beta(ft, rooting_profile_varindex_water) ** (zisoi(j)*100._r8) ) & / dzsoi_decomp(j) end do end do @@ -1460,10 +1465,10 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) do j = 1, hlm_numlevdecomp ! use standard CLM root fraction profiles; cinput_rootfr(ft,j) = ( .5_r8*( & - exp(-pftcon%roota_par(ft) * zisoi(j-1)) & - + exp(-pftcon%rootb_par(ft) * zisoi(j-1)) & - - exp(-pftcon%roota_par(ft) * zisoi(j)) & - - exp(-pftcon%rootb_par(ft) * zisoi(j)))) / dzsoi_decomp(j) + exp(-EDPftvarcon_inst%roota_par(ft) * zisoi(j-1)) & + + exp(-EDPftvarcon_inst%rootb_par(ft) * zisoi(j-1)) & + - exp(-EDPftvarcon_inst%roota_par(ft) * zisoi(j)) & + - exp(-EDPftvarcon_inst%rootb_par(ft) * zisoi(j)))) / dzsoi_decomp(j) end do end do endif @@ -1651,26 +1656,26 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out) do ft = 1,numpft_ed do j = 1, hlm_numlevdecomp bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%leaf_litter_out(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%leaf_litter_out(ft) * EDPftvarcon_inst%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) ! bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_flab(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flab(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%root_litter_out(ft) * pftcon%fr_flig(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) + currentpatch%root_litter_out(ft) * EDPftvarcon_inst%fr_flig(ft) * currentpatch%area/AREA * froot_prof(s,ft,j) ! !! and seed_decay too. for now, use the same lability fractions as for leaf litter bc_out(s)%FATES_c_to_litr_lab_c_col(j) = bc_out(s)%FATES_c_to_litr_lab_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_cel_c_col(j) = bc_out(s)%FATES_c_to_litr_cel_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(s,j) bc_out(s)%FATES_c_to_litr_lig_c_col(j) = bc_out(s)%FATES_c_to_litr_lig_c_col(j) + & - currentpatch%seed_decay(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) + currentpatch%seed_decay(ft) * EDPftvarcon_inst%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(s,j) ! enddo end do diff --git a/components/clm/src/ED/biogeophys/EDBtranMod.F90 b/components/clm/src/ED/biogeophys/EDBtranMod.F90 index d44da0d1c8..5e868eb0ed 100644 --- a/components/clm/src/ED/biogeophys/EDBtranMod.F90 +++ b/components/clm/src/ED/biogeophys/EDBtranMod.F90 @@ -5,7 +5,7 @@ module EDBtranMod ! ! ------------------------------------------------------------------------------------ - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm use EDTypesMod , only : ed_site_type, & ed_patch_type, & @@ -111,8 +111,8 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) !------------------------------------------------------------------------------ associate( & - smpsc => pftcon%smpsc , & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS - smpso => pftcon%smpso & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS + smpsc => EDPftvarcon_inst%smpsc , & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS + smpso => EDPftvarcon_inst%smpso & ! INTERF-TODO: THESE SHOULD BE FATES PARAMETERS ) do s = 1,nsites diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index 130b093da0..d48b07a240 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -50,7 +50,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! ! !USES: - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDtypesMod , only : ed_patch_type use EDTypesMod , only : ed_site_type @@ -117,11 +117,11 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) !----------------------------------------------------------------------- associate(& - rhol => pftcon%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir - rhos => pftcon%rhos , & ! Input: [real(r8) (:) ] stem reflectance: 1=vis, 2=nir - taul => pftcon%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir - taus => pftcon%taus , & ! Input: [real(r8) (:) ] stem transmittance: 1=vis, 2=nir - xl => pftcon%xl) ! Input: [real(r8) (:) ] ecophys const - leaf/stem orientation index + rhol => EDPftvarcon_inst%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir + rhos => EDPftvarcon_inst%rhos , & ! Input: [real(r8) (:) ] stem reflectance: 1=vis, 2=nir + taul => EDPftvarcon_inst%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir + taus => EDPftvarcon_inst%taus , & ! Input: [real(r8) (:) ] stem transmittance: 1=vis, 2=nir + xl => EDPftvarcon_inst%xl) ! Input: [real(r8) (:) ] ecophys const - leaf/stem orientation index ! albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) (USED IN LND2ATM,BALANCE_CHECK) ! albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) (LND2ATM,BALANCE_CHECK) diff --git a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 index 6dd2592c24..7c2bab069c 100644 --- a/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/components/clm/src/ED/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -63,11 +63,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use clm_varpar , only : mxpft ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) - use pftconMod , only : pftcon ! THIS WILL BE DEPRECATED WHEN PARAMETER + use EDPftvarcon , only : EDPftvarcon_inst ! THIS WILL BE DEPRECATED WHEN PARAMETER ! READS ARE REFACTORED (RGK 10-13-2016) - use EDParamsMod , only : ED_val_grperc use EDParamsMod , only : ED_val_ag_biomass - use EDSharedParamsMod , only : EDParamsShareInst + use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst use EDTypesMod , only : ed_patch_type use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_site_type @@ -200,16 +199,16 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) associate( & - c3psn => pftcon%c3psn , & - slatop => pftcon%slatop , & ! specific leaf area at top of canopy, + c3psn => EDPftvarcon_inst%c3psn , & + slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, ! projected area basis [m^2/gC] - flnr => pftcon%flnr , & ! fraction of leaf N in the Rubisco + flnr => EDPftvarcon_inst%flnr , & ! fraction of leaf N in the Rubisco ! enzyme (gN Rubisco / gN leaf) - woody => pftcon%woody , & ! Is vegetation woody or not? - fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-) - leafcn => pftcon%leafcn , & ! leaf C:N (gC/gN) - frootcn => pftcon%frootcn, & ! froot C:N (gc/gN) ! slope of BB relationship - q10 => EDParamsShareInst%Q10 ) + woody => EDPftvarcon_inst%woody , & ! Is vegetation woody or not? + fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-) + leafcn => EDPftvarcon_inst%leafcn , & ! leaf C:N (gC/gN) + frootcn => EDPftvarcon_inst%frootcn, & ! froot C:N (gc/gN) ! slope of BB relationship + q10 => FatesSynchronizedParamsInst%Q10 ) do s = 1,nsites @@ -500,7 +499,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) leaf_frac = 1.0_r8/(currentCohort%canopy_trim + & EDecophyscon%sapwood_ratio(currentCohort%pft) * & - currentCohort%hite + pftcon%froot_leaf(currentCohort%pft)) + currentCohort%hite + EDPftvarcon_inst%froot_leaf(currentCohort%pft)) currentCohort%bsw = EDecophyscon%sapwood_ratio(currentCohort%pft) * & @@ -586,7 +585,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! no drought response right now.. something like: ! resp_m = resp_m * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft) * & - ! pftcon%resp_drought_response(ft)) + ! EDPftvarcon_inst%resp_drought_response(ft)) currentCohort%resp_m = currentCohort%resp_m + currentCohort%rdark @@ -599,7 +598,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) if ( DEBUG ) write(fates_log(),*) 'EDPhoto 912 ', currentCohort%resp_tstep if ( DEBUG ) write(fates_log(),*) 'EDPhoto 913 ', currentCohort%resp_m - currentCohort%resp_g = ED_val_grperc(ft) * & + currentCohort%resp_g = EDPftvarcon_inst%grperc(ft) * & (max(0._r8,currentCohort%gpp_tstep - & currentCohort%resp_m)) currentCohort%resp_tstep = currentCohort%resp_m + & @@ -688,7 +687,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! ------------------------------------------------------------------------------------ use EDEcophysContype , only : EDecophyscon - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst ! Arguments ! ------------------------------------------------------------------------------------ @@ -784,7 +783,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in associate( bb_slope => EDecophyscon%BB_slope ) ! slope of BB relationship - if (nint(pftcon%c3psn(ft)) == 1) then! photosynthetic pathway: 0. = c4, 1. = c3 + if (nint(EDPftvarcon_inst%c3psn(ft)) == 1) then! photosynthetic pathway: 0. = c4, 1. = c3 pp_type = 1 init_co2_intra_c = init_a2l_co2_c3 * can_co2_ppress else @@ -1476,8 +1475,8 @@ subroutine LeafLayerMaintenanceRespiration(lmr25top_ft, & lmr) use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm - use pftconMod , only : pftcon - + use EDPftvarcon , only : EDPftvarcon_inst + ! Arguments real(r8), intent(in) :: lmr25top_ft ! canopy top leaf maint resp rate at 25C ! for this pft (umol CO2/m**2/s) @@ -1500,7 +1499,7 @@ subroutine LeafLayerMaintenanceRespiration(lmr25top_ft, & ! ---------------------------------------------------------------------------------- lmr25 = lmr25top_ft * nscaler - if ( nint(pftcon%c3psn(ft)) == 1)then + if ( nint(EDpftvarcon_inst%c3psn(ft)) == 1)then lmr = lmr25 * ft1_f(veg_tempk, lmrha) * & fth_f(veg_tempk, lmrhd, lmrse, lmrc) else @@ -1543,7 +1542,7 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & ! co2_rcurve_islope: initial slope of CO2 response curve (C4 plants) ! --------------------------------------------------------------------------------- - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm ! Arguments @@ -1616,7 +1615,7 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & jmax = jmax25 * ft1_f(veg_tempk, jmaxha) * fth_f(veg_tempk, jmaxhd, jmaxse, jmaxc) tpu = tpu25 * ft1_f(veg_tempk, tpuha) * fth_f(veg_tempk, tpuhd, tpuse, tpuc) - if (nint(pftcon%c3psn(ft)) /= 1) then + if (nint(EDPftvarcon_inst%c3psn(ft)) /= 1) then vcmax = vcmax25 * 2._r8**((veg_tempk-(tfrz+25._r8))/10._r8) vcmax = vcmax / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-veg_tempk ) )) vcmax = vcmax / (1._r8 + exp( 0.3_r8*(veg_tempk-(tfrz+40._r8)) )) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index 7c715deafa..01b3373857 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -13,6 +13,7 @@ module SFMainMod use FatesInterfaceMod , only : bc_in_type use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysconType , only : EDecophyscon use EDtypesMod , only : ed_site_type use EDtypesMod , only : ed_patch_type @@ -163,7 +164,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 @@ -336,7 +337,7 @@ subroutine wind_effect ( currentSite, bc_in) do while(associated(currentCohort)) write(fates_log(),*) 'SF currentCohort%c_area ',currentCohort%c_area - if(pftcon%woody(currentCohort%pft) == 1)then + if(EDPftvarcon_inst%woody(currentCohort%pft) == 1)then currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area else total_grass_area = total_grass_area + currentCohort%c_area @@ -752,7 +753,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 @@ -767,7 +768,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 @@ -807,7 +808,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 @@ -868,7 +869,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. @@ -920,7 +921,7 @@ subroutine post_fire_mortality ( currentSite ) do while(associated(currentCohort)) currentCohort%fire_mort = 0.0_r8 currentCohort%crownfire_mort = 0.0_r8 - if (pftcon%woody(currentCohort%pft) == 1) then + if (EDPftvarcon_inst%woody(currentCohort%pft) == 1) then ! Equation 22 in Thonicke et al. 2010. currentCohort%crownfire_mort = EDecophyscon%crown_kill(currentCohort%pft)*currentCohort%cfa**3.0_r8 ! Equation 18 in Thonicke et al. 2010. diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 index 978ac5f9a2..5b539aeb04 100644 --- a/components/clm/src/ED/fire/SFParamsMod.F90 +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -4,6 +4,7 @@ module SFParamsMod ! use FatesConstantsMod , only: r8 => fates_r8 use EDtypesMod , only: NLSC,NFSC,NCWD + use FatesParametersInterface, only : param_string_length implicit none save @@ -23,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) @@ -35,178 +39,337 @@ module SFParamsMod real(r8),protected :: SF_val_mid_moisture_C(NFSC) real(r8),protected :: SF_val_mid_moisture_S(NFSC) - character(len=20),parameter :: SF_name_fdi_a = "fdi_a" - character(len=20),parameter :: SF_name_fdi_b = "fdi_b" - character(len=20),parameter :: SF_name_fdi_alpha = "fdi_alpha" - character(len=20),parameter :: SF_name_miner_total = "miner_total" - character(len=20),parameter :: SF_name_fuel_energy = "fuel_energy" - character(len=20),parameter :: SF_name_part_dens = "part_dens" - character(len=20),parameter :: SF_name_miner_damp = "miner_damp" - character(len=20),parameter :: SF_name_max_durat = "max_durat" - character(len=20),parameter :: SF_name_durat_slope = "durat_slope" - character(len=20),parameter :: SF_name_alpha_SH = "alpha_SH" - character(len=20),parameter :: SF_name_alpha_FMC = "alpha_FMC" - character(len=20),parameter :: SF_name_CWD_frac = "CWD_frac" - character(len=20),parameter :: SF_name_max_decomp = "max_decomp" - character(len=20),parameter :: SF_name_SAV = "SAV" - character(len=20),parameter :: SF_name_FBD = "FBD" - character(len=20),parameter :: SF_name_min_moisture = "min_moisture" - character(len=20),parameter :: SF_name_mid_moisture = "mid_moisture" - character(len=20),parameter :: SF_name_low_moisture_C = "low_moisture_C" - character(len=20),parameter :: SF_name_low_moisture_S = "low_moisture_S" - character(len=20),parameter :: SF_name_mid_moisture_C = "mid_moisture_C" - character(len=20),parameter :: SF_name_mid_moisture_S = "mid_moisture_S" - - public :: SFParamsRead + character(len=param_string_length),parameter :: SF_name_fdi_a = "fates_fdi_a" + character(len=param_string_length),parameter :: SF_name_fdi_b = "fates_fdi_b" + character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fates_fdi_alpha" + character(len=param_string_length),parameter :: SF_name_miner_total = "fates_miner_total" + character(len=param_string_length),parameter :: SF_name_fuel_energy = "fates_fuel_energy" + character(len=param_string_length),parameter :: SF_name_part_dens = "fates_part_dens" + character(len=param_string_length),parameter :: SF_name_miner_damp = "fates_miner_damp" + character(len=param_string_length),parameter :: SF_name_max_durat = "fates_max_durat" + character(len=param_string_length),parameter :: SF_name_durat_slope = "fates_durat_slope" + character(len=param_string_length),parameter :: SF_name_alpha_SH = "fates_alpha_SH" + character(len=param_string_length),parameter :: SF_name_alpha_FMC = "fates_alpha_FMC" + character(len=param_string_length),parameter :: SF_name_CWD_frac = "fates_CWD_frac" + character(len=param_string_length),parameter :: SF_name_max_decomp = "fates_max_decomp" + character(len=param_string_length),parameter :: SF_name_SAV = "fates_SAV" + character(len=param_string_length),parameter :: SF_name_FBD = "fates_FBD" + character(len=param_string_length),parameter :: SF_name_min_moisture = "fates_min_moisture" + character(len=param_string_length),parameter :: SF_name_mid_moisture = "fates_mid_moisture" + character(len=param_string_length),parameter :: SF_name_low_moisture_C = "fates_low_moisture_C" + character(len=param_string_length),parameter :: SF_name_low_moisture_S = "fates_low_moisture_S" + character(len=param_string_length),parameter :: SF_name_mid_moisture_C = "fates_mid_moisture_C" + character(len=param_string_length),parameter :: SF_name_mid_moisture_S = "fates_mid_moisture_S" + + public :: SpitFireRegisterParams + public :: SpitFireReceiveParams + + private :: SpitFireParamsInit + private :: SpitFireRegisterScalars + private :: SpitFireReceiveScalars + + private :: SpitFireRegisterNCWD + private :: SpitFireReceiveNCWD + + private :: SpitFireRegisterNLSC + private :: SpitFireReceiveNLSC + + private :: SpitFireRegisterNFSC + private :: SpitFireReceiveNFSC contains !----------------------------------------------------------------------- - ! + subroutine SpitFireParamsInit() + ! Initialize all parameters to nan to ensure that we get valid + ! values back from the host. + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + + implicit none + + SF_val_fdi_a = nan + SF_val_fdi_b = nan + SF_val_fdi_alpha = nan + SF_val_miner_total = nan + SF_val_fuel_energy = nan + SF_val_part_dens = nan + SF_val_miner_damp = nan + SF_val_max_durat = nan + SF_val_durat_slope = nan + SF_val_alpha_SH = nan + + SF_val_CWD_frac(:) = nan + + SF_val_alpha_FMC(:) = nan + SF_val_max_decomp(:) = nan + + SF_val_SAV(:) = nan + SF_val_FBD(:) = nan + SF_val_min_moisture(:) = nan + SF_val_mid_moisture(:) = nan + SF_val_low_moisture_C(:) = nan + SF_val_low_moisture_S(:) = nan + SF_val_mid_moisture_C(:) = nan + SF_val_mid_moisture_S(:) = nan + + end subroutine SpitFireParamsInit + + !----------------------------------------------------------------------- + subroutine 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 + + call SpitFireParamsInit() + call SpitFireRegisterScalars(fates_params) + call SpitFireRegisterNCWD(fates_params) + call SpitFireRegisterNLSC(fates_params) + call SpitFireRegisterNFSC(fates_params) + + end subroutine SpitFireRegisterParams + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call SpitFireReceiveScalars(fates_params) + call SpitFireReceiveNCWD(fates_params) + call SpitFireReceiveNLSC(fates_params) + call SpitFireReceiveNFSC(fates_params) + + end subroutine SpitFireReceiveParams + !----------------------------------------------------------------------- - subroutine SFParamsRead(ncid) - ! - ! calls to initialize parameter instance and do ncdio read - ! - use ncdio_pio , only : file_desc_t - - implicit none + 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 - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) - call SFParamsReadLocal(ncid) + call fates_params%RegisterParameter(name=SF_name_fdi_a, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_fdi_b, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_fdi_alpha, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_miner_total, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_fuel_energy, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_part_dens, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_miner_damp, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_max_durat, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_durat_slope, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=SF_name_alpha_SH, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + end subroutine SpitFireRegisterScalars + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveScalars(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call fates_params%RetreiveParameter(name=SF_name_fdi_a, & + data=SF_val_fdi_a) + + call fates_params%RetreiveParameter(name=SF_name_fdi_b, & + data=SF_val_fdi_b) + + call fates_params%RetreiveParameter(name=SF_name_fdi_alpha, & + data=SF_val_fdi_alpha) + + call fates_params%RetreiveParameter(name=SF_name_miner_total, & + data=SF_val_miner_total) + + call fates_params%RetreiveParameter(name=SF_name_fuel_energy, & + data=SF_val_fuel_energy) + + call fates_params%RetreiveParameter(name=SF_name_part_dens, & + data=SF_val_part_dens) + + call fates_params%RetreiveParameter(name=SF_name_miner_damp, & + data=SF_val_miner_damp) + + call fates_params%RetreiveParameter(name=SF_name_max_durat, & + data=SF_val_max_durat) + + call fates_params%RetreiveParameter(name=SF_name_durat_slope, & + data=SF_val_durat_slope) + + call fates_params%RetreiveParameter(name=SF_name_alpha_SH, & + data=SF_val_alpha_SH) + + end subroutine SpitFireReceiveScalars - end subroutine SFParamsRead !----------------------------------------------------------------------- + subroutine SpitFireRegisterNCWD(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_cwd, dimension_shape_1d + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names_cwd(1) = (/dimension_name_cwd/) + + call fates_params%RegisterParameter(name=SF_name_CWD_frac, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_cwd) + + end subroutine SpitFireRegisterNCWD + + !----------------------------------------------------------------------- + subroutine SpitFireReceiveNCWD(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call fates_params%RetreiveParameter(name=SF_name_CWD_frac, & + data=SF_val_CWD_frac) + + end subroutine SpitFireReceiveNCWD !----------------------------------------------------------------------- - ! + subroutine 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 + subroutine SpitFireRegisterNFSC(fates_params) - implicit none + use FatesParametersInterface, only : fates_parameters_type, dimension_name_fsc, dimension_shape_1d - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + implicit none - ! local vars - character(len=32) :: subname = 'SFParamsReadLocal::' + class(fates_parameters_type), intent(inout) :: fates_params - ! - ! call read function - ! + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_fsc/) - call readNcdio(ncid = ncid, & - varName=SF_name_fdi_a, & - callingName=subname, & - retVal=SF_val_fdi_a) - - call readNcdio(ncid = ncid, & - varName=SF_name_fdi_b, & - callingName=subname, & - retVal=SF_val_fdi_b) - - call readNcdio(ncid = ncid, & - varName=SF_name_fdi_alpha, & - callingName=subname, & - retVal=SF_val_fdi_alpha) - - call readNcdio(ncid = ncid, & - varName=SF_name_miner_total, & - callingName=subname, & - retVal=SF_val_miner_total) - - call readNcdio(ncid = ncid, & - varName=SF_name_fuel_energy, & - callingName=subname, & - retVal=SF_val_fuel_energy) - - call readNcdio(ncid = ncid, & - varName=SF_name_part_dens, & - callingName=subname, & - retVal=SF_val_part_dens) - - call readNcdio(ncid = ncid, & - varName=SF_name_miner_damp, & - callingName=subname, & - retVal=SF_val_miner_damp) - - call readNcdio(ncid = ncid, & - varName=SF_name_max_durat, & - callingName=subname, & - retVal=SF_val_max_durat) - - call readNcdio(ncid = ncid, & - varName=SF_name_durat_slope, & - callingName=subname, & - retVal=SF_val_durat_slope) - - call readNcdio(ncid = ncid, & - varName=SF_name_alpha_SH, & - callingName=subname, & - retVal=SF_val_alpha_SH) - - call readNcdio(ncid = ncid, & - varName=SF_name_alpha_FMC, & - callingName=subname, & - retVal=SF_val_alpha_FMC) - - call readNcdio(ncid = ncid, & - varName=SF_name_CWD_frac, & - callingName=subname, & - retVal=SF_val_CWD_frac) - - call readNcdio(ncid = ncid, & - varName=SF_name_max_decomp, & - callingName=subname, & - retVal=SF_val_max_decomp) - - call readNcdio(ncid = ncid, & - varName=SF_name_SAV, & - callingName=subname, & - retVal=SF_val_SAV) - - call readNcdio(ncid = ncid, & - varName=SF_name_FBD, & - callingName=subname, & - retVal=SF_val_FBD) - - call readNcdio(ncid = ncid, & - varName=SF_name_min_moisture, & - callingName=subname, & - retVal=SF_val_min_moisture) - - call readNcdio(ncid = ncid, & - varName=SF_name_mid_moisture, & - callingName=subname, & - retVal=SF_val_mid_moisture) - - call readNcdio(ncid = ncid, & - varName=SF_name_low_moisture_C, & - callingName=subname, & - retVal=SF_val_low_moisture_C) - - call readNcdio(ncid = ncid, & - varName=SF_name_low_moisture_S, & - callingName=subname, & - retVal=SF_val_low_moisture_S) - - call readNcdio(ncid = ncid, & - varName=SF_name_mid_moisture_C, & - callingName=subname, & - retVal=SF_val_mid_moisture_C) - - call readNcdio(ncid = ncid, & - varName=SF_name_mid_moisture_S, & - callingName=subname, & - retVal=SF_val_mid_moisture_S) - - end subroutine SFParamsReadLocal + call fates_params%RegisterParameter(name=SF_name_SAV, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_FBD, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_min_moisture, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_mid_moisture, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_low_moisture_C, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_low_moisture_S, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_mid_moisture_C, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=SF_name_mid_moisture_S, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + 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/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 4f949ba76e..eb14e071b3 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -10,7 +10,7 @@ module EDInitMod use FatesGlobals , only : fates_log use clm_varctl , only : use_ed_spit_fire use clm_time_manager , only : is_restart - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst use EDEcophysConType , only : EDecophyscon use EDGrowthFunctionsMod , only : bdead, bleaf, dbh use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts @@ -261,17 +261,17 @@ subroutine init_cohorts( patch_in ) temp_cohort%dbh = Dbh(temp_cohort) ! FIX(RF, 090314) - comment out addition of ' + 0.0001_r8*pft ' - seperate out PFTs a little bit... temp_cohort%canopy_trim = 1.0_r8 temp_cohort%bdead = Bdead(temp_cohort) - temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + pftcon%froot_leaf(pft) & + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + EDPftvarcon_inst%froot_leaf(pft) & + EDecophyscon%sapwood_ratio(temp_cohort%pft)*temp_cohort%hite) temp_cohort%b = temp_cohort%balive + temp_cohort%bdead - if( pftcon%evergreen(pft) == 1) then + if( EDPftvarcon_inst%evergreen(pft) == 1) then temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) temp_cohort%laimemory = 0._r8 cstatus = 2 endif - if( pftcon%season_decid(pft) == 1 ) then !for dorment places + if( EDPftvarcon_inst%season_decid(pft) == 1 ) then !for dorment places temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) !stored carbon in new seedlings. if(patch_in%siteptr%status == 2)then temp_cohort%laimemory = 0.0_r8 @@ -283,7 +283,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/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90 index 16e2f2f577..eda22e0b2e 100644 --- a/components/clm/src/ED/main/EDParamsMod.F90 +++ b/components/clm/src/ED/main/EDParamsMod.F90 @@ -4,7 +4,8 @@ module EDParamsMod ! use shr_kind_mod , only: r8 => shr_kind_r8 use EDtypesMod , only: maxPft - + use FatesParametersInterface, only : param_string_length + implicit none save ! private - if we allow this module to be private, it does not allow the protected values below to be @@ -13,11 +14,11 @@ module EDParamsMod ! ! this is what the user can use for the actual values ! + real(r8),protected :: ED_val_grass_spread real(r8),protected :: ED_val_comp_excln real(r8),protected :: ED_val_stress_mort real(r8),protected :: ED_val_dispersal - real(r8),protected :: ED_val_grperc(maxPft) real(r8),protected :: ED_val_maxspread real(r8),protected :: ED_val_minspread real(r8),protected :: ED_val_init_litter @@ -26,125 +27,152 @@ module EDParamsMod real(r8),protected :: ED_val_profile_tol real(r8),protected :: ED_val_ag_biomass - character(len=20),parameter :: ED_name_grass_spread = "grass_spread" - character(len=20),parameter :: ED_name_comp_excln = "comp_excln" - character(len=20),parameter :: ED_name_stress_mort = "stress_mort" - character(len=20),parameter :: ED_name_dispersal = "dispersal" - character(len=20),parameter :: ED_name_grperc = "grperc" - character(len=20),parameter :: ED_name_maxspread = "maxspread" - character(len=20),parameter :: ED_name_minspread = "minspread" - character(len=20),parameter :: ED_name_init_litter = "init_litter" - character(len=20),parameter :: ED_name_nfires = "nfires" - character(len=20),parameter :: ED_name_understorey_death = "understorey_death" - character(len=20),parameter :: ED_name_profile_tol = "profile_tol" - character(len=20),parameter :: ED_name_ag_biomass= "ag_biomass" + character(len=param_string_length),parameter :: ED_name_grass_spread = "fates_grass_spread" + character(len=param_string_length),parameter :: ED_name_comp_excln = "fates_comp_excln" + character(len=param_string_length),parameter :: ED_name_stress_mort = "fates_stress_mort" + character(len=param_string_length),parameter :: ED_name_dispersal = "fates_dispersal" + character(len=param_string_length),parameter :: ED_name_maxspread = "fates_maxspread" + character(len=param_string_length),parameter :: ED_name_minspread = "fates_minspread" + character(len=param_string_length),parameter :: ED_name_init_litter = "fates_init_litter" + character(len=param_string_length),parameter :: ED_name_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 :: EDParamsRead + public :: FatesParamsInit + public :: FatesRegisterParams + public :: FatesReceiveParams contains !----------------------------------------------------------------------- - ! - !----------------------------------------------------------------------- - subroutine EDParamsRead(ncid) - ! - ! calls to initialize parameter instance and do ncdio read - ! - use ncdio_pio , only : file_desc_t - - implicit none + subroutine FatesParamsInit() + ! Initialize all parameters to nan to ensure that we get valid + ! values back from the host. + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + implicit none - call EDParamsReadLocal(ncid) + ED_val_grass_spread = nan + ED_val_comp_excln = nan + ED_val_stress_mort = nan + ED_val_dispersal = nan + ED_val_maxspread = nan + ED_val_minspread = nan + ED_val_init_litter = nan + ED_val_nfires = nan + ED_val_understorey_death = nan + ED_val_profile_tol = nan + ED_val_ag_biomass = nan - end subroutine EDParamsRead - !----------------------------------------------------------------------- + end subroutine FatesParamsInit !----------------------------------------------------------------------- - ! - !----------------------------------------------------------------------- - subroutine EDParamsReadLocal(ncid) - ! - ! read the netcdf file and populate internalInstScalar - ! - use ncdio_pio , only : file_desc_t - use paramUtilMod , only : readNcdio + subroutine FatesRegisterParams(fates_params) + ! Register the parameters we want the host to provide, and + ! indicate whether they are fates parameters or host parameters + ! that need to be synced with host values. - implicit none + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar1d, dimension_shape_1d - ! arguments - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + implicit none - ! local vars - character(len=32) :: subname = 'EDParamsReadLocal::' + class(fates_parameters_type), intent(inout) :: fates_params - ! - ! call read function - ! + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_scalar1d/) - call readNcdio(ncid = ncid, & - varName=ED_name_grass_spread, & - callingName=subname, & - retVal=ED_val_grass_spread) - - call readNcdio(ncid = ncid, & - varName=ED_name_comp_excln, & - callingName=subname, & - retVal=ED_val_comp_excln) - - call readNcdio(ncid = ncid, & - varName=ED_name_stress_mort, & - callingName=subname, & - retVal=ED_val_stress_mort) - - call readNcdio(ncid = ncid, & - varName=ED_name_dispersal, & - callingName=subname, & - retVal=ED_val_dispersal) - - call readNcdio(ncid = ncid, & - varName=ED_name_grperc, & - callingName=subname, & - retVal=ED_val_grperc) - - call readNcdio(ncid = ncid, & - varName=ED_name_maxspread, & - callingName=subname, & - retVal=ED_val_maxspread) - - call readNcdio(ncid = ncid, & - varName=ED_name_minspread, & - callingName=subname, & - retVal=ED_val_minspread) - - call readNcdio(ncid = ncid, & - varName=ED_name_init_litter, & - callingName=subname, & - retVal=ED_val_init_litter) - - call readNcdio(ncid = ncid, & - varName=ED_name_nfires, & - callingName=subname, & - retVal=ED_val_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) + call FatesParamsInit() + + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_stress_mort, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_dispersal, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_maxspread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_minspread, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_init_litter, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_nfires, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_understorey_death, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_profile_tol, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + call fates_params%RegisterParameter(name=ED_name_ag_biomass, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + end subroutine FatesRegisterParams - end subroutine EDParamsReadLocal !----------------------------------------------------------------------- + subroutine FatesReceiveParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call fates_params%RetreiveParameter(name=ED_name_grass_spread, & + data=ED_val_grass_spread) + + call fates_params%RetreiveParameter(name=ED_name_comp_excln, & + data=ED_val_comp_excln) + + call fates_params%RetreiveParameter(name=ED_name_grass_spread, & + data=ED_val_grass_spread) + call fates_params%RetreiveParameter(name=ED_name_comp_excln, & + data=ED_val_comp_excln) + + call fates_params%RetreiveParameter(name=ED_name_stress_mort, & + data=ED_val_stress_mort) + + call fates_params%RetreiveParameter(name=ED_name_dispersal, & + data=ED_val_dispersal) + + call fates_params%RetreiveParameter(name=ED_name_maxspread, & + data=ED_val_maxspread) + + call fates_params%RetreiveParameter(name=ED_name_minspread, & + data=ED_val_minspread) + + call fates_params%RetreiveParameter(name=ED_name_init_litter, & + data=ED_val_init_litter) + + call fates_params%RetreiveParameter(name=ED_name_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/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 index 0961e71adb..b60586c8c1 100644 --- a/components/clm/src/ED/main/EDPftvarcon.F90 +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -6,138 +6,755 @@ module EDPftvarcon ! read and initialize vegetation (PFT) constants. ! ! !USES: - use clm_varpar , only : mxpft + use clm_varpar , only : mxpft, numrad, ivis, inir, nvariants use shr_kind_mod, only : r8 => shr_kind_r8 + use FatesGlobals, only : fates_log ! ! !PUBLIC TYPES: implicit none save private + integer, parameter, public :: lower_bound_pft = 0 + integer, parameter, public :: lower_bound_general = 1 + !ED specific variables. type, public :: EDPftvarcon_type - real(r8) :: max_dbh (0:mxpft) ! maximum dbh at which height growth ceases... - real(r8) :: freezetol (0:mxpft) ! minimum temperature tolerance... - real(r8) :: wood_density (0:mxpft) ! wood density g cm^-3 ... - real(r8) :: alpha_stem (0:mxpft) ! live stem turnover rate. y-1 - real(r8) :: hgt_min (0:mxpft) ! sapling height m - real(r8) :: cushion (0:mxpft) ! labile carbon storage target as multiple of leaf pool. - real(r8) :: leaf_stor_priority (0:mxpft) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). - real(r8) :: leafwatermax (0:mxpft) ! degree to which respiration is limited by btran if btran = 0 - real(r8) :: rootresist (0:mxpft) - real(r8) :: soilbeta (0:mxpft) - real(r8) :: crown (0:mxpft) - real(r8) :: bark_scaler (0:mxpft) - real(r8) :: crown_kill (0:mxpft) - real(r8) :: initd (0:mxpft) - real(r8) :: sd_mort (0:mxpft) - real(r8) :: seed_rain (0:mxpft) - real(r8) :: BB_slope (0:mxpft) - real(r8) :: root_long (0:mxpft) ! root longevity (yrs) - real(r8) :: clone_alloc (0:mxpft) ! fraction of carbon balance allocated to clonal reproduction. - real(r8) :: seed_alloc (0:mxpft) ! fraction of carbon balance allocated to seeds. - real(r8) :: sapwood_ratio (0:mxpft) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m - real(r8) :: dbh2h_m (0:mxpft) ! allocation parameter m from dbh to height + real(r8), allocatable :: max_dbh (:) ! maximum dbh at which height growth ceases... + real(r8), allocatable :: freezetol (:) ! minimum temperature tolerance... + real(r8), allocatable :: wood_density (:) ! wood density g cm^-3 ... + real(r8), allocatable :: alpha_stem (:) ! live stem turnover rate. y-1 + real(r8), allocatable :: hgt_min (:) ! sapling height m + real(r8), allocatable :: cushion (:) ! labile carbon storage target as multiple of leaf pool. + real(r8), allocatable :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). + real(r8), allocatable :: leafwatermax (:) ! degree to which respiration is limited by btran if btran = 0 + real(r8), allocatable :: rootresist (:) + real(r8), allocatable :: soilbeta (:) + real(r8), allocatable :: crown (:) + real(r8), allocatable :: bark_scaler (:) + real(r8), allocatable :: crown_kill (:) + real(r8), allocatable :: initd (:) + real(r8), allocatable :: sd_mort (:) + real(r8), allocatable :: seed_rain (:) + real(r8), allocatable :: BB_slope (:) + real(r8), allocatable :: root_long (:) ! root longevity (yrs) + real(r8), allocatable :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. + real(r8), allocatable :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. + real(r8), allocatable :: sapwood_ratio (:) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m + real(r8), allocatable :: dbh2h_m (:) ! allocation parameter m from dbh to height + real(r8), allocatable :: woody(:) + real(r8), allocatable :: stress_decid(:) + real(r8), allocatable :: season_decid(:) + real(r8), allocatable :: evergreen(:) + real(r8), allocatable :: froot_leaf(:) + real(r8), allocatable :: slatop(:) + real(r8), allocatable :: leaf_long(:) + real(r8), allocatable :: roota_par(:) + real(r8), allocatable :: rootb_par(:) + real(r8), allocatable :: lf_flab(:) + real(r8), allocatable :: lf_fcel(:) + real(r8), allocatable :: lf_flig(:) + real(r8), allocatable :: fr_flab(:) + real(r8), allocatable :: fr_fcel(:) + real(r8), allocatable :: fr_flig(:) + real(r8), allocatable :: xl(:) + real(r8), allocatable :: c3psn(:) + real(r8), allocatable :: flnr(:) + real(r8), allocatable :: fnitr(:) + real(r8), allocatable :: leafcn(:) + real(r8), allocatable :: frootcn(:) + real(r8), allocatable :: smpso(:) + real(r8), allocatable :: smpsc(:) + real(r8), allocatable :: grperc(:) ! NOTE(bja, 2017-01) moved from EDParamsMod, was allocated as (maxPft=79), not (0:mxpft=78)! + real(r8), allocatable :: rhol(:, :) + real(r8), allocatable :: rhos(:, :) + real(r8), allocatable :: taul(:, :) + real(r8), allocatable :: taus(:, :) + real(r8), allocatable :: rootprof_beta(:, :) + contains + procedure, public :: Init => EDpftconInit + procedure, public :: Register + procedure, public :: Receive + procedure, private :: Register_PFT + procedure, private :: Receive_PFT + procedure, private :: Register_PFT_nvariants + procedure, private :: Receive_PFT_nvariants + procedure, private :: Register_PFT_numrad + procedure, private :: Receive_PFT_numrad end type EDPftvarcon_type type(EDPftvarcon_type), public :: EDPftvarcon_inst + character(len=*), parameter, private :: sourcefile = & + __FILE__ ! ! !PUBLIC MEMBER FUNCTIONS: - public :: EDpftconrd ! Read and initialize vegetation (PFT) constants + !----------------------------------------------------------------------- contains !----------------------------------------------------------------------- - subroutine EDpftconrd( ncid ) - ! - ! !DESCRIPTION: - ! Read and initialize vegetation (PFT) constants - ! - ! !USES: - use ncdio_pio , only : file_desc_t, ncd_io - use FatesGlobals, only : endrun => fates_endrun - ! - ! !ARGUMENTS: + subroutine EDpftconInit(this) + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + implicit none - ! - type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id - ! !LOCAL VARIABLES: + class(EDPftvarcon_type), intent(inout) :: this + + end subroutine EDpftconInit + + !----------------------------------------------------------------------- + subroutine Register(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%Register_PFT(fates_params) + call this%Register_PFT_numrad(fates_params) + call this%Register_PFT_nvariants(fates_params) + + end subroutine Register + + !----------------------------------------------------------------------- + subroutine Receive(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%Receive_PFT(fates_params) + call this%Receive_PFT_numrad(fates_params) + call this%Receive_PFT_nvariants(fates_params) + + end subroutine Receive + + !----------------------------------------------------------------------- + subroutine Register_PFT(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/) + + integer, parameter :: dim_lower_bound(1) = (/ lower_bound_pft /) + + character(len=param_string_length) :: name + + !X! name = '' + !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + !X! dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_max_dbh' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_freezetol' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_wood_density' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_alpha_stem' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hgt_min' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_cushion' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_leaf_stor_priority' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_leafwatermax' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_rootresist' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_soilbeta' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_crown' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_bark_scaler' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_crown_kill' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_initd' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_sd_mort' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_seed_rain' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_BB_slope' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_root_long' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_clone_alloc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_seed_alloc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_sapwood_ratio' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_woody' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_stress_decid' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_season_decid' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_evergreen' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_froot_leaf' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_slatop' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_leaf_long' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_roota_par' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_rootb_par' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_lf_flab' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_lf_fcel' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_lf_flig' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_fr_flab' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_fr_fcel' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_fr_flig' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_xl' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_c3psn' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_flnr' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_fnitr' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_leafcn' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_frootcn' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_smpso' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_smpsc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_grperc' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + + end subroutine Register_PFT + + !----------------------------------------------------------------------- + subroutine Receive_PFT(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name - logical :: readv ! read variable in or not - character(len=32) :: subname = 'EDpftconrd' ! subroutine name + !X! name = '' + !X! call fates_params%RetreiveParameter(name=name, & + !X! data=this%) - call ncd_io('max_dbh',EDPftvarcon_inst%max_dbh, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_max_dbh' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%max_dbh) - call ncd_io('freezetol',EDPftvarcon_inst%freezetol, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_freezetol' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%freezetol) - call ncd_io('wood_density',EDPftvarcon_inst%wood_density, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_wood_density' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%wood_density) - call ncd_io('alpha_stem',EDPftvarcon_inst%alpha_stem, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_alpha_stem' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%alpha_stem) - call ncd_io('hgt_min',EDPftvarcon_inst%hgt_min, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_hgt_min' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hgt_min) - call ncd_io('cushion',EDPftvarcon_inst%cushion, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_cushion' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%cushion) - call ncd_io('leaf_stor_priority',EDPftvarcon_inst%leaf_stor_priority, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_leaf_stor_priority' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%leaf_stor_priority) - call ncd_io('leafwatermax',EDPftvarcon_inst%leafwatermax, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_leafwatermax' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%leafwatermax) - call ncd_io('rootresist',EDPftvarcon_inst%rootresist,'read', ncid, readvar=readv) - if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + name = 'fates_rootresist' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%rootresist) - call ncd_io('soilbeta',EDPftvarcon_inst%soilbeta,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_soilbeta' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%soilbeta) - call ncd_io('crown',EDPftvarcon_inst%crown,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_crown' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%crown) - call ncd_io('bark_scaler',EDPftvarcon_inst%bark_scaler,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_bark_scaler' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%bark_scaler) - call ncd_io('crown_kill',EDPftvarcon_inst%crown_kill,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_crown_kill' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%crown_kill) - call ncd_io('initd',EDPftvarcon_inst%initd,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_initd' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%initd) - call ncd_io('sd_mort',EDPftvarcon_inst%sd_mort,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_sd_mort' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%sd_mort) - call ncd_io('seed_rain',EDPftvarcon_inst%seed_rain,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_seed_rain' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%seed_rain) - call ncd_io('BB_slope',EDPftvarcon_inst%BB_slope,'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_BB_slope' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%BB_slope) + + name = 'fates_root_long' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%root_long) + + name = 'fates_clone_alloc' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%clone_alloc) + + name = 'fates_seed_alloc' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%seed_alloc) + + name = 'fates_sapwood_ratio' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%sapwood_ratio) + + name = 'fates_woody' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%woody) + + name = 'fates_stress_decid' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%stress_decid) + + name = 'fates_season_decid' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%season_decid) + + name = 'fates_evergreen' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%evergreen) + + name = 'fates_froot_leaf' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%froot_leaf) + + name = 'fates_slatop' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%slatop) + + name = 'fates_leaf_long' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%leaf_long) + + name = 'fates_roota_par' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%roota_par) + + name = 'fates_rootb_par' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%rootb_par) + + name = 'fates_lf_flab' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%lf_flab) + + name = 'fates_lf_fcel' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%lf_fcel) + + name = 'fates_lf_flig' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%lf_flig) + + name = 'fates_fr_flab' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%fr_flab) + + name = 'fates_fr_fcel' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%fr_fcel) + + name = 'fates_fr_flig' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%fr_flig) + + name = 'fates_xl' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%xl) + + name = 'fates_c3psn' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%c3psn) + + name = 'fates_flnr' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%flnr) + + name = 'fates_fnitr' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%fnitr) + + name = 'fates_leafcn' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%leafcn) + + name = 'fates_frootcn' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%frootcn) + + name = 'fates_smpso' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%smpso) + + name = 'fates_smpsc' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%smpsc) + + name = 'fates_grperc' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%grperc) + + end subroutine Receive_PFT + + !----------------------------------------------------------------------- + subroutine Register_PFT_numrad(this, fates_params) + ! NOTE(bja, 2017-02) these are 2-d parameters, but they are + ! currently stored in the parameter file as separate 1-d + ! arrays. We have to register the parameters as 1-d arrays as they + ! are on the parameter file. We store them as 2-d in the receive step. + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/) + integer, parameter :: dim_lower_bound(1) = (/ lower_bound_pft /) + character(len=param_string_length) :: name + + !X! name = '' + !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + !X! dimension_names=dim_names) + + name = 'fates_rholvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fates_rholnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fates_rhosvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fates_rhosnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fates_taulvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fates_taulnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fates_tausvis' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + name = 'fates_tausnir' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names) + + + end subroutine Register_PFT_numrad + + !----------------------------------------------------------------------- + subroutine Receive_PFT_numrad(this, fates_params) + ! NOTE(bja, 2017-02) these are 2-d parameters, but they are + ! currently stored in the parameter file as separate 1-d arrays. + ! We can't allocate slices of arrays separately, so we have to + ! manually allocate the memory here, retreive into a dummy array, + ! and copy. All parameters in this subroutine are sized the same, + ! so we can reused the dummy array. If someone wants to cleanup + ! the input file, all this complexity can be removed. + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length, max_dimensions + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + !X! name = '' + !X! call fates_params%RetreiveParameter(name=name, & + !X! data=this%) + + integer :: index + integer :: dimension_shape + integer :: dimension_sizes(max_dimensions) + character(len=param_string_length) :: dimension_names(max_dimensions) + logical :: is_host_param + + integer :: lower_bound_1, upper_bound_1, lower_bound_2, upper_bound_2 + real(r8), allocatable :: dummy_data(:) + + ! Fetch metadata from a representative variable. All variables + ! called by this subroutine must be dimensioned the same way! + name = 'fates_rholvis' + index = fates_params%FindIndex(name) + call fates_params%GetMetaData(index, name, dimension_shape, dimension_sizes, dimension_names, is_host_param) + lower_bound_1 = lower_bound_pft + upper_bound_1 = lower_bound_pft + dimension_sizes(1) - 1 + lower_bound_2 = lower_bound_general + upper_bound_2 = numrad + + allocate(dummy_data(lower_bound_1:upper_bound_1)) + + ! + ! received rhol data + ! + allocate(this%rhol(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + + name = 'fates_rholvis' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%rhol(lower_bound_1:upper_bound_1, ivis) = dummy_data + + name = 'fates_rholnir' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%rhol(lower_bound_1:upper_bound_1, inir) = dummy_data + + ! + ! received rhos data + ! + allocate(this%rhos(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + + name = 'fates_rhosvis' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%rhos(lower_bound_1:upper_bound_1, ivis) = dummy_data + + name = 'fates_rhosnir' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%rhos(lower_bound_1:upper_bound_1, inir) = dummy_data + + ! + ! received taul data + ! + allocate(this%taul(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + + name = 'fates_taulvis' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%taul(lower_bound_1:upper_bound_1, ivis) = dummy_data + + name = 'fates_taulnir' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%taul(lower_bound_1:upper_bound_1, inir) = dummy_data + + ! + ! received taus data + ! + allocate(this%taus(lower_bound_1:upper_bound_1, lower_bound_2:upper_bound_2)) + + name = 'fates_tausvis' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%taus(lower_bound_1:upper_bound_1, ivis) = dummy_data + + name = 'fates_tausnir' + call fates_params%RetreiveParameter(name=name, & + data=dummy_data) + this%taus(lower_bound_1:upper_bound_1, inir) = dummy_data + + end subroutine Receive_PFT_numrad + + !----------------------------------------------------------------------- + subroutine Register_PFT_nvariants(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : max_dimensions, dimension_name_variants, dimension_name_pft, dimension_shape_2d + + implicit none + + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + integer, parameter :: dim_lower_bound(2) = (/ lower_bound_pft, lower_bound_general /) + character(len=param_string_length) :: dim_names(2) + character(len=param_string_length) :: name + + ! NOTE(bja, 2017-01) initialization doesn't seem to work correctly + ! if dim_names has a parameter qualifier. + dim_names(1) = dimension_name_pft + dim_names(2) = dimension_name_variants + + !X! name = '' + !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + !X! dimension_names=dim_names) + + name = 'fates_rootprof_beta' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + end subroutine Register_PFT_nvariants + + !----------------------------------------------------------------------- + subroutine Receive_PFT_nvariants(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length + + implicit none - call ncd_io('root_long',EDPftvarcon_inst%root_long, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + class(EDPftvarcon_type), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params - call ncd_io('seed_alloc',EDPftvarcon_inst%seed_alloc, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + character(len=param_string_length) :: name - call ncd_io('clone_alloc',EDPftvarcon_inst%clone_alloc, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + !X! name = '' + !X! call fates_params%RetreiveParameter(name=name, & + !X! data=this%) - call ncd_io('sapwood_ratio',EDPftvarcon_inst%sapwood_ratio, 'read', ncid, readvar=readv) - if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') - -! HOLDING ON SEW ENSITIVITY-ANALYSIS PARAMETERS UNTIL MACHINE CONFIGS SET RGK/CX -! call ncd_io('dbh2h_m',EDPftvarcon_inst%dbh2h_m, 'read', ncid, readvar=readv) -! if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + name = 'fates_rootprof_beta' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%rootprof_beta) - end subroutine EDpftconrd + end subroutine Receive_PFT_nvariants end module EDPftvarcon diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 16ac4eef1c..4a8b491b70 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -560,6 +560,4 @@ subroutine ed_hist_scpfmaps end subroutine ed_hist_scpfmaps - - end module EDTypesMod diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index d7aa01ec11..0cc706f776 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -11,7 +11,7 @@ module FatesHistoryInterfaceMod use FatesInterfaceMod, only : hlm_hio_ignore_val ! FIXME(bja, 2016-10) need to remove CLM dependancy - use pftconMod , only : pftcon + use EDPftvarcon , only : EDPftvarcon_inst implicit none @@ -1097,7 +1097,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if ! Woody State Variables (basal area and number density and mortality) - if (pftcon%woody(ft) == 1) then + if (EDPftvarcon_inst%woody(ft) == 1) then hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*ccohort%n hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*ccohort%n diff --git a/components/clm/src/ED/main/FatesParameterDerivedMod.F90 b/components/clm/src/ED/main/FatesParameterDerivedMod.F90 index 41641d754e..f1000ad11f 100644 --- a/components/clm/src/ED/main/FatesParameterDerivedMod.F90 +++ b/components/clm/src/ED/main/FatesParameterDerivedMod.F90 @@ -53,7 +53,7 @@ end subroutine InitAllocate subroutine Init(this,maxpft) - use pftconMod , only: pftcon + use EDPftvarcon, only: EDPftvarcon_inst class(param_derived_type), intent(inout) :: this integer, intent(in) :: maxpft @@ -63,10 +63,10 @@ subroutine Init(this,maxpft) real(r8) :: lnc ! leaf N concentration (gN leaf/m^2) associate( & - slatop => pftcon%slatop , & ! specific leaf area at top of canopy, + slatop => EDPftvarcon_inst%slatop , & ! specific leaf area at top of canopy, ! projected area basis [m^2/gC] - fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-) - leafcn => pftcon%leafcn ) ! leaf C:N (gC/gN) + fnitr => EDPftvarcon_inst%fnitr , & ! foliage nitrogen limitation factor (-) + leafcn => EDPftvarcon_inst%leafcn ) ! leaf C:N (gC/gN) call this%InitAllocate(maxpft) diff --git a/components/clm/src/ED/main/FatesParametersInterface.F90 b/components/clm/src/ED/main/FatesParametersInterface.F90 new file mode 100644 index 0000000000..007dd78d71 --- /dev/null +++ b/components/clm/src/ED/main/FatesParametersInterface.F90 @@ -0,0 +1,484 @@ +module FatesParametersInterface + ! NOTE(bja, 2017-01) this is part of the interface between fates and + ! the host model. To avoid circular dependancies, it should not + ! depend on any host modules. + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_log + + implicit none + + integer, parameter, public :: max_params = 250 + integer, parameter, public :: max_dimensions = 2 + integer, parameter, public :: max_used_dimensions = 25 + integer, parameter, public :: param_string_length = 40 + ! NOTE(bja, 2017-02) these are the values returned from netcdf after + ! inquiring about the number of dimensions + integer, parameter, public :: dimension_shape_scalar = 0 + integer, parameter, public :: dimension_shape_1d = 1 + integer, parameter, public :: dimension_shape_2d = 2 + + ! Dimensions in the fates namespace: + character(len=*), parameter, public :: dimension_name_scalar = '' + character(len=*), parameter, public :: dimension_name_scalar1d = 'fates_scalar' + character(len=*), parameter, public :: dimension_name_pft = 'fates_pft' + character(len=*), parameter, public :: dimension_name_segment = 'fates_segment' + character(len=*), parameter, public :: dimension_name_cwd = 'fates_NCWD' + character(len=*), parameter, public :: dimension_name_lsc = 'fates_litterclass' + character(len=*), parameter, public :: dimension_name_fsc = 'fates_litterclass' + character(len=*), parameter, public :: dimension_name_allpfts = 'fates_allpfts' + character(len=*), parameter, public :: dimension_name_variants = 'fates_variants' + + ! Dimensions in the host namespace: + character(len=*), parameter, public :: dimension_name_host_allpfts = 'allpfts' + + type, private :: parameter_type + character(len=param_string_length) :: name + logical :: sync_with_host + integer :: dimension_shape + integer :: dimension_sizes(max_dimensions) + character(len=param_string_length) :: dimension_names(max_dimensions) + integer :: dimension_lower_bound(max_dimensions) + real(r8), allocatable :: data(:, :) + end type parameter_type + + type, public :: fates_parameters_type + integer, private :: num_parameters + type(parameter_type), private :: parameters(max_params) + + contains + procedure, public :: Init + procedure, public :: Destroy + procedure, public :: RegisterParameter + generic, public :: RetreiveParameter => RetreiveParameterScalar, RetreiveParameter1D, RetreiveParameter2D + generic, public :: RetreiveParameterAllocate => RetreiveParameter1DAllocate, RetreiveParameter2DAllocate + generic, public :: SetData => SetDataScalar, SetData1D, SetData2D + procedure, public :: GetUsedDimensions + procedure, public :: SetDimensionSizes + procedure, public :: GetMaxDimensionSize + procedure, public :: GetMetaData + procedure, public :: num_params + procedure, public :: FindIndex + + procedure, private :: RetreiveParameterScalar + procedure, private :: RetreiveParameter1D + procedure, private :: RetreiveParameter2D + procedure, private :: RetreiveParameter1DAllocate + procedure, private :: RetreiveParameter2DAllocate + procedure, private :: SetDataScalar + procedure, private :: SetData1D + procedure, private :: SetData2D + + end type fates_parameters_type + +contains + + !----------------------------------------------------------------------- + subroutine Init(this) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + + this%num_parameters = 0 + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine Destroy(this) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + + integer :: n + do n = 1, this%num_parameters + deallocate(this%parameters(n)%data) + end do + + end subroutine Destroy + + !----------------------------------------------------------------------- + subroutine RegisterParameter(this, name, dimension_shape, dimension_names, & + sync_with_host, lower_bounds) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + integer, intent(in) :: dimension_shape + character(len=param_string_length) :: dimension_names(1:) + logical, intent(in), optional :: sync_with_host + integer, intent(in), optional :: lower_bounds(1:) + + integer :: i, n, num_names, num_bounds + + this%num_parameters = this%num_parameters + 1 + i = this%num_parameters + ! FIXME(bja, 2017-01) assert(i <= max_params) + this%parameters(i)%name = name + this%parameters(i)%dimension_shape = dimension_shape + this%parameters(i)%dimension_sizes(:) = 0 + ! FIXME(bja, 2017-01) assert(size(dimension_names, 1) <= max_dimensions) + num_names = min(max_dimensions, size(dimension_names, 1)) + this%parameters(i)%dimension_names(:) = '' + do n = 1, num_names + this%parameters(i)%dimension_names(n) = dimension_names(n) + end do + this%parameters(i)%sync_with_host = .false. + if (present(sync_with_host)) then + this%parameters(i)%sync_with_host = sync_with_host + end if + ! allocate as a standard 1-based array unless otherwise specified + ! by the caller. + this%parameters(i)%dimension_lower_bound = (/ 1, 1 /) + if (present(lower_bounds)) then + num_bounds = min(max_dimensions, size(lower_bounds, 1)) + do n = 1, num_bounds + this%parameters(i)%dimension_lower_bound(n) = lower_bounds(n) + end do + endif + end subroutine RegisterParameter + + !----------------------------------------------------------------------- + subroutine RetreiveParameterScalar(this, name, data) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out) :: data + + integer :: i + + i = this%FindIndex(name) + ! assert(size(data) == size(this%parameters(i)%data)) + data = this%parameters(i)%data(1, 1) + + end subroutine RetreiveParameterScalar + + !----------------------------------------------------------------------- + subroutine RetreiveParameter1D(this, name, data) + + use abortutils, only : endrun + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out) :: data(:) + + integer :: i, d, size_dim_1 + + i = this%FindIndex(name) + if (size(data) /= size(this%parameters(i)%data(:, 1))) then + write(fates_log(), *) 'ERROR : retreiveparameter1d : ', name, ' size inconsistent.' + write(fates_log(), *) 'ERROR : expected size = ', size(data) + write(fates_log(), *) 'ERROR : data size received from file = ', size(this%parameters(i)%data(:, 1)) + write(fates_log(), *) 'ERROR : dimesions received from file' + write(fates_log(), *) 'ERROR : names size' + do d = 1, max_dimensions + write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d) + end do + call endrun(msg='size error retreiving 1d parameter.') + end if + data = this%parameters(i)%data(:, 1) + + end subroutine RetreiveParameter1D + + !----------------------------------------------------------------------- + subroutine RetreiveParameter2D(this, name, data) + + use abortutils, only : endrun + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out) :: data(:, :) + + integer :: i, d + + i = this%FindIndex(name) + if (size(data, 1) /= size(this%parameters(i)%data, 1) .and. & + size(data, 2) /= size(this%parameters(i)%data, 2)) then + write(fates_log(), *) 'ERROR : retreiveparameter2d : ', name, ' size inconsistent.' + write(fates_log(), *) 'ERROR : expected shape = ', shape(data) + write(fates_log(), *) 'ERROR : dim 1 expected size = ', size(data, 1) + write(fates_log(), *) 'ERROR : dim 2 expected size = ', size(data, 2) + write(fates_log(), *) 'ERROR : dim 1 data size received from file = ', size(this%parameters(i)%data, 1) + write(fates_log(), *) 'ERROR : dim 2 data size received from file = ', size(this%parameters(i)%data, 2) + write(fates_log(), *) 'ERROR : dimesions received from file' + write(fates_log(), *) 'ERROR : names size' + do d = 1, max_dimensions + write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d) + end do + call endrun(msg='size error retreiving 2d parameter.') + end if + data = this%parameters(i)%data + + end subroutine RetreiveParameter2D + + !----------------------------------------------------------------------- + subroutine RetreiveParameter1DAllocate(this, name, data) + + use abortutils, only : endrun + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out), allocatable :: data(:) + + integer :: i, lower_bound, upper_bound + + i = this%FindIndex(name) + lower_bound = this%parameters(i)%dimension_lower_bound(1) + upper_bound = lower_bound + this%parameters(i)%dimension_sizes(1) - 1 + allocate(data(lower_bound:upper_bound)) + data(lower_bound:upper_bound) = this%parameters(i)%data(:, 1) + + end subroutine RetreiveParameter1DAllocate + + !----------------------------------------------------------------------- + subroutine RetreiveParameter2DAllocate(this, name, data) + + use abortutils, only : endrun + + implicit none + + class(fates_parameters_type), intent(inout) :: this + character(len=param_string_length), intent(in) :: name + real(r8), intent(out), allocatable :: data(:, :) + + integer :: i, lb_1, ub_1, lb_2, ub_2 + + i = this%FindIndex(name) + lb_1 = this%parameters(i)%dimension_lower_bound(1) + ub_1 = lb_1 + this%parameters(i)%dimension_sizes(1) - 1 + lb_2 = this%parameters(i)%dimension_lower_bound(2) + ub_2 = lb_2 + this%parameters(i)%dimension_sizes(2) - 1 + allocate(data(lb_1:ub_1, lb_2:ub_2)) + data(lb_1:ub_1, lb_2:ub_2) = this%parameters(i)%data + + end subroutine RetreiveParameter2DAllocate + + !----------------------------------------------------------------------- + function FindIndex(this, name) result(i) + + implicit none + + class(fates_parameters_type), intent(in) :: this + character(len=param_string_length), intent(in) :: name + + integer :: i + + do i = 1, this%num_parameters + if (trim(this%parameters(i)%name) == trim(name)) then + exit + end if + end do + if (i > this%num_parameters) then + ! error, parameter name not found. + end if + + end function FindIndex + + !----------------------------------------------------------------------- + integer function num_params(this) + + implicit none + + class(fates_parameters_type), intent(in) :: this + + num_params = this%num_parameters + + end function num_params + + !----------------------------------------------------------------------- + subroutine GetUsedDimensions(this, is_host_file, num_used_dimensions, used_dimensions) + ! Construct a list of the unique dimension names used by the + ! parameters. + + implicit none + + class(fates_parameters_type), intent(inout) :: this + logical, intent(in) :: is_host_file + integer, intent(out) :: num_used_dimensions + character(len=param_string_length), intent(out) :: used_dimensions(max_used_dimensions) + + integer :: p, d, i + character(len=param_string_length) :: dim_name + + num_used_dimensions = 0 + do p = 1, this%num_parameters + if (is_host_file .eqv. this%parameters(p)%sync_with_host) then + do d = 1, max_dimensions + dim_name = this%parameters(p)%dimension_names(d) + if (len_trim(dim_name) /= 0) then + ! non-empty dimension name, check if it needs to be added to the list. + do i = 1, num_used_dimensions + if (used_dimensions(i) == dim_name) then + ! dimension is already in list. can stop searching + exit + end if + end do + + if (i > num_used_dimensions) then + ! dimension name was not in the list, add it. + num_used_dimensions = num_used_dimensions + 1 + used_dimensions(num_used_dimensions) = dim_name + end if + end if ! if dim_name + end do ! do d + end if ! if host_param + end do ! do p + + end subroutine GetUsedDimensions + + !----------------------------------------------------------------------- + subroutine SetDimensionSizes(this, is_host_file, num_used_dimensions, dimension_names, dimension_sizes) + ! Construct a list of the unique dimension names used by the + ! parameters. + + implicit none + + class(fates_parameters_type), intent(inout) :: this + logical, intent(in) :: is_host_file + integer, intent(in) :: num_used_dimensions + character(len=param_string_length), intent(in) :: dimension_names(max_used_dimensions) + integer, intent(in) :: dimension_sizes(max_used_dimensions) + + integer :: p, d, i + character(len=param_string_length) :: dim_name + + do p = 1, this%num_parameters + if (is_host_file .eqv. this%parameters(p)%sync_with_host) then + do d = 1, max_dimensions + dim_name = this%parameters(p)%dimension_names(d) + if (len_trim(dim_name) /= 0) then + ! non-empty dimension name, set the size + do i = 1, num_used_dimensions + if (trim(dimension_names(i)) == trim(dim_name)) then + !write(*, *) '--> ', trim(this%parameters(p)%name), ' setting ', trim(dim_name), ' d = ', d, 'size = ', dimension_sizes(i) + this%parameters(p)%dimension_sizes(d) = dimension_sizes(i) + exit + end if + end do + end if ! if dim_name + end do ! do dim + end if ! if host_param + end do ! do param + + end subroutine SetDimensionSizes + + !----------------------------------------------------------------------- + subroutine GetMetaData(this, index, name, dimension_shape, dimension_sizes, dimension_names, is_host_param) + + implicit none + + class(fates_parameters_type), intent(in) :: this + integer, intent(in) :: index + character(len=param_string_length), intent(out) :: name + integer, intent(out) :: dimension_shape + integer, intent(out) :: dimension_sizes(max_dimensions) + character(len=param_string_length), intent(out) :: dimension_names(max_dimensions) + logical, intent(out) :: is_host_param + + name = this%parameters(index)%name + dimension_shape = this%parameters(index)%dimension_shape + dimension_sizes = this%parameters(index)%dimension_sizes + dimension_names = this%parameters(index)%dimension_names + is_host_param = this%parameters(index)%sync_with_host + + end subroutine GetMetaData + + !----------------------------------------------------------------------- + function GetMaxDimensionSize(this) result(max_dim_size) + + implicit none + + class(fates_parameters_type), intent(in) :: this + + integer :: p, d, max_dim_size + + max_dim_size = 0 + + do p = 1, this%num_params() + do d = 1, max_dimensions + max_dim_size = max(max_dim_size, this%parameters(p)%dimension_sizes(d)) + end do + end do + + end function GetMaxDimensionSize + + !----------------------------------------------------------------------- + subroutine SetDataScalar(this, index, data) + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(in) :: index + real(r8), intent(in) :: data + + allocate(this%parameters(index)%data(1, 1)) + this%parameters(index)%data(1, 1) = data + + end subroutine SetDataScalar + + !----------------------------------------------------------------------- + subroutine SetData1D(this, index, data) + + use abortutils, only : endrun + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(in) :: index + real(r8), intent(in) :: data(:) + + integer :: size_dim_1, d + + size_dim_1 = this%parameters(index)%dimension_sizes(1) + if (size(data) /= size_dim_1) then + write(fates_log(), *) 'ERROR : setdata1d : ', this%parameters(index)%name, ' size inconsistent.' + write(fates_log(), *) 'ERROR : expected size = ', size(data) + write(fates_log(), *) 'ERROR : data size received from file = ', size_dim_1 + write(fates_log(), *) 'ERROR : dimesions received from file' + write(fates_log(), *) 'ERROR : names size' + do d = 1, max_dimensions + write(fates_log(), *) this%parameters(index)%dimension_names(d), ', ', this%parameters(index)%dimension_sizes(d) + end do + call endrun(msg='size error setting 1d parameter.') + end if + + allocate(this%parameters(index)%data(size_dim_1, 1)) + this%parameters(index)%data(:, 1) = data(:) + + end subroutine SetData1D + + !----------------------------------------------------------------------- + subroutine SetData2D(this, index, data) + ! FIXME(bja, 2017-01) this is broken, needs data dimensions to work correctly! + + implicit none + + class(fates_parameters_type), intent(inout) :: this + integer, intent(in) :: index + real(r8), intent(in) :: data(:, :) + + ! NOTE(bja, 2017-01) This should work for fortran 2003? Or 2008? + ! Either way, it works with intel and pgi being used in 2017-01, + ! but is broken in gfortran 5.2 and earlier. That would copy the + ! data as well.... + + !X! allocate(this%parameters(index)%data, source=data) + + allocate(this%parameters(index)%data(size(data, 1), size(data, 2))) + this%parameters(index)%data = data + + end subroutine SetData2D +end module FatesParametersInterface + + + diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 index f15ff350d1..c59e72eabc 100644 --- a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -1315,7 +1315,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) use EDInitMod, only : zero_site use EDParamsMod, only : ED_val_maxspread use EDPatchDynamicsMod, only : create_patch - use pftconMod, only : pftcon + use EDPftvarcon, only : EDPftvarcon_inst ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this @@ -1426,7 +1426,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites ) cohortstatus = newp%siteptr%status - if(pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + if(EDPftvarcon_inst%stress_decid(ft) == 1)then !drought decidous, override status. cohortstatus = newp%siteptr%dstatus endif diff --git a/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90 b/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90 new file mode 100644 index 0000000000..57c6143934 --- /dev/null +++ b/components/clm/src/ED/main/FatesSynchronizedParamsMod.F90 @@ -0,0 +1,131 @@ +module FatesSynchronizedParamsMod + + !----------------------------------------------------------------------- + ! + ! !USES: + use FatesConstantsMod, only : r8 => fates_r8 + implicit none + + ! FatesSynchronizedParamsInst. PGI wants the type decl. public but the instance + ! is indeed protected. A generic private statement at the start of the module + ! overrides the protected functionality with PGI + + type, public :: FatesSynchronizedParamsType + real(r8) :: Q10 ! temperature dependence + real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates + contains + procedure, public :: RegisterParams + procedure, public :: ReceiveParams + procedure, private :: Init + procedure, private :: RegisterParamsScalar + procedure, private :: ReceiveParamsScalar + end type FatesSynchronizedParamsType + + type(FatesSynchronizedParamsType), public :: FatesSynchronizedParamsInst + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + !----------------------------------------------------------------------- + +contains + + subroutine Init(this) + ! Initialize all parameters to nan to ensure that we get valid + ! values back from the host. + + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + + implicit none + + class(FatesSynchronizedParamsType), intent(inout) :: this + + this%Q10 = nan + this%froz_q10 = nan + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine RegisterParams(this, fates_params) + ! Register the parameters we want the host to provide, and + ! indicate whether they are fates parameters or host parameters + ! that need to be synced with host values. + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none + + class(FatesSynchronizedParamsType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%Init() + call this%RegisterParamsScalar(fates_params) + + end subroutine RegisterParams + + !----------------------------------------------------------------------- + subroutine ReceiveParams(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none + + class(FatesSynchronizedParamsType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + call this%ReceiveParamsScalar(fates_params) + + end subroutine ReceiveParams + + !----------------------------------------------------------------------- + subroutine RegisterParamsScalar(this, fates_params) + ! Register the parameters we want the host to provide, and + ! indicate whether they are fates parameters or host parameters + ! that need to be synced with host values. + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_host_allpfts, dimension_shape_1d + + implicit none + + class(FatesSynchronizedParamsType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_host_allpfts/) + character(len=param_string_length) :: name + + call this%Init() + + name = 'q10_mr' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, sync_with_host=.true.) + + name = 'froz_q10' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, sync_with_host=.true.) + + end subroutine RegisterParamsScalar + + !----------------------------------------------------------------------- + subroutine ReceiveParamsScalar(this, fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none + + class(FatesSynchronizedParamsType), intent(inout) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + name = 'q10_mr' + call fates_params%RetreiveParameter(name=name, & + data=this%Q10) + + name = 'froz_q10' + call fates_params%RetreiveParameter(name=name, & + data=this%froz_q10) + + end subroutine ReceiveParamsScalar + +end module FatesSynchronizedParamsMod diff --git a/components/clm/src/main/clm_varctl.F90 b/components/clm/src/main/clm_varctl.F90 index 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/paramUtilMod.F90 b/components/clm/src/main/paramUtilMod.F90 index 75a85e3e6c..96c95440e7 100644 --- a/components/clm/src/main/paramUtilMod.F90 +++ b/components/clm/src/main/paramUtilMod.F90 @@ -11,14 +11,22 @@ module paramUtilMod module procedure readNcdioScalar module procedure readNcdioArray1d module procedure readNcdioArray2d + module procedure readNcdioScalarCheckDimensions + module procedure readNcdioArray1dCheckDimensions + module procedure readNcdioArray2dCheckDimensions end interface public :: readNcdioScalar public :: readNcdioArray1d public :: readNcdioArray2d + public :: readNcdioScalarCheckDimensions + public :: readNcdioArray1dCheckDimensions + public :: readNcdioArray2dCheckDimensions public :: readNcdio + private :: checkDimensions + contains !----------------------------------------------------------------------- ! @@ -128,4 +136,156 @@ subroutine readNcdioArray2d(ncid, varName, callingName, retVal) end subroutine readNcdioArray2d !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioScalarCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioScalarCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray1dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal( 1: ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioArray1dCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray2dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, & + callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal(1:, : ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + ! + ! netcdf read here + ! + call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname) + call readNcdio(ncid, varName, callingName, retVal) + + end subroutine readNcdioArray2dCheckDimensions + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine checkDimensions(ncid, varName, expected_numDims, expected_dimNames, callingName) + ! + ! Assert that the expected number of dimensions and dimension + ! names for a variable match the actual names on the file. + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, var_desc_t, check_var, ncd_inqvdname, ncd_inqvdims + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + integer, intent(in) :: expected_numDims ! number of expected dimensions on the variable + character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension names + character(len=*), intent(in) :: callingName ! calling routine + integer :: error_num + + ! local vars + character(len=32) :: subname = 'checkDimensions::' + type(Var_desc_t) :: var_desc ! variable descriptor + logical :: readvar ! whether the variable was found + character(len=100) :: received_dimName + integer :: d, num_dims + character(len=256) :: msg + + call check_var(ncid, varName, var_desc, readvar) + if (readvar) then + call ncd_inqvdims(ncid, num_dims, var_desc) + if (num_dims /= expected_numDims) then + write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: expected number of dimensions = ", & + expected_numDims, " num dimensions received from file = ", num_dims + call endrun(msg) + end if + do d = 1, num_dims + received_dimName = '' + call ncd_inqvdname(ncid, varname=trim(varName), dimnum=d, dname=received_dimName, err_code=error_num) + if (trim(expected_dimNames(d)) /= trim(received_dimName)) then + write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: dimension ", d, & + " expected dimension name '"//trim(expected_dimNames(d))//& + "' dimension name received from file '"//trim(received_dimName)//"'." + call endrun(msg) + end if + end do + end if + + end subroutine checkDimensions + !----------------------------------------------------------------------- + end module paramUtilMod diff --git a/components/clm/src/main/pftconMod.F90 b/components/clm/src/main/pftconMod.F90 index 4bbd9978ae..902ae462fa 100644 --- a/components/clm/src/main/pftconMod.F90 +++ b/components/clm/src/main/pftconMod.F90 @@ -465,7 +465,7 @@ subroutine InitRead(this) use ncdio_pio , only : ncd_inqdid, ncd_inqdlen use clm_varctl , only : paramfile, use_ed, use_flexibleCN, use_dynroot use spmdMod , only : masterproc - use EDPftvarcon , only : EDpftconrd + use CLMFatesParamInterfaceMod, only : FatesReadPFTs ! ! !ARGUMENTS: class(pftcon_type) :: this @@ -975,13 +975,6 @@ subroutine InitRead(this) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) end if - ! - ! ED variables - ! - if ( use_ed ) then - ! The following sets the module variable EDpftcon_inst in EDPftcon - call EDpftconrd ( ncid ) - endif ! ! Dynamic Root variables for crops ! @@ -992,6 +985,8 @@ subroutine InitRead(this) call ncd_pio_closefile(ncid) + call FatesReadPFTs() + do i = 0, mxpft if (.not. use_ed)then if ( trim(adjustl(pftname(i))) /= trim(expected_pftnames(i)) )then @@ -1358,6 +1353,5 @@ subroutine Clean(this) end subroutine Clean - end module pftconMod diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index 5f16421700..b43009fb09 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -17,6 +17,7 @@ module readParamsMod private ! public :: readParameters + !----------------------------------------------------------------------- contains @@ -25,9 +26,6 @@ module readParamsMod subroutine readParameters (nutrient_competition_method, photosyns_inst) ! ! ! USES: - use EDSharedParamsMod , only : EDParamsReadShared - use EDParamsMod , only : EDParamsRead - use SFParamsMod , only : SFParamsRead use CNSharedParamsMod , only : CNParamsReadShared use CNGapMortalityMod , only : readCNGapMortParams => readParams use CNMRespMod , only : readCNMRespParams => readParams @@ -45,6 +43,8 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) use NutrientCompetitionMethodMod , only : nutrient_competition_method_type use clm_varctl, only : NLFilename_in use PhotosynthesisMod , only : photosyns_type + + use CLMFatesParamInterfaceMod , only : FatesReadParameters ! ! !ARGUMENTS: type(photosyns_type) , intent(in) :: photosyns_inst @@ -67,15 +67,6 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) call ncd_inqdid(ncid,'pft',dimid) call ncd_inqdlen(ncid,dimid,npft) - ! - ! Ecosystem Dynamics model - ! - if (use_ed) then - call EDParamsReadShared(ncid) - call EDParamsRead(ncid) - call SFParamsRead(ncid) - end if - ! ! Above ground biogeochemistry... ! @@ -113,6 +104,8 @@ subroutine readParameters (nutrient_competition_method, photosyns_inst) ! call ncd_pio_closefile(ncid) + call FatesReadParameters() + end subroutine readParameters end module readParamsMod diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 5034c355fd..0b2a110b52 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -163,7 +163,6 @@ module CLMFatesInterfaceMod end type hlm_fates_interface_type - logical :: DEBUG = .false. character(len=*), parameter, private :: sourcefile = & @@ -1309,7 +1308,6 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & use perf_mod , only : t_startf, t_stopf use PatchType , only : patch use quadraticMod , only : quadratic - use EDSharedParamsMod , only : EDParamsShareInst use EDTypesMod , only : numpft_ed, dinc_ed use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed use EDEcophysContype , only : EDecophyscon diff --git a/components/clm/src/utils/clmfates_paraminterfaceMod.F90 b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 new file mode 100644 index 0000000000..2d9ac58bb5 --- /dev/null +++ b/components/clm/src/utils/clmfates_paraminterfaceMod.F90 @@ -0,0 +1,237 @@ +module CLMFatesParamInterfaceMod + ! NOTE(bja, 2017-01) this code can not go into the main clm-fates + ! interface module because of circular dependancies with pftvarcon. + + use FatesGlobals, only : fates_log + + implicit none + + ! NOTE(bja, 2017-01) these methods can NOT be part of the clmi-fates + ! nterface type because they are called before the instance is + ! initialized. + public :: FatesReadParameters + public :: FatesReadPFTs + private :: ParametersFromNetCDF + private :: SetParameterDimensions + private :: GetUsedDimensionSizes + + logical :: DEBUG = .false. + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +contains + + !----------------------------------------------------------------------- + subroutine FatesReadParameters() + + use clm_varctl, only : use_ed, paramfile, fates_paramfile + use spmdMod, only : masterproc + + use FatesParametersInterface, only : fates_parameters_type + + use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams + use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams + use FatesSynchronizedParamsMod, only : FatesSynchronizedParamsInst + + implicit none + + character(len=32) :: subname = 'FatesReadParameters' + class(fates_parameters_type), allocatable :: fates_params + logical :: is_host_file + + if (use_ed) then + if (masterproc) then + write(fates_log(), *) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' parameters ' + end if + + allocate(fates_params) + call fates_params%Init() + call FatesRegisterParams(fates_params) + call SpitFireRegisterParams(fates_params) + call FatesSynchronizedParamsInst%RegisterParams(fates_params) + + is_host_file = .false. + call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) + + is_host_file = .true. + call ParametersFromNetCDF(paramfile, is_host_file, fates_params) + + call FatesReceiveParams(fates_params) + call SpitFireReceiveParams(fates_params) + call FatesSynchronizedParamsInst%ReceiveParams(fates_params) + + call fates_params%Destroy() + deallocate(fates_params) + end if + + end subroutine FatesReadParameters + + !----------------------------------------------------------------------- + subroutine FatesReadPFTs() + + use clm_varctl, only : use_ed, paramfile, fates_paramfile + use spmdMod, only : masterproc + + use FatesParametersInterface, only : fates_parameters_type + use EDPftvarcon , only : EDPftvarcon_inst + + use fileutils , only : getfil + use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile + + implicit none + + character(len=32) :: subname = 'FatesReadPFTs' + class(fates_parameters_type), allocatable :: fates_params + logical :: is_host_file + + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + + if (use_ed) then + if (masterproc) then + write(fates_log(), *) 'clmfates_interfaceMod.F90::'//trim(subname)//' :: CLM reading ED/FATES '//' PFTs ' + end if + + allocate(fates_params) + call fates_params%Init() + call EDPftvarcon_inst%Init() + + call EDPftvarcon_inst%Register(fates_params) + + is_host_file = .false. + call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) + + is_host_file = .true. + call ParametersFromNetCDF(paramfile, is_host_file, fates_params) + + call EDPftvarcon_inst%Receive(fates_params) + + call fates_params%Destroy() + deallocate(fates_params) + end if + + end subroutine FatesReadPFTs + + !----------------------------------------------------------------------- + subroutine SetParameterDimensions(ncid, is_host_file, fates_params) + ! Get the list of dimensions used by the fates parameters, + ! retreive them from the parameter file, then give the information + ! back to fates. + use FatesParametersInterface, only : fates_parameters_type, param_string_length, max_dimensions, max_used_dimensions + use ncdio_pio , only : file_desc_t + + implicit none + + type(file_desc_t), intent(inout) :: ncid + logical, intent(in) :: is_host_file + class(fates_parameters_type), intent(inout) :: fates_params + + integer :: num_used_dimensions + character(len=param_string_length) :: used_dimension_names(max_used_dimensions) + integer :: used_dimension_sizes(max_used_dimensions) + + call fates_params%GetUsedDimensions(is_host_file, num_used_dimensions, used_dimension_names) + + call GetUsedDimensionSizes(ncid, num_used_dimensions, used_dimension_names, used_dimension_sizes) + + call fates_params%SetDimensionSizes(is_host_file, num_used_dimensions, used_dimension_names, used_dimension_sizes) + + end subroutine SetParameterDimensions + + !----------------------------------------------------------------------- + subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) + + use ncdio_pio , only : ncd_inqdid, ncd_inqdlen + use FatesParametersInterface, only : param_string_length + use ncdio_pio, only : file_desc_t + + + implicit none + + type(file_desc_t), intent(inout) :: ncid + integer, intent(in) :: num_used_dimensions + character(len=param_string_length), intent(in) :: dimension_names(:) + integer, intent(out) :: dimension_sizes(:) + + integer :: d, max_dim_size, num_dims + integer :: dim_len, dim_id + + dimension_sizes(:) = 0 + max_dim_size = 0 + + do d = 1, num_used_dimensions + call ncd_inqdid(ncid, dimension_names(d), dim_id) + call ncd_inqdlen(ncid, dim_id, dim_len) + dimension_sizes(d) = dim_len + !write(*, *) '--> ', trim(dimension_names(d)), ' setting size ', dimension_sizes(d) + end do + + end subroutine GetUsedDimensionSizes + + !----------------------------------------------------------------------- + subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) + + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils, only : endrun + use fileutils , only : getfil + use ncdio_pio , only : file_desc_t, ncd_pio_closefile, ncd_pio_openfile + use paramUtilMod, only : readNcdio + + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length, max_dimensions, max_used_dimensions + use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d + + implicit none + + character(len=*), intent(in) :: filename + logical, intent(in) :: is_host_file + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=32) :: subname = 'clmfates_interface::ReadParameters' + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: i, num_params, dimension_shape + integer :: max_dim_size + real(r8), allocatable :: data(:, :) + character(len=param_string_length) :: name + integer :: dimension_sizes(max_dimensions) + character(len=param_string_length) :: dimension_names(max_dimensions) + integer :: size_dim_1, size_dim_2 + logical :: is_host_param + + call getfil (filename, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + call SetParameterDimensions(ncid, is_host_file, fates_params) + max_dim_size = fates_params%GetMaxDimensionSize() + allocate(data(max_dim_size, max_dim_size)) + + num_params = fates_params%num_params() + do i = 1, num_params + call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, dimension_names, is_host_param) + if (is_host_file .eqv. is_host_param) then + select case(dimension_shape) + case(dimension_shape_scalar) + size_dim_1 = 1 + size_dim_2 = 1 + case(dimension_shape_1d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = 1 + case(dimension_shape_2d) + size_dim_1 = dimension_sizes(1) + size_dim_2 = dimension_sizes(2) + case default + call endrun(msg='unsupported number of dimensions reading parameters.') + end select + call readNcdio(ncid, name, dimension_shape, dimension_names, subname, data(1:size_dim_1, 1:size_dim_2)) + call fates_params%SetData(i, data(1:size_dim_1, 1:size_dim_2)) + end if + end do + deallocate(data) + call ncd_pio_closefile(ncid) + end subroutine ParametersFromNetCDF + !----------------------------------------------------------------------- + +end module CLMFatesParamInterfaceMod