diff --git a/cime/cime_config/cesm/machines/config_compilers.xml b/cime/cime_config/cesm/machines/config_compilers.xml index 4456f841a0..318ac8ed9a 100644 --- a/cime/cime_config/cesm/machines/config_compilers.xml +++ b/cime/cime_config/cesm/machines/config_compilers.xml @@ -556,6 +556,7 @@ for mct, etc. $(NETCDF_HOME) -DLinux -DCPRGNU + -ffree-line-length-132 -ffpe-trap=invalid,zero,overflow -L$(NETCDF_HOME)/lib/ -lnetcdff -lnetcdf -lcurl -llapack -lblas -DHAVE_VPRINTF -DHAVE_GETTIMEOFDAY diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index 5ce6d6631f..f5419cedd7 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -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)) @@ -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 * & @@ -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 diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index cdca9ec65b..81143bd553 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -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 @@ -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 !-------------------------------------------------------------------------------------! @@ -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 @@ -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 @@ -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 @@ -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. @@ -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 @@ -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 @@ -510,7 +520,7 @@ 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 @@ -518,7 +528,7 @@ subroutine terminate_cohorts( patchptr ) 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 @@ -526,7 +536,7 @@ subroutine terminate_cohorts( patchptr ) 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 @@ -534,7 +544,7 @@ subroutine terminate_cohorts( patchptr ) 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 @@ -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 @@ -689,10 +699,10 @@ 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 @@ -700,18 +710,25 @@ subroutine fuse_cohorts(patchptr) 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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index c0d2b25dfb..fccd8c0843 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -789,9 +789,9 @@ subroutine Growth_Derivatives( currentSite, currentCohort) ! NPP if ( DEBUG ) write(iulog,*) 'EDphys 716 ',currentCohort%npp_acc - currentCohort%npp = currentCohort%npp_acc * udata%n_sub !Link to CLM. convert from kgC/indiv/day into kgC/indiv/year - currentCohort%gpp = currentCohort%gpp_acc * udata%n_sub !Link to CLM. convert from kgC/indiv/day into kgC/indiv/year - currentCohort%resp = currentCohort%resp_acc * udata%n_sub !Link to CLM. convert from kgC/indiv/day into kgC/indiv/year + currentCohort%npp_acc_hold = currentCohort%npp_acc * udata%n_sub ! convert from kgC/indiv/day into kgC/indiv/year + currentCohort%gpp_acc_hold = currentCohort%gpp_acc * udata%n_sub ! convert from kgC/indiv/day into kgC/indiv/year + currentCohort%resp_acc_hold = currentCohort%resp_acc * udata%n_sub ! convert from kgC/indiv/day into kgC/indiv/year currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n @@ -833,16 +833,17 @@ subroutine Growth_Derivatives( currentSite, currentCohort) ! Calculate carbon balance ! this is the fraction of maintenance demand we -have- to do... - if ( DEBUG ) write(iulog,*) 'EDphys 760 ',currentCohort%npp, currentCohort%md, & + if ( DEBUG ) write(iulog,*) 'EDphys 760 ',currentCohort%npp_acc_hold, currentCohort%md, & EDecophyscon%leaf_stor_priority(currentCohort%pft) - currentCohort%carbon_balance = currentCohort%npp - currentCohort%md * EDecophyscon%leaf_stor_priority(currentCohort%pft) + currentCohort%carbon_balance = currentCohort%npp_acc_hold - & + currentCohort%md * EDecophyscon%leaf_stor_priority(currentCohort%pft) ! Allowing only carbon from NPP pool to account for npp flux into the maintenance pools ! ie this does not include any use of storage carbon or balive to make up for missing carbon balance in the transfer - currentCohort%npp_leaf = min(currentCohort%npp*currentCohort%leaf_md/currentCohort%md, & + currentCohort%npp_leaf = min(currentCohort%npp_acc_hold*currentCohort%leaf_md/currentCohort%md, & currentCohort%leaf_md*EDecophyscon%leaf_stor_priority(currentCohort%pft)) - currentCohort%npp_froot = min(currentCohort%npp*currentCohort%root_md/currentCohort%md, & + currentCohort%npp_froot = min(currentCohort%npp_acc_hold*currentCohort%root_md/currentCohort%md, & currentCohort%root_md*EDecophyscon%leaf_stor_priority(currentCohort%pft)) @@ -944,12 +945,12 @@ subroutine Growth_Derivatives( currentSite, currentCohort) if ( DEBUG ) write(iulog,*) 'EDPhys dbstoredt I ',currentCohort%dbstoredt currentCohort%seed_prod = (1.0_r8 - gr_fract) * currentCohort%carbon_balance - if (abs(currentCohort%npp-(currentCohort%dbalivedt+currentCohort%dbdeaddt+currentCohort%dbstoredt+ & + if (abs(currentCohort%npp_acc_hold-(currentCohort%dbalivedt+currentCohort%dbdeaddt+currentCohort%dbstoredt+ & currentCohort%seed_prod+currentCohort%md)) > 0.0000000001_r8)then - write(iulog,*) 'error in carbon check growth derivs',currentCohort%npp- & + write(iulog,*) 'error in carbon check growth derivs',currentCohort%npp_acc_hold- & (currentCohort%dbalivedt+currentCohort%dbdeaddt+currentCohort%dbstoredt+currentCohort%seed_prod+currentCohort%md) write(iulog,*) 'cohort fluxes',currentCohort%pft,currentCohort%canopy_layer,currentCohort%n, & - currentCohort%npp,currentCohort%dbalivedt,balive_loss, & + currentCohort%npp_acc_hold,currentCohort%dbalivedt,balive_loss, & currentCohort%dbdeaddt,currentCohort%dbstoredt,currentCohort%seed_prod,currentCohort%md * & EDecophyscon%leaf_stor_priority(currentCohort%pft) write(iulog,*) 'proxies' ,target_balive,currentCohort%balive,currentCohort%dbh,va,vs,gr_fract diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index c4bdd45df6..2086dcb146 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -401,7 +401,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) !How much diffuse light is intercepted and then reflected? refl_dif(L,ft,iv,ib) = (1._r8 - tr_dif_z(L,ft,iv)) * rhol(ft,ib) !How much diffuse light in this layer is transmitted? - tran_dif(L,ft,iv,ib) = (1._r8 - tr_dif_z(L,ft,iv)) * taul(ft,ib) + tr_dif_z(L,ft,iv) + tran_dif(L,ft,iv,ib) = (1._r8 - tr_dif_z(L,ft,iv)) * & + taul(ft,ib) + tr_dif_z(L,ft,iv) end do !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! @@ -418,13 +419,17 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) ! FIX(RF,032414) ray tracing eqution - need to find derivation of this... ! for each unit going down, there are x units going up. do iv = currentPatch%nrad(L,ft),1, -1 - dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv+1,ib) * tran_dif(L,ft,iv,ib)*tran_dif(L,ft,iv,ib) / & - (1._r8 - dif_ratio(L,ft,iv+1,ib) * refl_dif(L,ft,iv,ib)) + refl_dif(L,ft,iv,ib) - dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv,ib) * ftweight(L,ft,iv)/ftweight(L,ft,1) - dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv,ib) + dif_ratio(L,ft,iv+1,ib)* & + dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv+1,ib) * & + tran_dif(L,ft,iv,ib)*tran_dif(L,ft,iv,ib) / & + (1._r8 - dif_ratio(L,ft,iv+1,ib) * refl_dif(L,ft,iv,ib)) & + + refl_dif(L,ft,iv,ib) + dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv,ib) * & + ftweight(L,ft,iv)/ftweight(L,ft,1) + dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv,ib) + dif_ratio(L,ft,iv+1,ib) * & (ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1) end do - weighted_dif_ratio(L,ib) = weighted_dif_ratio(L,ib) + dif_ratio(L,ft,1,ib) * ftweight(L,ft,1) + weighted_dif_ratio(L,ib) = weighted_dif_ratio(L,ib) + & + dif_ratio(L,ft,1,ib) * ftweight(L,ft,1) !instance where the first layer ftweight is used a proxy for the whole column. FTWA end do!cp_numSWb endif ! currentPatch%present diff --git a/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90 index 559c4b91ba..9499f93d02 100755 --- a/components/clm/src/ED/main/EDMainMod.F90 +++ b/components/clm/src/ED/main/EDMainMod.F90 @@ -202,7 +202,8 @@ subroutine ed_integrate_state_variables(currentSite, temperature_inst ) currentCohort%bstore+udata%deltat* & (currentCohort%md+currentCohort%seed_prod)-cohort_biomass_store-currentCohort%npp_acc) endif - !do we need these any more? + + ! THESE SHOULD BE MOVED TO A MORE "VISIBLE" LOCATION (RGK 10-2016) currentCohort%npp_acc = 0.0_r8 currentCohort%gpp_acc = 0.0_r8 currentCohort%resp_acc = 0.0_r8 diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index f655c1be78..a24a493f57 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -58,8 +58,8 @@ module EDRestVectorMod real(r8), pointer :: n(:) real(r8), pointer :: gpp_acc(:) real(r8), pointer :: npp_acc(:) - real(r8), pointer :: gpp(:) - real(r8), pointer :: npp(:) + real(r8), pointer :: gpp_acc_hold(:) + real(r8), pointer :: npp_acc_hold(:) real(r8), pointer :: npp_leaf(:) real(r8), pointer :: npp_froot(:) real(r8), pointer :: npp_bsw(:) @@ -168,7 +168,8 @@ module EDRestVectorMod module procedure newEDRestartVectorClass end interface EDRestartVectorClass - character(len=*), private, parameter :: mod_filename = __FILE__ + character(len=*), private, parameter :: mod_filename = & + __FILE__ ! ! non type-bound procedures @@ -212,8 +213,8 @@ subroutine deleteEDRestartVectorClass( this ) deallocate(this%n ) deallocate(this%gpp_acc ) deallocate(this%npp_acc ) - deallocate(this%gpp ) - deallocate(this%npp ) + deallocate(this%gpp_acc_hold ) + deallocate(this%npp_acc_hold ) deallocate(this%npp_leaf ) deallocate(this%npp_froot ) deallocate(this%npp_bsw ) @@ -499,15 +500,15 @@ function newEDRestartVectorClass( bounds ) SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) new%npp_acc(:) = 0.0_r8 - allocate(new%gpp & + allocate(new%gpp_acc_hold & (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%gpp(:) = 0.0_r8 + new%gpp_acc_hold(:) = 0.0_r8 - allocate(new%npp & + allocate(new%npp_acc_hold & (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp(:) = 0.0_r8 + new%npp_acc_hold(:) = 0.0_r8 allocate(new%npp_leaf & (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) @@ -1022,16 +1023,16 @@ subroutine doVectorIO( this, ncid, flag ) interpinic_flag='interp', data=this%npp_acc, & readvar=readvar) - call restartvar(ncid=ncid, flag=flag, varname='ed_gpp', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='ed_gpp_acc_hold', xtype=ncd_double, & dim1name=coh_dimName, & long_name='ed cohort - gpp', units='unitless', & - interpinic_flag='interp', data=this%gpp, & + interpinic_flag='interp', data=this%gpp_acc_hold, & readvar=readvar) - call restartvar(ncid=ncid, flag=flag, varname='ed_npp', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='ed_npp_acc_hold', xtype=ncd_double, & dim1name=coh_dimName, & long_name='ed cohort - npp', units='unitless', & - interpinic_flag='interp', data=this%npp, & + interpinic_flag='interp', data=this%npp_acc_hold, & readvar=readvar) call restartvar(ncid=ncid, flag=flag, varname='ed_npp_leaf', xtype=ncd_double, & @@ -1306,9 +1307,9 @@ subroutine printDataInfoVector( this ) write(iulog,*) trim(methodName)//' :: npp_acc ', & this%npp_acc(iSta:iSto) write(iulog,*) trim(methodName)//' :: gpp ', & - this%gpp(iSta:iSto) + this%gpp_acc_hold(iSta:iSto) write(iulog,*) trim(methodName)//' :: npp ', & - this%npp(iSta:iSto) + this%npp_acc_hold(iSta:iSto) write(iulog,*) trim(methodName)//' :: npp_leaf ', & this%npp_leaf(iSta:iSto) write(iulog,*) trim(methodName)//' :: npp_froot ', & @@ -1461,8 +1462,8 @@ subroutine printDataInfoLL( this, bounds, nsites, sites ) write(iulog,*) trim(methodName)//' n ' ,totalCohorts,currentCohort%n write(iulog,*) trim(methodName)//' gpp_acc ' ,totalCohorts,currentCohort%gpp_acc write(iulog,*) trim(methodName)//' npp_acc ' ,totalCohorts,currentCohort%npp_acc - write(iulog,*) trim(methodName)//' gpp ' ,totalCohorts,currentCohort%gpp - write(iulog,*) trim(methodName)//' npp ' ,totalCohorts,currentCohort%npp + write(iulog,*) trim(methodName)//' gpp_acc_hold ' ,totalCohorts,currentCohort%gpp_acc_hold + write(iulog,*) trim(methodName)//' npp_acc_hold ' ,totalCohorts,currentCohort%npp_acc_hold write(iulog,*) trim(methodName)//' npp_leaf ' ,totalCohorts,currentCohort%npp_leaf write(iulog,*) trim(methodName)//' npp_froot ' ,totalCohorts,currentCohort%npp_froot write(iulog,*) trim(methodName)//' npp_bsw ' ,totalCohorts,currentCohort%npp_bsw @@ -1597,8 +1598,8 @@ subroutine printIoInfoLL( this, bounds, nsites, sites, fcolumn ) write(iulog,*) trim(methodName)//' n ',currentCohort%n write(iulog,*) trim(methodName)//' gpp_acc ',currentCohort%gpp_acc write(iulog,*) trim(methodName)//' npp_acc ',currentCohort%npp_acc - write(iulog,*) trim(methodName)//' gpp ',currentCohort%gpp - write(iulog,*) trim(methodName)//' npp ',currentCohort%npp + write(iulog,*) trim(methodName)//' gpp_acc_hold ',currentCohort%gpp_acc_hold + write(iulog,*) trim(methodName)//' npp_acc_hold ',currentCohort%npp_acc_hold write(iulog,*) trim(methodName)//' npp_leaf ',currentCohort%npp_leaf write(iulog,*) trim(methodName)//' npp_froot ',currentCohort%npp_froot write(iulog,*) trim(methodName)//' npp_bsw ',currentCohort%npp_bsw @@ -1742,8 +1743,8 @@ subroutine convertCohortListToVector( this, bounds, nsites, sites, fcolumn ) this%n(countCohort) = currentCohort%n this%gpp_acc(countCohort) = currentCohort%gpp_acc this%npp_acc(countCohort) = currentCohort%npp_acc - this%gpp(countCohort) = currentCohort%gpp - this%npp(countCohort) = currentCohort%npp + this%gpp_acc_hold(countCohort) = currentCohort%gpp_acc_hold + this%npp_acc_hold(countCohort) = currentCohort%npp_acc_hold this%npp_leaf(countCohort) = currentCohort%npp_leaf this%npp_froot(countCohort) = currentCohort%npp_froot this%npp_bsw(countCohort) = currentCohort%npp_bsw @@ -2030,7 +2031,9 @@ subroutine createPatchCohortStructure( this, bounds, nsites, sites, fcolumn ) ! item it needs, not the entire cohort...refactor temp_cohort%dbh = Dbh(temp_cohort) + 0.0001_r8*ft - write(iulog,*) 'EDRestVectorMod.F90::createPatchCohortStructure call create_cohort ' + if (this%DEBUG) then + write(iulog,*) 'EDRestVectorMod.F90::createPatchCohortStructure call create_cohort ' + end if call create_cohort(newp, ft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & @@ -2179,8 +2182,8 @@ subroutine convertCohortVectorToList( this, bounds, nsites, sites, fcolumn ) currentCohort%n = this%n(countCohort) currentCohort%gpp_acc = this%gpp_acc(countCohort) currentCohort%npp_acc = this%npp_acc(countCohort) - currentCohort%gpp = this%gpp(countCohort) - currentCohort%npp = this%npp(countCohort) + currentCohort%gpp_acc_hold = this%gpp_acc_hold(countCohort) + currentCohort%npp_acc_hold = this%npp_acc_hold(countCohort) currentCohort%npp_leaf = this%npp_leaf(countCohort) currentCohort%npp_froot = this%npp_froot(countCohort) currentCohort%npp_bsw = this%npp_bsw(countCohort) diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index d02891cb28..6de2f1ea2c 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -198,16 +198,36 @@ module EDTypesMod ! because we don't want to continually re-calculate the cohort's position when ! performing size diagnostics at high-frequency calls + ! CARBON FLUXES - real(r8) :: gpp ! GPP: kgC/indiv/year - real(r8) :: gpp_acc ! GPP: kgC/indiv/day - real(r8) :: gpp_tstep ! GPP: kgC/indiv/timestep - real(r8) :: npp ! NPP: kgC/indiv/year - real(r8) :: npp_acc ! NPP: kgC/indiv/day - real(r8) :: npp_tstep ! NPP: kgC/indiv/timestep - real(r8) :: resp ! Resp: kgC/indiv/year - real(r8) :: resp_acc ! Resp: kgC/indiv/day - real(r8) :: resp_tstep ! Resp: kgC/indiv/timestep + + ! ---------------------------------------------------------------------------------- + ! NPP, GPP and RESP: Instantaneous, accumulated and accumulated-hold types.* + ! + ! _tstep: The instantaneous estimate that is calculated at each rapid plant biophysics + ! time-step (ie photosynthesis, sub-hourly). (kgC/indiv/timestep) + ! _acc: The accumulation of the _tstep variable from the beginning to ending of + ! the dynamics time-scale. This variable is zero'd during initialization and + ! after the dynamics call-sequence is completed. (kgC/indiv/day) + ! _acc_hold: While _acc is zero'd after the dynamics call sequence and then integrated, + ! _acc_hold "holds" the integrated value until the next time dynamics is + ! called. This is necessary for restarts. This variable also has units + ! converted to a useful rate (kgC/indiv/yr) + ! ---------------------------------------------------------------------------------- + + real(r8) :: gpp_tstep ! Gross Primary Production (see above *) + real(r8) :: gpp_acc + real(r8) :: gpp_acc_hold + + real(r8) :: npp_tstep ! Net Primary Production (see above *) + real(r8) :: npp_acc + real(r8) :: npp_acc_hold + + real(r8) :: resp_tstep ! Autotrophic respiration (see above *) + real(r8) :: resp_acc + real(r8) :: resp_acc_hold + + ! Net Primary Production Partitions real(r8) :: npp_leaf ! NPP into leaves (includes replacement of turnover): KgC/indiv/day real(r8) :: npp_froot ! NPP into fine roots (includes replacement of turnover): KgC/indiv/day diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index 77aace9d47..faacc7d77a 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -798,9 +798,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) associate( scpf => ccohort%size_by_pft_class ) hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & - n_perm2*ccohort%gpp ! [kgC/m2/yr] + n_perm2*ccohort%gpp_acc_hold ! [kgC/m2/yr] hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & - ccohort%npp*n_perm2 + ccohort%npp_acc_hold *n_perm2 hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & ccohort%npp_leaf*n_perm2 hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & @@ -818,15 +818,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & ccohort%npp_store*n_perm2 - if( abs(ccohort%npp-(ccohort%npp_leaf+ccohort%npp_froot+ & + if( abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_froot+ & ccohort%npp_bsw+ccohort%npp_bdead+ & ccohort%npp_bseed+ccohort%npp_store))>1.e-9) then write(fates_log(),*) 'NPP Partitions are not balancing' write(fates_log(),*) 'Fractional Error: ', & - abs(ccohort%npp-(ccohort%npp_leaf+ccohort%npp_froot+ & + abs(ccohort%npp_acc_hold-(ccohort%npp_leaf+ccohort%npp_froot+ & ccohort%npp_bsw+ccohort%npp_bdead+ & - ccohort%npp_bseed+ccohort%npp_store))/ccohort%npp - write(fates_log(),*) 'Terms: ',ccohort%npp,ccohort%npp_leaf,ccohort%npp_froot, & + ccohort%npp_bseed+ccohort%npp_store))/ccohort%npp_acc_hold + write(fates_log(),*) 'Terms: ',ccohort%npp_acc_hold,ccohort%npp_leaf,ccohort%npp_froot, & ccohort%npp_bsw,ccohort%npp_bdead, & ccohort%npp_bseed,ccohort%npp_store write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance '