diff --git a/components/elm/bld/ELMBuildNamelist.pm b/components/elm/bld/ELMBuildNamelist.pm
index 3a453214343a..ccc64c356929 100755
--- a/components/elm/bld/ELMBuildNamelist.pm
+++ b/components/elm/bld/ELMBuildNamelist.pm
@@ -790,11 +790,11 @@ sub setup_cmdl_fates_mode {
# The following variables may be set by the user and are compatible with use_fates
# no need to set defaults, covered in a different routine
- my @list = ( "fates_spitfire_mode", "use_vertsoilc", "use_century_decomp",
+ my @list = ( "fates_spitfire_mode", "use_vertsoilc", "use_century_decomp", "fates_seeddisp_cadence",
"use_fates_planthydro", "use_fates_ed_st3", "use_fates_ed_prescribed_phys",
- "use_fates_inventory_init", "use_fates_fixed_biogeog", "use_fates_nocomp","use_fates_sp",
+ "use_fates_inventory_init", "use_fates_fixed_biogeog", "use_fates_nocomp","use_fates_sp",
"fates_inventory_ctrl_filename","use_fates_logging", "use_fates_tree_damage",
- "use_fates_parteh_mode","use_fates_cohort_age_tracking","use_snicar_ad");
+ "use_fates_parteh_mode","use_fates_cohort_age_tracking","use_snicar_ad");
foreach my $var ( @list ) {
if ( defined($nl->get_value($var)) ) {
$nl_flags->{$var} = $nl->get_value($var);
@@ -858,6 +858,10 @@ sub setup_cmdl_fates_mode {
if ( defined($nl->get_value($var)) ) {
fatal_error("$var is being set, but can ONLY be set when -bgc fates option is used.\n");
}
+ $var = "fates_seeddisp_cadence";
+ if ( defined($nl->get_value($var)) ) {
+ fatal_error("$var is being set, but can ONLY be set when -bgc fates option is used.\n");
+ }
}
}
@@ -3223,6 +3227,7 @@ sub setup_logic_fates {
add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fates_sp', 'use_fates'=>$nl_flags->{'use_fates'});
add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fates_nocomp', 'use_fates'=>$nl_flags->{'use_fates'});
add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fates_tree_damage', 'use_fates'=>$nl_flags->{'use_fates'});
+ add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fates_seeddisp_cadence', 'use_fates'=>$nl_flags->{'use_fates'});
add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fates_paramfile', 'phys'=>$nl_flags->{'phys'});
}
diff --git a/components/elm/bld/namelist_files/namelist_defaults.xml b/components/elm/bld/namelist_files/namelist_defaults.xml
index 717b07b9ba71..06fa7b65f65f 100644
--- a/components/elm/bld/namelist_files/namelist_defaults.xml
+++ b/components/elm/bld/namelist_files/namelist_defaults.xml
@@ -2089,6 +2089,7 @@ this mask will have smb calculated over the entire global land surface
.false.
.false.
1
+0
.false.
"/dev/null"
.true.
diff --git a/components/elm/bld/namelist_files/namelist_definition.xml b/components/elm/bld/namelist_files/namelist_definition.xml
index fc563e9a3dd3..3e80a0781356 100644
--- a/components/elm/bld/namelist_files/namelist_definition.xml
+++ b/components/elm/bld/namelist_files/namelist_definition.xml
@@ -314,6 +314,17 @@ Allowed values are:
Switch deciding which nutrient model to use in FATES.
+
+Switch defining the cadence at which seeds are dispersed across
+gridcells. Setting the switch value to zero turns off dispersal.
+Setting the switch to 1, 2, or 3 sets the dispersal cadence to
+daily, monthly or yearly. The daily cadence is primarily
+recommended for test and debug only. Note that turning this
+feature on will result in more memory usage.
+(Only relevant if FATES is being used).
+
+
Toggle to turn on FATES fixed biogeography mode (only relevant if FATES is being used).
diff --git a/components/elm/src/data_types/GridcellType.F90 b/components/elm/src/data_types/GridcellType.F90
index 32425c2f882a..e33800256e60 100644
--- a/components/elm/src/data_types/GridcellType.F90
+++ b/components/elm/src/data_types/GridcellType.F90
@@ -125,7 +125,7 @@ subroutine grc_pp_init(this, begg, endg)
allocate(this%MaxElevation (begg:endg)) ; this%MaxElevation (:) = spval
allocate(this%landunit_indices(1:max_lunit, begg:endg)); this%landunit_indices(:,:) = ispval
-
+
! allocate(this%topounit_indices (begg:endg,1:max_topounits)) ; this%topounit_indices (:,:) = ispval
end subroutine grc_pp_init
diff --git a/components/elm/src/external_models/fates b/components/elm/src/external_models/fates
index a90710a2ef97..1874511a2944 160000
--- a/components/elm/src/external_models/fates
+++ b/components/elm/src/external_models/fates
@@ -1 +1 @@
-Subproject commit a90710a2ef976ff08b87d0ff0507c5628fe6846b
+Subproject commit 1874511a2944d623f4b7a608cdacd9bc96cf8610
diff --git a/components/elm/src/main/controlMod.F90 b/components/elm/src/main/controlMod.F90
index efb0dc540c3e..8cabdec52c00 100755
--- a/components/elm/src/main/controlMod.F90
+++ b/components/elm/src/main/controlMod.F90
@@ -259,6 +259,7 @@ subroutine control_init( )
use_fates_nocomp, &
use_fates_sp, &
fates_parteh_mode, &
+ fates_seeddisp_cadence, &
use_fates_tree_damage
namelist /elm_inparm / use_betr
@@ -778,6 +779,7 @@ subroutine control_spmd()
call mpi_bcast (fates_inventory_ctrl_filename, len(fates_inventory_ctrl_filename), &
MPI_CHARACTER, 0, mpicom, ier)
call mpi_bcast (fates_parteh_mode, 1, MPI_INTEGER, 0, mpicom, ier)
+ call mpi_bcast (fates_seeddisp_cadence, 1, MPI_INTEGER, 0, mpicom, ier)
call mpi_bcast (use_fates_tree_damage, 1, MPI_LOGICAL, 0, mpicom, ier)
call mpi_bcast (use_betr, 1, MPI_LOGICAL, 0, mpicom, ier)
@@ -1184,6 +1186,8 @@ subroutine control_print ()
write(iulog, *) ' use_fates_nocomp = ', use_fates_nocomp
write(iulog, *) ' use_fates_sp = ', use_fates_sp
write(iulog, *) ' fates_inventory_ctrl_filename = ',fates_inventory_ctrl_filename
+ write(iulog, *) ' fates_seeddisp_cadence = ', fates_seeddisp_cadence
+ write(iulog, *) ' fates_seeddisp_cadence: 0, 1, 2, 3 => off, daily, monthly, or yearly dispersal'
end if
! VSFM
diff --git a/components/elm/src/main/elm_driver.F90 b/components/elm/src/main/elm_driver.F90
index e9cf2de44fca..f4bfe2d865e9 100644
--- a/components/elm/src/main/elm_driver.F90
+++ b/components/elm/src/main/elm_driver.F90
@@ -201,8 +201,10 @@ subroutine elm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate)
! the calling tree is given in the description of this module.
!
! !USES:
- use elm_varctl , only : fates_spitfire_mode
- use FATESFireFactoryMod , only : scalar_lightning
+ use elm_varctl , only : fates_spitfire_mode
+ use elm_varctl , only : fates_seeddisp_cadence
+ use FATESFireFactoryMod , only : scalar_lightning
+ use FatesInterfaceTypesMod, only : fates_dispersal_cadence_none
! !ARGUMENTS:
implicit none
@@ -1387,6 +1389,11 @@ subroutine elm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate)
end do
!$OMP END PARALLEL DO
+ ! Pass fates seed dispersal information to all nodes
+ if (use_fates) then
+ if (fates_seeddisp_cadence /= fates_dispersal_cadence_none) call alm_fates%WrapGlobalSeedDispersal()
+ end if
+
! ============================================================================
! Determine gridcell averaged properties to send to atm
! ============================================================================
diff --git a/components/elm/src/main/elm_initializeMod.F90 b/components/elm/src/main/elm_initializeMod.F90
index 1acca88b82b2..21d36c9ca36d 100755
--- a/components/elm/src/main/elm_initializeMod.F90
+++ b/components/elm/src/main/elm_initializeMod.F90
@@ -85,7 +85,7 @@ subroutine initialize1( )
use dynSubgridControlMod , only: dynSubgridControl_init
use filterMod , only: allocFilters
use reweightMod , only: reweight_wrapup
- use topounit_varcon , only: max_topounits, has_topounit, topounit_varcon_init
+ use topounit_varcon , only: max_topounits, has_topounit, topounit_varcon_init
use elm_varctl , only: use_top_solar_rad
!
! !LOCAL VARIABLES:
diff --git a/components/elm/src/main/elm_varctl.F90 b/components/elm/src/main/elm_varctl.F90
index 2aa37ce849de..4f3e1f8c2787 100644
--- a/components/elm/src/main/elm_varctl.F90
+++ b/components/elm/src/main/elm_varctl.F90
@@ -235,6 +235,8 @@ module elm_varctl
integer, public :: fates_parteh_mode = -9 ! 1 => carbon only
! 2 => C+N+P (not enabled yet)
! no others enabled
+ integer, public :: fates_seeddisp_cadence = iundef ! 0 => no seed dispersal across gridcells
+ ! 1, 2, 3 => daily, monthly, or yearly seed dispersal
!----------------------------------------------------------
diff --git a/components/elm/src/main/elmfates_interfaceMod.F90 b/components/elm/src/main/elmfates_interfaceMod.F90
index cec9b146abfc..ab6d8d004e20 100644
--- a/components/elm/src/main/elmfates_interfaceMod.F90
+++ b/components/elm/src/main/elmfates_interfaceMod.F90
@@ -47,6 +47,7 @@ module ELMFatesInterfaceMod
use elm_varctl , only : use_vertsoilc
use elm_varctl , only : fates_spitfire_mode
use elm_varctl , only : fates_parteh_mode
+ use elm_varctl , only : fates_seeddisp_cadence
use elm_varctl , only : use_fates_planthydro
use elm_varctl , only : use_fates_cohort_age_tracking
use elm_varctl , only : use_fates_ed_st3
@@ -89,11 +90,15 @@ module ELMFatesInterfaceMod
get_ref_date, &
timemgr_datediff, &
is_beg_curr_day, &
+ is_end_curr_month, &
get_step_size, &
get_nstep
+ use perf_mod , only : t_startf, t_stopf
+
use spmdMod , only : masterproc
use decompMod , only : get_proc_bounds, &
get_proc_clumps, &
+ get_proc_global, &
get_clump_bounds
use GridcellType , only : grc_pp
@@ -113,6 +118,7 @@ module ELMFatesInterfaceMod
! Used FATES Modules
use FatesConstantsMod , only : ifalse
+ use FatesConstantsMod , only : fates_check_param_set
use FatesInterfaceMod , only : fates_interface_type
use FatesInterfaceMod , only : allocate_bcin
use FatesInterfaceMod , only : allocate_bcpconst
@@ -127,12 +133,14 @@ module ELMFatesInterfaceMod
use FatesInterfaceMod , only : UpdateFatesRMeansTStep
use FatesInterfaceMod , only : InitTimeAveragingGlobals
use FatesInterfaceTypesMod, only : fates_maxPatchesPerSite
+ use FatesInterfaceMod , only : DetermineGridCellNeighbors
use FatesHistoryInterfaceMod, only : fates_hist
use FatesRestartInterfaceMod, only : fates_restart_interface_type
use PRTGenericMod , only : num_elements
use FatesPatchMod , only : fates_patch_type
- use FatesInterfaceTypesMod, only : hlm_stepsize
+ use FatesDispersalMod , only : lneighbors, dispersal_type, IsItDispersalTime
+ use FatesInterfaceTypesMod, only : hlm_stepsize, hlm_current_day
use EDMainMod , only : ed_ecosystem_dynamics
use EDMainMod , only : ed_update_site
use EDInitMod , only : zero_site
@@ -172,6 +180,10 @@ module ELMFatesInterfaceMod
use perf_mod , only : t_startf, t_stopf
+ use FatesInterfaceTypesMod, only : fates_dispersal_cadence_none
+
+ use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
+
implicit none
@@ -209,6 +221,9 @@ module ELMFatesInterfaceMod
! fates_fire_data_method determines the fire data passed from HLM to FATES
class(fates_fire_base_type), allocatable :: fates_fire_data_method
+ ! Type structure that holds allocatable arrays for mpi-based seed dispersal
+ type(dispersal_type) :: fates_seed
+
contains
procedure, public :: init
@@ -237,9 +252,11 @@ module ELMFatesInterfaceMod
procedure, public :: ComputeRootSoilFlux
procedure, public :: wrap_hydraulics_drive
procedure, public :: WrapUpdateFatesRmean
-
- end type hlm_fates_interface_type
+ procedure, public :: WrapGlobalSeedDispersal
+ procedure, public :: WrapUpdateFatesSeedInOut
+ end type hlm_fates_interface_type
+
! hlm_bounds_to_fates_bounds is not currently called outside the interface.
! Although there may be good reasons to, I privatized it so that the next
! developer will at least question its usage (RGK)
@@ -363,6 +380,7 @@ subroutine ELMFatesGlobals2()
integer :: pass_num_lu_harvest_types
integer :: pass_lu_harvest
integer :: pass_tree_damage
+
! ----------------------------------------------------------------------------------
! FATES lightning definitions
! 1 : use a global constant lightning rate found in fates_params.
@@ -396,6 +414,7 @@ subroutine ELMFatesGlobals2()
call set_fates_ctrlparms('hio_ignore_val',rval=spval)
call set_fates_ctrlparms('soilwater_ipedof',ival=get_ipedof(0))
call set_fates_ctrlparms('parteh_mode',ival=fates_parteh_mode)
+ call set_fates_ctrlparms('seeddisp_cadence',ival=fates_seeddisp_cadence)
if(use_fates_tree_damage)then
pass_tree_damage = 1
@@ -580,12 +599,14 @@ subroutine init(this, bounds_proc )
! is not turned on
! ---------------------------------------------------------------------------------
+ use spmdMod, only : npes
+ use decompMod, only : procinfo
use FatesInterfaceMod, only : FatesReportParameters
use FatesParameterDerivedMod, only : param_derived
use FatesInterfaceTypesMod, only : numpft_fates => numpft
use elm_varsur, only : wt_nat_patch
- use topounit_varcon , only: max_topounits, has_topounit
- use FATESFireFactoryMod , only: create_fates_fire_data_method
+ use topounit_varcon, only : max_topounits, has_topounit
+ use FATESFireFactoryMod, only : create_fates_fire_data_method
implicit none
@@ -608,6 +629,7 @@ subroutine init(this, bounds_proc )
type(bounds_type) :: bounds_clump
integer :: nmaxcol
integer :: ndecomp
+ integer :: numg
! Initialize the FATES communicators with the HLM
! This involves to stages
@@ -615,18 +637,25 @@ subroutine init(this, bounds_proc )
! 2) add the history variables defined in clm_inst to the history machinery
call param_derived%Init( numpft_fates )
+ ! Initialize dispersal
+ if (fates_seeddisp_cadence /= fates_dispersal_cadence_none) then
+ ! Initialize fates global seed dispersal array for all nodes
+ call get_proc_global(ng=numg)
+ call this%fates_seed%init(npes,numg,procinfo%ncells,numpft_fates)
+
+ ! Initialize the array of nearest neighbors for fates-driven grid cell communications
+ ! This must be called after surfrd_get_data and decompInit_lnd
+ call DetermineGridCellNeighbors(lneighbors,this%fates_seed,numg)
+ end if
+
nclumps = get_proc_clumps()
allocate(this%fates(nclumps))
allocate(this%f2hmap(nclumps))
-
if(debug)then
write(iulog,*) 'alm_fates%init(): allocating for ',nclumps,' threads'
end if
-
- nclumps = get_proc_clumps()
-
!$OMP PARALLEL DO PRIVATE (nc,bounds_clump,nmaxcol,s,c,l,g,collist,pi,pf,ft)
do nc = 1,nclumps
@@ -666,7 +695,7 @@ subroutine init(this, bounds_proc )
enddo
if(debug)then
- write(iulog,*) 'alm_fates%init(): thread',nc,': allocated ',s,' sites'
+ write(iulog,*) 'alm_fates%init(): thread',nc,': allocated ',s,' sites'
end if
! Allocate vectors that match FATES sites with HLM columns
@@ -1023,6 +1052,12 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, &
! timestep, here, we unload them from the boundary condition
! structures into the cohort structures.
call UnPackNutrientAquisitionBCs(this%fates(nc)%sites, this%fates(nc)%bc_in)
+
+ ! Distribute any seeds from neighboring gridcells into the current gridcell
+ ! Global seed availability array populated by WrapGlobalSeedDispersal call
+ if (fates_seeddisp_cadence /= fates_dispersal_cadence_none) then
+ call this%WrapUpdateFatesSeedInOut(bounds_clump)
+ end if
! ---------------------------------------------------------------------------------
! Flush arrays to values defined by %flushval (see registry entry in
@@ -1040,7 +1075,7 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, &
! ---------------------------------------------------------------------------------
do s = 1,this%fates(nc)%nsites
-
+
call ed_ecosystem_dynamics(this%fates(nc)%sites(s), &
this%fates(nc)%bc_in(s), &
this%fates(nc)%bc_out(s))
@@ -1048,7 +1083,6 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, &
call ed_update_site(this%fates(nc)%sites(s), &
this%fates(nc)%bc_in(s), &
this%fates(nc)%bc_out(s))
-
enddo
! ---------------------------------------------------------------------------------
@@ -1067,7 +1101,7 @@ subroutine dynamics_driv(this, bounds_clump, top_as_inst, &
call fates_hist%update_history_dyn( nc, &
this%fates(nc)%nsites, &
this%fates(nc)%sites, &
- this%fates(nc)%bc_in)
+ this%fates(nc)%bc_in)
if (masterproc) then
write(iulog, *) 'FATES dynamics complete'
@@ -1201,14 +1235,18 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, &
! snow depth variable rather than the CLM variable).
logical , intent(in) :: is_initing_from_restart
+ logical :: dispersal_flag ! local flag to pass to the inside of the site loop
+
integer :: npatch ! number of patches in each site
integer :: ifp ! index FATES patch
integer :: p ! HLM patch index
integer :: s ! site index
integer :: c ! column index
+ integer :: g ! gridcell index
real(r8) :: areacheck
+
associate( &
tlai => canopystate_inst%tlai_patch , &
elai => canopystate_inst%elai_patch , &
@@ -1266,9 +1304,23 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, &
! variables is to inform patch%wtcol(p). wt_ed is imposed on wtcol,
! but only for FATES columns.
+ ! Check if seed dispersal mode is 'turned on', if not return to calling procedure
+ if (fates_seeddisp_cadence /= fates_dispersal_cadence_none) then
+ ! zero the outgoing seed array
+ this%fates_seed%outgoing_local(:,:) = 0._r8
+ dispersal_flag = .false.
+ if (IsItDispersalTime()) dispersal_flag = .true.
+ end if
+
do s = 1,this%fates(nc)%nsites
c = this%f2hmap(nc)%fcolumn(s)
+ g = col_pp%gridcell(c)
+
+ ! Accumulate seeds from sites to the gridcell local outgoing buffer
+ if (fates_seeddisp_cadence /= fates_dispersal_cadence_none) then
+ if (dispersal_flag) this%fates_seed%outgoing_local(g,:) = this%fates(nc)%sites(s)%seed_out(:)
+ end if
veg_pp%is_veg(col_pp%pfti(c):col_pp%pftf(c)) = .false.
veg_pp%is_bareground(col_pp%pfti(c):col_pp%pftf(c)) = .false.
@@ -1358,6 +1410,8 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, &
z0m(p) = this%fates(nc)%bc_out(s)%z0m_pa(ifp)
displa(p) = this%fates(nc)%bc_out(s)%displa_pa(ifp)
dleaf_patch(p) = this%fates(nc)%bc_out(s)%dleaf_pa(ifp)
+
+
end do
@@ -1703,7 +1757,7 @@ subroutine restart( this, bounds_proc, ncid, flag, &
upfreq_in=5)
end do
call fates_hist%update_history_dyn( nc, &
- this%fates(nc)%nsites, &
+ this%fates(nc)%nsites, &
this%fates(nc)%sites, &
this%fates(nc)%bc_in)
@@ -1711,6 +1765,11 @@ subroutine restart( this, bounds_proc, ncid, flag, &
end do
!$OMP END PARALLEL DO
+ ! Disperse seeds
+ if (fates_seeddisp_cadence /= fates_dispersal_cadence_none) then
+ call this%WrapGlobalSeedDispersal(is_restart_flag=.true.)
+ end if
+
end if
return
@@ -1866,7 +1925,7 @@ subroutine init_coldstart(this, canopystate_inst, soilstate_inst, frictionvel_in
call fates_hist%update_history_dyn( nc, &
this%fates(nc)%nsites, &
this%fates(nc)%sites, &
- this%fates(nc)%bc_in)
+ this%fates(nc)%bc_in)
end if
end do
@@ -2480,6 +2539,134 @@ subroutine wrap_canopy_radiation(this, bounds_clump, &
end subroutine wrap_canopy_radiation
+ ! ======================================================================================
+
+ subroutine WrapGlobalSeedDispersal(this,is_restart_flag)
+
+ ! Call mpi procedure to provide the global seed output distribution array to every gridcell.
+ ! This could be conducted with a more sophisticated halo-type structure or distributed graph.
+
+ use decompMod, only : procinfo
+ use spmdMod, only : MPI_REAL8, mpicom
+ use FatesDispersalMod, only : lneighbors, neighbor_type
+ use FatesInterfaceTypesMod, only : numpft_fates => numpft
+
+ ! Arguments
+ class(hlm_fates_interface_type), intent(inout) :: this
+ logical, optional :: is_restart_flag
+
+ ! Local
+ integer :: numg ! total number of gridcells across all processors
+ integer :: ier ! error code
+ integer :: g ! gridcell index
+
+ logical :: set_restart_flag ! local logical variable to pass to IsItDispersalTime
+
+#ifdef _OPENMP
+ logical, external :: omp_in_parallel
+#endif
+
+ type (neighbor_type), pointer :: neighbor
+
+ ! Check to see if we are not in a threaded region. Fail the run if this returns true.
+#ifdef _OPENMP
+ if (omp_in_parallel()) then
+ call endrun(msg='elmfates interface error: MPI routine called within threaded region'//&
+ errMsg(sourcefile, __LINE__))
+ end if
+#endif
+
+ ! This should only be run once per day
+ if(is_beg_curr_day()) then
+
+ ! If WrapGlobalSeedDispersal is being called at the end a fates restart call,
+ ! pass .false. to the set_dispersed_flag to avoid updating the
+ ! global dispersal date
+ set_restart_flag = .true.
+ if (present(is_restart_flag)) then
+ if (is_restart_flag) set_restart_flag = .false.
+ end if
+
+ call t_startf('fates-seed-mpi_allgatherv')
+
+ if (IsItDispersalTime(setdispersedflag=set_restart_flag)) then
+
+ ! Re-initialize incoming seed buffer for this time step
+ this%fates_seed%incoming_global(:,:) = 0._r8
+ this%fates_seed%outgoing_global(:,:) = 0._r8
+
+ ! Distribute and sum outgoing seed data from all nodes to all nodes
+ call MPI_Allgatherv(this%fates_seed%outgoing_local, procinfo%ncells*numpft_fates, MPI_REAL8, &
+ this%fates_seed%outgoing_global, this%fates_seed%ncells_array*numpft_fates, this%fates_seed%begg_array, &
+ MPI_REAL8, mpicom, ier)
+
+ if (ier /= 0) then
+ call endrun(msg='elmfates interface error: MPI_Allgatherv failed'//&
+ errMsg(sourcefile, __LINE__))
+ end if
+
+ ! zero outgoing local for all gridcells outside threaded region now that we've passed them out
+ this%fates_seed%outgoing_local(:,:) = 0._r8
+
+ ! Calculate the current gridcell incoming seed for each gridcell index
+ ! This should be conducted outside of a threaded region to provide access to
+ ! the neighbor%gindex which might not be available in via the clumped index
+ call get_proc_global(ng=numg)
+ do g = 1, numg
+ neighbor => lneighbors(g)%first_neighbor
+ do while (associated(neighbor))
+ ! This also applies the same neighborhood distribution scheme to all pfts
+ ! This needs to have a per pft density probability value
+ this%fates_seed%incoming_global(g,:) = this%fates_seed%incoming_global(g,:) + &
+ this%fates_seed%outgoing_global(neighbor%gindex,:) * &
+ neighbor%density_prob(:) / lneighbors(g)%neighbor_count
+ neighbor => neighbor%next_neighbor
+ end do
+ end do
+ endif
+ endif
+ call t_stopf('fates-seed-mpi_allgatherv')
+
+ end subroutine WrapGlobalSeedDispersal
+
+ ! ======================================================================================
+
+ subroutine WrapUpdateFatesSeedInOut(this,bounds_clump)
+
+ ! This subroutine pass seed_id_global to bc_in and reset seed_out
+
+ ! Arguments
+ class(hlm_fates_interface_type), intent(inout) :: this
+ type(bounds_type), intent(in) :: bounds_clump
+
+ integer :: g ! global index of the host gridcell
+ integer :: c ! global index of the host column
+ integer :: s ! FATES site index
+ integer :: nc ! clump index
+
+ call t_startf('fates-seed-disperse')
+
+ nc = bounds_clump%clump_index
+
+ ! Check that it is the beginning of the current dispersal time step
+ if (IsItDispersalTime()) then
+ do s = 1, this%fates(nc)%nsites
+ c = this%f2hmap(nc)%fcolumn(s)
+ g = col_pp%gridcell(c)
+
+ ! assuming equal area for all sites, seed_id_global in [kg/grid/day], seed_in in [kg/site/day]
+ this%fates(nc)%sites(s)%seed_in(:) = this%fates_seed%incoming_global(g,:)
+ this%fates(nc)%sites(s)%seed_out(:) = 0._r8 ! reset seed_out
+ end do
+ else
+ ! if it is not the dispersing time, pass in zero
+ this%fates(nc)%sites(s)%seed_in(:) = 0._r8
+ end if
+
+ call t_stopf('fates-seed-disperse')
+
+ end subroutine WrapUpdateFatesSeedInOut
+
! ======================================================================================
subroutine wrap_update_hifrq_hist(this, bounds_clump )
@@ -2727,7 +2914,7 @@ subroutine WrapUpdateFatesRmean(this, nc)
end do
end do
- call UpdateFatesRMeansTStep(this%fates(nc)%sites,this%fates(nc)%bc_in)
+ call UpdateFatesRMeansTStep(this%fates(nc)%sites,this%fates(nc)%bc_in,this%fates(nc)%bc_out)
end subroutine WrapUpdateFatesRmean