diff --git a/biogeochem/DamageMainMod.F90 b/biogeochem/DamageMainMod.F90 index f0a05f7ee6..11de5d1799 100644 --- a/biogeochem/DamageMainMod.F90 +++ b/biogeochem/DamageMainMod.F90 @@ -11,10 +11,6 @@ module DamageMainMod use EDPftvarcon , only : EDPftvarcon_inst use EDParamsMod , only : damage_event_code use EDParamsMod , only : ED_val_history_damage_bin_edges - use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type - use EDTypesMod , only : AREA use FatesInterfaceTypesMod, only : hlm_current_day use FatesInterfaceTypesMod, only : hlm_current_month use FatesInterfaceTypesMod, only : hlm_current_year @@ -54,7 +50,7 @@ module DamageMainMod - subroutine IsItDamageTime(is_master, currentSite) + subroutine IsItDamageTime(is_master) !---------------------------------------------------------------------------- ! This subroutine determines whether damage should occur (it is called daily) @@ -63,7 +59,7 @@ subroutine IsItDamageTime(is_master, currentSite) integer, intent(in) :: is_master - type(ed_site_type), intent(inout), target :: currentSite + !type(ed_site_type), intent(inout), target :: currentSite integer :: icode ! Integer equivalent of the event code (parameter file only allows reals) integer :: damage_date ! Day of month for damage extracted from event code diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 31d36c5e60..90aa71cb0f 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -15,14 +15,15 @@ module EDCanopyStructureMod use EDPftvarcon , only : EDPftvarcon_inst use PRTParametersMod , only : prt_params use FatesAllometryMod , only : carea_allom - use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, terminate_cohort, fuse_cohorts + use EDCohortDynamicsMod , only : terminate_cohorts, terminate_cohort, fuse_cohorts use EDCohortDynamicsMod , only : InitPRTObject - use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use FatesAllometryMod , only : tree_lai use FatesAllometryMod , only : tree_sai - use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : nclmax - use EDTypesMod , only : nlevleaf + use EDtypesMod , only : ed_site_type + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod, only : fates_cohort_type + use EDParamsMod , only : nclmax + use EDParamsMod , only : nlevleaf use EDtypesMod , only : AREA use EDLoggingMortalityMod , only : UpdateHarvestC use FatesGlobals , only : endrun => fates_endrun @@ -136,8 +137,8 @@ subroutine canopy_structure( currentSite , bc_in ) ! ! !LOCAL VARIABLES: - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort integer :: i_lyr ! current layer index integer :: z ! Current number of canopy layers. (1= canopy, 2 = understorey) integer :: ipft @@ -337,18 +338,17 @@ end subroutine canopy_structure subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) use EDParamsMod, only : ED_val_comp_excln - use SFParamsMod, only : SF_val_CWD_frac ! !ARGUMENTS type(ed_site_type), intent(inout) :: currentSite - type(ed_patch_type), intent(inout) :: currentPatch + type(fates_patch_type), intent(inout) :: currentPatch integer, intent(in) :: i_lyr ! Current canopy layer of interest type(bc_in_type), intent(in) :: bc_in ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort - type(ed_cohort_type), pointer :: copyc - type(ed_cohort_type), pointer :: nextc ! The next cohort in line + type(fates_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: copyc + type(fates_cohort_type), pointer :: nextc ! The next cohort in line integer :: i_cwd ! Index for CWD pool real(r8) :: cc_loss ! cohort crown area loss in demotion (m2) real(r8) :: leaf_c ! leaf carbon [kg] @@ -670,7 +670,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) !allocate(copyc%tveg_lpa) !!allocate(copyc%l2fr_ema) ! Note, no need to give a starter value here, - ! that will be taken care of in copy_cohort() + ! that will be taken care of in copy() !!call copyc%l2fr_ema%InitRMean(ema_60day) ! Initialize the PARTEH object and point to the @@ -682,8 +682,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) call InitHydrCohort(currentSite,copyc) endif - call copy_cohort(currentCohort, copyc) - call InitPRTBoundaryConditions(copyc) + call currentCohort%Copy(copyc) + call copyc%InitPRTBoundaryConditions() newarea = currentCohort%c_area - cc_loss copyc%n = currentCohort%n*newarea/currentCohort%c_area @@ -797,13 +797,13 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), intent(inout), target :: currentPatch + type(fates_patch_type), intent(inout), target :: currentPatch integer, intent(in) :: i_lyr ! Current canopy layer of interest ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort - type(ed_cohort_type), pointer :: copyc - type(ed_cohort_type), pointer :: nextc ! the next cohort, or used for looping + type(fates_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: copyc + type(fates_cohort_type), pointer :: nextc ! the next cohort, or used for looping ! cohorts against the current real(r8) :: scale_factor ! for prob. exclusion - scales weight to a fraction @@ -1138,7 +1138,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) !!allocate(copyc%l2fr_ema) ! Note, no need to give a starter value here, - ! that will be taken care of in copy_cohort() + ! that will be taken care of in copy() !!call copyc%l2fr_ema%InitRMean(ema_60day) ! Initialize the PARTEH object and point to the @@ -1157,8 +1157,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr) !call copyc%tveg_lpa%InitRMean(ema_lpa,& ! init_value=currentPatch%tveg_lpa%GetMean()) - call copy_cohort(currentCohort, copyc) !makes an identical copy... - call InitPRTBoundaryConditions(copyc) + call currentCohort%Copy(copyc) !makes an identical copy... + call copyc%InitPRTBoundaryConditions() newarea = currentCohort%c_area - cc_gain !new area of existing cohort @@ -1243,8 +1243,8 @@ subroutine canopy_spread( currentSite ) type (ed_site_type), intent(inout), target :: currentSite ! ! !LOCAL VARIABLES: - type (ed_cohort_type), pointer :: currentCohort - type (ed_patch_type) , pointer :: currentPatch + type (fates_cohort_type), pointer :: currentCohort + type (fates_patch_type) , pointer :: currentPatch real(r8) :: sitelevel_canopyarea ! Amount of canopy in top layer at the site level real(r8) :: inc ! Arbitrary daily incremental change in canopy area integer :: z @@ -1308,8 +1308,8 @@ subroutine canopy_summarization( nsites, sites, bc_in ) type(bc_in_type) , intent(in) :: bc_in(nsites) ! ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type) , pointer :: currentCohort + type (fates_patch_type) , pointer :: currentPatch + type (fates_cohort_type) , pointer :: currentCohort integer :: s integer :: ft ! plant functional type integer :: ifp ! the number of the vegetated patch (1,2,3). In SP mode bareground patch is 0 @@ -1499,7 +1499,8 @@ subroutine leaf_area_profile( currentSite ) ! !USES: - use EDtypesMod , only : area, dinc_vai, dlower_vai, hitemax, n_hite_bins + use EDtypesMod , only : area, hitemax, n_hite_bins + use EDParamsMod, only : dinc_vai, dlower_vai ! ! !ARGUMENTS @@ -1508,8 +1509,8 @@ subroutine leaf_area_profile( currentSite ) ! ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type) , pointer :: currentCohort + type (fates_patch_type) , pointer :: currentPatch + type (fates_cohort_type) , pointer :: currentCohort real(r8) :: remainder !Thickness of layer at bottom of canopy. real(r8) :: fleaf ! fraction of cohort incepting area that is leaves. integer :: ft ! Plant functional type index. @@ -1801,8 +1802,8 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) ! to vegetation coverage to the host land model. ! ---------------------------------------------------------------------------------- - use EDTypesMod , only : ed_patch_type, ed_cohort_type, & - ed_site_type, AREA + use EDTypesMod , only : ed_site_type, AREA + use FatesPatchMod, only : fates_patch_type use FatesInterfaceTypesMod , only : bc_out_type ! @@ -1813,9 +1814,9 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) type(bc_out_type), intent(inout) :: bc_out(nsites) ! Locals - type (ed_cohort_type) , pointer :: currentCohort + type (fates_cohort_type) , pointer :: currentCohort integer :: s, ifp, c, p - type (ed_patch_type) , pointer :: currentPatch + type (fates_patch_type) , pointer :: currentPatch real(r8) :: bare_frac_area real(r8) :: total_patch_area real(r8) :: total_canopy_area @@ -2031,7 +2032,7 @@ function calc_areaindex(cpatch,ai_type) result(ai) ! ---------------------------------------------------------------------------------- ! Arguments - type(ed_patch_type),intent(in), target :: cpatch + type(fates_patch_type),intent(in), target :: cpatch character(len=*),intent(in) :: ai_type integer :: cl,ft @@ -2095,12 +2096,12 @@ subroutine CanopyLayerArea(currentPatch,site_spread,layer_index,layer_area) ! --------------------------------------------------------------------------------------------- ! Arguments - type(ed_patch_type),intent(inout), target :: currentPatch + type(fates_patch_type),intent(inout), target :: currentPatch real(r8),intent(in) :: site_spread integer,intent(in) :: layer_index real(r8),intent(inout) :: layer_area - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort layer_area = 0.0_r8 @@ -2125,14 +2126,11 @@ subroutine UpdatePatchLAI(currentPatch) ! and related variables ! --------------------------------------------------------------------------------------------- - ! Uses - use EDtypesMod, only : dlower_vai - ! Arguments - type(ed_patch_type),intent(inout), target :: currentPatch + type(fates_patch_type),intent(inout), target :: currentPatch ! Local Variables - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort integer :: cl ! Canopy layer index integer :: ft ! Plant functional type index @@ -2175,10 +2173,10 @@ subroutine UpdateCohortLAI(currentCohort, canopy_layer_tlai, total_canopy_area) ! Update LAI and related variables for a given cohort ! Uses - use EDtypesMod, only : dlower_vai + use EDParamsMod, only : dlower_vai ! Arguments - type(ed_cohort_type),intent(inout), target :: currentCohort + type(fates_cohort_type),intent(inout), target :: currentCohort real(r8), intent(in) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer real(r8), intent(in) :: total_canopy_area ! either patch%total_canopy_area or patch%area @@ -2220,11 +2218,11 @@ function NumPotentialCanopyLayers(currentPatch,site_spread,include_substory) res ! the understory in the event the understory has reached maximum allowable area. ! -------------------------------------------------------------------------------------------- - type(ed_patch_type),target :: currentPatch + type(fates_patch_type),target :: currentPatch real(r8),intent(in) :: site_spread logical :: include_substory - type(ed_cohort_type),pointer :: currentCohort + type(fates_cohort_type),pointer :: currentCohort integer :: z real(r8) :: c_area diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index b45ad0e257..c4bfabdcf7 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1,9 +1,10 @@ Module EDCohortDynamicsMod ! - ! !DESCRIPTION: - ! Cohort stuctures in ED. + ! DESCRIPTION: + ! Cohort stuctures in FATES ! - ! !USES: + + ! USES: use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use FatesInterfaceTypesMod , only : hlm_freq_day @@ -26,8 +27,10 @@ Module EDCohortDynamicsMod use EDPftvarcon , only : GetDecompyFrac use PRTParametersMod , only : prt_params use FatesParameterDerivedMod, only : param_derived - use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : nclmax + use EDTypesMod , only : ed_site_type + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type + use EDParamsMod , only : nclmax use PRTGenericMod , only : element_list use PRTGenericMod , only : StorageNutrientTarget use FatesLitterMod , only : ncwd @@ -38,21 +41,20 @@ Module EDCohortDynamicsMod use EDTypesMod , only : AREA use EDTypesMod , only : min_npm2, min_nppatch use EDTypesMod , only : min_n_safemath - use EDTypesMod , only : nlevleaf + use EDParamsMod , only : nlevleaf use PRTGenericMod , only : max_nleafage - use EDTypesMod , only : ican_upper + use FatesConstantsMod , only : ican_upper use EDTypesMod , only : site_fluxdiags_type use PRTGenericMod , only : num_elements - use EDTypesMod , only : leaves_on - use EDTypesMod , only : leaves_off - use EDTypesMod , only : leaves_shedding - use EDTypesMod , only : ihard_stress_decid - use EDTypesMod , only : isemi_stress_decid + use FatesConstantsMod , only : leaves_on + use FatesConstantsMod , only : leaves_off + use FatesConstantsMod , only : leaves_shedding + use FatesConstantsMod , only : ihard_stress_decid + use FatesConstantsMod , only : isemi_stress_decid use EDParamsMod , only : ED_val_cohort_age_fusion_tol use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_parteh_mode use FatesPlantHydraulicsMod, only : FuseCohortHydraulics - use FatesPlantHydraulicsMod, only : CopyCohortHydraulics use FatesPlantHydraulicsMod, only : UpdateSizeDepPlantHydProps use FatesPlantHydraulicsMod, only : InitPlantHydStates use FatesPlantHydraulicsMod, only : InitHydrCohort @@ -90,7 +92,6 @@ Module EDCohortDynamicsMod use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ use PRTGenericMod, only : SetState - use PRTAllometricCarbonMod, only : callom_prt_vartypes use PRTAllometricCarbonMod, only : ac_bc_inout_id_netdc use PRTAllometricCarbonMod, only : ac_bc_in_id_pft @@ -128,20 +129,14 @@ Module EDCohortDynamicsMod private ! public :: create_cohort - public :: zero_cohort - public :: nan_cohort public :: terminate_cohorts public :: terminate_cohort public :: fuse_cohorts public :: insert_cohort public :: sort_cohorts - public :: copy_cohort public :: count_cohorts public :: InitPRTObject - public :: InitPRTBoundaryConditions public :: SendCohortToLitter - public :: UpdateCohortBioPhysRates - public :: DeallocateCohort public :: EvaluateAndCorrectDBH public :: DamageRecovery @@ -162,333 +157,138 @@ Module EDCohortDynamicsMod contains !-------------------------------------------------------------------------------------! - subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & - prt, elongf_leaf, elongf_fnrt, elongf_stem, status, & - recruitstatus,ctrim, carea, clayer, crowndamage, spread, bc_in) - ! - ! !DESCRIPTION: - ! create new cohort - ! There are 4 places this is called - ! 1) Initializing new cohorts at the beginning of a cold-start simulation - ! 2) Initializing new recruits during dynamics - ! 3) Initializing new cohorts at the beginning of a inventory read - ! 4) Initializing new cohorts during restart - ! - ! It is assumed that in the first 3, this is called with a reasonable amount of starter information. - ! - ! !USES: - ! - ! !ARGUMENTS - - type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), intent(inout), pointer :: patchptr - - integer, intent(in) :: pft ! Cohort Plant Functional Type - integer, intent(in) :: crowndamage ! Cohort damage class - integer, intent(in) :: clayer ! canopy status of cohort - ! (1 = canopy, 2 = understorey, etc.) - integer, intent(in) :: status ! growth status of plant - ! (2 = leaves on , 1 = leaves off) - integer, intent(in) :: recruitstatus ! recruit status of plant - ! (1 = recruitment , 0 = other) - real(r8), intent(in) :: nn ! number of individuals in cohort - ! per 'area' (10000m2 default) - real(r8), intent(in) :: hite ! height: meters - real(r8), intent(in) :: coage ! cohort age in years - real(r8), intent(in) :: dbh ! dbh: cm - real(r8), intent(in) :: elongf_leaf ! leaf elongation factor (fraction) - real(r8), intent(in) :: elongf_fnrt ! fine-root "elongation factor" (fraction) - real(r8), intent(in) :: elongf_stem ! stem "elongation factor" (fraction) - ! For all elongation factors: - ! 0 means fully abscissed - ! 1 means fully flushed - class(prt_vartypes),intent(inout), pointer :: prt ! The allocated PARTEH - !class(prt_vartypes),target :: prt ! The allocated PARTEH - ! object - real(r8), intent(in) :: ctrim ! What is the fraction of the maximum - ! leaf biomass that we are targeting? - real(r8), intent(in) :: spread ! The community assembly effects how - ! spread crowns are in horizontal space - real(r8), intent(in) :: carea ! area of cohort ONLY USED IN SP MODE. - type(bc_in_type), intent(in) :: bc_in ! External boundary conditions - - - ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: new_cohort ! Pointer to New Cohort structure. - type(ed_cohort_type), pointer :: storesmallcohort - type(ed_cohort_type), pointer :: storebigcohort - integer :: iage ! loop counter for leaf age classes - real(r8) :: leaf_c ! total leaf carbon - integer :: tnull,snull ! are the tallest and shortest cohorts allocate - integer :: nlevrhiz ! number of rhizosphere layers - - !---------------------------------------------------------------------- - - allocate(new_cohort) - - call nan_cohort(new_cohort) ! Make everything in the cohort not-a-number - call zero_cohort(new_cohort) ! Zero things that need to be zeroed. - - ! Point to the PARTEH object - new_cohort%prt => prt - - ! The PARTEH cohort object should be allocated and already - ! initialized in this routine. - call new_cohort%prt%CheckInitialConditions() - - !**********************/ - ! Define cohort state variable - !**********************/ - - new_cohort%indexnumber = fates_unset_int ! Cohort indexing was not thread-safe, setting - ! bogus value for the time being (RGK-012017) - - new_cohort%patchptr => patchptr - - new_cohort%pft = pft - new_cohort%crowndamage = crowndamage - new_cohort%status_coh = status - new_cohort%efleaf_coh = elongf_leaf - new_cohort%effnrt_coh = elongf_fnrt - new_cohort%efstem_coh = elongf_stem - new_cohort%n = nn - new_cohort%hite = hite - new_cohort%dbh = dbh - new_cohort%coage = coage - new_cohort%canopy_trim = ctrim - new_cohort%canopy_layer = clayer - new_cohort%canopy_layer_yesterday = real(clayer, r8) - - ! Initialize the leaf to fineroot biomass ratio - ! for C-only, this will stay constant, for nutrient enabled - ! this will be dynamic. In both cases, new cohorts are - ! initialized with the minimum. This works in the nutrient - ! enabled case, because cohorts are also initialized with - ! full stores, which match with minimum fr biomass - - new_cohort%l2fr = prt_params%allom_l2fr(pft) - - if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - new_cohort%cx_int = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 - new_cohort%cx0 = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 - new_cohort%ema_dcxdt = 0._r8 ! Assume unchanged dCX/dt - new_cohort%cnp_limiter = 0 ! Assume limitations are unknown - end if - - ! This sets things like vcmax25top, that depend on the - ! leaf age fractions (which are defined by PARTEH) - call UpdateCohortBioPhysRates(new_cohort) - - call sizetype_class_index(new_cohort%dbh, new_cohort%pft, & - new_cohort%size_class,new_cohort%size_by_pft_class) - - ! If cohort age trackign is off we call this here once - ! just so everythin is in the first bin - - ! this makes it easier to copy and terminate cohorts later - ! we don't need to update this ever if cohort age tracking is off - call coagetype_class_index(new_cohort%coage, new_cohort%pft, & - new_cohort%coage_class,new_cohort%coage_by_pft_class) - - ! This routine may be called during restarts, and at this point in the call sequence - ! the actual cohort data is unknown, as this is really only used for allocation - ! In these cases, testing if things like biomass are reasonable is pre-mature - ! However, in this part of the code, we will pass in nominal values for size, number and type - - if (new_cohort%dbh <= 0._r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 ) then - write(fates_log(),*) 'ED: something is zero in create_cohort', & - new_cohort%dbh,new_cohort%n, & - new_cohort%pft - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - - ! Assign canopy extent and depth - if(hlm_use_sp.eq.ifalse)then - call carea_allom(new_cohort%dbh,new_cohort%n,spread,new_cohort%pft, & - new_cohort%crowndamage,new_cohort%c_area) - else - new_cohort%c_area = carea ! set this from previously precision-controlled value in SP mode - endif - ! Query PARTEH for the leaf carbon [kg] - leaf_c = new_cohort%prt%GetState(leaf_organ,carbon12_element) - - new_cohort%treelai = tree_lai(leaf_c, new_cohort%pft, new_cohort%c_area, & - new_cohort%n, new_cohort%canopy_layer, & - patchptr%canopy_layer_tlai,new_cohort%vcmax25top ) - - if(hlm_use_sp.eq.ifalse)then - new_cohort%treesai = tree_sai(new_cohort%pft, new_cohort%dbh, & - new_cohort%crowndamage, new_cohort%canopy_trim, new_cohort%efstem_coh, & - new_cohort%c_area, new_cohort%n, new_cohort%canopy_layer, & - patchptr%canopy_layer_tlai, new_cohort%treelai,new_cohort%vcmax25top,2 ) - end if - - - ! Put cohort at the right place in the linked list - storebigcohort => patchptr%tallest - storesmallcohort => patchptr%shortest - - if (associated(patchptr%tallest)) then - tnull = 0 - else - tnull = 1 - patchptr%tallest => new_cohort - endif - - if (associated(patchptr%shortest)) then - snull = 0 - else - snull = 1 - patchptr%shortest => new_cohort - endif - - ! Allocate running mean functions - - ! (Keeping as an example) - !! allocate(new_cohort%tveg_lpa) - !! call new_cohort%tveg_lpa%InitRMean(ema_lpa,init_value=patchptr%tveg_lpa%GetMean()) - - call InitPRTBoundaryConditions(new_cohort) - - - ! Recuits do not have mortality rates, nor have they moved any - ! carbon when they are created. They will bias our statistics - ! until they have experienced a full day. We need a newly recruited flag. - ! This flag will be set to false after it has experienced - ! growth, disturbance and mortality. - new_cohort%isnew = .true. - - if( hlm_use_planthydro.eq.itrue ) then - - nlevrhiz = currentSite%si_hydr%nlevrhiz - - ! This allocates array spaces - call InitHydrCohort(currentSite,new_cohort) - - ! zero out the water balance error - new_cohort%co_hydr%errh2o = 0._r8 - - ! This calculates node heights - call UpdatePlantHydrNodes(new_cohort,new_cohort%pft, & - new_cohort%hite,currentSite%si_hydr) - - ! This calculates volumes and lengths - call UpdatePlantHydrLenVol(new_cohort,currentSite%si_hydr) +subroutine create_cohort(currentSite, patchptr, pft, nn, hite, coage, dbh, & + prt, elongf_leaf, elongf_fnrt, elongf_stem, status, recruitstatus, ctrim, & + carea, clayer, crowndamage, spread, bc_in) + +! +! DESCRIPTION: +! create new cohort +! There are 4 places this is called +! 1) Initializing new cohorts at the beginning of a cold-start simulation +! 2) Initializing new recruits during dynamics +! 3) Initializing new cohorts at the beginning of a inventory read +! 4) Initializing new cohorts during restart +! +! It is assumed that in the first 3, this is called with a reasonable amount of starter information. +! + +! ARGUMENTS: +type(ed_site_type), intent(inout), target :: currentSite ! site object +type(fates_patch_type), intent(inout), pointer :: patchptr ! pointer to patch object +integer, intent(in) :: pft ! cohort Plant Functional Type +integer, intent(in) :: crowndamage ! cohort damage class +integer, intent(in) :: clayer ! canopy status of cohort [1=canopy; 2=understorey] +integer, intent(in) :: status ! growth status of plant [1=leaves off; 2=leaves on] +integer, intent(in) :: recruitstatus ! recruit status of plant [1 = recruitment , 0 = other] +real(r8), intent(in) :: nn ! number of individuals in cohort [/m2] +real(r8), intent(in) :: hite ! cohort height [m] +real(r8), intent(in) :: coage ! cohort age [m] +real(r8), intent(in) :: dbh ! cohort diameter at breast height [cm] +real(r8), intent(in) :: elongf_leaf ! leaf elongation factor [fraction] - 0: fully abscissed; 1: fully flushed +real(r8), intent(in) :: elongf_fnrt ! fine-root "elongation factor" [fraction] +real(r8), intent(in) :: elongf_stem ! stem "elongation factor" [fraction] +class(prt_vartypes), intent(inout), pointer :: prt ! allocated PARTEH object +real(r8), intent(in) :: ctrim ! fraction of the maximum leaf biomass we are targeting +real(r8), intent(in) :: spread ! how spread crowns are in horizontal space +real(r8), intent(in) :: carea ! area of cohort - ONLY USED IN SP MODE [m2] +type(bc_in_type), intent(in) :: bc_in ! external boundary conditions + +! LOCAL VARIABLES: +type(fates_cohort_type), pointer :: newCohort ! pointer to New Cohort structure. +type(fates_cohort_type), pointer :: storesmallcohort +type(fates_cohort_type), pointer :: storebigcohort +real(r8) :: rmean_temp ! running mean temperature +integer :: tnull, snull ! are the tallest and shortest cohorts allocate +integer :: nlevrhiz ! number of rhizosphere layers + +!---------------------------------------------------------------------- + +! create new cohort +allocate(newCohort) +call newCohort%Create(prt, pft, nn, hite, coage, dbh, status, ctrim, carea, & + clayer, crowndamage, spread, patchptr%canopy_layer_tlai, elongf_leaf, elongf_fnrt, & + elongf_stem) + + +! Put cohort at the right place in the linked list +storebigcohort => patchptr%tallest +storesmallcohort => patchptr%shortest + +if (associated(patchptr%tallest)) then + tnull = 0 +else + tnull = 1 + patchptr%tallest => newCohort +endif + +if (associated(patchptr%shortest)) then + snull = 0 +else + snull = 1 + patchptr%shortest => newCohort +endif + +! Allocate running mean functions + +! (Keeping as an example) +!! allocate(newCohort%tveg_lpa) +!! call newCohort%tveg_lpa%InitRMean(ema_lpa,init_value=patchptr%tveg_lpa%GetMean()) + +if (hlm_use_planthydro .eq. itrue) then + + nlevrhiz = currentSite%si_hydr%nlevrhiz + + ! This allocates array spaces + call InitHydrCohort(currentSite, newCohort) + + ! zero out the water balance error + newCohort%co_hydr%errh2o = 0._r8 + + ! This calculates node heights + call UpdatePlantHydrNodes(newCohort, newCohort%pft, & + newCohort%hite,currentSite%si_hydr) + + ! This calculates volumes and lengths + call UpdatePlantHydrLenVol(newCohort,currentSite%si_hydr) + + ! This updates the Kmax's of the plant's compartments + call UpdatePlantKmax(newCohort%co_hydr,newCohort,currentSite%si_hydr) + + ! Since this is a newly initialized plant, we set the previous compartment-size + ! equal to the ones we just calculated. + call SavePreviousCompartmentVolumes(newCohort%co_hydr) + + ! This comes up with starter suctions and then water contents + ! based on the soil values + call InitPlantHydStates(currentSite,newCohort) + + if(recruitstatus==1)then + + newCohort%co_hydr%is_newly_recruited = .true. + + ! If plant hydraulics is active, we must constrain the + ! number density of the new recruits based on the moisture + ! available to be subsumed in the new plant tissues. + ! So we go through the process of pre-initializing the hydraulic + ! states in the temporary cohort, to calculate this new number density + rmean_temp = patchptr%tveg24%GetMean() + call ConstrainRecruitNumber(currentSite, newCohort, patchptr, & + bc_in, rmean_temp) - ! This updates the Kmax's of the plant's compartments - call UpdatePlantKmax(new_cohort%co_hydr,new_cohort,currentSite%si_hydr) - - ! Since this is a newly initialized plant, we set the previous compartment-size - ! equal to the ones we just calculated. - call SavePreviousCompartmentVolumes(new_cohort%co_hydr) - - ! This comes up with starter suctions and then water contents - ! based on the soil values - call InitPlantHydStates(currentSite,new_cohort) - - if(recruitstatus==1)then - - new_cohort%co_hydr%is_newly_recruited = .true. - - ! If plant hydraulics is active, we must constrain the - ! number density of the new recruits based on the moisture - ! available to be subsumed in the new plant tissues. - ! So we go through the process of pre-initializing the hydraulic - ! states in the temporary cohort, to calculate this new number density - - call ConstrainRecruitNumber(currentSite,new_cohort, bc_in) - - endif - - endif - - call insert_cohort(new_cohort, patchptr%tallest, patchptr%shortest, tnull, snull, & - storebigcohort, storesmallcohort) - - patchptr%tallest => storebigcohort - patchptr%shortest => storesmallcohort - - end subroutine create_cohort - - ! ------------------------------------------------------------------------------------- - - subroutine InitPRTBoundaryConditions(new_cohort) - - ! Set the boundary conditions that flow in an out of the PARTEH - ! allocation hypotheses. Each of these calls to "RegsterBC" are simply - ! setting pointers. - ! For instance, if the hypothesis wants to know what - ! the DBH of the plant is, then we pass in the dbh as an argument (new_cohort%dbh), - ! and also tell it which boundary condition we are talking about (which is - ! defined by an integer index (ac_bc_inout_id_dbh) - ! - ! Again, elaborated Example: - ! "ac_bc_inout_id_dbh" is the unique integer that defines the object index - ! for the allometric carbon "ac" boundary condition "bc" for DBH "dbh" - ! that is classified as input and output "inout". - ! See PRTAllometricCarbonMod.F90 to track its usage. - ! bc_rval is used as the optional argument identifyer to specify a real - ! value boundary condition. - ! bc_ival is used as the optional argument identifyer to specify an integer - ! value boundary condition. - - type(ed_cohort_type), intent(inout), target :: new_cohort - - select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp) - - ! Register boundary conditions for the Carbon Only Allometric Hypothesis - - call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_dbh,bc_rval = new_cohort%dbh) - call new_cohort%prt%RegisterBCInOut(ac_bc_inout_id_netdc,bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_cdamage,bc_ival = new_cohort%crowndamage) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_pft,bc_ival = new_cohort%pft) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_lstat,bc_ival = new_cohort%status_coh) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_efleaf,bc_rval = new_cohort%efleaf_coh) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_effnrt,bc_rval = new_cohort%effnrt_coh) - call new_cohort%prt%RegisterBCIn(ac_bc_in_id_efstem,bc_rval = new_cohort%efstem_coh) - - case (prt_cnp_flex_allom_hyp) - - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pft,bc_ival = new_cohort%pft) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_lstat,bc_ival = new_cohort%status_coh) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_efleaf,bc_rval = new_cohort%efleaf_coh) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_effnrt,bc_rval = new_cohort%effnrt_coh) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_efstem,bc_rval = new_cohort%efstem_coh) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval = new_cohort%npp_acc) - - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_nc_repro,bc_rval = new_cohort%nc_repro) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_pc_repro,bc_rval = new_cohort%pc_repro) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_cdamage,bc_ival = new_cohort%crowndamage) - - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess,bc_rval = new_cohort%resp_excess) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr,bc_rval = new_cohort%l2fr) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_cx_int,bc_rval = new_cohort%cx_int) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_emadcxdt,bc_rval = new_cohort%ema_dcxdt) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_cx0,bc_rval = new_cohort%cx0) - - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval = new_cohort%daily_n_gain) - call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval = new_cohort%daily_p_gain) - - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval = new_cohort%daily_n_efflux) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pefflux, bc_rval = new_cohort%daily_p_efflux) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_limiter, bc_ival = new_cohort%cnp_limiter) - - case DEFAULT + endif - write(fates_log(),*) 'You specified an unknown PRT module' - write(fates_log(),*) 'Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) +endif - end select +call insert_cohort(patchptr, newCohort, patchptr%tallest, patchptr%shortest, tnull, snull, & + storebigcohort, storesmallcohort) +patchptr%tallest => storebigcohort +patchptr%shortest => storesmallcohort - end subroutine InitPRTBoundaryConditions +end subroutine create_cohort - ! ------------------------------------------------------------------------------------! +! ------------------------------------------------------------------------------------! subroutine InitPRTObject(prt) @@ -544,229 +344,6 @@ end subroutine InitPRTObject !-------------------------------------------------------------------------------------! - subroutine nan_cohort(cc_p) - ! - ! !DESCRIPTION: - ! Make all the cohort variables NaN so they aren't used before defined. - ! - ! !USES: - - use FatesConstantsMod, only : fates_unset_int - - ! - ! !ARGUMENTS - type (ed_cohort_type), intent(inout), target :: cc_p - ! - ! !LOCAL VARIABLES: - type (ed_cohort_type) , pointer :: currentCohort - !---------------------------------------------------------------------- - - currentCohort => cc_p - - currentCohort%taller => null() ! pointer to next tallest cohort - currentCohort%shorter => null() ! pointer to next shorter cohort - currentCohort%patchptr => null() ! pointer to patch that cohort is in - - nullify(currentCohort%taller) - nullify(currentCohort%shorter) - nullify(currentCohort%patchptr) - - ! VEGETATION STRUCTURE - currentCohort%pft = fates_unset_int ! pft number - currentCohort%crowndamage = fates_unset_int ! Crown damage class - currentCohort%indexnumber = fates_unset_int ! unique number for each cohort. (within clump?) - currentCohort%canopy_layer = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) - currentCohort%canopy_layer_yesterday = nan ! recent canopy status of cohort (1 = canopy, 2 = understorey, etc.) - currentCohort%NV = fates_unset_int ! Number of leaf layers: - - currentCohort%status_coh = fates_unset_int ! growth status of plant (2 = leaves on , 1 = leaves off) - currentCohort%efleaf_coh = nan ! leaf elongation factor (fraction from 0 (fully abscissed) to 1 (fully flushed) - currentCohort%effnrt_coh = nan ! fine-root "elongation factor" (fraction from 0 (fully abscissed) to 1 (fully flushed) - currentCohort%efstem_coh = nan ! stem "elongation factor" (fraction from 0 (fully abscissed) to 1 (fully flushed) - currentCohort%size_class = fates_unset_int ! size class index - currentCohort%size_class_lasttimestep = fates_unset_int ! size class index - currentCohort%size_by_pft_class = fates_unset_int ! size by pft classification index - currentCohort%coage_class = fates_unset_int ! cohort age class index - currentCohort%coage_by_pft_class = fates_unset_int ! cohort age by pft class index - - currentCohort%n = nan ! number of individuals in cohort per 'area' (10000m2 default) - currentCohort%dbh = nan ! 'diameter at breast height' in cm - currentCohort%coage = nan ! age of the cohort in years - currentCohort%hite = nan ! height: meters - currentCohort%g_sb_laweight = nan ! Total leaf conductance of cohort (stomata+blayer) weighted by leaf-area [m/s]*[m2] - currentCohort%canopy_trim = nan ! What is the fraction of the maximum leaf biomass that we are targeting? :- - currentCohort%leaf_cost = nan ! How much does it cost to maintain leaves: kgC/m2/year-1 - currentCohort%excl_weight = nan ! How much of this cohort is demoted each year, as a proportion of all cohorts:- - currentCohort%prom_weight = nan ! How much of this cohort is promoted each year, as a proportion of all cohorts:- - currentCohort%c_area = nan ! areal extent of canopy (m2) - currentCohort%treelai = nan ! lai of tree (total leaf area (m2) / canopy area (m2) - currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2) - currentCohort%seed_prod = nan - currentCohort%vcmax25top = nan - currentCohort%jmax25top = nan - currentCohort%tpu25top = nan - currentCohort%kp25top = nan - - ! CARBON FLUXES - currentCohort%gpp_acc_hold = nan ! GPP: kgC/indiv/year - currentCohort%gpp_tstep = nan ! GPP: kgC/indiv/timestep - currentCohort%gpp_acc = nan ! GPP: kgC/indiv/day - currentCohort%npp_acc_hold = nan ! NPP: kgC/indiv/year - currentCohort%npp_tstep = nan ! NPP: kGC/indiv/timestep - currentCohort%npp_acc = nan ! NPP: kgC/indiv/day - currentCohort%year_net_uptake(:) = nan ! Net uptake of individual leaf layers kgC/m2/year - currentCohort%ts_net_uptake(:) = nan ! Net uptake of individual leaf layers kgC/m2/s - currentCohort%resp_acc_hold = nan ! RESP: kgC/indiv/year - currentCohort%resp_tstep = nan ! RESP: kgC/indiv/timestep - currentCohort%resp_acc = nan ! RESP: kGC/cohort/day - - ! Fluxes from nutrient allocation - currentCohort%daily_nh4_uptake = nan - currentCohort%daily_no3_uptake = nan - currentCohort%daily_n_gain = nan - currentCohort%sym_nfix_daily = nan - currentCohort%sym_nfix_tstep = nan - currentCohort%daily_p_gain = nan - currentCohort%daily_c_efflux = nan - currentCohort%daily_n_efflux = nan - currentCohort%daily_p_efflux = nan - currentCohort%daily_n_demand = nan - currentCohort%daily_p_demand = nan - currentCohort%cx_int = nan - currentCohort%cx0 = nan - currentCohort%ema_dcxdt = nan - currentCohort%cnp_limiter = fates_unset_int - - currentCohort%c13disc_clm = nan ! C13 discrimination, per mil at indiv/timestep - currentCohort%c13disc_acc = nan ! C13 discrimination, per mil at indiv/timestep at indiv/daily at the end of a day - - !RESPIRATION - currentCohort%rdark = nan - currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year - currentCohort%resp_m_unreduced = nan ! Diagnostic-only unreduced Maintenance respiration. kGC/cohort/year - currentCohort%resp_excess = nan ! Respiration of excess (unallocatable) carbon (kg/indiv/day) - currentCohort%livestem_mr = nan ! Live stem maintenance respiration. kgC/indiv/s-1 - currentCohort%livecroot_mr = nan ! Coarse root maintenance respiration. kgC/indiv/s-1 - currentCohort%froot_mr = nan ! Fine root maintenance respiration. kgC/indiv/s-1 - currentCohort%resp_g_tstep = nan ! Growth respiration. kGC/indiv/timestep - - - ! ALLOCATION - currentCohort%dmort = nan ! proportional mortality rate. (year-1) - - ! logging - currentCohort%lmort_direct = nan - currentCohort%lmort_infra = nan - currentCohort%lmort_collateral = nan - currentCohort%l_degrad = nan - - currentCohort%c_area = nan ! areal extent of canopy (m2) - currentCohort%treelai = nan ! lai of tree (total leaf area (m2) / canopy area (m2) - currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2) - - - ! VARIABLES NEEDED FOR INTEGRATION - currentCohort%dndt = nan ! time derivative of cohort size - currentCohort%dhdt = nan ! time derivative of height - currentCohort%ddbhdt = nan ! time derivative of dbh - - ! FIRE - currentCohort%fraction_crown_burned = nan ! proportion of crown affected by fire - currentCohort%cambial_mort = nan ! probability that trees dies due to cambial char P&R (1986) - currentCohort%crownfire_mort = nan ! probability of tree post-fire mortality due to crown scorch - currentCohort%fire_mort = nan ! post-fire mortality from cambial and crown damage assuming two are independent - - end subroutine nan_cohort - - !-------------------------------------------------------------------------------------! - - subroutine zero_cohort(cc_p) - ! - ! !DESCRIPTION: - ! Zero variables that need to be accounted for if - ! this cohort is altered before they are defined. - ! - ! !USES: - ! - ! !ARGUMENTS - type (ed_cohort_type), intent(inout), target :: cc_p - ! - ! !LOCAL VARIABLES: - type (ed_cohort_type) , pointer :: currentCohort - !---------------------------------------------------------------------- - - currentCohort => cc_p - - currentCohort%NV = 0 - currentCohort%status_coh = 0 - currentCohort%efleaf_coh = 0._r8 - currentCohort%effnrt_coh = 0._r8 - currentCohort%efstem_coh = 0._r8 - currentCohort%rdark = 0._r8 - currentCohort%resp_m = 0._r8 - currentCohort%resp_m_unreduced = 0._r8 - currentCohort%resp_excess = 0._r8 - currentCohort%resp_g_tstep = 0._r8 - currentCohort%livestem_mr = 0._r8 - currentCohort%livecroot_mr = 0._r8 - currentCohort%froot_mr = 0._r8 - currentCohort%fire_mort = 0._r8 - currentcohort%npp_acc = 0._r8 - currentcohort%gpp_acc = 0._r8 - currentcohort%resp_acc = 0._r8 - currentcohort%npp_tstep = 0._r8 - currentcohort%gpp_tstep = 0._r8 - currentcohort%resp_tstep = 0._r8 - currentcohort%resp_acc_hold = 0._r8 - - currentcohort%year_net_uptake(:) = 999._r8 ! this needs to be 999, or trimming of new cohorts will break. - currentcohort%ts_net_uptake(:) = 0._r8 - currentcohort%fraction_crown_burned = 0._r8 - currentCohort%size_class = 1 - currentCohort%coage_class = 1 - currentCohort%seed_prod = 0._r8 - currentCohort%size_class_lasttimestep = 0 - currentcohort%npp_acc_hold = 0._r8 - currentcohort%gpp_acc_hold = 0._r8 - currentcohort%dmort = 0._r8 - currentcohort%g_sb_laweight = 0._r8 - currentcohort%treesai = 0._r8 - currentCohort%lmort_direct = 0._r8 - currentCohort%lmort_infra = 0._r8 - currentCohort%lmort_collateral = 0._r8 - currentCohort%l_degrad = 0._r8 - currentCohort%leaf_cost = 0._r8 - currentcohort%excl_weight = 0._r8 - currentcohort%prom_weight = 0._r8 - currentcohort%crownfire_mort = 0._r8 - currentcohort%cambial_mort = 0._r8 - currentCohort%c13disc_clm = 0._r8 - currentCohort%c13disc_acc = 0._r8 - - ! Daily nutrient fluxes are INTEGRATED over the course of the - ! day. This variable MUST be zerod upon creation AND - ! after allocation. These variables exist in - ! carbon-only mode but are not used. - - currentCohort%daily_nh4_uptake = 0._r8 - currentCohort%daily_no3_uptake = 0._r8 - currentCohort%daily_p_gain = 0._r8 - - currentCohort%daily_c_efflux = 0._r8 - currentCohort%daily_n_efflux = 0._r8 - currentCohort%daily_p_efflux = 0._r8 - - ! Initialize these as negative - currentCohort%daily_p_demand = -9._r8 - currentCohort%daily_n_demand = -9._r8 - - ! Fixation is also integrated over the course of the day - ! and must be zeroed upon creation and after plant - ! resource allocation - currentCohort%sym_nfix_daily = 0._r8 - - end subroutine zero_cohort - - !-------------------------------------------------------------------------------------! subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_in) ! ! !DESCRIPTION: @@ -777,7 +354,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ ! ! !ARGUMENTS type (ed_site_type) , intent(inout) :: currentSite - type (ed_patch_type), intent(inout) :: currentPatch + type (fates_patch_type), intent(inout) :: currentPatch integer , intent(in) :: level integer :: call_index type(bc_in_type), intent(in) :: bc_in @@ -792,9 +369,9 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_ ! ! !LOCAL VARIABLES: - type (ed_cohort_type) , pointer :: currentCohort - type (ed_cohort_type) , pointer :: shorterCohort - type (ed_cohort_type) , pointer :: tallerCohort + type (fates_cohort_type) , pointer :: currentCohort + type (fates_cohort_type) , pointer :: shorterCohort + type (fates_cohort_type) , pointer :: tallerCohort real(r8) :: leaf_c ! leaf carbon [kg] real(r8) :: store_c ! storage carbon [kg] @@ -894,13 +471,13 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in) ! ! !ARGUMENTS type (ed_site_type) , intent(inout), target :: currentSite - type (ed_patch_type) , intent(inout), target :: currentPatch - type (ed_cohort_type), intent(inout), target :: currentCohort + type (fates_patch_type) , intent(inout), target :: currentPatch + type (fates_cohort_type), intent(inout), target :: currentCohort type(bc_in_type), intent(in) :: bc_in ! !LOCAL VARIABLES: - type (ed_cohort_type) , pointer :: shorterCohort - type (ed_cohort_type) , pointer :: tallerCohort + type (fates_cohort_type) , pointer :: shorterCohort + type (fates_cohort_type) , pointer :: tallerCohort real(r8) :: leaf_c ! leaf carbon [kg] real(r8) :: store_c ! storage carbon [kg] @@ -974,7 +551,7 @@ subroutine terminate_cohort(currentSite, currentPatch, currentCohort, bc_in) shorterCohort%taller => tallerCohort endif - call DeallocateCohort(currentCohort) + call currentCohort%FreeMemory() end subroutine terminate_cohort @@ -1000,8 +577,8 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in) ! Arguments type (ed_site_type) , target :: csite - type (ed_patch_type) , target :: cpatch - type (ed_cohort_type) , target :: ccohort + type (fates_patch_type) , target :: cpatch + type (fates_cohort_type) , target :: ccohort real(r8) :: nplant ! Number (absolute) ! of plants to transfer type(bc_in_type), intent(in) :: bc_in @@ -1110,40 +687,10 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in) return end subroutine SendCohortToLitter - !-------------------------------------------------------------------------------------- - subroutine DeallocateCohort(currentCohort) - - ! ---------------------------------------------------------------------------------- - ! This subroutine deallocates all dynamic memory and objects - ! inside the cohort structure. This DOES NOT deallocate - ! the cohort structure itself. - ! ---------------------------------------------------------------------------------- - - type(ed_cohort_type),intent(inout) :: currentCohort - integer :: istat ! return status code - character(len=255) :: smsg - - ! At this point, nothing should be pointing to current Cohort - if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort) - - ! Deallocate the cohort's PRT structures - call currentCohort%prt%DeallocatePRTVartypes() - - ! Deallocate the PRT object - - deallocate(currentCohort%prt, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc002: fail in deallocate(currentCohort%prt):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - - return - end subroutine DeallocateCohort - subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! @@ -1161,17 +708,17 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! ! !ARGUMENTS type (ed_site_type), intent(inout) :: currentSite - type (ed_patch_type), intent(inout), pointer :: currentPatch + type (fates_patch_type), intent(inout), pointer :: currentPatch type (bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: - type (ed_cohort_type) , pointer :: currentCohort - type (ed_cohort_type) , pointer :: nextc - type (ed_cohort_type) , pointer :: nextnextc + type (fates_cohort_type) , pointer :: currentCohort + type (fates_cohort_type) , pointer :: nextc + type (fates_cohort_type) , pointer :: nextnextc - type (ed_cohort_type) , pointer :: shorterCohort - type (ed_cohort_type) , pointer :: tallerCohort + type (fates_cohort_type) , pointer :: shorterCohort + type (fates_cohort_type) , pointer :: tallerCohort integer :: i integer :: fusion_took_place @@ -1321,7 +868,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! Leaf biophysical rates (use leaf mass weighting) ! ----------------------------------------------------------------- - call UpdateCohortBioPhysRates(currentCohort) + call currentCohort%UpdateCohortBioPhysRates() currentCohort%l2fr = (currentCohort%n*currentCohort%l2fr & + nextc%n*nextc%l2fr)/newn @@ -1622,7 +1169,7 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) call UpdateSizeDepPlantHydProps(currentSite,currentCohort, bc_in) endif - call DeallocateCohort(nextc) + call nextc%FreeMemory() deallocate(nextc, stat=istat, errmsg=smsg) if (istat/=0) then write(fates_log(),*) 'dealloc003: fail on deallocate(nextc):'//trim(smsg) @@ -1726,13 +1273,13 @@ subroutine sort_cohorts(patchptr) ! sort cohorts into the correct order DO NOT CHANGE THIS IT WILL BREAK ! ============================================================================ - type(ed_patch_type) , intent(inout), target :: patchptr + type(fates_patch_type) , intent(inout), target :: patchptr - type(ed_patch_type) , pointer :: current_patch - type(ed_cohort_type), pointer :: current_c, next_c - type(ed_cohort_type), pointer :: shortestc, tallestc - type(ed_cohort_type), pointer :: storesmallcohort - type(ed_cohort_type), pointer :: storebigcohort + type(fates_patch_type) , pointer :: current_patch + type(fates_cohort_type), pointer :: current_c, next_c + type(fates_cohort_type), pointer :: shortestc, tallestc + type(fates_cohort_type), pointer :: storesmallcohort + type(fates_cohort_type), pointer :: storebigcohort integer :: snull,tnull current_patch => patchptr @@ -1760,7 +1307,8 @@ subroutine sort_cohorts(patchptr) shortestc => current_c endif - call insert_cohort(current_c, tallestc, shortestc, tnull, snull, storebigcohort, storesmallcohort) + call insert_cohort(current_patch, current_c, tallestc, shortestc, & + tnull, snull, storebigcohort, storesmallcohort) current_patch%tallest => storebigcohort current_patch%shortest => storesmallcohort @@ -1771,7 +1319,7 @@ subroutine sort_cohorts(patchptr) end subroutine sort_cohorts !-------------------------------------------------------------------------------------! - subroutine insert_cohort(pcc, ptall, pshort, tnull, snull, storebigcohort, storesmallcohort) + subroutine insert_cohort(currentPatch, pcc, ptall, pshort, tnull, snull, storebigcohort, storesmallcohort) ! ! !DESCRIPTION: ! Insert cohort into linked list @@ -1779,24 +1327,24 @@ subroutine insert_cohort(pcc, ptall, pshort, tnull, snull, storebigcohort, store ! !USES: ! ! !ARGUMENTS - type(ed_cohort_type) , intent(inout), pointer :: pcc - type(ed_cohort_type) , intent(inout), pointer :: ptall - type(ed_cohort_type) , intent(inout), pointer :: pshort + type(fates_patch_type), intent(inout), target :: currentPatch + type(fates_cohort_type) , intent(inout), pointer :: pcc + type(fates_cohort_type) , intent(inout), pointer :: ptall + type(fates_cohort_type) , intent(inout), pointer :: pshort integer , intent(in) :: tnull integer , intent(in) :: snull - type(ed_cohort_type) , intent(inout),pointer,optional :: storesmallcohort ! storage of the smallest cohort for insertion routine - type(ed_cohort_type) , intent(inout),pointer,optional :: storebigcohort ! storage of the largest cohort for insertion routine + type(fates_cohort_type) , intent(inout),pointer,optional :: storesmallcohort ! storage of the smallest cohort for insertion routine + type(fates_cohort_type) , intent(inout),pointer,optional :: storebigcohort ! storage of the largest cohort for insertion routine ! ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: current - type(ed_cohort_type), pointer :: tallptr, shortptr, icohort - type(ed_cohort_type), pointer :: ptallest, pshortest + !type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: current + type(fates_cohort_type), pointer :: tallptr, shortptr, icohort + type(fates_cohort_type), pointer :: ptallest, pshortest real(r8) :: tsp integer :: tallptrnull,exitloop !---------------------------------------------------------------------- - currentPatch => pcc%patchptr ptallest => ptall pshortest => pshort @@ -1845,7 +1393,6 @@ subroutine insert_cohort(pcc, ptall, pshort, tnull, snull, storebigcohort, store storebigcohort => icohort end if currentPatch%tallest => icohort - icohort%patchptr%tallest => icohort !new cohort is not tallest else !next shorter cohort to new cohort is the next shorter cohort @@ -1866,7 +1413,6 @@ subroutine insert_cohort(pcc, ptall, pshort, tnull, snull, storebigcohort, store storesmallcohort => icohort end if currentPatch%shortest => icohort - icohort%patchptr%shortest => icohort else !new cohort is not shortest and becomes next taller cohort !to the cohort just below it as defined in the previous block @@ -1883,175 +1429,7 @@ subroutine insert_cohort(pcc, ptall, pshort, tnull, snull, storebigcohort, store end subroutine insert_cohort !-------------------------------------------------------------------------------------! - subroutine copy_cohort( currentCohort,copyc ) - ! - ! !DESCRIPTION: - ! Copies all the variables in one cohort into another empty cohort - ! - ! !USES: - ! - ! !ARGUMENTS - type(ed_cohort_type), intent(inout) , target :: copyc ! New cohort argument. - type(ed_cohort_type), intent(in) , target :: currentCohort ! Old cohort argument. - ! - ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: n,o ! New and old cohort pointers - !---------------------------------------------------------------------- - o => currentCohort - n => copyc - - n%indexnumber = fates_unset_int - - ! VEGETATION STRUCTURE - n%pft = o%pft - n%crowndamage = o%crowndamage - n%n = o%n - n%dbh = o%dbh - n%coage = o%coage - n%hite = o%hite - n%g_sb_laweight = o%g_sb_laweight - n%leaf_cost = o%leaf_cost - n%canopy_layer = o%canopy_layer - n%canopy_layer_yesterday = o%canopy_layer_yesterday - n%nv = o%nv - n%status_coh = o%status_coh - n%efleaf_coh = o%efleaf_coh - n%effnrt_coh = o%effnrt_coh - n%efstem_coh = o%efstem_coh - n%canopy_trim = o%canopy_trim - n%excl_weight = o%excl_weight - n%prom_weight = o%prom_weight - n%size_class = o%size_class - n%size_class_lasttimestep = o%size_class_lasttimestep - n%size_by_pft_class = o%size_by_pft_class - n%coage_class = o%coage_class - n%coage_by_pft_class = o%coage_by_pft_class - - ! This transfers the PRT objects over. - call n%prt%CopyPRTVartypes(o%prt) - n%l2fr = o%l2fr - - ! Leaf biophysical rates - n%vcmax25top = o%vcmax25top - n%jmax25top = o%jmax25top - n%tpu25top = o%tpu25top - n%kp25top = o%kp25top - - ! Copy over running means - if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - n%cx_int = o%cx_int - n%ema_dcxdt = o%ema_dcxdt - n%cx0 = o%cx0 - end if - - ! CARBON FLUXES - n%gpp_acc_hold = o%gpp_acc_hold - n%gpp_acc = o%gpp_acc - n%gpp_tstep = o%gpp_tstep - - n%npp_acc_hold = o%npp_acc_hold - n%npp_tstep = o%npp_tstep - n%npp_acc = o%npp_acc - - if ( debug .and. .not.o%isnew ) write(fates_log(),*) 'EDcohortDyn Ia ',o%npp_acc - if ( debug .and. .not.o%isnew ) write(fates_log(),*) 'EDcohortDyn Ib ',o%resp_acc - - n%resp_tstep = o%resp_tstep - n%resp_acc = o%resp_acc - n%resp_acc_hold = o%resp_acc_hold - n%year_net_uptake = o%year_net_uptake - n%ts_net_uptake = o%ts_net_uptake - - ! These do not need to be copied because they - ! are written to history before dynamics occurs - ! and cohorts are reformed - n%daily_nh4_uptake = o%daily_nh4_uptake - n%daily_no3_uptake = o%daily_no3_uptake - n%sym_nfix_daily = o%sym_nfix_daily - n%daily_n_gain = o%daily_n_gain - n%daily_p_gain = o%daily_p_gain - n%daily_c_efflux = o%daily_c_efflux - n%daily_n_efflux = o%daily_n_efflux - n%daily_p_efflux = o%daily_p_efflux - n%daily_n_demand = o%daily_n_demand - n%daily_p_demand = o%daily_p_demand - - ! C13 discrimination - n%c13disc_clm = o%c13disc_clm - n%c13disc_acc = o%c13disc_acc - - !RESPIRATION - n%rdark = o%rdark - n%resp_m = o%resp_m - n%resp_m_unreduced= o%resp_m_unreduced - n%resp_excess = o%resp_excess - n%resp_g_tstep = o%resp_g_tstep - n%livestem_mr = o%livestem_mr - n%livecroot_mr = o%livecroot_mr - n%froot_mr = o%froot_mr - - ! ALLOCATION - n%dmort = o%dmort - n%seed_prod = o%seed_prod - - n%treelai = o%treelai - n%treesai = o%treesai - n%c_area = o%c_area - - ! Mortality diagnostics - n%cmort = o%cmort - n%bmort = o%bmort - n%hmort = o%hmort - n%smort = o%smort - n%asmort = o%asmort - n%frmort = o%frmort - n%dgmort = o%dgmort - - ! logging mortalities, Yi Xu - n%lmort_direct =o%lmort_direct - n%lmort_collateral =o%lmort_collateral - n%lmort_infra =o%lmort_infra - n%l_degrad =o%l_degrad - - ! Flags - n%isnew = o%isnew - - ! VARIABLES NEEDED FOR INTEGRATION - n%dndt = o%dndt - n%dhdt = o%dhdt - n%ddbhdt = o%ddbhdt - - ! FIRE - n%fraction_crown_burned = o%fraction_crown_burned - n%fire_mort = o%fire_mort - n%crownfire_mort = o%crownfire_mort - n%cambial_mort = o%cambial_mort - - ! Plant Hydraulics - - if( hlm_use_planthydro.eq.itrue ) then - call CopyCohortHydraulics(n,o) - endif - - ! indices for binning - n%size_class = o%size_class - n%size_class_lasttimestep = o%size_class_lasttimestep - n%size_by_pft_class = o%size_by_pft_class - n%coage_class = o%coage_class - n%coage_by_pft_class = o%coage_by_pft_class - - !Pointers - n%taller => NULL() ! pointer to next tallest cohort - n%shorter => NULL() ! pointer to next shorter cohort - n%patchptr => o%patchptr ! pointer to patch that cohort is in - - - - - end subroutine copy_cohort - - !-------------------------------------------------------------------------------------! subroutine count_cohorts( currentPatch ) ! ! !DESCRIPTION: @@ -2059,10 +1437,10 @@ subroutine count_cohorts( currentPatch ) ! !USES: ! ! !ARGUMENTS - type(ed_patch_type), intent(inout), target :: currentPatch !new site + type(fates_patch_type), intent(inout), target :: currentPatch !new site ! ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort !new patch + type(fates_cohort_type), pointer :: currentCohort !new patch integer :: backcount !---------------------------------------------------------------------- @@ -2092,81 +1470,6 @@ end subroutine count_cohorts ! =================================================================================== - subroutine UpdateCohortBioPhysRates(currentCohort) - - ! -------------------------------------------------------------------------------- - ! This routine updates the four key biophysical rates of leaves - ! based on the changes in a cohort's leaf age proportions - ! - ! This should be called after growth. Growth occurs - ! after turnover and damage states are applied to the tree. - ! Therefore, following growth, the leaf mass fractions - ! of different age classes are unchanged until the next day. - ! -------------------------------------------------------------------------------- - - type(ed_cohort_type),intent(inout) :: currentCohort - - - real(r8) :: frac_leaf_aclass(max_nleafage) ! Fraction of leaves in each age-class - integer :: iage ! loop index for leaf ages - integer :: ipft ! plant functional type index - - ! First, calculate the fraction of leaves in each age class - ! It is assumed that each class has the same proportion - ! across leaf layers - - do iage = 1, nleafage - frac_leaf_aclass(iage) = & - currentCohort%prt%GetState(leaf_organ, carbon12_element,iage) - end do - - ! If there are leaves, then perform proportional weighting on the four rates - ! We assume that leaf age does not effect the specific leaf area, so the mass - ! fractions are applicable to these rates - - ipft = currentCohort%pft - - if(sum(frac_leaf_aclass(1:nleafage))>nearzero .and. hlm_use_sp .eq. ifalse) then - - - frac_leaf_aclass(1:nleafage) = frac_leaf_aclass(1:nleafage) / & - sum(frac_leaf_aclass(1:nleafage)) - - currentCohort%vcmax25top = sum(EDPftvarcon_inst%vcmax25top(ipft,1:nleafage) * & - frac_leaf_aclass(1:nleafage)) - - currentCohort%jmax25top = sum(param_derived%jmax25top(ipft,1:nleafage) * & - frac_leaf_aclass(1:nleafage)) - - currentCohort%tpu25top = sum(param_derived%tpu25top(ipft,1:nleafage) * & - frac_leaf_aclass(1:nleafage)) - - currentCohort%kp25top = sum(param_derived%kp25top(ipft,1:nleafage) * & - frac_leaf_aclass(1:nleafage)) - - elseif (hlm_use_sp .eq. itrue) then - - currentCohort%vcmax25top = EDPftvarcon_inst%vcmax25top(ipft,1) - currentCohort%jmax25top = param_derived%jmax25top(ipft,1) - currentCohort%tpu25top = param_derived%tpu25top(ipft,1) - currentCohort%kp25top = param_derived%kp25top(ipft,1) - - else - - currentCohort%vcmax25top = 0._r8 - currentCohort%jmax25top = 0._r8 - currentCohort%tpu25top = 0._r8 - currentCohort%kp25top = 0._r8 - - end if - - - return - end subroutine UpdateCohortBioPhysRates - - - ! ============================================================================ - subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) @@ -2177,7 +1480,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) ! ----------------------------------------------------------------------------------- ! argument - type(ed_cohort_type),intent(inout) :: currentCohort + type(fates_cohort_type),intent(inout) :: currentCohort real(r8),intent(out) :: delta_dbh real(r8),intent(out) :: delta_hite @@ -2282,12 +1585,12 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! -------------------------------------------------------------------------- type(ed_site_type) :: csite ! Site of the current cohort - type(ed_patch_type) :: cpatch ! patch of the current cohort - type(ed_cohort_type),pointer :: ccohort ! Current (damaged) cohort + type(fates_patch_type) :: cpatch ! patch of the current cohort + type(fates_cohort_type),pointer :: ccohort ! Current (damaged) cohort logical :: newly_recovered ! true if we create a new cohort ! locals - type(ed_cohort_type), pointer :: rcohort ! New cohort that recovers by + type(fates_cohort_type), pointer :: rcohort ! New cohort that recovers by ! having a lower damage class real(r8) :: sapw_area ! sapwood area real(r8) :: target_sapw_c,target_sapw_m ! sapwood mass, C and N/P @@ -2484,8 +1787,8 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) ! correct boundary condition fields rcohort%prt => null() call InitPRTObject(rcohort%prt) - call InitPRTBoundaryConditions(rcohort) - call copy_cohort(ccohort, rcohort) + call rcohort%InitPRTBoundaryConditions() + call ccohort%Copy(rcohort) rcohort%n = nplant_recover @@ -2521,6 +1824,12 @@ subroutine DamageRecovery(csite,cpatch,ccohort,newly_recovered) return end subroutine DamageRecovery + + + + +!:.........................................................................: + end module EDCohortDynamicsMod diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 537d62642c..a4703ae840 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -15,8 +15,8 @@ module EDLoggingMortalityMod use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : rsnbl_math_prec - use EDTypesMod , only : ed_cohort_type - use EDTypesMod , only : ed_patch_type + use FatesCohortMod , only : fates_cohort_type + use FatesPatchMod , only : fates_patch_type use EDTypesMod , only : site_massbal_type use EDTypesMod , only : site_fluxdiags_type use FatesLitterMod , only : ncwd @@ -25,9 +25,9 @@ module EDLoggingMortalityMod use FatesLitterMod , only : adjust_SF_CWD_frac use EDTypesMod , only : ed_site_type use EDTypesMod , only : ed_resources_management_type - use EDTypesMod , only : dtype_ilog - use EDTypesMod , only : dtype_ifall - use EDTypesMod , only : dtype_ifire + use FatesConstantsMod , only : dtype_ilog + use FatesConstantsMod , only : dtype_ifall + use FatesConstantsMod , only : dtype_ifire use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac use PRTParametersMod , only : prt_params @@ -461,8 +461,8 @@ subroutine get_harvestable_carbon (csite, site_area, hlm_harvest_catnames, harve real(r8), intent(out) :: harvestable_forest_c(hlm_num_lu_harvest_cats) ! Local Variables - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: harvestable_patch_c ! patch level total carbon available for harvest, kgC site-1 real(r8) :: harvestable_cohort_c ! cohort level total carbon available for harvest, kgC site-1 real(r8) :: sapw_m ! Biomass of sap wood @@ -717,22 +717,21 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site use SFParamsMod, only : SF_val_cwd_frac use EDtypesMod, only : area use EDtypesMod, only : ed_site_type - use EDtypesMod, only : ed_patch_type - use EDtypesMod, only : ed_cohort_type + use FatesCohortMod, only : fates_cohort_type use FatesConstantsMod, only : rsnbl_math_prec use FatesAllometryMod, only : carea_allom ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: currentSite - type(ed_patch_type) , intent(inout), target :: currentPatch - type(ed_patch_type) , intent(inout), target :: newPatch + type(fates_patch_type) , intent(inout), target :: currentPatch + type(fates_patch_type) , intent(inout), target :: newPatch real(r8) , intent(in) :: patch_site_areadis type(bc_in_type) , intent(in) :: bc_in !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort type(site_massbal_type), pointer :: site_mass type(site_fluxdiags_type), pointer :: flux_diags type(litter_type),pointer :: new_litt diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index d0e224fd79..bf47a5cce3 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -9,9 +9,9 @@ module EDMortalityFunctionsMod use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use EDPftvarcon , only : EDPftvarcon_inst - use EDTypesMod , only : ed_cohort_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type + use EDParamsMod, only : maxpft use FatesConstantsMod , only : itrue,ifalse use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : storage_fraction_of_target @@ -48,22 +48,22 @@ module EDMortalityFunctionsMod contains - - - subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmort,dgmort ) + subroutine mortality_rates( cohort_in,bc_in,btran_ft, mean_temp, & + cmort,hmort,bmort, frmort,smort,asmort,dgmort ) ! ============================================================================ ! Calculate mortality rates from carbon storage, hydraulic cavitation, ! background and freezing and size and age dependent senescence ! ============================================================================ - use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm - use FatesInterfaceTypesMod , only : hlm_hio_ignore_val + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesConstantsMod, only : fates_check_param_set use DamageMainMod, only : GetDamageMortality - type (ed_cohort_type), intent(in) :: cohort_in + type (fates_cohort_type), intent(in) :: cohort_in type (bc_in_type), intent(in) :: bc_in + real(r8), intent(in) :: btran_ft(maxpft) + real(r8), intent(in) :: mean_temp real(r8),intent(out) :: bmort ! background mortality : Fraction per year real(r8),intent(out) :: cmort ! carbon starvation mortality real(r8),intent(out) :: hmort ! hydraulic failure mortality @@ -156,7 +156,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor hmort = 0.0_r8 endif else - if(cohort_in%patchptr%btran_ft(cohort_in%pft) <= hf_sm_threshold)then + if(btran_ft(cohort_in%pft) <= hf_sm_threshold)then hmort = EDPftvarcon_inst%mort_scalar_hydrfailure(cohort_in%pft) else hmort = 0.0_r8 @@ -196,7 +196,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor ! Eastern US carbon sink. Glob. Change Biol., 12, 2370-2390, ! doi: 10.1111/j.1365-2486.2006.01254.x - temp_in_C = cohort_in%patchptr%tveg24%GetMean() - tfrz + temp_in_C = mean_temp - tfrz temp_dep_fraction = max(0.0_r8, min(1.0_r8, 1.0_r8 - (temp_in_C - & EDPftvarcon_inst%freezetol(cohort_in%pft))/frost_mort_buffer) ) @@ -231,8 +231,9 @@ end subroutine mortality_rates ! ============================================================================ - subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & - harvestable_forest_c, harvest_tag) + subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, btran_ft, & + mean_temp, anthro_disturbance_label, age_since_anthro_disturbance, & + frac_site_primary, harvestable_forest_c, harvest_tag) ! ! !DESCRIPTION: @@ -245,9 +246,13 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite - type(ed_cohort_type),intent(inout), target :: currentCohort + type(fates_cohort_type),intent(inout), target :: currentCohort type(bc_in_type), intent(in) :: bc_in - real(r8), intent(in) :: frac_site_primary + real(r8), intent(in) :: btran_ft(maxpft) + real(r8), intent(in) :: mean_temp + integer, intent(in) :: anthro_disturbance_label + real(r8), intent(in) :: age_since_anthro_disturbance + real(r8), intent(in) :: frac_site_primary real(r8), intent(in) :: harvestable_forest_c(:) ! total carbon available for logging, kgC site-1 integer, intent(out) :: harvest_tag(:) ! tag to record the harvest status @@ -274,7 +279,8 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr ! Mortality for trees in the understorey. !if trees are in the canopy, then their death is 'disturbance'. This probably needs a different terminology - call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort,smort, asmort, dgmort) + call mortality_rates(currentCohort,bc_in,btran_ft, mean_temp, & + cmort,hmort,bmort,frmort, smort, asmort, dgmort) call LoggingMortality_frac(ipft, currentCohort%dbh, currentCohort%canopy_layer, & currentCohort%lmort_direct, & currentCohort%lmort_collateral, & @@ -283,8 +289,8 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_pr bc_in%hlm_harvest_rates, & bc_in%hlm_harvest_catnames, & bc_in%hlm_harvest_units, & - currentCohort%patchptr%anthro_disturbance_label, & - currentCohort%patchptr%age_since_anthro_disturbance, & + anthro_disturbance_label, & + age_since_anthro_disturbance, & frac_site_primary, harvestable_forest_c, harvest_tag) if (currentCohort%canopy_layer > 1)then @@ -328,7 +334,7 @@ function ExemptTreefallDist(ccohort) result(is_exempt) ! ============================================================================ ! Arguments - type(ed_cohort_type),intent(in), target :: ccohort + type(fates_cohort_type),intent(in), target :: ccohort logical :: is_exempt ! if true, then treat all mortality from this cohort as non-disturbance-generating diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 81caad2b28..6f022ccfbd 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -5,38 +5,42 @@ module EDPatchDynamicsMod ! ============================================================================ use FatesGlobals , only : fates_log use FatesGlobals , only : FatesWarn,N2S,A2S - use FatesInterfaceTypesMod , only : hlm_freq_day + use FatesInterfaceTypesMod, only : hlm_freq_day + use FatesInterfaceTypesMod, only : hlm_current_tod use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac use PRTParametersMod , only : prt_params use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort - use EDCohortDynamicsMod , only : DeallocateCohort use EDTypesMod , only : area_site => area use ChecksBalancesMod , only : PatchMassStock use FatesLitterMod , only : ncwd use FatesLitterMod , only : ndcmpy use FatesLitterMod , only : litter_type + use FatesConstantsMod , only : n_dbh_bins use FatesLitterMod , only : adjust_SF_CWD_frac use EDTypesMod , only : homogenize_seed_pfts - use EDTypesMod , only : n_dbh_bins, area, patchfusion_dbhbin_loweredges + use EDTypesMod , only : area + use FatesConstantsMod , only : patchfusion_dbhbin_loweredges use EDtypesMod , only : force_patchfuse_min_biomass - use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDTypesMod , only : ed_site_type + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : site_massbal_type use EDTypesMod , only : site_fluxdiags_type use EDTypesMod , only : min_patch_area use EDTypesMod , only : min_patch_area_forced - use EDTypesMod , only : nclmax - use EDTypesMod , only : maxpft - use EDTypesMod , only : dtype_ifall - use EDTypesMod , only : dtype_ilog - use EDTypesMod , only : dtype_ifire - use EDTypesMod , only : ican_upper + use EDParamsMod , only : nclmax + use EDParamsMod , only : regeneration_model + use FatesInterfaceTypesMod, only : numpft + use FatesConstantsMod , only : dtype_ifall + use FatesConstantsMod , only : dtype_ilog + use FatesConstantsMod , only : dtype_ifire + use FatesConstantsMod , only : ican_upper use PRTGenericMod , only : num_elements use PRTGenericMod , only : element_list - use EDTypesMod , only : lg_sf - use EDTypesMod , only : dl_sf - use EDTypesMod , only : dump_patch - use EDTypesMod , only : N_DIST_TYPES + use FatesLitterMod , only : lg_sf + use FatesLitterMod , only : dl_sf + use FatesConstantsMod , only : N_DIST_TYPES use EDTypesMod , only : AREA_INV use FatesConstantsMod , only : rsnbl_math_prec use FatesConstantsMod , only : fates_tiny @@ -79,7 +83,6 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : hlm_harvest_carbon use EDCohortDynamicsMod , only : InitPRTObject - use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use ChecksBalancesMod, only : SiteMassStock use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : leaf_organ @@ -109,10 +112,8 @@ module EDPatchDynamicsMod ! implicit none private - ! - public :: create_patch + public :: spawn_patches - public :: zero_patch public :: fuse_patches public :: terminate_patches public :: patch_pft_size_profile @@ -179,8 +180,8 @@ subroutine disturbance_rates( site_in, bc_in) type(bc_in_type) , intent(in) :: bc_in ! ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type), pointer :: currentCohort + type (fates_patch_type) , pointer :: currentPatch + type (fates_cohort_type), pointer :: currentCohort real(r8) :: cmort real(r8) :: bmort @@ -203,6 +204,7 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: frac_site_primary real(r8) :: harvest_rate real(r8) :: tempsum + real(r8) :: mean_temp real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) @@ -223,9 +225,10 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort => currentPatch%shortest do while(associated(currentCohort)) ! Mortality for trees in the understorey. - currentCohort%patchptr => currentPatch - - call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort,smort,asmort,dgmort) + !currentCohort%patchptr => currentPatch + mean_temp = currentPatch%tveg24%GetMean() + call mortality_rates(currentCohort,bc_in,currentPatch%btran_ft, & + mean_temp, cmort,hmort,bmort,frmort,smort,asmort,dgmort) currentCohort%dmort = cmort+hmort+bmort+frmort+smort+asmort+dgmort call carea_allom(currentCohort%dbh,currentCohort%n,site_in%spread,currentCohort%pft, & currentCohort%crowndamage,currentCohort%c_area) @@ -410,7 +413,7 @@ subroutine spawn_patches( currentSite, bc_in) ! !USES: use EDParamsMod , only : ED_val_understorey_death, logging_coll_under_frac - use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts + use EDCohortDynamicsMod , only : terminate_cohorts use FatesConstantsMod , only : rsnbl_math_prec ! @@ -419,14 +422,14 @@ subroutine spawn_patches( currentSite, bc_in) type (bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: new_patch - type (ed_patch_type) , pointer :: new_patch_primary - type (ed_patch_type) , pointer :: new_patch_secondary - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type), pointer :: currentCohort - type (ed_cohort_type), pointer :: nc - type (ed_cohort_type), pointer :: storesmallcohort - type (ed_cohort_type), pointer :: storebigcohort + type (fates_patch_type) , pointer :: new_patch + type (fates_patch_type) , pointer :: new_patch_primary + type (fates_patch_type) , pointer :: new_patch_secondary + type (fates_patch_type) , pointer :: currentPatch + type (fates_cohort_type), pointer :: currentCohort + type (fates_cohort_type), pointer :: nc + type (fates_cohort_type), pointer :: storesmallcohort + type (fates_cohort_type), pointer :: storebigcohort real(r8) :: site_areadis_primary ! total area disturbed (to primary forest) in m2 per site per day real(r8) :: site_areadis_secondary ! total area disturbed (to secondary forest) in m2 per site per day real(r8) :: patch_site_areadis ! total area disturbed in m2 per patch per day @@ -491,7 +494,7 @@ subroutine spawn_patches( currentSite, bc_in) if(disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then write(fates_log(),*) 'patch disturbance rate > 1 ?',disturbance_rate - call dump_patch(currentPatch) + call currentPatch%Dump() call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -543,9 +546,9 @@ subroutine spawn_patches( currentSite, bc_in) ! first create patch to receive primary forest area if ( site_areadis_primary .gt. nearzero ) then allocate(new_patch_primary) - - call create_patch(currentSite, new_patch_primary, age, & - site_areadis_primary, primaryforest, i_nocomp_pft) + call new_patch_primary%Create(age, site_areadis_primary, & + primaryforest, i_nocomp_pft, hlm_numSWb, numpft, & + currentSite%nlevsoil, hlm_current_tod, regeneration_model) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches @@ -564,10 +567,11 @@ subroutine spawn_patches( currentSite, bc_in) endif ! next create patch to receive secondary forest area - if ( site_areadis_secondary .gt. nearzero) then - allocate(new_patch_secondary) - call create_patch(currentSite, new_patch_secondary, age, & - site_areadis_secondary, secondaryforest,i_nocomp_pft) + if (site_areadis_secondary .gt. nearzero) then + allocate(new_patch_secondary) + call new_patch_secondary%Create(age, site_areadis_secondary, & + secondaryforest, i_nocomp_pft, hlm_numSWb, numpft, & + currentSite%nlevsoil, hlm_current_tod, regeneration_model) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches @@ -694,18 +698,18 @@ subroutine spawn_patches( currentSite, bc_in) ! correct boundary condition fields nc%prt => null() call InitPRTObject(nc%prt) - call InitPRTBoundaryConditions(nc) + call nc%InitPRTBoundaryConditions() ! (Keeping as an example) ! Allocate running mean functions !allocate(nc%tveg_lpa) !call nc%tveg_lpa%InitRMean(ema_lpa,init_value=new_patch%tveg_lpa%GetMean()) - call zero_cohort(nc) + call nc%ZeroValues() ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort ! is the curent cohort that stays in the donor patch (currentPatch) - call copy_cohort(currentCohort, nc) + call currentCohort%Copy(nc) !this is the case as the new patch probably doesn't have a closed canopy, and ! even if it does, that will be sorted out in canopy_structure. @@ -1121,8 +1125,8 @@ subroutine spawn_patches( currentSite, bc_in) new_patch%shortest => nc nc%shorter => null() endif - nc%patchptr => new_patch - call insert_cohort(nc, new_patch%tallest, new_patch%shortest, & + !nc%patchptr => new_patch + call insert_cohort(new_patch, nc, new_patch%tallest, new_patch%shortest, & tnull, snull, storebigcohort, storesmallcohort) new_patch%tallest => storebigcohort @@ -1130,7 +1134,7 @@ subroutine spawn_patches( currentSite, bc_in) else ! Get rid of the new temporary cohort - call DeallocateCohort(nc) + call nc%FreeMemory() deallocate(nc, stat=istat, errmsg=smsg) if (istat/=0) then write(fates_log(),*) 'dealloc005: fail on deallocate(nc):'//trim(smsg) @@ -1277,8 +1281,8 @@ subroutine check_patch_area( currentSite ) ! ! !LOCAL VARIABLES: real(r8) :: areatot - type(ed_patch_type), pointer :: currentPatch - type(ed_patch_type), pointer :: largestPatch + type(fates_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: largestPatch real(r8) :: largest_area integer :: el real(r8) :: live_stock @@ -1348,7 +1352,7 @@ subroutine set_patchno( currentSite ) type(ed_site_type),intent(in) :: currentSite ! ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch integer patchno !--------------------------------------------------------------------- @@ -1428,8 +1432,8 @@ subroutine TransLitterNewPatch(currentSite, & ! ! !ARGUMENTS: type(ed_site_type) , intent(in) :: currentSite ! site - type(ed_patch_type) , intent(in) :: currentPatch ! Donor patch - type(ed_patch_type) , intent(inout) :: newPatch ! New patch + type(fates_patch_type) , intent(in) :: currentPatch ! Donor patch + type(fates_patch_type) , intent(inout) :: newPatch ! New patch real(r8) , intent(in) :: patch_site_areadis ! Area being donated ! by current patch @@ -1641,15 +1645,15 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, & ! ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: currentSite - type(ed_patch_type) , intent(inout), target :: currentPatch ! Donor Patch - type(ed_patch_type) , intent(inout), target :: newPatch ! New Patch + type(fates_patch_type) , intent(inout), target :: currentPatch ! Donor Patch + type(fates_patch_type) , intent(inout), target :: newPatch ! New Patch real(r8) , intent(in) :: patch_site_areadis ! Area being donated type(bc_in_type) , intent(in) :: bc_in ! ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort type(litter_type), pointer :: new_litt type(litter_type), pointer :: curr_litt type(site_massbal_type), pointer :: site_mass @@ -1883,13 +1887,13 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, & ! ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: currentSite - type(ed_patch_type) , intent(inout), target :: currentPatch - type(ed_patch_type) , intent(inout), target :: newPatch + type(fates_patch_type) , intent(inout), target :: currentPatch + type(fates_patch_type) , intent(inout), target :: newPatch real(r8) , intent(in) :: patch_site_areadis type(bc_in_type) , intent(in) :: bc_in ! ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort type(litter_type), pointer :: new_litt type(litter_type), pointer :: curr_litt type(site_massbal_type), pointer :: site_mass @@ -2095,278 +2099,7 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, & end subroutine mortality_litter_fluxes ! ============================================================================ - - subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft) - - use FatesInterfaceTypesMod, only : hlm_current_tod,hlm_current_date,hlm_reference_date - - ! - ! !DESCRIPTION: - ! Set default values for creating a new patch - ! - ! !USES: - ! - ! !ARGUMENTS: - type(ed_site_type) , intent(inout), target :: currentSite - type(ed_patch_type), intent(inout), target :: new_patch - real(r8), intent(in) :: age ! notional age of this patch in years - real(r8), intent(in) :: areap ! initial area of this patch in m2. - integer, intent(in) :: label ! anthropogenic disturbance label - integer, intent(in) :: nocomp_pft ! no competition mode pft label - - - ! Until bc's are pointed to by sites give veg a default temp [K] - real(r8), parameter :: temp_init_veg = 15._r8+t_water_freeze_k_1atm - - real(r8), parameter :: init_seedling_par = 5.0_r8 !arbitrary initialization for - !seedling layer PAR [MJ m-2 d-1] - - real(r8), parameter :: init_seedling_smp = -26652.0_r8 !arbitrary initialization of smp [mm] - integer :: pft !pft index - - ! !LOCAL VARIABLES: - !--------------------------------------------------------------------- - integer :: el ! element loop index - - - allocate(new_patch%tr_soil_dir(hlm_numSWb)) - allocate(new_patch%tr_soil_dif(hlm_numSWb)) - allocate(new_patch%tr_soil_dir_dif(hlm_numSWb)) - allocate(new_patch%fab(hlm_numSWb)) - allocate(new_patch%fabd(hlm_numSWb)) - allocate(new_patch%fabi(hlm_numSWb)) - allocate(new_patch%sabs_dir(hlm_numSWb)) - allocate(new_patch%sabs_dif(hlm_numSWb)) - allocate(new_patch%fragmentation_scaler(currentSite%nlevsoil)) - - allocate(new_patch%tveg24) - call new_patch%tveg24%InitRMean(fixed_24hr,init_value=temp_init_veg,init_offset=real(hlm_current_tod,r8) ) - allocate(new_patch%tveg_lpa) - call new_patch%tveg_lpa%InitRmean(ema_lpa,init_value=temp_init_veg) - - - if ( regeneration_model == TRS_regeneration ) then - allocate(new_patch%seedling_layer_par24) - call new_patch%seedling_layer_par24%InitRMean(fixed_24hr,init_value=init_seedling_par, init_offset=real(hlm_current_tod,r8)) - allocate(new_patch%sdlng_mort_par) - call new_patch%sdlng_mort_par%InitRMean(ema_sdlng_mort_par,init_value=temp_init_veg) - allocate(new_patch%sdlng2sap_par) - call new_patch%sdlng2sap_par%InitRMean(ema_sdlng2sap_par,init_value=init_seedling_par) - allocate(new_patch%sdlng_mdd(numpft)) - allocate(new_patch%sdlng_emerg_smp(numpft)) - do pft = 1,numpft - allocate(new_patch%sdlng_mdd(pft)%p) - call new_patch%sdlng_mdd(pft)%p%InitRMean(ema_sdlng_mdd, init_value=0.0_r8) - allocate(new_patch%sdlng_emerg_smp(pft)%p) - call new_patch%sdlng_emerg_smp(pft)%p%InitRMean(ema_sdlng_emerg_h2o,init_value=init_seedling_smp) - enddo - end if - - - allocate(new_patch%tveg_longterm) - call new_patch%tveg_longterm%InitRmean(ema_longterm,init_value=temp_init_veg) - - - ! Litter - ! Allocate, Zero Fluxes, and Initialize to "unset" values - - allocate(new_patch%litter(num_elements)) - do el=1,num_elements - call new_patch%litter(el)%InitAllocate(numpft,currentSite%nlevsoil,element_list(el)) - call new_patch%litter(el)%ZeroFlux() - call new_patch%litter(el)%InitConditions(init_leaf_fines = fates_unset_r8, & - init_root_fines = fates_unset_r8, & - init_ag_cwd = fates_unset_r8, & - init_bg_cwd = fates_unset_r8, & - init_seed = fates_unset_r8, & - init_seed_germ = fates_unset_r8) - end do - - call zero_patch(new_patch) !The nan value in here is not working?? - - new_patch%tallest => null() ! pointer to patch's tallest cohort - new_patch%shortest => null() ! pointer to patch's shortest cohort - new_patch%older => null() ! pointer to next older patch - new_patch%younger => null() ! pointer to next shorter patch - - ! assign known patch attributes - - new_patch%age = age - new_patch%age_class = 1 - new_patch%area = areap - - ! assign anthropgenic disturbance category and label - new_patch%anthro_disturbance_label = label - if (label .eq. secondaryforest) then - new_patch%age_since_anthro_disturbance = age - else - new_patch%age_since_anthro_disturbance = fates_unset_r8 - endif - new_patch%nocomp_pft_label = nocomp_pft - - ! This new value will be generated when the calculate disturbance - ! rates routine is called. This does not need to be remembered or in the restart file. - - new_patch%f_sun = 0._r8 - new_patch%ed_laisun_z(:,:,:) = 0._r8 - new_patch%ed_laisha_z(:,:,:) = 0._r8 - new_patch%ed_parsun_z(:,:,:) = 0._r8 - new_patch%ed_parsha_z(:,:,:) = 0._r8 - new_patch%fabi = 0._r8 - new_patch%fabd = 0._r8 - new_patch%tr_soil_dir(:) = 1._r8 - new_patch%tr_soil_dif(:) = 1._r8 - new_patch%tr_soil_dir_dif(:) = 0._r8 - new_patch%fabd_sun_z(:,:,:) = 0._r8 - new_patch%fabd_sha_z(:,:,:) = 0._r8 - new_patch%fabi_sun_z(:,:,:) = 0._r8 - new_patch%fabi_sha_z(:,:,:) = 0._r8 - new_patch%scorch_ht(:) = 0._r8 - new_patch%frac_burnt = 0._r8 - new_patch%litter_moisture(:) = 0._r8 - new_patch%fuel_eff_moist = 0._r8 - new_patch%livegrass = 0._r8 - new_patch%sum_fuel = 0._r8 - new_patch%fuel_bulkd = 0._r8 - new_patch%fuel_sav = 0._r8 - new_patch%fuel_mef = 0._r8 - new_patch%ros_front = 0._r8 - new_patch%effect_wspeed = 0._r8 - new_patch%tau_l = 0._r8 - new_patch%fuel_frac(:) = 0._r8 - new_patch%tfc_ros = 0._r8 - new_patch%fi = 0._r8 - new_patch%fd = 0._r8 - new_patch%ros_back = 0._r8 - new_patch%scorch_ht(:) = 0._r8 - new_patch%burnt_frac_litter(:) = 0._r8 - new_patch%total_tree_area = 0.0_r8 - new_patch%NCL_p = 1 - - - return - end subroutine create_patch - - ! ============================================================================ - subroutine zero_patch(cp_p) - ! - ! !DESCRIPTION: - ! Sets all the variables in the patch to nan or zero - ! (this needs to be two seperate routines, one for nan & one for zero - ! - ! !USES: - ! - ! !ARGUMENTS: - type(ed_patch_type), intent(inout), target :: cp_p - ! - ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: currentPatch - !--------------------------------------------------------------------- - - currentPatch => cp_p - - currentPatch%tallest => null() - currentPatch%shortest => null() - currentPatch%older => null() - currentPatch%younger => null() - - currentPatch%patchno = 999 - - currentPatch%age = nan - currentPatch%age_class = 1 - currentPatch%area = nan - currentPatch%canopy_layer_tlai(:) = nan - currentPatch%total_canopy_area = nan - - currentPatch%tlai_profile(:,:,:) = nan - currentPatch%elai_profile(:,:,:) = 0._r8 - currentPatch%tsai_profile(:,:,:) = nan - currentPatch%esai_profile(:,:,:) = nan - currentPatch%canopy_area_profile(:,:,:) = nan - - currentPatch%fabd_sun_z(:,:,:) = nan - currentPatch%fabd_sha_z(:,:,:) = nan - currentPatch%fabi_sun_z(:,:,:) = nan - currentPatch%fabi_sha_z(:,:,:) = nan - - currentPatch%ed_laisun_z(:,:,:) = nan - currentPatch%ed_laisha_z(:,:,:) = nan - currentPatch%ed_parsun_z(:,:,:) = nan - currentPatch%ed_parsha_z(:,:,:) = nan - currentPatch%psn_z(:,:,:) = 0._r8 - - currentPatch%f_sun(:,:,:) = nan - currentPatch%tr_soil_dir(:) = nan ! fraction of incoming direct radiation that is transmitted to the soil as direct - currentPatch%tr_soil_dif(:) = nan ! fraction of incoming diffuse radiation that is transmitted to the soil as diffuse - currentPatch%tr_soil_dir_dif(:) = nan ! fraction of incoming direct radiation that is transmitted to the soil as diffuse - currentPatch%fabd(:) = nan ! fraction of incoming direct radiation that is absorbed by the canopy - currentPatch%fabi(:) = nan ! fraction of incoming diffuse radiation that is absorbed by the canopy - - currentPatch%canopy_mask(:,:) = 999 ! is there any of this pft in this layer? - currentPatch%nrad(:,:) = 999 ! number of exposed leaf layers for each canopy layer and pft - currentPatch%ncan(:,:) = 999 ! number of total leaf layers for each canopy layer and pft - currentPatch%pft_agb_profile(:,:) = nan - - ! DISTURBANCE - currentPatch%disturbance_rates(:) = 0._r8 - currentPatch%fract_ldist_not_harvested = 0._r8 - - - ! FIRE - currentPatch%litter_moisture(:) = nan ! litter moisture - currentPatch%fuel_eff_moist = nan ! average fuel moisture content of the ground fuel - ! (incl. live grasses. omits 1000hr fuels) - currentPatch%livegrass = nan ! total ag grass biomass in patch. 1=c3 grass, 2=c4 grass. gc/m2 - currentPatch%sum_fuel = nan ! total ground fuel related to ros (omits 1000hr fuels). gc/m2 - currentPatch%fuel_bulkd = nan ! average fuel bulk density of the ground fuel - ! (incl. live grasses. omits 1000hr fuels). kgc/m3 - currentPatch%fuel_sav = nan ! average surface area to volume ratio of the ground fuel - ! (incl. live grasses. omits 1000hr fuels). - currentPatch%fuel_mef = nan ! average moisture of extinction factor of the ground fuel - ! (incl. live grasses. omits 1000hr fuels). - currentPatch%ros_front = nan ! average rate of forward spread of each fire in the patch. m/min. - currentPatch%effect_wspeed = nan ! dailywind modified by fraction of relative grass and tree cover. m/min. - currentPatch%tau_l = nan ! mins p&r(1986) - currentPatch%fuel_frac(:) = nan ! fraction of each litter class in the sum_fuel - !- for purposes of calculating weighted averages. - currentPatch%tfc_ros = nan ! used in fi calc - currentPatch%fi = nan ! average fire intensity of flaming front during day. - ! backward ros plays no role. kj/m/s or kw/m. - currentPatch%fire = 999 ! sr decide_fire.1=fire hot enough to proceed. 0=stop everything- no fires today - currentPatch%fd = nan ! fire duration (mins) - currentPatch%ros_back = nan ! backward ros (m/min) - currentPatch%scorch_ht(:) = nan ! scorch height of flames on a given PFT - currentPatch%frac_burnt = nan ! fraction burnt daily - currentPatch%burnt_frac_litter(:) = nan - currentPatch%btran_ft(:) = 0.0_r8 - - currentPatch%canopy_layer_tlai(:) = 0.0_r8 - - currentPatch%fab(:) = 0.0_r8 - currentPatch%sabs_dir(:) = 0.0_r8 - currentPatch%sabs_dif(:) = 0.0_r8 - currentPatch%zstar = 0.0_r8 - currentPatch%c_stomata = 0.0_r8 ! This is calculated immediately before use - currentPatch%c_lblayer = 0.0_r8 - currentPatch%fragmentation_scaler(:) = 0.0_r8 - currentPatch%radiation_error = 0.0_r8 - - ! diagnostic radiation profiles - currentPatch%nrmlzd_parprof_pft_dir_z(:,:,:,:) = 0._r8 - currentPatch%nrmlzd_parprof_pft_dif_z(:,:,:,:) = 0._r8 - currentPatch%nrmlzd_parprof_dir_z(:,:,:) = 0._r8 - currentPatch%nrmlzd_parprof_dif_z(:,:,:) = 0._r8 - - currentPatch%solar_zenith_flag = .false. - currentPatch%solar_zenith_angle = nan - currentPatch%fcansno = nan - - currentPatch%gnd_alb_dir(:) = nan - currentPatch%gnd_alb_dif(:) = nan - - end subroutine zero_patch - - ! ============================================================================ + subroutine fuse_patches( csite, bc_in ) ! ! !DESCRIPTION: @@ -2383,7 +2116,7 @@ subroutine fuse_patches( csite, bc_in ) ! ! !LOCAL VARIABLES: type(ed_site_type) , pointer :: currentSite - type(ed_patch_type), pointer :: currentPatch,tpp,tmpptr + type(fates_patch_type), pointer :: currentPatch,tpp,tmpptr integer :: ft,z !counters for pft and height class real(r8) :: norm !normalized difference between biomass profiles real(r8) :: profiletol !tolerance of patch fusion routine. Starts off high and is reduced if there are too many patches. @@ -2690,20 +2423,21 @@ subroutine fuse_2_patches(csite, dp, rp) ! ! !ARGUMENTS: type (ed_site_type), intent(inout),target :: csite ! Current site - type (ed_patch_type) , pointer :: dp ! Donor Patch - type (ed_patch_type) , target, intent(inout) :: rp ! Recipient Patch + type (fates_patch_type) , pointer :: dp ! Donor Patch + type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch ! ! !LOCAL VARIABLES: - type (ed_cohort_type), pointer :: currentCohort ! Current Cohort - type (ed_cohort_type), pointer :: nextc ! Remembers next cohort in list - type (ed_cohort_type), pointer :: storesmallcohort - type (ed_cohort_type), pointer :: storebigcohort - integer :: c,p,pft ! counters for pft and litter size class + type (fates_cohort_type), pointer :: currentCohort ! Current Cohort + type (fates_cohort_type), pointer :: nextc ! Remembers next cohort in list + type (fates_cohort_type), pointer :: storesmallcohort + type (fates_cohort_type), pointer :: storebigcohort + integer :: c,p !counters for pft and litter size class. integer :: tnull,snull ! are the tallest and shortest cohorts associated? integer :: el ! loop counting index for elements - type(ed_patch_type), pointer :: youngerp ! pointer to the patch younger than donor - type(ed_patch_type), pointer :: olderp ! pointer to the patch older than donor + integer :: pft ! loop counter for pfts + type(fates_patch_type), pointer :: youngerp ! pointer to the patch younger than donor + type(fates_patch_type), pointer :: olderp ! pointer to the patch older than donor real(r8) :: inv_sum_area ! Inverse of the sum of the two patches areas !----------------------------------------------------------------------------------------------- @@ -2802,12 +2536,13 @@ subroutine fuse_2_patches(csite, dp, rp) rp%shortest => currentCohort endif - call insert_cohort(currentCohort, rp%tallest, rp%shortest, tnull, snull, storebigcohort, storesmallcohort) + call insert_cohort(rp, currentCohort, rp%tallest, rp%shortest, & + tnull, snull, storebigcohort, storesmallcohort) rp%tallest => storebigcohort rp%shortest => storesmallcohort - currentCohort%patchptr => rp + !currentCohort%patchptr => rp currentCohort => nextc @@ -2837,7 +2572,7 @@ subroutine fuse_2_patches(csite, dp, rp) end if ! We have no need for the dp pointer anymore, we have passed on it's legacy - call dealloc_patch(dp) + call dp%FreeMemory(regeneration_model, numpft) deallocate(dp, stat=istat, errmsg=smsg) if (istat/=0) then write(fates_log(),*) 'dealloc006: fail on deallocate(dp):'//trim(smsg) @@ -2882,10 +2617,10 @@ subroutine terminate_patches(currentSite) type(ed_site_type), target, intent(inout) :: currentSite ! ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: currentPatch - type(ed_patch_type), pointer :: olderPatch - type(ed_patch_type), pointer :: youngerPatch - type(ed_patch_type), pointer :: patchpointer + type(fates_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: olderPatch + type(fates_patch_type), pointer :: youngerPatch + type(fates_patch_type), pointer :: patchpointer integer, parameter :: max_cycles = 10 ! After 10 loops through ! You should had fused integer :: count_cycles @@ -3051,7 +2786,7 @@ subroutine DistributeSeeds(currentSite,seed_mass,el,pft) integer, intent(in) :: pft ! pft index ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch type(litter_type), pointer :: litt @@ -3072,95 +2807,6 @@ subroutine DistributeSeeds(currentSite,seed_mass,el,pft) return end subroutine DistributeSeeds - - ! ===================================================================================== - - subroutine dealloc_patch(cpatch) - - ! This Subroutine is intended to de-allocate the allocatable memory that is pointed - ! to via the patch structure. This subroutine DOES NOT deallocate the patch - ! structure itself. - - type(ed_patch_type) :: cpatch - - type(ed_cohort_type), pointer :: ccohort ! current - type(ed_cohort_type), pointer :: ncohort ! next - integer :: el,pft ! loop counter for elements and pfts - - ! First Deallocate the cohort space - ! ----------------------------------------------------------------------------------- - ccohort => cpatch%shortest - do while(associated(ccohort)) - - ncohort => ccohort%taller - - call DeallocateCohort(ccohort) - deallocate(ccohort, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc007: fail on deallocate(cchort):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - - ccohort => ncohort - - end do - - ! Deallocate all litter objects - do el=1,num_elements - call cpatch%litter(el)%DeallocateLitt() - end do - deallocate(cpatch%litter, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc008: fail on deallocate(cpatch%litter):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - - ! Secondly, deallocate the allocatable vector spaces in the patch - deallocate(cpatch%tr_soil_dir, & - cpatch%tr_soil_dif, & - cpatch%tr_soil_dir_dif, & - cpatch%fab, & - cpatch%fabd, & - cpatch%fabi, & - cpatch%sabs_dir, & - cpatch%sabs_dif, & - cpatch%fragmentation_scaler, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc009: fail on deallocate patch vectors:'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - - ! Deallocate any running means - if ( regeneration_model == TRS_regeneration ) then - deallocate(cpatch%seedling_layer_par24) - deallocate(cpatch%sdlng_mort_par) - deallocate(cpatch%sdlng2sap_par) - do pft = 1, numpft - deallocate(cpatch%sdlng_mdd(pft)%p) - deallocate(cpatch%sdlng_emerg_smp(pft)%p) - enddo - deallocate(cpatch%sdlng_mdd) - deallocate(cpatch%sdlng_emerg_smp) - end if - - deallocate(cpatch%tveg24, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc010: fail on deallocate(cpatch%tveg24):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - deallocate(cpatch%tveg_lpa, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc011: fail on deallocate(cpatch%tveg_lpa):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - deallocate(cpatch%tveg_longterm, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc012: fail on deallocate(cpatch%tveg_longterm):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - return - end subroutine dealloc_patch - ! ============================================================================ subroutine patch_pft_size_profile(cp_pnt) ! @@ -3170,11 +2816,11 @@ subroutine patch_pft_size_profile(cp_pnt) ! !USES: ! ! !ARGUMENTS: - type(ed_patch_type), target, intent(inout) :: cp_pnt + type(fates_patch_type), target, intent(inout) :: cp_pnt ! ! !LOCAL VARIABLES: - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: mind(N_DBH_BINS) ! Bottom of DBH bin real(r8) :: maxd(N_DBH_BINS) ! Top of DBH bin real(r8) :: delta_dbh ! Size of DBH bin @@ -3230,7 +2876,7 @@ function countPatches( nsites, sites ) result ( totNumPatches ) type(ed_site_type) , intent(inout), target :: sites(nsites) ! ! !LOCAL VARIABLES: - type (ed_patch_type), pointer :: currentPatch + type (fates_patch_type), pointer :: currentPatch integer :: totNumPatches ! total number of patches. integer :: s !--------------------------------------------------------------------- @@ -3263,7 +2909,7 @@ subroutine get_frac_site_primary(site_in, frac_site_primary) real(r8) , intent(out) :: frac_site_primary ! !LOCAL VARIABLES: - type (ed_patch_type), pointer :: currentPatch + type (fates_patch_type), pointer :: currentPatch frac_site_primary = 0._r8 currentPatch => site_in%oldest_patch diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index a62a3c1f62..b0dca899f7 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -21,6 +21,7 @@ module EDPhysiologyMod use FatesInterfaceTypesMod, only : hlm_nitrogen_spec use FatesInterfaceTypesMod, only : hlm_phosphorus_spec use FatesInterfaceTypesMod, only : hlm_use_tree_damage + use FatesInterfaceTypesMod, only : hlm_use_ed_prescribed_phys use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : nearzero use FatesConstantsMod, only : sec_per_day @@ -38,11 +39,8 @@ module EDPhysiologyMod use EDPftvarcon , only : GetDecompyFrac use FatesInterfaceTypesMod, only : bc_in_type use FatesInterfaceTypesMod, only : bc_out_type - use EDCohortDynamicsMod , only : zero_cohort use EDCohortDynamicsMod , only : create_cohort, sort_cohorts use EDCohortDynamicsMod , only : InitPRTObject - use EDCohortDynamicsMod , only : InitPRTBoundaryConditions - use EDCohortDynamicsMod , only : copy_cohort use FatesAllometryMod , only : tree_lai use FatesAllometryMod , only : tree_sai use FatesAllometryMod , only : leafc_from_treelai @@ -51,7 +49,9 @@ module EDPhysiologyMod use EDTypesMod , only : site_massbal_type use EDTypesMod , only : numlevsoil_max use EDTypesMod , only : numWaterMem - use EDTypesMod , only : dl_sf, dinc_vai, dlower_vai, area_inv + use FatesLitterMod , only : dl_sf + use EDParamsMod , only : dinc_vai, dlower_vai + use EDTypesMod , only : area_inv use EDTypesMod , only : AREA use FatesLitterMod , only : ncwd use FatesLitterMod , only : ndcmpy @@ -59,17 +59,19 @@ module EDPhysiologyMod use FatesLitterMod , only : ilignin use FatesLitterMod , only : icellulose use FatesLitterMod , only : adjust_SF_CWD_frac - use EDTypesMod , only : nclmax + use EDParamsMod , only : nclmax use EDTypesMod , only : AREA,AREA_INV - use EDTypesMod , only : nlevleaf + use FatesConstantsMod , only : leaves_shedding + use FatesConstantsMod , only : ihard_stress_decid + use FatesConstantsMod , only : isemi_stress_decid + use EDParamsMod , only : nlevleaf use EDTypesMod , only : num_vegtemp_mem - use EDTypesMod , only : maxpft - use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDTypesMod , only : leaves_on - use EDTypesMod , only : leaves_off - use EDTypesMod , only : leaves_shedding - use EDTypesMod , only : ihard_stress_decid - use EDTypesMod , only : isemi_stress_decid + use EDParamsMod , only : maxpft + use EDTypesMod , only : ed_site_type + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod, only : fates_cohort_type + use FatesConstantsMod , only : leaves_on + use FatesConstantsMod , only : leaves_off use EDTypesMod , only : min_n_safemath use PRTGenericMod , only : num_elements use PRTGenericMod , only : element_list @@ -83,6 +85,7 @@ module EDPhysiologyMod use EDTypesMod , only : phen_dstat_moiston use EDTypesMod , only : phen_dstat_timeon use EDTypesMod , only : phen_dstat_pshed + use EDTypesMod , only : phen_dstat_pshed use EDTypesMod , only : init_recruit_trim use shr_log_mod , only : errMsg => shr_log_errMsg use FatesGlobals , only : fates_log @@ -144,6 +147,7 @@ module EDPhysiologyMod public :: phenology public :: satellite_phenology public :: assign_cohort_SP_properties + public :: calculate_SP_properties public :: recruitment public :: ZeroLitterFluxes @@ -204,7 +208,7 @@ subroutine ZeroLitterFluxes( currentSite ) ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch integer :: el @@ -226,8 +230,8 @@ subroutine ZeroAllocationRates( currentSite ) ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) @@ -252,13 +256,13 @@ subroutine GenerateDamageAndLitterFluxes( csite, cpatch, bc_in ) ! Arguments type(ed_site_type) :: csite - type(ed_patch_type) :: cpatch + type(fates_patch_type) :: cpatch type(bc_in_type), intent(in) :: bc_in ! Locals - type(ed_cohort_type), pointer :: ccohort ! Current cohort - type(ed_cohort_type), pointer :: ndcohort ! New damage-class cohort + type(fates_cohort_type), pointer :: ccohort ! Current cohort + type(fates_cohort_type), pointer :: ndcohort ! New damage-class cohort type(litter_type), pointer :: litt ! Points to the litter object type(site_fluxdiags_type), pointer :: flux_diags ! pointer to site level flux diagnostics object integer :: cd ! Damage class index @@ -312,11 +316,11 @@ subroutine GenerateDamageAndLitterFluxes( csite, cpatch, bc_in ) ndcohort%prt => null() call InitPRTObject(ndcohort%prt) - call InitPRTBoundaryConditions(ndcohort) - call zero_cohort(ndcohort) + call ndcohort%InitPRTBoundaryConditions() + call ndcohort%ZeroValues() ! nc_canopy_d is the new cohort that gets damaged - call copy_cohort(ccohort, ndcohort) + call ccohort%Copy(ndcohort) ! new number densities - we just do damaged cohort here - ! undamaged at the end of the cohort loop once we know how many damaged to @@ -441,7 +445,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) ! !ARGUMENTS type(ed_site_type), intent(inout) :: currentSite - type(ed_patch_type), intent(inout) :: currentPatch + type(fates_patch_type), intent(inout) :: currentPatch type(bc_in_type), intent(in) :: bc_in ! @@ -518,7 +522,7 @@ subroutine PreDisturbanceIntegrateLitter(currentPatch) ! ----------------------------------------------------------------------------------- ! Arguments - type(ed_patch_type),intent(inout),target :: currentPatch + type(fates_patch_type),intent(inout),target :: currentPatch ! Locals @@ -601,8 +605,8 @@ subroutine trim_canopy( currentSite ) type (ed_site_type),intent(inout), target :: currentSite ! ! !LOCAL VARIABLES: - type (ed_cohort_type) , pointer :: currentCohort - type (ed_patch_type) , pointer :: currentPatch + type (fates_cohort_type) , pointer :: currentCohort + type (fates_patch_type) , pointer :: currentPatch integer :: z ! leaf layer integer :: ipft ! pft index @@ -923,7 +927,7 @@ subroutine phenology( currentSite, bc_in ) ! ! !LOCAL VARIABLES: - type(ed_patch_type),pointer :: cpatch + type(fates_patch_type),pointer :: cpatch integer :: model_day_int ! integer model day 1 - inf integer :: ncolddays ! no days underneath the threshold for leaf drop integer :: i_wmem ! Loop counter for water mem days @@ -1533,8 +1537,8 @@ subroutine phenology_leafonoff(currentSite) type(ed_site_type), intent(inout), target :: currentSite ! ! !LOCAL VARIABLES: - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: leaf_c ! leaf carbon [kg] real(r8) :: fnrt_c ! fine root carbon [kg] @@ -1773,8 +1777,8 @@ subroutine satellite_phenology(currentSite, bc_in) class(prt_vartypes), pointer :: prt ! !LOCAL VARIABLES: - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: spread ! dummy value of canopy spread to estimate c_area real(r8) :: leaf_c ! leaf carbon estimated to generate target tlai @@ -1878,121 +1882,141 @@ subroutine satellite_phenology(currentSite, bc_in) end subroutine satellite_phenology - ! ===================================================================================== - - subroutine assign_cohort_SP_properties(currentCohort,htop,tlai,tsai,parea,init,leaf_c) - - ! -----------------------------------------------------------------------------------! - ! Takes the daily inputs of leaf area index, stem area index and canopy height and - ! translates them into a FATES structure with one patch and one cohort per PFT - ! The leaf area of the cohort is modified each day to match that asserted by the HLM - ! -----------------------------------------------------------------------------------! - - - type(ed_cohort_type), intent(inout), target :: currentCohort - - real(r8), intent(in) :: tlai ! target leaf area index from SP inputs - real(r8), intent(in) :: tsai ! target stem area index from SP inputs - real(r8), intent(in) :: htop ! target tree height from SP inputs - real(r8), intent(in) :: parea ! patch area for this PFT - integer, intent(in) :: init ! are we in the initialization routine? if so do not set leaf_c - real(r8), intent(out) :: leaf_c ! leaf carbon estimated to generate target tlai + ! ====================================================================================== - real(r8) :: dummy_n ! set cohort n to a dummy value of 1.0 - integer :: fates_pft ! fates pft numer for weighting loop - real(r8) :: spread ! dummy value of canopy spread to estimate c_area - real(r8) :: check_treelai - real(r8) :: canopylai(1:nclmax) - real(r8) :: fracerr - real(r8) :: oldcarea - - ! Do some checks - if(associated(currentCohort%shorter))then - write(fates_log(),*) 'SP mode has >1 cohort' - write(fates_log(),*) "SP mode >1 cohort: PFT",currentCohort%pft, currentCohort%shorter%pft - write(fates_log(),*) "SP mode >1 cohort: CL",currentCohort%canopy_layer, currentCohort%shorter%canopy_layer - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - !------------------------------------------ - ! Calculate dbh from input height, and c_area from dbh - !------------------------------------------ - currentCohort%hite = htop - - fates_pft = currentCohort%pft - call h2d_allom(currentCohort%hite,fates_pft,currentCohort%dbh) - - dummy_n = 1.0_r8 ! make n=1 to get area of one tree. - spread = 1.0_r8 ! fix this to 0 to remove dynamics of canopy closure, assuming a closed canopy. - ! n.b. the value of this will only affect 'n', which isn't/shouldn't be a diagnostic in - ! SP mode. - call carea_allom(currentCohort%dbh,dummy_n,spread,currentCohort%pft,& - currentCohort%crowndamage,currentCohort%c_area) - - !------------------------------------------ - ! Calculate canopy N assuming patch area is full - !------------------------------------------ - currentCohort%n = parea / currentCohort%c_area - - ! correct c_area for the new nplant - call carea_allom(currentCohort%dbh,currentCohort%n,spread,currentCohort%pft,& - currentCohort%crowndamage,currentCohort%c_area) + subroutine calculate_SP_properties(htop, tlai, tsai, parea, pft, crown_damage, & + canopy_layer, vcmax25top, leaf_c, dbh, cohort_n, c_area) + ! + ! DESCRIPTION: + ! Takes the daily inputs of leaf area index, stem area index and canopy height and + ! translates them into a FATES structure with one patch and one cohort per PFT. + ! The leaf area of the cohort is modified each day to match that asserted by the HLM + ! - ! ------------------------------------------ - ! Calculate leaf carbon from target treelai - ! ------------------------------------------ - currentCohort%treelai = tlai + ! ARGUMENTS: + real(r8), intent(in) :: tlai ! target leaf area index from SP inputs [m2 m-2] + real(r8), intent(in) :: tsai ! target stem area index from SP inputs [m2 m-2] + real(r8), intent(in) :: htop ! target tree height from SP inputs [m] + real(r8), intent(in) :: parea ! patch area for this PFT [m2] + real(r8), intent(in) :: vcmax25top ! maximum carboxylation at canopy top and 25degC [umol CO2/m2/s] + integer, intent(in) :: pft ! cohort PFT index + integer, intent(in) :: crown_damage ! cohort crown damage status + integer, intent(in) :: canopy_layer ! canopy status of cohort [1 = canopy, 2 = understorey, etc.] + real(r8), intent(out) :: leaf_c ! leaf carbon estimated to generate target tlai [kgC] + real(r8), intent(out) :: dbh ! cohort diameter at breast height [cm] + real(r8), intent(out) :: cohort_n ! cohort density [/m2] + real(r8), intent(out) :: c_area + + ! LOCAL VARIABLES: + real(r8) :: check_treelai ! check tree LAI against input tlai [m2/m2] + real(r8) :: canopylai(1:nclmax) ! canopy LAI [m2/m2] + real(r8) :: oldcarea ! save value of crown area [m2] + + ! calculate DBH from input height + call h2d_allom(htop, pft, dbh) + + ! calculate canopy area, assuming n = 1.0 and spread = 1.0_r8 + call carea_allom(dbh, 1.0_r8, 1.0_r8, pft, crown_damage, c_area) + + ! calculate canopy N assuming patch area is full + cohort_n = parea/c_area + + ! correct c_area for the new nplant, assuming spread = 1.0 + call carea_allom(dbh, cohort_n, 1.0_r8, pft, crown_damage, c_area) + + ! calculate leaf carbon from target treelai canopylai(:) = 0._r8 - if(init.eq.itrue)then - ! If we are initializing, the canopy layer has not been set yet, so just set to 1 - currentCohort%canopy_layer = 1 - ! We need to get the vcmax25top - currentCohort%vcmax25top = EDPftvarcon_inst%vcmax25top(currentCohort%pft,1) - endif - leaf_c = leafc_from_treelai( currentCohort%treelai, currentCohort%pft, currentCohort%c_area,& - currentCohort%n, currentCohort%canopy_layer, currentCohort%vcmax25top) + leaf_c = leafc_from_treelai(tlai, pft, c_area, cohort_n, canopy_layer, vcmax25top) - !check that the inverse calculation of leafc from treelai is the same as the + ! check that the inverse calculation of leafc from treelai is the same as the ! standard calculation of treelai from leafc. Maybe can delete eventually? + check_treelai = tree_lai(leaf_c, pft, c_area, cohort_n, canopy_layer, & + canopylai, vcmax25top) - check_treelai = tree_lai(leaf_c, currentCohort%pft, currentCohort%c_area, & - currentCohort%n, currentCohort%canopy_layer, & - canopylai,currentCohort%vcmax25top ) - - if( abs(currentCohort%treelai-check_treelai).gt.1.0e-12)then !this is not as precise as nearzero - write(fates_log(),*) 'error in validate treelai',currentCohort%treelai,check_treelai,currentCohort%treelai-check_treelai - write(fates_log(),*) 'tree_lai inputs: ', currentCohort%pft, currentCohort%c_area, currentCohort%n, & - currentCohort%canopy_layer, currentCohort%vcmax25top + if (abs(tlai - check_treelai) .gt. 1.0e-12) then !this is not as precise as nearzero + write(fates_log(),*) 'error in validate treelai', tlai, check_treelai, tlai - check_treelai + write(fates_log(),*) 'tree_lai inputs: ', pft, c_area, cohort_n, & + canopy_layer, vcmax25top call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! the carea_allom routine sometimes generates precision-tolerance level errors in the canopy area ! these mean that the canopy area does not exactly add up to the patch area, which causes chaos in ! the radiation routines. Correct both the area and the 'n' to remove error, and don't use - !! carea_allom in SP mode after this point. - - if(abs(currentCohort%c_area-parea).gt.nearzero)then ! there is an error - if(abs(currentCohort%c_area-parea).lt.10.e-9)then !correct this if it's a very small error - oldcarea = currentCohort%c_area - !generate new cohort area - currentCohort%c_area = currentCohort%c_area - (currentCohort%c_area- parea) - currentCohort%n = currentCohort%n * (currentCohort%c_area/oldcarea) - if(abs(currentCohort%c_area-parea).gt.nearzero)then - write(fates_log(),*) 'SPassign, c_area still broken',currentCohort%c_area-parea,currentCohort%c_area-oldcarea - call endrun(msg=errMsg(sourcefile, __LINE__)) + ! carea_allom in SP mode after this point. + + if (abs(c_area - parea) .gt. nearzero) then ! there is an error + if (abs(c_area - parea) .lt. 10.e-9) then ! correct this if it's a very small error + oldcarea = c_area + ! generate new cohort area + c_area = c_area - (c_area - parea) + cohort_n = cohort_n*(c_area/oldcarea) + if (abs(c_area-parea) .gt. nearzero) then + write(fates_log(),*) 'SPassign, c_area still broken', c_area - parea, c_area - oldcarea + call endrun(msg=errMsg(sourcefile, __LINE__)) end if else - write(fates_log(),*) 'SPassign, big error in c_area',currentCohort%c_area-parea,currentCohort%pft + write(fates_log(),*) 'SPassign, big error in c_area', c_area - parea, pft end if ! still broken end if !small error - if(init.eq.ifalse)then - call SetState(currentCohort%prt, leaf_organ, carbon12_element, leaf_c, 1) + end subroutine calculate_SP_properties + + ! ====================================================================================== + + subroutine assign_cohort_SP_properties(currentCohort, htop, tlai, tsai, parea, init, & + leaf_c) + ! + ! DESCRIPTION: + ! Takes the daily inputs of leaf area index, stem area index and canopy height and + ! translates them into a FATES structure with one patch and one cohort per PFT. + ! The leaf area of the cohort is modified each day to match that asserted by the HLM + + + ! ARGUMENTS + type(fates_cohort_type), intent(inout), target :: currentCohort ! cohort object + real(r8), intent(in) :: tlai ! target leaf area index from SP inputs [m2/m2] + real(r8), intent(in) :: tsai ! target stem area index from SP inputs [m2/m2] + real(r8), intent(in) :: htop ! target tree height from SP inputs [m] + real(r8), intent(in) :: parea ! patch area for this PFT [m2] + integer, intent(in) :: init ! are we in the initialization routine? if so do not set leaf_c + real(r8), intent(out) :: leaf_c ! leaf carbon estimated to generate target tlai [kgC] + + ! LOCAL VARIABLES + real(r8) :: dbh ! cohort dbh [cm] + real(r8) :: cohort_n ! cohort density [/m2] + real(r8) :: c_area ! cohort canopy area [m2] + + if (associated(currentCohort%shorter)) then + write(fates_log(),*) 'SP mode has >1 cohort' + write(fates_log(),*) "SP mode >1 cohort: PFT", currentCohort%pft, currentCohort%shorter%pft + write(fates_log(),*) "SP mode >1 cohort: CL", currentCohort%canopy_layer, currentCohort%shorter%canopy_layer + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + if (init .eq. itrue) then + ! If we are initializing, the canopy layer has not been set yet, so just set to 1 + currentCohort%canopy_layer = 1 + ! We need to get the vcmax25top + currentCohort%vcmax25top = EDPftvarcon_inst%vcmax25top(currentCohort%pft, 1) endif - ! assert sai + call calculate_SP_properties(htop, tlai, tsai, parea, currentCohort%pft, & + currentCohort%crowndamage, currentCohort%canopy_layer, currentCohort%vcmax25top, & + leaf_c, dbh, cohort_n, c_area) + + ! set allometric characteristics + currentCohort%hite = htop + currentCohort%dbh = dbh + currentCohort%n = cohort_n + currentCohort%c_area = c_area + currentCohort%treelai = tlai currentCohort%treesai = tsai + if (init .eq. ifalse) then + call SetState(currentCohort%prt, leaf_organ, carbon12_element, leaf_c, 1) + endif + end subroutine assign_cohort_SP_properties ! ===================================================================================== @@ -2019,9 +2043,9 @@ subroutine SeedIn( currentSite, bc_in ) type(ed_site_type), intent(inout), target :: currentSite type(bc_in_type), intent(in) :: bc_in - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch type(litter_type), pointer :: litt - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort type(site_massbal_type), pointer :: site_mass integer :: pft @@ -2164,7 +2188,7 @@ subroutine SeedDecay( litt , currentPatch, bc_in ) ! ! !ARGUMENTS type(litter_type) :: litt - type(ed_patch_type), intent(in) :: currentPatch ! ahb added this + type(fates_patch_type), intent(in) :: currentPatch ! ahb added this type(bc_in_type), intent(in) :: bc_in ! ahb added this ! ! !LOCAL VARIABLES: @@ -2284,7 +2308,7 @@ subroutine SeedGermination( litt, cold_stat, drought_stat, bc_in, currentPatch ) integer , intent(in) :: cold_stat ! Is the site in cold leaf-off status? integer, dimension(numpft), intent(in) :: drought_stat ! Is the site in drought leaf-off status? type(bc_in_type), intent(in) :: bc_in - type(ed_patch_type), intent(in) :: currentPatch + type(fates_patch_type), intent(in) :: currentPatch ! ! !LOCAL VARIABLES: integer :: pft @@ -2397,378 +2421,321 @@ end subroutine SeedGermination ! ===================================================================================== - - - - ! ===================================================================================== - - subroutine recruitment( currentSite, currentPatch, bc_in ) - ! - ! !DESCRIPTION: - ! spawn new cohorts of juveniles of each PFT - ! - ! !USES: - use FatesInterfaceTypesMod, only : hlm_use_ed_prescribed_phys - use FatesLitterMod , only : ncwd - - ! - ! !ARGUMENTS - type(ed_site_type), intent(inout) :: currentSite - type(ed_patch_type), intent(inout),pointer :: currentPatch - type(bc_in_type), intent(in) :: bc_in - ! - ! !LOCAL VARIABLES: - class(prt_vartypes), pointer :: prt - integer :: ft - integer :: c - type (ed_cohort_type) , pointer :: temp_cohort - type (litter_type), pointer :: litt ! The litter object (carbon right now) - type(site_massbal_type), pointer :: site_mass ! For accounting total in-out mass fluxes - integer :: el ! loop counter for element - integer :: element_id ! element index consistent with definitions in PRTGenericMod - integer :: iage ! age loop counter for leaf age bins - integer :: crowndamage - integer,parameter :: recruitstatus = 1 !weather it the new created cohorts is recruited or initialized - real(r8) :: c_leaf ! target leaf biomass [kgC] - real(r8) :: c_fnrt ! target fine root biomass [kgC] - real(r8) :: c_sapw ! target sapwood biomass [kgC] - real(r8) :: a_sapw ! target sapwood cross section are [m2] (dummy) - real(r8) :: c_agw ! target Above ground biomass [kgC] - real(r8) :: c_bgw ! target Below ground biomass [kgC] - real(r8) :: c_struct ! target Structural biomass [kgc] - real(r8) :: c_store ! target Storage biomass [kgC] - real(r8) :: m_leaf ! leaf mass (element agnostic) [kg] - real(r8) :: m_fnrt ! fine-root mass (element agnostic) [kg] - real(r8) :: m_sapw ! sapwood mass (element agnostic) [kg] - real(r8) :: m_agw ! AG wood mass (element agnostic) [kg] - real(r8) :: m_bgw ! BG wood mass (element agnostic) [kg] - real(r8) :: m_struct ! structural mass (element agnostic) [kg] - real(r8) :: m_store ! storage mass (element agnostic) [kg] - real(r8) :: m_repro ! reproductive mass (element agnostic) [kg] - real(r8) :: mass_avail ! The mass of each nutrient/carbon available in the seed_germination pool [kg] - real(r8) :: mass_demand ! Total mass demanded by the plant to achieve the stoichiometric targets - ! of all the organs in the recruits. Used for both [kg per plant] and [kg per cohort] - real(r8) :: fnrt_drop_fraction - real(r8) :: stem_drop_fraction - real(r8) :: sdlng2sap_par ! running mean of par at the seedlng layer [MJ m-2 day-1] - real(r8) :: seedling_layer_smp !soil matric potential at seedling rooting depth [mm H20 suction] - integer :: ilayer_seedling_root ! the soil layer at seedling rooting depth - !---------------------------------------------------------------------- - - allocate(temp_cohort) ! create temporary cohort - call zero_cohort(temp_cohort) - - - do ft = 1,numpft - - ! The following if block is for the prescribed biogeography and/or nocomp modes. - ! Since currentSite%use_this_pft is a site-level quantity and thus only limits whether a given PFT - ! is permitted on a given gridcell or not, it applies to the prescribed biogeography case only. - ! If nocomp is enabled, then we must determine whether a given PFT is allowed on a given patch or not. - - if(currentSite%use_this_pft(ft).eq.itrue & - .and. ((hlm_use_nocomp .eq. ifalse) .or. (ft .eq. currentPatch%nocomp_pft_label)))then - - temp_cohort%canopy_trim = init_recruit_trim - temp_cohort%pft = ft - temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) - temp_cohort%coage = 0.0_r8 - fnrt_drop_fraction = prt_params%phen_fnrt_drop_fraction(ft) - stem_drop_fraction = prt_params%phen_stem_drop_fraction(ft) - temp_cohort%l2fr = currentSite%rec_l2fr(ft,currentPatch%NCL_p) - temp_cohort%crowndamage = 1 ! new recruits are undamaged - - call h2d_allom(temp_cohort%hite,ft,temp_cohort%dbh) - - ! Default assumption is that leaves are on and fully flushed - temp_cohort%efleaf_coh = 1.0_r8 - temp_cohort%effnrt_coh = 1.0_r8 - temp_cohort%efstem_coh = 1.0_r8 - temp_cohort%status_coh = leaves_on - - ! But if the plant is seasonally (cold) deciduous, and the site status is flagged - ! as "cold", then set the cohort's status to leaves_off, and remember the leaf biomass - if ((prt_params%season_decid(ft) == itrue) .and. & - (any(currentSite%cstatus == [phen_cstat_nevercold,phen_cstat_iscold]))) then - temp_cohort%efleaf_coh = 0.0_r8 - temp_cohort%effnrt_coh = 1.0_r8 - fnrt_drop_fraction - temp_cohort%efstem_coh = 1.0_r8 - stem_drop_fraction - temp_cohort%status_coh = leaves_off - - endif - - ! Or.. if the plant is drought deciduous, make sure leaf status is consistent with the - ! leaf elongation factor. - ! For tissues other than leaves, the actual drop fraction is a combination of the - ! elongation factor (e) and the drop fraction (x), which will ensure that the remaining - ! tissue biomass will be exactly e when x=1, and exactly the original biomass when x = 0. - select case (prt_params%stress_decid(ft)) - case (ihard_stress_decid,isemi_stress_decid) - temp_cohort%efleaf_coh = currentSite%elong_factor(ft) - temp_cohort%effnrt_coh = 1.0_r8 - (1.0_r8 - temp_cohort%efleaf_coh ) * fnrt_drop_fraction - temp_cohort%efstem_coh = 1.0_r8 - (1.0_r8 - temp_cohort%efleaf_coh ) * stem_drop_fraction - - ! For the initial state, we always assume that leaves are flushing (instead of partially abscissing) - ! whenever the elongation factor is non-zero. If the elongation factor is zero, then leaves are in - ! the "off" state. - if ( temp_cohort%efleaf_coh > 0.0_r8 ) then - temp_cohort%status_coh = leaves_on - else - temp_cohort%status_coh = leaves_off - end if - end select - - - ! Initialize live pools - call bleaf(temp_cohort%dbh,ft,temp_cohort%crowndamage,& - temp_cohort%canopy_trim, temp_cohort%efleaf_coh, c_leaf) - call bfineroot(temp_cohort%dbh,ft,temp_cohort%canopy_trim,temp_cohort%l2fr, & - temp_cohort%effnrt_coh, c_fnrt) - call bsap_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, & - temp_cohort%canopy_trim, temp_cohort%efstem_coh, a_sapw, c_sapw) - call bagw_allom(temp_cohort%dbh,ft,temp_cohort%crowndamage, temp_cohort%efstem_coh, c_agw) - call bbgw_allom(temp_cohort%dbh,ft, temp_cohort%efstem_coh, c_bgw) - call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) - call bstore_allom(temp_cohort%dbh,ft, temp_cohort%crowndamage, & - temp_cohort%canopy_trim,c_store) - - - ! Cycle through available carbon and nutrients, find the limiting element - ! to dictate the total number of plants that can be generated - - if_not_presribed: if ( (hlm_use_ed_prescribed_phys .eq. ifalse) .or. & - (EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0._r8) ) then - - temp_cohort%n = 1.e20_r8 - - do_elem: do el = 1,num_elements - - element_id = element_list(el) - select case(element_id) - case(carbon12_element) - - mass_demand = c_struct+c_leaf+c_fnrt+c_sapw+c_store - - case(nitrogen_element) - - mass_demand = & - c_struct*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(struct_organ)) + & - c_leaf*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(leaf_organ)) + & - c_fnrt*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) + & - c_sapw*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + & - StorageNutrientTarget(ft, element_id, & - c_leaf*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(leaf_organ)), & - c_fnrt*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)), & - c_sapw*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)), & - c_struct*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(struct_organ))) - - case(phosphorus_element) - - mass_demand = & - c_struct*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(struct_organ)) + & - c_leaf*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(leaf_organ)) + & - c_fnrt*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) + & - c_sapw*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + & - StorageNutrientTarget(ft, element_id, & - c_leaf*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(leaf_organ)), & - c_fnrt*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)), & - c_sapw*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)), & - c_struct*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(struct_organ))) - - case default - write(fates_log(),*) 'Undefined element type in recruitment' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - ! If TRS seedling dynamics is switched off then the available mass to make new recruits - ! is everything in the seed_germ pool. - if ( regeneration_model == default_regeneration .or. & - regeneration_model == TRS_no_seedling_dyn .or. & - prt_params%allom_dbh_maxheight(ft) < min_max_dbh_for_trees ) then - - mass_avail = currentPatch%area * currentPatch%litter(el)%seed_germ(ft) - - ! If TRS seedling dynamics is on then calculate the available mass to make new recruits - ! as a pft-specific function of light and soil moisture in the seedling layer. - else if ( regeneration_model == TRS_regeneration .and. & - prt_params%allom_dbh_maxheight(ft) > min_max_dbh_for_trees ) then - - sdlng2sap_par = currentPatch%sdlng2sap_par%GetMean() * sec_per_day * megajoules_per_joule - - mass_avail = currentPatch%area * currentPatch%litter(el)%seed_germ(ft) * & - EDPftvarcon_inst%seedling_light_rec_a(ft) * & + subroutine recruitment(currentSite, currentPatch, bc_in) + ! + ! DESCRIPTION: + ! spawn new cohorts of juveniles of each PFT + ! + + ! ARGUMENTS: + type(ed_site_type), intent(inout) :: currentSite + type(fates_patch_type), intent(inout), pointer :: currentPatch + type(bc_in_type), intent(in) :: bc_in + + ! LOCAL VARIABLES: + class(prt_vartypes), pointer :: prt ! PARTEH object + type(litter_type), pointer :: litt ! litter object (carbon right now) + type(site_massbal_type), pointer :: site_mass ! for accounting total in-out mass fluxes + integer :: ft ! loop counter for PFTs + integer :: leaf_status ! cohort phenology status [leaves on/off] + integer :: el ! loop counter for element + integer :: element_id ! element index consistent with definitions in PRTGenericMod + integer :: iage ! age loop counter for leaf age bins + integer :: crowndamage ! crown damage class of the cohort [1 = undamaged, >1 = damaged] + real(r8) :: hite ! new cohort height [m] + real(r8) :: dbh ! new cohort DBH [cm] + real(r8) :: cohort_n ! new cohort density + real(r8) :: l2fr ! leaf to fineroot biomass ratio [0-1] + real(r8) :: c_leaf ! target leaf biomass [kgC] + real(r8) :: c_fnrt ! target fine root biomass [kgC] + real(r8) :: c_sapw ! target sapwood biomass [kgC] + real(r8) :: a_sapw ! target sapwood cross section are [m2] (dummy) + real(r8) :: c_agw ! target Above ground biomass [kgC] + real(r8) :: c_bgw ! target Below ground biomass [kgC] + real(r8) :: c_struct ! target Structural biomass [kgc] + real(r8) :: c_store ! target Storage biomass [kgC] + real(r8) :: m_leaf ! leaf mass (element agnostic) [kg] + real(r8) :: m_fnrt ! fine-root mass (element agnostic) [kg] + real(r8) :: m_sapw ! sapwood mass (element agnostic) [kg] + real(r8) :: m_agw ! AG wood mass (element agnostic) [kg] + real(r8) :: m_bgw ! BG wood mass (element agnostic) [kg] + real(r8) :: m_struct ! structural mass (element agnostic) [kg] + real(r8) :: m_store ! storage mass (element agnostic) [kg] + real(r8) :: m_repro ! reproductive mass (element agnostic) [kg] + real(r8) :: efleaf_coh + real(r8) :: effnrt_coh + real(r8) :: efstem_coh + real(r8) :: mass_avail ! mass of each nutrient/carbon available in the seed_germination pool [kg] + real(r8) :: mass_demand ! total mass demanded by the plant to achieve the stoichiometric + ! targets of all the organs in the recruits. Used for both [kg per plant] and [kg per cohort] + real(r8) :: stem_drop_fraction ! + real(r8) :: fnrt_drop_fraction ! + real(r8) :: sdlng2sap_par ! running mean of PAR at the seedling layer [MJ/m2/day] + real(r8) :: seedling_layer_smp ! soil matric potential at seedling rooting depth [mm H2O suction] + integer, parameter :: recruitstatus = 1 ! whether the newly created cohorts are recruited or initialized + integer :: ilayer_seedling_root ! the soil layer at seedling rooting depth + + !--------------------------------------------------------------------------- + + do ft = 1, numpft + + ! The following if block is for the prescribed biogeography and/or nocomp modes. + ! Since currentSite%use_this_pft is a site-level quantity and thus only limits whether a given PFT + ! is permitted on a given gridcell or not, it applies to the prescribed biogeography case only. + ! If nocomp is enabled, then we must determine whether a given PFT is allowed on a given patch or not. + + if (currentSite%use_this_pft(ft) .eq. itrue .and. & + ((hlm_use_nocomp .eq. ifalse) .or. & + (ft .eq. currentPatch%nocomp_pft_label))) then + + hite = EDPftvarcon_inst%hgt_min(ft) + stem_drop_fraction = prt_params%phen_stem_drop_fraction(ft) + fnrt_drop_fraction = prt_params%phen_fnrt_drop_fraction(ft) + l2fr = currentSite%rec_l2fr(ft, currentPatch%NCL_p) + crowndamage = 1 ! new recruits are undamaged + + ! calculate DBH from initial height + call h2d_allom(hite, ft, dbh) + + ! default assumption is that leaves are on + efleaf_coh = 1.0_r8 + effnrt_coh = 1.0_r8 + efstem_coh = 1.0_r8 + leaf_status = leaves_on + + ! but if the plant is seasonally (cold) deciduous, and the site status is flagged + ! as "cold", then set the cohort's status to leaves_off, and remember the leaf biomass + if ((prt_params%season_decid(ft) == itrue) .and. & + (any(currentSite%cstatus == [phen_cstat_nevercold, phen_cstat_iscold]))) then + efleaf_coh = 0.0_r8 + effnrt_coh = 1.0_r8 - fnrt_drop_fraction + efstem_coh = 1.0_r8 - stem_drop_fraction + leaf_status = leaves_off + end if + + ! Or.. if the plant is drought deciduous, make sure leaf status is consistent with the + ! leaf elongation factor. + ! For tissues other than leaves, the actual drop fraction is a combination of the + ! elongation factor (e) and the drop fraction (x), which will ensure that the remaining + ! tissue biomass will be exactly e when x=1, and exactly the original biomass when x = 0. + select case (prt_params%stress_decid(ft)) + case (ihard_stress_decid, isemi_stress_decid) + efleaf_coh = currentSite%elong_factor(ft) + effnrt_coh = 1.0_r8 - (1.0_r8 - efleaf_coh)*fnrt_drop_fraction + efstem_coh = 1.0_r8 - (1.0_r8 - efleaf_coh)*stem_drop_fraction + + ! For the initial state, we always assume that leaves are flushing (instead of partially abscissing) + ! whenever the elongation factor is non-zero. If the elongation factor is zero, then leaves are in + ! the "off" state. + if (efleaf_coh > 0.0_r8) then + leaf_status = leaves_on + else + leaf_status = leaves_off + end if + end select + + ! calculate live pools + call bleaf(dbh, ft, crowndamage, init_recruit_trim, efleaf_coh, & + c_leaf) + call bfineroot(dbh, ft, init_recruit_trim, l2fr, effnrt_coh, c_fnrt) + call bsap_allom(dbh, ft, crowndamage, init_recruit_trim, & + efstem_coh, a_sapw, c_sapw) + call bagw_allom(dbh, ft, crowndamage, efstem_coh, c_agw) + call bbgw_allom(dbh, ft, efstem_coh, c_bgw) + call bdead_allom(c_agw, c_bgw, c_sapw, ft, c_struct) + call bstore_allom(dbh, ft, crowndamage, init_recruit_trim, c_store) + + ! cycle through available carbon and nutrients, find the limiting element + ! to dictate the total number of plants that can be generated + if_not_prescribed: if ((hlm_use_ed_prescribed_phys .eq. ifalse) .or. & + (EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0._r8)) then + + cohort_n = 1.e20_r8 + + do_elem: do el = 1, num_elements + element_id = element_list(el) + select case(element_id) + case(carbon12_element) + mass_demand = c_struct + c_leaf + c_fnrt + c_sapw + c_store + case(nitrogen_element) + mass_demand = & + c_struct*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(struct_organ)) + & + c_leaf*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(leaf_organ)) + & + c_fnrt*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(fnrt_organ)) + & + c_sapw*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(sapw_organ)) + & + StorageNutrientTarget(ft, element_id, & + c_leaf*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(leaf_organ)), & + c_fnrt*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(fnrt_organ)), & + c_sapw*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(sapw_organ)), & + c_struct*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(struct_organ))) + case(phosphorus_element) + mass_demand = & + c_struct*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(struct_organ)) + & + c_leaf*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(leaf_organ)) + & + c_fnrt*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(fnrt_organ)) + & + c_sapw*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(sapw_organ)) + & + StorageNutrientTarget(ft, element_id, & + c_leaf*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(leaf_organ)), & + c_fnrt*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(fnrt_organ)), & + c_sapw*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(sapw_organ)), & + c_struct*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(struct_organ))) + case default + write(fates_log(),*) 'Undefined element type in recruitment' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + ! If TRS seedling dynamics is switched off then the available mass to make new recruits + ! is everything in the seed_germ pool. + if (regeneration_model == default_regeneration .or. & + regeneration_model == TRS_no_seedling_dyn .or. & + prt_params%allom_dbh_maxheight(ft) < min_max_dbh_for_trees) then + + mass_avail = currentPatch%area * currentPatch%litter(el)%seed_germ(ft) + + ! If TRS seedling dynamics is on then calculate the available mass to make new recruits + ! as a pft-specific function of light and soil moisture in the seedling layer. + else if (regeneration_model == TRS_regeneration .and. & + prt_params%allom_dbh_maxheight(ft) > min_max_dbh_for_trees) then + + sdlng2sap_par = currentPatch%sdlng2sap_par%GetMean()* & + sec_per_day*megajoules_per_joule + + mass_avail = currentPatch%area* & + currentPatch%litter(el)%seed_germ(ft)* & + EDPftvarcon_inst%seedling_light_rec_a(ft)* & sdlng2sap_par**EDPftvarcon_inst%seedling_light_rec_b(ft) - - - ! If soil moisture is below pft-specific seedling moisture stress threshold the - ! recruitment does not occur. - ilayer_seedling_root = minloc(abs(bc_in%z_sisl(:)-EDPftvarcon_inst%seedling_root_depth(ft)),dim=1) - - seedling_layer_smp = bc_in%smp_sl(ilayer_seedling_root) - - if ( seedling_layer_smp < EDPftvarcon_inst%seedling_psi_crit(ft) ) then - - mass_avail = 0.0_r8 - - end if ! End check if soil moisture is sufficient for recruitment - - end if ! End use TRS with seedling dynamics - - ! ------------------------------------------------------------------------ - ! Update number density if this is the limiting mass - ! ------------------------------------------------------------------------ - - temp_cohort%n = min(temp_cohort%n, mass_avail/mass_demand) - - end do do_elem - - else - - ! prescribed recruitment rates. number per sq. meter per year - temp_cohort%n = currentPatch%area * & - EDPftvarcon_inst%prescribed_recruitment(ft) * & - hlm_freq_day + ! If soil moisture is below pft-specific seedling moisture stress threshold the + ! recruitment does not occur. + ilayer_seedling_root = minloc(abs(bc_in%z_sisl(:) - & + EDPftvarcon_inst%seedling_root_depth(ft)), dim=1) - endif if_not_presribed + seedling_layer_smp = bc_in%smp_sl(ilayer_seedling_root) - ! Only bother allocating a new cohort if there is a reasonable amount of it - any_recruits: if (temp_cohort%n > min_n_safemath )then + if (seedling_layer_smp < EDPftvarcon_inst%seedling_psi_crit(ft)) then + mass_avail = 0.0_r8 + end if - ! ----------------------------------------------------------------------------- - ! PART II. - ! Initialize the PARTEH object, and determine the initial masses of all - ! organs and elements. - ! ----------------------------------------------------------------------------- - prt => null() - call InitPRTObject(prt) + end if ! End use TRS with seedling dynamics - do el = 1,num_elements + ! update number density if this is the limiting mass + cohort_n = min(cohort_n, mass_avail/mass_demand) - element_id = element_list(el) + end do do_elem - ! If this is carbon12, then the initialization is straight forward - ! otherwise, we use stoichiometric ratios - select case(element_id) - case(carbon12_element) - - m_struct = c_struct - m_leaf = c_leaf - m_fnrt = c_fnrt - m_sapw = c_sapw - m_store = c_store - m_repro = 0._r8 - - case(nitrogen_element) - - m_struct = c_struct*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(struct_organ)) - m_leaf = c_leaf*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(leaf_organ)) - m_fnrt = c_fnrt*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) - m_sapw = c_sapw*prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) - m_store = StorageNutrientTarget(ft, element_id, m_leaf, m_fnrt, m_sapw, m_struct ) - m_repro = 0._r8 - - case(phosphorus_element) - - m_struct = c_struct*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(struct_organ)) - m_leaf = c_leaf*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(leaf_organ)) - m_fnrt = c_fnrt*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) - m_sapw = c_sapw*prt_params%phos_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) - m_store = StorageNutrientTarget(ft, element_id, m_leaf, m_fnrt, m_sapw, m_struct ) - m_repro = 0._r8 - - end select - - select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) - - ! Put all of the leaf mass into the first bin - call SetState(prt,leaf_organ, element_id,m_leaf,1) - do iage = 2,nleafage - call SetState(prt,leaf_organ, element_id,0._r8,iage) - end do - - call SetState(prt,fnrt_organ, element_id, m_fnrt) - call SetState(prt,sapw_organ, element_id, m_sapw) - call SetState(prt,store_organ, element_id, m_store) - call SetState(prt,struct_organ, element_id, m_struct) - call SetState(prt,repro_organ, element_id, m_repro) - - case default - write(fates_log(),*) 'Unspecified PARTEH module during create_cohort' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - site_mass => currentSite%mass_balance(el) - - ! Remove mass from the germination pool. However, if we are use prescribed physiology, - ! AND the forced recruitment model, then we are not realling using the prognostic - ! seed_germination model, so we have to short circuit things. We send all of the - ! seed germination mass to an outflux pool, and use an arbitrary generic input flux - ! to balance out the new recruits. - - if ( (hlm_use_ed_prescribed_phys .eq. itrue ) .and. & - (EDPftvarcon_inst%prescribed_recruitment(ft) .ge. 0._r8 )) then - - site_mass%flux_generic_in = site_mass%flux_generic_in + & - temp_cohort%n*(m_struct + m_leaf + m_fnrt + m_sapw + m_store + m_repro) - - site_mass%flux_generic_out = site_mass%flux_generic_out + & - currentPatch%area * currentPatch%litter(el)%seed_germ(ft) - - currentPatch%litter(el)%seed_germ(ft) = 0._r8 - - - else - - currentPatch%litter(el)%seed_germ(ft) = currentPatch%litter(el)%seed_germ(ft) - & - temp_cohort%n / currentPatch%area * & - (m_struct + m_leaf + m_fnrt + m_sapw + m_store + m_repro) - - end if - - - - end do - - ! This call cycles through the initial conditions, and makes sure that they - ! are all initialized. - ! ----------------------------------------------------------------------------------- - - call prt%CheckInitialConditions() - - ! This initializes the cohort - - call create_cohort(currentSite,currentPatch, temp_cohort%pft, temp_cohort%n, & - temp_cohort%hite, temp_cohort%coage, temp_cohort%dbh, prt, & - temp_cohort%efleaf_coh, temp_cohort%effnrt_coh, temp_cohort%efstem_coh, & - temp_cohort%status_coh, recruitstatus, & - temp_cohort%canopy_trim,temp_cohort%c_area, & - currentPatch%NCL_p, & - temp_cohort%crowndamage, & - currentSite%spread, bc_in) - - ! Note that if hydraulics is on, the number of cohorts may had - ! changed due to hydraulic constraints. - ! This constaint is applied during "create_cohort" subroutine. - - ! keep track of how many individuals were recruited for passing to history - currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n - - endif any_recruits - endif !use_this_pft - enddo !pft loop - - deallocate(temp_cohort, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc013: fail on deallocate(temp_cohort):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - - - end subroutine recruitment - - ! ============================================================================ + else + ! prescribed recruitment rates. number per sq. meter per year + cohort_n = currentPatch%area*EDPftvarcon_inst%prescribed_recruitment(ft) * & + hlm_freq_day + endif if_not_prescribed + + ! Only bother allocating a new cohort if there is a reasonable amount of it + any_recruits: if (cohort_n > min_n_safemath) then + + ! -------------------------------------------------------------------------------- + ! PART II. + ! Initialize the PARTEH object, and determine the initial masses of all + ! organs and elements. + ! -------------------------------------------------------------------------------- + + prt => null() + call InitPRTObject(prt) + + do el = 1,num_elements + + element_id = element_list(el) + + ! If this is carbon12, then the initialization is straight forward + ! otherwise, we use stoichiometric ratios + select case(element_id) + case(carbon12_element) + m_struct = c_struct + m_leaf = c_leaf + m_fnrt = c_fnrt + m_sapw = c_sapw + m_store = c_store + m_repro = 0._r8 + case(nitrogen_element) + m_struct = c_struct*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%nitr_stoich_p1(ft, prt_params%organ_param_id(sapw_organ)) + m_store = StorageNutrientTarget(ft, element_id, m_leaf, m_fnrt, m_sapw, m_struct) + m_repro = 0._r8 + case(phosphorus_element) + m_struct = c_struct*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%phos_stoich_p1(ft, prt_params%organ_param_id(sapw_organ)) + m_store = StorageNutrientTarget(ft, element_id, m_leaf, m_fnrt, m_sapw, m_struct) + m_repro = 0._r8 + end select + + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp, prt_cnp_flex_allom_hyp) + + ! put all of the leaf mass into the first bin + call SetState(prt, leaf_organ, element_id, m_leaf, 1) + do iage = 2, nleafage + call SetState(prt,leaf_organ, element_id, 0._r8, iage) + end do + + call SetState(prt, fnrt_organ, element_id, m_fnrt) + call SetState(prt, sapw_organ, element_id, m_sapw) + call SetState(prt, store_organ, element_id, m_store) + call SetState(prt, struct_organ, element_id, m_struct) + call SetState(prt, repro_organ, element_id, m_repro) + + case default + write(fates_log(),*) 'Unspecified PARTEH module during create_cohort' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + site_mass => currentSite%mass_balance(el) + + ! Remove mass from the germination pool. However, if we are use prescribed physiology, + ! AND the forced recruitment model, then we are not realling using the prognostic + ! seed_germination model, so we have to short circuit things. We send all of the + ! seed germination mass to an outflux pool, and use an arbitrary generic input flux + ! to balance out the new recruits. + if ((hlm_use_ed_prescribed_phys .eq. itrue) .and. & + (EDPftvarcon_inst%prescribed_recruitment(ft) .ge. 0._r8)) then + + site_mass%flux_generic_in = site_mass%flux_generic_in + & + cohort_n*(m_struct + m_leaf + m_fnrt + m_sapw + m_store + m_repro) + + site_mass%flux_generic_out = site_mass%flux_generic_out + & + currentPatch%area * currentPatch%litter(el)%seed_germ(ft) + + currentPatch%litter(el)%seed_germ(ft) = 0._r8 + else + currentPatch%litter(el)%seed_germ(ft) = & + currentPatch%litter(el)%seed_germ(ft) - cohort_n / currentPatch%area * & + (m_struct + m_leaf + m_fnrt + m_sapw + m_store + m_repro) + end if + end do + + ! cycle through the initial conditions, and makes sure that they are all initialized + call prt%CheckInitialConditions() + + call create_cohort(currentSite, currentPatch, ft, cohort_n, & + hite, 0.0_r8, dbh, prt, efleaf_coh, effnrt_coh, efstem_coh, & + leaf_status, recruitstatus, init_recruit_trim, 0.0_r8, & + currentPatch%NCL_p, crowndamage, currentSite%spread, bc_in) + + ! Note that if hydraulics is on, the number of cohorts may have + ! changed due to hydraulic constraints. + ! This constaint is applied during "create_cohort" subroutine. + + ! keep track of how many individuals were recruited for passing to history + currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + cohort_n + + endif any_recruits + endif !use_this_pft + enddo !pft loop + end subroutine recruitment + + ! ====================================================================================== subroutine CWDInput( currentSite, currentPatch, litt, bc_in) @@ -2785,13 +2752,13 @@ subroutine CWDInput( currentSite, currentPatch, litt, bc_in) ! ! !ARGUMENTS type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type),intent(inout), target :: currentPatch + type(fates_patch_type),intent(inout), target :: currentPatch type(litter_type),intent(inout),target :: litt type(bc_in_type),intent(in) :: bc_in ! ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort type(site_fluxdiags_type), pointer :: flux_diags type(site_massbal_type), pointer :: site_mass integer :: c @@ -3130,13 +3097,11 @@ subroutine fragmentation_scaler( currentPatch, bc_in) ! currentPatch%fragmentation_scaler ! ! !USES: - - use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesConstantsMod, only : pi => pi_const ! ! !ARGUMENTS - type(ed_patch_type), intent(inout) :: currentPatch + type(fates_patch_type), intent(inout) :: currentPatch type(bc_in_type), intent(in) :: bc_in ! @@ -3268,8 +3233,8 @@ subroutine UpdateRecruitL2FR(csite) ! and less than the max_count cohort. type(ed_site_type) :: csite - type(ed_patch_type), pointer :: cpatch - type(ed_cohort_type), pointer :: ccohort + type(fates_patch_type), pointer :: cpatch + type(fates_cohort_type), pointer :: ccohort real(r8) :: rec_n(maxpft,nclmax) ! plant count real(r8) :: rec_l2fr0(maxpft,nclmax) ! mean l2fr for this day @@ -3336,8 +3301,8 @@ end subroutine UpdateRecruitL2FR subroutine UpdateRecruitStoich(csite) type(ed_site_type) :: csite - type(ed_patch_type), pointer :: cpatch - type(ed_cohort_type), pointer :: ccohort + type(fates_patch_type), pointer :: cpatch + type(fates_cohort_type), pointer :: ccohort integer :: ft ! functional type index integer :: cl ! canopy layer index real(r8) :: rec_l2fr_pft ! Actual l2fr of a pft in it's patch @@ -3379,8 +3344,8 @@ subroutine SetRecruitL2FR(csite) type(ed_site_type) :: csite - type(ed_patch_type), pointer :: cpatch - type(ed_cohort_type), pointer :: ccohort + type(fates_patch_type), pointer :: cpatch + type(fates_cohort_type), pointer :: ccohort integer :: ft,cl if(hlm_parteh_mode .ne. prt_cnp_flex_allom_hyp) return diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 59d5c055f3..1871f3fe0f 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -96,8 +96,8 @@ module FatesAllometryMod use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : FatesWarn,N2S,A2S,I2S - use EDTypesMod , only : nlevleaf, dinc_vai - use EDTypesMod , only : nclmax + use EDParamsMod , only : nlevleaf, dinc_vai + use EDParamsMod , only : nclmax use DamageMainMod , only : GetCrownReduction implicit none diff --git a/biogeochem/FatesCohortMod.F90 b/biogeochem/FatesCohortMod.F90 new file mode 100644 index 0000000000..71685a869e --- /dev/null +++ b/biogeochem/FatesCohortMod.F90 @@ -0,0 +1,1090 @@ +module FatesCohortMod + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : fates_unset_int + use FatesConstantsMod, only : ifalse, itrue + use FatesConstantsMod, only : nearzero + use FatesConstantsMod, only : ican_upper, ican_ustory + use EDParamsMod, only : nlevleaf + use EDParamsMod, only : nclmax + use FatesGlobals, only : endrun => fates_endrun + use FatesGlobals, only : fates_log + use PRTGenericMod, only : max_nleafage + use PRTGenericMod, only : prt_vartypes + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp + use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ + use PRTGenericMod, only : repro_organ, store_organ, struct_organ + use PRTGenericMod, only : carbon12_element + use PRTParametersMod, only : prt_params + use FatesParameterDerivedMod, only : param_derived + use FatesHydraulicsMemMod, only : ed_cohort_hydr_type + use FatesInterfaceTypesMod, only : hlm_parteh_mode + use FatesInterfaceTypesMod, only : hlm_use_sp + use FatesInterfaceTypesMod, only : hlm_use_planthydro + use FatesInterfaceTypesMod, only : nleafage + use EDPftvarcon, only : EDPftvarcon_inst + use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index + use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index + use FatesAllometryMod, only : carea_allom, tree_lai, tree_sai + use PRTAllometricCarbonMod, only : ac_bc_inout_id_dbh, ac_bc_inout_id_netdc + use PRTAllometricCarbonMod, only : ac_bc_in_id_cdamage, ac_bc_in_id_pft + use PRTAllometricCarbonMod, only : ac_bc_in_id_ctrim, ac_bc_in_id_lstat + use PRTAllometricCarbonMod, only : ac_bc_in_id_efleaf + use PRTAllometricCarbonMod, only : ac_bc_in_id_effnrt + use PRTAllometricCarbonMod, only : ac_bc_in_id_efstem + use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim + use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_in_id_netdc + use PRTAllometricCNPMod, only : acnp_bc_in_id_netdc, acnp_bc_in_id_nc_repro + use PRTAllometricCNPMod, only : acnp_bc_in_id_pc_repro, acnp_bc_in_id_cdamage + use PRTAllometricCNPMod, only : acnp_bc_inout_id_dbh, acnp_bc_inout_id_resp_excess + use PRTAllometricCNPMod, only : acnp_bc_inout_id_l2fr, acnp_bc_inout_id_cx_int + use PRTAllometricCNPMod, only : acnp_bc_inout_id_emadcxdt, acnp_bc_inout_id_cx0 + use PRTAllometricCNPMod, only : acnp_bc_inout_id_netdn, acnp_bc_inout_id_netdp + use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux + use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux, acnp_bc_out_id_limiter + use PRTAllometricCNPMod, only : acnp_bc_in_id_efleaf + use PRTAllometricCNPMod, only : acnp_bc_in_id_effnrt + use PRTAllometricCNPMod, only : acnp_bc_in_id_efstem + + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod, only : errMsg => shr_log_errMsg + + implicit none + private + + ! PARAMETERS + character(len=*), parameter, private :: sourcefile = __FILE__ + + ! FATES COHORT TYPE + type, public :: fates_cohort_type + + ! POINTERS + type (fates_cohort_type), pointer :: taller => null() ! pointer to next tallest cohort + type (fates_cohort_type), pointer :: shorter => null() ! pointer to next shorter cohort + + !--------------------------------------------------------------------------- + + ! Multi-species, multi-organ Plant Reactive Transport (PRT) + ! Contains carbon and nutrient state variables for various plant organs + class(prt_vartypes), pointer :: prt + real(r8) :: l2fr ! leaf to fineroot biomass ratio [kg root / kg leaf] + ! (this is constant in carbon only simulationss, and + ! is set by the allom_l2fr parameter). + ! For nutrient enabled simulations, this is dynamic. + ! In cold-start simulations, the allom_l2fr + ! parameter sets the starter value. + + !--------------------------------------------------------------------------- + + ! VEGETATION STRUCTURE + + integer :: pft ! pft index + real(r8) :: n ! number of individuals in cohort per 'area' (10000m2 default) [/m2] + real(r8) :: dbh ! diameter at breast height [cm] + real(r8) :: coage ! age [years] + real(r8) :: hite ! height [m] + integer :: indexnumber ! unique number for each cohort (within clump?) + integer :: canopy_layer ! canopy status of cohort [1 = canopy, 2 = understorey, etc.] + real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort [1 = canopy, 2 = understorey, etc.] + ! real to be conservative during fusion + integer :: crowndamage ! crown damage class of the cohort [1 = undamaged, >1 = damaged] + real(r8) :: g_sb_laweight ! total conductance (stomata + boundary layer) of the cohort + ! weighted by its leaf area [m/s]*[m2] + real(r8) :: canopy_trim ! fraction of the maximum leaf biomass that we are targeting [0-1] + real(r8) :: leaf_cost ! how much does it cost to maintain leaves [kgC/m2/year] + real(r8) :: excl_weight ! how much of this cohort is demoted each year, as a proportion of all cohorts + real(r8) :: prom_weight ! how much of this cohort is promoted each year, as a proportion of all cohorts + integer :: nv ! number of leaf layers + integer :: status_coh ! growth status of plant [2 = leaves on , 1 = leaves off] + real(r8) :: efleaf_coh ! elongation factor for leaves [fraction] + real(r8) :: effnrt_coh ! elongation factor for fine roots [fraction] + real(r8) :: efstem_coh ! elongation factor for stem [fraction] + ! for all the elongation factors, 0 means fully abscissed, and + ! 1 means fully flushed. + real(r8) :: c_area ! areal extent of canopy [m2] + real(r8) :: treelai ! lai of an individual within cohort leaf area [m2 leaf area/m2 crown area] + real(r8) :: treesai ! stem area index of an individual within cohort [m2 stem area/m2 crown area] + logical :: isnew ! flag to signify a new cohort - new cohorts have not experienced + ! npp or mortality and should therefore not be fused or averaged + integer :: size_class ! index that indicates which diameter size bin the cohort currently resides in + ! this is used for history output. We maintain this in the main cohort memory + ! because we don't want to continually re-calculate the cohort's position when + ! performing size diagnostics at high-frequency calls + integer :: coage_class ! index that indicates which age bin the cohort currently resides in + ! (used for history output) + integer :: size_by_pft_class ! index that indicates the cohorts position of the joint size-class x functional + ! type classification. We also maintain this in the main cohort memory + ! because we don't want to continually re-calculate the cohort's position when + ! performing size diagnostics at high-frequency calls + integer :: coage_by_pft_class ! index that indicates the cohorts position of the join cohort age class x PFT + integer :: size_class_lasttimestep ! size class of the cohort at the last time step + + !--------------------------------------------------------------------------- + + ! CARBON AND NUTRIENT FLUXES + + ! -------------------------------------------------------------------------- + ! NPP, GPP and RESP: Instantaneous, accumulated and accumulated-hold types* + ! + ! _tstep: The instantaneous estimate that is calculated at each rapid plant biophysics + ! time-step (ie photosynthesis, sub-hourly) [kgC/indiv/timestep] + ! _acc: The accumulation of the _tstep variable from the beginning to ending of + ! the dynamics time-scale. This variable is zero'd during initialization and + ! after the dynamics call-sequence is completed. [kgC/indiv/day] + ! _acc_hold: While _acc is zero'd after the dynamics call sequence and then integrated, + ! _acc_hold "holds" the integrated value until the next time dynamics is + ! called. This is necessary for restarts. This variable also has units + ! converted to a useful rate [kgC/indiv/yr] + ! -------------------------------------------------------------------------- + + real(r8) :: gpp_tstep ! Gross Primary Production (see above *) + real(r8) :: gpp_acc + real(r8) :: gpp_acc_hold + + real(r8) :: npp_tstep ! Net Primary Production (see above *) + real(r8) :: npp_acc + real(r8) :: npp_acc_hold + + real(r8) :: resp_tstep ! Autotrophic respiration (see above *) + real(r8) :: resp_acc + real(r8) :: resp_acc_hold + + real(r8) :: c13disc_clm ! carbon 13 discrimination in new synthesized carbon at each indiv/timestep [ppm] + real(r8) :: c13disc_acc ! carbon 13 discrimination in new synthesized carbon at each indiv/day + ! at the end of a day [ppm] + + ! The following four biophysical rates are assumed to be at the canopy top, at reference temp 25degC, + ! and based on the leaf age weighted average of the PFT parameterized values. + ! The last condition is why it is dynamic and tied to the cohort + + real(r8) :: vcmax25top ! maximum carboxylation at canopy top and 25degC [umol CO2/m2/s] + real(r8) :: jmax25top ! maximum electron transport rate at canopy top and 25degC [umol electrons/m2/s] + real(r8) :: tpu25top ! triose phosphate utilization rate at canopy top and 25degC [umol CO2/m2/s] + real(r8) :: kp25top ! initial slope of CO2 response curve (C4 plants) at 25C + + real(r8) :: ts_net_uptake(nlevleaf) ! net uptake of leaf layers [kgC/m2/timestep] + real(r8) :: year_net_uptake(nlevleaf) ! net uptake of leaf layers [kgC/m2/year] + + ! used for CNP + integer :: cnp_limiter ! which element is limiting growth [0 = none, 1 = C, 2 = N, 3 = P] + real(r8) :: cx_int ! time integration of the log of the relative carbon storage over relative nutrient + real(r8) :: ema_dcxdt ! derivative of the log of the relative carbon storage over relative nutrient + real(r8) :: cx0 ! value on the previous time-step of log of the relative carbon storage over + ! relative nutrient + real(r8) :: nc_repro ! N:C ratio of a new recruit, used also for defining reproductive stoich + real(r8) :: pc_repro ! P:C ratio of a new recruit + + ! Nutrient Fluxes (if N, P, etc. are turned on) + real(r8) :: daily_nh4_uptake ! integrated daily uptake of mineralized ammonium through competitive acquisition + ! in soil [kgN/plant/day] + real(r8) :: daily_no3_uptake ! integrated daily uptake of mineralized nitrate through competitive acquisition + ! in soil [kgN/plant/day] + + real(r8) :: sym_nfix_daily ! accumulated symbiotic N fixation from the roots [kgN/indiv/day] + real(r8) :: sym_nfix_tstep ! symbiotic N fixation from the roots for the time-step [kgN/indiv/timestep] + + real(r8) :: daily_n_gain ! sum of fixation and uptake of mineralized NH4/NO3 in solution as well as + ! symbiotic fixation + real(r8) :: daily_p_gain ! integrated daily uptake of mineralized P through competitive acquisition + ! in soil [kgP/plant/day] + + real(r8) :: daily_c_efflux ! daily mean efflux of excess carbon from roots into labile pool [kgC/plant/day] + real(r8) :: daily_n_efflux ! daily mean efflux of excess nitrogen from roots into labile pool [kgN/plant/day] + real(r8) :: daily_p_efflux ! daily mean efflux of excess phophorus from roots into labile pool [kgP/plant/day] + + real(r8) :: daily_n_demand ! daily amount of N demanded by the plant [kgN/plant/day] + real(r8) :: daily_p_demand ! daily amount of P demanded by the plant [kgN/plant/day] + + real(r8) :: seed_prod ! diagnostic seed production rate [kgC/plant/day] + + !--------------------------------------------------------------------------- + + ! RESPIRATION COMPONENTS + real(r8) :: rdark ! dark respiration [kgC/indiv/s] + real(r8) :: resp_g_tstep ! growth respiration [kgC/indiv/timestep] + real(r8) :: resp_m ! maintenance respiration [kgC/indiv/timestep] + real(r8) :: resp_m_unreduced ! diagnostic-only unreduced maintenance respiration [kgC/indiv/timestep] + real(r8) :: resp_excess ! respiration of excess carbon [kgC/indiv/day] + real(r8) :: livestem_mr ! aboveground live stem maintenance respiration [kgC/indiv/s] + real(r8) :: livecroot_mr ! belowground live stem maintenance respiration [kgC/indiv/s] + real(r8) :: froot_mr ! live fine root maintenance respiration [kgC/indiv/s] + + !--------------------------------------------------------------------------- + + ! DAMAGE + real(r8) :: branch_frac ! fraction of aboveground woody biomass in branches [0-1] + + !--------------------------------------------------------------------------- + + ! MORTALITY + real(r8) :: dmort ! proportional mortality rate [/year] + + ! Mortality Rate Partitions + real(r8) :: bmort ! background mortality rate [indiv/year] + real(r8) :: cmort ! carbon starvation mortality rate [indiv/year] + real(r8) :: hmort ! hydraulic failure mortality rate [indiv/year] + real(r8) :: frmort ! freezing mortality rate [indiv/year] + real(r8) :: smort ! senesence mortality [indiv/year] + real(r8) :: asmort ! age senescence mortality [indiv/year] + real(r8) :: dgmort ! damage mortality [indiv/year] + + ! Logging Mortality Rate + ! Yi Xu & M. Huang + real(r8) :: lmort_direct ! directly logging rate [fraction/logging activity] + real(r8) :: lmort_collateral ! collaterally damaged rate [fraction/logging activity] + real(r8) :: lmort_infra ! mechanically damaged rate [fraction/logging activity] + real(r8) :: l_degrad ! rate of trees that are not killed but suffer from forest degradation + ! (i.e. they are moved to newly-anthro-disturbed secondary + ! forest patch) [fraction/logging activity] + + !--------------------------------------------------------------------------- + + ! NITROGEN POOLS + ! -------------------------------------------------------------------------- + ! Nitrogen pools are not prognostic in the current implementation. + ! They are diagnosed during photosynthesis using a simple C2N parameter. + ! Local values are used in that routine. + ! -------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + + ! GROWTH DERIVIATIVES + real(r8) :: dndt ! time derivative of cohort size [n/year] + real(r8) :: dhdt ! time derivative of height [m/year] + real(r8) :: ddbhdt ! time derivative of dbh [cm/year] + real(r8) :: dbdeaddt ! time derivative of dead biomass [kgC/year] + + !--------------------------------------------------------------------------- + + ! FIRE + real(r8) :: fraction_crown_burned ! proportion of crown affected by fire [0-1] + real(r8) :: cambial_mort ! probability that trees dies due to cambial charring [0-1] + ! (conditional on the tree being subjected to the fire) + real(r8) :: crownfire_mort ! probability of tree post-fire mortality from crown scorch [0-1] + ! (conditional on the tree being subjected to the fire) + real(r8) :: fire_mort ! post-fire mortality from cambial and crown damage assuming two are independent [0-1] + + !--------------------------------------------------------------------------- + + ! HYDRAULICS + type(ed_cohort_hydr_type), pointer :: co_hydr ! all cohort hydraulics data, see FatesHydraulicsMemMod.F90 + + contains + + procedure :: Init + procedure :: NanValues + procedure :: ZeroValues + procedure :: Create + procedure :: Copy + procedure :: FreeMemory + procedure :: CanUpperUnder + procedure :: InitPRTBoundaryConditions + procedure :: UpdateCohortBioPhysRates + procedure :: Dump + + end type fates_cohort_type + + contains + + !=========================================================================== + + subroutine Init(this, prt) + ! + ! DESCRIPTION: + ! Create new cohort and set default values for all variables + ! + + ! ARGUMENTS: + class(fates_cohort_type), intent(inout) :: this + class(prt_vartypes), intent(inout), pointer :: prt ! allocated PARTEH object + + call this%NanValues() ! make everything in the cohort not-a-number + call this%ZeroValues() ! zero things that need to be zeroed + + ! point to the PARTEH object + this%prt => prt + + ! The PARTEH cohort object should be allocated and already + ! initialized in this routine. + call this%prt%CheckInitialConditions() + + ! new cohorts do not have mortality rates, nor have they moved any + ! carbon when they are created. They will bias our statistics + ! until they have experienced a full day. We need a newly recruited flag. + ! This flag will be set to false after it has experienced + ! growth, disturbance and mortality. + this%isnew = .true. + + end subroutine Init + + !=========================================================================== + + subroutine NanValues(this) + ! + ! DESCRIPTION: + ! make all the cohort variables NaN or unset so they aren't used before defined + ! + + ! ARGUMENTS: + class(fates_cohort_type), intent(inout) :: this + + ! set pointers to null + this%taller => null() + this%shorter => null() + this%prt => null() + this%co_hydr => null() + nullify(this%taller) + nullify(this%shorter) + nullify(this%prt) + nullify(this%co_hydr) + + ! VEGETATION STRUCTURE + this%l2fr = nan + this%pft = fates_unset_int + this%n = nan + this%dbh = nan + this%coage = nan + this%hite = nan + this%indexnumber = fates_unset_int + this%canopy_layer = fates_unset_int + this%canopy_layer_yesterday = nan + this%crowndamage = fates_unset_int + this%g_sb_laweight = nan + this%canopy_trim = nan + this%leaf_cost = nan + this%excl_weight = nan + this%prom_weight = nan + this%nv = fates_unset_int + this%status_coh = fates_unset_int + this%efleaf_coh = nan + this%effnrt_coh = nan + this%efstem_coh = nan + this%c_area = nan + this%treelai = nan + this%treesai = nan + this%isnew = .false. + this%size_class = fates_unset_int + this%coage_class = fates_unset_int + this%size_by_pft_class = fates_unset_int + this%coage_by_pft_class = fates_unset_int + this%size_class_lasttimestep = fates_unset_int + + ! CARBON AND NUTRIENT FLUXES + this%gpp_tstep = nan + this%gpp_acc = nan + this%gpp_acc_hold = nan + this%npp_tstep = nan + this%npp_acc = nan + this%npp_acc_hold = nan + this%resp_tstep = nan + this%resp_acc = nan + this%resp_acc_hold = nan + this%c13disc_clm = nan + this%c13disc_acc = nan + this%vcmax25top = nan + this%jmax25top = nan + this%tpu25top = nan + this%kp25top = nan + this%year_net_uptake(:) = nan + this%ts_net_uptake(:) = nan + this%cnp_limiter = fates_unset_int + this%cx_int = nan + this%ema_dcxdt = nan + this%cx0 = nan + this%nc_repro = nan + this%pc_repro = nan + this%daily_nh4_uptake = nan + this%daily_no3_uptake = nan + this%sym_nfix_daily = nan + this%sym_nfix_tstep = nan + this%daily_n_gain = nan + this%daily_p_gain = nan + this%daily_c_efflux = nan + this%daily_n_efflux = nan + this%daily_p_efflux = nan + this%daily_n_demand = nan + this%daily_p_demand = nan + this%seed_prod = nan + + ! RESPIRATION COMPONENTS + this%rdark = nan + this%resp_g_tstep = nan + this%resp_m = nan + this%resp_m_unreduced = nan + this%resp_excess = nan + this%livestem_mr = nan + this%livecroot_mr = nan + this%froot_mr = nan + + ! DAMAGE + this%branch_frac = nan + + ! MORTALITY + this%dmort = nan + this%bmort = nan + this%cmort = nan + this%frmort = nan + this%smort = nan + this%asmort = nan + this%dgmort = nan + this%lmort_direct = nan + this%lmort_collateral = nan + this%lmort_infra = nan + this%l_degrad = nan + + ! GROWTH DERIVATIVES + this%dndt = nan + this%dhdt = nan + this%ddbhdt = nan + this%dbdeaddt = nan + + ! FIRE + this%fraction_crown_burned = nan + this%cambial_mort = nan + this%crownfire_mort = nan + this%fire_mort = nan + + end subroutine NanValues + + !=========================================================================== + + subroutine ZeroValues(this) + ! + ! DESCRIPTION: + ! Zero variables that need to be accounted for if this cohort is altered + ! before they are defined. + ! + ! ARGUMENTS + class(fates_cohort_type), intent(inout) :: this + + this%g_sb_laweight = 0._r8 + + this%leaf_cost = 0._r8 + this%excl_weight = 0._r8 + this%prom_weight = 0._r8 + this%nv = 0 + this%status_coh = 0 + this%efleaf_coh = 0.0_r8 + this%effnrt_coh = 0.0_r8 + this%efstem_coh = 0.0_r8 + + this%treesai = 0._r8 + this%size_class = 1 + this%coage_class = 1 + + this%size_class_lasttimestep = 0 + this%gpp_tstep = 0._r8 + this%gpp_acc = 0._r8 + this%gpp_acc_hold = 0._r8 + this%npp_tstep = 0._r8 + this%npp_acc = 0._r8 + this%npp_acc_hold = 0._r8 + this%resp_tstep = 0._r8 + this%resp_acc = 0._r8 + this%resp_acc_hold = 0._r8 + this%c13disc_clm = 0._r8 + this%c13disc_acc = 0._r8 + + this%ts_net_uptake(:) = 0._r8 + this%year_net_uptake(:) = 999._r8 ! this needs to be 999, or trimming of new cohorts will break. + + this%daily_nh4_uptake = 0._r8 + this%daily_no3_uptake = 0._r8 + + ! fixation is also integrated over the course of the day and must be + ! zeroed upon creation and after plant resource allocation + this%sym_nfix_daily = 0._r8 + this%daily_n_gain = 0._r8 + this%daily_p_gain = 0._r8 + + ! daily nutrient fluxes are INTEGRATED over the course of the day. + ! These variables MUST be zerod upon creation AND after allocation. + ! These variables exist in carbon-only mode but are not used. + this%daily_c_efflux = 0._r8 + this%daily_n_efflux = 0._r8 + this%daily_p_efflux = 0._r8 + + ! initialize these as negative + this%daily_n_demand = -9._r8 + this%daily_p_demand = -9._r8 + this%seed_prod = 0._r8 + this%rdark = 0._r8 + this%resp_g_tstep = 0._r8 + this%resp_m = 0._r8 + this%resp_m_unreduced = 0._r8 + this%resp_excess = 0._r8 + this%livestem_mr = 0._r8 + this%livecroot_mr = 0._r8 + this%froot_mr = 0._r8 + + this%dmort = 0._r8 + this%lmort_direct = 0._r8 + this%lmort_collateral = 0._r8 + this%lmort_infra = 0._r8 + this%l_degrad = 0._r8 + this%fraction_crown_burned = 0._r8 + this%cambial_mort = 0._r8 + this%crownfire_mort = 0._r8 + this%fire_mort = 0._r8 + + end subroutine ZeroValues + + !=========================================================================== + + subroutine Create(this, prt, pft, nn, hite, coage, dbh, status, & + ctrim, carea, clayer, crowndamage, spread, can_tlai, elongf_leaf, & + elongf_fnrt, elongf_stem) + ! + ! DESCRIPTION: + ! set up values for a newly created cohort + + ! ARGUMENTS + class(fates_cohort_type), intent(inout), target :: this ! cohort object + class(prt_vartypes), intent(inout), pointer :: prt ! The allocated PARTEH object + integer, intent(in) :: pft ! cohort Plant Functional Type + integer, intent(in) :: crowndamage ! cohort damage class + integer, intent(in) :: clayer ! canopy status of cohort [canopy/understory] + integer, intent(in) :: status ! growth status of cohort [leaves on/off] + real(r8), intent(in) :: nn ! number of individuals in cohort [/m2] + real(r8), intent(in) :: hite ! cohort height [m] + real(r8), intent(in) :: coage ! cohort age [yr] + real(r8), intent(in) :: dbh ! cohort diameter at breat height [cm] + real(r8), intent(in) :: ctrim ! fraction of the maximum leaf biomass + real(r8), intent(in) :: spread ! how spread crowns are in horizontal space + real(r8), intent(in) :: carea ! area of cohort, for SP mode [m2] + real(r8), intent(in) :: can_tlai(nclmax) ! patch-level total LAI of each leaf layer + real(r8), intent(in) :: elongf_leaf ! leaf elongation factor [fraction] + real(r8), intent(in) :: elongf_fnrt ! fine-root "elongation factor" [fraction] + real(r8), intent(in) :: elongf_stem ! stem "elongation factor" [fraction] + + ! LOCAL VARIABLES: + integer :: iage ! loop counter for leaf age classes + real(r8) :: leaf_c ! total leaf carbon [kgC] + + ! initialize cohort + call this%Init(prt) + + ! set values + this%pft = pft + this%crowndamage = crowndamage + this%canopy_layer = clayer + this%canopy_layer_yesterday = real(clayer, r8) + this%status_coh = status + this%n = nn + this%hite = hite + this%dbh = dbh + this%coage = coage + this%canopy_trim = ctrim + this%efleaf_coh = elongf_leaf + this%effnrt_coh = elongf_fnrt + this%efstem_coh = elongf_stem + + ! This routine may be called during restarts, and at this point in the call sequence + ! the actual cohort data is unknown, as this is really only used for allocation + ! In these cases, testing if things like biomass are reasonable is premature + ! However, in this part of the code, we will pass in nominal values for size, number and type + if (this%dbh <= 0._r8 .or. this%n == 0._r8 .or. this%pft == 0) then + write(fates_log(),*) 'FATES: something is zero in cohort%Create', & + this%dbh, this%n, this%pft + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + ! Initialize the leaf to fineroot biomass ratio. + ! For C-only, this will stay constant, for nutrient-enabled this will be + ! dynamic. In both cases, new cohorts are initialized with the minimum. + ! This works in the nutrient enabled case because cohorts are also + ! initialized with full stores, which match with minimum fineroot biomass + this%l2fr = prt_params%allom_l2fr(pft) + + if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + this%cx_int = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + this%cx0 = 0._r8 ! Assume balanced N,P/C stores ie log(1) = 0 + this%ema_dcxdt = 0._r8 ! Assume unchanged dCX/dt + this%cnp_limiter = 0 ! Assume limitations are unknown + end if + + ! This sets things like vcmax25top, that depend on the leaf age fractions + ! (which are defined by PARTEH) + call this%UpdateCohortBioPhysRates() + + ! calculate size classes + call sizetype_class_index(this%dbh, this%pft, this%size_class, & + this%size_by_pft_class) + + ! If cohort age tracking is off we call this here once, just so everything + ! is in the first bin. This makes it easier to copy and terminate cohorts + ! later. + ! We don't need to update this ever if cohort age tracking is off + call coagetype_class_index(this%coage, this%pft, this%coage_class, & + this%coage_by_pft_class) + + ! asssign or calculate canopy extent and depth + if (hlm_use_sp .eq. ifalse) then + call carea_allom(this%dbh, this%n, spread, this%pft, this%crowndamage, & + this%c_area) + else + ! set this from previously precision-controlled value in SP mode + this%c_area = carea + endif + + ! Query PARTEH for the leaf carbon [kg] + leaf_c = this%prt%GetState(leaf_organ, carbon12_element) + + ! calculate tree lai + this%treelai = tree_lai(leaf_c, this%pft, this%c_area, this%n, & + this%canopy_layer, can_tlai, this%vcmax25top) + + if (hlm_use_sp .eq. ifalse) then + this%treesai = tree_sai(this%pft, this%dbh, this%crowndamage, & + this%canopy_trim, this%efstem_coh, this%c_area, this%n, & + this%canopy_layer, can_tlai, this%treelai,this%vcmax25top, 2) + end if + + call this%InitPRTBoundaryConditions() + + end subroutine Create + + !=========================================================================== + + subroutine Copy(this, copyCohort) + ! + ! DESCRIPTION: + ! copies all the variables in one cohort into a new cohort + ! + + ! ARGUMENTS + class(fates_cohort_type), intent(in) :: this ! old cohort + class(fates_cohort_type), intent(inout) :: copyCohort ! new cohort + + copyCohort%indexnumber = fates_unset_int + + ! POINTERS + copyCohort%taller => NULL() + copyCohort%shorter => NULL() + + ! PRT + call copyCohort%prt%CopyPRTVartypes(this%prt) + copyCohort%l2fr = this%l2fr + + ! VEGETATION STRUCTURE + copyCohort%pft = this%pft + copyCohort%n = this%n + copyCohort%dbh = this%dbh + copyCohort%coage = this%coage + copyCohort%hite = this%hite + copyCohort%canopy_layer = this%canopy_layer + copyCohort%canopy_layer_yesterday = this%canopy_layer_yesterday + copyCohort%crowndamage = this%crowndamage + copyCohort%g_sb_laweight = this%g_sb_laweight + copyCohort%canopy_trim = this%canopy_trim + copyCohort%leaf_cost = this%leaf_cost + copyCohort%excl_weight = this%excl_weight + copyCohort%prom_weight = this%prom_weight + copyCohort%nv = this%nv + copyCohort%status_coh = this%status_coh + copyCohort%efleaf_coh = this%efleaf_coh + copyCohort%effnrt_coh = this%effnrt_coh + copyCohort%efstem_coh = this%efstem_coh + copyCohort%c_area = this%c_area + copyCohort%treelai = this%treelai + copyCohort%treesai = this%treesai + copyCohort%isnew = this%isnew + copyCohort%size_class = this%size_class + copyCohort%coage_class = this%coage_class + copyCohort%size_by_pft_class = this%size_by_pft_class + copyCohort%coage_by_pft_class = this%coage_by_pft_class + copyCohort%size_class_lasttimestep = this%size_class_lasttimestep + + ! CARBON AND NUTRIENT FLUXES + copyCohort%gpp_tstep = this%gpp_tstep + copyCohort%gpp_acc = this%gpp_acc + copyCohort%gpp_acc_hold = this%gpp_acc_hold + copyCohort%npp_tstep = this%npp_tstep + copyCohort%npp_acc = this%npp_acc + copyCohort%npp_acc_hold = this%npp_acc_hold + copyCohort%resp_tstep = this%resp_tstep + copyCohort%resp_acc = this%resp_acc + copyCohort%resp_acc_hold = this%resp_acc_hold + copyCohort%c13disc_clm = this%c13disc_clm + copyCohort%c13disc_acc = this%c13disc_acc + copyCohort%vcmax25top = this%vcmax25top + copyCohort%jmax25top = this%jmax25top + copyCohort%tpu25top = this%tpu25top + copyCohort%kp25top = this%kp25top + copyCohort%ts_net_uptake = this%ts_net_uptake + copyCohort%year_net_uptake = this%year_net_uptake + copyCohort%cnp_limiter = this%cnp_limiter + + if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then + copyCohort%cx_int = this%cx_int + copyCohort%ema_dcxdt = this%ema_dcxdt + copyCohort%cx0 = this%cx0 + end if + + copyCohort%nc_repro = this%nc_repro + copyCohort%daily_nh4_uptake = this%daily_nh4_uptake + copyCohort%daily_no3_uptake = this%daily_no3_uptake + copyCohort%sym_nfix_daily = this%sym_nfix_daily + copyCohort%sym_nfix_tstep = this%sym_nfix_tstep + copyCohort%daily_n_gain = this%daily_n_gain + copyCohort%daily_p_gain = this%daily_p_gain + copyCohort%daily_c_efflux = this%daily_c_efflux + copyCohort%daily_n_efflux = this%daily_n_efflux + copyCohort%daily_p_efflux = this%daily_p_efflux + copyCohort%daily_n_demand = this%daily_n_demand + copyCohort%daily_p_demand = this%daily_p_demand + copyCohort%seed_prod = this%seed_prod + + ! RESPIRATION COMPONENTS + copyCohort%rdark = this%rdark + copyCohort%resp_g_tstep = this%resp_g_tstep + copyCohort%resp_m = this%resp_m + copyCohort%resp_m_unreduced = this%resp_m_unreduced + copyCohort%resp_excess = this%resp_excess + copyCohort%livestem_mr = this%livestem_mr + copyCohort%livecroot_mr = this%livecroot_mr + copyCohort%froot_mr = this%froot_mr + + ! DAMAGE + copyCohort%branch_frac = this%branch_frac + + ! MORTALITY + copyCohort%dmort = this%dmort + copyCohort%bmort = this%bmort + copyCohort%cmort = this%cmort + copyCohort%hmort = this%hmort + copyCohort%frmort = this%frmort + copyCohort%smort = this%smort + copyCohort%asmort = this%asmort + copyCohort%dgmort = this%dgmort + copyCohort%lmort_direct = this%lmort_direct + copyCohort%lmort_collateral = this%lmort_collateral + copyCohort%lmort_infra = this%lmort_infra + copyCohort%l_degrad = this%l_degrad + + ! GROWTH DERIVATIVES + copyCohort%dndt = this%dndt + copyCohort%dhdt = this%dhdt + copyCohort%ddbhdt = this%ddbhdt + copyCohort%dbdeaddt = this%dbdeaddt + + ! FIRE + copyCohort%fraction_crown_burned = this%fraction_crown_burned + copyCohort%cambial_mort = this%cambial_mort + copyCohort%crownfire_mort = this%crownfire_mort + copyCohort%fire_mort = this%fire_mort + + ! HYDRAULICS + if (hlm_use_planthydro .eq. itrue) then + call copyCohort%co_hydr%CopyCohortHydraulics(this%co_hydr) + endif + + end subroutine Copy + + !=========================================================================== + + subroutine FreeMemory(this) + ! + ! DESCRIPTION: + ! deallocates all dynamic memory and objects within the cohort structure + ! DOES NOT deallocate the cohort structure itself + ! + + ! ARGUMENTS + class(fates_cohort_type), intent(inout) :: this ! cohort object + + ! LOCALS: + integer :: istat ! return status code + character(len=255) :: smsg ! error message + + ! at this point, nothing should be pointing to current cohort + if (hlm_use_planthydro .eq. itrue) then + call this%co_hydr%DeAllocateHydrCohortArrays() + deallocate(this%co_hydr) + end if + + ! deallocate the cohort's PRT structures + call this%prt%DeallocatePRTVartypes() + + ! Deallocate the PRT object + deallocate(this%prt, stat=istat, errmsg=smsg) + if (istat /= 0) then + write(fates_log(),*) 'dealloc002: fail in deallocate(currentCohort%prt):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + end subroutine FreeMemory + + !=========================================================================== + + subroutine InitPRTBoundaryConditions(this) + ! + ! DESCRIPTION: + ! Set the boundary conditions that flow in an out of the PARTEH + ! allocation hypotheses. Each of these calls to "RegsterBC" are simply + ! setting pointers. + ! For instance, if the hypothesis wants to know what + ! the DBH of the plant is, then we pass in the dbh as an argument (copyCohort%dbh), + ! and also tell it which boundary condition we are talking about (which is + ! defined by an integer index (ac_bc_inout_id_dbh) + ! + ! Again, elaborated Example: + ! "ac_bc_inout_id_dbh" is the unique integer that defines the object index + ! for the allometric carbon "ac" boundary condition "bc" for DBH "dbh" + ! that is classified as input and output "inout". + ! See PRTAllometricCarbonMod.F90 to track its usage. + ! bc_rval is used as the optional argument identifyer to specify a real + ! value boundary condition. + ! bc_ival is used as the optional argument identifyer to specify an integer + ! value boundary condition. + + ! ARGUMENTS: + class(fates_cohort_type), intent(inout), target :: this + + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp) + + ! Register boundary conditions for the Carbon Only Allometric Hypothesis + + call this%prt%RegisterBCInOut(ac_bc_inout_id_dbh, bc_rval=this%dbh) + call this%prt%RegisterBCInOut(ac_bc_inout_id_netdc, bc_rval=this%npp_acc) + call this%prt%RegisterBCIn(ac_bc_in_id_cdamage, bc_ival=this%crowndamage) + call this%prt%RegisterBCIn(ac_bc_in_id_pft, bc_ival=this%pft) + call this%prt%RegisterBCIn(ac_bc_in_id_ctrim, bc_rval=this%canopy_trim) + call this%prt%RegisterBCIn(ac_bc_in_id_lstat, bc_ival=this%status_coh) + call this%prt%RegisterBCIn(ac_bc_in_id_efleaf, bc_rval = this%efleaf_coh) + call this%prt%RegisterBCIn(ac_bc_in_id_effnrt, bc_rval = this%effnrt_coh) + call this%prt%RegisterBCIn(ac_bc_in_id_efstem, bc_rval = this%efstem_coh) + + case (prt_cnp_flex_allom_hyp) + + ! Register boundary conditions for the CNP Allometric Hypothesis + + call this%prt%RegisterBCIn(acnp_bc_in_id_pft, bc_ival=this%pft) + call this%prt%RegisterBCIn(acnp_bc_in_id_ctrim, bc_rval=this%canopy_trim) + call this%prt%RegisterBCIn(acnp_bc_in_id_lstat, bc_ival=this%status_coh) + call this%prt%RegisterBCIn(acnp_bc_in_id_efleaf, bc_rval = this%efleaf_coh) + call this%prt%RegisterBCIn(acnp_bc_in_id_effnrt, bc_rval = this%effnrt_coh) + call this%prt%RegisterBCIn(acnp_bc_in_id_efstem, bc_rval = this%efstem_coh) + call this%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval=this%npp_acc) + + call this%prt%RegisterBCIn(acnp_bc_in_id_nc_repro, bc_rval=this%nc_repro) + call this%prt%RegisterBCIn(acnp_bc_in_id_pc_repro, bc_rval=this%pc_repro) + call this%prt%RegisterBCIn(acnp_bc_in_id_cdamage, bc_ival=this%crowndamage) + + call this%prt%RegisterBCInOut(acnp_bc_inout_id_dbh, bc_rval=this%dbh) + call this%prt%RegisterBCInOut(acnp_bc_inout_id_resp_excess, bc_rval=this%resp_excess) + call this%prt%RegisterBCInOut(acnp_bc_inout_id_l2fr, bc_rval=this%l2fr) + call this%prt%RegisterBCInOut(acnp_bc_inout_id_cx_int, bc_rval=this%cx_int) + call this%prt%RegisterBCInOut(acnp_bc_inout_id_emadcxdt, bc_rval=this%ema_dcxdt) + call this%prt%RegisterBCInOut(acnp_bc_inout_id_cx0, bc_rval=this%cx0) + + call this%prt%RegisterBCInOut(acnp_bc_inout_id_netdn, bc_rval=this%daily_n_gain) + call this%prt%RegisterBCInOut(acnp_bc_inout_id_netdp, bc_rval=this%daily_p_gain) + + call this%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval=this%daily_c_efflux) + call this%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval=this%daily_n_efflux) + call this%prt%RegisterBCOut(acnp_bc_out_id_pefflux, bc_rval=this%daily_p_efflux) + call this%prt%RegisterBCOut(acnp_bc_out_id_limiter, bc_ival=this%cnp_limiter) + + case DEFAULT + + write(fates_log(),*) 'You specified an unknown PRT module' + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select + + end subroutine InitPRTBoundaryConditions + + !=========================================================================== + + subroutine UpdateCohortBioPhysRates(this) + ! + ! DESCRIPTION: + ! Update the four key biophysical rates of leaves based on the changes + ! in a cohort's leaf age proportions. + ! + ! This should be called after growth. Growth occurs + ! after turnover and damage states are applied to the tree. + ! Therefore, following growth, the leaf mass fractions + ! of different age classes are unchanged until the next day. + + ! ARGUMENTS + class(fates_cohort_type), intent(inout) :: this ! cohort object + + ! LOCAL VARIABLES + real(r8) :: frac_leaf_aclass(max_nleafage) ! fraction of leaves in each age-class + integer :: iage ! loop index for leaf ages + integer :: ipft ! plant functional type index + + ! First, calculate the fraction of leaves in each age class + ! It is assumed that each class has the same proportion across leaf layers + do iage = 1, nleafage + frac_leaf_aclass(iage) = this%prt%GetState(leaf_organ, & + carbon12_element, iage) + end do + + ! If there are leaves, then perform proportional weighting on the four rates + ! We assume that leaf age does not effect the specific leaf area, so the mass + ! fractions are applicable to these rates + + ipft = this%pft + + if (sum(frac_leaf_aclass(1:nleafage)) > nearzero .and. & + hlm_use_sp .eq. ifalse) then + + frac_leaf_aclass(1:nleafage) = frac_leaf_aclass(1:nleafage)/ & + sum(frac_leaf_aclass(1:nleafage)) + + this%vcmax25top = sum(EDPftvarcon_inst%vcmax25top(ipft, 1:nleafage)* & + frac_leaf_aclass(1:nleafage)) + + this%jmax25top = sum(param_derived%jmax25top(ipft, 1:nleafage)* & + frac_leaf_aclass(1:nleafage)) + + this%tpu25top = sum(param_derived%tpu25top(ipft, 1:nleafage)* & + frac_leaf_aclass(1:nleafage)) + + this%kp25top = sum(param_derived%kp25top(ipft, 1:nleafage)* & + frac_leaf_aclass(1:nleafage)) + + else if (hlm_use_sp .eq. itrue) then + + this%vcmax25top = EDPftvarcon_inst%vcmax25top(ipft, 1) + this%jmax25top = param_derived%jmax25top(ipft, 1) + this%tpu25top = param_derived%tpu25top(ipft, 1) + this%kp25top = param_derived%kp25top(ipft, 1) + + else + + this%vcmax25top = 0._r8 + this%jmax25top = 0._r8 + this%tpu25top = 0._r8 + this%kp25top = 0._r8 + + end if + + end subroutine UpdateCohortBioPhysRates + + !=========================================================================== + + function CanUpperUnder(this) result(can_position) + ! + ! DESCRIPTION: + ! This simple function is used to determine if a cohort's crown position + ! is in the upper portion (ie the canopy) or the understory. This + ! differentiation is only used for diagnostic purposes. Functionally, + ! the model uses the canopy layer position, which may have more than + ! two layers at any given time. Utlimately, every plant that is not in + ! the top layer (canopy), is considered understory. + ! + + ! ARGUMENTS: + class(fates_cohort_type) :: this ! current cohort of interest + integer :: can_position ! canopy position + + if (this%canopy_layer == 1)then + can_position = ican_upper + else + can_position = ican_ustory + end if + + end function CanUpperUnder + + !=========================================================================== + + subroutine Dump(this) + ! + ! DESCRIPTION: + ! Print out attributes of a cohort + ! + + ! ARGUMENTS: + class(fates_cohort_type), intent(in), target :: this + + write(fates_log(),*) '----------------------------------------' + write(fates_log(),*) ' Dumping Cohort Information ' + write(fates_log(),*) '----------------------------------------' + write(fates_log(),*) 'cohort%pft = ', this%pft + write(fates_log(),*) 'cohort%n = ', this%n + write(fates_log(),*) 'cohort%dbh = ', this%dbh + write(fates_log(),*) 'cohort%hite = ', this%hite + write(fates_log(),*) 'cohort%crowndamage = ', this%crowndamage + write(fates_log(),*) 'cohort%coage = ', this%coage + write(fates_log(),*) 'cohort%l2fr = ', this%l2fr + write(fates_log(),*) 'leaf carbon = ', this%prt%GetState(leaf_organ,carbon12_element) + write(fates_log(),*) 'fineroot carbon = ', this%prt%GetState(fnrt_organ,carbon12_element) + write(fates_log(),*) 'sapwood carbon = ', this%prt%GetState(sapw_organ,carbon12_element) + write(fates_log(),*) 'structural (dead) carbon = ', this%prt%GetState(struct_organ,carbon12_element) + write(fates_log(),*) 'storage carbon = ', this%prt%GetState(store_organ,carbon12_element) + write(fates_log(),*) 'reproductive carbon = ', this%prt%GetState(repro_organ,carbon12_element) + write(fates_log(),*) 'cohort%g_sb_laweight = ', this%g_sb_laweight + write(fates_log(),*) 'cohort%leaf_cost = ', this%leaf_cost + write(fates_log(),*) 'cohort%canopy_layer = ', this%canopy_layer + write(fates_log(),*) 'cohort%canopy_layer_yesterday = ', this%canopy_layer_yesterday + write(fates_log(),*) 'cohort%nv = ', this%nv + write(fates_log(),*) 'cohort%status_coh = ', this%status_coh + write(fates_log(),*) 'co%status_coh = ', this%status_coh + write(fates_log(),*) 'co%efleaf_coh = ', this%efleaf_coh + write(fates_log(),*) 'co%effnrt_coh = ', this%effnrt_coh + write(fates_log(),*) 'co%efstem_coh = ', this%efstem_coh + write(fates_log(),*) 'cohort%canopy_trim = ', this%canopy_trim + write(fates_log(),*) 'cohort%excl_weight = ', this%excl_weight + write(fates_log(),*) 'cohort%prom_weight = ', this%prom_weight + write(fates_log(),*) 'cohort%size_class = ', this%size_class + write(fates_log(),*) 'cohort%size_by_pft_class = ', this%size_by_pft_class + write(fates_log(),*) 'cohort%coage_class = ', this%coage_class + write(fates_log(),*) 'cohort%coage_by_pft_class = ', this%coage_by_pft_class + write(fates_log(),*) 'cohort%gpp_acc_hold = ', this%gpp_acc_hold + write(fates_log(),*) 'cohort%gpp_acc = ', this%gpp_acc + write(fates_log(),*) 'cohort%gpp_tstep = ', this%gpp_tstep + write(fates_log(),*) 'cohort%npp_acc_hold = ', this%npp_acc_hold + write(fates_log(),*) 'cohort%npp_tstep = ', this%npp_tstep + write(fates_log(),*) 'cohort%npp_acc = ', this%npp_acc + write(fates_log(),*) 'cohort%resp_tstep = ', this%resp_tstep + write(fates_log(),*) 'cohort%resp_acc = ', this%resp_acc + write(fates_log(),*) 'cohort%resp_acc_hold = ', this%resp_acc_hold + write(fates_log(),*) 'cohort%rdark = ', this%rdark + write(fates_log(),*) 'cohort%resp_m = ', this%resp_m + write(fates_log(),*) 'cohort%resp_g_tstep = ', this%resp_g_tstep + write(fates_log(),*) 'cohort%livestem_mr = ', this%livestem_mr + write(fates_log(),*) 'cohort%livecroot_mr = ', this%livecroot_mr + write(fates_log(),*) 'cohort%froot_mr = ', this%froot_mr + write(fates_log(),*) 'cohort%dgmort = ', this%dgmort + write(fates_log(),*) 'cohort%treelai = ', this%treelai + write(fates_log(),*) 'cohort%treesai = ', this%treesai + write(fates_log(),*) 'cohort%c_area = ', this%c_area + write(fates_log(),*) 'cohort%cmort = ', this%cmort + write(fates_log(),*) 'cohort%bmort = ', this%bmort + write(fates_log(),*) 'cohort%smort = ', this%smort + write(fates_log(),*) 'cohort%asmort = ', this%asmort + write(fates_log(),*) 'cohort%dgmort = ', this%dgmort + write(fates_log(),*) 'cohort%hmort = ', this%hmort + write(fates_log(),*) 'cohort%frmort = ', this%frmort + write(fates_log(),*) 'cohort%asmort = ', this%asmort + write(fates_log(),*) 'cohort%lmort_direct = ', this%lmort_direct + write(fates_log(),*) 'cohort%lmort_collateral = ', this%lmort_collateral + write(fates_log(),*) 'cohort%lmort_infra = ', this%lmort_infra + write(fates_log(),*) 'cohort%isnew = ', this%isnew + write(fates_log(),*) 'cohort%dndt = ', this%dndt + write(fates_log(),*) 'cohort%dhdt = ', this%dhdt + write(fates_log(),*) 'cohort%ddbhdt = ', this%ddbhdt + write(fates_log(),*) 'cohort%dbdeaddt = ', this%dbdeaddt + write(fates_log(),*) 'cohort%fraction_crown_burned = ', this%fraction_crown_burned + write(fates_log(),*) 'cohort%fire_mort = ', this%fire_mort + write(fates_log(),*) 'cohort%crownfire_mort = ', this%crownfire_mort + write(fates_log(),*) 'cohort%cambial_mort = ', this%cambial_mort + write(fates_log(),*) 'cohort%size_class = ', this%size_class + write(fates_log(),*) 'cohort%size_by_pft_class = ', this%size_by_pft_class + + if (associated(this%co_hydr)) call this%co_hydr%Dump() + + write(fates_log(),*) '----------------------------------------' + + end subroutine Dump + + !=========================================================================== + +end module FatesCohortMod \ No newline at end of file diff --git a/biogeochem/FatesLitterMod.F90 b/biogeochem/FatesLitterMod.F90 index e0ef9c80aa..e16cce69db 100644 --- a/biogeochem/FatesLitterMod.F90 +++ b/biogeochem/FatesLitterMod.F90 @@ -36,7 +36,6 @@ module FatesLitterMod use FatesConstantsMod, only : nearzero use FatesConstantsMod, only : calloc_abs_error use FatesConstantsMod, only : fates_unset_r8 - use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg @@ -56,6 +55,16 @@ module FatesLitterMod integer, public, parameter :: icellulose = 2 ! Array index for cellulose portion integer, public, parameter :: ilignin = 3 ! Array index for the lignin portion + ! SPITFIRE + + integer, parameter, public :: NFSC = NCWD+2 ! number fuel size classes (4 cwd size classes, leaf litter, and grass) + integer, parameter, public :: tw_sf = 1 ! array index of twig pool for spitfire + integer, parameter, public :: lb_sf = 3 ! array index of large branch pool for spitfire + integer, parameter, public :: tr_sf = 4 ! array index of dead trunk pool for spitfire + integer, parameter, public :: dl_sf = 5 ! array index of dead leaf pool for spitfire (dead grass and dead leaves) + integer, parameter, public :: lg_sf = 6 ! array index of live grass pool for spitfire + + type, public :: litter_type diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 new file mode 100644 index 0000000000..8a38366217 --- /dev/null +++ b/biogeochem/FatesPatchMod.F90 @@ -0,0 +1,809 @@ +module FatesPatchMod + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : fates_unset_r8 + use FatesConstantsMod, only : fates_unset_int + use FatesConstantsMod, only : primaryforest, secondaryforest + use FatesConstantsMod, only : TRS_regeneration + use FatesGlobals, only : fates_log + use FatesGlobals, only : endrun => fates_endrun + use FatesUtilsMod, only : check_hlm_list + use FatesUtilsMod, only : check_var_real + use FatesCohortMod, only : fates_cohort_type + use FatesRunningMeanMod, only : rmean_type, rmean_arr_type + use FatesLitterMod, only : nfsc + use FatesLitterMod, only : litter_type + use PRTGenericMod, only : num_elements + use PRTGenericMod, only : element_list + use EDParamsMod, only : maxSWb, nlevleaf, nclmax, maxpft + use FatesConstantsMod, only : n_dbh_bins, n_dist_types + use FatesConstantsMod, only : n_rad_stream_types + use FatesConstantsMod, only : t_water_freeze_k_1atm + use FatesRunningMeanMod, only : ema_24hr, fixed_24hr, ema_lpa, ema_longterm + use FatesRunningMeanMod, only : ema_sdlng_emerg_h2o, ema_sdlng_mort_par + use FatesRunningMeanMod, only : ema_sdlng2sap_par, ema_sdlng_mdd + + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod, only : errMsg => shr_log_errMsg + + implicit none + private + + ! for error message writing + character(len=*), parameter :: sourcefile = __FILE__ + + type, public :: fates_patch_type + + ! POINTERS + type (fates_cohort_type), pointer :: tallest => null() ! pointer to patch's tallest cohort + type (fates_cohort_type), pointer :: shortest => null() ! pointer to patch's shortest cohort + type (fates_patch_type), pointer :: older => null() ! pointer to next older patch + type (fates_patch_type), pointer :: younger => null() ! pointer to next younger patch + + !--------------------------------------------------------------------------- + + ! INDICES + integer :: patchno ! unique number given to each new patch created for tracking + integer :: nocomp_pft_label ! when nocomp is active, use this label for patch ID + ! each patch ID corresponds to a pft number since each + ! patch has only one pft. Bareground patches are given + ! a zero integer as a label. If nocomp is not active this + ! is set to unset. This is set in patch%Create as an argument + ! to that procedure. + + !--------------------------------------------------------------------------- + + ! PATCH INFO + real(r8) :: age ! average patch age [years] + integer :: age_class ! age class of the patch for history binning purposes + real(r8) :: area ! patch area [m2] + integer :: countcohorts ! number of cohorts in patch + integer :: ncl_p ! number of occupied canopy layers + integer :: anthro_disturbance_label ! patch label for anthropogenic disturbance classification + real(r8) :: age_since_anthro_disturbance ! average age for secondary forest since last anthropogenic disturbance [years] + + !--------------------------------------------------------------------------- + + ! RUNNING MEANS + !class(rmean_type), pointer :: t2m ! place-holder for 2m air temperature (variable window-size) + class(rmean_type), pointer :: tveg24 ! 24-hour mean vegetation temperature [K] + class(rmean_type), pointer :: tveg_lpa ! running mean of vegetation temperature at the + ! leaf photosynthesis acclimation timescale [K] + class(rmean_type), pointer :: tveg_longterm ! long-term running mean of vegetation temperature at the + ! leaf photosynthesis acclimation timescale [K] (i.e T_home) + class(rmean_type), pointer :: seedling_layer_par24 ! 24-hour mean of photosynthetically active radiation at seedling layer [W/m2] + class(rmean_arr_type), pointer :: sdlng_emerg_smp(:) ! running mean of soil matric potential at the seedling + ! rooting depth at the H2O seedling emergence timescale (see sdlng_emerg_h2o_timescale parameter) + class(rmean_type), pointer :: sdlng_mort_par ! running mean of photosythetically active radiation + ! at the seedling layer and at the par-based seedling + ! mortality timescale (sdlng_mort_par_timescale) + class(rmean_arr_type), pointer :: sdlng_mdd(:) ! running mean of moisture deficit days + ! at the seedling layer and at the mdd-based seedling + ! mortality timescale (sdlng_mdd_timescale) + ! (sdlng2sap_par_timescale) + class(rmean_type), pointer :: sdlng2sap_par ! running mean of photosythetically active radiation + ! at the seedling layer and at the par-based seedling + ! to sapling transition timescale + ! (sdlng2sap_par_timescale) + + !--------------------------------------------------------------------------- + + ! LEAF ORGANIZATION + real(r8) :: pft_agb_profile(maxpft,n_dbh_bins) ! binned aboveground biomass, for patch fusion [kgC/m2] + real(r8) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer [m2 veg/m2 canopy area] + ! (patch without bare ground) + ! used to determine attenuation of parameters during photosynthesis + real(r8) :: total_canopy_area ! area that is covered by vegetation [m2] + real(r8) :: total_tree_area ! area that is covered by woody vegetation [m2] + real(r8) :: zstar ! height of smallest canopy tree, only meaningful in "strict PPA" mode [m] + real(r8) :: elai_profile(nclmax,maxpft,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer [m2 leaf/m2 contributing crown area] + real(r8) :: esai_profile(nclmax,maxpft,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer [m2 leaf/m2 contributing crown area] + real(r8) :: tlai_profile(nclmax,maxpft,nlevleaf) + real(r8) :: tsai_profile(nclmax,maxpft,nlevleaf) + real(r8) :: canopy_area_profile(nclmax,maxpft,nlevleaf) ! fraction of crown area per canopy area in each layer + ! they will sum to 1.0 in the fully closed canopy layers + ! but only in leaf-layers that contain contributions + ! from all cohorts that donate to canopy_area + integer :: canopy_mask(nclmax,maxpft) ! is there any of this pft in this canopy layer? + integer :: nrad(nclmax,maxpft) ! number of exposed leaf layers for each canopy layer and pft + integer :: ncan(nclmax,maxpft) ! number of total leaf layers for each canopy layer and pft + real(r8) :: c_stomata ! mean stomatal conductance of all leaves in the patch [umol/m2/s] + real(r8) :: c_lblayer ! mean boundary layer conductance of all leaves in the patch [umol/m2/s] + + !TODO - can we delete these? + real(r8) :: layer_height_profile(nclmax,maxpft,nlevleaf) + real(r8) :: psn_z(nclmax,maxpft,nlevleaf) + real(r8) :: nrmlzd_parprof_pft_dir_z(n_rad_stream_types,nclmax,maxpft,nlevleaf) + real(r8) :: nrmlzd_parprof_pft_dif_z(n_rad_stream_types,nclmax,maxpft,nlevleaf) + real(r8) :: nrmlzd_parprof_dir_z(n_rad_stream_types,nclmax,nlevleaf) + real(r8) :: nrmlzd_parprof_dif_z(n_rad_stream_types,nclmax,nlevleaf) + + !--------------------------------------------------------------------------- + + ! RADIATION + real(r8) :: radiation_error ! radiation error [W/m2] + real(r8) :: fcansno ! fraction of canopy covered in snow [0-1] + logical :: solar_zenith_flag ! integer flag specifying daylight (based on zenith angle) + real(r8) :: solar_zenith_angle ! solar zenith angle [radians] + real(r8) :: gnd_alb_dif(maxSWb) ! ground albedo for diffuse rad, both bands [0-1] + real(r8) :: gnd_alb_dir(maxSWb) ! ground albedo for direct rad, both bands [0-1] + + ! organized by canopy layer, pft, and leaf layer + real(r8) :: fabd_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of direct light absorbed [0-1] + real(r8) :: fabd_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of direct light absorbed [0-1] + real(r8) :: fabi_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of indirect light absorbed [0-1] + real(r8) :: fabi_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of indirect light absorbed [0-1] + real(r8) :: ed_parsun_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the sun [W/m2] + real(r8) :: ed_parsha_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the shade [W/m2] + real(r8) :: ed_laisun_z(nclmax,maxpft,nlevleaf) + real(r8) :: ed_laisha_z(nclmax,maxpft,nlevleaf) + real(r8) :: f_sun(nclmax,maxpft,nlevleaf) ! fraction of leaves in the sun [0-1] + + ! radiation profiles for comparison against observations + real(r8) :: parprof_pft_dir_z(nclmax,maxpft,nlevleaf) ! direct-beam PAR profile through canopy, by canopy, PFT, leaf level [W/m2] + real(r8) :: parprof_pft_dif_z(nclmax,maxpft,nlevleaf) ! diffuse PAR profile through canopy, by canopy, PFT, leaf level [W/m2] + real(r8) :: parprof_dir_z(nclmax,nlevleaf) ! direct-beam PAR profile through canopy, by canopy, leaf level [W/m2] + real(r8) :: parprof_dif_z(nclmax,nlevleaf) ! diffuse PAR profile through canopy, by canopy, leaf level [W/m2] + + real(r8), allocatable :: tr_soil_dir(:) ! fraction of incoming direct radiation transmitted to the soil as direct, by numSWB [0-1] + real(r8), allocatable :: tr_soil_dif(:) ! fraction of incoming diffuse radiation that is transmitted to the soil as diffuse [0-1] + real(r8), allocatable :: tr_soil_dir_dif(:) ! fraction of incoming direct radiation that is transmitted to the soil as diffuse [0-1] + real(r8), allocatable :: fab(:) ! fraction of incoming total radiation that is absorbed by the canopy + real(r8), allocatable :: fabd(:) ! fraction of incoming direct radiation that is absorbed by the canopy + real(r8), allocatable :: fabi(:) ! fraction of incoming diffuse radiation that is absorbed by the canopy + real(r8), allocatable :: sabs_dir(:) ! fraction of incoming direct radiation that is absorbed by the canopy + real(r8), allocatable :: sabs_dif(:) ! fraction of incoming diffuse radiation that is absorbed by the canopy + + !--------------------------------------------------------------------------- + + ! ROOTS + real(r8) :: btran_ft(maxpft) ! btran calculated seperately for each PFT + real(r8) :: bstress_sal_ft(maxpft) ! bstress from salinity calculated seperately for each PFT + + !--------------------------------------------------------------------------- + + ! EXTERNAL SEED RAIN + real(r8) :: nitr_repro_stoich(maxpft) ! The NC ratio of a new recruit in this patch + real(r8) :: phos_repro_stoich(maxpft) ! The PC ratio of a new recruit in this patch + + !--------------------------------------------------------------------------- + + ! DISTURBANCE + real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate [0-1/day] from 1) mortality + ! 2) fire + ! 3) logging mortatliy + real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested [0-1] + + !--------------------------------------------------------------------------- + + ! LITTER AND COARSE WOODY DEBRIS + type(litter_type), pointer :: litter(:) ! litter (leaf,fnrt,CWD and seeds) for different elements + real(r8), allocatable :: fragmentation_scaler(:) ! scale rate of litter fragmentation based on soil layer [0-1] + + !--------------------------------------------------------------------------- + + ! FUELS AND FIRE + ! fuel characteristics + real(r8) :: sum_fuel ! total ground fuel related to ROS (omits 1000 hr fuels) [kgC/m2] + real(r8) :: fuel_frac(nfsc) ! fraction of each litter class in the ros_fuel [0-1] + real(r8) :: livegrass ! total aboveground grass biomass in patch [kgC/m2] + real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel. [kg/m3] + ! (incl. live grasses, omits 1000hr fuels) + real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel [cm-1] + ! (incl. live grasses, omits 1000hr fuels) + real(r8) :: fuel_mef ! average moisture of extinction factor + ! of the ground fuel (incl. live grasses, omits 1000hr fuels) + real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel + ! (incl. live grasses. omits 1000hr fuels) + real(r8) :: litter_moisture(nfsc) ! moisture of litter [m3/m3] + + ! fire spread + real(r8) :: ros_front ! rate of forward spread of fire [m/min] + real(r8) :: ros_back ! rate of backward spread of fire [m/min] + real(r8) :: effect_wspeed ! windspeed modified by fraction of relative grass and tree cover [m/min] + real(r8) :: tau_l ! duration of lethal heating [min] + real(r8) :: fi ! average fire intensity of flaming front [kJ/m/s] or [kW/m] + integer :: fire ! is there a fire? [1=yes; 0=no] + real(r8) :: fd ! fire duration [min] + + ! fire effects + real(r8) :: scorch_ht(maxpft) ! scorch height [m] + real(r8) :: frac_burnt ! fraction burnt [0-1/day] + real(r8) :: tfc_ros ! total intensity-relevant fuel consumed - no trunks [kgC/m2 of burned ground/day] + real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned, conditional on it being burned [0-1] + + !--------------------------------------------------------------------------- + + ! PLANT HYDRAULICS (not currently used in hydraulics RGK 03-2018) + ! type(ed_patch_hydr_type), pointer :: pa_hydr ! All patch hydraulics data, see FatesHydraulicsMemMod.F90 + + contains + + procedure :: Init + procedure :: NanValues + procedure :: ZeroValues + procedure :: InitRunningMeans + procedure :: InitLitter + procedure :: Create + procedure :: FreeMemory + procedure :: Dump + procedure :: CheckVars + + end type fates_patch_type + + contains + + !=========================================================================== + + subroutine Init(this, num_swb, num_levsoil) + ! + ! DESCRIPTION: + ! Initialize a new patch - allocate arrays and set values to nan and/or 0.0 + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(inout) :: this ! patch object + integer, intent(in) :: num_swb ! number of shortwave broad-bands to track + integer, intent(in) :: num_levsoil ! number of soil layers + + ! allocate arrays + allocate(this%tr_soil_dir(num_swb)) + allocate(this%tr_soil_dif(num_swb)) + allocate(this%tr_soil_dir_dif(num_swb)) + allocate(this%fab(num_swb)) + allocate(this%fabd(num_swb)) + allocate(this%fabi(num_swb)) + allocate(this%sabs_dir(num_swb)) + allocate(this%sabs_dif(num_swb)) + allocate(this%fragmentation_scaler(num_levsoil)) + + ! initialize all values to nan + call this%NanValues() + + ! zero values that should be zeroed + call this%ZeroValues() + + end subroutine Init + + !=========================================================================== + + subroutine NanValues(this) + ! + ! DESCRIPTION: + ! Sets all values in patch to nan + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(inout) :: this ! patch object + + ! set pointers to null + this%tallest => null() + this%shortest => null() + this%older => null() + this%younger => null() + nullify(this%tallest) + nullify(this%shortest) + nullify(this%older) + nullify(this%younger) + + ! INDICES + this%patchno = fates_unset_int + this%nocomp_pft_label = fates_unset_int + + ! PATCH INFO + this%age = nan + this%age_class = fates_unset_int + this%area = nan + this%countcohorts = fates_unset_int + this%ncl_p = fates_unset_int + this%anthro_disturbance_label = fates_unset_int + this%age_since_anthro_disturbance = nan + + ! LEAF ORGANIZATION + this%pft_agb_profile(:,:) = nan + this%canopy_layer_tlai(:) = nan + this%total_canopy_area = nan + this%total_tree_area = nan + this%zstar = nan + this%elai_profile(:,:,:) = nan + this%esai_profile(:,:,:) = nan + this%tlai_profile(:,:,:) = nan + this%tsai_profile(:,:,:) = nan + this%canopy_area_profile(:,:,:) = nan + this%canopy_mask(:,:) = fates_unset_int + this%nrad(:,:) = fates_unset_int + this%ncan(:,:) = fates_unset_int + this%c_stomata = nan + this%c_lblayer = nan + this%layer_height_profile(:,:,:) = nan + + this%psn_z(:,:,:) = nan + this%nrmlzd_parprof_pft_dir_z(:,:,:,:) = nan + this%nrmlzd_parprof_pft_dif_z(:,:,:,:) = nan + this%nrmlzd_parprof_dir_z(:,:,:) = nan + this%nrmlzd_parprof_dir_z(:,:,:) = nan + + ! RADIATION + this%radiation_error = nan + this%fcansno = nan + this%solar_zenith_flag = .false. + this%solar_zenith_angle = nan + this%gnd_alb_dif(:) = nan + this%gnd_alb_dir(:) = nan + this%fabd_sun_z(:,:,:) = nan + this%fabd_sha_z(:,:,:) = nan + this%fabi_sun_z(:,:,:) = nan + this%fabi_sha_z(:,:,:) = nan + this%ed_laisun_z(:,:,:) = nan + this%ed_laisha_z(:,:,:) = nan + this%ed_parsun_z(:,:,:) = nan + this%ed_parsha_z(:,:,:) = nan + this%f_sun(:,:,:) = nan + this%parprof_pft_dir_z(:,:,:) = nan + this%parprof_pft_dif_z(:,:,:) = nan + this%parprof_dir_z(:,:) = nan + this%parprof_dif_z(:,:) = nan + this%tr_soil_dir(:) = nan + this%tr_soil_dif(:) = nan + this%tr_soil_dir_dif(:) = nan + this%fab(:) = nan + this%fabd(:) = nan + this%fabi(:) = nan + this%sabs_dir(:) = nan + this%sabs_dif(:) = nan + + ! ROOTS + this%btran_ft(:) = nan + this%bstress_sal_ft(:) = nan + + ! EXTERNAL SEED RAIN + this%nitr_repro_stoich(:) = nan + this%phos_repro_stoich(:) = nan + + ! DISTURBANCE + this%disturbance_rates(:) = nan + this%fract_ldist_not_harvested = nan + + ! LITTER AND COARSE WOODY DEBRIS + this%fragmentation_scaler(:) = nan + + ! FUELS AND FIRE + this%sum_fuel = nan + this%fuel_frac(:) = nan + this%livegrass = nan + this%fuel_bulkd = nan + this%fuel_sav = nan + this%fuel_mef = nan + this%fuel_eff_moist = nan + this%litter_moisture(:) = nan + this%ros_front = nan + this%ros_back = nan + this%effect_wspeed = nan + this%tau_l = nan + this%fi = nan + this%fire = fates_unset_int + this%fd = nan + this%scorch_ht(:) = nan + this%frac_burnt = nan + this%tfc_ros = nan + this%burnt_frac_litter(:) = nan + + end subroutine NanValues + + !=========================================================================== + + subroutine ZeroValues(this) + ! + ! DESCRIPTION: + ! sets specific variables in patch to zero + ! these should only be values that are incremented, so that we can + ! catch all other uninitialized variables with nans + + ! ARGUMENTS: + class(fates_patch_type), intent(inout) :: this + + ! LEAF ORGANIZATION + this%canopy_layer_tlai(:) = 0.0_r8 + this%total_tree_area = 0.0_r8 + this%zstar = 0.0_r8 + this%elai_profile(:,:,:) = 0.0_r8 + this%c_stomata = 0.0_r8 + this%c_lblayer = 0.0_r8 + this%psn_z(:,:,:) = 0.0_r8 + this%nrmlzd_parprof_pft_dir_z(:,:,:,:) = 0.0_r8 + this%nrmlzd_parprof_pft_dif_z(:,:,:,:) = 0.0_r8 + this%nrmlzd_parprof_dir_z(:,:,:) = 0.0_r8 + this%nrmlzd_parprof_dif_z(:,:,:) = 0.0_r8 + + ! RADIATION + this%radiation_error = 0.0_r8 + this%fabd_sun_z(:,:,:) = 0.0_r8 + this%fabd_sha_z(:,:,:) = 0.0_r8 + this%fabi_sun_z(:,:,:) = 0.0_r8 + this%fabi_sha_z(:,:,:) = 0.0_r8 + this%ed_parsun_z(:,:,:) = 0.0_r8 + this%ed_parsha_z(:,:,:) = 0.0_r8 + this%ed_laisun_z(:,:,:) = 0.0_r8 + this%ed_laisha_z(:,:,:) = 0.0_r8 + this%f_sun = 0.0_r8 + this%tr_soil_dir_dif(:) = 0.0_r8 + this%fab(:) = 0.0_r8 + this%fabi(:) = 0.0_r8 + this%fabd(:) = 0.0_r8 + this%sabs_dir(:) = 0.0_r8 + this%sabs_dif(:) = 0.0_r8 + + ! ROOTS + this%btran_ft(:) = 0.0_r8 + + ! DISTURBANCE + this%disturbance_rates(:) = 0.0_r8 + this%fract_ldist_not_harvested = 0.0_r8 + + ! LITTER AND COARSE WOODY DEBRIS + this%fragmentation_scaler(:) = 0.0_r8 + + ! FIRE + this%sum_fuel = 0.0_r8 + this%fuel_frac(:) = 0.0_r8 + this%livegrass = 0.0_r8 + this%fuel_bulkd = 0.0_r8 + this%fuel_sav = 0.0_r8 + this%fuel_mef = 0.0_r8 + this%fuel_eff_moist = 0.0_r8 + this%litter_moisture(:) = 0.0_r8 + this%ros_front = 0.0_r8 + this%ros_back = 0.0_r8 + this%effect_wspeed = 0.0_r8 + this%tau_l = 0.0_r8 + this%fi = 0.0_r8 + this%fd = 0.0_r8 + this%scorch_ht(:) = 0.0_r8 + this%frac_burnt = 0.0_r8 + this%tfc_ros = 0.0_r8 + this%burnt_frac_litter(:) = 0.0_r8 + + end subroutine ZeroValues + + !=========================================================================== + + subroutine InitRunningMeans(this, current_tod, regeneration_model, numpft) + ! + ! DESCRIPTION: + ! set initial values for patch running means + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(inout) :: this ! patch object + integer, intent(in) :: current_tod ! time of day [seconds past 0Z] + integer, intent(in) :: regeneration_model ! regeneration model type + integer, intent(in) :: numpft ! number of pfts on patch + + ! PARAMETERS: + ! Until bc's are pointed to by sites give veg a default temp [K] + real(r8), parameter :: temp_init_veg = 15._r8 + t_water_freeze_k_1atm + real(r8), parameter :: init_seedling_par = 5.0_r8 ! arbitrary initialization for seedling layer [MJ m-2 d-1] + real(r8), parameter :: init_seedling_smp = -26652.0_r8 ! abitrary initialization of smp [mm] + integer :: pft ! pft looping index + + allocate(this%tveg24) + allocate(this%tveg_lpa) + allocate(this%tveg_longterm) + + ! set initial values for running means + call this%tveg24%InitRMean(fixed_24hr, init_value=temp_init_veg, & + init_offset=real(current_tod, r8)) + call this%tveg_lpa%InitRmean(ema_lpa, init_value=temp_init_veg) + call this%tveg_longterm%InitRmean(ema_longterm, init_value=temp_init_veg) + + if (regeneration_model == TRS_regeneration) then + allocate(this%seedling_layer_par24) + allocate(this%sdlng_mdd(numpft)) + allocate(this%sdlng_emerg_smp(numpft)) + allocate(this%sdlng_mort_par) + allocate(this%sdlng2sap_par) + + call this%seedling_layer_par24%InitRMean(fixed_24hr, & + init_value=init_seedling_par, init_offset=real(current_tod, r8)) + call this%sdlng_mort_par%InitRMean(ema_sdlng_mort_par, & + init_value=temp_init_veg) + call this%sdlng2sap_par%InitRMean(ema_sdlng2sap_par, & + init_value=init_seedling_par) + + do pft = 1,numpft + allocate(this%sdlng_mdd(pft)%p) + allocate(this%sdlng_emerg_smp(pft)%p) + + call this%sdlng_mdd(pft)%p%InitRMean(ema_sdlng_mdd, & + init_value=0.0_r8) + call this%sdlng_emerg_smp(pft)%p%InitRMean(ema_sdlng_emerg_h2o, & + init_value=init_seedling_smp) + end do + end if + + end subroutine InitRunningMeans + + !=========================================================================== + + subroutine InitLitter(this, num_pft, num_levsoil) + ! + ! DESCRIPTION: + ! set initial values for litter + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(inout) :: this ! patch object + integer, intent(in) :: num_pft ! number of pfts to simulate + integer, intent(in) :: num_levsoil ! number of soil layers + + ! LOCALS: + integer :: el ! looping index + + allocate(this%litter(num_elements)) + + do el = 1, num_elements + call this%litter(el)%InitAllocate(num_pft, num_levsoil, element_list(el)) + call this%litter(el)%ZeroFlux() + call this%litter(el)%InitConditions(init_leaf_fines=fates_unset_r8, & + init_root_fines=fates_unset_r8, init_ag_cwd=fates_unset_r8, & + init_bg_cwd=fates_unset_r8, init_seed=fates_unset_r8, & + init_seed_germ=fates_unset_r8) + end do + + end subroutine InitLitter + + !=========================================================================== + + subroutine Create(this, age, area, label, nocomp_pft, num_swb, num_pft, & + num_levsoil, current_tod, regeneration_model) + ! + ! DESCRIPTION: + ! create a new patch with input and default values + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(inout) :: this ! patch object + real(r8), intent(in) :: age ! notional age of this patch in years + real(r8), intent(in) :: area ! initial area of this patch in m2. + integer, intent(in) :: label ! anthropogenic disturbance label + integer, intent(in) :: nocomp_pft ! no-competition mode pft label + integer, intent(in) :: num_swb ! number of shortwave broad-bands to track + integer, intent(in) :: num_pft ! number of pfts to simulate + integer, intent(in) :: num_levsoil ! number of soil layers + integer, intent(in) :: current_tod ! time of day [seconds past 0Z] + integer, intent(in) :: regeneration_model ! regeneration model version + + ! initialize patch + ! sets all values to nan, then some values to zero + call this%Init(num_swb, num_levsoil) + + ! initialize running means for patch + call this%InitRunningMeans(current_tod, regeneration_model, num_pft) + + ! initialize litter + call this%InitLitter(num_pft, num_levsoil) + + ! assign known patch attributes + this%age = age + this%age_class = 1 + this%area = area + + ! assign anthropgenic disturbance category and label + this%anthro_disturbance_label = label + if (label .eq. secondaryforest) then + this%age_since_anthro_disturbance = age + else + this%age_since_anthro_disturbance = fates_unset_r8 + endif + this%nocomp_pft_label = nocomp_pft + + this%tr_soil_dir(:) = 1.0_r8 + this%tr_soil_dif(:) = 1.0_r8 + this%NCL_p = 1 + + end subroutine Create + + !=========================================================================== + + subroutine FreeMemory(this, regeneration_model, numpft) + ! + ! DESCRIPTION: + ! deallocate the allocatable memory associated with this patch + ! this DOES NOT deallocate the patch structure itself + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(inout) :: this + integer, intent(in) :: regeneration_model + integer, intent(in) :: numpft + + ! LOCALS: + type(fates_cohort_type), pointer :: ccohort ! current cohort + type(fates_cohort_type), pointer :: ncohort ! next cohort + integer :: el ! loop counter for elements + integer :: pft ! loop counter for pfts + integer :: istat ! return status code + character(len=255) :: smsg ! message string for deallocation errors + + ! first deallocate the cohorts + ccohort => this%shortest + do while(associated(ccohort)) + ncohort => ccohort%taller + call ccohort%FreeMemory() + deallocate(ccohort, stat=istat, errmsg=smsg) + if (istat /= 0) then + write(fates_log(),*) 'dealloc007: fail on deallocate(cchort):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + ccohort => ncohort + end do + + ! deallocate all litter objects + do el=1,num_elements + call this%litter(el)%DeallocateLitt() + end do + deallocate(this%litter, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc008: fail on deallocate(this%litter):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + ! deallocate the allocatable arrays + deallocate(this%tr_soil_dir, & + this%tr_soil_dif, & + this%tr_soil_dir_dif, & + this%fab, & + this%fabd, & + this%fabi, & + this%sabs_dir, & + this%sabs_dif, & + this%fragmentation_scaler, & + stat=istat, errmsg=smsg) + + if (istat/=0) then + write(fates_log(),*) 'dealloc009: fail on deallocate patch vectors:'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + ! deallocate running means + deallocate(this%tveg24, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc010: fail on deallocate(this%tveg24):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + deallocate(this%tveg_lpa, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc011: fail on deallocate(this%tveg_lpa):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + deallocate(this%tveg_longterm, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc012: fail on deallocate(this%tveg_longterm):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + if (regeneration_model == TRS_regeneration) then + deallocate(this%seedling_layer_par24) + deallocate(this%sdlng_mort_par) + deallocate(this%sdlng2sap_par) + do pft = 1, numpft + deallocate(this%sdlng_mdd(pft)%p) + end do + deallocate(this%sdlng_mdd) + do pft = 1, numpft + deallocate(this%sdlng_emerg_smp(pft)%p) + end do + deallocate(this%sdlng_emerg_smp) + end if + + end subroutine FreeMemory + + !=========================================================================== + + subroutine Dump(this) + ! + ! DESCRIPTION: + ! print attributes of a patch + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(in) :: this ! patch object + + ! LOCALS: + integer :: el ! element loop counting index + + write(fates_log(),*) '----------------------------------------' + write(fates_log(),*) ' Dumping Patch Information ' + write(fates_log(),*) ' (omitting arrays) ' + write(fates_log(),*) '----------------------------------------' + write(fates_log(),*) 'pa%patchno = ',this%patchno + write(fates_log(),*) 'pa%age = ',this%age + write(fates_log(),*) 'pa%age_class = ',this%age_class + write(fates_log(),*) 'pa%area = ',this%area + write(fates_log(),*) 'pa%countcohorts = ',this%countcohorts + write(fates_log(),*) 'pa%ncl_p = ',this%ncl_p + write(fates_log(),*) 'pa%total_canopy_area = ',this%total_canopy_area + write(fates_log(),*) 'pa%total_tree_area = ',this%total_tree_area + write(fates_log(),*) 'pa%zstar = ',this%zstar + write(fates_log(),*) 'pa%solar_zenith_flag = ',this%solar_zenith_flag + write(fates_log(),*) 'pa%solar_zenith_angle = ',this%solar_zenith_angle + write(fates_log(),*) 'pa%gnd_alb_dif = ',this%gnd_alb_dif(:) + write(fates_log(),*) 'pa%gnd_alb_dir = ',this%gnd_alb_dir(:) + write(fates_log(),*) 'pa%c_stomata = ',this%c_stomata + write(fates_log(),*) 'pa%c_lblayer = ',this%c_lblayer + write(fates_log(),*) 'pa%disturbance_rates = ',this%disturbance_rates(:) + write(fates_log(),*) 'pa%anthro_disturbance_label = ',this%anthro_disturbance_label + write(fates_log(),*) '----------------------------------------' + + do el = 1, num_elements + write(fates_log(),*) 'element id: ',element_list(el) + write(fates_log(),*) 'seed mass: ',sum(this%litter(el)%seed) + write(fates_log(),*) 'seed germ mass: ',sum(this%litter(el)%seed_germ) + write(fates_log(),*) 'leaf fines(pft): ',sum(this%litter(el)%leaf_fines) + write(fates_log(),*) 'root fines(pft,sl): ',sum(this%litter(el)%root_fines) + write(fates_log(),*) 'ag_cwd(c): ',sum(this%litter(el)%ag_cwd) + write(fates_log(),*) 'bg_cwd(c,sl): ',sum(this%litter(el)%bg_cwd) + end do + + end subroutine Dump + + !=========================================================================== + + subroutine CheckVars(this, var_aliases, return_code) + ! + ! DESCRIPTION: + ! perform numerical checks on patch variables of interest + ! The input string is of the form: 'VAR1_NAME:VAR2_NAME:VAR3_NAME' + ! + + ! ARGUMENTS: + class(fates_patch_type), intent(in) :: this ! patch object + character(len=*), intent(in) :: var_aliases + integer, intent(out) :: return_code ! return 0 for all fine + ! return 1 if a nan detected + ! return 10+ if an overflow + ! return 100% if an underflow + ! LOCALS: + type(fates_cohort_type), pointer :: currentCohort + + ! Check through a registry of variables to check + + if (check_hlm_list(trim(var_aliases), 'co_n')) then + currentCohort => this%shortest + do while(associated(currentCohort)) + call check_var_real(currentCohort%n, 'cohort%n', return_code) + if (.not.(return_code .eq. 0)) then + call this%Dump() + call currentCohort%Dump() + return + end if + currentCohort => currentCohort%taller + end do + end if + + if (check_hlm_list(trim(var_aliases), 'co_dbh')) then + currentCohort => this%shortest + do while(associated(currentCohort)) + call check_var_real(currentCohort%dbh, 'cohort%dbh', return_code) + if (.not. (return_code .eq. 0)) then + call this%Dump() + call currentCohort%Dump() + return + end if + currentCohort => currentCohort%taller + end do + end if + + if (check_hlm_list(trim(var_aliases), 'pa_area')) then + call check_var_real(this%area, 'patch%area', return_code) + if (.not. (return_code .eq. 0)) then + call this%Dump() + return + end if + end if + + end subroutine CheckVars + + !=========================================================================== + +end module FatesPatchMod \ No newline at end of file diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index b32186c93f..ecc2dabbbc 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -41,11 +41,11 @@ module FatesSoilBGCFluxMod use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : bbgw_allom use FatesAllometryMod , only : carea_allom - use EDTypesMod , only : p_uptake_mode - use EDTypesMod , only : n_uptake_mode + use EDParamsMod , only : p_uptake_mode + use EDParamsMod , only : n_uptake_mode use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type + use FatesPatchMod , only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : AREA,AREA_INV use FatesInterfaceTypesMod, only : bc_in_type use FatesInterfaceTypesMod, only : bc_out_type @@ -126,8 +126,8 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) integer :: icomp ! competitor index integer :: id ! decomp layer index integer :: pft ! pft index - type(ed_patch_type), pointer :: cpatch ! current patch pointer - type(ed_cohort_type), pointer :: ccohort ! current cohort pointer + type(fates_patch_type), pointer :: cpatch ! current patch pointer + type(fates_cohort_type), pointer :: ccohort ! current cohort pointer real(r8) :: fnrt_c ! fine-root carbon [kg] nsites = size(sites,dim=1) @@ -249,8 +249,8 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out) type(bc_out_type), intent(inout) :: bc_out type(bc_in_type), intent(in) :: bc_in - type(ed_patch_type), pointer :: cpatch ! current patch pointer - type(ed_cohort_type), pointer :: ccohort ! current cohort pointer + type(fates_patch_type), pointer :: cpatch ! current patch pointer + type(fates_cohort_type), pointer :: ccohort ! current cohort pointer integer :: pft ! plant functional type integer :: fp ! patch index of the site real(r8) :: agnpp ! Above ground daily npp @@ -419,8 +419,8 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) integer :: j ! soil layer index integer :: id ! decomp index (might == j) integer :: pft ! plant functional type - type(ed_patch_type), pointer :: cpatch ! current patch pointer - type(ed_cohort_type), pointer :: ccohort ! current cohort pointer + type(fates_patch_type), pointer :: cpatch ! current patch pointer + type(fates_cohort_type), pointer :: ccohort ! current cohort pointer real(r8) :: fnrt_c ! fine-root carbon [kg] real(r8) :: veg_rootc ! fine root carbon in each layer [g/m3] real(r8) :: decompmicc_layer ! Microbial dedcomposer biomass for current layer @@ -532,8 +532,8 @@ subroutine EffluxIntoLitterPools(csite, cpatch, ccohort, bc_in ) ! Arguments type(ed_site_type), intent(inout) :: csite - type(ed_patch_type), intent(inout) :: cpatch - type(ed_cohort_type), intent(inout),target :: ccohort + type(fates_patch_type), intent(inout) :: cpatch + type(fates_cohort_type), intent(inout),target :: ccohort type(bc_in_type), intent(in) :: bc_in ! locals @@ -616,7 +616,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) use FatesInterfaceTypesMod, only : bc_in_type, bc_out_type - use FatesInterfaceTypesMod, only : hlm_use_vertsoilc use FatesConstantsMod, only : itrue use FatesGlobals, only : endrun => fates_endrun use EDParamsMod , only : ED_val_cwd_flig, ED_val_cwd_fcel @@ -631,8 +630,8 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) type(bc_out_type) , intent(inout),target :: bc_out ! !LOCAL VARIABLES: - type (ed_patch_type), pointer :: currentPatch - type (ed_cohort_type), pointer :: ccohort + type (fates_patch_type), pointer :: currentPatch + type (fates_cohort_type), pointer :: ccohort real(r8), pointer :: flux_cel_si(:) real(r8), pointer :: flux_lab_si(:) real(r8), pointer :: flux_lig_si(:) diff --git a/biogeophys/EDAccumulateFluxesMod.F90 b/biogeophys/EDAccumulateFluxesMod.F90 index 9756c743f0..f32a2f0e6e 100644 --- a/biogeophys/EDAccumulateFluxesMod.F90 +++ b/biogeophys/EDAccumulateFluxesMod.F90 @@ -38,8 +38,9 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) ! ! !USES: - use EDTypesMod , only : ed_patch_type, ed_cohort_type, & - ed_site_type, AREA + use EDTypesMod , only : ed_site_type, AREA + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod, only : fates_cohort_type use FatesInterfaceTypesMod , only : bc_in_type,bc_out_type ! @@ -51,8 +52,8 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) real(r8), intent(in) :: dt_time ! timestep interval ! ! !LOCAL VARIABLES: - type(ed_cohort_type), pointer :: ccohort ! current cohort - type(ed_patch_type) , pointer :: cpatch ! current patch + type(fates_cohort_type), pointer :: ccohort ! current cohort + type(fates_patch_type) , pointer :: cpatch ! current patch integer :: iv !leaf layer integer :: c ! clm/alm column integer :: s ! ed site diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index 7b803469e5..a785493d54 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -9,10 +9,10 @@ module EDBtranMod use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm use FatesConstantsMod , only : itrue,ifalse,nearzero use FatesConstantsMod , only : nocomp_bareground - use EDTypesMod , only : ed_site_type, & - ed_patch_type, & - ed_cohort_type, & - maxpft + use EDTypesMod , only : ed_site_type + use FatesPatchMod, only : fates_patch_type + use EDParamsMod, only : maxpft + use FatesCohortMod, only : fates_cohort_type use shr_kind_mod , only : r8 => shr_kind_r8 use FatesInterfaceTypesMod , only : bc_in_type, & bc_out_type, & @@ -110,8 +110,8 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) ! ! !LOCAL VARIABLES: - type(ed_patch_type),pointer :: cpatch ! Current Patch Pointer - type(ed_cohort_type),pointer :: ccohort ! Current cohort pointer + type(fates_patch_type),pointer :: cpatch ! Current Patch Pointer + type(fates_cohort_type),pointer :: ccohort ! Current cohort pointer integer :: s ! site integer :: j ! soil layer integer :: ifp ! patch vector index for the site diff --git a/biogeophys/EDSurfaceAlbedoMod.F90 b/biogeophys/EDSurfaceAlbedoMod.F90 index 18d29c0109..18c7e7866e 100644 --- a/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/biogeophys/EDSurfaceAlbedoMod.F90 @@ -10,8 +10,9 @@ module EDSurfaceRadiationMod #include "shr_assert.h" - use EDTypesMod , only : ed_patch_type, ed_site_type - use EDTypesMod , only : maxpft + use EDTypesMod , only : ed_site_type + use FatesPatchMod, only : fates_patch_type + use EDParamsMod, only : maxpft use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue use FatesConstantsMod , only : pi_const @@ -20,18 +21,19 @@ module EDSurfaceRadiationMod 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 + use EDParamsMod , only : maxSWb + use EDParamsMod , only : nclmax + use EDParamsMod , only : nlevleaf use EDTypesMod , only : n_rad_stream_types use EDTypesMod , only : idiffuse use EDTypesMod , only : idirect - use EDTypesMod , only : ivis - use EDTypesMod , only : inir - use EDTypesMod , only : ipar + use EDParamsMod , only : ivis + use EDParamsMod , only : inir + use EDParamsMod , only : ipar use EDCanopyStructureMod, only: calc_areaindex use FatesGlobals , only : fates_log use FatesGlobals, only : endrun => fates_endrun + use EDPftvarcon, only : EDPftvarcon_inst ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -65,14 +67,8 @@ module EDSurfaceRadiationMod subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! - ! - ! !USES: - use EDPftvarcon , only : EDPftvarcon_inst - use EDtypesMod , only : ed_patch_type - use EDTypesMod , only : ed_site_type - - + ! !ARGUMENTS: integer, intent(in) :: nsites @@ -85,7 +81,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) integer :: s ! site loop counter integer :: ifp ! patch loop counter integer :: ib ! radiation broad band counter - type(ed_patch_type), pointer :: currentPatch ! patch pointer + type(fates_patch_type), pointer :: currentPatch ! patch pointer !----------------------------------------------------------------------- ! ------------------------------------------------------------------------------- @@ -194,16 +190,11 @@ subroutine PatchNormanRadiation (currentPatch, & ! ! ----------------------------------------------------------------------------------- - ! - ! !USES: - use EDPftvarcon , only : EDPftvarcon_inst - use EDtypesMod , only : ed_patch_type - ! ----------------------------------------------------------------------------------- ! !ARGUMENTS: ! ----------------------------------------------------------------------------------- - type(ed_patch_type), intent(inout), target :: currentPatch + type(fates_patch_type), intent(inout), target :: currentPatch real(r8), intent(inout) :: albd_parb_out(hlm_numSWb) real(r8), intent(inout) :: albi_parb_out(hlm_numSWb) real(r8), intent(inout) :: fabd_parb_out(hlm_numSWb) @@ -1126,7 +1117,7 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) ! locals - type (ed_patch_type),pointer :: cpatch ! c"urrent" patch + type (fates_patch_type),pointer :: cpatch ! c"urrent" patch real(r8) :: sunlai real(r8) :: shalai real(r8) :: elai diff --git a/biogeophys/FatesBstressMod.F90 b/biogeophys/FatesBstressMod.F90 index c56b4930f5..f37ab8ccb1 100644 --- a/biogeophys/FatesBstressMod.F90 +++ b/biogeophys/FatesBstressMod.F90 @@ -7,10 +7,10 @@ module FatesBstressMod ! use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm use FatesConstantsMod , only : itrue,ifalse - use EDTypesMod , only : ed_site_type, & - ed_patch_type, & - ed_cohort_type, & - maxpft + use EDParamsMod, only : maxpft + use EDTypesMod , only : ed_site_type + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use shr_kind_mod , only : r8 => shr_kind_r8 use FatesInterfaceTypesMod , only : bc_in_type, & bc_out_type, & @@ -48,8 +48,8 @@ subroutine btran_sal_stress_fates( nsites, sites, bc_in) ! ! !LOCAL VARIABLES: - type(ed_patch_type),pointer :: cpatch ! Current Patch Pointer - type(ed_cohort_type),pointer :: ccohort ! Current cohort pointer + type(fates_patch_type),pointer :: cpatch ! Current Patch Pointer + type(fates_cohort_type),pointer :: ccohort ! Current cohort pointer integer :: s ! site integer :: j ! soil layer integer :: ft ! plant functional type index diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index b97c50b72b..d3c4df6a38 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -52,11 +52,11 @@ module FatesPlantHydraulicsMod use EDParamsMod , only : hydr_solver use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type + use FatesPatchMod , only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : AREA_INV use EDTypesMod , only : AREA - use EDTypesMod , only : leaves_on + use FatesConstantsMod , only : leaves_on use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : bc_out_type @@ -252,7 +252,6 @@ module FatesPlantHydraulicsMod public :: InitHydrCohort public :: DeallocateHydrCohort public :: UpdateH2OVeg - public :: CopyCohortHydraulics public :: FuseCohortHydraulics public :: UpdateSizeDepPlantHydProps public :: UpdateSizeDepPlantHydStates @@ -336,8 +335,8 @@ subroutine RestartHydrStates(sites,nsites,bc_in,bc_out) ! locals ! ---------------------------------------------------------------------------------- ! LL pointers - type(ed_patch_type),pointer :: cpatch ! current patch - type(ed_cohort_type),pointer :: ccohort ! current cohort + type(fates_patch_type),pointer :: cpatch ! current patch + type(fates_cohort_type),pointer :: ccohort ! current cohort type(ed_cohort_hydr_type),pointer :: ccohort_hydr type(ed_site_hydr_type),pointer :: csite_hydr integer :: s ! site loop counter @@ -533,7 +532,7 @@ subroutine InitPlantHydStates(site, cohort) ! !ARGUMENTS: type(ed_site_type), intent(inout), target :: site ! current site pointer - type(ed_cohort_type), intent(inout), target :: cohort ! current cohort pointer + type(fates_cohort_type), intent(inout), target :: cohort ! current cohort pointer ! ! !LOCAL VARIABLES: type(ed_site_hydr_type), pointer :: csite_hydr @@ -682,7 +681,7 @@ subroutine UpdatePlantPsiFTCFromTheta(ccohort,csite_hydr) ! of total conductivity based on the relative water ! content ! Arguments - type(ed_cohort_type),intent(inout), target :: ccohort + type(fates_cohort_type),intent(inout), target :: ccohort type(ed_site_hydr_type),intent(in), target :: csite_hydr ! Locals @@ -742,7 +741,7 @@ subroutine UpdatePlantHydrNodes(ccohort,ft,plant_height,csite_hydr) ! -------------------------------------------------------------------------------- ! Arguments - type(ed_cohort_type), intent(inout) :: ccohort + type(fates_cohort_type), intent(inout) :: ccohort integer,intent(in) :: ft ! plant functional type index real(r8), intent(in) :: plant_height ! [m] type(ed_site_hydr_type), intent(in) :: csite_hydr @@ -845,7 +844,7 @@ subroutine UpdateSizeDepPlantHydProps(currentSite,ccohort,bc_in) ! ARGUMENTS: type(ed_site_type) , intent(in) :: currentSite ! Site stuff - type(ed_cohort_type) , intent(inout) :: ccohort ! current cohort pointer + type(fates_cohort_type) , intent(inout) :: ccohort ! current cohort pointer type(bc_in_type) , intent(in) :: bc_in ! Boundary Conditions ! Locals @@ -894,7 +893,7 @@ subroutine UpdatePlantHydrLenVol(ccohort,csite_hydr) ! ----------------------------------------------------------------------------------- ! Arguments - type(ed_cohort_type),intent(inout) :: ccohort + type(fates_cohort_type),intent(inout) :: ccohort type(ed_site_hydr_type),intent(in) :: csite_hydr type(ed_cohort_hydr_type),pointer :: ccohort_hydr ! Plant hydraulics structure @@ -1096,7 +1095,7 @@ subroutine UpdateSizeDepPlantHydStates(currentSite,ccohort) ! !ARGUMENTS: type(ed_site_type) , intent(in) :: currentSite ! Site stuff - type(ed_cohort_type) , intent(inout) :: ccohort + type(fates_cohort_type) , intent(inout) :: ccohort ! ! !LOCAL VARIABLES: type(ed_cohort_hydr_type), pointer :: ccohort_hydr @@ -1195,79 +1194,11 @@ end function constrain_water_contents ! ===================================================================================== -subroutine CopyCohortHydraulics(newCohort, oldCohort) - - ! Arguments - type(ed_cohort_type), intent(inout), target :: newCohort - type(ed_cohort_type), intent(inout), target :: oldCohort - - ! Locals - type(ed_cohort_hydr_type), pointer :: ncohort_hydr - type(ed_cohort_hydr_type), pointer :: ocohort_hydr - - - ncohort_hydr => newCohort%co_hydr - ocohort_hydr => oldCohort%co_hydr - - ! Node heights - ncohort_hydr%z_node_ag = ocohort_hydr%z_node_ag - ncohort_hydr%z_upper_ag = ocohort_hydr%z_upper_ag - ncohort_hydr%z_lower_ag = ocohort_hydr%z_lower_ag - ncohort_hydr%z_node_troot = ocohort_hydr%z_node_troot - - ! Compartment kmax's - ncohort_hydr%kmax_petiole_to_leaf = ocohort_hydr%kmax_petiole_to_leaf - ncohort_hydr%kmax_stem_lower = ocohort_hydr%kmax_stem_lower - ncohort_hydr%kmax_stem_upper = ocohort_hydr%kmax_stem_upper - ncohort_hydr%kmax_troot_upper = ocohort_hydr%kmax_troot_upper - ncohort_hydr%kmax_troot_lower = ocohort_hydr%kmax_troot_lower - ncohort_hydr%kmax_aroot_upper = ocohort_hydr%kmax_aroot_upper - ncohort_hydr%kmax_aroot_lower = ocohort_hydr%kmax_aroot_lower - ncohort_hydr%kmax_aroot_radial_in = ocohort_hydr%kmax_aroot_radial_in - ncohort_hydr%kmax_aroot_radial_out = ocohort_hydr%kmax_aroot_radial_out - - ! Compartment volumes - ncohort_hydr%v_ag_init = ocohort_hydr%v_ag_init - ncohort_hydr%v_ag = ocohort_hydr%v_ag - ncohort_hydr%v_troot_init = ocohort_hydr%v_troot_init - ncohort_hydr%v_troot = ocohort_hydr%v_troot - ncohort_hydr%v_aroot_layer_init = ocohort_hydr%v_aroot_layer_init - ncohort_hydr%v_aroot_layer = ocohort_hydr%v_aroot_layer - ncohort_hydr%l_aroot_layer = ocohort_hydr%l_aroot_layer - - ! State Variables - ncohort_hydr%th_ag = ocohort_hydr%th_ag - ncohort_hydr%th_troot = ocohort_hydr%th_troot - ncohort_hydr%th_aroot = ocohort_hydr%th_aroot - ncohort_hydr%psi_ag = ocohort_hydr%psi_ag - ncohort_hydr%psi_troot = ocohort_hydr%psi_troot - ncohort_hydr%psi_aroot = ocohort_hydr%psi_aroot - ncohort_hydr%ftc_ag = ocohort_hydr%ftc_ag - ncohort_hydr%ftc_troot = ocohort_hydr%ftc_troot - ncohort_hydr%ftc_aroot = ocohort_hydr%ftc_aroot - - ! Other - ncohort_hydr%btran = ocohort_hydr%btran - ncohort_hydr%supsub_flag = ocohort_hydr%supsub_flag - ncohort_hydr%iterh1 = ocohort_hydr%iterh1 - ncohort_hydr%iterh2 = ocohort_hydr%iterh2 - ncohort_hydr%iterlayer = ocohort_hydr%iterlayer - ncohort_hydr%errh2o = ocohort_hydr%errh2o - - - ! BC PLANT HYDRAULICS - flux terms - ncohort_hydr%qtop = ocohort_hydr%qtop - - ncohort_hydr%is_newly_recruited = ocohort_hydr%is_newly_recruited - -end subroutine CopyCohortHydraulics - -! ===================================================================================== subroutine FuseCohortHydraulics(currentSite,currentCohort, nextCohort, bc_in, newn) - type(ed_cohort_type), intent(inout), target :: currentCohort ! current cohort - type(ed_cohort_type), intent(inout), target :: nextCohort ! next (donor) cohort + type(fates_cohort_type), intent(inout), target :: currentCohort ! current cohort + type(fates_cohort_type), intent(inout), target :: nextCohort ! next (donor) cohort type(ed_site_type), intent(inout), target :: currentSite ! current site type(bc_in_type), intent(in) :: bc_in @@ -1372,7 +1303,7 @@ subroutine InitHydrCohort(currentSite,currentCohort) ! Arguments type(ed_site_type), target :: currentSite - type(ed_cohort_type), target :: currentCohort + type(fates_cohort_type), target :: currentCohort type(ed_cohort_hydr_type), pointer :: ccohort_hydr if ( hlm_use_planthydro.eq.ifalse ) return @@ -1388,7 +1319,7 @@ end subroutine InitHydrCohort subroutine DeallocateHydrCohort(currentCohort) ! Arguments - type(ed_cohort_type), target :: currentCohort + type(fates_cohort_type), target :: currentCohort type(ed_cohort_hydr_type), pointer :: ccohort_hydr if ( hlm_use_planthydro.eq.ifalse ) return @@ -1776,8 +1707,8 @@ subroutine UpdateH2OVeg(csite,bc_out,prev_site_h2o,icall) ! Locals - type(ed_cohort_type), pointer :: currentCohort - type(ed_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch type(ed_cohort_hydr_type), pointer :: ccohort_hydr type(ed_site_hydr_type), pointer :: csite_hydr integer :: s @@ -1859,8 +1790,8 @@ subroutine RecruitWUptake(nsites,sites,bc_in,dtime,recruitflag) logical, intent(out) :: recruitflag !flag to check if there is newly recruited cohorts ! Locals - type(ed_cohort_type), pointer :: currentCohort - type(ed_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch type(ed_cohort_hydr_type), pointer :: ccohort_hydr type(ed_site_hydr_type), pointer :: csite_hydr integer :: s, j, ft @@ -1925,7 +1856,7 @@ end subroutine RecruitWUptake !===================================================================================== -subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) +subroutine ConstrainRecruitNumber(csite,ccohort, cpatch, bc_in, mean_temp) ! --------------------------------------------------------------------------- ! This subroutine constrains the number of plants so that there is enought water @@ -1934,13 +1865,14 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) ! Arguments type(ed_site_type), intent(inout), target :: csite - type(ed_cohort_type) , intent(inout), target :: ccohort + type(fates_cohort_type) , intent(inout), target :: ccohort + type(fates_patch_type), intent(inout), target :: cpatch type(bc_in_type) , intent(in) :: bc_in + real(r8), intent(in) :: mean_temp ! Locals type(ed_cohort_hydr_type), pointer :: ccohort_hydr type(ed_site_hydr_type), pointer :: csite_hydr - type(ed_patch_type), pointer :: cpatch real(r8) :: tmp1 real(r8) :: watres_local ! minum water content [m3/m3] real(r8) :: total_water ! total water in rhizosphere at a specific layer (m^3 ha-1) @@ -1956,7 +1888,6 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) real(r8) :: leaf_m, store_m, sapw_m ! Element mass in organ tissues real(r8) :: fnrt_m, struct_m, repro_m ! Element mass in organ tissues - cpatch => ccohort%patchptr csite_hydr => csite%si_hydr ccohort_hydr =>ccohort%co_hydr recruitw = (sum(ccohort_hydr%th_ag(:)*ccohort_hydr%v_ag(:)) + & @@ -1990,7 +1921,7 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) end do ! Prevent recruitment when temperatures are freezing or below - if (cpatch%tveg24%GetMean() <= 273.15_r8) then + if (mean_temp <= 273.15_r8) then nmin = 0._r8 end if @@ -2060,8 +1991,8 @@ subroutine UpdateSizeDepRhizVolLenCon(currentSite, bc_in) ! ! !LOCAL VARIABLES: type(ed_site_hydr_type), pointer :: csite_hydr - type(ed_patch_type) , pointer :: cPatch - type(ed_cohort_type) , pointer :: cCohort + type(fates_patch_type) , pointer :: cPatch + type(fates_cohort_type) , pointer :: cCohort type(ed_cohort_hydr_type), pointer :: ccohort_hydr real(r8) :: hksat_s ! hksat converted to units of 10^6sec ! which is equiv to [kg m-1 s-1 MPa-1] @@ -2197,8 +2128,8 @@ subroutine BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) integer :: s integer :: ifp real(r8) :: balive_patch - type(ed_patch_type),pointer :: cpatch - type(ed_cohort_type),pointer :: ccohort + type(fates_patch_type),pointer :: cpatch + type(fates_cohort_type),pointer :: ccohort do s = 1,nsites @@ -2427,8 +2358,8 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) !---------------------------------------------------------------------- - type (ed_patch_type), pointer :: cpatch ! current patch pointer - type (ed_cohort_type), pointer :: ccohort ! current cohort pointer + type (fates_patch_type), pointer :: cpatch ! current patch pointer + type (fates_cohort_type), pointer :: ccohort ! current cohort pointer type(ed_site_hydr_type), pointer :: csite_hydr ! site hydraulics pointer type(ed_cohort_hydr_type), pointer :: ccohort_hydr ! cohort hydraulics pointer @@ -2943,7 +2874,7 @@ subroutine UpdatePlantKmax(ccohort_hydr,ccohort,csite_hydr) ! Arguments type(ed_cohort_hydr_type),intent(inout),target :: ccohort_hydr - type(ed_cohort_type),intent(in),target :: ccohort + type(fates_cohort_type),intent(in),target :: ccohort type(ed_site_hydr_type),intent(in),target :: csite_hydr ! Locals @@ -3153,7 +3084,7 @@ subroutine OrderLayersForSolve1D(csite_hydr,cohort,cohort_hydr,ordered, kbg_laye ! Arguments (IN) type(ed_site_hydr_type), intent(in),target :: csite_hydr - type(ed_cohort_type), intent(in),target :: cohort + type(fates_cohort_type), intent(in),target :: cohort type(ed_cohort_hydr_type),intent(in),target :: cohort_hydr @@ -3295,7 +3226,7 @@ subroutine ImTaylorSolve1D(slat, slon,recruitflag,csite_hydr,cohort,cohort_hydr, real(r8), intent(in) :: slat ! latitidue of the site real(r8), intent(in) :: slon ! longitidue of the site logical, intent(in) :: recruitflag - type(ed_cohort_type),intent(in),target :: cohort + type(fates_cohort_type),intent(in),target :: cohort type(ed_cohort_hydr_type),intent(inout),target :: cohort_hydr type(ed_site_hydr_type), intent(in),target :: csite_hydr real(r8), intent(in) :: dtime @@ -3988,7 +3919,7 @@ subroutine Report1DError(cohort, csite_hydr, ilayer, z_node, v_node, & ! like, and then quits. ! Arguments (IN) - type(ed_cohort_type),intent(in),target :: cohort + type(fates_cohort_type),intent(in),target :: cohort type(ed_site_hydr_type),intent(in), target :: csite_hydr integer, intent(in) :: ilayer ! soil layer index of interest real(r8), intent(in) :: z_node(:) ! elevation of nodes @@ -4301,7 +4232,7 @@ subroutine AccumulateMortalityWaterStorage(csite,ccohort,delta_n) ! Arguments type(ed_site_type), intent(inout), target :: csite - type(ed_cohort_type) , intent(inout), target :: ccohort + type(fates_cohort_type) , intent(inout), target :: ccohort real(r8), intent(in) :: delta_n ! Loss in number density ! for this cohort /ha/day @@ -4345,8 +4276,8 @@ subroutine RecruitWaterStorage(nsites,sites,bc_out) type(bc_out_type), intent(inout) :: bc_out(nsites) ! Locals - type(ed_cohort_type), pointer :: currentCohort - type(ed_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch type(ed_cohort_hydr_type), pointer :: ccohort_hydr type(ed_site_hydr_type), pointer :: csite_hydr integer :: s @@ -4795,7 +4726,7 @@ subroutine MatSolve2D(csite_hydr,cohort,cohort_hydr, & ! ----------------------------------------------------------------------------------- type(ed_site_hydr_type), intent(inout),target :: csite_hydr ! ED csite_hydr structure type(ed_cohort_hydr_type), target :: cohort_hydr - type(ed_cohort_type) , intent(inout), target :: cohort + type(fates_cohort_type) , intent(inout), target :: cohort real(r8),intent(in) :: tmx ! time interval to integrate over [s] real(r8),intent(in) :: qtop real(r8),intent(out) :: sapflow ! time integrated mass flux between transp-root and stem [kg] @@ -5564,7 +5495,7 @@ subroutine PicardSolve2D(csite_hydr,cohort,cohort_hydr, & ! ----------------------------------------------------------------------------------- type(ed_site_hydr_type), intent(inout),target :: csite_hydr ! ED csite_hydr structure type(ed_cohort_hydr_type), target :: cohort_hydr - type(ed_cohort_type) , intent(inout), target :: cohort + type(fates_cohort_type) , intent(inout), target :: cohort real(r8),intent(in) :: tmx ! time interval to integrate over [s] real(r8),intent(in) :: qtop integer :: nnode !total number of nodes diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index bae50e8221..603e691067 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -38,12 +38,14 @@ module FATESPlantRespPhotosynthMod 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 + use EDParamsMod, only : maxpft + use EDParamsMod, only : nlevleaf + use EDParamsMod, only : nclmax use PRTGenericMod, only : max_nleafage use EDTypesMod, only : do_fates_salinity use EDParamsMod, only : q10_mr + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod, only : fates_cohort_type use EDParamsMod, only : maintresp_leaf_model use FatesConstantsMod, only : lmrmodel_ryan_1991 use FatesConstantsMod, only : lmrmodel_atkin_etal_2017 @@ -122,16 +124,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! a multi-layer canopy ! ----------------------------------------------------------------------------------- - ! !USES: - - use FatesSynchronizedParamsMod , only : FatesSynchronizedParamsInst - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_site_type - use EDTypesMod , only : maxpft - use EDTypesMod , only : dinc_vai - use EDTypesMod , only : dlower_vai + use EDParamsMod , only : dinc_vai + use EDParamsMod , only : dlower_vai use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : bc_out_type use EDCanopyStructureMod, only : calc_areaindex @@ -160,8 +156,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! LOCAL VARIABLES: ! ----------------------------------------------------------------------------------- - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type), pointer :: currentCohort + type (fates_patch_type) , pointer :: currentPatch + type (fates_cohort_type), pointer :: currentCohort ! ----------------------------------------------------------------------------------- ! These three arrays hold leaf-level biophysical rates that are calculated @@ -1894,13 +1890,9 @@ subroutine UpdateCanopyNCanNRadPresent(currentPatch) ! profile). ! --------------------------------------------------------------------------------- - - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type - ! Arguments - type(ed_patch_type), target :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), target :: currentPatch + type(fates_cohort_type), pointer :: currentCohort ! Locals integer :: cl ! Canopy Layer Index diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 16aca5d243..797ca859b8 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -24,16 +24,16 @@ module SFMainMod use PRTGenericMod , only : element_pos use EDtypesMod , only : ed_site_type - use EDtypesMod , only : ed_patch_type - use EDtypesMod , only : ed_cohort_type + use FatesPatchMod , only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDtypesMod , only : AREA - use EDtypesMod , only : DL_SF - use EDTypesMod , only : TW_SF - use EDtypesMod , only : LB_SF - use EDtypesMod , only : LG_SF + use FatesLitterMod , only : DL_SF + use FatesLitterMod , only : TW_SF + use FatesLitterMod , only : LB_SF + use FatesLitterMod , only : LG_SF use FatesLitterMod , only : ncwd - use EDtypesMod , only : NFSC - use EDtypesMod , only : TR_SF + use FatesLitterMod , only : NFSC + use FatesLitterMod , only : TR_SF use FatesLitterMod , only : litter_type use PRTGenericMod, only : leaf_organ @@ -85,7 +85,7 @@ subroutine fire_model( currentSite, bc_in) type(bc_in_type) , intent(in) :: bc_in - type (ed_patch_type), pointer :: currentPatch + type (fates_patch_type), pointer :: currentPatch !zero fire things currentPatch => currentSite%youngest_patch @@ -127,7 +127,7 @@ subroutine fire_danger_index ( currentSite, bc_in) type(ed_site_type) , intent(inout), target :: currentSite type(bc_in_type) , intent(in) :: bc_in - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch real(r8) :: temp_in_C ! daily averaged temperature in celcius real(r8) :: rainfall ! daily precip in mm/day @@ -181,8 +181,8 @@ subroutine charecteristics_of_fuel ( currentSite ) type(ed_site_type), intent(in), target :: currentSite - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort type(litter_type), pointer :: litt_c real(r8) alpha_FMC(nfsc) ! Relative fuel moisture adjusted per drying ratio @@ -357,8 +357,8 @@ subroutine wind_effect ( currentSite, bc_in) type(ed_site_type) , intent(inout), target :: currentSite type(bc_in_type) , intent(in) :: bc_in - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: total_grass_area ! per patch,in m2 real(r8) :: tree_fraction ! site level. no units @@ -458,7 +458,7 @@ subroutine rate_of_spread ( currentSite ) type(ed_site_type), intent(in), target :: currentSite - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch ! Rothermal fire spread model parameters. real(r8) beta,beta_op ! weighted average of packing ratio (unitless) @@ -601,7 +601,7 @@ subroutine ground_fuel_consumption ( currentSite ) SF_val_mid_moisture_Coeff, SF_val_mid_moisture_Slope type(ed_site_type) , intent(in), target :: currentSite - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch type(litter_type), pointer :: litt_c ! carbon 12 litter pool real(r8) :: moist !effective fuel moisture @@ -703,7 +703,7 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) SF_val_max_durat, SF_val_durat_slope, SF_val_fire_threshold type(ed_site_type), intent(inout), target :: currentSite - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch type(bc_in_type), intent(in) :: bc_in real(r8) ROS !m/s @@ -895,8 +895,8 @@ subroutine crown_scorching ( currentSite ) type(ed_site_type), intent(in), target :: currentSite - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: tree_ag_biomass ! total amount of above-ground tree biomass in patch. kgC/m2 real(r8) :: leaf_c ! leaf carbon [kg] @@ -959,8 +959,8 @@ subroutine crown_damage ( currentSite ) type(ed_site_type), intent(in), target :: currentSite - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: crown_depth ! Depth of crown in meters currentPatch => currentSite%oldest_patch @@ -1026,8 +1026,8 @@ subroutine cambial_damage_kill ( currentSite ) type(ed_site_type), intent(in), target :: currentSite - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: tau_c !critical time taken to kill cambium (minutes) real(r8) :: bt !bark thickness in cm. @@ -1082,8 +1082,8 @@ subroutine post_fire_mortality ( currentSite ) type(ed_site_type), intent(in), target :: currentSite - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort currentPatch => currentSite%oldest_patch diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index 65849f829d..306034a804 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -4,7 +4,7 @@ module SFParamsMod ! use FatesConstantsMod , only: r8 => fates_r8 use FatesConstantsMod , only: fates_check_param_set - use EDtypesMod , only: NFSC + use FatesLitterMod , only: NFSC use FatesLitterMod , only: ncwd use FatesParametersInterface, only : param_string_length use FatesGlobals, only : fates_log diff --git a/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 b/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 index 6238111e30..4d5efcf241 100644 --- a/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 +++ b/functional_unit_testing/parteh/f90src/FatesCohortWrapMod.F90 @@ -69,7 +69,7 @@ module FatesCohortWrapMod use FatesConstantsMod , only : nearzero - use EDTypesMod , only : nclmax + use EDParamsMod , only : nclmax use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log @@ -78,7 +78,7 @@ module FatesCohortWrapMod implicit none private ! Modules are private by default - type, public :: ed_cohort_type + type, public :: fates_cohort_type integer :: pft ! pft number real(r8) :: dbh ! dbh: cm @@ -106,11 +106,11 @@ module FatesCohortWrapMod ! Multi-species, multi-pool Reactive Transport class(prt_vartypes), pointer :: prt - end type ed_cohort_type + end type fates_cohort_type ! Global Instances - type(ed_cohort_type), pointer, public :: cohort_array(:) + type(fates_cohort_type), pointer, public :: cohort_array(:) integer, public :: numcohort character(len=*), parameter, private :: sourcefile = __FILE__ @@ -132,7 +132,7 @@ subroutine CohortInitAlloc(numcohorts) ! Locals integer(i4) :: ico - type(ed_cohort_type), pointer :: ccohort + type(fates_cohort_type), pointer :: ccohort allocate(cohort_array(numcohorts)) @@ -189,7 +189,7 @@ subroutine CohortPySet(ipft,hgt_min,canopy_trim) ! Locals - type(ed_cohort_type), pointer :: ccohort ! Current cohort + type(fates_cohort_type), pointer :: ccohort ! Current cohort real(r8) :: leaf_c real(r8) :: fnrt_c real(r8) :: sapw_c @@ -376,7 +376,7 @@ subroutine WrapDailyPRT(ipft,daily_carbon_gain,canopy_trim,flush_c,drop_frac_c,l real(r8), intent(in), optional :: daily_phosphorus_gain real(r8), intent(in), optional :: daily_r_maint_demand - type(ed_cohort_type), pointer :: ccohort + type(fates_cohort_type), pointer :: ccohort logical, parameter :: is_drought = .false. ccohort => cohort_array(ipft) @@ -443,7 +443,7 @@ subroutine WrapQueryVars(ipft,crowndamage, leaf_area,crown_area,agb,store_c,targ real(r8),intent(out) :: target_leaf_c real(r8) :: leaf_c - type(ed_cohort_type), pointer :: ccohort + type(fates_cohort_type), pointer :: ccohort real(r8),parameter :: nplant = 1.0_r8 real(r8),parameter :: site_spread = 1.0_r8 @@ -540,7 +540,7 @@ subroutine WrapQueryDiagnostics(ipft, dbh, & real(r8),intent(out) :: growth_resp real(r8),intent(out) :: crown_area - type(ed_cohort_type), pointer :: ccohort + type(fates_cohort_type), pointer :: ccohort real(r8),parameter :: nplant = 1.0_r8 real(r8),parameter :: site_spread = 1.0_r8 diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index 4506d2c354..dfd5eaba2a 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -12,4 +12,3 @@ list(APPEND clm_sources ) sourcelist_to_parent(clm_sources) - diff --git a/main/ChecksBalancesMod.F90 b/main/ChecksBalancesMod.F90 index ab76715fe6..aa81b4fbae 100644 --- a/main/ChecksBalancesMod.F90 +++ b/main/ChecksBalancesMod.F90 @@ -3,8 +3,8 @@ module ChecksBalancesMod use shr_kind_mod, only : r8 => shr_kind_r8 use shr_const_mod, only : SHR_CONST_CDAY use EDtypesMod, only : ed_site_type - use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : ed_cohort_type + use FatesPatchMod, only : fates_patch_type + use FatesCohortMod, only : fates_cohort_type use EDTypesMod, only : AREA use EDTypesMod, only : site_massbal_type use PRTGenericMod, only : num_elements @@ -48,8 +48,8 @@ subroutine SiteMassStock(currentSite,el,total_stock,biomass_stock,litter_stock,s real(r8),intent(out) :: litter_stock ! kg real(r8),intent(out) :: biomass_stock ! kg real(r8),intent(out) :: seed_stock ! kg - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort real(r8) :: patch_biomass ! kg real(r8) :: patch_seed ! kg real(r8) :: patch_litter ! kg @@ -81,14 +81,14 @@ subroutine PatchMassStock(currentPatch,el,live_stock,seed_stock,litter_stock) ! --------------------------------------------------------------------------------- ! Sum up the mass of the different stocks on a patch for each element ! --------------------------------------------------------------------------------- - type(ed_patch_type),intent(inout),target :: currentPatch + type(fates_patch_type),intent(inout),target :: currentPatch integer,intent(in) :: el real(r8),intent(out) :: live_stock real(r8),intent(out) :: seed_stock real(r8),intent(out) :: litter_stock type(litter_type), pointer :: litt ! litter object - type(ed_cohort_type), pointer :: currentCohort + type(fates_cohort_type), pointer :: currentCohort integer :: element_id litt => currentPatch%litter(el) @@ -146,7 +146,7 @@ subroutine CheckLitterPools(currentSite,bc_in) type(bc_in_type), intent(in) :: bc_in ! Local variables - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch type(litter_type), pointer :: litt ! Litter object integer :: el ! Litter element loop index integer :: element_id ! parteh consistent litter index diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index caf0c5843b..8b76b604f4 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -10,31 +10,34 @@ module EDInitMod use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : primaryforest - use FatesConstantsMod , only : nearzero + use FatesConstantsMod , only : nearzero use FatesGlobals , only : endrun => fates_endrun - use EDTypesMod , only : nclmax + use EDParamsMod , only : nclmax + use EDParamsMod , only : regeneration_model use FatesGlobals , only : fates_log use FatesInterfaceTypesMod , only : hlm_is_restart + use FatesInterfaceTypesMod , only : hlm_current_tod + use FatesInterfaceTypesMod , only : hlm_numSWb use EDPftvarcon , only : EDPftvarcon_inst use PRTParametersMod , only : prt_params use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts use EDCohortDynamicsMod , only : InitPRTObject - use EDPatchDynamicsMod , only : create_patch use EDPatchDynamicsMod , only : set_patchno - use EDPhysiologyMod , only : assign_cohort_sp_properties + use EDPhysiologyMod , only : calculate_sp_properties use ChecksBalancesMod , only : SiteMassStock use FatesInterfaceTypesMod , only : hlm_day_of_year - use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDTypesMod , only : ed_site_type + use FatesPatchMod , only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : numWaterMem use EDTypesMod , only : num_vegtemp_mem - use EDTypesMod , only : maxpft use EDTypesMod , only : AREA use EDTypesMod , only : init_spread_near_bare_ground use EDTypesMod , only : init_spread_inventory - use EDTypesMod , only : leaves_on - use EDTypesMod , only : leaves_off - use EDTypesMod , only : ihard_stress_decid - use EDTypesMod , only : isemi_stress_decid + use FatesConstantsMod , only : leaves_on + use FatesConstantsMod , only : leaves_off + use FatesConstantsMod , only : ihard_stress_decid + use FatesConstantsMod , only : isemi_stress_decid use PRTGenericMod , only : num_elements use PRTGenericMod , only : element_list use EDTypesMod , only : phen_cstat_nevercold @@ -558,9 +561,9 @@ subroutine init_patches( nsites, sites, bc_in) integer :: is_first_patch type(ed_site_type), pointer :: sitep - type(ed_patch_type), pointer :: newppft(:) - type(ed_patch_type), pointer :: newp - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: newppft(:) + type(fates_patch_type), pointer :: newp + type(fates_patch_type), pointer :: currentPatch ! List out some nominal patch values that are used for Near Bear Ground initializations ! as well as initializing inventory @@ -643,8 +646,9 @@ subroutine init_patches( nsites, sites, bc_in) if(newparea.gt.0._r8)then ! Stop patches being initilialized when PFT not present in nocomop mode allocate(newp) - - call create_patch(sites(s), newp, age, newparea, primaryforest, nocomp_pft) + call newp%Create(age, newparea, primaryforest, nocomp_pft, & + hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & + regeneration_model) if(is_first_patch.eq.itrue)then !is this the first patch? ! set poointers for first patch (or only patch, if nocomp is false) @@ -772,331 +776,288 @@ subroutine init_patches( nsites, sites, bc_in) end subroutine init_patches ! ============================================================================ - subroutine init_cohorts( site_in, patch_in, bc_in) - ! - ! !DESCRIPTION: - ! initialize new cohorts on bare ground - ! - ! !USES: - - ! - ! !ARGUMENTS - type(ed_site_type), intent(inout), pointer :: site_in - type(ed_patch_type), intent(inout), pointer :: patch_in - type(bc_in_type), intent(in) :: bc_in - ! - ! !LOCAL VARIABLES: - type(ed_cohort_type),pointer :: temp_cohort - class(prt_vartypes),pointer :: prt_obj - integer :: pft - integer :: crowndamage ! which crown damage class - integer :: iage ! index for leaf age loop - integer :: el ! index for element loop - integer :: element_id ! element index consistent with defs in PRTGeneric - integer :: use_pft_local(numpft) ! determine whether this PFT is used for this patch and site. - real(r8) :: c_agw ! biomass above ground (non-leaf) [kgC] - real(r8) :: c_bgw ! biomass below ground (non-fineroot) [kgC] - real(r8) :: c_leaf ! biomass in leaves [kgC] - real(r8) :: c_fnrt ! biomass in fine roots [kgC] - real(r8) :: c_sapw ! biomass in sapwood [kgC] - real(r8) :: c_struct ! biomass in structure (dead) [kgC] - real(r8) :: c_store ! biomass in storage [kgC] - real(r8) :: a_sapw ! area in sapwood (dummy) [m2] - real(r8) :: m_struct ! Generic (any element) mass for structure [kg] - real(r8) :: m_leaf ! Generic mass for leaf [kg] - real(r8) :: m_fnrt ! Generic mass for fine-root [kg] - real(r8) :: m_sapw ! Generic mass for sapwood [kg] - real(r8) :: m_store ! Generic mass for storage [kg] - real(r8) :: m_repro ! Generic mass for reproductive tissues [kg] - real(r8) :: fnrt_drop_fraction ! Fraction of fine roots to absciss when leaves absciss - real(r8) :: stem_drop_fraction ! Fraction of stems to absciss when leaves absciss - - integer, parameter :: rstatus = 0 - integer init - - real(r8) :: dummy_n ! set cohort n to a dummy value of 1 - !---------------------------------------------------------------------- - - patch_in%tallest => null() - patch_in%shortest => null() - - ! Manage interactions of fixed biogeog (site level filter) and - ! nocomp (patch level filter) - ! Need to cover all potential biogeog x nocomp combinations - ! 1. biogeog = false. nocomp = false: all PFTs on (DEFAULT) - ! 2. biogeog = true. nocomp = false: site level filter - ! 3. biogeog = false. nocomp = true : patch level filter - ! 4. biogeog = true. nocomp = true : patch and site level filter - ! in principle this could be a patch level variable. - do pft = 1,numpft - ! Turn every PFT ON, unless we are in a special case. - use_pft_local(pft) = itrue ! Case 1 - if(hlm_use_fixed_biogeog.eq.itrue)then !filter geographically - use_pft_local(pft) = site_in%use_this_pft(pft) ! Case 2 - if(hlm_use_nocomp.eq.itrue.and.pft.ne.patch_in%nocomp_pft_label)then - ! Having set the biogeog filter as on or off, turn off all PFTs - ! whose identiy does not correspond to this patch label. - use_pft_local(pft) = ifalse ! Case 3 - endif - else - if(hlm_use_nocomp.eq.itrue.and.pft.ne.patch_in%nocomp_pft_label)then - ! This case has all PFTs on their own patch everywhere. - use_pft_local(pft) = ifalse ! Case 4 - endif - endif - end do - - - pft_loop: do pft = 1,numpft - - if_use_this_pft: if(use_pft_local(pft).eq.itrue)then - - allocate(temp_cohort) ! temporary cohort - temp_cohort%pft = pft - temp_cohort%l2fr = prt_params%allom_l2fr(pft) - temp_cohort%canopy_trim = 1.0_r8 - temp_cohort%crowndamage = 1 ! Assume no damage to begin with - - ! Retrieve drop fraction of non-leaf tissues for phenology initialisation - fnrt_drop_fraction = prt_params%phen_fnrt_drop_fraction(pft) - stem_drop_fraction = prt_params%phen_stem_drop_fraction(pft) - - - ! Initialise phenology variables. - spmode_case: select case (hlm_use_sp) - case (itrue) - ! Satellite phenology: do not override SP values with built-in phenology - temp_cohort%efleaf_coh = 1.0_r8 - temp_cohort%effnrt_coh = 1.0_r8 - temp_cohort%efstem_coh = 1.0_r8 - - temp_cohort%status_coh = leaves_on - case (ifalse) - ! Use built-in phenology - - if( prt_params%season_decid(pft) == itrue .and. & - any(site_in%cstatus == [phen_cstat_nevercold,phen_cstat_iscold])) then - ! Cold deciduous, off season, assume complete abscission. - temp_cohort%efleaf_coh = 0._r8 - temp_cohort%effnrt_coh = 1.0_r8 - fnrt_drop_fraction - temp_cohort%efstem_coh = 1.0_r8 - stem_drop_fraction - - temp_cohort%status_coh = leaves_off - elseif ( any(prt_params%stress_decid(pft) == [ihard_stress_decid,isemi_stress_decid])) then - ! If the plant is drought deciduous, make sure leaf status is - ! always consistent with the leaf elongation factor. For tissues - ! other than leaves, the actual drop fraction is a combination of the - ! elongation factor (e) and the drop fraction (x), which will ensure - ! that the remaining tissue biomass will be exactly e when x=1, and - ! exactly the original biomass when x = 0. - temp_cohort%efleaf_coh = site_in%elong_factor(pft) - temp_cohort%effnrt_coh = 1.0_r8 - (1.0_r8 - temp_cohort%efleaf_coh ) * fnrt_drop_fraction - temp_cohort%efstem_coh = 1.0_r8 - (1.0_r8 - temp_cohort%efleaf_coh ) * stem_drop_fraction - - if (temp_cohort%efleaf_coh > 0.0_r8) then - temp_cohort%status_coh = leaves_on - else - temp_cohort%status_coh = leaves_off - end if - else - ! Evergreens, or deciduous during growing season. - ! Assume leaves are fully flushed. - temp_cohort%efleaf_coh = 1.0_r8 - temp_cohort%effnrt_coh = 1.0_r8 - temp_cohort%efstem_coh = 1.0_r8 - - temp_cohort%status_coh = leaves_on - end if - end select spmode_case - - ! If positive EDPftvarcon_inst%initd is interpreted as initial recruit density. - ! If negative EDPftvarcon_inst%initd is interpreted as initial dbh. - ! Dbh-initialization can only be used in nocomp mode. - ! In the dbh-initialization case, we calculate crown area for a single tree and then calculate - ! the density of plants needed for a full canopy. - - if_init_dens: if (EDPftvarcon_inst%initd(pft)>nearzero) then ! interpret as initial density and calculate diameter - - temp_cohort%n = EDPftvarcon_inst%initd(pft) * patch_in%area - if(hlm_use_nocomp.eq.itrue)then !in nocomp mode we only have one PFT per patch - ! as opposed to numpft's. So we should up the initial density - ! to compensate (otherwise runs are very hard to compare) - ! this multiplies it by the number of PFTs there would have been in - ! the single shared patch in competition mode. - ! n.b. that this is the same as currentcohort%n = %initd(pft) &AREA - temp_cohort%n = temp_cohort%n * sum(site_in%use_this_pft) - endif - - - ! h,dbh,leafc,n from SP values or from small initial size. - if(hlm_use_sp.eq.itrue)then - init = itrue - ! At this point, we do not know the bc_in values of tlai tsai and htop, - ! so this is initializing to an arbitrary value for the very first timestep. - ! Not sure if there's a way around this or not. - call assign_cohort_SP_properties(temp_cohort, 0.5_r8,0.2_r8, 0.1_r8,patch_in%area,init,c_leaf) - - else - temp_cohort%hite = EDPftvarcon_inst%hgt_min(pft) - ! Calculate the plant diameter from height - call h2d_allom(temp_cohort%hite,pft,temp_cohort%dbh) - - ! Calculate the leaf biomass from allometry - ! (calculates a maximum first, then applies canopy trim) - call bleaf(temp_cohort%dbh,pft,temp_cohort%crowndamage, & - temp_cohort%canopy_trim, temp_cohort%efleaf_coh, c_leaf) - end if ! sp mode - - else ! interpret as initial diameter and calculate density - if(hlm_use_nocomp .eq. itrue)then - temp_cohort%dbh = abs(EDPftvarcon_inst%initd(pft)) - - ! calculate crown area of a single plant - dummy_n = 1.0_r8 ! make n=1 to get area of one tree - - call carea_allom(temp_cohort%dbh, dummy_n, init_spread_inventory, temp_cohort%pft, & - temp_cohort%crowndamage, temp_cohort%c_area) - - ! calculate initial density required to close canopy - temp_cohort%n = patch_in%area / temp_cohort%c_area - - ! Calculate the leaf biomass from allometry - ! (calculates a maximum first, then applies canopy trim) - call bleaf(temp_cohort%dbh,pft,temp_cohort%crowndamage, & - temp_cohort%canopy_trim, temp_cohort%efleaf_coh,c_leaf) - - else - write(fates_log(),*) 'Negative fates_recruit_init_density can only be used in no comp mode' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if if_init_dens - - - - ! Calculate total above-ground biomass from allometry - call bagw_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage, temp_cohort%efstem_coh, c_agw) - - ! Calculate coarse root biomass from allometry - call bbgw_allom(temp_cohort%dbh,pft, temp_cohort%efstem_coh, c_bgw) - - ! Calculate fine root biomass from allometry - ! (calculates a maximum and then trimming value) - call bfineroot(temp_cohort%dbh,pft,temp_cohort%canopy_trim,temp_cohort%l2fr, & - temp_cohort%effnrt_coh, c_fnrt) - - ! Calculate sapwood biomass - call bsap_allom(temp_cohort%dbh,pft,temp_cohort%crowndamage, & - temp_cohort%canopy_trim, temp_cohort%efstem_coh, a_sapw, c_sapw) - - call bdead_allom( c_agw, c_bgw, c_sapw, pft, c_struct ) - - call bstore_allom(temp_cohort%dbh, pft, temp_cohort%crowndamage, & - temp_cohort%canopy_trim, c_store) - - if ( debug ) write(fates_log(),*) 'EDInitMod.F90 call create_cohort ' - - temp_cohort%coage = 0.0_r8 - - - ! -------------------------------------------------------------------------------- - ! Initialize the mass of every element in every organ of the organ - ! -------------------------------------------------------------------------------- - - prt_obj => null() - call InitPRTObject(prt_obj) - - element_loop: do el = 1,num_elements - - element_id = element_list(el) - - ! If this is carbon12, then the initialization is straight forward - ! otherwise, we use stoichiometric ratios - select case(element_id) - case(carbon12_element) - - m_struct = c_struct - m_leaf = c_leaf - m_fnrt = c_fnrt - m_sapw = c_sapw - m_store = c_store - m_repro = 0._r8 - - case(nitrogen_element) - - m_struct = c_struct*prt_params%nitr_stoich_p1(pft,prt_params%organ_param_id(struct_organ)) - m_leaf = c_leaf*prt_params%nitr_stoich_p1(pft,prt_params%organ_param_id(leaf_organ)) - m_fnrt = c_fnrt*prt_params%nitr_stoich_p1(pft,prt_params%organ_param_id(fnrt_organ)) - m_sapw = c_sapw*prt_params%nitr_stoich_p1(pft,prt_params%organ_param_id(sapw_organ)) - m_repro = 0._r8 - m_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) - - case(phosphorus_element) - - m_struct = c_struct*prt_params%phos_stoich_p1(pft,prt_params%organ_param_id(struct_organ)) - m_leaf = c_leaf*prt_params%phos_stoich_p1(pft,prt_params%organ_param_id(leaf_organ)) - m_fnrt = c_fnrt*prt_params%phos_stoich_p1(pft,prt_params%organ_param_id(fnrt_organ)) - m_sapw = c_sapw*prt_params%phos_stoich_p1(pft,prt_params%organ_param_id(sapw_organ)) - m_repro = 0._r8 - m_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) - - end select - - select case(hlm_parteh_mode) - case (prt_carbon_allom_hyp,prt_cnp_flex_allom_hyp ) - - ! Put all of the leaf mass into the first bin - call SetState(prt_obj,leaf_organ, element_id,m_leaf,1) - do iage = 2,nleafage - call SetState(prt_obj,leaf_organ, element_id,0._r8,iage) - end do - - call SetState(prt_obj,fnrt_organ, element_id, m_fnrt) - call SetState(prt_obj,sapw_organ, element_id, m_sapw) - call SetState(prt_obj,store_organ, element_id, m_store) - call SetState(prt_obj,struct_organ, element_id, m_struct) - call SetState(prt_obj,repro_organ, element_id, m_repro) - - case default - write(fates_log(),*) 'Unspecified PARTEH module during create_cohort' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end select - - end do element_loop - - call prt_obj%CheckInitialConditions() - - call create_cohort(site_in, patch_in, pft, temp_cohort%n, temp_cohort%hite, & - temp_cohort%coage, temp_cohort%dbh, prt_obj, temp_cohort%efleaf_coh, & - temp_cohort%effnrt_coh, temp_cohort%efstem_coh, temp_cohort%status_coh, & - rstatus, temp_cohort%canopy_trim, & - temp_cohort%c_area,1,temp_cohort%crowndamage, site_in%spread, bc_in) - - - deallocate(temp_cohort, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc014: fail on deallocate(temp_cohort):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - - end if if_use_this_pft - end do pft_loop - - ! (Keeping as an example) - ! Pass patch level temperature to the new cohorts (this is a nominal 15C right now) - !temp_cohort => patch_in%tallest - !do while(associated(temp_cohort)) - !call temp_cohort%tveg_lpa%UpdateRmean(patch_in%tveg_lpa%GetMean()) - !temp_cohort => temp_cohort%shorter - !end do - - call fuse_cohorts(site_in, patch_in,bc_in) - call sort_cohorts(patch_in) - - - end subroutine init_cohorts - - ! =============================================================================================== - + subroutine init_cohorts(site_in, patch_in, bc_in) + ! + ! DESCRIPTION: + ! initialize new cohorts on bare ground + ! + + ! ARGUMENTS + type(ed_site_type), intent(inout), pointer :: site_in + type(fates_patch_type), intent(inout), pointer :: patch_in + type(bc_in_type), intent(in) :: bc_in + + ! LOCAL VARIABLES: + class(prt_vartypes), pointer :: prt ! PARTEH object + integer :: leaf_status ! cohort phenology status [leaves on/off] + integer :: pft ! index for PFT + integer :: iage ! index for leaf age loop + integer :: el ! index for element loop + integer :: element_id ! element index consistent with defs in PRTGeneric + integer :: use_pft_local(numpft) ! determine whether this PFT is used for this patch and site + integer :: crown_damage ! crown damage class of the cohort [1 = undamaged, >1 = damaged] + real(r8) :: l2fr ! leaf to fineroot biomass ratio [kg kg-1] + real(r8) :: canopy_trim ! fraction of the maximum leaf biomass that we are targeting [0-1] + real(r8) :: cohort_n ! cohort density + real(r8) :: dbh ! cohort dbh [cm] + real(r8) :: hite ! cohort height [m] + real(r8) :: c_area ! cohort crown area [m2] + real(r8) :: c_agw ! above ground (non-leaf) biomass [kgC] + real(r8) :: c_bgw ! below ground (non-fineroot) biomss [kgC] + real(r8) :: c_leaf ! leaf biomass [kgC] + real(r8) :: c_fnrt ! fine root biomss [kgC] + real(r8) :: c_sapw ! sapwood biomass [kgC] + real(r8) :: c_struct ! structural (dead) biomass [kgC] + real(r8) :: c_store ! storage biomass [kgC] + real(r8) :: a_sapw ! sapwood area [m2] + real(r8) :: m_struct ! generic (any element) mass for structure [kg] + real(r8) :: m_leaf ! generic mass for leaf [kg] + real(r8) :: m_fnrt ! generic mass for fine-root [kg] + real(r8) :: m_sapw ! generic mass for sapwood [kg] + real(r8) :: m_store ! generic mass for storage [kg] + real(r8) :: m_repro ! generic mass for reproductive tissues [kg] + ! of all the organs in the recruits. Used for both [kg per plant] and [kg per cohort] + real(r8) :: efleaf_coh + real(r8) :: effnrt_coh + real(r8) :: efstem_coh + real(r8) :: stem_drop_fraction ! fraction of stem to absciss when leaves absciss + real(r8) :: fnrt_drop_fraction ! fraction of fine roots to absciss when leaves absciss + integer, parameter :: recruitstatus = 0 ! whether the newly created cohorts are recruited or initialized + + !------------------------------------------------------------------------------------- + + patch_in%tallest => null() + patch_in%shortest => null() + + ! Manage interactions of fixed biogeog (site level filter) and nocomp (patch level filter) + ! Need to cover all potential biogeog x nocomp combinations + ! 1. biogeog = false. nocomp = false: all PFTs on (DEFAULT) + ! 2. biogeog = true. nocomp = false: site level filter + ! 3. biogeog = false. nocomp = true : patch level filter + ! 4. biogeog = true. nocomp = true : patch and site level filter + ! in principle this could be a patch level variable. + do pft = 1, numpft + ! first turn every PFT ON, unless we are in a special case + use_pft_local(pft) = itrue ! Case 1 + if (hlm_use_fixed_biogeog .eq. itrue) then !filter geographically + use_pft_local(pft) = site_in%use_this_pft(pft) ! Case 2 + if (hlm_use_nocomp .eq. itrue .and. pft .ne. patch_in%nocomp_pft_label) then + ! having set the biogeog filter as on or off, turn off all PFTs + ! whose identity does not correspond to this patch label + use_pft_local(pft) = ifalse ! Case 3 + endif + else + if (hlm_use_nocomp .eq. itrue .and. pft .ne. patch_in%nocomp_pft_label) then + ! This case has all PFTs on their own patch everywhere + use_pft_local(pft) = ifalse ! Case 4 + endif + endif + end do + + pft_loop: do pft = 1, numpft + if_use_this_pft: if (use_pft_local(pft) .eq. itrue) then + l2fr = prt_params%allom_l2fr(pft) + canopy_trim = 1.0_r8 + crown_damage = 1 ! Assume no damage to begin with + + ! retrieve drop fraction of non-leaf tissues for phenology initialization + fnrt_drop_fraction = prt_params%phen_fnrt_drop_fraction(pft) + stem_drop_fraction = prt_params%phen_stem_drop_fraction(pft) + + ! initialize phenology variables + if_spmode: if (hlm_use_sp == itrue) then + ! satellite phenology: do not override SP values with build-in phenology + efleaf_coh = 1.0_r8 + effnrt_coh = 1.0_r8 + efstem_coh = 1.0_r8 + leaf_status = leaves_on + else + ! use built-in phenology + if (prt_params%season_decid(pft) == itrue .and. & + any(site_in%cstatus == [phen_cstat_nevercold, phen_cstat_iscold])) then + ! Cold deciduous, off season, assume complete abscission + efleaf_coh = 0.0_r8 + effnrt_coh = 1.0_r8 - fnrt_drop_fraction + efstem_coh = 1.0_r8 - stem_drop_fraction + leaf_status = leaves_off + else if (any(prt_params%stress_decid(pft) == [ihard_stress_decid, isemi_stress_decid])) then + ! If the plant is drought deciduous, make sure leaf status is + ! always consistent with the leaf elongation factor. For tissues + ! other than leaves, the actual drop fraction is a combination of the + ! elongation factor (e) and the drop fraction (x), which will ensure + ! that the remaining tissue biomass will be exactly e when x=1, and + ! exactly the original biomass when x = 0. + efleaf_coh = site_in%elong_factor(pft) + effnrt_coh = 1.0_r8 - (1.0_r8 - efleaf_coh)*fnrt_drop_fraction + efstem_coh = 1.0_r8 - (1.0_r8 - efleaf_coh)*stem_drop_fraction + + if (efleaf_coh > 0.0_r8) then + leaf_status = leaves_on + else + leaf_status = leaves_off + end if + else + ! Evergreens, or deciduous during growing season + ! Assume leaves fully flushed + efleaf_coh = 1.0_r8 + effnrt_coh = 1.0_r8 + efstem_coh = 1.0_r8 + leaf_status = leaves_on + end if + end if if_spmode + + ! If positive EDPftvarcon_inst%initd is interpreted as initial recruit density. + ! If negative EDPftvarcon_inst%initd is interpreted as initial dbh. + ! Dbh-initialization can only be used in nocomp mode. + ! In the dbh-initialization case, we calculate crown area for a single tree and then calculate + ! the density of plants needed for a full canopy. + if_init_dens: if (EDPftvarcon_inst%initd(pft) > nearzero) then ! interpret as initial density and calculate diameter + + cohort_n = EDPftvarcon_inst%initd(pft)*patch_in%area + if (hlm_use_nocomp .eq. itrue) then !in nocomp mode we only have one PFT per patch + ! as opposed to numpft's. So we should up the initial density + ! to compensate (otherwise runs are very hard to compare) + ! this multiplies it by the number of PFTs there would have been in + ! the single shared patch in competition mode. + ! n.b. that this is the same as currentcohort%n = %initd(pft) &AREA + cohort_n = cohort_n*sum(site_in%use_this_pft) + endif + hite = EDPftvarcon_inst%hgt_min(pft) + + ! h, dbh, leafc, n from SP values or from small initial size + if (hlm_use_sp .eq. itrue) then + ! At this point, we do not know the bc_in values of tlai tsai and htop, + ! so this is initializing to an arbitrary value for the very first timestep. + ! Not sure if there's a way around this or not. + hite = 0.5_r8 + call calculate_SP_properties(hite, 0.2_r8, 0.1_r8, & + patch_in%area, pft, crown_damage, 1, & + EDPftvarcon_inst%vcmax25top(pft, 1), c_leaf, dbh, & + cohort_n, c_area) + else + ! calculate the plant diameter from height + call h2d_allom(hite, pft, dbh) + + ! Calculate the leaf biomass from allometry + ! (calculates a maximum first, then applies canopy trim) + call bleaf(dbh, pft, crown_damage, canopy_trim, efleaf_coh, c_leaf) + endif ! sp mode + + else ! interpret as initial diameter and calculate density + if (hlm_use_nocomp .eq. itrue) then + + dbh = abs(EDPftvarcon_inst%initd(pft)) + + ! calculate crown area of a single plant + call carea_allom(dbh, 1.0_r8, init_spread_inventory, pft, crown_damage, & + c_area) + + ! calculate initial density required to close canopy + cohort_n = patch_in%area/c_area + + ! Calculate the leaf biomass from allometry + ! (calculates a maximum first, then applies canopy trim) + call bleaf(dbh, pft, crown_damage, canopy_trim, efleaf_coh, & + c_leaf) + + else + write(fates_log(),*) 'Negative fates_recruit_init_density can only be used in no comp mode' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + endif if_init_dens + + ! calculate total above-ground biomass from allometry + call bagw_allom(dbh, pft, crown_damage, efstem_coh, c_agw) + + ! calculate coarse root biomass from allometry + call bbgw_allom(dbh, pft, efstem_coh, c_bgw) + + ! Calculate fine root biomass from allometry + ! (calculates a maximum and then trimming value) + call bfineroot(dbh, pft, canopy_trim, l2fr, effnrt_coh, c_fnrt) + + ! Calculate sapwood biomass + call bsap_allom(dbh, pft, crown_damage, canopy_trim, efstem_coh, & + a_sapw, c_sapw) + + call bdead_allom(c_agw, c_bgw, c_sapw, pft, c_struct) + call bstore_allom(dbh, pft, crown_damage, canopy_trim, c_store) + + if (debug) write(fates_log(),*) 'EDInitMod.F90 call create_cohort ' + + ! -------------------------------------------------------------------------------- + ! Initialize the mass of every element in every organ of the organ + ! -------------------------------------------------------------------------------- + + prt => null() + call InitPRTObject(prt) + + element_loop: do el = 1, num_elements + + element_id = element_list(el) + ! If this is carbon12, then the initialization is straight forward + ! otherwise, we use stoichiometric ratios + select case(element_id) + case(carbon12_element) + m_struct = c_struct + m_leaf = c_leaf + m_fnrt = c_fnrt + m_sapw = c_sapw + m_store = c_store + m_repro = 0._r8 + case(nitrogen_element) + m_struct = c_struct*prt_params%nitr_stoich_p1(pft, prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%nitr_stoich_p1(pft, prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%nitr_stoich_p1(pft, prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%nitr_stoich_p1(pft, prt_params%organ_param_id(sapw_organ)) + m_repro = 0._r8 + m_store = StorageNutrientTarget(pft, element_id, m_leaf, m_fnrt, m_sapw, m_struct) + case(phosphorus_element) + + m_struct = c_struct*prt_params%phos_stoich_p1(pft, prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%phos_stoich_p1(pft, prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%phos_stoich_p1(pft, prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%phos_stoich_p1(pft, prt_params%organ_param_id(sapw_organ)) + m_repro = 0._r8 + m_store = StorageNutrientTarget(pft, element_id, m_leaf, m_fnrt, m_sapw, m_struct) + end select + + select case(hlm_parteh_mode) + case (prt_carbon_allom_hyp, prt_cnp_flex_allom_hyp ) + ! Put all of the leaf mass into the first bin + call SetState(prt, leaf_organ, element_id, m_leaf, 1) + do iage = 2,nleafage + call SetState(prt, leaf_organ, element_id, 0._r8, iage) + end do + call SetState(prt, fnrt_organ, element_id, m_fnrt) + call SetState(prt, sapw_organ, element_id, m_sapw) + call SetState(prt, store_organ, element_id, m_store) + call SetState(prt, struct_organ, element_id, m_struct) + call SetState(prt, repro_organ, element_id, m_repro) + + case default + write(fates_log(),*) 'Unspecified PARTEH module during create_cohort' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end do element_loop + + call prt%CheckInitialConditions() + + call create_cohort(site_in, patch_in, pft, cohort_n, & + hite, 0.0_r8, dbh, prt, efleaf_coh, & + effnrt_coh, efstem_coh, leaf_status, recruitstatus, & + canopy_trim, c_area, 1, crown_damage, site_in%spread, bc_in) + + endif if_use_this_pft + enddo pft_loop + + call fuse_cohorts(site_in, patch_in,bc_in) + call sort_cohorts(patch_in) + + end subroutine init_cohorts + + ! ====================================================================================== end module EDInitMod diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 75f9c3e498..bd28d678dc 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -56,7 +56,6 @@ module EDMainMod use EDPhysiologyMod , only : GenerateDamageAndLitterFluxes use FatesSoilBGCFluxMod , only : FluxIntoLitterPools use FatesSoilBGCFluxMod , only : EffluxIntoLitterPools - use EDCohortDynamicsMod , only : UpdateCohortBioPhysRates use FatesSoilBGCFluxMod , only : PrepNutrientAquisitionBCs use FatesSoilBGCFluxMod , only : PrepCH4BCs use SFMainMod , only : fire_model @@ -65,8 +64,8 @@ module EDMainMod use FatesLitterMod , only : litter_type use FatesLitterMod , only : ncwd use EDtypesMod , only : ed_site_type - use EDtypesMod , only : ed_patch_type - use EDtypesMod , only : ed_cohort_type + use FatesPatchMod , only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : AREA use EDTypesMod , only : site_massbal_type use PRTGenericMod , only : num_elements @@ -150,7 +149,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) type(bc_out_type) , intent(inout) :: bc_out ! ! !LOCAL VARIABLES: - type(ed_patch_type), pointer :: currentPatch + type(fates_patch_type), pointer :: currentPatch integer :: el ! Loop counter for variables integer :: do_patch_dynamics ! for some modes, we turn off patch dynamics @@ -178,7 +177,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) call IsItLoggingTime(hlm_masterproc,currentSite) ! Call a routine that identifies if damage should occur - call IsItDamageTime(hlm_masterproc, currentSite) + call IsItDamageTime(hlm_masterproc) !************************************************************************** ! Fire, growth, biogeochemistry. @@ -324,9 +323,6 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! ! !USES: use FatesInterfaceTypesMod, only : hlm_num_lu_harvest_cats - use FatesInterfaceTypesMod, only : nlevdamage - use FatesAllometryMod , only : bleaf - use FatesAllometryMod , only : carea_allom use PRTGenericMod , only : leaf_organ use PRTGenericMod , only : repro_organ use PRTGenericMod , only : sapw_organ @@ -335,16 +331,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) use PRTGenericMod , only : fnrt_organ use FatesInterfaceTypesMod, only : hlm_use_cohort_age_tracking use FatesConstantsMod, only : itrue - use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, insert_cohort - use EDCohortDynamicsMod , only : DeallocateCohort - use FatesPlantHydraulicsMod, only : InitHydrCohort - use EDCohortDynamicsMod , only : InitPRTObject - use EDCohortDynamicsMod , only : InitPRTBoundaryConditions use FatesConstantsMod , only : nearzero use EDCanopyStructureMod , only : canopy_structure - use PRTLossFluxesMod , only : PRTDamageRecoveryFluxes - use PRTGenericMod , only : max_nleafage - use PRTGenericMod , only : prt_global ! !ARGUMENTS: @@ -355,11 +343,11 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! ! !LOCAL VARIABLES: type(site_massbal_type), pointer :: site_cmass - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type) , pointer :: currentCohort - type(ed_cohort_type) , pointer :: nc - type(ed_cohort_type) , pointer :: storesmallcohort - type(ed_cohort_type) , pointer :: storebigcohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type) , pointer :: currentCohort + type(fates_cohort_type) , pointer :: nc + type(fates_cohort_type) , pointer :: storesmallcohort + type(fates_cohort_type) , pointer :: storebigcohort integer :: snull integer :: tnull @@ -375,6 +363,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) logical :: is_drought ! logical for if the plant (site) is in a drought state real(r8) :: delta_dbh ! correction for dbh real(r8) :: delta_hite ! correction for hite + real(r8) :: mean_temp logical :: newly_recovered ! If the current loop is dealing with a newly created cohort, which ! was created because it is a clone of the previous cohort in @@ -478,8 +467,12 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Calculate the mortality derivatives - call Mortality_Derivative( currentSite, currentCohort, bc_in, frac_site_primary, & - harvestable_forest_c, harvest_tag ) + mean_temp = currentPatch%tveg24%GetMean() + call Mortality_Derivative(currentSite, currentCohort, bc_in, & + currentPatch%btran_ft, mean_temp, & + currentPatch%anthro_disturbance_label, & + currentPatch%age_since_anthro_disturbance, frac_site_primary, & + harvestable_forest_c, harvest_tag) ! ----------------------------------------------------------------------------- ! Apply Plant Allocation and Reactive Transport @@ -643,7 +636,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! mass in the different leaf age classes. Following growth ! and turnover, these proportions won't change again. This ! routine is also called following fusion - call UpdateCohortBioPhysRates(currentCohort) + call currentCohort%UpdateCohortBioPhysRates() ! This cohort has grown, it is no longer "new" currentCohort%isnew = .false. @@ -788,7 +781,7 @@ subroutine ed_update_site( currentSite, bc_in, bc_out ) type(bc_out_type) , intent(inout) :: bc_out ! ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: currentPatch + type (fates_patch_type) , pointer :: currentPatch !----------------------------------------------------------------------- if(hlm_use_sp.eq.ifalse)then call canopy_spread(currentSite) @@ -887,8 +880,8 @@ subroutine TotalBalanceCheck (currentSite, call_index ) ! Also, the carbon pools are per site/gridcell, so that ! we can account for the changing areas of patches. - type(ed_patch_type) , pointer :: currentPatch - type(ed_cohort_type) , pointer :: currentCohort + type(fates_patch_type) , pointer :: currentPatch + type(fates_cohort_type) , pointer :: currentCohort type(litter_type), pointer :: litt logical, parameter :: print_cohorts = .true. ! Set to true if you want ! to print cohort data @@ -1042,8 +1035,8 @@ subroutine bypass_dynamics(currentSite) type(ed_site_type) , intent(inout), target :: currentSite ! Locals - type(ed_patch_type), pointer :: currentPatch - type(ed_cohort_type), pointer :: currentCohort + type(fates_patch_type), pointer :: currentPatch + type(fates_cohort_type), pointer :: currentCohort currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 04730d0747..438d387213 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -9,6 +9,7 @@ module EDParamsMod use FatesParametersInterface, only : param_string_length use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun + use FatesConstantsMod, only : fates_unset_r8 ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -85,6 +86,50 @@ module EDParamsMod ! empirical curvature parameters for ac, aj photosynthesis co-limitation, c3 and c4 plants respectively real(r8),protected,public :: theta_cj_c3 ! Empirical curvature parameter for ac, aj photosynthesis co-limitation in c3 plants real(r8),protected,public :: theta_cj_c4 ! Empirical curvature parameter for ac, aj photosynthesis co-limitation in c4 plants + + ! Global identifier of how nutrients interact with the host land model + ! either they are fully coupled, or they generate uptake rates synthetically + ! in prescribed mode. In the latter, there is both NO mass removed from the HLM's soil + ! BGC N and P pools, and there is also none removed. + + integer, public :: n_uptake_mode + integer, public :: p_uptake_mode + + integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers + + ! parameters that govern the VAI (LAI+SAI) bins used in radiative transfer code + integer, parameter, public :: nlevleaf = 30 ! number of leaf+stem layers in each canopy layer + + real(r8), public :: dinc_vai(nlevleaf) = fates_unset_r8 ! VAI bin widths array + real(r8), public :: dlower_vai(nlevleaf) = fates_unset_r8 ! lower edges of VAI bins + + ! TODO: we use this cp_maxSWb only because we have a static array q(size=2) of + ! land-ice abledo for vis and nir. This should be a parameter, which would + ! get us on track to start using multi-spectral or hyper-spectral (RGK 02-2017) + + integer, parameter, public :: maxSWb = 2 ! maximum number of broad-bands in the + ! shortwave spectrum cp_numSWb <= cp_maxSWb + ! this is just for scratch-array purposes + ! if cp_numSWb is larger than this value + ! simply bump this number up as needed + +integer, parameter, public :: ivis = 1 ! This is the array index for short-wave + ! radiation in the visible spectrum, as expected + ! in boundary condition files and parameter + ! files. This will be compared with + ! the HLM's expectation in FatesInterfaceMod +integer, parameter, public :: inir = 2 ! This is the array index for short-wave + ! radiation in the near-infrared spectrum, as expected + ! in boundary condition files and parameter + ! files. This will be compared with + ! the HLM's expectation in FatesInterfaceMod + +integer, parameter, public :: ipar = ivis ! The photosynthetically active band + ! can be approximated to be equal to the visible band + + + +integer, parameter, public :: maxpft = 16 ! maximum number of PFTs allowed real(r8),protected,public :: q10_mr ! Q10 for respiration rate (for soil fragmenation and plant respiration) (unitless) real(r8),protected,public :: q10_froz ! Q10 for frozen-soil respiration rates (for soil fragmentation) (unitless) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 22add34b3a..bdd670b671 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -6,8 +6,7 @@ module EDPftvarcon ! read and initialize vegetation (PFT) constants. ! ! !USES: - use EDTypesMod , only : maxSWb, ivis, inir - use EDTypesMod , only : n_uptake_mode, p_uptake_mode + use EDParamsMod , only : maxSWb, ivis, inir use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : nearzero use FatesConstantsMod, only : itrue, ifalse diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index c64ba35584..c9b9a90161 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -1,6 +1,7 @@ module EDTypesMod use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : endrun => fates_endrun use FatesConstantsMod, only : ifalse use FatesConstantsMod, only : itrue use FatesGlobals, only : fates_log @@ -9,35 +10,32 @@ module EDTypesMod use PRTGenericMod, only : prt_vartypes use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod, only : repro_organ, store_organ, struct_organ + use PRTGenericMod, only : prt_carbon_allom_hyp + use PRTGenericMod, only : prt_cnp_flex_allom_hyp use PRTGenericMod, only : num_organ_types use PRTGenericMod, only : num_elements use PRTGenericMod, only : element_list use PRTGenericMod, only : num_element_types use PRTGenericMod, only : carbon12_element use FatesLitterMod, only : litter_type - use FatesLitterMod, only : ncwd + use FatesLitterMod, only : ncwd, NFSC use FatesConstantsMod, only : n_anthro_disturbance_categories use FatesConstantsMod, only : days_per_year use FatesRunningMeanMod, only : rmean_type,rmean_arr_type use FatesConstantsMod, only : fates_unset_r8 use FatesInterfaceTypesMod,only : bc_in_type use FatesInterfaceTypesMod,only : bc_out_type - + use FatesInterfaceTypesMod,only : hlm_parteh_mode + use FatesCohortMod, only : fates_cohort_type + use FatesPatchMod, only : fates_patch_type + use EDParamsMod, only : maxSWb, nclmax, nlevleaf, maxpft + use FatesConstantsMod, only : n_dbh_bins, n_dist_types + use shr_log_mod, only : errMsg => shr_log_errMsg + implicit none private ! By default everything is private save - - integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers - integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy - integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer - ! to understory layers (all layers that - ! are not the top canopy layer) - - integer, parameter, public :: maxpft = 16 ! maximum number of PFTs allowed - ! the parameter file may determine that fewer - ! are used, but this helps allocate scratch - ! space and output arrays. - + real(r8), parameter, public :: init_recruit_trim = 0.8_r8 ! This is the initial trimming value that ! new recruits start with @@ -47,69 +45,13 @@ module EDTypesMod ! this is ok for now. (RGK 04-2018) ! ------------------------------------------------------------------------------------- - integer, parameter, public :: n_rad_stream_types = 2 ! The number of radiation streams used (direct/diffuse) integer, parameter, public :: idirect = 1 ! This is the array index for direct radiation integer, parameter, public :: idiffuse = 2 ! This is the array index for diffuse radiation - ! parameters that govern the VAI (LAI+SAI) bins used in radiative transfer code - integer, parameter, public :: nlevleaf = 30 ! number of leaf+stem layers in canopy layer - real(r8), public :: dinc_vai(nlevleaf) = fates_unset_r8 ! VAI bin widths array - real(r8), public :: dlower_vai(nlevleaf) = fates_unset_r8 ! lower edges of VAI bins - - ! TODO: we use this cp_maxSWb only because we have a static array q(size=2) of - ! land-ice abledo for vis and nir. This should be a parameter, which would - ! get us on track to start using multi-spectral or hyper-spectral (RGK 02-2017) - - integer, parameter, public :: maxSWb = 2 ! maximum number of broad-bands in the - ! shortwave spectrum cp_numSWb <= cp_maxSWb - ! this is just for scratch-array purposes - ! if cp_numSWb is larger than this value - ! simply bump this number up as needed - - integer, parameter, public :: ivis = 1 ! This is the array index for short-wave - ! radiation in the visible spectrum, as expected - ! in boundary condition files and parameter - ! files. This will be compared with - ! the HLM's expectation in FatesInterfaceMod - integer, parameter, public :: inir = 2 ! This is the array index for short-wave - ! radiation in the near-infrared spectrum, as expected - ! in boundary condition files and parameter - ! files. This will be compared with - ! the HLM's expectation in FatesInterfaceMod - - integer, parameter, public :: ipar = ivis ! The photosynthetically active band - ! can be approximated to be equal to the visible band - - - integer, parameter, public :: leaves_shedding = 3 ! Flag specifying that a deciduous plant has leaves - ! but is shedding them (partial shedding). This plant - ! should not allocate carbon towards growth or - ! reproduction. - integer, parameter, public :: leaves_on = 2 ! Flag specifying that a deciduous plant has leaves - ! and should be allocating to them as well - integer, parameter, public :: leaves_off = 1 ! Flag specifying that a deciduous plant has dropped - ! its leaves and should not be trying to allocate - ! towards any growth. - - integer, parameter, public :: ihard_stress_decid = 1 ! If the PFT is stress (drought) deciduous, - ! this flag is used to tell that the PFT - ! is a "hard" deciduous (i.e., the plant - ! has only two statuses, the plant either - ! sheds all leaves when it's time, or seeks - ! to flush the leaves back to allometry - ! when conditions improve. - integer, parameter, public :: isemi_stress_decid = 2 ! If the PFT is stress (drought) deciduous, - ! this flag is used to tell that the PFT - ! is a semi-deciduous (i.e., the plant - ! can downregulate the amount of leaves - ! relative to the allometry based on - ! soil moisture conditions. It can still - ! shed all leaves if conditions are very - ! dry. - - ! Flag to turn on/off salinity effects on the effective "btran" + + ! Flag to turn on/off salinity effects on the effective "btran" ! btran stress function. logical, parameter, public :: do_fates_salinity = .false. @@ -140,12 +82,11 @@ module EDTypesMod ! The actual number of soil layers should not exceed this + + ! BIOLOGY/BIOGEOCHEMISTRY integer , parameter, public :: num_vegtemp_mem = 10 ! Window of time over which we track temp for cold sensecence (days) - integer , parameter, public :: N_DIST_TYPES = 3 ! Disturbance Modes 1) tree-fall, 2) fire, 3) logging - integer , parameter, public :: dtype_ifall = 1 ! index for naturally occuring tree-fall generated event - integer , parameter, public :: dtype_ifire = 2 ! index for fire generated disturbance event - integer , parameter, public :: dtype_ilog = 3 ! index for logging generated disturbance event + ! Phenology status flag definitions (cold type is cstat, dry type is dstat) @@ -160,21 +101,8 @@ module EDTypesMod integer, parameter, public :: phen_dstat_timeon = 3 ! Leaves on due to time exceedance (drought phenology) integer, parameter, public :: phen_dstat_pshed = 4 ! Leaves partially abscissing (drought phenology) - - ! SPITFIRE - - integer, parameter, public :: NFSC = NCWD+2 ! number fuel size classes (4 cwd size classes, leaf litter, and grass) - integer, parameter, public :: tw_sf = 1 ! array index of twig pool for spitfire - integer, parameter, public :: lb_sf = 3 ! array index of large branch pool for spitfire - integer, parameter, public :: tr_sf = 4 ! array index of dead trunk pool for spitfire - integer, parameter, public :: dl_sf = 5 ! array index of dead leaf pool for spitfire (dead grass and dead leaves) - integer, parameter, public :: lg_sf = 6 ! array index of live grass pool for spitfire - ! PATCH FUSION real(r8), parameter, public :: force_patchfuse_min_biomass = 0.005_r8 ! min biomass (kg / m2 patch area) below which to force-fuse patches - integer , parameter, public :: N_DBH_BINS = 6 ! no. of dbh bins used when comparing patches - real(r8), parameter, public :: patchfusion_dbhbin_loweredges(N_DBH_BINS) = & - (/0._r8, 5._r8, 20._r8, 50._r8, 100._r8, 150._r8/) ! array of bin lower edges for comparing patches real(r8), parameter, public :: patch_fusion_tolerance_relaxation_increment = 1.1_r8 ! amount by which to increment patch fusion threshold real(r8), parameter, public :: max_age_of_second_oldest_patch = 200._r8 ! age in years above which to combine all patches @@ -197,462 +125,8 @@ module EDTypesMod ! special mode to cause PFTs to create seed mass of all currently-existing PFTs logical, parameter, public :: homogenize_seed_pfts = .false. - - - ! Global identifier of how nutrients interact with the host land model - ! either they are fully coupled, or they generate uptake rates synthetically - ! in prescribed mode. In the latter, there is both NO mass removed from the HLM's soil - ! BGC N and P pools, and there is also none removed. - - integer, public :: n_uptake_mode - integer, public :: p_uptake_mode - + character(len=*), parameter, private :: sourcefile = __FILE__ - !************************************ - !** COHORT type structure ** - !************************************ - type, public :: ed_cohort_type - - ! POINTERS - type (ed_cohort_type) , pointer :: taller => null() ! pointer to next tallest cohort - type (ed_cohort_type) , pointer :: shorter => null() ! pointer to next shorter cohort - type (ed_patch_type) , pointer :: patchptr => null() ! pointer to patch that cohort is in - - - - ! Multi-species, multi-organ Plant Reactive Transport (PRT) - ! Contains carbon and nutrient state variables for various plant organs - - class(prt_vartypes), pointer :: prt - - real(r8) :: l2fr ! leaf to fineroot biomass ratio (this is constant - ! in carbon only simulationss, and is set by the - ! allom_l2fr_min parameter. In nutrient - ! enabled simulations, this is dynamic, will - ! vary between allom_l2fr_min and allom_l2fr_max - ! parameters, with a tendency driven by - ! nutrient storage) [kg root / kg leaf] - - - - - - ! VEGETATION STRUCTURE - integer :: pft ! pft number - real(r8) :: n ! number of individuals in cohort per 'area' (10000m2 default) - real(r8) :: dbh ! dbh: cm - real(r8) :: coage ! cohort age in years - real(r8) :: hite ! height: meters - integer :: indexnumber ! unique number for each cohort. (within clump?) - integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) - integer :: crowndamage ! crown damage class of the cohort [1: undamaged, >1: damaged] - real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort - ! (1 = canopy, 2 = understorey, etc.) - ! real to be conservative during fusion - real(r8) :: g_sb_laweight ! Total conductance (stomata+boundary layer) of the cohort, weighted by its leaf area [m/s]*[m2] - real(r8) :: canopy_trim ! What is the fraction of the maximum leaf biomass that we are targeting? :- - real(r8) :: leaf_cost ! How much does it cost to maintain leaves: kgC/m2/year-1 - real(r8) :: excl_weight ! How much of this cohort is demoted each year, as a proportion of all cohorts:- - real(r8) :: prom_weight ! How much of this cohort is promoted each year, as a proportion of all cohorts:- - integer :: nv ! Number of leaf layers: - - integer :: status_coh ! growth status of plant (2 = leaves on , 1 = leaves off) - real(r8) :: efleaf_coh ! Elongation factor for leaves (fraction) - real(r8) :: effnrt_coh ! Elongation factor for fine roots (fraction) - real(r8) :: efstem_coh ! Elongation factor for stem (fraction) - ! For all the elongation factors, zero means fully abscissed, and - ! one means fully flushed. - real(r8) :: c_area ! areal extent of canopy (m2) - real(r8) :: treelai ! lai of an individual within cohort leaf area (m2) / crown area (m2) - real(r8) :: treesai ! stem area index of an indiv. within cohort: stem area (m2) / crown area (m2) - logical :: isnew ! flag to signify a new cohort, new cohorts have not experienced - ! npp or mortality and should therefore not be fused or averaged - integer :: size_class ! An index that indicates which diameter size bin the cohort currently resides in - ! this is used for history output. We maintain this in the main cohort memory - ! because we don't want to continually re-calculate the cohort's position when - ! performing size diagnostics at high-frequency calls - integer :: coage_class ! An index that indicates which age bin the cohort currently resides in - ! used for history output. - integer :: size_by_pft_class ! An index that indicates the cohorts position of the joint size-class x functional - ! type classification. We also maintain this in the main cohort memory - ! because we don't want to continually re-calculate the cohort's position when - ! performing size diagnostics at high-frequency calls - integer :: coage_by_pft_class ! An index that indicates the cohorts position of the join cohort age class x PFT - integer :: size_class_lasttimestep ! size class of the cohort at the last time step - - ! CARBON FLUXES - - ! ---------------------------------------------------------------------------------- - ! NPP, GPP and RESP: Instantaneous, accumulated and accumulated-hold types.* - ! - ! _tstep: The instantaneous estimate that is calculated at each rapid plant biophysics - ! time-step (ie photosynthesis, sub-hourly). (kgC/indiv/timestep) - ! _acc: The accumulation of the _tstep variable from the beginning to ending of - ! the dynamics time-scale. This variable is zero'd during initialization and - ! after the dynamics call-sequence is completed. (kgC/indiv/day) - ! _acc_hold: While _acc is zero'd after the dynamics call sequence and then integrated, - ! _acc_hold "holds" the integrated value until the next time dynamics is - ! called. This is necessary for restarts. This variable also has units - ! converted to a useful rate (kgC/indiv/yr) - ! ---------------------------------------------------------------------------------- - - real(r8) :: gpp_tstep ! Gross Primary Production (see above *) - real(r8) :: gpp_acc - real(r8) :: gpp_acc_hold - - real(r8) :: npp_tstep ! Net Primary Production (see above *) - real(r8) :: npp_acc - real(r8) :: npp_acc_hold - - real(r8) :: resp_tstep ! Autotrophic respiration (see above *) - real(r8) :: resp_acc - real(r8) :: resp_acc_hold - - ! carbon 13c discrimination - real(r8) :: c13disc_clm ! carbon 13 discrimination in new synthesized carbon: part-per-mil, at each indiv/timestep - real(r8) :: c13disc_acc ! carbon 13 discrimination in new synthesized carbon: part-per-mil, at each indiv/day, at the end of a day - - - ! Used for CNP - integer :: cnp_limiter ! Which element is limiting growth? ! 0=none,1=C,2=N,3=P - real(r8) :: cx_int ! The time integration of the log of the relative carbon storage over relative nutrient - real(r8) :: ema_dcxdt ! The derivative of the log of the relative carbon storage over relative nutrient - real(r8) :: cx0 ! The value on the previous time-step of log of the relative carbon - ! storage over relative nutrient - real(r8) :: nc_repro ! The NC ratio of a new recruit, used also for defining reproductive stoich - real(r8) :: pc_repro ! The PC ratio of a new recruit - - ! Nutrient Fluxes (if N, P, etc. are turned on) - - real(r8) :: daily_nh4_uptake ! integrated daily uptake of mineralized ammonium through competitive acquisition in soil [kg N / plant/ day] - real(r8) :: daily_no3_uptake ! integrated daily uptake of mineralized nitrate through competitive acquisition in soil [kg N / plant/ day] - - real(r8) :: sym_nfix_daily ! Accumulated symbiotic N fixation from the roots [kgN/indiv/day] - real(r8) :: sym_nfix_tstep ! Symbiotic N fixation from the roots for the time-step[kgN/indiv/tstep] - - real(r8) :: daily_n_gain ! sum of fixation and uptake of mineralized nh4/no3 in solution as well as symbiotic fixation - real(r8) :: daily_p_gain ! integrated daily uptake of mineralized P through competitive acquisition in soil [kg P / plant/ day] - - real(r8) :: daily_c_efflux ! daily mean efflux of excess carbon from roots into labile pool [kg C/plant/day] - real(r8) :: daily_n_efflux ! daily mean efflux of excess nitrogen from roots into labile pool [kg N/plant/day] - real(r8) :: daily_p_efflux ! daily mean efflux of excess phophorus from roots into labile pool [kg P/plant/day] - - real(r8) :: daily_n_demand ! The daily amount of N demanded by the plant [kgN/plant/day] - real(r8) :: daily_p_demand ! The daily amount of P demanded by the plant [kgN/plant/day] - - - ! The following four biophysical rates are assumed to be - ! at the canopy top, at reference temp 25C, and based on the - ! leaf age weighted average of the PFT parameterized values. The last - ! condition is why it is dynamic and tied to the cohort - - real(r8) :: vcmax25top ! Maximum carboxylation at the cohort's top - ! at reference temperature (25C). - real(r8) :: jmax25top ! canopy top: maximum electron transport - ! rate at 25C (umol electrons/m**2/s) - real(r8) :: tpu25top ! canopy top: triose phosphate utilization - ! rate at 25C (umol CO2/m**2/s) - real(r8) :: kp25top ! canopy top: initial slope of CO2 response - ! curve (C4 plants) at 25C - - - - real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/timestep - real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year - - - ! RESPIRATION COMPONENTS - real(r8) :: rdark ! Dark respiration: kgC/indiv/s - - real(r8) :: resp_g_tstep ! Growth respiration: kgC/indiv/timestep - real(r8) :: resp_m ! Maintenance respiration: kgC/indiv/timestep - real(r8) :: resp_m_unreduced ! Diagnostic-only unreduced maintenance respiration: kgC/indiv/timestep - real(r8) :: resp_excess ! Respiration of excess carbon kgC/indiv/day - real(r8) :: livestem_mr ! Live stem maintenance respiration: kgC/indiv/s - ! (Above ground) - real(r8) :: livecroot_mr ! Live stem maintenance respiration: kgC/indiv/s - ! (below ground) - real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s - - !DAMAGE - real(r8) :: branch_frac ! Fraction of aboveground woody biomass in branches - - !MORTALITY - real(r8) :: dmort ! proportional mortality rate. (year-1) - - ! Mortality Rate Partitions - real(r8) :: bmort ! background mortality rate n/year - real(r8) :: cmort ! carbon starvation mortality rate n/year - real(r8) :: hmort ! hydraulic failure mortality rate n/year - real(r8) :: frmort ! freezing mortality n/year - real(r8) :: smort ! senesence mortality n/year - real(r8) :: asmort ! age senescence mortality n/year - real(r8) :: dgmort ! damage mortality n/year - - ! Logging Mortality Rate - ! Yi Xu & M. Huang - real(r8) :: lmort_direct ! directly logging rate fraction /per logging activity - real(r8) :: lmort_collateral ! collaterally damaged rate fraction /per logging activity - real(r8) :: lmort_infra ! mechanically damaged rate fraction /per logging activity - real(r8) :: l_degrad ! rate of trees that are not killed but suffer from forest degradation - ! (i.e. they are moved to newly-anthro-disturbed secondary - ! forest patch). fraction /per logging activity - - real(r8) :: seed_prod ! diagnostic seed production rate [kgC/plant/day] - - ! NITROGEN POOLS - ! ---------------------------------------------------------------------------------- - ! Nitrogen pools are not prognostic in the current implementation. - ! They are diagnosed during photosynthesis using a simple C2N parameter. Local values - ! used in that routine. - ! ---------------------------------------------------------------------------------- - - ! GROWTH DERIVIATIVES - real(r8) :: dndt ! time derivative of cohort size : n/year - real(r8) :: dhdt ! time derivative of height : m/year - real(r8) :: ddbhdt ! time derivative of dbh : cm/year - real(r8) :: dbdeaddt ! time derivative of dead biomass : KgC/year - - - - - ! FIRE - real(r8) :: fraction_crown_burned ! proportion of crown affected by fire:- - real(r8) :: cambial_mort ! probability that trees dies due to cambial char - ! (conditional on the tree being subjected to the fire) - real(r8) :: crownfire_mort ! probability of tree post-fire mortality - ! due to crown scorch (conditional on the tree being subjected to the fire) - real(r8) :: fire_mort ! post-fire mortality from cambial and crown damage assuming two are independent:- - - ! Hydraulics - type(ed_cohort_hydr_type), pointer :: co_hydr ! All cohort hydraulics data, see FatesHydraulicsMemMod.F90 - - - ! Running means - - ! (keeping this in-code as an example) - !class(rmean_type), pointer :: tveg_lpa ! exponential moving average of leaf temperature at the - ! leaf photosynthetic acclimation time-scale [K] - - - end type ed_cohort_type - - !************************************ - !** Patch type structure ** - !************************************ - - type, public :: ed_patch_type - - ! POINTERS - type (ed_cohort_type), pointer :: tallest => null() ! pointer to patch's tallest cohort - type (ed_cohort_type), pointer :: shortest => null() ! pointer to patch's shortest cohort - type (ed_patch_type), pointer :: older => null() ! pointer to next older patch - type (ed_patch_type), pointer :: younger => null() ! pointer to next younger patch - - !INDICES - integer :: patchno ! unique number given to each new patch created for tracking - - ! PATCH INFO - real(r8) :: age ! average patch age: years - integer :: age_class ! age class of the patch for history binning purposes - real(r8) :: area ! patch area: m2 - integer :: countcohorts ! Number of cohorts in patch - integer :: ncl_p ! Number of occupied canopy layers - integer :: anthro_disturbance_label ! patch label for anthropogenic disturbance classification - real(r8) :: age_since_anthro_disturbance ! average age for secondary forest since last anthropogenic disturbance - - - ! Running means - !class(rmean_type), pointer :: t2m ! Place-holder for 2m air temperature (variable window-size) - class(rmean_type), pointer :: tveg24 ! 24-hour mean vegetation temperature (K) - class(rmean_type), pointer :: tveg_lpa ! Running mean of vegetation temperature at the - ! leaf photosynthesis acclimation timescale [K] - - class(rmean_type), pointer :: tveg_longterm ! Long-Term Running mean of vegetation temperature at the - ! leaf photosynthesis acclimation timescale [K] (i.e T_home) - - integer :: nocomp_pft_label ! Where nocomp is active, use this label for patch ID. - ! Each patch ID corresponds to a pft number since each - ! patch has only one pft. Bareground patches are given - ! a zero integer as a label. - ! If nocomp is not active this is set to unset. - ! This is set in create_patch as an argument - ! to that procedure. - - class(rmean_type), pointer :: seedling_layer_par24 ! 24-hour mean of photosynthetically active radiation - ! at the seedling layer (w-m2) - - class(rmean_arr_type), pointer :: sdlng_emerg_smp(:) - ! Running mean of soil matric potential at the seedling - ! rooting depth at the h2o seedling emergence - ! timescale (see sdlng_emerg_h2o_timescale parameter) - class(rmean_type), pointer :: sdlng_mort_par ! Running mean of photosythetically active radiation - ! at the seedling layer and at the par-based seedling - ! mortality timescale (sdlng_mort_par_timescale) - class(rmean_arr_type), pointer :: sdlng_mdd(:) ! Running mean of moisture deficit days - ! at the seedling layer and at the mdd-based seedling - ! mortality timescale (sdlng_mdd_timescale) - ! (sdlng2sap_par_timescale) - class(rmean_type), pointer :: sdlng2sap_par ! Running mean of photosythetically active radiation - ! at the seedling layer and at the par-based seedling - ! to sapling transition timescale - ! (sdlng2sap_par_timescale) - - ! LEAF ORGANIZATION - real(r8) :: pft_agb_profile(maxpft,n_dbh_bins) ! binned above ground biomass, for patch fusion: KgC/m2 - real(r8) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer - ! used to determine attenuation of parameters during - ! photosynthesis m2 veg / m2 of canopy area (patch without bare ground) - real(r8) :: total_canopy_area ! area that is covered by vegetation : m2 - real(r8) :: total_tree_area ! area that is covered by woody vegetation : m2 - real(r8) :: zstar ! height of smallest canopy tree -- only meaningful in "strict PPA" mode - - real(r8) :: c_stomata ! Mean stomatal conductance of all leaves in the patch [umol/m2/s] - real(r8) :: c_lblayer ! Mean boundary layer conductance of all leaves in the patch [umol/m2/s] - - ! UNITS for the ai profiles - ! [ m2 leaf / m2 contributing crown footprints] - real(r8) :: tlai_profile(nclmax,maxpft,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer. - real(r8) :: elai_profile(nclmax,maxpft,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer - real(r8) :: tsai_profile(nclmax,maxpft,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer - real(r8) :: esai_profile(nclmax,maxpft,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer - real(r8) :: radiation_error ! radiation error (w/m2) - real(r8) :: layer_height_profile(nclmax,maxpft,nlevleaf) - real(r8) :: canopy_area_profile(nclmax,maxpft,nlevleaf) ! fraction of crown area per canopy area in each layer - ! they will sum to 1.0 in the fully closed canopy layers - ! but only in leaf-layers that contain contributions - ! from all cohorts that donate to canopy_area - - - ! layer, pft, and leaf layer:- - integer :: canopy_mask(nclmax,maxpft) ! is there any of this pft in this canopy layer? - integer :: nrad(nclmax,maxpft) ! number of exposed leaf layers for each canopy layer and pft - integer :: ncan(nclmax,maxpft) ! number of total leaf layers for each canopy layer and pft - - !RADIATION FLUXES - real(r8) :: fcansno ! Fraction of canopy covered in snow - - logical :: solar_zenith_flag ! integer flag specifying daylight (based on zenith angle) - real(r8) :: solar_zenith_angle ! solar zenith angle (radians) - - real(r8) :: gnd_alb_dif(maxSWb) ! ground albedo for diffuse rad, both bands (fraction) - real(r8) :: gnd_alb_dir(maxSWb) ! ground albedo for direct rad, both bands (fraction) - - real(r8) :: fabd_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of direct light absorbed by each canopy - ! layer, pft, and leaf layer:- - real(r8) :: fabd_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of direct light absorbed by each canopy - ! layer, pft, and leaf layer:- - real(r8) :: fabi_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of indirect light absorbed by each canopy - ! layer, pft, and leaf layer:- - real(r8) :: fabi_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of indirect light absorbed by each canopy - ! layer, pft, and leaf layer:- - - real(r8) :: ed_laisun_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the sun in each canopy layer, - ! pft, and leaf layer. m2/m2 - real(r8) :: ed_laisha_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the shade in each canopy layer, - real(r8) :: ed_parsun_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the sun in each canopy layer, - real(r8) :: ed_parsha_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the shade in each canopy layer, - real(r8) :: f_sun(nclmax,maxpft,nlevleaf) ! fraction of leaves in the sun in each canopy layer, pft, - - ! radiation profiles for comparison against observations - - ! normalized direct photosynthetically active radiation profiles by - ! incident type (direct/diffuse at top of canopy),leaf,pft,leaf (unitless) - real(r8) :: nrmlzd_parprof_pft_dir_z(n_rad_stream_types,nclmax,maxpft,nlevleaf) - - ! normalized diffuse photosynthetically active radiation profiles by - ! incident type (direct/diffuse at top of canopy),leaf,pft,leaf (unitless) - real(r8) :: nrmlzd_parprof_pft_dif_z(n_rad_stream_types,nclmax,maxpft,nlevleaf) - - ! normalized direct photosynthetically active radiation profiles by - ! incident type (direct/diffuse at top of canopy),leaf,leaf (unitless) - real(r8) :: nrmlzd_parprof_dir_z(n_rad_stream_types,nclmax,nlevleaf) - - ! normalized diffuse photosynthetically active radiation profiles by - ! incident type (direct/diffuse at top of canopy),leaf,leaf (unitless) - real(r8) :: nrmlzd_parprof_dif_z(n_rad_stream_types,nclmax,nlevleaf) - - real(r8) :: parprof_pft_dir_z(nclmax,maxpft,nlevleaf) ! direct-beam PAR profile through canopy, by canopy,PFT,leaf level (w/m2) - real(r8) :: parprof_pft_dif_z(nclmax,maxpft,nlevleaf) ! diffuse PAR profile through canopy, by canopy,PFT,leaf level (w/m2) - real(r8) :: parprof_dir_z(nclmax,nlevleaf) ! direct-beam PAR profile through canopy, by canopy,leaf level (w/m2) - real(r8) :: parprof_dif_z(nclmax,nlevleaf) ! diffuse PAR profile through canopy, by canopy,leaf level (w/m2) - - ! and leaf layer. m2/m2 - real(r8),allocatable :: tr_soil_dir(:) ! fraction of incoming direct radiation that (cm_numSWb) - ! is transmitted to the soil as direct - real(r8),allocatable :: tr_soil_dif(:) ! fraction of incoming diffuse radiation that - ! is transmitted to the soil as diffuse - real(r8),allocatable :: tr_soil_dir_dif(:) ! fraction of incoming direct radiation that - ! is transmitted to the soil as diffuse - real(r8),allocatable :: fab(:) ! fraction of incoming total radiation that is absorbed by the canopy - real(r8),allocatable :: fabd(:) ! fraction of incoming direct radiation that is absorbed by the canopy - real(r8),allocatable :: fabi(:) ! fraction of incoming diffuse radiation that is absorbed by the canopy - real(r8),allocatable :: sabs_dir(:) ! fraction of incoming direct radiation that is absorbed by the canopy - real(r8),allocatable :: sabs_dif(:) ! fraction of incoming diffuse radiation that is absorbed by the canopy - - - ! PHOTOSYNTHESIS - - real(r8) :: psn_z(nclmax,maxpft,nlevleaf) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s - - ! ROOTS - real(r8) :: btran_ft(maxpft) ! btran calculated seperately for each PFT:- - real(r8) :: bstress_sal_ft(maxpft) ! bstress from salinity calculated seperately for each PFT:- - - - ! These two variables are only used for external seed rain currently. - real(r8) :: nitr_repro_stoich(maxpft) ! The NC ratio of a new recruit in this patch - real(r8) :: phos_repro_stoich(maxpft) ! The PC ratio of a new recruit in this patch - - - ! DISTURBANCE - real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate from 1) mortality - ! 2) fire: fraction/day - ! 3) logging mortatliy - real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested - - - ! Litter and Coarse Woody Debris - - type(litter_type), pointer :: litter(:) ! Litter (leaf,fnrt,CWD and seeds) for different elements - - real(r8),allocatable :: fragmentation_scaler(:) ! Scale rate of litter fragmentation based on soil layer. 0 to 1. - - !FUEL CHARECTERISTICS - real(r8) :: sum_fuel ! total ground fuel related to ros (omits 1000hr fuels): KgC/m2 - real(r8) :: fuel_frac(nfsc) ! fraction of each litter class in the ros_fuel:-. - real(r8) :: livegrass ! total aboveground grass biomass in patch. KgC/m2 - real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel. kgBiomass/m3 - ! (incl. live grasses. omits 1000hr fuels). KgC/m3 - real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel. cm-1 - ! (incl. live grasses. omits 1000hr fuels). - real(r8) :: fuel_mef ! average moisture of extinction factor - ! of the ground fuel (incl. live grasses. omits 1000hr fuels). - real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel - ! (incl. live grasses. omits 1000hr fuels) - real(r8) :: litter_moisture(nfsc) - - ! FIRE SPREAD - real(r8) :: ros_front ! rate of forward spread of fire: m/min - real(r8) :: ros_back ! rate of backward spread of fire: m/min - real(r8) :: effect_wspeed ! windspeed modified by fraction of relative grass and tree cover: m/min - real(r8) :: tau_l ! Duration of lethal heating: mins - real(r8) :: fi ! average fire intensity of flaming front: kj/m/s or kw/m - integer :: fire ! Is there a fire? 1=yes 0=no - real(r8) :: fd ! fire duration: mins - - ! FIRE EFFECTS - real(r8) :: scorch_ht(maxpft) ! scorch height: m - real(r8) :: frac_burnt ! fraction burnt: frac patch/day - real(r8) :: tfc_ros ! total intensity-relevant fuel consumed - no trunks. KgC/m2 of burned ground/day - real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned, conditional on it being burned - - - ! PLANT HYDRAULICS (not currently used in hydraulics RGK 03-2018) - ! type(ed_patch_hydr_type) , pointer :: pa_hydr ! All patch hydraulics data, see FatesHydraulicsMemMod.F90 - - end type ed_patch_type - - !************************************ !** Resources management type ** ! YX @@ -757,8 +231,8 @@ module EDTypesMod type, public :: ed_site_type ! POINTERS - type (ed_patch_type), pointer :: oldest_patch => null() ! pointer to oldest patch at the site - type (ed_patch_type), pointer :: youngest_patch => null() ! pointer to yngest patch at the site + type (fates_patch_type), pointer :: oldest_patch => null() ! pointer to oldest patch at the site + type (fates_patch_type), pointer :: youngest_patch => null() ! pointer to yngest patch at the site ! Resource management type (ed_resources_management_type) :: resources_management ! resources_management at the site @@ -956,36 +430,9 @@ module EDTypesMod end type ed_site_type ! Make public necessary subroutines and functions - public :: val_check_ed_vars public :: dump_site - public :: dump_patch - public :: dump_cohort - public :: dump_cohort_hydr - public :: CanUpperUnder - contains - - ! ===================================================================================== - - function CanUpperUnder(ccohort) result(can_position) - - ! This simple function is used to determine if a - ! cohort's crown position is in the upper portion (ie the canopy) - ! or the understory. This differentiation is only used for - ! diagnostic purposes. Functionally, the model uses - ! the canopy layer position, which may have more than two layers - ! at any given time. Utlimately, every plant that is not in the - ! top layer (canopy), is considered understory. - type(ed_cohort_type) :: ccohort ! Current cohort of interest - integer :: can_position - - if(ccohort%canopy_layer == 1)then - can_position = ican_upper - else - can_position = ican_ustory - end if - - end function CanUpperUnder + contains ! ===================================================================================== @@ -1031,246 +478,25 @@ subroutine ZeroMassBalFlux(this) return end subroutine ZeroMassBalFlux - - ! ===================================================================================== - - subroutine val_check_ed_vars(currentPatch,var_aliases,return_code) - - ! ---------------------------------------------------------------------------------- - ! Perform numerical checks on variables of interest. - ! The input string is of the form: 'VAR1_NAME:VAR2_NAME:VAR3_NAME' - ! ---------------------------------------------------------------------------------- - - - use FatesUtilsMod,only : check_hlm_list - use FatesUtilsMod,only : check_var_real - - ! Arguments - type(ed_patch_type),intent(in), target :: currentPatch - character(len=*),intent(in) :: var_aliases - integer,intent(out) :: return_code ! return 0 for all fine - ! return 1 if a nan detected - ! return 10+ if an overflow - ! return 100% if an underflow - ! Locals - type(ed_cohort_type), pointer :: currentCohort - - - ! Check through a registry of variables to check - - if ( check_hlm_list(trim(var_aliases),'co_n') ) then - - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - call check_var_real(currentCohort%n,'cohort%n',return_code) - if(.not.(return_code.eq.0)) then - call dump_patch(currentPatch) - call dump_cohort(currentCohort) - return - end if - currentCohort => currentCohort%taller - end do - end if - - if ( check_hlm_list(trim(var_aliases),'co_dbh') ) then - - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - call check_var_real(currentCohort%dbh,'cohort%dbh',return_code) - if(.not.(return_code.eq.0)) then - call dump_patch(currentPatch) - call dump_cohort(currentCohort) - return - end if - currentCohort => currentCohort%taller - end do - end if - - if ( check_hlm_list(trim(var_aliases),'pa_area') ) then - - call check_var_real(currentPatch%area,'patch%area',return_code) - if(.not.(return_code.eq.0)) then - call dump_patch(currentPatch) - return - end if - end if - - - - return - end subroutine val_check_ed_vars - ! ===================================================================================== subroutine dump_site(csite) - type(ed_site_type),intent(in),target :: csite - + type(ed_site_type),intent(in),target :: csite - ! EDTypes is - write(fates_log(),*) '----------------------------------------' - write(fates_log(),*) ' Site Coordinates ' - write(fates_log(),*) '----------------------------------------' - write(fates_log(),*) 'latitude = ', csite%lat - write(fates_log(),*) 'longitude = ', csite%lon - write(fates_log(),*) '----------------------------------------' - return + ! EDTypes is - end subroutine dump_site + write(fates_log(),*) '----------------------------------------' + write(fates_log(),*) ' Site Coordinates ' + write(fates_log(),*) '----------------------------------------' + write(fates_log(),*) 'latitude = ', csite%lat + write(fates_log(),*) 'longitude = ', csite%lon + write(fates_log(),*) '----------------------------------------' + return - ! ===================================================================================== - - - subroutine dump_patch(cpatch) - - type(ed_patch_type),intent(in),target :: cpatch - - ! locals - integer :: el ! element loop counting index - - write(fates_log(),*) '----------------------------------------' - write(fates_log(),*) ' Dumping Patch Information ' - write(fates_log(),*) ' (omitting arrays) ' - write(fates_log(),*) '----------------------------------------' - write(fates_log(),*) 'pa%patchno = ',cpatch%patchno - write(fates_log(),*) 'pa%age = ',cpatch%age - write(fates_log(),*) 'pa%age_class = ',cpatch%age_class - write(fates_log(),*) 'pa%area = ',cpatch%area - write(fates_log(),*) 'pa%countcohorts = ',cpatch%countcohorts - write(fates_log(),*) 'pa%ncl_p = ',cpatch%ncl_p - write(fates_log(),*) 'pa%total_canopy_area = ',cpatch%total_canopy_area - write(fates_log(),*) 'pa%total_tree_area = ',cpatch%total_tree_area - write(fates_log(),*) 'pa%zstar = ',cpatch%zstar - write(fates_log(),*) 'pa%solar_zenith_flag = ',cpatch%solar_zenith_flag - write(fates_log(),*) 'pa%solar_zenith_angle = ',cpatch%solar_zenith_angle - write(fates_log(),*) 'pa%gnd_alb_dif = ',cpatch%gnd_alb_dif(:) - write(fates_log(),*) 'pa%gnd_alb_dir = ',cpatch%gnd_alb_dir(:) - write(fates_log(),*) 'pa%c_stomata = ',cpatch%c_stomata - write(fates_log(),*) 'pa%c_lblayer = ',cpatch%c_lblayer - write(fates_log(),*) 'pa%disturbance_rates = ',cpatch%disturbance_rates(:) - write(fates_log(),*) 'pa%anthro_disturbance_label = ',cpatch%anthro_disturbance_label - write(fates_log(),*) '----------------------------------------' - do el = 1,num_elements - write(fates_log(),*) 'element id: ',element_list(el) - write(fates_log(),*) 'seed mass: ',sum(cpatch%litter(el)%seed) - write(fates_log(),*) 'seed germ mass: ',sum(cpatch%litter(el)%seed_germ) - write(fates_log(),*) 'leaf fines(pft): ',sum(cpatch%litter(el)%leaf_fines) - write(fates_log(),*) 'root fines(pft,sl): ',sum(cpatch%litter(el)%root_fines) - write(fates_log(),*) 'ag_cwd(c): ',sum(cpatch%litter(el)%ag_cwd) - write(fates_log(),*) 'bg_cwd(c,sl): ',sum(cpatch%litter(el)%bg_cwd) - end do - - return - - end subroutine dump_patch - - ! ===================================================================================== +end subroutine dump_site - subroutine dump_cohort(ccohort) - - - type(ed_cohort_type),intent(in),target :: ccohort - - write(fates_log(),*) '----------------------------------------' - write(fates_log(),*) ' Dumping Cohort Information ' - write(fates_log(),*) '----------------------------------------' - write(fates_log(),*) 'co%pft = ', ccohort%pft - write(fates_log(),*) 'co%n = ', ccohort%n - write(fates_log(),*) 'co%dbh = ', ccohort%dbh - write(fates_log(),*) 'co%hite = ', ccohort%hite - write(fates_log(),*) 'co%crowndamage = ', ccohort%crowndamage - write(fates_log(),*) 'co%coage = ', ccohort%coage - write(fates_log(),*) 'co%l2fr = ', ccohort%l2fr - write(fates_log(),*) 'leaf carbon = ', ccohort%prt%GetState(leaf_organ,carbon12_element) - write(fates_log(),*) 'fineroot carbon = ', ccohort%prt%GetState(fnrt_organ,carbon12_element) - write(fates_log(),*) 'sapwood carbon = ', ccohort%prt%GetState(sapw_organ,carbon12_element) - write(fates_log(),*) 'structural (dead) carbon = ', ccohort%prt%GetState(struct_organ,carbon12_element) - write(fates_log(),*) 'storage carbon = ', ccohort%prt%GetState(store_organ,carbon12_element) - write(fates_log(),*) 'reproductive carbon = ', ccohort%prt%GetState(repro_organ,carbon12_element) - write(fates_log(),*) 'co%g_sb_laweight = ', ccohort%g_sb_laweight - write(fates_log(),*) 'co%leaf_cost = ', ccohort%leaf_cost - write(fates_log(),*) 'co%canopy_layer = ', ccohort%canopy_layer - write(fates_log(),*) 'co%canopy_layer_yesterday = ', ccohort%canopy_layer_yesterday - write(fates_log(),*) 'co%nv = ', ccohort%nv - write(fates_log(),*) 'co%status_coh = ', ccohort%status_coh - write(fates_log(),*) 'co%efleaf_coh = ', ccohort%efleaf_coh - write(fates_log(),*) 'co%effnrt_coh = ', ccohort%effnrt_coh - write(fates_log(),*) 'co%efstem_coh = ', ccohort%efstem_coh - write(fates_log(),*) 'co%canopy_trim = ', ccohort%canopy_trim - write(fates_log(),*) 'co%excl_weight = ', ccohort%excl_weight - write(fates_log(),*) 'co%prom_weight = ', ccohort%prom_weight - write(fates_log(),*) 'co%size_class = ', ccohort%size_class - write(fates_log(),*) 'co%size_by_pft_class = ', ccohort%size_by_pft_class - write(fates_log(),*) 'co%coage_class = ', ccohort%coage_class - write(fates_log(),*) 'co%coage_by_pft_class = ', ccohort%coage_by_pft_class - write(fates_log(),*) 'co%gpp_acc_hold = ', ccohort%gpp_acc_hold - write(fates_log(),*) 'co%gpp_acc = ', ccohort%gpp_acc - write(fates_log(),*) 'co%gpp_tstep = ', ccohort%gpp_tstep - write(fates_log(),*) 'co%npp_acc_hold = ', ccohort%npp_acc_hold - write(fates_log(),*) 'co%npp_tstep = ', ccohort%npp_tstep - write(fates_log(),*) 'co%npp_acc = ', ccohort%npp_acc - write(fates_log(),*) 'co%resp_tstep = ', ccohort%resp_tstep - write(fates_log(),*) 'co%resp_acc = ', ccohort%resp_acc - write(fates_log(),*) 'co%resp_acc_hold = ', ccohort%resp_acc_hold - write(fates_log(),*) 'co%rdark = ', ccohort%rdark - write(fates_log(),*) 'co%resp_m = ', ccohort%resp_m - write(fates_log(),*) 'co%resp_g_tstep = ', ccohort%resp_g_tstep - write(fates_log(),*) 'co%livestem_mr = ', ccohort%livestem_mr - write(fates_log(),*) 'co%livecroot_mr = ', ccohort%livecroot_mr - write(fates_log(),*) 'co%froot_mr = ', ccohort%froot_mr - write(fates_log(),*) 'co%dgmort = ', ccohort%dgmort - write(fates_log(),*) 'co%treelai = ', ccohort%treelai - write(fates_log(),*) 'co%treesai = ', ccohort%treesai - write(fates_log(),*) 'co%c_area = ', ccohort%c_area - write(fates_log(),*) 'co%cmort = ', ccohort%cmort - write(fates_log(),*) 'co%bmort = ', ccohort%bmort - write(fates_log(),*) 'co%smort = ', ccohort%smort - write(fates_log(),*) 'co%asmort = ', ccohort%asmort - write(fates_log(),*) 'co%dgmort = ', ccohort%dgmort - write(fates_log(),*) 'co%hmort = ', ccohort%hmort - write(fates_log(),*) 'co%frmort = ', ccohort%frmort - write(fates_log(),*) 'co%asmort = ', ccohort%asmort - write(fates_log(),*) 'co%lmort_direct = ', ccohort%lmort_direct - write(fates_log(),*) 'co%lmort_collateral = ', ccohort%lmort_collateral - write(fates_log(),*) 'co%lmort_infra = ', ccohort%lmort_infra - write(fates_log(),*) 'co%isnew = ', ccohort%isnew - write(fates_log(),*) 'co%dndt = ', ccohort%dndt - write(fates_log(),*) 'co%dhdt = ', ccohort%dhdt - write(fates_log(),*) 'co%ddbhdt = ', ccohort%ddbhdt - write(fates_log(),*) 'co%dbdeaddt = ', ccohort%dbdeaddt - write(fates_log(),*) 'co%fraction_crown_burned = ', ccohort%fraction_crown_burned - write(fates_log(),*) 'co%fire_mort = ', ccohort%fire_mort - write(fates_log(),*) 'co%crownfire_mort = ', ccohort%crownfire_mort - write(fates_log(),*) 'co%cambial_mort = ', ccohort%cambial_mort - write(fates_log(),*) 'co%size_class = ', ccohort%size_class - write(fates_log(),*) 'co%size_by_pft_class = ', ccohort%size_by_pft_class - - if (associated(ccohort%co_hydr) ) then - call dump_cohort_hydr(ccohort) - endif - write(fates_log(),*) '----------------------------------------' - return - end subroutine dump_cohort - - ! ===================================================================================== - subroutine dump_cohort_hydr(ccohort) - - - type(ed_cohort_type),intent(in),target :: ccohort - type(ed_cohort_hydr_type), pointer :: ccohort_hydr - ccohort_hydr => ccohort%co_hydr - - write(fates_log(),*) '--------------------------------------------' - write(fates_log(),*) ' Dumping Cohort Plant Hydraulic Information ' - write(fates_log(),*) 'ccohort_hydr%th_aroot(:) = ', ccohort_hydr%th_aroot(:) - write(fates_log(),*) 'ccohort_hydr%v_aroot_layer_init(:) = ', ccohort_hydr%v_aroot_layer_init(:) - write(fates_log(),*) 'ccohort_hydr%v_aroot_layer(:) = ', ccohort_hydr%v_aroot_layer(:) - write(fates_log(),*) '--------------------------------------------' - return - end subroutine dump_cohort_hydr - - end module EDTypesMod diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 04da38638a..08a8aaa3df 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -30,11 +30,57 @@ module FatesConstantsMod ! Integer equivalent of false (in case come compilers dont auto convert) integer, parameter, public :: ifalse = 0 + ! the parameter file may determine that fewer + ! are used, but this helps allocate scratch + ! space and output arrays. + + integer, parameter, public :: n_rad_stream_types = 2 ! The number of radiation streams used (direct/diffuse) + + integer , parameter, public :: N_DBH_BINS = 6 ! no. of dbh bins used when comparing patches + real(fates_r8), parameter, public :: patchfusion_dbhbin_loweredges(N_DBH_BINS) = & + (/0._fates_r8, 5._fates_r8, 20._fates_r8, 50._fates_r8, 100._fates_r8, 150._fates_r8/) ! array of bin lower edges for comparing patches + + + integer , parameter, public :: N_DIST_TYPES = 3 ! Disturbance Modes 1) tree-fall, 2) fire, 3) logging + integer , parameter, public :: dtype_ifall = 1 ! index for naturally occuring tree-fall generated event + integer , parameter, public :: dtype_ifire = 2 ! index for fire generated disturbance event + integer , parameter, public :: dtype_ilog = 3 ! index for logging generated disturbance event + ! Labels for patch disturbance history integer, parameter, public :: n_anthro_disturbance_categories = 2 integer, parameter, public :: primaryforest = 1 integer, parameter, public :: secondaryforest = 2 + + integer, parameter, public :: leaves_on = 2 ! Flag specifying that a deciduous plant has leaves + ! and should be allocating to them as well + integer, parameter, public :: leaves_off = 1 ! Flag specifying that a deciduous plant has dropped + ! its leaves and should not be trying to allocate + ! towards any growth. + integer, parameter, public :: leaves_shedding = 3 ! Flag specifying that a deciduous plant has leaves + ! but is shedding them (partial shedding). This plant + ! should not allocate carbon towards growth or + ! reproduction. +integer, parameter, public :: ihard_stress_decid = 1 ! If the PFT is stress (drought) deciduous, + ! this flag is used to tell that the PFT + ! is a "hard" deciduous (i.e., the plant + ! has only two statuses, the plant either + ! sheds all leaves when it's time, or seeks + ! to flush the leaves back to allometry + ! when conditions improve. +integer, parameter, public :: isemi_stress_decid = 2 ! If the PFT is stress (drought) deciduous, + ! this flag is used to tell that the PFT + ! is a semi-deciduous (i.e., the plant + ! can downregulate the amount of leaves + ! relative to the allometry based on + ! soil moisture conditions. It can still + ! shed all leaves if conditions are very + ! dry. + + integer, parameter, public :: ican_upper = 1 ! nominal index for the upper canopy + integer, parameter, public :: ican_ustory = 2 ! nominal index for diagnostics that refer to understory layers + ! (all layers that are not the top canopy layer) + ! Bareground label for no competition mode integer, parameter, public :: nocomp_bareground = 0 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 0594c77506..779a1dbdda 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -12,25 +12,25 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : t_water_freeze_k_1atm use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun - use EDTypesMod , only : nclmax - use EDTypesMod , only : ican_upper + use EDParamsMod , only : nclmax, maxpft + use FatesConstantsMod , only : ican_upper use PRTGenericMod , only : element_pos use PRTGenericMod , only : num_elements use PRTGenericMod , only : prt_cnp_flex_allom_hyp use EDTypesMod , only : site_fluxdiags_type use EDtypesMod , only : ed_site_type - use EDtypesMod , only : ed_cohort_type - use EDtypesMod , only : ed_patch_type + use FatesCohortMod , only : fates_cohort_type + use FatesPatchMod , only : fates_patch_type use EDtypesMod , only : AREA use EDtypesMod , only : AREA_INV use EDTypesMod , only : numWaterMem use EDTypesMod , only : num_vegtemp_mem use EDTypesMod , only : site_massbal_type use PRTGenericMod , only : element_list - use EDTypesMod , only : N_DIST_TYPES - use EDTypesMod , only : dtype_ifall - use EDTypesMod , only : dtype_ifire - use EDTypesMod , only : dtype_ilog + use FatesConstantsMod , only : N_DIST_TYPES + use FatesConstantsMod , only : dtype_ifall + use FatesConstantsMod , only : dtype_ifire + use FatesConstantsMod , only : dtype_ilog use FatesIODimensionsMod , only : fates_io_dimension_type use FatesIOVariableKindMod , only : fates_io_variable_kind_type use FatesIOVariableKindMod , only : site_int @@ -1925,8 +1925,8 @@ subroutine update_history_nutrflux(this,csite) class(fates_history_interface_type) :: this type(ed_site_type), intent(in) :: csite - type(ed_patch_type), pointer :: cpatch - type(ed_cohort_type), pointer :: ccohort + type(fates_patch_type), pointer :: cpatch + type(fates_cohort_type), pointer :: ccohort integer :: iclscpf ! layer x size x pft class index integer :: iscpf ! Size x pft class index integer :: io_si ! site's global index in the history vector @@ -2110,10 +2110,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! --------------------------------------------------------------------------------- - use EDtypesMod , only : nfsc + use FatesLitterMod , only : nfsc use FatesLitterMod , only : ncwd - use EDtypesMod , only : ican_upper - use EDtypesMod , only : ican_ustory + use FatesConstantsMod , only : ican_upper + use FatesConstantsMod , only : ican_ustory use FatesSizeAgeTypeIndicesMod, only : get_sizeage_class_index use FatesSizeAgeTypeIndicesMod, only : get_sizeagepft_class_index use FatesSizeAgeTypeIndicesMod, only : get_agepft_class_index @@ -2125,7 +2125,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) use FatesSizeAgeTypeIndicesMod, only : get_cdamagesizepft_class_index use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index - use EDTypesMod , only : nlevleaf + use EDParamsMod , only : nlevleaf use EDParamsMod , only : ED_val_history_height_bin_edges use FatesInterfaceTypesMod , only : nlevdamage @@ -2211,8 +2211,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) integer :: return_code - type(ed_patch_type),pointer :: cpatch - type(ed_cohort_type),pointer :: ccohort + type(fates_patch_type),pointer :: cpatch + type(fates_cohort_type),pointer :: ccohort real(r8), parameter :: reallytalltrees = 1000. ! some large number (m) @@ -4384,7 +4384,7 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) ! after rapid timescale productivity calculations (gpp and respiration). ! --------------------------------------------------------------------------------- - use EDTypesMod , only : nclmax, nlevleaf + use EDParamsMod , only : nclmax, nlevleaf ! ! Arguments class(fates_history_interface_type) :: this @@ -4411,8 +4411,8 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) real(r8) :: site_area_veg ! area of the site that is not bare-ground integer :: ipa2 ! patch incrementer integer :: cnlfpft_indx, cnlf_indx, ipft, ican, ileaf ! more iterators and indices - type(ed_patch_type),pointer :: cpatch - type(ed_cohort_type),pointer :: ccohort + type(fates_patch_type),pointer :: cpatch + type(fates_cohort_type),pointer :: ccohort real(r8) :: per_dt_tstep ! Time step in frequency units (/s) associate( hio_gpp_si => this%hvars(ih_gpp_si)%r81d, & @@ -4858,8 +4858,6 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) use FatesHydraulicsMemMod, only : ed_cohort_hydr_type, nshell use FatesHydraulicsMemMod, only : ed_site_hydr_type - use EDTypesMod , only : maxpft - ! Arguments class(fates_history_interface_type) :: this @@ -4903,8 +4901,8 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) real(r8) :: psi ! matric potential of soil layer real(r8) :: depth_frac ! fraction of rhizosphere layer depth occupied by current soil layer character(2) :: fmt_char - type(ed_patch_type),pointer :: cpatch - type(ed_cohort_type),pointer :: ccohort + type(fates_patch_type),pointer :: cpatch + type(fates_cohort_type),pointer :: ccohort type(ed_cohort_hydr_type), pointer :: ccohort_hydr type(ed_site_hydr_type), pointer :: site_hydr real(r8) :: per_dt_tstep ! Time step in frequency units (/s) diff --git a/main/FatesHydraulicsMemMod.F90 b/main/FatesHydraulicsMemMod.F90 index 23f3f75482..61e97173c7 100644 --- a/main/FatesHydraulicsMemMod.F90 +++ b/main/FatesHydraulicsMemMod.F90 @@ -2,6 +2,7 @@ module FatesHydraulicsMemMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : fates_unset_r8 + use FatesGlobals, only : fates_log use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) use FatesConstantsMod, only : itrue,ifalse use FatesHydroWTFMod, only : wrf_arr_type @@ -314,11 +315,74 @@ module FatesHydraulicsMemMod procedure :: AllocateHydrCohortArrays procedure :: DeallocateHydrCohortArrays + procedure :: CopyCohortHydraulics + procedure :: Dump end type ed_cohort_hydr_type contains - + + subroutine CopyCohortHydraulics(ncohort_hydr, ocohort_hydr) + + ! Arguments + class(ed_cohort_hydr_type), intent(inout) :: ncohort_hydr + class(ed_cohort_hydr_type), intent(inout) :: ocohort_hydr + + ! Node heights + ncohort_hydr%z_node_ag = ocohort_hydr%z_node_ag + ncohort_hydr%z_upper_ag = ocohort_hydr%z_upper_ag + ncohort_hydr%z_lower_ag = ocohort_hydr%z_lower_ag + ncohort_hydr%z_node_troot = ocohort_hydr%z_node_troot + + ! Compartment kmax's + ncohort_hydr%kmax_petiole_to_leaf = ocohort_hydr%kmax_petiole_to_leaf + ncohort_hydr%kmax_stem_lower = ocohort_hydr%kmax_stem_lower + ncohort_hydr%kmax_stem_upper = ocohort_hydr%kmax_stem_upper + ncohort_hydr%kmax_troot_upper = ocohort_hydr%kmax_troot_upper + ncohort_hydr%kmax_troot_lower = ocohort_hydr%kmax_troot_lower + ncohort_hydr%kmax_aroot_upper = ocohort_hydr%kmax_aroot_upper + ncohort_hydr%kmax_aroot_lower = ocohort_hydr%kmax_aroot_lower + ncohort_hydr%kmax_aroot_radial_in = ocohort_hydr%kmax_aroot_radial_in + ncohort_hydr%kmax_aroot_radial_out = ocohort_hydr%kmax_aroot_radial_out + + ! Compartment volumes + ncohort_hydr%v_ag_init = ocohort_hydr%v_ag_init + ncohort_hydr%v_ag = ocohort_hydr%v_ag + ncohort_hydr%v_troot_init = ocohort_hydr%v_troot_init + ncohort_hydr%v_troot = ocohort_hydr%v_troot + ncohort_hydr%v_aroot_layer_init = ocohort_hydr%v_aroot_layer_init + ncohort_hydr%v_aroot_layer = ocohort_hydr%v_aroot_layer + ncohort_hydr%l_aroot_layer = ocohort_hydr%l_aroot_layer + + ! State Variables + ncohort_hydr%th_ag = ocohort_hydr%th_ag + ncohort_hydr%th_troot = ocohort_hydr%th_troot + ncohort_hydr%th_aroot = ocohort_hydr%th_aroot + ncohort_hydr%psi_ag = ocohort_hydr%psi_ag + ncohort_hydr%psi_troot = ocohort_hydr%psi_troot + ncohort_hydr%psi_aroot = ocohort_hydr%psi_aroot + ncohort_hydr%ftc_ag = ocohort_hydr%ftc_ag + ncohort_hydr%ftc_troot = ocohort_hydr%ftc_troot + ncohort_hydr%ftc_aroot = ocohort_hydr%ftc_aroot + + ! Other + ncohort_hydr%btran = ocohort_hydr%btran + ncohort_hydr%supsub_flag = ocohort_hydr%supsub_flag + ncohort_hydr%iterh1 = ocohort_hydr%iterh1 + ncohort_hydr%iterh2 = ocohort_hydr%iterh2 + ncohort_hydr%iterlayer = ocohort_hydr%iterlayer + ncohort_hydr%errh2o = ocohort_hydr%errh2o + + + ! BC PLANT HYDRAULICS - flux terms + ncohort_hydr%qtop = ocohort_hydr%qtop + + ncohort_hydr%is_newly_recruited = ocohort_hydr%is_newly_recruited + + end subroutine CopyCohortHydraulics + + ! ========================================================================== + subroutine AllocateHydrCohortArrays(this,nlevrhiz) ! Arguments @@ -361,7 +425,24 @@ subroutine DeallocateHydrCohortArrays(this) return end subroutine DeallocateHydrCohortArrays - ! =================================================================================== + ! ========================================================================== + + subroutine Dump(this) + + class(ed_cohort_hydr_type), intent(in) :: this + + write(fates_log(),*) '--------------------------------------------' + write(fates_log(),*) ' Dumping Cohort Plant Hydraulic Information ' + write(fates_log(),*) 'ccohort_hydr%th_aroot(:) = ', this%th_aroot(:) + write(fates_log(),*) 'ccohort_hydr%v_aroot_layer_init(:) = ', this%v_aroot_layer_init(:) + write(fates_log(),*) 'ccohort_hydr%v_aroot_layer(:) = ', this%v_aroot_layer(:) + write(fates_log(),*) '--------------------------------------------' + + return + + end subroutine Dump + + ! ========================================================================== subroutine InitHydrSite(this,numpft,numlevsclass,hydr_solver_type,nlevsoil) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index dc60420fac..be6c1bbd38 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -10,8 +10,8 @@ module FatesInterfaceMod ! ------------------------------------------------------------------------------------ use EDTypesMod , only : ed_site_type - use EDTypesMod , only : dinc_vai - use EDTypesMod , only : dlower_vai + use EDParamsMod , only : dinc_vai + use EDParamsMod , only : dlower_vai use EDParamsMod , only : ED_val_vai_top_bin_width use EDParamsMod , only : ED_val_vai_width_increase_factor use EDParamsMod , only : ED_val_history_damage_bin_edges @@ -20,18 +20,18 @@ module FatesInterfaceMod use EDParamsMod , only : maxpatch_secondary use EDParamsMod , only : max_cohort_per_patch use EDParamsMod , only : regeneration_model - 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 EDParamsMod , only : maxSWb + use EDParamsMod , only : ivis + use EDParamsMod , only : inir + use EDParamsMod , only : nclmax + use EDParamsMod , only : nlevleaf + use EDParamsMod , only : maxpft use EDTypesMod , only : do_fates_salinity use EDTypesMod , only : numWaterMem use EDTypesMod , only : numlevsoil_max use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type + use FatesPatchMod , only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : area_inv use EDTypesMod , only : num_vegtemp_mem use FatesConstantsMod , only : r8 => fates_r8 @@ -64,8 +64,8 @@ module FatesInterfaceMod 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 : p_uptake_mode - use EDTypesMod , only : n_uptake_mode + use EDParamsMod , only : p_uptake_mode + use EDParamsMod , only : n_uptake_mode use EDTypesMod , only : ed_site_type use FatesConstantsMod , only : prescribed_p_uptake use FatesConstantsMod , only : prescribed_n_uptake @@ -106,6 +106,7 @@ module FatesInterfaceMod ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_kind_mod , only : SHR_KIND_CL ! Just use everything from FatesInterfaceTypesMod, this is ! its sister code @@ -729,10 +730,10 @@ subroutine SetFatesGlobalElements1(use_fates,surf_numpft,surf_numcft) implicit none - logical,intent(in) :: use_fates ! Is fates turned on? - integer,intent(in) :: surf_numpft ! Number of PFTs in surface dataset - integer,intent(in) :: surf_numcft ! Number of CFTs in surface dataset - + logical, intent(in) :: use_fates ! Is fates turned on? + integer, intent(in) :: surf_numpft ! Number of PFTs in surface dataset + integer, intent(in) :: surf_numcft ! Number of CFTs in surface dataset + integer :: fates_numpft ! Number of PFTs tracked in FATES if (use_fates) then @@ -1067,9 +1068,9 @@ end subroutine InitPARTEHGlobals subroutine fates_history_maps - use EDTypesMod, only : NFSC - use EDTypesMod, only : nclmax - use EDTypesMod, only : nlevleaf + use FatesLitterMod, only : NFSC + use EDParamsMod, only : nclmax + use EDParamsMod, only : nlevleaf 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 @@ -1952,8 +1953,8 @@ subroutine UpdateFatesRMeansTStep(sites,bc_in) type(ed_site_type), intent(inout) :: sites(:) type(bc_in_type), intent(in) :: bc_in(:) - type(ed_patch_type), pointer :: cpatch - type(ed_cohort_type), pointer :: ccohort + type(fates_patch_type), pointer :: cpatch + type(fates_cohort_type), pointer :: ccohort integer :: s, ifp, io_si, pft real(r8) :: new_seedling_layer_par ! seedling layer par in the current timestep real(r8) :: new_seedling_layer_smp ! seedling layer smp in the current timestep @@ -2058,7 +2059,7 @@ subroutine SeedlingParPatch(cpatch, & ! of those two (which should sum to unity). ! Arguments - type(ed_patch_type) :: cpatch ! the current patch + type(fates_patch_type) :: cpatch ! the current patch real(r8), intent(in) :: atm_par ! direct+diffuse PAR at canopy top [W/m2] real(r8), intent(out) :: seedling_par_high ! High intensity PAR for seedlings [W/m2] real(r8), intent(out) :: par_high_frac ! Area fraction with high intensity diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 026989cd38..0141c68fe5 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -28,18 +28,22 @@ module FatesInventoryInitMod use FatesConstantsMod, only : itrue use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log + use EDParamsMod , only : regeneration_model use FatesInterfaceTypesMod, only : bc_in_type use FatesInterfaceTypesMod, only : hlm_inventory_ctrl_file use FatesInterfaceTypesMod, only : nleafage + use FatesInterfaceTypesMod, only : hlm_current_tod + use FatesInterfaceTypesMod, only : hlm_numSWb + use FatesInterfaceTypesMod, only : numpft use FatesLitterMod , only : litter_type use EDTypesMod , only : ed_site_type - use EDTypesMod , only : ed_patch_type - use EDTypesMod , only : ed_cohort_type + use FatesPatchMod , only : fates_patch_type + use FatesCohortMod , only : fates_cohort_type use EDTypesMod , only : area - use EDTypesMod , only : leaves_on - use EDTypesMod , only : leaves_off - use EDTypesMod , only : ihard_stress_decid - use EDTypesMod , only : isemi_stress_decid + use FatesConstantsMod, only : leaves_on + use FatesConstantsMod, only : leaves_off + use FatesConstantsMod, only : ihard_stress_decid + use FatesConstantsMod, only : isemi_stress_decid use PRTGenericMod , only : num_elements use PRTGenericMod , only : element_list use EDTypesMod , only : phen_cstat_nevercold @@ -67,6 +71,7 @@ module FatesInventoryInitMod use FatesRunningMeanMod, only : ema_lpa use PRTGenericMod, only : StorageNutrientTarget use FatesConstantsMod, only : fates_unset_int + use EDCanopyStructureMod, only : canopy_summarization, canopy_structure implicit none private @@ -77,7 +82,7 @@ module FatesInventoryInitMod ! with a patch. BY having a vector of patch pointers that lines up with the string ! identifier array, this can be done quickly. type pp_array - type(ed_patch_type), pointer :: cpatch + type(fates_patch_type), pointer :: cpatch end type pp_array character(len=*), parameter, private :: sourcefile = __FILE__ @@ -111,7 +116,6 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) use shr_file_mod, only : shr_file_getUnit use shr_file_mod, only : shr_file_freeUnit use FatesConstantsMod, only : nearzero - use EDPatchDynamicsMod, only : create_patch use EDPatchDynamicsMod, only : fuse_patches use EDCohortDynamicsMod, only : fuse_cohorts use EDCohortDynamicsMod, only : sort_cohorts @@ -125,12 +129,12 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! Locals type(ed_site_type), pointer :: currentSite - type(ed_patch_type), pointer :: currentpatch - type(ed_cohort_type), pointer :: currentcohort - type(ed_patch_type), pointer :: newpatch - type(ed_patch_type), pointer :: olderpatch - type(ed_patch_type), pointer :: head_of_unsorted_patch_list - type(ed_patch_type), pointer :: next_in_unsorted_patch_list + type(fates_patch_type), pointer :: currentpatch + type(fates_cohort_type), pointer :: currentcohort + type(fates_patch_type), pointer :: newpatch + type(fates_patch_type), pointer :: olderpatch + type(fates_patch_type), pointer :: head_of_unsorted_patch_list + type(fates_patch_type), pointer :: next_in_unsorted_patch_list integer :: sitelist_file_unit ! fortran file unit for site list integer :: pss_file_unit ! fortran file unit for the pss file integer :: css_file_unit ! fortran file unit for the css file @@ -143,6 +147,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) real(r8) :: area_init ! dummy value for creating a patch integer :: s ! site index integer :: ipa ! patch index + integer :: iv, ft, ic integer :: total_cohorts ! cohort counter for error checking integer, allocatable :: inv_format_list(:) ! list of format specs character(len=path_strlen), allocatable :: inv_css_list(:) ! list of css file names @@ -267,12 +272,6 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) do ipa=1,npatches - allocate(newpatch) - - newpatch%patchno = ipa - newpatch%younger => null() - newpatch%older => null() - ! This call doesn't do much asside from initializing the patch with ! nominal values, NaNs, zero's and allocating some vectors. We should ! be able to get the following values from the patch files. But on @@ -280,8 +279,14 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) age_init = 0.0_r8 area_init = 0.0_r8 + allocate(newpatch) + call newpatch%Create(age_init, area_init, primaryforest, & + fates_unset_int, hlm_numSWb, numpft, sites(s)%nlevsoil, & + hlm_current_tod, regeneration_model) - call create_patch(sites(s), newpatch, age_init, area_init, primaryforest, fates_unset_int ) + newpatch%patchno = ipa + newpatch%younger => null() + newpatch%older => null() if( inv_format_list(invsite) == 1 ) then @@ -520,6 +525,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! Report Basal Area (as a check on if things were read in) ! ---------------------------------------------------------------------------------------- + !call canopy_structure(sites(s),bc_in(s)) basal_area_postf = 0.0_r8 currentpatch => sites(s)%youngest_patch do while(associated(currentpatch)) @@ -529,9 +535,12 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) currentcohort%n*0.25*((currentcohort%dbh/100.0_r8)**2.0_r8)*pi_const currentcohort => currentcohort%shorter end do + currentPatch => currentpatch%older enddo + + write(fates_log(),*) '-------------------------------------------------------' write(fates_log(),*) 'Basal Area from inventory, AFTER fusion' write(fates_log(),*) 'Lat: ',sites(s)%lat,' Lon: ',sites(s)%lon @@ -540,11 +549,13 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! If this is flagged as true, the post-fusion inventory will be written to file ! in the run directory. + if(do_inventory_out)then call write_inventory_type1(sites(s)) end if end do + deallocate(inv_format_list, inv_pss_list, inv_css_list, inv_lat_list, inv_lon_list) return @@ -745,10 +756,9 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name use FatesSizeAgeTypeIndicesMod, only: get_age_class_index use EDtypesMod, only: AREA - use SFParamsMod , only : SF_val_CWD_frac ! Arguments - type(ed_patch_type),intent(inout), target :: newpatch ! Patch structure + type(fates_patch_type),intent(inout), target :: newpatch ! Patch structure integer,intent(in) :: pss_file_unit ! Self explanatory integer,intent(in) :: ipa ! Patch index (line number) integer,intent(out) :: ios ! Return flag @@ -895,8 +905,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! should be quickly re-calculated integer,parameter :: rstatus = 0 ! recruit status - type(ed_patch_type), pointer :: cpatch ! current patch pointer - type(ed_cohort_type), pointer :: temp_cohort ! temporary patch (needed for allom funcs) + type(fates_patch_type), pointer :: cpatch ! current patch pointer + type(fates_cohort_type), pointer :: temp_cohort ! temporary patch (needed for allom funcs) integer :: ipa ! patch idex integer :: iage integer :: el @@ -1214,8 +1224,8 @@ subroutine write_inventory_type1(currentSite) type(ed_site_type), target :: currentSite ! Locals - type(ed_patch_type), pointer :: currentpatch - type(ed_cohort_type), pointer :: currentcohort + type(fates_patch_type), pointer :: currentpatch + type(fates_cohort_type), pointer :: currentcohort character(len=128) :: pss_name_out ! output file string character(len=128) :: css_name_out ! output file string diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index aa13150c4a..b19817a091 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -4,7 +4,7 @@ module FatesParametersInterface ! depend on any host modules. use FatesConstantsMod, only : r8 => fates_r8 - use FatesGlobals, only : fates_log + use FatesGlobals, only : fates_log, fates_endrun implicit none private ! Modules are private by default @@ -172,8 +172,6 @@ end subroutine RetrieveParameterScalar !----------------------------------------------------------------------- subroutine RetrieveParameter1D(this, name, data) - use abortutils, only : endrun - implicit none class(fates_parameters_type), intent(inout) :: this @@ -192,7 +190,7 @@ subroutine RetrieveParameter1D(this, name, data) do d = 1, max_dimensions write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d) end do - call endrun(msg='size error retreiving 1d parameter.') + call fates_endrun(msg='size error retreiving 1d parameter.') end if data = this%parameters(i)%data(:, 1) @@ -201,8 +199,6 @@ end subroutine RetrieveParameter1D !----------------------------------------------------------------------- subroutine RetrieveParameter2D(this, name, data) - use abortutils, only : endrun - implicit none class(fates_parameters_type), intent(inout) :: this @@ -225,7 +221,7 @@ subroutine RetrieveParameter2D(this, name, data) do d = 1, max_dimensions write(fates_log(), *) this%parameters(i)%dimension_names(d), ', ', this%parameters(i)%dimension_sizes(d) end do - call endrun(msg='size error retreiving 2d parameter.') + call fates_endrun(msg='size error retreiving 2d parameter.') end if data = this%parameters(i)%data @@ -234,8 +230,6 @@ end subroutine RetrieveParameter2D !----------------------------------------------------------------------- subroutine RetrieveParameter1DAllocate(this, name, data) - use abortutils, only : endrun - implicit none class(fates_parameters_type), intent(inout) :: this @@ -255,8 +249,6 @@ end subroutine RetrieveParameter1DAllocate !----------------------------------------------------------------------- subroutine RetrieveParameter2DAllocate(this, name, data) - use abortutils, only : endrun - implicit none class(fates_parameters_type), intent(inout) :: this @@ -439,9 +431,7 @@ end subroutine SetDataScalar !----------------------------------------------------------------------- subroutine SetData1D(this, index, data) - - use abortutils, only : endrun - + implicit none class(fates_parameters_type), intent(inout) :: this @@ -460,7 +450,7 @@ subroutine SetData1D(this, index, data) do d = 1, max_dimensions write(fates_log(), *) this%parameters(index)%dimension_names(d), ', ', this%parameters(index)%dimension_sizes(d) end do - call endrun(msg='size error setting 1d parameter.') + call fates_endrun(msg='size error setting 1d parameter.') end if allocate(this%parameters(index)%data(size_dim_1, 1)) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index ed259ed921..55016e9acb 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -26,7 +26,6 @@ module FatesRestartInterfaceMod use FatesInterfaceTypesMod, only : hlm_use_nocomp, hlm_use_fixed_biogeog use FatesInterfaceTypesMod, only : fates_maxElementsPerSite use FatesInterfaceTypesMod, only : hlm_use_tree_damage - use EDCohortDynamicsMod, only : UpdateCohortBioPhysRates use FatesHydraulicsMemMod, only : nshell use FatesHydraulicsMemMod, only : n_hypool_ag use FatesHydraulicsMemMod, only : n_hypool_troot @@ -34,17 +33,15 @@ module FatesRestartInterfaceMod use FatesPlantHydraulicsMod, only : UpdatePlantPsiFTCFromTheta use PRTGenericMod, only : prt_global use PRTGenericMod, only : prt_cnp_flex_allom_hyp - use EDCohortDynamicsMod, only : nan_cohort - use EDCohortDynamicsMod, only : zero_cohort use EDCohortDynamicsMod, only : InitPRTObject - use EDCohortDynamicsMod, only : InitPRTBoundaryConditions use FatesPlantHydraulicsMod, only : InitHydrCohort use FatesInterfaceTypesMod, only : nlevsclass use FatesInterfaceTypesMod, only : nlevdamage use FatesLitterMod, only : litter_type - use FatesLitterMod, only : ncwd + use FatesLitterMod, only : ncwd, nfsc use FatesLitterMod, only : ndcmpy - use EDTypesMod, only : nfsc, nlevleaf, area + use EDTypesMod, only : area + use EDParamsMod, only : nlevleaf use PRTGenericMod, only : prt_global use PRTGenericMod, only : num_elements use FatesRunningMeanMod, only : rmean_type @@ -1903,13 +1900,12 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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 - use EDTypesMod, only : maxSWb - use EDTypesMod, only : nclmax + use FatesCohortMod, only : fates_cohort_type + use FatesPatchMod, only : fates_patch_type + use EDParamsMod, only : maxSWb + use EDParamsMod, only : nclmax use EDTypesMod, only : numWaterMem use EDTypesMod, only : num_vegtemp_mem - use EDTypesMod, only : maxpft use FatesInterfaceTypesMod, only : nlevdamage ! Arguments @@ -1976,8 +1972,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: icdj ! loop counter for damage type(fates_restart_variable_type) :: rvar - type(ed_patch_type),pointer :: cpatch - type(ed_cohort_type),pointer :: ccohort + type(fates_patch_type),pointer :: cpatch + type(fates_cohort_type),pointer :: ccohort associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & @@ -2643,18 +2639,15 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) ! --------------------------------------------------------------------------------- use EDTypesMod, only : ed_site_type - use EDTypesMod, only : ed_cohort_type - use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : maxSWb + use FatesCohortMod, only : fates_cohort_type + use FatesPatchMod, only : fates_patch_type + use EDParamsMod, only : maxSWb, regeneration_model use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch + use FatesInterfaceTypesMod, only : hlm_current_tod, hlm_numSWb, numpft - use EDTypesMod, only : maxpft use EDTypesMod, only : area - use EDPatchDynamicsMod, only : zero_patch use EDInitMod, only : zero_site use EDInitMod, only : init_site_vars - use EDPatchDynamicsMod, only : create_patch - use EDPftvarcon, only : EDPftvarcon_inst use FatesAllometryMod, only : h2d_allom @@ -2668,9 +2661,9 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) ! local variables - type(ed_patch_type) , pointer :: newp - type(ed_cohort_type), pointer :: new_cohort - type(ed_cohort_type), pointer :: prev_cohort + type(fates_patch_type) , pointer :: newp + type(fates_cohort_type), pointer :: new_cohort + type(fates_cohort_type), pointer :: prev_cohort integer :: cohortstatus integer :: s ! site index integer :: idx_pa ! local patch index @@ -2721,7 +2714,9 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) nocomp_pft = fates_unset_int ! the nocomp_pft label is set after patch creation has occured in 'get_restart_vectors' ! make new patch - call create_patch(sites(s), newp, fates_unset_r8, fates_unset_r8, primaryforest, nocomp_pft ) + call newp%Create(fates_unset_r8, fates_unset_r8, primaryforest, & + nocomp_pft, hlm_numSWb, numpft, sites(s)%nlevsoil, & + hlm_current_tod, regeneration_model) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches @@ -2751,9 +2746,8 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) do fto = 1, rio_ncohort_pa( io_idx_co_1st ) allocate(new_cohort) - call nan_cohort(new_cohort) - call zero_cohort(new_cohort) - new_cohort%patchptr => newp + call new_cohort%NanValues() + call new_cohort%ZeroValues() ! If this is the first in the list, it is tallest if (.not.associated(newp%tallest)) then @@ -2843,14 +2837,13 @@ end subroutine create_patchcohort_structure subroutine get_restart_vectors(this, nc, nsites, sites) use EDTypesMod, only : ed_site_type - use EDTypesMod, only : ed_cohort_type - use EDTypesMod, only : ed_patch_type - use EDTypesMod, only : maxSWb - use EDTypesMod, only : nclmax + use FatesCohortMod, only : fates_cohort_type + use FatesPatchMod, only : fates_patch_type + use EDParamsMod, only : maxSWb + use EDParamsMod, only : nclmax use FatesInterfaceTypesMod, only : numpft use FatesInterfaceTypesMod, only : fates_maxElementsPerPatch use EDTypesMod, only : numWaterMem - use EDTypesMod, only : maxpft use EDTypesMod, only : num_vegtemp_mem use FatesSizeAgeTypeIndicesMod, only : get_age_class_index @@ -2864,8 +2857,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! locals ! ---------------------------------------------------------------------------------- ! LL pointers - type(ed_patch_type),pointer :: cpatch ! current patch - type(ed_cohort_type),pointer :: ccohort ! current cohort + type(fates_patch_type),pointer :: cpatch ! current patch + type(fates_cohort_type),pointer :: ccohort ! current cohort type(litter_type), pointer :: litt ! litter object on the current patch ! loop indices integer :: s, i, j, k, pft @@ -3251,8 +3244,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%efstem_coh = rio_efstem_co(io_idx_co) ccohort%isnew = ( rio_isnew_co(io_idx_co) .eq. new_cohort ) - call InitPRTBoundaryConditions(ccohort) - call UpdateCohortBioPhysRates(ccohort) + call ccohort%InitPRTBoundaryConditions() + call ccohort%UpdateCohortBioPhysRates() ! Initialize Plant Hydraulics @@ -3568,7 +3561,7 @@ subroutine update_3dpatch_radiation(this, nsites, sites, bc_out) ! ------------------------------------------------------------------------- use EDTypesMod, only : ed_site_type - use EDTypesMod, only : ed_patch_type + use FatesPatchMod, only : fates_patch_type use EDSurfaceRadiationMod, only : PatchNormanRadiation use FatesInterfaceTypesMod, only : hlm_numSWb @@ -3580,7 +3573,7 @@ subroutine update_3dpatch_radiation(this, nsites, sites, bc_out) ! locals ! ---------------------------------------------------------------------------------- - type(ed_patch_type),pointer :: currentPatch ! current patch + type(fates_patch_type),pointer :: currentPatch ! current patch integer :: s ! site counter integer :: ib ! radiation band counter integer :: ifp ! patch counter diff --git a/main/FatesSizeAgeTypeIndicesMod.F90 b/main/FatesSizeAgeTypeIndicesMod.F90 index 75eef6b6ad..7945bef035 100644 --- a/main/FatesSizeAgeTypeIndicesMod.F90 +++ b/main/FatesSizeAgeTypeIndicesMod.F90 @@ -6,7 +6,7 @@ module FatesSizeAgeTypeIndicesMod use FatesInterfaceTypesMod, only : nlevage use FatesInterfaceTypesMod, only : nlevheight use FatesInterfaceTypesMod, only : nlevcoage - use EDTypesMod, only : nclmax + use EDParamsMod, only : nclmax use FatesInterfaceTypesMod, only : nlevdamage use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index b97bfe68cd..ec29fff40a 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -61,11 +61,12 @@ module PRTAllometricCNPMod use FatesConstantsMod , only : TRS_no_seedling_dyn use FatesConstantsMod , only : min_max_dbh_for_trees use PRTParametersMod , only : prt_params - use EDTypesMod , only : leaves_on,leaves_off,leaves_shedding - use EDTypesMod , only : p_uptake_mode - use EDTypesMod , only : n_uptake_mode - use FatesConstantsMod , only : prescribed_p_uptake - use FatesConstantsMod , only : prescribed_n_uptake + use FatesConstantsMod , only : leaves_on,leaves_off + use FatesConstantsMod , only : leaves_shedding + use EDParamsMod , only : p_uptake_mode + use EDParamsMod , only : n_uptake_mode + use FatesConstantsMod , only : prescribed_p_uptake + use FatesConstantsMod , only : prescribed_n_uptake use EDPftvarcon, only : EDPftvarcon_inst use EDParamsMod , only : regeneration_model @@ -726,9 +727,6 @@ end function SafeLog subroutine CNPAdjustFRootTargets(this, target_c, target_dcdd) - use FatesInterfaceTypesMod , only : hlm_day_of_year - use FatesInterfaceTypesMod , only : hlm_current_year - class(cnp_allom_prt_vartypes) :: this real(r8) :: target_c(:) real(r8) :: target_dcdd(:) @@ -2557,6 +2555,4 @@ subroutine EstimateGrowthNC(this,target_c,target_dcdd,state_mask,avg_nc,avg_pc) return end subroutine EstimateGrowthNC - - end module PRTAllometricCNPMod diff --git a/parteh/PRTAllometricCarbonMod.F90 b/parteh/PRTAllometricCarbonMod.F90 index a9b3ea2ab8..c16d3541e6 100644 --- a/parteh/PRTAllometricCarbonMod.F90 +++ b/parteh/PRTAllometricCarbonMod.F90 @@ -58,11 +58,11 @@ module PRTAllometricCarbonMod use PRTParametersMod , only : prt_params use EDParamsMod , only : regeneration_model - use EDTypesMod , only : leaves_on - use EDTypesMod , only : leaves_off - use EDTypesMod , only : leaves_shedding - use EDTypesMod , only : ihard_stress_decid - use EDTypesMod , only : isemi_stress_decid + use FatesConstantsMod , only : leaves_on + use FatesConstantsMod , only : leaves_off + use FatesConstantsMod , only : leaves_shedding + use FatesConstantsMod , only : ihard_stress_decid + use FatesConstantsMod , only : isemi_stress_decid implicit none private @@ -1266,6 +1266,6 @@ subroutine FastPRTAllometricCarbon(this) return end subroutine FastPRTAllometricCarbon - + end module PRTAllometricCarbonMod diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 9390c0825c..098b1e3738 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -32,7 +32,7 @@ module PRTInitParamsFatesMod use FatesAllometryMod, only : set_root_fraction use PRTGenericMod, only : StorageNutrientTarget use EDTypesMod, only : init_recruit_trim - use EDTypesMod, only : ihard_stress_decid, isemi_stress_decid + use FatesConstantsMod, only : ihard_stress_decid, isemi_stress_decid ! ! !PUBLIC TYPES: