Skip to content

Commit

Permalink
Merge pull request #2 from rgknox/DynamicRoots_MD_bugfix_rkupdates
Browse files Browse the repository at this point in the history
Dynamic roots md bugfix rkupdates
  • Loading branch information
JunyanDing authored Oct 7, 2021
2 parents ea14e77 + c944640 commit f0802ed
Show file tree
Hide file tree
Showing 30 changed files with 12,793 additions and 11,691 deletions.
3,375 changes: 1,707 additions & 1,668 deletions biogeochem/EDCanopyStructureMod.F90

Large diffs are not rendered by default.

650 changes: 329 additions & 321 deletions biogeochem/EDCohortDynamicsMod.F90

Large diffs are not rendered by default.

74 changes: 51 additions & 23 deletions biogeochem/EDPatchDynamicsMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,9 @@ module EDPatchDynamicsMod
use FatesInterfaceTypesMod , only : bc_in_type
use FatesInterfaceTypesMod , only : hlm_days_per_year
use FatesInterfaceTypesMod , only : numpft
use FatesInterfaceTypesMod , only : hlm_use_sp
use FatesInterfaceTypesMod , only : hlm_use_nocomp
use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog
use FatesGlobals , only : endrun => fates_endrun
use FatesConstantsMod , only : r8 => fates_r8
use FatesConstantsMod , only : itrue, ifalse
Expand Down Expand Up @@ -427,8 +430,9 @@ subroutine disturbance_rates( site_in, bc_in)
enddo !patch loop

end subroutine disturbance_rates

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

subroutine spawn_patches( currentSite, bc_in)
!
! !DESCRIPTION:
Expand All @@ -447,7 +451,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 : zero_cohort, copy_cohort, terminate_cohorts
use FatesConstantsMod , only : rsnbl_math_prec

!
Expand Down Expand Up @@ -561,7 +565,7 @@ subroutine spawn_patches( currentSite, bc_in)
allocate(new_patch_primary)

call create_patch(currentSite, new_patch_primary, age, &
site_areadis_primary, primaryforest)
site_areadis_primary, primaryforest,fates_unset_int)

! Initialize the litter pools to zero, these
! pools will be populated by looping over the existing patches
Expand All @@ -584,7 +588,7 @@ subroutine spawn_patches( currentSite, bc_in)
if ( site_areadis_secondary .gt. nearzero) then
allocate(new_patch_secondary)
call create_patch(currentSite, new_patch_secondary, age, &
site_areadis_secondary, secondaryforest)
site_areadis_secondary, secondaryforest,fates_unset_int)

! Initialize the litter pools to zero, these
! pools will be populated by looping over the existing patches
Expand Down Expand Up @@ -1228,7 +1232,7 @@ subroutine check_patch_area( currentSite )
end if

if(debug) then
write(fates_log(),*) 'Total patch area precision being fixed, adjusting'
write(fates_log(),*) 'Total patch area precision being fixed, adjusting',(areatot-area_site)
write(fates_log(),*) 'largest patch. This may have slight impacts on carbon balance.'
end if

Expand Down Expand Up @@ -1276,6 +1280,22 @@ subroutine set_patchno( currentSite )
currentPatch => currentPatch%younger
enddo

if(hlm_use_sp.eq.itrue)then
patchno = 1
currentPatch => currentSite%oldest_patch
do while(associated(currentPatch))
if(currentPatch%nocomp_pft_label.eq.0)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

! ============================================================================
Expand Down Expand Up @@ -1396,7 +1416,7 @@ subroutine TransLitterNewPatch(currentSite, &
curr_litt%seed_germ_decay(pft)*patch_site_areadis/newPatch%area

end do

! -----------------------------------------------------------------------------
! Distribute the existing litter that was already in place on the donor
! patch. Some of this burns and is sent to the atmosphere, and some goes to the
Expand Down Expand Up @@ -1966,7 +1986,7 @@ end subroutine mortality_litter_fluxes

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

subroutine create_patch(currentSite, new_patch, age, areap, label)
subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft)

!
! !DESCRIPTION:
Expand All @@ -1980,7 +2000,7 @@ subroutine create_patch(currentSite, new_patch, age, areap, label)
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
! !LOCAL VARIABLES:
!---------------------------------------------------------------------
integer :: el ! element loop index
Expand Down Expand Up @@ -2032,6 +2052,7 @@ subroutine create_patch(currentSite, new_patch, age, areap, label)
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.
Expand Down Expand Up @@ -2357,14 +2378,20 @@ subroutine fuse_patches( csite, bc_in )
endif ! sum(biomass(:,:) .gt. force_patchfuse_min_biomass
endif ! maxage


! Do not fuse patches that have different PFT labels in nocomp mode
if(hlm_use_nocomp.eq.itrue.and. &
tpp%nocomp_pft_label.ne.currentPatch%nocomp_pft_label)then
fuse_flag = 0
end if
!-------------------------------------------------------------------------!
! Call the patch fusion routine if there is not a meaningful difference !
! any of the pft x height categories !
! or both are older than forced fusion age !
!-------------------------------------------------------------------------!

if(fuse_flag == 1)then

!-----------------------!
! fuse the two patches !
!-----------------------!
Expand Down Expand Up @@ -2641,9 +2668,10 @@ subroutine terminate_patches(currentSite)

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

if(currentPatch%area <= min_patch_area)then



! Even if the patch area is small, avoid fusing it into its neighbor
! if it is the youngest of all patches. We do this in attempts to maintain
! a discrete patch for very young patches
Expand Down Expand Up @@ -2678,17 +2706,17 @@ subroutine terminate_patches(currentSite)
! patch. As mentioned earlier, we try not to fuse it.

gotfused = .true.
else
else !anthro labels of two patches are not the same
if (count_cycles .gt. 0) then
! if we're having an incredibly hard time fusing patches because of their differing anthropogenic disturbance labels,
! since the size is so small, let's sweep the problem under the rug and change the tiny patch's label to that of its older sibling
! and then allow them to fuse together.
currentPatch%anthro_disturbance_label = olderPatch%anthro_disturbance_label
call fuse_2_patches(currentSite, olderPatch, currentPatch)
gotfused = .true.
endif
endif
endif
endif !countcycles
endif !distlabel
endif !older patch

if( .not. gotfused .and. associated(currentPatch%younger) ) then

Expand All @@ -2711,12 +2739,11 @@ subroutine terminate_patches(currentSite)
currentPatch%anthro_disturbance_label = youngerPatch%anthro_disturbance_label
call fuse_2_patches(currentSite, youngerPatch, currentPatch)
gotfused = .true.
endif
endif
endif
endif
endif

endif ! count cycles
endif ! anthro labels
endif ! has an older patch
endif ! is not the youngest patch
endif ! very small patch
! It is possible that an incredibly small patch just fused into another incredibly
! small patch, resulting in an incredibly small patch. It is also possible that this
! resulting incredibly small patch is the oldest patch. If this was true than
Expand All @@ -2726,6 +2753,7 @@ subroutine terminate_patches(currentSite)

if(currentPatch%area > min_patch_area_forced)then
currentPatch => currentPatch%older

count_cycles = 0
else
count_cycles = count_cycles + 1
Expand All @@ -2746,9 +2774,9 @@ subroutine terminate_patches(currentSite)
! an infinite loop.
currentPatch => currentPatch%older
count_cycles = 0
end if
end if !count cycles

enddo
enddo ! current patch loop

!check area is not exceeded
call check_patch_area( currentSite )
Expand Down
Loading

0 comments on commit f0802ed

Please sign in to comment.