Reverting bc_in_ptr and bc_out_ptr, because nag.

NGEET · May 25, 2021 · 0f7b617 · 0f7b617
1 parent b77a0d5
commit 0f7b617
Show file tree

Hide file tree

Showing 12 changed files with 52 additions and 59 deletions.
diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90
@@ -197,25 +197,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)
 
 
             ! ---------------------------------------------------------------------------------------
@@ -234,12 +234,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
 
@@ -332,7 +332,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
@@ -341,7 +341,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
@@ -720,7 +721,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
@@ -695,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      
@@ -708,6 +708,7 @@ 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
@@ -824,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
@@ -858,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
@@ -881,7 +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
 
@@ -906,7 +909,7 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant)
     plant_dens = nplant/cpatch%area
 
     call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, &
-         csite%bc_in_ptr%max_rooting_depth_index_col)
+         bc_in%max_rooting_depth_index_col)
 
     do el=1,num_elements
 

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,7 @@ 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:
@@ -570,7 +572,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site
 
             call set_root_fraction(currentSite%rootfrac_scr, pft, &
                  currentSite%zi_soil, &
-                 currentSite%bc_in_ptr%max_rooting_depth_index_col)
+                 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

diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90
@@ -661,13 +661,13 @@ subroutine spawn_patches( currentSite, bc_in)
 
              if(currentPatch%disturbance_mode .eq. dtype_ilog) then
                 call logging_litter_fluxes(currentSite, currentPatch, &
-                     new_patch, patch_site_areadis)
+                     new_patch, patch_site_areadis,bc_in)
              elseif(currentPatch%disturbance_mode .eq. dtype_ifire) then
                 call fire_litter_fluxes(currentSite, currentPatch, &
-                     new_patch, patch_site_areadis)  
+                     new_patch, patch_site_areadis,bc_in)  
              else
                 call mortality_litter_fluxes(currentSite, currentPatch, &
-                     new_patch, patch_site_areadis)
+                     new_patch, patch_site_areadis,bc_in)
              endif
 
              ! --------------------------------------------------------------------------
@@ -1083,9 +1083,9 @@ subroutine spawn_patches( currentSite, bc_in)
              ! the first call to terminate cohorts removes sparse number densities,
              ! the second call removes for all other reasons (sparse culling must happen
              ! before fusion)
-             call terminate_cohorts(currentSite, currentPatch, 1,16)
+             call terminate_cohorts(currentSite, currentPatch, 1,16,bc_in)
              call fuse_cohorts(currentSite,currentPatch, bc_in)
-             call terminate_cohorts(currentSite, currentPatch, 2,16)
+             call terminate_cohorts(currentSite, currentPatch, 2,16,bc_in)
              call sort_cohorts(currentPatch)
 
           end if    ! if ( new_patch%area > nearzero ) then 
@@ -1157,16 +1157,16 @@ subroutine spawn_patches( currentSite, bc_in)
        ! before fusion)
 
        if ( site_areadis_primary .gt. nearzero) then
-          call terminate_cohorts(currentSite, new_patch_primary, 1,17)
+          call terminate_cohorts(currentSite, new_patch_primary, 1,17, bc_in)
           call fuse_cohorts(currentSite,new_patch_primary, bc_in)
-          call terminate_cohorts(currentSite, new_patch_primary, 2,17)
+          call terminate_cohorts(currentSite, new_patch_primary, 2,17, bc_in)
           call sort_cohorts(new_patch_primary)
        endif
 
        if ( site_areadis_secondary .gt. nearzero) then
-          call terminate_cohorts(currentSite, new_patch_secondary, 1,18)
+          call terminate_cohorts(currentSite, new_patch_secondary, 1,18,bc_in)
           call fuse_cohorts(currentSite,new_patch_secondary, bc_in)
-          call terminate_cohorts(currentSite, new_patch_secondary, 2,18)
+          call terminate_cohorts(currentSite, new_patch_secondary, 2,18,bc_in)
           call sort_cohorts(new_patch_secondary)
        endif
 
@@ -1526,7 +1526,7 @@ end subroutine TransLitterNewPatch
   ! ============================================================================
 
   subroutine fire_litter_fluxes(currentSite, currentPatch, &
-       newPatch, patch_site_areadis)
+       newPatch, patch_site_areadis, bc_in)
     !
     ! !DESCRIPTION:
     !  CWD pool burned by a fire. 
@@ -1545,6 +1545,8 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, &
     type(ed_patch_type) , intent(inout), target :: currentPatch   ! Donor Patch
     type(ed_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:
 
@@ -1674,7 +1676,7 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, &
              site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass
 
              call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
-                  currentSite%bc_in_ptr%max_rooting_depth_index_col)
+                  bc_in%max_rooting_depth_index_col)
 
              ! Contribution of dead trees to root litter (no root burn flux to atm)
              do dcmpy=1,ndcmpy
@@ -1747,7 +1749,7 @@ end subroutine fire_litter_fluxes
   ! ============================================================================
 
   subroutine mortality_litter_fluxes(currentSite, currentPatch, &
-       newPatch, patch_site_areadis)
+       newPatch, patch_site_areadis,bc_in)
     !
     ! !DESCRIPTION:
     ! Carbon going from mortality associated with disturbance into CWD pools. 
@@ -1769,6 +1771,7 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, &
     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
@@ -1884,7 +1887,7 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, &
           bg_wood = num_dead * (struct_m + sapw_m) * (1.0_r8-prt_params%allom_agb_frac(pft))
 
           call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
-               currentSite%bc_in_ptr%max_rooting_depth_index_col)
+               bc_in%max_rooting_depth_index_col)
 
 
           do c=1,ncwd

diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90
@@ -236,7 +236,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in )
        ! Send fluxes from newly created litter into the litter pools
        ! This litter flux is from non-disturbance inducing mortality, as well
        ! as litter fluxes from live trees
-       call CWDInput(currentSite, currentPatch, litt)
+       call CWDInput(currentSite, currentPatch, litt,bc_in)
 
 
        ! Only calculate fragmentation flux over layers that are active
@@ -1876,7 +1876,7 @@ end subroutine recruitment
 
   ! ============================================================================
 
-  subroutine CWDInput( currentSite, currentPatch, litt)
+  subroutine CWDInput( currentSite, currentPatch, litt, bc_in)
 
     !
     ! !DESCRIPTION:
@@ -1894,7 +1894,7 @@ subroutine CWDInput( currentSite, currentPatch, litt)
     type(ed_site_type), intent(inout), target :: currentSite
     type(ed_patch_type),intent(inout), target :: currentPatch
     type(litter_type),intent(inout),target    :: litt
-
+    type(bc_in_type),intent(in)               :: bc_in
 
     !
     ! !LOCAL VARIABLES:
@@ -1954,7 +1954,7 @@ subroutine CWDInput( currentSite, currentPatch, litt)
       pft = currentCohort%pft        
 
       call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, &
-           currentSite%bc_in_ptr%max_rooting_depth_index_col)
+           bc_in%max_rooting_depth_index_col)
 
       leaf_m_turnover   = currentCohort%prt%GetTurnover(leaf_organ,element_id)
       store_m_turnover  = currentCohort%prt%GetTurnover(store_organ,element_id)

diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90
@@ -417,7 +417,7 @@ end subroutine UnPackNutrientAquisitionBCs
 
   ! =====================================================================================
 
-  subroutine PrepCH4BCs(csite)
+  subroutine PrepCH4BCs(csite,bc_in,bc_out)
 
     !
     ! This routine prepares the output boundary conditions for methane calculations
@@ -428,8 +428,8 @@ subroutine PrepCH4BCs(csite)
     ! !ARGUMENTS    
     type(ed_site_type), intent(inout) :: csite
 
-    type(bc_out_type), pointer    :: bc_out
-    type(bc_in_type), pointer     :: bc_in
+    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
     integer                       :: pft           ! plant functional type
@@ -449,9 +449,6 @@ subroutine PrepCH4BCs(csite)
     ! Exit if we need not communicate with the hlm's ch4 module
     if(.not.(hlm_use_ch4==itrue)) return
 
-    bc_out => csite%bc_out_ptr
-    bc_in  => csite%bc_in_ptr
-
     ! Initialize to zero
     bc_out%annavg_agnpp_pa(:) = 0._r8
     bc_out%annavg_bgnpp_pa(:) = 0._r8

diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90
@@ -140,7 +140,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out)
               do ft = 1,numpft
 
                   call set_root_fraction(sites(s)%rootfrac_scr, ft, sites(s)%zi_soil, &
-                       sites(s)%bc_in_ptr%max_rooting_depth_index_col ) 
+                       bc_in(s)%max_rooting_depth_index_col ) 
 
                  cpatch%btran_ft(ft) = 0.0_r8
                  do j = 1,bc_in(s)%nlevsoil

diff --git a/biogeophys/FatesBstressMod.F90 b/biogeophys/FatesBstressMod.F90
@@ -68,7 +68,7 @@ subroutine btran_sal_stress_fates( nsites, sites, bc_in)
 
                  call set_root_fraction(sites(s)%rootfrac_scr, ft, &
                       sites(s)%zi_soil, &
-                      sites(s)%bc_in_ptr%max_rooting_depth_index_col )
+                      bc_in(s)%max_rooting_depth_index_col )
 
                  do j = 1,bc_in(s)%nlevsoil
 

diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90
@@ -145,9 +145,6 @@ subroutine init_site_vars( site_in, bc_in, bc_out )
     site_in%dz_soil(:) = bc_in%dz_sisl(:)
     site_in%z_soil(:)  = bc_in%z_sisl(:)
 
-    site_in%bc_in_ptr => bc_in
-    site_in%bc_out_ptr => bc_out
-
     !
     end subroutine init_site_vars