Skip to content

Commit

Permalink
Merge pull request ESCOMP#10 from NCAR/releasetest
Browse files Browse the repository at this point in the history 
Bring in sci.1.8.0_api.3.0.0
  • Loading branch information
@ekluzek
ekluzek authored Apr 12, 2018
2 parents 70558e9 + 3d08f7c commit b40a85a
Show file tree
Hide file tree
Showing 3 changed files with 98 additions and 53 deletions.
133 changes: 87 additions & 46 deletions biogeochem/EDPatchDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,8 @@ module EDPatchDynamicsMod
use FatesInterfaceMod , only : hlm_freq_day
use EDPftvarcon , only : EDPftvarcon_inst
use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort
use EDtypesMod , only : ncwd, n_dbh_bins, ntol, area, dbhmax
use EDtypesMod , only : ncwd, n_dbh_bins, area, patchfusion_dbhbin_loweredges
use EDtypesMod , only : force_patchfuse_min_biomass
use EDTypesMod , only : maxPatchesPerSite
use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type
use EDTypesMod , only : min_patch_area
Expand Down Expand Up @@ -118,7 +119,8 @@ subroutine disturbance_rates( site_in, bc_in)

call mortality_rates(currentCohort,bc_in,cmort,hmort,bmort,frmort)
currentCohort%dmort = cmort+hmort+bmort+frmort
call carea_allom(currentCohort%dbh,currentCohort%n,site_in%spread,currentCohort%pft,currentCohort%c_area)
call carea_allom(currentCohort%dbh,currentCohort%n,site_in%spread,currentCohort%pft, &
currentCohort%c_area)

! Initialize diagnostic mortality rates
currentCohort%cmort = cmort
Expand Down Expand Up @@ -1324,6 +1326,8 @@ subroutine fuse_patches( csite, bc_in )
!
! !USES:
use EDParamsMod , only : ED_val_patch_fusion_tol
use EDTypesMod , only : patch_fusion_tolerance_relaxation_increment
use EDTypesMod , only : max_age_of_second_oldest_patch
!
! !ARGUMENTS:
type(ed_site_type), intent(inout), target :: csite
Expand All @@ -1335,14 +1339,12 @@ subroutine fuse_patches( csite, bc_in )
integer :: ft,z !counters for pft and height class
real(r8) :: norm !normalized difference between biomass profiles
real(r8) :: profiletol !tolerance of patch fusion routine. Starts off high and is reduced if there are too many patches.
integer :: maxpatch !maximum number of allowed patches. FIX-RF. These should be namelist variables.
integer :: nopatches !number of patches presently in gridcell
integer :: iterate !switch of patch reduction iteration scheme. 1 to keep going, 0 to stop
integer :: fuse_flag !do patches get fused (1) or not (0).
!
!---------------------------------------------------------------------

maxpatch = maxPatchesPerSite

currentSite => csite

profiletol = ED_val_patch_fusion_tol
Expand All @@ -1359,7 +1361,7 @@ subroutine fuse_patches( csite, bc_in )
iterate = 1

!---------------------------------------------------------------------!
! Keep doing this until nopatches >= maxpatch !
! Keep doing this until nopatches >= maxPatchesPerSite !
!---------------------------------------------------------------------!

do while(iterate == 1)
Expand All @@ -1385,36 +1387,80 @@ subroutine fuse_patches( csite, bc_in )
endif

if(associated(tpp).and.associated(currentPatch))then
fuse_flag = 1 !the default is to fuse the patches

!--------------------------------------------------------------------------------------------
! The default is to fuse the patches, unless some criteria is met which keeps them separated.
! there are multiple criteria which all need to be met to keep them distinct:
! (a) one of them is younger than the max age at which we force fusion;
! (b) there is more than a threshold (tiny) amount of biomass in at least one of the patches;
! (c) for at least one pft x size class, where there is biomass in that class in at least one patch,
! and the normalized difference between the patches exceeds a threshold.
!--------------------------------------------------------------------------------------------

fuse_flag = 1
if(currentPatch%patchno /= tpp%patchno) then !these should be the same patch

!---------------------------------------------------------------------!
! Calculate the difference criteria for each pft and dbh class !
!---------------------------------------------------------------------!
do ft = 1,numpft ! loop over pfts
do z = 1,n_dbh_bins ! loop over hgt bins
!is there biomass in this category?
if(currentPatch%pft_agb_profile(ft,z) > 0.0_r8.or.tpp%pft_agb_profile(ft,z) > 0.0_r8)then
norm = abs(currentPatch%pft_agb_profile(ft,z) - tpp%pft_agb_profile(ft,z))/(0.5_r8*&
&(currentPatch%pft_agb_profile(ft,z) + tpp%pft_agb_profile(ft,z)))
!---------------------------------------------------------------------!
! Look for differences in profile biomass, above the minimum biomass !
!---------------------------------------------------------------------!

if(norm > profiletol)then
!looking for differences between profile density.
if(currentPatch%pft_agb_profile(ft,z) > NTOL.or.tpp%pft_agb_profile(ft,z) > NTOL)then
fuse_flag = 0 !do not fuse - keep apart.
endif
endif ! profile tol
endif ! NTOL
enddo !ht bins
enddo ! PFT

!---------------------------------------------------------------------!
! Call the patch fusion routine if there is a meaningful difference !
! any of the pft x height categories !
!---------------------------------------------------------------------!
!-----------------------------------------------------------------------------------
! check to see if both patches are older than the age at which we force them to fuse
!-----------------------------------------------------------------------------------

if ( tpp%age .le. max_age_of_second_oldest_patch .or. &
currentPatch%age .le. max_age_of_second_oldest_patch ) then


!---------------------------------------------------------------------------------------------------------
! the next bit of logic forces fusion of two patches which both have tiny biomass densities. without this,
! fates gives a bunch of really young patches which all have almost no biomass and so don't need to be
! distinguished from each other. but if force_patchfuse_min_biomass is too big, it takes too long for the
! youngest patch to build up enough biomass to be its own distinct entity, which leads to large oscillations
! in the patch dynamics and dependent variables.
!---------------------------------------------------------------------------------------------------------

if(sum(currentPatch%pft_agb_profile(:,:)) > force_patchfuse_min_biomass .or. &
sum(tpp%pft_agb_profile(:,:)) > force_patchfuse_min_biomass ) then

!---------------------------------------------------------------------!
! Calculate the difference criteria for each pft and dbh class !
!---------------------------------------------------------------------!

do ft = 1,numpft ! loop over pfts
do z = 1,n_dbh_bins ! loop over hgt bins

!----------------------------------
!is there biomass in this category?
!----------------------------------

if(currentPatch%pft_agb_profile(ft,z) > 0.0_r8 .or. &
tpp%pft_agb_profile(ft,z) > 0.0_r8)then

!-------------------------------------------------------------------------------------
! what is the relative difference in biomass i nthis category between the two patches?
!-------------------------------------------------------------------------------------

norm = abs(currentPatch%pft_agb_profile(ft,z) - &
tpp%pft_agb_profile(ft,z))/(0.5_r8 * &
&(currentPatch%pft_agb_profile(ft,z) + tpp%pft_agb_profile(ft,z)))

!---------------------------------------------------------------------!
! Look for differences in profile biomass, above the minimum biomass !
!---------------------------------------------------------------------!

if(norm > profiletol)then

fuse_flag = 0 !do not fuse - keep apart.

endif ! profile tol
endif ! biomass(ft,z) .gt. 0
enddo !ht bins
enddo ! PFT
endif ! sum(biomass(:,:) .gt. force_patchfuse_min_biomass
endif ! maxage

!-------------------------------------------------------------------------!
! 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
tmpptr => currentPatch%older
Expand Down Expand Up @@ -1448,9 +1494,9 @@ subroutine fuse_patches( csite, bc_in )
currentPatch => currentPatch%older
enddo

if(nopatches > maxpatch)then
if(nopatches > maxPatchesPerSite)then
iterate = 1
profiletol = profiletol * 1.1_r8
profiletol = profiletol * patch_fusion_tolerance_relaxation_increment

!---------------------------------------------------------------------!
! Making profile tolerance larger means that more fusion will happen !
Expand All @@ -1459,7 +1505,7 @@ subroutine fuse_patches( csite, bc_in )
iterate = 0
endif

enddo !do while nopatches>maxpatch
enddo !do while nopatches>maxPatchesPerSite

end subroutine fuse_patches

Expand Down Expand Up @@ -1768,20 +1814,15 @@ subroutine patch_pft_size_profile(cp_pnt)

currentPatch => cp_pnt

delta_dbh = (DBHMAX/N_DBH_BINS)

currentPatch%pft_agb_profile(:,:) = 0.0_r8

do j = 1,N_DBH_BINS
if (j == 1) then
mind(j) = 0.0_r8
maxd(j) = delta_dbh
else if (j == N_DBH_BINS) then
mind(j) = (j-1) * delta_dbh
if (j == N_DBH_BINS) then
mind(j) = patchfusion_dbhbin_loweredges(j)
maxd(j) = gigantictrees
else
mind(j) = (j-1) * delta_dbh
maxd(j) = (j)*delta_dbh
mind(j) = patchfusion_dbhbin_loweredges(j)
maxd(j) = patchfusion_dbhbin_loweredges(j+1)
endif
enddo

Expand Down
14 changes: 9 additions & 5 deletions main/EDTypesMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,13 +81,18 @@ module EDTypesMod
real(r8), parameter :: fire_threshold = 50.0_r8 ! threshold for fires that spread or go out. KWm-2 (Pyne 1986)

! PATCH FUSION
real(r8), parameter :: NTOL = 0.05_r8 ! min plant density for hgt bin to be used in height profile comparisons
real(r8), parameter :: force_patchfuse_min_biomass = 0.005_r8 ! min biomass (kg / m2 patch area) below which to force-fuse patches
integer , parameter :: N_DBH_BINS = 6 ! no. of dbh bins used when comparing patches
real(r8), parameter :: patchfusion_dbhbin_loweredges(N_DBH_BINS) = &
(/0._r8, 5._r8, 20._r8, 50._r8, 100._r8, 150._r8/) ! array of bin lower edges for comparing patches
real(r8), parameter :: patch_fusion_tolerance_relaxation_increment = 1.1_r8 ! amount by which to increment patch fusion threshold
real(r8), parameter :: max_age_of_second_oldest_patch = 200._r8 ! age in years above which to combine all patches

! COHORT FUSION
real(r8), parameter :: HITEMAX = 30.0_r8 ! max dbh value used in hgt profile comparison
real(r8), parameter :: DBHMAX = 150.0_r8 ! max dbh value used in hgt profile comparison
integer , parameter :: N_HITE_BINS = 60 ! no. of hite bins used to distribute LAI
integer , parameter :: N_DBH_BINS = 5 ! no. of dbh bins used when comparing patches


! COHORT TERMINATION
real(r8), parameter :: min_npm2 = 1.0E-8_r8 ! minimum cohort number density per m2 before termination
real(r8), parameter :: min_patch_area = 0.001_r8 ! smallest allowable patch area before termination
real(r8), parameter :: min_nppatch = 1.0E-11_r8 ! minimum number of cohorts per patch (min_npm2*min_patch_area)
Expand Down Expand Up @@ -261,7 +266,6 @@ module EDTypesMod
procedure, public :: b_total

end type ed_cohort_type




Expand Down
4 changes: 2 additions & 2 deletions main/FatesHistoryInterfaceMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2615,12 +2615,12 @@ subroutine define_history_vars(this, initialize_variables)
! Site level counting variables
call this%set_history_var(vname='ED_NPATCHES', units='none', &
long='Total number of ED patches per site', use_default='active', &
avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, &
avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, &
ivar=ivar, initialize=initialize_variables, index = ih_npatches_si)

call this%set_history_var(vname='ED_NCOHORTS', units='none', &
long='Total number of ED cohorts per site', use_default='active', &
avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, &
avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, &
ivar=ivar, initialize=initialize_variables, index = ih_ncohorts_si)

! Patch variables
Expand Down

0 comments on commit b40a85a

Please sign in to comment.