From dbb3301f035ff356b35272705e8934d36bf53712 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 18 Oct 2016 20:33:28 -0700 Subject: [PATCH 1/7] Converted %npp and friends to %npp_acc_hold and friends. Documentation included. One free gpp with any resp of equal or lesser value. --- .../ED/biogeochem/EDCanopyStructureMod.F90 | 2 +- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 48 +++++++++---------- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 20 ++++---- components/clm/src/ED/main/EDMainMod.F90 | 3 +- .../clm/src/ED/main/EDRestVectorMod.F90 | 44 ++++++++--------- components/clm/src/ED/main/EDTypesMod.F90 | 38 +++++++++++---- components/clm/src/ED/main/HistoryIOMod.F90 | 12 ++--- 7 files changed, 94 insertions(+), 73 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index a0056056c8..55d785fb83 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -754,7 +754,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)) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index fca32709d3..719f14988b 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -340,16 +340,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 @@ -433,10 +433,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. @@ -446,8 +446,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 @@ -706,10 +706,10 @@ subroutine fuse_cohorts(patchptr) if ( DEBUG ) write(iulog,*) 'EDcohortDyn V ',currentCohort%npp_acc if ( DEBUG ) write(iulog,*) 'EDcohortDyn VI ',currentCohort%resp_acc - - 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%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%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 @@ -1015,20 +1015,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 - 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 diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index c0d2b25dfb..aa2ba42cd4 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,16 @@ 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 +944,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/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..5fbcb72caa 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(:) @@ -212,8 +212,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 +499,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 +1022,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 +1306,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 +1461,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 +1597,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 +1742,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 @@ -2179,8 +2179,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 9f64aefa17..959f025715 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -190,16 +190,36 @@ module EDTypesMod logical :: isnew ! flag to signify a new cohort, new cohorts have not experienced ! npp or mortality and should therefore not be fused or averaged + ! 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/HistoryIOMod.F90 b/components/clm/src/ED/main/HistoryIOMod.F90 index b21edabe18..ca589dc26e 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/HistoryIOMod.F90 @@ -498,9 +498,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) if( .not.(ccohort%isnew) ) then 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) + & @@ -518,15 +518,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 ' From 38f276db4fb4bcb75b95abb1cdc635330e797448 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 31 Oct 2016 17:58:09 -0700 Subject: [PATCH 2/7] Fixed the logic on a warning statement in create cohort. The logic was tripping true for all restart initialization cases and producing false positive warnings. I changed the logic to only trip in cases where the arguments passed into the routine signaled something was unusual, and in that case to kill the run instead of simply report. --- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 72 +++++++++++-------- 1 file changed, 41 insertions(+), 31 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 1d87f95fa8..1ed42734d8 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 @@ -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,14 +710,14 @@ 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 @@ -791,7 +801,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 @@ -1024,8 +1034,8 @@ subroutine copy_cohort( currentCohort,copyc ) 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_hold = o%npp_acc_hold n%resp_tstep = o%resp_tstep @@ -1080,7 +1090,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 +1139,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 From a422ad58043cfea52a484e3517dda313c16900bc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 2 Nov 2016 14:25:26 -0700 Subject: [PATCH 3/7] Added ERP_D_P15x2_Ld5 to the ed test suite. --- components/clm/cime_config/testdefs/testlist_clm.xml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml index 512908b01b..b0f3609389 100644 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ b/components/clm/cime_config/testdefs/testlist_clm.xml @@ -719,6 +719,9 @@ + + ed + ed ed From 4a3b4d60fbc8a9243c385800b9055c5053b528fa Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 2 Nov 2016 15:30:06 -0700 Subject: [PATCH 4/7] Moved more print statements that were reporting when not in debug mode. --- .../clm/src/ED/biogeochem/EDCanopyStructureMod.F90 | 11 ++++++----- components/clm/src/ED/main/EDRestVectorMod.F90 | 4 +++- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index da85a09336..85ece1178a 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -994,8 +994,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 * & @@ -1013,9 +1011,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/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index 5fbcb72caa..b1678bb053 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -2030,7 +2030,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, & From b19e58ec64559269584047f1c9a6d77c29ef571e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 30 Nov 2016 13:44:48 -0800 Subject: [PATCH 5/7] Removed the thread-change test. Will add at a later date when that test starts showing passes. --- components/clm/cime_config/testdefs/testlist_clm.xml | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml index dc01f973cc..ca8f94aeef 100644 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ b/components/clm/cime_config/testdefs/testlist_clm.xml @@ -694,8 +694,8 @@ ed - hobart hobart + hobart yellowstone yellowstone yellowstone @@ -709,8 +709,8 @@ ed - hobart hobart + hobart yellowstone yellowstone @@ -722,20 +722,17 @@ - - ed - ed - hobart ed hobart + hobart yellowstone ed - hobart hobart + hobart yellowstone yellowstone yellowstone From 099f821e52ed39653d3c4d1f74ba0ac0f9598006 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 1 Dec 2016 11:54:20 -0800 Subject: [PATCH 6/7] Reduced a line-length in EDCohortDynanicsMod.F90 to appease the nag gods. --- .../clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 1ed42734d8..81143bd553 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -719,9 +719,16 @@ subroutine fuse_cohorts(patchptr) 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_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%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 From 8e1ae1582a848d4a4fa23b4ab2105a85db4c6f41 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 1 Dec 2016 13:30:31 -0800 Subject: [PATCH 7/7] Reduced more line lengths to be compatible with nag. Also added a maximum line length to the eddi machine settings to help catch these before I submit. --- .../cesm/machines/config_compilers.xml | 1 + .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 3 ++- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 17 +++++++++++------ components/clm/src/ED/main/EDRestVectorMod.F90 | 3 ++- 4 files changed, 16 insertions(+), 8 deletions(-) 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/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index aa2ba42cd4..fccd8c0843 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -836,7 +836,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort) if ( DEBUG ) write(iulog,*) 'EDphys 760 ',currentCohort%npp_acc_hold, currentCohort%md, & EDecophyscon%leaf_stor_priority(currentCohort%pft) - currentCohort%carbon_balance = currentCohort%npp_acc_hold - 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 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/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index b1678bb053..a24a493f57 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -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