diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 7fe96b45a5..ef3817dc37 100755 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -211,6 +211,7 @@ subroutine allocate_live_biomass(cc_p) 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 endif currentCohort%b = currentCohort%bdead + currentCohort%balive diff --git a/biogeochem/EDGrowthFunctionsMod.F90 b/biogeochem/EDGrowthFunctionsMod.F90 index a497df202a..086d0f7775 100755 --- a/biogeochem/EDGrowthFunctionsMod.F90 +++ b/biogeochem/EDGrowthFunctionsMod.F90 @@ -103,6 +103,7 @@ real(r8) function Bleaf( cohort_in ) ! ============================================================================ type(ed_cohort_type), intent(in) :: cohort_in + real(r8) :: slascaler ! changes the target biomass according to the SLA if(cohort_in%dbh < 0._r8.or.cohort_in%pft == 0.or.cohort_in%dbh > 1000.0_r8)then write(iulog,*) 'problems in bleaf',cohort_in%dbh,cohort_in%pft @@ -111,12 +112,17 @@ real(r8) function Bleaf( cohort_in ) if(cohort_in%dbh <= EDecophyscon%max_dbh(cohort_in%pft))then bleaf = 0.0419_r8 * (cohort_in%dbh**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 else - bleaf = 0.0419_r8 * (EDecophyscon%max_dbh(cohort_in%pft)**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 - endif - + bleaf = 0.0419_r8 * (EDecophyscon%max_dbh(cohort_in%pft)**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 + endif + slascaler = 0.03_r8/pftcon%slatop(cohort_in%pft) + bleaf = bleaf * slascaler + + !write(*,*) 'bleaf',bleaf, slascaler,cohort_in%pft + !Adjust for canopies that have become so deep that their bottom layer is not producing any carbon... !nb this will change the allometry and the effects of this remain untested. RF. April 2014 - bleaf = bleaf*cohort_in%canopy_trim + + bleaf = bleaf * cohort_in%canopy_trim return end function Bleaf diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 826e7a60ac..397606ced1 100755 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1096,7 +1096,11 @@ subroutine fuse_2_patches(dp, rp) rp%frac_burnt = (dp%frac_burnt*dp%area + rp%frac_burnt*rp%area)/(dp%area + rp%area) rp%burnt_frac_litter(:) = (dp%burnt_frac_litter(:)*dp%area + rp%burnt_frac_litter(:)*rp%area)/(dp%area + rp%area) rp%btran_ft(:) = (dp%btran_ft(:)*dp%area + rp%btran_ft(:)*rp%area)/(dp%area + rp%area) - + rp%dleaf_litter_dt(:) = (dp%dleaf_litter_dt(:)*dp%area + rp%dleaf_litter_dt(:)*rp%area)/(dp%area+rp%area) + rp%leaf_litter_in(:) = (dp%leaf_litter_in(:)*dp%area + rp%leaf_litter_in(:)*rp%area)/(dp%area+rp%area) + rp%leaf_litter_out(:) = (dp%leaf_litter_out(:)*dp%area + rp%leaf_litter_out(:)*rp%area)/(dp%area+rp%area) + + rp%area = rp%area + dp%area !THIS MUST COME AT THE END! !insert donor cohorts into recipient patch diff --git a/biogeochem/EDPhenologyType.F90 b/biogeochem/EDPhenologyType.F90 index f948fc7024..00bcff7740 100644 --- a/biogeochem/EDPhenologyType.F90 +++ b/biogeochem/EDPhenologyType.F90 @@ -37,6 +37,7 @@ module EDPhenologyType ! Public procedures procedure, public :: accumulateAndExtract procedure, public :: init + procedure, public :: restart procedure, public :: initAccVars procedure, public :: initAccBuffer procedure, public :: clean @@ -51,6 +52,40 @@ module EDPhenologyType contains !------------------------------------------------------------------------------ + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(ed_phenology_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid + character(len=*) , intent(in) :: flag + + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='ED_GDD', xtype=ncd_double, & + dim1name='pft', & + long_name='growing degree days for ED', units='ddays', & + interpinic_flag='interp', readvar=readvar, data=this%ED_GDD_patch) + + + end subroutine restart + subroutine accumulateAndExtract( this, bounds, & t_ref2m_patch, & gridcell, latdeg, & @@ -78,6 +113,7 @@ subroutine accumulateAndExtract( this, bounds, & ! local variables ! ! update_accum_field expects a pointer, can't make this an allocatable + ! real(r8), pointer :: rbufslp(:) ! temporary single level - pft level integer :: g, p ! local index for gridcell and pft integer :: ier ! error code @@ -91,7 +127,7 @@ subroutine accumulateAndExtract( this, bounds, & ! Accumulate and extract GDD0 for ED do p = bounds%begp,bounds%endp - + g = gridcell(p) if (latdeg(g) >= 0._r8) then @@ -120,11 +156,10 @@ subroutine accumulateAndExtract( this, bounds, & if( latdeg(g) < 0._r8 .and. month < calParams%june ) then !do not accumulate in earlier half of year. rbufslp(p) = accumResetVal endif - end do call update_accum_field ( trim(this%accString), rbufslp, get_nstep() ) - call extract_accum_field ( trim(this%accstring), this%ED_GDD_patch, get_nstep() ) + call extract_accum_field ( trim(this%accString), this%ED_GDD_patch, get_nstep() ) deallocate(rbufslp) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index ab543045de..969f8481b1 100755 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -8,6 +8,7 @@ module EDPhysiologyMod use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : iulog + use spmdMod , only : masterproc use TemperatureType , only : temperature_type use SoilStateType , only : soilstate_type use WaterstateType , only : waterstate_type @@ -85,6 +86,7 @@ subroutine non_canopy_derivs( currentPatch, temperature_inst, soilstate_inst, wa currentPatch%leaf_litter_in(:) = 0.0_r8 currentPatch%root_litter_in(:) = 0.0_r8 + currentPatch%dleaf_litter_dt(:) = 0.0_r8 currentPatch%leaf_litter_out(:) = 0.0_r8 currentPatch%root_litter_out(:) = 0.0_r8 currentPatch%cwd_AG_in(:) = 0.0_r8 @@ -230,6 +232,8 @@ subroutine phenology( currentSite, ed_phenology_inst, temperature_inst, watersta ! ! !USES: use clm_varcon, only : tfrz + use clm_time_manager, only : get_days_per_year, get_curr_date + use clm_time_manager, only : get_ref_date, timemgr_datediff use EDTypesMod, only : udata ! ! !ARGUMENTS: @@ -247,6 +251,14 @@ subroutine phenology( currentSite, ed_phenology_inst, temperature_inst, watersta integer :: ncolddayslim ! critical no days underneath the threshold for leaf drop integer :: i integer :: timesincedleafon,timesincedleafoff,timesinceleafon,timesinceleafoff + integer :: refdate + integer :: curdate + + integer :: yr ! year (0, ...) + integer :: mon ! month (1, ..., 12) + integer :: day ! day of month (1, ..., 31) + integer :: sec ! seconds of the day + real(r8) :: gdd_threshold real(r8) :: a,b,c ! params of leaf-pn model from botta et al. 2000. real(r8) :: cold_t ! threshold below which cold days are counted @@ -256,13 +268,26 @@ subroutine phenology( currentSite, ed_phenology_inst, temperature_inst, watersta real(r8) :: off_time ! minimum number of days between leaf off and leaf on for drought phenology real(r8) :: temp_in_C ! daily averaged temperature in celcius real(r8) :: mindayson + real(r8) :: modelday + !------------------------------------------------------------------------ t_veg24 => temperature_inst%t_veg24_patch ! Input: [real(r8) (:)] avg pft vegetation temperature for last 24 hrs ED_GDD_patch => ed_phenology_inst%ED_GDD_patch ! Input: [real(r8) (:)] growing deg. days base 0 deg C (ddays) + g = currentSite%clmgcell + + call get_curr_date(yr, mon, day, sec) + curdate = yr*10000 + mon*100 + day + + call get_ref_date(yr, mon, day, sec) + refdate = yr*10000 + mon*100 + day + + call timemgr_datediff(refdate, 0, curdate, sec, modelday) + if ( masterproc ) write(iulog,*) 'modelday',modelday + ! Parameter of drought decid leaf loss in mm in top layer...FIX(RF,032414) ! - this is arbitrary and poorly understood. Needs work. ED_ drought_threshold = 0.15 @@ -315,11 +340,7 @@ subroutine phenology( currentSite, ed_phenology_inst, temperature_inst, watersta endif enddo - timesinceleafoff = t - currentSite%leafoffdate - if (t < currentSite%leafoffdate)then - timesinceleafoff = t +(365-currentSite%leafoffdate) - endif - + timesinceleafoff = modelday - currentSite%leafoffdate !LEAF ON: COLD DECIDUOUS. Needs to !1) have exceeded the growing degree day threshold !2) The leaves should not be on already @@ -327,17 +348,15 @@ subroutine phenology( currentSite, ed_phenology_inst, temperature_inst, watersta if (ED_GDD_patch(currentSite%oldest_patch%clm_pno) > gdd_threshold)then if (currentSite%status == 1)then if (currentSite%ncd >= 1)then - currentSite%status = 2 !alter status of site to 'leaves on' - currentSite%leafondate = t !record leaf on date - write(iulog,*) 'leaves on' + currentSite%status = 2 !alter status of site to 'leaves on' + currentSite%leafondate = t !record leaf on date + write(iulog,*) 'leaves on' endif !ncd endif !status endif !GDD - timesinceleafon = t - currentSite%leafondate - if (t < currentSite%leafondate)then - timesinceleafon = t +(365-currentSite%leafondate) - endif + timesinceleafon = modelday - currentSite%leafondate + !LEAF OFF: COLD THRESHOLD !Needs to: @@ -350,18 +369,18 @@ subroutine phenology( currentSite, ed_phenology_inst, temperature_inst, watersta if (timesinceleafon > mindayson)then if (currentSite%status == 2)then currentSite%status = 1 !alter status of site to 'leaves on' - currentSite%leafoffdate = t !record leaf off date - write(iulog,*) 'leaves off' + currentSite%leafoffdate = modelday !record leaf off date + write(iulog,*) 'leaves off cold' endif endif endif !LEAF OFF: COLD LIFESPAN THRESHOLD - if (timesinceleafoff > 360)then !remove leaves after a whole year when there is no 'off' period. - if (currentSite%status == 2)then + if(timesinceleafoff > 400)then !remove leaves after a whole year when there is no 'off' period. + if(currentSite%status == 2)then currentSite%status = 1 !alter status of site to 'leaves on' - currentSite%leafoffdate = t !record leaf off date - write(iulog,*) 'leaves off' + currentSite%leafoffdate = modelday !record leaf off date + write(iulog,*) 'leaves off time' endif endif @@ -476,10 +495,15 @@ subroutine phenology_leafonoff(currentSite) ! !LOCAL VARIABLES: type(ed_patch_type) , pointer :: currentPatch type(ed_cohort_type), pointer :: currentCohort + + real(r8) :: store_output ! the amount of the store to put into leaves - is a barrier against negative storage and C starvation. + !------------------------------------------------------------------------ currentPatch => CurrentSite%oldest_patch + store_output = 0.5_r8 + do while(associated(currentPatch)) currentCohort => currentPatch%tallest do while(associated(currentCohort)) @@ -492,7 +516,7 @@ subroutine phenology_leafonoff(currentSite) if (currentCohort%laimemory <= currentCohort%bstore)then currentCohort%bl = currentCohort%laimemory !extract stored carbon to make new leaves. else - currentCohort%bl = currentCohort%bstore !we can only put on as much carbon as there is in the store... + currentCohort%bl = currentCohort%bstore * store_output !we can only put on as much carbon as there is in the store... !nb. Putting all of bstore into leaves is C-starvation suicidal. The tendency for this could be parameterized endif currentCohort%balive = currentCohort%balive + currentCohort%bl ! Add deployed carbon to alive biomass pool @@ -525,8 +549,8 @@ subroutine phenology_leafonoff(currentSite) if (currentCohort%laimemory <= currentCohort%bstore)then currentCohort%bl = currentCohort%laimemory !extract stored carbon to make new leaves. else - currentCohort%bl = currentCohort%bstore !we can only put on as much carbon as there is in the store... - endif + currentCohort%bl = currentCohort%bstore * store_output !we can only put on as much carbon as there is in the store... + endif currentCohort%balive = currentCohort%balive + currentCohort%bl currentCohort%bstore = currentCohort%bstore - currentCohort%bl ! empty store currentCohort%laimemory = 0.0_r8 diff --git a/biogeophys/EDPhotosynthesisMod.F90 b/biogeophys/EDPhotosynthesisMod.F90 index 889c905412..93767f0a17 100644 --- a/biogeophys/EDPhotosynthesisMod.F90 +++ b/biogeophys/EDPhotosynthesisMod.F90 @@ -435,7 +435,7 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & !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) = 0.167_r8 * vcmax25top(FT) + jmax25top(FT) = 1.67_r8 * vcmax25top(FT) tpu25top(FT) = 0.167_r8 * vcmax25top(FT) kp25top(FT) = 20000._r8 * vcmax25top(FT) @@ -776,7 +776,13 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & enddo !sunsha loop !average leaf-level stomatal resistance rate over sun and shade leaves... rs_z(cl,ft,iv) = 1._r8/gs_z(cl,ft,iv) + else !No leaf area. This layer is present only because of stems. (leaves are off, or have reduced to 0 + currentPatch%psn_z(cl,ft,iv) = 0._r8 + rs_z(CL,FT,iv) = min(rsmax0, 1._r8/bbb(FT) * cf) + end if !is there leaf area? + + end if ! night or day end do ! iv canopy layer end if ! present(L,ft) ? rd_array @@ -811,8 +817,8 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & !------------------------------------------------------------------------------ ! Convert from umolC/m2leaf/s to umolC/indiv/s ( x canopy area x 1m2 leaf area). tree_area = currentCohort%c_area/currentCohort%n - if(currentCohort%nv > 1)then - + if (currentCohort%nv > 1) then !is there canopy, and are the leaves on? + currentCohort%gpp_clm = 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) * & diff --git a/biogeophys/EDSurfaceAlbedoMod.F90 b/biogeophys/EDSurfaceAlbedoMod.F90 index 868bd98491..a061c5c275 100644 --- a/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/biogeophys/EDSurfaceAlbedoMod.F90 @@ -149,8 +149,6 @@ subroutine ED_Norman_Radiation (bounds, & fsun_z => surfalb_inst%fsun_z_patch & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer ) - - ! TODO (mv, 2014-10-29) the filter here is different than below ! this is needed to have the VOC's be bfb - this needs to be ! re-examined int he future @@ -281,7 +279,7 @@ subroutine ED_Norman_Radiation (bounds, & sb = (90._r8 - (acos(cosz)*180/pi)) * (pi / 180._r8) chil(p) = xl(ft) !min(max(xl(ft), -0.4_r8), 0.6_r8 ) if (abs(chil(p)) <= 0.01_r8) then - chil = 0.01_r8 + chil(p) = 0.01_r8 end if phi1b(p,ft) = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p) phi2b(p,ft) = 0.877_r8 * (1._r8 - 2._r8*phi1b(p,ft)) !0 = horiz leaves, 1 - vert leaves. @@ -725,16 +723,23 @@ subroutine ED_Norman_Radiation (bounds, & ! Absorbed radiation, shaded and sunlit portions of leaf layers !here we get one unit of diffuse radiation... how much of !it is absorbed? - do iv = 1, currentPatch%nrad(L,ft) - if (radtype==1)then - currentPatch%fabd_sha_z(L,ft,iv) = Abs_dif_z(ft,iv) * (1._r8 - currentPatch%f_sun(L,ft,iv)) - currentPatch%fabd_sun_z(L,ft,iv) = Abs_dif_z(ft,iv) * currentPatch%f_sun(L,ft,iv) + & - Abs_dir_z(ft,iv) - else - currentPatch%fabi_sha_z(L,ft,iv) = Abs_dif_z(ft,iv) * (1._r8 - currentPatch%f_sun(L,ft,iv)) - currentPatch%fabi_sun_z(L,ft,iv) = Abs_dif_z(ft,iv) * currentPatch%f_sun(L,ft,iv) - end if - end do + + if (ib == 1) then ! only set the absorbed PAR for the visible light band. + do iv = 1, currentPatch%nrad(L,ft) + if (radtype==1) then + currentPatch%fabd_sha_z(L,ft,iv) = Abs_dif_z(ft,iv) * & + (1._r8 - currentPatch%f_sun(L,ft,iv)) + currentPatch%fabd_sun_z(L,ft,iv) = Abs_dif_z(ft,iv) * & + currentPatch%f_sun(L,ft,iv) + & + Abs_dir_z(ft,iv) + else + currentPatch%fabi_sha_z(L,ft,iv) = Abs_dif_z(ft,iv) * & + (1._r8 - currentPatch%f_sun(L,ft,iv)) + currentPatch%fabi_sun_z(L,ft,iv) = Abs_dif_z(ft,iv) * & + currentPatch%f_sun(L,ft,iv) + endif + end do + endif ! ib !==============================================================================! ! Sum fluxes @@ -886,7 +891,7 @@ subroutine ED_Norman_Radiation (bounds, & write(iulog,*) 'cp',currentPatch%area, currentPatch%patchno write(iulog,*) 'albgrd(c,ib)',albgrd(c,ib) - ! albd(p,ib) = albd(p,ib) + error + albd(p,ib) = albd(p,ib) + error end if else @@ -910,7 +915,7 @@ subroutine ED_Norman_Radiation (bounds, & write(iulog,*) 'CAP',currentPatch%canopy_area_profile(1,1:2,1) - ! albi(p,ib) = albi(p,ib) + error + albi(p,ib) = albi(p,ib) + error end if diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index 28dbfa2d77..5f8dbdcfb9 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -6,3 +6,4 @@ list(APPEND clm_sources ) sourcelist_to_parent(clm_sources) + diff --git a/main/EDCLMLinkMod.F90 b/main/EDCLMLinkMod.F90 index 5de402f35f..b0b559e9ca 100755 --- a/main/EDCLMLinkMod.F90 +++ b/main/EDCLMLinkMod.F90 @@ -606,6 +606,7 @@ subroutine ed_clm_link( this, bounds, ed_allsites_inst, ed_phenology_inst, & !update cohort quantitie s currentCohort => currentPatch%shortest do while(associated(currentCohort)) + ft = currentCohort%pft currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) @@ -680,9 +681,11 @@ subroutine ed_clm_link( this, bounds, ed_allsites_inst, ed_phenology_inst, & ! currentPatch%total_canopy_area/currentPatch%area is fraction of this patch cover by plants ! currentPatch%area/AREA is the fraction of the soil covered by this patch. - clmpatch%wt_ed(p) = min(1.0_r8,(currentPatch%total_canopy_area/currentPatch%area)) * (currentPatch%area/AREA) + clmpatch%wt_ed(p) = min(1.0_r8,(currentPatch%total_canopy_area/currentPatch%area)) * & + (currentPatch%area/AREA) currentPatch%bare_frac_area = (1.0_r8 - min(1.0_r8,currentPatch%total_canopy_area/currentPatch%area)) * & (currentPatch%area/AREA) + ! write(iulog,*) 'bare frac',currentPatch%bare_frac_area total_patch_area = total_patch_area + clmpatch%wt_ed(p) + currentPatch%bare_frac_area total_bare_ground = total_bare_ground + currentPatch%bare_frac_area @@ -791,7 +794,6 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & begp => bounds%begp , & endp => bounds%endp & - ) ! ============================================================================ diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index ccabb1baed..66e929a386 100755 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -5,6 +5,7 @@ module EDMainMod ! ============================================================================ use shr_kind_mod , only : r8 => shr_kind_r8 + use spmdMod , only : masterproc use decompMod , only : bounds_type use clm_varctl , only : iulog use atm2lndType , only : atm2lnd_type @@ -113,7 +114,9 @@ subroutine ed_driver( bounds, ed_allsites_inst, ed_clm_inst, ed_phenology_inst, call ed_clm_inst%ed_clm_link( bounds, ed_allsites_inst(bounds%begg:bounds%endg), & ed_phenology_inst, waterstate_inst, canopystate_inst) - write(iulog,*) 'leaving ed model',bounds%begg,bounds%endg,dayDiffInt + if (masterproc) then + write(iulog,*) 'leaving ed model',bounds%begg,bounds%endg,dayDiffInt + end if end subroutine ed_driver @@ -321,11 +324,12 @@ subroutine ed_integrate_state_variables(currentSite, soilstate_inst, temperature do p = 1,numpft_ed if(currentPatch%leaf_litter(p) shr_log_errMsg use shr_sys_mod , only : shr_sys_abort use clm_varctl , only : iulog + use spmdMod , only : masterproc use decompMod , only : bounds_type, get_clmlevel_gsmap use CanopyStateType , only : canopystate_type use WaterStateType , only : waterstate_type @@ -87,6 +88,16 @@ module EDRestVectorMod ! real(r8), pointer :: water_memory(:) real(r8), pointer :: old_stock(:) + real(r8), pointer :: cd_status(:) + real(r8), pointer :: dd_status(:) + real(r8), pointer :: ncd(:) + real(r8), pointer :: leafondate(:) + real(r8), pointer :: leafoffdate(:) + real(r8), pointer :: dleafondate(:) + real(r8), pointer :: dleafoffdate(:) + real(r8), pointer :: acc_NI(:) + + contains ! ! implement getVector and setVector @@ -176,6 +187,14 @@ subroutine deleteEDRestartVectorClass( this ) deallocate(this%areaRestart ) deallocate(this%water_memory ) deallocate(this%old_stock ) + deallocate(this%cd_status ) + deallocate(this%dd_status ) + deallocate(this%ncd ) + deallocate(this%leafondate ) + deallocate(this%leafoffdate ) + deallocate(this%dleafondate ) + deallocate(this%dleafoffdate ) + deallocate(this%acc_NI ) end subroutine deleteEDRestartVectorClass @@ -384,6 +403,46 @@ function newEDRestartVectorClass( bounds ) SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) new%old_stock(:) = 0.0_r8 + allocate(new%cd_status & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%cd_status(:) = 0_r8 + + allocate(new%dd_status & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%dd_status(:) = 0_r8 + + allocate(new%ncd & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%ncd(:) = 0_r8 + + allocate(new%leafondate & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%leafondate(:) = 0_r8 + + allocate(new%leafoffdate & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%leafoffdate(:) = 0_r8 + + allocate(new%dleafondate & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%dleafondate(:) = 0_r8 + + allocate(new%dleafoffdate & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%dleafoffdate(:) = 0_r8 + + allocate(new%acc_NI & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%acc_NI(:) = 0_r8 + end associate end function newEDRestartVectorClass @@ -405,7 +464,7 @@ subroutine setVectors( this, bounds, ed_allsites_inst ) ! !LOCAL VARIABLES: !----------------------------------------------------------------------- - write(iulog,*) 'edtime setVectors ',get_nstep() + if ( masterproc ) write(iulog,*) 'edtime setVectors ',get_nstep() if (this%DEBUG) then call this%printIoInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) @@ -718,6 +777,56 @@ subroutine doVectorIO( this, ncid, flag ) deallocate(gsmOP) + call restartvar(ncid=ncid, flag=flag, varname='ed_cd_status', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cold dec status', units='unitless', & + interpinic_flag='interp', data=this%cd_status, & + readvar=readvar) + + + call restartvar(ncid=ncid, flag=flag, varname='ed_dd_status', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed drought dec status', units='unitless', & + interpinic_flag='interp', data=this%dd_status, & + readvar=readvar) + + + call restartvar(ncid=ncid, flag=flag, varname='ed_chilling days', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed chilling day counter', units='unitless', & + interpinic_flag='interp', data=this%ncd, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_leafondate', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed leafondate', units='unitless', & + interpinic_flag='interp', data=this%leafondate, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_leafoffdate', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed leafoffdate', units='unitless', & + interpinic_flag='interp', data=this%leafoffdate, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_dleafondate', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed dleafondate', units='unitless', & + interpinic_flag='interp', data=this%dleafondate, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_dleafoffdate', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed dleafoffdate', units='unitless', & + interpinic_flag='interp', data=this%dleafoffdate, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_acc_NI', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed nesterov index', units='unitless', & + interpinic_flag='interp', data=this%acc_NI, & + readvar=readvar) + end subroutine doVectorIO !-------------------------------------------------------------------------------! @@ -810,7 +919,23 @@ subroutine printDataInfoVector( this ) this%water_memory(iSta:iSto) write(iulog,*) trim(methodName)//' :: old_stock ', & this%old_stock(iSta:iSto) - + write(iulog,*) trim(methodName)//' :: cd_status', & + this%cd_status(iSta:iSto) + write(iulog,*) trim(methodName)//' :: dd_status', & + this%cd_status(iSta:iSto) + write(iulog,*) trim(methodName)//' :: ncd', & + this%ncd(iSta:iSto) + write(iulog,*) trim(methodName)//' :: leafondate', & + this%leafondate(iSta:iSto) + write(iulog,*) trim(methodName)//' :: leafoffdate', & + this%leafoffdate(iSta:iSto) + write(iulog,*) trim(methodName)//' :: dleafondate', & + this%dleafondate(iSta:iSto) + write(iulog,*) trim(methodName)//' :: dleafoffdate', & + this%dleafoffdate(iSta:iSto) + write(iulog,*) trim(methodName)//' :: acc_NI', & + this%acc_NI(iSta:iSto) + end subroutine printDataInfoVector !-------------------------------------------------------------------------------! @@ -903,6 +1028,15 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) write(iulog,*) trim(methodName)//' age ' ,currentPatch%age write(iulog,*) trim(methodName)//' area ' ,currentPatch%area write(iulog,*) trim(methodName)//' old_stock ' ,ed_allsites_inst(g)%old_stock + write(iulog,*) trim(methodName)//' cd_status ' ,ed_allsites_inst(g)%status + write(iulog,*) trim(methodName)//' dd_status ' ,ed_allsites_inst(g)%dstatus + write(iulog,*) trim(methodName)//' ncd ' ,ed_allsites_inst(g)%ncd + write(iulog,*) trim(methodName)//' leafondate ' ,ed_allsites_inst(g)%leafondate + write(iulog,*) trim(methodName)//' leafoffdate ' ,ed_allsites_inst(g)%leafoffdate + write(iulog,*) trim(methodName)//' dleafondate ' ,ed_allsites_inst(g)%dleafondate + write(iulog,*) trim(methodName)//' dleafoffdate ' ,ed_allsites_inst(g)%dleafoffdate + write(iulog,*) trim(methodName)//' acc_NI' ,ed_allsites_inst(g)%acc_NI + currentPatch => currentPatch%younger @@ -910,9 +1044,9 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) numPatches = numPatches + 1 enddo ! currentPatch do while endif - g = g + 1 write(iulog,*) trim(methodName)//' water_memory ',ed_allsites_inst(g)%water_memory(1) + g = g + 1 enddo @@ -1106,12 +1240,6 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) enddo ! currentCohort do while - if ( numCohort > numCohortsPerPatch ) then - write(iulog,*) 'offsetNumCohorts, numCohortsPerPatch ',countCohort, numCohortsPerPatch - call shr_sys_abort( 'error in convertCohortListToVector :: '//& - 'overrun of number of total cohorts in one patch. Try increasing cohorts for '//& - 'IO '//errMsg(__FILE__, __LINE__)) - endif ! ! deal with patch level fields here @@ -1120,6 +1248,16 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) this%age(incrementOffset) = currentPatch%age this%areaRestart(incrementOffset) = currentPatch%area this%old_stock(incrementOffset) = ed_allsites_inst(g)%old_stock + this%cd_status(incrementOffset) = ed_allsites_inst(g)%status + this%dd_status(incrementOffset) = ed_allsites_inst(g)%dstatus + this%ncd(incrementOffset) = ed_allsites_inst(g)%ncd + this%leafondate(incrementOffset) = ed_allsites_inst(g)%leafondate + this%leafoffdate(incrementOffset) = ed_allsites_inst(g)%leafoffdate + this%dleafondate(incrementOffset) = ed_allsites_inst(g)%dleafondate + this%dleafoffdate(incrementOffset)= ed_allsites_inst(g)%dleafoffdate + this%acc_NI(incrementOffset) = ed_allsites_inst(g)%acc_NI + + ! set cohorts per patch for IO this%cohortsPerPatch( incrementOffset ) = numCohort @@ -1164,9 +1302,6 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) countNclmax = incrementOffset countCohort = incrementOffset - write(iulog,*) 'incrementOffset, cohorts_per_gcell, numCohort, totalCohorts ', & - incrementOffset, cohorts_per_gcell, numCohort, totalCohorts - currentPatch => currentPatch%younger enddo ! currentPatch do while @@ -1179,14 +1314,6 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) countWaterMem = countWaterMem + 1 end do - if ( incrementOffset > cohorts_per_gcell ) then - write(iulog,*) 'incrementOffset, cohorts_per_gcell, numCohort, totalCohorts ', & - incrementOffset, cohorts_per_gcell, numCohort, totalCohorts - call shr_sys_abort( 'error in convertCohortListToVector :: '//& - 'overrun of number of total cohorts in this gcell. Try increasing cohorts for '//& - 'IO '//errMsg(__FILE__, __LINE__)) - endif - countWaterMem = incrementOffset endif ! is there soil check @@ -1468,12 +1595,6 @@ subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) enddo ! currentPatch do while - if ( numCohort > numCohortsPerPatch ) then - write(iulog,*) 'CVTL offsetNumCohorts, numCohortsPerPatch ',countCohort, numCohortsPerPatch - call shr_sys_abort( 'error in convertCohortListToVector :: '//& - 'overrun of number of total cohorts in one patch. Try increasing cohorts for '//& - 'IO '//errMsg(__FILE__, __LINE__)) - endif ! FIX(SPM,032414) move to init if you can...or make a new init function currentPatch%leaf_litter(:) = 0.0_r8 @@ -1490,6 +1611,15 @@ subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) currentPatch%age = this%age(incrementOffset) currentPatch%area = this%areaRestart(incrementOffset) ed_allsites_inst(g)%old_stock = this%old_stock(incrementOffset) + ed_allsites_inst(g)%status = this%cd_status(incrementOffset) + ed_allsites_inst(g)%dstatus = this%dd_status(incrementOffset) + ed_allsites_inst(g)%ncd = this%ncd(incrementOffset) + ed_allsites_inst(g)%leafondate = this%leafondate(incrementOffset) + ed_allsites_inst(g)%leafoffdate = this%leafoffdate(incrementOffset) + ed_allsites_inst(g)%dleafondate = this%dleafondate(incrementOffset) + ed_allsites_inst(g)%dleafoffdate = this%dleafoffdate(incrementOffset) + ed_allsites_inst(g)%acc_NI = this%acc_NI(incrementOffset) + ! set cohorts per patch for IO if (this%DEBUG) then @@ -1544,14 +1674,6 @@ subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) countWaterMem = countWaterMem + 1 end do - if ( incrementOffset > cohorts_per_gcell ) then - write(iulog,*) 'CVTL incrementOffset, cohorts_per_gcell, numCohort, totalCohorts ', & - incrementOffset, cohorts_per_gcell, numCohort, totalCohorts - call shr_sys_abort( 'error in convertCohortListToVector :: '//& - 'overrun of number of total cohorts in this gcell. Try increasing cohorts for '//& - 'IO '//errMsg(__FILE__, __LINE__)) - endif - countWaterMem = incrementOffset endif ! is there soil check