From 5f571930cdd919a291e8ff64162c2f5c99953170 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 6 May 2020 16:35:02 -0700 Subject: [PATCH 1/4] Split FatesInterfaceMod into two, routines and data --- biogeochem/EDCanopyStructureMod.F90 | 16 +- biogeochem/EDCohortDynamicsMod.F90 | 18 +- biogeochem/EDLoggingMortalityMod.F90 | 16 +- biogeochem/EDMortalityFunctionsMod.F90 | 14 +- biogeochem/EDPatchDynamicsMod.F90 | 14 +- biogeochem/EDPhysiologyMod.F90 | 26 +- biogeophys/EDAccumulateFluxesMod.F90 | 2 +- biogeophys/EDBtranMod.F90 | 4 +- biogeophys/EDSurfaceAlbedoMod.F90 | 8 +- biogeophys/FatesBstressMod.F90 | 4 +- biogeophys/FatesPlantHydraulicsMod.F90 | 222 +----- biogeophys/FatesPlantRespPhotosynthMod.F90 | 12 +- fire/SFMainMod.F90 | 12 +- main/ChecksBalancesMod.F90 | 4 +- main/EDInitMod.F90 | 106 +-- main/EDMainMod.F90 | 30 +- main/FatesGlobals.F90 | 3 +- main/FatesHistoryInterfaceMod.F90 | 26 +- main/FatesHydraulicsMemMod.F90 | 177 +++++ main/FatesInterfaceMod.F90 | 836 +++------------------ main/FatesInterfaceTypesMod.F90 | 698 +++++++++++++++++ main/FatesInventoryInitMod.F90 | 10 +- main/FatesParameterDerivedMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 26 +- main/FatesSizeAgeTypeIndicesMod.F90 | 8 +- 25 files changed, 1136 insertions(+), 1158 deletions(-) create mode 100644 main/FatesInterfaceTypesMod.F90 diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index acf7a9edd0..0e2de53919 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -24,10 +24,10 @@ module EDCanopyStructureMod use EDTypesMod , only : nlevleaf use EDtypesMod , only : AREA use FatesGlobals , only : endrun => fates_endrun - use FatesInterfaceMod , only : hlm_days_per_year - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_use_cohort_age_tracking - use FatesInterfaceMod , only : numpft + use FatesInterfaceTypesMod , only : hlm_days_per_year + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : numpft use FatesPlantHydraulicsMod, only : UpdateH2OVeg,InitHydrCohort, RecruitWaterStorage use EDTypesMod , only : maxCohortsPerPatch @@ -121,7 +121,7 @@ subroutine canopy_structure( currentSite , bc_in ) use EDParamsMod, only : ED_val_comp_excln use EDTypesMod , only : min_patch_area - use FatesInterfaceMod, only : bc_in_type + use FatesInterfaceTypesMod, only : bc_in_type ! ! !ARGUMENTS type(ed_site_type) , intent(inout), target :: currentSite @@ -1256,8 +1256,8 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ! Much of this routine was once ed_clm_link minus all the IO and history stuff ! --------------------------------------------------------------------------------- - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use EDPatchDynamicsMod , only : set_patchno use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index @@ -1874,7 +1874,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) use EDTypesMod , only : ed_patch_type, ed_cohort_type, & ed_site_type, AREA - use FatesInterfaceMod , only : bc_out_type + use FatesInterfaceTypesMod , only : bc_out_type use EDPftvarcon , only : EDPftvarcon_inst diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 13a3068e51..f5659dca97 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -6,18 +6,18 @@ module EDCohortDynamicsMod ! !USES: use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log - use FatesInterfaceMod , only : hlm_freq_day - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : hlm_freq_day + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : itrue,ifalse use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : calloc_abs_error - use FatesInterfaceMod , only : hlm_days_per_year - use FatesInterfaceMod , only : nleafage + use FatesInterfaceTypesMod , only : hlm_days_per_year + use FatesInterfaceTypesMod , only : nleafage use SFParamsMod , only : SF_val_CWD_frac use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac @@ -38,8 +38,8 @@ module EDCohortDynamicsMod use EDTypesMod , only : site_fluxdiags_type use EDTypesMod , only : num_elements use EDParamsMod , only : ED_val_cohort_age_fusion_tol - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_parteh_mode + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_parteh_mode use FatesPlantHydraulicsMod, only : FuseCohortHydraulics use FatesPlantHydraulicsMod, only : CopyCohortHydraulics use FatesPlantHydraulicsMod, only : UpdateSizeDepPlantHydProps @@ -953,7 +953,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! !USES: use EDParamsMod , only : ED_val_cohort_size_fusion_tol use EDParamsMod , only : ED_val_cohort_age_fusion_tol - use FatesInterfaceMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesConstantsMod , only : itrue use FatesConstantsMod, only : days_per_year use EDTypesMod , only : maxCohortsPerPatch diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index f8c9a4cef8..060a156f39 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -38,14 +38,14 @@ module EDLoggingMortalityMod use EDParamsMod , only : logging_mechanical_frac use EDParamsMod , only : logging_coll_under_frac use EDParamsMod , only : logging_dbhmax_infra - use FatesInterfaceMod , only : hlm_current_year - use FatesInterfaceMod , only : hlm_current_month - use FatesInterfaceMod , only : hlm_current_day - use FatesInterfaceMod , only : hlm_model_day - use FatesInterfaceMod , only : hlm_day_of_year - use FatesInterfaceMod , only : hlm_days_per_year - use FatesInterfaceMod , only : hlm_use_logging - use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_current_year + use FatesInterfaceTypesMod , only : hlm_current_month + use FatesInterfaceTypesMod , only : hlm_current_day + use FatesInterfaceTypesMod , only : hlm_model_day + use FatesInterfaceTypesMod , only : hlm_day_of_year + use FatesInterfaceTypesMod , only : hlm_days_per_year + use FatesInterfaceTypesMod , only : hlm_use_logging + use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesConstantsMod , only : itrue,ifalse use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index af6334e71e..567094d98b 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -13,13 +13,13 @@ module EDMortalityFunctionsMod use FatesConstantsMod , only : itrue,ifalse use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : storage_fraction_of_target - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_use_ed_prescribed_phys - use FatesInterfaceMod , only : hlm_freq_day - use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys + use FatesInterfaceTypesMod , only : hlm_freq_day + use FatesInterfaceTypesMod , only : hlm_use_planthydro use EDLoggingMortalityMod , only : LoggingMortality_frac use EDParamsMod , only : fates_mortality_disturbance_fraction - use FatesInterfaceMod , only : bc_in_type + use FatesInterfaceTypesMod , only : bc_in_type use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : store_organ @@ -50,7 +50,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor ! ============================================================================ use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm - use FatesInterfaceMod , only : hlm_hio_ignore_val + use FatesInterfaceTypesMod , only : hlm_hio_ignore_val use FatesConstantsMod, only : fates_check_param_set type (ed_cohort_type), intent(in) :: cohort_in @@ -217,7 +217,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in) ! ! !USES: - use FatesInterfaceMod, only : hlm_freq_day + use FatesInterfaceTypesMod, only : hlm_freq_day ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c57b8b3d6a..2998fd85d8 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -4,7 +4,7 @@ module EDPatchDynamicsMod ! Controls formation, creation, fusing and termination of patch level processes. ! ============================================================================ use FatesGlobals , only : fates_log - use FatesInterfaceMod , only : hlm_freq_day + use FatesInterfaceTypesMod , only : hlm_freq_day use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort @@ -37,11 +37,11 @@ module EDPatchDynamicsMod use EDTypesMod , only : dl_sf use EDTypesMod , only : dump_patch use FatesConstantsMod , only : rsnbl_math_prec - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_numSWb - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_days_per_year - use FatesInterfaceMod , only : numpft + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_numSWb + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : hlm_days_per_year + use FatesInterfaceTypesMod , only : numpft use FatesGlobals , only : endrun => fates_endrun use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse @@ -75,7 +75,7 @@ module EDPatchDynamicsMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTLossFluxesMod, only : PRTBurnLosses - use FatesInterfaceMod, only : hlm_parteh_mode + use FatesInterfaceTypesMod, only : hlm_parteh_mode use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 3e11d37aa9..0b5f977a30 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -7,21 +7,21 @@ module EDPhysiologyMod ! ============================================================================ use FatesGlobals, only : fates_log - use FatesInterfaceMod, only : hlm_days_per_year - use FatesInterfaceMod, only : hlm_model_day - use FatesInterfaceMod, only : hlm_freq_day - use FatesInterfaceMod, only : hlm_day_of_year - use FatesInterfaceMod, only : numpft - use FatesInterfaceMod, only : nleafage - use FatesInterfaceMod, only : hlm_use_planthydro - use FatesInterfaceMod, only : hlm_parteh_mode + use FatesInterfaceTypesMod, only : hlm_days_per_year + use FatesInterfaceTypesMod, only : hlm_model_day + use FatesInterfaceTypesMod, only : hlm_freq_day + use FatesInterfaceTypesMod, only : hlm_day_of_year + use FatesInterfaceTypesMod, only : numpft + use FatesInterfaceTypesMod, only : nleafage + use FatesInterfaceTypesMod, only : hlm_use_planthydro + use FatesInterfaceTypesMod, only : hlm_parteh_mode use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : nearzero use FatesConstantsMod, only : g_per_kg use FatesConstantsMod, only : days_per_sec use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac - use FatesInterfaceMod, only : bc_in_type + use FatesInterfaceTypesMod, only : bc_in_type use EDCohortDynamicsMod , only : zero_cohort use EDCohortDynamicsMod , only : create_cohort, sort_cohorts use EDCohortDynamicsMod , only : InitPRTObject @@ -1422,7 +1422,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! spawn new cohorts of juveniles of each PFT ! ! !USES: - use FatesInterfaceMod, only : hlm_use_ed_prescribed_phys + use FatesInterfaceTypesMod, only : hlm_use_ed_prescribed_phys ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite @@ -2226,9 +2226,9 @@ subroutine FluxIntoLitterPools(nsites, sites, bc_in, bc_out) use EDTypesMod, only : AREA use FatesConstantsMod, only : sec_per_day - use FatesInterfaceMod, only : bc_in_type, bc_out_type - use FatesInterfaceMod, only : hlm_use_vertsoilc - use FatesInterfaceMod, only : hlm_numlevgrnd + use FatesInterfaceTypesMod, only : bc_in_type, bc_out_type + use FatesInterfaceTypesMod, only : hlm_use_vertsoilc + use FatesInterfaceTypesMod, only : hlm_numlevgrnd use FatesConstantsMod, only : itrue use FatesGlobals, only : endrun => fates_endrun use EDParamsMod , only : ED_val_cwd_flig, ED_val_cwd_fcel diff --git a/biogeophys/EDAccumulateFluxesMod.F90 b/biogeophys/EDAccumulateFluxesMod.F90 index 37ac96df52..4d873cca85 100644 --- a/biogeophys/EDAccumulateFluxesMod.F90 +++ b/biogeophys/EDAccumulateFluxesMod.F90 @@ -39,7 +39,7 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) use EDTypesMod , only : ed_patch_type, ed_cohort_type, & ed_site_type, AREA - use FatesInterfaceMod , only : bc_in_type,bc_out_type + use FatesInterfaceTypesMod , only : bc_in_type,bc_out_type ! ! !ARGUMENTS diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 90d2b3f3c3..76bd1425c1 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -13,10 +13,10 @@ module EDBtranMod ed_cohort_type, & maxpft use shr_kind_mod , only : r8 => shr_kind_r8 - use FatesInterfaceMod , only : bc_in_type, & + use FatesInterfaceTypesMod , only : bc_in_type, & bc_out_type, & numpft - use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesGlobals , only : fates_log use FatesAllometryMod , only : set_root_fraction use FatesAllometryMod , only : i_hydro_rootprof_context diff --git a/biogeophys/EDSurfaceAlbedoMod.F90 b/biogeophys/EDSurfaceAlbedoMod.F90 index d9e4c6b3f2..4e5309ea61 100644 --- a/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/biogeophys/EDSurfaceAlbedoMod.F90 @@ -16,10 +16,10 @@ module EDSurfaceRadiationMod use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue use FatesConstantsMod , only : pi_const - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : bc_out_type - use FatesInterfaceMod , only : hlm_numSWb - use FatesInterfaceMod , only : numpft + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : bc_out_type + use FatesInterfaceTypesMod , only : hlm_numSWb + use FatesInterfaceTypesMod , only : numpft use EDTypesMod , only : maxSWb use EDTypesMod , only : nclmax use EDTypesMod , only : nlevleaf diff --git a/biogeophys/FatesBstressMod.F90 b/biogeophys/FatesBstressMod.F90 index 10d6777cc3..b4e81adcdc 100644 --- a/biogeophys/FatesBstressMod.F90 +++ b/biogeophys/FatesBstressMod.F90 @@ -12,10 +12,10 @@ module FatesBstressMod ed_cohort_type, & maxpft use shr_kind_mod , only : r8 => shr_kind_r8 - use FatesInterfaceMod , only : bc_in_type, & + use FatesInterfaceTypesMod , only : bc_in_type, & bc_out_type, & numpft - use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesGlobals , only : fates_log use EDBtranMod , only : check_layer_water use FatesAllometryMod , only : set_root_fraction diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index f926c64741..ae73b6acb8 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -55,12 +55,12 @@ module FatesPlantHydraulicsMod use EDTypesMod , only : AREA use EDTypesMod , only : leaves_on - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : bc_out_type - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_ipedof - use FatesInterfaceMod , only : numpft - use FatesInterfaceMod , only : nlevsclass + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : bc_out_type + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_ipedof + use FatesInterfaceTypesMod , only : numpft + use FatesInterfaceTypesMod , only : nlevsclass use FatesAllometryMod, only : bleaf use FatesAllometryMod, only : bsap_allom @@ -90,6 +90,14 @@ module FatesPlantHydraulicsMod use FatesHydraulicsMemMod, only: recruit_water_avail_layer use FatesHydraulicsMemMod, only: rwccap, rwcft use FatesHydraulicsMemMod, only: ignore_layer1 + use FateshydraulicsMemMod, only: wrf_plant, wkf_plant + use FateshydraulicsMemMod, only: alpha_vg + use FateshydraulicsMemMod, only: th_sat_vg + use FateshydraulicsMemMod, only: th_res_vg + use FateshydraulicsMemMod, only: psd_vg + use FateshydraulicsMemMod, only: tort_vg +! use FateshydraulicsMemMod, only: + use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ @@ -175,35 +183,7 @@ module FatesPlantHydraulicsMod __FILE__ - integer, public, parameter :: van_genuchten_type = 1 - integer, public, parameter :: campbell_type = 2 - integer, public, parameter :: tfs_type = 3 - - integer, parameter :: plant_wrf_type = tfs_type - integer, parameter :: plant_wkf_type = tfs_type - integer, parameter :: soil_wrf_type = campbell_type - integer, parameter :: soil_wkf_type = campbell_type - - - ! Define the global object that holds the water retention functions - ! for plants of each different porous media type, and plant functional type - - class(wrf_arr_type),pointer :: wrf_plant(:,:) - - ! Define the global object that holds the water conductance functions - ! for plants of each different porous media type, and plant functional type - - class(wkf_arr_type), pointer :: wkf_plant(:,:) - - ! Testing parameters for Van Genuchten soil WRTs - ! unused unless van_genuchten_type is selected, also - ! it would be much better to use the native parameters passed in - ! from the HLM's soil model - real(r8), parameter :: alpha_vg = 0.001_r8 - real(r8), parameter :: th_sat_vg = 0.65_r8 - real(r8), parameter :: th_res_vg = 0.15_r8 - real(r8), parameter :: psd_vg = 2.7_r8 - real(r8), parameter :: tort_vg = 0.5_r8 + ! The maximum allowable water balance error over a plant-soil continuum ! for a given step [kgs] (0.1 mg) @@ -235,7 +215,7 @@ module FatesPlantHydraulicsMod public :: UpdatePlantHydrLenVol public :: UpdatePlantKmax public :: ConstrainRecruitNumber - public :: InitHydroGlobals + !------------------------------------------------------------------------------ ! 01/18/16: Created by Brad Christoffersen @@ -5194,174 +5174,4 @@ end subroutine SetMaxCondConnections ! ===================================================================================== - subroutine InitHydroGlobals() - - ! This routine allocates the Water Transfer Functions (WTFs) - ! which include both water retention functions (WRFs) - ! as well as the water conductance (K) functions (WKFs) - ! But, this is only for plants! These functions have specific - ! parameters, potentially, for each plant functional type and - ! each organ (pft x organ), but this can be used globally (across - ! all sites on the node (machine) to save memory. These functions - ! are also applied to soils, but since soil properties vary with - ! soil layer and location, those functions are bound to the site - ! structure, and are therefore not "global". - - ! Define - class(wrf_type_vg), pointer :: wrf_vg - class(wkf_type_vg), pointer :: wkf_vg - class(wrf_type_cch), pointer :: wrf_cch - class(wkf_type_tfs), pointer :: wkf_tfs - class(wrf_type_tfs), pointer :: wrf_tfs - - integer :: ft ! PFT index - integer :: pm ! plant media index - integer :: inode ! compartment node index - real(r8) :: cap_corr ! correction for nonzero psi0x (TFS) - real(r8) :: cap_slp ! slope of capillary region of curve - real(r8) :: cap_int ! intercept of capillary region of curve - - if(hlm_use_planthydro.eq.ifalse) return - - ! we allocate from stomata_p_media, which should be zero - - allocate(wrf_plant(stomata_p_media:n_plant_media,numpft)) - allocate(wkf_plant(stomata_p_media:n_plant_media,numpft)) - - ! ----------------------------------------------------------------------------------- - ! Initialize the Water Retention Functions - ! ----------------------------------------------------------------------------------- - - select case(plant_wrf_type) - case(van_genuchten_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wrf_vg) - wrf_plant(pm,ft)%p => wrf_vg - call wrf_vg%set_wrf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg]) - end do - end do - case(campbell_type) - do ft = 1,numpft - do pm = 1,n_plant_media - allocate(wrf_cch) - wrf_plant(pm,ft)%p => wrf_cch - call wrf_cch%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & - EDPftvarcon_inst%hydr_pinot_node(ft,pm), & - 9._r8]) - end do - end do - case(tfs_type) - do ft = 1,numpft - do pm = 1,n_plant_media - allocate(wrf_tfs) - wrf_plant(pm,ft)%p => wrf_tfs - - if (pm.eq.leaf_p_media) then ! Leaf tissue - cap_slp = 0.0_r8 - cap_int = 0.0_r8 - cap_corr = 1.0_r8 - else ! Non leaf tissues - cap_slp = (hydr_psi0 - hydr_psicap )/(1.0_r8 - rwccap(pm)) - cap_int = -cap_slp + hydr_psi0 - cap_corr = -cap_int/cap_slp - end if - - call wrf_tfs%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & - EDPftvarcon_inst%hydr_resid_node(ft,pm), & - EDPftvarcon_inst%hydr_pinot_node(ft,pm), & - EDPftvarcon_inst%hydr_epsil_node(ft,pm), & - rwcft(pm), & - cap_corr, & - cap_int, & - cap_slp,real(pm,r8)]) - end do - end do - - end select - - ! ----------------------------------------------------------------------------------- - ! Initialize the Water Conductance (K) Functions - ! ----------------------------------------------------------------------------------- - - select case(plant_wkf_type) - case(van_genuchten_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wkf_vg) - wkf_plant(pm,ft)%p => wkf_vg - call wkf_vg%set_wkf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg, tort_vg]) - end do - - end do - case(campbell_type) - write(fates_log(),*) 'campbell/clapp-hornberger conductance not used in plants' - call endrun(msg=errMsg(sourcefile, __LINE__)) - case(tfs_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wkf_tfs) - wkf_plant(pm,ft)%p => wkf_tfs - call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_node(ft,pm), & - EDPftvarcon_inst%hydr_avuln_node(ft,pm)]) - end do - end do - end select - - ! There is only 1 stomata conductance hypothesis which uses the p50 and - ! vulnerability parameters - ! ----------------------------------------------------------------------------------- - - do ft = 1,numpft - allocate(wkf_tfs) - wkf_plant(stomata_p_media,ft)%p => wkf_tfs - call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_gs(ft), & - EDPftvarcon_inst%hydr_avuln_gs(ft)]) - end do - - - return - end subroutine InitHydroGlobals - - !! subroutine UpdateLWPMemFLCMin(ccohort_hydr) - - ! This code may be re-introduced at a later date (rgk 08-2019) - - ! SET COHORT-LEVEL BTRAN FOR USE IN NEXT TIMESTEP - ! first update the leaf water potential memory - !! do t=2, numLWPmem - !!ccohort_hydr%lwp_mem(t-1) = ccohort_hydr%lwp_mem(t) - !!end do - !!ccohort_hydr%lwp_mem(numLWPmem) = ccohort_hydr%psi_ag(1) - !!call flc_gs_from_psi(cCohort, ccohort_hydr%psi_ag(1)) - - !!refill_rate = -log(0.5)/(ccohort_hydr%refill_days*24._r8*3600._r8) ! s-1 - !!do k=1,n_hypool_ag - !!ccohort_hydr%flc_min_ag(k) = min(ccohort_hydr%flc_min_ag(k), ccohort_hydr%flc_ag(k)) - !!if(ccohort_hydr%psi_ag(k) >= ccohort_hydr%refill_thresh .and. & - !! ccohort_hydr%flc_ag(k) > ccohort_hydr%flc_min_ag(k)) then ! then refilling - !! ccohort_hydr%flc_min_ag(k) = ccohort_hydr%flc_ag(k) - & - !! (ccohort_hydr%flc_ag(k) - ccohort_hydr%flc_min_ag(k))*exp(-refill_rate*dtime) - !!end if - !!end do - !!do k=1,n_hypool_troot - !!ccohort_hydr%flc_min_troot(k) = min(ccohort_hydr%flc_min_troot(k), ccohort_hydr%flc_troot(k)) - !!if(ccohort_hydr%psi_troot(k) >= ccohort_hydr%refill_thresh .and. & - !! ccohort_hydr%flc_troot(k) > ccohort_hydr%flc_min_troot(k)) then ! then refilling - !! ccohort_hydr%flc_min_troot(k) = ccohort_hydr%flc_troot(k) - & - !! (ccohort_hydr%flc_troot(k) - ccohort_hydr%flc_min_troot(k))*exp(-refill_rate*dtime) - !!end if - !!end do - !!do j=1,site_hydr%nlevrhiz - !!ccohort_hydr%flc_min_aroot(j) = min(ccohort_hydr%flc_min_aroot(j), ccohort_hydr%flc_aroot(j)) - !!if(ccohort_hydr%psi_aroot(j) >= ccohort_hydr%refill_thresh .and. & - !! ccohort_hydr%flc_aroot(j) > ccohort_hydr%flc_min_aroot(j)) then ! then refilling - !! ccohort_hydr%flc_min_aroot(j) = ccohort_hydr%flc_aroot(j) - & - !! (ccohort_hydr%flc_aroot(j) - ccohort_hydr%flc_min_aroot(j))*exp(-refill_rate*dtime) - !!end if - !!end do - !!end subroutine UpdateLWPMemFLCMin - - - end module FatesPlantHydraulicsMod diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 59531574de..0f2d32a5dd 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -26,10 +26,10 @@ module FATESPlantRespPhotosynthMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : itrue use FatesConstantsMod, only : nearzero - use FatesInterfaceMod, only : hlm_use_planthydro - use FatesInterfaceMod, only : hlm_parteh_mode - use FatesInterfaceMod, only : numpft - use FatesInterfaceMod, only : nleafage + use FatesInterfaceTypesMod, only : hlm_use_planthydro + use FatesInterfaceTypesMod, only : hlm_parteh_mode + use FatesInterfaceTypesMod, only : numpft + use FatesInterfaceTypesMod, only : nleafage use EDTypesMod, only : maxpft use EDTypesMod, only : nlevleaf use EDTypesMod, only : nclmax @@ -89,8 +89,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) use EDTypesMod , only : ed_site_type use EDTypesMod , only : maxpft use EDTypesMod , only : dinc_ed - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : bc_out_type + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : bc_out_type use EDCanopyStructureMod, only : calc_areaindex use FatesConstantsMod, only : umolC_to_kgC use FatesConstantsMod, only : g_per_kg diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index c015db7131..ac4f672608 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -7,11 +7,11 @@ module SFMainMod use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse - use FatesInterfaceMod , only : hlm_masterproc ! 1= master process, 0=not master process + use FatesInterfaceTypesMod , only : hlm_masterproc ! 1= master process, 0=not master process use EDTypesMod , only : numWaterMem use FatesGlobals , only : fates_log - use FatesInterfaceMod , only : bc_in_type + use FatesInterfaceTypesMod , only : bc_in_type use EDPftvarcon , only : EDPftvarcon_inst @@ -40,7 +40,7 @@ module SFMainMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState - use FatesInterfaceMod , only : numpft + use FatesInterfaceTypesMod , only : numpft implicit none private @@ -70,7 +70,7 @@ module SFMainMod ! ============================================================================ subroutine fire_model( currentSite, bc_in) - use FatesInterfaceMod, only : hlm_use_spitfire + use FatesInterfaceTypesMod, only : hlm_use_spitfire type(ed_site_type) , intent(inout), target :: currentSite type(bc_in_type) , intent(in) :: bc_in @@ -419,7 +419,7 @@ subroutine rate_of_spread ( currentSite ) SF_val_miner_damp, & SF_val_fuel_energy - use FatesInterfaceMod, only : hlm_current_day, hlm_current_month + use FatesInterfaceTypesMod, only : hlm_current_day, hlm_current_month type(ed_site_type), intent(in), target :: currentSite @@ -662,7 +662,7 @@ subroutine area_burnt_intensity ( currentSite ) !currentPatch%ROS_front forward ROS (m/min) !currentPatch%TFC_ROS total fuel consumed by flaming front (kgC/m2) - use FatesInterfaceMod, only : hlm_use_spitfire + use FatesInterfaceTypesMod, only : hlm_use_spitfire use EDParamsMod, only : ED_val_nignitions use EDParamsMod, only : cg_strikes ! fraction of cloud-to-ground ligtning strikes use FatesConstantsMod, only : years_per_day diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index 72d9288a51..9374c373e0 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -9,9 +9,9 @@ module ChecksBalancesMod use EDTypesMod, only : site_massbal_type use EDTypesMod, only : num_elements use EDTypesMod, only : element_list - use FatesInterfaceMod, only : numpft + use FatesInterfaceTypesMod, only : numpft use FatesConstantsMod, only : g_per_kg - use FatesInterfaceMod, only : bc_in_type + use FatesInterfaceTypesMod, only : bc_in_type use FatesLitterMod, only : litter_type use FatesLitterMod, only : ncwd use FatesLitterMod, only : ndcmpy diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 8ec32c173d..1098e8eda5 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -12,7 +12,7 @@ module EDInitMod use FatesGlobals , only : endrun => fates_endrun use EDTypesMod , only : nclmax use FatesGlobals , only : fates_log - use FatesInterfaceMod , only : hlm_is_restart + use FatesInterfaceTypesMod , only : hlm_is_restart use EDPftvarcon , only : EDPftvarcon_inst use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts use EDCohortDynamicsMod , only : InitPRTObject @@ -36,13 +36,13 @@ module EDInitMod use EDTypesMod , only : phen_cstat_notcold use EDTypesMod , only : phen_dstat_moiston use EDTypesMod , only : element_pos - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_use_inventory_init - use FatesInterfaceMod , only : numpft - use FatesInterfaceMod , only : nleafage - use FatesInterfaceMod , only : nlevsclass - use FatesInterfaceMod , only : nlevcoage + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_inventory_init + use FatesInterfaceTypesMod , only : numpft + use FatesInterfaceTypesMod , only : nleafage + use FatesInterfaceTypesMod , only : nlevsclass + use FatesInterfaceTypesMod , only : nlevcoage use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bbgw_allom @@ -52,7 +52,7 @@ module EDInitMod use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : bstore_allom - use FatesInterfaceMod, only : hlm_parteh_mode + use FatesInterfaceTypesMod, only : hlm_parteh_mode use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : prt_vartypes @@ -66,7 +66,7 @@ module EDInitMod use PRTGenericMod, only : nitrogen_element use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : SetState - use FatesPlantHydraulicsMod, only : InitHydroGlobals +!! use FatesPlantHydraulicsMod, only : InitHydroGlobals use PRTAllometricCarbonMod, only : InitPRTGlobalAllometricCarbon ! use PRTAllometricCNPMod, only : InitPRTGlobalAllometricCNP @@ -93,92 +93,6 @@ module EDInitMod contains - ! ============================================================================ - - ! ==================================================================================== - - subroutine InitFatesGlobals(masterproc) - - ! -------------------------------------------------------------------------- - ! This subroutine is simply a wrapper that calls various FATES modules - ! that initialize global objects, things, constructs, etc. Globals only - ! need to be set once during initialization, for each machine, and this - ! should not be called for forked SMP processes. - ! -------------------------------------------------------------------------- - - logical,intent(in) :: masterproc ! This is useful for reporting - ! and diagnostics so info is not printed - ! on numerous nodes to standard out. This - ! is not used to filter which machines - ! (nodes) to run these procedures, they - ! should be run on ALL nodes. - - ! Initialize PARTEH globals - ! (like the element lists, and mapping tables) - call InitPARTEHGlobals() - - ! Initialize Hydro globals - ! (like water retention functions) - call InitHydroGlobals() - - - return - end subroutine InitFatesGlobals - - ! ==================================================================================== - - - subroutine InitPARTEHGlobals() - - ! Initialize the Plant Allocation and Reactive Transport - ! global functions and mapping tables - ! Also associate the elements defined in PARTEH with a list in FATES - ! "element_list" is useful because it allows the fates side of the code - ! to loop through elements, and call the correct PARTEH interfaces - ! automatically. - - select case(hlm_parteh_mode) - case(prt_carbon_allom_hyp) - - num_elements = 1 - allocate(element_list(num_elements)) - element_list(1) = carbon12_element - element_pos(:) = 0 - element_pos(carbon12_element) = 1 - - call InitPRTGlobalAllometricCarbon() - - case(prt_cnp_flex_allom_hyp) - - num_elements = 3 - allocate(element_list(num_elements)) - element_list(1) = carbon12_element - element_list(2) = nitrogen_element - element_list(3) = phosphorus_element - element_pos(:) = 0 - element_pos(carbon12_element) = 1 - element_pos(nitrogen_element) = 2 - element_pos(phosphorus_element) = 3 - - !call InitPRTGlobalAllometricCNP() - write(fates_log(),*) 'You specified the allometric CNP mode' - write(fates_log(),*) 'with relaxed target stoichiometry.' - write(fates_log(),*) 'I.e., namelist parametre fates_parteh_mode = 2' - write(fates_log(),*) 'This mode is not available yet. Please set it to 1.' - call endrun(msg=errMsg(sourcefile, __LINE__)) - - case DEFAULT - write(fates_log(),*) 'You specified an unknown PRT module' - write(fates_log(),*) 'Check your setting for fates_parteh_mode' - write(fates_log(),*) 'in the CLM namelist. The only valid value now is 1' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - - end select - - end subroutine InitPARTEHGlobals - - ! ============================================================================ subroutine init_site_vars( site_in, bc_in ) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 31f9d930e8..c2913ca0a1 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -8,20 +8,20 @@ module EDMainMod use shr_kind_mod , only : r8 => shr_kind_r8 use FatesGlobals , only : fates_log - use FatesInterfaceMod , only : hlm_freq_day - use FatesInterfaceMod , only : hlm_day_of_year - use FatesInterfaceMod , only : hlm_days_per_year - use FatesInterfaceMod , only : hlm_current_year - use FatesInterfaceMod , only : hlm_current_month - use FatesInterfaceMod , only : hlm_current_day - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_use_cohort_age_tracking - use FatesInterfaceMod , only : hlm_reference_date - use FatesInterfaceMod , only : hlm_use_ed_prescribed_phys - use FatesInterfaceMod , only : hlm_use_ed_st3 - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_masterproc - use FatesInterfaceMod , only : numpft + use FatesInterfaceTypesMod , only : hlm_freq_day + use FatesInterfaceTypesMod , only : hlm_day_of_year + use FatesInterfaceTypesMod , only : hlm_days_per_year + use FatesInterfaceTypesMod , only : hlm_current_year + use FatesInterfaceTypesMod , only : hlm_current_month + use FatesInterfaceTypesMod , only : hlm_current_day + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : hlm_reference_date + use FatesInterfaceTypesMod , only : hlm_use_ed_prescribed_phys + use FatesInterfaceTypesMod , only : hlm_use_ed_st3 + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : hlm_masterproc + use FatesInterfaceTypesMod , only : numpft use EDCohortDynamicsMod , only : terminate_cohorts use EDCohortDynamicsMod , only : fuse_cohorts use EDCohortDynamicsMod , only : sort_cohorts @@ -280,7 +280,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in ) ! FIX(SPM,032414) refactor so everything goes through interface ! ! !USES: - use FatesInterfaceMod, only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue ! !ARGUMENTS: diff --git a/main/FatesGlobals.F90 b/main/FatesGlobals.F90 index 260b3a9313..d37ffe3b2a 100644 --- a/main/FatesGlobals.F90 +++ b/main/FatesGlobals.F90 @@ -67,7 +67,6 @@ subroutine fates_endrun(msg) end subroutine fates_endrun ! ===================================================================================== - - + end module FatesGlobals diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 51db184e95..4da22e4ef0 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -27,19 +27,19 @@ module FatesHistoryInterfaceMod use FatesIODimensionsMod , only : fates_io_dimension_type use FatesIOVariableKindMod , only : fates_io_variable_kind_type use FatesHistoryVariableType , only : fates_history_variable_type - use FatesInterfaceMod , only : hlm_hio_ignore_val - use FatesInterfaceMod , only : hlm_use_planthydro - use FatesInterfaceMod , only : hlm_use_ed_st3 - use FatesInterfaceMod , only : hlm_use_cohort_age_tracking - use FatesInterfaceMod , only : numpft - use FatesInterfaceMod , only : hlm_freq_day + use FatesInterfaceTypesMod , only : hlm_hio_ignore_val + use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_ed_st3 + use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking + use FatesInterfaceTypesMod , only : numpft + use FatesInterfaceTypesMod , only : hlm_freq_day use EDParamsMod , only : ED_val_comp_excln use EDParamsMod , only : ED_val_phen_coldtemp - use FatesInterfaceMod , only : nlevsclass, nlevage - use FatesInterfaceMod , only : nlevheight - use FatesInterfaceMod , only : bc_in_type - use FatesInterfaceMod , only : hlm_model_day - use FatesInterfaceMod , only : nlevcoage + use FatesInterfaceTypesMod , only : nlevsclass, nlevage + use FatesInterfaceTypesMod , only : nlevheight + use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : hlm_model_day + use FatesInterfaceTypesMod , only : nlevcoage ! FIXME(bja, 2016-10) need to remove CLM dependancy use EDPftvarcon , only : EDPftvarcon_inst @@ -1376,7 +1376,7 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype hlms, flushval, upfreq, ivar, initialize, index) use FatesUtilsMod, only : check_hlm_list - use FatesInterfaceMod, only : hlm_name + use FatesInterfaceTypesMod, only : hlm_name implicit none @@ -3765,7 +3765,7 @@ subroutine define_history_vars(this, initialize_variables) use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 use FatesIOVariableKindMod, only : site_coage_pft_r8, site_coage_r8 use FatesIOVariableKindMod, only : site_height_r8 - use FatesInterfaceMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 diff --git a/main/FatesHydraulicsMemMod.F90 b/main/FatesHydraulicsMemMod.F90 index 9d5c18bfa5..68793aeb1e 100644 --- a/main/FatesHydraulicsMemMod.F90 +++ b/main/FatesHydraulicsMemMod.F90 @@ -64,6 +64,37 @@ module FatesHydraulicsMemMod ! Should we ignore the first soil layer and have root layers start on the second? logical, parameter, public :: ignore_layer1=.true. + + integer, public, parameter :: van_genuchten_type = 1 + integer, public, parameter :: campbell_type = 2 + integer, public, parameter :: tfs_type = 3 + + integer, parameter :: plant_wrf_type = tfs_type + integer, parameter :: plant_wkf_type = tfs_type + integer, parameter :: soil_wrf_type = campbell_type + integer, parameter :: soil_wkf_type = campbell_type + + + ! Define the global object that holds the water retention functions + ! for plants of each different porous media type, and plant functional type + + class(wrf_arr_type),pointer :: wrf_plant(:,:) + + ! Define the global object that holds the water conductance functions + ! for plants of each different porous media type, and plant functional type + + class(wkf_arr_type), pointer :: wkf_plant(:,:) + + ! Testing parameters for Van Genuchten soil WRTs + ! unused unless van_genuchten_type is selected, also + ! it would be much better to use the native parameters passed in + ! from the HLM's soil model + real(r8), parameter :: alpha_vg = 0.001_r8 + real(r8), parameter :: th_sat_vg = 0.65_r8 + real(r8), parameter :: th_res_vg = 0.15_r8 + real(r8), parameter :: psd_vg = 2.7_r8 + real(r8), parameter :: tort_vg = 0.5_r8 + ! Derived parameters @@ -74,6 +105,10 @@ module FatesHydraulicsMemMod ! single individual at different layer (kg H2o/m2) real(r8), public :: recruit_water_avail_layer(nlevsoi_hyd_max) ! the recruit water avaibility from soil (kg H2o/m2) + + public :: InitHydroGlobals + + type, public :: ed_site_hydr_type ! Plant Hydraulics @@ -577,6 +612,148 @@ subroutine SetConnections(this) end if end subroutine SetConnections + + ! ==================================================================================== + + subroutine InitHydroGlobals(numpft) + + use FatesHydroWTFMod, only : wrf_arr_type + use FatesHydroWTFMod, only : wkf_arr_type + use FatesHydroWTFMod, only : wrf_type, wrf_type_vg, wrf_type_cch, wrf_type_tfs + use FatesHydroWTFMod, only : wkf_type, wkf_type_vg, wkf_type_cch, wkf_type_tfs + use EDPftvarcon, only : EDPftvarcon_inst + use EDParamsMod, only : hydr_psi0 + use EDParamsMod, only : hydr_psicap + + + ! This routine allocates the Water Transfer Functions (WTFs) + ! which include both water retention functions (WRFs) + ! as well as the water conductance (K) functions (WKFs) + ! But, this is only for plants! These functions have specific + ! parameters, potentially, for each plant functional type and + ! each organ (pft x organ), but this can be used globally (across + ! all sites on the node (machine) to save memory. These functions + ! are also applied to soils, but since soil properties vary with + ! soil layer and location, those functions are bound to the site + ! structure, and are therefore not "global". + + integer,intent(in) :: numpft + + ! Define + class(wrf_type_vg), pointer :: wrf_vg + class(wkf_type_vg), pointer :: wkf_vg + class(wrf_type_cch), pointer :: wrf_cch + class(wkf_type_tfs), pointer :: wkf_tfs + class(wrf_type_tfs), pointer :: wrf_tfs + + integer :: ft ! PFT index + integer :: pm ! plant media index + integer :: inode ! compartment node index + real(r8) :: cap_corr ! correction for nonzero psi0x (TFS) + real(r8) :: cap_slp ! slope of capillary region of curve + real(r8) :: cap_int ! intercept of capillary region of curve + + if(hlm_use_planthydro.eq.ifalse) return + ! we allocate from stomata_p_media, which should be zero + + allocate(wrf_plant(stomata_p_media:n_plant_media,numpft)) + allocate(wkf_plant(stomata_p_media:n_plant_media,numpft)) + + ! ----------------------------------------------------------------------------------- + ! Initialize the Water Retention Functions + ! ----------------------------------------------------------------------------------- + + select case(plant_wrf_type) + case(van_genuchten_type) + do ft = 1,numpft + do pm = 1, n_plant_media + allocate(wrf_vg) + wrf_plant(pm,ft)%p => wrf_vg + call wrf_vg%set_wrf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg]) + end do + end do + case(campbell_type) + do ft = 1,numpft + do pm = 1,n_plant_media + allocate(wrf_cch) + wrf_plant(pm,ft)%p => wrf_cch + call wrf_cch%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & + EDPftvarcon_inst%hydr_pinot_node(ft,pm), & + 9._r8]) + end do + end do + case(tfs_type) + do ft = 1,numpft + do pm = 1,n_plant_media + allocate(wrf_tfs) + wrf_plant(pm,ft)%p => wrf_tfs + + if (pm.eq.leaf_p_media) then ! Leaf tissue + cap_slp = 0.0_r8 + cap_int = 0.0_r8 + cap_corr = 1.0_r8 + else ! Non leaf tissues + cap_slp = (hydr_psi0 - hydr_psicap )/(1.0_r8 - rwccap(pm)) + cap_int = -cap_slp + hydr_psi0 + cap_corr = -cap_int/cap_slp + end if + + call wrf_tfs%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & + EDPftvarcon_inst%hydr_resid_node(ft,pm), & + EDPftvarcon_inst%hydr_pinot_node(ft,pm), & + EDPftvarcon_inst%hydr_epsil_node(ft,pm), & + rwcft(pm), & + cap_corr, & + cap_int, & + cap_slp,real(pm,r8)]) + end do + end do + + end select + + ! ----------------------------------------------------------------------------------- + ! Initialize the Water Conductance (K) Functions + ! ----------------------------------------------------------------------------------- + + select case(plant_wkf_type) + case(van_genuchten_type) + do ft = 1,numpft + do pm = 1, n_plant_media + allocate(wkf_vg) + wkf_plant(pm,ft)%p => wkf_vg + call wkf_vg%set_wkf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg, tort_vg]) + end do + + end do + case(campbell_type) + write(fates_log(),*) 'campbell/clapp-hornberger conductance not used in plants' + call endrun(msg=errMsg(sourcefile, __LINE__)) + case(tfs_type) + do ft = 1,numpft + do pm = 1, n_plant_media + allocate(wkf_tfs) + wkf_plant(pm,ft)%p => wkf_tfs + call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_node(ft,pm), & + EDPftvarcon_inst%hydr_avuln_node(ft,pm)]) + end do + end do + end select + + ! There is only 1 stomata conductance hypothesis which uses the p50 and + ! vulnerability parameters + ! ----------------------------------------------------------------------------------- + + do ft = 1,numpft + allocate(wkf_tfs) + wkf_plant(stomata_p_media,ft)%p => wkf_tfs + call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_gs(ft), & + EDPftvarcon_inst%hydr_avuln_gs(ft)]) + end do + + + return + end subroutine InitHydroGlobals + end module FatesHydraulicsMemMod diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index d72f2b5cd6..207b0f09fe 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -38,590 +38,21 @@ module FatesInterfaceMod use EDParamsMod , only : bgc_soil_salinity use PRTGenericMod , only : prt_carbon_allom_hyp use PRTGenericMod , only : prt_cnp_flex_allom_hyp - + use HydraulicsMemMod , only : InitHydroGlobals + use EDParamsMod, only : ED_val_history_sizeclass_bin_edges, ED_val_history_ageclass_bin_edges + use EDParamsMod, only : ED_val_history_height_bin_edges + use EDParamsMod, only : ED_val_history_coageclass_bin_edges + use CLMFatesParamInterfaceMod , only : FatesReadParameters + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - implicit none - - private ! By default everything is private - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - - ! ------------------------------------------------------------------------------------- - ! Parameters that are dictated by the Host Land Model - ! THESE ARE NOT DYNAMIC. SHOULD BE SET ONCE DURING INTIALIZATION. - ! ------------------------------------------------------------------------------------- - - - integer, public, protected :: hlm_numSWb ! Number of broad-bands in the short-wave radiation - ! specturm to track - ! (typically 2 as a default, VIS/NIR, in ED variants <2016) - - integer, public, protected :: hlm_ivis ! The HLMs assumption of the array index associated with the - ! visible portion of the spectrum in short-wave radiation arrays - - integer, public, protected :: hlm_inir ! The HLMs assumption of the array index associated with the - ! NIR portion of the spectrum in short-wave radiation arrays - - - integer, public, protected :: hlm_numlevgrnd ! Number of ground layers - ! NOTE! SOIL LAYERS ARE NOT A GLOBAL, THEY - ! ARE VARIABLE BY SITE - - integer, public, protected :: hlm_is_restart ! Is the HLM signalling that this is a restart - ! type simulation? - ! 1=TRUE, 0=FALSE - - character(len=16), public, protected :: hlm_name ! This character string passed by the HLM - ! is used during the processing of IO data, - ! so that FATES knows which IO variables it - ! should prepare. For instance - ! ATS, ALM and CLM will only want variables - ! specficially packaged for them. - ! This string sets which filter is enacted. - - - real(r8), public, protected :: hlm_hio_ignore_val ! This value can be flushed to history - ! diagnostics, such that the - ! HLM will interpret that the value should not - ! be included in the average. - - integer, public, protected :: hlm_masterproc ! Is this the master processor, typically useful - ! for knowing if the current machine should be - ! printing out messages to the logs or terminals - ! 1 = TRUE (is master) 0 = FALSE (is not master) - - integer, public, protected :: hlm_ipedof ! The HLM pedotransfer index - ! this is only used by the plant hydraulics - ! submodule to check and/or enable consistency - ! between the pedotransfer functions of the HLM - ! and how it moves and stores water in its - ! rhizosphere shells - - integer, public, protected :: hlm_max_patch_per_site ! The HLM needs to exchange some patch - ! level quantities with FATES - ! FATES does not dictate those allocations - ! since it happens pretty early in - ! the model initialization sequence. - ! So we want to at least query it, - ! compare it to our maxpatchpersite, - ! and gracefully halt if we are over-allocating - - integer, public, protected :: hlm_parteh_mode ! This flag signals which Plant Allocation and Reactive - ! Transport (exensible) Hypothesis (PARTEH) to use - - - integer, public, protected :: hlm_use_vertsoilc ! This flag signals whether or not the - ! host model is using vertically discretized - ! soil carbon - ! 1 = TRUE, 0 = FALSE - - integer, public, protected :: hlm_use_spitfire ! This flag signals whether or not to use SPITFIRE - ! 1 = TRUE, 0 = FALSE - - - integer, public, protected :: hlm_use_logging ! This flag signals whether or not to use - ! the logging module - - integer, public, protected :: hlm_use_planthydro ! This flag signals whether or not to use - ! plant hydraulics (bchristo/xu methods) - ! 1 = TRUE, 0 = FALSE - ! THIS IS CURRENTLY NOT SUPPORTED - - integer, public, protected :: hlm_use_cohort_age_tracking ! This flag signals whether or not to use - ! cohort age tracking. 1 = TRUE, 0 = FALSE - - integer, public, protected :: hlm_use_ed_st3 ! This flag signals whether or not to use - ! (ST)atic (ST)and (ST)ructure mode (ST3) - ! Essentially, this gives us the ability - ! to turn off "dynamics", ie growth, disturbance - ! recruitment and mortality. - ! (EXPERIMENTAL!!!!! - RGK 07-2017) - ! 1 = TRUE, 0 = FALSE - ! default should be FALSE (dynamics on) - ! cannot be true with prescribed_phys - - integer, public, protected :: hlm_use_ed_prescribed_phys ! This flag signals whether or not to use - ! prescribed physiology, somewhat the opposite - ! to ST3, in this case can turn off - ! fast processes like photosynthesis and respiration - ! and prescribe NPP - ! (NOT CURRENTLY IMPLEMENTED - PLACEHOLDER) - ! 1 = TRUE, 0 = FALSE - ! default should be FALSE (biophysics on) - ! cannot be true with st3 mode - - integer, public, protected :: hlm_use_inventory_init ! Initialize this simulation from - ! an inventory file. If this is toggled on - ! an inventory control file must be specified - ! as well. - ! 1 = TRUE, 0 = FALSE - - character(len=256), public, protected :: hlm_inventory_ctrl_file ! This is the full path to the - ! inventory control file that - ! specifieds the availabel inventory datasets - ! there locations and their formats - ! This need only be defined when - ! hlm_use_inventory_init = 1 - - ! ------------------------------------------------------------------------------------- - ! Parameters that are dictated by FATES and known to be required knowledge - ! needed by the HLMs - ! ------------------------------------------------------------------------------------- - - ! Variables mostly used for dimensioning host land model (HLM) array spaces - - integer, public, protected :: fates_maxElementsPerPatch ! maxElementsPerPatch is the value that is ultimately - ! used to set the size of the largest arrays necessary - ! in things like restart files (probably hosted by the - ! HLM). The size of these arrays are not a parameter - ! because it is simply the maximum of several different - ! dimensions. It is possible that this would be the - ! maximum number of cohorts per patch, but - ! but it could be other things. - - integer, public, protected :: fates_maxElementsPerSite ! This is the max number of individual items one can store per - ! each grid cell and effects the striding in the ED restart - ! data as some fields are arrays where each array is - ! associated with one cohort - - ! ------------------------------------------------------------------------------------- - ! These vectors are used for history output mapping - ! CLM/ALM have limited support for multi-dimensional history output arrays. - ! FATES structure and composition is multi-dimensional, so we end up "multi-plexing" - ! multiple dimensions into one dimension. These new dimensions need definitions, - ! mapping to component dimensions, and definitions for those component dimensions as - ! well. - ! ------------------------------------------------------------------------------------- - - real(r8), public, allocatable :: fates_hdim_levcoage(:) ! cohort age class lower bound dimension - integer , public, allocatable :: fates_hdim_pfmap_levcapf(:) ! map of pfts into cohort age class x pft dimension - integer , public, allocatable :: fates_hdim_camap_levcapf(:) ! map of cohort age class into cohort age x pft dimension - - - real(r8), public, allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension - integer , public, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension - integer , public, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension - real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension - real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension - integer , public, allocatable :: fates_hdim_levpft(:) ! plant pft dimension - integer , public, allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension - integer , public, allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension - integer , public, allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension - integer , public, allocatable :: fates_hdim_levelem(:) ! element dimension - integer , public, allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dim - integer , public, allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the can-layer x leaf-layer dimension - integer , public, allocatable :: fates_hdim_canmap_levcnlfpf(:) ! can-layer map into the can-layer x pft x leaf-layer dim - integer , public, allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the can-layer x pft x leaf-layer dim - integer , public, allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dim - integer , public, allocatable :: fates_hdim_scmap_levscag(:) ! map of size-class into size-class x patch age dimension - integer , public, allocatable :: fates_hdim_agmap_levscag(:) ! map of patch-age into size-class x patch age dimension - integer , public, allocatable :: fates_hdim_scmap_levscagpft(:) ! map of size-class into size-class x patch age x pft dimension - integer , public, allocatable :: fates_hdim_agmap_levscagpft(:) ! map of patch-age into size-class x patch age x pft dimension - integer , public, allocatable :: fates_hdim_pftmap_levscagpft(:) ! map of pft into size-class x patch age x pft dimension - integer , public, allocatable :: fates_hdim_agmap_levagepft(:) ! map of patch-age into patch age x pft dimension - integer , public, allocatable :: fates_hdim_pftmap_levagepft(:) ! map of pft into patch age x pft dimension - - integer , public, allocatable :: fates_hdim_elmap_levelpft(:) ! map of elements in the element x pft dimension - integer , public, allocatable :: fates_hdim_elmap_levelcwd(:) ! map of elements in the element x cwd dimension - integer , public, allocatable :: fates_hdim_elmap_levelage(:) ! map of elements in the element x age dimension - integer , public, allocatable :: fates_hdim_pftmap_levelpft(:) ! map of pfts in the element x pft dimension - integer , public, allocatable :: fates_hdim_cwdmap_levelcwd(:) ! map of cwds in the element x cwd dimension - integer , public, allocatable :: fates_hdim_agemap_levelage(:) ! map of ages in the element x age dimension - - ! ------------------------------------------------------------------------------------ - ! DYNAMIC BOUNDARY CONDITIONS - ! ------------------------------------------------------------------------------------ - - - ! ------------------------------------------------------------------------------------- - ! Scalar Timing Variables - ! It is assumed that all of the sites on a given machine will be synchronous. - ! It is also assumed that the HLM will control time. - ! ------------------------------------------------------------------------------------- - integer, public, protected :: hlm_current_year ! Current year - integer, public, protected :: hlm_current_month ! month of year - integer, public, protected :: hlm_current_day ! day of month - integer, public, protected :: hlm_current_tod ! time of day (seconds past 0Z) - integer, public, protected :: hlm_current_date ! time of day (seconds past 0Z) - integer, public, protected :: hlm_reference_date ! YYYYMMDD - real(r8), public, protected :: hlm_model_day ! elapsed days between current date and ref - integer, public, protected :: hlm_day_of_year ! The integer day of the year - integer, public, protected :: hlm_days_per_year ! The HLM controls time, some HLMs may - ! include a leap - real(r8), public, protected :: hlm_freq_day ! fraction of year for daily time-step - ! (1/days_per_year_, this is a frequency - - - ! ------------------------------------------------------------------------------------- - ! - ! Constant parameters that are dictated by the fates parameter file - ! - ! ------------------------------------------------------------------------------------- - - integer, public, protected :: numpft ! The total number of PFTs defined in the simulation - integer, public, protected :: nlevsclass ! The total number of cohort size class bins output to history - integer, public, protected :: nlevage ! The total number of patch age bins output to history - integer, public, protected :: nlevheight ! The total number of height bins output to history - integer, public, protected :: nlevcoage ! The total number of cohort age bins output to history - integer, public, protected :: nleafage ! The total number of leaf age classes - - ! ------------------------------------------------------------------------------------- - ! Structured Boundary Conditions (SITE/PATCH SCALE) - ! For floating point arrays, it is sometimes the convention to define the arrays as - ! POINTER instead of ALLOCATABLE. This usually achieves the same result with subtle - ! differences. POINTER arrays can point to scalar values, discontinuous array slices - ! or alias other variables, ALLOCATABLES cannnot. According to S. Lionel - ! (Intel-Forum Post), ALLOCATABLES are better perfomance wise as long as they point - ! to contiguous memory spaces and do not alias other variables, the case here. - ! Naming conventions: _si means site dimensions (scalar in that case) - ! _pa means patch dimensions - ! _rb means radiation band - ! _sl means soil layer - ! _sisl means site x soil layer - ! ------------------------------------------------------------------------------------ - - type, public :: bc_in_type - - ! The actual number of FATES' ED patches - integer :: npatches - - - ! Soil layer structure - - integer :: nlevsoil ! the number of soil layers in this column - integer :: nlevdecomp ! the number of soil layers in the column - ! that are biogeochemically active - real(r8),allocatable :: zi_sisl(:) ! interface level below a "z" level (m) - ! this contains a zero index for surface. - real(r8),allocatable :: dz_sisl(:) ! layer thickness (m) - real(r8),allocatable :: z_sisl(:) ! layer depth (m) - - ! Decomposition Layer Structure - real(r8), allocatable :: dz_decomp_sisl(:) ! This should match dz_sisl(), unless - ! only one layer is chosen, in that - ! case, it has its own depth, which - ! has traditionally been 1 meter - - integer,allocatable :: decomp_id(:) ! The decomposition layer index that each - ! soil layer maps to. This will either - ! be equivalent (ie integer ascending) - ! Or, all will be 1. - - - ! Vegetation Dynamics - ! --------------------------------------------------------------------------------- - - ! The site level 24 hour vegetation temperature is used for various purposes during vegetation - ! dynamics. However, we are currently using the bare ground patch's value [K] - ! TO-DO: Get some consensus on the correct vegetation temperature used for phenology. - ! It is possible that the bare-ground value is where the average is being stored. - ! (RGK-01-2017) - real(r8) :: t_veg24_si - - ! Patch 24 hour vegetation temperature [K] - real(r8),allocatable :: t_veg24_pa(:) - - ! Fire Model - - ! Average precipitation over the last 24 hours [mm/s] - real(r8), allocatable :: precip24_pa(:) - - ! Average relative humidity over past 24 hours [-] - real(r8), allocatable :: relhumid24_pa(:) - - ! Patch 24-hour running mean of wind (m/s ?) - real(r8), allocatable :: wind24_pa(:) - - - ! Radiation variables for calculating sun/shade fractions - ! --------------------------------------------------------------------------------- - - ! Downwelling direct beam radiation (patch,radiation-band) [W/m2] - real(r8), allocatable :: solad_parb(:,:) - - ! Downwelling diffuse (I-ndirect) radiation (patch,radiation-band) [W/m2] - real(r8), allocatable :: solai_parb(:,:) - + ! Just use everything from FatesInterfaceTypesMod, this is + ! its sister code + use FatesInterfaceTypesMod - ! Photosynthesis variables - ! --------------------------------------------------------------------------------- - - ! Patch level filter flag for photosynthesis calculations - ! has a short memory, flags: - ! 1 = patch has not been called - ! 2 = patch is currently marked for photosynthesis - ! 3 = patch has been called for photosynthesis at least once - integer, allocatable :: filter_photo_pa(:) - - ! atmospheric pressure (Pa) - real(r8) :: forc_pbot - - ! daylength scaling factor (0-1) - real(r8), allocatable :: dayl_factor_pa(:) - - ! saturation vapor pressure at t_veg (Pa) - real(r8), allocatable :: esat_tv_pa(:) - - ! vapor pressure of canopy air (Pa) - real(r8), allocatable :: eair_pa(:) - - ! Atmospheric O2 partial pressure (Pa) - real(r8), allocatable :: oair_pa(:) - - ! Atmospheric CO2 partial pressure (Pa) - real(r8), allocatable :: cair_pa(:) - - ! boundary layer resistance (s/m) - real(r8), allocatable :: rb_pa(:) - - ! vegetation temperature (Kelvin) - real(r8), allocatable :: t_veg_pa(:) - - ! air temperature at agcm reference height (kelvin) - real(r8), allocatable :: tgcm_pa(:) - - ! soil temperature (Kelvin) - real(r8), allocatable :: t_soisno_sl(:) - - ! Canopy Radiation Boundaries - ! --------------------------------------------------------------------------------- - - ! Filter for vegetation patches with a positive zenith angle (daylight) - logical, allocatable :: filter_vegzen_pa(:) - - ! Cosine of the zenith angle (0-1), by patch - ! Note RGK: It does not seem like the code would currently generate - ! different zenith angles for different patches (nor should it) - ! I am leaving it at this scale for simplicity. Patches should - ! have no spacially variable information - real(r8), allocatable :: coszen_pa(:) - - ! Abledo of the ground for direct radiation, by site broadband (0-1) - real(r8), allocatable :: albgr_dir_rb(:) - - ! Albedo of the ground for diffuse radiation, by site broadband (0-1) - real(r8), allocatable :: albgr_dif_rb(:) - - ! LitterFlux Boundaries - ! the index of the deepest model soil level where roots may be - ! due to permafrost or bedrock constraints - integer :: max_rooting_depth_index_col - - ! BGC Accounting - - real(r8) :: tot_het_resp ! total heterotrophic respiration (gC/m2/s) - real(r8) :: tot_somc ! total soil organic matter carbon (gc/m2) - real(r8) :: tot_litc ! total litter carbon tracked in the HLM (gc/m2) - - ! Canopy Structure - - real(r8) :: snow_depth_si ! Depth of snow in snowy areas of site (m) - real(r8) :: frac_sno_eff_si ! Fraction of ground covered by snow (0-1) - - ! Hydrology variables for BTRAN - ! --------------------------------------------------------------------------------- - - ! Soil suction potential of layers in each site, negative, [mm] - real(r8), allocatable :: smp_sl(:) - - !soil salinity of layers in each site [ppt] - real(r8), allocatable :: salinity_sl(:) - - ! Effective porosity = porosity - vol_ic, of layers in each site [-] - real(r8), allocatable :: eff_porosity_sl(:) - - ! volumetric soil water at saturation (porosity) - real(r8), allocatable :: watsat_sl(:) - - ! Temperature of ground layers [K] - real(r8), allocatable :: tempk_sl(:) - - ! Liquid volume in ground layer (m3/m3) - real(r8), allocatable :: h2o_liqvol_sl(:) - - ! Site level filter for uptake response functions - logical :: filter_btran - - - ! ALL HYDRO DATA STRUCTURES SHOULD NOW BE ALLOCATED ON RHIZOSPHERE LEVELS - - ! Plant-Hydro - ! --------------------------------------------------------------------------------- - - real(r8),allocatable :: qflx_transp_pa(:) ! Transpiration flux as dictated by the HLM's - ! canopy solver. [mm H2O/s] [+ into root] - real(r8),allocatable :: swrad_net_pa(:) ! Net absorbed shortwave radiation (W/m2) - real(r8),allocatable :: lwrad_net_pa(:) ! Net absorbed longwave radiation (W/m2) - real(r8),allocatable :: watsat_sisl(:) ! volumetric soil water at saturation (porosity) - real(r8),allocatable :: watres_sisl(:) ! volumetric residual soil water - real(r8),allocatable :: sucsat_sisl(:) ! minimum soil suction (mm) - real(r8),allocatable :: bsw_sisl(:) ! Clapp and Hornberger "b" - real(r8),allocatable :: hksat_sisl(:) ! hydraulic conductivity at saturation (mm H2O /s) - real(r8),allocatable :: h2o_liq_sisl(:) ! Liquid water mass in each layer (kg/m2) - real(r8) :: smpmin_si ! restriction for min of soil potential (mm) - - end type bc_in_type - - - type, public :: bc_out_type - - ! Sunlit fraction of the canopy for this patch [0-1] - real(r8),allocatable :: fsun_pa(:) - - ! Sunlit canopy LAI - real(r8),allocatable :: laisun_pa(:) - - ! Shaded canopy LAI - real(r8),allocatable :: laisha_pa(:) - - ! Logical stating whether a ground layer can have water uptake by plants - ! The only condition right now is that liquid water exists - ! The name (suction) is used to indicate that soil suction should be calculated - logical, allocatable :: active_suction_sl(:) - - ! Effective fraction of roots in each soil layer - real(r8), allocatable :: rootr_pasl(:,:) - - ! Integrated (vertically) transpiration wetness factor (0 to 1) - ! (diagnostic, should not be used by HLM) - real(r8), allocatable :: btran_pa(:) - - ! Sunlit canopy resistance [s/m] - real(r8), allocatable :: rssun_pa(:) - - ! Shaded canopy resistance [s/m] - real(r8), allocatable :: rssha_pa(:) - - ! leaf photosynthesis (umol CO2 /m**2/ s) - ! (NOT CURRENTLY USED, PLACE-HOLDER) - !real(r8), allocatable :: psncanopy_pa(:) - - ! leaf maintenance respiration rate (umol CO2/m**2/s) - ! (NOT CURRENTLY USED, PLACE-HOLDER) - !real(r8), allocatable :: lmrcanopy_pa(:) - - ! Canopy Radiation Boundaries - ! --------------------------------------------------------------------------------- - - ! Surface albedo (direct) (HLMs use this for atm coupling and balance checks) - real(r8), allocatable :: albd_parb(:,:) - - ! Surface albedo (diffuse) (HLMs use this for atm coupling and balance checks) - real(r8), allocatable :: albi_parb(:,:) - - ! Flux absorbed by canopy per unit direct flux (HLMs use this for balance checks) - real(r8), allocatable :: fabd_parb(:,:) - - ! Flux absorbed by canopy per unit diffuse flux (HLMs use this for balance checks) - real(r8), allocatable :: fabi_parb(:,:) - - ! Down direct flux below canopy per unit direct flx (HLMs use this for balance checks) - real(r8), allocatable :: ftdd_parb(:,:) - - ! Down diffuse flux below canopy per unit direct flx (HLMs use this for balance checks) - real(r8), allocatable :: ftid_parb(:,:) - - ! Down diffuse flux below canopy per unit diffuse flx (HLMs use this for balance checks) - real(r8), allocatable :: ftii_parb(:,:) - - - ! Mass fluxes to BGC from fragmentation of litter into decomposing pools - - real(r8), allocatable :: litt_flux_cel_c_si(:) ! cellulose carbon litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_lig_c_si(:) ! lignan carbon litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_lab_c_si(:) ! labile carbon litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_cel_n_si(:) ! cellulose nitrogen litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_lig_n_si(:) ! lignan nitrogen litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_lab_n_si(:) ! labile nitrogen litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_cel_p_si(:) ! cellulose phosphorus litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_lig_p_si(:) ! lignan phosphorus litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_lab_p_si(:) ! labile phosphorus litter, fates->BGC g/m3/s - - ! Canopy Structure - - real(r8), allocatable :: elai_pa(:) ! exposed leaf area index - real(r8), allocatable :: esai_pa(:) ! exposed stem area index - real(r8), allocatable :: tlai_pa(:) ! total leaf area index - real(r8), allocatable :: tsai_pa(:) ! total stem area index - real(r8), allocatable :: htop_pa(:) ! top of the canopy [m] - real(r8), allocatable :: hbot_pa(:) ! bottom of canopy? [m] - - real(r8), allocatable :: z0m_pa(:) ! roughness length [m] - real(r8), allocatable :: displa_pa(:) ! displacement height [m] - real(r8), allocatable :: dleaf_pa(:) ! leaf characteristic dimension/width/diameter [m] - - real(r8), allocatable :: canopy_fraction_pa(:) ! Area fraction of each patch in the site - ! Use most likely for weighting - ! This is currently the projected canopy - ! area of each patch [0-1] - - real(r8), allocatable :: frac_veg_nosno_alb_pa(:) ! This is not really a fraction - ! this is actually binary based on if any - ! vegetation in the patch is exposed. - ! [0,1] - - ! FATES Hydraulics - - - - real(r8) :: plant_stored_h2o_si ! stored water in LIVE+DEAD vegetation (kg/m2 H2O) - ! Assuming density of 1Mg/m3 ~= mm/m2 H2O - ! This must be set and transfered prior to clm_drv() - ! following the calls to ed_update_site() - ! ed_update_site() is called during both the restart - ! and coldstart process - - real(r8),allocatable :: qflx_soil2root_sisl(:) ! Water flux from soil into root by site and soil layer - ! [mm H2O/s] [+ into root] - - real(r8),allocatable :: qflx_ro_sisl(:) ! Water flux runoff generated by - ! root to soil flux super-saturating the soils - ! This does seem unlikely, but we need accomodate - ! small fluxes for various reasons - ! [mm H2O/s] - - - end type bc_out_type - - - type, public :: fates_interface_type - - ! This is the root of the ED/FATES hierarchy of instantaneous state variables - ! ie the root of the linked lists. Each path list is currently associated with a - ! grid-cell, this is intended to be migrated to columns - - integer :: nsites - - type(ed_site_type), pointer :: sites(:) - - ! These are boundary conditions that the FATES models are required to be filled. - ! These values are filled by the driver or HLM. Once filled, these have an - ! intent(in) status. Each site has a derived type structure, which may include - ! a scalar for site level data, a patch vector, potentially cohort vectors (but - ! not yet atm) and other dimensions such as soil-depth or pft. These vectors - ! are initialized by maximums, and the allocations are static in time to avoid - ! having to allocate/de-allocate memory - - type(bc_in_type), allocatable :: bc_in(:) - - ! These are the boundary conditions that the FATES model returns to its HLM or - ! driver. It has the same allocation strategy and similar vector types. - - type(bc_out_type), allocatable :: bc_out(:) - - contains - - procedure, public :: zero_bcs - procedure, public :: set_bcs - - end type fates_interface_type - - ! Make public necessary subroutines and functions public :: FatesInterfaceInit public :: set_fates_ctrlparms @@ -633,13 +64,13 @@ module FatesInterfaceMod contains - ! ==================================================================================== + ! ==================================================================================== subroutine FatesInterfaceInit(log_unit,global_verbose) - + use FatesGlobals, only : FatesGlobalsInit - + implicit none - + integer, intent(in) :: log_unit logical, intent(in) :: global_verbose @@ -647,26 +78,26 @@ subroutine FatesInterfaceInit(log_unit,global_verbose) end subroutine FatesInterfaceInit - ! ==================================================================================== - - ! INTERF-TODO: THIS IS A PLACE-HOLDER ROUTINE, NOT CALLED YET... - subroutine fates_clean(this) - - implicit none - - ! Input Arguments - class(fates_interface_type), intent(inout) :: this - - ! Incrementally walk through linked list and deallocate - + ! ==================================================================================== + + ! INTERF-TODO: THIS IS A PLACE-HOLDER ROUTINE, NOT CALLED YET... + subroutine fates_clean(this) + implicit none + + ! Input Arguments + class(fates_interface_type), intent(inout) :: this + + ! Incrementally walk through linked list and deallocate + + - ! Deallocate the site list -! deallocate (this%sites) + ! Deallocate the site list + ! deallocate (this%sites) - return - end subroutine fates_clean - + return + end subroutine fates_clean + ! ==================================================================================== @@ -796,6 +227,8 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in) return end subroutine allocate_bcin + + ! ==================================================================================== subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) @@ -881,123 +314,8 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) end subroutine allocate_bcout ! ==================================================================================== - - subroutine zero_bcs(this,s) - - implicit none - class(fates_interface_type), intent(inout) :: this - integer, intent(in) :: s - - ! Input boundaries - - this%bc_in(s)%t_veg24_si = 0.0_r8 - this%bc_in(s)%t_veg24_pa(:) = 0.0_r8 - this%bc_in(s)%precip24_pa(:) = 0.0_r8 - this%bc_in(s)%relhumid24_pa(:) = 0.0_r8 - this%bc_in(s)%wind24_pa(:) = 0.0_r8 - - this%bc_in(s)%solad_parb(:,:) = 0.0_r8 - this%bc_in(s)%solai_parb(:,:) = 0.0_r8 - this%bc_in(s)%smp_sl(:) = 0.0_r8 - this%bc_in(s)%eff_porosity_sl(:) = 0.0_r8 - this%bc_in(s)%watsat_sl(:) = 0.0_r8 - this%bc_in(s)%tempk_sl(:) = 0.0_r8 - this%bc_in(s)%h2o_liqvol_sl(:) = 0.0_r8 - this%bc_in(s)%filter_vegzen_pa(:) = .false. - this%bc_in(s)%coszen_pa(:) = 0.0_r8 - this%bc_in(s)%albgr_dir_rb(:) = 0.0_r8 - this%bc_in(s)%albgr_dif_rb(:) = 0.0_r8 - this%bc_in(s)%max_rooting_depth_index_col = 0 - this%bc_in(s)%tot_het_resp = 0.0_r8 - this%bc_in(s)%tot_somc = 0.0_r8 - this%bc_in(s)%tot_litc = 0.0_r8 - this%bc_in(s)%snow_depth_si = 0.0_r8 - this%bc_in(s)%frac_sno_eff_si = 0.0_r8 - - if(do_fates_salinity)then - this%bc_in(s)%salinity_sl(:) = 0.0_r8 - endif - - if (hlm_use_planthydro.eq.itrue) then - - this%bc_in(s)%qflx_transp_pa(:) = 0.0_r8 - this%bc_in(s)%swrad_net_pa(:) = 0.0_r8 - this%bc_in(s)%lwrad_net_pa(:) = 0.0_r8 - this%bc_in(s)%watsat_sisl(:) = 0.0_r8 - this%bc_in(s)%watres_sisl(:) = 0.0_r8 - this%bc_in(s)%sucsat_sisl(:) = 0.0_r8 - this%bc_in(s)%bsw_sisl(:) = 0.0_r8 - this%bc_in(s)%hksat_sisl(:) = 0.0_r8 - end if - - - ! Output boundaries - this%bc_out(s)%active_suction_sl(:) = .false. - this%bc_out(s)%fsun_pa(:) = 0.0_r8 - this%bc_out(s)%laisun_pa(:) = 0.0_r8 - this%bc_out(s)%laisha_pa(:) = 0.0_r8 - this%bc_out(s)%rootr_pasl(:,:) = 0.0_r8 - this%bc_out(s)%btran_pa(:) = 0.0_r8 - - ! Fates -> BGC fragmentation mass fluxes - select case(hlm_parteh_mode) - case(prt_carbon_allom_hyp) - this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 - case(prt_cnp_flex_allom_hyp) - this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_cel_n_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_n_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_n_si(:) = 0._r8 - this%bc_out(s)%litt_flux_cel_p_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_p_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_p_si(:) = 0._r8 - case default - write(fates_log(), *) 'An unknown parteh hypothesis was passed' - write(fates_log(), *) 'while zeroing output boundary conditions' - write(fates_log(), *) 'hlm_parteh_mode: ',hlm_parteh_mode - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - - - this%bc_out(s)%rssun_pa(:) = 0.0_r8 - this%bc_out(s)%rssha_pa(:) = 0.0_r8 - - this%bc_out(s)%albd_parb(:,:) = 0.0_r8 - this%bc_out(s)%albi_parb(:,:) = 0.0_r8 - this%bc_out(s)%fabd_parb(:,:) = 0.0_r8 - this%bc_out(s)%fabi_parb(:,:) = 0.0_r8 - this%bc_out(s)%ftdd_parb(:,:) = 0.0_r8 - this%bc_out(s)%ftid_parb(:,:) = 0.0_r8 - this%bc_out(s)%ftii_parb(:,:) = 0.0_r8 - - this%bc_out(s)%elai_pa(:) = 0.0_r8 - this%bc_out(s)%esai_pa(:) = 0.0_r8 - this%bc_out(s)%tlai_pa(:) = 0.0_r8 - this%bc_out(s)%tsai_pa(:) = 0.0_r8 - this%bc_out(s)%htop_pa(:) = 0.0_r8 - this%bc_out(s)%hbot_pa(:) = 0.0_r8 - this%bc_out(s)%displa_pa(:) = 0.0_r8 - this%bc_out(s)%z0m_pa(:) = 0.0_r8 - this%bc_out(s)%dleaf_pa(:) = 0.0_r8 - - this%bc_out(s)%canopy_fraction_pa(:) = 0.0_r8 - this%bc_out(s)%frac_veg_nosno_alb_pa(:) = 0.0_r8 - - if (hlm_use_planthydro.eq.itrue) then - this%bc_out(s)%qflx_soil2root_sisl(:) = 0.0_r8 - this%bc_out(s)%qflx_ro_sisl(:) = 0.0_r8 - end if - this%bc_out(s)%plant_stored_h2o_si = 0.0_r8 - - return - end subroutine zero_bcs - subroutine set_bcs(this,s) + subroutine set_bcs(bc_in) ! -------------------------------------------------------------------------------- ! @@ -1011,8 +329,7 @@ subroutine set_bcs(this,s) ! ! -------------------------------------------------------------------------------- implicit none - class(fates_interface_type), intent(inout) :: this - integer, intent(in) :: s + type(bc_in_type), intent(inout) :: bc_in ! Input boundaries ! Warning: these "z" type variables @@ -1020,12 +337,11 @@ subroutine set_bcs(this,s) ! so THIS ROUTINE SHOULD NOT BE CALLED AFTER ! INITIALIZATION if(do_fates_salinity)then - this%bc_in(s)%salinity_sl(:) = bgc_soil_salinity + bc_in%salinity_sl(:) = bgc_soil_salinity endif - + end subroutine set_bcs - ! =================================================================================== subroutine set_fates_global_elements(use_fates) @@ -1046,10 +362,7 @@ subroutine set_fates_global_elements(use_fates) ! ! -------------------------------------------------------------------------------- - use EDParamsMod, only : ED_val_history_sizeclass_bin_edges, ED_val_history_ageclass_bin_edges - use EDParamsMod, only : ED_val_history_height_bin_edges - use EDParamsMod, only : ED_val_history_coageclass_bin_edges - use CLMFatesParamInterfaceMod , only : FatesReadParameters + implicit none logical,intent(in) :: use_fates ! Is fates turned on? @@ -1073,14 +386,14 @@ subroutine set_fates_global_elements(use_fates) write(fates_log(), *) 'it was found that the lower bound was neither 0 or 1?' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + if(numpft>maxpft) then write(fates_log(), *) 'The number of PFTs dictated by the FATES parameter file' write(fates_log(), *) 'is larger than the maximum allowed. Increase the FATES parameter constant' write(fates_log(), *) 'FatesInterfaceMod.F90:maxpft accordingly' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + ! Identify the number of leaf age-classes if( (lbound(EDPftvarcon_inst%leaf_long(:,:),dim=2) .eq. 0) .or. & @@ -1152,6 +465,21 @@ subroutine set_fates_global_elements(use_fates) end if end do + ! Initialize Hydro globals + ! (like water retention functions) + ! this needs to know the number of PFTs, which is + ! determined in that call + call InitHydroGlobals(numpft) + + ! Initialize the Plant Allocation and Reactive Transport + ! global functions and mapping tables + ! Also associate the elements defined in PARTEH with a list in FATES + ! "element_list" is useful because it allows the fates side of the code + ! to loop through elements, and call the correct PARTEH interfaces + ! automatically. + call InitPARTEHGlobals() + + ! Set Various Mapping Arrays used in history output as well ! These will not be used if use_ed or use_fates is false call fates_history_maps() @@ -1172,7 +500,59 @@ subroutine set_fates_global_elements(use_fates) end subroutine set_fates_global_elements - !============================================================================================== + ! ====================================================================== + + subroutine InitPARTEHGlobals() + + ! Initialize the Plant Allocation and Reactive Transport + ! global functions and mapping tables + ! Also associate the elements defined in PARTEH with a list in FATES + ! "element_list" is useful because it allows the fates side of the code + ! to loop through elements, and call the correct PARTEH interfaces + ! automatically. + + select case(hlm_parteh_mode) + case(prt_carbon_allom_hyp) + + num_elements = 1 + allocate(element_list(num_elements)) + element_list(1) = carbon12_element + element_pos(:) = 0 + element_pos(carbon12_element) = 1 + + call InitPRTGlobalAllometricCarbon() + + case(prt_cnp_flex_allom_hyp) + + num_elements = 3 + allocate(element_list(num_elements)) + element_list(1) = carbon12_element + element_list(2) = nitrogen_element + element_list(3) = phosphorus_element + element_pos(:) = 0 + element_pos(carbon12_element) = 1 + element_pos(nitrogen_element) = 2 + element_pos(phosphorus_element) = 3 + + !call InitPRTGlobalAllometricCNP() + write(fates_log(),*) 'You specified the allometric CNP mode' + write(fates_log(),*) 'with relaxed target stoichiometry.' + write(fates_log(),*) 'I.e., namelist parametre fates_parteh_mode = 2' + write(fates_log(),*) 'This mode is not available yet. Please set it to 1.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + case DEFAULT + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Check your setting for fates_parteh_mode' + write(fates_log(),*) 'in the CLM namelist. The only valid value now is 1' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + + end subroutine InitPARTEHGlobals + + !============================================================================================== subroutine fates_history_maps @@ -1841,7 +1221,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) return end subroutine set_fates_ctrlparms - + ! ==================================================================================== subroutine FatesReportParameters(masterproc) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 new file mode 100644 index 0000000000..a7bd57ea70 --- /dev/null +++ b/main/FatesInterfaceTypesMod.F90 @@ -0,0 +1,698 @@ +module FatesInterfaceTypesMod + implicit none + + private ! By default everything is private + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + ! ------------------------------------------------------------------------------------- + ! Parameters that are dictated by the Host Land Model + ! THESE ARE NOT DYNAMIC. SHOULD BE SET ONCE DURING INTIALIZATION. + ! ------------------------------------------------------------------------------------- + + + integer, public, protected :: hlm_numSWb ! Number of broad-bands in the short-wave radiation + ! specturm to track + ! (typically 2 as a default, VIS/NIR, in ED variants <2016) + + integer, public, protected :: hlm_ivis ! The HLMs assumption of the array index associated with the + ! visible portion of the spectrum in short-wave radiation arrays + + integer, public, protected :: hlm_inir ! The HLMs assumption of the array index associated with the + ! NIR portion of the spectrum in short-wave radiation arrays + + + integer, public, protected :: hlm_numlevgrnd ! Number of ground layers + ! NOTE! SOIL LAYERS ARE NOT A GLOBAL, THEY + ! ARE VARIABLE BY SITE + + integer, public, protected :: hlm_is_restart ! Is the HLM signalling that this is a restart + ! type simulation? + ! 1=TRUE, 0=FALSE + + character(len=16), public, protected :: hlm_name ! This character string passed by the HLM + ! is used during the processing of IO data, + ! so that FATES knows which IO variables it + ! should prepare. For instance + ! ATS, ALM and CLM will only want variables + ! specficially packaged for them. + ! This string sets which filter is enacted. + + + real(r8), public, protected :: hlm_hio_ignore_val ! This value can be flushed to history + ! diagnostics, such that the + ! HLM will interpret that the value should not + ! be included in the average. + + integer, public, protected :: hlm_masterproc ! Is this the master processor, typically useful + ! for knowing if the current machine should be + ! printing out messages to the logs or terminals + ! 1 = TRUE (is master) 0 = FALSE (is not master) + + integer, public, protected :: hlm_ipedof ! The HLM pedotransfer index + ! this is only used by the plant hydraulics + ! submodule to check and/or enable consistency + ! between the pedotransfer functions of the HLM + ! and how it moves and stores water in its + ! rhizosphere shells + + integer, public, protected :: hlm_max_patch_per_site ! The HLM needs to exchange some patch + ! level quantities with FATES + ! FATES does not dictate those allocations + ! since it happens pretty early in + ! the model initialization sequence. + ! So we want to at least query it, + ! compare it to our maxpatchpersite, + ! and gracefully halt if we are over-allocating + + integer, public, protected :: hlm_parteh_mode ! This flag signals which Plant Allocation and Reactive + ! Transport (exensible) Hypothesis (PARTEH) to use + + + integer, public, protected :: hlm_use_vertsoilc ! This flag signals whether or not the + ! host model is using vertically discretized + ! soil carbon + ! 1 = TRUE, 0 = FALSE + + integer, public, protected :: hlm_use_spitfire ! This flag signals whether or not to use SPITFIRE + ! 1 = TRUE, 0 = FALSE + + + integer, public, protected :: hlm_use_logging ! This flag signals whether or not to use + ! the logging module + + integer, public, protected :: hlm_use_planthydro ! This flag signals whether or not to use + ! plant hydraulics (bchristo/xu methods) + ! 1 = TRUE, 0 = FALSE + ! THIS IS CURRENTLY NOT SUPPORTED + + integer, public, protected :: hlm_use_cohort_age_tracking ! This flag signals whether or not to use + ! cohort age tracking. 1 = TRUE, 0 = FALSE + + integer, public, protected :: hlm_use_ed_st3 ! This flag signals whether or not to use + ! (ST)atic (ST)and (ST)ructure mode (ST3) + ! Essentially, this gives us the ability + ! to turn off "dynamics", ie growth, disturbance + ! recruitment and mortality. + ! (EXPERIMENTAL!!!!! - RGK 07-2017) + ! 1 = TRUE, 0 = FALSE + ! default should be FALSE (dynamics on) + ! cannot be true with prescribed_phys + + integer, public, protected :: hlm_use_ed_prescribed_phys ! This flag signals whether or not to use + ! prescribed physiology, somewhat the opposite + ! to ST3, in this case can turn off + ! fast processes like photosynthesis and respiration + ! and prescribe NPP + ! (NOT CURRENTLY IMPLEMENTED - PLACEHOLDER) + ! 1 = TRUE, 0 = FALSE + ! default should be FALSE (biophysics on) + ! cannot be true with st3 mode + + integer, public, protected :: hlm_use_inventory_init ! Initialize this simulation from + ! an inventory file. If this is toggled on + ! an inventory control file must be specified + ! as well. + ! 1 = TRUE, 0 = FALSE + + character(len=256), public, protected :: hlm_inventory_ctrl_file ! This is the full path to the + ! inventory control file that + ! specifieds the availabel inventory datasets + ! there locations and their formats + ! This need only be defined when + ! hlm_use_inventory_init = 1 + + ! ------------------------------------------------------------------------------------- + ! Parameters that are dictated by FATES and known to be required knowledge + ! needed by the HLMs + ! ------------------------------------------------------------------------------------- + + ! Variables mostly used for dimensioning host land model (HLM) array spaces + + integer, public, protected :: fates_maxElementsPerPatch ! maxElementsPerPatch is the value that is ultimately + ! used to set the size of the largest arrays necessary + ! in things like restart files (probably hosted by the + ! HLM). The size of these arrays are not a parameter + ! because it is simply the maximum of several different + ! dimensions. It is possible that this would be the + ! maximum number of cohorts per patch, but + ! but it could be other things. + + integer, public, protected :: fates_maxElementsPerSite ! This is the max number of individual items one can store per + ! each grid cell and effects the striding in the ED restart + ! data as some fields are arrays where each array is + ! associated with one cohort + + ! ------------------------------------------------------------------------------------- + ! These vectors are used for history output mapping + ! CLM/ALM have limited support for multi-dimensional history output arrays. + ! FATES structure and composition is multi-dimensional, so we end up "multi-plexing" + ! multiple dimensions into one dimension. These new dimensions need definitions, + ! mapping to component dimensions, and definitions for those component dimensions as + ! well. + ! ------------------------------------------------------------------------------------- + + real(r8), public, allocatable :: fates_hdim_levcoage(:) ! cohort age class lower bound dimension + integer , public, allocatable :: fates_hdim_pfmap_levcapf(:) ! map of pfts into cohort age class x pft dimension + integer , public, allocatable :: fates_hdim_camap_levcapf(:) ! map of cohort age class into cohort age x pft dimension + + + real(r8), public, allocatable :: fates_hdim_levsclass(:) ! plant size class lower bound dimension + integer , public, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension + integer , public, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension + real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension + real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension + integer , public, allocatable :: fates_hdim_levpft(:) ! plant pft dimension + integer , public, allocatable :: fates_hdim_levfuel(:) ! fire fuel class dimension + integer , public, allocatable :: fates_hdim_levcwdsc(:) ! cwd class dimension + integer , public, allocatable :: fates_hdim_levcan(:) ! canopy-layer dimension + integer , public, allocatable :: fates_hdim_levelem(:) ! element dimension + integer , public, allocatable :: fates_hdim_canmap_levcnlf(:) ! canopy-layer map into the canopy-layer x leaf-layer dim + integer , public, allocatable :: fates_hdim_lfmap_levcnlf(:) ! leaf-layer map into the can-layer x leaf-layer dimension + integer , public, allocatable :: fates_hdim_canmap_levcnlfpf(:) ! can-layer map into the can-layer x pft x leaf-layer dim + integer , public, allocatable :: fates_hdim_lfmap_levcnlfpf(:) ! leaf-layer map into the can-layer x pft x leaf-layer dim + integer , public, allocatable :: fates_hdim_pftmap_levcnlfpf(:) ! pft map into the canopy-layer x pft x leaf-layer dim + integer , public, allocatable :: fates_hdim_scmap_levscag(:) ! map of size-class into size-class x patch age dimension + integer , public, allocatable :: fates_hdim_agmap_levscag(:) ! map of patch-age into size-class x patch age dimension + integer , public, allocatable :: fates_hdim_scmap_levscagpft(:) ! map of size-class into size-class x patch age x pft dimension + integer , public, allocatable :: fates_hdim_agmap_levscagpft(:) ! map of patch-age into size-class x patch age x pft dimension + integer , public, allocatable :: fates_hdim_pftmap_levscagpft(:) ! map of pft into size-class x patch age x pft dimension + integer , public, allocatable :: fates_hdim_agmap_levagepft(:) ! map of patch-age into patch age x pft dimension + integer , public, allocatable :: fates_hdim_pftmap_levagepft(:) ! map of pft into patch age x pft dimension + + integer , public, allocatable :: fates_hdim_elmap_levelpft(:) ! map of elements in the element x pft dimension + integer , public, allocatable :: fates_hdim_elmap_levelcwd(:) ! map of elements in the element x cwd dimension + integer , public, allocatable :: fates_hdim_elmap_levelage(:) ! map of elements in the element x age dimension + integer , public, allocatable :: fates_hdim_pftmap_levelpft(:) ! map of pfts in the element x pft dimension + integer , public, allocatable :: fates_hdim_cwdmap_levelcwd(:) ! map of cwds in the element x cwd dimension + integer , public, allocatable :: fates_hdim_agemap_levelage(:) ! map of ages in the element x age dimension + + ! ------------------------------------------------------------------------------------ + ! DYNAMIC BOUNDARY CONDITIONS + ! ------------------------------------------------------------------------------------ + + + ! ------------------------------------------------------------------------------------- + ! Scalar Timing Variables + ! It is assumed that all of the sites on a given machine will be synchronous. + ! It is also assumed that the HLM will control time. + ! ------------------------------------------------------------------------------------- + integer, public, protected :: hlm_current_year ! Current year + integer, public, protected :: hlm_current_month ! month of year + integer, public, protected :: hlm_current_day ! day of month + integer, public, protected :: hlm_current_tod ! time of day (seconds past 0Z) + integer, public, protected :: hlm_current_date ! time of day (seconds past 0Z) + integer, public, protected :: hlm_reference_date ! YYYYMMDD + real(r8), public, protected :: hlm_model_day ! elapsed days between current date and ref + integer, public, protected :: hlm_day_of_year ! The integer day of the year + integer, public, protected :: hlm_days_per_year ! The HLM controls time, some HLMs may + ! include a leap + real(r8), public, protected :: hlm_freq_day ! fraction of year for daily time-step + ! (1/days_per_year_, this is a frequency + + + ! ------------------------------------------------------------------------------------- + ! + ! Constant parameters that are dictated by the fates parameter file + ! + ! ------------------------------------------------------------------------------------- + + integer, public, protected :: numpft ! The total number of PFTs defined in the simulation + integer, public, protected :: nlevsclass ! The total number of cohort size class bins output to history + integer, public, protected :: nlevage ! The total number of patch age bins output to history + integer, public, protected :: nlevheight ! The total number of height bins output to history + integer, public, protected :: nlevcoage ! The total number of cohort age bins output to history + integer, public, protected :: nleafage ! The total number of leaf age classes + + ! ------------------------------------------------------------------------------------- + ! Structured Boundary Conditions (SITE/PATCH SCALE) + ! For floating point arrays, it is sometimes the convention to define the arrays as + ! POINTER instead of ALLOCATABLE. This usually achieves the same result with subtle + ! differences. POINTER arrays can point to scalar values, discontinuous array slices + ! or alias other variables, ALLOCATABLES cannnot. According to S. Lionel + ! (Intel-Forum Post), ALLOCATABLES are better perfomance wise as long as they point + ! to contiguous memory spaces and do not alias other variables, the case here. + ! Naming conventions: _si means site dimensions (scalar in that case) + ! _pa means patch dimensions + ! _rb means radiation band + ! _sl means soil layer + ! _sisl means site x soil layer + ! ------------------------------------------------------------------------------------ + + type, public :: bc_in_type + + ! The actual number of FATES' ED patches + integer :: npatches + + + ! Soil layer structure + + integer :: nlevsoil ! the number of soil layers in this column + integer :: nlevdecomp ! the number of soil layers in the column + ! that are biogeochemically active + real(r8),allocatable :: zi_sisl(:) ! interface level below a "z" level (m) + ! this contains a zero index for surface. + real(r8),allocatable :: dz_sisl(:) ! layer thickness (m) + real(r8),allocatable :: z_sisl(:) ! layer depth (m) + + ! Decomposition Layer Structure + real(r8), allocatable :: dz_decomp_sisl(:) ! This should match dz_sisl(), unless + ! only one layer is chosen, in that + ! case, it has its own depth, which + ! has traditionally been 1 meter + + integer,allocatable :: decomp_id(:) ! The decomposition layer index that each + ! soil layer maps to. This will either + ! be equivalent (ie integer ascending) + ! Or, all will be 1. + + + ! Vegetation Dynamics + ! --------------------------------------------------------------------------------- + + ! The site level 24 hour vegetation temperature is used for various purposes during vegetation + ! dynamics. However, we are currently using the bare ground patch's value [K] + ! TO-DO: Get some consensus on the correct vegetation temperature used for phenology. + ! It is possible that the bare-ground value is where the average is being stored. + ! (RGK-01-2017) + real(r8) :: t_veg24_si + + ! Patch 24 hour vegetation temperature [K] + real(r8),allocatable :: t_veg24_pa(:) + + ! Fire Model + + ! Average precipitation over the last 24 hours [mm/s] + real(r8), allocatable :: precip24_pa(:) + + ! Average relative humidity over past 24 hours [-] + real(r8), allocatable :: relhumid24_pa(:) + + ! Patch 24-hour running mean of wind (m/s ?) + real(r8), allocatable :: wind24_pa(:) + + + ! Radiation variables for calculating sun/shade fractions + ! --------------------------------------------------------------------------------- + + ! Downwelling direct beam radiation (patch,radiation-band) [W/m2] + real(r8), allocatable :: solad_parb(:,:) + + ! Downwelling diffuse (I-ndirect) radiation (patch,radiation-band) [W/m2] + real(r8), allocatable :: solai_parb(:,:) + + + + ! Photosynthesis variables + ! --------------------------------------------------------------------------------- + + ! Patch level filter flag for photosynthesis calculations + ! has a short memory, flags: + ! 1 = patch has not been called + ! 2 = patch is currently marked for photosynthesis + ! 3 = patch has been called for photosynthesis at least once + integer, allocatable :: filter_photo_pa(:) + + ! atmospheric pressure (Pa) + real(r8) :: forc_pbot + + ! daylength scaling factor (0-1) + real(r8), allocatable :: dayl_factor_pa(:) + + ! saturation vapor pressure at t_veg (Pa) + real(r8), allocatable :: esat_tv_pa(:) + + ! vapor pressure of canopy air (Pa) + real(r8), allocatable :: eair_pa(:) + + ! Atmospheric O2 partial pressure (Pa) + real(r8), allocatable :: oair_pa(:) + + ! Atmospheric CO2 partial pressure (Pa) + real(r8), allocatable :: cair_pa(:) + + ! boundary layer resistance (s/m) + real(r8), allocatable :: rb_pa(:) + + ! vegetation temperature (Kelvin) + real(r8), allocatable :: t_veg_pa(:) + + ! air temperature at agcm reference height (kelvin) + real(r8), allocatable :: tgcm_pa(:) + + ! soil temperature (Kelvin) + real(r8), allocatable :: t_soisno_sl(:) + + ! Canopy Radiation Boundaries + ! --------------------------------------------------------------------------------- + + ! Filter for vegetation patches with a positive zenith angle (daylight) + logical, allocatable :: filter_vegzen_pa(:) + + ! Cosine of the zenith angle (0-1), by patch + ! Note RGK: It does not seem like the code would currently generate + ! different zenith angles for different patches (nor should it) + ! I am leaving it at this scale for simplicity. Patches should + ! have no spacially variable information + real(r8), allocatable :: coszen_pa(:) + + ! Abledo of the ground for direct radiation, by site broadband (0-1) + real(r8), allocatable :: albgr_dir_rb(:) + + ! Albedo of the ground for diffuse radiation, by site broadband (0-1) + real(r8), allocatable :: albgr_dif_rb(:) + + ! LitterFlux Boundaries + ! the index of the deepest model soil level where roots may be + ! due to permafrost or bedrock constraints + integer :: max_rooting_depth_index_col + + ! BGC Accounting + + real(r8) :: tot_het_resp ! total heterotrophic respiration (gC/m2/s) + real(r8) :: tot_somc ! total soil organic matter carbon (gc/m2) + real(r8) :: tot_litc ! total litter carbon tracked in the HLM (gc/m2) + + ! Canopy Structure + + real(r8) :: snow_depth_si ! Depth of snow in snowy areas of site (m) + real(r8) :: frac_sno_eff_si ! Fraction of ground covered by snow (0-1) + + ! Hydrology variables for BTRAN + ! --------------------------------------------------------------------------------- + + ! Soil suction potential of layers in each site, negative, [mm] + real(r8), allocatable :: smp_sl(:) + + !soil salinity of layers in each site [ppt] + real(r8), allocatable :: salinity_sl(:) + + ! Effective porosity = porosity - vol_ic, of layers in each site [-] + real(r8), allocatable :: eff_porosity_sl(:) + + ! volumetric soil water at saturation (porosity) + real(r8), allocatable :: watsat_sl(:) + + ! Temperature of ground layers [K] + real(r8), allocatable :: tempk_sl(:) + + ! Liquid volume in ground layer (m3/m3) + real(r8), allocatable :: h2o_liqvol_sl(:) + + ! Site level filter for uptake response functions + logical :: filter_btran + + + ! ALL HYDRO DATA STRUCTURES SHOULD NOW BE ALLOCATED ON RHIZOSPHERE LEVELS + + ! Plant-Hydro + ! --------------------------------------------------------------------------------- + + real(r8),allocatable :: qflx_transp_pa(:) ! Transpiration flux as dictated by the HLM's + ! canopy solver. [mm H2O/s] [+ into root] + real(r8),allocatable :: swrad_net_pa(:) ! Net absorbed shortwave radiation (W/m2) + real(r8),allocatable :: lwrad_net_pa(:) ! Net absorbed longwave radiation (W/m2) + real(r8),allocatable :: watsat_sisl(:) ! volumetric soil water at saturation (porosity) + real(r8),allocatable :: watres_sisl(:) ! volumetric residual soil water + real(r8),allocatable :: sucsat_sisl(:) ! minimum soil suction (mm) + real(r8),allocatable :: bsw_sisl(:) ! Clapp and Hornberger "b" + real(r8),allocatable :: hksat_sisl(:) ! hydraulic conductivity at saturation (mm H2O /s) + real(r8),allocatable :: h2o_liq_sisl(:) ! Liquid water mass in each layer (kg/m2) + real(r8) :: smpmin_si ! restriction for min of soil potential (mm) + + end type bc_in_type + + + type, public :: bc_out_type + + ! Sunlit fraction of the canopy for this patch [0-1] + real(r8),allocatable :: fsun_pa(:) + + ! Sunlit canopy LAI + real(r8),allocatable :: laisun_pa(:) + + ! Shaded canopy LAI + real(r8),allocatable :: laisha_pa(:) + + ! Logical stating whether a ground layer can have water uptake by plants + ! The only condition right now is that liquid water exists + ! The name (suction) is used to indicate that soil suction should be calculated + logical, allocatable :: active_suction_sl(:) + + ! Effective fraction of roots in each soil layer + real(r8), allocatable :: rootr_pasl(:,:) + + ! Integrated (vertically) transpiration wetness factor (0 to 1) + ! (diagnostic, should not be used by HLM) + real(r8), allocatable :: btran_pa(:) + + ! Sunlit canopy resistance [s/m] + real(r8), allocatable :: rssun_pa(:) + + ! Shaded canopy resistance [s/m] + real(r8), allocatable :: rssha_pa(:) + + ! leaf photosynthesis (umol CO2 /m**2/ s) + ! (NOT CURRENTLY USED, PLACE-HOLDER) + !real(r8), allocatable :: psncanopy_pa(:) + + ! leaf maintenance respiration rate (umol CO2/m**2/s) + ! (NOT CURRENTLY USED, PLACE-HOLDER) + !real(r8), allocatable :: lmrcanopy_pa(:) + + ! Canopy Radiation Boundaries + ! --------------------------------------------------------------------------------- + + ! Surface albedo (direct) (HLMs use this for atm coupling and balance checks) + real(r8), allocatable :: albd_parb(:,:) + + ! Surface albedo (diffuse) (HLMs use this for atm coupling and balance checks) + real(r8), allocatable :: albi_parb(:,:) + + ! Flux absorbed by canopy per unit direct flux (HLMs use this for balance checks) + real(r8), allocatable :: fabd_parb(:,:) + + ! Flux absorbed by canopy per unit diffuse flux (HLMs use this for balance checks) + real(r8), allocatable :: fabi_parb(:,:) + + ! Down direct flux below canopy per unit direct flx (HLMs use this for balance checks) + real(r8), allocatable :: ftdd_parb(:,:) + + ! Down diffuse flux below canopy per unit direct flx (HLMs use this for balance checks) + real(r8), allocatable :: ftid_parb(:,:) + + ! Down diffuse flux below canopy per unit diffuse flx (HLMs use this for balance checks) + real(r8), allocatable :: ftii_parb(:,:) + + + ! Mass fluxes to BGC from fragmentation of litter into decomposing pools + + real(r8), allocatable :: litt_flux_cel_c_si(:) ! cellulose carbon litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lig_c_si(:) ! lignan carbon litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lab_c_si(:) ! labile carbon litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_cel_n_si(:) ! cellulose nitrogen litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lig_n_si(:) ! lignan nitrogen litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lab_n_si(:) ! labile nitrogen litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_cel_p_si(:) ! cellulose phosphorus litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lig_p_si(:) ! lignan phosphorus litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_lab_p_si(:) ! labile phosphorus litter, fates->BGC g/m3/s + + ! Canopy Structure + + real(r8), allocatable :: elai_pa(:) ! exposed leaf area index + real(r8), allocatable :: esai_pa(:) ! exposed stem area index + real(r8), allocatable :: tlai_pa(:) ! total leaf area index + real(r8), allocatable :: tsai_pa(:) ! total stem area index + real(r8), allocatable :: htop_pa(:) ! top of the canopy [m] + real(r8), allocatable :: hbot_pa(:) ! bottom of canopy? [m] + + real(r8), allocatable :: z0m_pa(:) ! roughness length [m] + real(r8), allocatable :: displa_pa(:) ! displacement height [m] + real(r8), allocatable :: dleaf_pa(:) ! leaf characteristic dimension/width/diameter [m] + + real(r8), allocatable :: canopy_fraction_pa(:) ! Area fraction of each patch in the site + ! Use most likely for weighting + ! This is currently the projected canopy + ! area of each patch [0-1] + + real(r8), allocatable :: frac_veg_nosno_alb_pa(:) ! This is not really a fraction + ! this is actually binary based on if any + ! vegetation in the patch is exposed. + ! [0,1] + + ! FATES Hydraulics + + + + real(r8) :: plant_stored_h2o_si ! stored water in LIVE+DEAD vegetation (kg/m2 H2O) + ! Assuming density of 1Mg/m3 ~= mm/m2 H2O + ! This must be set and transfered prior to clm_drv() + ! following the calls to ed_update_site() + ! ed_update_site() is called during both the restart + ! and coldstart process + + real(r8),allocatable :: qflx_soil2root_sisl(:) ! Water flux from soil into root by site and soil layer + ! [mm H2O/s] [+ into root] + + real(r8),allocatable :: qflx_ro_sisl(:) ! Water flux runoff generated by + ! root to soil flux super-saturating the soils + ! This does seem unlikely, but we need accomodate + ! small fluxes for various reasons + ! [mm H2O/s] + + + end type bc_out_type + + + type, public :: fates_interface_type + + ! This is the root of the ED/FATES hierarchy of instantaneous state variables + ! ie the root of the linked lists. Each path list is currently associated with a + ! grid-cell, this is intended to be migrated to columns + + integer :: nsites + + type(ed_site_type), pointer :: sites(:) + + ! These are boundary conditions that the FATES models are required to be filled. + ! These values are filled by the driver or HLM. Once filled, these have an + ! intent(in) status. Each site has a derived type structure, which may include + ! a scalar for site level data, a patch vector, potentially cohort vectors (but + ! not yet atm) and other dimensions such as soil-depth or pft. These vectors + ! are initialized by maximums, and the allocations are static in time to avoid + ! having to allocate/de-allocate memory + + type(bc_in_type), allocatable :: bc_in(:) + + ! These are the boundary conditions that the FATES model returns to its HLM or + ! driver. It has the same allocation strategy and similar vector types. + + type(bc_out_type), allocatable :: bc_out(:) + + contains + + procedure, public :: zero_bcs + + end type fates_interface_type + + + ! ==================================================================================== + + subroutine zero_bcs(this,s) + + implicit none + class(fates_interface_type), intent(inout) :: this + integer, intent(in) :: s + + ! Input boundaries + + this%bc_in(s)%t_veg24_si = 0.0_r8 + this%bc_in(s)%t_veg24_pa(:) = 0.0_r8 + this%bc_in(s)%precip24_pa(:) = 0.0_r8 + this%bc_in(s)%relhumid24_pa(:) = 0.0_r8 + this%bc_in(s)%wind24_pa(:) = 0.0_r8 + + this%bc_in(s)%solad_parb(:,:) = 0.0_r8 + this%bc_in(s)%solai_parb(:,:) = 0.0_r8 + this%bc_in(s)%smp_sl(:) = 0.0_r8 + this%bc_in(s)%eff_porosity_sl(:) = 0.0_r8 + this%bc_in(s)%watsat_sl(:) = 0.0_r8 + this%bc_in(s)%tempk_sl(:) = 0.0_r8 + this%bc_in(s)%h2o_liqvol_sl(:) = 0.0_r8 + this%bc_in(s)%filter_vegzen_pa(:) = .false. + this%bc_in(s)%coszen_pa(:) = 0.0_r8 + this%bc_in(s)%albgr_dir_rb(:) = 0.0_r8 + this%bc_in(s)%albgr_dif_rb(:) = 0.0_r8 + this%bc_in(s)%max_rooting_depth_index_col = 0 + this%bc_in(s)%tot_het_resp = 0.0_r8 + this%bc_in(s)%tot_somc = 0.0_r8 + this%bc_in(s)%tot_litc = 0.0_r8 + this%bc_in(s)%snow_depth_si = 0.0_r8 + this%bc_in(s)%frac_sno_eff_si = 0.0_r8 + + if(do_fates_salinity)then + this%bc_in(s)%salinity_sl(:) = 0.0_r8 + endif + + if (hlm_use_planthydro.eq.itrue) then + + this%bc_in(s)%qflx_transp_pa(:) = 0.0_r8 + this%bc_in(s)%swrad_net_pa(:) = 0.0_r8 + this%bc_in(s)%lwrad_net_pa(:) = 0.0_r8 + this%bc_in(s)%watsat_sisl(:) = 0.0_r8 + this%bc_in(s)%watres_sisl(:) = 0.0_r8 + this%bc_in(s)%sucsat_sisl(:) = 0.0_r8 + this%bc_in(s)%bsw_sisl(:) = 0.0_r8 + this%bc_in(s)%hksat_sisl(:) = 0.0_r8 + end if + + + ! Output boundaries + this%bc_out(s)%active_suction_sl(:) = .false. + this%bc_out(s)%fsun_pa(:) = 0.0_r8 + this%bc_out(s)%laisun_pa(:) = 0.0_r8 + this%bc_out(s)%laisha_pa(:) = 0.0_r8 + this%bc_out(s)%rootr_pasl(:,:) = 0.0_r8 + this%bc_out(s)%btran_pa(:) = 0.0_r8 + + ! Fates -> BGC fragmentation mass fluxes + select case(hlm_parteh_mode) + case(prt_carbon_allom_hyp) + this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 + case(prt_cnp_flex_allom_hyp) + this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 + this%bc_out(s)%litt_flux_cel_n_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_n_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_n_si(:) = 0._r8 + this%bc_out(s)%litt_flux_cel_p_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lig_p_si(:) = 0._r8 + this%bc_out(s)%litt_flux_lab_p_si(:) = 0._r8 + case default + write(fates_log(), *) 'An unknown parteh hypothesis was passed' + write(fates_log(), *) 'while zeroing output boundary conditions' + write(fates_log(), *) 'hlm_parteh_mode: ',hlm_parteh_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + + + this%bc_out(s)%rssun_pa(:) = 0.0_r8 + this%bc_out(s)%rssha_pa(:) = 0.0_r8 + + this%bc_out(s)%albd_parb(:,:) = 0.0_r8 + this%bc_out(s)%albi_parb(:,:) = 0.0_r8 + this%bc_out(s)%fabd_parb(:,:) = 0.0_r8 + this%bc_out(s)%fabi_parb(:,:) = 0.0_r8 + this%bc_out(s)%ftdd_parb(:,:) = 0.0_r8 + this%bc_out(s)%ftid_parb(:,:) = 0.0_r8 + this%bc_out(s)%ftii_parb(:,:) = 0.0_r8 + + this%bc_out(s)%elai_pa(:) = 0.0_r8 + this%bc_out(s)%esai_pa(:) = 0.0_r8 + this%bc_out(s)%tlai_pa(:) = 0.0_r8 + this%bc_out(s)%tsai_pa(:) = 0.0_r8 + this%bc_out(s)%htop_pa(:) = 0.0_r8 + this%bc_out(s)%hbot_pa(:) = 0.0_r8 + this%bc_out(s)%displa_pa(:) = 0.0_r8 + this%bc_out(s)%z0m_pa(:) = 0.0_r8 + this%bc_out(s)%dleaf_pa(:) = 0.0_r8 + + this%bc_out(s)%canopy_fraction_pa(:) = 0.0_r8 + this%bc_out(s)%frac_veg_nosno_alb_pa(:) = 0.0_r8 + + if (hlm_use_planthydro.eq.itrue) then + this%bc_out(s)%qflx_soil2root_sisl(:) = 0.0_r8 + this%bc_out(s)%qflx_ro_sisl(:) = 0.0_r8 + end if + this%bc_out(s)%plant_stored_h2o_si = 0.0_r8 + + return + end subroutine zero_bcs + + +end module FatesInterfaceTypesMod diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 830ee7d099..4df7c25e14 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -28,9 +28,9 @@ module FatesInventoryInitMod use FatesConstantsMod, only : itrue use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log - use FatesInterfaceMod, only : bc_in_type - use FatesInterfaceMod, only : hlm_inventory_ctrl_file - use FatesInterfaceMod, only : nleafage + use FatesInterfaceTypesMod, only : bc_in_type + use FatesInterfaceTypesMod, only : hlm_inventory_ctrl_file + use FatesInterfaceTypesMod, only : nleafage use FatesLitterMod , only : litter_type use EDTypesMod , only : ed_site_type use EDTypesMod , only : ed_patch_type @@ -45,7 +45,7 @@ module FatesInventoryInitMod use EDTypesMod , only : phen_dstat_timeoff use EDTypesMod , only : phen_dstat_moistoff use EDPftvarcon , only : EDPftvarcon_inst - use FatesInterfaceMod, only : hlm_parteh_mode + use FatesInterfaceTypesMod, only : hlm_parteh_mode use EDCohortDynamicsMod, only : InitPRTObject use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp @@ -862,7 +862,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & use FatesAllometryMod , only : bstore_allom use EDCohortDynamicsMod , only : create_cohort - use FatesInterfaceMod , only : numpft + use FatesInterfaceTypesMod , only : numpft ! Arguments type(ed_site_type),intent(inout), target :: csite ! current site diff --git a/main/FatesParameterDerivedMod.F90 b/main/FatesParameterDerivedMod.F90 index 36e528f939..66445c1906 100644 --- a/main/FatesParameterDerivedMod.F90 +++ b/main/FatesParameterDerivedMod.F90 @@ -12,7 +12,7 @@ module FatesParameterDerivedMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : umolC_to_kgC use FatesConstantsMod, only : g_per_kg - use FatesInterfaceMod, only : nleafage + use FatesInterfaceTypesMod, only : nleafage implicit none private diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 2929da121a..dbb790d2ca 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -14,11 +14,11 @@ module FatesRestartInterfaceMod use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : fates_io_variable_kind_type use FatesRestartVariableMod, only : fates_restart_variable_type - use FatesInterfaceMod, only : nlevcoage - use FatesInterfaceMod, only : bc_in_type - use FatesInterfaceMod, only : bc_out_type - use FatesInterfaceMod, only : hlm_use_planthydro - use FatesInterfaceMod, only : fates_maxElementsPerSite + use FatesInterfaceTypesMod, only : nlevcoage + use FatesInterfaceTypesMod, only : bc_in_type + use FatesInterfaceTypesMod, only : bc_out_type + use FatesInterfaceTypesMod, only : hlm_use_planthydro + use FatesInterfaceTypesMod, only : fates_maxElementsPerSite use EDCohortDynamicsMod, only : UpdateCohortBioPhysRates use FatesHydraulicsMemMod, only : nshell use FatesHydraulicsMemMod, only : n_hypool_ag @@ -31,7 +31,7 @@ module FatesRestartInterfaceMod use EDCohortDynamicsMod, only : InitPRTObject use EDCohortDynamicsMod, only : InitPRTBoundaryConditions use FatesPlantHydraulicsMod, only : InitHydrCohort - use FatesInterfaceMod, only : nlevsclass + use FatesInterfaceTypesMod, only : nlevsclass use FatesLitterMod, only : litter_type use FatesLitterMod, only : ncwd use FatesLitterMod, only : ndcmpy @@ -1353,7 +1353,7 @@ subroutine set_restart_var(this,vname,vtype,long_name,units,flushval, & hlms,initialize,ivar,index) use FatesUtilsMod, only : check_hlm_list - use FatesInterfaceMod, only : hlm_name + use FatesInterfaceTypesMod, only : hlm_name ! arguments class(fates_restart_interface_type) :: this @@ -1404,8 +1404,8 @@ end subroutine set_restart_var subroutine set_restart_vectors(this,nc,nsites,sites) - use FatesInterfaceMod, only : fates_maxElementsPerPatch - use FatesInterfaceMod, only : numpft + use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch + use FatesInterfaceTypesMod, only : numpft use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type @@ -1955,7 +1955,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type use EDTypesMod, only : maxSWb - use FatesInterfaceMod, only : fates_maxElementsPerPatch + use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch use EDTypesMod, only : maxpft use EDTypesMod, only : area @@ -2147,8 +2147,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : ed_cohort_type use EDTypesMod, only : ed_patch_type use EDTypesMod, only : maxSWb - use FatesInterfaceMod, only : numpft - use FatesInterfaceMod, only : fates_maxElementsPerPatch + use FatesInterfaceTypesMod, only : numpft + use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem use FatesSizeAgeTypeIndicesMod, only : get_age_class_index @@ -2679,7 +2679,7 @@ subroutine update_3dpatch_radiation(this, nsites, sites, bc_out) use EDTypesMod, only : ed_site_type use EDTypesMod, only : ed_patch_type use EDSurfaceRadiationMod, only : PatchNormanRadiation - use FatesInterfaceMod, only : hlm_numSWb + use FatesInterfaceTypesMod, only : hlm_numSWb ! !ARGUMENTS: class(fates_restart_interface_type) , intent(inout) :: this diff --git a/main/FatesSizeAgeTypeIndicesMod.F90 b/main/FatesSizeAgeTypeIndicesMod.F90 index 5683cc5302..2205fdc619 100644 --- a/main/FatesSizeAgeTypeIndicesMod.F90 +++ b/main/FatesSizeAgeTypeIndicesMod.F90 @@ -1,10 +1,10 @@ module FatesSizeAgeTypeIndicesMod use FatesConstantsMod, only : r8 => fates_r8 - use FatesInterfaceMod, only : nlevsclass - use FatesInterfaceMod, only : nlevage - use FatesInterfaceMod, only : nlevheight - use FatesInterfaceMod, only : nlevcoage + use FatesInterfaceTypesMod, only : nlevsclass + use FatesInterfaceTypesMod, only : nlevage + use FatesInterfaceTypesMod, only : nlevheight + use FatesInterfaceTypesMod, only : nlevcoage use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges use EDParamsMod, only : ED_val_history_height_bin_edges From 15c5b8ed0b16581277b59f3727bf5547000bd0d4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 7 May 2020 16:08:46 -0700 Subject: [PATCH 2/4] Interface refactors, includes fixing the age based cohort cap, reshuffling call to FatesGlobals() to be earlier so we have error messages working for initialization sequence --- biogeochem/EDCohortDynamicsMod.F90 | 8 +- biogeophys/FatesPlantHydraulicsMod.F90 | 210 +++++++++++++++++++++-- main/EDInitMod.F90 | 1 - main/EDTypesMod.F90 | 6 +- main/FatesHydraulicsMemMod.F90 | 177 ------------------- main/FatesInterfaceMod.F90 | 229 ++++++++++++++++++++----- main/FatesInterfaceTypesMod.F90 | 209 ++++++---------------- parteh/PRTLossFluxesMod.F90 | 16 +- 8 files changed, 448 insertions(+), 408 deletions(-) diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index f5659dca97..c88e83c1c6 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -985,7 +985,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) real(r8) :: leaf_c_target real(r8) :: dynamic_size_fusion_tolerance real(r8) :: dynamic_age_fusion_tolerance - integer :: maxCohortsPerPatch_age_tracking real(r8) :: dbh real(r8) :: leaf_c ! leaf carbon [kg] @@ -1004,11 +1003,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! set the cohort age fusion tolerance (in fraction of years) dynamic_age_fusion_tolerance = ED_val_cohort_age_fusion_tol - if ( hlm_use_cohort_age_tracking .eq. itrue) then - maxCohortsPerPatch_age_tracking = 300 - end if - - !This needs to be a function of the canopy layer, because otherwise, at canopy closure !the number of cohorts doubles and very dissimilar cohorts are fused together @@ -1434,7 +1428,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) if ( hlm_use_cohort_age_tracking .eq.itrue) then - if ( nocohorts > maxCohortsPerPatch_age_tracking ) then + if ( nocohorts > maxCohortsPerPatch ) then iterate = 1 !---------------------------------------------------------------------! ! Making profile tolerance larger means that more fusion will happen ! diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index ae73b6acb8..ca984d16da 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -90,14 +90,6 @@ module FatesPlantHydraulicsMod use FatesHydraulicsMemMod, only: recruit_water_avail_layer use FatesHydraulicsMemMod, only: rwccap, rwcft use FatesHydraulicsMemMod, only: ignore_layer1 - use FateshydraulicsMemMod, only: wrf_plant, wkf_plant - use FateshydraulicsMemMod, only: alpha_vg - use FateshydraulicsMemMod, only: th_sat_vg - use FateshydraulicsMemMod, only: th_res_vg - use FateshydraulicsMemMod, only: psd_vg - use FateshydraulicsMemMod, only: tort_vg -! use FateshydraulicsMemMod, only: - use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ @@ -183,7 +175,35 @@ module FatesPlantHydraulicsMod __FILE__ - + integer, public, parameter :: van_genuchten_type = 1 + integer, public, parameter :: campbell_type = 2 + integer, public, parameter :: tfs_type = 3 + + integer, parameter :: plant_wrf_type = tfs_type + integer, parameter :: plant_wkf_type = tfs_type + integer, parameter :: soil_wrf_type = campbell_type + integer, parameter :: soil_wkf_type = campbell_type + + + ! Define the global object that holds the water retention functions + ! for plants of each different porous media type, and plant functional type + + class(wrf_arr_type),pointer :: wrf_plant(:,:) + + ! Define the global object that holds the water conductance functions + ! for plants of each different porous media type, and plant functional type + + class(wkf_arr_type), pointer :: wkf_plant(:,:) + + ! Testing parameters for Van Genuchten soil WRTs + ! unused unless van_genuchten_type is selected, also + ! it would be much better to use the native parameters passed in + ! from the HLM's soil model + real(r8), parameter :: alpha_vg = 0.001_r8 + real(r8), parameter :: th_sat_vg = 0.65_r8 + real(r8), parameter :: th_res_vg = 0.15_r8 + real(r8), parameter :: psd_vg = 2.7_r8 + real(r8), parameter :: tort_vg = 0.5_r8 ! The maximum allowable water balance error over a plant-soil continuum ! for a given step [kgs] (0.1 mg) @@ -215,7 +235,7 @@ module FatesPlantHydraulicsMod public :: UpdatePlantHydrLenVol public :: UpdatePlantKmax public :: ConstrainRecruitNumber - + public :: InitHydroGlobals !------------------------------------------------------------------------------ ! 01/18/16: Created by Brad Christoffersen @@ -5174,4 +5194,174 @@ end subroutine SetMaxCondConnections ! ===================================================================================== + subroutine InitHydroGlobals() + + ! This routine allocates the Water Transfer Functions (WTFs) + ! which include both water retention functions (WRFs) + ! as well as the water conductance (K) functions (WKFs) + ! But, this is only for plants! These functions have specific + ! parameters, potentially, for each plant functional type and + ! each organ (pft x organ), but this can be used globally (across + ! all sites on the node (machine) to save memory. These functions + ! are also applied to soils, but since soil properties vary with + ! soil layer and location, those functions are bound to the site + ! structure, and are therefore not "global". + + ! Define + class(wrf_type_vg), pointer :: wrf_vg + class(wkf_type_vg), pointer :: wkf_vg + class(wrf_type_cch), pointer :: wrf_cch + class(wkf_type_tfs), pointer :: wkf_tfs + class(wrf_type_tfs), pointer :: wrf_tfs + + integer :: ft ! PFT index + integer :: pm ! plant media index + integer :: inode ! compartment node index + real(r8) :: cap_corr ! correction for nonzero psi0x (TFS) + real(r8) :: cap_slp ! slope of capillary region of curve + real(r8) :: cap_int ! intercept of capillary region of curve + + if(hlm_use_planthydro.eq.ifalse) return + + ! we allocate from stomata_p_media, which should be zero + + allocate(wrf_plant(stomata_p_media:n_plant_media,numpft)) + allocate(wkf_plant(stomata_p_media:n_plant_media,numpft)) + + ! ----------------------------------------------------------------------------------- + ! Initialize the Water Retention Functions + ! ----------------------------------------------------------------------------------- + + select case(plant_wrf_type) + case(van_genuchten_type) + do ft = 1,numpft + do pm = 1, n_plant_media + allocate(wrf_vg) + wrf_plant(pm,ft)%p => wrf_vg + call wrf_vg%set_wrf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg]) + end do + end do + case(campbell_type) + do ft = 1,numpft + do pm = 1,n_plant_media + allocate(wrf_cch) + wrf_plant(pm,ft)%p => wrf_cch + call wrf_cch%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & + EDPftvarcon_inst%hydr_pinot_node(ft,pm), & + 9._r8]) + end do + end do + case(tfs_type) + do ft = 1,numpft + do pm = 1,n_plant_media + allocate(wrf_tfs) + wrf_plant(pm,ft)%p => wrf_tfs + + if (pm.eq.leaf_p_media) then ! Leaf tissue + cap_slp = 0.0_r8 + cap_int = 0.0_r8 + cap_corr = 1.0_r8 + else ! Non leaf tissues + cap_slp = (hydr_psi0 - hydr_psicap )/(1.0_r8 - rwccap(pm)) + cap_int = -cap_slp + hydr_psi0 + cap_corr = -cap_int/cap_slp + end if + + call wrf_tfs%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & + EDPftvarcon_inst%hydr_resid_node(ft,pm), & + EDPftvarcon_inst%hydr_pinot_node(ft,pm), & + EDPftvarcon_inst%hydr_epsil_node(ft,pm), & + rwcft(pm), & + cap_corr, & + cap_int, & + cap_slp,real(pm,r8)]) + end do + end do + + end select + + ! ----------------------------------------------------------------------------------- + ! Initialize the Water Conductance (K) Functions + ! ----------------------------------------------------------------------------------- + + select case(plant_wkf_type) + case(van_genuchten_type) + do ft = 1,numpft + do pm = 1, n_plant_media + allocate(wkf_vg) + wkf_plant(pm,ft)%p => wkf_vg + call wkf_vg%set_wkf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg, tort_vg]) + end do + + end do + case(campbell_type) + write(fates_log(),*) 'campbell/clapp-hornberger conductance not used in plants' + call endrun(msg=errMsg(sourcefile, __LINE__)) + case(tfs_type) + do ft = 1,numpft + do pm = 1, n_plant_media + allocate(wkf_tfs) + wkf_plant(pm,ft)%p => wkf_tfs + call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_node(ft,pm), & + EDPftvarcon_inst%hydr_avuln_node(ft,pm)]) + end do + end do + end select + + ! There is only 1 stomata conductance hypothesis which uses the p50 and + ! vulnerability parameters + ! ----------------------------------------------------------------------------------- + + do ft = 1,numpft + allocate(wkf_tfs) + wkf_plant(stomata_p_media,ft)%p => wkf_tfs + call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_gs(ft), & + EDPftvarcon_inst%hydr_avuln_gs(ft)]) + end do + + + return + end subroutine InitHydroGlobals + + !! subroutine UpdateLWPMemFLCMin(ccohort_hydr) + + ! This code may be re-introduced at a later date (rgk 08-2019) + + ! SET COHORT-LEVEL BTRAN FOR USE IN NEXT TIMESTEP + ! first update the leaf water potential memory + !! do t=2, numLWPmem + !!ccohort_hydr%lwp_mem(t-1) = ccohort_hydr%lwp_mem(t) + !!end do + !!ccohort_hydr%lwp_mem(numLWPmem) = ccohort_hydr%psi_ag(1) + !!call flc_gs_from_psi(cCohort, ccohort_hydr%psi_ag(1)) + + !!refill_rate = -log(0.5)/(ccohort_hydr%refill_days*24._r8*3600._r8) ! s-1 + !!do k=1,n_hypool_ag + !!ccohort_hydr%flc_min_ag(k) = min(ccohort_hydr%flc_min_ag(k), ccohort_hydr%flc_ag(k)) + !!if(ccohort_hydr%psi_ag(k) >= ccohort_hydr%refill_thresh .and. & + !! ccohort_hydr%flc_ag(k) > ccohort_hydr%flc_min_ag(k)) then ! then refilling + !! ccohort_hydr%flc_min_ag(k) = ccohort_hydr%flc_ag(k) - & + !! (ccohort_hydr%flc_ag(k) - ccohort_hydr%flc_min_ag(k))*exp(-refill_rate*dtime) + !!end if + !!end do + !!do k=1,n_hypool_troot + !!ccohort_hydr%flc_min_troot(k) = min(ccohort_hydr%flc_min_troot(k), ccohort_hydr%flc_troot(k)) + !!if(ccohort_hydr%psi_troot(k) >= ccohort_hydr%refill_thresh .and. & + !! ccohort_hydr%flc_troot(k) > ccohort_hydr%flc_min_troot(k)) then ! then refilling + !! ccohort_hydr%flc_min_troot(k) = ccohort_hydr%flc_troot(k) - & + !! (ccohort_hydr%flc_troot(k) - ccohort_hydr%flc_min_troot(k))*exp(-refill_rate*dtime) + !!end if + !!end do + !!do j=1,site_hydr%nlevrhiz + !!ccohort_hydr%flc_min_aroot(j) = min(ccohort_hydr%flc_min_aroot(j), ccohort_hydr%flc_aroot(j)) + !!if(ccohort_hydr%psi_aroot(j) >= ccohort_hydr%refill_thresh .and. & + !! ccohort_hydr%flc_aroot(j) > ccohort_hydr%flc_min_aroot(j)) then ! then refilling + !! ccohort_hydr%flc_min_aroot(j) = ccohort_hydr%flc_aroot(j) - & + !! (ccohort_hydr%flc_aroot(j) - ccohort_hydr%flc_min_aroot(j))*exp(-refill_rate*dtime) + !!end if + !!end do + !!end subroutine UpdateLWPMemFLCMin + + + end module FatesPlantHydraulicsMod diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 1098e8eda5..0c77539815 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -85,7 +85,6 @@ module EDInitMod public :: init_site_vars public :: init_patches public :: set_site_properties - public :: InitFatesGlobals private :: init_cohorts diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 913c1a8ef5..5cb4480e4f 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -10,7 +10,7 @@ module EDTypesMod use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod, only : repro_organ, store_organ, struct_organ use PRTGenericMod, only : all_carbon_elements - use PRTGenericMod, only : num_organ_types + use PRTGenericMod, only : num_element_types use FatesLitterMod, only : litter_type use FatesLitterMod, only : ncwd use FatesConstantsMod, only : n_anthro_disturbance_categories @@ -23,7 +23,7 @@ module EDTypesMod integer, parameter, public :: maxPatchesPerSite = 14 ! maximum number of patches to live on a site integer, parameter, public :: maxPatchesPerSite_by_disttype(n_anthro_disturbance_categories) = & (/ 10, 4 /) !!! MUST SUM TO maxPatchesPerSite !!! - integer, parameter, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch + integer, public :: maxCohortsPerPatch = 100 ! maximum number of cohorts per patch integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy @@ -189,7 +189,7 @@ module EDTypesMod ! in PRTGenericMod.F90. examples are carbon12_element ! nitrogen_element, etc. - integer, public :: element_pos(num_organ_types) ! This is the reverse lookup + integer, public :: element_pos(num_element_types) ! This is the reverse lookup ! for element types. Pick an element ! global index, and it gives you ! the position in the element_list diff --git a/main/FatesHydraulicsMemMod.F90 b/main/FatesHydraulicsMemMod.F90 index 68793aeb1e..9d5c18bfa5 100644 --- a/main/FatesHydraulicsMemMod.F90 +++ b/main/FatesHydraulicsMemMod.F90 @@ -64,37 +64,6 @@ module FatesHydraulicsMemMod ! Should we ignore the first soil layer and have root layers start on the second? logical, parameter, public :: ignore_layer1=.true. - - integer, public, parameter :: van_genuchten_type = 1 - integer, public, parameter :: campbell_type = 2 - integer, public, parameter :: tfs_type = 3 - - integer, parameter :: plant_wrf_type = tfs_type - integer, parameter :: plant_wkf_type = tfs_type - integer, parameter :: soil_wrf_type = campbell_type - integer, parameter :: soil_wkf_type = campbell_type - - - ! Define the global object that holds the water retention functions - ! for plants of each different porous media type, and plant functional type - - class(wrf_arr_type),pointer :: wrf_plant(:,:) - - ! Define the global object that holds the water conductance functions - ! for plants of each different porous media type, and plant functional type - - class(wkf_arr_type), pointer :: wkf_plant(:,:) - - ! Testing parameters for Van Genuchten soil WRTs - ! unused unless van_genuchten_type is selected, also - ! it would be much better to use the native parameters passed in - ! from the HLM's soil model - real(r8), parameter :: alpha_vg = 0.001_r8 - real(r8), parameter :: th_sat_vg = 0.65_r8 - real(r8), parameter :: th_res_vg = 0.15_r8 - real(r8), parameter :: psd_vg = 2.7_r8 - real(r8), parameter :: tort_vg = 0.5_r8 - ! Derived parameters @@ -105,10 +74,6 @@ module FatesHydraulicsMemMod ! single individual at different layer (kg H2o/m2) real(r8), public :: recruit_water_avail_layer(nlevsoi_hyd_max) ! the recruit water avaibility from soil (kg H2o/m2) - - public :: InitHydroGlobals - - type, public :: ed_site_hydr_type ! Plant Hydraulics @@ -612,148 +577,6 @@ subroutine SetConnections(this) end if end subroutine SetConnections - - ! ==================================================================================== - - subroutine InitHydroGlobals(numpft) - - use FatesHydroWTFMod, only : wrf_arr_type - use FatesHydroWTFMod, only : wkf_arr_type - use FatesHydroWTFMod, only : wrf_type, wrf_type_vg, wrf_type_cch, wrf_type_tfs - use FatesHydroWTFMod, only : wkf_type, wkf_type_vg, wkf_type_cch, wkf_type_tfs - use EDPftvarcon, only : EDPftvarcon_inst - use EDParamsMod, only : hydr_psi0 - use EDParamsMod, only : hydr_psicap - - - ! This routine allocates the Water Transfer Functions (WTFs) - ! which include both water retention functions (WRFs) - ! as well as the water conductance (K) functions (WKFs) - ! But, this is only for plants! These functions have specific - ! parameters, potentially, for each plant functional type and - ! each organ (pft x organ), but this can be used globally (across - ! all sites on the node (machine) to save memory. These functions - ! are also applied to soils, but since soil properties vary with - ! soil layer and location, those functions are bound to the site - ! structure, and are therefore not "global". - - integer,intent(in) :: numpft - - ! Define - class(wrf_type_vg), pointer :: wrf_vg - class(wkf_type_vg), pointer :: wkf_vg - class(wrf_type_cch), pointer :: wrf_cch - class(wkf_type_tfs), pointer :: wkf_tfs - class(wrf_type_tfs), pointer :: wrf_tfs - - integer :: ft ! PFT index - integer :: pm ! plant media index - integer :: inode ! compartment node index - real(r8) :: cap_corr ! correction for nonzero psi0x (TFS) - real(r8) :: cap_slp ! slope of capillary region of curve - real(r8) :: cap_int ! intercept of capillary region of curve - - if(hlm_use_planthydro.eq.ifalse) return - ! we allocate from stomata_p_media, which should be zero - - allocate(wrf_plant(stomata_p_media:n_plant_media,numpft)) - allocate(wkf_plant(stomata_p_media:n_plant_media,numpft)) - - ! ----------------------------------------------------------------------------------- - ! Initialize the Water Retention Functions - ! ----------------------------------------------------------------------------------- - - select case(plant_wrf_type) - case(van_genuchten_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wrf_vg) - wrf_plant(pm,ft)%p => wrf_vg - call wrf_vg%set_wrf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg]) - end do - end do - case(campbell_type) - do ft = 1,numpft - do pm = 1,n_plant_media - allocate(wrf_cch) - wrf_plant(pm,ft)%p => wrf_cch - call wrf_cch%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & - EDPftvarcon_inst%hydr_pinot_node(ft,pm), & - 9._r8]) - end do - end do - case(tfs_type) - do ft = 1,numpft - do pm = 1,n_plant_media - allocate(wrf_tfs) - wrf_plant(pm,ft)%p => wrf_tfs - - if (pm.eq.leaf_p_media) then ! Leaf tissue - cap_slp = 0.0_r8 - cap_int = 0.0_r8 - cap_corr = 1.0_r8 - else ! Non leaf tissues - cap_slp = (hydr_psi0 - hydr_psicap )/(1.0_r8 - rwccap(pm)) - cap_int = -cap_slp + hydr_psi0 - cap_corr = -cap_int/cap_slp - end if - - call wrf_tfs%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & - EDPftvarcon_inst%hydr_resid_node(ft,pm), & - EDPftvarcon_inst%hydr_pinot_node(ft,pm), & - EDPftvarcon_inst%hydr_epsil_node(ft,pm), & - rwcft(pm), & - cap_corr, & - cap_int, & - cap_slp,real(pm,r8)]) - end do - end do - - end select - - ! ----------------------------------------------------------------------------------- - ! Initialize the Water Conductance (K) Functions - ! ----------------------------------------------------------------------------------- - - select case(plant_wkf_type) - case(van_genuchten_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wkf_vg) - wkf_plant(pm,ft)%p => wkf_vg - call wkf_vg%set_wkf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg, tort_vg]) - end do - - end do - case(campbell_type) - write(fates_log(),*) 'campbell/clapp-hornberger conductance not used in plants' - call endrun(msg=errMsg(sourcefile, __LINE__)) - case(tfs_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wkf_tfs) - wkf_plant(pm,ft)%p => wkf_tfs - call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_node(ft,pm), & - EDPftvarcon_inst%hydr_avuln_node(ft,pm)]) - end do - end do - end select - - ! There is only 1 stomata conductance hypothesis which uses the p50 and - ! vulnerability parameters - ! ----------------------------------------------------------------------------------- - - do ft = 1,numpft - allocate(wkf_tfs) - wkf_plant(stomata_p_media,ft)%p => wkf_tfs - call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_gs(ft), & - EDPftvarcon_inst%hydr_avuln_gs(ft)]) - end do - - - return - end subroutine InitHydroGlobals - end module FatesHydraulicsMemMod diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 207b0f09fe..41a7455520 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -9,58 +9,71 @@ module FatesInterfaceMod ! which is allocated by thread ! ------------------------------------------------------------------------------------ - use EDTypesMod , only : ed_site_type - use EDTypesMod , only : maxPatchesPerSite - use EDTypesMod , only : maxCohortsPerPatch - use EDTypesMod , only : maxSWb - use EDTypesMod , only : ivis - use EDTypesMod , only : inir - use EDTypesMod , only : nclmax - use EDTypesMod , only : nlevleaf - use EDTypesMod , only : maxpft - use EDTypesMod , only : do_fates_salinity - use EDTypesMod , only : numWaterMem - use EDTypesMod , only : numlevsoil_max - use EDTypesMod , only : num_elements - use EDTypesMod , only : element_list - use FatesConstantsMod , only : r8 => fates_r8 - use FatesConstantsMod , only : itrue,ifalse - use FatesGlobals , only : fates_global_verbose - use FatesGlobals , only : fates_log - use FatesGlobals , only : endrun => fates_endrun - use FatesLitterMod , only : ncwd - use FatesLitterMod , only : ndcmpy - use EDPftvarcon , only : FatesReportPFTParams - use EDPftvarcon , only : FatesCheckParams - use EDPftvarcon , only : EDPftvarcon_inst - use SFParamsMod , only : SpitFireCheckParams - use EDParamsMod , only : FatesReportParams - use EDParamsMod , only : bgc_soil_salinity - use PRTGenericMod , only : prt_carbon_allom_hyp - use PRTGenericMod , only : prt_cnp_flex_allom_hyp - use HydraulicsMemMod , only : InitHydroGlobals - use EDParamsMod, only : ED_val_history_sizeclass_bin_edges, ED_val_history_ageclass_bin_edges - use EDParamsMod, only : ED_val_history_height_bin_edges - use EDParamsMod, only : ED_val_history_coageclass_bin_edges - use CLMFatesParamInterfaceMod , only : FatesReadParameters + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : maxPatchesPerSite + use EDTypesMod , only : maxCohortsPerPatch + use EDTypesMod , only : maxSWb + use EDTypesMod , only : ivis + use EDTypesMod , only : inir + use EDTypesMod , only : nclmax + use EDTypesMod , only : nlevleaf + use EDTypesMod , only : maxpft + use EDTypesMod , only : do_fates_salinity + use EDTypesMod , only : numWaterMem + use EDTypesMod , only : numlevsoil_max + use EDTypesMod , only : num_elements + use EDTypesMod , only : element_list + use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : itrue,ifalse + use FatesGlobals , only : fates_global_verbose + use FatesGlobals , only : fates_log + use FatesGlobals , only : endrun => fates_endrun + use FatesLitterMod , only : ncwd + use FatesLitterMod , only : ndcmpy + use EDPftvarcon , only : FatesReportPFTParams + use EDPftvarcon , only : FatesCheckParams + use EDPftvarcon , only : EDPftvarcon_inst + use SFParamsMod , only : SpitFireCheckParams + use EDParamsMod , only : FatesReportParams + use EDParamsMod , only : bgc_soil_salinity + use PRTGenericMod , only : prt_carbon_allom_hyp + use PRTGenericMod , only : prt_cnp_flex_allom_hyp + use PRTGenericMod , only : carbon12_element + use PRTGenericMod , only : nitrogen_element + use PRTGenericMod , only : phosphorus_element + use EDTypesMod , only : element_pos, element_list + use FatesPlantHydraulicsMod , only : InitHydroGlobals + use EDParamsMod , only : ED_val_history_sizeclass_bin_edges + use EDParamsMod , only : ED_val_history_ageclass_bin_edges + use EDParamsMod , only : ED_val_history_height_bin_edges + use EDParamsMod , only : ED_val_history_coageclass_bin_edges + use CLMFatesParamInterfaceMod , only : FatesReadParameters + use PRTAllometricCarbonMod , only : InitPRTGlobalAllometricCarbon ! CIME Globals - use shr_log_mod , only : errMsg => shr_log_errMsg - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) ! Just use everything from FatesInterfaceTypesMod, this is ! its sister code use FatesInterfaceTypesMod + implicit none + + character(len=*), parameter :: sourcefile = & + __FILE__ + + ! Make public necessary subroutines and functions public :: FatesInterfaceInit public :: set_fates_ctrlparms public :: SetFatesTime - public :: set_fates_global_elements + public :: SetFatesGlobalElements public :: FatesReportParameters public :: allocate_bcin public :: allocate_bcout + public :: zero_bcs contains @@ -99,8 +112,123 @@ subroutine fates_clean(this) end subroutine fates_clean - ! ==================================================================================== - + ! ==================================================================================== + + subroutine zero_bcs(fates,s) + + type(fates_interface_type), intent(inout) :: fates + integer, intent(in) :: s + + ! Input boundaries + + fates%bc_in(s)%t_veg24_si = 0.0_r8 + fates%bc_in(s)%t_veg24_pa(:) = 0.0_r8 + fates%bc_in(s)%precip24_pa(:) = 0.0_r8 + fates%bc_in(s)%relhumid24_pa(:) = 0.0_r8 + fates%bc_in(s)%wind24_pa(:) = 0.0_r8 + + fates%bc_in(s)%solad_parb(:,:) = 0.0_r8 + fates%bc_in(s)%solai_parb(:,:) = 0.0_r8 + fates%bc_in(s)%smp_sl(:) = 0.0_r8 + fates%bc_in(s)%eff_porosity_sl(:) = 0.0_r8 + fates%bc_in(s)%watsat_sl(:) = 0.0_r8 + fates%bc_in(s)%tempk_sl(:) = 0.0_r8 + fates%bc_in(s)%h2o_liqvol_sl(:) = 0.0_r8 + fates%bc_in(s)%filter_vegzen_pa(:) = .false. + fates%bc_in(s)%coszen_pa(:) = 0.0_r8 + fates%bc_in(s)%albgr_dir_rb(:) = 0.0_r8 + fates%bc_in(s)%albgr_dif_rb(:) = 0.0_r8 + fates%bc_in(s)%max_rooting_depth_index_col = 0 + fates%bc_in(s)%tot_het_resp = 0.0_r8 + fates%bc_in(s)%tot_somc = 0.0_r8 + fates%bc_in(s)%tot_litc = 0.0_r8 + fates%bc_in(s)%snow_depth_si = 0.0_r8 + fates%bc_in(s)%frac_sno_eff_si = 0.0_r8 + + if(do_fates_salinity)then + fates%bc_in(s)%salinity_sl(:) = 0.0_r8 + endif + + if (hlm_use_planthydro.eq.itrue) then + + fates%bc_in(s)%qflx_transp_pa(:) = 0.0_r8 + fates%bc_in(s)%swrad_net_pa(:) = 0.0_r8 + fates%bc_in(s)%lwrad_net_pa(:) = 0.0_r8 + fates%bc_in(s)%watsat_sisl(:) = 0.0_r8 + fates%bc_in(s)%watres_sisl(:) = 0.0_r8 + fates%bc_in(s)%sucsat_sisl(:) = 0.0_r8 + fates%bc_in(s)%bsw_sisl(:) = 0.0_r8 + fates%bc_in(s)%hksat_sisl(:) = 0.0_r8 + end if + + + ! Output boundaries + fates%bc_out(s)%active_suction_sl(:) = .false. + fates%bc_out(s)%fsun_pa(:) = 0.0_r8 + fates%bc_out(s)%laisun_pa(:) = 0.0_r8 + fates%bc_out(s)%laisha_pa(:) = 0.0_r8 + fates%bc_out(s)%rootr_pasl(:,:) = 0.0_r8 + fates%bc_out(s)%btran_pa(:) = 0.0_r8 + + ! Fates -> BGC fragmentation mass fluxes + select case(hlm_parteh_mode) + case(prt_carbon_allom_hyp) + fates%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 + case(prt_cnp_flex_allom_hyp) + fates%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_cel_n_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lig_n_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lab_n_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_cel_p_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lig_p_si(:) = 0._r8 + fates%bc_out(s)%litt_flux_lab_p_si(:) = 0._r8 + case default + write(fates_log(), *) 'An unknown parteh hypothesis was passed' + write(fates_log(), *) 'while zeroing output boundary conditions' + write(fates_log(), *) 'hlm_parteh_mode: ',hlm_parteh_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + + + fates%bc_out(s)%rssun_pa(:) = 0.0_r8 + fates%bc_out(s)%rssha_pa(:) = 0.0_r8 + + fates%bc_out(s)%albd_parb(:,:) = 0.0_r8 + fates%bc_out(s)%albi_parb(:,:) = 0.0_r8 + fates%bc_out(s)%fabd_parb(:,:) = 0.0_r8 + fates%bc_out(s)%fabi_parb(:,:) = 0.0_r8 + fates%bc_out(s)%ftdd_parb(:,:) = 0.0_r8 + fates%bc_out(s)%ftid_parb(:,:) = 0.0_r8 + fates%bc_out(s)%ftii_parb(:,:) = 0.0_r8 + + fates%bc_out(s)%elai_pa(:) = 0.0_r8 + fates%bc_out(s)%esai_pa(:) = 0.0_r8 + fates%bc_out(s)%tlai_pa(:) = 0.0_r8 + fates%bc_out(s)%tsai_pa(:) = 0.0_r8 + fates%bc_out(s)%htop_pa(:) = 0.0_r8 + fates%bc_out(s)%hbot_pa(:) = 0.0_r8 + fates%bc_out(s)%displa_pa(:) = 0.0_r8 + fates%bc_out(s)%z0m_pa(:) = 0.0_r8 + fates%bc_out(s)%dleaf_pa(:) = 0.0_r8 + + fates%bc_out(s)%canopy_fraction_pa(:) = 0.0_r8 + fates%bc_out(s)%frac_veg_nosno_alb_pa(:) = 0.0_r8 + + if (hlm_use_planthydro.eq.itrue) then + fates%bc_out(s)%qflx_soil2root_sisl(:) = 0.0_r8 + fates%bc_out(s)%qflx_ro_sisl(:) = 0.0_r8 + end if + fates%bc_out(s)%plant_stored_h2o_si = 0.0_r8 + + return + end subroutine zero_bcs + + ! =========================================================================== subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in) @@ -344,7 +472,7 @@ end subroutine set_bcs ! =================================================================================== - subroutine set_fates_global_elements(use_fates) + subroutine SetFatesGlobalElements(use_fates) ! -------------------------------------------------------------------------------- ! @@ -366,11 +494,10 @@ subroutine set_fates_global_elements(use_fates) implicit none logical,intent(in) :: use_fates ! Is fates turned on? - integer :: i if (use_fates) then - + ! first read the non-PFT parameters call FatesReadParameters() @@ -386,7 +513,7 @@ subroutine set_fates_global_elements(use_fates) write(fates_log(), *) 'it was found that the lower bound was neither 0 or 1?' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + if(numpft>maxpft) then write(fates_log(), *) 'The number of PFTs dictated by the FATES parameter file' write(fates_log(), *) 'is larger than the maximum allowed. Increase the FATES parameter constant' @@ -404,6 +531,18 @@ subroutine set_fates_global_elements(use_fates) else nleafage = size(EDPftvarcon_inst%leaf_long,dim=2) end if + + ! These values are used to define the restart file allocations and general structure + ! of memory for the cohort arrays + + if ( hlm_use_cohort_age_tracking .eq. itrue) then + maxCohortsPerPatch = 300 + else + maxCohortsPerPatch = 100 + end if + + fates_maxElementsPerPatch = max(maxCohortsPerPatch, ndcmpy*numlevsoil_max ,ncwd*numlevsoil_max) + ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays @@ -469,7 +608,7 @@ subroutine set_fates_global_elements(use_fates) ! (like water retention functions) ! this needs to know the number of PFTs, which is ! determined in that call - call InitHydroGlobals(numpft) + call InitHydroGlobals() ! Initialize the Plant Allocation and Reactive Transport ! global functions and mapping tables @@ -498,7 +637,7 @@ subroutine set_fates_global_elements(use_fates) end if - end subroutine set_fates_global_elements + end subroutine SetFatesGlobalElements ! ====================================================================== diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index a7bd57ea70..ff9a33d08a 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1,4 +1,14 @@ module FatesInterfaceTypesMod + + use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : itrue,ifalse + use FatesGlobals , only : fates_global_verbose + use FatesGlobals , only : fates_log + use FatesGlobals , only : endrun => fates_endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use EDTypesMod , only : ed_site_type + implicit none private ! By default everything is private @@ -12,26 +22,26 @@ module FatesInterfaceTypesMod ! ------------------------------------------------------------------------------------- - integer, public, protected :: hlm_numSWb ! Number of broad-bands in the short-wave radiation + integer, public :: hlm_numSWb ! Number of broad-bands in the short-wave radiation ! specturm to track ! (typically 2 as a default, VIS/NIR, in ED variants <2016) - integer, public, protected :: hlm_ivis ! The HLMs assumption of the array index associated with the + integer, public :: hlm_ivis ! The HLMs assumption of the array index associated with the ! visible portion of the spectrum in short-wave radiation arrays - integer, public, protected :: hlm_inir ! The HLMs assumption of the array index associated with the + integer, public :: hlm_inir ! The HLMs assumption of the array index associated with the ! NIR portion of the spectrum in short-wave radiation arrays - integer, public, protected :: hlm_numlevgrnd ! Number of ground layers + integer, public :: hlm_numlevgrnd ! Number of ground layers ! NOTE! SOIL LAYERS ARE NOT A GLOBAL, THEY ! ARE VARIABLE BY SITE - integer, public, protected :: hlm_is_restart ! Is the HLM signalling that this is a restart + integer, public :: hlm_is_restart ! Is the HLM signalling that this is a restart ! type simulation? ! 1=TRUE, 0=FALSE - character(len=16), public, protected :: hlm_name ! This character string passed by the HLM + character(len=16), public :: hlm_name ! This character string passed by the HLM ! is used during the processing of IO data, ! so that FATES knows which IO variables it ! should prepare. For instance @@ -40,24 +50,24 @@ module FatesInterfaceTypesMod ! This string sets which filter is enacted. - real(r8), public, protected :: hlm_hio_ignore_val ! This value can be flushed to history + real(r8), public :: hlm_hio_ignore_val ! This value can be flushed to history ! diagnostics, such that the ! HLM will interpret that the value should not ! be included in the average. - integer, public, protected :: hlm_masterproc ! Is this the master processor, typically useful + integer, public :: hlm_masterproc ! Is this the master processor, typically useful ! for knowing if the current machine should be ! printing out messages to the logs or terminals ! 1 = TRUE (is master) 0 = FALSE (is not master) - integer, public, protected :: hlm_ipedof ! The HLM pedotransfer index + integer, public :: hlm_ipedof ! The HLM pedotransfer index ! this is only used by the plant hydraulics ! submodule to check and/or enable consistency ! between the pedotransfer functions of the HLM ! and how it moves and stores water in its ! rhizosphere shells - integer, public, protected :: hlm_max_patch_per_site ! The HLM needs to exchange some patch + integer, public :: hlm_max_patch_per_site ! The HLM needs to exchange some patch ! level quantities with FATES ! FATES does not dictate those allocations ! since it happens pretty early in @@ -66,31 +76,31 @@ module FatesInterfaceTypesMod ! compare it to our maxpatchpersite, ! and gracefully halt if we are over-allocating - integer, public, protected :: hlm_parteh_mode ! This flag signals which Plant Allocation and Reactive + integer, public :: hlm_parteh_mode ! This flag signals which Plant Allocation and Reactive ! Transport (exensible) Hypothesis (PARTEH) to use - integer, public, protected :: hlm_use_vertsoilc ! This flag signals whether or not the + integer, public :: hlm_use_vertsoilc ! This flag signals whether or not the ! host model is using vertically discretized ! soil carbon ! 1 = TRUE, 0 = FALSE - integer, public, protected :: hlm_use_spitfire ! This flag signals whether or not to use SPITFIRE + integer, public :: hlm_use_spitfire ! This flag signals whether or not to use SPITFIRE ! 1 = TRUE, 0 = FALSE - integer, public, protected :: hlm_use_logging ! This flag signals whether or not to use + integer, public :: hlm_use_logging ! This flag signals whether or not to use ! the logging module - integer, public, protected :: hlm_use_planthydro ! This flag signals whether or not to use + integer, public :: hlm_use_planthydro ! This flag signals whether or not to use ! plant hydraulics (bchristo/xu methods) ! 1 = TRUE, 0 = FALSE ! THIS IS CURRENTLY NOT SUPPORTED - integer, public, protected :: hlm_use_cohort_age_tracking ! This flag signals whether or not to use + integer, public :: hlm_use_cohort_age_tracking ! This flag signals whether or not to use ! cohort age tracking. 1 = TRUE, 0 = FALSE - integer, public, protected :: hlm_use_ed_st3 ! This flag signals whether or not to use + integer, public :: hlm_use_ed_st3 ! This flag signals whether or not to use ! (ST)atic (ST)and (ST)ructure mode (ST3) ! Essentially, this gives us the ability ! to turn off "dynamics", ie growth, disturbance @@ -100,7 +110,7 @@ module FatesInterfaceTypesMod ! default should be FALSE (dynamics on) ! cannot be true with prescribed_phys - integer, public, protected :: hlm_use_ed_prescribed_phys ! This flag signals whether or not to use + integer, public :: hlm_use_ed_prescribed_phys ! This flag signals whether or not to use ! prescribed physiology, somewhat the opposite ! to ST3, in this case can turn off ! fast processes like photosynthesis and respiration @@ -110,13 +120,13 @@ module FatesInterfaceTypesMod ! default should be FALSE (biophysics on) ! cannot be true with st3 mode - integer, public, protected :: hlm_use_inventory_init ! Initialize this simulation from + integer, public :: hlm_use_inventory_init ! Initialize this simulation from ! an inventory file. If this is toggled on ! an inventory control file must be specified ! as well. ! 1 = TRUE, 0 = FALSE - character(len=256), public, protected :: hlm_inventory_ctrl_file ! This is the full path to the + character(len=256), public :: hlm_inventory_ctrl_file ! This is the full path to the ! inventory control file that ! specifieds the availabel inventory datasets ! there locations and their formats @@ -130,7 +140,7 @@ module FatesInterfaceTypesMod ! Variables mostly used for dimensioning host land model (HLM) array spaces - integer, public, protected :: fates_maxElementsPerPatch ! maxElementsPerPatch is the value that is ultimately + integer, public :: fates_maxElementsPerPatch ! maxElementsPerPatch is the value that is ultimately ! used to set the size of the largest arrays necessary ! in things like restart files (probably hosted by the ! HLM). The size of these arrays are not a parameter @@ -139,7 +149,7 @@ module FatesInterfaceTypesMod ! maximum number of cohorts per patch, but ! but it could be other things. - integer, public, protected :: fates_maxElementsPerSite ! This is the max number of individual items one can store per + integer, public :: fates_maxElementsPerSite ! This is the max number of individual items one can store per ! each grid cell and effects the striding in the ED restart ! data as some fields are arrays where each array is ! associated with one cohort @@ -198,17 +208,17 @@ module FatesInterfaceTypesMod ! It is assumed that all of the sites on a given machine will be synchronous. ! It is also assumed that the HLM will control time. ! ------------------------------------------------------------------------------------- - integer, public, protected :: hlm_current_year ! Current year - integer, public, protected :: hlm_current_month ! month of year - integer, public, protected :: hlm_current_day ! day of month - integer, public, protected :: hlm_current_tod ! time of day (seconds past 0Z) - integer, public, protected :: hlm_current_date ! time of day (seconds past 0Z) - integer, public, protected :: hlm_reference_date ! YYYYMMDD - real(r8), public, protected :: hlm_model_day ! elapsed days between current date and ref - integer, public, protected :: hlm_day_of_year ! The integer day of the year - integer, public, protected :: hlm_days_per_year ! The HLM controls time, some HLMs may + integer, public :: hlm_current_year ! Current year + integer, public :: hlm_current_month ! month of year + integer, public :: hlm_current_day ! day of month + integer, public :: hlm_current_tod ! time of day (seconds past 0Z) + integer, public :: hlm_current_date ! time of day (seconds past 0Z) + integer, public :: hlm_reference_date ! YYYYMMDD + real(r8), public :: hlm_model_day ! elapsed days between current date and ref + integer, public :: hlm_day_of_year ! The integer day of the year + integer, public :: hlm_days_per_year ! The HLM controls time, some HLMs may ! include a leap - real(r8), public, protected :: hlm_freq_day ! fraction of year for daily time-step + real(r8), public :: hlm_freq_day ! fraction of year for daily time-step ! (1/days_per_year_, this is a frequency @@ -218,12 +228,12 @@ module FatesInterfaceTypesMod ! ! ------------------------------------------------------------------------------------- - integer, public, protected :: numpft ! The total number of PFTs defined in the simulation - integer, public, protected :: nlevsclass ! The total number of cohort size class bins output to history - integer, public, protected :: nlevage ! The total number of patch age bins output to history - integer, public, protected :: nlevheight ! The total number of height bins output to history - integer, public, protected :: nlevcoage ! The total number of cohort age bins output to history - integer, public, protected :: nleafage ! The total number of leaf age classes + integer, public :: numpft ! The total number of PFTs defined in the simulation + integer, public :: nlevsclass ! The total number of cohort size class bins output to history + integer, public :: nlevage ! The total number of patch age bins output to history + integer, public :: nlevheight ! The total number of height bins output to history + integer, public :: nlevcoage ! The total number of cohort age bins output to history + integer, public :: nleafage ! The total number of leaf age classes ! ------------------------------------------------------------------------------------- ! Structured Boundary Conditions (SITE/PATCH SCALE) @@ -570,129 +580,14 @@ module FatesInterfaceTypesMod type(bc_out_type), allocatable :: bc_out(:) - contains - - procedure, public :: zero_bcs end type fates_interface_type + contains + ! ==================================================================================== - subroutine zero_bcs(this,s) - - implicit none - class(fates_interface_type), intent(inout) :: this - integer, intent(in) :: s - - ! Input boundaries - - this%bc_in(s)%t_veg24_si = 0.0_r8 - this%bc_in(s)%t_veg24_pa(:) = 0.0_r8 - this%bc_in(s)%precip24_pa(:) = 0.0_r8 - this%bc_in(s)%relhumid24_pa(:) = 0.0_r8 - this%bc_in(s)%wind24_pa(:) = 0.0_r8 - - this%bc_in(s)%solad_parb(:,:) = 0.0_r8 - this%bc_in(s)%solai_parb(:,:) = 0.0_r8 - this%bc_in(s)%smp_sl(:) = 0.0_r8 - this%bc_in(s)%eff_porosity_sl(:) = 0.0_r8 - this%bc_in(s)%watsat_sl(:) = 0.0_r8 - this%bc_in(s)%tempk_sl(:) = 0.0_r8 - this%bc_in(s)%h2o_liqvol_sl(:) = 0.0_r8 - this%bc_in(s)%filter_vegzen_pa(:) = .false. - this%bc_in(s)%coszen_pa(:) = 0.0_r8 - this%bc_in(s)%albgr_dir_rb(:) = 0.0_r8 - this%bc_in(s)%albgr_dif_rb(:) = 0.0_r8 - this%bc_in(s)%max_rooting_depth_index_col = 0 - this%bc_in(s)%tot_het_resp = 0.0_r8 - this%bc_in(s)%tot_somc = 0.0_r8 - this%bc_in(s)%tot_litc = 0.0_r8 - this%bc_in(s)%snow_depth_si = 0.0_r8 - this%bc_in(s)%frac_sno_eff_si = 0.0_r8 - - if(do_fates_salinity)then - this%bc_in(s)%salinity_sl(:) = 0.0_r8 - endif - - if (hlm_use_planthydro.eq.itrue) then - - this%bc_in(s)%qflx_transp_pa(:) = 0.0_r8 - this%bc_in(s)%swrad_net_pa(:) = 0.0_r8 - this%bc_in(s)%lwrad_net_pa(:) = 0.0_r8 - this%bc_in(s)%watsat_sisl(:) = 0.0_r8 - this%bc_in(s)%watres_sisl(:) = 0.0_r8 - this%bc_in(s)%sucsat_sisl(:) = 0.0_r8 - this%bc_in(s)%bsw_sisl(:) = 0.0_r8 - this%bc_in(s)%hksat_sisl(:) = 0.0_r8 - end if - - - ! Output boundaries - this%bc_out(s)%active_suction_sl(:) = .false. - this%bc_out(s)%fsun_pa(:) = 0.0_r8 - this%bc_out(s)%laisun_pa(:) = 0.0_r8 - this%bc_out(s)%laisha_pa(:) = 0.0_r8 - this%bc_out(s)%rootr_pasl(:,:) = 0.0_r8 - this%bc_out(s)%btran_pa(:) = 0.0_r8 - - ! Fates -> BGC fragmentation mass fluxes - select case(hlm_parteh_mode) - case(prt_carbon_allom_hyp) - this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 - case(prt_cnp_flex_allom_hyp) - this%bc_out(s)%litt_flux_cel_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 - this%bc_out(s)%litt_flux_cel_n_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_n_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_n_si(:) = 0._r8 - this%bc_out(s)%litt_flux_cel_p_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lig_p_si(:) = 0._r8 - this%bc_out(s)%litt_flux_lab_p_si(:) = 0._r8 - case default - write(fates_log(), *) 'An unknown parteh hypothesis was passed' - write(fates_log(), *) 'while zeroing output boundary conditions' - write(fates_log(), *) 'hlm_parteh_mode: ',hlm_parteh_mode - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - - - this%bc_out(s)%rssun_pa(:) = 0.0_r8 - this%bc_out(s)%rssha_pa(:) = 0.0_r8 - - this%bc_out(s)%albd_parb(:,:) = 0.0_r8 - this%bc_out(s)%albi_parb(:,:) = 0.0_r8 - this%bc_out(s)%fabd_parb(:,:) = 0.0_r8 - this%bc_out(s)%fabi_parb(:,:) = 0.0_r8 - this%bc_out(s)%ftdd_parb(:,:) = 0.0_r8 - this%bc_out(s)%ftid_parb(:,:) = 0.0_r8 - this%bc_out(s)%ftii_parb(:,:) = 0.0_r8 - - this%bc_out(s)%elai_pa(:) = 0.0_r8 - this%bc_out(s)%esai_pa(:) = 0.0_r8 - this%bc_out(s)%tlai_pa(:) = 0.0_r8 - this%bc_out(s)%tsai_pa(:) = 0.0_r8 - this%bc_out(s)%htop_pa(:) = 0.0_r8 - this%bc_out(s)%hbot_pa(:) = 0.0_r8 - this%bc_out(s)%displa_pa(:) = 0.0_r8 - this%bc_out(s)%z0m_pa(:) = 0.0_r8 - this%bc_out(s)%dleaf_pa(:) = 0.0_r8 - - this%bc_out(s)%canopy_fraction_pa(:) = 0.0_r8 - this%bc_out(s)%frac_veg_nosno_alb_pa(:) = 0.0_r8 - - if (hlm_use_planthydro.eq.itrue) then - this%bc_out(s)%qflx_soil2root_sisl(:) = 0.0_r8 - this%bc_out(s)%qflx_ro_sisl(:) = 0.0_r8 - end if - this%bc_out(s)%plant_stored_h2o_si = 0.0_r8 - - return - end subroutine zero_bcs - -end module FatesInterfaceTypesMod + + end module FatesInterfaceTypesMod diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index a805d58a96..4e59a4354d 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -18,8 +18,8 @@ module PRTLossFluxesMod use PRTGenericMod, only : check_initialized use PRTGenericMod, only : num_organ_types use PRTGenericMod, only : prt_global - use FatesInterfaceMod, only : hlm_freq_day - + use FatesConstantsMOd, only : years_per_day + use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : i4 => fates_int use FatesConstantsMod, only : nearzero @@ -651,9 +651,9 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) ! ----------------------------------------------------------------------------------- if ( EDPftvarcon_inst%branch_turnover(ipft) > nearzero ) then - base_turnover(sapw_organ) = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) - base_turnover(struct_organ) = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) - base_turnover(store_organ) = hlm_freq_day / EDPftvarcon_inst%branch_turnover(ipft) + base_turnover(sapw_organ) = years_per_day / EDPftvarcon_inst%branch_turnover(ipft) + base_turnover(struct_organ) = years_per_day / EDPftvarcon_inst%branch_turnover(ipft) + base_turnover(store_organ) = years_per_day / EDPftvarcon_inst%branch_turnover(ipft) else base_turnover(sapw_organ) = 0.0_r8 base_turnover(struct_organ) = 0.0_r8 @@ -664,7 +664,7 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) ! life-span is selected ! --------------------------------------------------------------------------------- if ( EDPftvarcon_inst%root_long(ipft) > nearzero ) then - base_turnover(fnrt_organ) = hlm_freq_day / EDPftvarcon_inst%root_long(ipft) + base_turnover(fnrt_organ) = years_per_day / EDPftvarcon_inst%root_long(ipft) else base_turnover(fnrt_organ) = 0.0_r8 end if @@ -681,11 +681,11 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) (EDPftvarcon_inst%evergreen(ipft) == itrue) ) then if(is_drought) then - base_turnover(leaf_organ) = hlm_freq_day / & + base_turnover(leaf_organ) = years_per_day / & (EDPftvarcon_inst%leaf_long(ipft,aclass_sen_id) * & EDPftvarcon_inst%senleaf_long_fdrought(ipft) ) else - base_turnover(leaf_organ) = hlm_freq_day / & + base_turnover(leaf_organ) = years_per_day / & EDPftvarcon_inst%leaf_long(ipft,aclass_sen_id) end if else From 3bba389bea71f10873fce95d29be4c02df239bec Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 8 May 2020 12:51:35 -0600 Subject: [PATCH 3/4] made FatesInterfaceMod private again. Removed redundant calculation of max elements --- main/FatesInterfaceMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0eb4f864f6..32b36a9ec1 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -61,6 +61,8 @@ module FatesInterfaceMod implicit none + private + character(len=*), parameter :: sourcefile = & __FILE__ @@ -539,9 +541,6 @@ subroutine SetFatesGlobalElements(use_fates) else maxCohortsPerPatch = 100 end if - - fates_maxElementsPerPatch = max(maxCohortsPerPatch, ndcmpy*numlevsoil_max ,ncwd*numlevsoil_max) - ! These values are used to define the restart file allocations and general structure ! of memory for the cohort arrays From 5b7bd67843942ffa436eae209f14bdd958858031 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 11 May 2020 13:47:09 -0600 Subject: [PATCH 4/4] Syntax updates per Gregs review --- main/EDInitMod.F90 | 3 --- parteh/PRTLossFluxesMod.F90 | 3 +-- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 0c77539815..ea342f0e68 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -66,9 +66,6 @@ module EDInitMod use PRTGenericMod, only : nitrogen_element use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : SetState -!! use FatesPlantHydraulicsMod, only : InitHydroGlobals - use PRTAllometricCarbonMod, only : InitPRTGlobalAllometricCarbon -! use PRTAllometricCNPMod, only : InitPRTGlobalAllometricCNP ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 4e59a4354d..49125304f3 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -18,8 +18,7 @@ module PRTLossFluxesMod use PRTGenericMod, only : check_initialized use PRTGenericMod, only : num_organ_types use PRTGenericMod, only : prt_global - use FatesConstantsMOd, only : years_per_day - + use FatesConstantsMod, only : years_per_day use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : i4 => fates_int use FatesConstantsMod, only : nearzero