Skip to content

Commit

Permalink
Conflict resolution: re-named gpp and npp accumulation/hold variables…
Browse files Browse the repository at this point in the history 
… needed to be applied to the new restart variable list.
  • Loading branch information
@rgknox
rgknox committed Dec 6, 2016
2 parents fc3f10a + 29b03dc commit 613a301
Show file tree
Hide file tree
Showing 9 changed files with 154 additions and 112 deletions.
13 changes: 7 additions & 6 deletions biogeochem/EDCanopyStructureMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -742,7 +742,7 @@ subroutine canopy_summarization( nsites, sites, bc_in )
if(currentCohort%balive <= 0._r8)then
write(fates_log(),*) 'ED: balive is zero in canopy_summarization',currentCohort%balive
endif

currentCohort => currentCohort%taller

enddo ! ends 'do while(associated(currentCohort))
Expand Down Expand Up @@ -995,8 +995,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * &
EDecophyscon%crown(currentCohort%pft)) ! pftcon%vertical_canopy_frac(ft))

write(fates_log(), *) 'calc snow 2', snow_depth_si , frac_sno_eff_si

fraction_exposed =1.0_r8

currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv)+ dinc_ed * fleaf * &
Expand All @@ -1014,9 +1012,12 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
currentPatch%layer_height_profile(L,ft,iv) = currentPatch%layer_height_profile(L,ft,iv) + (dinc_ed * fleaf * &
currentCohort%c_area/currentPatch%total_canopy_area *(layer_top_hite+layer_bottom_hite)/2.0_r8) !average height of layer.

write(fates_log(), *) 'LHP', currentPatch%layer_height_profile(L,ft,iv)
if ( DEBUG ) write(fates_log(), *) 'EDCLMLink 1246 ', currentPatch%elai_profile(1,ft,iv)

if ( DEBUG ) then
write(fates_log(), *) 'calc snow 2', snow_depth_si , frac_sno_eff_si
write(fates_log(), *) 'LHP', currentPatch%layer_height_profile(L,ft,iv)
write(fates_log(), *) 'EDCLMLink 1246 ', currentPatch%elai_profile(1,ft,iv)
end if

end do

!Bottom layer
Expand Down
125 changes: 71 additions & 54 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,10 @@ module EDCohortDynamicsMod
! Cohort stuctures in ED.
!
! !USES:
use shr_kind_mod , only : r8 => shr_kind_r8;
use clm_varctl , only : iulog
use abortutils , only : endrun
use FatesGlobals , only : fates_log
use FatesConstantsMod , only : r8 => fates_r8
use shr_log_mod , only : errMsg => shr_log_errMsg
use pftconMod , only : pftcon
use EDEcophysContype , only : EDecophyscon
use EDGrowthFunctionsMod , only : c_area, tree_lai
Expand All @@ -32,6 +34,9 @@ module EDCohortDynamicsMod

logical, parameter :: DEBUG = .false. ! local debug flag

character(len=*), parameter, private :: sourcefile = &
__FILE__

! 10/30/09: Created by Rosie Fisher
!-------------------------------------------------------------------------------------!

Expand Down Expand Up @@ -95,13 +100,18 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, &
call size_and_type_class_index(new_cohort%dbh,new_cohort%pft, &
new_cohort%size_class,new_cohort%size_by_pft_class)

if ( DEBUG ) write(iulog,*) 'EDCohortDyn I ',bstore
if ( DEBUG ) write(fates_log(),*) 'EDCohortDyn I ',bstore

if (new_cohort%dbh <= 0.0_r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 &
.or. new_cohort%canopy_trim <= 0.0_r8 .or. new_cohort%balive <= 0._r8) then
write(iulog,*) 'ED: something is zero in create_cohort', &
! This routine may be called during restarts, and at this point in the call sequence
! the actual cohort data is unknown, as this is really only used for allocation
! In these cases, testing if things like biomass are reasonable is pre-mature
! However, in this part of the code, we will pass in nominal values for size, number and type

if (new_cohort%dbh <= 0.0_r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 ) then
write(fates_log(),*) 'ED: something is zero in create_cohort', &
new_cohort%indexnumber,new_cohort%dbh,new_cohort%n, &
new_cohort%pft,new_cohort%canopy_trim,new_cohort%balive
new_cohort%pft
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

if (new_cohort%siteptr%status==2 .and. pftcon%season_decid(pft) == 1) then
Expand Down Expand Up @@ -274,12 +284,12 @@ subroutine allocate_live_biomass(cc_p,mode)
endif

if (abs(currentcohort%balive -currentcohort%bl- currentcohort%br - currentcohort%bsw)>1e-12) then
write(iulog,*) 'issue with carbon allocation in create_cohort,allocate_live_biomass',&
write(fates_log(),*) 'issue with carbon allocation in create_cohort,allocate_live_biomass',&
currentcohort%balive -currentcohort%bl- currentcohort%br - currentcohort%bsw, &
currentcohort%status_coh,currentcohort%balive
write(iulog,*) 'actual vs predicted balive',ideal_balive,currentcohort%balive ,ratio_balive,leaf_frac
write(iulog,*) 'leaf,root,stem',currentcohort%bl,currentcohort%br,currentcohort%bsw
write(iulog,*) 'pft',ft,pftcon%evergreen(ft),pftcon%season_decid(ft),leaves_off_switch
write(fates_log(),*) 'actual vs predicted balive',ideal_balive,currentcohort%balive ,ratio_balive,leaf_frac
write(fates_log(),*) 'leaf,root,stem',currentcohort%bl,currentcohort%br,currentcohort%bsw
write(fates_log(),*) 'pft',ft,pftcon%evergreen(ft),pftcon%season_decid(ft),leaves_off_switch
endif
currentCohort%b = currentCohort%bdead + currentCohort%balive

Expand Down Expand Up @@ -347,16 +357,16 @@ subroutine nan_cohort(cc_p)
currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2)

! CARBON FLUXES
currentCohort%gpp = nan ! GPP: kgC/indiv/year
currentCohort%gpp_tstep = nan ! GPP: kgC/indiv/timestep
currentCohort%gpp_acc_hold = nan ! GPP: kgC/indiv/year
currentCohort%gpp_tstep = nan ! GPP: kgC/indiv/timestep
currentCohort%gpp_acc = nan ! GPP: kgC/indiv/day
currentCohort%npp = nan ! NPP: kgC/indiv/year
currentCohort%npp_tstep = nan ! NPP: kGC/indiv/timestep
currentCohort%npp_acc_hold = nan ! NPP: kgC/indiv/year
currentCohort%npp_tstep = nan ! NPP: kGC/indiv/timestep
currentCohort%npp_acc = nan ! NPP: kgC/indiv/day
currentCohort%year_net_uptake(:) = nan ! Net uptake of individual leaf layers kgC/m2/year
currentCohort%ts_net_uptake(:) = nan ! Net uptake of individual leaf layers kgC/m2/s
currentCohort%resp = nan ! RESP: kgC/indiv/year
currentCohort%resp_tstep = nan ! RESP: kgC/indiv/timestep
currentCohort%resp_acc_hold = nan ! RESP: kgC/indiv/year
currentCohort%resp_tstep = nan ! RESP: kgC/indiv/timestep
currentCohort%resp_acc = nan ! RESP: kGC/cohort/day

currentCohort%npp_leaf = nan
Expand Down Expand Up @@ -435,10 +445,10 @@ subroutine zero_cohort(cc_p)
currentcohort%npp_acc = 0._r8
currentcohort%gpp_acc = 0._r8
currentcohort%resp_acc = 0._r8
currentcohort%npp_tstep = 0._r8
currentcohort%gpp_tstep = 0._r8
currentcohort%resp_tstep = 0._r8
currentcohort%resp = 0._r8
currentcohort%npp_tstep = 0._r8
currentcohort%gpp_tstep = 0._r8
currentcohort%resp_tstep = 0._r8
currentcohort%resp_acc_hold = 0._r8
currentcohort%carbon_balance = 0._r8
currentcohort%leaf_litter = 0._r8
currentcohort%year_net_uptake(:) = 999 ! this needs to be 999, or trimming of new cohorts will break.
Expand All @@ -448,8 +458,8 @@ subroutine zero_cohort(cc_p)
currentcohort%md = 0._r8
currentcohort%root_md = 0._r8
currentcohort%leaf_md = 0._r8
currentcohort%npp = 0._r8
currentcohort%gpp = 0._r8
currentcohort%npp_acc_hold = 0._r8
currentcohort%gpp_acc_hold = 0._r8
currentcohort%storage_flux = 0._r8
currentcohort%dmort = 0._r8
currentcohort%gscan = 0._r8
Expand Down Expand Up @@ -496,7 +506,7 @@ subroutine terminate_cohorts( patchptr )
if (currentcohort%n < min_n_safemath) then
terminate = 1
if ( DEBUG ) then
write(iulog,*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh
write(fates_log(),*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh
endif
endif

Expand All @@ -510,31 +520,31 @@ subroutine terminate_cohorts( patchptr )
terminate = 1

if ( DEBUG ) then
write(iulog,*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh
write(fates_log(),*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh
endif
endif

! In the third canopy layer
if (currentCohort%canopy_layer > cp_nclmax ) then
terminate = 1
if ( DEBUG ) then
write(iulog,*) 'terminating cohorts 2', currentCohort%canopy_layer
write(fates_log(),*) 'terminating cohorts 2', currentCohort%canopy_layer
endif
endif

! live biomass pools are terminally depleted
if (currentCohort%balive < 1e-10_r8 .or. currentCohort%bstore < 1e-10_r8) then
terminate = 1
if ( DEBUG ) then
write(iulog,*) 'terminating cohorts 3', currentCohort%balive,currentCohort%bstore
write(fates_log(),*) 'terminating cohorts 3', currentCohort%balive,currentCohort%bstore
endif
endif

! Total cohort biomass is negative
if (currentCohort%balive+currentCohort%bdead+currentCohort%bstore < 0._r8) then
terminate = 1
if ( DEBUG ) then
write(iulog,*) 'terminating cohorts 4', currentCohort%balive, &
write(fates_log(),*) 'terminating cohorts 4', currentCohort%balive, &
currentCohort%bstore, currentCohort%bdead, &
currentCohort%balive+currentCohort%bdead+&
currentCohort%bstore, currentCohort%n
Expand Down Expand Up @@ -667,11 +677,11 @@ subroutine fuse_cohorts(patchptr)
currentCohort%balive = (currentCohort%n*currentCohort%balive + nextc%n*nextc%balive)/newn
currentCohort%bdead = (currentCohort%n*currentCohort%bdead + nextc%n*nextc%bdead)/newn

if ( DEBUG ) write(iulog,*) 'EDcohortDyn I ',currentCohort%bstore
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn I ',currentCohort%bstore

currentCohort%bstore = (currentCohort%n*currentCohort%bstore + nextc%n*nextc%bstore)/newn

if ( DEBUG ) write(iulog,*) 'EDcohortDyn II ',currentCohort%bstore
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn II ',currentCohort%bstore

currentCohort%seed_prod = (currentCohort%n*currentCohort%seed_prod + nextc%n*nextc%seed_prod)/newn
currentCohort%root_md = (currentCohort%n*currentCohort%root_md + nextc%n*nextc%root_md)/newn
Expand All @@ -689,29 +699,36 @@ subroutine fuse_cohorts(patchptr)
currentCohort%bsw = (currentCohort%n*currentCohort%bsw + nextc%n*nextc%bsw)/newn
currentCohort%bl = (currentCohort%n*currentCohort%bl + nextc%n*nextc%bl)/newn

if ( DEBUG ) write(iulog,*) 'EDcohortDyn 569 ',currentCohort%br
if ( DEBUG ) write(iulog,*) 'EDcohortDyn 570 ',currentCohort%n
if ( DEBUG ) write(iulog,*) 'EDcohortDyn 571 ',nextc%br
if ( DEBUG ) write(iulog,*) 'EDcohortDyn 572 ',nextc%n
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn 569 ',currentCohort%br
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn 570 ',currentCohort%n
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn 571 ',nextc%br
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn 572 ',nextc%n

currentCohort%br = (currentCohort%n*currentCohort%br + nextc%n*nextc%br)/newn
currentCohort%hite = (currentCohort%n*currentCohort%hite + nextc%n*nextc%hite)/newn
currentCohort%dbh = (currentCohort%n*currentCohort%dbh + nextc%n*nextc%dbh)/newn

currentCohort%gpp_acc = (currentCohort%n*currentCohort%gpp_acc + nextc%n*nextc%gpp_acc)/newn

if ( DEBUG ) write(iulog,*) 'EDcohortDyn III ',currentCohort%npp_acc
if ( DEBUG ) write(iulog,*) 'EDcohortDyn IV ',currentCohort%resp_acc
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn III ',currentCohort%npp_acc
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn IV ',currentCohort%resp_acc

currentCohort%npp_acc = (currentCohort%n*currentCohort%npp_acc + nextc%n*nextc%npp_acc)/newn
currentCohort%resp_acc = (currentCohort%n*currentCohort%resp_acc + nextc%n*nextc%resp_acc)/newn

if ( DEBUG ) write(iulog,*) 'EDcohortDyn V ',currentCohort%npp_acc
if ( DEBUG ) write(iulog,*) 'EDcohortDyn VI ',currentCohort%resp_acc
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn V ',currentCohort%npp_acc
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn VI ',currentCohort%resp_acc

currentCohort%resp_acc_hold = &
(currentCohort%n*currentCohort%resp_acc_hold + &
nextc%n*nextc%resp_acc_hold)/newn
currentCohort%npp_acc_hold = &
(currentCohort%n*currentCohort%npp_acc_hold + &
nextc%n*nextc%npp_acc_hold)/newn
currentCohort%gpp_acc_hold = &
(currentCohort%n*currentCohort%gpp_acc_hold + &
nextc%n*nextc%gpp_acc_hold)/newn

currentCohort%resp = (currentCohort%n*currentCohort%resp + nextc%n*nextc%resp)/newn
currentCohort%npp = (currentCohort%n*currentCohort%npp + nextc%n*nextc%npp)/newn
currentCohort%gpp = (currentCohort%n*currentCohort%gpp + nextc%n*nextc%gpp)/newn
currentCohort%canopy_trim = (currentCohort%n*currentCohort%canopy_trim + nextc%n*nextc%canopy_trim)/newn
currentCohort%dmort = (currentCohort%n*currentCohort%dmort + nextc%n*nextc%dmort)/newn
currentCohort%fire_mort = (currentCohort%n*currentCohort%fire_mort + nextc%n*nextc%fire_mort)/newn
Expand Down Expand Up @@ -791,7 +808,7 @@ subroutine fuse_cohorts(patchptr)
!---------------------------------------------------------------------!
dynamic_fusion_tolerance = dynamic_fusion_tolerance * 1.1_r8

write(iulog,*) 'maxcohorts exceeded',dynamic_fusion_tolerance
write(fates_log(),*) 'maxcohorts exceeded',dynamic_fusion_tolerance

else
iterate = 0
Expand Down Expand Up @@ -1017,20 +1034,20 @@ subroutine copy_cohort( currentCohort,copyc )
n%excl_weight = o%excl_weight
n%prom_weight = o%prom_weight

! CARBON FLUXES
n%gpp = o%gpp
! CARBON FLUXES
n%gpp_acc_hold = o%gpp_acc_hold
n%gpp_acc = o%gpp_acc
n%gpp_tstep = o%gpp_tstep
n%npp = o%npp
n%npp_tstep = o%npp_tstep
n%gpp_tstep = o%gpp_tstep
n%npp_acc_hold = o%npp_acc_hold
n%npp_tstep = o%npp_tstep

if ( DEBUG ) write(iulog,*) 'EDcohortDyn Ia ',o%npp_acc
if ( DEBUG ) write(iulog,*) 'EDcohortDyn Ib ',o%resp_acc
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn Ia ',o%npp_acc
if ( DEBUG ) write(fates_log(),*) 'EDcohortDyn Ib ',o%resp_acc

n%npp_acc = o%npp_acc
n%resp_tstep = o%resp_tstep
n%npp_acc_hold = o%npp_acc_hold
n%resp_tstep = o%resp_tstep
n%resp_acc = o%resp_acc
n%resp = o%resp
n%resp_acc_hold = o%resp_acc_hold
n%year_net_uptake = o%year_net_uptake
n%ts_net_uptake = o%ts_net_uptake

Expand Down Expand Up @@ -1080,7 +1097,7 @@ subroutine copy_cohort( currentCohort,copyc )
n%dbdeaddt = o%dbdeaddt
n%dbstoredt = o%dbstoredt

if ( DEBUG ) write(iulog,*) 'EDCohortDyn dpstoredt ',o%dbstoredt
if ( DEBUG ) write(fates_log(),*) 'EDCohortDyn dpstoredt ',o%dbstoredt

n%storage_flux = o%storage_flux

Expand Down Expand Up @@ -1129,7 +1146,7 @@ function count_cohorts( currentPatch ) result ( backcount )
enddo

if (backcount /= currentPatch%countcohorts) then
write(iulog,*) 'problem with linked list, not symmetrical'
write(fates_log(),*) 'problem with linked list, not symmetrical'
endif

end function count_cohorts
Expand Down
Loading

0 comments on commit 613a301

Please sign in to comment.