From fdd35050fc051b0a3fe03c0edba23e48490e27a8 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Wed, 24 Feb 2016 16:40:29 -0700 Subject: [PATCH 01/15] Changed temporary_spitfire_switch to 1 --- components/clm/src/ED/fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index 60194c1735..f63c60c263 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -56,7 +56,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 0 + temporary_SF_switch = 1 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 From 1d4238ae0c1a597639c2d1c0dd73af37e2843595 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Fri, 7 Oct 2016 14:02:33 -0600 Subject: [PATCH 02/15] Modified two bugs in effective windspeed and in livegrass moisture found in SPITFIRE. --- components/clm/src/ED/fire/SFMainMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index f63c60c263..e907a01303 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -222,7 +222,7 @@ subroutine charecteristics_of_fuel ( currentSite ) ! average water content !is this the correct metric? timeav_swc = sum(currentSite%water_memory(1:10)) / 10._r8 ! Equation B2 in Thonicke et al. 2010 - fuel_moisture(dg_sf) = max(0.0_r8, 10.0_r8/9._r8 * timeav_swc - 1.0_r8/9.0_r8) + fuel_moisture(lg_sf) = max(0.0_r8, 10.0_r8/9._r8 * timeav_swc - 1.0_r8/9.0_r8) ! Average properties over the first four litter pools (dead leaves, twigs, s branches, l branches) currentPatch%fuel_bulkd = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * SF_val_FBD(dg_sf:lb_sf)) @@ -363,7 +363,7 @@ subroutine wind_effect ( currentSite, atm2lnd_inst) do while(associated(currentPatch)) currentPatch%total_tree_area = min(currentPatch%total_tree_area,currentPatch%area) - currentPatch%effect_wspeed = wind * (tree_fraction*0.6+grass_fraction*0.4+bare_fraction*1.0) + currentPatch%effect_wspeed = wind * (tree_fraction*0.4+(grass_fraction+bare_fraction)*0.6) currentPatch => currentPatch%younger enddo !end patch loop From a246d580651cb5a3573e4263b4248ff2848f9473 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Fri, 14 Oct 2016 10:14:45 -0600 Subject: [PATCH 03/15] turned off SPITFIRE temporary switch for testing --- components/clm/src/ED/fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index f86b006c6c..3e6606d27d 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -56,7 +56,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 1 + temporary_SF_switch = 0 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 From dbb3301f035ff356b35272705e8934d36bf53712 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 18 Oct 2016 20:33:28 -0700 Subject: [PATCH 04/15] 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 32bc16a78f2204ba0363223b4d6f924b7f089a25 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Wed, 19 Oct 2016 08:22:38 -0600 Subject: [PATCH 05/15] turn temp_sf_switch on --- components/clm/src/ED/fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index 3e6606d27d..f86b006c6c 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -56,7 +56,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 0 + temporary_SF_switch = 1 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 From 38f276db4fb4bcb75b95abb1cdc635330e797448 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 31 Oct 2016 17:58:09 -0700 Subject: [PATCH 06/15] 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 07/15] 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 08/15] 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 824e36c99ec5f21204b9bae3997b728180d82243 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Mon, 14 Nov 2016 13:41:23 -0700 Subject: [PATCH 09/15] Altered test scripts to make spitfire off by default, and add a single SPITFIRE test into the test suite. --- components/clm/cime_config/testdefs/testlist_clm.xml | 2 +- .../testmods_dirs/clm/{edNoFire => edFire}/include_user_mods | 0 .../testmods_dirs/clm/{edNoFire => edFire}/shell_commands | 0 .../cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm | 2 ++ .../cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm | 2 -- 5 files changed, 3 insertions(+), 3 deletions(-) rename components/clm/cime_config/testdefs/testmods_dirs/clm/{edNoFire => edFire}/include_user_mods (100%) rename components/clm/cime_config/testdefs/testmods_dirs/clm/{edNoFire => edFire}/shell_commands (100%) create mode 100644 components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm delete mode 100644 components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml index 512908b01b..24c39ef75a 100644 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ b/components/clm/cime_config/testdefs/testlist_clm.xml @@ -721,7 +721,7 @@ ed - ed + ed hobart yellowstone diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/include_user_mods b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/include_user_mods similarity index 100% rename from components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/include_user_mods rename to components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/include_user_mods diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/shell_commands b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/shell_commands similarity index 100% rename from components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/shell_commands rename to components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/shell_commands diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm new file mode 100644 index 0000000000..7295965ba5 --- /dev/null +++ b/components/clm/cime_config/testdefs/testmods_dirs/clm/edFire/user_nl_clm @@ -0,0 +1,2 @@ +use_ed_spit_fire = .true. + diff --git a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm b/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm deleted file mode 100644 index 05070adc21..0000000000 --- a/components/clm/cime_config/testdefs/testmods_dirs/clm/edNoFire/user_nl_clm +++ /dev/null @@ -1,2 +0,0 @@ -use_ed_spit_fire = .false. - From 7ece58c53e61ad1fea001ed1c4bb9a7c5754d165 Mon Sep 17 00:00:00 2001 From: Rosie Fisher Date: Mon, 14 Nov 2016 13:50:12 -0700 Subject: [PATCH 10/15] Changes to namelist defaults to turn spitfire off --- .../namelist_defaults_clm4_5.xml | 2 +- .../clm/cime_config/testdefs/testlist_clm.xml | 1602 ----------------- .../ED/biogeochem/EDCanopyStructureMod.F90 | 30 +- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 57 +- .../src/ED/biogeophys/EDPhotosynthesisMod.F90 | 357 ++-- components/clm/src/ED/main/EDTypesMod.F90 | 22 +- .../clm/src/ED/main/FatesConstantsMod.F90 | 41 + .../src/ED/main/FatesHistoryDimensionMod.F90 | 92 + ...IOMod.F90 => FatesHistoryInterfaceMod.F90} | 1510 ++++++++-------- .../src/ED/main/FatesHistoryVarKindMod.F90 | 91 + .../src/ED/main/FatesHistoryVariableType.F90 | 221 +++ .../clm/src/utils/clmfates_interfaceMod.F90 | 219 +-- 12 files changed, 1589 insertions(+), 2655 deletions(-) delete mode 100644 components/clm/cime_config/testdefs/testlist_clm.xml create mode 100644 components/clm/src/ED/main/FatesHistoryDimensionMod.F90 rename components/clm/src/ED/main/{HistoryIOMod.F90 => FatesHistoryInterfaceMod.F90} (53%) create mode 100644 components/clm/src/ED/main/FatesHistoryVarKindMod.F90 create mode 100644 components/clm/src/ED/main/FatesHistoryVariableType.F90 diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml index 2afd482e67..53348abe3a 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -1973,6 +1973,6 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_simyr1850_c160216.nc .false. .false. -.true. +.false. diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml deleted file mode 100644 index 24c39ef75a..0000000000 --- a/components/clm/cime_config/testdefs/testlist_clm.xml +++ /dev/null @@ -1,1602 +0,0 @@ - - - - - - yellowstone - - - null - - - - - hobart - - - - - yellowstone - - - - - edison - yellowstone - - - edison - yellowstone - yellowstone - - - - - edison - edison - edison - hobart - hobart - janus - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - - - - - yellowstone - - - - - null - - - - - null - - - - - null - - - - - null - - - - - yellowstone - - - edison - - - - - null - - - - - null - - - - - null - - - - - null - - - - - null - - - - - - - null - - - - - hobart - - - - - hobart - - - - - yellowstone - yellowstone - - - edison - - - null - - - - - - - yellowstone - - - hobart - - - yellowstone - yellowstone - yellowstone - - - hobart - hobart - - - yellowstone - yellowstone - yellowstone - - - edison - - - yellowstone - - - yellowstone - - - - - edison - yellowstone - - - yellowstone - - - edison - hobart - yellowstone - yellowstone - - - - - - - null - - - - - edison - edison - yellowstone - yellowstone - - - hobart - - - - - - - hobart - - - - - - - null - - - - - hobart - - - - - edison - yellowstone - - - yellowstone - - - edison - - - - - yellowstone - - - - - edison - hopper - - - - - - - edison - yellowstone - - - - - null - - - - - - - null - - - - - - - yellowstone - - - - - - - null - - - - - - - null - - - - - - - hobart - janus - yellowstone - yellowstone - yellowstone - - - - - null - - - - - hobart - - - - - - - hobart - - - hobart - - - edison - yellowstone - - - - - null - - - - - edison - yellowstone - - - yellowstone - - - hobart - - - - - edison - yellowstone - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - hobart - - - - - - - null - - - - - null - - - - - janus - yellowstone - yellowstone - yellowstone - - - - - edison - - - null - - - - - - - null - - - - - null - - - - - - - null - - - - - null - - - - - yellowstone - - - - - yellowstone - - - - - yellowstone - - - - - edison - yellowstone - - - - - hobart - - - yellowstone - yellowstone - - - - - hobart - yellowstone - yellowstone - - - hobart - yellowstone - yellowstone - - - hobart - hobart - yellowstone - yellowstone - yellowstone - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - - - ed - edison - yellowstone - yellowstone - - - edison - yellowstone - yellowstone - - - yellowstone - - - - - edison - yellowstone - yellowstone - yellowstone - - - hobart - - - edison - yellowstone - yellowstone - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - edison - hobart - yellowstone - yellowstone - - - hobart - - - yellowstone - - - hobart - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - - - hobart - - - ed - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - - - - - edison - yellowstone - - - edison - yellowstone - - - yellowstone - - - yellowstone - yellowstone - - - - - edison - edison - yellowstone - - - hobart - - - yellowstone - - - yellowstone - - - - - - - yellowstone - - - yellowstone - - - hobart - - - - - yellowstone - - - - - yellowstone - - - yellowstone - - - yellowstone - - - yellowstone - yellowstone - - - edison - - - yellowstone - - - hobart - - - yellowstone - - - yellowstone - - - yellowstone - - - - - yellowstone - - - edison - - - - - - - yellowstone - - - yellowstone - - - - - yellowstone - - - edison - - - - - yellowstone - - - edison - - - - - - - yellowstone - yellowstone - - - yellowstone - - - - - - - yellowstone - - - - - - - ed - hobart - yellowstone - yellowstone - yellowstone - - - - - ed - yellowstone - - - ed - hobart - yellowstone - yellowstone - - - - - ed - yellowstone - - - - - ed - ed - hobart - yellowstone - - - ed - hobart - yellowstone - yellowstone - yellowstone - - - ed - yellowstone - yellowstone - - - - - ed - - - ed - yellowstone - yellowstone - - - - - ed - yellowstone - - - ed - yellowstone - - - - - ed - - - - - - - yellowstone - - - - - - - edison - yellowstone - - - edison - yellowstone - - - - - edison - yellowstone - - - edison - yellowstone - - - - - edison - yellowstone - - - - - - - yellowstone - - - - - - - yellowstone - - - - - hobart - - - - - edison - - - edison - - - yellowstone - - - - - - - hobart - - - edison - janus - yellowstone - yellowstone - yellowstone - yellowstone - - - - - edison - eos - hopper - titan - - - - - edison - - - yellowstone - - - - - edison - yellowstone - - - - - - - edison - - - yellowstone - - - - - - - null - - - - - - - yellowstone - - - - - edison - yellowstone - yellowstone - - - hobart - - - - - null - - - - - - - edison - hopper - janus - - - - - edison - yellowstone - - - yellowstone - - - null - - - - - - - edison - edison - yellowstone - - - - - - - edison - yellowstone - yellowstone - - - hobart - - - edison - yellowstone - yellowstone - yellowstone - - - yellowstone - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - - - hobart - hobart - hobart - hobart - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - yellowstone - - - - - edison - - - edison - - - yellowstone - yellowstone - yellowstone - - - yellowstone - yellowstone - - - - - yellowstone - - - - - - - yellowstone - - - hobart - - - yellowstone - - - - - yellowstone - - - yellowstone - - - - - - - edison - - - null - - - - - - - null - - - - - - - yellowstone - - - - - null - - - - - edison - - - yellowstone - - - yellowstone - - - edison - yellowstone - yellowstone - - - - - - - edison - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - - - yellowstone - - - - - - - yellowstone - - - - - yellowstone - - - - - - - null - - - - - - - null - - - - - - - null - - - - - null - - - - - - - yellowstone - - - - - null - - - - - - - null - - - - - - - null - - - - - - - null - - - - - hobart - - - - - - - null - - - - - null - - - - - - - null - - - - - null - - - - - - - null - - - - - edison - - - yellowstone - - - - - - - null - - - - - null - - - - - - - null - - - - - - - hobart - - - - - null - - - - - null - - - - - null - - - - - null - - - - - null - - - - - - - null - - - - - - - yellowstone - - - yellowstone - - - yellowstone - - - - - hobart - yellowstone - yellowstone - - - yellowstone - - - hobart - - - yellowstone - - - - - edison - - - - - - - yellowstone - - - yellowstone - - - - - yellowstone - - - - - - - yellowstone - - - hobart - - - - - - - edison - yellowstone - yellowstone - - - - - bluewaters - edison - eos - hopper - titan - - - - - null - - - - - - - edison - - - - - null - - - - - - - yellowstone - - - - - - - null - - - - - - - null - - - - - null - - - - - hobart - - - - - null - - - - - null - - - - - null - - - - - - - hobart - - - - - edison - yellowstone - yellowstone - - - - - - - null - - - - - null - - - - - hobart - - - - - edison - yellowstone - - - - - null - - - - - null - - - - - - - null - - - - - - - null - - - - - null - - - - - null - - - - - null - - - - - null - - - - - - - null - - - - - edison - yellowstone - - - - - - - null - - - - - - - null - - - - - null - - - - - edison - yellowstone - - - - - null - - - - - null - - - - - - - null - - - - - null - - - janus - yellowstone - yellowstone - yellowstone - - - - - edison - hobart - hobart - hopper - - - eastwind - evergreen - olympus - yellowstone - - - - - edison - hopper - janus - yellowstone - yellowstone - yellowstone - - - - - hobart - hobart - janus - janus - - - - diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 index a0056056c8..5ce6d6631f 100755 --- a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -546,7 +546,8 @@ subroutine canopy_structure( currentSite ) enddo if(((checkarea-currentPatch%area)) > 0.0001)then - write(fates_log(),*) 'problem with canopy area', checkarea,currentPatch%area,checkarea-currentPatch%area,i,z,missing_area + write(fates_log(),*) 'problem with canopy area', checkarea, currentPatch%area, checkarea - currentPatch%area, & + i, z, missing_area currentCohort => currentPatch%tallest do while (associated(currentCohort)) if(currentCohort%canopy_layer == i)then @@ -658,6 +659,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use FatesInterfaceMod , only : bc_in_type use EDPatchDynamicsMod , only : set_patchno + use EDCohortDynamicsMod , only : size_and_type_class_index use EDGrowthFunctionsMod , only : tree_lai, c_area use EDEcophysConType , only : EDecophyscon use EDtypesMod , only : area @@ -675,7 +677,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) integer :: ft ! plant functional type integer :: ifp integer :: patchn ! identification number for each patch. - real(r8) :: coarse_wood_frac real(r8) :: canopy_leaf_area ! total amount of leaf area in the vegetated area. m2. !---------------------------------------------------------------------- @@ -710,26 +711,13 @@ subroutine canopy_summarization( nsites, sites, bc_in ) do while(associated(currentCohort)) ft = currentCohort%pft - currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) - - currentCohort%livecrootn = 0.0_r8 - - if (pftcon%woody(ft) == 1) then - coarse_wood_frac = 0.5_r8 - else - coarse_wood_frac = 0.0_r8 - end if - - if ( DEBUG ) then - write(fates_log(),*) 'canopy_summarization 724 ',currentCohort%livecrootn - write(fates_log(),*) 'canopy_summarization 725 ',currentCohort%br - write(fates_log(),*) 'canopy_summarization 726 ',coarse_wood_frac - write(fates_log(),*) 'canopy_summarization 727 ',pftcon%leafcn(ft) - endif - - currentCohort%livecrootn = currentCohort%br * coarse_wood_frac / pftcon%leafcn(ft) + - if ( DEBUG ) write(fates_log(),*) 'canopy_summarization 732 ',currentCohort%livecrootn + ! Update the cohort's index within the size bin classes + ! Update the cohort's index within the SCPF classification system + call size_and_type_class_index(currentCohort%dbh,currentCohort%pft, & + currentCohort%size_class,currentCohort%size_by_pft_class) + currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore currentCohort%treelai = tree_lai(currentCohort) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index fca32709d3..cdca9ec65b 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -27,7 +27,7 @@ module EDCohortDynamicsMod public :: sort_cohorts public :: copy_cohort public :: count_cohorts -! public :: countCohorts + public :: size_and_type_class_index public :: allocate_live_biomass logical, parameter :: DEBUG = .false. ! local debug flag @@ -92,6 +92,9 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, & new_cohort%balive = balive new_cohort%bstore = bstore + 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 (new_cohort%dbh <= 0.0_r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 & @@ -290,6 +293,8 @@ subroutine nan_cohort(cc_p) ! ! !USES: use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use FatesConstantsMod, only : fates_unset_int + ! ! !ARGUMENTS type (ed_cohort_type), intent(inout), target :: cc_p @@ -311,11 +316,13 @@ subroutine nan_cohort(cc_p) nullify(currentCohort%siteptr) ! VEGETATION STRUCTURE - currentCohort%pft = 999 ! pft number - currentCohort%indexnumber = 999 ! unique number for each cohort. (within clump?) - currentCohort%canopy_layer = 999 ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) - currentCohort%NV = 999 ! Number of leaf layers: - - currentCohort%status_coh = 999 ! growth status of plant (2 = leaves on , 1 = leaves off) + currentCohort%pft = fates_unset_int ! pft number + currentCohort%indexnumber = fates_unset_int ! unique number for each cohort. (within clump?) + currentCohort%canopy_layer = fates_unset_int ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + currentCohort%NV = fates_unset_int ! Number of leaf layers: - + currentCohort%status_coh = fates_unset_int ! growth status of plant (2 = leaves on , 1 = leaves off) + currentCohort%size_class = fates_unset_int ! size class index + currentCohort%size_by_pft_class = fates_unset_int ! size by pft classification index currentCohort%n = nan ! number of individuals in cohort per 'area' (10000m2 default) currentCohort%dbh = nan ! 'diameter at breast height' in cm @@ -361,7 +368,7 @@ subroutine nan_cohort(cc_p) !RESPIRATION - currentCohort%rd = nan + currentCohort%rdark = nan currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year currentCohort%resp_g = nan ! Growth respiration. kGC/cohort/year currentCohort%livestem_mr = nan ! Live stem maintenance respiration. kgC/indiv/s-1 @@ -381,11 +388,6 @@ subroutine nan_cohort(cc_p) currentCohort%leaf_litter = nan ! leaf litter from phenology: KgC/m2 currentCohort%woody_turnover = nan ! amount of wood lost each day: kgC/indiv/year. Currently set to zero. - ! NITROGEN POOLS - currentCohort%livestemn = nan ! live stem nitrogen : KgN/invid - currentCohort%livecrootn = nan ! live coarse root nitrogen: KgN/invid - currentCohort%frootn = nan ! fine root nitrogen : KgN/invid - ! VARIABLES NEEDED FOR INTEGRATION currentCohort%dndt = nan ! time derivative of cohort size currentCohort%dhdt = nan ! time derivative of height @@ -423,7 +425,7 @@ subroutine zero_cohort(cc_p) currentCohort%NV = 0 currentCohort%status_coh = 0 - currentCohort%rd = 0._r8 + currentCohort%rdark = 0._r8 currentCohort%resp_m = 0._r8 currentCohort%resp_g = 0._r8 currentCohort%livestem_mr = 0._r8 @@ -1040,18 +1042,13 @@ subroutine copy_cohort( currentCohort,copyc ) n%npp_store = o%npp_store !RESPIRATION - n%rd = o%rd + n%rdark = o%rdark n%resp_m = o%resp_m n%resp_g = o%resp_g n%livestem_mr = o%livestem_mr n%livecroot_mr = o%livecroot_mr n%froot_mr = o%froot_mr - ! NITROGEN POOLS - n%livestemn = o%livestemn - n%livecrootn = o%livecrootn - n%frootn = o%frootn - ! ALLOCATION n%md = o%md n%leaf_md = o%leaf_md @@ -1137,6 +1134,28 @@ function count_cohorts( currentPatch ) result ( backcount ) end function count_cohorts + ! ===================================================================================== + + subroutine size_and_type_class_index(dbh,pft,size_class,size_by_pft_class) + + use EDTypesMod, only: sclass_ed + use EDTypesMod, only: nlevsclass_ed + + ! Arguments + real(r8),intent(in) :: dbh + integer,intent(in) :: pft + integer,intent(out) :: size_class + integer,intent(out) :: size_by_pft_class + + size_class = count(dbh-sclass_ed.ge.0.0_r8) + + size_by_pft_class = (pft-1)*nlevsclass_ed+size_class + + return + end subroutine size_and_type_class_index + + + !-------------------------------------------------------------------------------------! ! function countCohorts( bounds, ed_allsites_inst ) result ( totNumCohorts ) ! diff --git a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 index aecc47109f..a9e6cf5049 100644 --- a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +++ b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 @@ -9,14 +9,14 @@ module EDPhotosynthesisMod ! ! !USES: ! - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun - 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 + implicit none private - ! - ! PUBLIC MEMBER FUNCTIONS: @@ -39,38 +39,55 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! a multi-layer canopy ! ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun - use clm_varcon , only : rgas, tfrz, namep - use clm_varpar , only : nlevsoi, mxpft - use clm_varctl , only : iulog - use pftconMod , only : pftcon + use clm_varpar , only : mxpft ! THIS WILL BE DEPRECATED WHEN PARAMETER + ! READS ARE REFACTORED (RGK 10-13-2016) + use pftconMod , only : pftcon ! THIS WILL BE DEPRECATED WHEN PARAMETER + ! READS ARE REFACTORED (RGK 10-13-2016) use EDParamsMod , only : ED_val_grperc + use EDParamsMod , only : ED_val_ag_biomass use EDSharedParamsMod , only : EDParamsShareInst - use EDTypesMod , only : numpft_ed, dinc_ed - use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : dinc_ed + use EDTypesMod , only : ed_patch_type + use EDTypesMod , only : ed_cohort_type + use EDTypesMod , only : ed_site_type + use EDTypesMod , only : numpft_ed + use EDTypesMod , only : numpatchespercol + use EDTypesMod , only : cp_numlevsoil + use EDTypesMod , only : cp_nlevcan + use EDTypesMod , only : cp_nclmax + use EDEcophysContype , only : EDecophyscon - use FatesInterfaceMod , only : bc_in_type,bc_out_type - use EDtypesMod , only : numpatchespercol, cp_nlevcan, cp_nclmax - use EDCanopyStructureMod,only: calc_areaindex - ! + use FatesInterfaceMod , only : bc_in_type + use FatesInterfaceMod , only : bc_out_type + + use EDCanopyStructureMod, only : calc_areaindex + + use FatesConstantsMod, only : umolC_to_kgC + use FatesConstantsMod, only : g_per_kg + use FatesConstantsMod, only : mg_per_g + use FatesConstantsMod, only : sec_per_min + use FatesConstantsMod, only : umol_per_mmol + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + ! !ARGUMENTS: + ! ----------------------------------------------------------------------------------- integer,intent(in) :: nsites type(ed_site_type),intent(inout),target :: sites(nsites) type(bc_in_type),intent(in) :: bc_in(nsites) type(bc_out_type),intent(inout) :: bc_out(nsites) real(r8),intent(in) :: dtime - ! - ! !CALLED FROM: - ! subroutine CanopyFluxes - ! + ! !LOCAL VARIABLES: + ! ----------------------------------------------------------------------------------- type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort - ! + integer , parameter :: psn_type = 2 !c3 or c4. logical :: DEBUG = .false. @@ -84,8 +101,8 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) real(r8) :: lmr_z(cp_nclmax,mxpft,cp_nlevcan) ! initial slope of CO2 response curve (C4 plants) real(r8) :: rs_z(cp_nclmax,mxpft,cp_nlevcan) ! stomatal resistance s/m real(r8) :: gs_z(cp_nclmax,mxpft,cp_nlevcan) ! stomatal conductance m/s - - real(r8) :: ci(cp_nclmax,mxpft,cp_nlevcan) ! intracellular leaf CO2 (Pa) + + real(r8) :: ci ! intracellular leaf CO2 (Pa) real(r8) :: lnc(mxpft) ! leaf N concentration (gN leaf/m^2) real(r8) :: kc( numpatchespercol ) ! Michaelis-Menten constant for CO2 (Pa) @@ -148,7 +165,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) integer :: c,CL,f,s,iv,j,ps,ft,ifp ! indices integer :: NCL_p ! number of canopy layers in patch real(r8) :: cf ! s m**2/umol -> s/m - real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] + real(r8) :: gb ! leaf boundary layer conductance (m/s) real(r8) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) @@ -180,7 +197,6 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) real(r8) :: an(cp_nclmax,mxpft,cp_nlevcan) ! net leaf photosynthesis (umol CO2/m**2/s) real(r8) :: an_av(cp_nclmax,mxpft,cp_nlevcan) ! net leaf photosynthesis (umol CO2/m**2/s) averaged over sun and shade leaves. real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) - real(r8) :: laican ! canopy sum of lai_z real(r8) :: vai ! leaf and steam area in ths layer. integer :: exitloop @@ -188,15 +204,41 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) real(r8) :: tcsoi ! Temperature response function for root respiration. real(r8) :: tc ! Temperature response function for wood - real(r8) :: br ! Base rate of root respiration. (gC/gN/s) + real(r8) :: q10 ! temperature dependence of root respiration integer :: sunsha ! sun (1) or shaded (2) leaves... - real(r8) :: dr(2) real(r8) :: coarse_wood_frac ! amount of woody biomass that is coarse... real(r8) :: tree_area real(r8) :: gs_cohort real(r8) :: rscanopy real(r8) :: elai + + real(r8) :: live_stem_n ! Live stem (above-ground sapwood) nitrogen content (kgN/plant) + real(r8) :: live_croot_n ! Live coarse root (below-ground sapwood) nitrogen content (kgN/plant) + real(r8) :: froot_n ! Fine root nitrogen content (kgN/plant) + + ! Parameters + ! ----------------------------------------------------------------------- + ! Base maintenance respiration rate for plant tissues base_mr_20 + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! + ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 + ! (gC/gN/s) + ! ------------------------------------------------------------------------ + + real(r8),parameter :: base_mr_20 = 2.525e-6_r8 + + ! maximum stomatal resistance [s/m] + real(r8),parameter :: rsmax0 = 2.e4_r8 + + ! First guess on ratio between intracellular co2 and the atmosphere + ! an iterator converges on actual + real(r8),parameter :: init_a2l_co2_c3 = 0.7_r8 + real(r8),parameter :: init_a2l_co2_c4 = 0.4_r8 + associate( & c3psn => pftcon%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 @@ -205,11 +247,9 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) woody => pftcon%woody , & ! Is vegetation woody or not? fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-) leafcn => pftcon%leafcn , & ! leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! froot C:N (gc/gN) bb_slope => EDecophyscon%BB_slope ) ! slope of BB relationship - ! Assign local pointers to derived type members (gridcell-level) - dr(1) = 0.025_r8; dr(2) = 0.015_r8 - ! Peter Thornton: 3/13/09 ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning ! to improve seasonal cycle of atmospheric CO2 concentration in global @@ -226,7 +266,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) act25 = 3.6_r8 !umol/mgRubisco/min ! Convert rubisco activity units from umol/mgRubisco/min -> umol/gRubisco/s - act25 = act25 * 1000.0_r8 / 60.0_r8 + act25 = act25 * mg_per_g / sec_per_min ! Activation energy, from: ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 @@ -371,14 +411,6 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if bbb(FT) = max (bbbopt(ps)*currentPatch%btran_ft(FT), 1._r8) - ! THIS CALL APPEARS TO BE REDUNDANT WITH LINE 650 (RGK) - if (nint(c3psn(FT)) == 1)then - ci(:,FT,:) = 0.7_r8 * bc_in(s)%cair_pa(ifp) - else - ci(:,FT,:) = 0.4_r8 * bc_in(s)%cair_pa(ifp) - end if - - ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) lnc(FT) = 1._r8 / (slatop(FT) * leafcn(FT)) @@ -390,7 +422,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Here use a factor "1.67", from Medlyn et al (2002) Plant, Cell and Environment 25:1167-1179 !RF - copied this from the CLM trunk code, but where did it come from, and how can we make these consistant? - !jmax25top(FT) = (2.59_r8 - 0.035_r8*min(max((t10(p)-tfrz),11._r8),35._r8)) * vcmax25top(FT) + !jmax25top(FT) = (2.59_r8 - 0.035_r8*min(max((t10(p)-tfrzc),11._r8),35._r8)) * vcmax25top(FT) jmax25top(FT) = 1.67_r8 * vcmax25top(FT) tpu25top(FT) = 0.167_r8 * vcmax25top(FT) @@ -409,13 +441,6 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Leaf maintenance respiration to match the base rate used in CN ! but with the new temperature functions for C3 and C4 plants. ! - ! Base rate for maintenance respiration is from: - ! M. Ryan, 1991. Effects of climate change on plant respiration. - ! Ecological Applications, 1(2), 157-167. - ! Original expression is br = 0.0106 molC/(molN h) - ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) - ! - ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 ! ! CN respiration has units: g C / g N [leaf] / s. This needs to be ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s @@ -423,7 +448,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Then scale this value at the top of the canopy for canopy depth lmr25top(FT) = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) - lmr25top(FT) = lmr25top(FT) * lnc(FT) / 12.e-06_r8 + lmr25top(FT) = lmr25top(FT) * lnc(FT) / (umolC_to_kgC * g_per_kg) end do !FT @@ -435,7 +460,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) do iv = 1, currentPatch%nrad(CL,FT) if(currentPatch%canopy_area_profile(CL,FT,iv)>0._r8.and.currentPatch%present(CL,FT) /= 1)then - write(iulog,*) 'CF: issue with present structure',CL,FT,iv, & + write(fates_log(),*) 'CF: issue with present structure',CL,FT,iv, & currentPatch%canopy_area_profile(CL,FT,iv),currentPatch%present(CL,FT), & currentPatch%nrad(CL,FT),currentPatch%ncl_p,cp_nclmax currentPatch%present(CL,FT) = 1 @@ -520,10 +545,9 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Leaf-level photosynthesis and stomatal conductance !==============================================================================! - rsmax0 = 2.e4_r8 - ! Leaf boundary layer conductance, umol/m**2/s + ! THESE HARD CODED CONVERSIONS NEED TO BE CALLED FROM GLOBAL CONSTANTS (RGK 10-13-2016) cf = bc_in(s)%forc_pbot/(rgas*1.e-3_r8*bc_in(s)%tgcm_pa(ifp))*1.e06_r8 gb = 1._r8/bc_in(s)%rb_pa(ifp) gb_mol = gb * cf @@ -542,7 +566,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if if(currentPatch%present(CL,FT) == 1)then ! are there any leaves of this pft in this layer? do iv = 1, currentPatch%nrad(CL,FT) - if ( DEBUG ) write(iulog,*) 'EDphoto 581 ',currentPatch%ed_parsun_z(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDphoto 581 ',currentPatch%ed_parsun_z(CL,ft,iv) if (currentPatch%ed_parsun_z(CL,FT,iv) <= 0._r8) then ! night time ac = 0._r8 @@ -557,12 +581,12 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) else ! day time !is there leaf area? - (NV can be larger than 0 with only stem area if deciduous) - if ( DEBUG ) write(iulog,*) 'EDphot 594 ',currentPatch%ed_laisun_z(CL,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDphot 595 ',currentPatch%ed_laisha_z(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDphot 594 ',currentPatch%ed_laisun_z(CL,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDphot 595 ',currentPatch%ed_laisha_z(CL,ft,iv) if(currentPatch%ed_laisun_z(CL,ft,iv)+currentPatch%ed_laisha_z(cl,ft,iv) > 0._r8)then - if ( DEBUG ) write(iulog,*) '600 in laisun, laisha loop ' + if ( DEBUG ) write(fates_log(),*) '600 in laisun, laisha loop ' !Loop aroun shaded and unshaded leaves currentPatch%psn_z(CL,ft,iv) = 0._r8 ! psn is accumulated across sun and shaded leaves. @@ -605,9 +629,9 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! THIS CALL APPEARS TO BE REDUNDANT WITH LINE 423 (RGK) if (nint(c3psn(FT)) == 1)then - ci(cl,ft,iv) = 0.7_r8 * bc_in(s)%cair_pa(ifp) + ci = init_a2l_co2_c3 * bc_in(s)%cair_pa(ifp) else - ci(cl,ft,iv) = 0.4_r8 * bc_in(s)%cair_pa(ifp) + ci = init_a2l_co2_c4 * bc_in(s)%cair_pa(ifp) end if niter = 0 @@ -617,15 +641,15 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) niter = niter + 1 ! Save old ci - ciold = ci(cl,ft,iv) + ciold = ci ! Photosynthesis limitation rate calculations if (nint(c3psn(FT)) == 1)then ! C3: Rubisco-limited photosynthesis - ac = vcmax_z(cl,ft,iv) * max(ci(cl,ft,iv)-co2_cp(ifp), 0._r8) / (ci(cl,ft,iv)+kc(ifp)* & + ac = vcmax_z(cl,ft,iv) * max(ci-co2_cp(ifp), 0._r8) / (ci+kc(ifp)* & (1._r8+bc_in(s)%oair_pa(ifp)/ko(ifp))) ! C3: RuBP-limited photosynthesis - aj = je * max(ci(cl,ft,iv)-co2_cp(ifp), 0._r8) / (4._r8*ci(cl,ft,iv)+8._r8*co2_cp(ifp)) + aj = je * max(ci-co2_cp(ifp), 0._r8) / (4._r8*ci+8._r8*co2_cp(ifp)) ! C3: Product-limited photosynthesis ap = 3._r8 * tpu_z(cl,ft,iv) else @@ -649,7 +673,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if ! C4: PEP carboxylase-limited (CO2-limited) - ap = kp_z(cl,ft,iv) * max(ci(cl,ft,iv), 0._r8) / bc_in(s)%forc_pbot + ap = kp_z(cl,ft,iv) * max(ci, 0._r8) / bc_in(s)%forc_pbot end if ! Gross photosynthesis smoothing calculations. First co-limit ac and aj. Then co-limit ap aquad = theta_cj(ps) @@ -683,14 +707,14 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) gs_mol = max(r1,r2) ! Derive new estimate for ci - ci(cl,ft,iv) = bc_in(s)%cair_pa(ifp) - an(cl,ft,iv) * bc_in(s)%forc_pbot * & + ci = bc_in(s)%cair_pa(ifp) - an(cl,ft,iv) * bc_in(s)%forc_pbot * & (1.4_r8*gs_mol+1.6_r8*gb_mol) / (gb_mol*gs_mol) ! Check for ci convergence. Delta ci/pair = mol/mol. Multiply by 10**6 to ! convert to umol/mol (ppm). Exit iteration if convergence criteria of +/- 1 x 10**-6 ppm ! is met OR if at least ten iterations (niter=10) are completed - if ((abs(ci(cl,ft,iv)-ciold)/bc_in(s)%forc_pbot*1.e06_r8 <= 2.e-06_r8) .or. niter == 5) then + if ((abs(ci-ciold)/bc_in(s)%forc_pbot*1.e06_r8 <= 2.e-06_r8) .or. niter == 5) then exitloop = 1 end if end do !iteration loop @@ -703,14 +727,14 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) ! Final estimates for cs and ci (needed for early exit of ci iteration when an < 0) cs = bc_in(s)%cair_pa(ifp) - 1.4_r8/gb_mol * an(cl,ft,iv) * bc_in(s)%forc_pbot cs = max(cs,1.e-06_r8) - ci(cl,ft,iv) = bc_in(s)%cair_pa(ifp) - & + ci = bc_in(s)%cair_pa(ifp) - & an(cl,ft,iv) * bc_in(s)%forc_pbot * (1.4_r8*gs_mol+1.6_r8*gb_mol) / (gb_mol*gs_mol) ! Convert gs_mol (umol H2O/m**2/s) to gs (m/s) and then to rs (s/m) gs = gs_mol / cf - if ( DEBUG ) write(iulog,*) 'EDPhoto 737 ', currentPatch%psn_z(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 738 ', ag(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 739 ', currentPatch%f_sun(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 737 ', currentPatch%psn_z(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 738 ', ag(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 739 ', currentPatch%f_sun(cl,ft,iv) !accumulate total photosynthesis umol/m2 ground/s-1. weight per unit sun and sha leaves. if(sunsha == 1)then !sunlit @@ -733,15 +757,15 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if - if ( DEBUG ) write(iulog,*) 'EDPhoto 758 ', currentPatch%psn_z(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 759 ', ag(cl,ft,iv) - if ( DEBUG ) write(iulog,*) 'EDPhoto 760 ', currentPatch%f_sun(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 758 ', currentPatch%psn_z(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 759 ', ag(cl,ft,iv) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 760 ', currentPatch%f_sun(cl,ft,iv) ! Make sure iterative solution is correct if (gs_mol < 0._r8) then - write (iulog,*)'Negative stomatal conductance:' - write (iulog,*)'ifp,iv,gs_mol= ',ifp,iv,gs_mol - call endrun(msg=errmsg(sourcefile, __LINE__)) + write (fates_log(),*)'Negative stomatal conductance:' + write (fates_log(),*)'ifp,iv,gs_mol= ',ifp,iv,gs_mol + call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! Compare with Ball-Berry model: gs_mol = m * an * hs/cs p + b @@ -749,8 +773,8 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) gs_mol_err = bb_slope(ft)*max(an(cl,ft,iv), 0._r8)*hs/cs*bc_in(s)%forc_pbot + bbb(FT) if (abs(gs_mol-gs_mol_err) > 1.e-01_r8) then - write (iulog,*) 'CF: Ball-Berry error check - stomatal conductance error:' - write (iulog,*) gs_mol, gs_mol_err + write (fates_log(),*) 'CF: Ball-Berry error check - stomatal conductance error:' + write (fates_log(),*) gs_mol, gs_mol_err end if enddo !sunsha loop @@ -787,7 +811,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%npp_tstep = 0.0_r8 currentCohort%resp_tstep = 0.0_r8 currentCohort%gpp_tstep = 0.0_r8 - currentCohort%rd = 0.0_r8 + currentCohort%rdark = 0.0_r8 currentCohort%resp_m = 0.0_r8 ! Select canopy layer and PFT. @@ -798,34 +822,34 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) !------------------------------------------------------------------------------ ! Convert from umolC/m2leaf/s to umolC/indiv/s ( x canopy area x 1m2 leaf area). tree_area = currentCohort%c_area/currentCohort%n - if ( DEBUG ) write(iulog,*) 'EDPhoto 816 ', currentCohort%gpp_tstep - if ( DEBUG ) write(iulog,*) 'EDPhoto 817 ', currentPatch%psn_z(cl,ft,1:currentCohort%nv-1) - if ( DEBUG ) write(iulog,*) 'EDPhoto 818 ', cl - if ( DEBUG ) write(iulog,*) 'EDPhoto 819 ', ft - if ( DEBUG ) write(iulog,*) 'EDPhoto 820 ', currentCohort%nv - if ( DEBUG ) write(iulog,*) 'EDPhoto 821 ', currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 816 ', currentCohort%gpp_tstep + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 817 ', currentPatch%psn_z(cl,ft,1:currentCohort%nv-1) + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 818 ', cl + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 819 ', ft + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 820 ', currentCohort%nv + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 821 ', currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1) if (currentCohort%nv > 1) then !is there canopy, and are the leaves on? currentCohort%gpp_tstep = sum(currentPatch%psn_z(cl,ft,1:currentCohort%nv-1) * & currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1)) * tree_area - currentCohort%rd = sum(lmr_z(cl,ft,1:currentCohort%nv-1) * & + currentCohort%rdark = sum(lmr_z(cl,ft,1:currentCohort%nv-1) * & currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1)) * tree_area currentCohort%gscan = sum((1.0_r8/(rs_z(cl,ft,1:currentCohort%nv-1)+bc_in(s)%rb_pa(ifp)))) * tree_area - currentCohort%ts_net_uptake(1:currentCohort%nv) = an_av(cl,ft,1:currentCohort%nv) * 12E-9 * dtime + currentCohort%ts_net_uptake(1:currentCohort%nv) = an_av(cl,ft,1:currentCohort%nv) * umolC_to_kgC * dtime else currentCohort%gpp_tstep = 0.0_r8 - currentCohort%rd = 0.0_r8 + currentCohort%rdark = 0.0_r8 currentCohort%gscan = 0.0_r8 currentCohort%ts_net_uptake(:) = 0.0_r8 end if - if ( DEBUG ) write(iulog,*) 'EDPhoto 832 ', currentCohort%gpp_tstep + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 832 ', currentCohort%gpp_tstep laifrac = (currentCohort%treelai+currentCohort%treesai)-(currentCohort%nv-1)*dinc_ed @@ -833,104 +857,112 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%gscan = currentCohort%gscan+gs_cohort if ( DEBUG ) then - write(iulog,*) 'EDPhoto 868 ', currentCohort%gpp_tstep - write(iulog,*) 'EDPhoto 869 ', currentPatch%psn_z(cl,ft,currentCohort%nv) - write(iulog,*) 'EDPhoto 870 ', currentPatch%elai_profile(cl,ft,currentCohort%nv) - write(iulog,*) 'EDPhoto 871 ', laifrac - write(iulog,*) 'EDPhoto 872 ', tree_area - write(iulog,*) 'EDPhoto 873 ', currentCohort%nv, cl, ft + write(fates_log(),*) 'EDPhoto 868 ', currentCohort%gpp_tstep + write(fates_log(),*) 'EDPhoto 869 ', currentPatch%psn_z(cl,ft,currentCohort%nv) + write(fates_log(),*) 'EDPhoto 870 ', currentPatch%elai_profile(cl,ft,currentCohort%nv) + write(fates_log(),*) 'EDPhoto 871 ', laifrac + write(fates_log(),*) 'EDPhoto 872 ', tree_area + write(fates_log(),*) 'EDPhoto 873 ', currentCohort%nv, cl, ft endif currentCohort%gpp_tstep = currentCohort%gpp_tstep + currentPatch%psn_z(cl,ft,currentCohort%nv) * & currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area - if ( DEBUG ) write(iulog,*) 'EDPhoto 843 ', currentCohort%rd + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 843 ', currentCohort%rdark - currentCohort%rd = currentCohort%rd + lmr_z(cl,ft,currentCohort%nv) * & - currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area - !------------------------------------------------------------------------------ - ! Calculate Whole Plant Respiration (this doesn't really need to be in this iteration at all, surely?) - ! Leaf respn needs to be in the sub-layer loop to account for changing N through canopy. - ! - ! base rate for maintenance respiration is from: - ! M. Ryan, 1991. Effects of climate change on plant respiration. - ! Ecological Applications, 1(2), 157-167. - ! Original expression is br = 0.0106 molC/(molN h) - ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) - !------------------------------------------------------------------------------ + currentCohort%rdark = currentCohort%rdark + lmr_z(cl,ft,currentCohort%nv) * & + currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area - br = 2.525e-6_r8 + ! Convert dark respiration from umol/plant/s to kgC/plant/s + currentCohort%rdark = currentCohort%rdark * umolC_to_kgC leaf_frac = 1.0_r8/(currentCohort%canopy_trim + EDecophyscon%sapwood_ratio(currentCohort%pft) * & currentCohort%hite + pftcon%froot_leaf(currentCohort%pft)) - currentCohort%bsw = EDecophyscon%sapwood_ratio(currentCohort%pft) * currentCohort%hite * & - (currentCohort%balive + currentCohort%laimemory)*leaf_frac - currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) - currentCohort%livestem_mr = 0._r8 - currentCohort%livecroot_mr = 0._r8 - if ( DEBUG ) write(iulog,*) 'EDPhoto 874 ', currentCohort%livecroot_mr - if ( DEBUG ) write(iulog,*) 'EDPhoto 875 ', currentCohort%livecrootn + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! THIS CALCULATION SHOULD BE MOVED TO THE ALLOMETRY MODULE (RGK 10-8-2016) + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + currentCohort%bsw = EDecophyscon%sapwood_ratio(currentCohort%pft) * & + currentCohort%hite * (currentCohort%balive + currentCohort%laimemory)*leaf_frac - if (woody(FT) == 1) then - tc = q10**((bc_in(s)%t_veg_pa(ifp)-tfrz - 20.0_r8)/10.0_r8) - currentCohort%livestem_mr = currentCohort%livestemn * br * tc !*currentPatch%btran_ft(currentCohort%pft) - currentCohort%livecroot_mr = currentCohort%livecrootn * br * tc !*currentPatch%btran_ft(currentCohort%pft) + ! Calculate the amount of nitrogen in the above and below ground + ! stem and root pools, used for maint resp + ! We are using the fine-root C:N ratio as an approximation for + ! the sapwood pools. + ! Units are in (kgN/plant) + ! ------------------------------------------------------------------ + live_stem_n = ED_val_ag_biomass * currentCohort%bsw / & + frootcn(currentCohort%pft) + live_croot_n = (1.0_r8-ED_val_ag_biomass) * currentCohort%bsw / & + frootcn(currentCohort%pft) + froot_n = currentCohort%br / frootcn(currentCohort%pft) + + + !------------------------------------------------------------------------------ + ! Calculate Whole Plant Respiration (this doesn't really need to be in this iteration at all, surely?) + ! Leaf respn needs to be in the sub-layer loop to account for changing N through canopy. + !------------------------------------------------------------------------------ - !convert from gC /indiv/s-1 to kgC/indiv/s-1 - ! TODO: CHANGE THAT 1000 to 1000.0_r8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - currentCohort%livestem_mr = currentCohort%livestem_mr /1000 - currentCohort%livecroot_mr = currentCohort%livecroot_mr /1000 + ! Live stem MR (kgC/plant/s) (above ground sapwood) + ! ------------------------------------------------------------------ + if (woody(ft) == 1) then + tc = q10**((bc_in(s)%t_veg_pa(ifp)-tfrz - 20.0_r8)/10.0_r8) + ! kgC/s = kgN * kgC/kgN/s + currentCohort%livestem_mr = live_stem_n * base_mr_20 * tc else - tc = 1.0_r8 currentCohort%livestem_mr = 0._r8 - currentCohort%livecroot_mr = 0._r8 end if - if (pftcon%woody(currentCohort%pft) == 1) then - coarse_wood_frac = 0.5_r8 - else - coarse_wood_frac = 0.0_r8 - end if - ! Soil temperature. + ! Fine Root MR (kgC/plant/s) + ! ------------------------------------------------------------------ currentCohort%froot_mr = 0._r8 - - do j = 1,nlevsoi + do j = 1,cp_numlevsoil tcsoi = q10**((bc_in(s)%t_soisno_gl(j)-tfrz - 20.0_r8)/10.0_r8) - !fine root respn. - currentCohort%froot_mr = currentCohort%froot_mr + (1.0_r8 - coarse_wood_frac) * & - currentCohort%br*br*tcsoi * currentPatch%rootfr_ft(ft,j)/leafcn(currentCohort%pft) - ! convert from gC/indiv/s-1 to kgC/indiv/s-1 - currentCohort%froot_mr = currentCohort%froot_mr /1000.0_r8 + currentCohort%froot_mr = currentCohort%froot_mr + & + froot_n * base_mr_20 * tcsoi * currentPatch%rootfr_ft(ft,j) enddo - ! convert gpp and resp from umol/indiv/s-1 to kgC/indiv/s-1 = X * 12 *10-6 * 10-3 - !currentCohort%resp_m = currentCohort%rd * 12.0E-9 + ! Coarse Root MR (kgC/plant/s) (below ground sapwood) + ! ------------------------------------------------------------------ + if (woody(ft) == 1) then + currentCohort%livecroot_mr = 0._r8 + do j = 1,cp_numlevsoil + ! Soil temperature used to adjust base rate of MR + tcsoi = q10**((bc_in(s)%t_soisno_gl(j)-tfrz - 20.0_r8)/10.0_r8) + currentCohort%livecroot_mr = currentCohort%livecroot_mr + & + live_croot_n * base_mr_20 * tcsoi * & + currentPatch%rootfr_ft(ft,j) + enddo + else + currentCohort%livecroot_mr = 0._r8 + end if - if ( DEBUG ) write(iulog,*) 'EDPhoto 904 ', currentCohort%resp_m - if ( DEBUG ) write(iulog,*) 'EDPhoto 905 ', currentCohort%rd - if ( DEBUG ) write(iulog,*) 'EDPhoto 906 ', currentCohort%livestem_mr - if ( DEBUG ) write(iulog,*) 'EDPhoto 907 ', currentCohort%livecroot_mr - if ( DEBUG ) write(iulog,*) 'EDPhoto 908 ', currentCohort%froot_mr + ! convert gpp from umol/indiv/s-1 to kgC/indiv/s-1 = X * 12 *10-6 * 10-3 - currentCohort%gpp_tstep = currentCohort%gpp_tstep * 12.0E-9 + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 904 ', currentCohort%resp_m + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 905 ', currentCohort%rdark + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 906 ', currentCohort%livestem_mr + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 907 ', currentCohort%livecroot_mr + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 908 ', currentCohort%froot_mr + + currentCohort%gpp_tstep = currentCohort%gpp_tstep * umolC_to_kgC ! add on whole plant respiration values in kgC/indiv/s-1 currentCohort%resp_m = currentCohort%livestem_mr + currentCohort%livecroot_mr + currentCohort%froot_mr ! no drought response * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft)*pftcon%resp_drought_response(FT)) - currentCohort%resp_m = currentCohort%resp_m + currentCohort%rd * 12.0E-9 !this was already corrected fo BTRAN + currentCohort%resp_m = currentCohort%resp_m + currentCohort%rdark ! convert from kgC/indiv/s to kgC/indiv/timestep currentCohort%resp_m = currentCohort%resp_m * dtime currentCohort%gpp_tstep = currentCohort%gpp_tstep * dtime - if ( DEBUG ) write(iulog,*) 'EDPhoto 911 ', currentCohort%gpp_tstep - if ( DEBUG ) write(iulog,*) 'EDPhoto 912 ', currentCohort%resp_tstep - if ( DEBUG ) write(iulog,*) 'EDPhoto 913 ', currentCohort%resp_m + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 911 ', currentCohort%gpp_tstep + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 912 ', currentCohort%resp_tstep + if ( DEBUG ) write(fates_log(),*) 'EDPhoto 913 ', currentCohort%resp_m - currentCohort%resp_g = ED_val_grperc(1) * (max(0._r8,currentCohort%gpp_tstep - currentCohort%resp_m)) + currentCohort%resp_g = ED_val_grperc(ft) * (max(0._r8,currentCohort%gpp_tstep - currentCohort%resp_m)) currentCohort%resp_tstep = currentCohort%resp_m + currentCohort%resp_g ! kgC/indiv/ts currentCohort%npp_tstep = currentCohort%gpp_tstep - currentCohort%resp_tstep ! kgC/indiv/ts @@ -949,7 +981,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) currentCohort%gscan = 0._r8 end if else !pft<0 n<0 - write(iulog,*) 'CF: pft 0 or n 0',currentCohort%pft,currentCohort%n,currentCohort%indexnumber + write(fates_log(),*) 'CF: pft 0 or n 0',currentCohort%pft,currentCohort%n,currentCohort%indexnumber currentCohort%gpp_tstep = 0._r8 currentCohort%resp_m = 0._r8 currentCohort%gscan = 0._r8 @@ -979,7 +1011,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) end if bc_out(s)%rssun_pa(ifp) = rscanopy bc_out(s)%rssha_pa(ifp) = rscanopy - bc_out(s)%gccanopy_pa(ifp) = 1.0_r8/rscanopy*cf/1000 !convert into umol m02 s-1 then mmol m-2 s-1. + bc_out(s)%gccanopy_pa(ifp) = 1.0_r8/rscanopy*cf/umol_per_mmol !convert into umol m-2 s-1 then mmol m-2 s-1. end if currentPatch => currentPatch%younger @@ -1004,7 +1036,8 @@ function ft1_f(tl, ha) result(ans) ! 7/23/16: Copied over from CLM by Ryan Knox ! !!USES - use clm_varcon , only : rgas, tfrz + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm ! ! !ARGUMENTS: real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) @@ -1030,7 +1063,9 @@ function fth_f(tl,hd,se,scaleFactor) result(ans) ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 ! 7/23/16: Copied over from CLM by Ryan Knox ! - use clm_varcon , only : rgas, tfrz + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + ! ! !ARGUMENTS: real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) @@ -1058,8 +1093,11 @@ function fth25_f(hd,se)result(ans) ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 ! 7/23/16: Copied over from CLM by Ryan Knox ! - !!USES - use clm_varcon , only : rgas, tfrz + !!USES + + use FatesConstantsMod, only : rgas => rgas_J_K_kmol + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + ! ! !ARGUMENTS: real(r8), intent(in) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) @@ -1090,7 +1128,6 @@ subroutine quadratic_f (a, b, c, r1, r2) ! 7/23/16: Copied over from CLM by Ryan Knox ! ! !USES: - implicit none ! ! !ARGUMENTS: real(r8), intent(in) :: a,b,c ! Terms for quadratic equation @@ -1101,8 +1138,8 @@ subroutine quadratic_f (a, b, c, r1, r2) !------------------------------------------------------------------------------ if (a == 0._r8) then - write (iulog,*) 'Quadratic solution error: a = ',a - call endrun(msg=errmsg(sourcefile, __LINE__)) + write (fates_log(),*) 'Quadratic solution error: a = ',a + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if (b >= 0._r8) then diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 9f64aefa17..d02891cb28 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -189,6 +189,14 @@ module EDTypesMod real(r8) :: treesai ! stem area index of tree (total stem area (m2) / canopy area (m2) logical :: isnew ! flag to signify a new cohort, new cohorts have not experienced ! npp or mortality and should therefore not be fused or averaged + integer :: size_class ! An index that indicates which diameter size bin the cohort currently resides in + ! this is used for history output. We maintain this in the main cohort memory + ! because we don't want to continually re-calculate the cohort's position when + ! performing size diagnostics at high-frequency calls + integer :: size_by_pft_class ! An index that indicates the cohorts position of the joint size-class x functional + ! type classification. We also maintain this in the main cohort memory + ! 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 @@ -212,11 +220,13 @@ module EDTypesMod real(r8) :: year_net_uptake(cp_nlevcan) ! Net uptake of leaf layers: kgC/m2/year ! RESPIRATION COMPONENTS - real(r8) :: rd ! Dark respiration: umol/indiv/s + real(r8) :: rdark ! Dark respiration: kgC/indiv/s real(r8) :: resp_g ! Growth respiration: kgC/indiv/timestep real(r8) :: resp_m ! Maintenance respiration: kgC/indiv/timestep real(r8) :: livestem_mr ! Live stem maintenance respiration: kgC/indiv/s - real(r8) :: livecroot_mr ! Live coarse root maintenance respiration: kgC/indiv/s + ! (Above ground) + real(r8) :: livecroot_mr ! Live stem maintenance respiration: kgC/indiv/s + ! (below ground) real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s ! ALLOCATION @@ -239,9 +249,11 @@ module EDTypesMod real(r8) :: fmort ! fire mortality n/year ! NITROGEN POOLS - real(r8) :: livestemn ! live stem nitrogen : KgN/invid - real(r8) :: livecrootn ! live coarse root nitrogen: KgN/invid - real(r8) :: frootn ! fine root nitrogen : KgN/invid + ! ---------------------------------------------------------------------------------- + ! Nitrogen pools are not prognostic in the current implementation. + ! They are diagnosed during photosynthesis using a simple C2N parameter. Local values + ! used in that routine. + ! ---------------------------------------------------------------------------------- ! GROWTH DERIVIATIVES real(r8) :: dndt ! time derivative of cohort size : n/year diff --git a/components/clm/src/ED/main/FatesConstantsMod.F90 b/components/clm/src/ED/main/FatesConstantsMod.F90 index 244f6f6505..3df36d6b56 100644 --- a/components/clm/src/ED/main/FatesConstantsMod.F90 +++ b/components/clm/src/ED/main/FatesConstantsMod.F90 @@ -14,4 +14,45 @@ module FatesConstantsMod integer, parameter :: fates_short_string_length = 32 integer, parameter :: fates_long_string_length = 199 + ! Unset and various other 'special' values + integer, parameter :: fates_unset_int = -9999 + + ! Unit conversion constants: + + ! Conversion factor umols of Carbon -> kg of Carbon (1 mol = 12g) + ! We do not use umolC_per_kg because it is a non-terminating decimal + real(fates_r8), parameter :: umolC_to_kgC = 12.0E-9_fates_r8 + + ! Conversion factor: grams per kilograms + real(fates_r8), parameter :: g_per_kg = 1000.0_fates_r8 + + ! Conversion factor: miligrams per grams + real(fates_r8), parameter :: mg_per_g = 1000.0_fates_r8 + + ! Conversion factor: micromoles per milimole + real(fates_r8), parameter :: umol_per_mmol = 1000.0_fates_r8 + + ! Conversion factor: milimoles per mole + real(fates_r8), parameter :: mmol_per_mol = 1000.0_fates_r8 + + ! Conversion factor: micromoles per mole + real(fates_r8), parameter :: umol_per_mol = 1.0E6_fates_r8 + + + ! Conversion: secons per minute + real(fates_r8), parameter :: sec_per_min = 60.0_fates_r8 + + + ! Physical constants + + ! universal gas constant [J/K/kmol] + real(fates_r8), parameter :: rgas_J_K_kmol = 8314.4598_fates_r8 + + ! freezing point of water at 1 atm (K) + real(fates_r8), parameter :: t_water_freeze_k_1atm = 273.15_fates_r8 + + ! freezing point of water at triple point (K) + real(fates_r8), parameter :: t_water_freeze_k_triple = 273.16_fates_r8 + + end module FatesConstantsMod diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 new file mode 100644 index 0000000000..d980f84093 --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 @@ -0,0 +1,92 @@ +module FatesHistoryDimensionMod + + use FatesConstantsMod, only : fates_short_string_length + + implicit none + + ! FIXME(bja, 2016-10) do these need to be strings, or can they be integer enumerations? + character(*), parameter :: patch_r8 = 'PA_R8' + character(*), parameter :: patch_ground_r8 = 'PA_GRND_R8' + character(*), parameter :: patch_size_pft_r8 = 'PA_SCPF_R8' + character(*), parameter :: site_r8 = 'SI_R8' + character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' + character(*), parameter :: site_size_pft_r8 = 'SI_SCPF_R8' + character(*), parameter :: patch_int = 'PA_INT' + + integer, parameter :: fates_num_dimension_types = 4 + character(*), parameter :: patch = 'patch' + character(*), parameter :: column = 'column' + character(*), parameter :: levgrnd = 'levgrnd' + character(*), parameter :: levscpf = 'levscpf' + + ! patch = This is a structure that records where FATES patch boundaries + ! on each thread point to in the host IO array, this structure + ! is allocated by number of threads + + ! column = This is a structure that records where FATES column boundaries + ! on each thread point to in the host IO array, this structure + ! is allocated by number of threads + + ! ground = This is a structure that records the boundaries for the + ! ground level (includes rock) dimension + + ! levscpf = This is a structure that records the boundaries for the + ! number of size-class x pft dimension + + + ! This structure is not allocated by thread, but the upper and lower boundaries + ! of the dimension for each thread is saved in the clump_ entry + type fates_history_dimension_type + character(len=fates_short_string_length) :: name + integer :: lower_bound + integer :: upper_bound + integer, allocatable :: clump_lower_bound(:) ! lower bound of thread's portion of HIO array + integer, allocatable :: clump_upper_bound(:) ! upper bound of thread's portion of HIO array + contains + procedure, public :: Init + procedure, public :: SetThreadBounds + end type fates_history_dimension_type + +contains + + ! ===================================================================================== + subroutine Init(this, name, num_threads, lower_bound, upper_bound) + + implicit none + + ! arguments + class(fates_history_dimension_type), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: num_threads + integer, intent(in) :: lower_bound + integer, intent(in) :: upper_bound + + this%name = trim(name) + this%lower_bound = lower_bound + this%upper_bound = upper_bound + + allocate(this%clump_lower_bound(num_threads)) + this%clump_lower_bound(:) = -1 + + allocate(this%clump_upper_bound(num_threads)) + this%clump_upper_bound(:) = -1 + + end subroutine Init + + ! ===================================================================================== + + subroutine SetThreadBounds(this, thread_index, lower_bound, upper_bound) + + implicit none + + class(fates_history_dimension_type), intent(inout) :: this + integer, intent(in) :: thread_index + integer, intent(in) :: lower_bound + integer, intent(in) :: upper_bound + + this%clump_lower_bound(thread_index) = lower_bound + this%clump_upper_bound(thread_index) = upper_bound + + end subroutine SetThreadBounds + +end module FatesHistoryDimensionMod diff --git a/components/clm/src/ED/main/HistoryIOMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 similarity index 53% rename from components/clm/src/ED/main/HistoryIOMod.F90 rename to components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index b21edabe18..77aace9d47 100644 --- a/components/clm/src/ED/main/HistoryIOMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -1,10 +1,17 @@ -Module HistoryIOMod +module FatesHistoryInterfaceMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : fates_avg_flag_length, fates_short_string_length, fates_long_string_length use FatesGlobals , only : fates_log + + use FatesHistoryDimensionMod, only : fates_history_dimension_type, fates_num_dimension_types + use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type + use FatesHistoryVariableType, only : fates_history_variable_type + use EDTypesMod , only : cp_hio_ignore_val + + ! FIXME(bja, 2016-10) need to remove CLM dependancy use pftconMod , only : pftcon implicit none @@ -120,21 +127,27 @@ Module HistoryIOMod integer, private :: ih_m4_si_scpf integer, private :: ih_m5_si_scpf + integer, private :: ih_ar_si_scpf + integer, private :: ih_ar_grow_si_scpf + integer, private :: ih_ar_maint_si_scpf + integer, private :: ih_ar_darkm_si_scpf + integer, private :: ih_ar_agsapm_si_scpf + integer, private :: ih_ar_crootm_si_scpf + integer, private :: ih_ar_frootm_si_scpf ! The number of variable dim/kind types we have defined (static) - integer, parameter :: n_iovar_dk = 6 - - - ! This structure is not allocated by thread, but the upper and lower boundaries - ! of the dimension for each thread is saved in the clump_ entry - type iovar_dim_type - character(fates_short_string_length) :: name ! This should match the name of the dimension - integer :: lb ! lower bound - integer :: ub ! upper bound - integer,allocatable :: clump_lb(:) ! lower bound of thread's portion of HIO array - integer,allocatable :: clump_ub(:) ! upper bound of thread's portion of HIO array - end type iovar_dim_type - + integer, parameter :: fates_num_dim_kinds = 6 + + type, public :: fates_bounds_type + integer :: patch_begin + integer :: patch_end + integer :: column_begin + integer :: column_end + integer :: ground_begin + integer :: ground_end + integer :: pft_class_begin + integer :: pft_class_end + end type fates_bounds_type ! This structure is allocated by thread, and must be calculated after the FATES @@ -148,105 +161,394 @@ Module HistoryIOMod end type iovar_map_type - - ! This structure is not multi-threaded - type iovar_dimkind_type - character(fates_short_string_length) :: name ! String labelling this IO type - integer :: ndims ! number of dimensions in this IO type - integer, allocatable :: dimsize(:) ! The size of each dimension - logical :: active - type(iovar_dim_type), pointer :: dim1_ptr - type(iovar_dim_type), pointer :: dim2_ptr - end type iovar_dimkind_type - - - - ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) - type iovar_def_type - character(len=fates_short_string_length) :: vname - character(len=fates_short_string_length) :: units - character(len=fates_long_string_length) :: long - character(len=fates_short_string_length) :: use_default ! States whether a variable should be turned - ! on the output files by default (active/inactive) - ! It is a good idea to set inactive for very large - ! or infrequently used output datasets - character(len=fates_short_string_length) :: vtype - character(len=fates_avg_flag_length) :: avgflag - integer :: upfreq ! Update frequency (this is for checks and flushing) - ! 1 = dynamics "dyn" (daily) - ! 2 = production "prod" (prob model tstep) - real(r8) :: flushval - type(iovar_dimkind_type),pointer :: iovar_dk_ptr - ! Pointers (only one of these is allocated per variable) - real(r8), pointer :: r81d(:) - real(r8), pointer :: r82d(:,:) - real(r8), pointer :: r83d(:,:,:) - integer, pointer :: int1d(:) - integer, pointer :: int2d(:,:) - integer, pointer :: int3d(:,:,:) - end type iovar_def_type - - - type, public :: fates_hio_interface_type + type, public :: fates_history_interface_type ! Instance of the list of history output varialbes - type(iovar_def_type), pointer :: hvars(:) - integer :: n_hvars + type(fates_history_variable_type), allocatable :: hvars(:) + integer, private :: num_history_vars_ ! Instanteat one registry of the different dimension/kinds (dk) ! All output variables will have a pointer to one of these dk's - type(iovar_dimkind_type), pointer :: iovar_dk(:) + type(fates_history_variable_kind_type) :: dim_kinds(fates_num_dim_kinds) ! This is a structure that explains where FATES patch boundaries - ! on each thread point to in the host IO array, this structure - ! is allocated by number of threads - type(iovar_dim_type) :: iopa_dim + ! on each thread point to in the host IO array, this structure is + ! allocated by number of threads. This could be dynamically + ! allocated, but is unlikely to change...? + type(fates_history_dimension_type) :: dim_bounds(fates_num_dimension_types) - ! This is a structure that explains where FATES patch boundaries - ! on each thread point to in the host IO array, this structure - ! is allocated by number of threads - type(iovar_dim_type) :: iosi_dim - - ! This is a structure that contains the boundaries for the - ! ground level (includes rock) dimension - type(iovar_dim_type) :: iogrnd_dim - - ! This is a structure that contains the boundaries for the - ! number of size-class x pft dimension - type(iovar_dim_type) :: ioscpf_dim - - type(iovar_map_type), pointer :: iovar_map(:) - + + integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ contains + procedure, public :: Init + procedure, public :: SetThreadBounds + procedure, public :: initialize_history_vars + procedure, public :: assemble_valid_output_types + procedure, public :: update_history_dyn procedure, public :: update_history_prod procedure, public :: update_history_cbal - procedure, public :: define_history_vars - procedure, public :: set_history_var - procedure, public :: init_iovar_dk_maps - procedure, public :: iotype_index - procedure, public :: set_dim_ptrs - procedure, public :: get_hvar_bounds - procedure, public :: dim_init - procedure, public :: set_dim_thread_bounds + + ! 'get' methods used by external callers to access private read only data + procedure, public :: num_history_vars + procedure, public :: patch_index + procedure, public :: column_index + procedure, public :: levgrnd_index + procedure, public :: levscpf_index + + ! private work functions + procedure, private :: define_history_vars + procedure, private :: set_history_var + procedure, private :: init_dim_kinds_maps + procedure, private :: set_dim_indices procedure, private :: flush_hvars - end type fates_hio_interface_type + procedure, private :: set_patch_index + procedure, private :: set_column_index + procedure, private :: set_levgrnd_index + procedure, private :: set_levscpf_index + + end type fates_history_interface_type contains - ! =================================================================================== + ! ====================================================================== + + subroutine Init(this, num_threads, fates_bounds) + + use FatesHistoryDimensionMod, only : patch, column, levgrnd, levscpf + + implicit none + + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: num_threads + type(fates_bounds_type), intent(in) :: fates_bounds + + integer :: dim_count = 0 + + dim_count = dim_count + 1 + call this%set_patch_index(dim_count) + call this%dim_bounds(dim_count)%Init(patch, num_threads, & + fates_bounds%patch_begin, fates_bounds%patch_end) + + dim_count = dim_count + 1 + call this%set_column_index(dim_count) + call this%dim_bounds(dim_count)%Init(column, num_threads, & + fates_bounds%column_begin, fates_bounds%column_end) + + dim_count = dim_count + 1 + call this%set_levgrnd_index(dim_count) + call this%dim_bounds(dim_count)%Init(levgrnd, num_threads, & + fates_bounds%ground_begin, fates_bounds%ground_end) + + dim_count = dim_count + 1 + call this%set_levscpf_index(dim_count) + call this%dim_bounds(dim_count)%Init(levscpf, num_threads, & + fates_bounds%pft_class_begin, fates_bounds%pft_class_end) + ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) + + ! Allocate the mapping between FATES indices and the IO indices + allocate(this%iovar_map(num_threads)) + + end subroutine Init + + ! ====================================================================== + subroutine SetThreadBounds(this, thread_index, thread_bounds) + + implicit none + + class(fates_history_interface_type), intent(inout) :: this + + integer, intent(in) :: thread_index + type(fates_bounds_type), intent(in) :: thread_bounds + + integer :: index + + index = this%patch_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%patch_begin, thread_bounds%patch_end) + + index = this%column_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%column_begin, thread_bounds%column_end) + + index = this%levgrnd_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%ground_begin, thread_bounds%ground_end) + + index = this%levscpf_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%pft_class_begin, thread_bounds%pft_class_end) + + end subroutine SetThreadBounds - subroutine update_history_cbal(this,nc,nsites,sites) + ! =================================================================================== + subroutine assemble_valid_output_types(this) + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8 + + implicit none + + class(fates_history_interface_type), intent(inout) :: this + + call this%init_dim_kinds_maps() + + call this%set_dim_indices(patch_r8, 1, this%patch_index()) + + call this%set_dim_indices(site_r8, 1, this%column_index()) + + call this%set_dim_indices(patch_ground_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_ground_r8, 2, this%levgrnd_index()) + + call this%set_dim_indices(site_ground_r8, 1, this%column_index()) + call this%set_dim_indices(site_ground_r8, 2, this%levgrnd_index()) + + call this%set_dim_indices(patch_size_pft_r8, 1, this%patch_index()) + call this%set_dim_indices(patch_size_pft_r8, 2, this%levscpf_index()) + + call this%set_dim_indices(site_size_pft_r8, 1, this%column_index()) + call this%set_dim_indices(site_size_pft_r8, 2, this%levscpf_index()) + + end subroutine assemble_valid_output_types + + ! =================================================================================== + + subroutine set_dim_indices(this, dk_name, idim, dim_index) + + use FatesHistoryVariableKindMod , only : iotype_index + + implicit none + + ! arguments + class(fates_history_interface_type), intent(inout) :: this + character(len=*), intent(in) :: dk_name + integer, intent(in) :: idim ! dimension index + integer, intent(in) :: dim_index + + + ! local + integer :: ityp + + ityp = iotype_index(trim(dk_name), fates_num_dim_kinds, this%dim_kinds) + + ! First check to see if the dimension is allocated + if (this%dim_kinds(ityp)%ndims < idim) then + write(fates_log(), *) 'Trying to define dimension size to a dim-type structure' + write(fates_log(), *) 'but the dimension index does not exist' + write(fates_log(), *) 'type: ',dk_name,' ndims: ',this%dim_kinds(ityp)%ndims,' input dim:',idim + stop + !end_run + end if + + if (idim == 1) then + this%dim_kinds(ityp)%dim1_index = dim_index + else if (idim == 2) then + this%dim_kinds(ityp)%dim2_index = dim_index + end if + + ! With the map, we can set the dimension size + this%dim_kinds(ityp)%dimsize(idim) = this%dim_bounds(dim_index)%upper_bound - & + this%dim_bounds(dim_index)%lower_bound + 1 + + end subroutine set_dim_indices + + ! ======================================================================= + subroutine set_patch_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%patch_index_ = index + end subroutine set_patch_index + + integer function patch_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + patch_index = this%patch_index_ + end function patch_index + + ! ======================================================================= + subroutine set_column_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%column_index_ = index + end subroutine set_column_index + + integer function column_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + column_index = this%column_index_ + end function column_index + + ! ======================================================================= + subroutine set_levgrnd_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levgrnd_index_ = index + end subroutine set_levgrnd_index + + integer function levgrnd_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levgrnd_index = this%levgrnd_index_ + end function levgrnd_index + + ! ======================================================================= + subroutine set_levscpf_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levscpf_index_ = index + end subroutine set_levscpf_index + + integer function levscpf_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levscpf_index = this%levscpf_index_ + end function levscpf_index + + ! ====================================================================================== + + subroutine flush_hvars(this,nc,upfreq_in) + + class(fates_history_interface_type) :: this + integer,intent(in) :: nc + integer,intent(in) :: upfreq_in + + integer :: ivar + type(fates_history_variable_type),pointer :: hvar + integer :: lb1,ub1,lb2,ub2 + + do ivar=1,ubound(this%hvars,1) + associate( hvar => this%hvars(ivar) ) + if (hvar%upfreq == upfreq_in) then ! Only flush variables with update on dynamics step + call hvar%Flush(nc, this%dim_bounds, this%dim_kinds) + end if + end associate + end do + + end subroutine flush_hvars + + + ! ===================================================================================== + + subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype, & + hlms, flushval, upfreq, ivar, initialize, index) + + use FatesUtilsMod, only : check_hlm_list + use EDTypesMod, only : cp_hlm_name + + implicit none + + ! arguments + class(fates_history_interface_type), intent(inout) :: this + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: use_default + character(len=*), intent(in) :: avgflag + character(len=*), intent(in) :: vtype + character(len=*), intent(in) :: hlms + real(r8), intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT + integer, intent(in) :: upfreq + logical, intent(in) :: initialize + integer, intent(inout) :: ivar + integer, intent(inout) :: index ! This is the index for the variable of + ! interest that is associated with an + ! explict name (for fast reference during update) + ! A zero is passed back when the variable is + ! not used + + ! locals + type(fates_history_variable_type), pointer :: hvar + integer :: ub1, lb1, ub2, lb2 ! Bounds for allocating the var + integer :: ityp + + logical :: write_var + + write_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) + if( write_var ) then + ivar = ivar+1 + index = ivar + + if (initialize) then + call this%hvars(ivar)%Init(vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, fates_num_dim_kinds, this%dim_kinds, & + this%dim_bounds) + end if + else + index = 0 + end if + + return + end subroutine set_history_var + + ! ==================================================================================== + + subroutine init_dim_kinds_maps(this) + + ! ---------------------------------------------------------------------------------- + ! This subroutine simply initializes the structures that define the different + ! array and type formats for different IO variables + ! + ! PA_R8 : 1D patch scale 8-byte reals + ! SI_R8 : 1D site scale 8-byte reals + ! + ! The allocation on the structures is not dynamic and should only add up to the + ! number of entries listed here. + ! + ! ---------------------------------------------------------------------------------- + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 + + implicit none + + ! Arguments + class(fates_history_interface_type), intent(inout) :: this + + + integer :: index + + ! 1d Patch + index = 1 + call this%dim_kinds(index)%Init(patch_r8, 1) + + ! 1d Site + index = index + 1 + call this%dim_kinds(index)%Init(site_r8, 1) + + ! patch x ground + index = index + 1 + call this%dim_kinds(index)%Init(patch_ground_r8, 2) + + ! patch x size-class/pft + index = index + 1 + call this%dim_kinds(index)%Init(patch_size_pft_r8, 2) + + ! site x ground + index = index + 1 + call this%dim_kinds(index)%Init(site_ground_r8, 2) + + ! site x size-class/pft + index = index + 1 + call this%dim_kinds(index)%Init(site_size_pft_r8, 2) + + ! FIXME(bja, 2016-10) assert(index == fates_num_dim_kinds) + end subroutine init_dim_kinds_maps + + ! ======================================================================= + subroutine update_history_cbal(this,nc,nsites,sites) use EDtypesMod , only : ed_site_type ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -314,7 +616,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) use EDParamsMod , only : ED_val_ag_biomass ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -329,15 +631,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index - integer :: scpf ! index of the size-class x pft bin - integer :: sc ! index of the size-class bin real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column real(r8) :: patch_scaling_scalar ! ratio of canopy to patch area for counteracting patch scaling real(r8) :: dbh ! diameter ("at breast height") - type(iovar_def_type),pointer :: hvar + type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -490,75 +790,76 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! ------------------------------------------------------------------------ dbh = ccohort%dbh !-0.5*(1./365.25)*ccohort%ddbhdt - sc = count(dbh-sclass_ed.ge.0.0) - scpf = (ft-1)*nlevsclass_ed+sc ! Flux Variables (cohorts must had experienced a day before any of these values ! have any meaning, otherwise they are just inialization values 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] - hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & - ccohort%npp*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) + & - ccohort%npp_froot*n_perm2 - hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & - ccohort%npp_bsw*(1._r8-ED_val_ag_biomass)*n_perm2 - hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & - ccohort%npp_bsw*ED_val_ag_biomass*n_perm2 - hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & - ccohort%npp_bdead*(1._r8-ED_val_ag_biomass)*n_perm2 - hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & - ccohort%npp_bdead*ED_val_ag_biomass*n_perm2 - hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & - ccohort%npp_bseed*n_perm2 - 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+ & - 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+ & - 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_bsw,ccohort%npp_bdead, & - ccohort%npp_bseed,ccohort%npp_store - write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance ' - stop ! we need termination control for FATES!!! - ! call endrun(msg=errMsg(__FILE__, __LINE__)) - end if + 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] + hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & + ccohort%npp*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) + & + ccohort%npp_froot*n_perm2 + hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & + ccohort%npp_bsw*(1._r8-ED_val_ag_biomass)*n_perm2 + hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & + ccohort%npp_bsw*ED_val_ag_biomass*n_perm2 + hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & + ccohort%npp_bdead*(1._r8-ED_val_ag_biomass)*n_perm2 + hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & + ccohort%npp_bdead*ED_val_ag_biomass*n_perm2 + hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & + ccohort%npp_bseed*n_perm2 + 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+ & + 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+ & + 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_bsw,ccohort%npp_bdead, & + ccohort%npp_bseed,ccohort%npp_store + write(fates_log(),*) ' NPP components during FATES-HLM linking does not balance ' + stop ! we need termination control for FATES!!! + ! call endrun(msg=errMsg(__FILE__, __LINE__)) + end if - ! Woody State Variables (basal area and number density and mortality) - if (pftcon%woody(ft) == 1) then - - hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*n_perm2*AREA - hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*n_perm2*AREA - hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA - hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + ccohort%imort*n_perm2*AREA - hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*n_perm2*AREA - - ! basal area [m2/ha] - hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & - 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*n_perm2*AREA - - ! number density [/ha] - hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + AREA*n_perm2 - - ! Growth Incrments must have NaN check and woody check - if(ccohort%ddbhdt == ccohort%ddbhdt) then - hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & - ccohort%ddbhdt*n_perm2*AREA - else - hio_ddbh_si_scpf(io_si,scpf) = -999.9 - end if - end if - + ! Woody State Variables (basal area and number density and mortality) + if (pftcon%woody(ft) == 1) then + + hio_m1_si_scpf(io_si,scpf) = hio_m1_si_scpf(io_si,scpf) + ccohort%bmort*n_perm2*AREA + hio_m2_si_scpf(io_si,scpf) = hio_m2_si_scpf(io_si,scpf) + ccohort%hmort*n_perm2*AREA + hio_m3_si_scpf(io_si,scpf) = hio_m3_si_scpf(io_si,scpf) + ccohort%cmort*n_perm2*AREA + hio_m4_si_scpf(io_si,scpf) = hio_m4_si_scpf(io_si,scpf) + ccohort%imort*n_perm2*AREA + hio_m5_si_scpf(io_si,scpf) = hio_m5_si_scpf(io_si,scpf) + ccohort%fmort*n_perm2*AREA + + ! basal area [m2/ha] + hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & + 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*n_perm2*AREA + + ! number density [/ha] + hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + AREA*n_perm2 + + ! Growth Incrments must have NaN check and woody check + if(ccohort%ddbhdt == ccohort%ddbhdt) then + hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & + ccohort%ddbhdt*n_perm2*AREA + else + hio_ddbh_si_scpf(io_si,scpf) = -999.9 + end if + end if + + end associate end if ccohort => ccohort%taller @@ -628,9 +929,11 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) use EDtypesMod , only : ed_site_type, & ed_cohort_type, & ed_patch_type, & - AREA + AREA, & + sclass_ed, & + nlevsclass_ed ! Arguments - class(fates_hio_interface_type) :: this + class(fates_history_interface_type) :: this integer , intent(in) :: nc ! clump index integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) @@ -645,11 +948,11 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) integer :: io_soipa integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector - + integer :: ft ! functional type index real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column - type(iovar_def_type),pointer :: hvar + type(fates_history_variable_type),pointer :: hvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -661,7 +964,15 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) hio_aresp_pa => this%hvars(ih_aresp_pa)%r81d, & hio_maint_resp_pa => this%hvars(ih_maint_resp_pa)%r81d, & hio_growth_resp_pa => this%hvars(ih_growth_resp_pa)%r81d, & - hio_npp_si => this%hvars(ih_npp_si)%r81d ) + hio_npp_si => this%hvars(ih_npp_si)%r81d, & + hio_ar_si_scpf => this%hvars(ih_ar_si_scpf)%r82d, & + hio_ar_grow_si_scpf => this%hvars(ih_ar_grow_si_scpf)%r82d, & + hio_ar_maint_si_scpf => this%hvars(ih_ar_maint_si_scpf)%r82d, & + hio_ar_agsapm_si_scpf => this%hvars(ih_ar_agsapm_si_scpf)%r82d, & + hio_ar_darkm_si_scpf => this%hvars(ih_ar_darkm_si_scpf)%r82d, & + hio_ar_crootm_si_scpf => this%hvars(ih_ar_crootm_si_scpf)%r82d, & + hio_ar_frootm_si_scpf => this%hvars(ih_ar_frootm_si_scpf)%r82d ) + ! Flush the relevant history variables call this%flush_hvars(nc,upfreq_in=2) @@ -691,7 +1002,10 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) endif if ( .not. ccohort%isnew ) then - + + ! Calculate index for the scpf class + associate( scpf => ccohort%size_by_pft_class ) + ! scale up cohort fluxes to their patches hio_npp_pa(io_pa) = hio_npp_pa(io_pa) + & ccohort%npp_tstep * 1.e3_r8 * n_density / dt_tstep @@ -707,6 +1021,37 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) ! map ed cohort-level npp fluxes to clm column fluxes hio_npp_si(io_si) = hio_npp_si(io_si) + ccohort%npp_tstep * n_perm2 * 1.e3_r8 /dt_tstep + + ! Total AR (kgC/m2/yr) = (kgC/plant/step) / (s/step) * (plant/m2) * (s/yr) + hio_ar_si_scpf(io_si,scpf) = hio_ar_si_scpf(io_si,scpf) + & + (ccohort%resp_tstep/dt_tstep) * n_perm2 * daysecs * yeardays + + ! Growth AR (kgC/m2/yr) + hio_ar_grow_si_scpf(io_si,scpf) = hio_ar_grow_si_scpf(io_si,scpf) + & + (ccohort%resp_g/dt_tstep) * n_perm2 * daysecs * yeardays + + ! Maint AR (kgC/m2/yr) + hio_ar_maint_si_scpf(io_si,scpf) = hio_ar_maint_si_scpf(io_si,scpf) + & + (ccohort%resp_m/dt_tstep) * n_perm2 * daysecs * yeardays + + ! Maintenance AR partition variables are stored as rates (kgC/plant/s) + ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) + hio_ar_agsapm_si_scpf(io_si,scpf) = hio_ar_agsapm_si_scpf(io_si,scpf) + & + ccohort%livestem_mr * n_perm2 * daysecs * yeardays + + ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) + hio_ar_darkm_si_scpf(io_si,scpf) = hio_ar_darkm_si_scpf(io_si,scpf) + & + ccohort%rdark * n_perm2 * daysecs * yeardays + + ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) + hio_ar_crootm_si_scpf(io_si,scpf) = hio_ar_crootm_si_scpf(io_si,scpf) + & + ccohort%livecroot_mr * n_perm2 * daysecs * yeardays + + ! (kgC/m2/yr) = (kgC/plant/s) * (plant/m2) * (s/yr) + hio_ar_frootm_si_scpf(io_si,scpf) = hio_ar_frootm_si_scpf(io_si,scpf) + & + ccohort%froot_mr * n_perm2 * daysecs * yeardays + + end associate endif ccohort => ccohort%taller @@ -721,51 +1066,40 @@ subroutine update_history_prod(this,nc,nsites,sites,dt_tstep) end subroutine update_history_prod - ! ====================================================================================== + ! ==================================================================================== + integer function num_history_vars(this) - subroutine flush_hvars(this,nc,upfreq_in) - - class(fates_hio_interface_type) :: this - integer,intent(in) :: nc - integer,intent(in) :: upfreq_in + implicit none - integer :: ivar - type(iovar_def_type),pointer :: hvar - integer :: lb1,ub1,lb2,ub2 + class(fates_history_interface_type), intent(in) :: this + num_history_vars = this%num_history_vars_ + + end function num_history_vars + + ! ==================================================================================== + + subroutine initialize_history_vars(this) - do ivar=1,ubound(this%hvars,1) - hvar => this%hvars(ivar) - if (hvar%upfreq==upfreq_in) then ! Only flush variables with update on dynamics step - call this%get_hvar_bounds(hvar,nc,lb1,ub1,lb2,ub2) - select case(trim(hvar%iovar_dk_ptr%name)) - case('PA_R8') - hvar%r81d(lb1:ub1) = hvar%flushval - case('SI_R8') - hvar%r81d(lb1:ub1) = hvar%flushval - case('PA_GRND_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('PA_SCPF_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('SI_GRND_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('SI_SCPF_R8') - hvar%r82d(lb1:ub1,lb2:ub2) = hvar%flushval - case('PA_INT') - hvar%int1d(lb1:ub1) = nint(hvar%flushval) - case default - write(fates_log(),*) 'iotyp undefined while flushing history variables' - stop - !end_run - end select - end if - end do - - end subroutine flush_hvars + implicit none + + class(fates_history_interface_type), intent(inout) :: this - ! ==================================================================================== + ! Determine how many of the history IO variables registered in FATES + ! are going to be allocated + call this%define_history_vars(initialize_variables=.false.) + + ! Allocate the list of history output variable objects + allocate(this%hvars(this%num_history_vars())) + + ! construct the object that defines all of the IO variables + call this%define_history_vars(initialize_variables=.true.) + + end subroutine initialize_history_vars + + ! ==================================================================================== - subroutine define_history_vars(this,callstep,nvar) + subroutine define_history_vars(this, initialize_variables) ! --------------------------------------------------------------------------------- ! @@ -793,727 +1127,427 @@ subroutine define_history_vars(this,callstep,nvar) ! If your HLM makes use of, and you want, INTEGER OUTPUT, pass the flushval as ! a real. The applied flush value will use the NINT() intrinsic function ! --------------------------------------------------------------------------------- + + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 + implicit none - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: callstep ! are we 'count'ing or 'initializ'ing? - integer,optional,intent(out) :: nvar - integer :: ivar - - if(.not. (trim(callstep).eq.'count' .or. trim(callstep).eq.'initialize') ) then - write(fates_log(),*) 'defining history variables in FATES requires callstep count or initialize' - ! end_run('MESSAGE') - end if + class(fates_history_interface_type), intent(inout) :: this + logical, intent(in) :: initialize_variables ! are we 'count'ing or 'initializ'ing? + + integer :: ivar ivar=0 ! Site level counting variables - call this%set_history_var(vname='ED_NPATCHES',units='none', & + call this%set_history_var(vname='ED_NPATCHES', units='none', & long='Total number of ED patches per site', use_default='active', & - avgflag='A',vtype='SI_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_npatches_si) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_npatches_si) - call this%set_history_var(vname='ED_NCOHORTS',units='none', & + call this%set_history_var(vname='ED_NCOHORTS', units='none', & long='Total number of ED cohorts per site', use_default='active', & - avgflag='A',vtype='SI_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_ncohorts_si) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_ncohorts_si) ! Patch variables - call this%set_history_var(vname='TRIMMING',units='none', & + call this%set_history_var(vname='TRIMMING', units='none', & long='Degree to which canopy expansion is limited by leaf economics', & use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=1.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_trimming_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=1.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_trimming_pa) - call this%set_history_var(vname='AREA_PLANT',units='m2', & + call this%set_history_var(vname='AREA_PLANT', units='m2', & long='area occupied by all plants', use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_area_plant_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_area_plant_pa) - call this%set_history_var(vname='AREA_TREES',units='m2', & + call this%set_history_var(vname='AREA_TREES', units='m2', & long='area occupied by woody plants', use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_area_treespread_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_area_treespread_pa) - call this%set_history_var(vname='CANOPY_SPREAD',units='0-1', & + call this%set_history_var(vname='CANOPY_SPREAD', units='0-1', & long='Scaling factor between tree basal area and canopy area', & use_default='active', & - avgflag='A',vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep,index = ih_canopy_spread_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_canopy_spread_pa) - call this%set_history_var(vname='PFTbiomass',units='gC/m2', & + call this%set_history_var(vname='PFTbiomass', units='gC/m2', & long='total PFT level biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_biomass_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_biomass_pa_pft ) call this%set_history_var(vname='PFTleafbiomass', units='gC/m2', & long='total PFT level leaf biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_leafbiomass_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_leafbiomass_pa_pft ) call this%set_history_var(vname='PFTstorebiomass', units='gC/m2', & long='total PFT level stored biomass', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_storebiomass_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storebiomass_pa_pft ) call this%set_history_var(vname='PFTnindivs', units='indiv / m2', & long='total PFT level number of individuals', use_default='active', & - avgflag='A', vtype='PA_GRND_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar, callstep=callstep, index = ih_nindivs_pa_pft ) + avgflag='A', vtype=patch_ground_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_nindivs_pa_pft ) ! Fire Variables call this%set_history_var(vname='FIRE_NESTEROV_INDEX', units='none', & long='nesterov_fire_danger index', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_nesterov_fire_danger_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_nesterov_fire_danger_pa) call this%set_history_var(vname='FIRE_ROS', units='m/min', & long='fire rate of spread m/min', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_spitfire_ROS_pa) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_spitfire_ROS_pa) call this%set_history_var(vname='EFFECT_WSPEED', units='none', & long ='effective windspeed for fire spread', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_effect_wspeed_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_effect_wspeed_pa ) call this%set_history_var(vname='FIRE_TFC_ROS', units='none', & long ='total fuel consumed', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_TFC_ROS_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_TFC_ROS_pa ) call this%set_history_var(vname='FIRE_INTENSITY', units='kJ/m/s', & long='spitfire fire intensity: kJ/m/s', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_intensity_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_intensity_pa ) call this%set_history_var(vname='FIRE_AREA', units='fraction', & long='spitfire fire area:m2', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_area_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_area_pa ) call this%set_history_var(vname='SCORCH_HEIGHT', units='m', & long='spitfire fire area:m2', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_scorch_height_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_scorch_height_pa ) call this%set_history_var(vname='fire_fuel_mef', units='m', & long='spitfire fuel moisture', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_mef_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_mef_pa ) call this%set_history_var(vname='fire_fuel_bulkd', units='m', & long='spitfire fuel bulk density', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_bulkd_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_bulkd_pa ) call this%set_history_var(vname='FIRE_FUEL_EFF_MOIST', units='m', & long='spitfire fuel moisture', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_eff_moist_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_eff_moist_pa ) call this%set_history_var(vname='fire_fuel_sav', units='m', & long='spitfire fuel surface/volume ', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_fire_fuel_sav_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_fire_fuel_sav_pa ) call this%set_history_var(vname='SUM_FUEL', units='gC m-2', & long='total ground fuel related to ros (omits 1000hr fuels)', & use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_sum_fuel_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_sum_fuel_pa ) ! Litter Variables call this%set_history_var(vname='LITTER_IN', units='gC m-2 s-1', & long='Litter flux in leaves', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_litter_in_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_in_pa ) call this%set_history_var(vname='LITTER_OUT', units='gC m-2 s-1', & long='Litter flux out leaves', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_litter_out_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_litter_out_pa ) call this%set_history_var(vname='SEED_BANK', units='gC m-2', & long='Total Seed Mass of all PFTs', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_bank_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_bank_si ) call this%set_history_var(vname='SEEDS_IN', units='gC m-2 s-1', & long='Seed Production Rate', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seeds_in_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seeds_in_pa ) call this%set_history_var(vname='SEED_GERMINATION', units='gC m-2 s-1', & long='Seed mass converted into new cohorts', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_germination_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_germination_pa ) call this%set_history_var(vname='SEED_DECAY', units='gC m-2 s-1', & long='Seed mass decay', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_seed_decay_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_seed_decay_pa ) call this%set_history_var(vname='ED_bstore', units='gC m-2', & long='Storage biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bstore_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bstore_pa ) call this%set_history_var(vname='ED_bdead', units='gC m-2', & long='Dead (structural) biomass (live trees, not CWD)', & use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bdead_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bdead_pa ) call this%set_history_var(vname='ED_balive', units='gC m-2', & long='Live biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_balive_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_balive_pa ) call this%set_history_var(vname='ED_bleaf', units='gC m-2', & long='Leaf biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_bleaf_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_bleaf_pa ) call this%set_history_var(vname='ED_biomass', units='gC m-2', & long='Total biomass', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=1, & - ivar=ivar,callstep=callstep, index = ih_btotal_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_btotal_pa ) ! Ecosystem Carbon Fluxes (updated rapidly, upfreq=2) call this%set_history_var(vname='NPP_column', units='gC/m^2/s', & long='net primary production on the site', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_npp_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_npp_si ) call this%set_history_var(vname='GPP', units='gC/m^2/s', & long='gross primary production', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_gpp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_gpp_pa ) call this%set_history_var(vname='NPP', units='gC/m^2/s', & long='net primary production', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_npp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_npp_pa ) call this%set_history_var(vname='AR', units='gC/m^2/s', & long='autotrophic respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_aresp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_aresp_pa ) call this%set_history_var(vname='GROWTH_RESP', units='gC/m^2/s', & long='growth respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_growth_resp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_growth_resp_pa ) call this%set_history_var(vname='MAINT_RESP', units='gC/m^2/s', & long='maintenance respiration', use_default='active', & - avgflag='A', vtype='PA_R8',hlms='CLM:ALM',flushval=0.0_r8, upfreq=2, & - ivar=ivar,callstep=callstep, index = ih_maint_resp_pa ) + avgflag='A', vtype=patch_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=2, & + ivar=ivar, initialize=initialize_variables, index = ih_maint_resp_pa ) ! Carbon Flux (grid dimension x scpf) (THESE ARE DEFAULT INACTIVE!!! ! (BECAUSE THEY TAKE UP SPACE!!! ! =================================================================================== - call this%set_history_var(vname='GPP_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='GPP_SCPF', units='kgC/m2/yr', & long='gross primary production', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_gpp_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_gpp_si_scpf ) - call this%set_history_var(vname='NPP_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_SCPF', units='kgC/m2/yr', & long='total net primary production', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_totl_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_totl_si_scpf ) - call this%set_history_var(vname='NPP_LEAF_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_LEAF_SCPF', units='kgC/m2/yr', & long='NPP flux into leaves', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_leaf_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_leaf_si_scpf ) - call this%set_history_var(vname='NPP_SEED_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_SEED_SCPF', units='kgC/m2/yr', & long='NPP flux into seeds', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_seed_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_seed_si_scpf ) - call this%set_history_var(vname='NPP_FNRT_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_FNRT_SCPF', units='kgC/m2/yr', & long='NPP flux into fine roots', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_fnrt_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_fnrt_si_scpf ) - call this%set_history_var(vname='NPP_BGSW_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_BGSW_SCPF', units='kgC/m2/yr', & long='NPP flux into below-ground sapwood', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_bgsw_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgsw_si_scpf ) - call this%set_history_var(vname='NPP_BGDW_SCPF',units='kgC/m2/yr', & - long='NPP flux into below-ground deadwood', use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_bgdw_si_scpf ) + call this%set_history_var(vname='NPP_BGDW_SCPF', units='kgC/m2/yr', & + long='NPP flux into below-ground deadwood', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_bgdw_si_scpf ) - call this%set_history_var(vname='NPP_AGSW_SCPF',units='kgC/m2/yr', & + call this%set_history_var(vname='NPP_AGSW_SCPF', units='kgC/m2/yr', & long='NPP flux into above-ground sapwood', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_agsw_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agsw_si_scpf ) call this%set_history_var(vname = 'NPP_AGDW_SCPF', units='kgC/m2/yr', & - long='NPP flux into above-ground deadwood', use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_agdw_si_scpf ) + long='NPP flux into above-ground deadwood', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_agdw_si_scpf ) call this%set_history_var(vname = 'NPP_STOR_SCPF', units='kgC/m2/yr', & long='NPP flux into storage', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_npp_stor_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_npp_stor_si_scpf ) call this%set_history_var(vname='DDBH_SCPF', units = 'cm/yr/ha', & - long='diameter growth increment and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_ddbh_si_scpf ) + long='diameter growth increment and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ddbh_si_scpf ) - call this%set_history_var(vname='BA_SCPF',units = 'm2/ha', & + call this%set_history_var(vname='BA_SCPF', units = 'm2/ha', & long='basal area by patch and pft/size', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_ba_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_ba_si_scpf ) - call this%set_history_var(vname='NPLANT_SCPF',units = 'N/ha', & + call this%set_history_var(vname='NPLANT_SCPF', units = 'N/ha', & long='stem number density by patch and pft/size', use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_nplant_si_scpf ) + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nplant_si_scpf ) - call this%set_history_var(vname='M1_SCPF',units = 'N/ha/yr', & - long='background mortality count by patch and pft/size', use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m1_si_scpf ) + call this%set_history_var(vname='M1_SCPF', units = 'N/ha/yr', & + long='background mortality count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m1_si_scpf ) - call this%set_history_var(vname='M2_SCPF',units = 'N/ha/yr', & - long='hydraulic mortality count by patch and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m2_si_scpf ) - - call this%set_history_var(vname='M3_SCPF',units = 'N/ha/yr', & - long='carbon starvation mortality count by patch and pft/size',use_default='inactive', & - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m3_si_scpf ) - - call this%set_history_var(vname='M4_SCPF',units = 'N/ha/yr', & - long='impact mortality count by patch and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m4_si_scpf ) + call this%set_history_var(vname='M2_SCPF', units = 'N/ha/yr', & + long='hydraulic mortality count by patch and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m2_si_scpf ) + + call this%set_history_var(vname='M3_SCPF', units = 'N/ha/yr', & + long='carbon starvation mortality count by patch and pft/size', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m3_si_scpf ) + + call this%set_history_var(vname='M4_SCPF', units = 'N/ha/yr', & + long='impact mortality count by patch and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m4_si_scpf ) + + call this%set_history_var(vname='M5_SCPF', units = 'N/ha/yr', & + long='fire mortality count by patch and pft/size',use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_m5_si_scpf ) + + ! Size structured diagnostics that require rapid updates (upfreq=2) + + call this%set_history_var(vname='AR_SCPF',units = 'kgC/m2/yr', & + long='total autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_si_scpf ) + + call this%set_history_var(vname='AR_GROW_SCPF',units = 'kgC/m2/yr', & + long='growth autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_grow_si_scpf ) + + call this%set_history_var(vname='AR_MAINT_SCPF',units = 'kgC/m2/yr', & + long='maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_maint_si_scpf ) + + call this%set_history_var(vname='AR_DARKM_SCPF',units = 'kgC/m2/yr', & + long='dark portion of maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_darkm_si_scpf ) + + call this%set_history_var(vname='AR_AGSAPM_SCPF',units = 'kgC/m2/yr', & + long='above-ground sapwood maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_agsapm_si_scpf ) + + call this%set_history_var(vname='AR_CROOTM_SCPF',units = 'kgC/m2/yr', & + long='below-ground sapwood maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8,hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_crootm_si_scpf ) - call this%set_history_var(vname='M5_SCPF',units = 'N/ha/yr', & - long='fire mortality count by patch and pft/size',use_default='inactive',& - avgflag='A', vtype='SI_SCPF_R8',hlms='CLM:ALM',flushval=0.0_r8, & - upfreq=1, ivar=ivar,callstep=callstep, index = ih_m5_si_scpf ) + call this%set_history_var(vname='AR_FROOTM_SCPF',units = 'kgC/m2/yr', & + long='fine root maintenance autotrophic respiration per m2 per year',use_default='inactive',& + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_ar_frootm_si_scpf ) ! CARBON BALANCE VARIABLES THAT DEPEND ON HLM BGC INPUTS call this%set_history_var(vname='NEP', units='gC/m^2/s', & long='net ecosystem production', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_nep_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_nep_si ) call this%set_history_var(vname='Fire_Closs', units='gC/m^2/s', & long='ED/SPitfire Carbon loss to atmosphere', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_fire_c_to_atm_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_fire_c_to_atm_si ) call this%set_history_var(vname='NBP', units='gC/m^2/s', & long='net biosphere production', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_nbp_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_nbp_si ) call this%set_history_var(vname='TOTECOSYSC', units='gC/m^2', & long='total ecosystem carbon', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_totecosysc_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_totecosysc_si ) call this%set_history_var(vname='CBALANCE_ERROR_ED', units='gC/m^2/s', & long='total carbon balance error on ED side', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_fates_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_fates_si ) call this%set_history_var(vname='CBALANCE_ERROR_BGC', units='gC/m^2/s', & long='total carbon balance error on HLMs BGC side', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_bgc_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_bgc_si ) call this%set_history_var(vname='CBALANCE_ERROR_TOTAL', units='gC/m^2/s', & long='total carbon balance error total', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cbal_err_tot_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cbal_err_tot_si ) call this%set_history_var(vname='BIOMASS_STOCK_COL', units='gC/m^2', & long='total ED biomass carbon at the column level', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_biomass_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_biomass_stock_si ) call this%set_history_var(vname='ED_LITTER_STOCK_COL', units='gC/m^2', & long='total ED litter carbon at the column level', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_litter_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_litter_stock_si ) call this%set_history_var(vname='CWD_STOCK_COL', units='gC/m^2', & long='total CWD carbon at the column level', use_default='active', & - avgflag='A', vtype='SI_R8',hlms='CLM:ALM',flushval=cp_hio_ignore_val, & - upfreq=3, ivar=ivar,callstep=callstep, index = ih_cwd_stock_si ) + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=cp_hio_ignore_val, & + upfreq=3, ivar=ivar, initialize=initialize_variables, index = ih_cwd_stock_si ) ! Must be last thing before return - if(present(nvar)) nvar = ivar - - return + this%num_history_vars_ = ivar end subroutine define_history_vars - - ! ===================================================================================== - - subroutine set_history_var(this,vname,units,long,use_default,avgflag,vtype,hlms, & - flushval,upfreq,ivar,callstep,index) - - - use FatesUtilsMod, only : check_hlm_list - use EDTypesMod, only : cp_hlm_name - - ! arguments - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: vname - character(len=*),intent(in) :: units - character(len=*),intent(in) :: long - character(len=*),intent(in) :: use_default - character(len=*),intent(in) :: avgflag - character(len=*),intent(in) :: vtype - character(len=*),intent(in) :: hlms - real(r8),intent(in) :: flushval ! IF THE TYPE IS AN INT WE WILL round with NINT - integer,intent(in) :: upfreq - character(len=*),intent(in) :: callstep - integer, intent(inout) :: ivar - integer, intent(inout) :: index ! This is the index for the variable of - ! interest that is associated with an - ! explict name (for fast reference during update) - ! A zero is passed back when the variable is - ! not used - - ! locals - type(iovar_def_type),pointer :: hvar - integer :: ub1,lb1,ub2,lb2 ! Bounds for allocating the var - integer :: ityp - - if( check_hlm_list(trim(hlms),trim(cp_hlm_name)) ) then - - ivar = ivar+1 - index = ivar - - if(trim(callstep).eq.'initialize')then - - hvar => this%hvars(ivar) - hvar%vname = vname - hvar%units = units - hvar%long = long - hvar%use_default = use_default - hvar%vtype = vtype - hvar%avgflag = avgflag - hvar%flushval = flushval - hvar%upfreq = upfreq - ityp=this%iotype_index(trim(vtype)) - hvar%iovar_dk_ptr => this%iovar_dk(ityp) - this%iovar_dk(ityp)%active = .true. - - nullify(hvar%r81d) - nullify(hvar%r82d) - nullify(hvar%r83d) - nullify(hvar%int1d) - nullify(hvar%int2d) - nullify(hvar%int3d) - - call this%get_hvar_bounds(hvar,0,lb1,ub1,lb2,ub2) - - ! currently, all array spaces are flushed each time - ! the update is called. The flush here on the initialization - ! may be redundant, but will prevent issues in the future - ! if we have host models where not all threads are updating - ! the HIO array spaces. (RGK:09-2016) - - select case(trim(vtype)) - case('PA_R8') - allocate(hvar%r81d(lb1:ub1));hvar%r81d(:)=flushval - case('SI_R8') - allocate(hvar%r81d(lb1:ub1));hvar%r81d(:)=flushval - case('PA_GRND_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('PA_SCPF_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('SI_GRND_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case('SI_SCPF_R8') - allocate(hvar%r82d(lb1:ub1,lb2:ub2));hvar%r82d(:,:)=flushval - case default - write(fates_log(),*) 'Incompatible vtype passed to set_history_var' - write(fates_log(),*) 'vtype = ',trim(vtype),' ?' - stop - ! end_run - end select - - end if - else - - index = 0 - end if - - return - end subroutine set_history_var - - ! ===================================================================================== - - subroutine get_hvar_bounds(this,hvar,thread,lb1,ub1,lb2,ub2) - - class(fates_hio_interface_type) :: this - type(iovar_def_type),target,intent(in) :: hvar - integer,intent(in) :: thread - integer,intent(out) :: lb1 - integer,intent(out) :: ub1 - integer,intent(out) :: lb2 - integer,intent(out) :: ub2 - - ! local - integer :: ndims - - lb1 = 0 - ub1 = 0 - lb2 = 0 - ub2 = 0 - - ndims = hvar%iovar_dk_ptr%ndims - - ! The thread = 0 case is the boundaries for the whole proc/node - if (thread==0) then - lb1 = hvar%iovar_dk_ptr%dim1_ptr%lb - ub1 = hvar%iovar_dk_ptr%dim1_ptr%ub - if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%lb - ub2 = hvar%iovar_dk_ptr%dim2_ptr%ub - end if - else - lb1 = hvar%iovar_dk_ptr%dim1_ptr%clump_lb(thread) - ub1 = hvar%iovar_dk_ptr%dim1_ptr%clump_ub(thread) - if(ndims>1)then - lb2 = hvar%iovar_dk_ptr%dim2_ptr%clump_lb(thread) - ub2 = hvar%iovar_dk_ptr%dim2_ptr%clump_ub(thread) - end if - end if - - return - end subroutine get_hvar_bounds - - - ! ==================================================================================== - - subroutine init_iovar_dk_maps(this) - - ! ---------------------------------------------------------------------------------- - ! This subroutine simply initializes the structures that define the different - ! array and type formats for different IO variables - ! - ! PA_R8 : 1D patch scale 8-byte reals - ! SI_R8 : 1D site scale 8-byte reals - ! - ! The allocation on the structures is not dynamic and should only add up to the - ! number of entries listed here. - ! - ! note (RGK) %active is not used yet. Was intended as a check on the HLM->FATES - ! control parameter passing to ensure all active dimension types received all - ! dimensioning specifications from the host, but we currently arent using those - ! passing functions.. - ! ---------------------------------------------------------------------------------- - - ! Arguments - class(fates_hio_interface_type) :: this - - ! Locals - integer :: ityp - integer, parameter :: unset_int = -999 - - allocate(this%iovar_dk(n_iovar_dk)) - - ! 1d Patch - ityp = 1 - this%iovar_dk(ityp)%name = 'PA_R8' - this%iovar_dk(ityp)%ndims = 1 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! 1d Site - ityp = 2 - this%iovar_dk(ityp)%name = 'SI_R8' - this%iovar_dk(ityp)%ndims = 1 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! patch x ground - ityp = 3 - this%iovar_dk(ityp)%name = 'PA_GRND_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! patch x size-class/pft - ityp = 4 - this%iovar_dk(ityp)%name = 'PA_SCPF_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! site x ground - ityp = 5 - this%iovar_dk(ityp)%name = 'SI_GRND_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - ! site x size-class/pft - ityp = 6 - this%iovar_dk(ityp)%name = 'SI_SCPF_R8' - this%iovar_dk(ityp)%ndims = 2 - allocate(this%iovar_dk(ityp)%dimsize(this%iovar_dk(ityp)%ndims)) - this%iovar_dk(ityp)%dimsize(:) = unset_int - this%iovar_dk(ityp)%active = .false. - nullify(this%iovar_dk(ityp)%dim1_ptr) - nullify(this%iovar_dk(ityp)%dim2_ptr) - - - - - - - return - end subroutine init_iovar_dk_maps - - ! =================================================================================== - - subroutine set_dim_ptrs(this,dk_name,idim,dim_target) - - ! arguments - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: dk_name - integer,intent(in) :: idim ! dimension index - type(iovar_dim_type),target :: dim_target - - - ! local - integer :: ityp - - ityp = this%iotype_index(trim(dk_name)) - - ! First check to see if the dimension is allocated - if(this%iovar_dk(ityp)%ndims dim_target - elseif(idim==2) then - this%iovar_dk(ityp)%dim2_ptr => dim_target - end if - - ! With the map, we can set the dimension size - this%iovar_dk(ityp)%dimsize(idim) = dim_target%ub - dim_target%lb + 1 - - - return - end subroutine set_dim_ptrs - - ! ==================================================================================== - - function iotype_index(this,iotype_name) result(ityp) - - ! argument - class(fates_hio_interface_type) :: this - character(len=*),intent(in) :: iotype_name - - ! local - integer :: ityp - - do ityp=1,n_iovar_dk - if(trim(iotype_name).eq.trim(this%iovar_dk(ityp)%name))then - return - end if - end do - write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' - !end_run - - end function iotype_index - - ! ===================================================================================== - - subroutine dim_init(this,iovar_dim,dim_name,nthreads,lb_in,ub_in) - - ! arguments - class(fates_hio_interface_type) :: this - type(iovar_dim_type),target :: iovar_dim - character(len=*),intent(in) :: dim_name - integer,intent(in) :: nthreads - integer,intent(in) :: lb_in - integer,intent(in) :: ub_in - - allocate(iovar_dim%clump_lb(nthreads)) - allocate(iovar_dim%clump_ub(nthreads)) - - iovar_dim%name = trim(dim_name) - iovar_dim%lb = lb_in - iovar_dim%ub = ub_in - - return - end subroutine dim_init - - ! ===================================================================================== - - subroutine set_dim_thread_bounds(this,iovar_dim,nc,lb_in,ub_in) - - class(fates_hio_interface_type) :: this - type(iovar_dim_type),target :: iovar_dim - integer,intent(in) :: nc ! Thread index - integer,intent(in) :: lb_in - integer,intent(in) :: ub_in - - iovar_dim%clump_lb(nc) = lb_in - iovar_dim%clump_ub(nc) = ub_in - - return - end subroutine set_dim_thread_bounds ! ==================================================================================== ! DEPRECATED, TRANSITIONAL OR FUTURE CODE SECTION ! ==================================================================================== - !subroutine set_fates_hio_str(tag,iotype_name,iostr_val) + !subroutine set_fates_hio_str(tag,iotype_name, iostr_val) ! ! Arguments -! character(len=*),intent(in) :: tag -! character(len=*), optional,intent(in) :: iotype_name +! character(len=*), intent(in) :: tag +! character(len=*), optional, intent(in) :: iotype_name ! integer, optional, intent(in) :: iostr_val ! ! local variables @@ -1524,32 +1558,32 @@ end subroutine set_dim_thread_bounds ! select case (trim(tag)) ! case('flush_to_unset') -! write(*,*) '' -! write(*,*) 'Flushing FATES IO types prior to transfer from host' -! do ityp=1,ubound(iovar_str,1) +! write(*, *) '' +! write(*, *) 'Flushing FATES IO types prior to transfer from host' +! do ityp=1,ubound(iovar_str, 1) ! iovar_str(ityp)%dimsize = unset_int ! iovar_str(ityp)%active = .false. ! end do ! case('check_allset') -! do ityp=1,ubound(iovar_str,1) -! write(*,*) 'Checking to see if ',iovar_str(ityp)%name,' IO communicators were sent to FATES' +! do ityp=1,ubound(iovar_str, 1) +! write(*, *) 'Checking to see if ',iovar_str(ityp)%name, ' IO communicators were sent to FATES' ! if(iovar_str(ityp)%active)then ! if(iovar_str(ityp)%offset .eq. unset_int) then -! write(*,*) 'FATES offset information of IO type:',iovar_str(ityp)%name -! write(*,*) 'was never set' +! write(*, *) 'FATES offset information of IO type:', iovar_str(ityp)%name +! write(*, *) 'was never set' ! ! end_run('MESSAGE') ! end if -! do idim=1,iovar_str(ityp)%ndims +! do idim=1, iovar_str(ityp)%ndims ! if(iovar_str(ityp)%dimsize(idim) .eq. unset_int) then -! write(*,*) 'FATES dimension information of IO type:',iovar_str(ityp)%name -! write(*,*) 'was never set' +! write(*, *) 'FATES dimension information of IO type:', iovar_str(ityp)%name +! write(*, *) 'was never set' ! ! end_run('MESSAGE') ! end if ! end do ! end if ! end do -! write(*,*) 'Checked. All history IO specifications properly sent to FATES.' +! write(*, *) 'Checked. All history IO specifications properly sent to FATES.' ! case default ! ! Must have two arguments if this is not a check or flush @@ -1561,39 +1595,39 @@ end subroutine set_dim_thread_bounds ! case('offset') ! ityp=iotype_index(trim(iotype_name)) ! iovar_str(ityp)%offset = iostr_val -! write(*,*) 'Transfering offset for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering offset for IOTYPE',iotype_name, ' to FATES' ! case('dimsize1') ! ityp=iotype_index(trim(iotype_name)) ! iovar_str(ityp)%dimsize(1) = iostr_val -! write(*,*) 'Transfering 1st dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 1st dimension size for IOTYPE',iotype_name, ' to FATES' ! case('dimsize2') ! ityp=iotype_index(trim(iotype_name)) -! if(ubound(iovar_str(ityp)%dimsize,1)==1)then -! write(fates_log(),*) 'Transfering second dimensional bound to unallocated space' -! write(fates_log(),*) 'type:',iotype_name +! if(ubound(iovar_str(ityp)%dimsize, 1)==1)then +! write(fates_log(), *) 'Transfering second dimensional bound to unallocated space' +! write(fates_log(), *) 'type:', iotype_name ! ! end_run ! end if ! iovar_str(ityp)%dimsize(2) = iostr_val -! write(*,*) 'Transfering 2nd dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 2nd dimension size for IOTYPE',iotype_name, ' to FATES' ! case('dimsize3') ! ityp=iotype_index(trim(iotype_name)) -! if(ubound(iovar_str(ityp)%dimsize,1)<3)then -! write(fates_log(),*) 'Transfering third dimensional bound to unallocated space' -! write(fates_log(),*) 'type:',iotype_name +! if(ubound(iovar_str(ityp)%dimsize, 1)<3)then +! write(fates_log(), *) 'Transfering third dimensional bound to unallocated space' +! write(fates_log(), *) 'type:', iotype_name ! ! end_run ! end if ! iovar_str(ityp)%dimsize(3) = iostr_val -! write(*,*) 'Transfering 3rd dimension size for IOTYPE',iotype_name,' to FATES' +! write(*, *) 'Transfering 3rd dimension size for IOTYPE',iotype_name, ' to FATES' ! case default -! write(*,*) 'IO parameter not recognized:',trim(tag) +! write(*, *) 'IO parameter not recognized:', trim(tag) ! ! end_run ! end select ! else -! write(*,*) 'no value was provided for the tag' +! write(*, *) 'no value was provided for the tag' ! end if ! ! end select @@ -1602,4 +1636,4 @@ end subroutine set_dim_thread_bounds -end module HistoryIOMod +end module FatesHistoryInterfaceMod diff --git a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 new file mode 100644 index 0000000000..fd8bd7a871 --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 @@ -0,0 +1,91 @@ +module FatesHistoryVariableKindMod + + use FatesConstantsMod, only : fates_long_string_length + use FatesGlobals, only : fates_log + use FatesHistoryDimensionMod, only : fates_history_dimension_type + + implicit none + + ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES + ! control parameter passing to ensure all active dimension types received all + ! dimensioning specifications from the host, but we currently arent using those + ! passing functions.. + + ! This structure is not multi-threaded + type fates_history_variable_kind_type + character(len=fates_long_string_length) :: name ! String labelling this IO type + integer :: ndims ! number of dimensions in this IO type + integer, allocatable :: dimsize(:) ! The size of each dimension + logical, private :: active_ + integer :: dim1_index + integer :: dim2_index + + contains + + procedure, public :: Init + procedure, public :: set_active + procedure, public :: is_active + + end type fates_history_variable_kind_type + + + +contains + + ! =================================================================================== + subroutine Init(this, name, num_dims) + + use FatesConstantsMod, only : fates_unset_int + + implicit none + + class(fates_history_variable_kind_type), intent(inout) :: this + character(*), intent(in) :: name + integer, intent(in) :: num_dims + + this%name = trim(name) + this%ndims = num_dims + allocate(this%dimsize(this%ndims)) + this%dimsize(:) = fates_unset_int + this%active_ = .false. + this%dim1_index = fates_unset_int + this%dim2_index = fates_unset_int + + end subroutine Init + + ! ======================================================================= + subroutine set_active(this) + implicit none + class(fates_history_variable_kind_type), intent(inout) :: this + this%active_ = .true. + end subroutine set_active + + logical function is_active(this) + implicit none + class(fates_history_variable_kind_type), intent(in) :: this + is_active = this%active_ + end function is_active + + ! ==================================================================================== + + function iotype_index(iotype_name, num_dim_kinds, dim_kinds) result(dk_index) + + ! argument + character(len=*), intent(in) :: iotype_name + integer, intent(in) :: num_dim_kinds + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) + + ! local + integer :: dk_index + + do dk_index=1, num_dim_kinds + if (trim(iotype_name) .eq. trim(dim_kinds(dk_index)%name)) then + return + end if + end do + write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' + !end_run + + end function iotype_index + +end module FatesHistoryVariableKindMod diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 new file mode 100644 index 0000000000..218950432f --- /dev/null +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -0,0 +1,221 @@ +module FatesHistoryVariableType + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_log + use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type + + implicit none + + ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) + + type fates_history_variable_type + character(len=32) :: vname + character(len=24) :: units + character(len=128) :: long + character(len=24) :: use_default ! States whether a variable should be turned + ! on the output files by default (active/inactive) + ! It is a good idea to set inactive for very large + ! or infrequently used output datasets + character(len=24) :: vtype + character(len=1) :: avgflag + integer :: upfreq ! Update frequency (this is for checks and flushing) + ! 1 = dynamics "dyn" (daily) + ! 2 = production "prod" (prob model tstep) + real(r8) :: flushval + integer :: dim_kinds_index + ! Pointers (only one of these is allocated per variable) + real(r8), pointer :: r81d(:) + real(r8), pointer :: r82d(:,:) + real(r8), pointer :: r83d(:,:,:) + integer, pointer :: int1d(:) + integer, pointer :: int2d(:,:) + integer, pointer :: int3d(:,:,:) + contains + procedure, public :: Init + procedure, public :: Flush + procedure, private :: GetBounds + end type fates_history_variable_type + +contains + + subroutine Init(this, vname, units, long, use_default, & + vtype, avgflag, flushval, upfreq, num_dim_kinds, dim_kinds, dim_bounds) + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8 + + use FatesHistoryVariableKindMod, only : iotype_index + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: use_default + character(len=*), intent(in) :: vtype + character(len=*), intent(in) :: avgflag + real(r8), intent(in) :: flushval ! If the type is an int we will round with nint + integer, intent(in) :: upfreq + integer, intent(in) :: num_dim_kinds + type(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(inout) :: dim_kinds(:) + + integer :: dk_index + integer :: lb1, ub1, lb2, ub2 + + this%vname = vname + this%units = units + this%long = long + this%use_default = use_default + this%vtype = vtype + this%avgflag = avgflag + this%flushval = flushval + this%upfreq = upfreq + + nullify(this%r81d) + nullify(this%r82d) + nullify(this%r83d) + nullify(this%int1d) + nullify(this%int2d) + nullify(this%int3d) + + dk_index = iotype_index(trim(vtype), num_dim_kinds, dim_kinds) + this%dim_kinds_index = dk_index + call dim_kinds(dk_index)%set_active() + + call this%GetBounds(0, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) + + ! NOTE(rgk, 2016-09) currently, all array spaces are flushed each + ! time the update is called. The flush here on the initialization + ! may be redundant, but will prevent issues in the future if we + ! have host models where not all threads are updating the HHistory + ! array spaces. + + select case(trim(vtype)) + case(patch_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(site_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(patch_ground_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(patch_size_pft_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_ground_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case(site_size_pft_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + + case default + write(fates_log(),*) 'Incompatible vtype passed to set_history_var' + write(fates_log(),*) 'vtype = ',trim(vtype),' ?' + stop + ! end_run + end select + + end subroutine Init + + ! ===================================================================================== + + subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + integer, intent(in) :: thread + class(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) + integer, intent(out) :: lb1 + integer, intent(out) :: ub1 + integer, intent(out) :: lb2 + integer, intent(out) :: ub2 + + ! local + integer :: ndims + integer :: d_index + + lb1 = 0 + ub1 = 0 + lb2 = 0 + ub2 = 0 + + ndims = dim_kinds(this%dim_kinds_index)%ndims + + ! The thread = 0 case is the boundaries for the whole proc/node + if (thread==0) then + d_index = dim_kinds(this%dim_kinds_index)%dim1_index + lb1 = dim_bounds(d_index)%lower_bound + ub1 = dim_bounds(d_index)%upper_bound + if(ndims>1)then + d_index = dim_kinds(this%dim_kinds_index)%dim2_index + lb2 = dim_bounds(d_index)%lower_bound + ub2 = dim_bounds(d_index)%upper_bound + end if + else + d_index = dim_kinds(this%dim_kinds_index)%dim1_index + lb1 = dim_bounds(d_index)%clump_lower_bound(thread) + ub1 = dim_bounds(d_index)%clump_upper_bound(thread) + if(ndims>1)then + d_index = dim_kinds(this%dim_kinds_index)%dim2_index + lb2 = dim_bounds(d_index)%clump_lower_bound(thread) + ub2 = dim_bounds(d_index)%clump_upper_bound(thread) + end if + end if + + end subroutine GetBounds + + subroutine Flush(this, thread, dim_bounds, dim_kinds) + + use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesHistoryDimensionMod, only : site_r8, site_ground_r8, site_size_pft_r8, patch_int + + implicit none + + class(fates_history_variable_type), intent(inout) :: this + integer, intent(in) :: thread + type(fates_history_dimension_type), intent(in) :: dim_bounds(:) + type(fates_history_variable_kind_type), intent(in) :: dim_kinds(:) + + integer :: lb1, ub1, lb2, ub2 + + call this%GetBounds(thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) + + select case(trim(dim_kinds(this%dim_kinds_index)%name)) + case(patch_r8) + this%r81d(lb1:ub1) = this%flushval + case(site_r8) + this%r81d(lb1:ub1) = this%flushval + case(patch_ground_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(patch_size_pft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_ground_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_size_pft_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(patch_int) + this%int1d(lb1:ub1) = nint(this%flushval) + case default + write(fates_log(),*) 'fates history variable type undefined while flushing history variables' + stop + !end_run + end select + + end subroutine Flush + +end module FatesHistoryVariableType diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 86fd070b4b..963d013e37 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -81,8 +81,8 @@ module CLMFatesInterfaceMod set_fates_ctrlparms, & allocate_bcin, & allocate_bcout - - use HistoryIOMod , only : fates_hio_interface_type + + use FatesHistoryInterfaceMod, only : fates_history_interface_type use ChecksBalancesMod , only : SummarizeNetFluxes, FATES_BGC_Carbon_BalanceCheck use EDTypesMod , only : udata @@ -139,7 +139,7 @@ module CLMFatesInterfaceMod type(f2hmap_type), allocatable :: f2hmap(:) ! fates_hio is the interface class for the history output - type(fates_hio_interface_type) :: fates_hio + type(fates_history_interface_type) :: fates_hist contains @@ -172,7 +172,7 @@ module CLMFatesInterfaceMod ! ==================================================================================== - subroutine init(this,bounds_proc, use_ed) + subroutine init(this, bounds_proc, use_ed) ! --------------------------------------------------------------------------------- ! This initializes the dlm_fates_interface_type @@ -255,8 +255,7 @@ subroutine init(this,bounds_proc, use_ed) write(iulog,*) 'clm_fates%init(): allocating for ',nclumps,' threads' end if - return - end subroutine init + end subroutine init ! ==================================================================================== @@ -414,8 +413,6 @@ subroutine check_hlm_active(this, nc, bounds_clump) end if end do - - end subroutine check_hlm_active ! ------------------------------------------------------------------------------------ @@ -510,7 +507,7 @@ subroutine dynamics_driv(this, nc, bounds_clump, & ! --------------------------------------------------------------------------------- ! Update history IO fields that depend on ecosystem dynamics ! --------------------------------------------------------------------------------- - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -635,7 +632,6 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & end do end associate - return end subroutine wrap_update_hlmfates_dyn ! ------------------------------------------------------------------------------------ @@ -681,7 +677,7 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) ! ------------------------------------------------------------------------ ! Update history IO fields that depend on ecosystem dynamics ! ------------------------------------------------------------------------ - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) @@ -691,8 +687,7 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) end do !$OMP END PARALLEL DO - - return + end subroutine init_restart ! ==================================================================================== @@ -749,14 +744,14 @@ subroutine init_coldstart(this, waterstate_inst, canopystate_inst) ! ------------------------------------------------------------------------ ! Update history IO fields that depend on ecosystem dynamics ! ------------------------------------------------------------------------ - call this%fates_hio%update_history_dyn( nc, & + call this%fates_hist%update_history_dyn( nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) end if end do !$OMP END PARALLEL DO - return + end subroutine init_coldstart ! ====================================================================================== @@ -847,7 +842,7 @@ subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) end do end associate - return + end subroutine wrap_sunfrac ! =================================================================================== @@ -1044,7 +1039,7 @@ subroutine wrap_btran(this,nc,fn,filterc,soilstate_inst, waterstate_inst, & end do end do end associate - return + end subroutine wrap_btran ! ==================================================================================== @@ -1063,7 +1058,6 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & use perf_mod , only : t_startf, t_stopf use PatchType , only : patch use quadraticMod , only : quadratic - use EDParamsMod , only : ED_val_grperc use EDSharedParamsMod , only : EDParamsShareInst use EDTypesMod , only : numpft_ed, dinc_ed use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed, numPatchesPerCol @@ -1174,7 +1168,7 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & end associate call t_stopf('edpsn') - return + end subroutine wrap_photosynthesis ! ====================================================================================== @@ -1210,13 +1204,11 @@ subroutine wrap_accumulatefluxes(this, nc, fn, filterp) dtime) - call this%fates_hio%update_history_prod(nc, & + call this%fates_hist%update_history_prod(nc, & this%fates(nc)%nsites, & this%fates(nc)%sites, & dtime) - return - end subroutine wrap_accumulatefluxes ! ====================================================================================== @@ -1303,7 +1295,6 @@ subroutine wrap_canopy_radiation(this, bounds_clump, nc, & end associate - return end subroutine wrap_canopy_radiation ! ====================================================================================== @@ -1344,7 +1335,6 @@ subroutine wrap_litter_fluxout(this, nc, bounds_clump, canopystate_inst, soilbio soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lig_c_col(c,:) = this%fates(nc)%bc_out(s)%FATES_c_to_litr_lig_c_col(:) end do - end subroutine wrap_litter_fluxout ! ====================================================================================== @@ -1397,13 +1387,12 @@ subroutine wrap_bgc_summary(this, nc, soilbiogeochem_carbonflux_inst, & ! Update history variables that track these variables - call this%fates_hio%update_history_cbal(nc, & + call this%fates_hist%update_history_cbal(nc, & this%fates(nc)%nsites, & this%fates(nc)%sites) end associate - return end subroutine wrap_bgc_summary ! ====================================================================================== @@ -1411,8 +1400,12 @@ end subroutine wrap_bgc_summary subroutine init_history_io(this,bounds_proc) use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp - use EDtypesMod , only : nlevsclass_ed - use clm_varpar , only : mxpft, nlevgrnd + + use FatesConstantsMod, only : fates_short_string_length, fates_long_string_length + use FatesHistoryInterfaceMod, only : fates_bounds_type + use FatesHistoryDimensionMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8, & + site_r8, site_ground_r8, site_size_pft_r8 + ! Arguments class(hlm_fates_interface_type), intent(inout) :: this @@ -1427,15 +1420,20 @@ subroutine init_history_io(this,bounds_proc) integer :: nclumps ! number of threads on this proc integer :: s ! FATES site index integer :: c ! ALM/CLM column index - character(len=32) :: dim2name + character(len=fates_short_string_length) :: dim2name + character(len=fates_long_string_length) :: ioname + integer :: d_index, dk_index + type(fates_bounds_type) :: fates_bounds + type(fates_bounds_type) :: fates_clump + ! This routine initializes the types of output variables ! not the variables themselves, just the types ! --------------------------------------------------------------------------------- if(.not.use_ed) return - !associate(hio => this%fates_hio) + !associate(hio => this%fates_hist) nclumps = get_proc_clumps() @@ -1444,11 +1442,11 @@ subroutine init_history_io(this,bounds_proc) ! ! ------------------------------------------------------------------------------- ! Those who wish add variables that require new dimensions, please - ! see FATES: HistoryIOMod.F90. Dimension types are defined at the top of the + ! see FATES: FatesHistoryInterfaceMod.F90. Dimension types are defined at the top of the ! module, and a new explicitly named instance of that type should be created. ! With this new dimension, a new output type/kind can contain that dimension. - ! A new type/kind can be added to the iovar_dk structure, which defines its members - ! in created in init_iovar_dk_maps(). Make sure to increase the size of n_iovar_dk. + ! A new type/kind can be added to the dim_kinds structure, which defines its members + ! in created in init_dim_kinds_maps(). Make sure to increase the size of fates_num_dim_kinds. ! A type/kind of output is defined by the data type (ie r8,int,..) ! and the dimensions. Keep in mind that 3D variables (or 4D if you include time) ! are not really supported in CLM/ALM right now. There are ways around this @@ -1456,38 +1454,42 @@ subroutine init_history_io(this,bounds_proc) ! "scpf" ! ------------------------------------------------------------------------------------ - call this%fates_hio%dim_init(this%fates_hio%iopa_dim,'patch',nclumps,bounds_proc%begp,bounds_proc%endp) - call this%fates_hio%dim_init(this%fates_hio%iosi_dim,'column',nclumps,bounds_proc%begc,bounds_proc%endc) - call this%fates_hio%dim_init(this%fates_hio%iogrnd_dim,'levgrnd',nclumps,1,nlevgrnd) - call this%fates_hio%dim_init(this%fates_hio%ioscpf_dim,'levscpf',nclumps,1,nlevsclass_ed*mxpft) + call hlm_bounds_to_fates_bounds(bounds_proc, fates_bounds) - ! Allocate the mapping between FATES indices and the IO indices - allocate(this%fates_hio%iovar_map(nclumps)) + call this%fates_hist%Init(nclumps, fates_bounds) - ! Define the bounds on the first dimension for each thread - !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,s,c) + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) ! thread bounds for patch - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iopa_dim,nc,bounds_clump%begp,bounds_clump%endp) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iosi_dim,nc,bounds_clump%begc,bounds_clump%endc) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%iogrnd_dim,nc,1,nlevgrnd) - call this%fates_hio%set_dim_thread_bounds(this%fates_hio%ioscpf_dim,nc,1,nlevsclass_ed*mxpft) + call hlm_bounds_to_fates_bounds(bounds_clump, fates_clump) + call this%fates_hist%SetThreadBounds(nc, fates_clump) + end do + !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------------------ - ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH - ! ------------------------------------------------------------------------------------ + ! ------------------------------------------------------------------------------------ + ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH + ! ------------------------------------------------------------------------------------ - allocate(this%fates_hio%iovar_map(nc)%site_index(this%fates(nc)%nsites)) - allocate(this%fates_hio%iovar_map(nc)%patch1_index(this%fates(nc)%nsites)) + ! Allocate the mapping between FATES indices and the IO indices + allocate(this%fates_hist%iovar_map(nclumps)) + + + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump,s,c) + do nc = 1,nclumps + + call get_clump_bounds(nc, bounds_clump) + + allocate(this%fates_hist%iovar_map(nc)%site_index(this%fates(nc)%nsites)) + allocate(this%fates_hist%iovar_map(nc)%patch1_index(this%fates(nc)%nsites)) do s=1,this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) - this%fates_hio%iovar_map(nc)%site_index(s) = c - this%fates_hio%iovar_map(nc)%patch1_index(s) = col%patchi(c)+1 + this%fates_hist%iovar_map(nc)%site_index(s) = c + this%fates_hist%iovar_map(nc)%patch1_index(s) = col%patchi(c)+1 end do end do @@ -1497,100 +1499,76 @@ subroutine init_history_io(this,bounds_proc) ! PART II: USE THE JUST DEFINED DIMENSIONS TO ASSEMBLE THE VALID IO TYPES ! INTERF-TODO: THESE CAN ALL BE EMBEDDED INTO A SUBROUTINE IN HISTORYIOMOD ! ------------------------------------------------------------------------------------ - - call this%fates_hio%init_iovar_dk_maps() - - call this%fates_hio%set_dim_ptrs(dk_name='PA_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='SI_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='PA_GRND_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_GRND_R8',idim=2,dim_target=this%fates_hio%iogrnd_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='SI_GRND_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_GRND_R8',idim=2,dim_target=this%fates_hio%iogrnd_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='PA_SCPF_R8',idim=1,dim_target=this%fates_hio%iopa_dim) - call this%fates_hio%set_dim_ptrs(dk_name='PA_SCPF_R8',idim=2,dim_target=this%fates_hio%ioscpf_dim) - - call this%fates_hio%set_dim_ptrs(dk_name='SI_SCPF_R8',idim=1,dim_target=this%fates_hio%iosi_dim) - call this%fates_hio%set_dim_ptrs(dk_name='SI_SCPF_R8',idim=2,dim_target=this%fates_hio%ioscpf_dim) - + call this%fates_hist%assemble_valid_output_types() ! ------------------------------------------------------------------------------------ ! PART III: DEFINE THE LIST OF OUTPUT VARIABLE OBJECTS, AND REGISTER THEM WITH THE ! HLM ACCORDING TO THEIR TYPES ! ------------------------------------------------------------------------------------ + call this%fates_hist%initialize_history_vars() + nvar = this%fates_hist%num_history_vars() - ! Determine how many of the history IO variables registered in FATES - ! are going to be allocated - - call this%fates_hio%define_history_vars('count',nvar) - this%fates_hio%n_hvars = nvar - - ! Allocate the list of history output variable objects - allocate(this%fates_hio%hvars(nvar)) - - ! construct the object that defines all of the IO variables - call this%fates_hio%define_history_vars('initialize') - - do ivar = 1,nvar + do ivar = 1, nvar - associate( vname => this%fates_hio%hvars(ivar)%vname, & - vunits => this%fates_hio%hvars(ivar)%units, & - vlong => this%fates_hio%hvars(ivar)%long, & - vdefault => this%fates_hio%hvars(ivar)%use_default, & - vavgflag => this%fates_hio%hvars(ivar)%avgflag, & - ioname => this%fates_hio%hvars(ivar)%iovar_dk_ptr%name ) - - + associate( vname => this%fates_hist%hvars(ivar)%vname, & + vunits => this%fates_hist%hvars(ivar)%units, & + vlong => this%fates_hist%hvars(ivar)%long, & + vdefault => this%fates_hist%hvars(ivar)%use_default, & + vavgflag => this%fates_hist%hvars(ivar)%avgflag) + + dk_index = this%fates_hist%hvars(ivar)%dim_kinds_index + ioname = trim(this%fates_hist%dim_kinds(dk_index)%name) select case(trim(ioname)) - case('PA_R8') + case(patch_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r81d, & + ptr_patch=this%fates_hist%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_R8') + case(site_r8) call hist_addfld1d(fname=trim(vname),units=trim(vunits), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_col=this%fates_hio%hvars(ivar)%r81d, & + ptr_col=this%fates_hist%hvars(ivar)%r81d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('PA_GRND_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(patch_ground_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & ! <--- addfld2d type2d=trim(dim2name), & ! <--- type2d avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r82d, & + ptr_patch=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('PA_SCPF_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(patch_size_pft_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_patch=this%fates_hio%hvars(ivar)%r82d, & + ptr_patch=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_GRND_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(site_ground_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_col=this%fates_hio%hvars(ivar)%r82d, & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) - case('SI_SCPF_R8') - dim2name = this%fates_hio%hvars(ivar)%iovar_dk_ptr%dim2_ptr%name + case(site_size_pft_r8) + d_index = this%fates_hist%dim_kinds(dk_index)%dim2_index + dim2name = this%fates_hist%dim_bounds(d_index)%name call hist_addfld2d(fname=trim(vname),units=trim(vunits), & type2d=trim(dim2name), & avgflag=trim(vavgflag),long_name=trim(vlong), & - ptr_col=this%fates_hio%hvars(ivar)%r82d, & + ptr_col=this%fates_hist%hvars(ivar)%r82d, & default=trim(vdefault), & set_lake=0._r8,set_urb=0._r8) @@ -1602,8 +1580,31 @@ subroutine init_history_io(this,bounds_proc) end associate end do - return end subroutine init_history_io + subroutine hlm_bounds_to_fates_bounds(hlm, fates) + + use FatesHistoryInterfaceMod, only : fates_bounds_type + use EDtypesMod, only : nlevsclass_ed + use clm_varpar, only : mxpft, nlevgrnd + + implicit none + + type(bounds_type), intent(in) :: hlm + type(fates_bounds_type), intent(out) :: fates + + fates%patch_begin = hlm%begp + fates%patch_end = hlm%endp + + fates%column_begin = hlm%begc + fates%column_end = hlm%endc + + fates%ground_begin = 1 + fates%ground_end = nlevgrnd + + fates%pft_class_begin = 1 + fates%pft_class_end = nlevsclass_ed * mxpft + + end subroutine hlm_bounds_to_fates_bounds end module CLMFatesInterfaceMod From 525f30922bce9bc0581a78be0d91297a72d51b7e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 28 Nov 2016 23:26:38 -0800 Subject: [PATCH 11/15] Swapped out the EdNoFire for EdFire test. --- components/clm/cime_config/testdefs/testlist_clm.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/components/clm/cime_config/testdefs/testlist_clm.xml b/components/clm/cime_config/testdefs/testlist_clm.xml index e56c1f7667..238eb3e001 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 @@ -724,15 +724,15 @@ ed - hobart - ed + ed hobart + hobart yellowstone ed - hobart hobart + hobart yellowstone yellowstone yellowstone From b19e58ec64559269584047f1c9a6d77c29ef571e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 30 Nov 2016 13:44:48 -0800 Subject: [PATCH 12/15] 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 dcd00dcaac3d359f4b87206f316fb2213e1c08a4 Mon Sep 17 00:00:00 2001 From: Ben Andre Date: Thu, 1 Dec 2016 11:59:29 -0700 Subject: [PATCH 13/15] Remove temporary_SF_switch Remove temporary_SF_switch. Spitfire is runtime configurable via name list and is now off by default. This switch was only used to disable spitfire at compile time. Fixes: 140 User interface changes?: spitfire configured at runtime instead of compile time. Code review: self Test suite: SMS_D_Mmpi-serial_Ld5.5x5_amazon.ICLM45ED.yellowstone_intel.clm-edTest Test baseline: 2ac7960 Test namelist changes: none Test answer changes: bit for bit Test summary: pass --- components/clm/src/ED/fire/SFMainMod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index f86b006c6c..be53100a71 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -52,11 +52,8 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) type (ed_patch_type), pointer :: currentPatch - integer temporary_SF_switch - !zero fire things currentPatch => currentSite%youngest_patch - temporary_SF_switch = 1 do while(associated(currentPatch)) currentPatch%frac_burnt = 0.0_r8 currentPatch%AB = 0.0_r8 @@ -68,7 +65,7 @@ subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) write(iulog,*) 'use_ed_spit_fire',use_ed_spit_fire endif - if(use_ed_spit_fire.and.temporary_SF_switch==1)then + if(use_ed_spit_fire)then call fire_danger_index(currentSite, temperature_inst, atm2lnd_inst) call wind_effect(currentSite, atm2lnd_inst) call charecteristics_of_fuel(currentSite) From 099f821e52ed39653d3c4d1f74ba0ac0f9598006 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 1 Dec 2016 11:54:20 -0800 Subject: [PATCH 14/15] 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 15/15] 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