Skip to content

Commit

Permalink
merged changes into lower_termination_threshold
Browse files Browse the repository at this point in the history
  • Loading branch information
@ckoven
ckoven committed Mar 6, 2017
2 parents 37ba5ce + 55f42dd commit 6a5aa19
Show file tree
Hide file tree
Showing 28 changed files with 941 additions and 965 deletions.
64 changes: 32 additions & 32 deletions components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,17 +5,19 @@ module EDCanopyStructureMod
! This is obviosuly far too complicated for it's own good and needs re-writing.
! ============================================================================

use shr_kind_mod , only : r8 => shr_kind_r8;
use FatesConstantsMod , only : r8 => fates_r8
use FatesGlobals , only : fates_log
use pftconMod , only : pftcon
use EDGrowthFunctionsMod , only : c_area
use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts
use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd
use EDtypesMod , only : cp_nclmax,cp_nlevcan
use EDtypesMod , only : numpft_ed
use EDTypesMod , only : nclmax
use EDTypesMod , only : nlevcan
use EDTypesMod , only : numpft_ed
use FatesGlobals , only : endrun => fates_endrun

! CIME Globals
use shr_log_mod , only : errMsg => shr_log_errMsg
use abortutils , only : endrun
use FatesGlobals , only : fates_log

implicit none
private
Expand Down Expand Up @@ -79,7 +81,7 @@ subroutine canopy_structure( currentSite )

use EDParamsMod, only : ED_val_comp_excln, ED_val_ag_biomass
use SFParamsMod, only : SF_val_cwd_frac
use EDtypesMod , only : ncwd, min_patch_area, cp_nlevcan
use EDtypesMod , only : ncwd, min_patch_area
!
! !ARGUMENTS
type(ed_site_type) , intent(inout), target :: currentSite
Expand All @@ -94,10 +96,10 @@ subroutine canopy_structure( currentSite )
real(r8) :: cc_loss
real(r8) :: lossarea
real(r8) :: newarea
real(r8) :: arealayer(cp_nlevcan) ! Amount of plant area currently in each canopy layer
real(r8) :: sumdiff(cp_nlevcan) ! The total of the exclusion weights for all cohorts in layer z
real(r8) :: arealayer(nlevcan) ! Amount of plant area currently in each canopy layer
real(r8) :: sumdiff(nlevcan) ! The total of the exclusion weights for all cohorts in layer z
real(r8) :: weight ! The amount of the total lost area that comes from this cohort
real(r8) :: sum_weights(cp_nlevcan)
real(r8) :: sum_weights(nlevcan)
real(r8) :: new_total_area_check
real(r8) :: missing_area, promarea,cc_gain,sumgain
integer :: promswitch,lower_cohort_switch
Expand Down Expand Up @@ -144,7 +146,7 @@ subroutine canopy_structure( currentSite )
z = z + 1
endif

currentPatch%NCL_p = min(cp_nclmax,z) ! Set current canopy layer occupancy indicator.
currentPatch%NCL_p = min(nclmax,z) ! Set current canopy layer occupancy indicator.

do i = 1,z ! Loop around the currently occupied canopy layers.

Expand Down Expand Up @@ -212,7 +214,7 @@ subroutine canopy_structure( currentSite )
currentCohort%b * currentCohort%n

!kill the ones which go into canopy layers that are not allowed... (default nclmax=2)
if(i+1 > cp_nclmax)then
if(i+1 > nclmax)then
!put the litter from the terminated cohorts into the fragmenting pools
! write(fates_log(),*) '3rd canopy layer'
do c=1,ncwd
Expand Down Expand Up @@ -263,8 +265,9 @@ subroutine canopy_structure( currentSite )
currentSite%demotion_carbonflux = currentSite%demotion_carbonflux + &
currentCohort%b * currentCohort%n

!kill the ones which go into canopy layers that are not allowed... (default cp_nclmax=2)
if(i+1 > cp_nclmax)then
!kill the ones which go into canopy layers that are not allowed... (default nclmax=2)
if(i+1 > nclmax)then

!put the litter from the terminated cohorts into the fragmenting pools
do c=1,ncwd

Expand Down Expand Up @@ -309,7 +312,7 @@ subroutine canopy_structure( currentSite )

enddo !arealayer loop
if(arealayer(i)-currentPatch%area > 0.00001_r8)then
write(fates_log(),*) 'lossarea problem', lossarea,sumloss,z,currentPatch%patchno,currentPatch%clm_pno
write(fates_log(),*) 'lossarea problem', lossarea,sumloss,z,currentPatch%patchno
endif

enddo !z
Expand All @@ -334,7 +337,7 @@ subroutine canopy_structure( currentSite )
excess_area = arealayer(j)-currentPatch%area
endif
enddo
currentPatch%ncl_p = min(z,cp_nclmax)
currentPatch%ncl_p = min(z,nclmax)

enddo !is there still excess area in any layer?

Expand Down Expand Up @@ -525,7 +528,7 @@ subroutine canopy_structure( currentSite )

if(currentPatch%area-arealayer(i) < 0.000001_r8)then
!write(fates_log(),*) 'gainarea problem',sumgain,arealayer(i),currentPatch%area,z, &
!currentPatch%patchno,currentPatch%clm_pno,currentPatch%area - arealayer(i),i,missing_area,count_mi
!currentPatch%patchno,currentPatch%area - arealayer(i),i,missing_area,count_mi
endif
if(promswitch == 1)then
! write(fates_log(),*) 'z loop',arealayer(1:3),currentPatch%patchno,z
Expand All @@ -552,7 +555,7 @@ subroutine canopy_structure( currentSite )
endif
endif
enddo
currentPatch%ncl_p = min(z,cp_nclmax)
currentPatch%ncl_p = min(z,nclmax)
if(promswitch == 1)then
! write(fates_log(),*) 'missingarea loop',arealayer(1:3),currentPatch%patchno,missing_area,z
endif
Expand All @@ -562,7 +565,7 @@ subroutine canopy_structure( currentSite )
call terminate_cohorts(currentPatch)

if(promswitch == 1)then
!write(fates_log(),*) 'going into cohort check',currentPatch%clm_pno
!write(fates_log(),*) 'going into cohort check'
endif
! ----------- Check cohort area ------------------------------!
do i = 1,z
Expand Down Expand Up @@ -624,7 +627,6 @@ subroutine canopy_spread( currentSite )
! Calculates the spatial spread of tree canopies based on canopy closure.
!
! !USES:
use EDTypesMod , only : cp_nlevcan
use EDParamsMod , only : ED_val_maxspread, ED_val_minspread
!
! !ARGUMENTS
Expand All @@ -633,7 +635,7 @@ subroutine canopy_spread( currentSite )
! !LOCAL VARIABLES:
type (ed_cohort_type), pointer :: currentCohort
type (ed_patch_type) , pointer :: currentPatch
real(r8) :: arealayer(cp_nlevcan) ! Amount of canopy in each layer.
real(r8) :: arealayer(nlevcan) ! Amount of canopy in each layer.
real(r8) :: inc ! Arbitrary daily incremental change in canopy area
integer :: z
!----------------------------------------------------------------------
Expand All @@ -656,7 +658,7 @@ subroutine canopy_spread( currentSite )
enddo

!If the canopy area is approaching closure, squash the tree canopies and make them taller and thinner
do z = 1,cp_nclmax
do z = 1,nclmax

if(arealayer(z)/currentPatch%area > 0.9_r8)then
currentPatch%spread(z) = currentPatch%spread(z) - inc
Expand Down Expand Up @@ -691,6 +693,7 @@ subroutine canopy_summarization( nsites, sites, bc_in )

use FatesInterfaceMod , only : bc_in_type
use EDPatchDynamicsMod , only : set_patchno
use EDPatchDYnamicsMod , only : set_root_fraction
use EDCohortDynamicsMod , only : size_and_type_class_index
use EDGrowthFunctionsMod , only : tree_lai, c_area
use EDEcophysConType , only : EDecophyscon
Expand Down Expand Up @@ -730,7 +733,7 @@ subroutine canopy_summarization( nsites, sites, bc_in )

do while(associated(currentPatch))

call currentPatch%set_root_fraction(bc_in(s)%depth_gl)
call set_root_fraction(currentPatch,bc_in(s)%depth_gl)

!zero cohort-summed variables.
currentPatch%total_canopy_area = 0.0_r8
Expand Down Expand Up @@ -804,7 +807,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
! !USES:

use EDGrowthFunctionsMod , only : tree_lai, tree_sai, c_area
use EDtypesMod , only : area, dinc_ed, hitemax, numpft_ed, n_hite_bins
use EDtypesMod , only : area, dinc_ed, hitemax, n_hite_bins
use EDEcophysConType , only : EDecophyscon

!
Expand Down Expand Up @@ -880,7 +883,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
max(currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft),currentCohort%NV)
currentPatch%lai = currentPatch%lai +currentCohort%lai

do L = 1,cp_nclmax-1
do L = 1,nclmax-1
if(currentCohort%canopy_layer == L)then
currentPatch%canopy_layer_lai(L) = currentPatch%canopy_layer_lai(L) + currentCohort%lai + &
currentCohort%sai
Expand Down Expand Up @@ -1133,10 +1136,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
/currentPatch%tlai_profile(L,ft,iv)
enddo

currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8
currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8
currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8
currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: cp_nlevcan) = 0._r8
currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8
currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8
currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8
currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan) = 0._r8

enddo
enddo
Expand Down Expand Up @@ -1194,7 +1197,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
do L = 1,currentPatch%NCL_p
do ft = 1,numpft_ed
if(currentPatch%present(L,FT) > 1)then
write(fates_log(), *) 'ED: present issue',currentPatch%clm_pno,L,ft,currentPatch%present(L,FT)
write(fates_log(), *) 'ED: present issue',L,ft,currentPatch%present(L,FT)
currentPatch%present(L,ft) = 1
endif
enddo
Expand All @@ -1221,7 +1224,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out)
use EDTypesMod , only : ed_patch_type, ed_cohort_type, &
ed_site_type, AREA
use FatesInterfaceMod , only : bc_out_type
use ColumnType , only : col ! THIS MUST BE REMOVED WITH CLM_PNO

!
! !ARGUMENTS
Expand All @@ -1245,8 +1247,6 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out)
do while(associated(currentPatch))
ifp = ifp+1

currentPatch%clm_pno = ifp + col%patchi(c) ! THIS IS SLOWLY BEING REMOVED

if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then
write(fates_log(),*) 'ED: canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area
currentPatch%total_canopy_area = currentPatch%area
Expand Down
35 changes: 19 additions & 16 deletions components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,20 +4,24 @@ module EDCohortDynamicsMod
! Cohort stuctures in ED.
!
! !USES:
use abortutils , only : endrun
use FatesGlobals , only : endrun => fates_endrun
use FatesGlobals , only : fates_log
use FatesGlobals , only : freq_day
use FatesInterfaceMod , only : hlm_freq_day
use FatesConstantsMod , only : r8 => fates_r8
use FatesConstantsMod , only : fates_unset_int
use shr_log_mod , only : errMsg => shr_log_errMsg
use pftconMod , only : pftcon
use EDEcophysContype , only : EDecophyscon
use EDGrowthFunctionsMod , only : c_area, tree_lai
use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type
use EDTypesMod , only : fusetol, cp_nclmax
use EDtypesMod , only : ncwd, maxcohortsperpatch
use EDtypesMod , only : sclass_ed,nlevsclass_ed,AREA
use EDtypesMod , only : min_npm2, min_nppatch, min_n_safemath
use EDTypesMod , only : fusetol
use EDTypesMod , only : nclmax
use EDTypesMod , only : ncwd
use EDTypesMod , only : maxCohortsPerPatch
use EDTypesMod , only : sclass_ed,nlevsclass_ed,AREA
use EDTypesMod , only : min_npm2, min_nppatch
use EDTypesMod , only : min_n_safemath
! CIME globals
use shr_log_mod , only : errMsg => shr_log_errMsg
!
implicit none
private
Expand Down Expand Up @@ -224,7 +228,6 @@ subroutine allocate_live_biomass(cc_p,mode)
! Use different proportions if the leaves are on vs off
if(leaves_off_switch==0)then


new_bl = currentcohort%balive*leaf_frac

new_br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac
Expand All @@ -237,12 +240,12 @@ subroutine allocate_live_biomass(cc_p,mode)
if(mode==1)then

currentcohort%npp_leaf = currentcohort%npp_leaf + &
max(0.0_r8,new_bl - currentcohort%bl) / freq_day
max(0.0_r8,new_bl - currentcohort%bl) / hlm_freq_day

currentcohort%npp_froot = currentcohort%npp_froot + &
max(0._r8,new_br - currentcohort%br) / freq_day
max(0._r8,new_br - currentcohort%br) / hlm_freq_day

currentcohort%npp_bsw = max(0.0_r8, new_bsw - currentcohort%bsw)/freq_day
currentcohort%npp_bsw = max(0.0_r8, new_bsw - currentcohort%bsw)/hlm_freq_day

currentcohort%npp_bdead = currentCohort%dbdeaddt

Expand Down Expand Up @@ -275,9 +278,9 @@ subroutine allocate_live_biomass(cc_p,mode)
if(mode==1)then

currentcohort%npp_froot = currentcohort%npp_froot + &
max(0.0_r8,new_br-currentcohort%br)/freq_day
max(0.0_r8,new_br-currentcohort%br)/hlm_freq_day

currentcohort%npp_bsw = max(0.0_r8, new_bsw-currentcohort%bsw)/freq_day
currentcohort%npp_bsw = max(0.0_r8, new_bsw-currentcohort%bsw)/hlm_freq_day

currentcohort%npp_bdead = currentCohort%dbdeaddt

Expand Down Expand Up @@ -533,7 +536,7 @@ subroutine terminate_cohorts( patchptr )
endif

! In the third canopy layer
if (currentCohort%canopy_layer > cp_nclmax ) then
if (currentCohort%canopy_layer > nclmax ) then
terminate = 1
if ( DEBUG ) then
write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer
Expand Down Expand Up @@ -616,7 +619,7 @@ subroutine fuse_cohorts(patchptr)
! Join similar cohorts to reduce total number
!
! !USES:
use EDTypesMod , only : cp_nlevcan
use EDTypesMod , only : nlevcan
!
! !ARGUMENTS
type (ed_patch_type), intent(inout), target :: patchptr
Expand Down Expand Up @@ -771,7 +774,7 @@ subroutine fuse_cohorts(patchptr)
! recent canopy history
currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + nextc%n*nextc%canopy_layer_yesterday)/newn

do i=1, cp_nlevcan
do i=1, nlevcan
if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then
currentCohort%year_net_uptake(i) = min(nextc%year_net_uptake(i),currentCohort%year_net_uptake(i))
else
Expand Down
16 changes: 8 additions & 8 deletions components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,11 +6,11 @@ module EDGrowthFunctionsMod
! At present, there is only a single allocation trajectory.
! ============================================================================

use shr_kind_mod , only : r8 => shr_kind_r8
use FatesConstantsMod, only : r8 => fates_r8
use FatesGlobals , only : fates_log
use pftconMod , only : pftcon
use EDEcophysContype , only : EDecophyscon
use EDTypesMod , only : ed_cohort_type, cp_nlevcan, dinc_ed
use EDTypesMod , only : ed_cohort_type, nlevcan, dinc_ed

implicit none
private
Expand Down Expand Up @@ -159,10 +159,10 @@ real(r8) function tree_lai( cohort_in )
cohort_in%treelai = tree_lai

! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it
! at the moments cp_nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a
! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a
! huge error
if(cohort_in%treelai > cp_nlevcan*dinc_ed)then
write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , cp_nlevcan * dinc_ed
if(cohort_in%treelai > nlevcan*dinc_ed)then
write(fates_log(),*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevcan * dinc_ed
endif

return
Expand Down Expand Up @@ -196,10 +196,10 @@ real(r8) function tree_sai( cohort_in )
cohort_in%treesai = tree_sai

! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it
! at the moments cp_nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a
! at the moments nlevcan default is 40, which is very large, so exceeding this would clearly illustrate a
! huge error
if(cohort_in%treesai > cp_nlevcan*dinc_ed)then
write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , cp_nlevcan * dinc_ed
if(cohort_in%treesai > nlevcan*dinc_ed)then
write(fates_log(),*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevcan * dinc_ed
endif

return
Expand Down
Loading

0 comments on commit 6a5aa19

Please sign in to comment.