Merge pull request #716 from rgknox/parteh-scaling-fixes

Parteh scaling fixes
NGEET · May 26, 2021 · 1723d14 · 1723d14
2 parents 516c184 + 0f7b617
commit 1723d14
Show file tree

Hide file tree

Showing 28 changed files with 1,787 additions and 1,048 deletions.
diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90
@@ -196,25 +196,25 @@ subroutine canopy_structure( currentSite , bc_in )
 
             ! Its possible that before we even enter this scheme
             ! some cohort numbers are very low.  Terminate them.
-            call terminate_cohorts(currentSite, currentPatch, 1, 12)
+            call terminate_cohorts(currentSite, currentPatch, 1, 12, bc_in)
 
             ! Calculate how many layers we have in this canopy
             ! This also checks the understory to see if its crown 
             ! area is large enough to warrant a temporary sub-understory layer
             z = NumPotentialCanopyLayers(currentPatch,currentSite%spread,include_substory=.false.)
 
             do i_lyr = 1,z ! Loop around the currently occupied canopy layers. 
-               call DemoteFromLayer(currentSite, currentPatch, i_lyr)
+               call DemoteFromLayer(currentSite, currentPatch, i_lyr, bc_in)
             end do
 
             ! After demotions, we may then again have cohorts that are very very
             ! very sparse, remove them
-            call terminate_cohorts(currentSite, currentPatch, 1,13)
+            call terminate_cohorts(currentSite, currentPatch, 1,13,bc_in)
 
             call fuse_cohorts(currentSite, currentPatch, bc_in)
 
             ! Remove cohorts for various other reasons
-            call terminate_cohorts(currentSite, currentPatch, 2,13)
+            call terminate_cohorts(currentSite, currentPatch, 2,13,bc_in)
 
 
             ! ---------------------------------------------------------------------------------------
@@ -233,12 +233,12 @@ subroutine canopy_structure( currentSite , bc_in )
                end do
 
                ! Remove cohorts that are incredibly sparse
-               call terminate_cohorts(currentSite, currentPatch, 1,14)
+               call terminate_cohorts(currentSite, currentPatch, 1,14,bc_in)
 
                call fuse_cohorts(currentSite, currentPatch, bc_in)
 
                ! Remove cohorts for various other reasons
-               call terminate_cohorts(currentSite, currentPatch, 2,14)
+               call terminate_cohorts(currentSite, currentPatch, 2,14,bc_in)
 
             end if
 
@@ -331,7 +331,7 @@ end subroutine canopy_structure
    ! ==============================================================================================
 
 
-   subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr)
+   subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in)
 
       use EDParamsMod, only : ED_val_comp_excln
       use SFParamsMod, only : SF_val_CWD_frac
@@ -340,7 +340,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr)
       type(ed_site_type), intent(inout), target  :: currentSite
       type(ed_patch_type), intent(inout), target :: 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
@@ -719,7 +720,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr)
                   ! put the litter from the terminated cohorts 
                   ! straight into the fragmenting pools
                   call SendCohortToLitter(currentSite,currentPatch, &
-                       currentCohort,currentCohort%n)
+                       currentCohort,currentCohort%n,bc_in)
 
                   currentCohort%n            = 0.0_r8
                   currentCohort%c_area       = 0.0_r8

diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90
@@ -91,11 +91,11 @@ module EDCohortDynamicsMod
   use PRTAllometricCNPMod,    only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim
   use PRTAllometricCNPMod,    only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh
   use PRTAllometricCNPMod,    only : acnp_bc_inout_id_rmaint_def, acnp_bc_in_id_netdc
-  use PRTAllometricCNPMod,    only : acnp_bc_in_id_netdn, acnp_bc_in_id_netdp
+  use PRTAllometricCNPMod,    only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp
   use PRTAllometricCNPMod,    only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux
   use PRTAllometricCNPMod,    only : acnp_bc_out_id_pefflux
-  use PRTAllometricCNPMod,    only : acnp_bc_out_id_ngrow,acnp_bc_out_id_nmax
-  use PRTAllometricCNPMod,    only : acnp_bc_out_id_pgrow,acnp_bc_out_id_pmax
+  use PRTAllometricCNPMod,    only : acnp_bc_out_id_nneed
+  use PRTAllometricCNPMod,    only : acnp_bc_out_id_pneed
 
 
   use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)  
@@ -400,7 +400,8 @@ subroutine InitPRTBoundaryConditions(new_cohort)
        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_netdc, bc_rval = new_cohort%npp_acc)
-       call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdn, bc_rval = new_cohort%daily_n_uptake)
+       call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdnh4, bc_rval = new_cohort%daily_nh4_uptake)
+       call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdno3, bc_rval = new_cohort%daily_no3_uptake)
        call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdp, bc_rval = new_cohort%daily_p_uptake)
 
        call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh)
@@ -409,10 +410,8 @@ subroutine InitPRTBoundaryConditions(new_cohort)
        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_ngrow, bc_rval = new_cohort%daily_n_need1)
-       call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nmax, bc_rval = new_cohort%daily_n_need2)
-       call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pgrow, bc_rval = new_cohort%daily_p_need1)
-       call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pmax, bc_rval = new_cohort%daily_p_need2)
+       call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nneed, bc_rval = new_cohort%daily_n_need)
+       call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pneed, bc_rval = new_cohort%daily_p_need)
 
 
     case DEFAULT
@@ -559,15 +558,14 @@ subroutine nan_cohort(cc_p)
     currentCohort%resp_acc           = nan ! RESP: kGC/cohort/day
 
     ! Fluxes from nutrient allocation
-    currentCohort%daily_n_uptake = nan
+    currentCohort%daily_nh4_uptake = nan
+    currentCohort%daily_no3_uptake = nan
     currentCohort%daily_p_uptake = nan
     currentCohort%daily_c_efflux = nan
     currentCohort%daily_n_efflux = nan
     currentCohort%daily_p_efflux = nan
-    currentCohort%daily_n_need1 = nan
-    currentCohort%daily_n_need2 = nan
-    currentCohort%daily_p_need1 = nan
-    currentCohort%daily_p_need2 = nan
+    currentCohort%daily_n_need   = nan
+    currentCohort%daily_p_need   = nan
     currentCohort%daily_n_demand = nan
     currentCohort%daily_p_demand = nan
 
@@ -678,17 +676,16 @@ subroutine zero_cohort(cc_p)
     ! after allocation. These variables exist in
     ! carbon-only mode but are not used.
 
-    currentCohort%daily_n_uptake = 0._r8
+    currentCohort%daily_nh4_uptake = 0._r8
+    currentCohort%daily_no3_uptake = 0._r8
     currentCohort%daily_p_uptake = 0._r8
 
     currentCohort%daily_c_efflux = 0._r8
     currentCohort%daily_n_efflux = 0._r8
     currentCohort%daily_p_efflux = 0._r8
 
-    currentCohort%daily_n_need1 = 0._r8
-    currentCohort%daily_n_need2 = 0._r8
-    currentCohort%daily_p_need1 = 0._r8
-    currentCohort%daily_p_need2 = 0._r8
+    currentCohort%daily_n_need = 0._r8
+    currentCohort%daily_p_need = 0._r8
 
     ! Initialize these as negative
     currentCohort%daily_p_demand = -9._r8
@@ -698,7 +695,7 @@ subroutine zero_cohort(cc_p)
   end subroutine zero_cohort
 
   !-------------------------------------------------------------------------------------!
-  subroutine terminate_cohorts( currentSite, currentPatch, level , call_index)
+  subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_in)
     !
     ! !DESCRIPTION:
     ! terminates cohorts when they get too small      
@@ -711,7 +708,8 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index)
     type (ed_patch_type), intent(inout), target :: currentPatch
     integer             , intent(in)            :: level
     integer                                     :: call_index
-
+    type(bc_in_type), intent(in)                :: bc_in
+
     ! Important point regarding termination levels.  Termination is typically
     ! called after fusion.  We do this so that we can re-capture the biomass that would
     ! otherwise be lost from termination.  The biomass of a fused plant remains in the
@@ -827,7 +825,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index)
 
           if (currentCohort%n.gt.0.0_r8) then
              call SendCohortToLitter(currentSite,currentPatch, &
-                  currentCohort,currentCohort%n)
+                  currentCohort,currentCohort%n,bc_in)
           end if
 
           ! Set pointers and remove the current cohort from the list
@@ -861,7 +859,7 @@ end subroutine terminate_cohorts
 
   ! =====================================================================================
 
-  subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant)
+  subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in)
 
     ! -----------------------------------------------------------------------------------
     ! This routine transfers the existing mass in all pools and all elements
@@ -884,9 +882,9 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant)
     type (ed_patch_type)  , target  :: cpatch
     type (ed_cohort_type) , target  :: ccohort
     real(r8)                        :: nplant     ! Number (absolute)
-                                                  ! of plants to transfer
+    ! of plants to transfer
+    type(bc_in_type), intent(in)    :: bc_in
 
-    !
     type(litter_type), pointer        :: litt       ! Litter object for each element
     type(site_fluxdiags_type),pointer :: flux_diags
 
@@ -910,7 +908,8 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant)
 
     plant_dens = nplant/cpatch%area
 
-    call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil)
+    call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, &
+         bc_in%max_rooting_depth_index_col)
 
     do el=1,num_elements
 
@@ -1396,8 +1395,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in)
                                       currentCohort%frmort = (currentCohort%n*currentCohort%frmort + nextc%n*nextc%frmort)/newn
 
                                       ! Nutrient fluxes
-                                      currentCohort%daily_n_uptake = (currentCohort%n*currentCohort%daily_n_uptake + & 
-                                           nextc%n*nextc%daily_n_uptake)/newn
+                                      currentCohort%daily_nh4_uptake = (currentCohort%n*currentCohort%daily_nh4_uptake + & 
+                                           nextc%n*nextc%daily_nh4_uptake)/newn
+                                      currentCohort%daily_no3_uptake = (currentCohort%n*currentCohort%daily_no3_uptake + & 
+                                           nextc%n*nextc%daily_no3_uptake)/newn
                                       currentCohort%daily_p_uptake = (currentCohort%n*currentCohort%daily_p_uptake + & 
                                            nextc%n*nextc%daily_p_uptake)/newn
 
@@ -1413,15 +1414,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in)
                                       currentCohort%daily_p_efflux = (currentCohort%n*currentCohort%daily_p_efflux + & 
                                            nextc%n*nextc%daily_p_efflux)/newn
 
-                                      currentCohort%daily_n_need1 = (currentCohort%n*currentCohort%daily_n_need1 + & 
-                                           nextc%n*nextc%daily_n_need1)/newn
-                                      currentCohort%daily_n_need2 = (currentCohort%n*currentCohort%daily_n_need2 + & 
-                                           nextc%n*nextc%daily_n_need2)/newn
-                                      currentCohort%daily_p_need1 = (currentCohort%n*currentCohort%daily_p_need1 + & 
-                                           nextc%n*nextc%daily_p_need1)/newn
-                                      currentCohort%daily_p_need2 = (currentCohort%n*currentCohort%daily_p_need2 + & 
-                                           nextc%n*nextc%daily_p_need2)/newn
-
+                                      currentCohort%daily_n_need = (currentCohort%n*currentCohort%daily_n_need + & 
+                                           nextc%n*nextc%daily_n_need)/newn
+                                      currentCohort%daily_p_need = (currentCohort%n*currentCohort%daily_p_need + & 
+                                           nextc%n*nextc%daily_p_need)/newn
 
 
                                       ! logging mortality, Yi Xu
@@ -1817,15 +1813,14 @@ subroutine copy_cohort( currentCohort,copyc )
     n%year_net_uptake = o%year_net_uptake
     n%ts_net_uptake   = o%ts_net_uptake
 
-    n%daily_n_uptake = o%daily_n_uptake
+    n%daily_nh4_uptake = o%daily_nh4_uptake
+    n%daily_no3_uptake = o%daily_no3_uptake
     n%daily_p_uptake = o%daily_p_uptake
     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_need1 = o%daily_n_need1
-    n%daily_n_need2 = o%daily_n_need2
-    n%daily_p_need1 = o%daily_p_need1
-    n%daily_p_need2 = o%daily_p_need2
+    n%daily_n_need   = o%daily_n_need
+    n%daily_p_need   = o%daily_p_need
     n%daily_n_demand = o%daily_n_demand
     n%daily_p_demand = o%daily_p_demand
 

diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90
@@ -40,6 +40,7 @@ module EDLoggingMortalityMod
    use EDParamsMod       , only : logging_mechanical_frac 
    use EDParamsMod       , only : logging_coll_under_frac 
    use EDParamsMod       , only : logging_dbhmax_infra
+   use FatesInterfaceTypesMod , only : bc_in_type
    use FatesInterfaceTypesMod , only : hlm_current_year
    use FatesInterfaceTypesMod , only : hlm_current_month
    use FatesInterfaceTypesMod , only : hlm_current_day
@@ -394,7 +395,7 @@ end subroutine get_harvest_rate_area
 
    ! ============================================================================
 
-   subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis)
+   subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis, bc_in)
 
       ! -------------------------------------------------------------------------------------------
       !
@@ -440,6 +441,8 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
       type(ed_patch_type) , intent(inout), target  :: currentPatch
       type(ed_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
@@ -567,7 +570,9 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
             ! derived from the current patch, so we need to multiply by patch_areadis/np%area
             ! ----------------------------------------------------------------------------------------
 
-            call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil)
+            call set_root_fraction(currentSite%rootfrac_scr, pft, &
+                 currentSite%zi_soil, &
+                 bc_in%max_rooting_depth_index_col)
 
             ag_wood = (direct_dead+indirect_dead) * (struct_m + sapw_m ) * &
                   prt_params%allom_agb_frac(currentCohort%pft)

diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90
@@ -19,7 +19,6 @@ module EDMortalityFunctionsMod
    use FatesInterfaceTypesMod     , only : hlm_use_planthydro
    use EDLoggingMortalityMod , only : LoggingMortality_frac
    use EDParamsMod           , only : fates_mortality_disturbance_fraction
-   use FatesInterfaceTypesMod     , only : bc_in_type
 
    use PRTGenericMod,          only : all_carbon_elements
    use PRTGenericMod,          only : store_organ