Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

cleaning up nocomp patch indexing #1226

Open
wants to merge 8 commits into
base: main
Choose a base branch
from
16 changes: 6 additions & 10 deletions biogeochem/EDCanopyStructureMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ module EDCanopyStructureMod
use FatesAllometryMod , only : tree_lai
use FatesAllometryMod , only : tree_sai
use EDTypesMod , only : ed_site_type
use EDTypesMod , only : set_patchno
use FatesAllometryMod , only : VegAreaLayer
use FatesAllometryMod , only : CrownDepth
use FatesPatchMod, only : fates_patch_type
Expand Down Expand Up @@ -1314,7 +1315,6 @@ subroutine canopy_summarization( nsites, sites, bc_in )
! ---------------------------------------------------------------------------------

use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking
use EDPatchDynamicsMod , only : set_patchno
use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index
use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index
use EDtypesMod , only : area
Expand Down Expand Up @@ -1351,7 +1351,7 @@ subroutine canopy_summarization( nsites, sites, bc_in )
! driving model. Loops through all patches and sets cpatch%patchno to the integer
! order of oldest to youngest where the oldest is 1.
! --------------------------------------------------------------------------------
call set_patchno( sites(s) )
call set_patchno( sites(s) , .false., 0)

currentPatch => sites(s)%oldest_patch

Expand Down Expand Up @@ -1897,7 +1897,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out)

do s = 1,nsites

ifp = 0
total_patch_area = 0._r8
total_canopy_area = 0._r8
bc_out(s)%canopy_fraction_pa(:) = 0._r8
Expand All @@ -1909,9 +1908,8 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out)
c = fcolumn(s)
do while(associated(currentPatch))

if(currentPatch%nocomp_pft_label.ne.nocomp_bareground)then ! ignore the bare-ground-PFT patch entirely for these BC outs

ifp = ifp+1
ifp = currentPatch%patchno
if_bare: if(currentPatch%nocomp_pft_label.ne.nocomp_bareground)then ! ignore the bare-ground-PFT patch entirely for these BC outs

if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then
if(debug)then
Expand Down Expand Up @@ -2029,7 +2027,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out)

total_patch_area = total_patch_area + currentPatch%area/AREA

end if
end if if_bare
currentPatch => currentPatch%younger
end do

Expand All @@ -2049,13 +2047,11 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out)
end if

currentPatch => sites(s)%oldest_patch
ifp = 0
do while(associated(currentPatch))
ifp = currentPatch%patchno
if(currentPatch%nocomp_pft_label.ne.nocomp_bareground)then ! for vegetated patches only
ifp = ifp+1
bc_out(s)%canopy_fraction_pa(ifp) = bc_out(s)%canopy_fraction_pa(ifp)/total_patch_area
endif ! veg patch

currentPatch => currentPatch%younger
end do

Expand Down
50 changes: 5 additions & 45 deletions biogeochem/EDPatchDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,8 @@ module EDPatchDynamicsMod
use FatesConstantsMod , only : patchfusion_dbhbin_loweredges
use EDtypesMod , only : force_patchfuse_min_biomass
use EDTypesMod , only : ed_site_type
use FatesPatchMod, only : fates_patch_type
use FatesPatchMod , only : fates_patch_type
use EDTypesMod , only : set_patchno
use FatesCohortMod , only : fates_cohort_type
use EDTypesMod , only : site_massbal_type
use EDTypesMod , only : site_fluxdiags_type
Expand Down Expand Up @@ -124,7 +125,6 @@ module EDPatchDynamicsMod
public :: patch_pft_size_profile
public :: disturbance_rates
public :: check_patch_area
public :: set_patchno
private:: fuse_2_patches

character(len=*), parameter, private :: sourcefile = &
Expand Down Expand Up @@ -1357,7 +1357,7 @@ subroutine spawn_patches( currentSite, bc_in)


call check_patch_area(currentSite)
call set_patchno(currentSite)
call set_patchno(currentSite,.false.,0)

end do landusechange_receiverpatchlabel_loop
end do landuse_donortype_loop
Expand Down Expand Up @@ -1868,48 +1868,6 @@ subroutine check_patch_area( currentSite )
return
end subroutine check_patch_area

! ============================================================================
subroutine set_patchno( currentSite )
!
! !DESCRIPTION:
! Give patches an order number from the oldest to youngest.
!
! !USES:
!
! !ARGUMENTS:
type(ed_site_type),intent(in) :: currentSite
!
! !LOCAL VARIABLES:
type(fates_patch_type), pointer :: currentPatch
integer patchno
!---------------------------------------------------------------------

patchno = 1
currentPatch => currentSite%oldest_patch
do while(associated(currentPatch))
currentPatch%patchno = patchno
patchno = patchno + 1
currentPatch => currentPatch%younger
enddo

if(hlm_use_fixed_biogeog.eq.itrue .and. hlm_use_nocomp.eq.itrue)then
patchno = 1
currentPatch => currentSite%oldest_patch
do while(associated(currentPatch))
if(currentPatch%nocomp_pft_label.eq.nocomp_bareground)then
! for bareground patch, we make the patch number 0
! we also do not count this in the veg. patch numbering scheme.
currentPatch%patchno = 0
else
currentPatch%patchno = patchno
patchno = patchno + 1
endif
currentPatch => currentPatch%younger
enddo
endif

end subroutine set_patchno

! ============================================================================

subroutine TransLitterNewPatch(currentSite, &
Expand Down Expand Up @@ -3677,6 +3635,8 @@ subroutine terminate_patches(currentSite, bc_in)
!check area is not exceeded
call check_patch_area( currentSite )

call set_patchno( currentSite, .false., 0)

return
end subroutine terminate_patches

Expand Down
29 changes: 16 additions & 13 deletions biogeochem/EDPhysiologyMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -639,8 +639,6 @@ subroutine trim_canopy( currentSite )
real(r8) :: cumulative_lai_cohort ! cumulative LAI within the current cohort only

! Temporary diagnostic ouptut
integer :: ipatch
integer :: icohort

! LAPACK linear least squares fit variables
! The standard equation for a linear fit, y = mx + b, is converted to a linear system, AX=B and has
Expand Down Expand Up @@ -674,19 +672,14 @@ subroutine trim_canopy( currentSite )
real(r8) :: leaf_long ! temporary leaf lifespan before accounting for deciduousness
!----------------------------------------------------------------------

ipatch = 1 ! Start counting patches

currentPatch => currentSite%youngest_patch
do while(associated(currentPatch))

! Add debug diagnstic output to determine which patch
if (debug) then
write(fates_log(),*) 'Current patch:', ipatch
write(fates_log(),*) 'Current patch cohorts:', currentPatch%countcohorts
endif

icohort = 1

currentCohort => currentPatch%tallest
do while (associated(currentCohort))

Expand All @@ -696,7 +689,6 @@ subroutine trim_canopy( currentSite )

! Add debug diagnostic output to determine which cohort
if (debug) then
write(fates_log(),*) 'Current cohort:', icohort
write(fates_log(),*) 'Starting canopy trim:', initial_trim
endif

Expand Down Expand Up @@ -916,10 +908,9 @@ subroutine trim_canopy( currentSite )

! currentCohort%canopy_trim = 1.0_r8 !FIX(RF,032414) this turns off ctrim for now.
currentCohort => currentCohort%shorter
icohort = icohort + 1
enddo
currentPatch => currentPatch%older
ipatch = ipatch + 1

enddo

end subroutine trim_canopy
Expand Down Expand Up @@ -966,6 +957,8 @@ subroutine phenology( currentSite, bc_in )
integer :: gddstart ! beginning of counting period for growing degree days.
integer :: nlevroot ! Number of rooting levels to consider
real(r8) :: temp_in_C ! daily averaged temperature in celsius
real(r8) :: temp_wgt ! canopy area weighting factor for daily average
! vegetation temperature calculation
real(r8) :: elongf_prev ! Elongation factor from previous time
real(r8) :: elongf_1st ! First guess for elongation factor
integer :: ndays_pft_leaf_lifespan ! PFT life span of drought deciduous [days].
Expand Down Expand Up @@ -1019,13 +1012,23 @@ subroutine phenology( currentSite, bc_in )
!Parameters, default from from SDGVM model of senesence

temp_in_C = 0._r8
temp_wgt = 0._r8
cpatch => CurrentSite%oldest_patch
do while(associated(cpatch))
temp_in_C = temp_in_C + cpatch%tveg24%GetMean()*cpatch%area
temp_in_C = temp_in_C + cpatch%tveg24%GetMean()*cpatch%total_canopy_area
temp_wgt = temp_wgt + cpatch%total_canopy_area
cpatch => cpatch%younger
end do
temp_in_C = temp_in_C * area_inv - tfrz

if(temp_wgt>nearzero)then
temp_in_C = temp_in_C/temp_wgt - tfrz
else
! If there is no canopy area, we use the veg temperature
! of the first patch, which is the forcing air temperature
! as defined in CLM/ELM. The forcing air temperature
! should be the same among all patches. (Although
! it is unlikely there are more than 1 in this scenario)
temp_in_C = CurrentSite%oldest_patch%tveg24%GetMean() - tfrz
end if

!-----------------Cold Phenology--------------------!

Expand Down
37 changes: 19 additions & 18 deletions biogeochem/FatesSoilBGCFluxMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -252,7 +252,7 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out)
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
integer :: ifp ! patch index of the site
real(r8) :: agnpp ! Above ground daily npp
real(r8) :: bgnpp ! Below ground daily npp
real(r8) :: plant_area ! crown area (m2) of all plants in patch
Expand Down Expand Up @@ -283,17 +283,17 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out)

! Process CH4 variables first
!if(.not.(hlm_use_ch4==itrue) .and. .not.(hlm_parteh_mode==prt_cnp_flex_allom_hyp) )

fp = 0

cpatch => csite%oldest_patch
do while (associated(cpatch))

ifp = cpatch%patchno

if_notbare: if(cpatch%nocomp_pft_label .ne. nocomp_bareground)then
! Patch ordering when passing boundary conditions
! always goes from oldest to youngest, following
! the convention of EDPatchDynamics::set_patchno()

fp = fp + 1


agnpp = 0._r8
bgnpp = 0._r8
woody_area = 0._r8
Expand Down Expand Up @@ -334,13 +334,13 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out)
if(hlm_use_ch4==itrue)then

! Fine root fraction over depth
bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) = &
bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) + &
bc_out%rootfr_pa(ifp,1:bc_in%nlevsoil) = &
bc_out%rootfr_pa(ifp,1:bc_in%nlevsoil) + &
csite%rootfrac_scr(1:bc_in%nlevsoil)

! Fine root carbon, convert [kg/plant] -> [g/m2]
bc_out%frootc_pa(fp) = &
bc_out%frootc_pa(fp) + &
bc_out%frootc_pa(ifp) = &
bc_out%frootc_pa(ifp) + &
fnrt_c*ccohort%n/cpatch%area * g_per_kg

! (gC/m2/s) root respiration (fine root MR + total root GR)
Expand All @@ -366,10 +366,10 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out)
end do

if(hlm_use_ch4==itrue)then
if( sum(bc_out%rootfr_pa(fp,1:bc_in%nlevsoil)) > nearzero) then
bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) = &
bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) / &
sum(bc_out%rootfr_pa(fp,1:bc_in%nlevsoil))
if( sum(bc_out%rootfr_pa(ifp,1:bc_in%nlevsoil)) > nearzero) then
bc_out%rootfr_pa(ifp,1:bc_in%nlevsoil) = &
bc_out%rootfr_pa(ifp,1:bc_in%nlevsoil) / &
sum(bc_out%rootfr_pa(ifp,1:bc_in%nlevsoil))
end if

! RGK: These averages should switch to the new patch averaging methods
Expand All @@ -378,17 +378,18 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out)
! would be arguably worse than just using the instantaneous value

! gC/m2/s
bc_out%annavg_agnpp_pa(fp) = agnpp
bc_out%annavg_bgnpp_pa(fp) = bgnpp
bc_out%annavg_agnpp_pa(ifp) = agnpp
bc_out%annavg_bgnpp_pa(ifp) = bgnpp
! gc/m2/yr
bc_out%annsum_npp_pa(fp) = (bgnpp+agnpp)*days_per_year*sec_per_day
bc_out%annsum_npp_pa(ifp) = (bgnpp+agnpp)*days_per_year*sec_per_day

if(plant_area>nearzero) then
bc_out%woody_frac_aere_pa(fp) = woody_area/plant_area
bc_out%woody_frac_aere_pa(ifp) = woody_area/plant_area
end if

end if
end if if_notbare

cpatch => cpatch%younger
end do

Expand Down
10 changes: 5 additions & 5 deletions biogeophys/EDAccumulateFluxesMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,6 @@ module EDAccumulateFluxesMod
use FatesConstantsMod , only : r8 => fates_r8
use FatesConstantsMod , only : nocomp_bareground


implicit none
private
!
Expand Down Expand Up @@ -62,16 +61,16 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time)

do s = 1, nsites

ifp = 0

! Note: Do not attempt to accumulate or log any
! heterotrophic respiration fluxes from the HLM here
! It is likely this has not been calculated yet (ELM/CLM)

cpatch => sites(s)%oldest_patch
do while (associated(cpatch))
do while (associated(cpatch))

ifp = cpatch%patchno

if(cpatch%nocomp_pft_label.ne.nocomp_bareground)then
ifp = ifp+1

if( bc_in(s)%filter_photo_pa(ifp) == 3 ) then
ccohort => cpatch%shortest
Expand Down Expand Up @@ -105,6 +104,7 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time)
enddo ! while(associated(ccohort))
end if
end if ! not bare ground

cpatch => cpatch%younger
end do ! while(associated(cpatch))
end do
Expand Down
11 changes: 6 additions & 5 deletions biogeophys/EDBtranMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -137,11 +137,12 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out)

bc_out(s)%rootr_pasl(:,:) = 0._r8

ifp = 0
cpatch => sites(s)%oldest_patch
do while (associated(cpatch))
if(cpatch%nocomp_pft_label.ne.nocomp_bareground)then ! only for veg patches
ifp=ifp+1
do while (associated(cpatch))

ifp = cpatch%patchno

if_bare: if(cpatch%nocomp_pft_label.ne.nocomp_bareground)then ! only for veg patches

! THIS SHOULD REALLY BE A COHORT LOOP ONCE WE HAVE rootfr_ft FOR COHORTS (RGK)

Expand Down Expand Up @@ -246,7 +247,7 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out)
enddo

end if
endif ! not bare ground
endif if_bare
cpatch => cpatch%younger
end do

Expand Down
Loading