From d4997ff1a948e2f07f4412f50a556fc4565e2902 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 23 May 2016 18:01:54 -0700 Subject: [PATCH 01/23] partial progress (early) on columnizing sites --- .../clm/src/ED/main/FatesInterfaceMod.F90 | 73 +++++++++++----- .../clm/src/utils/clmfates_interfaceMod.F90 | 87 ++++++++++++++++--- 2 files changed, 126 insertions(+), 34 deletions(-) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index a55585613e..450f86231d 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -33,6 +33,9 @@ module FatesInterfaceMod ! ie the root of the linked lists. Each path list is currently associated ! with a grid-cell, this is intended to be migrated to columns ! prev: type(ed_site_type)::ed_allsites_inst + + integer :: nsites + type(ed_site_type), allocatable :: sites(:) ! INTERF-TODO ADD THE DLM->FATES BOUNDARY CONDITION CLASS @@ -52,25 +55,24 @@ module FatesInterfaceMod contains - subroutine init(this,bounds_clump) - - implicit none - - ! Input Arguments - class(fates_interface_type), intent(inout) :: this - - ! INTERF-TODO: AS THE FATES PUBLIC API- BOUNDS CLUMP WILL NOT BE ALLOWED - ! IN HERE FOR MUCH LONGER. - type(bounds_type),intent(in) :: bounds_clump - - - ! Initialize the mapping elements between FATES and the DLM - - ! These bounds are for a single clump (thread) - allocate (this%sites(bounds_clump%begg:bounds_clump%endg)) - - return - end subroutine init +! subroutine init(this,bounds_clump) +! +! implicit none +! +! ! Input Arguments +! class(fates_interface_type), intent(inout) :: this +! +! ! INTERF-TODO: AS THE FATES PUBLIC API- BOUNDS CLUMP WILL NOT BE ALLOWED +! ! IN HERE FOR MUCH LONGER. +! type(bounds_type),intent(in) :: bounds_clump +! +! ! Initialize the mapping elements between FATES and the DLM +! +! ! These bounds are for a single clump (thread) +! allocate (this%sites(this%nsites)) +! +! return +! end subroutine init ! ------------------------------------------------------------------------------------ @@ -93,18 +95,45 @@ end subroutine fates_clean ! ------------------------------------------------------------------------------------ - subroutine site_init(this,bounds_clump) + subroutine site_init(this,fcolumn,bounds_clump) ! Input Arguments class(fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_clump ! locals + integer :: s + integer :: c integer :: g ! Initialize (INTERF-TODO THIS ROUTINE CALLS CLM STUFF-MIGRATE CODE TO HERE) - call ed_init_sites( bounds_clump, & - this%sites(bounds_clump%begg:bounds_clump%endg) ) +! call ed_init_sites( bounds_clump, & +! this%sites(bounds_clump%begg:bounds_clump%endg) ) + + do s = 1:this%nsites + + call zero_site(this%sites(s)) + + c = fcolumn(s) + g = gridcell(c) + + this%sites(s)%lat = grc%latdeg(g) + this%sites(s)%lon = grc%londeg(g) + + end do + + do g = bounds%begg,bounds%endg + ! zero the site + call zero_site(ed_allsites_inst(g)) + + !create clm mapping to ED structure + ed_allsites_inst(g)%clmgcell = g + ed_allsites_inst(g)%lat = grc%latdeg(g) + ed_allsites_inst(g)%lon = grc%londeg(g) + enddo + + + ! INTERF-TODO: WHEN WE MOVE TO COLUMNS, THIS WILL BE UNNECESSARY do g = bounds_clump%begg,bounds_clump%endg diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 9c41bac3cb..e5334c5132 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -50,6 +50,9 @@ module CLMFatesInterfaceMod use clm_time_manager , only : get_ref_date, timemgr_datediff use spmdMod , only : masterproc use decompMod , only : get_proc_bounds, get_proc_clumps, get_clump_bounds + use ColumnType , only : col + use LandunitType , only : lun + use landunit_varcon , only : istsoil ! Used FATES Modules use FatesInterfaceMod , only : fates_interface_type @@ -62,6 +65,18 @@ module CLMFatesInterfaceMod use EDEcophysConType , only : EDecophysconInit implicit none + type, private :: f2hmap_type + + ! This is the associated column index of each FATES site + integer, allocatable :: fcolumn (:) + + ! This is the associated site index of any HLM columns + ! This vector may be sparse, and non-sites have index 0 + integer, allocatable :: hsites (:) + + end type f2hmap_type + + type, public :: hlm_fates_interface_type ! private @@ -74,10 +89,18 @@ module CLMFatesInterfaceMod type(fates_interface_type), allocatable :: fates (:) + + ! This memory structure is used to map fates sites + ! into the host model. Currently, the FATES site + ! and its column number matching are its only members + + type(f2hmap_type), allocatable :: f2hmap(:) + ! fates2hlm (previously called "clm_ed_inst") contains types and variables ! that are passed back to the driving land model, ie fates-to-hlm. ! usefull to a calling model. In this case HLM means "Hosting Land Model" ! prev: type(ed_clm_type)::ed_clm_inst + type(ed_clm_type) :: fates2hlm @@ -139,6 +162,9 @@ subroutine init(this,bounds_proc, use_ed) ! local variables integer :: nclumps ! Number of threads integer :: nc ! thread index + integer :: s ! FATES site index + integer :: c ! HLM column index + integer, allocatable :: collist (:) type(bounds_type) :: bounds_clump if (use_ed) then @@ -163,14 +189,50 @@ subroutine init(this,bounds_proc, use_ed) nclumps = get_proc_clumps() allocate(this%fates(nclumps)) + allocate(this%f2hmap(nclumps)) do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) - ! INTERF-TODO: BOUNDS CLUMP SHOULD NOT BE PASSED TO THE FATES PUBLIC - ! WILL REQUIRE MAPPING PRIOR TO THIS STEP AND EITHER A FATES-BOUNDS - ! OR NATIVE TYPE SHOULD BE PASSED, ALL THAT HAPPENS IN THIS CALL IS ALLOCATION - ! OF SITES() - call this%fates(nc)%init(bounds_clump) + nmaxcol = bounds_clump%endc - bounds_clump%begc + 1 + allocate(collist(1:nmaxcol)) + + ! Allocate the mapping that points columns to FATES sites, 0 is NA + allocate(self%f2hmap(nc)%hsites(bounds_clump%begc:bounds_clump%endc)) + + ! Initialize all columns with a zero index, which indicates no FATES site + self%f2hmap(nc)%hsites(:) = 0 + + s = 0 + do c = bounds_clump%begc,bounds_clump%endc + l = col%landunit(c) + + ! These are the key constraints that determine if this column + ! will have a FATES site associated with it + if (col%active(c) .and. lun%itype(l) == istsoil ) then + s = s + 1 + collist(s) = c + self%f2hmap(nc)%hsites(c) = s + endif + + enddo + + ! Allocate vectors that match FATES sites with HLM columns + allocate(self%f2hmap(nc)%fcolumn(s)) + + ! Assign the h2hmap indexing + self%f2hmap(nc)%column(1:s) = collist(1:s) + + ! Deallocate the temporary arrays + deallocate(collist) + + ! Set the number of FATES sites + this%fates(nc)%nsites = s + + ! Allocate the FATES sites + allocate (this%fates(nc)%sites(s)) + +! call this%fates(nc)%init() end do @@ -191,7 +253,7 @@ subroutine fates2hlm_link(this, bounds_clump, nc, waterstate_inst, canopystate_i integer, intent(in) :: nc call this%fates2hlm%ed_clm_link( bounds_clump, & - this%fates(nc)%sites(bounds_clump%begg:bounds_clump%endg), & + this%fates(nc)%sites, & this%phen_inst, & waterstate_inst, & canopystate_inst) @@ -271,20 +333,21 @@ subroutine dynamics_driv(this, nc, bounds_clump, & ! where most things happen - do g = bounds_clump%begg,bounds_clump%endg - if (this%fates(nc)%sites(g)%istheresoil) then - call ed_ecosystem_dynamics(this%fates(nc)%sites(g), & + do s = 1,this%fates(nc)%nsites + +! if (this%fates(nc)%sites(g)%istheresoil) then + call ed_ecosystem_dynamics(this%fates(nc)%sites(s), & this%fates2hlm, & this%phen_inst, atm2lnd_inst, & soilstate_inst, temperature_inst, waterstate_inst) - call ed_update_site(this%fates(nc)%sites(g)) - endif + call ed_update_site(this%fates(nc)%sites(s)) +! endif enddo ! link to CLM/ALM structures call this%fates2hlm%ed_clm_link( bounds_clump, & - this%fates(nc)%sites(bounds_clump%begg:bounds_clump%endg), & + this%fates(nc)%sites, & this%phen_inst, & waterstate_inst, & canopystate_inst) From dda3fbc9b4c02ac540e19851c552458a6be9b20b Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 24 May 2016 15:04:52 -0700 Subject: [PATCH 02/23] partial progress --- components/clm/src/ED/main/EDInitMod.F90 | 126 +++++++++--------- .../clm/src/ED/main/FatesInterfaceMod.F90 | 26 ++-- 2 files changed, 69 insertions(+), 83 deletions(-) diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 534d320b5c..f73138e33a 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -140,84 +140,82 @@ subroutine zero_site( site_in ) end subroutine zero_site ! ============================================================================ - subroutine set_site_properties( bounds, ed_allsites_inst ) + subroutine set_site_properties( sites, nsites) ! ! !DESCRIPTION: ! ! !USES: ! ! !ARGUMENTS - type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + + type(ed_site_type) , intent(inout), target :: sites ! ! !LOCAL VARIABLES: - integer :: i,g !beginning and end of these data clumps. - real(r8) :: leafon (bounds%begg:bounds%endg) - real(r8) :: leafoff (bounds%begg:bounds%endg) - real(r8) :: stat (bounds%begg:bounds%endg) - real(r8) :: NCD (bounds%begg:bounds%endg) - real(r8) :: GDD (bounds%begg:bounds%endg) - real(r8) :: dstat (bounds%begg:bounds%endg) - real(r8) :: acc_NI (bounds%begg:bounds%endg) - real(r8) :: watermem (bounds%begg:bounds%endg) - integer :: dleafoff (bounds%begg:bounds%endg) - integer :: dleafon (bounds%begg:bounds%endg) + integer :: s + real(r8) :: leafon + real(r8) :: leafoff + real(r8) :: stat + real(r8) :: NCD + real(r8) :: GDD + real(r8) :: dstat + real(r8) :: acc_NI + real(r8) :: watermem + integer :: dleafoff + integer :: dleafon !---------------------------------------------------------------------- if ( .not. is_restart() ) then !initial guess numbers for site condition. - do i = bounds%begg,bounds%endg - NCD(i) = 0.0_r8 - GDD(i) = 30.0_r8 - leafon(i) = 100.0_r8 - leafoff(i) = 300.0_r8 - stat(i) = 2 - acc_NI(i) = 0.0_r8 - dstat(i) = 2 - dleafoff(i) = 300 - dleafon(i) = 100 - watermem(i) = 0.5_r8 + NCD = 0.0_r8 + GDD = 30.0_r8 + leafon = 100.0_r8 + leafoff = 300.0_r8 + stat = 2 + acc_NI = 0.0_r8 + dstat = 2 + dleafoff = 300 + dleafon = 100 + watermem = 0.5_r8 enddo else ! assignements for restarts - do i = bounds%begg,bounds%endg - NCD(i) = 1.0_r8 ! NCD should be 1 on restart - !GDD(i) = 0.0_r8 - leafon(i) = 0.0_r8 - leafoff(i) = 0.0_r8 - stat(i) = 1 - acc_NI(i) = 0.0_r8 - dstat(i) = 2 - dleafoff(i) = 300 - dleafon(i) = 100 - watermem(i) = 0.5_r8 - enddo + NCD = 1.0_r8 ! NCD should be 1 on restart + !GDD(i) = 0.0_r8 + leafon = 0.0_r8 + leafoff = 0.0_r8 + stat = 1 + acc_NI = 0.0_r8 + dstat = 2 + dleafoff = 300 + dleafon = 100 + watermem = 0.5_r8 endif - do g = bounds%begg,bounds%endg - ed_allsites_inst(g)%gdd = GDD(g) - ed_allsites_inst(g)%ncd = NCD(g) - ed_allsites_inst(g)%leafondate = leafon(g) - ed_allsites_inst(g)%leafoffdate = leafoff(g) - ed_allsites_inst(g)%dleafoffdate = dleafoff(g) - ed_allsites_inst(g)%dleafondate = dleafon(g) + do s = 1,nsites + sites(s)%gdd = GDD + sites(s)%ncd = NCD + sites(s)%leafondate = leafon + sites(s)%leafoffdate = leafoff + sites(s)%dleafoffdate = dleafoff + sites(s)%dleafondate = dleafon if ( .not. is_restart() ) then - ed_allsites_inst(g)%water_memory(1:10) = watermem(g) + sites(s)%water_memory(1:10) = watermem end if - ed_allsites_inst(g)%status = stat(g) + sites(s)%status = stat !start off with leaves off to initialise - ed_allsites_inst(g)%dstatus= dstat(g) - - ed_allsites_inst(g)%acc_NI = acc_NI(g) - ed_allsites_inst(g)%frac_burnt = 0.0_r8 - ed_allsites_inst(g)%old_stock = 0.0_r8 - enddo - + sites(s)%dstatus= dstat + + sites(s)%acc_NI = acc_NI(s) + sites(s)%frac_burnt = 0.0_r8 + sites(s)%old_stock = 0.0_r8 + end do + + return end subroutine set_site_properties ! ============================================================================ - subroutine init_patches( bounds, ed_allsites_inst ) + subroutine init_patches( sites, nsites) ! ! !DESCRIPTION: !initialize patches on new ground @@ -226,11 +224,10 @@ subroutine init_patches( bounds, ed_allsites_inst ) use EDParamsMod , only : ED_val_maxspread ! ! !ARGUMENTS - type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites ! ! !LOCAL VARIABLES: - integer :: g + integer :: s real(r8) :: cwd_ag_local(ncwd) real(r8) :: cwd_bg_local(ncwd) real(r8) :: spread_local(nclmax) @@ -250,27 +247,26 @@ subroutine init_patches( bounds, ed_allsites_inst ) age = 0.0_r8 !FIX(SPM,032414) clean this up...inits out of this loop - do g = bounds%begg,bounds%endg + do s = 1, nsites allocate(newp) -! call zero_patch(newp) !Note (mv,11-04-2014, this is a bug fix - this line was missing) newp%patchno = 1 newp%younger => null() newp%older => null() - ed_allsites_inst(g)%youngest_patch => newp - ed_allsites_inst(g)%youngest_patch => newp - ed_allsites_inst(g)%oldest_patch => newp + sites(s)%youngest_patch => newp + sites(s)%youngest_patch => newp + sites(s)%oldest_patch => newp ! make new patch... - call create_patch(ed_allsites_inst(g), newp, age, AREA, & + call create_patch(sites(s), newp, age, AREA, & spread_local, cwd_ag_local, cwd_bg_local, leaf_litter_local, & root_litter_local, seed_bank_local) - + call init_cohorts(newp) - enddo !gridcells + enddo end subroutine init_patches diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 450f86231d..ddcd69af6c 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -95,11 +95,12 @@ end subroutine fates_clean ! ------------------------------------------------------------------------------------ - subroutine site_init(this,fcolumn,bounds_clump) + subroutine init_coldstart(this,fcolumn) ! Input Arguments class(fates_interface_type), intent(inout) :: this - type(bounds_type),intent(in) :: bounds_clump + integer :: fcolumn(this%nsites) +! type(bounds_type),intent(in) :: bounds_clump ! locals integer :: s @@ -110,7 +111,7 @@ subroutine site_init(this,fcolumn,bounds_clump) ! call ed_init_sites( bounds_clump, & ! this%sites(bounds_clump%begg:bounds_clump%endg) ) - do s = 1:this%nsites + do s = 1,this%nsites call zero_site(this%sites(s)) @@ -122,24 +123,13 @@ subroutine site_init(this,fcolumn,bounds_clump) end do - do g = bounds%begg,bounds%endg - ! zero the site - call zero_site(ed_allsites_inst(g)) + call set_site_properties(this%sites,this%nsites) - !create clm mapping to ED structure - ed_allsites_inst(g)%clmgcell = g - ed_allsites_inst(g)%lat = grc%latdeg(g) - ed_allsites_inst(g)%lon = grc%londeg(g) - enddo + call init_patches(this%sites, this%nsites) - - - ! INTERF-TODO: WHEN WE MOVE TO COLUMNS, THIS WILL BE UNNECESSARY - do g = bounds_clump%begg,bounds_clump%endg - if (this%sites(g)%istheresoil) then - call ed_update_site(this%sites(g)) - end if + do s = 1,this%nsites + call ed_update_site(this%sites(s)) end do return From 50540b21de6df3dca1f5b6463c79765c099f36ff Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 24 May 2016 18:19:22 -0700 Subject: [PATCH 03/23] more partial progress, most of work on subgrid decomposition for cohorts on columns hashed out. --- components/clm/src/ED/main/EDInitMod.F90 | 104 ++-- .../clm/src/ED/main/EDRestVectorMod.F90 | 462 +++++++++--------- components/clm/src/ED/main/EDTypesMod.F90 | 9 +- .../clm/src/ED/main/EDVecCohortType.F90 | 6 +- .../clm/src/ED/main/FatesInterfaceMod.F90 | 16 +- components/clm/src/main/decompInitMod.F90 | 5 +- components/clm/src/main/initGridCellsMod.F90 | 14 +- components/clm/src/main/subgridMod.F90 | 22 +- 8 files changed, 324 insertions(+), 314 deletions(-) diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index f73138e33a..d1641f530b 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -41,57 +41,57 @@ module EDInitMod ! ============================================================================ - subroutine ed_init_sites( bounds, ed_allsites_inst ) - ! - ! !DESCRIPTION: - ! Intialize all ED sites - ! - ! !USES: - use ColumnType , only : col - use landunit_varcon , only : istsoil - ! - ! !ARGUMENTS - type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) - ! - ! !LOCAL VARIABLES: - integer :: g,l,c - logical :: istheresoil(bounds%begg:bounds%endg) - !---------------------------------------------------------------------- - - ! - ! INITIALISE THE SITE STRUCTURES - ! - ! Makes unique cohort identifiers. Needs zeroing at beginning of run. - udata%cohort_number = 0 - - do g = bounds%begg,bounds%endg - ! zero the site - call zero_site(ed_allsites_inst(g)) - - !create clm mapping to ED structure - ed_allsites_inst(g)%clmgcell = g - ed_allsites_inst(g)%lat = grc%latdeg(g) - ed_allsites_inst(g)%lon = grc%londeg(g) - enddo - - istheresoil(bounds%begg:bounds%endg) = .false. - do c = bounds%begc,bounds%endc - g = col%gridcell(c) - if (col%itype(c) == istsoil) then - istheresoil(g) = .true. - endif - ed_allsites_inst(g)%istheresoil = istheresoil(g) - enddo - - call set_site_properties( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) - - ! on restart, this functionality is handled in EDRestVectorMod::createPatchCohortStructure - !if (.not. is_restart() ) then - call init_patches( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) - !endif - - end subroutine ed_init_sites +! subroutine ed_init_sites( bounds, ed_allsites_inst ) +! ! +! ! !DESCRIPTION: +! ! Intialize all ED sites +! ! +! ! !USES: +! use ColumnType , only : col +! use landunit_varcon , only : istsoil +! ! +! ! !ARGUMENTS +! type(bounds_type) , intent(in) :: bounds +! type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) +! ! +! ! !LOCAL VARIABLES: +! integer :: g,l,c +! logical :: istheresoil(bounds%begg:bounds%endg) +! !---------------------------------------------------------------------- +! +! ! +! ! INITIALISE THE SITE STRUCTURES +! ! +! ! Makes unique cohort identifiers. Needs zeroing at beginning of run. +! udata%cohort_number = 0 +! +! do g = bounds%begg,bounds%endg +! ! zero the site +! call zero_site(ed_allsites_inst(g)) +! +! !create clm mapping to ED structure +! ed_allsites_inst(g)%clmgcell = g +! ed_allsites_inst(g)%lat = grc%latdeg(g) +! ed_allsites_inst(g)%lon = grc%londeg(g) +! enddo + +! istheresoil(bounds%begg:bounds%endg) = .false. +! do c = bounds%begc,bounds%endc +! g = col%gridcell(c) +! if (col%itype(c) == istsoil) then +! istheresoil(g) = .true. +! endif +! ed_allsites_inst(g)%istheresoil = istheresoil(g) +! enddo +! +! call set_site_properties( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) +! +! ! on restart, this functionality is handled in EDRestVectorMod::createPatchCohortStructure +! !if (.not. is_restart() ) then +! call init_patches( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) +! !endif +! +! end subroutine ed_init_sites ! ============================================================================ subroutine zero_site( site_in ) @@ -149,6 +149,7 @@ subroutine set_site_properties( sites, nsites) ! !ARGUMENTS type(ed_site_type) , intent(inout), target :: sites + integer, intent(in) :: nsites ! ! !LOCAL VARIABLES: integer :: s @@ -225,6 +226,7 @@ subroutine init_patches( sites, nsites) ! ! !ARGUMENTS type(ed_site_type) , intent(inout), target :: sites + integer, intent(in) :: nsites ! ! !LOCAL VARIABLES: integer :: s diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index 873523c5db..62bbb7b839 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -11,7 +11,7 @@ module EDRestVectorMod use CanopyStateType , only : canopystate_type use WaterStateType , only : waterstate_type use pftconMod , only : pftcon - use EDTypesMod , only : area, cohorts_per_gcell, numpft_ed, numWaterMem, nclmax, numCohortsPerPatch + use EDTypesMod , only : area, cohorts_per_col, numpft_ed, numWaterMem, nclmax, numCohortsPerPatch use EDTypesMod , only : ncwd, invalidValue, nlevcan_ed use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type use EDPhenologyType , only : ed_phenology_type @@ -39,8 +39,8 @@ module EDRestVectorMod ! required to map cohorts and patches to/fro ! vectors/LinkedLists - integer, pointer :: cellWithPatch(:) - integer, pointer :: numPatchesPerCell(:) + integer, pointer :: colWithPatch(:) + integer, pointer :: numPatchesPerCol(:) integer, pointer :: cohortsPerPatch(:) ! ! cohort data @@ -177,8 +177,8 @@ subroutine deleteEDRestartVectorClass( this ) class(EDRestartVectorClass), intent(inout) :: this ! ! !LOCAL VARIABLES: - deallocate(this%cellWithPatch ) - deallocate(this%numPatchesPerCell ) + deallocate(this%colWithPatch ) + deallocate(this%numPatchesPerCol ) deallocate(this%cohortsPerPatch ) deallocate(this%balive ) deallocate(this%bdead ) @@ -270,15 +270,15 @@ function newEDRestartVectorClass( bounds ) ! cohort level variables that are required on restart ! - allocate(new%cellWithPatch & - (bounds%begg:bounds%endg), stat=retVal) + allocate(new%colWithPatch & + (bounds%begc:bounds%endc), stat=retVal) SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%cellWithPatch(:) = 0 + new%colWithPatch(:) = 0 - allocate(new%numPatchesPerCell & - (bounds%begg:bounds%endg), stat=retVal) + allocate(new%numPatchesPerCol & + (bounds%begc:bounds%endc), stat=retVal) SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%numPatchesPerCell(:) = invalidValue + new%numPatchesPerCol(:) = invalidValue allocate(new%cohortsPerPatch & (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) @@ -592,7 +592,7 @@ function newEDRestartVectorClass( bounds ) end function newEDRestartVectorClass !-------------------------------------------------------------------------------! - subroutine setVectors( this, bounds, ed_allsites_inst ) + subroutine setVectors( this, bounds, sites ) ! ! !DESCRIPTION: ! implement setVectors @@ -603,7 +603,7 @@ subroutine setVectors( this, bounds, ed_allsites_inst ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(in), target :: sites(:) ! ! !LOCAL VARIABLES: !----------------------------------------------------------------------- @@ -611,22 +611,22 @@ subroutine setVectors( this, bounds, ed_allsites_inst ) if ( masterproc ) write(iulog,*) 'edtime setVectors ',get_nstep() !if (this%DEBUG) then - !call this%printIoInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) - !call this%printDataInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + ! call this%printIoInfoLL ( bounds, sites, nsites ) + ! call this%printDataInfoLL ( bounds, sites, nsites ) !end if - call this%convertCohortListToVector ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call this%convertCohortListToVector ( bounds, sites ) if (this%DEBUG) then - call this%printIoInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) - call this%printDataInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call this%printIoInfoLL ( bounds, sites, nsites ) + call this%printDataInfoLL ( bounds, sites, nsites ) call this%printDataInfoVector ( ) end if end subroutine setVectors !-------------------------------------------------------------------------------! - subroutine getVectors( this, bounds, ed_allsites_inst ) + subroutine getVectors( this, bounds, sites, nsites) ! ! !DESCRIPTION: ! implement getVectors @@ -639,31 +639,30 @@ subroutine getVectors( this, bounds, ed_allsites_inst ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(:) + integer , intent(in) :: nsites ! ! !LOCAL VARIABLES: - integer :: g + integer :: s !----------------------------------------------------------------------- if (this%DEBUG) then write(iulog,*) 'edtime getVectors ',get_nstep() end if - call this%createPatchCohortStructure ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call this%createPatchCohortStructure ( bounds, sites ) - call this%convertCohortVectorToList ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call this%convertCohortVectorToList ( bounds, sites ) - do g = bounds%begg,bounds%endg - if (ed_allsites_inst(g)%istheresoil) then - call ed_update_site( ed_allsites_inst(g) ) - end if + do s = 1,nsites + call ed_update_site( sites(s) ) end do if (this%DEBUG) then - call this%printIoInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) - call this%printDataInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call this%printIoInfoLL ( bounds, sites ) + call this%printDataInfoLL ( bounds, sites ) call this%printDataInfoVector ( ) end if @@ -678,7 +677,7 @@ subroutine doVectorIO( this, ncid, flag ) ! !USES: use ncdio_pio , only : file_desc_t, ncd_int, ncd_double use restUtilMod, only : restartvar - use clm_varcon, only : nameg, nameCohort + use clm_varcon, only : namec, nameCohort use spmdMod, only : iam ! ! !ARGUMENTS: @@ -694,21 +693,21 @@ subroutine doVectorIO( this, ncid, flag ) ! ! cohort level vars ! - call restartvar(ncid=ncid, flag=flag, varname='ed_io_cellWithPatch', xtype=ncd_int, & - dim1name=nameg, & - long_name='1 if a gridcell has a patch', units='1=true,0=false', & - interpinic_flag='interp', data=this%cellWithPatch, & + call restartvar(ncid=ncid, flag=flag, varname='ed_io_colWithPatch', xtype=ncd_int, & + dim1name=namec, & + long_name='1 if a column has a patch', units='1=true,0=false', & + interpinic_flag='interp', data=this%colWithPatch, & readvar=readvar) - call restartvar(ncid=ncid, flag=flag, varname='ed_io_numPatchesPerCell', xtype=ncd_int, & - dim1name=nameg, & - long_name='works with ed_cellWithPatch. num patches per gridcell', units='unitless', & - interpinic_flag='interp', data=this%numPatchesPerCell, & + call restartvar(ncid=ncid, flag=flag, varname='ed_io_numPatchesPerCol', xtype=ncd_int, & + dim1name=namec, & + long_name='works with ed_colWithPatch. num patches per column', units='unitless', & + interpinic_flag='interp', data=this%numPatchesPerCol, & readvar=readvar) call restartvar(ncid=ncid, flag=flag, varname='ed_io_cohortsPerPatch', xtype=ncd_int, & dim1name=dimName, & - long_name='list of cohorts per patch. indexed by numPatchesPerCell', units='unitless', & + long_name='list of cohorts per patch. indexed by numPatchesPerCol', units='unitless', & interpinic_flag='interp', data=this%cohortsPerPatch, & readvar=readvar) @@ -1227,7 +1226,7 @@ subroutine printDataInfoVector( this ) end subroutine printDataInfoVector !-------------------------------------------------------------------------------! - subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) + subroutine printDataInfoLL( this, bounds, sites, nsites ) ! ! !DESCRIPTION: ! counts the total number of cohorts over all p levels (ed_patch_type) so we @@ -1238,12 +1237,13 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(in), target :: sites + integer , intent(in) :: nsites ! ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort - integer :: g + integer :: s integer :: totalCohorts integer :: numCohort integer :: numPatches,totPatchCount @@ -1255,11 +1255,9 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) write(iulog,*) 'vecLenStart ',this%vectorLengthStart - g = bounds%begg - do while(g <= bounds%endg) + do s = 1,nsites - if (ed_allsites_inst(g)%istheresoil) then - currentPatch => ed_allsites_inst(g)%oldest_patch + currentPatch => sites(s)%oldest_patch numPatches = 1 @@ -1289,20 +1287,20 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) write(iulog,*) trim(methodName)//' n ' ,totalCohorts,currentCohort%n write(iulog,*) trim(methodName)//' gpp_acc ' ,totalCohorts,currentCohort%gpp_acc write(iulog,*) trim(methodName)//' npp_acc ' ,totalCohorts,currentCohort%npp_acc - write(iulog,*) trim(methodName)//' gpp ' ,totalCohorts,currentCohort%gpp - write(iulog,*) trim(methodName)//' npp ' ,totalCohorts,currentCohort%npp - write(iulog,*) trim(methodName)//' npp_leaf ' ,totalCohorts,currentCohort%npp_leaf - write(iulog,*) trim(methodName)//' npp_froot ' ,totalCohorts,currentCohort%npp_froot + write(iulog,*) trim(methodName)//' gpp ' ,totalCohorts,currentCohort%gpp + write(iulog,*) trim(methodName)//' npp ' ,totalCohorts,currentCohort%npp + 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)//' 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_clm ' ,totalCohorts,currentCohort%resp_clm write(iulog,*) trim(methodName)//' pft ' ,totalCohorts,currentCohort%pft write(iulog,*) trim(methodName)//' status_coh ' ,totalCohorts,currentCohort%status_coh @@ -1313,8 +1311,8 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) currentCohort => currentCohort%taller enddo ! currentCohort do while - write(iulog,*) trim(methodName)//': numpatches for gcell ',& - ed_allsites_inst(g)%clmgcell, numPatches + write(iulog,*) trim(methodName)//': numpatches for col ',& + numPatches write(iulog,*) trim(methodName)//': patches and cohorts ',& totPatchCount,numCohort @@ -1335,15 +1333,15 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) 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 ' ,ed_allsites_inst(g)%old_stock - write(iulog,*) trim(methodName)//' cd_status ' ,ed_allsites_inst(g)%status - write(iulog,*) trim(methodName)//' dd_status ' ,ed_allsites_inst(g)%dstatus - write(iulog,*) trim(methodName)//' ncd ' ,ed_allsites_inst(g)%ncd - write(iulog,*) trim(methodName)//' leafondate ' ,ed_allsites_inst(g)%leafondate - write(iulog,*) trim(methodName)//' leafoffdate ' ,ed_allsites_inst(g)%leafoffdate - write(iulog,*) trim(methodName)//' dleafondate ' ,ed_allsites_inst(g)%dleafondate - write(iulog,*) trim(methodName)//' dleafoffdate ' ,ed_allsites_inst(g)%dleafoffdate - write(iulog,*) trim(methodName)//' acc_NI' ,ed_allsites_inst(g)%acc_NI + 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 currentPatch => currentPatch%younger @@ -1351,10 +1349,8 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) totPatchCount = totPatchCount + 1 numPatches = numPatches + 1 enddo ! currentPatch do while - endif - write(iulog,*) trim(methodName)//' water_memory ',ed_allsites_inst(g)%water_memory(1) - g = g + 1 + write(iulog,*) trim(methodName)//' water_memory ',sites(s)%water_memory(1) enddo @@ -1363,7 +1359,7 @@ subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) end subroutine printDataInfoLL !-------------------------------------------------------------------------------! - subroutine printIoInfoLL( this, bounds, ed_allsites_inst ) + subroutine printIoInfoLL( this, bounds, sites, nsites, fcolumn ) !! ! !DESCRIPTION: ! for debugging. prints some IO info regarding cohorts/patches @@ -1374,12 +1370,14 @@ subroutine printIoInfoLL( this, bounds, ed_allsites_inst ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(in), target :: sites + integer , intent(in) :: nsites + integer, intent(in) :: fcolumn(this%nsites) ! ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort - integer g + integer s integer totalCohorts integer numCohort integer numPatches,totPatchCount @@ -1391,79 +1389,76 @@ subroutine printIoInfoLL( this, bounds, ed_allsites_inst ) write(iulog,*) 'vecLenStart ',this%vectorLengthStart - g = bounds%begg - do while(g <= bounds%endg) - - if (ed_allsites_inst(g)%istheresoil) then - currentPatch => ed_allsites_inst(g)%oldest_patch - - numPatches = 1 - - do while(associated(currentPatch)) - currentCohort => currentPatch%shortest - - write(iulog,*) trim(methodName)//': found gcell with patch(s) ',g - - numCohort = 0 - - do while(associated(currentCohort)) - - totalCohorts = totalCohorts + 1 - numCohort = numCohort + 1 + do s=1,nsites + + currentPatch => sites(s)%oldest_patch - 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 ',currentCohort%gpp - write(iulog,*) trim(methodName)//' npp ',currentCohort%npp - 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_clm ',currentCohort%resp_clm - 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 + numPatches = 1 - write(iulog,*) trim(methodName)//': numpatches for gcell ',ed_allsites_inst(g)%clmgcell, numPatches - write(iulog,*) trim(methodName)//': patches and cohorts ',totPatchCount,numCohort + 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 ',currentCohort%gpp + write(iulog,*) trim(methodName)//' npp ',currentCohort%npp + 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_clm ',currentCohort%resp_clm + 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 + currentPatch => currentPatch%younger - totPatchCount = totPatchCount + 1 - numPatches = numPatches + 1 - enddo ! currentPatch do while - endif - g = g + 1 + totPatchCount = totPatchCount + 1 + numPatches = numPatches + 1 + enddo ! currentPatch do while enddo - + + return end subroutine printIoInfoLL !-------------------------------------------------------------------------------! - subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) + subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) ! ! !DESCRIPTION: ! counts the total number of cohorts over all p levels (ed_patch_type) so we @@ -1475,12 +1470,14 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(in), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) ! ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort - integer :: g + integer :: s integer :: totalCohorts ! number of cohorts starting from 1 integer :: countCohort ! number of cohorts starting from ! vectorLengthStart @@ -1506,80 +1503,88 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) countWaterMem = this%vectorLengthStart countSunZ = this%vectorLengthStart - g = bounds%begg - do while(g <= bounds%endg) - - if (ed_allsites_inst(g)%istheresoil)then - - currentPatch => ed_allsites_inst(g)%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,*) '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(countCohort) = currentCohort%gpp - this%npp(countCohort) = currentCohort%npp - 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_clm(countCohort) = currentCohort%resp_clm - 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 + do s = 1,nsites + + ! Calculate the offsets + + incrementOffset = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col + countCohort = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col + countPft = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col + countNcwd = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col + countNclmax = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col + countWaterMem = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col + countSunZ = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col + + 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(countCohort) = currentCohort%gpp + this%npp(countCohort) = currentCohort%npp + 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_clm(countCohort) = currentCohort%resp_clm + 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 @@ -1610,7 +1615,7 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) if (this%DEBUG) then write(iulog,*) 'offsetNumCohorts III ' & - ,countCohort,cohorts_per_gcell, numCohort + ,countCohort,cohorts_per_col, numCohort endif ! ! deal with patch level fields of arrays here @@ -1657,7 +1662,7 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) if (this%DEBUG) write(iulog,*) 'CLTV countSunZ 2 ',countSunZ ! set numpatches for this gcell - this%numPatchesPerCell( ed_allsites_inst(g)%clmgcell ) = numPatches + this%numPatchesPerCol( ed_allsites_inst(g)%clmgcell ) = numPatches incrementOffset = incrementOffset + numCohortsPerPatch @@ -1672,7 +1677,7 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) if (this%DEBUG) then write(iulog,*) 'CLTV incrementOffset ', incrementOffset - write(iulog,*) 'CLTV cohorts_per_gcell ', cohorts_per_gcell + write(iulog,*) 'CLTV cohorts_per_col ', cohorts_per_col write(iulog,*) 'CLTV numCohort ', numCohort write(iulog,*) 'CLTV totalCohorts ', totalCohorts end if @@ -1682,7 +1687,7 @@ subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) enddo ! currentPatch do while ! set which gridcells have patches/cohorts - this%cellWithPatch( ed_allsites_inst(g)%clmgcell ) = 1 + this%colWithPatch( ed_allsites_inst(g)%clmgcell ) = 1 do i = 1,numWaterMem ! numWaterMem currently 10 this%water_memory( countWaterMem ) = ed_allsites_inst(g)%water_memory(i) @@ -1751,7 +1756,7 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) do g = bounds%begg, bounds%endg if (this%DEBUG) then - write(iulog,*) 'cellWithPatch ',this%cellWithPatch(g),this%numPatchesPerCell(g) + write(iulog,*) 'colWithPatch ',this%colWithPatch(g),this%numPatchesPerCol(g) end if call zero_site( ed_allsites_inst(g) ) @@ -1766,7 +1771,7 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) ed_allsites_inst(g)%ncd = 0.0_r8 ! then this site has soil and should be set here - do patchIdx = 1,this%numPatchesPerCell(g) + do patchIdx = 1,this%numPatchesPerCol(g) if (this%DEBUG) then write(iulog,*) 'create patch ',patchIdx @@ -2019,7 +2024,7 @@ subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) if (this%DEBUG) then write(iulog,*) 'CVTL III ' & - ,countCohort,cohorts_per_gcell, numCohort + ,countCohort,cohorts_per_col, numCohort endif ! ! deal with patch level fields of arrays here @@ -2076,7 +2081,7 @@ subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) if (this%DEBUG) then write(iulog,*) 'CVTL incrementOffset ', incrementOffset - write(iulog,*) 'CVTL cohorts_per_gcell ', cohorts_per_gcell + write(iulog,*) 'CVTL cohorts_per_col ', cohorts_per_col write(iulog,*) 'CVTL numCohort ', numCohort write(iulog,*) 'CVTL totalCohorts ', totalCohorts end if @@ -2109,7 +2114,7 @@ end subroutine convertCohortVectorToList !--------------------------------------------! !-------------------------------------------------------------------------------! - subroutine EDRest ( bounds, ed_allsites_inst, ncid, flag ) + subroutine EDRest ( bounds, sites, nsites, ncid, flag ) ! ! !DESCRIPTION: ! Read/write ED restart data @@ -2123,7 +2128,8 @@ subroutine EDRest ( bounds, ed_allsites_inst, ncid, flag ) ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds ! bounds type(file_desc_t) , intent(inout) :: ncid ! netcdf id - type(ed_site_type) , intent(inout) :: ed_allsites_inst(bounds%begg:) + type(ed_site_type) , intent(inout) :: sites ! The site vector + integer , intent(in) :: nsites ! Size of the site vector character(len=*) , intent(in) :: flag !'read' or 'write' ! ! !LOCAL VARIABLES: @@ -2139,13 +2145,13 @@ subroutine EDRest ( bounds, ed_allsites_inst, ncid, flag ) end if if ( flag == 'write' ) then - call ervc%setVectors( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call ervc%setVectors( bounds, sites) ) endif call ervc%doVectorIO( ncid, flag ) if ( flag == 'read' ) then - call ervc%getVectors( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call ervc%getVectors( bounds, sites, nsites ) endif call ervc%deleteEDRestartVectorClass () diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 50f5dc0939..03209c5dd0 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -24,9 +24,9 @@ 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 :: numPatchesPerGridCell = 10 ! + integer, parameter :: numPatchesPerGridCol = 10 ! integer, parameter :: numCohortsPerPatch = 160 ! - integer, parameter :: cohorts_per_gcell = 1600 ! This is the max number of individual items one can store per + 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 ! data as some fields are arrays where each array is @@ -233,7 +233,7 @@ module EDTypesMod !INDICES integer :: patchno ! unique number given to each new patch created for tracking - integer :: clm_pno ! clm patch number (index of p vector) +! integer :: clm_pno ! clm patch number (index of p vector) ! PATCH INFO real(r8) :: age ! average patch age: years @@ -396,9 +396,6 @@ module EDTypesMod ! INDICES real(r8) :: lat ! latitude: degrees real(r8) :: lon ! longitude: degrees - integer :: clmgcell ! gridcell index - integer :: clmcolumn ! column index (assuming there is only one soil column in each gcell. - logical :: istheresoil ! are there any soil columns, or is this all ice/rocks/lakes? ! CARBON BALANCE real(r8) :: flux_in ! for carbon balance purpose. C coming into biomass pool: KgC/site diff --git a/components/clm/src/ED/main/EDVecCohortType.F90 b/components/clm/src/ED/main/EDVecCohortType.F90 index 96dc04e9b7..feefd13502 100644 --- a/components/clm/src/ED/main/EDVecCohortType.F90 +++ b/components/clm/src/ED/main/EDVecCohortType.F90 @@ -12,8 +12,8 @@ module EDVecCohortType public ! type, public :: ed_vec_cohort_type - integer :: cohorts_per_gridcell - integer , pointer :: gridcell(:) !index into gridcell level quantities + integer :: cohorts_per_column + integer , pointer :: column(:) !index into column level quantities contains procedure, public :: Init end type ed_vec_cohort_type @@ -35,7 +35,7 @@ subroutine Init(this, beg, end) ! FIX(SPM,032414) pull this out and put in own ED source - allocate(this%gridcell(beg:end)) + allocate(this%column(beg:end)) end subroutine Init diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index ddcd69af6c..f3b21b781f 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -99,18 +99,13 @@ subroutine init_coldstart(this,fcolumn) ! Input Arguments class(fates_interface_type), intent(inout) :: this - integer :: fcolumn(this%nsites) -! type(bounds_type),intent(in) :: bounds_clump + integer, intent(in) :: fcolumn(this%nsites) ! locals integer :: s integer :: c integer :: g - ! Initialize (INTERF-TODO THIS ROUTINE CALLS CLM STUFF-MIGRATE CODE TO HERE) -! call ed_init_sites( bounds_clump, & -! this%sites(bounds_clump%begg:bounds_clump%endg) ) - do s = 1,this%nsites call zero_site(this%sites(s)) @@ -127,17 +122,16 @@ subroutine init_coldstart(this,fcolumn) call init_patches(this%sites, this%nsites) - do s = 1,this%nsites call ed_update_site(this%sites(s)) end do return - end subroutine site_init + end subroutine init_coldstart ! ------------------------------------------------------------------------------------ - subroutine fates_restart(this, bounds_clump, ncid, flag ) + subroutine init_restart(this, bounds_clump, ncid, flag ) implicit none class(fates_interface_type), intent(inout) :: this @@ -145,10 +139,10 @@ subroutine fates_restart(this, bounds_clump, ncid, flag ) type(file_desc_t) , intent(inout) :: ncid ! netcdf id character(len=*) , intent(in) :: flag !'read' or 'write' - call EDRest( bounds_clump, this%sites(bounds_clump%begg:bounds_clump%endg), & + call EDRest( bounds_clump, this%sites, this%nsites, ncid, flag ) return - end subroutine fates_restart + end subroutine init_restart ! ------------------------------------------------------------------------------------ diff --git a/components/clm/src/main/decompInitMod.F90 b/components/clm/src/main/decompInitMod.F90 index a21c7af598..5aaad5e2db 100644 --- a/components/clm/src/main/decompInitMod.F90 +++ b/components/clm/src/main/decompInitMod.F90 @@ -500,7 +500,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glcmask) integer :: begl,endl ! beg,end landunits integer :: begc,endc ! beg,end columns integer :: begp,endp ! beg,end patches - integer :: begCohort,endCohort! beg,end patches + integer :: begCohort,endCohort! beg,end cohorts integer :: numg ! total number of gridcells across all processors integer :: numl ! total number of landunits across all processors integer :: numc ! total number of columns across all processors @@ -737,7 +737,8 @@ subroutine decompInit_glcp(lns,lni,lnj,glcmask) allocate(gindex(begCohort:endCohort)) ioff(:) = 0 do coi = begCohort,endCohort - gi = ed_vec_cohort%gridcell(coi) !function call to get gcell for this cohort idx + ci = ed_vec_cohort%column(coi) ! function call to get column for this cohort idx + gi = col%gridcell(ci) ! convert column into gridcell gindex(coi) = coStart(gi) + ioff(gi) ioff(gi) = ioff(gi) + 1 enddo diff --git a/components/clm/src/main/initGridCellsMod.F90 b/components/clm/src/main/initGridCellsMod.F90 index 4c455b4d14..af3c1a6f3c 100644 --- a/components/clm/src/main/initGridCellsMod.F90 +++ b/components/clm/src/main/initGridCellsMod.F90 @@ -228,24 +228,24 @@ subroutine set_cohort_decomp ( bounds_clump ) ! !DESCRIPTION: ! Set gridcell decomposition for cohorts ! - use EDTypesMod , only : cohorts_per_gcell + use EDTypesMod , only : cohorts_per_col use EDVecCohortType , only : ed_vec_cohort ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds_clump ! ! !LOCAL VARIABLES: - integer c, gi + integer c, ci !------------------------------------------------------------------------ - gi = bounds_clump%begg + ci = bounds_clump%begc do c = bounds_clump%begCohort, bounds_clump%endCohort - ed_vec_cohort%gridcell(c) = gi - if ( mod(c, cohorts_per_gcell ) == 0 ) gi = gi + 1 - - end do + ed_vec_cohort%column(c) = ci + if ( mod(c, cohorts_per_col ) == 0 ) ci = ci + 1 + + end do end subroutine set_cohort_decomp diff --git a/components/clm/src/main/subgridMod.F90 b/components/clm/src/main/subgridMod.F90 index 8bf80e5116..c900be3cf5 100644 --- a/components/clm/src/main/subgridMod.F90 +++ b/components/clm/src/main/subgridMod.F90 @@ -43,7 +43,7 @@ subroutine subgrid_get_gcellinfo (gi, & use clm_instur , only : wt_lunit, urban_valid, wt_glc_mec use landunit_varcon , only : istsoil, istcrop, istice, istice_mec, istdlak, istwet use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md - use EDtypesMod , only : cohorts_per_gcell + use EDtypesMod , only : cohorts_per_col ! ! !ARGUMENTS integer , intent(in) :: gi ! grid cell index @@ -76,7 +76,7 @@ subroutine subgrid_get_gcellinfo (gi, & ! Initialize patches, columns and landunits counters for gridcell ! ------------------------------------------------------------------------- - ipatches = 0 + ipatches = 0 icols = 0 ilunits = 0 icohorts = 0 @@ -98,10 +98,7 @@ subroutine subgrid_get_gcellinfo (gi, & ipatches = ipatches + npatches_per_lunit - ! - ! number of cohorts per gridcell set here. - ! - icohorts = icohorts + cohorts_per_gcell + if (present(nveg )) nveg = npatches_per_lunit @@ -248,6 +245,19 @@ subroutine subgrid_get_gcellinfo (gi, & ipatches = ipatches + npatches_per_lunit end if if (present(ncrop )) ncrop = npatches_per_lunit + + + ! ------------------------------------------------------------------------- + ! Number of cohorts is set here + ! ED cohorts (via FATES) populate all natural vegetation columns. + ! Current implementations mostly assume that only one column contains + ! natural vegetation, which is synonomous with the soil column. + ! For restart output however, we will allocate the cohort vector space + ! based on all columns. + ! ------------------------------------------------------------------------- + icohorts = icohorts + icols*cohorts_per_col + + ! ------------------------------------------------------------------------- ! Determine return arguments From 94da4974595807edd63aa6c450964b9c68404086 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 24 May 2016 18:27:43 -0700 Subject: [PATCH 04/23] more partial progress, some documentation with decomposition. --- components/clm/src/main/initGridCellsMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/clm/src/main/initGridCellsMod.F90 b/components/clm/src/main/initGridCellsMod.F90 index af3c1a6f3c..59032d4639 100644 --- a/components/clm/src/main/initGridCellsMod.F90 +++ b/components/clm/src/main/initGridCellsMod.F90 @@ -103,7 +103,8 @@ subroutine initGridcells ! Cohort layout ! Array index: 1 2 3 4 5 6 7 8 9 10 11 12 ! ------------------------------------------------------------ - ! Gridcell: 1 1 2 2 3 3 1 1 2 2 3 3 + ! Gridcell: 1 1 1 1 2 2 2 2 3 3 3 3 + ! Column: 1 1 2 2 3 3 4 4 5 5 6 6 ! Cohort: 1 2 1 2 1 2 1 2 1 2 1 2 nclumps = get_proc_clumps() From cdf4b43dab39144fa88d5ad7f0640d97daa17da6 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 24 May 2016 20:09:10 -0700 Subject: [PATCH 05/23] more partial progress, working through restart list to vector and vector to list procedures. Currently on convertCohortVectorToList(). --- .../clm/src/ED/main/EDRestVectorMod.F90 | 371 +++++++++--------- .../clm/src/ED/main/FatesInterfaceMod.F90 | 3 +- components/clm/src/main/ColumnType.F90 | 2 +- 3 files changed, 196 insertions(+), 180 deletions(-) diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index 62bbb7b839..840eb63429 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -592,7 +592,7 @@ function newEDRestartVectorClass( bounds ) end function newEDRestartVectorClass !-------------------------------------------------------------------------------! - subroutine setVectors( this, bounds, sites ) + subroutine setVectors( this, bounds, sites, nsites, fcolumn ) ! ! !DESCRIPTION: ! implement setVectors @@ -603,7 +603,9 @@ subroutine setVectors( this, bounds, sites ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: sites(:) + type(ed_site_type) , intent(in), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) ! ! !LOCAL VARIABLES: !----------------------------------------------------------------------- @@ -615,10 +617,10 @@ subroutine setVectors( this, bounds, sites ) ! call this%printDataInfoLL ( bounds, sites, nsites ) !end if - call this%convertCohortListToVector ( bounds, sites ) + call this%convertCohortListToVector ( bounds, sites, nsites, fcolumn ) if (this%DEBUG) then - call this%printIoInfoLL ( bounds, sites, nsites ) + call this%printIoInfoLL ( bounds, sites, nsites, fcolumn ) call this%printDataInfoLL ( bounds, sites, nsites ) call this%printDataInfoVector ( ) end if @@ -626,7 +628,7 @@ subroutine setVectors( this, bounds, sites ) end subroutine setVectors !-------------------------------------------------------------------------------! - subroutine getVectors( this, bounds, sites, nsites) + subroutine getVectors( this, bounds, sites, nsites, fcolumn) ! ! !DESCRIPTION: ! implement getVectors @@ -639,8 +641,9 @@ subroutine getVectors( this, bounds, sites, nsites) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: sites(:) + type(ed_site_type) , intent(inout), target :: sites(nsites) integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) ! @@ -652,7 +655,7 @@ subroutine getVectors( this, bounds, sites, nsites) write(iulog,*) 'edtime getVectors ',get_nstep() end if - call this%createPatchCohortStructure ( bounds, sites ) + call this%createPatchCohortStructure ( bounds, sites, nsites ) call this%convertCohortVectorToList ( bounds, sites ) @@ -661,8 +664,8 @@ subroutine getVectors( this, bounds, sites, nsites) end do if (this%DEBUG) then - call this%printIoInfoLL ( bounds, sites ) - call this%printDataInfoLL ( bounds, sites ) + call this%printIoInfoLL ( bounds, sites, nsites, fcolumn ) + call this%printDataInfoLL ( bounds, sites, nsites ) call this%printDataInfoVector ( ) end if @@ -1237,7 +1240,7 @@ subroutine printDataInfoLL( this, bounds, sites, nsites ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: sites + type(ed_site_type) , intent(in), target :: sites(nsites) integer , intent(in) :: nsites ! ! !LOCAL VARIABLES: @@ -1370,9 +1373,9 @@ subroutine printIoInfoLL( this, bounds, sites, nsites, fcolumn ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: sites + type(ed_site_type) , intent(in), target :: sites(nsites) integer , intent(in) :: nsites - integer, intent(in) :: fcolumn(this%nsites) + integer , intent(in) :: fcolumn(nsites) ! ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch @@ -1495,27 +1498,28 @@ subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) totalCohorts = 0 - incrementOffset = this%vectorLengthStart - countCohort = this%vectorLengthStart - countPft = this%vectorLengthStart - countNcwd = this%vectorLengthStart - countNclmax = this%vectorLengthStart - countWaterMem = this%vectorLengthStart - countSunZ = this%vectorLengthStart - + if(fcolumn(1).eq.bounds%begc .and. & + (fcolumn(1)-1)*cohorts_per_col.ne.(bounds%begCohort-1)) 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(__FILE__, __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 + + incrementOffset = (fcolumn(s)-1)*cohorts_per_col + 1 + countCohort = (fcolumn(s)-1)*cohorts_per_col + 1 + countPft = (fcolumn(s)-1)*cohorts_per_col + 1 + countNcwd = (fcolumn(s)-1)*cohorts_per_col + 1 + countNclmax = (fcolumn(s)-1)*cohorts_per_col + 1 + countWaterMem = (fcolumn(s)-1)*cohorts_per_col + 1 + countSunZ = (fcolumn(s)-1)*cohorts_per_col + 1 - incrementOffset = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col - countCohort = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col - countPft = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col - countNcwd = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col - countNclmax = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col - countWaterMem = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col - countSunZ = this%vectorLengthStart + (fcolumn(s)-1)*cohorts_per_col - currentPatch => sites(s)%oldest_patch ! new column, reset num patches @@ -1585,131 +1589,128 @@ subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) 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 - this%old_stock(incrementOffset) = ed_allsites_inst(g)%old_stock - this%cd_status(incrementOffset) = ed_allsites_inst(g)%status - this%dd_status(incrementOffset) = ed_allsites_inst(g)%dstatus - this%ncd(incrementOffset) = ed_allsites_inst(g)%ncd - this%leafondate(incrementOffset) = ed_allsites_inst(g)%leafondate - this%leafoffdate(incrementOffset) = ed_allsites_inst(g)%leafoffdate - this%dleafondate(incrementOffset) = ed_allsites_inst(g)%dleafondate - this%dleafoffdate(incrementOffset)= ed_allsites_inst(g)%dleafoffdate - this%acc_NI(incrementOffset) = ed_allsites_inst(g)%acc_NI + countCohort = countCohort + 1 - ! 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 ! numpft_ed currently 2 - 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) - this%seed_bank(countPft) = currentPatch%seed_bank(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,nclmax ! 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 ',nlevcan_ed,numpft_ed,nclmax + currentCohort => currentCohort%taller + + enddo ! currentCohort do while - do k = 1,nlevcan_ed ! nlevcan_ed currently 40 - do j = 1,numpft_ed ! numpft_ed currently 2 - do i = 1,nclmax ! 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 + ! + ! deal with patch level fields here + ! + this%livegrass(incrementOffset) = currentPatch%livegrass + this%age(incrementOffset) = currentPatch%age + this%areaRestart(incrementOffset) = currentPatch%area + + this%old_stock(incrementOffset) = sites(s)%old_stock + this%cd_status(incrementOffset) = sites(s)%status + this%dd_status(incrementOffset) = sites(s)%dstatus + this%ncd(incrementOffset) = sites(s)%ncd + this%leafondate(incrementOffset) = sites(s)%leafondate + this%leafoffdate(incrementOffset) = sites(s)%leafoffdate + this%dleafondate(incrementOffset) = sites(s)%dleafondate + this%dleafoffdate(incrementOffset)= sites(s)%dleafoffdate + this%acc_NI(incrementOffset) = sites(s)%acc_NI + + + ! 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) + this%seed_bank(countPft) = currentPatch%seed_bank(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,nclmax ! 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 ',nlevcan_ed,numpft_ed,nclmax + + do k = 1,nlevcan_ed ! nlevcan_ed currently 40 + do j = 1,numpft_ed ! numpft_ed currently 2 + do i = 1,nclmax ! 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 - - if (this%DEBUG) write(iulog,*) 'CLTV countSunZ 2 ',countSunZ - - ! set numpatches for this gcell - this%numPatchesPerCol( ed_allsites_inst(g)%clmgcell ) = numPatches - - incrementOffset = incrementOffset + numCohortsPerPatch - - ! reset counters so that they are all advanced evenly. Currently - ! the offset is 10, the max of numpft_ed, ncwd, 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 - - ! set which gridcells have patches/cohorts - this%colWithPatch( ed_allsites_inst(g)%clmgcell ) = 1 - - do i = 1,numWaterMem ! numWaterMem currently 10 - this%water_memory( countWaterMem ) = ed_allsites_inst(g)%water_memory(i) - countWaterMem = countWaterMem + 1 end do - - countWaterMem = incrementOffset - - endif ! is there soil check - - g = g + 1 - + + 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, 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 + + ! set numpatches for this gcell + this%numPatchesPerCol(fcolumn(s)) = numPatches + + ! set which columns have patches/cohorts (seems redundant given numPatchesPerCol) + this%colWithPatch(fcolumn(s)) = 1 + + do i = 1,numWaterMem ! numWaterMem currently 10 + this%water_memory( countWaterMem ) = sites(s)%water_memory(i) + countWaterMem = countWaterMem + 1 + end do + + countWaterMem = incrementOffset + enddo - + if (this%DEBUG) then write(iulog,*) 'CLTV total cohorts ',totalCohorts end if - - end subroutine convertCohortListToVector + + return + end subroutine convertCohortListToVector !-------------------------------------------------------------------------------! - subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) + subroutine createPatchCohortStructure( this, bounds, sites, nsites, fcolumn ) ! ! !DESCRIPTION: ! counts the total number of cohorts over all p levels (ed_patch_type) so we @@ -1723,11 +1724,14 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) 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 - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) ! ! !LOCAL VARIABLES: type (ed_patch_type) , pointer :: newp @@ -1737,10 +1741,13 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) real(r8) :: seed_bank_local(numpft_ed) real(r8) :: age !notional age of this patch integer :: cohortstatus - integer :: g,patchIdx,currIdx, fto, ft + integer :: s ! site index + integer :: c ! column index + integer :: g ! grid index + integer :: patchIdx,currIdx, fto, ft !----------------------------------------------------------------------- - currIdx = this%vectorLengthStart + 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 @@ -1753,25 +1760,29 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) ! loop over model grid cells and create patch/cohort structure based on ! restart data ! - do g = bounds%begg, bounds%endg + do s = 1,nsites + + c = fcolumn(s) + g = col%gridcell(c) + + currIdx = (c-1)*cohorts_per_col + 1 ! global cohort index at the head of the column if (this%DEBUG) then - write(iulog,*) 'colWithPatch ',this%colWithPatch(g),this%numPatchesPerCol(g) + write(iulog,*) 'colWithPatch ',this%colWithPatch(c),this%numPatchesPerCol(c) end if - call zero_site( ed_allsites_inst(g) ) + call zero_site( sites(s) ) ! ! set a few items that are necessary on restart for ED but not on the ! restart file ! - ed_allsites_inst(g)%istheresoil = .true. ! if we are dealing with ED data there will always be soil - ed_allsites_inst(g)%lat = grc%latdeg(g) - ed_allsites_inst(g)%lon = grc%londeg(g) - ed_allsites_inst(g)%gdd = 0.0_r8 - ed_allsites_inst(g)%ncd = 0.0_r8 + sites(s)%lat = grc%latdeg(g) + sites(s)%lon = grc%londeg(g) + sites(s)%gdd = 0.0_r8 + sites(s)%ncd = 0.0_r8 ! then this site has soil and should be set here - do patchIdx = 1,this%numPatchesPerCol(g) + do patchIdx = 1,this%numPatchesPerCol(c) if (this%DEBUG) then write(iulog,*) 'create patch ',patchIdx @@ -1783,11 +1794,11 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) call zero_patch(newp) ! make new patch - call create_patch(ed_allsites_inst(g), newp, age, area, & + call create_patch(sites(s), newp, age, area, & spread_local, cwd_ag_local, cwd_bg_local, & leaf_litter_local, root_litter_local, seed_bank_local) - newp%siteptr => ed_allsites_inst(g) + newp%siteptr => sites(s) ! give this patch a unique patch number newp%patchno = patchIdx @@ -1840,31 +1851,31 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) if (this%DEBUG) write(iulog,*) 'patchIdx = 1 ',patchIdx - ed_allsites_inst(g)%youngest_patch => newp - ed_allsites_inst(g)%oldest_patch => newp - ed_allsites_inst(g)%youngest_patch%younger => null() - ed_allsites_inst(g)%youngest_patch%older => null() - ed_allsites_inst(g)%oldest_patch%younger => null() - ed_allsites_inst(g)%oldest_patch%older => null() + 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 - ed_allsites_inst(g)%youngest_patch => newp - ed_allsites_inst(g)%youngest_patch%younger => null() - ed_allsites_inst(g)%youngest_patch%older => ed_allsites_inst(g)%oldest_patch - ed_allsites_inst(g)%oldest_patch%younger => ed_allsites_inst(g)%youngest_patch - ed_allsites_inst(g)%oldest_patch%older => null() + 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 => ed_allsites_inst(g)%youngest_patch - ed_allsites_inst(g)%youngest_patch%younger => newp - newp%younger => null() - ed_allsites_inst(g)%youngest_patch => newp + newp%older => sites(s)%youngest_patch + sites(s)%youngest_patch%younger => newp + newp%younger => null() + sites(s)%youngest_patch => newp endif @@ -1872,12 +1883,12 @@ subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) enddo ! ends loop over patchIdx - enddo ! ends loop over g + enddo ! ends loop over s end subroutine createPatchCohortStructure !-------------------------------------------------------------------------------! - subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) + subroutine convertCohortVectorToList( this, bounds, sites, nsites, fcolumn ) ! ! !DESCRIPTION: ! counts the total number of cohorts over all p levels (ed_patch_type) so we @@ -1889,7 +1900,10 @@ subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) ! !ARGUMENTS: class(EDRestartVectorClass) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) + ! ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch @@ -2114,7 +2128,7 @@ end subroutine convertCohortVectorToList !--------------------------------------------! !-------------------------------------------------------------------------------! - subroutine EDRest ( bounds, sites, nsites, ncid, flag ) + subroutine EDRest ( bounds, sites, nsites, fcolumn, ncid, flag ) ! ! !DESCRIPTION: ! Read/write ED restart data @@ -2128,8 +2142,9 @@ subroutine EDRest ( bounds, sites, nsites, ncid, flag ) ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds ! bounds type(file_desc_t) , intent(inout) :: ncid ! netcdf id - type(ed_site_type) , intent(inout) :: sites ! The site vector - integer , intent(in) :: nsites ! Size of the site vector + type(ed_site_type) , intent(inout) :: sites(nsites) ! The site vector + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) character(len=*) , intent(in) :: flag !'read' or 'write' ! ! !LOCAL VARIABLES: @@ -2145,7 +2160,7 @@ subroutine EDRest ( bounds, sites, nsites, ncid, flag ) end if if ( flag == 'write' ) then - call ervc%setVectors( bounds, sites) ) + call ervc%setVectors( bounds, sites, nsites, fcolumn ) endif call ervc%doVectorIO( ncid, flag ) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index f3b21b781f..a745705871 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -18,6 +18,7 @@ module FatesInterfaceMod use atm2lndType , only : atm2lnd_type use ncdio_pio , only : file_desc_t use PatchType , only : patch + use ColumnType , only : col ! ------------------------------------------------------------------------------------ use EDtypesMod , only : ed_patch_type, ed_site_type, numpft_ed @@ -111,7 +112,7 @@ subroutine init_coldstart(this,fcolumn) call zero_site(this%sites(s)) c = fcolumn(s) - g = gridcell(c) + g = col%gridcell(c) ! TODO-INTERF: col% and grc% should not be accessible here this%sites(s)%lat = grc%latdeg(g) this%sites(s)%lon = grc%londeg(g) diff --git a/components/clm/src/main/ColumnType.F90 b/components/clm/src/main/ColumnType.F90 index 8f230aff91..300c98d296 100644 --- a/components/clm/src/main/ColumnType.F90 +++ b/components/clm/src/main/ColumnType.F90 @@ -86,7 +86,7 @@ subroutine Init(this, begc, endc) allocate(this%wtlunit (begc:endc)) ; this%wtlunit (:) = nan allocate(this%patchi (begc:endc)) ; this%patchi (:) = ispval allocate(this%patchf (begc:endc)) ; this%patchf (:) = ispval - allocate(this%npatches (begc:endc)) ; this%npatches (:) = ispval + allocate(this%npatches (begc:endc)) ; this%npatches (:) = ispval allocate(this%itype (begc:endc)) ; this%itype (:) = ispval allocate(this%active (begc:endc)) ; this%active (:) = .false. From 605b81b72d4996bafb231ca819f713b54758f80d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 25 May 2016 15:20:18 -0700 Subject: [PATCH 06/23] first pass complete at converting EDRestVectorMod to columns. Variable colWithPatch was removed because it is offers no information beyond what is provided by numPatchesPerCol (which is more information rich. Also, old_stock,cd_status,dd_status,ncd,leafondate,leafoffdat,dleafondate,dleafoffdate and acc_NI are stored in the restart as column indexed, as they are site level variables. If these variables are converted to patch-scale, then they need large restart vector allocations. --- .../clm/src/ED/main/EDRestVectorMod.F90 | 673 +++++++++--------- 1 file changed, 335 insertions(+), 338 deletions(-) diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index 840eb63429..1bdffb3792 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -8,13 +8,10 @@ module EDRestVectorMod use clm_varctl , only : iulog use spmdMod , only : masterproc use decompMod , only : bounds_type - use CanopyStateType , only : canopystate_type - use WaterStateType , only : waterstate_type use pftconMod , only : pftcon use EDTypesMod , only : area, cohorts_per_col, numpft_ed, numWaterMem, nclmax, numCohortsPerPatch use EDTypesMod , only : ncwd, invalidValue, nlevcan_ed use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type - use EDPhenologyType , only : ed_phenology_type ! implicit none private @@ -39,7 +36,6 @@ module EDRestVectorMod ! required to map cohorts and patches to/fro ! vectors/LinkedLists - integer, pointer :: colWithPatch(:) integer, pointer :: numPatchesPerCol(:) integer, pointer :: cohortsPerPatch(:) ! @@ -177,7 +173,6 @@ subroutine deleteEDRestartVectorClass( this ) class(EDRestartVectorClass), intent(inout) :: this ! ! !LOCAL VARIABLES: - deallocate(this%colWithPatch ) deallocate(this%numPatchesPerCol ) deallocate(this%cohortsPerPatch ) deallocate(this%balive ) @@ -266,19 +261,64 @@ function newEDRestartVectorClass( bounds ) new%vectorLengthStart = bounds%begCohort new%vectorLengthStop = bounds%endCohort - ! - ! cohort level variables that are required on restart - ! + ! Column level variables + + allocate(new%numPatchesPerCol & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%numPatchesPerCol(:) = invalidValue - allocate(new%colWithPatch & + + allocate(new%old_stock & (bounds%begc:bounds%endc), stat=retVal) SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%colWithPatch(:) = 0 + new%old_stock(:) = 0.0_r8 - allocate(new%numPatchesPerCol & + allocate(new%cd_status & (bounds%begc:bounds%endc), stat=retVal) SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%numPatchesPerCol(:) = invalidValue + new%cd_status(:) = 0_r8 + + allocate(new%dd_status & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%dd_status(:) = 0_r8 + + allocate(new%ncd & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%ncd(:) = 0_r8 + + + allocate(new%leafondate & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%leafondate(:) = 0_r8 + + allocate(new%leafoffdate & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%leafoffdate(:) = 0_r8 + + allocate(new%dleafondate & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%dleafondate(:) = 0_r8 + + allocate(new%dleafoffdate & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%dleafoffdate(:) = 0_r8 + + allocate(new%acc_NI & + (bounds%begc:bounds%endc), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%acc_NI(:) = 0_r8 + + + ! cohort level variables + + allocate(new%cohortsPerPatch & (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) @@ -534,58 +574,16 @@ function newEDRestartVectorClass( bounds ) new%fabi_sha_z(:) = 0.0_r8 ! - ! site level variable + ! 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(__FILE__, __LINE__)) new%water_memory(:) = 0.0_r8 + - allocate(new%old_stock & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%old_stock(:) = 0.0_r8 - - allocate(new%cd_status & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%cd_status(:) = 0_r8 - - allocate(new%dd_status & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%dd_status(:) = 0_r8 - - allocate(new%ncd & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%ncd(:) = 0_r8 - - allocate(new%leafondate & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%leafondate(:) = 0_r8 - - allocate(new%leafoffdate & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%leafoffdate(:) = 0_r8 - - allocate(new%dleafondate & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%dleafondate(:) = 0_r8 - - allocate(new%dleafoffdate & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%dleafoffdate(:) = 0_r8 - - allocate(new%acc_NI & - (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) - SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) - new%acc_NI(:) = 0_r8 end associate @@ -693,21 +691,78 @@ subroutine doVectorIO( this, ncid, flag ) character(len=16) :: dimName = trim(nameCohort) !----------------------------------------------------------------------- - ! - ! cohort level vars - ! - call restartvar(ncid=ncid, flag=flag, varname='ed_io_colWithPatch', xtype=ncd_int, & + call restartvar(ncid=ncid, flag=flag, varname='ed_io_numPatchesPerCol', xtype=ncd_int, & dim1name=namec, & - long_name='1 if a column has a patch', units='1=true,0=false', & - interpinic_flag='interp', data=this%colWithPatch, & + long_name='Num patches per column', units='unitless', & + interpinic_flag='interp', data=this%numPatchesPerCol, & readvar=readvar) - call restartvar(ncid=ncid, flag=flag, varname='ed_io_numPatchesPerCol', xtype=ncd_int, & + call restartvar(ncid=ncid, flag=flag, varname='ed_old_stock', xtype=ncd_double, & dim1name=namec, & - long_name='works with ed_colWithPatch. num patches per column', units='unitless', & - interpinic_flag='interp', data=this%numPatchesPerCol, & + 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=namec, & + 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=namec, & + 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=namec, & + 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=namec, & + 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=namec, & + 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=namec, & + 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=namec, & + 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=namec, & + long_name='ed nesterov index', units='unitless', & + interpinic_flag='interp', data=this%acc_NI, & + readvar=readvar) + + + + ! + ! cohort level vars + ! + + + + call restartvar(ncid=ncid, flag=flag, varname='ed_io_cohortsPerPatch', xtype=ncd_int, & dim1name=dimName, & long_name='list of cohorts per patch. indexed by numPatchesPerCol', units='unitless', & @@ -1021,61 +1076,9 @@ subroutine doVectorIO( this, ncid, flag ) interpinic_flag='interp', data=this%water_memory, & readvar=readvar) - call restartvar(ncid=ncid, flag=flag, varname='ed_old_stock', xtype=ncd_double, & - dim1name=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=dimName, & - long_name='ed cold dec status', units='unitless', & - interpinic_flag='interp', data=this%cd_status, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_dd_status', xtype=ncd_double, & - dim1name=dimName, & - long_name='ed drought dec status', units='unitless', & - interpinic_flag='interp', data=this%dd_status, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_chilling_days', xtype=ncd_double, & - dim1name=dimName, & - long_name='ed chilling day counter', units='unitless', & - interpinic_flag='interp', data=this%ncd, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_leafondate', xtype=ncd_double, & - dim1name=dimName, & - long_name='ed leafondate', units='unitless', & - interpinic_flag='interp', data=this%leafondate, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_leafoffdate', xtype=ncd_double, & - dim1name=dimName, & - long_name='ed leafoffdate', units='unitless', & - interpinic_flag='interp', data=this%leafoffdate, & - readvar=readvar) - call restartvar(ncid=ncid, flag=flag, varname='ed_dleafondate', xtype=ncd_double, & - dim1name=dimName, & - long_name='ed dleafondate', units='unitless', & - interpinic_flag='interp', data=this%dleafondate, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_dleafoffdate', xtype=ncd_double, & - dim1name=dimName, & - long_name='ed dleafoffdate', units='unitless', & - interpinic_flag='interp', data=this%dleafoffdate, & - readvar=readvar) - - call restartvar(ncid=ncid, flag=flag, varname='ed_acc_NI', xtype=ncd_double, & - dim1name=dimName, & - long_name='ed nesterov index', units='unitless', & - interpinic_flag='interp', data=this%acc_NI, & - readvar=readvar) end subroutine doVectorIO @@ -1094,6 +1097,9 @@ subroutine printDataInfoVector( this ) 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 @@ -1207,24 +1213,25 @@ subroutine printDataInfoVector( this ) 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:iSto) + + write(iulog,*) trim(methodName)//' :: old_stock ', & + this%old_stock(iSta:iSta) write(iulog,*) trim(methodName)//' :: cd_status', & - this%cd_status(iSta:iSto) + this%cd_status(iSta:iSta) write(iulog,*) trim(methodName)//' :: dd_status', & - this%cd_status(iSta:iSto) + this%cd_status(iSta:iSta) write(iulog,*) trim(methodName)//' :: ncd', & - this%ncd(iSta:iSto) + this%ncd(iSta:iSta) write(iulog,*) trim(methodName)//' :: leafondate', & - this%leafondate(iSta:iSto) + this%leafondate(iSta:iSta) write(iulog,*) trim(methodName)//' :: leafoffdate', & - this%leafoffdate(iSta:iSto) + this%leafoffdate(iSta:iSta) write(iulog,*) trim(methodName)//' :: dleafondate', & - this%dleafondate(iSta:iSto) + this%dleafondate(iSta:iSta) write(iulog,*) trim(methodName)//' :: dleafoffdate', & - this%dleafoffdate(iSta:iSto) + this%dleafoffdate(iSta:iSta) write(iulog,*) trim(methodName)//' :: acc_NI', & - this%acc_NI(iSta:iSto) + this%acc_NI(iSta:iSta) end subroutine printDataInfoVector @@ -1480,7 +1487,7 @@ subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch type (ed_cohort_type), pointer :: currentCohort - integer :: s + integer :: s, c integer :: totalCohorts ! number of cohorts starting from 1 integer :: countCohort ! number of cohorts starting from ! vectorLengthStart @@ -1511,14 +1518,16 @@ subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) ! 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 = (fcolumn(s)-1)*cohorts_per_col + 1 - countCohort = (fcolumn(s)-1)*cohorts_per_col + 1 - countPft = (fcolumn(s)-1)*cohorts_per_col + 1 - countNcwd = (fcolumn(s)-1)*cohorts_per_col + 1 - countNclmax = (fcolumn(s)-1)*cohorts_per_col + 1 - countWaterMem = (fcolumn(s)-1)*cohorts_per_col + 1 - countSunZ = (fcolumn(s)-1)*cohorts_per_col + 1 + incrementOffset = (c-1)*cohorts_per_col + 1 + countCohort = (c-1)*cohorts_per_col + 1 + countPft = (c-1)*cohorts_per_col + 1 + countNcwd = (c-1)*cohorts_per_col + 1 + countNclmax = (c-1)*cohorts_per_col + 1 + countWaterMem = (c-1)*cohorts_per_col + 1 + countSunZ = (c-1)*cohorts_per_col + 1 currentPatch => sites(s)%oldest_patch @@ -1603,15 +1612,7 @@ subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) this%age(incrementOffset) = currentPatch%age this%areaRestart(incrementOffset) = currentPatch%area - this%old_stock(incrementOffset) = sites(s)%old_stock - this%cd_status(incrementOffset) = sites(s)%status - this%dd_status(incrementOffset) = sites(s)%dstatus - this%ncd(incrementOffset) = sites(s)%ncd - this%leafondate(incrementOffset) = sites(s)%leafondate - this%leafoffdate(incrementOffset) = sites(s)%leafoffdate - this%dleafondate(incrementOffset) = sites(s)%dleafondate - this%dleafoffdate(incrementOffset)= sites(s)%dleafoffdate - this%acc_NI(incrementOffset) = sites(s)%acc_NI + ! set cohorts per patch for IO @@ -1686,20 +1687,25 @@ subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) 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 - ! set numpatches for this gcell - this%numPatchesPerCol(fcolumn(s)) = numPatches - - ! set which columns have patches/cohorts (seems redundant given numPatchesPerCol) - this%colWithPatch(fcolumn(s)) = 1 + ! 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 - countWaterMem = incrementOffset - enddo if (this%DEBUG) then @@ -1767,10 +1773,6 @@ subroutine createPatchCohortStructure( this, bounds, sites, nsites, fcolumn ) currIdx = (c-1)*cohorts_per_col + 1 ! global cohort index at the head of the column - if (this%DEBUG) then - write(iulog,*) 'colWithPatch ',this%colWithPatch(c),this%numPatchesPerCol(c) - end if - call zero_site( sites(s) ) ! ! set a few items that are necessary on restart for ED but not on the @@ -1908,7 +1910,7 @@ subroutine convertCohortVectorToList( this, bounds, sites, nsites, fcolumn ) ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch type (ed_cohort_type),pointer :: currentCohort - integer :: g + integer :: g, c, s integer :: totalCohorts ! number of cohorts starting from 0 integer :: countCohort ! number of cohorts starting from ! vectorLengthStart @@ -1924,197 +1926,192 @@ subroutine convertCohortVectorToList( this, bounds, sites, nsites, fcolumn ) !----------------------------------------------------------------------- totalCohorts = 0 + + do s = 1,nsites + + c = fcolumn(s) + g = col%gridcell(c) - incrementOffset = this%vectorLengthStart - countCohort = this%vectorLengthStart - countPft = this%vectorLengthStart - countNcwd = this%vectorLengthStart - countNclmax = this%vectorLengthStart - countWaterMem = this%vectorLengthStart - countSunZ = this%vectorLengthStart - - g = bounds%begg - do while(g <= bounds%endg) - - if (ed_allsites_inst(g)%istheresoil) then - currentPatch => ed_allsites_inst(g)%oldest_patch - - ! new grid cell, reset num patches - numPatches = 0 - - ed_allsites_inst(g)%clmgcell = g - - 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 = this%gpp(countCohort) - currentCohort%npp = this%npp(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_clm = this%resp_clm(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 + incrementOffset = (c-1)*cohorts_per_col + 1 + countCohort = (c-1)*cohorts_per_col + 1 + countPft = (c-1)*cohorts_per_col + 1 + countNcwd = (c-1)*cohorts_per_col + 1 + countNclmax = (c-1)*cohorts_per_col + 1 + countWaterMem = (c-1)*cohorts_per_col + 1 + countSunZ = (c-1)*cohorts_per_col + 1 - currentCohort => currentCohort%taller + currentPatch => sites(s)%oldest_patch + + ! new grid cell, reset num patches + numPatches = 0 - enddo ! currentPatch 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%seed_bank(:) = 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) - ed_allsites_inst(g)%old_stock = this%old_stock(incrementOffset) - ed_allsites_inst(g)%status = this%cd_status(incrementOffset) - ed_allsites_inst(g)%dstatus = this%dd_status(incrementOffset) - ed_allsites_inst(g)%ncd = this%ncd(incrementOffset) - ed_allsites_inst(g)%leafondate = this%leafondate(incrementOffset) - ed_allsites_inst(g)%leafoffdate = this%leafoffdate(incrementOffset) - ed_allsites_inst(g)%dleafondate = this%dleafondate(incrementOffset) - ed_allsites_inst(g)%dleafoffdate = this%dleafoffdate(incrementOffset) - ed_allsites_inst(g)%acc_NI = this%acc_NI(incrementOffset) - - ! set cohorts per patch for IO + 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 III ' & - ,countCohort,cohorts_per_col, numCohort + write(iulog,*) 'CVTL countCohort ',countCohort, this%vectorLengthStart, this%vectorLengthStop 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) - currentPatch%seed_bank(i) = this%seed_bank(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,nclmax ! 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,nlevcan_ed ! nlevcan_ed currently 40 - do j = 1,numpft_ed ! numpft_ed currently 2 - do i = 1,nclmax ! 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 + + 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 = this%gpp(countCohort) + currentCohort%npp = this%npp(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_clm = this%resp_clm(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%seed_bank(:) = 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) + currentPatch%seed_bank(i) = this%seed_bank(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,nclmax ! 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,nlevcan_ed ! nlevcan_ed currently 40 + do j = 1,numpft_ed ! numpft_ed currently 2 + do i = 1,nclmax ! 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 - - if (this%DEBUG) write(iulog,*) 'CVTL countSunZ 2 ',countSunZ - - incrementOffset = incrementOffset + numCohortsPerPatch - - ! reset counters so that they are all advanced evenly. Currently - ! the offset must be > 160, nlevcan_ed*numpft_ed*nclmax - ! 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 - ed_allsites_inst(g)%water_memory(i) = this%water_memory( countWaterMem ) - countWaterMem = countWaterMem + 1 end do + + if (this%DEBUG) write(iulog,*) 'CVTL countSunZ 2 ',countSunZ + + incrementOffset = incrementOffset + numCohortsPerPatch - countWaterMem = incrementOffset - - endif ! is there soil check - - g = g + 1 + ! 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) + enddo if (this%DEBUG) then @@ -2166,7 +2163,7 @@ subroutine EDRest ( bounds, sites, nsites, fcolumn, ncid, flag ) call ervc%doVectorIO( ncid, flag ) if ( flag == 'read' ) then - call ervc%getVectors( bounds, sites, nsites ) + call ervc%getVectors( bounds, sites, nsites, fcolumn ) endif call ervc%deleteEDRestartVectorClass () From ef06474096c477379becc5fab9d40669530225fc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 25 May 2016 17:41:47 -0700 Subject: [PATCH 07/23] modified call sequence to restart initialization, passed clm_fates%f2hmap(nc)%fcolumn --- .../clm/src/ED/main/EDRestVectorMod.F90 | 28 +++++++--- .../clm/src/ED/main/FatesInterfaceMod.F90 | 5 +- components/clm/src/main/clm_driver.F90 | 4 +- components/clm/src/main/clm_instMod.F90 | 22 ++------ .../clm/src/utils/clmfates_interfaceMod.F90 | 51 ++++++++++++++++++- 5 files changed, 79 insertions(+), 31 deletions(-) diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index 1bdffb3792..b7f31403c4 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -12,6 +12,7 @@ module EDRestVectorMod use EDTypesMod , only : area, cohorts_per_col, numpft_ed, numWaterMem, nclmax, numCohortsPerPatch use EDTypesMod , only : ncwd, invalidValue, nlevcan_ed use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use abortutils , only : endrun ! implicit none private @@ -267,7 +268,6 @@ function newEDRestartVectorClass( bounds ) (bounds%begc:bounds%endc), stat=retVal) SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) new%numPatchesPerCol(:) = invalidValue - allocate(new%old_stock & (bounds%begc:bounds%endc), stat=retVal) @@ -1399,7 +1399,7 @@ subroutine printIoInfoLL( this, bounds, sites, nsites, fcolumn ) write(iulog,*) 'vecLenStart ',this%vectorLengthStart - do s=1,nsites + do s = 1,nsites currentPatch => sites(s)%oldest_patch @@ -1506,8 +1506,8 @@ subroutine convertCohortListToVector( this, bounds, sites, nsites, fcolumn ) totalCohorts = 0 if(fcolumn(1).eq.bounds%begc .and. & - (fcolumn(1)-1)*cohorts_per_col.ne.(bounds%begCohort-1)) then - write(iulog,*) 'fcolumn(1) in this clump points to the first column of the clump' + (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(__FILE__, __LINE__)) end if @@ -1783,7 +1783,23 @@ subroutine createPatchCohortStructure( this, bounds, sites, nsites, fcolumn ) sites(s)%gdd = 0.0_r8 sites(s)%ncd = 0.0_r8 - ! then this site has soil and should be set here + 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(__FILE__, __LINE__)) + end if + + ! This site may have some patches on it, but lets initialize it with null pointers + ! just in-case there are no patches + + sites(s)%youngest_patch => null() + sites(s)%oldest_patch => null() + sites(s)%youngest_patch%younger => null() + sites(s)%youngest_patch%older => null() + sites(s)%oldest_patch%younger => null() + sites(s)%oldest_patch%older => null() + + do patchIdx = 1,this%numPatchesPerCol(c) if (this%DEBUG) then @@ -1887,7 +1903,7 @@ subroutine createPatchCohortStructure( this, bounds, sites, nsites, fcolumn ) enddo ! ends loop over s - end subroutine createPatchCohortStructure + end subroutine createPatchCohortStructure !-------------------------------------------------------------------------------! subroutine convertCohortVectorToList( this, bounds, sites, nsites, fcolumn ) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index a745705871..9617826d38 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -132,7 +132,7 @@ end subroutine init_coldstart ! ------------------------------------------------------------------------------------ - subroutine init_restart(this, bounds_clump, ncid, flag ) + subroutine init_restart(this, bounds_clump, ncid, flag, fcolumn ) implicit none class(fates_interface_type), intent(inout) :: this @@ -140,8 +140,7 @@ subroutine init_restart(this, bounds_clump, ncid, flag ) type(file_desc_t) , intent(inout) :: ncid ! netcdf id character(len=*) , intent(in) :: flag !'read' or 'write' - call EDRest( bounds_clump, this%sites, this%nsites, - ncid, flag ) + call EDRest( bounds_clump, this%sites, this%nsites, fcolumn, ncid, flag ) return end subroutine init_restart diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 16390ac18d..11e8883b13 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -461,9 +461,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! INTERF-TODO: FATES(NC) SHOULD ONLY BE VISIBLE TO THE INTERFACE ! AND ONLY FATES API DEFINED TYPES SHOULD BE PASSED TO IT ! NEEDS A WRAPPER - call CanopyFluxes(bounds_clump, & + call CanopyFluxes(bounds_clump, & filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & - clm_fates%fates(nc)%sites(bounds_clump%begg:bounds_clump%endg), & + clm_fates%fates(nc)%sites, & atm2lnd_inst, canopystate_inst, cnveg_state_inst, & energyflux_inst, frictionvel_inst, soilstate_inst, solarabs_inst, surfalb_inst, & temperature_inst, waterflux_inst, waterstate_inst, ch4_inst, ozone_inst, photosyns_inst, & diff --git a/components/clm/src/main/clm_instMod.F90 b/components/clm/src/main/clm_instMod.F90 index c6e899be12..270ed17323 100644 --- a/components/clm/src/main/clm_instMod.F90 +++ b/components/clm/src/main/clm_instMod.F90 @@ -577,26 +577,10 @@ subroutine clm_instRest(bounds, ncid, flag) ! cannot handle multiple open files on one node. So we are not ! forking the reads call clm_fates%phen_inst%restart(bounds, ncid, flag) - nclumps = get_proc_clumps() - do nc = 1, nclumps - call get_clump_bounds(nc, bounds_clump) - ! INTERF-TODO: THIS CALL SHOULD NOT CALL FATES(NC) DIRECTLY - ! BUT IT SHOULD PASS bounds_clump TO A CLM_FATES WRAPPER - ! WHICH WILL IN TURN PASS A FATES API DEFINED BOUNDS TO FATES_INIT - ! WE ARE NOT READY FOR THAT YET AS fates_restart FUNCTIONS STILL - ! CALL CLM STUFF - call clm_fates%fates(nc)%fates_restart(bounds_clump,ncid, flag ) - - - if ( trim(flag) == 'read' ) then - - call clm_fates%fates2hlm_link(bounds_clump, nc, waterstate_inst, canopystate_inst) - - end if - end do - - call clm_fates%fates2hlm%restart(bounds, ncid, flag) + ! Bounds are not passed to FATES init_restart because + ! we call a loop on clumps within this subroutine anyway + call clmfates%init_restart(ncid,flag) end if diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index e5334c5132..c194ae3a0c 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -74,6 +74,10 @@ module CLMFatesInterfaceMod ! This vector may be sparse, and non-sites have index 0 integer, allocatable :: hsites (:) + ! + + + end type f2hmap_type @@ -221,7 +225,7 @@ subroutine init(this,bounds_proc, use_ed) allocate(self%f2hmap(nc)%fcolumn(s)) ! Assign the h2hmap indexing - self%f2hmap(nc)%column(1:s) = collist(1:s) + self%f2hmap(nc)%fcolumn(1:s) = collist(1:s) ! Deallocate the temporary arrays deallocate(collist) @@ -362,6 +366,51 @@ subroutine dynamics_driv(this, nc, bounds_clump, & return end subroutine dynamics_driv + + ! ------------------------------------------------------------------------------------ + + subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) + + implicit none + + ! Arguments + class(hlm_fates_interface_type), intent(inout) :: this + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + type(waterstate_type) , intent(in) :: waterstate_inst + type(canopystate_type) , intent(in) :: canopystate_inst + + ! Locals + type(bounds_type) :: bounds_clump + integer :: nc + integer :: nclumps + + nclumps = get_proc_clumps() + do nc = 1, nclumps + call get_clump_bounds(nc, bounds_clump) + + call EDRest( bounds_clump, this%fates(nc)%sites, this%fates(nc)%nsites, & + this%f2hmap(nc)%fcolumn, ncid, flag ) + + if ( trim(flag) == 'read' ) then + + call this%fates2hlm%ed_clm_link( bounds_clump, & + this%fates(nc)%sites, & + this%phen_inst, & + waterstate_inst, & + canopystate_inst) + + + end if + end do + + call clm_fates%fates2hlm%restart(bounds, ncid, flag) + + return + end subroutine init_restart + + + ! ------------------------------------------------------------------------------------ ! THESE WRAPPERS MAY COME IN HANDY, KEEPING FOR NOW ! subroutine set_fates2hlm(this,bounds_clump, setval_scalar) From 145a3d3303b52c53a8f3020bc5e802b8aad58dd7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 25 May 2016 19:08:28 -0700 Subject: [PATCH 08/23] starting conversion of EDCLMLink to columns. --- components/clm/src/ED/main/EDCLMLinkMod.F90 | 245 ++++++++++---------- 1 file changed, 122 insertions(+), 123 deletions(-) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index df5bc8f308..90bf514a9c 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -91,35 +91,35 @@ module EDCLMLinkMod real(r8), pointer, private :: maint_resp_patch (:) ! (gC/m2/s) patch maintenance respiration real(r8), pointer, private :: growth_resp_patch (:) ! (gC/m2/s) patch growth respiration - real(r8), pointer :: ed_gpp_gd_scpf (:,:) ! [kg/m2/yr] gross primary production - real(r8), pointer :: ed_npp_totl_gd_scpf (:,:) ! [kg/m2/yr] net primary production (npp) - real(r8), pointer :: ed_npp_leaf_gd_scpf (:,:) ! [kg/m2/yr] npp flux into leaf pool - real(r8), pointer :: ed_npp_seed_gd_scpf (:,:) ! [kg/m2/yr] npp flux into flower,fruit,nut,seed - real(r8), pointer :: ed_npp_fnrt_gd_scpf (:,:) ! [kg/m2/yr] npp flux into fine roots - real(r8), pointer :: ed_npp_bgsw_gd_scpf (:,:) ! [kg/m2/yr] npp flux into below ground sapwood - real(r8), pointer :: ed_npp_bgdw_gd_scpf (:,:) ! [kg/m2/yr] npp flux into below ground structural (dead) wood - real(r8), pointer :: ed_npp_agsw_gd_scpf (:,:) ! [kg/m2/yr] npp flux into above ground sapwood - real(r8), pointer :: ed_npp_agdw_gd_scpf (:,:) ! [kg/m2/yr] npp flux into below ground structural (dead) wood - real(r8), pointer :: ed_npp_stor_gd_scpf (:,:) ! [kg/m2/yr] npp flux through the storage pool - real(r8), pointer :: ed_litt_leaf_gd_scpf (:,:) ! [kg/m2/yr] carbon flux of live leaves to litter - real(r8), pointer :: ed_litt_fnrt_gd_scpf (:,:) ! [kg/m2/yr] carbon flux of fine roots to litter - real(r8), pointer :: ed_litt_sawd_gd_scpf (:,:) ! [kg/m2/yr] carbon flux of sapwood to litter (above+below) - real(r8), pointer :: ed_litt_ddwd_gd_scpf (:,:) ! [kg/m2/yr] carbon flux of dead wood (above+below) to litter - real(r8), pointer :: ed_r_leaf_gd_scpf (:,:) ! [kg/m2/yr] total leaf respiration - real(r8), pointer :: ed_r_stem_gd_scpf (:,:) ! [kg/m2/yr] total above ground live wood (stem) respiration - real(r8), pointer :: ed_r_root_gd_scpf (:,:) ! [kg/m2/yr] total below ground live wood (root) respiration - real(r8), pointer :: ed_r_stor_gd_scpf (:,:) ! [kg/m2/yr] total storage respiration + real(r8), pointer :: ed_gpp_col_scpf (:,:) ! [kg/m2/yr] gross primary production + real(r8), pointer :: ed_npp_totl_col_scpf (:,:) ! [kg/m2/yr] net primary production (npp) + real(r8), pointer :: ed_npp_leaf_col_scpf (:,:) ! [kg/m2/yr] npp flux into leaf pool + real(r8), pointer :: ed_npp_seed_col_scpf (:,:) ! [kg/m2/yr] npp flux into flower,fruit,nut,seed + real(r8), pointer :: ed_npp_fnrt_col_scpf (:,:) ! [kg/m2/yr] npp flux into fine roots + real(r8), pointer :: ed_npp_bgsw_col_scpf (:,:) ! [kg/m2/yr] npp flux into below ground sapwood + real(r8), pointer :: ed_npp_bgdw_col_scpf (:,:) ! [kg/m2/yr] npp flux into below ground structural (dead) wood + real(r8), pointer :: ed_npp_agsw_col_scpf (:,:) ! [kg/m2/yr] npp flux into above ground sapwood + real(r8), pointer :: ed_npp_agdw_col_scpf (:,:) ! [kg/m2/yr] npp flux into below ground structural (dead) wood + real(r8), pointer :: ed_npp_stor_col_scpf (:,:) ! [kg/m2/yr] npp flux through the storage pool + real(r8), pointer :: ed_litt_leaf_col_scpf (:,:) ! [kg/m2/yr] carbon flux of live leaves to litter + real(r8), pointer :: ed_litt_fnrt_col_scpf (:,:) ! [kg/m2/yr] carbon flux of fine roots to litter + real(r8), pointer :: ed_litt_sawd_col_scpf (:,:) ! [kg/m2/yr] carbon flux of sapwood to litter (above+below) + real(r8), pointer :: ed_litt_ddwd_col_scpf (:,:) ! [kg/m2/yr] carbon flux of dead wood (above+below) to litter + real(r8), pointer :: ed_r_leaf_col_scpf (:,:) ! [kg/m2/yr] total leaf respiration + real(r8), pointer :: ed_r_stem_col_scpf (:,:) ! [kg/m2/yr] total above ground live wood (stem) respiration + real(r8), pointer :: ed_r_root_col_scpf (:,:) ! [kg/m2/yr] total below ground live wood (root) respiration + real(r8), pointer :: ed_r_stor_col_scpf (:,:) ! [kg/m2/yr] total storage respiration ! Carbon State Variables for direct comparison to inventory - dimensions: (disturbance patch, pft x size) - real(r8), pointer :: ed_ddbh_gd_scpf (:,:) ! [cm/yr] diameter increment - real(r8), pointer :: ed_ba_gd_scpf (:,:) ! [m2/ha] basal area - real(r8), pointer :: ed_np_gd_scpf (:,:) ! [/m2] number of plants - real(r8), pointer :: ed_m1_gd_scpf (:,:) ! [Stems/ha/yr] Mean Background Mortality - real(r8), pointer :: ed_m2_gd_scpf (:,:) ! [Stems/ha/yr] Mean Hydraulic Mortaliry - real(r8), pointer :: ed_m3_gd_scpf (:,:) ! [Stems/ha/yr] Mean Carbon Starvation Mortality - real(r8), pointer :: ed_m4_gd_scpf (:,:) ! [Stems/ha/yr] Mean Impact Mortality - real(r8), pointer :: ed_m5_gd_scpf (:,:) ! [Stems/ha/yr] Mean Fire Mortality + real(r8), pointer :: ed_ddbh_col_scpf (:,:) ! [cm/yr] diameter increment + real(r8), pointer :: ed_ba_col_scpf (:,:) ! [m2/ha] basal area + real(r8), pointer :: ed_np_col_scpf (:,:) ! [/m2] number of plants + real(r8), pointer :: ed_m1_col_scpf (:,:) ! [Stems/ha/yr] Mean Background Mortality + real(r8), pointer :: ed_m2_col_scpf (:,:) ! [Stems/ha/yr] Mean Hydraulic Mortaliry + real(r8), pointer :: ed_m3_col_scpf (:,:) ! [Stems/ha/yr] Mean Carbon Starvation Mortality + real(r8), pointer :: ed_m4_col_scpf (:,:) ! [Stems/ha/yr] Mean Impact Mortality + real(r8), pointer :: ed_m5_col_scpf (:,:) ! [Stems/ha/yr] Mean Fire Mortality ! litterfall fluxes of C from ED patches to BGC columns real(r8), pointer, public :: ED_c_to_litr_lab_c_col(:,:) !total labile litter coming from ED. gC/m3/s @@ -228,7 +228,6 @@ subroutine InitAllocate(this, bounds) begp = bounds%begp; endp = bounds%endp begc = bounds%begc; endc = bounds%endc - begg = bounds%begg; endg = bounds%endg allocate(this%trimming_patch (begp:endp)) ; this%trimming_patch (:) = 0.0_r8 @@ -318,34 +317,34 @@ subroutine InitAllocate(this, bounds) allocate(this%ed_npatches_col (begc:endc)) ; this%ed_npatches_col (:) = nan allocate(this%ed_ncohorts_col (begc:endc)) ; this%ed_ncohorts_col (:) = nan - allocate(this%ed_gpp_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_gpp_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_totl_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_totl_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_leaf_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_leaf_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_seed_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_seed_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_fnrt_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_fnrt_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_bgsw_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_bgsw_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_bgdw_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_bgdw_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_agsw_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_agsw_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_agdw_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_agdw_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_npp_stor_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_npp_stor_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_litt_leaf_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_litt_leaf_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_litt_fnrt_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_litt_fnrt_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_litt_sawd_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_litt_sawd_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_litt_ddwd_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_litt_ddwd_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_r_leaf_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_r_leaf_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_r_stem_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_r_stem_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_r_root_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_r_root_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_r_stor_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)); this%ed_r_stor_gd_scpf (:,:) = 0.0_r8 + allocate(this%ed_gpp_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_gpp_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_totl_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_totl_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_leaf_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_leaf_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_seed_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_seed_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_fnrt_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_fnrt_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_bgsw_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_bgsw_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_bgdw_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_bgdw_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_agsw_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_agsw_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_agdw_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_agdw_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_npp_stor_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_npp_stor_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_litt_leaf_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_litt_leaf_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_litt_fnrt_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_litt_fnrt_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_litt_sawd_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_litt_sawd_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_litt_ddwd_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_litt_ddwd_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_r_leaf_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_r_leaf_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_r_stem_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_r_stem_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_r_root_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_r_root_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_r_stor_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)); this%ed_r_stor_col_scpf (:,:) = 0.0_r8 ! Carbon State Variables for direct comparison to inventory - dimensions: (disturbance patch, pft x size) - allocate(this%ed_ddbh_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_ddbh_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_ba_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_ba_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_np_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_np_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_m1_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_m1_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_m2_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_m2_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_m3_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_m3_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_m4_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_m4_gd_scpf (:,:) = 0.0_r8 - allocate(this%ed_m5_gd_scpf (begg:endg,1:nlevsclass_ed*mxpft)) ; this%ed_m5_gd_scpf (:,:) = 0.0_r8 + allocate(this%ed_ddbh_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_ddbh_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_ba_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_ba_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_np_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_np_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_m1_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_m1_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_m2_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_m2_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_m3_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_m3_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_m4_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_m4_col_scpf (:,:) = 0.0_r8 + allocate(this%ed_m5_col_scpf (begc:endc,1:nlevsclass_ed*mxpft)) ; this%ed_m5_col_scpf (:,:) = 0.0_r8 end subroutine InitAllocate @@ -631,73 +630,73 @@ subroutine InitHistory(this, bounds) ! Carbon Flux (grid dimension x scpf) ! ============================================================== - call hist_addfld2d (fname='ED_GPP_GD_SCPF',units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d (fname='ED_GPP_COL_SCPF',units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='gross primary production', & - ptr_gcell=this%ed_gpp_gd_scpf,default='inactive') + ptr_gcell=this%ed_gpp_col_scpf,default='inactive') - call hist_addfld2d (fname='ED_NPP_LEAF_GD_SCPF',units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d (fname='ED_NPP_LEAF_COL_SCPF',units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into leaves', & - ptr_gcell=this%ed_npp_leaf_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_leaf_col_scpf,default='inactive') - call hist_addfld2d (fname='ED_NPP_SEED_GD_SCPF',units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d (fname='ED_NPP_SEED_COL_SCPF',units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into seeds', & - ptr_gcell=this%ed_npp_seed_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_seed_col_scpf,default='inactive') - call hist_addfld2d (fname='ED_NPP_FNRT_GD_SCPF',units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d (fname='ED_NPP_FNRT_COL_SCPF',units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into fine roots', & - ptr_gcell=this%ed_npp_fnrt_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_fnrt_col_scpf,default='inactive') - call hist_addfld2d (fname='ED_NPP_BGSW_GD_SCPF',units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d (fname='ED_NPP_BGSW_COL_SCPF',units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into below-ground sapwood', & - ptr_gcell=this%ed_npp_bgsw_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_bgsw_col_scpf,default='inactive') - call hist_addfld2d (fname='ED_NPP_BGDW_GD_SCPF',units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d (fname='ED_NPP_BGDW_COL_SCPF',units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into below-ground deadwood', & - ptr_gcell=this%ed_npp_bgdw_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_bgdw_col_scpf,default='inactive') - call hist_addfld2d (fname='ED_NPP_AGSW_GD_SCPF',units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d (fname='ED_NPP_AGSW_COL_SCPF',units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into above-ground sapwood', & - ptr_gcell=this%ed_npp_agsw_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_agsw_col_scpf,default='inactive') - call hist_addfld2d ( fname = 'ED_NPP_AGDW_GD_SCPF', units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d ( fname = 'ED_NPP_AGDW_COL_SCPF', units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into above-ground deadwood', & - ptr_gcell=this%ed_npp_agdw_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_agdw_col_scpf,default='inactive') - call hist_addfld2d ( fname = 'ED_NPP_STOR_GD_SCPF', units='kgC/m2/yr',type2d='levscpf',& + call hist_addfld2d ( fname = 'ED_NPP_STOR_COL_SCPF', units='kgC/m2/yr',type2d='levscpf',& avgflag='A', long_name='NPP flux into storage', & - ptr_gcell=this%ed_npp_stor_gd_scpf,default='inactive') + ptr_gcell=this%ed_npp_stor_col_scpf,default='inactive') - call hist_addfld2d (fname='ED_DDBH_GD_SCPF', units = 'cm/yr/ha', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_DDBH_COL_SCPF', units = 'cm/yr/ha', type2d = 'levscpf', & avgflag='A', long_name='diameter growth increment and pft/size', & - ptr_gcell=this%ed_ddbh_gd_scpf, default='inactive') + ptr_gcell=this%ed_ddbh_col_scpf, default='inactive') - call hist_addfld2d (fname='ED_BA_GD_SCPF',units = 'm2/ha', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_BA_COL_SCPF',units = 'm2/ha', type2d = 'levscpf', & avgflag='A', long_name='basal area by patch and pft/size', & - ptr_gcell=this%ed_ba_gd_scpf, default='inactive') + ptr_gcell=this%ed_ba_col_scpf, default='inactive') - call hist_addfld2d (fname='ED_NPLANT_GD_SCPF',units = 'N/ha', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_NPLANT_COL_SCPF',units = 'N/ha', type2d = 'levscpf', & avgflag='A', long_name='stem number density by patch and pft/size', & - ptr_gcell=this%ed_np_gd_scpf, default='inactive') + ptr_gcell=this%ed_np_col_scpf, default='inactive') - call hist_addfld2d (fname='ED_M1_GD_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_M1_COL_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & avgflag='A', long_name='background mortality count by patch and pft/size', & - ptr_gcell=this%ed_m1_gd_scpf, default='inactive') + ptr_gcell=this%ed_m1_col_scpf, default='inactive') - call hist_addfld2d (fname='ED_M2_GD_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_M2_COL_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & avgflag='A', long_name='hydraulic mortality count by patch and pft/size', & - ptr_gcell=this%ed_m2_gd_scpf, default='inactive') + ptr_gcell=this%ed_m2_col_scpf, default='inactive') - call hist_addfld2d (fname='ED_M3_GD_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_M3_COL_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & avgflag='A', long_name='carbon starvation mortality count by patch and pft/size', & - ptr_gcell=this%ed_m3_gd_scpf, default='inactive') + ptr_gcell=this%ed_m3_col_scpf, default='inactive') - call hist_addfld2d (fname='ED_M4_GD_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_M4_COL_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & avgflag='A', long_name='impact mortality count by patch and pft/size', & - ptr_gcell=this%ed_m4_gd_scpf, default='inactive') + ptr_gcell=this%ed_m4_col_scpf, default='inactive') - call hist_addfld2d (fname='ED_M5_GD_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & + call hist_addfld2d (fname='ED_M5_COL_SCPF',units = 'N/ha/yr', type2d = 'levscpf', & avgflag='A', long_name='fire mortality count by patch and pft/size', & - ptr_gcell=this%ed_m5_gd_scpf, default='inactive') + ptr_gcell=this%ed_m5_col_scpf, default='inactive') this%ed_npatches_col(begc:endc) = spval call hist_addfld1d (fname='ED_NPATCHES', units='unitless', & @@ -949,7 +948,7 @@ subroutine SetValues( this, bounds, val) end subroutine SetValues !----------------------------------------------------------------------- - subroutine ed_clm_link( this, bounds, ed_allsites_inst, ed_phenology_inst, & + subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, ed_phenology_inst, & waterstate_inst, canopystate_inst) ! ! !USES: @@ -1288,28 +1287,28 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & phen_cd_status => ed_phenology_inst%phen_cd_status_patch , & ! InOut: - ed_gpp_scpf => this%ed_gpp_gd_scpf , & - ed_npp_totl_scpf => this%ed_npp_totl_gd_scpf , & - ed_npp_leaf_scpf => this%ed_npp_leaf_gd_scpf , & - ed_npp_seed_scpf => this%ed_npp_seed_gd_scpf , & - ed_npp_fnrt_scpf => this%ed_npp_fnrt_gd_scpf , & - ed_npp_bgsw_scpf => this%ed_npp_bgsw_gd_scpf , & - ed_npp_bgdw_scpf => this%ed_npp_bgdw_gd_scpf , & - ed_npp_agsw_scpf => this%ed_npp_agsw_gd_scpf , & - ed_npp_agdw_scpf => this%ed_npp_agdw_gd_scpf , & - ed_npp_stor_scpf => this%ed_npp_stor_gd_scpf , & + ed_gpp_scpf => this%ed_gpp_col_scpf , & + ed_npp_totl_scpf => this%ed_npp_totl_col_scpf , & + ed_npp_leaf_scpf => this%ed_npp_leaf_col_scpf , & + ed_npp_seed_scpf => this%ed_npp_seed_col_scpf , & + ed_npp_fnrt_scpf => this%ed_npp_fnrt_col_scpf , & + ed_npp_bgsw_scpf => this%ed_npp_bgsw_col_scpf , & + ed_npp_bgdw_scpf => this%ed_npp_bgdw_col_scpf , & + ed_npp_agsw_scpf => this%ed_npp_agsw_col_scpf , & + ed_npp_agdw_scpf => this%ed_npp_agdw_col_scpf , & + ed_npp_stor_scpf => this%ed_npp_stor_col_scpf , & ed_npatches => this%ed_npatches_col , & ed_ncohorts => this%ed_ncohorts_col , & - ed_ddbh_gd_scpf => this%ed_ddbh_gd_scpf , & - ed_ba_gd_scpf => this%ed_ba_gd_scpf , & - ed_np_gd_scpf => this%ed_np_gd_scpf , & - ed_m1_gd_scpf => this%ed_m1_gd_scpf , & - ed_m2_gd_scpf => this%ed_m2_gd_scpf , & - ed_m3_gd_scpf => this%ed_m3_gd_scpf , & - ed_m4_gd_scpf => this%ed_m4_gd_scpf , & - ed_m5_gd_scpf => this%ed_m5_gd_scpf , & + ed_ddbh_col_scpf => this%ed_ddbh_col_scpf , & + ed_ba_col_scpf => this%ed_ba_col_scpf , & + ed_np_col_scpf => this%ed_np_col_scpf , & + ed_m1_col_scpf => this%ed_m1_col_scpf , & + ed_m2_col_scpf => this%ed_m2_col_scpf , & + ed_m3_col_scpf => this%ed_m3_col_scpf , & + ed_m4_col_scpf => this%ed_m4_col_scpf , & + ed_m5_col_scpf => this%ed_m5_col_scpf , & tlai => canopystate_inst%tlai_patch , & ! InOut: elai => canopystate_inst%elai_patch , & ! InOut: @@ -1367,14 +1366,14 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & ed_npp_agdw_scpf(:,:) = 0.0_r8 ed_npp_stor_scpf(:,:) = 0.0_r8 - ed_ddbh_gd_scpf(:,:) = 0.0_r8 - ed_ba_gd_scpf(:,:) = 0.0_r8 - ed_np_gd_scpf(:,:) = 0.0_r8 - ed_m1_gd_scpf(:,:) = 0.0_r8 - ed_m2_gd_scpf(:,:) = 0.0_r8 - ed_m3_gd_scpf(:,:) = 0.0_r8 - ed_m4_gd_scpf(:,:) = 0.0_r8 - ed_m5_gd_scpf(:,:) = 0.0_r8 + ed_ddbh_col_scpf(:,:) = 0.0_r8 + ed_ba_col_scpf(:,:) = 0.0_r8 + ed_np_col_scpf(:,:) = 0.0_r8 + ed_m1_col_scpf(:,:) = 0.0_r8 + ed_m2_col_scpf(:,:) = 0.0_r8 + ed_m3_col_scpf(:,:) = 0.0_r8 + ed_m4_col_scpf(:,:) = 0.0_r8 + ed_m5_col_scpf(:,:) = 0.0_r8 ed_npatches(:) = 0._r8 ed_ncohorts(:) = 0._r8 @@ -1503,25 +1502,25 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & ! Woody State Variables (basal area and number density and mortality) if (pftcon%woody(ft) == 1) then - ed_m1_gd_scpf(g,scpf) = ed_m1_gd_scpf(g,scpf) + currentcohort%bmort*n_perm2*AREA - ed_m2_gd_scpf(g,scpf) = ed_m2_gd_scpf(g,scpf) + currentcohort%hmort*n_perm2*AREA - ed_m3_gd_scpf(g,scpf) = ed_m3_gd_scpf(g,scpf) + currentcohort%cmort*n_perm2*AREA - ed_m4_gd_scpf(g,scpf) = ed_m4_gd_scpf(g,scpf) + currentcohort%imort*n_perm2*AREA - ed_m5_gd_scpf(g,scpf) = ed_m5_gd_scpf(g,scpf) + currentcohort%fmort*n_perm2*AREA + ed_m1_col_scpf(g,scpf) = ed_m1_col_scpf(g,scpf) + currentcohort%bmort*n_perm2*AREA + ed_m2_col_scpf(g,scpf) = ed_m2_col_scpf(g,scpf) + currentcohort%hmort*n_perm2*AREA + ed_m3_col_scpf(g,scpf) = ed_m3_col_scpf(g,scpf) + currentcohort%cmort*n_perm2*AREA + ed_m4_col_scpf(g,scpf) = ed_m4_col_scpf(g,scpf) + currentcohort%imort*n_perm2*AREA + ed_m5_col_scpf(g,scpf) = ed_m5_col_scpf(g,scpf) + currentcohort%fmort*n_perm2*AREA ! basal area [m2/ha] - ed_ba_gd_scpf(g,scpf) = ed_ba_gd_scpf(g,scpf) + & + ed_ba_col_scpf(g,scpf) = ed_ba_col_scpf(g,scpf) + & 0.25*3.14159*((dbh/100.0)**2.0)*n_perm2*AREA ! number density [/ha] - ed_np_gd_scpf(g,scpf) = ed_np_gd_scpf(g,scpf) + AREA*n_perm2 + ed_np_col_scpf(g,scpf) = ed_np_col_scpf(g,scpf) + AREA*n_perm2 ! Growth Incrments must have NaN check and woody check if(currentCohort%ddbhdt == currentCohort%ddbhdt) then - ed_ddbh_gd_scpf(g,scpf) = ed_ddbh_gd_scpf(g,scpf) + & + ed_ddbh_col_scpf(g,scpf) = ed_ddbh_col_scpf(g,scpf) + & currentCohort%ddbhdt*n_perm2*AREA else - ed_ddbh_gd_scpf(g,scpf) = -999.9 + ed_ddbh_col_scpf(g,scpf) = -999.9 end if end if From d88898976f3ee81dc8aa06a94e5c9d2e08796fe5 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 25 May 2016 19:55:15 -0700 Subject: [PATCH 09/23] first pass changing the clm_ed_link to column indexed. --- components/clm/src/ED/main/EDCLMLinkMod.F90 | 87 ++++++++++++--------- 1 file changed, 50 insertions(+), 37 deletions(-) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index 87a34f701d..5739084c1c 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -966,7 +966,9 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c ! !ARGUMENTS class(ed_clm_type) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) type(waterstate_type) , intent(inout) :: waterstate_inst type(canopystate_type) , intent(inout) :: canopystate_inst ! @@ -1008,36 +1010,37 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c ! determine if gridcell is soil - istheresoil(begg:endg) = .false. - do c = begc,endc - g = col%gridcell(c) - l = col%landunit(c) - - if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then - istheresoil(g) = .true. - endif - ed_allsites_inst(g)%istheresoil = istheresoil(g) - enddo - +! istheresoil(begg:endg) = .false. +! do c = begc,endc +! g = col%gridcell(c) +! l = col%landunit(c) +! +! if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then +! istheresoil(g) = .true. +! endif +! ed_allsites_inst(g)%istheresoil = istheresoil(g) +! enddo ! retrieve the first soil patch associated with each gridcell. ! make sure we only get the first patch value for places which have soil. +! firstsoilpatch(begg:endg) = -999 +! do c = begc,endc +! g = col%gridcell(c) +! l = col%landunit(c) +! if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then +! firstsoilpatch(g) = col%patchi(c) +! sitecolumn(g) = c +! endif +! enddo +! do g = begg,endg +! if(firstsoilpatch(g) >= 0.and.ed_allsites_inst(g)%istheresoil)then +! ed_allsites_inst(g)%clmcolumn = sitecolumn(g) - firstsoilpatch(begg:endg) = -999 - do c = begc,endc - g = col%gridcell(c) - l = col%landunit(c) - - if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then - firstsoilpatch(g) = col%patchi(c) - sitecolumn(g) = c - endif - enddo - do g = begg,endg + do s = 1,nsites - if(firstsoilpatch(g) >= 0.and.ed_allsites_inst(g)%istheresoil)then - ed_allsites_inst(g)%clmcolumn = sitecolumn(g) + c = fcolumn(s) + ! ============================================================================ ! Zero the bare ground tile BGC variables. ! Valid Range for zero'ing here is the soil_patch and non crop patches @@ -1046,8 +1049,8 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c ! firstsoilpatch(g) + numpft - numcft ! ============================================================================ - begp_fp = firstsoilpatch(g) - endp_fp = firstsoilpatch(g) + numpft - numcft + begp_fp = col%patchi(c) + endp_fp = col%patchi(c) + numpft - numcft clmpatch%is_veg(begp_fp:endp_fp) = .false. clmpatch%is_bareground(begp_fp:endp_fp) = .false. @@ -1063,16 +1066,23 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c total_bare_ground = 0.0_r8 total_patch_area = 0._r8 - currentPatch => ed_allsites_inst(g)%oldest_patch + currentPatch => sites(s)%oldest_patch do while(associated(currentPatch)) patchn = patchn + 1 currentPatch%patchno = patchn if (patchn <= numpft - numcft)then !don't expand into crop patches. - currentPatch%clm_pno = firstsoilpatch(g) + patchn !the first 'soil' patch is unvegetated... + currentPatch%clm_pno = col%patchi(c) + patchn !the first 'soil' patch is unvegetated... + + ! INTERF-TODO: currentPatch%clm_pno should be removed (FATES internal variable with CLM iformation) + p = currentPatch%clm_pno - c = clmpatch%column(p) + + if(c .ne. clmpatch%column(p))then + ! ERROR AND EXIT() + end if + clmpatch%is_veg(p) = .true. !this .is. a tile filled with vegetation... call currentPatch%set_root_fraction() @@ -1171,36 +1181,39 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c ! currentPatch%total_canopy_area/currentPatch%area is fraction of this patch cover by plants ! currentPatch%area/AREA is the fraction of the soil covered by this patch. + ! INTERF-TODO: clmpatch%wt_ed should also be removed, and perhaps replaced with something + ! like clm_fates%xxxx(p) + clmpatch%wt_ed(p) = min(1.0_r8,(currentPatch%total_canopy_area/currentPatch%area)) * & (currentPatch%area/AREA) currentPatch%bare_frac_area = (1.0_r8 - min(1.0_r8,currentPatch%total_canopy_area/currentPatch%area)) * & (currentPatch%area/AREA) - + if ( DEBUG ) then write(iulog, *) 'EDCLMLinkMod bare frac', currentPatch%bare_frac_area end if total_patch_area = total_patch_area + clmpatch%wt_ed(p) + currentPatch%bare_frac_area total_bare_ground = total_bare_ground + currentPatch%bare_frac_area currentCohort=> currentPatch%tallest - + else write(iulog,*) 'ED: too many patches' end if ! patchn<15 - + currentPatch => currentPatch%younger end do !patch loop - + if((total_patch_area-1.0_r8)>1e-9)then write(iulog,*) 'total area is wrong in CLMEDLINK',total_patch_area endif - + !loop round all and zero the remaining empty vegetation patches - do p = firstsoilpatch(g)+patchn+1,firstsoilpatch(g)+numpft + do p = col%patchi(c)+patchn+1,col%patchi(c)+numpft clmpatch%wt_ed(p) = 0.0_r8 enddo !set the area of the bare ground patch. - p = firstsoilpatch(g) + p = col%patchi(c) clmpatch%wt_ed(p) = total_bare_ground clmpatch%is_bareground = .true. endif ! are there any soil patches? From a26fd3da367e8c270ad2f133e12450fdf0410152 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 26 May 2016 18:52:50 -0700 Subject: [PATCH 10/23] working through the lai profile subroutines, adding some checks too. --- components/clm/src/ED/main/EDCLMLinkMod.F90 | 460 ++++++++++---------- 1 file changed, 220 insertions(+), 240 deletions(-) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index 5739084c1c..547ff3e20b 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -20,6 +20,7 @@ module EDCLMLinkMod use SoilBiogeochemCarbonStatetype , only : soilbiogeochem_carbonstate_type use clm_time_manager , only : is_beg_curr_day, get_step_size, get_nstep use shr_const_mod, only: SHR_CONST_CDAY + use abortutils , only : endrun ! implicit none @@ -978,13 +979,10 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c integer :: g,l,p,c integer :: ft ! plant functional type integer :: patchn ! identification number for each patch. - integer :: firstsoilpatch(bounds%begg:bounds%endg) ! the first patch in this gridcell that is soil and thus bare... real(r8) :: total_bare_ground ! sum of the bare fraction in all pfts. real(r8) :: total_patch_area real(r8) :: coarse_wood_frac real(r8) :: canopy_leaf_area ! total amount of leaf area in the vegetated area. m2. - integer :: sitecolumn(bounds%begg:bounds%endg) - logical :: istheresoil(bounds%begg:bounds%endg) integer :: begp_fp, endp_fp ! Valid range of patch indices that are associated with ! FATES (F) for each parent (P) iteration (grid/column) !---------------------------------------------------------------------- @@ -1008,225 +1006,196 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c endp => bounds%endp & ) - ! determine if gridcell is soil - -! istheresoil(begg:endg) = .false. -! do c = begc,endc -! g = col%gridcell(c) -! l = col%landunit(c) -! -! if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then -! istheresoil(g) = .true. -! endif -! ed_allsites_inst(g)%istheresoil = istheresoil(g) -! enddo - ! retrieve the first soil patch associated with each gridcell. - ! make sure we only get the first patch value for places which have soil. -! firstsoilpatch(begg:endg) = -999 -! do c = begc,endc -! g = col%gridcell(c) -! l = col%landunit(c) -! if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then -! firstsoilpatch(g) = col%patchi(c) -! sitecolumn(g) = c -! endif -! enddo -! do g = begg,endg -! if(firstsoilpatch(g) >= 0.and.ed_allsites_inst(g)%istheresoil)then -! ed_allsites_inst(g)%clmcolumn = sitecolumn(g) - do s = 1,nsites - c = fcolumn(s) - ! ============================================================================ - ! Zero the bare ground tile BGC variables. - ! Valid Range for zero'ing here is the soil_patch and non crop patches - ! If the crops are not turned on, don't worry, they were zero'd once and should - ! not change again (RGK). - ! firstsoilpatch(g) + numpft - numcft - ! ============================================================================ + ! ============================================================================ + ! Zero the bare ground tile BGC variables. + ! Valid Range for zero'ing here is the soil_patch and non crop patches + ! If the crops are not turned on, don't worry, they were zero'd once and should + ! not change again (RGK). + ! firstsoilpatch(g) + numpft - numcft + ! ============================================================================ + + begp_fp = col%patchi(c) + endp_fp = col%patchi(c) + numpft - numcft + + clmpatch%is_veg(begp_fp:endp_fp) = .false. + clmpatch%is_bareground(begp_fp:endp_fp) = .false. + + tlai(begp_fp:endp_fp) = 0.0_r8 + htop(begp_fp:endp_fp) = 0.0_r8 + hbot(begp_fp:endp_fp) = 0.0_r8 + elai(begp_fp:endp_fp) = 0.0_r8 + tsai(begp_fp:endp_fp) = 0.0_r8 + esai(begp_fp:endp_fp) = 0.0_r8 + + + patchn = 0 + total_bare_ground = 0.0_r8 + total_patch_area = 0._r8 - begp_fp = col%patchi(c) - endp_fp = col%patchi(c) + numpft - numcft + currentPatch => sites(s)%oldest_patch + do while(associated(currentPatch)) + patchn = patchn + 1 + currentPatch%patchno = patchn - clmpatch%is_veg(begp_fp:endp_fp) = .false. - clmpatch%is_bareground(begp_fp:endp_fp) = .false. - tlai(begp_fp:endp_fp) = 0.0_r8 - htop(begp_fp:endp_fp) = 0.0_r8 - hbot(begp_fp:endp_fp) = 0.0_r8 - elai(begp_fp:endp_fp) = 0.0_r8 - tsai(begp_fp:endp_fp) = 0.0_r8 - esai(begp_fp:endp_fp) = 0.0_r8 - - - patchn = 0 - total_bare_ground = 0.0_r8 - total_patch_area = 0._r8 - - currentPatch => sites(s)%oldest_patch - do while(associated(currentPatch)) - patchn = patchn + 1 - currentPatch%patchno = patchn + if (patchn <= numpft - numcft)then !don't expand into crop patches. - if (patchn <= numpft - numcft)then !don't expand into crop patches. + currentPatch%clm_pno = col%patchi(c) + patchn !the first 'soil' patch is unvegetated... + + ! INTERF-TODO: currentPatch%clm_pno should be removed (FATES internal variable with CLM iformation) + + p = col%patchi(c) + patchn + + if(c .ne. clmpatch%column(p))then + write(iulog,*) ' fcolumn(s) does not match clmpatch%column(p)' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if - currentPatch%clm_pno = col%patchi(c) + patchn !the first 'soil' patch is unvegetated... + clmpatch%is_veg(p) = .true. !this .is. a tile filled with vegetation... + + call currentPatch%set_root_fraction() - ! INTERF-TODO: currentPatch%clm_pno should be removed (FATES internal variable with CLM iformation) + !zero cohort-summed variables. + currentPatch%total_canopy_area = 0.0_r8 + currentPatch%total_tree_area = 0.0_r8 + currentPatch%lai = 0.0_r8 + canopy_leaf_area = 0.0_r8 - p = currentPatch%clm_pno + !update cohort quantitie s + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + + ft = currentCohort%pft + currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) + + currentCohort%livecrootn = 0.0_r8 - if(c .ne. clmpatch%column(p))then - ! ERROR AND EXIT() + if (pftcon%woody(ft) == 1) then + coarse_wood_frac = 0.5_r8 + else + coarse_wood_frac = 0.0_r8 end if - - clmpatch%is_veg(p) = .true. !this .is. a tile filled with vegetation... - call currentPatch%set_root_fraction() - - !zero cohort-summed variables. - currentPatch%total_canopy_area = 0.0_r8 - currentPatch%total_tree_area = 0.0_r8 - currentPatch%lai = 0.0_r8 - canopy_leaf_area = 0.0_r8 - - !update cohort quantitie s - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - - ft = currentCohort%pft - currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) - - currentCohort%livecrootn = 0.0_r8 - - if (pftcon%woody(ft) == 1) then - coarse_wood_frac = 0.5_r8 - else - coarse_wood_frac = 0.0_r8 - end if - - if ( DEBUG ) then - write(iulog,*) 'EDCLMLink 618 ',currentCohort%livecrootn - write(iulog,*) 'EDCLMLink 619 ',currentCohort%br - write(iulog,*) 'EDCLMLink 620 ',coarse_wood_frac - write(iulog,*) 'EDCLMLink 621 ',pftcon%leafcn(ft) - endif - - currentCohort%livecrootn = currentCohort%br * coarse_wood_frac / pftcon%leafcn(ft) - - if ( DEBUG ) write(iulog,*) 'EDCLMLink 625 ',currentCohort%livecrootn + if ( DEBUG ) then + write(iulog,*) 'EDCLMLink 618 ',currentCohort%livecrootn + write(iulog,*) 'EDCLMLink 619 ',currentCohort%br + write(iulog,*) 'EDCLMLink 620 ',coarse_wood_frac + write(iulog,*) 'EDCLMLink 621 ',pftcon%leafcn(ft) + endif - currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore - currentCohort%treelai = tree_lai(currentCohort) - ! Why is currentCohort%c_area used and then reset in the - ! following line? - canopy_leaf_area = canopy_leaf_area + currentCohort%treelai *currentCohort%c_area - currentCohort%c_area = c_area(currentCohort) + currentCohort%livecrootn = currentCohort%br * coarse_wood_frac / pftcon%leafcn(ft) - if(currentCohort%canopy_layer==1)then - currentPatch%total_canopy_area = currentPatch%total_canopy_area + currentCohort%c_area - if(pftcon%woody(ft)==1)then - currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area - endif - endif + if ( DEBUG ) write(iulog,*) 'EDCLMLink 625 ',currentCohort%livecrootn - ! Check for erroneous zero values. - if(currentCohort%dbh <= 0._r8 .or. currentCohort%n == 0._r8)then - write(iulog,*) 'ED: dbh or n is zero in clmedlink', currentCohort%dbh,currentCohort%n - endif - if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then - write(iulog,*) 'ED: PFT or trim is zero in clmedlink',currentCohort%pft,currentCohort%canopy_trim - endif - if(currentCohort%balive <= 0._r8)then - write(iulog,*) 'ED: balive is zero in clmedlink',currentCohort%balive + currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore + currentCohort%treelai = tree_lai(currentCohort) + ! Why is currentCohort%c_area used and then reset in the + ! following line? + canopy_leaf_area = canopy_leaf_area + currentCohort%treelai *currentCohort%c_area + currentCohort%c_area = c_area(currentCohort) + + if(currentCohort%canopy_layer==1)then + currentPatch%total_canopy_area = currentPatch%total_canopy_area + currentCohort%c_area + if(pftcon%woody(ft)==1)then + currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area endif - - currentCohort => currentCohort%taller - - enddo ! ends 'do while(associated(currentCohort)) - - if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then - write(iulog,*) 'ED: canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area - currentPatch%total_canopy_area = currentPatch%area endif - ! PASS BACK PATCH-LEVEL QUANTITIES THAT ARE NEEDED BY THE CLM CODE - if (associated(currentPatch%tallest)) then - htop(p) = currentPatch%tallest%hite - else - ! FIX(RF,040113) - should this be a parameter for the minimum possible vegetation height? - htop(p) = 0.1_r8 + ! Check for erroneous zero values. + if(currentCohort%dbh <= 0._r8 .or. currentCohort%n == 0._r8)then + write(iulog,*) 'ED: dbh or n is zero in clmedlink', currentCohort%dbh,currentCohort%n + endif + if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then + write(iulog,*) 'ED: PFT or trim is zero in clmedlink',currentCohort%pft,currentCohort%canopy_trim + endif + if(currentCohort%balive <= 0._r8)then + write(iulog,*) 'ED: balive is zero in clmedlink',currentCohort%balive endif - hbot(p) = max(0._r8, min(0.2_r8, htop(p)- 1.0_r8)) + currentCohort => currentCohort%taller + + enddo ! ends 'do while(associated(currentCohort)) - ! leaf area index: of .only. the areas with some vegetation on them, as the non-vegetated areas - ! are merged into the bare ground fraction. This introduces a degree of unrealism, - ! which could be fixed if the surface albedo routine took account of the possibiltiy of bare - ! ground mixed with trees. + if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then + write(iulog,*) 'ED: canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area + currentPatch%total_canopy_area = currentPatch%area + endif - if(currentPatch%total_canopy_area > 0)then; - tlai(p) = canopy_leaf_area/currentPatch%total_canopy_area - else - tlai(p) = 0.0_r8 - endif + ! PASS BACK PATCH-LEVEL QUANTITIES THAT ARE NEEDED BY THE CLM CODE + if (associated(currentPatch%tallest)) then + htop(p) = currentPatch%tallest%hite + else + ! FIX(RF,040113) - should this be a parameter for the minimum possible vegetation height? + htop(p) = 0.1_r8 + endif + + hbot(p) = max(0._r8, min(0.2_r8, htop(p)- 1.0_r8)) + + ! leaf area index: of .only. the areas with some vegetation on them, as the non-vegetated areas + ! are merged into the bare ground fraction. This introduces a degree of unrealism, + ! which could be fixed if the surface albedo routine took account of the possibiltiy of bare + ! ground mixed with trees. + + if(currentPatch%total_canopy_area > 0)then; + tlai(p) = canopy_leaf_area/currentPatch%total_canopy_area + else + tlai(p) = 0.0_r8 + endif - ! We are assuming here that grass is all located underneath tree canopies. - ! The alternative is to assume it is all spatial distinct from tree canopies. - ! In which case, the bare area would have to be reduced by the grass area... - ! currentPatch%total_canopy_area/currentPatch%area is fraction of this patch cover by plants - ! currentPatch%area/AREA is the fraction of the soil covered by this patch. + ! We are assuming here that grass is all located underneath tree canopies. + ! The alternative is to assume it is all spatial distinct from tree canopies. + ! In which case, the bare area would have to be reduced by the grass area... + ! currentPatch%total_canopy_area/currentPatch%area is fraction of this patch cover by plants + ! currentPatch%area/AREA is the fraction of the soil covered by this patch. - ! INTERF-TODO: clmpatch%wt_ed should also be removed, and perhaps replaced with something - ! like clm_fates%xxxx(p) - clmpatch%wt_ed(p) = min(1.0_r8,(currentPatch%total_canopy_area/currentPatch%area)) * & - (currentPatch%area/AREA) - currentPatch%bare_frac_area = (1.0_r8 - min(1.0_r8,currentPatch%total_canopy_area/currentPatch%area)) * & - (currentPatch%area/AREA) + clmpatch%wt_ed(p) = min(1.0_r8,(currentPatch%total_canopy_area/currentPatch%area)) * & + (currentPatch%area/AREA) + currentPatch%bare_frac_area = (1.0_r8 - min(1.0_r8,currentPatch%total_canopy_area/currentPatch%area)) * & + (currentPatch%area/AREA) - if ( DEBUG ) then - write(iulog, *) 'EDCLMLinkMod bare frac', currentPatch%bare_frac_area - end if - total_patch_area = total_patch_area + clmpatch%wt_ed(p) + currentPatch%bare_frac_area - total_bare_ground = total_bare_ground + currentPatch%bare_frac_area - currentCohort=> currentPatch%tallest + if ( DEBUG ) then + write(iulog, *) 'EDCLMLinkMod bare frac', currentPatch%bare_frac_area + end if + + total_patch_area = total_patch_area + clmpatch%wt_ed(p) + currentPatch%bare_frac_area + total_bare_ground = total_bare_ground + currentPatch%bare_frac_area - else - write(iulog,*) 'ED: too many patches' - end if ! patchn<15 + else + write(iulog,*) 'ED: too many patches' + end if ! patchn<15 - currentPatch => currentPatch%younger - end do !patch loop + currentPatch => currentPatch%younger + end do !patch loop - if((total_patch_area-1.0_r8)>1e-9)then - write(iulog,*) 'total area is wrong in CLMEDLINK',total_patch_area - endif + if((total_patch_area-1.0_r8)>1e-9)then + write(iulog,*) 'total area is wrong in CLMEDLINK',total_patch_area + endif - !loop round all and zero the remaining empty vegetation patches - do p = col%patchi(c)+patchn+1,col%patchi(c)+numpft - clmpatch%wt_ed(p) = 0.0_r8 - enddo - - !set the area of the bare ground patch. - p = col%patchi(c) - clmpatch%wt_ed(p) = total_bare_ground - clmpatch%is_bareground = .true. - endif ! are there any soil patches? - - call this%ed_clm_leaf_area_profile(ed_allsites_inst(g), waterstate_inst, canopystate_inst ) - - end do !grid loop - - call this%flux_into_litter_pools(bounds, ed_allsites_inst(begg:endg), firstsoilpatch, & - canopystate_inst) + ! loop round all and zero the remaining empty vegetation patches + ! while ED's domain of influence only extends to non-crop patches + ! wt_ed should not be non-zero anwhere but ED patches, so this loop is ok + do p = col%patchi(c)+patchn+1,col%patchi(c)+numpft + clmpatch%wt_ed(p) = 0.0_r8 + enddo + + !set the area of the bare ground patch. + p = col%patchi(c) + clmpatch%wt_ed(p) = total_bare_ground + clmpatch%is_bareground = .true. + + call this%ed_clm_leaf_area_profile(sites(s), c, waterstate_inst, canopystate_inst ) + + end do ! column loop - call this%ed_update_history_variables(bounds, ed_allsites_inst(begg:endg), & - firstsoilpatch, canopystate_inst) + call this%flux_into_litter_pools(bounds, sites(:), fcolumns(:), firstsoilpatch, canopystate_inst) + + call this%ed_update_history_variables(bounds, sites(:), fcolumns(:), firstsoilpatch, canopystate_inst) end associate @@ -1586,7 +1555,7 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & end subroutine ed_update_history_variables !------------------------------------------------------------------------ - subroutine ed_clm_leaf_area_profile( this, currentSite, waterstate_inst, canopystate_inst ) + subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_inst, canopystate_inst ) ! ! !DESCRIPTION: ! Load LAI in each layer into array to send to CLM @@ -1602,6 +1571,7 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, waterstate_inst, canopys ! !ARGUMENTS class(ed_clm_type) :: this type(ed_site_type) , intent(inout) :: currentSite + integer , intent(in) :: c ! ALM/CLM column index of this site type(waterstate_type) , intent(inout) :: waterstate_inst type(canopystate_type) , intent(inout) :: canopystate_inst ! @@ -1613,8 +1583,8 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, waterstate_inst, canopys integer :: ft ! Plant functional type index. integer :: iv ! Vertical leaf layer index integer :: L ! Canopy layer index - integer :: P ! clm patch index - integer :: C ! column index + integer :: p ! clm patch index + real(r8) :: tlai_temp ! calculation of tlai to check this method real(r8) :: elai_temp ! make a new elai based on the layer-by-layer snow coverage. real(r8) :: tsai_temp ! @@ -1652,55 +1622,54 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, waterstate_inst, canopys ! leaf area index above it, irrespective of PFT identity... ! Each leaf is defined by how deep in the canopy it is, in terms of LAI units. (FIX(RF,032414), GB) - if (currentSite%istheresoil)then + currentPatch => currentSite%oldest_patch ! ed patch + p = col%patchi(c) ! CLM/ALM equivalent patch + + do while(associated(currentPatch)) + p = p + 1 ! First CLM/ALM patch is non-veg + + !Calculate tree and canopy areas. + currentPatch%canopy_area = 0._r8 + currentPatch%canopy_layer_lai(:) = 0._r8 + NC = 0 + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) + currentPatch%canopy_area = currentPatch%canopy_area + currentCohort%c_area + NC = NC+1 + currentCohort => currentCohort%taller + enddo + ! if plants take up all the tile, then so does the canopy. + currentPatch%canopy_area = min(currentPatch%canopy_area,currentPatch%area) - currentPatch => currentSite%oldest_patch ! ed patch - p = currentPatch%clm_pno ! index for clm patch - - do while(associated(currentPatch)) - - !Calculate tree and canopy areas. - currentPatch%canopy_area = 0._r8 - currentPatch%canopy_layer_lai(:) = 0._r8 - NC = 0 - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - currentCohort%c_area = c_area(currentCohort) - currentPatch%canopy_area = currentPatch%canopy_area + currentCohort%c_area - NC = NC+1 - currentCohort => currentCohort%taller + !calculate tree lai and sai. + currentPatch%ncan(:,:) = 0 + currentPatch%nrad(:,:) = 0 + currentPatch%lai = 0._r8 + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + currentCohort%treelai = tree_lai(currentCohort) + currentCohort%treesai = tree_sai(currentCohort) + currentCohort%lai = currentCohort%treelai *currentCohort%c_area/currentPatch%canopy_area + currentCohort%sai = currentCohort%treesai *currentCohort%c_area/currentPatch%canopy_area + !Calculate the LAI plus SAI in each canopy storey. + currentCohort%NV = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed) + + currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft) = & + max(currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft),currentCohort%NV) + currentPatch%lai = currentPatch%lai +currentCohort%lai + + do L = 1,nclmax-1 + if(currentCohort%canopy_layer == L)then + currentPatch%canopy_layer_lai(L) = currentPatch%canopy_layer_lai(L) + currentCohort%lai + & + currentCohort%sai + endif enddo - ! if plants take up all the tile, then so does the canopy. - currentPatch%canopy_area = min(currentPatch%canopy_area,currentPatch%area) - - !calculate tree lai and sai. - currentPatch%ncan(:,:) = 0 - currentPatch%nrad(:,:) = 0 - currentPatch%lai = 0._r8 - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - currentCohort%treelai = tree_lai(currentCohort) - currentCohort%treesai = tree_sai(currentCohort) - currentCohort%lai = currentCohort%treelai *currentCohort%c_area/currentPatch%canopy_area - currentCohort%sai = currentCohort%treesai *currentCohort%c_area/currentPatch%canopy_area - !Calculate the LAI plus SAI in each canopy storey. - currentCohort%NV = CEILING((currentCohort%treelai+currentCohort%treesai)/dinc_ed) - - currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft) = & - max(currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft),currentCohort%NV) - currentPatch%lai = currentPatch%lai +currentCohort%lai - - do L = 1,nclmax-1 - if(currentCohort%canopy_layer == L)then - currentPatch%canopy_layer_lai(L) = currentPatch%canopy_layer_lai(L) + currentCohort%lai + & - currentCohort%sai - endif - enddo - - currentCohort => currentCohort%taller - - enddo !currentCohort - currentPatch%nrad = currentPatch%ncan + + currentCohort => currentCohort%taller + + enddo !currentCohort + currentPatch%nrad = currentPatch%ncan if(smooth_leaf_distribution == 1)then ! we are going to ignore the concept of canopy layers, and put all of the leaf area into height banded bins. @@ -1721,7 +1690,9 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, waterstate_inst, canopys maxh(iv) = (iv)*dh endif enddo - c = clmpatch%column(currentPatch%clm_pno) + + !c = clmpatch%column(currentPatch%clm_pno) + currentCohort => currentPatch%shortest do while(associated(currentCohort)) ft = currentCohort%pft @@ -1825,7 +1796,16 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, waterstate_inst, canopys if(currentCohort%NV > currentPatch%nrad(L,ft))then write(iulog,*) 'ED: issue with NV',currentCohort%NV,currentCohort%pft,currentCohort%canopy_layer endif - c = clmpatch%column(currentPatch%clm_pno) + + ! c = clmpatch%column(currentPatch%clm_pno) + ! INTERF-TODO: REMOVE THIS AT SOME POINT, THIS SANITY CHECK IS NOT NEEDED WHEN THE + ! COLUMNIZATION IS COMPLETE + if( clmpatch%column(currentPatch%clm_pno) .ne. c .or. currentPatch%clm_pno .ne. p )then + ! ERROR + write(iulog,*) ' clmpatch%column(currentPatch%clm_pno) .ne. c .or. currentPatch%clm_pno .ne. p ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + !Whole layers. Make a weighted average of the leaf area in each layer before dividing it by the total area. !fill up layer for whole layers. FIX(RF,032414)- for debugging jan 2012 From e7723390490a89bbfb9ef31ace0ed36ca50cab53 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 May 2016 13:57:16 -0700 Subject: [PATCH 11/23] working through litter-flux linking, column migration --- components/clm/src/ED/main/EDCLMLinkMod.F90 | 250 ++++++++++---------- 1 file changed, 130 insertions(+), 120 deletions(-) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index 547ff3e20b..89efd34424 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -1016,7 +1016,7 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c ! Valid Range for zero'ing here is the soil_patch and non crop patches ! If the crops are not turned on, don't worry, they were zero'd once and should ! not change again (RGK). - ! firstsoilpatch(g) + numpft - numcft + ! col%patchi(c) + numpft - numcft ! ============================================================================ begp_fp = col%patchi(c) @@ -1193,9 +1193,9 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c end do ! column loop - call this%flux_into_litter_pools(bounds, sites(:), fcolumns(:), firstsoilpatch, canopystate_inst) + call this%flux_into_litter_pools(bounds, sites(:), nsites, fcolumns(:), canopystate_inst) - call this%ed_update_history_variables(bounds, sites(:), fcolumns(:), firstsoilpatch, canopystate_inst) + call this%ed_update_history_variables(bounds, sites(:), nsites, fcolumns(:), canopystate_inst) end associate @@ -1555,6 +1555,11 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & end subroutine ed_update_history_variables !------------------------------------------------------------------------ + + ! INTERF-TODO: THIS ROUTINE COULD BE SPLIT. IT CALCULATES BOTH FATES/ED INTERNALS + ! AS WELL AS VARIABLES FOR CLM/ALM. + + subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_inst, canopystate_inst ) ! ! !DESCRIPTION: @@ -1626,7 +1631,7 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins p = col%patchi(c) ! CLM/ALM equivalent patch do while(associated(currentPatch)) - p = p + 1 ! First CLM/ALM patch is non-veg + p = p + 1 ! First CLM/ALM patch is non-veg, increment at loop start !Calculate tree and canopy areas. currentPatch%canopy_area = 0._r8 @@ -1671,7 +1676,7 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins enddo !currentCohort currentPatch%nrad = currentPatch%ncan - if(smooth_leaf_distribution == 1)then + if(smooth_leaf_distribution == 1)then ! we are going to ignore the concept of canopy layers, and put all of the leaf area into height banded bins. ! using the same domains as we had before, except that CL always = 1 currentPatch%tlai_profile = 0._r8 @@ -1952,7 +1957,8 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins enddo enddo - p = currentPatch%clm_pno + ! This should not had changed +! p = currentPatch%clm_pno if(abs(tlai(p)-tlai_temp) > 0.0001_r8) then write(iulog,*) 'ED: error with tlai calcs',& @@ -2041,14 +2047,12 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins enddo !patch - endif !is there soil? - - end associate + end associate end subroutine ed_clm_leaf_area_profile - subroutine flux_into_litter_pools(this, bounds, ed_allsites_inst, firstsoilpatch, canopystate_inst) + subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumns, canopystate_inst) ! Created by Charlie Koven and Rosie Fisher, 2014-2015 ! take the flux out of the fragmenting litter pools and port into the decomposing litter pools. ! in this implementation, decomposing pools are assumed to be humus and non-flammable, whereas fragmenting pools @@ -2080,16 +2084,17 @@ subroutine flux_into_litter_pools(this, bounds, ed_allsites_inst, firstsoilpatch ! ! !ARGUMENTS class(ed_clm_type) :: this - type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) - integer :: firstsoilpatch(bounds%begg:bounds%endg) ! the first patch in this gridcell that is soil and thus bare... + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) type(canopystate_type) , intent(inout) :: canopystate_inst ! ! !LOCAL VARIABLES: type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort type(ed_site_type), pointer :: cs - integer c,p,cc,j,g + integer c,p,ci,j,g real(r8) time_convert ! from year to seconds real(r8) mass_convert ! ED uses kg, CLM uses g integer :: begp,endp @@ -2130,6 +2135,7 @@ subroutine flux_into_litter_pools(this, bounds, ed_allsites_inst, firstsoilpatch ! (2) a fine root profile, which is indexed by both column and pft, differs for each pft and also from one column to the next to avoid inputting any C into permafrost ! (3) a coarse root profile, which is the root-biomass=weighted average of the fine root profiles !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (use_vertsoilc) then ! define a single shallow surface profile for surface additions (leaves, stems, and N deposition) @@ -2285,119 +2291,123 @@ subroutine flux_into_litter_pools(this, bounds, ed_allsites_inst, firstsoilpatch !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! now disaggregate the inputs vertically, using the vertical profiles !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + do s = 1,nsites + + ! do g = bounds%begg,bounds%endg + ! if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then + c = fcolumn(s) + currentPatch => sites(s)%oldest_patch + + do while(associated(currentPatch)) - do g = bounds%begg,bounds%endg - if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then - currentPatch => ed_allsites_inst(g)%oldest_patch + ! cs => currentpatch%siteptr + ! cc = cs%clmcolumn - do while(associated(currentPatch)) - - cs => currentpatch%siteptr - cc = cs%clmcolumn - - ! the CWD pools lose information about which PFT they came from; for the stems this doesn't matter as they all have the same profile, - ! however for the coarse roots they may have different profiles. to approximately recover this information, loop over all cohorts in patch - ! to calculate the total root biomass in that patch of each pft, and then rescale the croot_prof as the weighted average of the froot_prof - biomass_bg_ft(1:numpft_ed) = 0._r8 - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + currentCohort%b * (currentCohort%n / currentPatch%area) * (1.0_r8-ED_val_ag_biomass) - currentCohort => currentCohort%shorter - enddo !currentCohort - ! - biomass_bg_tot = 0._r8 - do ft = 1,numpft_ed - biomass_bg_tot = biomass_bg_tot + biomass_bg_ft(ft) - end do - ! - do j = 1, nlevdecomp - ! zero this for each patch - croot_prof_perpatch(j) = 0._r8 - end do - ! - if ( biomass_bg_tot .gt. 0._r8) then - do ft = 1,numpft_ed - do j = 1, nlevdecomp - croot_prof_perpatch(j) = croot_prof_perpatch(j) + froot_prof(cc,ft,j) * biomass_bg_ft(ft) / biomass_bg_tot - end do - end do - else ! no biomass - croot_prof_perpatch(1) = 1./dzsoi_decomp(1) - end if - ! - ! add croot_prof as weighted average (weighted by patch area) of croot_prof_perpatch - do j = 1, nlevdecomp - croot_prof(cc, j) = croot_prof(cc, j) + croot_prof_perpatch(j) * currentPatch%area / AREA - end do - ! - ! now disaggregate, vertically and by decomposition substrate type, the actual fluxes from CWD and litter pools - ! - ! do c = 1, ncwd - ! write(iulog,*)'cdk CWD_AG_out', c, currentpatch%CWD_AG_out(c), cwd_fcel_ed, currentpatch%area/AREA - ! write(iulog,*)'cdk CWD_BG_out', c, currentpatch%CWD_BG_out(c), cwd_fcel_ed, currentpatch%area/AREA - ! end do - ! do ft = 1,numpft_ed - ! write(iulog,*)'cdk leaf_litter_out', ft, currentpatch%leaf_litter_out(ft), cwd_fcel_ed, currentpatch%area/AREA - ! write(iulog,*)'cdk root_litter_out', ft, currentpatch%root_litter_out(ft), cwd_fcel_ed, currentpatch%area/AREA - ! end do - ! ! - ! CWD pools fragmenting into decomposing litter pools. - do c = 1, ncwd - do j = 1, nlevdecomp - ED_c_to_litr_cel_c(cc,j) = ED_c_to_litr_cel_c(cc,j) + currentpatch%CWD_AG_out(c) * cwd_fcel_ed * currentpatch%area/AREA * stem_prof(cc,j) - ED_c_to_litr_lig_c(cc,j) = ED_c_to_litr_lig_c(cc,j) + currentpatch%CWD_AG_out(c) * cwd_flig_ed * currentpatch%area/AREA * stem_prof(cc,j) - ! - ED_c_to_litr_cel_c(cc,j) = ED_c_to_litr_cel_c(cc,j) + currentpatch%CWD_BG_out(c) * cwd_fcel_ed * currentpatch%area/AREA * croot_prof_perpatch(j) - ED_c_to_litr_lig_c(cc,j) = ED_c_to_litr_lig_c(cc,j) + currentpatch%CWD_BG_out(c) * cwd_flig_ed * currentpatch%area/AREA * croot_prof_perpatch(j) - end do - end do - - ! leaf and fine root pools. - do ft = 1,numpft_ed - do j = 1, nlevdecomp - ED_c_to_litr_lab_c(cc,j) = ED_c_to_litr_lab_c(cc,j) + currentpatch%leaf_litter_out(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(cc,j) - ED_c_to_litr_cel_c(cc,j) = ED_c_to_litr_cel_c(cc,j) + currentpatch%leaf_litter_out(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(cc,j) - ED_c_to_litr_lig_c(cc,j) = ED_c_to_litr_lig_c(cc,j) + currentpatch%leaf_litter_out(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(cc,j) - ! - ED_c_to_litr_lab_c(cc,j) = ED_c_to_litr_lab_c(cc,j) + currentpatch%root_litter_out(ft) * pftcon%fr_flab(ft) * currentpatch%area/AREA * froot_prof(cc,ft,j) - ED_c_to_litr_cel_c(cc,j) = ED_c_to_litr_cel_c(cc,j) + currentpatch%root_litter_out(ft) * pftcon%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(cc,ft,j) - ED_c_to_litr_lig_c(cc,j) = ED_c_to_litr_lig_c(cc,j) + currentpatch%root_litter_out(ft) * pftcon%fr_flig(ft) * currentpatch%area/AREA * froot_prof(cc,ft,j) - ! - !! and seed_decay too. for now, use the same lability fractions as for leaf litter - ED_c_to_litr_lab_c(cc,j) = ED_c_to_litr_lab_c(cc,j) + currentpatch%seed_decay(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(cc,j) - ED_c_to_litr_cel_c(cc,j) = ED_c_to_litr_cel_c(cc,j) + currentpatch%seed_decay(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(cc,j) - ED_c_to_litr_lig_c(cc,j) = ED_c_to_litr_lig_c(cc,j) + currentpatch%seed_decay(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(cc,j) - ! - enddo - end do + ! the CWD pools lose information about which PFT they came from; for the stems this doesn't matter as they all have the same profile, + ! however for the coarse roots they may have different profiles. to approximately recover this information, loop over all cohorts in patch + ! to calculate the total root biomass in that patch of each pft, and then rescale the croot_prof as the weighted average of the froot_prof + biomass_bg_ft(1:numpft_ed) = 0._r8 + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + currentCohort%b * (currentCohort%n / currentPatch%area) * (1.0_r8-ED_val_ag_biomass) + currentCohort => currentCohort%shorter + enddo !currentCohort + ! + biomass_bg_tot = 0._r8 + do ft = 1,numpft_ed + biomass_bg_tot = biomass_bg_tot + biomass_bg_ft(ft) + end do + ! + do j = 1, nlevdecomp + ! zero this for each patch + croot_prof_perpatch(j) = 0._r8 + end do + ! + if ( biomass_bg_tot .gt. 0._r8) then + do ft = 1,numpft_ed + do j = 1, nlevdecomp + croot_prof_perpatch(j) = croot_prof_perpatch(j) + froot_prof(c,ft,j) * biomass_bg_ft(ft) / biomass_bg_tot + end do + end do + else ! no biomass + croot_prof_perpatch(1) = 1./dzsoi_decomp(1) + end if + + ! + ! add croot_prof as weighted average (weighted by patch area) of croot_prof_perpatch + do j = 1, nlevdecomp + croot_prof(c, j) = croot_prof(c, j) + croot_prof_perpatch(j) * currentPatch%area / AREA + end do + ! + ! now disaggregate, vertically and by decomposition substrate type, the actual fluxes from CWD and litter pools + ! + ! do c = 1, ncwd + ! write(iulog,*)'cdk CWD_AG_out', c, currentpatch%CWD_AG_out(c), cwd_fcel_ed, currentpatch%area/AREA + ! write(iulog,*)'cdk CWD_BG_out', c, currentpatch%CWD_BG_out(c), cwd_fcel_ed, currentpatch%area/AREA + ! end do + ! do ft = 1,numpft_ed + ! write(iulog,*)'cdk leaf_litter_out', ft, currentpatch%leaf_litter_out(ft), cwd_fcel_ed, currentpatch%area/AREA + ! write(iulog,*)'cdk root_litter_out', ft, currentpatch%root_litter_out(ft), cwd_fcel_ed, currentpatch%area/AREA + ! end do + ! ! + ! CWD pools fragmenting into decomposing litter pools. + do ci = 1, ncwd + do j = 1, nlevdecomp + ED_c_to_litr_cel_c(c,j) = ED_c_to_litr_cel_c(c,j) + currentpatch%CWD_AG_out(ci) * cwd_fcel_ed * currentpatch%area/AREA * stem_prof(c,j) + ED_c_to_litr_lig_c(c,j) = ED_c_to_litr_lig_c(c,j) + currentpatch%CWD_AG_out(ci) * cwd_flig_ed * currentpatch%area/AREA * stem_prof(c,j) + ! + ED_c_to_litr_cel_c(c,j) = ED_c_to_litr_cel_c(c,j) + currentpatch%CWD_BG_out(ci) * cwd_fcel_ed * currentpatch%area/AREA * croot_prof_perpatch(j) + ED_c_to_litr_lig_c(c,j) = ED_c_to_litr_lig_c(c,j) + currentpatch%CWD_BG_out(ci) * cwd_flig_ed * currentpatch%area/AREA * croot_prof_perpatch(j) + end do + end do + + ! leaf and fine root pools. + do ft = 1,numpft_ed + do j = 1, nlevdecomp + ED_c_to_litr_lab_c(c,j) = ED_c_to_litr_lab_c(c,j) + currentpatch%leaf_litter_out(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(c,j) + ED_c_to_litr_cel_c(c,j) = ED_c_to_litr_cel_c(c,j) + currentpatch%leaf_litter_out(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(c,j) + ED_c_to_litr_lig_c(c,j) = ED_c_to_litr_lig_c(c,j) + currentpatch%leaf_litter_out(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(c,j) + ! + ED_c_to_litr_lab_c(c,j) = ED_c_to_litr_lab_c(c,j) + currentpatch%root_litter_out(ft) * pftcon%fr_flab(ft) * currentpatch%area/AREA * froot_prof(c,ft,j) + ED_c_to_litr_cel_c(c,j) = ED_c_to_litr_cel_c(c,j) + currentpatch%root_litter_out(ft) * pftcon%fr_fcel(ft) * currentpatch%area/AREA * froot_prof(c,ft,j) + ED_c_to_litr_lig_c(c,j) = ED_c_to_litr_lig_c(c,j) + currentpatch%root_litter_out(ft) * pftcon%fr_flig(ft) * currentpatch%area/AREA * froot_prof(c,ft,j) + ! + !! and seed_decay too. for now, use the same lability fractions as for leaf litter + ED_c_to_litr_lab_c(c,j) = ED_c_to_litr_lab_c(c,j) + currentpatch%seed_decay(ft) * pftcon%lf_flab(ft) * currentpatch%area/AREA * leaf_prof(c,j) + ED_c_to_litr_cel_c(c,j) = ED_c_to_litr_cel_c(c,j) + currentpatch%seed_decay(ft) * pftcon%lf_fcel(ft) * currentpatch%area/AREA * leaf_prof(c,j) + ED_c_to_litr_lig_c(c,j) = ED_c_to_litr_lig_c(c,j) + currentpatch%seed_decay(ft) * pftcon%lf_flig(ft) * currentpatch%area/AREA * leaf_prof(c,j) + ! + enddo + end do currentPatch => currentPatch%younger end do !currentPatch - end if - end do + + end do - do cc = bounds%begc,bounds%endc - do j = 1, nlevdecomp - ! time unit conversion - ED_c_to_litr_lab_c(cc,j)=ED_c_to_litr_lab_c(cc,j) * mass_convert / time_convert - ED_c_to_litr_cel_c(cc,j)=ED_c_to_litr_cel_c(cc,j) * mass_convert / time_convert - ED_c_to_litr_lig_c(cc,j)=ED_c_to_litr_lig_c(cc,j) * mass_convert / time_convert - + do c = bounds%begc,bounds%endc + do j = 1, nlevdecomp + ! time unit conversion + ED_c_to_litr_lab_c(c,j)=ED_c_to_litr_lab_c(c,j) * mass_convert / time_convert + ED_c_to_litr_cel_c(c,j)=ED_c_to_litr_cel_c(c,j) * mass_convert / time_convert + ED_c_to_litr_lig_c(c,j)=ED_c_to_litr_lig_c(c,j) * mass_convert / time_convert + + end do end do - end do - - ! write(iulog,*)'cdk ED_c_to_litr_lab_c: ', ED_c_to_litr_lab_c - ! write(iulog,*)'cdk ED_c_to_litr_cel_c: ', ED_c_to_litr_cel_c - ! write(iulog,*)'cdk ED_c_to_litr_lig_c: ', ED_c_to_litr_lig_c - ! write(iulog,*)'cdk nlevdecomp_full, bounds%begc, bounds%endc: ', nlevdecomp_full, bounds%begc, bounds%endc - ! write(iulog,*)'cdk leaf_prof: ', leaf_prof - ! write(iulog,*)'cdk stem_prof: ', stem_prof - ! write(iulog,*)'cdk froot_prof: ', froot_prof - ! write(iulog,*)'cdk croot_prof_perpatch: ', croot_prof_perpatch - ! write(iulog,*)'cdk croot_prof: ', croot_prof - - end associate - end subroutine flux_into_litter_pools + + ! write(iulog,*)'cdk ED_c_to_litr_lab_c: ', ED_c_to_litr_lab_c + ! write(iulog,*)'cdk ED_c_to_litr_cel_c: ', ED_c_to_litr_cel_c + ! write(iulog,*)'cdk ED_c_to_litr_lig_c: ', ED_c_to_litr_lig_c + ! write(iulog,*)'cdk nlevdecomp_full, bounds%begc, bounds%endc: ', nlevdecomp_full, bounds%begc, bounds%endc + ! write(iulog,*)'cdk leaf_prof: ', leaf_prof + ! write(iulog,*)'cdk stem_prof: ', stem_prof + ! write(iulog,*)'cdk froot_prof: ', froot_prof + ! write(iulog,*)'cdk croot_prof_perpatch: ', croot_prof_perpatch + ! write(iulog,*)'cdk croot_prof: ', croot_prof + + end associate + end subroutine flux_into_litter_pools !------------------------------------------------------------------------ subroutine SummarizeProductivityFluxes(this, bounds, ed_allsites_inst) From 215e358ab39b226b7de81c628d8a86a4b4d1263a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 May 2016 15:52:58 -0700 Subject: [PATCH 12/23] finished first pass through EDCLMLinkMod --- components/clm/src/ED/main/EDCLMLinkMod.F90 | 584 ++++++++++---------- components/clm/src/main/clm_driver.F90 | 2 +- 2 files changed, 291 insertions(+), 295 deletions(-) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index 89efd34424..2dde2fa525 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -963,7 +963,7 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c use pftconMod , only : pftcon use CanopyStateType , only : canopystate_type use WaterStateType , only : waterstate_type - ! + ! !ARGUMENTS class(ed_clm_type) :: this type(bounds_type) , intent(in) :: bounds @@ -1193,16 +1193,16 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c end do ! column loop - call this%flux_into_litter_pools(bounds, sites(:), nsites, fcolumns(:), canopystate_inst) + call this%flux_into_litter_pools(bounds, sites(:), nsites, fcolumn(:), canopystate_inst) - call this%ed_update_history_variables(bounds, sites(:), nsites, fcolumns(:), canopystate_inst) + call this%ed_update_history_variables(bounds, sites(:), nsites, fcolumn(:), canopystate_inst) end associate end subroutine ed_clm_link !----------------------------------------------------------------------- - subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & + subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, firstsoilpatch, canopystate_inst) ! ! !USES: @@ -1213,14 +1213,16 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & ! !ARGUMENTS: class(ed_clm_type) :: this type(bounds_type) , intent(in) :: bounds ! clump bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) type(ed_patch_type) , pointer :: currentPatch type(ed_cohort_type) , pointer :: currentCohort type(canopystate_type) , intent(inout) :: canopystate_inst ! ! !LOCAL VARIABLES: - integer :: G,p,ft,c - integer :: firstsoilpatch(bounds%begg:bounds%endg) + integer :: p,ft,c +! integer :: firstsoilpatch(bounds%begg:bounds%endg) real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column real(r8) :: patch_scaling_scalar ! ratio of canopy to patch area for counteracting patch scaling @@ -1353,206 +1355,215 @@ subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & ed_npatches(:) = 0._r8 ed_ncohorts(:) = 0._r8 - do g = bounds%begg,bounds%endg - - if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then - - ! ============================================================================ - ! Zero the bare ground tile BGC variables. - ! ============================================================================ - - trimming(firstsoilpatch(g)) = 1.0_r8 - canopy_spread(firstsoilpatch(g)) = 0.0_r8 - PFTbiomass(firstsoilpatch(g),:) = 0.0_r8 - PFTleafbiomass(firstsoilpatch(g),:) = 0.0_r8 - PFTstorebiomass(firstsoilpatch(g),:) = 0.0_r8 - PFTnindivs(firstsoilpatch(g),:) = 0.0_r8 - area_plant(firstsoilpatch(g)) = 0.0_r8 - area_trees(firstsoilpatch(g)) = 0.0_r8 - nesterov_fire_danger(firstsoilpatch(g)) = 0.0_r8 - spitfire_ROS(firstsoilpatch(g)) = 0.0_r8 - TFC_ROS(firstsoilpatch(g)) = 0.0_r8 - effect_wspeed(firstsoilpatch(g)) = 0.0_r8 - fire_intensity(firstsoilpatch(g)) = 0.0_r8 - fire_area(firstsoilpatch(g)) = 0.0_r8 - scorch_height(firstsoilpatch(g)) = 0.0_r8 - fire_fuel_bulkd(firstsoilpatch(g)) = 0.0_r8 - fire_fuel_eff_moist(firstsoilpatch(g)) = 0.0_r8 - fire_fuel_sav(firstsoilpatch(g)) = 0.0_r8 - fire_fuel_mef(firstsoilpatch(g)) = 0.0_r8 - litter_in(firstsoilpatch(g)) = 0.0_r8 - litter_out(firstsoilpatch(g)) = 0.0_r8 - seed_bank(firstsoilpatch(g)) = 0.0_r8 - seeds_in(firstsoilpatch(g)) = 0.0_r8 - seed_decay(firstsoilpatch(g)) = 0.0_r8 - seed_germination(firstsoilpatch(g)) = 0.0_r8 - ED_biomass(firstsoilpatch(g)) = 0.0_r8 - ED_balive(firstsoilpatch(g)) = 0.0_r8 - ED_bdead(firstsoilpatch(g)) = 0.0_r8 - ED_bstore(firstsoilpatch(g)) = 0.0_r8 - ED_bleaf(firstsoilpatch(g)) = 0.0_r8 - elai(firstsoilpatch(g)) = 0.0_r8 - tlai(firstsoilpatch(g)) = 0.0_r8 - tsai(firstsoilpatch(g)) = 0.0_r8 - esai(firstsoilpatch(g)) = 0.0_r8 - ED_bleaf(firstsoilpatch(g)) = 0.0_r8 - sum_fuel(firstsoilpatch(g)) = 0.0_r8 - - c = ed_allsites_inst(g)%clmcolumn - - currentPatch => ed_allsites_inst(g)%oldest_patch - do while(associated(currentPatch)) - - if(currentPatch%patchno <= numpft - numcft)then !don't expand into crop patches. - p = currentPatch%clm_pno - - ed_npatches(c) = ed_npatches(c) + 1._r8 - - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - !accumulate into history variables. - ft = currentCohort%pft - - ed_ncohorts(c) = ed_ncohorts(c) + 1._r8 - - if ((currentPatch%area .gt. 0._r8) .and. (currentPatch%total_canopy_area .gt. 0._r8)) then - - ! for quantities that are at the CLM patch level, because of the way that CLM patches are weighted for radiative purposes - ! this # density needs to be over either ED patch canopy area or ED patch total area, whichever is less - n_density = currentCohort%n/min(currentPatch%area,currentPatch%total_canopy_area) - - ! for quantities that are natively at column level, calculate plant density using whole area - n_perm2 = currentCohort%n/AREA - - else - n_density = 0.0_r8 - n_perm2 = 0.0_r8 - endif + do s = 1,nsites - if ( DEBUG ) then - write(iulog,*) 'EDCLMLinkMod I ',currentCohort%bstore - write(iulog,*) 'EDCLMLinkMod II ',p,ED_bstore(p) - endif + c = fcolumn(s) - ED_bleaf(p) = ED_bleaf(p) + n_density * currentCohort%bl * 1.e3_r8 - ED_bstore(p) = ED_bstore(p) + n_density * currentCohort%bstore * 1.e3_r8 - ED_biomass(p) = ED_biomass(p) + n_density * currentCohort%b * 1.e3_r8 - ED_bdead(p) = ED_bdead(p) + n_density * currentCohort%bdead * 1.e3_r8 - ED_balive(p) = ED_balive(p) + n_density * currentCohort%balive * 1.e3_r8 - PFTbiomass(p,ft) = PFTbiomass(p,ft) + n_density * currentCohort%b * 1.e3_r8 - PFTleafbiomass(p,ft) = PFTleafbiomass(p,ft) + n_density * currentCohort%bl * 1.e3_r8 - PFTstorebiomass(p,ft) = PFTstorebiomass(p,ft) + n_density * currentCohort%bstore * 1.e3_r8 - PFTnindivs(p,ft) = PFTnindivs(p,ft) + currentCohort%n - - dbh = currentCohort%dbh !-0.5*(1./365.25)*currentCohort%ddbhdt - sc = count(dbh-sclass_ed.ge.0.0) - scpf = (ft-1)*nlevsclass_ed+sc - - ! Flux Variables (must pass a NaN check on growth increment and not be recruits) - if( .not.(currentCohort%isnew) ) then - ed_gpp_scpf(g,scpf) = ed_gpp_scpf(g,scpf) + n_perm2*currentCohort%gpp ! [kgC/m2/yr] - ed_npp_totl_scpf(g,scpf) = ed_npp_totl_scpf(g,scpf) + currentcohort%npp*n_perm2 - ed_npp_leaf_scpf(g,scpf) = ed_npp_leaf_scpf(g,scpf) + currentcohort%npp_leaf*n_perm2 - ed_npp_fnrt_scpf(g,scpf) = ed_npp_fnrt_scpf(g,scpf) + currentcohort%npp_froot*n_perm2 - ed_npp_bgsw_scpf(g,scpf) = ed_npp_bgsw_scpf(g,scpf) + currentcohort%npp_bsw*(1._r8-ED_val_ag_biomass)*n_perm2 - ed_npp_agsw_scpf(g,scpf) = ed_npp_agsw_scpf(g,scpf) + currentcohort%npp_bsw*ED_val_ag_biomass*n_perm2 - ed_npp_bgdw_scpf(g,scpf) = ed_npp_bgdw_scpf(g,scpf) + currentcohort%npp_bdead*(1._r8-ED_val_ag_biomass)*n_perm2 - ed_npp_agdw_scpf(g,scpf) = ed_npp_agdw_scpf(g,scpf) + currentcohort%npp_bdead*ED_val_ag_biomass*n_perm2 - ed_npp_seed_scpf(g,scpf) = ed_npp_seed_scpf(g,scpf) + currentcohort%npp_bseed*n_perm2 - ed_npp_stor_scpf(g,scpf) = ed_npp_stor_scpf(g,scpf) + currentcohort%npp_store*n_perm2 - if( abs(currentcohort%npp-(currentcohort%npp_leaf+currentcohort%npp_froot+ & - currentcohort%npp_bsw+currentcohort%npp_bdead+ & - currentcohort%npp_bseed+currentcohort%npp_store))>1.e-9) then - write(iulog,*) 'NPP Partitions are not balancing' - write(iulog,*) 'Fractional Error: ',abs(currentcohort%npp-(currentcohort%npp_leaf+currentcohort%npp_froot+ & - currentcohort%npp_bsw+currentcohort%npp_bdead+ & - currentcohort%npp_bseed+currentcohort%npp_store))/currentcohort%npp - write(iulog,*) 'Terms: ',currentcohort%npp,currentcohort%npp_leaf,currentcohort%npp_froot, & - currentcohort%npp_bsw,currentcohort%npp_bdead, & - currentcohort%npp_bseed,currentcohort%npp_store - stop - end if - ! Woody State Variables (basal area and number density and mortality) - if (pftcon%woody(ft) == 1) then - - ed_m1_col_scpf(g,scpf) = ed_m1_col_scpf(g,scpf) + currentcohort%bmort*n_perm2*AREA - ed_m2_col_scpf(g,scpf) = ed_m2_col_scpf(g,scpf) + currentcohort%hmort*n_perm2*AREA - ed_m3_col_scpf(g,scpf) = ed_m3_col_scpf(g,scpf) + currentcohort%cmort*n_perm2*AREA - ed_m4_col_scpf(g,scpf) = ed_m4_col_scpf(g,scpf) + currentcohort%imort*n_perm2*AREA - ed_m5_col_scpf(g,scpf) = ed_m5_col_scpf(g,scpf) + currentcohort%fmort*n_perm2*AREA - - ! basal area [m2/ha] - ed_ba_col_scpf(g,scpf) = ed_ba_col_scpf(g,scpf) + & - 0.25*3.14159*((dbh/100.0)**2.0)*n_perm2*AREA - - ! number density [/ha] - ed_np_col_scpf(g,scpf) = ed_np_col_scpf(g,scpf) + AREA*n_perm2 - - ! Growth Incrments must have NaN check and woody check - if(currentCohort%ddbhdt == currentCohort%ddbhdt) then - ed_ddbh_col_scpf(g,scpf) = ed_ddbh_col_scpf(g,scpf) + & - currentCohort%ddbhdt*n_perm2*AREA - else - ed_ddbh_col_scpf(g,scpf) = -999.9 - end if - end if + ! ============================================================================ + ! Zero the bare ground tile BGC variables. + ! ============================================================================ + + p = col%patchi(c) + + ! INTERF-TODO: THIS ZERO'ING IS REDUNDANT, THE WHOLE PATCH CLUMP IS ALREADY ZERO'D + + trimming(p) = 1.0_r8 + canopy_spread(p) = 0.0_r8 + PFTbiomass(p,:) = 0.0_r8 + PFTleafbiomass(p,:) = 0.0_r8 + PFTstorebiomass(p,:) = 0.0_r8 + PFTnindivs(p,:) = 0.0_r8 + area_plant(p) = 0.0_r8 + area_trees(p) = 0.0_r8 + nesterov_fire_danger(p) = 0.0_r8 + spitfire_ROS(p) = 0.0_r8 + TFC_ROS(p) = 0.0_r8 + effect_wspeed(p) = 0.0_r8 + fire_intensity(p) = 0.0_r8 + fire_area(p) = 0.0_r8 + scorch_height(p) = 0.0_r8 + fire_fuel_bulkd(p) = 0.0_r8 + fire_fuel_eff_moist(p) = 0.0_r8 + fire_fuel_sav(p) = 0.0_r8 + fire_fuel_mef(p) = 0.0_r8 + litter_in(p) = 0.0_r8 + litter_out(p) = 0.0_r8 + seed_bank(p) = 0.0_r8 + seeds_in(p) = 0.0_r8 + seed_decay(p) = 0.0_r8 + seed_germination(p) = 0.0_r8 + ED_biomass(p) = 0.0_r8 + ED_balive(p) = 0.0_r8 + ED_bdead(p) = 0.0_r8 + ED_bstore(p) = 0.0_r8 + ED_bleaf(p) = 0.0_r8 + elai(p) = 0.0_r8 + tlai(p) = 0.0_r8 + tsai(p) = 0.0_r8 + esai(p) = 0.0_r8 + ED_bleaf(p) = 0.0_r8 + sum_fuel(p) = 0.0_r8 - end if + currentPatch => sites(s)%oldest_patch + do while(associated(currentPatch)) - currentCohort => currentCohort%taller - enddo ! cohort loop + ! INTERF-TODO: THIS LOGIC SHOULDN'T BE NECESSARY, SHOULD BE CHECKED AT THE BEGINNING + ! OF LINKING, ONCE - !Patch specific variables that are already calculated + ! %patchno is the local index of the ED/FATES patches, starting at 1 + if(currentPatch%patchno <= numpft - numcft)then !don't expand into crop patches. - !These things are all duplicated. Should they all be converted to LL or array structures RF? + ! Increment CLM/ALM patch index, first was non-veg, these are veg + p = p + 1 + + ed_npatches(c) = ed_npatches(c) + 1._r8 + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + !accumulate into history variables. + ft = currentCohort%pft - ! define scalar to counteract the patch albedo scaling logic for conserved quantities - if (currentPatch%area .gt. 0._r8) then - patch_scaling_scalar = min(1._r8, currentPatch%area / currentPatch%total_canopy_area) + ed_ncohorts(c) = ed_ncohorts(c) + 1._r8 + + if ((currentPatch%area .gt. 0._r8) .and. (currentPatch%total_canopy_area .gt. 0._r8)) then + + ! for quantities that are at the CLM patch level, because of the way that CLM patches are weighted for radiative purposes + ! this # density needs to be over either ED patch canopy area or ED patch total area, whichever is less + n_density = currentCohort%n/min(currentPatch%area,currentPatch%total_canopy_area) + + ! for quantities that are natively at column level, calculate plant density using whole area + n_perm2 = currentCohort%n/AREA + else - patch_scaling_scalar = 0._r8 + n_density = 0.0_r8 + n_perm2 = 0.0_r8 endif - nesterov_fire_danger(p) = ed_allsites_inst(g)%acc_NI - spitfire_ROS(p) = currentPatch%ROS_front - TFC_ROS(p) = currentPatch%TFC_ROS - effect_wspeed(p) = currentPatch%effect_wspeed - fire_intensity(p) = currentPatch%FI - fire_area(p) = currentPatch%frac_burnt - scorch_height(p) = currentPatch%SH - fire_fuel_bulkd(p) = currentPatch%fuel_bulkd - fire_fuel_eff_moist(p) = currentPatch%fuel_eff_moist - fire_fuel_sav(p) = currentPatch%fuel_sav - fire_fuel_mef(p) = currentPatch%fuel_mef - sum_fuel(p) = currentPatch%sum_fuel * 1.e3_r8 * patch_scaling_scalar - litter_in(p) = (sum(currentPatch%CWD_AG_in) +sum(currentPatch%leaf_litter_in)) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar - litter_out(p) = (sum(currentPatch%CWD_AG_out)+sum(currentPatch%leaf_litter_out)) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar - seed_bank(p) = sum(currentPatch%seed_bank) * 1.e3_r8 * patch_scaling_scalar - seeds_in(p) = sum(currentPatch%seeds_in) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar - seed_decay(p) = sum(currentPatch%seed_decay) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar - seed_germination(p) = sum(currentPatch%seed_germination) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar - canopy_spread(p) = currentPatch%spread(1) - area_plant(p) = 1._r8 - area_trees(p) = currentPatch%total_tree_area / min(currentPatch%total_canopy_area,currentPatch%area) - if(associated(currentPatch%tallest))then - trimming(p) = currentPatch%tallest%canopy_trim - else - trimming(p) = 0.0_r8 + if ( DEBUG ) then + write(iulog,*) 'EDCLMLinkMod I ',currentCohort%bstore + write(iulog,*) 'EDCLMLinkMod II ',p,ED_bstore(p) endif + ED_bleaf(p) = ED_bleaf(p) + n_density * currentCohort%bl * 1.e3_r8 + ED_bstore(p) = ED_bstore(p) + n_density * currentCohort%bstore * 1.e3_r8 + ED_biomass(p) = ED_biomass(p) + n_density * currentCohort%b * 1.e3_r8 + ED_bdead(p) = ED_bdead(p) + n_density * currentCohort%bdead * 1.e3_r8 + ED_balive(p) = ED_balive(p) + n_density * currentCohort%balive * 1.e3_r8 + PFTbiomass(p,ft) = PFTbiomass(p,ft) + n_density * currentCohort%b * 1.e3_r8 + PFTleafbiomass(p,ft) = PFTleafbiomass(p,ft) + n_density * currentCohort%bl * 1.e3_r8 + PFTstorebiomass(p,ft) = PFTstorebiomass(p,ft) + n_density * currentCohort%bstore * 1.e3_r8 + PFTnindivs(p,ft) = PFTnindivs(p,ft) + currentCohort%n + + dbh = currentCohort%dbh !-0.5*(1./365.25)*currentCohort%ddbhdt + sc = count(dbh-sclass_ed.ge.0.0) + scpf = (ft-1)*nlevsclass_ed+sc + + ! Flux Variables (must pass a NaN check on growth increment and not be recruits) + if( .not.(currentCohort%isnew) ) then + ed_gpp_scpf(c,scpf) = ed_gpp_scpf(c,scpf) + n_perm2*currentCohort%gpp ! [kgC/m2/yr] + ed_npp_totl_scpf(c,scpf) = ed_npp_totl_scpf(c,scpf) + currentcohort%npp*n_perm2 + ed_npp_leaf_scpf(c,scpf) = ed_npp_leaf_scpf(c,scpf) + currentcohort%npp_leaf*n_perm2 + ed_npp_fnrt_scpf(c,scpf) = ed_npp_fnrt_scpf(c,scpf) + currentcohort%npp_froot*n_perm2 + ed_npp_bgsw_scpf(c,scpf) = ed_npp_bgsw_scpf(c,scpf) + currentcohort%npp_bsw*(1._r8-ED_val_ag_biomass)*n_perm2 + ed_npp_agsw_scpf(c,scpf) = ed_npp_agsw_scpf(c,scpf) + currentcohort%npp_bsw*ED_val_ag_biomass*n_perm2 + ed_npp_bgdw_scpf(c,scpf) = ed_npp_bgdw_scpf(c,scpf) + currentcohort%npp_bdead*(1._r8-ED_val_ag_biomass)*n_perm2 + ed_npp_agdw_scpf(c,scpf) = ed_npp_agdw_scpf(c,scpf) + currentcohort%npp_bdead*ED_val_ag_biomass*n_perm2 + ed_npp_seed_scpf(c,scpf) = ed_npp_seed_scpf(c,scpf) + currentcohort%npp_bseed*n_perm2 + ed_npp_stor_scpf(c,scpf) = ed_npp_stor_scpf(c,scpf) + currentcohort%npp_store*n_perm2 + if( abs(currentcohort%npp-(currentcohort%npp_leaf+currentcohort%npp_froot+ & + currentcohort%npp_bsw+currentcohort%npp_bdead+ & + currentcohort%npp_bseed+currentcohort%npp_store))>1.e-9) then + write(iulog,*) 'NPP Partitions are not balancing' + write(iulog,*) 'Fractional Error: ',abs(currentcohort%npp-(currentcohort%npp_leaf+currentcohort%npp_froot+ & + currentcohort%npp_bsw+currentcohort%npp_bdead+ & + currentcohort%npp_bseed+currentcohort%npp_store))/currentcohort%npp + write(iulog,*) 'Terms: ',currentcohort%npp,currentcohort%npp_leaf,currentcohort%npp_froot, & + currentcohort%npp_bsw,currentcohort%npp_bdead, & + currentcohort%npp_bseed,currentcohort%npp_store + write(iulog,*) ' NPP components during FATES-HLM linking does not balance ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Woody State Variables (basal area and number density and mortality) + if (pftcon%woody(ft) == 1) then + + ed_m1_col_scpf(c,scpf) = ed_m1_col_scpf(c,scpf) + currentcohort%bmort*n_perm2*AREA + ed_m2_col_scpf(c,scpf) = ed_m2_col_scpf(c,scpf) + currentcohort%hmort*n_perm2*AREA + ed_m3_col_scpf(c,scpf) = ed_m3_col_scpf(c,scpf) + currentcohort%cmort*n_perm2*AREA + ed_m4_col_scpf(c,scpf) = ed_m4_col_scpf(c,scpf) + currentcohort%imort*n_perm2*AREA + ed_m5_col_scpf(c,scpf) = ed_m5_col_scpf(c,scpf) + currentcohort%fmort*n_perm2*AREA + + ! basal area [m2/ha] + ed_ba_col_scpf(c,scpf) = ed_ba_col_scpf(c,scpf) + & + 0.25*3.14159*((dbh/100.0)**2.0)*n_perm2*AREA + + ! number density [/ha] + ed_np_col_scpf(c,scpf) = ed_np_col_scpf(c,scpf) + AREA*n_perm2 + + ! Growth Incrments must have NaN check and woody check + if(currentCohort%ddbhdt == currentCohort%ddbhdt) then + ed_ddbh_col_scpf(c,scpf) = ed_ddbh_col_scpf(c,scpf) + & + currentCohort%ddbhdt*n_perm2*AREA + else + ed_ddbh_col_scpf(c,scpf) = -999.9 + end if + end if + + end if + + currentCohort => currentCohort%taller + enddo ! cohort loop + + !Patch specific variables that are already calculated + + !These things are all duplicated. Should they all be converted to LL or array structures RF? + + ! define scalar to counteract the patch albedo scaling logic for conserved quantities + if (currentPatch%area .gt. 0._r8) then + patch_scaling_scalar = min(1._r8, currentPatch%area / currentPatch%total_canopy_area) else - write(iulog,*) 'ED: too many patches' - end if ! patchn<15 + patch_scaling_scalar = 0._r8 + endif - currentPatch => currentPatch%younger - end do !patch loop + nesterov_fire_danger(p) = ed_allsites_inst(g)%acc_NI + spitfire_ROS(p) = currentPatch%ROS_front + TFC_ROS(p) = currentPatch%TFC_ROS + effect_wspeed(p) = currentPatch%effect_wspeed + fire_intensity(p) = currentPatch%FI + fire_area(p) = currentPatch%frac_burnt + scorch_height(p) = currentPatch%SH + fire_fuel_bulkd(p) = currentPatch%fuel_bulkd + fire_fuel_eff_moist(p) = currentPatch%fuel_eff_moist + fire_fuel_sav(p) = currentPatch%fuel_sav + fire_fuel_mef(p) = currentPatch%fuel_mef + sum_fuel(p) = currentPatch%sum_fuel * 1.e3_r8 * patch_scaling_scalar + litter_in(p) = (sum(currentPatch%CWD_AG_in) +sum(currentPatch%leaf_litter_in)) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar + litter_out(p) = (sum(currentPatch%CWD_AG_out)+sum(currentPatch%leaf_litter_out)) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar + seed_bank(p) = sum(currentPatch%seed_bank) * 1.e3_r8 * patch_scaling_scalar + seeds_in(p) = sum(currentPatch%seeds_in) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar + seed_decay(p) = sum(currentPatch%seed_decay) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar + seed_germination(p) = sum(currentPatch%seed_germination) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar + canopy_spread(p) = currentPatch%spread(1) + area_plant(p) = 1._r8 + area_trees(p) = currentPatch%total_tree_area / min(currentPatch%total_canopy_area,currentPatch%area) + if(associated(currentPatch%tallest))then + trimming(p) = currentPatch%tallest%canopy_trim + else + trimming(p) = 0.0_r8 + endif + + else + write(iulog,*) 'ED: too many patches' + end if ! patchn<15 + + currentPatch => currentPatch%younger + end do !patch loop - endif ! are there any soil patches? - enddo !gridcell loop + enddo ! site loop end associate - end subroutine ed_update_history_variables + end subroutine ed_update_history_variables !------------------------------------------------------------------------ @@ -2052,7 +2063,7 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins end subroutine ed_clm_leaf_area_profile - subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumns, canopystate_inst) + subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumn, canopystate_inst) ! Created by Charlie Koven and Rosie Fisher, 2014-2015 ! take the flux out of the fragmenting litter pools and port into the decomposing litter pools. ! in this implementation, decomposing pools are assumed to be humus and non-flammable, whereas fragmenting pools @@ -2384,7 +2395,7 @@ subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumns, canopys currentPatch => currentPatch%younger end do !currentPatch - end do + end do ! do sites(s) do c = bounds%begc,bounds%endc do j = 1, nlevdecomp @@ -2410,7 +2421,7 @@ subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumns, canopys end subroutine flux_into_litter_pools !------------------------------------------------------------------------ - subroutine SummarizeProductivityFluxes(this, bounds, ed_allsites_inst) + subroutine SummarizeProductivityFluxes(this, bounds, sites, nsites) ! Summarize the fast production inputs from fluxes per ED individual to fluxes per CLM patch and column ! Must be called between calculation of productivity fluxes and daily ED calls @@ -2429,11 +2440,12 @@ subroutine SummarizeProductivityFluxes(this, bounds, ed_allsites_inst) ! !ARGUMENTS class(ed_clm_type) :: this type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(in), target :: sites(nsites) + integer , intent(in) :: nsites ! ! !LOCAL VARIABLES: real(r8) :: dt ! radiation time step (seconds) - integer :: c, g, cc, fc, l, p, pp + integer :: c, fc, l, p type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort integer :: firstsoilpatch(bounds%begg:bounds%endg) ! the first patch in this gridcell that is soil and thus bare... @@ -2470,72 +2482,65 @@ subroutine SummarizeProductivityFluxes(this, bounds, ed_allsites_inst) ! retrieve the first soil patch associated with each gridcell. ! make sure we only get the first patch value for places which have soil. - firstsoilpatch(bounds%begg:bounds%endg) = -999 - do c = bounds%begc,bounds%endc - g = col%gridcell(c) - l = col%landunit(c) - if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then - firstsoilpatch(g) = col%patchi(c) - endif - enddo - - do g = bounds%begg,bounds%endg - if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then - cc = ed_allsites_inst(g)%clmcolumn - - currentPatch => ed_allsites_inst(g)%oldest_patch - do while(associated(currentPatch)) - - pp = currentPatch%clm_pno - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - - if ((currentPatch%area .gt. 0._r8) .and. (currentPatch%total_canopy_area .gt. 0._r8)) then - - ! for quantities that are at the CLM patch level, because of the way that CLM patches are weighted for radiative purposes - ! this # density needs to be over either ED patch canopy area or ED patch total area, whichever is less - n_density = currentCohort%n/min(currentPatch%area,currentPatch%total_canopy_area) - - ! for quantities that are natively at column level or higher, calculate plant density using whole area (for grid cell averages) - n_perm2 = currentCohort%n/AREA - - else - n_density = 0.0_r8 - n_perm2 = 0.0_r8 - endif + do s = 1,nsites + + c = fcolumn(s) + p = col%patchi(c) + + currentPatch => sites(s)%oldest_patch + do while(associated(currentPatch)) + + p = p + 1 + + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + + if ((currentPatch%area .gt. 0._r8) .and. (currentPatch%total_canopy_area .gt. 0._r8)) then - if ( .not. currentCohort%isnew ) then - - ! map ed cohort-level fluxes to clm patch fluxes - npp(pp) = npp(pp) + currentCohort%npp_clm * 1.e3_r8 * n_density / dt - gpp(pp) = gpp(pp) + currentCohort%gpp_clm * 1.e3_r8 * n_density / dt - ar(pp) = ar(pp) + currentCohort%resp_clm * 1.e3_r8 * n_density / dt - growth_resp(pp) = growth_resp(pp) + currentCohort%resp_g * 1.e3_r8 * n_density / dt - maint_resp(pp) = maint_resp(pp) + currentCohort%resp_m * 1.e3_r8 * n_density / dt - - ! map ed cohort-level npp fluxes to clm column fluxes - npp_col(cc) = npp_col(cc) + currentCohort%npp_clm * n_perm2 * 1.e3_r8 /dt - - endif + ! for quantities that are at the CLM patch level, because of the way that CLM patches are weighted for radiative purposes + ! this # density needs to be over either ED patch canopy area or ED patch total area, whichever is less + n_density = currentCohort%n/min(currentPatch%area,currentPatch%total_canopy_area) - currentCohort => currentCohort%shorter - enddo !currentCohort - currentPatch => currentPatch%younger - end do !currentPatch - end if - end do - + ! for quantities that are natively at column level or higher, calculate plant density using whole area (for grid cell averages) + n_perm2 = currentCohort%n/AREA + + else + n_density = 0.0_r8 + n_perm2 = 0.0_r8 + endif + + if ( .not. currentCohort%isnew ) then + + ! map ed cohort-level fluxes to clm patch fluxes + npp(p) = npp(p) + currentCohort%npp_clm * 1.e3_r8 * n_density / dt + gpp(p) = gpp(p) + currentCohort%gpp_clm * 1.e3_r8 * n_density / dt + ar(p) = ar(pp) + currentCohort%resp_clm * 1.e3_r8 * n_density / dt + growth_resp(p) = growth_resp(p) + currentCohort%resp_g * 1.e3_r8 * n_density / dt + maint_resp(p) = maint_resp(p) + currentCohort%resp_m * 1.e3_r8 * n_density / dt + + ! map ed cohort-level npp fluxes to clm column fluxes + npp_col(c) = npp_col(c) + currentCohort%npp_clm * n_perm2 * 1.e3_r8 /dt + + endif + + currentCohort => currentCohort%shorter + enddo !currentCohort + currentPatch => currentPatch%younger + end do !currentPatch + + end do ! site loop + ! leaving this as a comment here. it should produce same answer for npp_col as above, ! so it may be useful to try as a check to make sure machinery is working proerly !call p2c(bounds,num_soilc, filter_soilc, npp(bounds%begp:bounds%endp), npp_col(bounds%begc:bounds%endc)) - + end associate - end subroutine SummarizeProductivityFluxes +end subroutine SummarizeProductivityFluxes !------------------------------------------------------------------------ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & - ed_allsites_inst, soilbiogeochem_carbonflux_inst, & + sites, nsites, fcolumn, soilbiogeochem_carbonflux_inst, & soilbiogeochem_carbonstate_inst) ! Summarize the combined production and decomposition fluxes into net fluxes @@ -2556,7 +2561,9 @@ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns - type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(in), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst ! @@ -2566,7 +2573,7 @@ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & type(ed_site_type), pointer :: cs type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort - integer :: firstsoilpatch(bounds%begg:bounds%endg) ! the first patch in this gridcell that is soil and thus bare... +! integer :: firstsoilpatch(bounds%begg:bounds%endg) ! the first patch in this gridcell that is soil and thus bare... real(r8) :: n_perm2 ! individuals per m2 of the whole column associate(& @@ -2597,7 +2604,7 @@ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & do c = bounds%begc,bounds%endc ! summary flux variables fire_c_to_atm(c) = 0._r8 - + ! summary stock variables ed_litter_stock(c) = 0._r8 cwd_stock(c) = 0._r8 @@ -2605,54 +2612,43 @@ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & biomass_stock(c) = 0._r8 end do - ! retrieve the first soil patch associated with each gridcell. - ! make sure we only get the first patch value for places which have soil. - firstsoilpatch(bounds%begg:bounds%endg) = -999 - do c = bounds%begc,bounds%endc - g = col%gridcell(c) - l = col%landunit(c) - if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then - firstsoilpatch(g) = col%patchi(c) - endif - enddo - - do g = bounds%begg,bounds%endg - if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then - cc = ed_allsites_inst(g)%clmcolumn + do s = 1, nsites - ! map ed site-level fire fluxes to clm column fluxes - fire_c_to_atm(cc) = ed_allsites_inst(g)%total_burn_flux_to_atm / ( AREA * SHR_CONST_CDAY * 1.e3_r8) + c = fcolumn(s) + p = col%patchi(c) - currentPatch => ed_allsites_inst(g)%oldest_patch - do while(associated(currentPatch)) + ! map ed site-level fire fluxes to clm column fluxes + fire_c_to_atm(c) = sites(s)%total_burn_flux_to_atm / ( AREA * SHR_CONST_CDAY * 1.e3_r8) - pp = currentPatch%clm_pno + currentPatch => sites(s)%oldest_patch + do while(associated(currentPatch)) - ! map litter, CWD, and seed pools to column level - cwd_stock(cc) = cwd_stock(cc) + (currentPatch%area / AREA) * (sum(currentPatch%cwd_ag)+ & - sum(currentPatch%cwd_bg)) * 1.e3_r8 - ed_litter_stock(cc) = ed_litter_stock(cc) + (currentPatch%area / AREA) * & - (sum(currentPatch%leaf_litter)+sum(currentPatch%root_litter)) * 1.e3_r8 - seed_stock(cc) = seed_stock(cc) + (currentPatch%area / AREA) * sum(currentPatch%seed_bank) * 1.e3_r8 + p = p + 1 - currentCohort => currentPatch%tallest - do while(associated(currentCohort)) - - ! for quantities that are natively at column level or higher, calculate plant density using whole area (for grid cell averages) - n_perm2 = currentCohort%n/AREA + ! map litter, CWD, and seed pools to column level + cwd_stock(c) = cwd_stock(c) + (currentPatch%area / AREA) * (sum(currentPatch%cwd_ag)+ & + sum(currentPatch%cwd_bg)) * 1.e3_r8 + ed_litter_stock(c) = ed_litter_stock(c) + (currentPatch%area / AREA) * & + (sum(currentPatch%leaf_litter)+sum(currentPatch%root_litter)) * 1.e3_r8 + seed_stock(c) = seed_stock(c) + (currentPatch%area / AREA) * sum(currentPatch%seed_bank) * 1.e3_r8 + + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) - ! map biomass pools to column level - biomass_stock(cc) = biomass_stock(cc) + (currentCohort%bdead + currentCohort%balive + & - currentCohort%bstore) * n_perm2 * 1.e3_r8 + ! for quantities that are natively at column level or higher, calculate plant density using whole area (for grid cell averages) + n_perm2 = currentCohort%n/AREA + + ! map biomass pools to column level + biomass_stock(c) = biomass_stock(c) + (currentCohort%bdead + currentCohort%balive + & + currentCohort%bstore) * n_perm2 * 1.e3_r8 - currentCohort => currentCohort%shorter - enddo !currentCohort - currentPatch => currentPatch%younger - end do !currentPatch - end if - end do + currentCohort => currentCohort%shorter + enddo !currentCohort + currentPatch => currentPatch%younger + end do ! patch loop + end do ! site loop - ! calculate NEP and NBP fluxes. + ! calculate NEP and NBP fluxes. ????? do fc = 1,num_soilc c = filter_soilc(fc) nep(c) = npp_col(c) - hr(c) @@ -2849,7 +2845,7 @@ subroutine ED_BGC_Carbon_Balancecheck(this, bounds, num_soilc, filter_soilc, soi hr_timeintegrated(c) = 0._r8 end do - endif + endif end associate diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 04a505d143..c7c24a66ec 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -474,7 +474,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! if ED enabled, summarize productivity fluxes onto CLM history file structure call t_startf('edclmsumprodfluxes') call clm_fates%fates2hlm%SummarizeProductivityFluxes( bounds_clump, & - clm_fates%fates(nc)%sites(bounds_clump%begg:bounds_clump%endg)) + clm_fates%fates(nc)%sites,clm_fates%fates(nc)%nsites ) call t_stopf('edclmsumprodfluxes') endif From ddd7d5b79a570354087ec6127398026111023388 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 May 2016 17:10:55 -0700 Subject: [PATCH 13/23] finished pass on EDCLMLinkMod, finished pass on EDBGCDynMod, working on EDAlbedoMod --- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 8 ++++--- components/clm/src/ED/main/EDTypesMod.F90 | 4 +++- components/clm/src/biogeochem/EDBGCDynMod.F90 | 8 ++++--- .../clm/src/biogeophys/SurfaceAlbedoMod.F90 | 9 ++++--- components/clm/src/main/clm_driver.F90 | 24 +++++++++++++++---- 5 files changed, 38 insertions(+), 15 deletions(-) diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index a979bf00f0..b485aa70ef 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -33,7 +33,7 @@ module EDSurfaceRadiationMod subroutine ED_Norman_Radiation (bounds, & filter_vegsol, num_vegsol, filter_nourbanp, num_nourbanp, & - coszen, ed_allsites_inst, surfalb_inst) + coszen, sites, nsites, fcolumn, surfalb_inst) ! ! !DESCRIPTION: ! Two-stream fluxes for canopy radiative transfer @@ -62,7 +62,9 @@ subroutine ED_Norman_Radiation (bounds, & integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter real(r8) , intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) ! FATES site vector + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) type(surfalb_type) , intent(inout) :: surfalb_inst ! ! !LOCAL VARIABLES: @@ -70,7 +72,7 @@ subroutine ED_Norman_Radiation (bounds, & ! ED/NORMAN RADIATION DECS ! ============================================================================ type (ed_patch_type) , pointer :: currentPatch - integer :: radtype, L, ft, g ,j + integer :: radtype, L, ft, j integer :: iter ! Iteration index integer :: irep ! Flag to exit iteration loop real(r8) :: sb diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 611bdd9030..50f8d55304 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -233,7 +233,9 @@ module EDTypesMod !INDICES integer :: patchno ! unique number given to each new patch created for tracking -! integer :: clm_pno ! clm patch number (index of p vector) + + ! INTERF-TODO: THIS VARIABLE SHOULD BE REMOVED + integer :: clm_pno ! clm patch number (index of p vector) ! PATCH INFO real(r8) :: age ! average patch age: years diff --git a/components/clm/src/biogeochem/EDBGCDynMod.F90 b/components/clm/src/biogeochem/EDBGCDynMod.F90 index 6855b4d7ee..b1ee85ea91 100644 --- a/components/clm/src/biogeochem/EDBGCDynMod.F90 +++ b/components/clm/src/biogeochem/EDBGCDynMod.F90 @@ -273,7 +273,7 @@ subroutine EDBGCDynSummary(bounds, num_soilc, filter_soilc, num_soilp, filter_so c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - ed_clm_inst, ed_allsites_inst) + ed_clm_inst, sites, nsites, fcolumn) ! ! !DESCRIPTION: ! Call to all CN and SoilBiogeochem summary routines @@ -299,7 +299,9 @@ subroutine EDBGCDynSummary(bounds, num_soilc, filter_soilc, num_soilp, filter_so type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst type(ed_clm_type) , intent(inout) :: ed_clm_inst - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) ! ! !LOCAL VARIABLES: integer :: begc,endc @@ -351,7 +353,7 @@ subroutine EDBGCDynSummary(bounds, num_soilc, filter_soilc, num_soilp, filter_so ! ---------------------------------------------- call ed_clm_inst%SummarizeNetFluxes(bounds, num_soilc, filter_soilc, & - ed_allsites_inst(bounds%begg:bounds%endg), & + sites(:), nsites, fcolumn(:), & soilbiogeochem_carbonflux_inst, & soilbiogeochem_carbonstate_inst) diff --git a/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 index 56226dd241..a144163f92 100644 --- a/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 @@ -174,7 +174,8 @@ subroutine SurfaceAlbedo(bounds, & num_urbanc , filter_urbanc, & num_urbanp , filter_urbanp, & nextsw_cday , declinp1, & - ed_allsites_inst, aerosol_inst, canopystate_inst, waterstate_inst, & + sites, nsites, fcolumn, & ! FATES STUFF + aerosol_inst, canopystate_inst, waterstate_inst, & lakestate_inst, temperature_inst, surfalb_inst) ! ! !DESCRIPTION: @@ -217,7 +218,9 @@ subroutine SurfaceAlbedo(bounds, & integer , intent(in) :: filter_urbanp(:) ! patch filter for rban points real(r8) , intent(in) :: nextsw_cday ! calendar day at Greenwich (1.00, ..., days/year) real(r8) , intent(in) :: declinp1 ! declination angle (radians) for next time step - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) ! FATES site vector + integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) type(aerosol_type) , intent(in) :: aerosol_inst type(canopystate_type) , intent(in) :: canopystate_inst type(waterstate_type) , intent(in) :: waterstate_inst @@ -918,7 +921,7 @@ subroutine SurfaceAlbedo(bounds, & call ED_Norman_Radiation (bounds, & filter_vegsol, num_vegsol, filter_nourbanp, num_nourbanp, & - coszen_patch(bounds%begp:bounds%endp), ed_allsites_inst(bounds%begg:bounds%endg), & + coszen_patch(bounds%begp:bounds%endp), sites, nsites, fcolumn, & surfalb_inst) else diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index c7c24a66ec..54fca4c77b 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -848,13 +848,13 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) if ( use_ed ) then - call EDBGCDyn(bounds_clump, & + call EDBGCDyn(bounds_clump, & filter(nc)%num_soilc, filter(nc)%soilc, & filter(nc)%num_soilp, filter(nc)%soilp, & filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & cnveg_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - clm_fates%fates2hlm, & + clm_fates%fates2hlm, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & soilbiogeochem_state_inst, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & @@ -871,8 +871,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - clm_fates%fates2hlm, & - clm_fates%fates(nc)%sites(bounds_clump%begg:bounds_clump%endg)) + clm_fates%fates2hlm, & + clm_fates%fates(nc)%sites, & + clm_fates%fates(nc)%nsites, & + clm_fates%f2hmap(nc)%fcolumn ) end if @@ -931,9 +933,21 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) filter_inactive_and_active(nc)%num_urbanp, & filter_inactive_and_active(nc)%urbanp, & nextsw_cday, declinp1, & - clm_fates%fates(nc)%sites(bounds_clump%begg:bounds_clump%endg), & + clm_fates%fates(nc)%sites, & aerosol_inst, canopystate_inst, waterstate_inst, & lakestate_inst, temperature_inst, surfalb_inst) + + ! INTERF-TOD: THIS ACTUALLY WON'T BE TO BAD TO PULL OUT + ! ED_Norman_Radiation() is the last thing called + ! in SurfaceAlbedo, we can simply remove it + ! The clm_fates interfac called below will split + ! ED norman radiation into two parts + ! the calculation of values relevant to FATES + ! and then the transfer back to CLM/ALM memory stucts + + !call clm_fates%radiation() + + call t_stopf('surfalb') ! Albedos for urban columns From 3998821c88c382915459317661164b08019d9af4 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 30 May 2016 13:59:19 -0700 Subject: [PATCH 14/23] columnization on some patch routines. --- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 46 ++++++++--------- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 20 ++++---- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 28 ++++++----- components/clm/src/ED/main/EDCLMLinkMod.F90 | 49 +++++++++---------- .../clm/src/biogeophys/CanopyFluxesMod.F90 | 2 +- .../clm/src/biogeophys/SurfaceAlbedoMod.F90 | 5 +- components/clm/src/main/clm_driver.F90 | 4 +- 7 files changed, 77 insertions(+), 77 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index 0443de25ab..c696787852 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -1137,46 +1137,46 @@ function count_cohorts( currentPatch ) result ( backcount ) end function count_cohorts !-------------------------------------------------------------------------------------! - function countCohorts( bounds, ed_allsites_inst ) result ( totNumCohorts ) +! function countCohorts( bounds, ed_allsites_inst ) result ( totNumCohorts ) ! ! !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 decompMod, only : bounds_type +! use decompMod, only : bounds_type ! ! !ARGUMENTS - type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) +! type(bounds_type) , intent(in) :: bounds +! type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) ! ! !LOCAL VARIABLES: - type (ed_patch_type) , pointer :: currentPatch - type (ed_cohort_type) , pointer :: currentCohort - integer :: g, totNumCohorts - logical :: error +! type (ed_patch_type) , pointer :: currentPatch +! type (ed_cohort_type) , pointer :: currentCohort +! integer :: g, totNumCohorts +! logical :: error !---------------------------------------------------------------------- - totNumCohorts = 0 +! totNumCohorts = 0 - do g = bounds%begg,bounds%endg +! do g = bounds%begg,bounds%endg - if (ed_allsites_inst(g)%istheresoil) then +! if (ed_allsites_inst(g)%istheresoil) then - currentPatch => ed_allsites_inst(g)%oldest_patch - do while(associated(currentPatch)) +! currentPatch => ed_allsites_inst(g)%oldest_patch +! do while(associated(currentPatch)) - currentCohort => currentPatch%shortest - do while(associated(currentCohort)) - totNumCohorts = totNumCohorts + 1 - currentCohort => currentCohort%taller - enddo !currentCohort - currentPatch => currentPatch%younger - end do +! currentCohort => currentPatch%shortest +! do while(associated(currentCohort)) +! totNumCohorts = totNumCohorts + 1 +! currentCohort => currentCohort%taller +! enddo !currentCohort +! currentPatch => currentPatch%younger +! end do - end if - end do +! end if +! end do - end function countCohorts +! end function countCohorts end module EDCohortDynamicsMod diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index d95607ac31..29a00bb43d 100755 --- a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -1427,7 +1427,7 @@ subroutine patch_pft_size_profile(cp_pnt) end subroutine patch_pft_size_profile ! ============================================================================ - function countPatches( bounds, ed_allsites_inst ) result ( totNumPatches ) + function countPatches( bounds, sites, nsites ) result ( totNumPatches ) ! ! !DESCRIPTION: ! Loop over all Patches to count how many there are @@ -1439,24 +1439,22 @@ function countPatches( bounds, ed_allsites_inst ) result ( totNumPatches ) ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer, intent(in) :: nsites ! ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch - integer :: g ! gridcell integer :: totNumPatches ! total number of patches. !--------------------------------------------------------------------- totNumPatches = 0 - do g = bounds%begg,bounds%endg - if (ed_allsites_inst(g)%istheresoil) then - currentPatch => ed_allsites_inst(g)%oldest_patch - do while(associated(currentPatch)) - totNumPatches = totNumPatches + 1 - currentPatch => currentPatch%younger - enddo - endif + do s = 1,nsites + currentPatch => sites(s)%oldest_patch + do while(associated(currentPatch)) + totNumPatches = totNumPatches + 1 + currentPatch => currentPatch%younger + enddo enddo end function countPatches diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index b485aa70ef..4008dca3c5 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -33,7 +33,7 @@ module EDSurfaceRadiationMod subroutine ED_Norman_Radiation (bounds, & filter_vegsol, num_vegsol, filter_nourbanp, num_nourbanp, & - coszen, sites, nsites, fcolumn, surfalb_inst) + coszen, sites, nsites, fcolumn, hsites, surfalb_inst) ! ! !DESCRIPTION: ! Two-stream fluxes for canopy radiative transfer @@ -56,16 +56,17 @@ subroutine ED_Norman_Radiation (bounds, & use SurfaceAlbedoType , only : surfalb_type ! ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! bounds - integer , intent(in) :: filter_vegsol(:) ! filter for vegetated pfts with coszen>0 - integer , intent(in) :: num_vegsol ! number of vegetated pfts where coszen>0 - integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points - integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter - real(r8) , intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: filter_vegsol(:) ! filter for vegetated pfts with coszen>0 + integer , intent(in) :: num_vegsol ! number of vegetated pfts where coszen>0 + integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter + real(r8) , intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] type(ed_site_type) , intent(inout), target :: sites(nsites) ! FATES site vector integer , intent(in) :: nsites integer , intent(in) :: fcolumn(nsites) - type(surfalb_type) , intent(inout) :: surfalb_inst + integer , intent(in) :: hsites(bounds_clump%begc:bounds_clump%endc) + type(surfalb_type) , intent(inout) :: surfalb_inst ! ! !LOCAL VARIABLES: ! ============================================================================ @@ -158,8 +159,9 @@ subroutine ED_Norman_Radiation (bounds, & do fp = 1,num_nourbanp p = filter_nourbanp(fp) if (patch%is_veg(p)) then - g = patch%gridcell(p) - currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + c = patch%column(p) + s = hsites(c) + currentPatch => map_clmpatch_to_edpatch(sites(s), p) currentPatch%f_sun (:,:,:) = 0._r8 currentPatch%fabd_sun_z (:,:,:) = 0._r8 currentPatch%fabd_sha_z (:,:,:) = 0._r8 @@ -179,7 +181,6 @@ subroutine ED_Norman_Radiation (bounds, & do fp = 1,num_vegsol p = filter_vegsol(fp) c = patch%column(p) - g = patch%gridcell(p) weighted_dir_tr(:) = 0._r8 weighted_dif_down(:) = 0._r8 @@ -203,7 +204,10 @@ subroutine ED_Norman_Radiation (bounds, & if (patch%is_veg(p)) then ! We have vegetation... - currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + + ! INTERF-TODO: + s = hsites(c) + currentPatch => map_clmpatch_to_edpatch(sites(s), p) if (associated(currentPatch))then !zero all of the matrices used here to reduce potential for errors. diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index 2dde2fa525..facde8027d 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -1525,7 +1525,7 @@ subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, patch_scaling_scalar = 0._r8 endif - nesterov_fire_danger(p) = ed_allsites_inst(g)%acc_NI + nesterov_fire_danger(p) = sites(s)%acc_NI spitfire_ROS(p) = currentPatch%ROS_front TFC_ROS(p) = currentPatch%TFC_ROS effect_wspeed(p) = currentPatch%effect_wspeed @@ -2670,36 +2670,31 @@ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & ! calculate the total ED -> BGC flux and keep track of the last day's info for balance checking purposes if ( is_beg_curr_day() ) then ! - do g = bounds%begg,bounds%endg - if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then - cc = ed_allsites_inst(g)%clmcolumn - ed_to_bgc_last_edts(cc) = ed_to_bgc_this_edts(cc) - endif + do s = 1,nsites + c = fcolumn(s) + ed_to_bgc_last_edts(c) = ed_to_bgc_this_edts(c) end do ! - do g = bounds%begg,bounds%endg - if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then - cc = ed_allsites_inst(g)%clmcolumn - ed_to_bgc_this_edts(cc) = 0._r8 - seed_rain_flux(cc) = 0._r8 - endif + do s = 1,nsites + c = fcolumn(s) + ed_to_bgc_this_edts(c) = 0._r8 + seed_rain_flux(c) = 0._r8 end do ! - do g = bounds%begg,bounds%endg - if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then - cc = ed_allsites_inst(g)%clmcolumn - currentPatch => ed_allsites_inst(g)%oldest_patch - do while(associated(currentPatch)) - ! - ed_to_bgc_this_edts(cc) = ed_to_bgc_this_edts(cc) + (sum(currentPatch%CWD_AG_out) + sum(currentPatch%CWD_BG_out) + & - + sum(currentPatch%seed_decay) + sum(currentPatch%leaf_litter_out) + sum(currentPatch%root_litter_out)) & - * ( currentPatch%area/AREA ) * 1.e3_r8 / ( 365.0_r8*SHR_CONST_CDAY ) - ! - seed_rain_flux(cc) = seed_rain_flux(cc) + sum(currentPatch%seed_rain_flux) * 1.e3_r8 / ( 365.0_r8*SHR_CONST_CDAY ) - ! - currentPatch => currentPatch%younger - end do !currentPatch - end if + do s = 1,nsites + c = fcolumn(s) + + currentPatch => sites(s)%oldest_patch + do while(associated(currentPatch)) + ! + ed_to_bgc_this_edts(c) = ed_to_bgc_this_edts(c) + (sum(currentPatch%CWD_AG_out) + sum(currentPatch%CWD_BG_out) + & + + sum(currentPatch%seed_decay) + sum(currentPatch%leaf_litter_out) + sum(currentPatch%root_litter_out)) & + * ( currentPatch%area/AREA ) * 1.e3_r8 / ( 365.0_r8*SHR_CONST_CDAY ) + ! + seed_rain_flux(c) = seed_rain_flux(c) + sum(currentPatch%seed_rain_flux) * 1.e3_r8 / ( 365.0_r8*SHR_CONST_CDAY ) + ! + currentPatch => currentPatch%younger + end do !currentPatch end do endif diff --git a/components/clm/src/biogeophys/CanopyFluxesMod.F90 b/components/clm/src/biogeophys/CanopyFluxesMod.F90 index 0722ae4794..ddf3de34fe 100644 --- a/components/clm/src/biogeophys/CanopyFluxesMod.F90 +++ b/components/clm/src/biogeophys/CanopyFluxesMod.F90 @@ -76,7 +76,7 @@ module CanopyFluxesMod !------------------------------------------------------------------------------ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & - ed_allsites_inst, atm2lnd_inst, canopystate_inst, cnveg_state_inst, & + sites, nsites, fcolumn, atm2lnd_inst, canopystate_inst, cnveg_state_inst, & energyflux_inst, frictionvel_inst, soilstate_inst, solarabs_inst, surfalb_inst, & temperature_inst, waterflux_inst, waterstate_inst, ch4_inst, ozone_inst, photosyns_inst, & humanindex_inst, soil_water_retention_curve, cnveg_nitrogenstate_inst) diff --git a/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 index a144163f92..2a9e06a31e 100644 --- a/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 @@ -174,7 +174,7 @@ subroutine SurfaceAlbedo(bounds, & num_urbanc , filter_urbanc, & num_urbanp , filter_urbanp, & nextsw_cday , declinp1, & - sites, nsites, fcolumn, & ! FATES STUFF + sites, nsites, fcolumn, hsites, & ! FATES STUFF aerosol_inst, canopystate_inst, waterstate_inst, & lakestate_inst, temperature_inst, surfalb_inst) ! @@ -221,6 +221,7 @@ subroutine SurfaceAlbedo(bounds, & type(ed_site_type) , intent(inout), target :: sites(nsites) ! FATES site vector integer , intent(in) :: nsites integer , intent(in) :: fcolumn(nsites) + integer , intent(in) :: hsites(bounds%begc:bounds:endc) type(aerosol_type) , intent(in) :: aerosol_inst type(canopystate_type) , intent(in) :: canopystate_inst type(waterstate_type) , intent(in) :: waterstate_inst @@ -921,7 +922,7 @@ subroutine SurfaceAlbedo(bounds, & call ED_Norman_Radiation (bounds, & filter_vegsol, num_vegsol, filter_nourbanp, num_nourbanp, & - coszen_patch(bounds%begp:bounds%endp), sites, nsites, fcolumn, & + coszen_patch(bounds%begp:bounds%endp), sites, nsites, fcolumn, hsites, & surfalb_inst) else diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 54fca4c77b..c1f7a44e65 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -933,10 +933,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) filter_inactive_and_active(nc)%num_urbanp, & filter_inactive_and_active(nc)%urbanp, & nextsw_cday, declinp1, & - clm_fates%fates(nc)%sites, & + clm_fates%fates(nc)%sites, clm_fates%fates(nc)%nsites, & + clm_fates%f2hmap(nc)%fcolumn, clm_fates%f2hmap(nc)%hsites, & aerosol_inst, canopystate_inst, waterstate_inst, & lakestate_inst, temperature_inst, surfalb_inst) + ! INTERF-TOD: THIS ACTUALLY WON'T BE TO BAD TO PULL OUT ! ED_Norman_Radiation() is the last thing called ! in SurfaceAlbedo, we can simply remove it From 3ddab7721792ee41609564a2378878fae6d38563 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 31 May 2016 15:27:16 -0700 Subject: [PATCH 15/23] completed first pass of code for columnization. WOrking through compiler errors --- .../src/ED/biogeochem/EDCohortDynamicsMod.F90 | 2 +- .../src/ED/biogeochem/EDPatchDynamicsMod.F90 | 7 +- .../clm/src/ED/biogeochem/EDPhysiologyMod.F90 | 21 ++++-- .../ED/biogeophys/EDAccumulateFluxesMod.F90 | 16 ++-- .../clm/src/ED/biogeophys/EDBtranMod.F90 | 13 ++-- .../src/ED/biogeophys/EDPhotosynthesisMod.F90 | 18 +++-- .../src/ED/biogeophys/EDSurfaceAlbedoMod.F90 | 10 +-- components/clm/src/ED/fire/SFMainMod.F90 | 13 +++- components/clm/src/ED/main/EDCLMLinkMod.F90 | 69 ++++++++--------- components/clm/src/ED/main/EDInitMod.F90 | 75 +++---------------- components/clm/src/ED/main/EDMainMod.F90 | 39 +++++----- .../clm/src/ED/main/EDRestVectorMod.F90 | 7 +- components/clm/src/ED/main/EDTypesMod.F90 | 2 +- .../clm/src/ED/main/FatesInterfaceMod.F90 | 2 +- .../clm/src/biogeophys/CanopyFluxesMod.F90 | 25 ++++--- .../clm/src/biogeophys/SurfaceAlbedoMod.F90 | 5 +- components/clm/src/main/clm_driver.F90 | 4 +- 17 files changed, 152 insertions(+), 176 deletions(-) diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 index c696787852..beb2d1062b 100755 --- a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -27,7 +27,7 @@ module EDCohortDynamicsMod public :: sort_cohorts public :: copy_cohort public :: count_cohorts - public :: countCohorts +! public :: countCohorts public :: allocate_live_biomass logical, parameter :: DEBUG = .false. ! local debug flag diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 index 29a00bb43d..edea854454 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, numPatchesPerGridCell + use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, numPatchesPerCol use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, udata use EDTypesMod , only : min_patch_area ! @@ -1014,7 +1014,7 @@ subroutine fuse_patches( csite ) !--------------------------------------------------------------------- !maxpatch = 4 - maxpatch = numPatchesPerGridCell + maxpatch = numPatchesPerCol currentSite => csite @@ -1353,7 +1353,7 @@ subroutine terminate_patches(cs_pnt) areatot = areatot + currentPatch%area currentPatch => currentPatch%younger if((areatot-area) > 0.0000001_r8)then - write(iulog,*) 'ED: areatot too large. end terminate', areatot,currentSite%clmgcell + write(iulog,*) 'ED: areatot too large. end terminate', areatot endif enddo @@ -1445,6 +1445,7 @@ function countPatches( bounds, sites, nsites ) result ( totNumPatches ) ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch integer :: totNumPatches ! total number of patches. + integer :: s !--------------------------------------------------------------------- totNumPatches = 0 diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 index e0e3a730cf..c5aff001f1 100755 --- a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -247,6 +247,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) use clm_time_manager, only : get_days_per_year, get_curr_date use clm_time_manager, only : get_ref_date, timemgr_datediff use EDTypesMod, only : udata + use PatchType , only : patch ! ! !ARGUMENTS: type(ed_site_type) , intent(inout), target :: currentSite @@ -255,7 +256,6 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) ! ! !LOCAL VARIABLES: real(r8), pointer :: t_veg24(:) - integer :: g ! grid point integer :: t ! day of year integer :: ncolddays ! no days underneath the threshold for leaf drop integer :: ncolddayslim ! critical no days underneath the threshold for leaf drop @@ -268,6 +268,8 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) integer :: mon ! month (1, ..., 12) integer :: day ! day of month (1, ..., 31) integer :: sec ! seconds of the day + integer :: patchi ! the first CLM/ALM patch index of the associated column + integer :: coli ! the CLM/ALM column index of the associated site real(r8) :: gdd_threshold real(r8) :: a,b,c ! params of leaf-pn model from botta et al. 2000. @@ -283,10 +285,13 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) !------------------------------------------------------------------------ - t_veg24 => temperature_inst%t_veg24_patch ! Input: [real(r8) (:)] avg pft vegetation temperature for last 24 hrs + ! INTERF-TODO: THIS IS A BAND-AID, AS I WAS HOPING TO REMOVE CLM_PNO + ! ALREADY REMOVED currentSite%clmcolumn, hence the need for these - g = currentSite%clmgcell + patchi = currentSite%oldest_patch%clm_pno-1 + coli = patch%column(patchi) + t_veg24 => temperature_inst%t_veg24_patch ! Input: [real(r8) (:)] avg pft vegetation temperature for last 24 hrs call get_curr_date(yr, mon, day, sec) curdate = yr*10000 + mon*100 + day @@ -315,7 +320,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) cold_t = 7.5_r8 ! ed_ph_coldtemp t = udata%time_period - temp_in_C = t_veg24(currentSite%oldest_patch%clm_pno-1) - tfrz + temp_in_C = t_veg24(patchi) - tfrz !-----------------Cold Phenology--------------------! @@ -359,7 +364,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) endif ! ! accumulate the GDD using daily mean temperatures - if (t_veg24(currentSite%oldest_patch%clm_pno-1) .gt. tfrz) then + if (t_veg24(patchi) .gt. tfrz) then currentSite%ED_GDD_site = currentSite%ED_GDD_site + t_veg24(currentSite%oldest_patch%clm_pno-1) - tfrz endif @@ -437,7 +442,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst) ! distinction actually matter??).... !Accumulate surface water memory of last 10 days. - currentSite%water_memory(1) = waterstate_inst%h2osoi_vol_col(currentSite%clmcolumn,1) + currentSite%water_memory(1) = waterstate_inst%h2osoi_vol_col(coli,1) do i = 1,9 !shift memory along one currentSite%water_memory(11-i) = currentSite%water_memory(10-i) enddo @@ -1140,6 +1145,7 @@ subroutine fragmentation_scaler( currentPatch, temperature_inst ) ! !USES: use shr_const_mod , only : SHR_CONST_PI, SHR_CONST_TKFRZ use EDSharedParamsMod , only : EDParamsShareInst + use PatchType , only : patch ! ! !ARGUMENTS type(ed_patch_type) , intent(inout) :: currentPatch @@ -1165,8 +1171,9 @@ subroutine fragmentation_scaler( currentPatch, temperature_inst ) catanf_30 = catanf(30._r8) - c = currentPatch%siteptr%clmcolumn +! c = currentPatch%siteptr%clmcolumn p = currentPatch%clm_pno + c = patch%column(p) ! set "froz_q10" parameter froz_q10 = EDParamsShareInst%froz_q10 diff --git a/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 index 07464781d7..ad32348ca0 100644 --- a/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 +++ b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 @@ -20,7 +20,7 @@ module EDAccumulateFluxesMod contains !------------------------------------------------------------------------------ - subroutine AccumulateFluxes_ED(bounds, p, ed_allsites_inst, photosyns_inst) + subroutine AccumulateFluxes_ED(bounds, p, sites, nsites, hsites , photosyns_inst) ! ! !DESCRIPTION: ! see above @@ -36,14 +36,18 @@ subroutine AccumulateFluxes_ED(bounds, p, ed_allsites_inst, photosyns_inst) ! !ARGUMENTS type(bounds_type) , intent(in) :: bounds integer , intent(in) :: p !patch/'p' - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: hsites(bounds%begc:bounds%endc) + type(photosyns_type) , intent(inout) :: photosyns_inst ! ! !LOCAL VARIABLES: type(ed_cohort_type), pointer :: currentCohort ! current cohort type(ed_patch_type) , pointer :: currentPatch ! current patch integer :: iv !leaf layer - integer :: g !gridcell + integer :: c ! clm/alm column + integer :: s ! ed site !---------------------------------------------------------------------- associate(& @@ -55,8 +59,10 @@ subroutine AccumulateFluxes_ED(bounds, p, ed_allsites_inst, photosyns_inst) if (patch%is_veg(p)) then - g = patch%gridcell(p) - currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + c = patch%column(p) + s = hsites(c) + + currentPatch => map_clmpatch_to_edpatch(sites(s), p) currentCohort => currentPatch%shortest do while(associated(currentCohort)) diff --git a/components/clm/src/ED/biogeophys/EDBtranMod.F90 b/components/clm/src/ED/biogeophys/EDBtranMod.F90 index 5cfb93c74b..9c5475059c 100644 --- a/components/clm/src/ED/biogeophys/EDBtranMod.F90 +++ b/components/clm/src/ED/biogeophys/EDBtranMod.F90 @@ -25,7 +25,7 @@ module EDBtranMod contains !------------------------------------------------------------------------------ - subroutine btran_ed( bounds, p, ed_allsites_inst, & + subroutine btran_ed( bounds, p, sites, nsites, hsites, & soilstate_inst, waterstate_inst, temperature_inst, energyflux_inst) ! ! !DESCRIPTION: @@ -49,7 +49,9 @@ subroutine btran_ed( bounds, p, ed_allsites_inst, & ! !ARGUMENTS type(bounds_type) , intent(in) :: bounds ! clump bounds integer , intent(in) :: p ! patch/'p' - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: hsites(bounds%begc:bounds%endc) type(soilstate_type) , intent(inout) :: soilstate_inst type(waterstate_type) , intent(in) :: waterstate_inst type(temperature_type) , intent(in) :: temperature_inst @@ -57,7 +59,7 @@ subroutine btran_ed( bounds, p, ed_allsites_inst, & ! ! !LOCAL VARIABLES: integer :: iv !leaf layer - integer :: g !gridcell + integer :: s !site integer :: c !column integer :: j !soil layer integer :: ft ! plant functional type index @@ -140,9 +142,10 @@ subroutine btran_ed( bounds, p, ed_allsites_inst, & if (patch%is_veg(p)) then c = patch%column(p) - g = patch%gridcell(p) + s = hsites(c) - currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + currentPatch => map_clmpatch_to_edpatch(sites(s), p) + do FT = 1,numpft_ed currentPatch%btran_ft(FT) = 0.0_r8 do j = 1,nlevgrnd diff --git a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 index 6bf500cc52..058cbc749c 100644 --- a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +++ b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 @@ -20,7 +20,7 @@ module EDPhotosynthesisMod !--------------------------------------------------------- subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & - rb, dayl_factor, ed_allsites_inst, & + rb, dayl_factor, sites, nsites, hsites, & atm2lnd_inst, temperature_inst, canopystate_inst, photosyns_inst) ! ! !DESCRIPTION: @@ -61,7 +61,9 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & real(r8) , intent(in) :: cair( bounds%begp: ) ! Atmospheric CO2 partial pressure (Pa) real(r8) , intent(inout) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) real(r8) , intent(in) :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: hsites(bounds%begc:bounds%endc) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(temperature_type) , intent(in) :: temperature_inst type(canopystate_type) , intent(inout) :: canopystate_inst @@ -145,7 +147,7 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & real(r8) :: theta_ip ! empirical curvature parameter for ap photosynthesis co-limitation ! Other - integer :: c,CL,f,g,iv,j,p,ps,ft ! indices + integer :: c,CL,f,s,iv,j,p,ps,ft ! indices integer :: NCL_p ! number of canopy layers in patch real(r8) :: cf ! s m**2/umol -> s/m real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] @@ -323,10 +325,11 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & gccanopy(p) = 0._r8 if (patch%is_veg(p)) then - g = patch%gridcell(p) + c = patch%column(p) + s = hsites(c) - currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + currentPatch => map_clmpatch_to_edpatch(sites(s), p) currentPatch%ncan(:,:) = 0 !redo the canopy structure algorithm to get round a bug that is happening for site 125, FT13. @@ -401,10 +404,11 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & do f = 1,fn p = filterp(f) c = patch%column(p) + s = hsites(c) if (patch%is_veg(p)) then - g = patch%gridcell(p) - currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + + currentPatch => map_clmpatch_to_edpatch(sites(s), p) do FT = 1,numpft_ed if (nint(c3psn(FT)) == 1)then diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 index 4008dca3c5..3110bd63a4 100644 --- a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -65,7 +65,7 @@ subroutine ED_Norman_Radiation (bounds, & type(ed_site_type) , intent(inout), target :: sites(nsites) ! FATES site vector integer , intent(in) :: nsites integer , intent(in) :: fcolumn(nsites) - integer , intent(in) :: hsites(bounds_clump%begc:bounds_clump%endc) + integer , intent(in) :: hsites(bounds%begc:bounds%endc) type(surfalb_type) , intent(inout) :: surfalb_inst ! ! !LOCAL VARIABLES: @@ -113,7 +113,7 @@ subroutine ED_Norman_Radiation (bounds, & real(r8) :: denom real(r8) :: lai_reduction(2) - integer :: fp,p,c,iv ! array indices + integer :: fp,p,c,iv,s ! array indices integer :: ib ! waveband number real(r8) :: cosz ! 0.001 <= coszen <= 1.000 real(r8) :: chil(bounds%begp:bounds%endp) ! -0.4 <= xl <= 0.6 @@ -245,7 +245,7 @@ subroutine ED_Norman_Radiation (bounds, & end do !iv end do !ft end do !L - g = currentPatch%siteptr%clmgcell +! g = currentPatch%siteptr%clmgcell do radtype = 1,2 !do this once for one unit of diffuse, and once for one unit of direct radiation do ib = 1,numrad @@ -822,7 +822,7 @@ subroutine ED_Norman_Radiation (bounds, & error = abs(currentPatch%sabs_dir(ib)-(currentPatch%tr_soil_dir(ib)*(1.0_r8-albgrd(c,ib))+ & currentPatch%tr_soil_dir_dif(ib)*(1.0_r8-albgri(c,ib)))) if ( abs(error) > 0.0001)then - write(iulog,*)'dir ground absorption error',p,g,error,currentPatch%sabs_dir(ib), & + write(iulog,*)'dir ground absorption error',p,c,error,currentPatch%sabs_dir(ib), & currentPatch%tr_soil_dir(ib)* & (1.0_r8-albgrd(c,ib)),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) write(iulog,*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), & @@ -837,7 +837,7 @@ subroutine ED_Norman_Radiation (bounds, & else if ( abs(currentPatch%sabs_dif(ib)-(currentPatch%tr_soil_dif(ib) * & (1.0_r8-albgri(c,ib)))) > 0.0001)then - write(iulog,*)'dif ground absorption error',p,g,currentPatch%sabs_dif(ib) , & + write(iulog,*)'dif ground absorption error',p,c,currentPatch%sabs_dif(ib) , & (currentPatch%tr_soil_dif(ib)* & (1.0_r8-albgri(c,ib))),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) endif diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 index 60194c1735..d9d56b3575 100755 --- a/components/clm/src/ED/fire/SFMainMod.F90 +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -640,6 +640,7 @@ subroutine area_burnt ( currentSite ) use domainMod, only : ldomain use EDParamsMod, only : ED_val_nfires + use PatchType, only : patch type(ed_site_type), intent(inout), target :: currentSite @@ -650,7 +651,7 @@ subroutine area_burnt ( currentSite ) real db !distance fire has travelled backward real(r8) gridarea real(r8) size_of_fire - integer g + integer g, p currentSite%frac_burnt = 0.0_r8 @@ -683,9 +684,17 @@ subroutine area_burnt ( currentSite ) ! --- calculate area burnt--- if(lb > 0.0_r8) then - g = currentSite%clmgcell + + p = currentPatch%clm_pno + g = patch%gridcell(p) + ! g = currentSite%clmgcell (DEPRECATED VARIABLE) + + ! INTERF-TODO: + ! THIS SHOULD HAVE THE COLUMN AND LU AREA WEIGHT ALSO, NO? + gridarea = ldomain%area(g) *1000000.0_r8 !convert from km2 into m2 currentPatch%NF = ldomain%area(g) * ED_val_nfires * currentPatch%area/area /365 + ! If there are 15 lightening strickes per year, per km2. (approx from NASA product) ! then there are 15/365 s/km2 each day. diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index facde8027d..009070916e 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -10,7 +10,7 @@ module EDCLMLinkMod use decompMod , only : bounds_type use clm_varpar , only : nclmax, nlevcan_ed, numpft, numcft, mxpft use clm_varctl , only : iulog - + use ColumnType , only : col use EDtypesMod , only : ed_site_type, ed_cohort_type, ed_patch_type, ncwd use EDtypesMod , only : sclass_ed, nlevsclass_ed, AREA use CanopyStateType , only : canopystate_type @@ -21,6 +21,7 @@ module EDCLMLinkMod use clm_time_manager , only : is_beg_curr_day, get_step_size, get_nstep use shr_const_mod, only: SHR_CONST_CDAY use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg ! implicit none @@ -958,7 +959,6 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c use EDEcophysConType , only : EDecophyscon use EDtypesMod , only : area use PatchType , only : clmpatch => patch - use ColumnType , only : col use LandunitType , only : lun use pftconMod , only : pftcon use CanopyStateType , only : canopystate_type @@ -976,7 +976,7 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c ! !LOCAL VARIABLES: type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort - integer :: g,l,p,c + integer :: g,l,p,c,s integer :: ft ! plant functional type integer :: patchn ! identification number for each patch. real(r8) :: total_bare_ground ! sum of the bare fraction in all pfts. @@ -1202,13 +1202,13 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c end subroutine ed_clm_link !----------------------------------------------------------------------- - subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, - firstsoilpatch, canopystate_inst) + subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, canopystate_inst) ! ! !USES: use CanopyStateType , only : canopystate_type use PatchType , only : clmpatch => patch use pftconMod , only : pftcon + ! ! !ARGUMENTS: class(ed_clm_type) :: this @@ -1221,7 +1221,7 @@ subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, type(canopystate_type) , intent(inout) :: canopystate_inst ! ! !LOCAL VARIABLES: - integer :: p,ft,c + integer :: p,ft,c,s ! integer :: firstsoilpatch(bounds%begg:bounds%endg) real(r8) :: n_density ! individual of cohort per m2. real(r8) :: n_perm2 ! individuals per m2 for the whole column @@ -1587,7 +1587,7 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins ! !ARGUMENTS class(ed_clm_type) :: this type(ed_site_type) , intent(inout) :: currentSite - integer , intent(in) :: c ! ALM/CLM column index of this site + integer , intent(in) :: colindex ! ALM/CLM column index of this site type(waterstate_type) , intent(inout) :: waterstate_inst type(canopystate_type) , intent(inout) :: canopystate_inst ! @@ -1639,7 +1639,8 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins ! Each leaf is defined by how deep in the canopy it is, in terms of LAI units. (FIX(RF,032414), GB) currentPatch => currentSite%oldest_patch ! ed patch - p = col%patchi(c) ! CLM/ALM equivalent patch + p = col%patchi(colindex) ! first patch of the column of interest, for vegetated + ! columns this is the non-veg patch do while(associated(currentPatch)) p = p + 1 ! First CLM/ALM patch is non-veg, increment at loop start @@ -1738,15 +1739,15 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins !snow burial fraction_exposed = 1.0_r8 !default. - snowdp(c) = snow_depth(c) * frac_sno_eff(c) - if(snowdp(c) > maxh(iv))then + snowdp(colindex) = snow_depth(colindex) * frac_sno_eff(colindex) + if(snowdp(colindex) > maxh(iv))then fraction_exposed = 0._r8 endif - if(snowdp(c) < minh(iv))then + if(snowdp(colindex) < minh(iv))then fraction_exposed = 1._r8 endif - if(snowdp(c) >= minh(iv).and.snowdp(c) <= maxh(iv))then !only partly hidden... - fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(c)-minh(iv))/dh))) + if(snowdp(colindex) >= minh(iv).and.snowdp(colindex) <= maxh(iv))then !only partly hidden... + fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(colindex)-minh(iv))/dh))) endif ! no m2 of leaf per m2 of ground in each height class @@ -1816,9 +1817,9 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins ! c = clmpatch%column(currentPatch%clm_pno) ! INTERF-TODO: REMOVE THIS AT SOME POINT, THIS SANITY CHECK IS NOT NEEDED WHEN THE ! COLUMNIZATION IS COMPLETE - if( clmpatch%column(currentPatch%clm_pno) .ne. c .or. currentPatch%clm_pno .ne. p )then + if( clmpatch%column(currentPatch%clm_pno) .ne. colindex .or. currentPatch%clm_pno .ne. p )then ! ERROR - write(iulog,*) ' clmpatch%column(currentPatch%clm_pno) .ne. c .or. currentPatch%clm_pno .ne. p ' + write(iulog,*) ' clmpatch%column(currentPatch%clm_pno) .ne. colindex .or. currentPatch%clm_pno .ne. p ' call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -1841,15 +1842,15 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & EDecophyscon%crown(currentCohort%pft)) ! pftcon%vertical_canopy_frac(ft)) fraction_exposed = 1.0_r8 !default. - snowdp(c) = snow_depth(c) * frac_sno_eff(c) - if(snowdp(c) > layer_top_hite)then + snowdp(colindex) = snow_depth(colindex) * frac_sno_eff(colindex) + if(snowdp(colindex) > layer_top_hite)then fraction_exposed = 0._r8 endif - if(snowdp(c) <= layer_bottom_hite)then + if(snowdp(colindex) <= layer_bottom_hite)then fraction_exposed = 1._r8 endif - if(snowdp(c) > layer_bottom_hite.and.snowdp(c) <= layer_top_hite)then !only partly hidden... - fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(c)-layer_bottom_hite)/ & + if(snowdp(colindex) > layer_bottom_hite.and.snowdp(colindex) <= layer_top_hite)then !only partly hidden... + fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(colindex)-layer_bottom_hite)/ & (layer_top_hite-layer_bottom_hite )))) endif @@ -1874,14 +1875,14 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins fraction_exposed = 1.0_r8 !default. fraction_exposed = 1.0_r8 !default. - if(snowdp(c) > layer_top_hite)then + if(snowdp(colindex) > layer_top_hite)then fraction_exposed = 0._r8 endif - if(snowdp(c) <= layer_bottom_hite)then + if(snowdp(colindex) <= layer_bottom_hite)then fraction_exposed = 1._r8 endif - if(snowdp(c) > layer_bottom_hite.and.snowdp(c) <= layer_top_hite)then !only partly hidden... - fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(c)-layer_bottom_hite) / & + if(snowdp(colindex) > layer_bottom_hite.and.snowdp(colindex) <= layer_top_hite)then !only partly hidden... + fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(colindex)-layer_bottom_hite) / & (layer_top_hite-layer_bottom_hite )))) endif @@ -1973,7 +1974,7 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins if(abs(tlai(p)-tlai_temp) > 0.0001_r8) then write(iulog,*) 'ED: error with tlai calcs',& - NC,currentSite%clmgcell, abs(tlai(p)-tlai_temp), tlai_temp,tlai(p) + NC,colindex, abs(tlai(p)-tlai_temp), tlai_temp,tlai(p) do L = 1,currentPatch%NCL_p write(iulog,*) 'ED: carea profile',L,currentPatch%canopy_area_profile(L,1,1:currentPatch%nrad(L,1)) @@ -2024,7 +2025,7 @@ subroutine ed_clm_leaf_area_profile( this, currentSite, colindex, waterstate_ins if(abs(sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1))) > 1.00001)then write(iulog,*) 'ED: canopy-area-profile wrong',sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1)), & - currentSite%clmgcell,currentPatch%patchno,L + colindex,currentPatch%patchno,L write(iulog,*) 'ED: areas',currentPatch%canopy_area_profile(L,1:2,1),currentPatch%patchno currentCohort => currentPatch%shortest @@ -2086,9 +2087,6 @@ subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumn, canopyst use pftconMod, only : pftcon use clm_varcon, only : zisoi, dzsoi_decomp, zsoi - use ColumnType , only : col - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg use EDParamsMod, only : ED_val_ag_biomass ! implicit none @@ -2105,7 +2103,7 @@ subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumn, canopyst type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort type(ed_site_type), pointer :: cs - integer c,p,ci,j,g + integer c,p,ci,j,s real(r8) time_convert ! from year to seconds real(r8) mass_convert ! ED uses kg, CLM uses g integer :: begp,endp @@ -2421,7 +2419,7 @@ subroutine flux_into_litter_pools(this, bounds, sites, nsites, fcolumn, canopyst end subroutine flux_into_litter_pools !------------------------------------------------------------------------ - subroutine SummarizeProductivityFluxes(this, bounds, sites, nsites) + subroutine SummarizeProductivityFluxes(this, bounds, sites, nsites, fcolumn) ! Summarize the fast production inputs from fluxes per ED individual to fluxes per CLM patch and column ! Must be called between calculation of productivity fluxes and daily ED calls @@ -2430,7 +2428,6 @@ subroutine SummarizeProductivityFluxes(this, bounds, sites, nsites) ! Written By Charlie Koven, April 2016 ! ! !USES: - use ColumnType , only : col use LandunitType , only : lun use landunit_varcon , only : istsoil !use subgridAveMod , only : p2c @@ -2442,10 +2439,11 @@ subroutine SummarizeProductivityFluxes(this, bounds, sites, nsites) type(bounds_type) , intent(in) :: bounds type(ed_site_type) , intent(in), target :: sites(nsites) integer , intent(in) :: nsites + integer , intent(in) :: fcolumn(nsites) ! ! !LOCAL VARIABLES: real(r8) :: dt ! radiation time step (seconds) - integer :: c, fc, l, p + integer :: c, fc, l, p, s type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort integer :: firstsoilpatch(bounds%begg:bounds%endg) ! the first patch in this gridcell that is soil and thus bare... @@ -2515,7 +2513,7 @@ subroutine SummarizeProductivityFluxes(this, bounds, sites, nsites) ! map ed cohort-level fluxes to clm patch fluxes npp(p) = npp(p) + currentCohort%npp_clm * 1.e3_r8 * n_density / dt gpp(p) = gpp(p) + currentCohort%gpp_clm * 1.e3_r8 * n_density / dt - ar(p) = ar(pp) + currentCohort%resp_clm * 1.e3_r8 * n_density / dt + ar(p) = ar(p) + currentCohort%resp_clm * 1.e3_r8 * n_density / dt growth_resp(p) = growth_resp(p) + currentCohort%resp_g * 1.e3_r8 * n_density / dt maint_resp(p) = maint_resp(p) + currentCohort%resp_m * 1.e3_r8 * n_density / dt @@ -2550,7 +2548,6 @@ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & ! Written by Charlie Koven, Feb 2016 ! ! !USES: - use ColumnType , only : col use LandunitType , only : lun use landunit_varcon , only : istsoil ! @@ -2569,7 +2566,7 @@ subroutine SummarizeNetFluxes(this, bounds, num_soilc, filter_soilc, & ! ! !LOCAL VARIABLES: real(r8) :: dt ! radiation time step (seconds) - integer :: c, g, cc, fc, l, p, pp + integer :: c, s, cc, fc, l, p, pp type(ed_site_type), pointer :: cs type (ed_patch_type) , pointer :: currentPatch type (ed_cohort_type) , pointer :: currentCohort diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 83b457e7a3..5037931420 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -20,7 +20,7 @@ module EDInitMod use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts use EDPatchDynamicsMod , only : create_patch use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, area - use EDTypesMod , only : cohorts_per_gcell, ncwd, numpft_ed, udata + use EDTypesMod , only : cohorts_per_col, ncwd, numpft_ed, udata use EDCLMLinkMod , only : ed_clm_type implicit none @@ -28,11 +28,10 @@ module EDInitMod logical :: DEBUG = .false. - public :: ed_init_sites public :: zero_site - - private :: set_site_properties - private :: init_patches + public :: init_patches + public :: set_site_properties + private :: init_cohorts ! ============================================================================ @@ -40,59 +39,6 @@ module EDInitMod ! ============================================================================ -! subroutine ed_init_sites( bounds, ed_allsites_inst ) -! ! -! ! !DESCRIPTION: -! ! Intialize all ED sites -! ! -! ! !USES: -! use ColumnType , only : col -! use landunit_varcon , only : istsoil -! ! -! ! !ARGUMENTS -! type(bounds_type) , intent(in) :: bounds -! type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) -! ! -! ! !LOCAL VARIABLES: -! integer :: g,l,c -! logical :: istheresoil(bounds%begg:bounds%endg) -! !---------------------------------------------------------------------- -! -! ! -! ! INITIALISE THE SITE STRUCTURES -! ! -! ! Makes unique cohort identifiers. Needs zeroing at beginning of run. -! udata%cohort_number = 0 -! -! do g = bounds%begg,bounds%endg -! ! zero the site -! call zero_site(ed_allsites_inst(g)) -! -! !create clm mapping to ED structure -! ed_allsites_inst(g)%clmgcell = g -! ed_allsites_inst(g)%lat = grc%latdeg(g) -! ed_allsites_inst(g)%lon = grc%londeg(g) -! enddo - -! istheresoil(bounds%begg:bounds%endg) = .false. -! do c = bounds%begc,bounds%endc -! g = col%gridcell(c) -! if (col%itype(c) == istsoil) then -! istheresoil(g) = .true. -! endif -! ed_allsites_inst(g)%istheresoil = istheresoil(g) -! enddo -! -! call set_site_properties( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) -! -! ! on restart, this functionality is handled in EDRestVectorMod::createPatchCohortStructure -! !if (.not. is_restart() ) then -! call init_patches( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) -! !endif -! -! end subroutine ed_init_sites - - ! ============================================================================ subroutine zero_site( site_in ) ! ! !DESCRIPTION: @@ -112,9 +58,6 @@ subroutine zero_site( site_in ) ! INDICES site_in%lat = nan site_in%lon = nan - site_in%clmgcell = 0 - site_in%clmcolumn = 0 - site_in%istheresoil = .false. ! DISTURBANCE site_in%disturbance_rate = 0._r8 ! site level disturbance rates from mortality and fire. @@ -147,7 +90,7 @@ subroutine set_site_properties( sites, nsites) ! ! !ARGUMENTS - type(ed_site_type) , intent(inout), target :: sites + type(ed_site_type) , intent(inout), target :: sites(nsites) integer, intent(in) :: nsites ! ! !LOCAL VARIABLES: @@ -176,11 +119,11 @@ subroutine set_site_properties( sites, nsites) dleafoff = 300 dleafon = 100 watermem = 0.5_r8 - enddo + else ! assignements for restarts NCD = 1.0_r8 ! NCD should be 1 on restart - GDD(i) = 0.0_r8 + GDD = 0.0_r8 leafon = 0.0_r8 leafoff = 0.0_r8 stat = 1 @@ -207,7 +150,7 @@ subroutine set_site_properties( sites, nsites) !start off with leaves off to initialise sites(s)%dstatus= dstat - sites(s)%acc_NI = acc_NI(s) + sites(s)%acc_NI = acc_NI sites(s)%frac_burnt = 0.0_r8 sites(s)%old_stock = 0.0_r8 end do @@ -225,7 +168,7 @@ subroutine init_patches( sites, nsites) use EDParamsMod , only : ED_val_maxspread ! ! !ARGUMENTS - type(ed_site_type) , intent(inout), target :: sites + type(ed_site_type) , intent(inout), target :: sites(nsites) integer, intent(in) :: nsites ! ! !LOCAL VARIABLES: diff --git a/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90 index 5016bb23d4..5d37d4f289 100755 --- a/components/clm/src/ED/main/EDMainMod.F90 +++ b/components/clm/src/ED/main/EDMainMod.F90 @@ -166,7 +166,7 @@ subroutine ed_integrate_state_variables(currentSite, soilstate_inst, temperature currentPatch%age = currentPatch%age + udata%deltat ! FIX(SPM,032414) valgrind 'Conditional jump or move depends on uninitialised value' if( currentPatch%age < 0._r8 )then - write(iulog,*) 'negative patch age?',currentSite%clmgcell, currentPatch%age, & + write(iulog,*) 'negative patch age?',currentPatch%age, & currentPatch%patchno,currentPatch%area endif @@ -384,28 +384,25 @@ subroutine ed_total_balance_check (currentSite, call_index ) litter_stock = 0.0_r8 seed_stock = 0.0_r8 - if (currentSite%istheresoil) then - currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) - - litter_stock = litter_stock + currentPatch%area * (sum(currentPatch%cwd_ag)+ & - sum(currentPatch%cwd_bg)+sum(currentPatch%leaf_litter)+sum(currentPatch%root_litter)) - seed_stock = seed_stock + currentPatch%area * sum(currentPatch%seed_bank) - currentCohort => currentPatch%tallest; - - do while(associated(currentCohort)) - - biomass_stock = biomass_stock + (currentCohort%bdead + currentCohort%balive + & - currentCohort%bstore) * currentCohort%n - currentCohort => currentCohort%shorter; - - enddo !end cohort loop + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) - currentPatch => currentPatch%younger + litter_stock = litter_stock + currentPatch%area * (sum(currentPatch%cwd_ag)+ & + sum(currentPatch%cwd_bg)+sum(currentPatch%leaf_litter)+sum(currentPatch%root_litter)) + seed_stock = seed_stock + currentPatch%area * sum(currentPatch%seed_bank) + currentCohort => currentPatch%tallest; + + do while(associated(currentCohort)) + + biomass_stock = biomass_stock + (currentCohort%bdead + currentCohort%balive + & + currentCohort%bstore) * currentCohort%n + currentCohort => currentCohort%shorter; + + enddo !end cohort loop - enddo !end patch loop + currentPatch => currentPatch%younger - endif + enddo !end patch loop total_stock = biomass_stock + seed_stock +litter_stock change_in_stock = total_stock - currentSite%old_stock @@ -423,6 +420,6 @@ subroutine ed_total_balance_check (currentSite, call_index ) currentSite%flux_out = 0.0_r8 currentSite%old_stock = total_stock - end subroutine ed_total_balance_check + end subroutine ed_total_balance_check end module EDMainMod diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index b1699d1276..9658469449 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -660,9 +660,9 @@ subroutine getVectors( this, bounds, sites, nsites, fcolumn) write(iulog,*) 'edtime getVectors ',get_nstep() end if - call this%createPatchCohortStructure ( bounds, sites, nsites ) + call this%createPatchCohortStructure ( bounds, sites, nsites, fcolumn ) - call this%convertCohortVectorToList ( bounds, sites ) + call this%convertCohortVectorToList ( bounds, sites , nsites, fcolumn) do s = 1,nsites call ed_update_site( sites(s) ) @@ -1928,7 +1928,7 @@ subroutine convertCohortVectorToList( this, bounds, sites, nsites, fcolumn ) ! !LOCAL VARIABLES: type (ed_patch_type), pointer :: currentPatch type (ed_cohort_type),pointer :: currentCohort - integer :: g, c, s + integer :: c, s integer :: totalCohorts ! number of cohorts starting from 0 integer :: countCohort ! number of cohorts starting from ! vectorLengthStart @@ -1948,7 +1948,6 @@ subroutine convertCohortVectorToList( this, bounds, sites, nsites, fcolumn ) do s = 1,nsites c = fcolumn(s) - g = col%gridcell(c) incrementOffset = (c-1)*cohorts_per_col + 1 countCohort = (c-1)*cohorts_per_col + 1 diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 index 50f8d55304..e167744af9 100755 --- a/components/clm/src/ED/main/EDTypesMod.F90 +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -24,7 +24,7 @@ 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 :: numPatchesPerGridCol = 10 ! + integer, parameter :: numPatchesPerCol = 10 ! integer, parameter :: numCohortsPerPatch = 160 ! integer, parameter :: cohorts_per_col = 1600 ! This is the max number of individual items one can store per diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 9617826d38..d5dd53135b 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -19,12 +19,12 @@ module FatesInterfaceMod use ncdio_pio , only : file_desc_t use PatchType , only : patch use ColumnType , only : col + use GridCellType , only : grc ! ------------------------------------------------------------------------------------ use EDtypesMod , only : ed_patch_type, ed_site_type, numpft_ed use EDtypesMod , only : map_clmpatch_to_edpatch use EDSurfaceRadiationMod , only : ED_SunShadeFracs - use EDInitMod , only : ed_init_sites use EDMainMod , only : ed_update_site use EDRestVectorMod , only : EDRest diff --git a/components/clm/src/biogeophys/CanopyFluxesMod.F90 b/components/clm/src/biogeophys/CanopyFluxesMod.F90 index ddf3de34fe..00b7a93aaf 100644 --- a/components/clm/src/biogeophys/CanopyFluxesMod.F90 +++ b/components/clm/src/biogeophys/CanopyFluxesMod.F90 @@ -23,7 +23,7 @@ module CanopyFluxesMod use PhotosynthesisMod , only : Photosynthesis, PhotosynthesisTotal, Fractionation use EDPhotosynthesisMod , only : Photosynthesis_ED use EDAccumulateFluxesMod , only : AccumulateFluxes_ED - use EDBtranMod , only : Btran_ED + use EDBtranMod , only : btran_ed use SoilMoistStressMod , only : calc_effective_soilporosity, calc_volumetric_h2oliq use SoilMoistStressMod , only : calc_root_moist_stress, set_perchroot_opt use SimpleMathMod , only : array_div_vector @@ -75,9 +75,9 @@ module CanopyFluxesMod contains !------------------------------------------------------------------------------ - subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & - sites, nsites, fcolumn, atm2lnd_inst, canopystate_inst, cnveg_state_inst, & - energyflux_inst, frictionvel_inst, soilstate_inst, solarabs_inst, surfalb_inst, & + subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & + sites, nsites, hsites, atm2lnd_inst, canopystate_inst, cnveg_state_inst, & + energyflux_inst, frictionvel_inst, soilstate_inst, solarabs_inst, surfalb_inst, & temperature_inst, waterflux_inst, waterstate_inst, ch4_inst, ozone_inst, photosyns_inst, & humanindex_inst, soil_water_retention_curve, cnveg_nitrogenstate_inst) ! @@ -124,10 +124,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type ! ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds + type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg - type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_site_type) , intent(inout), target :: sites(nsites) + integer , intent(in) :: nsites + integer , intent(in) :: hsites(bounds%begc:bounds%endc) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(canopystate_type) , intent(inout) :: canopystate_inst type(cnveg_state_type) , intent(in) :: cnveg_state_inst @@ -498,7 +500,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & do f = 1, fn p = filterp(f) - call btran_ed(bounds, p, ed_allsites_inst(begg:endg), & + call btran_ed(bounds, p, sites, nsites, hsites(bounds%begc:bounds%endc), & soilstate_inst, waterstate_inst, temperature_inst, energyflux_inst) enddo @@ -742,7 +744,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & call Photosynthesis_ED (bounds, fn, filterp, & svpts(begp:endp), eah(begp:endp), o2(begp:endp), & co2(begp:endp), rb(begp:endp), dayl_factor(begp:endp), & - ed_allsites_inst(begg:endg), atm2lnd_inst, temperature_inst, canopystate_inst, photosyns_inst) + sites(:), nsites, hsites(bounds%begc:bounds%endc), & + atm2lnd_inst, temperature_inst, canopystate_inst, photosyns_inst) ! zero all of these things, not just the ones in the filter. do p = bounds%begp,bounds%endp @@ -1162,7 +1165,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & end if if ( use_ed ) then - call AccumulateFluxes_ED(bounds, p, ed_allsites_inst(begg:endg), photosyns_inst) + + ! TODO-INTERF: THIS CALL IS ONLY FOR ED STUFF, EASILY REMOVED + ! AND CALLED OUTSIDE OF THIS SUBROUTINE + call AccumulateFluxes_ED(bounds, p, sites(:),nsites, & + hsites(bounds%begc:bounds%endc), photosyns_inst) end if end do diff --git a/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 index 2a9e06a31e..a6f3f7ebc9 100644 --- a/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 @@ -221,7 +221,7 @@ subroutine SurfaceAlbedo(bounds, & type(ed_site_type) , intent(inout), target :: sites(nsites) ! FATES site vector integer , intent(in) :: nsites integer , intent(in) :: fcolumn(nsites) - integer , intent(in) :: hsites(bounds%begc:bounds:endc) + integer , intent(in) :: hsites(bounds%begc:bounds%endc) type(aerosol_type) , intent(in) :: aerosol_inst type(canopystate_type) , intent(in) :: canopystate_inst type(waterstate_type) , intent(in) :: waterstate_inst @@ -922,7 +922,8 @@ subroutine SurfaceAlbedo(bounds, & call ED_Norman_Radiation (bounds, & filter_vegsol, num_vegsol, filter_nourbanp, num_nourbanp, & - coszen_patch(bounds%begp:bounds%endp), sites, nsites, fcolumn, hsites, & + coszen_patch(bounds%begp:bounds%endp), sites(:), nsites, & + fcolumn, hsites(bounds%begc:bounds%endc), & surfalb_inst) else diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index c1f7a44e65..d28f76089c 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -463,7 +463,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! NEEDS A WRAPPER call CanopyFluxes(bounds_clump, & filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & - clm_fates%fates(nc)%sites, & + clm_fates%fates(nc)%sites, & + clm_fates%fates(nc)%nsites, & + clm_fates%f2hmap(nc)%hsites, & atm2lnd_inst, canopystate_inst, cnveg_state_inst, & energyflux_inst, frictionvel_inst, soilstate_inst, solarabs_inst, surfalb_inst, & temperature_inst, waterflux_inst, waterstate_inst, ch4_inst, ozone_inst, photosyns_inst, & From 6e5b9cf4f766ce459d57e84b537bd2e8f932bd63 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 31 May 2016 22:56:07 -0700 Subject: [PATCH 16/23] columnization first pass, build success --- .../clm/src/ED/main/FatesInterfaceMod.F90 | 29 +++++++------- components/clm/src/main/clm_driver.F90 | 5 ++- components/clm/src/main/clm_initializeMod.F90 | 12 +++++- components/clm/src/main/clm_instMod.F90 | 2 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 39 ++++++++++++------- 5 files changed, 54 insertions(+), 33 deletions(-) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index d5dd53135b..fb1a9a0e64 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -27,6 +27,7 @@ module FatesInterfaceMod use EDSurfaceRadiationMod , only : ED_SunShadeFracs use EDMainMod , only : ed_update_site use EDRestVectorMod , only : EDRest + use EDInitMod , only : zero_site, set_site_properties, init_patches type, public :: fates_interface_type @@ -46,10 +47,9 @@ module FatesInterfaceMod contains ! Procedures for initializing FATES threaded memory and communicators - procedure, public :: init procedure, public :: fates_clean - procedure, public :: site_init - procedure, public :: fates_restart + procedure, public :: init_coldstart +! procedure, public :: init_restart procedure, public :: canopy_sunshade_fracs end type fates_interface_type @@ -132,17 +132,18 @@ end subroutine init_coldstart ! ------------------------------------------------------------------------------------ - subroutine init_restart(this, bounds_clump, ncid, flag, fcolumn ) - - implicit none - class(fates_interface_type), intent(inout) :: this - type(bounds_type),intent(in) :: bounds_clump - type(file_desc_t) , intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag !'read' or 'write' - - call EDRest( bounds_clump, this%sites, this%nsites, fcolumn, ncid, flag ) - return - end subroutine init_restart +! subroutine init_restart(this, bounds_clump, ncid, flag, fcolumn ) +! +! implicit none +! class(fates_interface_type), intent(inout) :: this +! type(bounds_type),intent(in) :: bounds_clump +! type(file_desc_t) , intent(inout) :: ncid ! netcdf id +! integer , intent(in) :: fcolumn(this%nsites) +! character(len=*) , intent(in) :: flag !'read' or 'write' +! +! call EDRest( bounds_clump, this%sites, this%nsites, fcolumn, ncid, flag ) +! return +! end subroutine init_restart ! ------------------------------------------------------------------------------------ diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index d28f76089c..f968d9643e 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -475,8 +475,11 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) if (use_ed) then ! if ED enabled, summarize productivity fluxes onto CLM history file structure call t_startf('edclmsumprodfluxes') + ! INTERF-TODO: THIS NEEDS A WRAPPER call clm_fates%sumprod(bounds_clump) call clm_fates%fates2hlm%SummarizeProductivityFluxes( bounds_clump, & - clm_fates%fates(nc)%sites,clm_fates%fates(nc)%nsites ) + clm_fates%fates(nc)%sites, & + clm_fates%fates(nc)%nsites, & + clm_fates%f2hmap(nc)%fcolumn) call t_stopf('edclmsumprodfluxes') endif diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index 5c4e2b8e7c..7a2274e3ab 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -691,8 +691,16 @@ subroutine initialize2( ) ! INTERF-TODO: THIS CALL SHOULD NOT CALL FATES(NC) DIRECTLY ! BUT IT SHOULD PASS bounds_clump TO A CLM_FATES WRAPPER ! WHICH WILL IN TURN PASS A FATES API DEFINED BOUNDS TO SITE_INIT - call clm_fates%fates(nc)%site_init(bounds_clump) - call clm_fates%fates2hlm_link(bounds_clump,nc,waterstate_inst,canopystate_inst) + ! IE CREATE clm_fates%init_coldstart() + call clm_fates%fates(nc)%init_coldstart(clm_fates%f2hmap(nc)%fcolumn ) + + call clm_fates%fates2hlm%ed_clm_link( bounds_clump, & + clm_fates%fates(nc)%sites, & + clm_fates%fates(nc)%nsites, & + clm_fates%f2hmap(nc)%fcolumn, & + waterstate_inst, & + canopystate_inst) + end do !$OMP END PARALLEL DO diff --git a/components/clm/src/main/clm_instMod.F90 b/components/clm/src/main/clm_instMod.F90 index 0d4db35e69..ed22ed6117 100644 --- a/components/clm/src/main/clm_instMod.F90 +++ b/components/clm/src/main/clm_instMod.F90 @@ -571,7 +571,7 @@ subroutine clm_instRest(bounds, ncid, flag) ! Bounds are not passed to FATES init_restart because ! we call a loop on clumps within this subroutine anyway - call clmfates%init_restart(ncid,flag) + call clm_fates%init_restart(ncid,flag, waterstate_inst, canopystate_inst) end if diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 48861110f9..9809eb2246 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -62,6 +62,7 @@ module CLMFatesInterfaceMod use EDMainMod , only : ed_update_site use EDPftVarcon , only : EDpftvarcon_inst use EDEcophysConType , only : EDecophysconInit + use EDRestVectorMod , only : EDRest implicit none type, private :: f2hmap_type @@ -120,7 +121,7 @@ module CLMFatesInterfaceMod contains procedure, public :: init - procedure, public :: fates2hlm_link + procedure, public :: init_restart procedure, public :: dynamics_driv end type hlm_fates_interface_type @@ -160,8 +161,10 @@ subroutine init(this,bounds_proc, use_ed) integer :: nc ! thread index integer :: s ! FATES site index integer :: c ! HLM column index + integer :: l ! HLM LU index integer, allocatable :: collist (:) type(bounds_type) :: bounds_clump + integer :: nmaxcol if (use_ed) then @@ -187,10 +190,10 @@ subroutine init(this,bounds_proc, use_ed) allocate(collist(1:nmaxcol)) ! Allocate the mapping that points columns to FATES sites, 0 is NA - allocate(self%f2hmap(nc)%hsites(bounds_clump%begc:bounds_clump%endc)) + allocate(this%f2hmap(nc)%hsites(bounds_clump%begc:bounds_clump%endc)) ! Initialize all columns with a zero index, which indicates no FATES site - self%f2hmap(nc)%hsites(:) = 0 + this%f2hmap(nc)%hsites(:) = 0 s = 0 do c = bounds_clump%begc,bounds_clump%endc @@ -201,16 +204,16 @@ subroutine init(this,bounds_proc, use_ed) if (col%active(c) .and. lun%itype(l) == istsoil ) then s = s + 1 collist(s) = c - self%f2hmap(nc)%hsites(c) = s + this%f2hmap(nc)%hsites(c) = s endif enddo ! Allocate vectors that match FATES sites with HLM columns - allocate(self%f2hmap(nc)%fcolumn(s)) + allocate(this%f2hmap(nc)%fcolumn(s)) ! Assign the h2hmap indexing - self%f2hmap(nc)%fcolumn(1:s) = collist(1:s) + this%f2hmap(nc)%fcolumn(1:s) = collist(1:s) ! Deallocate the temporary arrays deallocate(collist) @@ -252,7 +255,7 @@ subroutine dynamics_driv(this, nc, bounds_clump, & ! !LOCAL VARIABLES: real(r8) :: dayDiff ! day of run integer :: dayDiffInt ! integer of day of run - integer :: g ! gridcell + integer :: s ! site integer :: yr ! year (0, ...) integer :: mon ! month (1, ..., 12) integer :: day ! day of month (1, ..., 31) @@ -312,9 +315,11 @@ subroutine dynamics_driv(this, nc, bounds_clump, & enddo ! link to CLM/ALM structures - call this%fates2hlm%ed_clm_link( bounds_clump, & - this%fates(nc)%sites, & - waterstate_inst, & + call this%fates2hlm%ed_clm_link( bounds_clump, & + this%fates(nc)%sites, & + this%fates(nc)%nsites, & + this%f2hmap(nc)%fcolumn, & + waterstate_inst, & canopystate_inst) @@ -338,8 +343,8 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) class(hlm_fates_interface_type), intent(inout) :: this type(file_desc_t) , intent(inout) :: ncid ! netcdf id character(len=*) , intent(in) :: flag !'read' or 'write' - type(waterstate_type) , intent(in) :: waterstate_inst - type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst ! Locals type(bounds_type) :: bounds_clump @@ -350,13 +355,17 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) do nc = 1, nclumps call get_clump_bounds(nc, bounds_clump) - call EDRest( bounds_clump, this%fates(nc)%sites, this%fates(nc)%nsites, & - this%f2hmap(nc)%fcolumn, ncid, flag ) + call EDRest( bounds_clump, & + this%fates(nc)%sites, & + this%fates(nc)%nsites, & + this%f2hmap(nc)%fcolumn, ncid, flag ) if ( trim(flag) == 'read' ) then call this%fates2hlm%ed_clm_link( bounds_clump, & this%fates(nc)%sites, & + this%fates(nc)%nsites, & + this%f2hmap(nc)%fcolumn, & waterstate_inst, & canopystate_inst) @@ -364,7 +373,7 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) end if end do - call clm_fates%fates2hlm%restart(bounds, ncid, flag) + call this%fates2hlm%restart(bounds_clump, ncid, flag) return end subroutine init_restart From 6a64c0c53598960a1d784ca97606a5c0b389a391 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 1 Jun 2016 18:09:21 -0700 Subject: [PATCH 17/23] rectifying how to allocate ed-sites with the potential of dynamic column status. 1x1br cold-starts running with what appears to be non-nonsense results. --- components/clm/src/ED/main/EDCLMLinkMod.F90 | 12 +- components/clm/src/main/clm_driver.F90 | 12 +- components/clm/src/main/clm_initializeMod.F90 | 3 + components/clm/src/main/clm_instMod.F90 | 2 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 112 ++++++++++++++++-- 5 files changed, 119 insertions(+), 22 deletions(-) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index 009070916e..12703640da 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -1409,7 +1409,6 @@ subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, ca ! INTERF-TODO: THIS LOGIC SHOULDN'T BE NECESSARY, SHOULD BE CHECKED AT THE BEGINNING ! OF LINKING, ONCE - ! %patchno is the local index of the ED/FATES patches, starting at 1 if(currentPatch%patchno <= numpft - numcft)then !don't expand into crop patches. @@ -1421,6 +1420,7 @@ subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, ca currentCohort => currentPatch%shortest do while(associated(currentCohort)) !accumulate into history variables. + ft = currentCohort%pft ed_ncohorts(c) = ed_ncohorts(c) + 1._r8 @@ -1517,9 +1517,9 @@ subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, ca !Patch specific variables that are already calculated !These things are all duplicated. Should they all be converted to LL or array structures RF? - ! define scalar to counteract the patch albedo scaling logic for conserved quantities - if (currentPatch%area .gt. 0._r8) then + + if (currentPatch%area .gt. 0._r8 .and. currentPatch%total_canopy_area .gt.0 ) then patch_scaling_scalar = min(1._r8, currentPatch%area / currentPatch%total_canopy_area) else patch_scaling_scalar = 0._r8 @@ -1545,7 +1545,11 @@ subroutine ed_update_history_variables( this, bounds, sites, nsites, fcolumn, ca seed_germination(p) = sum(currentPatch%seed_germination) * 1.e3_r8 * 365.0_r8 * SHR_CONST_CDAY * patch_scaling_scalar canopy_spread(p) = currentPatch%spread(1) area_plant(p) = 1._r8 - area_trees(p) = currentPatch%total_tree_area / min(currentPatch%total_canopy_area,currentPatch%area) + if (min(currentPatch%total_canopy_area,currentPatch%area)>0.0_r8) then + area_trees(p) = currentPatch%total_tree_area / min(currentPatch%total_canopy_area,currentPatch%area) + else + area_trees(p) = 0.0_r8 + end if if(associated(currentPatch%tallest))then trimming(p) = currentPatch%tallest%canopy_trim else diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index f968d9643e..576e39d435 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -839,9 +839,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) write(iulog,*) 'clm: calling ED model ', get_nstep() end if - ! INTERF-TODO: FATES(NC) SHOULD ONLY BE VISIBLE TO THE INTERFACE - ! AND ONLY FATES API DEFINED TYPES SHOULD BE PASSED TO IT - ! NEEDS A WRAPPER + + call clm_fates%check_hlm_active(nc, bounds_clump) + call clm_fates%dynamics_driv( nc, bounds_clump, & atm2lnd_inst, soilstate_inst, temperature_inst, & waterstate_inst, canopystate_inst) @@ -944,7 +944,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) lakestate_inst, temperature_inst, surfalb_inst) - ! INTERF-TOD: THIS ACTUALLY WON'T BE TO BAD TO PULL OUT + ! INTERF-TOD: THIS ACTUALLY WON'T BE TO HARD TO PULL OUT ! ED_Norman_Radiation() is the last thing called ! in SurfaceAlbedo, we can simply remove it ! The clm_fates interfac called below will split @@ -1098,10 +1098,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) call t_stopf('d2dgvm') end if - ! ============================================================================ - ! Call ED model on daily timestep - ! ============================================================================ - ! ============================================================================ ! History/Restart output ! ============================================================================ diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index 7a2274e3ab..e308d14d3f 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -481,6 +481,9 @@ subroutine initialize2( ) call SatellitePhenologyInit(bounds_proc) end if + + + ! ------------------------------------------------------------------------ ! On restart only - process the history namelist. ! ------------------------------------------------------------------------ diff --git a/components/clm/src/main/clm_instMod.F90 b/components/clm/src/main/clm_instMod.F90 index ed22ed6117..7ae1d358b5 100644 --- a/components/clm/src/main/clm_instMod.F90 +++ b/components/clm/src/main/clm_instMod.F90 @@ -428,7 +428,7 @@ subroutine clm_instInit(bounds) ! Incrementally changing to ED names to FATES call clm_fates%Init(bounds,use_ed) - + call clm_fates%init_allocate() deallocate (h2osno_col) deallocate (snow_depth_col) diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 9809eb2246..0501cd8f2b 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -53,6 +53,8 @@ module CLMFatesInterfaceMod use ColumnType , only : col use LandunitType , only : lun use landunit_varcon , only : istsoil + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg ! Used FATES Modules use FatesInterfaceMod , only : fates_interface_type @@ -118,14 +120,23 @@ module CLMFatesInterfaceMod ! type(fates_bounds_type) :: bound_fate + + contains procedure, public :: init + procedure, public :: init_allocate + procedure, public :: check_hlm_active procedure, public :: init_restart procedure, public :: dynamics_driv + + end type hlm_fates_interface_type + + logical :: DEBUG = .true. + contains subroutine init(this,bounds_proc, use_ed) @@ -158,13 +169,6 @@ subroutine init(this,bounds_proc, use_ed) ! ONLY PART OF THIS MAY BE OPERATIVE ! local variables integer :: nclumps ! Number of threads - integer :: nc ! thread index - integer :: s ! FATES site index - integer :: c ! HLM column index - integer :: l ! HLM LU index - integer, allocatable :: collist (:) - type(bounds_type) :: bounds_clump - integer :: nmaxcol if (use_ed) then @@ -178,15 +182,53 @@ subroutine init(this,bounds_proc, use_ed) end if + if(DEBUG)then + write(iulog,*) 'Entering clm_fates%init' + end if + nclumps = get_proc_clumps() allocate(this%fates(nclumps)) allocate(this%f2hmap(nclumps)) + if(DEBUG)then + write(iulog,*) 'clm_fates%init(): allocating for ',nclumps,' threads' + end if + + + end subroutine init + + + subroutine init_allocate(this) + + implicit none + + ! Input Arguments + class(hlm_fates_interface_type), intent(inout) :: this + ! local variables + integer :: nclumps ! Number of threads + integer :: nc ! thread index + integer :: s ! FATES site index + integer :: c ! HLM column index + integer :: l ! HLM LU index + integer, allocatable :: collist (:) + type(bounds_type) :: bounds_clump + integer :: nmaxcol + + if(DEBUG)then + write(iulog,*) 'Entering clm_fates%init_allocate' + end if + + nclumps = get_proc_clumps() do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) nmaxcol = bounds_clump%endc - bounds_clump%begc + 1 + + if(DEBUG)then + write(iulog,*) 'clm_fates%init(): thread',nc,': allocating ',nmaxcol,' column space' + end if + allocate(collist(1:nmaxcol)) ! Allocate the mapping that points columns to FATES sites, 0 is NA @@ -201,7 +243,16 @@ subroutine init(this,bounds_proc, use_ed) ! These are the key constraints that determine if this column ! will have a FATES site associated with it - if (col%active(c) .and. lun%itype(l) == istsoil ) then + + if(DEBUG)then + write(iulog,*) 'clm_fates%init(): thread',nc,': found column',c,'with lu',l + write(iulog,*) ' LU type:', lun%itype(l) + end if + + ! INTERF-TODO: WE HAVE NOT FILTERED OUT FATES SITES ON INACTIVE COLUMNS.. YET + ! NEED A RUN-TIME ROUTINE THAT CLEARS AND REWRITES THE SITE LIST + + if (lun%itype(l) == istsoil ) then s = s + 1 collist(s) = c this%f2hmap(nc)%hsites(c) = s @@ -209,6 +260,10 @@ subroutine init(this,bounds_proc, use_ed) enddo + if(DEBUG)then + write(iulog,*) 'clm_fates%init(): thread',nc,': allocated ',s,' sites' + end if + ! Allocate vectors that match FATES sites with HLM columns allocate(this%f2hmap(nc)%fcolumn(s)) @@ -228,11 +283,50 @@ subroutine init(this,bounds_proc, use_ed) end do - end subroutine init + end subroutine init_allocate ! ------------------------------------------------------------------------------------ + + subroutine check_hlm_active(this, nc, bounds_clump) + + + implicit none + class(hlm_fates_interface_type), intent(inout) :: this + integer :: nc + type(bounds_type),intent(in) :: bounds_clump + + ! local variables + integer :: c + + ! FATES-TODO: THIS SHOULD BE CHANGED TO DO RE-ALLOCATION + ! INSTEAD OF FAILURE + + do c = bounds_clump%begc,bounds_clump%endc + + ! FATES ACTIVE BUT HLM IS NOT + if(this%f2hmap(nc)%hsites(c)>0 .and. .not.col%active(c)) then + + + write(iulog,*) 'INACTIVE COLUMN WITH ACTIVE FATES SITE' + write(iulog,*) 'c = ',c + call endrun(msg=errMsg(__FILE__, __LINE__)) + + elseif (this%f2hmap(nc)%hsites(c)==0 .and. col%active(c)) then + + write(iulog,*) 'ACTIVE COLUMN WITH INACTIVE FATES SITE' + write(iulog,*) 'c = ',c + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end do + + + + end subroutine check_hlm_active + + ! ------------------------------------------------------------------------------------ + subroutine dynamics_driv(this, nc, bounds_clump, & atm2lnd_inst, soilstate_inst, temperature_inst, & waterstate_inst, canopystate_inst) From 497ad1b869de6f0f7b13e04986f1da95194ff478 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 4 Jun 2016 14:25:54 -0700 Subject: [PATCH 18/23] turned off the active filter check on FATES. Current scheme is to run on inactive columns on naturally vegetated landunits --- components/clm/src/main/clm_driver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 576e39d435..2ba5a637b0 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -839,8 +839,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) write(iulog,*) 'clm: calling ED model ', get_nstep() end if - - call clm_fates%check_hlm_active(nc, bounds_clump) + ! INTERF-TODO: THIS CHECK WILL BE TURNED ON IN FUTURE VERSION +! call clm_fates%check_hlm_active(nc, bounds_clump) call clm_fates%dynamics_driv( nc, bounds_clump, & atm2lnd_inst, soilstate_inst, temperature_inst, & From 87e2ce34eeb2560e0afc1a6ebecbab47e98ed760 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 5 Jun 2016 12:30:52 -0700 Subject: [PATCH 19/23] moved init_coldstart from FATES public to clm_fates, also added conditional to prevent prevent passing of unallocated arrays --- components/clm/src/ED/main/EDInitMod.F90 | 1 + components/clm/src/ED/main/EDMainMod.F90 | 8 ++- .../clm/src/ED/main/FatesInterfaceMod.F90 | 36 ------------- components/clm/src/main/clm_initializeMod.F90 | 2 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 52 ++++++++++++++++++- 5 files changed, 58 insertions(+), 41 deletions(-) diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 index 5037931420..60fce0d3d1 100755 --- a/components/clm/src/ED/main/EDInitMod.F90 +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -132,6 +132,7 @@ subroutine set_site_properties( sites, nsites) dleafoff = 300 dleafon = 100 watermem = 0.5_r8 + endif do s = 1,nsites diff --git a/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90 index 5d37d4f289..29a97ec261 100755 --- a/components/clm/src/ED/main/EDMainMod.F90 +++ b/components/clm/src/ED/main/EDMainMod.F90 @@ -410,8 +410,12 @@ subroutine ed_total_balance_check (currentSite, call_index ) error = abs(net_flux - change_in_stock) if ( abs(error) > 10e-6 ) then - write(iulog,*) 'total error:in,out,net,dstock,error',call_index, currentSite%flux_in, & - currentSite%flux_out,net_flux,change_in_stock,error + write(iulog,*) 'total error: call index: ',call_index, & + 'in: ',currentSite%flux_in, & + 'out: ',currentSite%flux_out, & + 'net: ',net_flux, & + 'dstock: ',change_in_stock, & + 'error=net_flux-dstock:', error write(iulog,*) 'biomass,litter,seeds', biomass_stock,litter_stock,seed_stock write(iulog,*) 'lat lon',currentSite%lat,currentSite%lon endif diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index fb1a9a0e64..d1c23d7955 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -96,42 +96,6 @@ end subroutine fates_clean ! ------------------------------------------------------------------------------------ - subroutine init_coldstart(this,fcolumn) - - ! Input Arguments - class(fates_interface_type), intent(inout) :: this - integer, intent(in) :: fcolumn(this%nsites) - - ! locals - integer :: s - integer :: c - integer :: g - - do s = 1,this%nsites - - call zero_site(this%sites(s)) - - c = fcolumn(s) - g = col%gridcell(c) ! TODO-INTERF: col% and grc% should not be accessible here - - this%sites(s)%lat = grc%latdeg(g) - this%sites(s)%lon = grc%londeg(g) - - end do - - call set_site_properties(this%sites,this%nsites) - - call init_patches(this%sites, this%nsites) - - do s = 1,this%nsites - call ed_update_site(this%sites(s)) - end do - - return - end subroutine init_coldstart - - ! ------------------------------------------------------------------------------------ - ! subroutine init_restart(this, bounds_clump, ncid, flag, fcolumn ) ! ! implicit none diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index e308d14d3f..aad1d5ec0f 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -695,7 +695,7 @@ subroutine initialize2( ) ! BUT IT SHOULD PASS bounds_clump TO A CLM_FATES WRAPPER ! WHICH WILL IN TURN PASS A FATES API DEFINED BOUNDS TO SITE_INIT ! IE CREATE clm_fates%init_coldstart() - call clm_fates%fates(nc)%init_coldstart(clm_fates%f2hmap(nc)%fcolumn ) + call clm_fates%init_coldstart() fates(nc)%init_coldstart(clm_fates%f2hmap(nc)%fcolumn ) call clm_fates%fates2hlm%ed_clm_link( bounds_clump, & clm_fates%fates(nc)%sites, & diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 0501cd8f2b..aab865e9a5 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -128,6 +128,7 @@ module CLMFatesInterfaceMod procedure, public :: init_allocate procedure, public :: check_hlm_active procedure, public :: init_restart + procedure, public :: init_coldstart procedure, public :: dynamics_driv @@ -398,14 +399,13 @@ subroutine dynamics_driv(this, nc, bounds_clump, & ! where most things happen do s = 1,this%fates(nc)%nsites -! if (this%fates(nc)%sites(g)%istheresoil) then call ed_ecosystem_dynamics(this%fates(nc)%sites(s), & this%fates2hlm, & atm2lnd_inst, & soilstate_inst, temperature_inst, waterstate_inst) call ed_update_site(this%fates(nc)%sites(s)) -! endif + enddo ! link to CLM/ALM structures @@ -472,6 +472,54 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) return end subroutine init_restart + subroutine init_coldstart(this) + + ! Arguments + class(hlm_fates_interface_type), intent(inout) :: this + + ! locals + integer :: nclumps + integer :: nc + type(bounds_type) :: bounds_clump + ! locals + integer :: s + integer :: c + integer :: g + + nclumps = get_proc_clumps() + do nc = 1, nclumps + + if (clm_fates%fates(nc)%nsites>0) then + + call get_clump_bounds(nc, bounds_clump) + + do s = 1,this%nsites + call zero_site(this%fates(nc)%sites(s)) + c = this%fates(nc)%fcolumn(s) + g = col%gridcell(c) ! TODO-INTERF: col% and grc% should not be accessible here + 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)%sites, this%fates(nc)%nsites) + + call init_patches(this%fates(nc)%sites, this%fates(nc)%nsites) + + do s = 1,this%fates(nc)%nsites + call ed_update_site(this%fates(nc)%sites(s)) + end do + + call this%fates2hlm%ed_clm_link( bounds_clump, & + this%fates(nc)%sites, & + this%fates(nc)%nsites, & + this%f2hmap(nc)%fcolumn, & + waterstate_inst, & + canopystate_inst) + end if + end do + return + end subroutine init_coldstart + ! ------------------------------------------------------------------------------------ From 324b6cd0619d6e3de05078ddc311576c53b46d7d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 5 Jun 2016 12:50:56 -0700 Subject: [PATCH 20/23] removed procedure declaration of init_coldstart from the Fates public (bug from previous commit). Updated CanopySunShadeFracs to be called from clm_fates, and also fixed how that function accesses the correct site. --- .../clm/src/ED/main/FatesInterfaceMod.F90 | 60 +-------- components/clm/src/main/clm_driver.F90 | 4 +- .../clm/src/utils/clmfates_interfaceMod.F90 | 114 ++++++++++++++---- 3 files changed, 96 insertions(+), 82 deletions(-) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index d1c23d7955..3506e7bc85 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -47,10 +47,7 @@ module FatesInterfaceMod contains ! Procedures for initializing FATES threaded memory and communicators - procedure, public :: fates_clean - procedure, public :: init_coldstart -! procedure, public :: init_restart - procedure, public :: canopy_sunshade_fracs +! procedure, public :: fates_clean end type fates_interface_type @@ -111,62 +108,7 @@ end subroutine fates_clean ! ------------------------------------------------------------------------------------ - subroutine canopy_sunshade_fracs(this ,filter_nourbanp, num_nourbanp, & - atm2lnd_inst,canopystate_inst) - - - ! TODO-INTERF: THIS ROUTINE NEEDS TO BE WRAPPED BY A CLM_FATES CALL - ! IN THAT CALL THE BOUNDARY CONDITIONS SHOULD BE PREPPED - ! SO THAT THIS CALL DOES NOT HAVE CLM TYPES HERE - ! This interface function is a wrapper call on ED_SunShadeFracs. The only - ! returned variable is a patch vector, fsun_patch, which describes the fraction - ! of the canopy that is exposed to sun. - - implicit none - - ! Input Arguments - class(fates_interface_type), intent(inout) :: this - - ! patch filter for non-urban points - integer, intent(in),dimension(:) :: filter_nourbanp - - ! number of patches in non-urban points in patch filter - integer, intent(in) :: num_nourbanp - - ! direct and diffuse downwelling radiation (W/m2) - type(atm2lnd_type),intent(in) :: atm2lnd_inst - - ! Input/Output Arguments to CLM - type(canopystate_type),intent(inout) :: canopystate_inst - - ! Local Variables - integer :: fp ! non-urban filter patch index - integer :: p ! patch index - integer :: g ! grid cell index - integer, parameter :: ipar = 1 ! The band index for PAR - type(ed_patch_type), pointer :: cpatch ! c"urrent" patch - - associate( forc_solad => atm2lnd_inst%forc_solad_grc, & - forc_solai => atm2lnd_inst%forc_solai_grc, & - fsun => canopystate_inst%fsun_patch) - - do fp = 1,num_nourbanp - - p = filter_nourbanp(fp) - g = patch%gridcell(p) - - if ( patch%is_veg(p) ) then - cpatch => map_clmpatch_to_edpatch(this%sites(g), p) - - call ED_SunShadeFracs(cpatch,forc_solad(g,ipar),forc_solai(g,ipar),fsun(p)) - - endif - - end do - end associate - return - end subroutine canopy_sunshade_fracs diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 2ba5a637b0..2dd0431f9d 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -393,8 +393,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) if(use_ed) then ! INTERF-TODO: FATES(NC) SHOULD ONLY BE VISIBLE TO THE INTERFACE ! AND ONLY FATES API DEFINED TYPES SHOULD BE PASSED TO IT - call clm_fates%fates(nc)%canopy_sunshade_fracs(filter(nc)%nourbanp, & - filter(nc)%num_nourbanp, & + call clm_fates%canopy_sunshade_fracs(nc,filter(nc)%nourbanp, & + filter(nc)%num_nourbanp, & atm2lnd_inst, canopystate_inst) else diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index aab865e9a5..ad416142c8 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -76,10 +76,6 @@ module CLMFatesInterfaceMod ! This vector may be sparse, and non-sites have index 0 integer, allocatable :: hsites (:) - ! - - - end type f2hmap_type @@ -130,7 +126,7 @@ module CLMFatesInterfaceMod procedure, public :: init_restart procedure, public :: init_coldstart procedure, public :: dynamics_driv - + procedure, public :: canopy_sunshade_fracs end type hlm_fates_interface_type @@ -447,23 +443,25 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) nclumps = get_proc_clumps() do nc = 1, nclumps - call get_clump_bounds(nc, bounds_clump) - - call EDRest( bounds_clump, & - this%fates(nc)%sites, & - this%fates(nc)%nsites, & - this%f2hmap(nc)%fcolumn, ncid, flag ) - - if ( trim(flag) == 'read' ) then + if (this%fates(nc)%nsites>0) then + call get_clump_bounds(nc, bounds_clump) - call this%fates2hlm%ed_clm_link( bounds_clump, & - this%fates(nc)%sites, & - this%fates(nc)%nsites, & - this%f2hmap(nc)%fcolumn, & - waterstate_inst, & - canopystate_inst) - + call EDRest( bounds_clump, & + this%fates(nc)%sites, & + this%fates(nc)%nsites, & + this%f2hmap(nc)%fcolumn, ncid, flag ) + + if ( trim(flag) == 'read' ) then + + call this%fates2hlm%ed_clm_link( bounds_clump, & + this%fates(nc)%sites, & + this%fates(nc)%nsites, & + this%f2hmap(nc)%fcolumn, & + waterstate_inst, & + canopystate_inst) + + end if end if end do @@ -496,7 +494,7 @@ subroutine init_coldstart(this) do s = 1,this%nsites call zero_site(this%fates(nc)%sites(s)) c = this%fates(nc)%fcolumn(s) - g = col%gridcell(c) ! TODO-INTERF: col% and grc% should not be accessible here + g = col%gridcell(c) this%fates(nc)%sites(s)%lat = grc%latdeg(g) this%fates(nc)%sites(s)%lon = grc%londeg(g) end do @@ -520,6 +518,80 @@ subroutine init_coldstart(this) return end subroutine init_coldstart + ! ------------------------------------------------------------------------------------ + + subroutine canopy_sunshade_fracs(this,nc,filter_nourbanp, num_nourbanp, & + atm2lnd_inst,canopystate_inst) + + + ! This interface function is a wrapper call on ED_SunShadeFracs. The only + ! returned variable is a patch vector, fsun_patch, which describes the fraction + ! of the canopy that is exposed to sun. + + implicit none + + ! Input Arguments + class(fates_interface_type), intent(inout) :: this + + integer, intent(in) :: nc + + ! patch filter for non-urban points + integer, intent(in),dimension(:) :: filter_nourbanp + + ! number of patches in non-urban points in patch filter + integer, intent(in) :: num_nourbanp + + ! direct and diffuse downwelling radiation (W/m2) + type(atm2lnd_type),intent(in) :: atm2lnd_inst + + ! Input/Output Arguments to CLM + type(canopystate_type),intent(inout) :: canopystate_inst + + ! Local Variables + integer :: fp ! non-urban filter patch index + integer :: p ! patch index + integer :: g ! grid cell index + integer :: c ! column index (HLM native index) + integer :: s ! site index (FATES native index) + integer, parameter :: ipar = 1 ! The band index for PAR + type(ed_patch_type), pointer :: cpatch ! c"urrent" patch + + associate( forc_solad => atm2lnd_inst%forc_solad_grc, & + forc_solai => atm2lnd_inst%forc_solai_grc, & + fsun => canopystate_inst%fsun_patch) + + do fp = 1,num_nourbanp + + p = filter_nourbanp(fp) + g = patch%gridcell(p) + c = patch%column(p) + s = this%f2hmap(nc)%hsites(c) + + if ( patch%is_veg(p) ) then + + ! ed_clm_link should be responsibe for setting is_veg + ! so this condition should prevent a non-site from + ! emerging here. Lets do a sanity check anyway + + if( s<1 .or. s>this%nsites)then + write(iulog,*) 'There is a disconnect between the is_veg filter' + write(iulog,*) 'set in ed_clm_link, and the allocation of sites' + write(iulog,*) 'Perhaps is_veg is being set in a rogue location?' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + cpatch => map_clmpatch_to_edpatch(this%fates(nc)%sites(s), p) + + call ED_SunShadeFracs(cpatch,forc_solad(g,ipar),forc_solai(g,ipar),fsun(p)) + + endif + + end do + end associate + return + end subroutine canopy_sunshade_fracs + + ! ------------------------------------------------------------------------------------ From 883d45204a7a2d0573d117e857f7a22a13760347 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sun, 5 Jun 2016 13:33:34 -0700 Subject: [PATCH 21/23] various bug and syntatical fixes for previous two commits --- .../clm/src/ED/main/FatesInterfaceMod.F90 | 61 ++----------------- components/clm/src/main/clm_driver.F90 | 3 +- components/clm/src/main/clm_initializeMod.F90 | 19 +----- .../clm/src/utils/clmfates_interfaceMod.F90 | 36 ++++++++--- 4 files changed, 35 insertions(+), 84 deletions(-) diff --git a/components/clm/src/ED/main/FatesInterfaceMod.F90 b/components/clm/src/ED/main/FatesInterfaceMod.F90 index 3506e7bc85..e62a9d75ba 100644 --- a/components/clm/src/ED/main/FatesInterfaceMod.F90 +++ b/components/clm/src/ED/main/FatesInterfaceMod.F90 @@ -13,21 +13,10 @@ module FatesInterfaceMod ! Used CLM Modules ! INTERF-TODO: NO CLM MODULES SHOULD BE ACCESSIBLE BY THE FATES ! PUBLIC API!!!! - use decompMod , only : bounds_type - use CanopyStateType , only : canopystate_type - use atm2lndType , only : atm2lnd_type - use ncdio_pio , only : file_desc_t - use PatchType , only : patch - use ColumnType , only : col - use GridCellType , only : grc ! ------------------------------------------------------------------------------------ - use EDtypesMod , only : ed_patch_type, ed_site_type, numpft_ed - use EDtypesMod , only : map_clmpatch_to_edpatch - use EDSurfaceRadiationMod , only : ED_SunShadeFracs - use EDMainMod , only : ed_update_site - use EDRestVectorMod , only : EDRest - use EDInitMod , only : zero_site, set_site_properties, init_patches + use EDtypesMod , only : ed_site_type + type, public :: fates_interface_type @@ -53,64 +42,24 @@ module FatesInterfaceMod contains -! subroutine init(this,bounds_clump) -! -! implicit none -! -! ! Input Arguments -! class(fates_interface_type), intent(inout) :: this -! -! ! INTERF-TODO: AS THE FATES PUBLIC API- BOUNDS CLUMP WILL NOT BE ALLOWED -! ! IN HERE FOR MUCH LONGER. -! type(bounds_type),intent(in) :: bounds_clump -! -! ! Initialize the mapping elements between FATES and the DLM -! -! ! These bounds are for a single clump (thread) -! allocate (this%sites(this%nsites)) -! -! return -! end subroutine init - ! ------------------------------------------------------------------------------------ ! INTERF-TODO: THIS IS A PLACE-HOLDER ROUTINE, NOT CALLED YET... - subroutine fates_clean(this,bounds_clump) + subroutine fates_clean(this) implicit none ! Input Arguments class(fates_interface_type), intent(inout) :: this - type(bounds_type),intent(in) :: bounds_clump ! Incrementally walk through linked list and deallocate + + ! Deallocate the site list deallocate (this%sites) return end subroutine fates_clean - ! ------------------------------------------------------------------------------------ - -! subroutine init_restart(this, bounds_clump, ncid, flag, fcolumn ) -! -! implicit none -! class(fates_interface_type), intent(inout) :: this -! type(bounds_type),intent(in) :: bounds_clump -! type(file_desc_t) , intent(inout) :: ncid ! netcdf id -! integer , intent(in) :: fcolumn(this%nsites) -! character(len=*) , intent(in) :: flag !'read' or 'write' -! -! call EDRest( bounds_clump, this%sites, this%nsites, fcolumn, ncid, flag ) -! return -! end subroutine init_restart - - ! ------------------------------------------------------------------------------------ - - - - - - end module FatesInterfaceMod diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 2dd0431f9d..b78469d0ce 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -391,8 +391,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! over the patch index range defined by bounds_clump%begp:bounds_proc%endp if(use_ed) then - ! INTERF-TODO: FATES(NC) SHOULD ONLY BE VISIBLE TO THE INTERFACE - ! AND ONLY FATES API DEFINED TYPES SHOULD BE PASSED TO IT + call clm_fates%canopy_sunshade_fracs(nc,filter(nc)%nourbanp, & filter(nc)%num_nourbanp, & atm2lnd_inst, canopystate_inst) diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index aad1d5ec0f..31452a1fd3 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -687,25 +687,8 @@ subroutine initialize2( ) ! -------------------------------------------------------------- if ( use_ed .and. .not.is_restart() ) then - !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) - do nc = 1, nclumps - call get_clump_bounds(nc, bounds_clump) - - ! INTERF-TODO: THIS CALL SHOULD NOT CALL FATES(NC) DIRECTLY - ! BUT IT SHOULD PASS bounds_clump TO A CLM_FATES WRAPPER - ! WHICH WILL IN TURN PASS A FATES API DEFINED BOUNDS TO SITE_INIT - ! IE CREATE clm_fates%init_coldstart() - call clm_fates%init_coldstart() fates(nc)%init_coldstart(clm_fates%f2hmap(nc)%fcolumn ) - call clm_fates%fates2hlm%ed_clm_link( bounds_clump, & - clm_fates%fates(nc)%sites, & - clm_fates%fates(nc)%nsites, & - clm_fates%f2hmap(nc)%fcolumn, & - waterstate_inst, & - canopystate_inst) - - end do - !$OMP END PARALLEL DO + call clm_fates%init_coldstart(waterstate_inst,canopystate_inst) end if diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index ad416142c8..5e56a33ad2 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -50,6 +50,7 @@ module CLMFatesInterfaceMod use clm_time_manager , only : get_ref_date, timemgr_datediff use spmdMod , only : masterproc use decompMod , only : get_proc_bounds, get_proc_clumps, get_clump_bounds + use GridCellType , only : grc use ColumnType , only : col use LandunitType , only : lun use landunit_varcon , only : istsoil @@ -60,11 +61,18 @@ module CLMFatesInterfaceMod use FatesInterfaceMod , only : fates_interface_type use EDCLMLinkMod , only : ed_clm_type use EDTypesMod , only : udata + use EDTypesMod , only : ed_patch_type + use EDtypesMod , only : map_clmpatch_to_edpatch use EDMainMod , only : ed_ecosystem_dynamics use EDMainMod , only : ed_update_site + use EDInitMod , only : zero_site + use EDInitMod , only : init_patches + use EDInitMod , only : set_site_properties use EDPftVarcon , only : EDpftvarcon_inst use EDEcophysConType , only : EDecophysconInit use EDRestVectorMod , only : EDRest + use EDSurfaceRadiationMod , only : ED_SunShadeFracs + implicit none type, private :: f2hmap_type @@ -262,6 +270,10 @@ subroutine init_allocate(this) end if ! Allocate vectors that match FATES sites with HLM columns + ! RGK: Sites and fcolumns are forced as args during clm_driv() as of 6/4/2016 + ! We may have to give these a dummy allocation of 1, which should + ! not be a problem since we always iterate on nsites. + allocate(this%f2hmap(nc)%fcolumn(s)) ! Assign the h2hmap indexing @@ -470,10 +482,12 @@ subroutine init_restart(this, ncid, flag, waterstate_inst, canopystate_inst ) return end subroutine init_restart - subroutine init_coldstart(this) + subroutine init_coldstart(this, waterstate_inst, canopystate_inst) ! Arguments class(hlm_fates_interface_type), intent(inout) :: this + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst ! locals integer :: nclumps @@ -484,16 +498,21 @@ subroutine init_coldstart(this) integer :: c integer :: g + + ! INTERF-TODO: I DONT SEE ANY REASON WE CAN'T FORK THE THREADS + ! HERE... (RGK). FORKING WILL BE TESTED AFTER STABLE COLUMNIZATION + ! COMPLETED + nclumps = get_proc_clumps() do nc = 1, nclumps - if (clm_fates%fates(nc)%nsites>0) then + if ( this%fates(nc)%nsites>0 ) then call get_clump_bounds(nc, bounds_clump) - do s = 1,this%nsites + do s = 1,this%fates(nc)%nsites call zero_site(this%fates(nc)%sites(s)) - c = this%fates(nc)%fcolumn(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) @@ -531,8 +550,8 @@ subroutine canopy_sunshade_fracs(this,nc,filter_nourbanp, num_nourbanp, & implicit none ! Input Arguments - class(fates_interface_type), intent(inout) :: this - + class(hlm_fates_interface_type), intent(inout) :: this + integer, intent(in) :: nc ! patch filter for non-urban points @@ -554,7 +573,8 @@ subroutine canopy_sunshade_fracs(this,nc,filter_nourbanp, num_nourbanp, & integer :: c ! column index (HLM native index) integer :: s ! site index (FATES native index) integer, parameter :: ipar = 1 ! The band index for PAR - type(ed_patch_type), pointer :: cpatch ! c"urrent" patch + type(ed_patch_type), pointer :: cpatch ! c"urrent" patch INTERF-TODO: SHOULD + ! BE HIDDEN AS A FATES PRIVATE associate( forc_solad => atm2lnd_inst%forc_solad_grc, & forc_solai => atm2lnd_inst%forc_solai_grc, & @@ -573,7 +593,7 @@ subroutine canopy_sunshade_fracs(this,nc,filter_nourbanp, num_nourbanp, & ! so this condition should prevent a non-site from ! emerging here. Lets do a sanity check anyway - if( s<1 .or. s>this%nsites)then + if( s < 1 .or. s > this%fates(nc)%nsites )then write(iulog,*) 'There is a disconnect between the is_veg filter' write(iulog,*) 'set in ed_clm_link, and the allocation of sites' write(iulog,*) 'Perhaps is_veg is being set in a rogue location?' From b535f31fa7158cf7509fcdfd3e593446a744bc24 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 6 Jun 2016 11:18:39 -0700 Subject: [PATCH 22/23] added a check to see if any unallocated site vectors exist --- components/clm/src/ED/main/EDCLMLinkMod.F90 | 3 +-- components/clm/src/utils/clmfates_interfaceMod.F90 | 8 +++++++- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 index 12703640da..e8648ccd03 100755 --- a/components/clm/src/ED/main/EDCLMLinkMod.F90 +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -1194,9 +1194,8 @@ subroutine ed_clm_link( this, bounds, sites, nsites, fcolumn, waterstate_inst, c end do ! column loop call this%flux_into_litter_pools(bounds, sites(:), nsites, fcolumn(:), canopystate_inst) - call this%ed_update_history_variables(bounds, sites(:), nsites, fcolumn(:), canopystate_inst) - + end associate end subroutine ed_clm_link diff --git a/components/clm/src/utils/clmfates_interfaceMod.F90 b/components/clm/src/utils/clmfates_interfaceMod.F90 index 5e56a33ad2..e8a2ba0c4f 100644 --- a/components/clm/src/utils/clmfates_interfaceMod.F90 +++ b/components/clm/src/utils/clmfates_interfaceMod.F90 @@ -288,7 +288,13 @@ subroutine init_allocate(this) ! Allocate the FATES sites allocate (this%fates(nc)%sites(s)) -! call this%fates(nc)%init() + if( this%fates(nc)%nsites == 0 ) then + write(iulog,*) 'Clump ',nc,' had no valid FATES sites' + write(iulog,*) 'This will likely cause problems until code is improved' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end do From 84d289f9103427174b44058a25441c382b4389ac Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 7 Jun 2016 12:33:00 -0700 Subject: [PATCH 23/23] fixed a bug where site to patch pointers were being flushed, but by accident I got all excited and started flushing patch pointers before patches had been initialized. I de-wronged it. --- components/clm/src/ED/main/EDRestVectorMod.F90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 index 9658469449..e470481959 100755 --- a/components/clm/src/ED/main/EDRestVectorMod.F90 +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -1792,15 +1792,9 @@ subroutine createPatchCohortStructure( this, bounds, sites, nsites, fcolumn ) call endrun(msg=errMsg(__FILE__, __LINE__)) end if - ! This site may have some patches on it, but lets initialize it with null pointers - ! just in-case there are no patches - + ! Initialize the site pointers to null sites(s)%youngest_patch => null() sites(s)%oldest_patch => null() - sites(s)%youngest_patch%younger => null() - sites(s)%youngest_patch%older => null() - sites(s)%oldest_patch%younger => null() - sites(s)%oldest_patch%older => null() do patchIdx = 1,this%numPatchesPerCol(c)