Skip to content

Terminate tiny patches to bareground in nocomp mode with landuse if they are orphans. #79

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.

Sign up for GitHub

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

Draft
mvdebolskiy wants to merge 2 commits into
base: terminate+btran-without-no-comp
Choose a base branch
from
Draft

Terminate tiny patches to bareground in nocomp mode with landuse if they are orphans. #79

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
86d8f3e
temp fixes for patches
mvdebolskiy Jul 2, 2026
8f1c305
put fuse in correct place to avoid infinite loop
mvdebolskiy Jul 3, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 0 additions & 13 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -355,19 +355,6 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_
endif
endif



! The rest of these are biological starvation checks, only allowed if we
! are not dealing with a recruit (level 2)
if (currentcohort%n < min_n_safemath .and. level == 1) then
terminate = itrue
termination_type = i_term_mort_type_numdens
if ( debug ) then
write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area, &
currentCohort%dbh,currentCohort%pft,call_index
endif
endif

! The rest of these are only allowed if we are not dealing with a recruit (level 2)
if_level_2: if (.not.currentCohort%isnew .and. level == 2) then

Expand Down
45 changes: 33 additions & 12 deletions biogeochem/EDPatchDynamicsMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3553,10 +3553,12 @@ subroutine terminate_patches(currentSite, bc_in)
type(fates_patch_type), pointer :: youngerPatch
type(fates_patch_type), pointer :: patchpointer
type(fates_patch_type), pointer :: largest_patch
type(fates_patch_type), pointer :: orphan_lu_patch
integer, parameter :: max_cycles = 10 ! After 10 loops through
! You should had fused
integer :: count_cycles
logical :: gotfused

logical :: current_patch_is_youngest_lutype
integer :: i_landuse, i_pft
integer :: land_use_type_to_remove
Expand All @@ -3569,14 +3571,13 @@ subroutine terminate_patches(currentSite, bc_in)

! Initialize the count cycles
count_cycles = 0

! Start at the youngest patch in the list and assume that the largest patch is this patch
currentPatch => currentSite%youngest_patch
do while(associated(currentPatch))
lessthan_min_patcharea_if: if(currentPatch%area <= min_patch_area)then

nocomp_if: if (hlm_use_nocomp .eq. itrue) then

gotfused = .false.
patchpointer => currentSite%youngest_patch
do while(associated(patchpointer))
Expand Down Expand Up @@ -3634,16 +3635,36 @@ subroutine terminate_patches(currentSite, bc_in)
call fuse_2_patches(currentSite, largest_patch, currentPatch)
gotfused = .true.
else
!! truly nothing else in this land-use label to fuse into; warn as before
warn_msg = 'small nocomp patch wasnt able to find '// &
'another patch to fuse with. '// &
'nocomp pft: '//trim(I2S(currentPatch%nocomp_pft_label))// &
'lu label: '//trim(I2S(currentPatch%land_use_label))// &
'area: '//trim(N2S(currentPatch%area))
call FatesWarn(warn_msg,index=5)
endif
endif

!! truly nothing else in this land-use label to fuse into;
if (.not. associated(currentPatch,currentSite%youngest_patch) &
.and. currentPatch%area < min_patch_area_forced) then
! This is the only patch in this landuse label when running with nocomp. It will cause numerical instability.
! We will terminate
warn_msg = 'This is an orphah patch with '// &
'nocomp pft: '//trim(I2S(currentPatch%nocomp_pft_label))// &
'lu label: '//trim(I2S(currentPatch%land_use_label))// &
'area: '//trim(N2S(currentPatch%area))// 'sending to bareground.'
call FatesWarn(warn_msg,index=5)
patchpointer => currentSite%youngest_patch
do while(associated(patchpointer))
if (patchpointer%nocomp_pft_label == nocomp_bareground) exit
patchpointer => patchpointer%older
end do
if (associated(patchpointer)) then
currentPatch%nocomp_pft_label = nocomp_bareground
currentPatch%land_use_label = nocomp_bareground_land
call fuse_2_patches(currentSite, currentPatch, patchpointer)
call terminate_cohorts(currentSite, patchpointer, 4,30,bc_in)
call patchpointer%SortCohorts()
call patchpointer%ValidateCohorts()
call patchpointer%CheckCohortsPfts(1)
! go back to youngest
currentPatch => currentSite%youngest_patch
gotfused = .true.
end if
end if
end if
end if
else nocomp_if

! Even if the patch area is small, avoid fusing it into its neighbor
Expand Down
7 changes: 5 additions & 2 deletions biogeophys/EDBtranMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ module EDBtranMod
bc_out_type, &
numpft
use FatesInterfaceTypesMod , only : hlm_use_planthydro
use FatesInterfaceTypesMod , only : hlm_use_nocomp
use FatesGlobals , only : fates_log
use FatesAllometryMod , only : set_root_fraction
use shr_log_mod , only : errMsg => shr_log_errMsg
Expand All @@ -30,7 +31,7 @@ module EDBtranMod
private


logical, parameter :: debug = .true.
logical, parameter :: debug = .false.
character(len=*), parameter :: sourcefile = __FILE__

public :: btran_ed
Expand Down Expand Up @@ -176,7 +177,9 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out)
pftgs(ft) = 0._r8
endif
end do




! THIS SHOULD REALLY BE A COHORT LOOP ONCE WE HAVE rootfr_ft FOR COHORTS (RGK)
cpatch%btran_ft(:) = 0.0_r8
root_resis(:,:) = 0.0_r8
Expand Down