Skip to content

Commit

Permalink
Interface: endrun and cleaning of fates<->hlm globals
Browse files Browse the repository at this point in the history 
Merge branch 'rgknox-endrun-maxcohort-weights'

In this change-set roughly two objectives are tackled. 1) a wrapper
was created to call the CIME shutdown/end-run utitlities. The wrapper
is essentially the same wrapper that CLM uses, but we need our own to
break dependence. 2) We have various globals in FATES that are
dictated by the HLM, and vice versa. I tried to wrangle these
variables into FatesInterfaceMod, and give them some functions to set
those variables and protect them. Moreover, the new global
fates_maxElementsPerSite and fates_maxElementsPerPatch, are calculate
based on the maximum requirements for array allocation for FATES
restarts. Previously, this was a hard-coded and misleading
value. While FATES asks the HLM to allocate a "cohort" array for
restart variables, it is really a multi-purpose array, and may be
larger than the needs we have to store cohorts.

Fixes: #178 and #177 and #144 and #186
Addresses: #141

User interface changes?: No

Code review:

Testing:

  rgknox:

    Test suite: edTest, clm_short_45
    Test baseline: 8b2ca7e (PR #176)
    Test namelist changes: None
    Test answer changes: b4b with baseline
    Test summary: all PASS

  andre

    Test suite: ed - yellowstone gnu, intel, pgi
                     hobart nag
    Test baseline: cdb9db7
    Test namelist changes: none
    Test answer: bit for bit
    Test summary: all tests pass

    Test suite: clm_short - yellowstone gnu, intel, pgi
    Test baseline: clm4_5_12_r195
    Test namelist changes: none
    Test answer: bit for bit
    Test summary: all tests pass
  • Loading branch information
@bandre-ucar
bandre-ucar committed Mar 6, 2017
2 parents cdb9db7 + d12288a commit b0bceb0
Show file tree
Hide file tree
Showing 28 changed files with 944 additions and 966 deletions.
63 changes: 31 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 @@ -138,7 +140,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 @@ -199,7 +201,7 @@ subroutine canopy_structure( currentSite )
currentCohort%dbh = currentCohort%dbh
copyc%dbh = copyc%dbh !+ 0.000000000001_r8
!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 @@ -244,8 +246,8 @@ subroutine canopy_structure( currentSite )
currentCohort%canopy_layer = i + 1 !the whole cohort becomes demoted
sumloss = sumloss + currentCohort%c_area

!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 @@ -292,7 +294,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 @@ -317,7 +319,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 @@ -492,7 +494,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 @@ -519,7 +521,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 @@ -530,7 +532,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 @@ -592,7 +594,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 @@ -601,7 +602,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 @@ -624,7 +625,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 @@ -659,6 +660,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 @@ -698,7 +700,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 @@ -772,7 +774,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 @@ -848,7 +850,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 @@ -1101,10 +1103,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 @@ -1162,7 +1164,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 @@ -1189,7 +1191,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 @@ -1213,8 +1214,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 @@ -223,7 +227,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 @@ -236,12 +239,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 @@ -274,9 +277,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 @@ -530,7 +533,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 @@ -602,7 +605,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 @@ -754,7 +757,7 @@ subroutine fuse_cohorts(patchptr)
currentCohort%npp_bseed = (currentCohort%n*currentCohort%npp_bseed + nextc%n*nextc%npp_bseed)/newn
currentCohort%npp_store = (currentCohort%n*currentCohort%npp_store + nextc%n*nextc%npp_store)/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 b0bceb0

Please sign in to comment.