Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fixes: carbon flux naming, messages and warning, thread-change test #147

Merged
merged 9 commits into from
Dec 2, 2016
8 changes: 4 additions & 4 deletions components/clm/cime_config/testdefs/testlist_clm.xml
Original file line number Diff line number Diff line change
Expand Up @@ -694,8 +694,8 @@
<grid name="1x1_brazil">
<test name="ERS_D_Mmpi-serial_Ld5">
<machine compiler="ed" testtype="ed" testmods="clm/edTest">ed</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="nag" testtype="aux_clm45" testmods="clm/edTest">hobart</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="gnu" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
<machine compiler="intel" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
<machine compiler="pgi" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
Expand All @@ -709,8 +709,8 @@
</test>
<test name="SMS_D_Mmpi-serial_Ld5">
<machine compiler="ed" testtype="ed" testmods="clm/edTest">ed</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="nag" testtype="aux_clm45" testmods="clm/edTest">hobart</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="intel" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
<machine compiler="pgi" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
</test>
Expand All @@ -724,15 +724,15 @@
<grid name="f10_f10">
<test name="ERS_D_Ld5">
<machine compiler="ed" testtype="ed" testmods="clm/edTest">ed</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edNoFire">ed</machine>
<machine compiler="nag" testtype="aux_clm45" testmods="clm/edTest">hobart</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="intel" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
</test>
<test name="SMS_D_Ld5">
<machine compiler="ed" testtype="ed" testmods="clm/edTest">ed</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="nag" testtype="aux_clm45" testmods="clm/edTest">hobart</machine>
<machine compiler="ed" testtype="ed" testmods="clm/edTest">hobart</machine>
<machine compiler="gnu" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
<machine compiler="intel" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
<machine compiler="pgi" testtype="aux_clm45" testmods="clm/edTest">yellowstone</machine>
Expand Down
13 changes: 7 additions & 6 deletions components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90
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 components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90
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