diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 81143bd553..2ccea2cad1 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -13,7 +13,7 @@ module EDCohortDynamicsMod use EDGrowthFunctionsMod , only : c_area, tree_lai use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDTypesMod , only : fusetol, cp_nclmax - use EDtypesMod , only : ncwd, numcohortsperpatch, udata + use EDtypesMod , only : ncwd, maxcohortsperpatch, udata use EDtypesMod , only : sclass_ed,nlevsclass_ed,AREA use EDtypesMod , only : min_npm2, min_nppatch, min_n_safemath ! @@ -626,7 +626,7 @@ subroutine fuse_cohorts(patchptr) iterate = 1 fusion_took_place = 0 currentPatch => patchptr - maxcohorts = numCohortsPerPatch + maxcohorts = maxCohortsPerPatch !---------------------------------------------------------------------! ! Keep doing this until nocohorts <= maxcohorts ! diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index c7cf190dc6..5fae1a783f 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -9,7 +9,7 @@ module EDPatchDynamicsMod use clm_varctl , only : iulog use pftconMod , only : pftcon use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort - use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, numPatchesPerCol + use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, maxPatchesPerCol use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, udata use EDTypesMod , only : min_patch_area, cp_numlevgrnd, cp_numSWb ! @@ -1018,7 +1018,7 @@ subroutine fuse_patches( csite ) !--------------------------------------------------------------------- !maxpatch = 4 - maxpatch = numPatchesPerCol + maxpatch = maxPatchesPerCol currentSite => csite diff --git a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 index a9e6cf5049..7e55aee9a4 100644 --- a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +++ b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 @@ -54,7 +54,7 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_site_type use EDTypesMod , only : numpft_ed - use EDTypesMod , only : numpatchespercol + use EDTypesMod , only : maxpatchespercol use EDTypesMod , only : cp_numlevsoil use EDTypesMod , only : cp_nlevcan use EDTypesMod , only : cp_nclmax @@ -105,9 +105,9 @@ subroutine Photosynthesis_ED (nsites, sites,bc_in,bc_out,dtime) 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) - real(r8) :: ko( numpatchespercol ) ! Michaelis-Menten constant for O2 (Pa) - real(r8) :: co2_cp( numpatchespercol ) ! CO2 compensation point (Pa) + real(r8) :: kc( maxpatchespercol ) ! Michaelis-Menten constant for CO2 (Pa) + real(r8) :: ko( maxpatchespercol ) ! Michaelis-Menten constant for O2 (Pa) + real(r8) :: co2_cp( maxpatchespercol ) ! CO2 compensation point (Pa) ! --------------------------------------------------------------- ! TO-DO: bbbopt is slated to be transferred to the parameter file diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index 2086dcb146..d76695916c 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -12,7 +12,7 @@ module EDSurfaceRadiationMod use EDtypesMod , only : ed_patch_type, ed_site_type use EDtypesMod , only : numpft_ed - use EDtypesMod , only : numPatchesPerCol + use EDtypesMod , only : maxPatchesPerCol use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use FatesInterfaceMod , only : bc_in_type, & @@ -74,8 +74,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: k_dir(numpft_ed) ! Direct beam extinction coefficient real(r8) :: tr_dir_z(cp_nclmax,numpft_ed,cp_nlevcan) ! Exponential transmittance of direct beam radiation through a single layer real(r8) :: tr_dif_z(cp_nclmax,numpft_ed,cp_nlevcan) ! Exponential transmittance of diffuse radiation through a single layer - real(r8) :: forc_dir(numPatchesPerCol,cp_maxSWb) - real(r8) :: forc_dif(numPatchesPerCol,cp_maxSWb) + real(r8) :: forc_dir(maxPatchesPerCol,cp_maxSWb) + real(r8) :: forc_dif(maxPatchesPerCol,cp_maxSWb) real(r8) :: weighted_dir_tr(cp_nclmax) real(r8) :: weighted_fsun(cp_nclmax) real(r8) :: weighted_dif_ratio(cp_nclmax,cp_maxSWb) @@ -93,8 +93,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) real(r8) :: abs_rad(cp_maxSWb) !radiation absorbed by soil real(r8) :: tr_soili ! Radiation transmitted to the soil surface. real(r8) :: tr_soild ! Radiation transmitted to the soil surface. - real(r8) :: phi1b(numPatchesPerCol,numpft_ed) ! Radiation transmitted to the soil surface. - real(r8) :: phi2b(numPatchesPerCol,numpft_ed) + real(r8) :: phi1b(maxPatchesPerCol,numpft_ed) ! Radiation transmitted to the soil surface. + real(r8) :: phi2b(maxPatchesPerCol,numpft_ed) real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) real(r8) :: angle @@ -107,8 +107,8 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out ) integer :: fp,iv,s ! array indices integer :: ib ! waveband number real(r8) :: cosz ! 0.001 <= coszen <= 1.000 - real(r8) :: chil(numPatchesPerCol) ! -0.4 <= xl <= 0.6 - real(r8) :: gdir(numPatchesPerCol) ! leaf projection in solar direction (0 to 1) + real(r8) :: chil(maxPatchesPerCol) ! -0.4 <= xl <= 0.6 + real(r8) :: gdir(maxPatchesPerCol) ! leaf projection in solar direction (0 to 1) !----------------------------------------------------------------------- diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 18a52c16d6..e8830e4161 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -54,10 +54,6 @@ subroutine zero_site( site_in ) site_in%oldest_patch => null() ! pointer to oldest patch at the site site_in%youngest_patch => null() ! pointer to yngest patch at the site - ! INDICES - site_in%lat = nan - site_in%lon = nan - ! DISTURBANCE site_in%disturbance_rate = 0._r8 ! site level disturbance rates from mortality and fire. site_in%dist_type = 0 ! disturbance dist_type id. diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 deleted file mode 100755 index a24a493f57..0000000000 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ /dev/null @@ -1,2386 +0,0 @@ -module EDRestVectorMod - -#include "shr_assert.h" - - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => 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 - use pftconMod , only : pftcon - use EDTypesMod , only : area, cohorts_per_col, numpft_ed, numWaterMem, cp_nclmax, numCohortsPerPatch - use EDTypesMod , only : ncwd, invalidValue, cp_nlevcan - use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use abortutils , only : endrun - - ! - implicit none - private - ! - ! integer constants for storing logical data - integer, parameter :: old_cohort = 0 - integer, parameter :: new_cohort = 1 - ! - ! ED cohort data as a type of vectors - ! - type, public :: EDRestartVectorClass - ! - ! for vector start and stop, equivalent to begCohort and endCohort - ! - integer :: vectorLengthStart - integer :: vectorLengthStop - - logical :: DEBUG = .false. - ! - ! add ED vectors that need to be written for Restarts - ! - - ! required to map cohorts and patches to/fro - ! vectors/LinkedLists - integer, pointer :: numPatchesPerCol(:) - integer, pointer :: cohortsPerPatch(:) - ! - ! cohort data - ! - real(r8), pointer :: balive(:) - real(r8), pointer :: bdead(:) - real(r8), pointer :: bl(:) - real(r8), pointer :: br(:) - real(r8), pointer :: bstore(:) - real(r8), pointer :: canopy_layer(:) - real(r8), pointer :: canopy_trim(:) - real(r8), pointer :: dbh(:) - real(r8), pointer :: hite(:) - real(r8), pointer :: laimemory(:) - real(r8), pointer :: leaf_md(:) ! this can probably be removed - real(r8), pointer :: root_md(:) ! this can probably be removed - real(r8), pointer :: n(:) - real(r8), pointer :: gpp_acc(:) - real(r8), pointer :: npp_acc(:) - 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(:) - real(r8), pointer :: npp_bdead(:) - real(r8), pointer :: npp_bseed(:) - real(r8), pointer :: npp_store(:) - real(r8), pointer :: bmort(:) - real(r8), pointer :: hmort(:) - real(r8), pointer :: cmort(:) - real(r8), pointer :: imort(:) - real(r8), pointer :: fmort(:) - real(r8), pointer :: ddbhdt(:) - real(r8), pointer :: resp_tstep(:) - integer, pointer :: pft(:) - integer, pointer :: status_coh(:) - integer, pointer :: isnew(:) - ! - ! patch level restart vars - ! indexed by ncwd - ! - real(r8), pointer :: cwd_ag(:) - real(r8), pointer :: cwd_bg(:) - ! - ! indexed by pft - ! - real(r8), pointer :: leaf_litter(:) - real(r8), pointer :: root_litter(:) - real(r8), pointer :: leaf_litter_in(:) - real(r8), pointer :: root_litter_in(:) - ! - ! indext by nclmax - ! - real(r8), pointer :: spread(:) - ! - ! one per patch - ! - real(r8), pointer :: livegrass(:) ! this can probably be removed - real(r8), pointer :: age(:) - real(r8), pointer :: areaRestart(:) - real(r8), pointer :: f_sun(:) - real(r8), pointer :: fabd_sun_z(:) - real(r8), pointer :: fabi_sun_z(:) - real(r8), pointer :: fabd_sha_z(:) - real(r8), pointer :: fabi_sha_z(:) - ! - ! site level restart vars - ! - real(r8), pointer :: water_memory(:) - real(r8), pointer :: old_stock(:) - real(r8), pointer :: cd_status(:) - real(r8), pointer :: dd_status(:) - real(r8), pointer :: ED_GDD_site(:) - 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(:) - - ! Site level carbon state/flux checks - real(r8), pointer :: nep_timeintegrated_si(:) - real(r8), pointer :: npp_timeintegrated_si(:) - real(r8), pointer :: hr_timeintegrated_si(:) - real(r8), pointer :: totecosys_old_si(:) - real(r8), pointer :: cbal_err_fates_si(:) - real(r8), pointer :: cbal_err_bgc_si(:) - real(r8), pointer :: cbal_err_tot_si(:) - real(r8), pointer :: tot_fatesc_old_si(:) - real(r8), pointer :: tot_bgcc_old_si(:) - real(r8), pointer :: fates_to_bgc_this_ts_si(:) - real(r8), pointer :: fates_to_bgc_last_ts_si(:) - real(r8), pointer :: seedrain_flux_si(:) - ! - ! site x pft - real(r8), pointer :: seed_bank(:) - - - contains - ! - ! implement getVector and setVector - ! - procedure :: setVectors - procedure :: getVectors - ! - ! restart calls - ! - procedure :: doVectorIO - ! - ! clean up pointer arrays - ! - procedure :: deleteEDRestartVectorClass - ! - ! utility routines - ! - procedure :: convertCohortListToVector - procedure :: createPatchCohortStructure - procedure :: convertCohortVectorToList - procedure :: printIoInfoLL - procedure :: printDataInfoLL - procedure :: printDataInfoVector - - end type EDRestartVectorClass - - ! Fortran way of getting a user-defined ctor - interface EDRestartVectorClass - module procedure newEDRestartVectorClass - end interface EDRestartVectorClass - - character(len=*), private, parameter :: mod_filename = & - __FILE__ - - ! - ! non type-bound procedures - ! - public :: EDRest - - !-------------------------------------------------------------------------------! - -contains - - !--------------------------------------------! - ! Type-Bound Procedures Here: - !--------------------------------------------! - - !-------------------------------------------------------------------------------! - subroutine deleteEDRestartVectorClass( this ) - ! - ! !DESCRIPTION: - ! provide clean-up routine of allocated pointer arrays - ! - ! !USES: - ! - ! !ARGUMENTS: - class(EDRestartVectorClass), intent(inout) :: this - ! - ! !LOCAL VARIABLES: - deallocate(this%numPatchesPerCol ) - deallocate(this%cohortsPerPatch ) - deallocate(this%balive ) - deallocate(this%bdead ) - deallocate(this%bl ) - deallocate(this%br ) - deallocate(this%bstore ) - deallocate(this%canopy_layer ) - deallocate(this%canopy_trim ) - deallocate(this%dbh ) - deallocate(this%hite ) - deallocate(this%laimemory ) - deallocate(this%leaf_md ) - deallocate(this%root_md ) - deallocate(this%n ) - deallocate(this%gpp_acc ) - deallocate(this%npp_acc ) - deallocate(this%gpp_acc_hold ) - deallocate(this%npp_acc_hold ) - deallocate(this%npp_leaf ) - deallocate(this%npp_froot ) - deallocate(this%npp_bsw ) - deallocate(this%npp_bdead ) - deallocate(this%npp_bseed ) - deallocate(this%npp_store ) - deallocate(this%bmort ) - deallocate(this%hmort ) - deallocate(this%cmort ) - deallocate(this%imort ) - deallocate(this%fmort ) - deallocate(this%ddbhdt ) - deallocate(this%resp_tstep ) - deallocate(this%pft ) - deallocate(this%status_coh ) - deallocate(this%isnew ) - deallocate(this%cwd_ag ) - deallocate(this%cwd_bg ) - deallocate(this%leaf_litter ) - deallocate(this%root_litter ) - deallocate(this%leaf_litter_in ) - deallocate(this%root_litter_in ) - deallocate(this%seed_bank ) - deallocate(this%spread ) - deallocate(this%livegrass ) - deallocate(this%age ) - deallocate(this%areaRestart ) - deallocate(this%f_sun ) - deallocate(this%fabd_sun_z ) - deallocate(this%fabi_sun_z ) - deallocate(this%fabd_sha_z ) - deallocate(this%fabi_sha_z ) - deallocate(this%water_memory ) - deallocate(this%old_stock ) - deallocate(this%cd_status ) - deallocate(this%dd_status ) - deallocate(this%ED_GDD_site ) - deallocate(this%ncd ) - deallocate(this%leafondate ) - deallocate(this%leafoffdate ) - deallocate(this%dleafondate ) - deallocate(this%dleafoffdate ) - deallocate(this%acc_NI ) - - deallocate(this%nep_timeintegrated_si) - deallocate(this%npp_timeintegrated_si) - deallocate(this%hr_timeintegrated_si) - deallocate(this%totecosys_old_si) - deallocate(this%cbal_err_fates_si) - deallocate(this%cbal_err_bgc_si) - deallocate(this%cbal_err_tot_si) - deallocate(this%tot_fatesc_old_si) - deallocate(this%tot_bgcc_old_si) - deallocate(this%fates_to_bgc_this_ts_si) - deallocate(this%fates_to_bgc_last_ts_si) - deallocate(this%seedrain_flux_si) - - end subroutine deleteEDRestartVectorClass - - !-------------------------------------------------------------------------------! - function newEDRestartVectorClass( bounds ) - ! - ! !DESCRIPTION: - ! provide user-defined ctor, with array length argument - ! allocate memory for vector to write - ! - ! !USES: - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! bounds - ! - ! !LOCAL VARIABLES: - type(EDRestartVectorClass) :: newEDRestartVectorClass - integer :: retVal = 99 - integer, parameter :: allocOK = 0 - !----------------------------------------------------------------------- - - associate( new => newEDRestartVectorClass) - - ! set class variables - new%vectorLengthStart = bounds%begCohort - new%vectorLengthStop = bounds%endCohort - - ! Column level variables - - allocate(new%numPatchesPerCol & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%numPatchesPerCol(:) = invalidValue - - allocate(new%old_stock & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%old_stock(:) = 0.0_r8 - - allocate(new%cd_status & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cd_status(:) = 0_r8 - - allocate(new%dd_status & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%dd_status(:) = 0_r8 - - allocate(new%ncd & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%ncd(:) = 0_r8 - - - allocate(new%leafondate & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%leafondate(:) = 0_r8 - - allocate(new%leafoffdate & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%leafoffdate(:) = 0_r8 - - allocate(new%dleafondate & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%dleafondate(:) = 0_r8 - - allocate(new%dleafoffdate & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%dleafoffdate(:) = 0_r8 - - allocate(new%acc_NI & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%acc_NI(:) = 0_r8 - - allocate(new%ED_GDD_site & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%ED_GDD_site(:) = 0_r8 - - - allocate(new%nep_timeintegrated_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%nep_timeintegrated_si(:) = 0_r8 - - allocate(new%npp_timeintegrated_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_timeintegrated_si(:) = 0_r8 - - allocate(new%hr_timeintegrated_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%hr_timeintegrated_si(:) = 0_r8 - - allocate(new%totecosys_old_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%totecosys_old_si(:) = 0_r8 - - allocate(new%cbal_err_fates_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cbal_err_fates_si(:) = 0_r8 - - allocate(new%cbal_err_bgc_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cbal_err_bgc_si(:) = 0_r8 - - allocate(new%cbal_err_tot_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cbal_err_tot_si(:) = 0_r8 - - allocate(new%tot_fatesc_old_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%tot_fatesc_old_si(:) = 0_r8 - - allocate(new%tot_bgcc_old_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%tot_bgcc_old_si(:) = 0_r8 - - allocate(new%fates_to_bgc_this_ts_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%fates_to_bgc_this_ts_si(:) = 0_r8 - - allocate(new%fates_to_bgc_last_ts_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%fates_to_bgc_last_ts_si(:) = 0_r8 - - allocate(new%seedrain_flux_si & - (bounds%begc:bounds%endc), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%seedrain_flux_si(:) = 0_r8 - - - ! cohort level variables - - allocate(new%cohortsPerPatch & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cohortsPerPatch(:) = invalidValue - - allocate(new%balive & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%balive(:) = 0.0_r8 - - allocate(new%bdead & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%bdead(:) = 0.0_r8 - - allocate(new%bl & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%bl(:) = 0.0_r8 - - allocate(new%br & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%br(:) = 0.0_r8 - - allocate(new%bstore & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%bstore(:) = 0.0_r8 - - allocate(new%canopy_layer & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%canopy_layer(:) = 0.0_r8 - - allocate(new%canopy_trim & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%canopy_trim(:) = 0.0_r8 - - allocate(new%dbh & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%dbh(:) = 0.0_r8 - - allocate(new%hite & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%hite(:) = 0.0_r8 - - allocate(new%laimemory & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%laimemory(:) = 0.0_r8 - - allocate(new%leaf_md & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%leaf_md(:) = 0.0_r8 - - allocate(new%root_md & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%root_md(:) = 0.0_r8 - - allocate(new%n & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%n(:) = 0.0_r8 - - allocate(new%gpp_acc & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%gpp_acc(:) = 0.0_r8 - - allocate(new%npp_acc & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_acc(:) = 0.0_r8 - - allocate(new%gpp_acc_hold & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%gpp_acc_hold(:) = 0.0_r8 - - allocate(new%npp_acc_hold & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_acc_hold(:) = 0.0_r8 - - allocate(new%npp_leaf & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_leaf(:) = 0.0_r8 - - allocate(new%npp_froot & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_froot(:) = 0.0_r8 - - allocate(new%npp_bsw & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_bsw(:) = 0.0_r8 - - allocate(new%npp_bdead & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_bdead(:) = 0.0_r8 - - allocate(new%npp_bseed & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_bseed(:) = 0.0_r8 - - allocate(new%npp_store & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%npp_store(:) = 0.0_r8 - - allocate(new%bmort & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%bmort(:) = 0.0_r8 - - allocate(new%hmort & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%hmort(:) = 0.0_r8 - - allocate(new%cmort & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cmort(:) = 0.0_r8 - - allocate(new%imort & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%imort(:) = 0.0_r8 - - allocate(new%fmort & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%fmort(:) = 0.0_r8 - - allocate(new%ddbhdt & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%ddbhdt(:) = 0.0_r8 - - allocate(new%resp_tstep & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%resp_tstep(:) = 0.0_r8 - - allocate(new%pft & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%pft(:) = 0 - - allocate(new%status_coh & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%status_coh(:) = 0 - - allocate(new%isnew & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%isnew(:) = new_cohort - - ! - ! some patch level variables that are required on restart - ! - allocate(new%cwd_ag & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cwd_ag(:) = 0.0_r8 - - allocate(new%cwd_bg & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%cwd_bg(:) = 0.0_r8 - - allocate(new%leaf_litter & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%leaf_litter(:) = 0.0_r8 - - allocate(new%root_litter & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%root_litter(:) = 0.0_r8 - - allocate(new%leaf_litter_in & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%leaf_litter_in(:) = 0.0_r8 - - allocate(new%root_litter_in & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%root_litter_in(:) = 0.0_r8 - - allocate(new%seed_bank & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%seed_bank(:) = 0.0_r8 - - allocate(new%spread & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%spread(:) = 0.0_r8 - - allocate(new%livegrass & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%livegrass(:) = 0.0_r8 - - allocate(new%age & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%age(:) = 0.0_r8 - - allocate(new%areaRestart & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%areaRestart(:) = 0.0_r8 - - allocate(new%f_sun & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%f_sun(:) = 0.0_r8 - - allocate(new%fabd_sun_z & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%fabd_sun_z(:) = 0.0_r8 - - allocate(new%fabi_sun_z & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%fabi_sun_z(:) = 0.0_r8 - - allocate(new%fabd_sha_z & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%fabd_sha_z(:) = 0.0_r8 - - allocate(new%fabi_sha_z & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%fabi_sha_z(:) = 0.0_r8 - - ! - ! Site level variable stored with cohort indexing - ! (to accomodate the second dimension) - ! - - allocate(new%water_memory & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(mod_filename, __LINE__)) - new%water_memory(:) = 0.0_r8 - - - end associate - - end function newEDRestartVectorClass - - !-------------------------------------------------------------------------------! - subroutine setVectors( this, bounds, nsites, sites, fcolumn ) - ! - ! !DESCRIPTION: - ! implement setVectors - ! - ! !USES: - use clm_time_manager , only : get_nstep - ! - ! !ARGUMENTS: - class(EDRestartVectorClass) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: nsites - type(ed_site_type) , intent(in), target :: sites(nsites) - integer , intent(in) :: fcolumn(nsites) - ! - ! !LOCAL VARIABLES: - !----------------------------------------------------------------------- - - if ( masterproc ) write(iulog,*) 'edtime setVectors ',get_nstep() - - !if (this%DEBUG) then - ! call this%printIoInfoLL ( bounds, sites, nsites ) - ! call this%printDataInfoLL ( bounds, sites, nsites ) - !end if - - call this%convertCohortListToVector ( bounds, nsites, sites, fcolumn ) - - if (this%DEBUG) then - call this%printIoInfoLL ( bounds, nsites, sites, fcolumn ) - call this%printDataInfoLL ( bounds, nsites, sites ) - - ! RGK: Commenting this out because it is calling several - ! variables over the wrong indices -! call this%printDataInfoVector ( ) - end if - - end subroutine setVectors - - !-------------------------------------------------------------------------------! - subroutine getVectors( this, bounds, nsites, sites, fcolumn) - ! - ! !DESCRIPTION: - ! implement getVectors - ! - ! !USES: - use clm_time_manager , only : get_nstep - use EDMainMod , only : ed_update_site - ! - ! !ARGUMENTS: - class(EDRestartVectorClass) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: nsites - type(ed_site_type) , intent(inout), target :: sites(nsites) - integer , intent(in) :: fcolumn(nsites) - ! - ! !LOCAL VARIABLES: - integer :: s - !----------------------------------------------------------------------- - - if (this%DEBUG) then - write(iulog,*) 'edtime getVectors ',get_nstep() - end if - - call this%createPatchCohortStructure ( bounds, nsites, sites, fcolumn ) - - call this%convertCohortVectorToList ( bounds, nsites , sites, fcolumn) - - do s = 1,nsites - call ed_update_site( sites(s) ) - end do - - if (this%DEBUG) then - call this%printIoInfoLL ( bounds, nsites, sites, fcolumn ) - call this%printDataInfoLL ( bounds, nsites, sites ) - call this%printDataInfoVector ( ) - end if - - end subroutine getVectors - - !-------------------------------------------------------------------------------! - subroutine doVectorIO( this, ncid, flag ) - ! - ! !DESCRIPTION: - ! implement VectorIO - ! - ! !USES: - use ncdio_pio , only : file_desc_t, ncd_int, ncd_double - use restUtilMod, only : restartvar - use clm_varcon, only : namec, nameCohort - use spmdMod, only : iam - ! - ! !ARGUMENTS: - class(EDRestartVectorClass), intent(inout) :: this - type(file_desc_t), intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag !'read' or 'write' - ! - ! !LOCAL VARIABLES: - logical :: readvar - character(len=16) :: coh_dimName = trim(nameCohort) - character(len=16) :: col_dimName = trim(namec) - !----------------------------------------------------------------------- - - - if(this%DEBUG) then - write(iulog,*) 'flag:',flag - write(iulog,*) 'dimname:',col_dimName - write(iulog,*) 'readvar:',readvar - write(iulog,*) 'associated?',associated(this%numPatchesPerCol) - write(iulog,*) '' - write(iulog,*) 'col size:',size(this%numPatchesPerCol) - write(iulog,*) 'col lbound:',lbound(this%numPatchesPerCol) - write(iulog,*) 'col ubound:',ubound(this%numPatchesPerCol) - - write(iulog,*) 'coh size:',size(this%cohortsPerPatch) - write(iulog,*) 'coh lbound:',lbound(this%cohortsPerPatch) - write(iulog,*) 'coh ubound:',ubound(this%cohortsPerPatch) - write(iulog,*) '' - end if - - call restartvar(ncid=ncid, flag=flag, varname='ed_io_numPatchesPerCol', xtype=ncd_int, & - dim1name=col_dimName, & - long_name='Num patches per column', units='unitless', & - interpinic_flag='interp', data=this%numPatchesPerCol, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_old_stock', xtype=ncd_double, & - dim1name=col_dimName, & - long_name='ed cohort - old_stock', units='unitless', & - interpinic_flag='interp', data=this%old_stock, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_cd_status', xtype=ncd_double, & - dim1name=col_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=col_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=col_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=col_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=col_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=col_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=col_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=col_dimName, & - long_name='ed nesterov index', units='unitless', & - interpinic_flag='interp', data=this%acc_NI, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_gdd_site', xtype=ncd_double, & - dim1name=col_dimName, & - long_name='ed GDD site', units='unitless', & - interpinic_flag='interp', data=this%ED_GDD_site, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='nep_timeintegrated_col', xtype=ncd_double, & - dim1name=col_dimName, long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%nep_timeintegrated_si) - - call restartvar(ncid=ncid, flag=flag, varname='npp_timeintegrated_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%npp_timeintegrated_si) - - call restartvar(ncid=ncid, flag=flag, varname='hr_timeintegrated_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%hr_timeintegrated_si) - - call restartvar(ncid=ncid, flag=flag, varname='cbalance_error_ed_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%cbal_err_fates_si) - - call restartvar(ncid=ncid, flag=flag, varname='cbalance_error_bgc_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%cbal_err_bgc_si) - - call restartvar(ncid=ncid, flag=flag, varname='cbalance_error_total_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%cbal_err_tot_si) - - call restartvar(ncid=ncid, flag=flag, varname='totecosysc_old_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%totecosys_old_si) - - call restartvar(ncid=ncid, flag=flag, varname='totedc_old_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%tot_fatesc_old_si) - - call restartvar(ncid=ncid, flag=flag, varname='totbgcc_old_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%tot_bgcc_old_si) - - call restartvar(ncid=ncid, flag=flag, varname='ed_to_bgc_this_edts_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%fates_to_bgc_this_ts_si) - - call restartvar(ncid=ncid, flag=flag, varname='ed_to_bgc_last_edts_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%fates_to_bgc_last_ts_si) - - call restartvar(ncid=ncid, flag=flag, varname='seed_rain_flux_col', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%seedrain_flux_si) - - - call restartvar(ncid=ncid, flag=flag, varname='ed_balive', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort ed_balive', units='unitless', & - interpinic_flag='interp', data=this%balive, & - readvar=readvar) - - - ! - ! cohort level vars - ! - call restartvar(ncid=ncid, flag=flag, varname='ed_io_cohortsPerPatch', xtype=ncd_int, & - dim1name=coh_dimName, & - long_name='cohorts per patch, indexed by numPatchesPerCol', units='unitless', & - interpinic_flag='interp', data=this%cohortsPerPatch, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_bdead', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - bdead', units='unitless', & - interpinic_flag='interp', data=this%bdead, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_bl', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - bl', units='unitless', & - interpinic_flag='interp', data=this%bl, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_br', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - br', units='unitless', & - interpinic_flag='interp', data=this%br, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_bstore', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - bstore', units='unitless', & - interpinic_flag='interp', data=this%bstore, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_canopy_layer', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - canopy_layer', units='unitless', & - interpinic_flag='interp', data=this%canopy_layer, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_canopy_trim', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - canopy_trim', units='unitless', & - interpinic_flag='interp', data=this%canopy_trim, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_dbh', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - dbh', units='unitless', & - interpinic_flag='interp', data=this%dbh, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_hite', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - hite', units='unitless', & - interpinic_flag='interp', data=this%hite, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_laimemory', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - laimemory', units='unitless', & - interpinic_flag='interp', data=this%laimemory, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_leaf_md', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - leaf_md', units='unitless', & - interpinic_flag='interp', data=this%leaf_md, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_root_md', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - root_md', units='unitless', & - interpinic_flag='interp', data=this%root_md, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_n', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - n', units='unitless', & - interpinic_flag='interp', data=this%n, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_gpp_acc', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - gpp_acc', units='unitless', & - interpinic_flag='interp', data=this%gpp_acc, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_npp_acc', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - npp_acc', units='unitless', & - interpinic_flag='interp', data=this%npp_acc, & - readvar=readvar) - - 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_acc_hold, & - readvar=readvar) - - 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_acc_hold, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_npp_leaf', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - npp_leaf', units='unitless', & - interpinic_flag='interp', data=this%npp_leaf, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_npp_froot', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - npp_froot', units='unitless', & - interpinic_flag='interp', data=this%npp_froot, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_npp_bsw', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - npp_bsw', units='unitless', & - interpinic_flag='interp', data=this%npp_bsw, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_npp_bdead', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - npp_bdead', units='unitless', & - interpinic_flag='interp', data=this%npp_bdead, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_npp_bseed', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - npp_bseed', units='unitless', & - interpinic_flag='interp', data=this%npp_bseed, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_npp_store', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - npp_store', units='unitless', & - interpinic_flag='interp', data=this%npp_store, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_bmort', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - bmort', units='unitless', & - interpinic_flag='interp', data=this%bmort, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_hmort', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - hmort', units='unitless', & - interpinic_flag='interp', data=this%hmort, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_cmort', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - cmort', units='unitless', & - interpinic_flag='interp', data=this%cmort, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_imort', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - imort', units='unitless', & - interpinic_flag='interp', data=this%imort, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_fmort', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - fmort', units='unitless', & - interpinic_flag='interp', data=this%fmort, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_ddbhdt', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - ddbhdt', units='unitless', & - interpinic_flag='interp', data=this%ddbhdt, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_resp_tstep', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - resp_tstep', units='unitless', & - interpinic_flag='interp', data=this%resp_tstep, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_pft', xtype=ncd_int, & - dim1name=coh_dimName, & - long_name='ed cohort - pft', units='unitless', & - interpinic_flag='interp', data=this%pft, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_status_coh', xtype=ncd_int, & - dim1name=coh_dimName, & - long_name='ed cohort - status_coh', units='unitless', & - interpinic_flag='interp', data=this%status_coh, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_isnew', xtype=ncd_int, & - dim1name=coh_dimName, & - long_name='ed cohort - isnew', units='unitless', & - interpinic_flag='interp', data=this%isnew, & - readvar=readvar) - - ! - ! patch level vars - ! - - call restartvar(ncid=ncid, flag=flag, varname='ed_cwd_ag', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - cwd_ag', units='unitless', & - interpinic_flag='interp', data=this%cwd_ag, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_cwd_bg', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - cwd_bg', units='unitless', & - interpinic_flag='interp', data=this%cwd_bg, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_leaf_litter', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - leaf_litter', units='unitless', & - interpinic_flag='interp', data=this%leaf_litter, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_root_litter', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - root_litter', units='unitless', & - interpinic_flag='interp', data=this%root_litter, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_leaf_litter_in', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - leaf_litter_in', units='unitless', & - interpinic_flag='interp', data=this%leaf_litter_in, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_root_litter_in', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - root_litter_in', units='unitless', & - interpinic_flag='interp', data=this%root_litter_in, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_seed_bank', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed site - seed_bank', units='unitless', & - interpinic_flag='interp', data=this%seed_bank, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_spread', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - spread', units='unitless', & - interpinic_flag='interp', data=this%spread, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_livegrass', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - livegrass', units='unitless', & - interpinic_flag='interp', data=this%livegrass, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_age', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - age', units='unitless', & - interpinic_flag='interp', data=this%age, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_area', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - area', units='unitless', & - interpinic_flag='interp', data=this%areaRestart, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_f_sun', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - f_sun', units='unitless', & - interpinic_flag='interp', data=this%f_sun, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_fabd_sun_z', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - fabd_sun_z', units='unitless', & - interpinic_flag='interp', data=this%fabd_sun_z, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_fabi_sun_z', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - fabi_sun_z', units='unitless', & - interpinic_flag='interp', data=this%fabi_sun_z, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_fabd_sha_z', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - fabd_sha_z', units='unitless', & - interpinic_flag='interp', data=this%fabd_sha_z, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_fabi_sha_z', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed patch - fabi_sha_z', units='unitless', & - interpinic_flag='interp', data=this%fabi_sha_z, & - readvar=readvar) - ! - ! site level vars - ! - - call restartvar(ncid=ncid, flag=flag, varname='ed_water_memory', xtype=ncd_double, & - dim1name=coh_dimName, & - long_name='ed cohort - water_memory', units='unitless', & - interpinic_flag='interp', data=this%water_memory, & - readvar=readvar) - - - - - - - end subroutine doVectorIO - - !-------------------------------------------------------------------------------! - subroutine printDataInfoVector( this ) - ! - ! !DESCRIPTION: - ! - ! !USES: - ! - ! !ARGUMENTS: - class(EDRestartVectorClass), intent(inout) :: this - ! - ! !LOCAL VARIABLES: - character(len=32) :: methodName = 'PDIV ' - integer :: iSta, iSto - !----------------------------------------------------------------------- - - ! RGK: changed the vector end-point on column variables to match the start point - ! this avoids exceeding bounds on the last column of the dataset - - iSta = this%vectorLengthStart - iSto = iSta + 1 - - write(iulog,*) trim(methodName)//' :: this%vectorLengthStart ', & - this%vectorLengthStart - write(iulog,*) trim(methodName)//' :: this%vectorLengthStop ', & - this%vectorLengthStop - - write(iulog,*) ' PDIV chk ',iSta,iSto - write(iulog,*) trim(methodName)//' :: balive ', & - this%balive(iSta:iSto) - write(iulog,*) trim(methodName)//' :: bdead ', & - this%bdead(iSta:iSto) - write(iulog,*) trim(methodName)//' :: bl ', & - this%bl(iSta:iSto) - write(iulog,*) trim(methodName)//' :: br ', & - this%br(iSta:iSto) - write(iulog,*) trim(methodName)//' :: bstore ', & - this%bstore(iSta:iSto) - - write(iulog,*) trim(methodName)//' :: canopy_layer ', & - this%canopy_layer(iSta:iSto) - write(iulog,*) trim(methodName)//' :: canopy_trim ', & - this%canopy_trim(iSta:iSto) - write(iulog,*) trim(methodName)//' :: dbh ', & - this%dbh(iSta:iSto) - - write(iulog,*) trim(methodName)//' :: hite ', & - this%hite(iSta:iSto) - write(iulog,*) trim(methodName)//' :: laimemory ', & - this%laimemory(iSta:iSto) - write(iulog,*) trim(methodName)//' :: leaf_md ', & - this%leaf_md(iSta:iSto) - write(iulog,*) trim(methodName)//' :: root_md ', & - this%root_md(iSta:iSto) - write(iulog,*) trim(methodName)//' :: n ', & - this%n(iSta:iSto) - write(iulog,*) trim(methodName)//' :: gpp_acc ', & - this%gpp_acc(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp_acc ', & - this%npp_acc(iSta:iSto) - write(iulog,*) trim(methodName)//' :: gpp ', & - this%gpp_acc_hold(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp ', & - this%npp_acc_hold(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp_leaf ', & - this%npp_leaf(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp_froot ', & - this%npp_froot(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp_bsw ', & - this%npp_bsw(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp_bdead ', & - this%npp_bdead(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp_bseed ', & - this%npp_bseed(iSta:iSto) - write(iulog,*) trim(methodName)//' :: npp_store ', & - this%npp_store(iSta:iSto) - write(iulog,*) trim(methodName)//' :: bmort ', & - this%bmort(iSta:iSto) - write(iulog,*) trim(methodName)//' :: hmort ', & - this%hmort(iSta:iSto) - write(iulog,*) trim(methodName)//' :: cmort ', & - this%cmort(iSta:iSto) - write(iulog,*) trim(methodName)//' :: imort ', & - this%imort(iSta:iSto) - write(iulog,*) trim(methodName)//' :: fmort ', & - this%fmort(iSta:iSto) - write(iulog,*) trim(methodName)//' :: ddbhdt ', & - this%ddbhdt(iSta:iSto) - write(iulog,*) trim(methodName)//' :: resp_tstep ', & - this%resp_tstep(iSta:iSto) - - write(iulog,*) trim(methodName)//' :: pft ', & - this%pft(iSta:iSto) - write(iulog,*) trim(methodName)//' :: status_coh ', & - this%status_coh(iSta:iSto) - write(iulog,*) trim(methodName)//' :: isnew ', & - this%isnew(iSta:iSto) - - write(iulog,*) trim(methodName)//' :: cwd_ag ', & - this%cwd_ag(iSta:iSto) - write(iulog,*) trim(methodName)//' :: cwd_bg ', & - this%cwd_bg(iSta:iSto) - write(iulog,*) trim(methodName)//' :: leaf_litter ', & - this%leaf_litter(iSta:iSto) - write(iulog,*) trim(methodName)//' :: root_litter ', & - this%root_litter(iSta:iSto) - write(iulog,*) trim(methodName)//' :: leaf_litter_in ', & - this%leaf_litter_in(iSta:iSto) - write(iulog,*) trim(methodName)//' :: root_litter_in ', & - this%root_litter_in(iSta:iSto) - write(iulog,*) trim(methodName)//' :: seed_bank ', & - this%seed_bank(iSta:iSto) - write(iulog,*) trim(methodName)//' :: spread ', & - this%spread(iSta:iSto) - write(iulog,*) trim(methodName)//' :: livegrass ', & - this%livegrass(iSta:iSto) - write(iulog,*) trim(methodName)//' :: age ', & - this%age(iSta:iSto) - write(iulog,*) trim(methodName)//' :: area ', & - this%areaRestart(iSta:iSto) - write(iulog,*) trim(methodName)//' :: f_sun ', & - this%f_sun(iSta:iSto) - write(iulog,*) trim(methodName)//' :: fabd_sun_z ', & - this%fabd_sun_z(iSta:iSto) - write(iulog,*) trim(methodName)//' :: fabi_sun_z ', & - this%fabi_sun_z(iSta:iSto) - write(iulog,*) trim(methodName)//' :: fabd_sha_z ', & - this%fabd_sha_z(iSta:iSto) - write(iulog,*) trim(methodName)//' :: fabi_sha_z ', & - this%fabi_sha_z(iSta:iSto) - write(iulog,*) trim(methodName)//' :: water_memory ', & - this%water_memory(iSta:iSto) - - write(iulog,*) trim(methodName)//' :: old_stock ', & - this%old_stock(iSta:iSta) - write(iulog,*) trim(methodName)//' :: cd_status', & - this%cd_status(iSta:iSta) - write(iulog,*) trim(methodName)//' :: dd_status', & - this%cd_status(iSta:iSto) - write(iulog,*) trim(methodName)//' :: ED_GDD_site', & - this%ED_GDD_site(iSta:iSto) - write(iulog,*) trim(methodName)//' :: ncd', & - this%ncd(iSta:iSta) - write(iulog,*) trim(methodName)//' :: leafondate', & - this%leafondate(iSta:iSta) - write(iulog,*) trim(methodName)//' :: leafoffdate', & - this%leafoffdate(iSta:iSta) - write(iulog,*) trim(methodName)//' :: dleafondate', & - this%dleafondate(iSta:iSta) - write(iulog,*) trim(methodName)//' :: dleafoffdate', & - this%dleafoffdate(iSta:iSta) - write(iulog,*) trim(methodName)//' :: acc_NI', & - this%acc_NI(iSta:iSta) - - end subroutine printDataInfoVector - - !-------------------------------------------------------------------------------! - subroutine printDataInfoLL( this, bounds, nsites, sites ) - ! - ! !DESCRIPTION: - ! counts the total number of cohorts over all p levels (ed_patch_type) so we - ! can allocate vectors, copy from LL -> vector and read/write restarts. - ! - ! !USES: - ! - ! !ARGUMENTS: - class(EDRestartVectorClass) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: nsites - type(ed_site_type) , intent(in), target :: sites(nsites) - ! - ! !LOCAL VARIABLES: - type (ed_patch_type), pointer :: currentPatch - type (ed_cohort_type), pointer :: currentCohort - integer :: s - integer :: totalCohorts - integer :: numCohort - integer :: numPatches,totPatchCount - character(len=32) :: methodName = 'printDataInfoLL ' - !----------------------------------------------------------------------- - - totalCohorts = 0 - totPatchCount = 1 - - write(iulog,*) 'vecLenStart ',this%vectorLengthStart - - do s = 1,nsites - - currentPatch => sites(s)%oldest_patch - - numPatches = 1 - - do while(associated(currentPatch)) - currentCohort => currentPatch%shortest - - numCohort = 0 - - do while(associated(currentCohort)) - - totalCohorts = totalCohorts + 1 - - write(iulog,*) trim(methodName)//' balive ' ,totalCohorts,currentCohort%balive - write(iulog,*) trim(methodName)//' bdead ' ,totalCohorts,currentCohort%bdead - write(iulog,*) trim(methodName)//' bl ' ,totalCohorts,currentCohort%bl - write(iulog,*) trim(methodName)//' br ' ,totalCohorts,currentCohort%br - write(iulog,*) trim(methodName)//' bstore ' ,totalCohorts,currentCohort%bstore - write(iulog,*) trim(methodName)//' canopy_layer ' ,totalCohorts,currentCohort%canopy_layer - write(iulog,*) trim(methodName)//' canopy_trim ' ,totalCohorts,currentCohort%canopy_trim - write(iulog,*) trim(methodName)//' dbh ' ,totalCohorts,currentCohort%dbh - write(iulog,*) trim(methodName)//' hite ' ,totalCohorts,currentCohort%hite - write(iulog,*) trim(methodName)//' laimemory ' ,totalCohorts,currentCohort%laimemory - write(iulog,*) trim(methodName)//' leaf_md ' ,totalCohorts,currentCohort%leaf_md - write(iulog,*) trim(methodName)//' root_md ' ,totalCohorts,currentCohort%root_md - 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_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 - write(iulog,*) trim(methodName)//' npp_bdead ' ,totalCohorts,currentCohort%npp_bdead - write(iulog,*) trim(methodName)//' npp_bseed ' ,totalCohorts,currentCohort%npp_bseed - write(iulog,*) trim(methodName)//' npp_store ' ,totalCohorts,currentCohort%npp_store - write(iulog,*) trim(methodName)//' bmort ' ,totalCohorts,currentCohort%bmort - write(iulog,*) trim(methodName)//' hmort ' ,totalCohorts,currentCohort%hmort - write(iulog,*) trim(methodName)//' cmort ' ,totalCohorts,currentCohort%cmort - write(iulog,*) trim(methodName)//' imort ' ,totalCohorts,currentCohort%imort - write(iulog,*) trim(methodName)//' fmort ' ,totalCohorts,currentCohort%fmort - write(iulog,*) trim(methodName)//' ddbhdt ' ,totalCohorts,currentCohort%ddbhdt - write(iulog,*) trim(methodName)//' resp_tstep ' ,totalCohorts,currentCohort%resp_tstep - write(iulog,*) trim(methodName)//' pft ' ,totalCohorts,currentCohort%pft - write(iulog,*) trim(methodName)//' status_coh ' ,totalCohorts,currentCohort%status_coh - write(iulog,*) trim(methodName)//' isnew ' ,totalCohorts,currentCohort%isnew - - numCohort = numCohort + 1 - - currentCohort => currentCohort%taller - enddo ! currentCohort do while - - write(iulog,*) trim(methodName)//': numpatches for col ',& - numPatches - - write(iulog,*) trim(methodName)//': patches and cohorts ',& - totPatchCount,numCohort - - write(iulog,*) trim(methodName)//' cwd_ag ' ,currentPatch%cwd_ag - write(iulog,*) trim(methodName)//' cwd_bg ' ,currentPatch%cwd_bg - write(iulog,*) trim(methodName)//' leaf_litter ' ,currentPatch%leaf_litter - write(iulog,*) trim(methodName)//' root_litter ' ,currentPatch%root_litter - write(iulog,*) trim(methodName)//' leaf_litter_in ' ,currentPatch%leaf_litter_in - write(iulog,*) trim(methodName)//' root_litter_in ' ,currentPatch%root_litter_in - write(iulog,*) trim(methodName)//' spread ' ,currentPatch%spread - write(iulog,*) trim(methodName)//' livegrass ' ,currentPatch%livegrass - write(iulog,*) trim(methodName)//' age ' ,currentPatch%age - write(iulog,*) trim(methodName)//' area ' ,currentPatch%area - write(iulog,*) trim(methodName)//' f_sun (sum) ' ,sum(currentPatch%f_sun) - write(iulog,*) trim(methodName)//' fabd_sun_z (sum) ' ,sum(currentPatch%fabd_sun_z) - write(iulog,*) trim(methodName)//' fabi_sun_z (sum) ' ,sum(currentPatch%fabi_sun_z) - write(iulog,*) trim(methodName)//' fabd_sha_z (sum) ' ,sum(currentPatch%fabd_sha_z) - write(iulog,*) trim(methodName)//' fabi_sha_z (sum) ' ,sum(currentPatch%fabi_sha_z) - - write(iulog,*) trim(methodName)//' old_stock ' ,sites(s)%old_stock - write(iulog,*) trim(methodName)//' cd_status ' ,sites(s)%status - write(iulog,*) trim(methodName)//' dd_status ' ,sites(s)%dstatus - write(iulog,*) trim(methodName)//' ncd ' ,sites(s)%ncd - write(iulog,*) trim(methodName)//' leafondate ' ,sites(s)%leafondate - write(iulog,*) trim(methodName)//' leafoffdate ' ,sites(s)%leafoffdate - write(iulog,*) trim(methodName)//' dleafondate ' ,sites(s)%dleafondate - write(iulog,*) trim(methodName)//' dleafoffdate ' ,sites(s)%dleafoffdate - write(iulog,*) trim(methodName)//' acc_NI' ,sites(s)%acc_NI - write(iulog,*) trim(methodName)//' ED_GDD_site ' ,sites(s)%ED_GDD_site - write(iulog,*) trim(methodName)//' seed_bank ' ,sites(s)%seed_bank - - currentPatch => currentPatch%younger - - totPatchCount = totPatchCount + 1 - numPatches = numPatches + 1 - enddo ! currentPatch do while - - write(iulog,*) trim(methodName)//' water_memory ',sites(s)%water_memory(1) - - enddo - - write(iulog,*) trim(methodName)//': total cohorts ',totalCohorts - - end subroutine printDataInfoLL - - !-------------------------------------------------------------------------------! - subroutine printIoInfoLL( this, bounds, nsites, sites, fcolumn ) - !! - ! !DESCRIPTION: - ! for debugging. prints some IO info regarding cohorts/patches - ! currently prints cohort level variables - ! - ! !USES: - ! - ! !ARGUMENTS: - class(EDRestartVectorClass) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: nsites - type(ed_site_type) , intent(in), target :: sites(nsites) - integer , intent(in) :: fcolumn(nsites) - ! - ! !LOCAL VARIABLES: - type (ed_patch_type), pointer :: currentPatch - type (ed_cohort_type), pointer :: currentCohort - integer s - integer totalCohorts - integer numCohort - integer numPatches,totPatchCount - character(len=32) :: methodName = 'printIoInfoLL ' - !----------------------------------------------------------------------- - - totalCohorts = 0 - totPatchCount = 1 - - write(iulog,*) 'vecLenStart ',this%vectorLengthStart - - do s = 1,nsites - - currentPatch => sites(s)%oldest_patch - - numPatches = 1 - - do while(associated(currentPatch)) - currentCohort => currentPatch%shortest - - write(iulog,*) trim(methodName)//': found column with patch(s) ',fcolumn(s) - - numCohort = 0 - - do while(associated(currentCohort)) - - totalCohorts = totalCohorts + 1 - numCohort = numCohort + 1 - - write(iulog,*) trim(methodName)//' balive ',numCohort,currentCohort%balive - write(iulog,*) trim(methodName)//' bdead ',currentCohort%bdead - write(iulog,*) trim(methodName)//' bl ',currentCohort%bl - write(iulog,*) trim(methodName)//' br ',currentCohort%br - write(iulog,*) trim(methodName)//' bstore ',currentCohort%bstore - write(iulog,*) trim(methodName)//' canopy_layer ',currentCohort%canopy_layer - write(iulog,*) trim(methodName)//' canopy_trim ',currentCohort%canopy_trim - write(iulog,*) trim(methodName)//' dbh ',currentCohort%dbh - write(iulog,*) trim(methodName)//' hite ',currentCohort%hite - write(iulog,*) trim(methodName)//' laimemory ',currentCohort%laimemory - write(iulog,*) trim(methodName)//' leaf_md ',currentCohort%leaf_md - write(iulog,*) trim(methodName)//' root_md ',currentCohort%root_md - 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_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 - write(iulog,*) trim(methodName)//' npp_bdead ',currentCohort%npp_bdead - write(iulog,*) trim(methodName)//' npp_bseed ',currentCohort%npp_bseed - write(iulog,*) trim(methodName)//' npp_store ',currentCohort%npp_store - write(iulog,*) trim(methodName)//' bmort ',currentCohort%bmort - write(iulog,*) trim(methodName)//' hmort ',currentCohort%hmort - write(iulog,*) trim(methodName)//' cmort ',currentCohort%cmort - write(iulog,*) trim(methodName)//' imort ',currentCohort%imort - write(iulog,*) trim(methodName)//' fmort ',currentCohort%fmort - write(iulog,*) trim(methodName)//' ddbhdt ',currentCohort%ddbhdt - write(iulog,*) trim(methodName)//' resp_tstep ',currentCohort%resp_tstep - write(iulog,*) trim(methodName)//' pft ',currentCohort%pft - write(iulog,*) trim(methodName)//' status_coh ',currentCohort%status_coh - write(iulog,*) trim(methodName)//' isnew ',currentCohort%isnew - - currentCohort => currentCohort%taller - enddo ! currentCohort do while - - write(iulog,*) trim(methodName)//': numpatches for column ',numPatches - write(iulog,*) trim(methodName)//': patches and cohorts ',totPatchCount,numCohort - - currentPatch => currentPatch%younger - - totPatchCount = totPatchCount + 1 - numPatches = numPatches + 1 - enddo ! currentPatch do while - enddo - - return - end subroutine printIoInfoLL - - !-------------------------------------------------------------------------------! - subroutine convertCohortListToVector( this, bounds, nsites, sites, fcolumn ) - ! - ! !DESCRIPTION: - ! counts the total number of cohorts over all p levels (ed_patch_type) so we - ! can allocate vectors, copy from LL -> vector and read/write restarts. - ! - ! !USES: - use EDTypesMod, only : cp_nclmax - ! - ! !ARGUMENTS: - class(EDRestartVectorClass) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: nsites - type(ed_site_type) , intent(in), target :: sites(nsites) - integer , intent(in) :: fcolumn(nsites) - ! - ! !LOCAL VARIABLES: - type (ed_patch_type), pointer :: currentPatch - type (ed_cohort_type), pointer :: currentCohort - integer :: s, c - integer :: totalCohorts ! number of cohorts starting from 1 - integer :: countCohort ! number of cohorts starting from - ! vectorLengthStart - integer :: numCohort - integer :: numPatches - integer :: totPatchCount, offsetTotPatchCount - integer :: countPft - integer :: countNcwd - integer :: countWaterMem - integer :: countNclmax - integer :: countSunZ - integer :: i,j,k - integer :: incrementOffset - !----------------------------------------------------------------------- - - totalCohorts = 0 - -! if(fcolumn(1).eq.bounds%begc .and. & -! (fcolumn(1)-1)*cohorts_per_col+1.ne.bounds%begCohort) then -! write(iulog,*) 'fcolumn(1) in this clump, points to the first column of the clump' -! write(iulog,*) 'but the assumption on first cohort index does not jive' -! call endrun(msg=errMsg(mod_filename, __LINE__)) -! end if - - - do s = 1,nsites - - ! Calculate the offsets - ! fcolumn is the global column index of the current site. - ! For the first site, if that site aligns with the first column index - ! in the clump, than the offset should be be equal to begCohort - - c = fcolumn(s) - - incrementOffset = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countCohort = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countPft = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countNcwd = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countNclmax = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countWaterMem = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countSunZ = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - - ! write seed_bank info(site-level, but PFT-resolved) - do i = 1,numpft_ed - this%seed_bank(incrementOffset+i-1) = sites(s)%seed_bank(i) - end do - - currentPatch => sites(s)%oldest_patch - - ! new column, reset num patches - numPatches = 0 - - do while(associated(currentPatch)) - - ! found patch, increment - numPatches = numPatches + 1 - - currentCohort => currentPatch%shortest - - ! new patch, reset num cohorts - numCohort = 0 - - do while(associated(currentCohort)) - - ! found cohort, increment - numCohort = numCohort + 1 - totalCohorts = totalCohorts + 1 - - if (this%DEBUG) then - write(iulog,*) 'CLTV countCohort ', countCohort - write(iulog,*) 'CLTV vecLenStart ', this%vectorLengthStart - write(iulog,*) 'CLTV vecLenStop ', this%vectorLengthStop - endif - - this%balive(countCohort) = currentCohort%balive - this%bdead(countCohort) = currentCohort%bdead - this%bl(countCohort) = currentCohort%bl - this%br(countCohort) = currentCohort%br - this%bstore(countCohort) = currentCohort%bstore - this%canopy_layer(countCohort) = currentCohort%canopy_layer - this%canopy_trim(countCohort) = currentCohort%canopy_trim - this%dbh(countCohort) = currentCohort%dbh - this%hite(countCohort) = currentCohort%hite - this%laimemory(countCohort) = currentCohort%laimemory - this%leaf_md(countCohort) = currentCohort%leaf_md - this%root_md(countCohort) = currentCohort%root_md - this%n(countCohort) = currentCohort%n - this%gpp_acc(countCohort) = currentCohort%gpp_acc - this%npp_acc(countCohort) = currentCohort%npp_acc - 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 - this%npp_bdead(countCohort) = currentCohort%npp_bdead - this%npp_bseed(countCohort) = currentCohort%npp_bseed - this%npp_store(countCohort) = currentCohort%npp_store - this%bmort(countCohort) = currentCohort%bmort - this%hmort(countCohort) = currentCohort%hmort - this%cmort(countCohort) = currentCohort%cmort - this%imort(countCohort) = currentCohort%imort - this%fmort(countCohort) = currentCohort%fmort - this%ddbhdt(countCohort) = currentCohort%ddbhdt - this%resp_tstep(countCohort) = currentCohort%resp_tstep - this%pft(countCohort) = currentCohort%pft - this%status_coh(countCohort) = currentCohort%status_coh - if ( currentCohort%isnew ) then - this%isnew(countCohort) = new_cohort - else - this%isnew(countCohort) = old_cohort - endif - - if (this%DEBUG) then - write(iulog,*) 'CLTV offsetNumCohorts II ',countCohort, & - numCohort - endif - - countCohort = countCohort + 1 - - currentCohort => currentCohort%taller - - enddo ! currentCohort do while - - ! - ! deal with patch level fields here - ! - this%livegrass(incrementOffset) = currentPatch%livegrass - this%age(incrementOffset) = currentPatch%age - this%areaRestart(incrementOffset) = currentPatch%area - - ! set cohorts per patch for IO - this%cohortsPerPatch( incrementOffset ) = numCohort - - if (this%DEBUG) then - write(iulog,*) 'offsetNumCohorts III ' & - ,countCohort,cohorts_per_col, numCohort - endif - ! - ! deal with patch level fields of arrays here - ! - ! these are arrays of length numpft_ed, each patch contains one - ! vector so we increment - do i = 1,numpft_ed - this%leaf_litter(countPft) = currentPatch%leaf_litter(i) - this%root_litter(countPft) = currentPatch%root_litter(i) - this%leaf_litter_in(countPft) = currentPatch%leaf_litter_in(i) - this%root_litter_in(countPft) = currentPatch%root_litter_in(i) - countPft = countPft + 1 - end do - - do i = 1,ncwd ! ncwd currently 4 - this%cwd_ag(countNcwd) = currentPatch%cwd_ag(i) - this%cwd_bg(countNcwd) = currentPatch%cwd_bg(i) - countNcwd = countNcwd + 1 - end do - - do i = 1,cp_nclmax ! cp_nclmax currently 2 - this%spread(countNclmax) = currentPatch%spread(i) - countNclmax = countNclmax + 1 - end do - - if (this%DEBUG) write(iulog,*) 'CLTV countSunZ 1 ',countSunZ - - if (this%DEBUG) write(iulog,*) 'CLTV 1186 ',cp_nlevcan,numpft_ed,cp_nclmax - - do k = 1,cp_nlevcan ! cp_nlevcan currently 40 - do j = 1,numpft_ed ! numpft_ed currently 2 - do i = 1,cp_nclmax ! cp_nclmax currently 2 - this%f_sun(countSunZ) = currentPatch%f_sun(i,j,k) - this%fabd_sun_z(countSunZ) = currentPatch%fabd_sun_z(i,j,k) - this%fabi_sun_z(countSunZ) = currentPatch%fabi_sun_z(i,j,k) - this%fabd_sha_z(countSunZ) = currentPatch%fabd_sha_z(i,j,k) - this%fabi_sha_z(countSunZ) = currentPatch%fabi_sha_z(i,j,k) - countSunZ = countSunZ + 1 - end do - end do - end do - - if (this%DEBUG) write(iulog,*) 'CLTV countSunZ 2 ',countSunZ - - incrementOffset = incrementOffset + numCohortsPerPatch - - ! reset counters so that they are all advanced evenly. Currently - ! the offset is 10, the max of numpft_ed, ncwd, cp_nclmax, - ! countWaterMem and the number of allowed cohorts per patch - countPft = incrementOffset - countNcwd = incrementOffset - countNclmax = incrementOffset - countCohort = incrementOffset - countSunZ = incrementOffset - - if (this%DEBUG) then - write(iulog,*) 'CLTV incrementOffset ', incrementOffset - write(iulog,*) 'CLTV cohorts_per_col ', cohorts_per_col - write(iulog,*) 'CLTV numCohort ', numCohort - write(iulog,*) 'CLTV totalCohorts ', totalCohorts - end if - - currentPatch => currentPatch%younger - - enddo ! currentPatch do while - - this%old_stock(c) = sites(s)%old_stock - this%cd_status(c) = sites(s)%status - this%dd_status(c) = sites(s)%dstatus - this%ncd(c) = sites(s)%ncd - this%leafondate(c) = sites(s)%leafondate - this%leafoffdate(c) = sites(s)%leafoffdate - this%dleafondate(c) = sites(s)%dleafondate - this%dleafoffdate(c) = sites(s)%dleafoffdate - this%acc_NI(c) = sites(s)%acc_NI - this%ED_GDD_site(c) = sites(s)%ED_GDD_site - - ! Carbon Balance and Checks - this%nep_timeintegrated_si(c) = sites(s)%nep_timeintegrated - this%npp_timeintegrated_si(c) = sites(s)%npp_timeintegrated - this%hr_timeintegrated_si(c) = sites(s)%hr_timeintegrated - this%totecosys_old_si(c) = sites(s)%totecosysc_old - this%tot_fatesc_old_si(c) = sites(s)%totfatesc_old - this%tot_bgcc_old_si(c) = sites(s)%totbgcc_old - this%cbal_err_fates_si(c) = sites(s)%cbal_err_fates - this%cbal_err_bgc_si(c) = sites(s)%cbal_err_bgc - this%cbal_err_tot_si(c) = sites(s)%cbal_err_tot - this%fates_to_bgc_this_ts_si(c) = sites(s)%fates_to_bgc_this_ts - this%fates_to_bgc_last_ts_si(c) = sites(s)%fates_to_bgc_last_ts - this%seedrain_flux_si(c) = sites(s)%tot_seed_rain_flux - - ! set numpatches for this column - this%numPatchesPerCol(c) = numPatches - - do i = 1,numWaterMem ! numWaterMem currently 10 - this%water_memory( countWaterMem ) = sites(s)%water_memory(i) - countWaterMem = countWaterMem + 1 - end do - - enddo - - if (this%DEBUG) then - write(iulog,*) 'CLTV total cohorts ',totalCohorts - end if - - return - end subroutine convertCohortListToVector - - !-------------------------------------------------------------------------------! - subroutine createPatchCohortStructure( this, bounds, nsites, sites, fcolumn ) - ! - ! !DESCRIPTION: - ! counts the total number of cohorts over all p levels (ed_patch_type) so we - ! can allocate vectors, copy from LL -> vector and read/write restarts. - ! - ! !USES: - use EDPatchDynamicsMod , only : zero_patch - use EDGrowthFunctionsMod, only : Dbh - use EDCohortDynamicsMod, only : create_cohort - use EDInitMod , only : zero_site - use EDParamsMod , only : ED_val_maxspread - use EDPatchDynamicsMod , only : create_patch - use GridcellType , only : grc - use ColumnType , only : col - ! - ! !ARGUMENTS: - class(EDRestartVectorClass) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: nsites - type(ed_site_type) , intent(inout), target :: sites(nsites) - integer , intent(in) :: fcolumn(nsites) - ! - ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: newp - type(ed_cohort_type), allocatable :: temp_cohort - real(r8) :: cwd_ag_local(ncwd),cwd_bg_local(ncwd),spread_local(cp_nclmax) - real(r8) :: leaf_litter_local(numpft_ed),root_litter_local(numpft_ed) - real(r8) :: age !notional age of this patch - integer :: cohortstatus - integer :: s ! site index - integer :: c ! column index - integer :: g ! grid index - integer :: patchIdx,currIdx, fto, ft - !----------------------------------------------------------------------- - - - - cwd_ag_local = 0.0_r8 !ED_val_init_litter !arbitrary value for litter pools. kgC m-2 ! - cwd_bg_local = 0.0_r8 !ED_val_init_litter - leaf_litter_local = 0.0_r8 - root_litter_local = 0.0_r8 - age = 0.0_r8 - spread_local = ED_val_maxspread - - ! - ! loop over model grid cells and create patch/cohort structure based on - ! restart data - ! - do s = 1,nsites - - c = fcolumn(s) - if( (s-1) .ne. (c-bounds%begc) ) then - write(iulog,*) 'NAT COLUMNS REALLY ARENT MONOTONICALLY INCREASING' - write(iulog,*) s,c,bounds%begc,s-1,c-bounds%begc - end if - - g = col%gridcell(c) - - currIdx = bounds%begCohort + (c-bounds%begc)*cohorts_per_col + 1 -! currIdx = (c-1)*cohorts_per_col + 1 ! global cohort index at the head of the column - - call zero_site( sites(s) ) - ! - ! set a few items that are necessary on restart for ED but not on the - ! restart file - ! - - sites(s)%lat = grc%latdeg(g) - sites(s)%lon = grc%londeg(g) - sites(s)%ncd = 0.0_r8 - - if (this%numPatchesPerCol(c)<0 .or. this%numPatchesPerCol(c)>10000) then - write(iulog,*) 'a column was expected to contain a valid number of patches' - write(iulog,*) '0 is a valid number, but this column seems uninitialized',this%numPatchesPerCol(c) - call endrun(msg=errMsg(mod_filename, __LINE__)) - end if - - ! Initialize the site pointers to null - sites(s)%youngest_patch => null() - sites(s)%oldest_patch => null() - - do patchIdx = 1,this%numPatchesPerCol(c) - - if (this%DEBUG) then - write(iulog,*) 'create patch ',patchIdx - write(iulog,*) 'patchIdx 1-numCohorts : ',this%cohortsPerPatch(currIdx) - end if - - ! create patch - allocate(newp) - - ! make new patch - call create_patch(sites(s), newp, age, area, & - spread_local, cwd_ag_local, cwd_bg_local, & - leaf_litter_local, root_litter_local) - - newp%siteptr => sites(s) - - ! give this patch a unique patch number - newp%patchno = patchIdx - - do fto = 1, this%cohortsPerPatch(currIdx) - - allocate(temp_cohort) - - temp_cohort%n = 700.0_r8 - temp_cohort%balive = 0.0_r8 - temp_cohort%bdead = 0.0_r8 - temp_cohort%bstore = 0.0_r8 - temp_cohort%laimemory = 0.0_r8 - temp_cohort%canopy_trim = 0.0_r8 - temp_cohort%canopy_layer = 1.0_r8 - - ! set the pft (only 2 used in ed) based on odd/even cohort - ! number - ft=2 - if ((mod(fto, 2) == 0 )) then - ft=1 - endif - - cohortstatus = newp%siteptr%status - - if(pftcon%stress_decid(ft) == 1)then !drought decidous, override status. - cohortstatus = newp%siteptr%dstatus - endif - - temp_cohort%hite = 1.25_r8 - ! the dbh function should only take as an argument, the one - ! item it needs, not the entire cohort...refactor - temp_cohort%dbh = Dbh(temp_cohort) + 0.0001_r8*ft - - 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, & - temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, newp%NCL_p) - - deallocate(temp_cohort) - - enddo ! ends loop over fto - - ! - ! insert this patch with cohorts into the site pointer. At this - ! point just insert the new patch in the youngest position - ! - if (patchIdx == 1) then ! nothing associated yet. first patch is pointed to by youngest and oldest - - if (this%DEBUG) write(iulog,*) 'patchIdx = 1 ',patchIdx - - sites(s)%youngest_patch => newp - sites(s)%oldest_patch => newp - sites(s)%youngest_patch%younger => null() - sites(s)%youngest_patch%older => null() - sites(s)%oldest_patch%younger => null() - sites(s)%oldest_patch%older => null() - - else if (patchIdx == 2) then ! add second patch to list - - if (this%DEBUG) write(iulog,*) 'patchIdx = 2 ',patchIdx - - sites(s)%youngest_patch => newp - sites(s)%youngest_patch%younger => null() - sites(s)%youngest_patch%older => sites(s)%oldest_patch - sites(s)%oldest_patch%younger => sites(s)%youngest_patch - sites(s)%oldest_patch%older => null() - - else ! more than 2 patches, insert patch into youngest slot - - if (this%DEBUG) write(iulog,*) 'patchIdx > 2 ',patchIdx - - newp%older => sites(s)%youngest_patch - sites(s)%youngest_patch%younger => newp - newp%younger => null() - sites(s)%youngest_patch => newp - - endif - - currIdx = currIdx + numCohortsPerPatch - - enddo ! ends loop over patchIdx - - enddo ! ends loop over s - - end subroutine createPatchCohortStructure - - !-------------------------------------------------------------------------------! - subroutine convertCohortVectorToList( this, bounds, nsites, sites, fcolumn ) - ! - ! !DESCRIPTION: - ! counts the total number of cohorts over all p levels (ed_patch_type) so we - ! can allocate vectors, copy from LL -> vector and read/write restarts. - ! - ! !USES: - ! - ! !ARGUMENTS: - class(EDRestartVectorClass) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: nsites - type(ed_site_type) , intent(inout), target :: sites(nsites) - integer , intent(in) :: fcolumn(nsites) - - ! - ! !LOCAL VARIABLES: - type (ed_patch_type), pointer :: currentPatch - type (ed_cohort_type),pointer :: currentCohort - integer :: c, s - integer :: totalCohorts ! number of cohorts starting from 0 - integer :: countCohort ! number of cohorts starting from - ! vectorLengthStart - integer :: numCohort - integer :: numPatches - integer :: countPft - integer :: countNcwd - integer :: countWaterMem - integer :: countNclmax - integer :: countSunZ - integer :: i,j,k - integer :: incrementOffset - !----------------------------------------------------------------------- - - totalCohorts = 0 - - do s = 1,nsites - - c = fcolumn(s) - - incrementOffset = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - - countCohort = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countPft = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countNcwd = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countNclmax = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countWaterMem = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - countSunZ = bounds%begCohort+(c-bounds%begc)*cohorts_per_col + 1 - - ! read seed_bank info(site-level, but PFT-resolved) - do i = 1,numpft_ed - sites(s)%seed_bank(i) = this%seed_bank(incrementOffset+i-1) - end do - - currentPatch => sites(s)%oldest_patch - - ! new grid cell, reset num patches - numPatches = 0 - - do while(associated(currentPatch)) - - ! found patch, increment - numPatches = numPatches + 1 - - currentCohort => currentPatch%shortest - - ! new patch, reset num cohorts - numCohort = 0 - - do while(associated(currentCohort)) - - ! found cohort, increment - numCohort = numCohort + 1 - totalCohorts = totalCohorts + 1 - - if (this%DEBUG) then - write(iulog,*) 'CVTL countCohort ',countCohort, this%vectorLengthStart, this%vectorLengthStop - endif - - currentCohort%balive = this%balive(countCohort) - currentCohort%bdead = this%bdead(countCohort) - currentCohort%bl = this%bl(countCohort) - currentCohort%br = this%br(countCohort) - currentCohort%bstore = this%bstore(countCohort) - currentCohort%canopy_layer = this%canopy_layer(countCohort) - currentCohort%canopy_trim = this%canopy_trim(countCohort) - currentCohort%dbh = this%dbh(countCohort) - currentCohort%hite = this%hite(countCohort) - currentCohort%laimemory = this%laimemory(countCohort) - currentCohort%leaf_md = this%leaf_md(countCohort) - currentCohort%root_md = this%root_md(countCohort) - currentCohort%n = this%n(countCohort) - currentCohort%gpp_acc = this%gpp_acc(countCohort) - currentCohort%npp_acc = this%npp_acc(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) - currentCohort%npp_bdead = this%npp_bdead(countCohort) - currentCohort%npp_bseed = this%npp_bseed(countCohort) - currentCohort%npp_store = this%npp_store(countCohort) - currentCohort%bmort = this%bmort(countCohort) - currentCohort%hmort = this%hmort(countCohort) - currentCohort%cmort = this%cmort(countCohort) - currentCohort%imort = this%imort(countCohort) - currentCohort%fmort = this%fmort(countCohort) - currentCohort%ddbhdt = this%ddbhdt(countCohort) - currentCohort%resp_tstep = this%resp_tstep(countCohort) - currentCohort%pft = this%pft(countCohort) - currentCohort%status_coh = this%status_coh(countCohort) - currentCohort%isnew = ( this%isnew(countCohort) .eq. new_cohort ) - - if (this%DEBUG) then - write(iulog,*) 'CVTL II ',countCohort, & - numCohort - endif - - countCohort = countCohort + 1 - - currentCohort => currentCohort%taller - - enddo ! current cohort do while - - - ! FIX(SPM,032414) move to init if you can...or make a new init function - currentPatch%leaf_litter(:) = 0.0_r8 - currentPatch%root_litter(:) = 0.0_r8 - currentPatch%leaf_litter_in(:) = 0.0_r8 - currentPatch%root_litter_in(:) = 0.0_r8 - currentPatch%spread(:) = 0.0_r8 - - ! - ! deal with patch level fields here - ! - currentPatch%livegrass = this%livegrass(incrementOffset) - currentPatch%age = this%age(incrementOffset) - currentPatch%area = this%areaRestart(incrementOffset) - - ! set cohorts per patch for IO - - if (this%DEBUG) then - write(iulog,*) 'CVTL III ' & - ,countCohort,cohorts_per_col, numCohort - endif - ! - ! deal with patch level fields of arrays here - ! - ! these are arrays of length numpft_ed, each patch contains one - ! vector so we increment - do i = 1,numpft_ed ! numpft_ed currently 2 - currentPatch%leaf_litter(i) = this%leaf_litter(countPft) - currentPatch%root_litter(i) = this%root_litter(countPft) - currentPatch%leaf_litter_in(i) = this%leaf_litter_in(countPft) - currentPatch%root_litter_in(i) = this%root_litter_in(countPft) - countPft = countPft + 1 - end do - - do i = 1,ncwd ! ncwd currently 4 - currentPatch%cwd_ag(i) = this%cwd_ag(countNcwd) - currentPatch%cwd_bg(i) = this%cwd_bg(countNcwd) - countNcwd = countNcwd + 1 - end do - - do i = 1,cp_nclmax ! cp_nclmax currently 2 - currentPatch%spread(i) = this%spread(countNclmax) - countNclmax = countNclmax + 1 - end do - - if (this%DEBUG) write(iulog,*) 'CVTL countSunZ 1 ',countSunZ - - do k = 1,cp_nlevcan ! cp_nlevcan currently 40 - do j = 1,numpft_ed ! numpft_ed currently 2 - do i = 1,cp_nclmax ! cp_nclmax currently 2 - currentPatch%f_sun(i,j,k) = this%f_sun(countSunZ) - currentPatch%fabd_sun_z(i,j,k) = this%fabd_sun_z(countSunZ) - currentPatch%fabi_sun_z(i,j,k) = this%fabi_sun_z(countSunZ) - currentPatch%fabd_sha_z(i,j,k) = this%fabd_sha_z(countSunZ) - currentPatch%fabi_sha_z(i,j,k) = this%fabi_sha_z(countSunZ) - countSunZ = countSunZ + 1 - end do - end do - end do - - if (this%DEBUG) write(iulog,*) 'CVTL countSunZ 2 ',countSunZ - - incrementOffset = incrementOffset + numCohortsPerPatch - - ! and the number of allowed cohorts per patch (currently 200) - countPft = incrementOffset - countNcwd = incrementOffset - countNclmax = incrementOffset - countCohort = incrementOffset - countSunZ = incrementOffset - - if (this%DEBUG) then - write(iulog,*) 'CVTL incrementOffset ', incrementOffset - write(iulog,*) 'CVTL cohorts_per_col ', cohorts_per_col - write(iulog,*) 'CVTL numCohort ', numCohort - write(iulog,*) 'CVTL totalCohorts ', totalCohorts - end if - - currentPatch => currentPatch%younger - - enddo ! currentPatch do while - - do i = 1,numWaterMem - sites(s)%water_memory(i) = this%water_memory( countWaterMem ) - countWaterMem = countWaterMem + 1 - end do - - sites(s)%old_stock = this%old_stock(c) - sites(s)%status = this%cd_status(c) - sites(s)%dstatus = this%dd_status(c) - sites(s)%ncd = this%ncd(c) - sites(s)%leafondate = this%leafondate(c) - sites(s)%leafoffdate = this%leafoffdate(c) - sites(s)%dleafondate = this%dleafondate(c) - sites(s)%dleafoffdate = this%dleafoffdate(c) - sites(s)%acc_NI = this%acc_NI(c) - sites(s)%ED_GDD_site = this%ED_GDD_site(c) - - ! Carbon Balance and Checks - sites(s)%nep_timeintegrated = this%nep_timeintegrated_si(c) - sites(s)%npp_timeintegrated = this%npp_timeintegrated_si(c) - sites(s)%hr_timeintegrated = this%hr_timeintegrated_si(c) - sites(s)%totecosysc_old = this%totecosys_old_si(c) - sites(s)%totfatesc_old = this%tot_fatesc_old_si(c) - sites(s)%totbgcc_old = this%tot_bgcc_old_si(c) - sites(s)%cbal_err_fates = this%cbal_err_fates_si(c) - sites(s)%cbal_err_bgc = this%cbal_err_bgc_si(c) - sites(s)%cbal_err_tot = this%cbal_err_tot_si(c) - sites(s)%fates_to_bgc_this_ts = this%fates_to_bgc_this_ts_si(c) - sites(s)%fates_to_bgc_last_ts = this%fates_to_bgc_last_ts_si(c) - sites(s)%tot_seed_rain_flux = this%seedrain_flux_si(c) - - enddo - - if (this%DEBUG) then - write(iulog,*) 'CVTL total cohorts ',totalCohorts - end if - - end subroutine convertCohortVectorToList - - !--------------------------------------------! - ! Non Type-Bound Procedures Here: - !--------------------------------------------! - - !-------------------------------------------------------------------------------! - subroutine EDRest ( bounds, nsites, sites, fcolumn, ncid, flag ) - ! - ! !DESCRIPTION: - ! Read/write ED restart data - ! EDRest called from restFileMod.F90 - ! - ! !USES: - - use ncdio_pio , only : file_desc_t - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! bounds - type(file_desc_t) , intent(inout) :: ncid ! netcdf id - integer , intent(in) :: nsites - type(ed_site_type) , intent(inout), target :: sites(nsites) ! The site vector - integer , intent(in) :: fcolumn(nsites) - character(len=*) , intent(in) :: flag !'read' or 'write' - ! - ! !LOCAL VARIABLES: - type(EDRestartVectorClass) :: ervc - - !----------------------------------------------------------------------- - ! - ! Note: ed_allsites_inst already exists and is allocated in clm_instInit - ! - - ervc = newEDRestartVectorClass( bounds ) - - if (ervc%DEBUG) then - write(iulog,*) 'EDRestVectorMod:EDRest flag ',flag - end if - - if ( flag == 'write' ) then - call ervc%setVectors( bounds, nsites, sites, fcolumn ) - endif - - call ervc%doVectorIO( ncid, flag ) - - if ( flag == 'read' ) then - call ervc%getVectors( bounds, nsites, sites, fcolumn ) - endif - - call ervc%deleteEDRestartVectorClass () - - end subroutine EDRest - -end module EDRestVectorMod diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 6de2f1ea2c..3419386adf 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -24,8 +24,8 @@ module EDTypesMod ! for setting number of patches per gridcell and number of cohorts per patch ! for I/O and converting to a vector - integer, parameter :: numPatchesPerCol = 10 ! - integer, parameter :: numCohortsPerPatch = 160 ! + integer, parameter :: maxPatchesPerCol = 10 ! + integer, parameter :: maxCohortsPerPatch = 160 ! integer, parameter :: cohorts_per_col = 1600 ! This is the max number of individual items one can store per ! each grid cell and effects the striding in the ED restart diff --git a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 index faacc7d77a..b2b090b24a 100644 --- a/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesHistoryInterfaceMod.F90 @@ -5,10 +5,9 @@ module FatesHistoryInterfaceMod 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 FatesIODimensionsMod, only : fates_io_dimension_type + use FatesIOVariableKindMod, only : fates_io_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 @@ -135,19 +134,11 @@ module FatesHistoryInterfaceMod 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 :: 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 + integer, parameter :: fates_history_num_dimensions = 4 + integer, parameter :: fates_history_num_dim_kinds = 6 + ! This structure is allocated by thread, and must be calculated after the FATES @@ -169,13 +160,13 @@ module FatesHistoryInterfaceMod ! Instanteat one registry of the different dimension/kinds (dk) ! All output variables will have a pointer to one of these dk's - type(fates_history_variable_kind_type) :: dim_kinds(fates_num_dim_kinds) + type(fates_io_variable_kind_type) :: dim_kinds(fates_history_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. This could be dynamically ! allocated, but is unlikely to change...? - type(fates_history_dimension_type) :: dim_bounds(fates_num_dimension_types) + type(fates_io_dimension_type) :: dim_bounds(fates_history_num_dimensions) type(iovar_map_type), pointer :: iovar_map(:) @@ -183,9 +174,9 @@ module FatesHistoryInterfaceMod contains procedure, public :: Init - procedure, public :: SetThreadBounds + procedure, public :: SetThreadBoundsEach procedure, public :: initialize_history_vars - procedure, public :: assemble_valid_output_types + procedure, public :: assemble_history_output_types procedure, public :: update_history_dyn procedure, public :: update_history_prod @@ -220,7 +211,8 @@ module FatesHistoryInterfaceMod subroutine Init(this, num_threads, fates_bounds) - use FatesHistoryDimensionMod, only : patch, column, levgrnd, levscpf + use FatesIODimensionsMod, only : patch, column, levgrnd, levscpf + use FatesIODimensionsMod, only : fates_bounds_type implicit none @@ -257,7 +249,9 @@ subroutine Init(this, num_threads, fates_bounds) end subroutine Init ! ====================================================================== - subroutine SetThreadBounds(this, thread_index, thread_bounds) + subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) + + use FatesIODimensionsMod, only : fates_bounds_type implicit none @@ -284,13 +278,13 @@ subroutine SetThreadBounds(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%pft_class_begin, thread_bounds%pft_class_end) - end subroutine SetThreadBounds + end subroutine SetThreadBoundsEach ! =================================================================================== - subroutine assemble_valid_output_types(this) + subroutine assemble_history_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 + use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 implicit none @@ -314,13 +308,13 @@ subroutine assemble_valid_output_types(this) 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 + end subroutine assemble_history_output_types ! =================================================================================== subroutine set_dim_indices(this, dk_name, idim, dim_index) - use FatesHistoryVariableKindMod , only : iotype_index + use FatesIOVariableKindMod , only : iotype_index implicit none @@ -334,7 +328,7 @@ subroutine set_dim_indices(this, dk_name, idim, dim_index) ! local integer :: ityp - ityp = iotype_index(trim(dk_name), fates_num_dim_kinds, this%dim_kinds) + ityp = iotype_index(trim(dk_name), fates_history_num_dim_kinds, this%dim_kinds) ! First check to see if the dimension is allocated if (this%dim_kinds(ityp)%ndims < idim) then @@ -479,7 +473,7 @@ subroutine set_history_var(this, vname, units, long, use_default, avgflag, vtype if (initialize) then call this%hvars(ivar)%Init(vname, units, long, use_default, & - vtype, avgflag, flushval, upfreq, fates_num_dim_kinds, this%dim_kinds, & + vtype, avgflag, flushval, upfreq, fates_history_num_dim_kinds, this%dim_kinds, & this%dim_bounds) end if else @@ -504,8 +498,8 @@ subroutine init_dim_kinds_maps(this) ! 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 + use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 implicit none @@ -539,7 +533,7 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_size_pft_r8, 2) - ! FIXME(bja, 2016-10) assert(index == fates_num_dim_kinds) + ! FIXME(bja, 2016-10) assert(index == fates_history_num_dim_kinds) end subroutine init_dim_kinds_maps ! ======================================================================= @@ -548,7 +542,7 @@ subroutine update_history_cbal(this,nc,nsites,sites) use EDtypesMod , only : ed_site_type ! Arguments - class(fates_history_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) @@ -1128,8 +1122,8 @@ subroutine define_history_vars(this, initialize_variables) ! 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 + use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1539,6 +1533,7 @@ subroutine define_history_vars(this, initialize_variables) end subroutine define_history_vars + ! ==================================================================================== ! DEPRECATED, TRANSITIONAL OR FUTURE CODE SECTION ! ==================================================================================== diff --git a/components/clm/src/ED/main/FatesHistoryVariableType.F90 b/components/clm/src/ED/main/FatesHistoryVariableType.F90 index 218950432f..44d6458668 100644 --- a/components/clm/src/ED/main/FatesHistoryVariableType.F90 +++ b/components/clm/src/ED/main/FatesHistoryVariableType.F90 @@ -2,7 +2,7 @@ module FatesHistoryVariableType use FatesConstantsMod, only : r8 => fates_r8 use FatesGlobals, only : fates_log - use FatesHistoryVariableKindMod, only : fates_history_variable_kind_type + use FatesIOVariableKindMod, only : fates_io_variable_kind_type implicit none @@ -41,11 +41,11 @@ module FatesHistoryVariableType 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 FatesIODimensionsMod, only : fates_io_dimension_type - use FatesHistoryVariableKindMod, only : iotype_index + use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIOVariableKindMod, only : iotype_index implicit none @@ -59,8 +59,8 @@ subroutine Init(this, vname, units, long, use_default, & 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(:) + type(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_variable_kind_type), intent(inout) :: dim_kinds(:) integer :: dk_index integer :: lb1, ub1, lb2, ub2 @@ -131,14 +131,14 @@ end subroutine Init subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) - use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesIODimensionsMod, only : fates_io_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(:) + class(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_variable_kind_type), intent(in) :: dim_kinds(:) integer, intent(out) :: lb1 integer, intent(out) :: ub1 integer, intent(out) :: lb2 @@ -178,18 +178,18 @@ subroutine GetBounds(this, thread, dim_bounds, dim_kinds, lb1, ub1, lb2, ub2) end subroutine GetBounds - subroutine Flush(this, thread, dim_bounds, dim_kinds) + 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 + use FatesIODimensionsMod, only : fates_io_dimension_type + use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesIOVariableKindMod, 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(:) + type(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_variable_kind_type), intent(in) :: dim_kinds(:) integer :: lb1, ub1, lb2, ub2 diff --git a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 b/components/clm/src/ED/main/FatesIODimensionsMod.F90 similarity index 75% rename from components/clm/src/ED/main/FatesHistoryDimensionMod.F90 rename to components/clm/src/ED/main/FatesIODimensionsMod.F90 index d980f84093..84c082e75c 100644 --- a/components/clm/src/ED/main/FatesHistoryDimensionMod.F90 +++ b/components/clm/src/ED/main/FatesIODimensionsMod.F90 @@ -1,19 +1,10 @@ -module FatesHistoryDimensionMod +module FatesIODimensionsMod 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 :: cohort = 'cohort' character(*), parameter :: patch = 'patch' character(*), parameter :: column = 'column' character(*), parameter :: levgrnd = 'levgrnd' @@ -34,9 +25,24 @@ module FatesHistoryDimensionMod ! number of size-class x pft dimension + type, public :: fates_bounds_type + integer :: patch_begin + integer :: patch_end + integer :: cohort_begin + integer :: cohort_end + integer :: column_begin ! FATES does not have a "column" type + integer :: column_end ! we call this a "site" (rgk 11-2016) + integer :: ground_begin + integer :: ground_end + integer :: pft_class_begin + integer :: pft_class_end + end type fates_bounds_type + + + ! 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 + type fates_io_dimension_type character(len=fates_short_string_length) :: name integer :: lower_bound integer :: upper_bound @@ -45,7 +51,7 @@ module FatesHistoryDimensionMod contains procedure, public :: Init procedure, public :: SetThreadBounds - end type fates_history_dimension_type + end type fates_io_dimension_type contains @@ -55,7 +61,7 @@ subroutine Init(this, name, num_threads, lower_bound, upper_bound) implicit none ! arguments - class(fates_history_dimension_type), intent(inout) :: this + class(fates_io_dimension_type), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: num_threads integer, intent(in) :: lower_bound @@ -79,7 +85,7 @@ subroutine SetThreadBounds(this, thread_index, lower_bound, upper_bound) implicit none - class(fates_history_dimension_type), intent(inout) :: this + class(fates_io_dimension_type), intent(inout) :: this integer, intent(in) :: thread_index integer, intent(in) :: lower_bound integer, intent(in) :: upper_bound @@ -89,4 +95,4 @@ subroutine SetThreadBounds(this, thread_index, lower_bound, upper_bound) end subroutine SetThreadBounds -end module FatesHistoryDimensionMod +end module FatesIODimensionsMod diff --git a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 similarity index 66% rename from components/clm/src/ED/main/FatesHistoryVarKindMod.F90 rename to components/clm/src/ED/main/FatesIOVariableKindMod.F90 index fd8bd7a871..343d3b4364 100644 --- a/components/clm/src/ED/main/FatesHistoryVarKindMod.F90 +++ b/components/clm/src/ED/main/FatesIOVariableKindMod.F90 @@ -1,18 +1,32 @@ -module FatesHistoryVariableKindMod +module FatesIOVariableKindMod use FatesConstantsMod, only : fates_long_string_length use FatesGlobals, only : fates_log - use FatesHistoryDimensionMod, only : fates_history_dimension_type + use FatesIODimensionsMod, only : fates_io_dimension_type implicit none + ! FIXME(bja, 2016-10) do these need to be strings, or can they be integer enumerations? + ! FIXME(rgk, 2016-11) these should probably be moved to varkindmod? + + 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_int = 'SI_INT' + character(*), parameter :: site_ground_r8 = 'SI_GRND_R8' + character(*), parameter :: site_size_pft_r8 = 'SI_SCPF_R8' + character(*), parameter :: patch_int = 'PA_INT' + character(*), parameter :: cohort_r8 = 'CO_R8' + character(*), parameter :: cohort_int = 'CO_INT' + ! 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 + type fates_io_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 @@ -26,7 +40,7 @@ module FatesHistoryVariableKindMod procedure, public :: set_active procedure, public :: is_active - end type fates_history_variable_kind_type + end type fates_io_variable_kind_type @@ -39,7 +53,7 @@ subroutine Init(this, name, num_dims) implicit none - class(fates_history_variable_kind_type), intent(inout) :: this + class(fates_io_variable_kind_type), intent(inout) :: this character(*), intent(in) :: name integer, intent(in) :: num_dims @@ -56,13 +70,13 @@ end subroutine Init ! ======================================================================= subroutine set_active(this) implicit none - class(fates_history_variable_kind_type), intent(inout) :: this + class(fates_io_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 + class(fates_io_variable_kind_type), intent(in) :: this is_active = this%active_ end function is_active @@ -73,7 +87,7 @@ 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(:) + type(fates_io_variable_kind_type), intent(in) :: dim_kinds(:) ! local integer :: dk_index @@ -88,4 +102,4 @@ function iotype_index(iotype_name, num_dim_kinds, dim_kinds) result(dk_index) end function iotype_index -end module FatesHistoryVariableKindMod +end module FatesIOVariableKindMod diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 356951bcf0..9be0bfa859 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -16,7 +16,7 @@ module FatesInterfaceMod ! ------------------------------------------------------------------------------------ use EDtypesMod , only : ed_site_type, & - numPatchesPerCol, & + maxPatchesPerCol, & cp_nclmax, & cp_numSWb, & cp_numlevgrnd, & @@ -346,8 +346,8 @@ subroutine allocate_bcin(bc_in) ! Allocate input boundaries ! Radiation - allocate(bc_in%solad_parb(numPatchesPerCol,cp_numSWb)) - allocate(bc_in%solai_parb(numPatchesPerCol,cp_numSWb)) + allocate(bc_in%solad_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_in%solai_parb(maxPatchesPerCol,cp_numSWb)) ! Hydrology allocate(bc_in%smp_gl(cp_numlevgrnd)) @@ -357,20 +357,20 @@ subroutine allocate_bcin(bc_in) allocate(bc_in%h2o_liqvol_gl(cp_numlevgrnd)) ! Photosynthesis - allocate(bc_in%filter_photo_pa(numPatchesPerCol)) - allocate(bc_in%dayl_factor_pa(numPatchesPerCol)) - allocate(bc_in%esat_tv_pa(numPatchesPerCol)) - allocate(bc_in%eair_pa(numPatchesPerCol)) - allocate(bc_in%oair_pa(numPatchesPerCol)) - allocate(bc_in%cair_pa(numPatchesPerCol)) - allocate(bc_in%rb_pa(numPatchesPerCol)) - allocate(bc_in%t_veg_pa(numPatchesPerCol)) - allocate(bc_in%tgcm_pa(numPatchesPerCol)) + allocate(bc_in%filter_photo_pa(maxPatchesPerCol)) + allocate(bc_in%dayl_factor_pa(maxPatchesPerCol)) + allocate(bc_in%esat_tv_pa(maxPatchesPerCol)) + allocate(bc_in%eair_pa(maxPatchesPerCol)) + allocate(bc_in%oair_pa(maxPatchesPerCol)) + allocate(bc_in%cair_pa(maxPatchesPerCol)) + allocate(bc_in%rb_pa(maxPatchesPerCol)) + allocate(bc_in%t_veg_pa(maxPatchesPerCol)) + allocate(bc_in%tgcm_pa(maxPatchesPerCol)) allocate(bc_in%t_soisno_gl(cp_numlevgrnd)) ! Canopy Radiation - allocate(bc_in%filter_vegzen_pa(numPatchesPerCol)) - allocate(bc_in%coszen_pa(numPatchesPerCol)) + allocate(bc_in%filter_vegzen_pa(maxPatchesPerCol)) + allocate(bc_in%coszen_pa(maxPatchesPerCol)) allocate(bc_in%albgr_dir_rb(cp_numSWb)) allocate(bc_in%albgr_dif_rb(cp_numSWb)) @@ -394,30 +394,30 @@ subroutine allocate_bcout(bc_out) ! Radiation - allocate(bc_out%fsun_pa(numPatchesPerCol)) - allocate(bc_out%laisun_pa(numPatchesPerCol)) - allocate(bc_out%laisha_pa(numPatchesPerCol)) + allocate(bc_out%fsun_pa(maxPatchesPerCol)) + allocate(bc_out%laisun_pa(maxPatchesPerCol)) + allocate(bc_out%laisha_pa(maxPatchesPerCol)) ! Hydrology allocate(bc_out%active_suction_gl(cp_numlevgrnd)) - allocate(bc_out%rootr_pagl(numPatchesPerCol,cp_numlevgrnd)) - allocate(bc_out%btran_pa(numPatchesPerCol)) + allocate(bc_out%rootr_pagl(maxPatchesPerCol,cp_numlevgrnd)) + allocate(bc_out%btran_pa(maxPatchesPerCol)) ! Photosynthesis - allocate(bc_out%rssun_pa(numPatchesPerCol)) - allocate(bc_out%rssha_pa(numPatchesPerCol)) - allocate(bc_out%gccanopy_pa(numPatchesPerCol)) - allocate(bc_out%lmrcanopy_pa(numPatchesPerCol)) - allocate(bc_out%psncanopy_pa(numPatchesPerCol)) + allocate(bc_out%rssun_pa(maxPatchesPerCol)) + allocate(bc_out%rssha_pa(maxPatchesPerCol)) + allocate(bc_out%gccanopy_pa(maxPatchesPerCol)) + allocate(bc_out%lmrcanopy_pa(maxPatchesPerCol)) + allocate(bc_out%psncanopy_pa(maxPatchesPerCol)) ! Canopy Radiation - allocate(bc_out%albd_parb(numPatchesPerCol,cp_numSWb)) - allocate(bc_out%albi_parb(numPatchesPerCol,cp_numSWb)) - allocate(bc_out%fabd_parb(numPatchesPerCol,cp_numSWb)) - allocate(bc_out%fabi_parb(numPatchesPerCol,cp_numSWb)) - allocate(bc_out%ftdd_parb(numPatchesPerCol,cp_numSWb)) - allocate(bc_out%ftid_parb(numPatchesPerCol,cp_numSWb)) - allocate(bc_out%ftii_parb(numPatchesPerCol,cp_numSWb)) + allocate(bc_out%albd_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_out%albi_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_out%fabd_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_out%fabi_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_out%ftdd_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_out%ftid_parb(maxPatchesPerCol,cp_numSWb)) + allocate(bc_out%ftii_parb(maxPatchesPerCol,cp_numSWb)) ! biogeochemistry allocate(bc_out%FATES_c_to_litr_lab_c_col(cp_numlevdecomp_full)) @@ -425,14 +425,14 @@ subroutine allocate_bcout(bc_out) allocate(bc_out%FATES_c_to_litr_lig_c_col(cp_numlevdecomp_full)) ! Canopy Structure - allocate(bc_out%elai_pa(numPatchesPerCol)) - allocate(bc_out%esai_pa(numPatchesPerCol)) - allocate(bc_out%tlai_pa(numPatchesPerCol)) - allocate(bc_out%tsai_pa(numPatchesPerCol)) - allocate(bc_out%htop_pa(numPatchesPerCol)) - allocate(bc_out%hbot_pa(numPatchesPerCol)) - allocate(bc_out%canopy_fraction_pa(numPatchesPerCol)) - allocate(bc_out%frac_veg_nosno_alb_pa(numPatchesPerCol)) + allocate(bc_out%elai_pa(maxPatchesPerCol)) + allocate(bc_out%esai_pa(maxPatchesPerCol)) + allocate(bc_out%tlai_pa(maxPatchesPerCol)) + allocate(bc_out%tsai_pa(maxPatchesPerCol)) + allocate(bc_out%htop_pa(maxPatchesPerCol)) + allocate(bc_out%hbot_pa(maxPatchesPerCol)) + allocate(bc_out%canopy_fraction_pa(maxPatchesPerCol)) + allocate(bc_out%frac_veg_nosno_alb_pa(maxPatchesPerCol)) return diff --git a/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 new file mode 100644 index 0000000000..18b77bc6cf --- /dev/null +++ b/components/clm/src/ED/main/FatesRestartInterfaceMod.F90 @@ -0,0 +1,1813 @@ +module FatesRestartInterfaceMod + + + use FatesConstantsMod , only : r8 => fates_r8 + use FatesConstantsMod , only : fates_avg_flag_length + use FatesConstantsMod , only : fates_short_string_length + use FatesConstantsMod , only : fates_long_string_length + use FatesGlobals , only : fates_log + + use FatesIODimensionsMod, only : fates_io_dimension_type + use FatesIOVariableKindMod, only : fates_io_variable_kind_type + use FatesRestartVariableMod, only : fates_restart_variable_type + + ! TO BE REMOVED WHEN ERROR HANDLINE IS ADDED (rgk 11-2016) + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + + implicit none + + ! ------------------------------------------------------------ + ! A note on variable naming conventions. + ! Many variables in this restart IO portion of the code will + ! follow the conventions: + ! + ! __ + ! + ! For instance we use an index for restart variable "ir_" + ! to point the object that contains the number of patches per + ! site "npatch" and this value is relevant to all sites "si" + ! thus: ir_npatch_si + ! + ! We also use associations to the data arrays of restart IO + ! variables "rio", for example the leaf litter "leaf_litter" + ! is retrieved for every patch and every functional type "paft" + ! thus: rio_leaf_litter_paft + ! + ! si: site dimension + ! pa: patch dimension + ! co: cohort dimension + ! ft: functional type dimension + ! cl: canopy layer dimension (upper, lower, etc) + ! ls: layer sublayer dimension (fine discretization of upper,lower) + ! wm: the number of memory slots for water (currently 10) + ! ------------------------------------------------------------- + + + ! Indices to the restart variable object + integer, private :: ir_npatch_si + integer, private :: ir_oldstock_si + integer, private :: ir_cd_status_si + integer, private :: ir_dd_status_si + integer, private :: ir_nchill_days_si + integer, private :: ir_leafondate_si + integer, private :: ir_leafoffdate_si + integer, private :: ir_dleafondate_si + integer, private :: ir_dleafoffdate_si + integer, private :: ir_acc_ni_si + integer, private :: ir_gdd_si + integer, private :: ir_nep_timeintegrated_si + integer, private :: ir_npp_timeintegrated_si + integer, private :: ir_hr_timeintegrated_si + integer, private :: ir_cbal_error_fates_si + integer, private :: ir_cbal_error_bgc_si + integer, private :: ir_cbal_error_total_si + integer, private :: ir_totecosysc_old_si + integer, private :: ir_totfatesc_old_si + integer, private :: ir_totbgcc_old_si + integer, private :: ir_fates_to_bgc_this_ts_si + integer, private :: ir_fates_to_bgc_last_ts_si + integer, private :: ir_seedrainflux_si + integer, private :: ir_ncohort_pa + integer, private :: ir_balive_co + integer, private :: ir_bdead_co + integer, private :: ir_bleaf_co + integer, private :: ir_broot_co + integer, private :: ir_bstore_co + integer, private :: ir_canopy_layer_co + integer, private :: ir_canopy_trim_co + integer, private :: ir_dbh_co + integer, private :: ir_height_co + integer, private :: ir_laimemory_co + integer, private :: ir_leaf_md_co + integer, private :: ir_root_md_co + integer, private :: ir_nplant_co + integer, private :: ir_gpp_acc_co + integer, private :: ir_npp_acc_co + integer, private :: ir_gpp_acc_hold_co + integer, private :: ir_npp_acc_hold_co + integer, private :: ir_npp_leaf_co + integer, private :: ir_npp_froot_co + integer, private :: ir_npp_sw_co + integer, private :: ir_npp_dead_co + integer, private :: ir_npp_seed_co + integer, private :: ir_npp_store_co + integer, private :: ir_bmort_co + integer, private :: ir_hmort_co + integer, private :: ir_cmort_co + integer, private :: ir_imort_co + integer, private :: ir_fmort_co + integer, private :: ir_ddbhdt_co + integer, private :: ir_resp_tstep_co + integer, private :: ir_pft_co + integer, private :: ir_status_co + integer, private :: ir_isnew_co + integer, private :: ir_cwd_ag_pacw + integer, private :: ir_cwd_bg_pacw + integer, private :: ir_leaf_litter_paft + integer, private :: ir_root_litter_paft + integer, private :: ir_leaf_litter_in_paft + integer, private :: ir_root_litter_in_paft + integer, private :: ir_seed_bank_sift + integer, private :: ir_spread_pacl + integer, private :: ir_livegrass_pa + integer, private :: ir_age_pa + integer, private :: ir_area_pa + integer, private :: ir_fsun_paclftls + integer, private :: ir_fabd_sun_paclftls + integer, private :: ir_fabi_sun_paclftls + integer, private :: ir_fabd_sha_paclftls + integer, private :: ir_fabi_sha_paclftls + integer, private :: ir_watermem_siwm + + ! The number of variable dim/kind types we have defined (static) + integer, parameter :: fates_restart_num_dimensions = 2 !(cohort,column) + integer, parameter :: fates_restart_num_dim_kinds = 4 !(cohort-int,cohort-r8,site-int,site-r8) + + ! integer constants for storing logical data + integer, parameter :: old_cohort = 0 + integer, parameter :: new_cohort = 1 + + ! Local debug flag + logical, parameter :: DEBUG=.false. + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + + ! This structure is allocated by thread, and must be calculated after the FATES + ! sites are allocated, and their mapping to the HLM is identified. This structure + ! is not combined with iovar_bounds, because that one is multi-instanced. This + ! structure is used more during the update phase, wherease _bounds is used + ! more for things like flushing + type restart_map_type + integer, allocatable :: site_index(:) ! maps site indexes to the HIO site position + integer, allocatable :: cohort1_index(:) ! maps site index to the HIO cohort 1st position + end type restart_map_type + + + + type, public :: fates_restart_interface_type + + type(fates_restart_variable_type),allocatable :: rvars(:) + integer,private :: num_restart_vars_ + + ! Instanteate one registry of the different dimension/kinds (dk) + ! All output variables will have a pointer to one of these dk's + type(fates_io_variable_kind_type) :: dim_kinds(fates_restart_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. This could be dynamically + ! allocated, but is unlikely to change...? + ! Note: history io also instanteates fates_io_dimension_type + type(fates_io_dimension_type) :: dim_bounds(fates_restart_num_dimensions) + + type(restart_map_type), pointer :: restart_map(:) + + integer, private :: cohort_index_, column_index_ + + contains + + procedure, public :: Init + procedure, public :: SetThreadBoundsEach + procedure, public :: assemble_restart_output_types + procedure, public :: initialize_restart_vars + procedure, public :: num_restart_vars + procedure, public :: column_index + procedure, public :: cohort_index + procedure, public :: set_restart_vectors + procedure, public :: create_patchcohort_structure + procedure, public :: get_restart_vectors + ! private work functions + procedure, private :: init_dim_kinds_maps + procedure, private :: set_dim_indices + procedure, private :: set_cohort_index + procedure, private :: set_column_index + procedure, private :: flush_rvars + procedure, private :: define_restart_vars + procedure, private :: set_restart_var + + end type fates_restart_interface_type + + + + +contains + + ! ===================================================================================== + + subroutine Init(this, num_threads, fates_bounds) + + use FatesIODimensionsMod, only : fates_bounds_type, column, cohort + + implicit none + + class(fates_restart_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_cohort_index(dim_count) + call this%dim_bounds(dim_count)%Init(cohort, num_threads, & + fates_bounds%cohort_begin, fates_bounds%cohort_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) + + ! FIXME(bja, 2016-10) assert(dim_count == FatesIOdimensionsmod::num_dimension_types) + + ! Allocate the mapping between FATES indices and the IO indices + allocate(this%restart_map(num_threads)) + + end subroutine Init + + ! ====================================================================== + + subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) + + use FatesIODimensionsMod, only : fates_bounds_type + + implicit none + + class(fates_restart_interface_type), intent(inout) :: this + + integer, intent(in) :: thread_index + type(fates_bounds_type), intent(in) :: thread_bounds + + integer :: index + + index = this%cohort_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%cohort_begin, thread_bounds%cohort_end) + + index = this%column_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%column_begin, thread_bounds%column_end) + + end subroutine SetThreadBoundsEach + + ! =================================================================================== + + subroutine assemble_restart_output_types(this) + + use FatesIOVariableKindMod, only : site_r8, site_int, cohort_r8, cohort_int + + implicit none + + class(fates_restart_interface_type), intent(inout) :: this + + call this%init_dim_kinds_maps() + + call this%set_dim_indices(cohort_r8, 1, this%cohort_index()) + call this%set_dim_indices(cohort_int, 1, this%cohort_index()) + + call this%set_dim_indices(site_r8, 1, this%column_index()) + call this%set_dim_indices(site_int, 1, this%column_index()) + + end subroutine assemble_restart_output_types + + ! =================================================================================== + + subroutine set_dim_indices(this, dk_name, idim, dim_index) + + use FatesIOVariableKindMod , only : iotype_index + + implicit none + + ! arguments + class(fates_restart_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_restart_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_cohort_index(this, index) + implicit none + class(fates_restart_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%cohort_index_ = index + end subroutine set_cohort_index + + integer function cohort_index(this) + implicit none + class(fates_restart_interface_type), intent(in) :: this + cohort_index = this%cohort_index_ + end function cohort_index + + ! ======================================================================= + + subroutine set_column_index(this, index) + implicit none + class(fates_restart_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_restart_interface_type), intent(in) :: this + column_index = this%column_index_ + end function column_index + + ! ======================================================================= + + subroutine init_dim_kinds_maps(this) + + ! ---------------------------------------------------------------------------------- + ! This subroutine simply initializes the structures that define the different + ! array and type formats for different IO variables + ! + ! CO_R8 : 1D cohort scale 8-byte reals + ! SI_R8 : 1D site scale 8-byte reals + ! CO_INT : 1D cohort scale integers + ! SI_INT : 1D site scale integers + ! + ! The allocation on the structures is not dynamic and should only add up to the + ! number of entries listed here. + ! + ! ---------------------------------------------------------------------------------- + use FatesIOVariableKindMod, only : site_r8, site_int, cohort_r8, cohort_int + + implicit none + + ! Arguments + class(fates_restart_interface_type), intent(inout) :: this + + integer :: index + + ! 1d cohort r8 + index = 1 + call this%dim_kinds(index)%Init(cohort_r8, 1) + + ! 1d Site r8 + index = index + 1 + call this%dim_kinds(index)%Init(site_r8, 1) + + ! cohort int + index = index + 1 + call this%dim_kinds(index)%Init(cohort_int, 1) + + ! site int + index = index + 1 + call this%dim_kinds(index)%Init(site_int, 1) + + ! FIXME(bja, 2016-10) assert(index == fates_num_dim_kinds) + end subroutine init_dim_kinds_maps + + + ! ==================================================================================== + + integer function num_restart_vars(this) + + implicit none + + class(fates_restart_interface_type), intent(in) :: this + + num_restart_vars = this%num_restart_vars_ + + end function num_restart_vars + + ! ==================================================================================== + + subroutine initialize_restart_vars(this) + + implicit none + + class(fates_restart_interface_type), intent(inout) :: this + + ! Determine how many of the restart IO variables registered in FATES + ! are going to be allocated + call this%define_restart_vars(initialize_variables=.false.) + + ! Allocate the list of restart output variable objects + allocate(this%rvars(this%num_restart_vars())) + + ! construct the object that defines all of the IO variables + call this%define_restart_vars(initialize_variables=.true.) + + end subroutine initialize_restart_vars + + ! ====================================================================================== + + subroutine flush_rvars(this,nc) + + class(fates_restart_interface_type) :: this + integer,intent(in) :: nc + + integer :: ivar + type(fates_restart_variable_type),pointer :: rvar + integer :: lb1,ub1,lb2,ub2 + + do ivar=1,ubound(this%rvars,1) + associate( rvar => this%rvars(ivar) ) + call rvar%Flush(nc, this%dim_bounds, this%dim_kinds) + end associate + end do + + end subroutine flush_rvars + + + + ! ==================================================================================== + + subroutine define_restart_vars(this, initialize_variables) + + ! --------------------------------------------------------------------------------- + ! + ! REGISTRY OF RESTART OUTPUT VARIABLES + ! + ! Please add any restart variables to this registry. This registry will handle + ! all variables that can make use of 1D column dimensioned or 1D cohort dimensioned + ! variables. Note that restarts are only using 1D vectors in ALM and CLM. If you + ! have a multi-dimensional variable that is below the cohort scale, then pack + ! that variable into a cohort-sized output array by giving it a vtype "cohort_r8" + ! or "cohort_int". + ! + ! Unlike history variables, restarts flush to zero. + ! --------------------------------------------------------------------------------- + + use FatesIOVariableKindMod, only : site_r8, site_int, cohort_int, cohort_r8 + implicit none + + class(fates_restart_interface_type), intent(inout) :: this + logical, intent(in) :: initialize_variables ! are we 'count'ing or 'initializ'ing? + integer :: ivar + real(r8), parameter :: flushinvalid = -9999.0 + real(r8), parameter :: flushzero = 0.0 + real(r8), parameter :: flushone = 1.0 + + + ivar=0 + + ! ----------------------------------------------------------------------------------- + ! Site level variables + ! ----------------------------------------------------------------------------------- + + call this%set_restart_var(vname='fates_PatchesPerSite', vtype=site_int, & + long_name='Total number of FATES patches per column', units='none', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npatch_si ) + + call this%set_restart_var(vname='fates_old_stock', vtype=site_r8, & + long_name='biomass stock in each site (previous step)', units='kgC/site', & + flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_oldstock_si ) + + call this%set_restart_var(vname='fates_cold_dec_status', vtype=site_r8, & + long_name='status flag for cold deciduous plants', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cd_status_si ) + + call this%set_restart_var(vname='fates_drought_dec_status', vtype=site_r8, & + long_name='status flag for drought deciduous plants', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dd_status_si ) + + call this%set_restart_var(vname='fates_chilling_days', vtype=site_r8, & + long_name='chilling day counter', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_nchill_days_si ) + + call this%set_restart_var(vname='fates_leafondate', vtype=site_r8, & + long_name='the day of year for leaf on', units='day of year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafondate_si ) + + call this%set_restart_var(vname='fates_leafoffdate', vtype=site_r8, & + long_name='the day of year for leaf off', units='day of year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leafoffdate_si ) + + call this%set_restart_var(vname='fates_drought_leafondate', vtype=site_r8, & + long_name='the day of year for drought based leaf-on', units='day of year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafondate_si ) + + call this%set_restart_var(vname='fates_drought_leafoffdate', vtype=site_r8, & + long_name='the day of year for drought based leaf-off', units='day of year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dleafoffdate_si ) + + call this%set_restart_var(vname='fates_acc_nesterov_id', vtype=site_r8, & + long_name='a nesterov index accumulator', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_acc_ni_si ) + + call this%set_restart_var(vname='fates_gdd_site', vtype=site_r8, & + long_name='growing degree days at each site', units='degC days', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_gdd_si ) + + call this%set_restart_var(vname='fates_nep_timeintegrated_site', vtype=site_r8, & + long_name='NEP integrated over model time-steps', units='gc/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_nep_timeintegrated_si ) + + call this%set_restart_var(vname='fates_npp_timeintegrated_site', vtype=site_r8, & + long_name='NPP integrated over model time-steps', units='gc/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_timeintegrated_si ) + + call this%set_restart_var(vname='fates_hr_timeintegrated_site', vtype=site_r8, & + long_name='heterotrophic respiration integrated over model time-steps', & + units='gc/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hr_timeintegrated_si ) + + call this%set_restart_var(vname='fates_cbal_err_fatesite', vtype=site_r8, & + long_name='the carbon accounting error for FATES processes', & + units='gC/m2/s', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cbal_error_fates_si ) + + call this%set_restart_var(vname='fates_cbal_err_bgcsite', vtype=site_r8, & + long_name='the carbon accounting error for (fates relevant) BGC processes', & + units='gC/m2/s', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cbal_error_bgc_si ) + + call this%set_restart_var(vname='fates_cbal_err_totsite', vtype=site_r8, & + long_name='the carbon accounting error for fates and bgc processes', & + units='gC/m2/s', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cbal_error_total_si ) + + call this%set_restart_var(vname='fates_totecosysc_old_site', vtype=site_r8, & + long_name='total ecosystem carbon above and below ground (previous time-step)', & + units='gC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_totecosysc_old_si ) + + call this%set_restart_var(vname='fates_totfatesc_old_site', vtype=site_r8, & + long_name='total carbon tracked in FATES, (previous time-step)', & + units='gc/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_totfatesc_old_si ) + + call this%set_restart_var(vname='fates_totbgcc_old_site', vtype=site_r8, & + long_name='total carbon tracked in the BGC module', & + units='gc/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_totbgcc_old_si ) + + call this%set_restart_var(vname='fates_to_bgc_this_edts_col', vtype=site_r8, & + long_name='total flux of carbon from FATES to BGC models on current timestep', & + units='gC/m2/s', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fates_to_bgc_this_ts_si ) + + call this%set_restart_var(vname='fates_to_bgc_last_edts_col', vtype=site_r8, & + long_name='total flux of carbon from FATES to BGC models on previous timestep', & + units='gC/m2/s', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fates_to_bgc_last_ts_si ) + + call this%set_restart_var(vname='fates_seed_rain_flux_site', vtype=site_r8, & + long_name='flux of seeds from exterior', & + units='kgC/m2/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seedrainflux_si ) + + ! ----------------------------------------------------------------------------------- + ! Variables stored within cohort vectors + ! Note: Some of these are multi-dimensional variables in the patch/site dimension + ! that are collapsed into the cohort vectors for storage and transfer + ! ----------------------------------------------------------------------------------- + + ! This variable may be confusing, because it is a patch level variables + ! but it is using the cohort IO vector to hold data + call this%set_restart_var(vname='fates_CohortsPerPatch', vtype=cohort_int, & + long_name='the number of cohorts per patch', units='unitless', flushval = flushinvalid, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ncohort_pa ) + + ! 1D cohort Variables + ! ----------------------------------------------------------------------------------- + + call this%set_restart_var(vname='fates_balive', vtype=cohort_r8, & + long_name='ed cohort alive biomass', units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_balive_co ) + + call this%set_restart_var(vname='fates_bdead', vtype=cohort_r8, & + long_name='ed cohort - dead (structural) biomass in living plants', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bdead_co ) + + call this%set_restart_var(vname='fates_bl', vtype=cohort_r8, & + long_name='ed cohort - leaf biomass', units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bleaf_co ) + + call this%set_restart_var(vname='fates_br', vtype=cohort_r8, & + long_name='ed cohort - fine root biomass', units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_broot_co ) + + call this%set_restart_var(vname='fates_bstore', vtype=cohort_r8, & + long_name='ed cohort - storage biomass', units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bstore_co ) + + call this%set_restart_var(vname='fates_canopy_layer', vtype=cohort_r8, & + long_name='ed cohort - canopy_layer', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_layer_co ) + + call this%set_restart_var(vname='fates_canopy_trim', vtype=cohort_r8, & + long_name='ed cohort - canopy_trim', units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_canopy_trim_co ) + + call this%set_restart_var(vname='fates_dbh', vtype=cohort_r8, & + long_name='ed cohort - diameter at breast height', units='cm', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_dbh_co ) + + call this%set_restart_var(vname='fates_height', vtype=cohort_r8, & + long_name='ed cohort - plant height', units='m', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_height_co ) + + call this%set_restart_var(vname='fates_laimemory', vtype=cohort_r8, & + long_name='ed cohort - target leaf biomass set from prev year', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_laimemory_co ) + + call this%set_restart_var(vname='fates_leaf_maint_dmnd', vtype=cohort_r8, & + long_name='ed cohort - leaf maintenance demand', & + units='kgC/indiv/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaf_md_co ) + + call this%set_restart_var(vname='fates_root_maint_dmnd', vtype=cohort_r8, & + long_name='ed cohort - fine root maintenance demand', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_root_md_co ) + + call this%set_restart_var(vname='fates_nplant', vtype=cohort_r8, & + long_name='ed cohort - number of plants in the cohort', & + units='/patch', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_nplant_co ) + + call this%set_restart_var(vname='fates_gpp_acc', vtype=cohort_r8, & + long_name='ed cohort - accumulated gpp over dynamics step', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_gpp_acc_co ) + + call this%set_restart_var(vname='fates_npp_acc', vtype=cohort_r8, & + long_name='ed cohort - accumulated npp over dynamics step', & + units='kgC/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_acc_co ) + + call this%set_restart_var(vname='fates_gpp_acc_hold', vtype=cohort_r8, & + long_name='ed cohort - current step gpp', & + units='kgC/indiv/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_gpp_acc_hold_co ) + + call this%set_restart_var(vname='fates_npp_acc_hold', vtype=cohort_r8, & + long_name='ed cohort - current step npp', & + units='kgC/indiv/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_acc_hold_co ) + + call this%set_restart_var(vname='fates_npp_leaf', vtype=cohort_r8, & + long_name='ed cohort - npp sent to leaves', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_leaf_co ) + + call this%set_restart_var(vname='fates_npp_froot', vtype=cohort_r8, & + long_name='ed cohort - npp sent to fine roots', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_froot_co ) + + call this%set_restart_var(vname='fates_npp_sapwood', vtype=cohort_r8, & + long_name='ed cohort - npp sent to sapwood', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_sw_co ) + + call this%set_restart_var(vname='fates_npp_bdead', vtype=cohort_r8, & + long_name='ed cohort - npp sent to dead (structure) biomass in live plants', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_dead_co ) + + call this%set_restart_var(vname='fates_npp_seed', vtype=cohort_r8, & + long_name='ed cohort - npp sent to seed biomass', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_seed_co ) + + call this%set_restart_var(vname='fates_npp_store', vtype=cohort_r8, & + long_name='ed cohort - npp sent to storage biomass', & + units='kgC/indiv/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_npp_store_co ) + + call this%set_restart_var(vname='fates_bmort', vtype=cohort_r8, & + long_name='ed cohort - background mortality rate', & + units='/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_bmort_co ) + + call this%set_restart_var(vname='fates_hmort', vtype=cohort_r8, & + long_name='ed cohort - hydraulic mortality rate', & + units='/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hmort_co ) + + call this%set_restart_var(vname='fates_cmort', vtype=cohort_r8, & + long_name='ed cohort - carbon starvation mortality rate', & + units='/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cmort_co ) + + call this%set_restart_var(vname='fates_imort', vtype=cohort_r8, & + long_name='ed cohort - impact mortality rate', & + units='/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_imort_co ) + + call this%set_restart_var(vname='fates_fmort', vtype=cohort_r8, & + long_name='ed cohort - frost mortality rate', & + units='/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fmort_co ) + + call this%set_restart_var(vname='fates_ddbhdt', vtype=cohort_r8, & + long_name='ed cohort - differential: ddbh/dt', & + units='cm/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_ddbhdt_co ) + + call this%set_restart_var(vname='fates_resp_tstep', vtype=cohort_r8, & + long_name='ed cohort - autotrophic respiration over timestep', & + units='kgC/indiv/timestep', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_resp_tstep_co ) + + call this%set_restart_var(vname='fates_pft', vtype=cohort_int, & + long_name='ed cohort - plant functional type', units='index', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_pft_co ) + + call this%set_restart_var(vname='fates_status_coh', vtype=cohort_int, & + long_name='ed cohort - plant phenology status', units='unitless', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_status_co ) + + call this%set_restart_var(vname='fates_isnew', vtype=cohort_int, & + long_name='ed cohort - binary flag specifying if a plant has experienced a full day cycle', & + units='0/1', flushval = flushone, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_isnew_co ) + + + ! Mixed dimension variables using the cohort vector + ! ----------------------------------------------------------------------------------- + + call this%set_restart_var(vname='fates_cwd_ag', vtype=cohort_r8, & + long_name='coarse woody debris above ground (non-respiring), by patch x cw class', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cwd_ag_pacw ) + + call this%set_restart_var(vname='fates_cwd_bg', vtype=cohort_r8, & + long_name='coarse woody debris below ground (non-respiring), by patch x cw class', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cwd_bg_pacw ) + + call this%set_restart_var(vname='fates_leaf_litter', vtype=cohort_r8, & + long_name='leaf litter, by patch x pft (non-respiring)', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaf_litter_paft ) + + call this%set_restart_var(vname='fates_root_litter', vtype=cohort_r8, & + long_name='root litter, by patch x pft (non-respiring)', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_root_litter_paft ) + + call this%set_restart_var(vname='fates_leaf_litter_in', vtype=cohort_r8, & + long_name='leaf litter flux from turnover and mort, by patch x pft', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_leaf_litter_in_paft ) + + call this%set_restart_var(vname='fates_root_litter_in', vtype=cohort_r8, & + long_name='root litter flux from turnover and mort, by patch x pft', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_root_litter_in_paft ) + + call this%set_restart_var(vname='fates_seed_bank', vtype=cohort_r8, & + long_name='seed pool for each functional type, by site x pft', & + units='kgC/m2/year', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seed_bank_sift ) + + call this%set_restart_var(vname='fates_spread', vtype=cohort_r8, & + long_name='dynamic ratio of dbh to canopy area, by patch x canopy-layer', & + units='cm/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_spread_pacl ) + + call this%set_restart_var(vname='fates_livegrass', vtype=cohort_r8, & + long_name='total AGB from grass, by patch', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_livegrass_pa ) + + call this%set_restart_var(vname='fates_age', vtype=cohort_r8, & + long_name='age of the ED patch', units='yr', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_age_pa ) + + call this%set_restart_var(vname='fates_area', vtype=cohort_r8, & + long_name='are of the ED patch', units='m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_area_pa ) + + ! These dimensions are pa "patch" cl "canopy layer" ft "functional type" ls "layer sublevel" + call this%set_restart_var(vname='fates_f_sun', vtype=cohort_r8, & + long_name='fraction of sunlit leaves, by patch x can-layer x pft x sublayer', & + units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fsun_paclftls ) + + call this%set_restart_var(vname='fates_fabd_sun_z', vtype=cohort_r8, & + long_name='sun fraction of direct light absorbed, by patch x can-layer x pft x sublayer', & + units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fabd_sun_paclftls ) + + call this%set_restart_var(vname='fates_fabi_sun_z', vtype=cohort_r8, & + long_name='sun fraction of indirect light absorbed, by patch x can-layer x pft x sublayer', & + units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fabi_sun_paclftls ) + + call this%set_restart_var(vname='fates_fabd_sha_z', vtype=cohort_r8, & + long_name='shade fraction of direct light absorbed, by patch x can-layer x pft x sublayer', & + units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fabd_sha_paclftls ) + + call this%set_restart_var(vname='fates_fabi_sha_z', vtype=cohort_r8, & + long_name='shade fraction of indirect light absorbed, by patch x can-layer x pft x sublayer', & + units='fraction', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fabi_sha_paclftls ) + + ! + ! site x time level vars + ! + + call this%set_restart_var(vname='fates_water_memory', vtype=cohort_r8, & + long_name='last 10 days of volumetric soil water, by site x day-index', & + units='m3/m3', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_watermem_siwm ) + + + ! Must be last thing before return + this%num_restart_vars_ = ivar + + end subroutine define_restart_vars + + + ! ===================================================================================== + + subroutine set_restart_var(this,vname,vtype,long_name,units,flushval, & + hlms,initialize,ivar,index) + + use FatesUtilsMod, only : check_hlm_list + use EDTypesMod, only : cp_hlm_name + + ! arguments + class(fates_restart_interface_type) :: this + character(len=*),intent(in) :: vname + character(len=*),intent(in) :: vtype + character(len=*),intent(in) :: units + real(r8), intent(in) :: flushval + character(len=*),intent(in) :: long_name + character(len=*),intent(in) :: hlms + 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 + + + type(fates_restart_variable_type),pointer :: rvar + integer :: ub1,lb1,ub2,lb2 ! Bounds for allocating the var + integer :: ityp + + logical :: use_var + + use_var = check_hlm_list(trim(hlms), trim(cp_hlm_name)) + + + if( use_var ) then + + ivar = ivar+1 + index = ivar + + if( initialize )then + + call this%rvars(ivar)%Init(vname, units, long_name, vtype, flushval, & + fates_restart_num_dim_kinds, this%dim_kinds, this%dim_bounds) + + end if + else + + index = 0 + end if + + return + end subroutine set_restart_var + + ! ===================================================================================== + + subroutine set_restart_vectors(this,nc,nsites,sites) + + use EDTypesMod, only : cp_nclmax + use EDTypesMod, only : cp_nlevcan + use EDTypesMod, only : maxCohortsPerPatch + use EDTypesMod, only : numpft_ed + use EDTypesMod, only : ed_site_type + use EDTypesMod, only : ed_cohort_type + use EDTypesMod, only : ed_patch_type + use EDTypesMod, only : cohorts_per_col + use EDTypesMod, only : ncwd + use EDTypesMod, only : numWaterMem + + ! Arguments + class(fates_restart_interface_type) :: this + integer , intent(in) :: nc ! clump index + integer , intent(in) :: nsites + type(ed_site_type) , intent(inout), target :: sites(nsites) + + ! Locals + integer :: s ! The local site index + + ! ---------------------------------------------------------------------------------- + ! The following group of integers indicate the positional index (idx) + ! of variables at different scales inside the I/O arrays (io) + ! Keep in mind that many of these variables have a composite dimension + ! at the patch scale. To hold this memory, we borrow the cohort + ! vector. Thus the head of each array points to the first cohort + ! of each patch. "io_idx_co_1st" + ! ---------------------------------------------------------------------------------- + integer :: io_idx_si ! site index + integer :: io_idx_co_1st ! 1st cohort of each patch + integer :: io_idx_co ! cohort index + integer :: io_idx_pa_pft ! each pft within each patch (pa_pft) + integer :: io_idx_pa_cwd ! each cwd class within each patch (pa_cwd) + integer :: io_idx_pa_cl ! each canopy layer class within each patch (pa_cl) + integer :: io_idx_pa_sunz ! index for the combined dimensions for radiation + integer :: io_idx_si_wmem ! each water memory class within each site + + ! Some counters (for checking mostly) + integer :: totalcohorts ! total cohort count on this thread (diagnostic) + integer :: patchespersite ! number of patches per site + integer :: cohortsperpatch ! number of cohorts per patch + + integer :: ft ! functional type index + integer :: k,j,i ! indices to the radiation matrix + + type(fates_restart_variable_type) :: rvar + type(ed_patch_type),pointer :: cpatch + type(ed_cohort_type),pointer :: ccohort + + + associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & + rio_old_stock_si => this%rvars(ir_oldstock_si)%r81d, & + rio_cd_status_si => this%rvars(ir_cd_status_si)%r81d, & + rio_dd_status_si => this%rvars(ir_dd_status_si)%r81d, & + rio_nchill_days_si => this%rvars(ir_nchill_days_si)%r81d, & + rio_leafondate_si => this%rvars(ir_leafondate_si)%r81d, & + rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%r81d, & + rio_dleafondate_si => this%rvars(ir_dleafondate_si)%r81d, & + rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%r81d, & + rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & + rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & + rio_nep_timeintegrated_si => this%rvars(ir_nep_timeintegrated_si)%r81d, & + rio_npp_timeintegrated_si => this%rvars(ir_npp_timeintegrated_si)%r81d, & + rio_hr_timeintegrated_si => this%rvars(ir_hr_timeintegrated_si)%r81d, & + rio_cbal_err_fates_si => this%rvars(ir_cbal_error_fates_si)%r81d, & + rio_cbal_err_bgc_si => this%rvars(ir_cbal_error_bgc_si)%r81d, & + rio_cbal_err_tot_si => this%rvars(ir_cbal_error_total_si)%r81d, & + rio_totecosysc_old_si => this%rvars(ir_totecosysc_old_si)%r81d, & + rio_totfatesc_old_si => this%rvars(ir_totfatesc_old_si)%r81d, & + rio_totbgcc_old_si => this%rvars(ir_totbgcc_old_si)%r81d, & + rio_fates_to_bgc_this_ts_si => this%rvars(ir_fates_to_bgc_this_ts_si)%r81d, & + rio_fates_to_bgc_last_ts_si => this%rvars(ir_fates_to_bgc_last_ts_si)%r81d, & + rio_seedrainflux_si => this%rvars(ir_seedrainflux_si)%r81d, & + rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & + rio_balive_co => this%rvars(ir_balive_co)%r81d, & + rio_bdead_co => this%rvars(ir_bdead_co)%r81d, & + rio_bleaf_co => this%rvars(ir_bleaf_co)%r81d, & + rio_broot_co => this%rvars(ir_broot_co)%r81d, & + rio_bstore_co => this%rvars(ir_bstore_co)%r81d, & + rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%r81d, & + rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & + rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & + rio_height_co => this%rvars(ir_height_co)%r81d, & + rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & + rio_leaf_md_co => this%rvars(ir_leaf_md_co)%r81d, & + rio_root_md_co => this%rvars(ir_root_md_co)%r81d, & + rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & + rio_gpp_acc_co => this%rvars(ir_gpp_acc_co)%r81d, & + rio_npp_acc_co => this%rvars(ir_npp_acc_co)%r81d, & + rio_gpp_acc_hold_co => this%rvars(ir_gpp_acc_hold_co)%r81d, & + rio_npp_acc_hold_co => this%rvars(ir_npp_acc_hold_co)%r81d, & + rio_npp_leaf_co => this%rvars(ir_npp_leaf_co)%r81d, & + rio_npp_froot_co => this%rvars(ir_npp_froot_co)%r81d, & + rio_npp_sw_co => this%rvars(ir_npp_sw_co)%r81d, & + rio_npp_dead_co => this%rvars(ir_npp_dead_co)%r81d, & + rio_npp_seed_co => this%rvars(ir_npp_seed_co)%r81d, & + rio_npp_store_co => this%rvars(ir_npp_store_co)%r81d, & + rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & + rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & + rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & + rio_imort_co => this%rvars(ir_imort_co)%r81d, & + rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & + rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & + rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & + rio_pft_co => this%rvars(ir_pft_co)%int1d, & + rio_status_co => this%rvars(ir_status_co)%int1d, & + rio_isnew_co => this%rvars(ir_isnew_co)%int1d, & + rio_cwd_ag_pacw => this%rvars(ir_cwd_ag_pacw)%r81d, & + rio_cwd_bg_pacw => this%rvars(ir_cwd_bg_pacw)%r81d, & + rio_leaf_litter_paft => this%rvars(ir_leaf_litter_paft)%r81d, & + rio_root_litter_paft => this%rvars(ir_root_litter_paft)%r81d, & + rio_leaf_litter_in_paft => this%rvars(ir_leaf_litter_in_paft)%r81d, & + rio_root_litter_in_paft => this%rvars(ir_root_litter_in_paft)%r81d, & + rio_seed_bank_sift => this%rvars(ir_seed_bank_sift)%r81d, & + rio_spread_pacl => this%rvars(ir_spread_pacl)%r81d, & + rio_livegrass_pa => this%rvars(ir_livegrass_pa)%r81d, & + rio_age_pa => this%rvars(ir_age_pa)%r81d, & + rio_area_pa => this%rvars(ir_area_pa)%r81d, & + rio_fsun_paclftls => this%rvars(ir_fsun_paclftls)%r81d, & + rio_fabd_sun_z_paclftls => this%rvars(ir_fabd_sun_paclftls)%r81d, & + rio_fabi_sun_z_paclftls => this%rvars(ir_fabi_sun_paclftls)%r81d, & + rio_fabd_sha_z_paclftls => this%rvars(ir_fabd_sha_paclftls)%r81d, & + rio_fabi_sha_z_paclftls => this%rvars(ir_fabi_sha_paclftls)%r81d, & + rio_watermem_siwm => this%rvars(ir_watermem_siwm)%r81d ) + + totalCohorts = 0 + + ! --------------------------------------------------------------------------------- + ! Flush arrays to values defined by %flushval (see registry entry in + ! subroutine define_history_vars() + ! --------------------------------------------------------------------------------- + call this%flush_rvars(nc) + + do s = 1,nsites + + ! Calculate the offsets + ! fcolumn is the global column index of the current site. + ! For the first site, if that site aligns with the first column index + ! in the clump, than the offset should be be equal to begCohort + + io_idx_si = this%restart_map(nc)%site_index(s) + io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) + + io_idx_co = io_idx_co_1st + io_idx_pa_pft = io_idx_co_1st + io_idx_pa_cwd = io_idx_co_1st + io_idx_pa_cl = io_idx_co_1st + io_idx_si_wmem = io_idx_co_1st + io_idx_pa_sunz = io_idx_co_1st + + ! write seed_bank info(site-level, but PFT-resolved) + do i = 1,numpft_ed + rio_seed_bank_sift(io_idx_co_1st+i-1) = sites(s)%seed_bank(i) + end do + + cpatch => sites(s)%oldest_patch + + ! new column, reset num patches + patchespersite = 0 + + do while(associated(cpatch)) + + ! found patch, increment + patchespersite = patchespersite + 1 + + ccohort => cpatch%shortest + + ! new patch, reset num cohorts + cohortsperpatch = 0 + + do while(associated(ccohort)) + + ! found cohort, increment + cohortsperpatch = cohortsperpatch + 1 + totalCohorts = totalCohorts + 1 + + if ( DEBUG ) then + write(fates_log(),*) 'CLTV io_idx_co ', io_idx_co + write(fates_log(),*) 'CLTV lowerbound ', lbound(rio_npp_acc_co,1) + write(fates_log(),*) 'CLTV upperbound ', ubound(rio_npp_acc_co,1) + endif + + rio_balive_co(io_idx_co) = ccohort%balive + rio_bdead_co(io_idx_co) = ccohort%bdead + rio_bleaf_co(io_idx_co) = ccohort%bl + rio_broot_co(io_idx_co) = ccohort%br + rio_bstore_co(io_idx_co) = ccohort%bstore + rio_canopy_layer_co(io_idx_co) = ccohort%canopy_layer + rio_canopy_trim_co(io_idx_co) = ccohort%canopy_trim + rio_dbh_co(io_idx_co) = ccohort%dbh + rio_height_co(io_idx_co) = ccohort%hite + rio_laimemory_co(io_idx_co) = ccohort%laimemory + rio_leaf_md_co(io_idx_co) = ccohort%leaf_md + rio_root_md_co(io_idx_co) = ccohort%root_md + rio_nplant_co(io_idx_co) = ccohort%n + rio_gpp_acc_co(io_idx_co) = ccohort%gpp_acc + rio_npp_acc_co(io_idx_co) = ccohort%npp_acc + rio_gpp_acc_hold_co(io_idx_co) = ccohort%gpp_acc_hold + rio_npp_acc_hold_co(io_idx_co) = ccohort%npp_acc_hold + rio_npp_leaf_co(io_idx_co) = ccohort%npp_leaf + rio_npp_froot_co(io_idx_co) = ccohort%npp_froot + rio_npp_sw_co(io_idx_co) = ccohort%npp_bsw + rio_npp_dead_co(io_idx_co) = ccohort%npp_bdead + rio_npp_seed_co(io_idx_co) = ccohort%npp_bseed + rio_npp_store_co(io_idx_co) = ccohort%npp_store + rio_bmort_co(io_idx_co) = ccohort%bmort + rio_hmort_co(io_idx_co) = ccohort%hmort + rio_cmort_co(io_idx_co) = ccohort%cmort + rio_imort_co(io_idx_co) = ccohort%imort + rio_fmort_co(io_idx_co) = ccohort%fmort + rio_ddbhdt_co(io_idx_co) = ccohort%ddbhdt + rio_resp_tstep_co(io_idx_co) = ccohort%resp_tstep + rio_pft_co(io_idx_co) = ccohort%pft + rio_status_co(io_idx_co) = ccohort%status_coh + if ( ccohort%isnew ) then + rio_isnew_co(io_idx_co) = new_cohort + else + rio_isnew_co(io_idx_co) = old_cohort + endif + + if ( DEBUG ) then + write(fates_log(),*) 'CLTV offsetNumCohorts II ',io_idx_co, & + cohortsperpatch + endif + + io_idx_co = io_idx_co + 1 + + ccohort => ccohort%taller + + enddo ! ccohort do while + + ! + ! deal with patch level fields here + ! + rio_livegrass_pa(io_idx_co_1st) = cpatch%livegrass + rio_age_pa(io_idx_co_1st) = cpatch%age + rio_area_pa(io_idx_co_1st) = cpatch%area + + ! set cohorts per patch for IO + rio_ncohort_pa( io_idx_co_1st ) = cohortsperpatch + + if ( DEBUG ) then + write(fates_log(),*) 'offsetNumCohorts III ' & + ,io_idx_co,cohorts_per_col, cohortsperpatch + endif + ! + ! deal with patch level fields of arrays here + ! + ! these are arrays of length numpft_ed, each patch contains one + ! vector so we increment + do i = 1,numpft_ed + rio_leaf_litter_paft(io_idx_pa_pft) = cpatch%leaf_litter(i) + rio_root_litter_paft(io_idx_pa_pft) = cpatch%root_litter(i) + rio_leaf_litter_in_paft(io_idx_pa_pft) = cpatch%leaf_litter_in(i) + rio_root_litter_in_paft(io_idx_pa_pft) = cpatch%root_litter_in(i) + io_idx_pa_pft = io_idx_pa_pft + 1 + end do + + do i = 1,ncwd ! ncwd currently 4 + rio_cwd_ag_pacw(io_idx_pa_cwd) = cpatch%cwd_ag(i) + rio_cwd_bg_pacw(io_idx_pa_cwd) = cpatch%cwd_bg(i) + io_idx_pa_cwd = io_idx_pa_cwd + 1 + end do + + do i = 1,cp_nclmax ! cp_nclmax currently 2 + rio_spread_pacl(io_idx_pa_cl) = cpatch%spread(i) + io_idx_pa_cl = io_idx_pa_cl + 1 + end do + + if ( DEBUG ) write(fates_log(),*) 'CLTV io_idx_pa_sunz 1 ',io_idx_pa_sunz + + if ( DEBUG ) write(fates_log(),*) 'CLTV 1186 ',cp_nlevcan,numpft_ed,cp_nclmax + + do k = 1,cp_nlevcan ! cp_nlevcan currently 40 + do j = 1,numpft_ed ! numpft_ed currently 2 + do i = 1,cp_nclmax ! cp_nclmax currently 2 + rio_fsun_paclftls(io_idx_pa_sunz) = cpatch%f_sun(i,j,k) + rio_fabd_sun_z_paclftls(io_idx_pa_sunz) = cpatch%fabd_sun_z(i,j,k) + rio_fabi_sun_z_paclftls(io_idx_pa_sunz) = cpatch%fabi_sun_z(i,j,k) + rio_fabd_sha_z_paclftls(io_idx_pa_sunz) = cpatch%fabd_sha_z(i,j,k) + rio_fabi_sha_z_paclftls(io_idx_pa_sunz) = cpatch%fabi_sha_z(i,j,k) + io_idx_pa_sunz = io_idx_pa_sunz + 1 + end do + end do + end do + + if ( DEBUG ) write(fates_log(),*) 'CLTV io_idx_pa_sunz 2 ',io_idx_pa_sunz + + + ! Set the first cohort index to the start of the next patch, increment + ! by the maximum number of cohorts per patch + io_idx_co_1st = io_idx_co_1st + maxCohortsPerPatch + + ! reset counters so that they are all advanced evenly. Currently + ! the offset is 10, the max of numpft_ed, ncwd, cp_nclmax, + ! io_idx_si_wmem and the number of allowed cohorts per patch + io_idx_pa_pft = io_idx_co_1st + io_idx_pa_cwd = io_idx_co_1st + io_idx_pa_cl = io_idx_co_1st + io_idx_co = io_idx_co_1st + io_idx_pa_sunz = io_idx_co_1st + + if ( DEBUG ) then + write(fates_log(),*) 'CLTV io_idx_co_1st ', io_idx_co_1st + write(fates_log(),*) 'CLTV cohorts_per_col ', cohorts_per_col + write(fates_log(),*) 'CLTV numCohort ', cohortsperpatch + write(fates_log(),*) 'CLTV totalCohorts ', totalCohorts + end if + + cpatch => cpatch%younger + + enddo ! cpatch do while + + rio_old_stock_si(io_idx_si) = sites(s)%old_stock + rio_cd_status_si(io_idx_si) = sites(s)%status + rio_dd_status_si(io_idx_si) = sites(s)%dstatus + rio_nchill_days_si(io_idx_si) = sites(s)%ncd + rio_leafondate_si(io_idx_si) = sites(s)%leafondate + rio_leafoffdate_si(io_idx_si) = sites(s)%leafoffdate + rio_dleafondate_si(io_idx_si) = sites(s)%dleafondate + rio_dleafoffdate_si(io_idx_si) = sites(s)%dleafoffdate + rio_acc_ni_si(io_idx_si) = sites(s)%acc_NI + rio_gdd_si(io_idx_si) = sites(s)%ED_GDD_site + + ! Carbon Balance and Checks + rio_nep_timeintegrated_si(io_idx_si) = sites(s)%nep_timeintegrated + rio_npp_timeintegrated_si(io_idx_si) = sites(s)%npp_timeintegrated + rio_hr_timeintegrated_si(io_idx_si) = sites(s)%hr_timeintegrated + rio_totecosysc_old_si(io_idx_si) = sites(s)%totecosysc_old + rio_totfatesc_old_si(io_idx_si) = sites(s)%totfatesc_old + rio_totbgcc_old_si(io_idx_si) = sites(s)%totbgcc_old + rio_cbal_err_fates_si(io_idx_si) = sites(s)%cbal_err_fates + rio_cbal_err_bgc_si(io_idx_si) = sites(s)%cbal_err_bgc + rio_cbal_err_tot_si(io_idx_si) = sites(s)%cbal_err_tot + rio_fates_to_bgc_this_ts_si(io_idx_si) = sites(s)%fates_to_bgc_this_ts + rio_fates_to_bgc_last_ts_si(io_idx_si) = sites(s)%fates_to_bgc_last_ts + rio_seedrainflux_si(io_idx_si) = sites(s)%tot_seed_rain_flux + + ! set numpatches for this column + rio_npatch_si(io_idx_si) = patchespersite + + do i = 1,numWaterMem ! numWaterMem currently 10 + rio_watermem_siwm( io_idx_si_wmem ) = sites(s)%water_memory(i) + io_idx_si_wmem = io_idx_si_wmem + 1 + end do + + enddo + + if ( DEBUG ) then + write(fates_log(),*) 'CLTV total cohorts ',totalCohorts + end if + + return + end associate + end subroutine set_restart_vectors + + ! ==================================================================================== + + subroutine create_patchcohort_structure(this, nc, nsites, sites ) + + ! ---------------------------------------------------------------------------------- + ! This subroutine takes a peak at the restart file to determine how to allocate + ! memory for the state structure, and then makes those allocations. This + ! subroutine is called prior to the transfer of the restart vectors into the + ! linked-list state structure. + ! --------------------------------------------------------------------------------- + use EDTypesMod, only : ed_site_type + use EDTypesMod, only : ed_cohort_type + use EDTypesMod, only : ed_patch_type + use EDTypesMod, only : ncwd + use EDTypesMod, only : cp_nlevcan + use EDTypesMod, only : cp_nclmax + use EDTypesMod, only : maxCohortsPerPatch + use EDTypesMod, only : numpft_ed + use EDTypesMod, only : area + use EDPatchDynamicsMod, only : zero_patch + use EDGrowthFunctionsMod, only : Dbh + use EDCohortDynamicsMod, only : create_cohort + use EDInitMod, only : zero_site + use EDParamsMod, only : ED_val_maxspread + use EDPatchDynamicsMod, only : create_patch + use pftconMod, only : pftcon + + ! !ARGUMENTS: + class(fates_restart_interface_type) , intent(inout) :: this + integer , intent(in) :: nc + integer , intent(in) :: nsites + type(ed_site_type) , intent(inout), target :: sites(nsites) + + ! local variables + + type(ed_patch_type) , pointer :: newp + type(ed_cohort_type), allocatable :: temp_cohort + real(r8) :: cwd_ag_local(ncwd) + real(r8) :: cwd_bg_local(ncwd) + real(r8) :: spread_local(cp_nclmax) + real(r8) :: leaf_litter_local(numpft_ed) + real(r8) :: root_litter_local(numpft_ed) + real(r8) :: patch_age + integer :: cohortstatus + integer :: s ! site index + integer :: idx_pa ! local patch index + integer :: io_idx_si ! global site index in IO vector + integer :: io_idx_co_1st ! global cohort index in IO vector + + integer :: fto + integer :: ft + + ! Dummy arguments used for calling create patch, these will be overwritten before + ! run-time. Just used now for allocation. + cwd_ag_local(:) = 0.0_r8 + cwd_bg_local(:) = 0.0_r8 + leaf_litter_local(:) = 0.0_r8 + root_litter_local(:) = 0.0_r8 + spread_local(:) = ED_val_maxspread + patch_age = 0.0_r8 + + ! ---------------------------------------------------------------------------------- + ! We really only need the counts for the number of patches per site + ! and the number of cohorts per patch. These values tell us how much + ! space to allocate. + ! ---------------------------------------------------------------------------------- + + associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d , & + rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d ) + + do s = 1,nsites + + io_idx_si = this%restart_map(nc)%site_index(s) + io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) + + call zero_site( sites(s) ) + + ! + ! set a few items that are necessary on restart for ED but not on the + ! restart file + ! + + sites(s)%ncd = 0.0_r8 + + if ( rio_npatch_si(io_idx_si)<0 .or. rio_npatch_si(io_idx_si) > 10000 ) then + write(fates_log(),*) 'a column was expected to contain a valid number of patches' + write(fates_log(),*) '0 is a valid number, but this column seems uninitialized',rio_npatch_si(io_idx_si) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Initialize the site pointers to null + sites(s)%youngest_patch => null() + sites(s)%oldest_patch => null() + + do idx_pa = 1,rio_npatch_si(io_idx_si) + + if ( DEBUG ) then + write(fates_log(),*) 'create patch ',idx_pa + write(fates_log(),*) 'idx_pa 1-cohortsperpatch : ', rio_ncohort_pa( io_idx_co_1st ) + end if + + ! create patch + allocate(newp) + + ! make new patch + call create_patch(sites(s), newp, patch_age, area, & + spread_local, cwd_ag_local, cwd_bg_local, & + leaf_litter_local, root_litter_local) + + newp%siteptr => sites(s) + + ! give this patch a unique patch number + newp%patchno = idx_pa + + do fto = 1, rio_ncohort_pa( io_idx_co_1st ) + + allocate(temp_cohort) + + temp_cohort%n = 700.0_r8 + temp_cohort%balive = 0.0_r8 + temp_cohort%bdead = 0.0_r8 + temp_cohort%bstore = 0.0_r8 + temp_cohort%laimemory = 0.0_r8 + temp_cohort%canopy_trim = 0.0_r8 + temp_cohort%canopy_layer = 1.0_r8 + + ! set the pft (only 2 used in ed) based on odd/even cohort + ! number + ft=2 + if ((mod(fto, 2) == 0 )) then + ft=1 + endif + + cohortstatus = newp%siteptr%status + + if(pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + cohortstatus = newp%siteptr%dstatus + endif + + temp_cohort%hite = 1.25_r8 + ! the dbh function should only take as an argument, the one + ! item it needs, not the entire cohort...refactor + temp_cohort%dbh = Dbh(temp_cohort) + 0.0001_r8*ft + + if (DEBUG) then + write(fates_log(),*) '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, & + temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, newp%NCL_p) + + deallocate(temp_cohort) + + enddo ! ends loop over fto + + ! + ! insert this patch with cohorts into the site pointer. At this + ! point just insert the new patch in the youngest position + ! + if (idx_pa == 1) then ! nothing associated yet. first patch is pointed to by youngest and oldest + + if ( DEBUG ) write(fates_log(),*) 'idx_pa = 1 ',idx_pa + + sites(s)%youngest_patch => newp + sites(s)%oldest_patch => newp + sites(s)%youngest_patch%younger => null() + sites(s)%youngest_patch%older => null() + sites(s)%oldest_patch%younger => null() + sites(s)%oldest_patch%older => null() + + else if (idx_pa == 2) then ! add second patch to list + + if ( DEBUG ) write(fates_log(),*) 'idx_pa = 2 ',idx_pa + + sites(s)%youngest_patch => newp + sites(s)%youngest_patch%younger => null() + sites(s)%youngest_patch%older => sites(s)%oldest_patch + sites(s)%oldest_patch%younger => sites(s)%youngest_patch + sites(s)%oldest_patch%older => null() + + else ! more than 2 patches, insert patch into youngest slot + + if ( DEBUG ) write(fates_log(),*) 'idx_pa > 2 ',idx_pa + + newp%older => sites(s)%youngest_patch + sites(s)%youngest_patch%younger => newp + newp%younger => null() + sites(s)%youngest_patch => newp + + endif + + io_idx_co_1st = io_idx_co_1st + maxCohortsPerPatch + + enddo ! ends loop over idx_pa + + enddo ! ends loop over s + + end associate + end subroutine create_patchcohort_structure + + ! ==================================================================================== + + subroutine get_restart_vectors(this, nc, nsites, sites) + + use EDTypesMod, only : ed_site_type + use EDTypesMod, only : ed_cohort_type + use EDTypesMod, only : ed_patch_type + use EDTypesMod, only : numpft_ed + use EDTypesMod, only : ncwd + use EDTypesMod, only : cp_nlevcan + use EDTypesMod, only : cp_nclmax + use EDTypesMod, only : maxCohortsPerPatch + use EDTypesMod, only : cohorts_per_col + use EDTypesMod, only : numWaterMem + + ! !ARGUMENTS: + class(fates_restart_interface_type) , intent(inout) :: this + integer , intent(in) :: nc + integer , intent(in) :: nsites + type(ed_site_type) , intent(inout), target :: sites(nsites) + + + ! locals + ! ---------------------------------------------------------------------------------- + ! LL pointers + type(ed_patch_type),pointer :: cpatch ! current patch + type(ed_cohort_type),pointer :: ccohort ! current cohort + + ! loop indices + integer :: s, i, j, k + + ! ---------------------------------------------------------------------------------- + ! The following group of integers indicate the positional index (idx) + ! of variables at different scales inside the I/O arrays (io) + ! Keep in mind that many of these variables have a composite dimension + ! at the patch scale. To hold this memory, we borrow the cohort + ! vector. Thus the head of each array points to the first cohort + ! of each patch. "io_idx_co_1st" + ! ---------------------------------------------------------------------------------- + integer :: io_idx_si ! site index + integer :: io_idx_co_1st ! 1st cohort of each patch + integer :: io_idx_co ! cohort index + integer :: io_idx_pa_pft ! each pft within each patch (pa_pft) + integer :: io_idx_pa_cwd ! each cwd class within each patch (pa_cwd) + integer :: io_idx_pa_cl ! each canopy layer class within each patch (pa_cl) + integer :: io_idx_pa_sunz ! index for the combined dimensions for radiation + integer :: io_idx_si_wmem ! each water memory class within each site + + ! Some counters (for checking mostly) + integer :: totalcohorts ! total cohort count on this thread (diagnostic) + integer :: patchespersite ! number of patches per site + integer :: cohortsperpatch ! number of cohorts per patch + + + + associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & + rio_old_stock_si => this%rvars(ir_oldstock_si)%r81d, & + rio_cd_status_si => this%rvars(ir_cd_status_si)%r81d, & + rio_dd_status_si => this%rvars(ir_dd_status_si)%r81d, & + rio_nchill_days_si => this%rvars(ir_nchill_days_si)%r81d, & + rio_leafondate_si => this%rvars(ir_leafondate_si)%r81d, & + rio_leafoffdate_si => this%rvars(ir_leafoffdate_si)%r81d, & + rio_dleafondate_si => this%rvars(ir_dleafondate_si)%r81d, & + rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%r81d, & + rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & + rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & + rio_nep_timeintegrated_si => this%rvars(ir_nep_timeintegrated_si)%r81d, & + rio_npp_timeintegrated_si => this%rvars(ir_npp_timeintegrated_si)%r81d, & + rio_hr_timeintegrated_si => this%rvars(ir_hr_timeintegrated_si)%r81d, & + rio_cbal_err_fates_si => this%rvars(ir_cbal_error_fates_si)%r81d, & + rio_cbal_err_bgc_si => this%rvars(ir_cbal_error_bgc_si)%r81d, & + rio_cbal_err_tot_si => this%rvars(ir_cbal_error_total_si)%r81d, & + rio_totecosysc_old_si => this%rvars(ir_totecosysc_old_si)%r81d, & + rio_totfatesc_old_si => this%rvars(ir_totfatesc_old_si)%r81d, & + rio_totbgcc_old_si => this%rvars(ir_totbgcc_old_si)%r81d, & + rio_fates_to_bgc_this_ts_si => this%rvars(ir_fates_to_bgc_this_ts_si)%r81d, & + rio_fates_to_bgc_last_ts_si => this%rvars(ir_fates_to_bgc_last_ts_si)%r81d, & + rio_seedrainflux_si => this%rvars(ir_seedrainflux_si)%r81d, & + rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & + rio_balive_co => this%rvars(ir_balive_co)%r81d, & + rio_bdead_co => this%rvars(ir_bdead_co)%r81d, & + rio_bleaf_co => this%rvars(ir_bleaf_co)%r81d, & + rio_broot_co => this%rvars(ir_broot_co)%r81d, & + rio_bstore_co => this%rvars(ir_bstore_co)%r81d, & + rio_canopy_layer_co => this%rvars(ir_canopy_layer_co)%r81d, & + rio_canopy_trim_co => this%rvars(ir_canopy_trim_co)%r81d, & + rio_dbh_co => this%rvars(ir_dbh_co)%r81d, & + rio_height_co => this%rvars(ir_height_co)%r81d, & + rio_laimemory_co => this%rvars(ir_laimemory_co)%r81d, & + rio_leaf_md_co => this%rvars(ir_leaf_md_co)%r81d, & + rio_root_md_co => this%rvars(ir_root_md_co)%r81d, & + rio_nplant_co => this%rvars(ir_nplant_co)%r81d, & + rio_gpp_acc_co => this%rvars(ir_gpp_acc_co)%r81d, & + rio_npp_acc_co => this%rvars(ir_npp_acc_co)%r81d, & + rio_gpp_acc_hold_co => this%rvars(ir_gpp_acc_hold_co)%r81d, & + rio_npp_acc_hold_co => this%rvars(ir_npp_acc_hold_co)%r81d, & + rio_npp_leaf_co => this%rvars(ir_npp_leaf_co)%r81d, & + rio_npp_froot_co => this%rvars(ir_npp_froot_co)%r81d, & + rio_npp_sw_co => this%rvars(ir_npp_sw_co)%r81d, & + rio_npp_dead_co => this%rvars(ir_npp_dead_co)%r81d, & + rio_npp_seed_co => this%rvars(ir_npp_seed_co)%r81d, & + rio_npp_store_co => this%rvars(ir_npp_store_co)%r81d, & + rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & + rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & + rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & + rio_imort_co => this%rvars(ir_imort_co)%r81d, & + rio_fmort_co => this%rvars(ir_fmort_co)%r81d, & + rio_ddbhdt_co => this%rvars(ir_ddbhdt_co)%r81d, & + rio_resp_tstep_co => this%rvars(ir_resp_tstep_co)%r81d, & + rio_pft_co => this%rvars(ir_pft_co)%int1d, & + rio_status_co => this%rvars(ir_status_co)%int1d, & + rio_isnew_co => this%rvars(ir_isnew_co)%int1d, & + rio_cwd_ag_pacw => this%rvars(ir_cwd_ag_pacw)%r81d, & + rio_cwd_bg_pacw => this%rvars(ir_cwd_bg_pacw)%r81d, & + rio_leaf_litter_paft => this%rvars(ir_leaf_litter_paft)%r81d, & + rio_root_litter_paft => this%rvars(ir_root_litter_paft)%r81d, & + rio_leaf_litter_in_paft => this%rvars(ir_leaf_litter_in_paft)%r81d, & + rio_root_litter_in_paft => this%rvars(ir_root_litter_in_paft)%r81d, & + rio_seed_bank_sift => this%rvars(ir_seed_bank_sift)%r81d, & + rio_spread_pacl => this%rvars(ir_spread_pacl)%r81d, & + rio_livegrass_pa => this%rvars(ir_livegrass_pa)%r81d, & + rio_age_pa => this%rvars(ir_age_pa)%r81d, & + rio_area_pa => this%rvars(ir_area_pa)%r81d, & + rio_fsun_paclftls => this%rvars(ir_fsun_paclftls)%r81d, & + rio_fabd_sun_z_paclftls => this%rvars(ir_fabd_sun_paclftls)%r81d, & + rio_fabi_sun_z_paclftls => this%rvars(ir_fabi_sun_paclftls)%r81d, & + rio_fabd_sha_z_paclftls => this%rvars(ir_fabd_sha_paclftls)%r81d, & + rio_fabi_sha_z_paclftls => this%rvars(ir_fabi_sha_paclftls)%r81d, & + rio_watermem_siwm => this%rvars(ir_watermem_siwm)%r81d ) + + totalcohorts = 0 + + do s = 1,nsites + + io_idx_si = this%restart_map(nc)%site_index(s) + io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) + + io_idx_co = io_idx_co_1st + io_idx_pa_pft = io_idx_co_1st + io_idx_pa_cwd = io_idx_co_1st + io_idx_pa_cl = io_idx_co_1st + io_idx_pa_sunz = io_idx_co_1st + io_idx_si_wmem = io_idx_co_1st + + ! read seed_bank info(site-level, but PFT-resolved) + do i = 1,numpft_ed + sites(s)%seed_bank(i) = rio_seed_bank_sift(io_idx_co_1st+i-1) + enddo + + ! Perform a check on the number of patches per site + patchespersite = 0 + + cpatch => sites(s)%oldest_patch + do while(associated(cpatch)) + + patchespersite = patchespersite + 1 + + ccohort => cpatch%shortest + + ! new patch, reset num cohorts + cohortsperpatch = 0 + + do while(associated(ccohort)) + + ! found cohort, increment + cohortsperpatch = cohortsperpatch + 1 + totalcohorts = totalcohorts + 1 + + if ( DEBUG ) then + write(fates_log(),*) 'CVTL io_idx_co ',io_idx_co + endif + + ccohort%balive = rio_balive_co(io_idx_co) + ccohort%bdead = rio_bdead_co(io_idx_co) + ccohort%bl = rio_bleaf_co(io_idx_co) + ccohort%br = rio_broot_co(io_idx_co) + ccohort%bstore = rio_bstore_co(io_idx_co) + ccohort%canopy_layer = rio_canopy_layer_co(io_idx_co) + ccohort%canopy_trim = rio_canopy_trim_co(io_idx_co) + ccohort%dbh = rio_dbh_co(io_idx_co) + ccohort%hite = rio_height_co(io_idx_co) + ccohort%laimemory = rio_laimemory_co(io_idx_co) + ccohort%leaf_md = rio_leaf_md_co(io_idx_co) + ccohort%root_md = rio_root_md_co(io_idx_co) + ccohort%n = rio_nplant_co(io_idx_co) + ccohort%gpp_acc = rio_gpp_acc_co(io_idx_co) + ccohort%npp_acc = rio_npp_acc_co(io_idx_co) + ccohort%gpp_acc_hold = rio_gpp_acc_hold_co(io_idx_co) + ccohort%npp_acc_hold = rio_npp_acc_hold_co(io_idx_co) + ccohort%npp_leaf = rio_npp_leaf_co(io_idx_co) + ccohort%npp_froot = rio_npp_froot_co(io_idx_co) + ccohort%npp_bsw = rio_npp_sw_co(io_idx_co) + ccohort%npp_bdead = rio_npp_dead_co(io_idx_co) + ccohort%npp_bseed = rio_npp_seed_co(io_idx_co) + ccohort%npp_store = rio_npp_store_co(io_idx_co) + ccohort%bmort = rio_bmort_co(io_idx_co) + ccohort%hmort = rio_hmort_co(io_idx_co) + ccohort%cmort = rio_cmort_co(io_idx_co) + ccohort%imort = rio_imort_co(io_idx_co) + ccohort%fmort = rio_fmort_co(io_idx_co) + ccohort%ddbhdt = rio_ddbhdt_co(io_idx_co) + ccohort%resp_tstep = rio_resp_tstep_co(io_idx_co) + ccohort%pft = rio_pft_co(io_idx_co) + ccohort%status_coh = rio_status_co(io_idx_co) + ccohort%isnew = ( rio_isnew_co(io_idx_co) .eq. new_cohort ) + + io_idx_co = io_idx_co + 1 + + ccohort => ccohort%taller + + enddo ! current cohort do while + + if(cohortsperpatch .ne. rio_ncohort_pa(io_idx_co_1st)) then + write(fates_log(),*) 'Number of cohorts per patch during retrieval' + write(fates_log(),*) 'does not match allocation' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + + ! FIX(SPM,032414) move to init if you can...or make a new init function + cpatch%leaf_litter(:) = 0.0_r8 + cpatch%root_litter(:) = 0.0_r8 + cpatch%leaf_litter_in(:) = 0.0_r8 + cpatch%root_litter_in(:) = 0.0_r8 + cpatch%spread(:) = 0.0_r8 + + ! + ! deal with patch level fields here + ! + cpatch%livegrass = rio_livegrass_pa(io_idx_co_1st) + cpatch%age = rio_age_pa(io_idx_co_1st) + cpatch%area = rio_area_pa(io_idx_co_1st) + + ! set cohorts per patch for IO + + if ( DEBUG ) then + write(fates_log(),*) 'CVTL III ' & + ,io_idx_co,cohorts_per_col, cohortsperpatch + endif + ! + ! deal with patch level fields of arrays here + ! + ! these are arrays of length numpft_ed, each patch contains one + ! vector so we increment + + do i = 1,numpft_ed + cpatch%leaf_litter(i) = rio_leaf_litter_paft(io_idx_pa_pft) + cpatch%root_litter(i) = rio_root_litter_paft(io_idx_pa_pft) + cpatch%leaf_litter_in(i) = rio_leaf_litter_in_paft(io_idx_pa_pft) + cpatch%root_litter_in(i) = rio_root_litter_in_paft(io_idx_pa_pft) + io_idx_pa_pft = io_idx_pa_pft + 1 + enddo + + do i = 1,ncwd ! ncwd currently 4 + cpatch%cwd_ag(i) = rio_cwd_ag_pacw(io_idx_pa_cwd) + cpatch%cwd_bg(i) = rio_cwd_bg_pacw(io_idx_pa_cwd) + io_idx_pa_cwd = io_idx_pa_cwd + 1 + enddo + + do i = 1,cp_nclmax ! cp_nclmax currently 2 + cpatch%spread(i) = rio_spread_pacl(io_idx_pa_cl) + io_idx_pa_cl = io_idx_pa_cl + 1 + enddo + + if ( DEBUG ) write(fates_log(),*) 'CVTL io_idx_pa_sunz 1 ',io_idx_pa_sunz + + do k = 1,cp_nlevcan ! cp_nlevcan currently 40 + do j = 1,numpft_ed ! numpft_ed currently 2 + do i = 1,cp_nclmax ! cp_nclmax currently 2 + cpatch%f_sun(i,j,k) = rio_fsun_paclftls(io_idx_pa_sunz) + cpatch%fabd_sun_z(i,j,k) = rio_fabd_sun_z_paclftls(io_idx_pa_sunz) + cpatch%fabi_sun_z(i,j,k) = rio_fabi_sun_z_paclftls(io_idx_pa_sunz) + cpatch%fabd_sha_z(i,j,k) = rio_fabd_sha_z_paclftls(io_idx_pa_sunz) + cpatch%fabi_sha_z(i,j,k) = rio_fabi_sha_z_paclftls(io_idx_pa_sunz) + io_idx_pa_sunz = io_idx_pa_sunz + 1 + end do + end do + end do + + if ( DEBUG ) write(fates_log(),*) 'CVTL io_idx_pa_sunz 2 ',io_idx_pa_sunz + + ! Now increment the position of the first cohort to that of the next + ! patch + + io_idx_co_1st = io_idx_co_1st + maxCohortsPerPatch + + ! and max the number of allowed cohorts per patch + io_idx_pa_pft = io_idx_co_1st + io_idx_pa_cwd = io_idx_co_1st + io_idx_pa_cl = io_idx_co_1st + io_idx_co = io_idx_co_1st + io_idx_pa_sunz = io_idx_co_1st + + if ( DEBUG ) then + write(fates_log(),*) 'CVTL io_idx_co_1st ', io_idx_co_1st + write(fates_log(),*) 'CVTL cohorts_per_col ', cohorts_per_col + write(fates_log(),*) 'CVTL cohortsperpatch ', cohortsperpatch + write(fates_log(),*) 'CVTL totalCohorts ', totalCohorts + end if + + cpatch => cpatch%younger + + enddo ! patch do while + + if(patchespersite .ne. rio_npatch_si(io_idx_si)) then + write(fates_log(),*) 'Number of patches per site during retrieval does not match allocation' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + do i = 1,numWaterMem + sites(s)%water_memory(i) = rio_watermem_siwm( io_idx_si_wmem ) + io_idx_si_wmem = io_idx_si_wmem + 1 + end do + + sites(s)%old_stock = rio_old_stock_si(io_idx_si) + sites(s)%status = rio_cd_status_si(io_idx_si) + sites(s)%dstatus = rio_dd_status_si(io_idx_si) + sites(s)%ncd = rio_nchill_days_si(io_idx_si) + sites(s)%leafondate = rio_leafondate_si(io_idx_si) + sites(s)%leafoffdate = rio_leafoffdate_si(io_idx_si) + sites(s)%dleafondate = rio_dleafondate_si(io_idx_si) + sites(s)%dleafoffdate = rio_dleafoffdate_si(io_idx_si) + sites(s)%acc_NI = rio_acc_ni_si(io_idx_si) + sites(s)%ED_GDD_site = rio_gdd_si(io_idx_si) + + ! Carbon Balance and Checks + sites(s)%nep_timeintegrated = rio_nep_timeintegrated_si(io_idx_si) + sites(s)%npp_timeintegrated = rio_npp_timeintegrated_si(io_idx_si) + sites(s)%hr_timeintegrated = rio_hr_timeintegrated_si(io_idx_si) + sites(s)%totecosysc_old = rio_totecosysc_old_si(io_idx_si) + sites(s)%totfatesc_old = rio_totfatesc_old_si(io_idx_si) + sites(s)%totbgcc_old = rio_totbgcc_old_si(io_idx_si) + sites(s)%cbal_err_fates = rio_cbal_err_fates_si(io_idx_si) + sites(s)%cbal_err_bgc = rio_cbal_err_bgc_si(io_idx_si) + sites(s)%cbal_err_tot = rio_cbal_err_tot_si(io_idx_si) + sites(s)%fates_to_bgc_this_ts = rio_fates_to_bgc_this_ts_si(io_idx_si) + sites(s)%fates_to_bgc_last_ts = rio_fates_to_bgc_last_ts_si(io_idx_si) + sites(s)%tot_seed_rain_flux = rio_seedrainflux_si(io_idx_si) + + end do + + if ( DEBUG ) then + write(fates_log(),*) 'CVTL total cohorts ',totalCohorts + end if + + end associate + end subroutine get_restart_vectors + + end module FatesRestartInterfaceMod diff --git a/components/clm/src/ED/main/FatesRestartVariableType.F90 b/components/clm/src/ED/main/FatesRestartVariableType.F90 new file mode 100644 index 0000000000..40648fb4c6 --- /dev/null +++ b/components/clm/src/ED/main/FatesRestartVariableType.F90 @@ -0,0 +1,203 @@ +module FatesRestartVariableMod + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_log + use FatesIOVariableKindMod, only : fates_io_variable_kind_type + + implicit none + + ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) + + type fates_restart_variable_type + character(len=32) :: vname + character(len=24) :: units + character(len=128) :: long + character(len=24) :: vtype + real(r8) :: flushval ! DONT THINK THIS IS NEEDED IN RESTARTS + ! RESTARTS HAVE A MAPPING TABLE AND + ! THERE IS NO AVERAGING AND NO NEED TO + ! INDICATE NON-INCLUDED ARRAY SPACES + ! KEEPING FOR NOW (RGK-11-2016) + integer :: dim_kinds_index + ! Pointers (only one of these is allocated per variable) + real(r8), pointer :: r81d(:) + integer, pointer :: int1d(:) + contains + procedure, public :: Init + procedure, public :: Flush + procedure, private :: GetBounds + end type fates_restart_variable_type + +contains + + subroutine Init(this, vname, units, long, vtype, flushval, num_dim_kinds, dim_kinds, dim_bounds) + + use FatesIODimensionsMod, only : fates_io_dimension_type + use FatesIOVariableKindMod, only : patch_r8, site_r8, cohort_r8 + use FatesIOVariableKindMod, only : patch_int, site_int, cohort_int + use FatesIOVariableKindMod, only : iotype_index + + implicit none + + class(fates_restart_variable_type), intent(inout) :: this + character(len=*), intent(in) :: vname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: long + character(len=*), intent(in) :: vtype + real(r8), intent(in) :: flushval + integer, intent(in) :: num_dim_kinds + type(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_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%vtype = vtype + this%flushval = flushval + + nullify(this%r81d) + nullify(this%int1d) + + 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(cohort_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(patch_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(site_r8) + allocate(this%r81d(lb1:ub1)) + this%r81d(:) = flushval + + case(cohort_int) + allocate(this%int1d(lb1:ub1)) + this%int1d(:) = idnint(flushval) + + case(patch_int) + allocate(this%int1d(lb1:ub1)) + this%int1d(:) = idnint(flushval) + + case(site_int) + allocate(this%int1d(lb1:ub1)) + this%int1d(:) = idnint(flushval) + + case default + write(fates_log(),*) 'Incompatible vtype passed to set_restart_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 FatesIODimensionsMod, only : fates_io_dimension_type + + implicit none + + class(fates_restart_variable_type), intent(inout) :: this + integer, intent(in) :: thread + class(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_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 FatesIODimensionsMod, only : fates_io_dimension_type + use FatesIOVariableKindMod, only : patch_r8, site_r8, cohort_r8 + use FatesIOVariableKindMod, only : patch_int, site_int, cohort_int + + implicit none + + class(fates_restart_variable_type), intent(inout) :: this + integer, intent(in) :: thread + type(fates_io_dimension_type), intent(in) :: dim_bounds(:) + type(fates_io_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(cohort_r8) + this%r81d(lb1:ub1) = this%flushval + case(patch_int) + this%int1d(lb1:ub1) = nint(this%flushval) + case(site_int) + this%int1d(lb1:ub1) = nint(this%flushval) + case(cohort_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 FatesRestartVariableMod diff --git a/components/clm/src/main/clm_instMod.F90 b/components/clm/src/main/clm_instMod.F90 index 8eace00b41..5c321eec47 100644 --- a/components/clm/src/main/clm_instMod.F90 +++ b/components/clm/src/main/clm_instMod.F90 @@ -444,7 +444,6 @@ subroutine clm_instRest(bounds, ncid, flag) ! ! !USES: use ncdio_pio , only : file_desc_t - use EDRestVectorMod , only : EDRest use UrbanParamsType , only : IsSimpleBuildTemp, IsProgBuildTemp use decompMod , only : get_proc_bounds, get_proc_clumps, get_clump_bounds @@ -535,9 +534,8 @@ subroutine clm_instRest(bounds, ncid, flag) if (use_ed) then - ! Bounds are not passed to FATES init_restart because - ! we call a loop on clumps within this subroutine anyway - call clm_fates%init_restart(ncid,flag, waterstate_inst, canopystate_inst) + call clm_fates%restart(bounds, ncid, flag=flag, & + waterstate_inst=waterstate_inst, canopystate_inst=canopystate_inst ) end if diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 963d013e37..2f1b9797ff 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -22,7 +22,6 @@ module CLMFatesInterfaceMod ! Therefore, the state variables in the clm_fates communicator is vectorized by ! threadcount, and the IO communication arrays are not. ! - ! INTERF-TODO: NEED AN INVALID R8 SETTING FOR FATES ! ! Conventions: ! keep line widths within 90 spaces @@ -57,7 +56,8 @@ module CLMFatesInterfaceMod use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type use SoilBiogeochemCarbonStateType, only : soilbiogeochem_carbonstate_type use clm_time_manager , only : is_restart - use ncdio_pio , only : file_desc_t + use ncdio_pio , only : file_desc_t, ncd_int, ncd_double + use restUtilMod, only : restartvar use clm_time_manager , only : get_days_per_year, & get_curr_date, & get_ref_date, & @@ -83,11 +83,11 @@ module CLMFatesInterfaceMod allocate_bcout use FatesHistoryInterfaceMod, only : fates_history_interface_type + use FatesRestartInterfaceMod, only : fates_restart_interface_type use ChecksBalancesMod , only : SummarizeNetFluxes, FATES_BGC_Carbon_BalanceCheck use EDTypesMod , only : udata use EDTypesMod , only : ed_patch_type - use EDtypesMod , only : numPatchesPerCol use EDtypesMod , only : cp_numlevgrnd use EDMainMod , only : ed_ecosystem_dynamics use EDMainMod , only : ed_update_site @@ -96,7 +96,6 @@ module CLMFatesInterfaceMod use EDInitMod , only : set_site_properties use EDPftVarcon , only : EDpftvarcon_inst use EDEcophysConType , only : EDecophysconInit - use EDRestVectorMod , only : EDRest use EDSurfaceRadiationMod , only : ED_SunShadeFracs, ED_Norman_Radiation use EDBtranMod , only : btran_ed, & get_active_suction_layers @@ -138,15 +137,18 @@ module CLMFatesInterfaceMod type(f2hmap_type), allocatable :: f2hmap(:) - ! fates_hio is the interface class for the history output + ! fates_hist is the interface class for the history output type(fates_history_interface_type) :: fates_hist + ! fates_restart is the inteface calss for restarting the model + type(fates_restart_interface_type) :: fates_restart + contains procedure, public :: init procedure, public :: init_allocate procedure, public :: check_hlm_active - procedure, public :: init_restart + procedure, public :: restart procedure, public :: init_coldstart procedure, public :: dynamics_driv procedure, public :: wrap_sunfrac @@ -189,8 +191,9 @@ subroutine init(this, bounds_proc, use_ed) ! Note: CLM/ALM currently wants sites to be allocated even if ed ! is not turned on ! --------------------------------------------------------------------------------- - + use FatesInterfaceMod, only : FatesInterfaceInit + implicit none @@ -271,6 +274,7 @@ subroutine init_allocate(this) integer :: s ! FATES site index integer :: c ! HLM column index integer :: l ! HLM LU index + integer :: g ! HLM grid index integer, allocatable :: collist (:) type(bounds_type) :: bounds_clump type(bounds_type) :: bounds_proc @@ -282,7 +286,7 @@ subroutine init_allocate(this) nclumps = get_proc_clumps() - !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,nmaxcol,s,c,l,collist) + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,nmaxcol,s,c,l,g,collist) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) @@ -349,13 +353,20 @@ subroutine init_allocate(this) ! Allocate and Initialize the Boundary Condition Arrays ! These are staticaly allocated at maximums, so - ! No information about the patch or cohort - ! structure is needed at this step + ! No information about the patch or cohort structure is needed at this step do s = 1, this%fates(nc)%nsites call allocate_bcin(this%fates(nc)%bc_in(s)) call allocate_bcout(this%fates(nc)%bc_out(s)) call this%fates(nc)%zero_bcs(s) + + ! Pass any grid-cell derived attributes to the site + ! --------------------------------------------------------------------------- + c = this%f2hmap(nc)%fcolumn(s) + g = col%gridcell(c) + this%fates(nc)%sites(s)%lat = grc%latdeg(g) + this%fates(nc)%sites(s)%lon = grc%londeg(g) + end do ! Initialize site-level static quantities dictated by the HLM @@ -634,63 +645,261 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & end associate end subroutine wrap_update_hlmfates_dyn - ! ------------------------------------------------------------------------------------ + ! ==================================================================================== + + subroutine restart( this, bounds_proc, ncid, flag, waterstate_inst, canopystate_inst ) + + ! --------------------------------------------------------------------------------- + ! The ability to restart the model is handled through three different types of calls + ! "Define" the variables in the restart file, we "read" those variables into memory + ! or "write" data into the file from memory. This subroutine accomodates all three + ! of those modes through the "flag" argument. FATES as an external model also + ! requires an initialization step, where we set-up the dimensions, allocate and + ! flush the memory space that is used to transfer data in and out of the file. This + ! Only occurs once, where as the define step occurs every time a file is opened. + ! + ! Note: waterstate_inst and canopystate_inst are arguments only because following + ! the reading of variables, it is necessary to update diagnostics of the canopy + ! throug the interface call clm_fates%wrap_update_hlmfates_dyn() which requires + ! this information from the HLM. + ! --------------------------------------------------------------------------------- + - subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) + use FatesConstantsMod, only : fates_long_string_length + use FatesIODimensionsMod, only: fates_bounds_type + use FatesIOVariableKindMod, only : site_r8, site_int, cohort_r8, cohort_int + use EDMainMod, only : ed_update_site + use EDTypesMod, only: cohorts_per_col ! EDtypes should be protected + ! this variable should be transferred + ! to a location where we keep + ! variables that are co-dictated by + ! FATES and the HLM implicit none ! Arguments + class(hlm_fates_interface_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds_proc type(file_desc_t) , intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag !'read' or 'write' + character(len=*) , intent(in) :: flag type(waterstate_type) , intent(inout) :: waterstate_inst type(canopystate_type) , intent(inout) :: canopystate_inst - + ! Locals type(bounds_type) :: bounds_clump integer :: nc integer :: nclumps + type(fates_bounds_type) :: fates_bounds + type(fates_bounds_type) :: fates_clump + integer :: c ! HLM column index + integer :: s ! Fates site index + integer :: dk_index + character(len=fates_long_string_length) :: ioname + integer :: nvar + integer :: ivar + logical :: readvar + + logical, save :: initialized = .false. nclumps = get_proc_clumps() - !$OMP PARALLEL DO PRIVATE (nc,bounds_clump) - do nc = 1, nclumps - if (this%fates(nc)%nsites>0) then + + ! --------------------------------------------------------------------------------- + ! note (rgk: 11-2016) The history and restart intialization process assumes + ! that the number of site/columns active is a static entity. Thus + ! we only allocate the mapping tables for the column/sites we start with. + ! If/when we start having dynamic column/sites (for reasons uknown as of yet) + ! we will need to re-evaluate the allocation of the mapping tables so they + ! can be unallocated,reallocated and set every time a new column/site is spawned + ! --------------------------------------------------------------------------------- + + ! --------------------------------------------------------------------------------- + ! Only initialize the FATES restart structures the first time it is called + ! Note that the allocations involved with initialization are static. + ! This is because the array spaces for IO span the entire column, patch and cohort + ! range on the proc. + ! With DYNAMIC LANDUNITS or SPAWNING NEW OR CULLING OLD SITES: + ! we will in that case have to de-allocate, reallocate and then re-set the mapping + ! tables: this%fates_restart%restart_map(nc) + ! I think that is it... + ! --------------------------------------------------------------------------------- + + if(.not.initialized) then + + initialized=.true. + + ! ------------------------------------------------------------------------------ + ! PART I: Set FATES DIMENSIONING INFORMATION + ! ------------------------------------------------------------------------------ + + call hlm_bounds_to_fates_bounds(bounds_proc, fates_bounds) + + call this%fates_restart%Init(nclumps, fates_bounds) + + ! Define the bounds on the first dimension for each thread + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump) + do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) - ! ------------------------------------------------------------------------ - ! Main call to read in FATES restart data and unroll it into linked lists - ! ------------------------------------------------------------------------ - call EDRest( bounds_clump, & - this%fates(nc)%nsites, & - this%fates(nc)%sites, & - this%f2hmap(nc)%fcolumn, ncid, flag ) + ! thread bounds for patch + call hlm_bounds_to_fates_bounds(bounds_clump, fates_clump) + call this%fates_restart%SetThreadBoundsEach(nc, fates_clump) + end do + !$OMP END PARALLEL DO + + !$OMP PARALLEL DO PRIVATE (nc,s,c) + do nc = 1,nclumps + + allocate(this%fates_restart%restart_map(nc)%site_index(this%fates(nc)%nsites)) + allocate(this%fates_restart%restart_map(nc)%cohort1_index(this%fates(nc)%nsites)) + do s=1,this%fates(nc)%nsites + c = this%f2hmap(nc)%fcolumn(s) + this%fates_restart%restart_map(nc)%site_index(s) = c + this%fates_restart%restart_map(nc)%cohort1_index(s) = & + bounds_proc%begCohort + (c-bounds_proc%begc)*cohorts_per_col + 1 + end do - if ( trim(flag) == 'read' ) then + end do + !$OMP END PARALLEL DO + + ! ------------------------------------------------------------------------------------ + ! 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_restart%assemble_restart_output_types() + + + ! ------------------------------------------------------------------------------------ + ! PART III: DEFINE THE LIST OF OUTPUT VARIABLE OBJECTS, AND REGISTER THEM WITH THE + ! HLM ACCORDING TO THEIR TYPES + ! ------------------------------------------------------------------------------------ + call this%fates_restart%initialize_restart_vars() + + end if + + ! --------------------------------------------------------------------------------- + ! If we are writing, we must loop through our linked list structures and transfer the + ! information in the linked lists (FATES state memory) to the output vectors. + ! --------------------------------------------------------------------------------- + + if(flag=='write')then + !$OMP PARALLEL DO PRIVATE (nc) + do nc = 1, nclumps + if (this%fates(nc)%nsites>0) then + call this%fates_restart%set_restart_vectors(nc,this%fates(nc)%nsites, & + this%fates(nc)%sites) + end if + end do + !$OMP END PARALLEL DO + end if + + ! --------------------------------------------------------------------------------- + ! In all cases, iterate through the list of variable objects + ! and either define, write or read to the NC buffer + ! This seems strange, but keep in mind that the call to restartvar() + ! has a different function in all three cases. + ! --------------------------------------------------------------------------------- + + nvar = this%fates_restart%num_restart_vars() + do ivar = 1, nvar + + associate( vname => this%fates_restart%rvars(ivar)%vname, & + vunits => this%fates_restart%rvars(ivar)%units, & + vlong => this%fates_restart%rvars(ivar)%long ) + + dk_index = this%fates_restart%rvars(ivar)%dim_kinds_index + ioname = trim(this%fates_restart%dim_kinds(dk_index)%name) + + select case(trim(ioname)) + case(cohort_r8) + + call restartvar(ncid=ncid, flag=flag, varname=trim(vname), & + xtype=ncd_double,dim1name=trim('cohort'),long_name=trim(vlong), & + units=trim(vunits),interpinic_flag='interp', & + data=this%fates_restart%rvars(ivar)%r81d,readvar=readvar) + + case(site_r8) + + call restartvar(ncid=ncid, flag=flag, varname=trim(vname), & + xtype=ncd_double,dim1name=trim('column'),long_name=trim(vlong), & + units=trim(vunits),interpinic_flag='interp', & + data=this%fates_restart%rvars(ivar)%r81d,readvar=readvar) + + case(cohort_int) + + call restartvar(ncid=ncid, flag=flag, varname=trim(vname), & + xtype=ncd_int,dim1name=trim('cohort'),long_name=trim(vlong), & + units=trim(vunits),interpinic_flag='interp', & + data=this%fates_restart%rvars(ivar)%int1d,readvar=readvar) + + case(site_int) + + call restartvar(ncid=ncid, flag=flag, varname=trim(vname), & + xtype=ncd_int,dim1name=trim('column'),long_name=trim(vlong), & + units=trim(vunits),interpinic_flag='interp', & + data=this%fates_restart%rvars(ivar)%int1d,readvar=readvar) + + case default + write(iulog,*) 'A FATES iotype was created that was not registerred' + write(iulog,*) 'in CLM.:',trim(ioname) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select + + end associate + end do + + ! --------------------------------------------------------------------------------- + ! If we are in a read mode, then we have just populated the sparse vectors + ! in the IO object list. The data in these vectors needs to be transferred + ! to the linked lists to populate the state memory. + ! --------------------------------------------------------------------------------- + + if(flag=='read')then + + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,s) + do nc = 1, nclumps + if (this%fates(nc)%nsites>0) then + + call get_clump_bounds(nc, bounds_clump) + + ! ------------------------------------------------------------------------ + ! Convert newly read-in vectors into the FATES namelist state variables + ! ------------------------------------------------------------------------ + call this%fates_restart%create_patchcohort_structure(nc, & + this%fates(nc)%nsites, this%fates(nc)%sites) + + call this%fates_restart%get_restart_vectors(nc, this%fates(nc)%nsites, & + this%fates(nc)%sites ) + + ! I think ed_update_site and update_hlmfates_dyn are doing some similar + ! update type stuff, should consolidate (rgk 11-2016) + do s = 1,this%fates(nc)%nsites + call ed_update_site( this%fates(nc)%sites(s) ) + end do ! ------------------------------------------------------------------------ ! Update diagnostics of FATES ecosystem structure used in HLM. ! ------------------------------------------------------------------------ call this%wrap_update_hlmfates_dyn(nc,bounds_clump, & - waterstate_inst,canopystate_inst) - + waterstate_inst,canopystate_inst) + ! ------------------------------------------------------------------------ ! Update history IO fields that depend on ecosystem dynamics ! ------------------------------------------------------------------------ call this%fates_hist%update_history_dyn( nc, & - this%fates(nc)%nsites, & - this%fates(nc)%sites) - + this%fates(nc)%nsites, & + this%fates(nc)%sites) end if - end if - - end do - !$OMP END PARALLEL DO - - end subroutine init_restart + end do + !$OMP END PARALLEL DO + + end if + + return + end subroutine restart - ! ==================================================================================== + !===================================================================================== subroutine init_coldstart(this, waterstate_inst, canopystate_inst) @@ -720,10 +929,6 @@ subroutine init_coldstart(this, waterstate_inst, canopystate_inst) do s = 1,this%fates(nc)%nsites call zero_site(this%fates(nc)%sites(s)) - c = this%f2hmap(nc)%fcolumn(s) - g = col%gridcell(c) - this%fates(nc)%sites(s)%lat = grc%latdeg(g) - this%fates(nc)%sites(s)%lon = grc%londeg(g) end do call set_site_properties(this%fates(nc)%nsites, this%fates(nc)%sites) @@ -1060,7 +1265,7 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & use quadraticMod , only : quadratic 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 + use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed use EDEcophysContype , only : EDecophyscon ! @@ -1402,9 +1607,9 @@ subroutine init_history_io(this,bounds_proc) use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp 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 + use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 + use FatesIOVariableKindMod, only : site_r8, site_ground_r8, site_size_pft_r8 + use FatesIODimensionsMod, only : fates_bounds_type ! Arguments @@ -1459,30 +1664,24 @@ subroutine init_history_io(this,bounds_proc) 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,fates_clump,s,c) + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump,fates_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) ! thread bounds for patch call hlm_bounds_to_fates_bounds(bounds_clump, fates_clump) - call this%fates_hist%SetThreadBounds(nc, fates_clump) + call this%fates_hist%SetThreadBoundsEach(nc, fates_clump) end do !$OMP END PARALLEL DO ! ------------------------------------------------------------------------------------ ! PART I.5: SET SOME INDEX MAPPINGS SPECIFICALLY FOR SITE<->COLUMN AND PATCH ! ------------------------------------------------------------------------------------ - - ! 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) + !$OMP PARALLEL DO PRIVATE (nc,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)) @@ -1499,7 +1698,7 @@ 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_hist%assemble_valid_output_types() + call this%fates_hist%assemble_history_output_types() ! ------------------------------------------------------------------------------------ ! PART III: DEFINE THE LIST OF OUTPUT VARIABLE OBJECTS, AND REGISTER THEM WITH THE @@ -1584,7 +1783,7 @@ end subroutine init_history_io subroutine hlm_bounds_to_fates_bounds(hlm, fates) - use FatesHistoryInterfaceMod, only : fates_bounds_type + use FatesIODimensionsMod, only : fates_bounds_type use EDtypesMod, only : nlevsclass_ed use clm_varpar, only : mxpft, nlevgrnd @@ -1592,6 +1791,9 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) type(bounds_type), intent(in) :: hlm type(fates_bounds_type), intent(out) :: fates + + fates%cohort_begin = hlm%begcohort + fates%cohort_end = hlm%endcohort fates%patch_begin = hlm%begp fates%patch_end = hlm%endp