From 057e5f45d86461aec4c4a833b0ff83349143cd84 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 20 May 2025 15:50:35 -0700 Subject: [PATCH 001/331] initial sketch of limited bc refactor subroutine update --- biogeochem/FatesPatchMod.F90 | 7 +++++++ main/FatesInterfaceMod.F90 | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 2f358cda63..6da5f2ba80 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -32,6 +32,8 @@ module FatesPatchMod use FatesRadiationMemMod, only : num_rad_stream_types use FatesInterfaceTypesMod, only : hlm_hio_ignore_val use FatesInterfaceTypesMod, only : numpft + use FatesInterfaceTypesMod, only : bc_in_type + use FatesInterfaceTypesMod, only : bc_out_type use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) use shr_log_mod, only : errMsg => shr_log_errMsg @@ -70,6 +72,11 @@ module FatesPatchMod type (fates_patch_type), pointer :: younger => null() ! pointer to next younger patch type (fates_cohort_vec_type), pointer :: co_scr(:) ! Scratch vector of cohort properties + ! BC data + ! TODO change this to a specific bc type for incremental refactor purposes if this method is picked + type(bc_in_type) :: bc_in + type(bc_out_type) :: bc_out + !--------------------------------------------------------------------------- ! INDICES diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 6982dd700b..dfb9fa2990 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -181,6 +181,7 @@ module FatesInterfaceMod public :: set_bcs public :: UpdateFatesRMeansTStep public :: InitTimeAveragingGlobals + public :: TransferBCIn private :: FatesReadParameters public :: DetermineGridCellNeighbors @@ -2705,4 +2706,36 @@ subroutine FatesReadParameters(param_reader) end subroutine FatesReadParameters +! ====================================================================================== + + subroutine TransferBCIn(this, transfer_array) + + + type(ed_site_type), intent(inout) :: this + real, intent(in) :: transfer_array(:,:) + + type(fates_patch_type), pointer :: currentPatch + + integer :: ifp + + currentPatch => this%oldest_patch + + ifp = 1 + do while associated(currentPatch) + + ! Set the HLM array index - TODO import multicolumn switch + if (multicolumn_singlesite) ifp = currentPatch%patchno + + currentPatch%bc_in%w_scalar_sisl = transfer_array(currentPatch%patchno,:) + + ! TODO - if not multicolumn, all younger patches should point to older patch, + ! IF input is column level or higher! + + currentPatch => this%younger + end do + + end subroutine TransferBCIn + + +! ====================================================================================== end module FatesInterfaceMod From 60f08a33f8a634273833721e1c52f0ece44e5298 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 21 May 2025 10:56:49 -0700 Subject: [PATCH 002/331] converting the transfer procedure to be more generic --- main/FatesInterfaceMod.F90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index dfb9fa2990..96c86f2bab 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2708,11 +2708,13 @@ end subroutine FatesReadParameters ! ====================================================================================== - subroutine TransferBCIn(this, transfer_array) + subroutine TransferBCIn(this, tag, transfer_array) + ! TODO - make an interface and dimensional versions of this subroutine? type(ed_site_type), intent(inout) :: this - real, intent(in) :: transfer_array(:,:) + character(len=*), intent(in) :: tag + real(r8), pointer, intent(in) :: transfer_array(:,:) type(fates_patch_type), pointer :: currentPatch @@ -2723,13 +2725,18 @@ subroutine TransferBCIn(this, transfer_array) ifp = 1 do while associated(currentPatch) - ! Set the HLM array index - TODO import multicolumn switch - if (multicolumn_singlesite) ifp = currentPatch%patchno + ! TODO import multicolumn switch + !if (multicolumn_singlesite) ifp = currentPatch%patchno - currentPatch%bc_in%w_scalar_sisl = transfer_array(currentPatch%patchno,:) + select case(trim(tag)) + + case('decomp_frac_moisture') + currentPatch%bc_in%w_scalar_sisl = transfer_array(ifp,:) ! TODO - if not multicolumn, all younger patches should point to older patch, ! IF input is column level or higher! + ! Given this, should the patch level bc subtypes actually be pointers to the + ! input values instead of copies of the pointer data? currentPatch => this%younger end do From 5822e42a8f665d0ee2d346df4cfbe4869b34b8bc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 21 May 2025 11:39:41 -0700 Subject: [PATCH 003/331] update to temporary design comment --- main/FatesInterfaceMod.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 96c86f2bab..58449bb634 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2733,10 +2733,11 @@ subroutine TransferBCIn(this, tag, transfer_array) case('decomp_frac_moisture') currentPatch%bc_in%w_scalar_sisl = transfer_array(ifp,:) - ! TODO - if not multicolumn, all younger patches should point to older patch, - ! IF input is column level or higher! - ! Given this, should the patch level bc subtypes actually be pointers to the - ! input values instead of copies of the pointer data? + ! NOTE: should the patch level bc subtypes actually be pointers to the + ! input values instead of copies of the pointer data? Or is not a good idea + ! since the HLM runs on a different time step than fates? + ! If these are not pointers then we really don't have a good way to avoid + ! memory duplicity. currentPatch => this%younger end do From 567a4ab0315593c136ba5b52ba99202f8eb3675e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 21 May 2025 20:26:19 -0700 Subject: [PATCH 004/331] add generic interface for transfer bc in with different ranks --- main/FatesInterfaceMod.F90 | 64 ++++++++++++++++++++++++++++++++------ 1 file changed, 55 insertions(+), 9 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 58449bb634..ebf88cb8ee 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -187,9 +187,19 @@ module FatesInterfaceMod public :: DetermineGridCellNeighbors logical :: debug = .false. ! for debugging this module - + + contains + ! ==================================================================================== + interface TransferBCIn(this, tag, data) + + module procedure TransferBCIn_1d + module procedure TransferBCIn_2d + module procedure TransferBCIn_3d + + end interface TransferBCIn + ! ==================================================================================== subroutine FatesInterfaceInit(log_unit,global_verbose) @@ -2708,30 +2718,66 @@ end subroutine FatesReadParameters ! ====================================================================================== - subroutine TransferBCIn(this, tag, transfer_array) + subroutine TransferBCIn_1d(this, tag, data) + + ! TODO - make an interface and dimensional versions of this subroutine? + + type(ed_site_type), intent(inout) :: this + character(len=*), intent(in) :: tag + real(r8), pointer, intent(in) :: data(:) + + type(fates_patch_type), pointer :: currentPatch + + ! LOCAL + integer :: ifc ! HLM column index + + currentPatch => this%oldest_patch + + do while associated(currentPatch) + + p = this%patch_map(currentPatch%patchno) + + select case(trim(tag)) + + case('leaf_area_index') + currentPatch%bc_in%hlm_sp_tlai = data(p) + ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) + + ! NOTE: should the patch level bc subtypes actually be pointers to the + ! input values instead of copies of the pointer data? Or is not a good idea + ! since the HLM runs on a different time step than fates? + ! If these are not pointers then we really don't have a good way to avoid + ! memory duplicity. + + currentPatch => this%younger + end do + +! ====================================================================================== + + subroutine TransferBCIn_2d(this, tag, data) ! TODO - make an interface and dimensional versions of this subroutine? type(ed_site_type), intent(inout) :: this character(len=*), intent(in) :: tag - real(r8), pointer, intent(in) :: transfer_array(:,:) + real(r8), pointer, intent(in) :: data(:,:) type(fates_patch_type), pointer :: currentPatch - integer :: ifp + ! LOCAL + integer :: c ! HLM column index currentPatch => this%oldest_patch - ifp = 1 do while associated(currentPatch) - ! TODO import multicolumn switch - !if (multicolumn_singlesite) ifp = currentPatch%patchno + c = this%column_map(currentPatch%patchno) select case(trim(tag)) case('decomp_frac_moisture') - currentPatch%bc_in%w_scalar_sisl = transfer_array(ifp,:) + currentPatch%bc_in%w_scalar_sisl = data(c,:) + ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) ! NOTE: should the patch level bc subtypes actually be pointers to the ! input values instead of copies of the pointer data? Or is not a good idea @@ -2742,7 +2788,7 @@ subroutine TransferBCIn(this, tag, transfer_array) currentPatch => this%younger end do - end subroutine TransferBCIn + end subroutine TransferBCIn_2d ! ====================================================================================== From 65ecffadd699642186a4c6a2a61a475012f032cd Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 2 Jul 2025 09:50:18 -0700 Subject: [PATCH 005/331] remove unused bc_out from init_site_vars --- main/EDInitMod.F90 | 5 ++--- main/FatesRestartInterfaceMod.F90 | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 09db71632c..be39037f00 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -53,7 +53,7 @@ module EDInitMod use EDTypesMod , only : phen_dstat_moistoff use EDTypesMod , only : phen_cstat_notcold use EDTypesMod , only : phen_dstat_moiston - use FatesInterfaceTypesMod , only : bc_in_type,bc_out_type + use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_inventory_init use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog @@ -128,7 +128,7 @@ module EDInitMod ! ============================================================================ - subroutine init_site_vars( site_in, bc_in, bc_out ) + subroutine init_site_vars( site_in, bc_in ) ! ! !DESCRIPTION: ! @@ -136,7 +136,6 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) ! !ARGUMENTS type(ed_site_type), intent(inout) :: site_in type(bc_in_type),intent(in) :: bc_in - type(bc_out_type),intent(in) :: bc_out ! ! !LOCAL VARIABLES: !---------------------------------------------------------------------- diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index d1d689fa62..c9e98c49ad 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -3085,7 +3085,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) io_idx_si = this%restart_map(nc)%site_index(s) io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) - call init_site_vars( sites(s), bc_in(s), bc_out(s) ) + call init_site_vars( sites(s), bc_in(s) ) call zero_site( sites(s) ) if ( rio_npatch_si(io_idx_si)<0 .or. rio_npatch_si(io_idx_si) > 10000 ) then From 1d61bfae30e262e3493f541eac73a106c9702e53 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 2 Jul 2025 09:55:26 -0700 Subject: [PATCH 006/331] remove unnecessary bc_in argument from canopy_summarization --- biogeochem/EDCanopyStructureMod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index e21e1c56e7..f8ad384e72 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -777,7 +777,7 @@ end subroutine canopy_spread ! ===================================================================================== - subroutine canopy_summarization( nsites, sites, bc_in ) + subroutine canopy_summarization( nsites, sites ) ! ---------------------------------------------------------------------------------- ! Much of this routine was once ed_clm_link minus all the IO and history stuff @@ -793,7 +793,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ! !ARGUMENTS integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) - type(bc_in_type) , intent(in) :: bc_in(nsites) ! ! !LOCAL VARIABLES: type (fates_patch_type) , pointer :: currentPatch From 7dd40f6e49811b6003c8fcd0b8df1bb5546c6a81 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 2 Jul 2025 09:58:00 -0700 Subject: [PATCH 007/331] remove unnecessary bc_out argument for accumulatefluxes_ed --- biogeophys/EDAccumulateFluxesMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/biogeophys/EDAccumulateFluxesMod.F90 b/biogeophys/EDAccumulateFluxesMod.F90 index b4f93ba5c9..22370eaeaf 100644 --- a/biogeophys/EDAccumulateFluxesMod.F90 +++ b/biogeophys/EDAccumulateFluxesMod.F90 @@ -29,7 +29,7 @@ module EDAccumulateFluxesMod !------------------------------------------------------------------------------ - subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) + subroutine AccumulateFluxes_ED(nsites, sites, bc_in, dt_time) ! ! !DESCRIPTION: @@ -40,14 +40,13 @@ subroutine AccumulateFluxes_ED(nsites, sites, bc_in, bc_out, dt_time) use EDTypesMod , only : ed_site_type, AREA use FatesPatchMod, only : fates_patch_type use FatesCohortMod, only : fates_cohort_type - use FatesInterfaceTypesMod , only : bc_in_type,bc_out_type + use FatesInterfaceTypesMod , only : bc_in_type ! ! !ARGUMENTS integer, intent(in) :: nsites type(ed_site_type), intent(inout), target :: sites(nsites) type(bc_in_type), intent(in) :: bc_in(nsites) - type(bc_out_type), intent(inout) :: bc_out(nsites) real(r8), intent(in) :: dt_time ! timestep interval ! ! !LOCAL VARIABLES: From 4e01bb25c36f7e3828af3a57dac8a9213200d24d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 15 Jul 2025 15:30:00 -0700 Subject: [PATCH 008/331] fix interface for module procedures --- main/FatesInterfaceMod.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index ebf88cb8ee..8cd3b923ab 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -188,11 +188,7 @@ module FatesInterfaceMod logical :: debug = .false. ! for debugging this module - -contains - - ! ==================================================================================== - interface TransferBCIn(this, tag, data) + interface TransferBCIn module procedure TransferBCIn_1d module procedure TransferBCIn_2d @@ -200,6 +196,8 @@ module FatesInterfaceMod end interface TransferBCIn +contains + ! ==================================================================================== subroutine FatesInterfaceInit(log_unit,global_verbose) From d4f2cb52e53fa6885c33cb980d4a16d8f5827a83 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 15 Jul 2025 15:35:25 -0700 Subject: [PATCH 009/331] correct do while statement --- main/FatesInterfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 8cd3b923ab..08df811bc7 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2731,7 +2731,7 @@ subroutine TransferBCIn_1d(this, tag, data) currentPatch => this%oldest_patch - do while associated(currentPatch) + do while (associated(currentPatch)) p = this%patch_map(currentPatch%patchno) @@ -2767,7 +2767,7 @@ subroutine TransferBCIn_2d(this, tag, data) currentPatch => this%oldest_patch - do while associated(currentPatch) + do while (associated(currentPatch)) c = this%column_map(currentPatch%patchno) From 8a61942febbe84277eaa3b6e17f8a7b36b9ef349 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 15 Jul 2025 15:42:47 -0700 Subject: [PATCH 010/331] correct select case and younger patch association --- main/FatesInterfaceMod.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 08df811bc7..bb7f172371 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2747,7 +2747,10 @@ subroutine TransferBCIn_1d(this, tag, data) ! If these are not pointers then we really don't have a good way to avoid ! memory duplicity. - currentPatch => this%younger + end select + + currentPatch => currentPatch%younger + end do ! ====================================================================================== @@ -2783,7 +2786,10 @@ subroutine TransferBCIn_2d(this, tag, data) ! If these are not pointers then we really don't have a good way to avoid ! memory duplicity. - currentPatch => this%younger + end select + + currentPatch => currentPatch%younger + end do end subroutine TransferBCIn_2d From 90bd8d8b438480b0f3d13bdffa8c8d03fea93c27 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 15 Jul 2025 15:51:27 -0700 Subject: [PATCH 011/331] add missing end subroutine statment --- main/FatesInterfaceMod.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index bb7f172371..2fc1f4bf76 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2718,8 +2718,6 @@ end subroutine FatesReadParameters subroutine TransferBCIn_1d(this, tag, data) - ! TODO - make an interface and dimensional versions of this subroutine? - type(ed_site_type), intent(inout) :: this character(len=*), intent(in) :: tag real(r8), pointer, intent(in) :: data(:) @@ -2753,12 +2751,12 @@ subroutine TransferBCIn_1d(this, tag, data) end do + end subroutine TransferBCIn_1d + ! ====================================================================================== subroutine TransferBCIn_2d(this, tag, data) - ! TODO - make an interface and dimensional versions of this subroutine? - type(ed_site_type), intent(inout) :: this character(len=*), intent(in) :: tag real(r8), pointer, intent(in) :: data(:,:) @@ -2794,6 +2792,5 @@ subroutine TransferBCIn_2d(this, tag, data) end subroutine TransferBCIn_2d - ! ====================================================================================== end module FatesInterfaceMod From 840be033140f9cbe5aec228265f6f5650de25930 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 15 Jul 2025 15:55:30 -0700 Subject: [PATCH 012/331] temporarily comment out the 3d option --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 2fc1f4bf76..178f7ba347 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -192,7 +192,7 @@ module FatesInterfaceMod module procedure TransferBCIn_1d module procedure TransferBCIn_2d - module procedure TransferBCIn_3d + !module procedure TransferBCIn_3d end interface TransferBCIn From 3fad6c603ef6abb72709ffbd3151d4e3857e6587 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 16 Jul 2025 15:31:58 -0700 Subject: [PATCH 013/331] add site-level mapping vectors --- main/EDTypesMod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 90be4df5ec..90250515ca 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -339,6 +339,9 @@ module EDTypesMod ! position in history output fields !integer :: clump_id + integer, allocatable :: column_map(:) + integer, allocatable :: patch_map(:) + ! Global index of this site in the history output file integer :: h_gid From 3d3a3a6cd903cc5bbb6c044481a230e79f50afd5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 16 Jul 2025 15:38:53 -0700 Subject: [PATCH 014/331] fix incorrect index definition --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 178f7ba347..ffddcd034e 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2725,7 +2725,7 @@ subroutine TransferBCIn_1d(this, tag, data) type(fates_patch_type), pointer :: currentPatch ! LOCAL - integer :: ifc ! HLM column index + integer :: p ! patch index currentPatch => this%oldest_patch From 6cf3221cd070a2a8bfd4ea83979f122b9b31af6b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 16 Jul 2025 17:12:42 -0700 Subject: [PATCH 015/331] move BC transfer procedure from interface mod to site as type-bound procedure --- main/EDTypesMod.F90 | 88 ++++++++++++++++++++++++++++++++++++++ main/FatesInterfaceMod.F90 | 88 -------------------------------------- 2 files changed, 88 insertions(+), 88 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 90250515ca..74ea838c23 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -604,10 +604,18 @@ module EDTypesMod logical, allocatable :: landuse_vector_gt_min(:) ! is the land use state vector for each land use type greater than the minimum below which we ignore? logical :: transition_landuse_from_off_to_on ! special flag to use only when reading restarts, which triggers procedure to initialize land use + ! interface TransferBCIn + ! module procedure TransferBCIn_1d + ! module procedure TransferBCIn_2d + ! !module procedure TransferBCIn_3d + ! end interface TransferBCIn + contains procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction + procedure, public :: TransferBCIn_1d + procedure, public :: TransferBCIn_2d end type ed_site_type @@ -868,4 +876,84 @@ function get_secondary_young_fraction(this) result(secondary_young_fraction) end function get_secondary_young_fraction + ! ====================================================================================== + + subroutine TransferBCIn_1d(this, tag, data) + + class(ed_site_type), intent(inout) :: this + character(len=*), intent(in) :: tag + real(r8), pointer, intent(in) :: data(:) + + type(fates_patch_type), pointer :: currentPatch + + ! LOCAL + integer :: p ! patch index + + currentPatch => this%oldest_patch + + do while (associated(currentPatch)) + + p = this%patch_map(currentPatch%patchno) + + select case(trim(tag)) + + case('leaf_area_index') + currentPatch%bc_in%hlm_sp_tlai = data(p) + ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) + + ! NOTE: should the patch level bc subtypes actually be pointers to the + ! input values instead of copies of the pointer data? Or is not a good idea + ! since the HLM runs on a different time step than fates? + ! If these are not pointers then we really don't have a good way to avoid + ! memory duplicity. + + end select + + currentPatch => currentPatch%younger + + end do + + end subroutine TransferBCIn_1d + + ! ====================================================================================== + + subroutine TransferBCIn_2d(this, tag, data) + + class(ed_site_type), intent(inout) :: this + character(len=*), intent(in) :: tag + real(r8), pointer, intent(in) :: data(:,:) + + type(fates_patch_type), pointer :: currentPatch + + ! LOCAL + integer :: c ! HLM column index + + currentPatch => this%oldest_patch + + do while (associated(currentPatch)) + + c = this%column_map(currentPatch%patchno) + + select case(trim(tag)) + + case('decomp_frac_moisture') + currentPatch%bc_in%w_scalar_sisl = data(c,:) + ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) + + ! NOTE: should the patch level bc subtypes actually be pointers to the + ! input values instead of copies of the pointer data? Or is not a good idea + ! since the HLM runs on a different time step than fates? + ! If these are not pointers then we really don't have a good way to avoid + ! memory duplicity. + + end select + + currentPatch => currentPatch%younger + + end do + + end subroutine TransferBCIn_2d + +! ====================================================================================== + end module EDTypesMod diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index ffddcd034e..3989e8bc24 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -181,21 +181,12 @@ module FatesInterfaceMod public :: set_bcs public :: UpdateFatesRMeansTStep public :: InitTimeAveragingGlobals - public :: TransferBCIn private :: FatesReadParameters public :: DetermineGridCellNeighbors logical :: debug = .false. ! for debugging this module - interface TransferBCIn - - module procedure TransferBCIn_1d - module procedure TransferBCIn_2d - !module procedure TransferBCIn_3d - - end interface TransferBCIn - contains ! ==================================================================================== @@ -2714,83 +2705,4 @@ subroutine FatesReadParameters(param_reader) end subroutine FatesReadParameters -! ====================================================================================== - - subroutine TransferBCIn_1d(this, tag, data) - - type(ed_site_type), intent(inout) :: this - character(len=*), intent(in) :: tag - real(r8), pointer, intent(in) :: data(:) - - type(fates_patch_type), pointer :: currentPatch - - ! LOCAL - integer :: p ! patch index - - currentPatch => this%oldest_patch - - do while (associated(currentPatch)) - - p = this%patch_map(currentPatch%patchno) - - select case(trim(tag)) - - case('leaf_area_index') - currentPatch%bc_in%hlm_sp_tlai = data(p) - ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) - - ! NOTE: should the patch level bc subtypes actually be pointers to the - ! input values instead of copies of the pointer data? Or is not a good idea - ! since the HLM runs on a different time step than fates? - ! If these are not pointers then we really don't have a good way to avoid - ! memory duplicity. - - end select - - currentPatch => currentPatch%younger - - end do - - end subroutine TransferBCIn_1d - -! ====================================================================================== - - subroutine TransferBCIn_2d(this, tag, data) - - type(ed_site_type), intent(inout) :: this - character(len=*), intent(in) :: tag - real(r8), pointer, intent(in) :: data(:,:) - - type(fates_patch_type), pointer :: currentPatch - - ! LOCAL - integer :: c ! HLM column index - - currentPatch => this%oldest_patch - - do while (associated(currentPatch)) - - c = this%column_map(currentPatch%patchno) - - select case(trim(tag)) - - case('decomp_frac_moisture') - currentPatch%bc_in%w_scalar_sisl = data(c,:) - ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) - - ! NOTE: should the patch level bc subtypes actually be pointers to the - ! input values instead of copies of the pointer data? Or is not a good idea - ! since the HLM runs on a different time step than fates? - ! If these are not pointers then we really don't have a good way to avoid - ! memory duplicity. - - end select - - currentPatch => currentPatch%younger - - end do - - end subroutine TransferBCIn_2d - -! ====================================================================================== end module FatesInterfaceMod From d18a2bcedf29e1cf25b3ae266863da01573a8ebd Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 17 Jul 2025 15:44:50 -0700 Subject: [PATCH 016/331] make generic procedure for transferbcin subroutine --- main/EDTypesMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 74ea838c23..e5d5aade11 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -614,8 +614,10 @@ module EDTypesMod procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction - procedure, public :: TransferBCIn_1d - procedure, public :: TransferBCIn_2d + + procedure, private :: TransferBCIn_1d + procedure, private :: TransferBCIn_2d + generic, public :: TransferBCIn => TransferBCIn_1d, TransferBCIn_2d end type ed_site_type From b4dc012390995f0336874a7ff1eb92f766558117 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 17 Jul 2025 15:46:50 -0700 Subject: [PATCH 017/331] minor cleanup --- main/EDTypesMod.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e5d5aade11..1469c6fc86 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -604,12 +604,6 @@ module EDTypesMod logical, allocatable :: landuse_vector_gt_min(:) ! is the land use state vector for each land use type greater than the minimum below which we ignore? logical :: transition_landuse_from_off_to_on ! special flag to use only when reading restarts, which triggers procedure to initialize land use - ! interface TransferBCIn - ! module procedure TransferBCIn_1d - ! module procedure TransferBCIn_2d - ! !module procedure TransferBCIn_3d - ! end interface TransferBCIn - contains procedure, public :: get_current_landuse_statevector @@ -940,7 +934,6 @@ subroutine TransferBCIn_2d(this, tag, data) case('decomp_frac_moisture') currentPatch%bc_in%w_scalar_sisl = data(c,:) - ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) ! NOTE: should the patch level bc subtypes actually be pointers to the ! input values instead of copies of the pointer data? Or is not a good idea From dad4cffdc23f822c9f608c70e95f52b737f45e20 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 22 Jul 2025 11:58:43 -0700 Subject: [PATCH 018/331] initial handover from site-level bc_in to patch level bc_in for fragmentation scalar only --- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeochem/FatesPatchMod.F90 | 12 +++++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index f509aec000..b62b3e7522 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -3215,7 +3215,7 @@ subroutine fragmentation_scaler( currentPatch, bc_in) if ( use_hlm_soil_scalar ) then ! Calculate the fragmentation_scaler - currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,bc_in%t_scalar_sisl * bc_in%w_scalar_sisl)) + currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,currentPatch%bc_in%t_scalar_sisl * currentPatch%bc_in%w_scalar_sisl)) else diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 6da5f2ba80..b4213505d6 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -303,7 +303,9 @@ subroutine Init(this, num_swb, num_levsoil) allocate(this%sabs_dif(num_swb)) allocate(this%fragmentation_scaler(num_levsoil)) allocate(this%co_scr(max_cohort_per_patch)) - + allocate(this%bc_in%w_scalar_sisl(num_levsoil)) + allocate(this%bc_in%t_scalar_sisl(num_levsoil)) + ! initialize all values to nan call this%NanValues() @@ -541,6 +543,10 @@ subroutine NanValues(this) this%scorch_ht(:) = nan this%tfc_ros = nan this%frac_burnt = nan + + ! Boundary conditions + this%bc_in%w_scalar_sisl(:) = nan + this%bc_in%t_scalar_sisl(:) = nan end subroutine NanValues @@ -630,6 +636,10 @@ subroutine ZeroValues(this) this%rx_fi = 0.0_r8 this%rx_frac_burnt = 0.0_r8 + ! Boundary conditions + this%bc_in%w_scalar_sisl(:) = 0.0_r8 + this%bc_in%t_scalar_sisl(:) = 0.0_r8 + end subroutine ZeroValues !=========================================================================== From 7ff66cc6f5d9d88a8d9423e5c156d60cd656d7f5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 28 Jul 2025 16:33:13 -0700 Subject: [PATCH 019/331] remove w and t scalars from interface bc init procedures --- main/FatesInterfaceMod.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 3989e8bc24..147829938a 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -302,8 +302,6 @@ subroutine zero_bcs(fates,s) fates%bc_in(s)%tot_litc = 0.0_r8 fates%bc_in(s)%snow_depth_si = 0.0_r8 fates%bc_in(s)%frac_sno_eff_si = 0.0_r8 - fates%bc_in(s)%w_scalar_sisl(:) = 0.0_r8 - fates%bc_in(s)%t_scalar_sisl(:) = 0.0_r8 if(do_fates_salinity)then fates%bc_in(s)%salinity_sl(:) = 0.0_r8 @@ -500,8 +498,6 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, allocate(bc_in%z_sisl(nlevsoil_in)) allocate(bc_in%decomp_id(nlevsoil_in)) allocate(bc_in%dz_decomp_sisl(nlevdecomp_in)) - allocate(bc_in%w_scalar_sisl(nlevsoil_in)) - allocate(bc_in%t_scalar_sisl(nlevsoil_in)) ! Lightning (or successful ignitions) and population density ! Fire related variables From c05af8997d90df6d851517b32f36bad618b0413e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 28 Jul 2025 16:37:58 -0700 Subject: [PATCH 020/331] add decomposition temperature limitation to transfer in --- main/EDTypesMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 1469c6fc86..1220b35071 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -934,6 +934,8 @@ subroutine TransferBCIn_2d(this, tag, data) case('decomp_frac_moisture') currentPatch%bc_in%w_scalar_sisl = data(c,:) + case('decomp_frac_temperature') + currentPatch%bc_in%t_scalar_sisl = data(c,:) ! NOTE: should the patch level bc subtypes actually be pointers to the ! input values instead of copies of the pointer data? Or is not a good idea From cb146d9c2326dd43f8fb7fd1a52f5a2f7d96bd51 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 1 Aug 2025 16:33:37 -0700 Subject: [PATCH 021/331] Update fluxintolitterpool non-mimics section to use the patch-level bc_out litter variables. --- biogeochem/FatesSoilBGCFluxMod.F90 | 109 ++++++++++++++--------------- 1 file changed, 54 insertions(+), 55 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index e0af2a9e0f..98b69abc36 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -627,7 +627,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) ! !ARGUMENTS type(ed_site_type) , intent(inout) :: csite type(bc_in_type) , intent(in) :: bc_in - type(bc_out_type) , intent(inout),target :: bc_out ! !LOCAL VARIABLES: type (fates_patch_type), pointer :: currentPatch @@ -636,6 +635,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) real(r8), pointer :: flux_lab_si(:) real(r8), pointer :: flux_lig_si(:) type(litter_type), pointer :: litt + type(bc_out_type), pointer :: bc_out real(r8) :: surface_prof(bc_in%nlevsoil) ! this array is used to distribute ! fragmented litter on the surface @@ -700,46 +700,48 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) surface_prof(id) = surface_prof(id)/surface_prof_tot end do - ! Loop over the different elements. - do el = 1, num_elements - - ! Zero out the boundary flux arrays - ! Make a pointer to the cellulose, labile and lignin - ! flux partitions. - - select case (element_list(el)) - case (carbon12_element) - bc_out%litt_flux_cel_c_si(:) = 0.0_r8 - bc_out%litt_flux_lig_c_si(:) = 0.0_r8 - bc_out%litt_flux_lab_c_si(:) = 0.0_r8 - flux_cel_si => bc_out%litt_flux_cel_c_si(:) - flux_lab_si => bc_out%litt_flux_lab_c_si(:) - flux_lig_si => bc_out%litt_flux_lig_c_si(:) - case (nitrogen_element) - bc_out%litt_flux_cel_n_si(:) = 0._r8 - bc_out%litt_flux_lig_n_si(:) = 0._r8 - bc_out%litt_flux_lab_n_si(:) = 0._r8 - flux_cel_si => bc_out%litt_flux_cel_n_si(:) - flux_lab_si => bc_out%litt_flux_lab_n_si(:) - flux_lig_si => bc_out%litt_flux_lig_n_si(:) - case (phosphorus_element) - bc_out%litt_flux_cel_p_si(:) = 0._r8 - bc_out%litt_flux_lig_p_si(:) = 0._r8 - bc_out%litt_flux_lab_p_si(:) = 0._r8 - flux_cel_si => bc_out%litt_flux_cel_p_si(:) - flux_lab_si => bc_out%litt_flux_lab_p_si(:) - flux_lig_si => bc_out%litt_flux_lig_p_si(:) - end select + currentPatch => csite%oldest_patch + fluxpatchloop: do while (associated(currentPatch)) - currentPatch => csite%oldest_patch - do while (associated(currentPatch)) + ! Set a pointer to the litter object + ! for the current element on the current + ! patch + litt => currentPatch%litter(el) + bc_out => currentPatch%bc_out - ! Set a pointer to the litter object - ! for the current element on the current - ! patch - litt => currentPatch%litter(el) - area_frac = currentPatch%area/area + area_frac = currentPatch%area/area + + ! Loop over the different elements. + elemloop: do el = 1, num_elements + ! Zero out the boundary flux arrays + ! Make a pointer to the cellulose, labile and lignin + ! flux partitions. + + select case (element_list(el)) + case (carbon12_element) + bc_out%litt_flux_cel_c_si(:) = 0.0_r8 + bc_out%litt_flux_lig_c_si(:) = 0.0_r8 + bc_out%litt_flux_lab_c_si(:) = 0.0_r8 + flux_cel_si => bc_out%litt_flux_cel_c_si(:) + flux_lab_si => bc_out%litt_flux_lab_c_si(:) + flux_lig_si => bc_out%litt_flux_lig_c_si(:) + case (nitrogen_element) + bc_out%litt_flux_cel_n_si(:) = 0._r8 + bc_out%litt_flux_lig_n_si(:) = 0._r8 + bc_out%litt_flux_lab_n_si(:) = 0._r8 + flux_cel_si => bc_out%litt_flux_cel_n_si(:) + flux_lab_si => bc_out%litt_flux_lab_n_si(:) + flux_lig_si => bc_out%litt_flux_lig_n_si(:) + case (phosphorus_element) + bc_out%litt_flux_cel_p_si(:) = 0._r8 + bc_out%litt_flux_lig_p_si(:) = 0._r8 + bc_out%litt_flux_lab_p_si(:) = 0._r8 + flux_cel_si => bc_out%litt_flux_cel_p_si(:) + flux_lab_si => bc_out%litt_flux_lab_p_si(:) + flux_lig_si => bc_out%litt_flux_lig_p_si(:) + end select + do ic = 1, ncwd do id = 1,nlev_eff_decomp @@ -763,12 +765,8 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) end do end do - - - ! leaf and fine root fragmentation fluxes - do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & @@ -810,22 +808,23 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) litt%root_fines_frag(ilignin,j) * area_frac enddo - currentPatch => currentPatch%younger - end do + ! Normalize all masses over the decomposition layer's depth + ! Convert from kg/m2/day -> g/m3/s - ! Normalize all masses over the decomposition layer's depth - ! Convert from kg/m2/day -> g/m3/s + do id = 1,nlev_eff_decomp + flux_cel_si(id) = days_per_sec * g_per_kg * & + flux_cel_si(id) / bc_in%dz_decomp_sisl(id) + flux_lig_si(id) = days_per_sec * g_per_kg * & + flux_lig_si(id) / bc_in%dz_decomp_sisl(id) + flux_lab_si(id) = days_per_sec * g_per_kg * & + flux_lab_si(id) / bc_in%dz_decomp_sisl(id) + end do - do id = 1,nlev_eff_decomp - flux_cel_si(id) = days_per_sec * g_per_kg * & - flux_cel_si(id) / bc_in%dz_decomp_sisl(id) - flux_lig_si(id) = days_per_sec * g_per_kg * & - flux_lig_si(id) / bc_in%dz_decomp_sisl(id) - flux_lab_si(id) = days_per_sec * g_per_kg * & - flux_lab_si(id) / bc_in%dz_decomp_sisl(id) - end do + end do elemloop + + currentPatch => currentPatch%younger - end do ! do elements + end do fluxpatchloop ! If we are coupled with MIMICS, then we need some assessment of litter quality ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) From b0880d4b0ad003d9cb569bf72b6050da5a768a2e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 1 Aug 2025 16:46:38 -0700 Subject: [PATCH 022/331] Update the mimics portion of the fluxintolitterpools code to be within the previous patch loop structure --- biogeochem/FatesSoilBGCFluxMod.F90 | 166 ++++++++++++++--------------- 1 file changed, 80 insertions(+), 86 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 98b69abc36..67990b2bc8 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -586,7 +586,7 @@ end subroutine EffluxIntoLitterPools ! ===================================================================================== - subroutine FluxIntoLitterPools(csite, bc_in, bc_out) + subroutine FluxIntoLitterPools(csite, bc_in) ! ----------------------------------------------------------------------------------- ! Created by Charlie Koven and Rosie Fisher, 2014-2015 @@ -822,102 +822,96 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) end do elemloop - currentPatch => currentPatch%younger - - end do fluxpatchloop - - ! If we are coupled with MIMICS, then we need some assessment of litter quality - ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) - ! then we need to approximate this by estimating the mean C:N ratios of each - ! plant organ, and mulitplying that by the different C Fluxes to get a total - ! approximate N flux. Note, in C-only, we will not capture any re-absorption. + ! If we are coupled with MIMICS, then we need some assessment of litter quality + ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) + ! then we need to approximate this by estimating the mean C:N ratios of each + ! plant organ, and mulitplying that by the different C Fluxes to get a total + ! approximate N flux. Note, in C-only, we will not capture any re-absorption. - if(trim(hlm_decomp).eq.'MIMICS') then + if(trim(hlm_decomp).eq.'MIMICS') then - ! If we track nitrogen (ie cnp or other) then - ! we diagnose the c-lig/n ratio directly from the pools - if(element_pos(nitrogen_element)>0) then - ! Sum totalN fluxes over depth [g/m2] - sum_N = sum((bc_out%litt_flux_cel_n_si(1:nlev_eff_soil) + & - bc_out%litt_flux_lig_n_si(1:nlev_eff_soil) + & - bc_out%litt_flux_lab_n_si(1:nlev_eff_soil)) * & - bc_in%dz_sisl(1:nlev_eff_soil)) - - else - - ! In this case (Carbon Only), we use the stoichiometry parameters to estimate - ! the C:N of live vegetation and the seedbank, and use that - ! as a proxy for the C:N of the litter flux + ! If we track nitrogen (ie cnp or other) then + ! we diagnose the c-lig/n ratio directly from the pools + if(element_pos(nitrogen_element)>0) then - sum_N = 0._r8 - - currentPatch => csite%oldest_patch - do while (associated(currentPatch)) + ! Sum totalN fluxes over depth [g/m2] + sum_N = sum((bc_out%litt_flux_cel_n_si(1:nlev_eff_soil) + & + bc_out%litt_flux_lig_n_si(1:nlev_eff_soil) + & + bc_out%litt_flux_lab_n_si(1:nlev_eff_soil)) * & + bc_in%dz_sisl(1:nlev_eff_soil)) - litt => currentPatch%litter(element_pos(carbon12_element)) - area_frac = currentPatch%area*area_inv - - tot_leaf_c = 0._r8 - tot_leaf_n = 0._r8 - tot_fnrt_c = 0._r8 - tot_fnrt_n = 0._r8 - tot_wood_c = 0._r8 - tot_wood_n = 0._r8 + else + + ! In this case (Carbon Only), we use the stoichiometry parameters to estimate + ! the C:N of live vegetation and the seedbank, and use that + ! as a proxy for the C:N of the litter flux - ccohort => currentPatch%tallest - do while (associated(ccohort)) - ipft = ccohort%pft - leaf_c = ccohort%n * area_inv * ccohort%prt%GetState(leaf_organ, carbon12_element) - sapw_c = ccohort%n * area_inv * ccohort%prt%GetState(sapw_organ, carbon12_element) - fnrt_c = ccohort%n * area_inv * ccohort%prt%GetState(fnrt_organ, carbon12_element) - struct_c = ccohort%n * area_inv * ccohort%prt%GetState(struct_organ, carbon12_element) - leaf_n = leaf_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) - sapw_n = sapw_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) - fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) - struct_n = struct_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) - tot_leaf_c = tot_leaf_c + leaf_c - tot_leaf_n = tot_leaf_n + leaf_n - tot_fnrt_c = tot_fnrt_c + fnrt_c - tot_fnrt_n = tot_fnrt_n + fnrt_n - tot_wood_c = tot_wood_c + sapw_c + struct_c - tot_wood_n = tot_wood_n + sapw_n + struct_n - ccohort => ccohort%shorter - end do + sum_N = 0._r8 + - if(tot_wood_c>nearzero) then - sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) - sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) - end if - if(tot_leaf_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) - end if - if(tot_fnrt_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) - end if - do ipft = 1,numpft - sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & - (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) - end do + tot_leaf_c = 0._r8 + tot_leaf_n = 0._r8 + tot_fnrt_c = 0._r8 + tot_fnrt_n = 0._r8 + tot_wood_c = 0._r8 + tot_wood_n = 0._r8 + + ccohort => currentPatch%tallest + do while (associated(ccohort)) + ipft = ccohort%pft + leaf_c = ccohort%n * area_inv * ccohort%prt%GetState(leaf_organ, carbon12_element) + sapw_c = ccohort%n * area_inv * ccohort%prt%GetState(sapw_organ, carbon12_element) + fnrt_c = ccohort%n * area_inv * ccohort%prt%GetState(fnrt_organ, carbon12_element) + struct_c = ccohort%n * area_inv * ccohort%prt%GetState(struct_organ, carbon12_element) + leaf_n = leaf_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + sapw_n = sapw_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + struct_n = struct_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + tot_leaf_c = tot_leaf_c + leaf_c + tot_leaf_n = tot_leaf_n + leaf_n + tot_fnrt_c = tot_fnrt_c + fnrt_c + tot_fnrt_n = tot_fnrt_n + fnrt_n + tot_wood_c = tot_wood_c + sapw_c + struct_c + tot_wood_n = tot_wood_n + sapw_n + struct_n + ccohort => ccohort%shorter + end do + + if(tot_wood_c>nearzero) then + sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) + end if + if(tot_leaf_c>nearzero)then + sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) + end if + if(tot_fnrt_c>nearzero)then + sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) + end if + do ipft = 1,numpft + sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & + (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) + end do - currentPatch => currentPatch%younger - end do - - ! Convert from kg/m2/day -> g/m2/s - sum_N = sum_N * days_per_sec * g_per_kg - - end if + ! Convert from kg/m2/day -> g/m2/s + sum_N = sum_N * days_per_sec * g_per_kg + + end if - ! Sum over layers and multiply by depth g/m3/s * m -> g/m2/s - sum_ligC = sum(bc_out%litt_flux_lig_c_si(1:nlev_eff_soil) * bc_in%dz_sisl(1:nlev_eff_soil)) + ! Sum over layers and multiply by depth g/m3/s * m -> g/m2/s + sum_ligC = sum(bc_out%litt_flux_lig_c_si(1:nlev_eff_soil) * bc_in%dz_sisl(1:nlev_eff_soil)) - if(sum_N>nearzero)then - bc_out%litt_flux_ligc_per_n = sum_ligC / sum_N - else - bc_out%litt_flux_ligc_per_n = 0._r8 - end if + if(sum_N>nearzero)then + bc_out%litt_flux_ligc_per_n = sum_ligC / sum_N + else + bc_out%litt_flux_ligc_per_n = 0._r8 + end if + + end if ! MIMICS check + + currentPatch => currentPatch%younger + + end do fluxpatchloop - end if From 30c110e994a285c87f24e676ed4413fab3dbdc7b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 1 Aug 2025 16:48:01 -0700 Subject: [PATCH 023/331] whitespace clean up --- biogeochem/FatesSoilBGCFluxMod.F90 | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 67990b2bc8..3c4836f913 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -743,18 +743,15 @@ subroutine FluxIntoLitterPools(csite, bc_in) end select do ic = 1, ncwd - do id = 1,nlev_eff_decomp flux_cel_si(id) = flux_cel_si(id) + & litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id) - end do do j = 1, nlev_eff_soil - id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & @@ -762,13 +759,11 @@ subroutine FluxIntoLitterPools(csite, bc_in) flux_lig_si(id) = flux_lig_si(id) + & litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig * area_frac - end do end do ! leaf and fine root fragmentation fluxes do id = 1,nlev_eff_decomp - flux_lab_si(id) = flux_lab_si(id) + & litt%leaf_fines_frag(ilabile) * area_frac* surface_prof(id) @@ -777,10 +772,8 @@ subroutine FluxIntoLitterPools(csite, bc_in) flux_lig_si(id) = flux_lig_si(id) + & litt%leaf_fines_frag(ilignin) * area_frac* surface_prof(id) - end do - ! decaying seeds from the litter pool do ipft = 1,numpft do id = 1,nlev_eff_decomp @@ -830,7 +823,6 @@ subroutine FluxIntoLitterPools(csite, bc_in) if(trim(hlm_decomp).eq.'MIMICS') then - ! If we track nitrogen (ie cnp or other) then ! we diagnose the c-lig/n ratio directly from the pools if(element_pos(nitrogen_element)>0) then @@ -849,7 +841,6 @@ subroutine FluxIntoLitterPools(csite, bc_in) sum_N = 0._r8 - tot_leaf_c = 0._r8 tot_leaf_n = 0._r8 tot_fnrt_c = 0._r8 @@ -911,10 +902,6 @@ subroutine FluxIntoLitterPools(csite, bc_in) currentPatch => currentPatch%younger end do fluxpatchloop - - - - return end subroutine FluxIntoLitterPools From 694243cfc9fac246eed94bd1a5627c0d64d4dff8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 12 Aug 2025 11:09:36 -0700 Subject: [PATCH 024/331] add transfer bc out subroutine --- main/EDTypesMod.F90 | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 1220b35071..135c90f4b5 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -952,5 +952,43 @@ subroutine TransferBCIn_2d(this, tag, data) end subroutine TransferBCIn_2d ! ====================================================================================== + + subroutine TransferBCOut(this, tag, data) + + class(ed_site_type), intent(inout) :: this + character(len=*), intent(in) :: tag + real(r8), pointer, intent(inout) :: data(:,:) + + type(fates_patch_type), pointer :: currentPatch + + ! LOCAL + integer :: c ! HLM column index + + currentPatch => this%oldest_patch + + do while (associated(currentPatch)) + + c = this%column_map(currentPatch%patchno) + + select case(trim(tag)) + + ! For the decomposition carbon pools, the host land model uses + ! a 3D array, where the third dimension signifies the litter type. + ! The HLM sets up a pointer to a 2D slice of the variable so we + ! don't have to worry about that here + case('decomp_cpools_met') + data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lab_c_si + case('decomp_cpools_cel') + data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_cel_c_si + case('decomp_cpools_lig') + data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lig_c_si + + end select + + currentPatch => currentPatch%younger + + end do + + end subroutine TransferBCOut end module EDTypesMod From e4e32bed883ba7ee26a34cece192f4baec50d220 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 12 Aug 2025 11:16:43 -0700 Subject: [PATCH 025/331] remove now unused bc_out from flux into litter pool procedure --- main/EDMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 7a5bd21840..31cf7befc2 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -794,7 +794,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! can remove it completely if/when this call is added in ELM to ! subroutine UpdateLitterFluxes(this,bounds_clump) in elmfates_interfaceMod.F90 - call FluxIntoLitterPools(currentsite, bc_in, bc_out) + call FluxIntoLitterPools(currentsite, bc_in) ! Update cohort number. From ed225e95d39fd6e81fbc638384c6bdd68ed9eecd Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 12 Aug 2025 15:44:46 -0700 Subject: [PATCH 026/331] add time conversion argument for the bc out transfer --- main/EDTypesMod.F90 | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 135c90f4b5..e6171e74ee 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -953,11 +953,13 @@ end subroutine TransferBCIn_2d ! ====================================================================================== - subroutine TransferBCOut(this, tag, data) + subroutine TransferBCOut(this, tag, data, dtime) class(ed_site_type), intent(inout) :: this - character(len=*), intent(in) :: tag - real(r8), pointer, intent(inout) :: data(:,:) + + character(len=*), intent(in) :: tag ! HLM-FATES common vocab string + real(r8), pointer, intent(inout) :: data(:,:) ! data pointer associated with tag + real(r8), intent(in) :: dtime ! HLM timestep size in seconds type(fates_patch_type), pointer :: currentPatch @@ -975,13 +977,14 @@ subroutine TransferBCOut(this, tag, data) ! For the decomposition carbon pools, the host land model uses ! a 3D array, where the third dimension signifies the litter type. ! The HLM sets up a pointer to a 2D slice of the variable so we - ! don't have to worry about that here + ! don't have to worry about that here. + ! We convert the bc_out from per second to per timestep case('decomp_cpools_met') - data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lab_c_si + data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lab_c_si * dtime case('decomp_cpools_cel') - data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_cel_c_si + data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_cel_c_si * dtime case('decomp_cpools_lig') - data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lig_c_si + data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lig_c_si * dtime end select From 804c562baba3f504de5ec49a5071e30ec9f27013 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 21 Aug 2025 15:19:19 -0700 Subject: [PATCH 027/331] remove area fraction from flux into litter pools now that subroutine does not sum to the site level --- biogeochem/FatesSoilBGCFluxMod.F90 | 39 ++++++++++++++---------------- 1 file changed, 18 insertions(+), 21 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 3c4836f913..d4ba9e89fe 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -644,7 +644,6 @@ subroutine FluxIntoLitterPools(csite, bc_in) real(r8) :: surface_prof_tot ! normalizes the surface_prof array integer :: nlev_eff_soil ! number of effective soil layers integer :: nlev_eff_decomp ! number of effective decomp layers - real(r8) :: area_frac ! fraction of site's area of current patch real(r8) :: z_decomp ! Used for calculating depth midpoints of decomp layers integer :: el ! Element index (C,N,P,etc) integer :: j ! Soil layer index @@ -709,8 +708,6 @@ subroutine FluxIntoLitterPools(csite, bc_in) litt => currentPatch%litter(el) bc_out => currentPatch%bc_out - area_frac = currentPatch%area/area - ! Loop over the different elements. elemloop: do el = 1, num_elements @@ -745,33 +742,33 @@ subroutine FluxIntoLitterPools(csite, bc_in) do ic = 1, ncwd do id = 1,nlev_eff_decomp flux_cel_si(id) = flux_cel_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) + litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id) + litt%ag_cwd_frag(ic) * ED_val_cwd_flig * surface_prof(id) end do do j = 1, nlev_eff_soil id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel * area_frac + litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel flux_lig_si(id) = flux_lig_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig * area_frac + litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig end do end do ! leaf and fine root fragmentation fluxes do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & - litt%leaf_fines_frag(ilabile) * area_frac* surface_prof(id) + litt%leaf_fines_frag(ilabile) * surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & - litt%leaf_fines_frag(icellulose) * area_frac* surface_prof(id) + litt%leaf_fines_frag(icellulose) * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%leaf_fines_frag(ilignin) * area_frac* surface_prof(id) + litt%leaf_fines_frag(ilignin) * surface_prof(id) end do ! decaying seeds from the litter pool @@ -779,26 +776,26 @@ subroutine FluxIntoLitterPools(csite, bc_in) do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flab(ipft) * area_frac* surface_prof(id) + EDPftvarcon_inst%lf_flab(ipft) * surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_fcel(ipft) * area_frac* surface_prof(id) + EDPftvarcon_inst%lf_fcel(ipft) * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flig(ipft) * area_frac* surface_prof(id) + EDPftvarcon_inst%lf_flig(ipft) * surface_prof(id) end do end do do j = 1, nlev_eff_soil id = bc_in%decomp_id(j) flux_lab_si(id) = flux_lab_si(id) + & - litt%root_fines_frag(ilabile,j) * area_frac + litt%root_fines_frag(ilabile,j) flux_cel_si(id) = flux_cel_si(id) + & - litt%root_fines_frag(icellulose,j) * area_frac + litt%root_fines_frag(icellulose,j) flux_lig_si(id) = flux_lig_si(id) + & - litt%root_fines_frag(ilignin,j) * area_frac + litt%root_fines_frag(ilignin,j) enddo ! Normalize all masses over the decomposition layer's depth @@ -869,17 +866,17 @@ subroutine FluxIntoLitterPools(csite, bc_in) end do if(tot_wood_c>nearzero) then - sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) - sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) end if if(tot_leaf_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) + sum_N = sum_N + sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) end if if(tot_fnrt_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) + sum_N = sum_N + sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) end if do ipft = 1,numpft - sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & + sum_N = sum_N + currentPatch%nitr_repro_stoich(ipft) * & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) end do From f024da458447e9d47a9a421dbf19bba967bec6bc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 21 Aug 2025 17:05:08 -0700 Subject: [PATCH 028/331] Add 1D bcout transfer subroutine and generic --- main/EDTypesMod.F90 | 48 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 46 insertions(+), 2 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e6171e74ee..5c9ada3128 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -613,6 +613,10 @@ module EDTypesMod procedure, private :: TransferBCIn_2d generic, public :: TransferBCIn => TransferBCIn_1d, TransferBCIn_2d + procedure, private :: TransferBCOut_1d + procedure, private :: TransferBCOut_2d + generic, public :: TransferBCOut => TransferBCOut_1d, TransferBCOut_2d + end type ed_site_type ! Make public necessary subroutines and functions @@ -953,7 +957,46 @@ end subroutine TransferBCIn_2d ! ====================================================================================== - subroutine TransferBCOut(this, tag, data, dtime) + subroutine TransferBCOut_1d(this, tag, data) + + class(ed_site_type), intent(inout) :: this + + character(len=*), intent(in) :: tag ! HLM-FATES common vocab string + real(r8), pointer, intent(inout) :: data(:,:) ! data pointer associated with tag + + type(fates_patch_type), pointer :: currentPatch + + ! LOCAL + integer :: c ! HLM column index + + currentPatch => this%oldest_patch + + do while (associated(currentPatch)) + + c = this%column_map(currentPatch%patchno) + + select case(trim(tag)) + + ! For the decomposition carbon pools, the host land model uses + ! a 3D array, where the third dimension signifies the litter type. + ! The HLM sets up a pointer to a 2D slice of the variable so we + ! don't have to worry about that here. + ! We convert the bc_out from per second to per timestep + case('litter_fall') + data(c) = data(c) + sum(currentPatch%bc_out%litt_flux_lab_c_si * currentPatch%bc_in%dz_decomp_sisl) & + + sum(currentPatch%bc_out%litt_flux_cel_c_si * currentPatch%bc_in%dz_decomp_sisl) & + + sum(currentPatch%bc_out%litt_flux_lig_c_si * currentPatch%bc_in%dz_decomp_sisl) + + end select + + currentPatch => currentPatch%younger + + end do + + end subroutine TransferBCOut_1d +! ====================================================================================== + + subroutine TransferBCOut_2d(this, tag, data, dtime) class(ed_site_type), intent(inout) :: this @@ -992,6 +1035,7 @@ subroutine TransferBCOut(this, tag, data, dtime) end do - end subroutine TransferBCOut + end subroutine TransferBCOut_2d + end module EDTypesMod From 49c9f122201101e28aab730f0f8395f332eb2976 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 22 Aug 2025 10:34:03 -0700 Subject: [PATCH 029/331] correct 1d bc out transfer definition --- main/EDTypesMod.F90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5c9ada3128..8f73bf4139 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -962,7 +962,7 @@ subroutine TransferBCOut_1d(this, tag, data) class(ed_site_type), intent(inout) :: this character(len=*), intent(in) :: tag ! HLM-FATES common vocab string - real(r8), pointer, intent(inout) :: data(:,:) ! data pointer associated with tag + real(r8), pointer, intent(inout) :: data(:) ! data pointer associated with tag type(fates_patch_type), pointer :: currentPatch @@ -977,11 +977,6 @@ subroutine TransferBCOut_1d(this, tag, data) select case(trim(tag)) - ! For the decomposition carbon pools, the host land model uses - ! a 3D array, where the third dimension signifies the litter type. - ! The HLM sets up a pointer to a 2D slice of the variable so we - ! don't have to worry about that here. - ! We convert the bc_out from per second to per timestep case('litter_fall') data(c) = data(c) + sum(currentPatch%bc_out%litt_flux_lab_c_si * currentPatch%bc_in%dz_decomp_sisl) & + sum(currentPatch%bc_out%litt_flux_cel_c_si * currentPatch%bc_in%dz_decomp_sisl) & @@ -994,6 +989,7 @@ subroutine TransferBCOut_1d(this, tag, data) end do end subroutine TransferBCOut_1d + ! ====================================================================================== subroutine TransferBCOut_2d(this, tag, data, dtime) From 00a5abbfcf5760c2a064e5aae7443867f92f34ad Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 22 Aug 2025 10:45:14 -0700 Subject: [PATCH 030/331] align arguments for transfer bcout generics --- main/EDTypesMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 8f73bf4139..fe2f7eb941 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -957,12 +957,13 @@ end subroutine TransferBCIn_2d ! ====================================================================================== - subroutine TransferBCOut_1d(this, tag, data) + subroutine TransferBCOut_1d(this, tag, data, dtime) class(ed_site_type), intent(inout) :: this - character(len=*), intent(in) :: tag ! HLM-FATES common vocab string + character(len=*), intent(in) :: tag ! HLM-FATES common vocab string real(r8), pointer, intent(inout) :: data(:) ! data pointer associated with tag + real(r8), intent(in) :: dtime ! HLM timestep size in seconds type(fates_patch_type), pointer :: currentPatch From 370ef5efff886b03ce5f31b889ac0ffbfaa039ee Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 22 Aug 2025 10:54:15 -0700 Subject: [PATCH 031/331] move litter pointer assignment inside element loop --- biogeochem/FatesSoilBGCFluxMod.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index d4ba9e89fe..1c0cb9954b 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -702,14 +702,16 @@ subroutine FluxIntoLitterPools(csite, bc_in) currentPatch => csite%oldest_patch fluxpatchloop: do while (associated(currentPatch)) - ! Set a pointer to the litter object - ! for the current element on the current - ! patch - litt => currentPatch%litter(el) - bc_out => currentPatch%bc_out + ! Set a pointer to the output boundary condition for the current patch + bc_out => currentPatch%bc_out ! Loop over the different elements. elemloop: do el = 1, num_elements + + ! Set a pointer to the litter object + ! for the current element on the current + ! patch + litt => currentPatch%litter(el) ! Zero out the boundary flux arrays ! Make a pointer to the cellulose, labile and lignin From a4cfdafd67ded675ea4274bece761cb8ab781970 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sat, 23 Aug 2025 14:32:05 -0700 Subject: [PATCH 032/331] add litter fluxes bcs to the patch type along with the decomposition level --- biogeochem/FatesPatchMod.F90 | 6 +++++ main/EDTypesMod.F90 | 44 ++++++++++++++++++++++++++++++++++-- 2 files changed, 48 insertions(+), 2 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index b4213505d6..f82ffc98b3 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -306,6 +306,10 @@ subroutine Init(this, num_swb, num_levsoil) allocate(this%bc_in%w_scalar_sisl(num_levsoil)) allocate(this%bc_in%t_scalar_sisl(num_levsoil)) + allocate(this%bc_out%litt_flux_cel_c_si(this%bc_in%nlevdecomp)) + allocate(this%bc_out%litt_flux_lig_c_si(this%bc_in%nlevdecomp)) + allocate(this%bc_out%litt_flux_lab_c_si(this%bc_in%nlevdecomp)) + ! initialize all values to nan call this%NanValues() @@ -547,6 +551,7 @@ subroutine NanValues(this) ! Boundary conditions this%bc_in%w_scalar_sisl(:) = nan this%bc_in%t_scalar_sisl(:) = nan + this%bc_in%nlevdecomp = nan end subroutine NanValues @@ -639,6 +644,7 @@ subroutine ZeroValues(this) ! Boundary conditions this%bc_in%w_scalar_sisl(:) = 0.0_r8 this%bc_in%t_scalar_sisl(:) = 0.0_r8 + this%bc_in%nlevdecomp = 0.0_r8 end subroutine ZeroValues diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index fe2f7eb941..c3ec7c3e5b 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -609,9 +609,10 @@ module EDTypesMod procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction + procedure, private :: TransferBCIn_0d procedure, private :: TransferBCIn_1d procedure, private :: TransferBCIn_2d - generic, public :: TransferBCIn => TransferBCIn_1d, TransferBCIn_2d + generic, public :: TransferBCIn => TransferBCIn_0d, TransferBCIn_1d, TransferBCIn_2d procedure, private :: TransferBCOut_1d procedure, private :: TransferBCOut_2d @@ -876,6 +877,46 @@ function get_secondary_young_fraction(this) result(secondary_young_fraction) end function get_secondary_young_fraction + ! ====================================================================================== + + subroutine TransferBCIn_0D(this, tag, data) + + class(ed_site_type), intent(inout) :: this + character(len=*), intent(in) :: tag + real(r8), pointer, intent(in) :: data + + type(fates_patch_type), pointer :: currentPatch + + ! LOCAL + integer :: p ! patch index + + currentPatch => this%oldest_patch + + do while (associated(currentPatch)) + + p = this%patch_map(currentPatch%patchno) + + select case(trim(tag)) + + case('nlevdecomp') + currentPatch%bc_in%nlevdecomp = data + + ! NOTE: should the patch level bc subtypes actually be pointers to the + ! input values instead of copies of the pointer data? Or is not a good idea + ! since the HLM runs on a different time step than fates? + ! If these are not pointers then we really don't have a good way to avoid + ! memory duplicity. + + end select + + currentPatch => currentPatch%younger + + end do + + end subroutine TransferBCIn_0d + + ! ====================================================================================== + ! ====================================================================================== subroutine TransferBCIn_1d(this, tag, data) @@ -899,7 +940,6 @@ subroutine TransferBCIn_1d(this, tag, data) case('leaf_area_index') currentPatch%bc_in%hlm_sp_tlai = data(p) - ! currentPatch%bc_in%w_scalar_sisl => transfer_array(ifp,:) ! NOTE: should the patch level bc subtypes actually be pointers to the ! input values instead of copies of the pointer data? Or is not a good idea From 00319b0c9713f30c21b04e8fb03774c6d51a5624 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sat, 23 Aug 2025 14:40:37 -0700 Subject: [PATCH 033/331] correct unset value for nlevdecomp --- biogeochem/FatesPatchMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index f82ffc98b3..8f561def0d 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -551,7 +551,7 @@ subroutine NanValues(this) ! Boundary conditions this%bc_in%w_scalar_sisl(:) = nan this%bc_in%t_scalar_sisl(:) = nan - this%bc_in%nlevdecomp = nan + this%bc_in%nlevdecomp = fates_unset_int end subroutine NanValues From 25f8ac2fbc8fec3335da163a22b9f665a15b8edd Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sat, 23 Aug 2025 14:53:00 -0700 Subject: [PATCH 034/331] make the scalar bcin transfer subroutine generic to integers --- main/EDTypesMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index c3ec7c3e5b..1b88162ea4 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -609,10 +609,10 @@ module EDTypesMod procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction - procedure, private :: TransferBCIn_0d + procedure, private :: TransferBCIn_0d_int procedure, private :: TransferBCIn_1d procedure, private :: TransferBCIn_2d - generic, public :: TransferBCIn => TransferBCIn_0d, TransferBCIn_1d, TransferBCIn_2d + generic, public :: TransferBCIn => TransferBCIn_0d_int, TransferBCIn_1d, TransferBCIn_2d procedure, private :: TransferBCOut_1d procedure, private :: TransferBCOut_2d @@ -879,11 +879,11 @@ end function get_secondary_young_fraction ! ====================================================================================== - subroutine TransferBCIn_0D(this, tag, data) + subroutine TransferBCIn_0D_int(this, tag, data) class(ed_site_type), intent(inout) :: this character(len=*), intent(in) :: tag - real(r8), pointer, intent(in) :: data + integer, pointer, intent(in) :: data type(fates_patch_type), pointer :: currentPatch @@ -913,7 +913,7 @@ subroutine TransferBCIn_0D(this, tag, data) end do - end subroutine TransferBCIn_0d + end subroutine TransferBCIn_0d_int ! ====================================================================================== From d26a81e597035721656db1b68a257622c1a67428 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 26 Aug 2025 15:13:14 -0700 Subject: [PATCH 035/331] start adding an interface variable type inspired by the history interface indexing --- main/FatesInterfaceMod.F90 | 5 +++ main/FatesInterfaceVarTypeMod.F90 | 60 +++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+) create mode 100644 main/FatesInterfaceVarTypeMod.F90 diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 147829938a..fca456a35e 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -114,6 +114,8 @@ module FatesInterfaceMod use FatesTwoStreamUtilsMod, only : TransferRadParams use LeafBiophysicsMod , only : lb_params use LeafBiophysicsMod , only : FvCB1980 + use FatesInterfaceVariableTypeMod, only : fates_interface_variable_type + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -160,6 +162,9 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst + ! This is the + type(fates_interface_variable_type) :: api_vars + end type fates_interface_type diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 new file mode 100644 index 0000000000..38489a131a --- /dev/null +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -0,0 +1,60 @@ +module FatesInterfaceVariableTypeMod + + ! This module contains the type definition and associated type-bound procedures + ! used to create an indexed list of associated HLM and FATES variables that are + ! related across the application programming interface. + ! This method is largely inspired by the FATES history infrastructure + + use FatesGlobals, only : fates_log + use FatesGlobals, only : endrun => fates_endrun + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : fates_long_string_length + + implicit none + private + + + type, public :: fates_interface_variable_type + + character(len=48) :: variable_name ! variable common reference name + character(len=fates_long_string_length) :: description ! variable description + + logical :: active = .false. ! true if the variable is used by the host land model + integer :: update_frequency ! this should facilitate a check that the update is being called in the correct subroutine + + ! pointers to data (only one of these to be allocated per variable) + ! TODO: make this polymorphic? + integer, pointer :: intscalar + integer, pointer :: int1d(:) + integer, pointer :: int2d(:,:) + integer, pointer :: int3d(:,:,:) + real(r8), pointer :: r8scalar + real(r8), pointer :: r81d(:) + real(r8), pointer :: r82d(:,:) + real(r8), pointer :: r83d(:,:,:) + + contains + procedure :: InitializeInterfaceVariables => Init + end type fates_interface_variable_type + + contains + + subroutine InitializeInterfaceVariables(this, variable_name, description, active, & + update_frequency) + + class(fates_interface_variable_type) :: this + + character(len=*), intent(in) :: variable_name + character(len=*), intent(in) :: description + logical, intent(in) :: active + integer, intent(in) :: update_frequency + + this%variable_name = variable_name + this%description = description + this%active = active + this%update_frequency = update_frequency + + end subroutine InitializeInterfaceVariables + +end module FatesInterfaceVariableTypeMod \ No newline at end of file From 26c4ba1bd481d1d105d48e12df62110b6c54a151 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 27 Aug 2025 16:49:52 -0700 Subject: [PATCH 036/331] add registry and initialization procedures to the interface variable type --- main/FatesInterfaceVarTypeMod.F90 | 53 +++++++++++++++++++++---------- 1 file changed, 37 insertions(+), 16 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 38489a131a..1211acc396 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -35,26 +35,47 @@ module FatesInterfaceVariableTypeMod real(r8), pointer :: r83d(:,:,:) contains - procedure :: InitializeInterfaceVariables => Init + procedure :: InitializeInterfaceVariable => Init + procedure :: Register => RegisterInterfaceVariable_int_scalar + end type fates_interface_variable_type contains - subroutine InitializeInterfaceVariables(this, variable_name, description, active, & - update_frequency) - - class(fates_interface_variable_type) :: this - - character(len=*), intent(in) :: variable_name - character(len=*), intent(in) :: description - logical, intent(in) :: active - integer, intent(in) :: update_frequency - - this%variable_name = variable_name - this%description = description - this%active = active - this%update_frequency = update_frequency + ! ==================================================================================== + + subroutine InitializeInterfaceVariable(this, variable_name) + + class(fates_interface_variable_type) :: this + + character(len=*), intent(in) :: variable_name + + nullify(this%iscalar) + nullify(this%int1d) + nullify(this%int2d) + nullify(this%int3d) + nullify(this%rscalar) + nullify(this%r81d) + nullify(this%r82d) + nullify(this%r83d) + + this%variable_name = variable_name + this%active = .false. + + end subroutine InitializeInterfaceVariable + + ! ==================================================================================== - end subroutine InitializeInterfaceVariables + subroutine RegisterInterfaceVariable(this, data, active) + + class(fates_interface_variable_type) :: this + + class(*), pointer, intent(in) :: data + logical, intent(in) :: active + + this%data => data + this%active = active + + end subroutine RegisterInterfaceVariable end module FatesInterfaceVariableTypeMod \ No newline at end of file From 2ff13e455a6c96c0d63135b7211aa8d3377b5238 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 27 Aug 2025 16:50:12 -0700 Subject: [PATCH 037/331] simplify the interface variable type for now --- main/FatesInterfaceVarTypeMod.F90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 1211acc396..6b2c67034d 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -13,23 +13,19 @@ module FatesInterfaceVariableTypeMod implicit none private - + ! Interface variable registry type type, public :: fates_interface_variable_type - character(len=48) :: variable_name ! variable common reference name - character(len=fates_long_string_length) :: description ! variable description - - logical :: active = .false. ! true if the variable is used by the host land model - integer :: update_frequency ! this should facilitate a check that the update is being called in the correct subroutine + character(len=48) :: variable_name ! variable common reference name + logical :: active ! true if the variable is used by the host land model ! pointers to data (only one of these to be allocated per variable) - ! TODO: make this polymorphic? - integer, pointer :: intscalar + integer, pointer :: iscalar integer, pointer :: int1d(:) integer, pointer :: int2d(:,:) integer, pointer :: int3d(:,:,:) - real(r8), pointer :: r8scalar + real(r8), pointer :: rscalar real(r8), pointer :: r81d(:) real(r8), pointer :: r82d(:,:) real(r8), pointer :: r83d(:,:,:) From d84c91777b2c0e8f76a86664ff0154fdabbd71e0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 27 Aug 2025 16:54:52 -0700 Subject: [PATCH 038/331] Add procedure call chain to define the registry variable keys --- main/FatesInterfaceMod.F90 | 85 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 82 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index fca456a35e..dbe7844ac7 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -162,9 +162,18 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst - ! This is the - type(fates_interface_variable_type) :: api_vars + ! This is the interface registry which associates variables with a common keyword + type(fates_interface_variable_type) :: api_vars(:) + + ! The number of variables in the registry + integer :: num_api_vars + + contains + procedure :: InitializeInterfaceRegistry + + procedure, private :: DefineInterfaceRegistry + procedure, private :: SetInterfaceVariable end type fates_interface_type @@ -2703,7 +2712,77 @@ subroutine FatesReadParameters(param_reader) call fates_params%Destroy() deallocate(fates_params) + +end subroutine FatesReadParameters + +! ====================================================================================== + +subroutine InitializeInterfaceRegistry(this) + + ! This initializes the interface registry + + class(fates_interface_type) :: this + + logical :: initialize + + ! First count up the keys defined in the registry + call this%DefineInterfaceRegistry(initialize=.false.) + + ! Allocate the registry + allocate(this%api_vars(this%num_hlm_vars)) + + ! Now set up the registry keys + call this%DefineInterfaceRegistry(initialize=.true.) + +end subroutine InitializeInterfaceRegistry - end subroutine FatesReadParameters +! ====================================================================================== + +subroutine DefineInterfaceRegistry(this, initialize) + + ! This procedure defines the list of common names to be associated with FATES and HLM + ! variables. + + class(fates_interface_type) :: this + + logical, intent(in) :: initialize ! false = count up the keys in the registry + + integer :: ivar ! indices + + ! Set ivar to zero. This will be incremented via each call to SetInterfaceVariable + ivar = 0 + + ! Define the interface registry names and indices + call this%DefineInterfaceVariable(variable_name='decomp_frac_moisture', index=ivar, initialize=initialize) + call this%DefineInterfaceVariable(variable_name='decomp_frac_temperature', index=ivar, initialize=initialize) + + ! Set the registry size based on the final update of ivar + this%num_api_vars = ivar + + +end subroutine DefineInterfaceRegistry + +! ====================================================================================== + +subroutine DefineInterfaceVariable(this, variable_name, index, initialize) + + ! This procedure + class(fates_interface_type) :: this + + character(len=*), intent(in) :: variable_name + integer, intent(inout) :: index + logical, intent(in) :: initialize + + ! Increment the index to return count + index = index + 1 + + ! If we are initializing the + if (initialize) then + call this%api_vars(index)%Init(variable_name) + end if + +end subroutine DefineInterfaceVariable + +! ====================================================================================== end module FatesInterfaceMod From 2d2e759aa120f6722dac7523a91b89baead60266 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 27 Aug 2025 16:55:25 -0700 Subject: [PATCH 039/331] add procedures to call in the host side that will call the initialization and registration --- main/FatesInterfaceMod.F90 | 40 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index dbe7844ac7..4986248926 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -171,9 +171,11 @@ module FatesInterfaceMod contains procedure :: InitializeInterfaceRegistry + procedure :: RegisterInterfaceVariables => Register procedure, private :: DefineInterfaceRegistry procedure, private :: SetInterfaceVariable + procedure, private :: GetRegistryIndex end type fates_interface_type @@ -2783,6 +2785,44 @@ subroutine DefineInterfaceVariable(this, variable_name, index, initialize) end subroutine DefineInterfaceVariable +! ====================================================================================== + + subroutine RegisterInterfaceVariables(this, vname, data) + + ! This procedure is called by the host land model to associate a data variable + ! with a particular registry key + + class(fates_interface_type) :: this + + character(len=*), intent(in) :: vname ! variable registry key + class(*), pointer, intent(in) :: data ! data to be associated with key + + this%api_vars(GetRegistryIndex(vname))%Register(data, active=.true.) + + end subroutine RegisterInterfaceVariables + +! ====================================================================================== + +integer function GetRegistryIndex(this, key) result(index) + + ! This procedure returns the index associated with the key provided + + class(fates_interface_type) :: this + + integer, intent(in) :: key + + integer :: ivar ! Iterator + + ! Iterate over the registry until the associated key is found + do ivar = 1, this%num_api_vars + if (this%api_vars(ivar)%variable_name == key) then + index = ivar + return + end if + end do + +end function GetRegistryIndex + ! ====================================================================================== end module FatesInterfaceMod From 5486b4d38a882f0a46eb0aade09ca332089db4e4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 28 Aug 2025 11:08:55 -0700 Subject: [PATCH 040/331] aligning argument names and comments to reflect registry key concept --- main/FatesInterfaceMod.F90 | 9 +++++---- main/FatesInterfaceVarTypeMod.F90 | 2 +- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 4986248926..a2bca433a6 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2787,17 +2787,18 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== - subroutine RegisterInterfaceVariables(this, vname, data) + subroutine RegisterInterfaceVariables(this, key, data) ! This procedure is called by the host land model to associate a data variable ! with a particular registry key class(fates_interface_type) :: this - character(len=*), intent(in) :: vname ! variable registry key - class(*), pointer, intent(in) :: data ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key + class(*), pointer, intent(in) :: data ! data to be associated with key - this%api_vars(GetRegistryIndex(vname))%Register(data, active=.true.) + ! Get index from registry key and associate the given data pointer + this%api_vars(GetRegistryIndex(key))%Register(data, active=.true.) end subroutine RegisterInterfaceVariables diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 6b2c67034d..c12c984f58 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -17,7 +17,7 @@ module FatesInterfaceVariableTypeMod ! Interface variable registry type type, public :: fates_interface_variable_type - character(len=48) :: variable_name ! variable common reference name + character(len=48) :: variable_name ! common registry key logical :: active ! true if the variable is used by the host land model ! pointers to data (only one of these to be allocated per variable) From d5e789fac0aa47cce535c0de1eff8e94f002418e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 29 Aug 2025 15:05:17 -0700 Subject: [PATCH 041/331] correct procedure pointer alias --- main/FatesInterfaceMod.F90 | 2 +- main/FatesInterfaceVarTypeMod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a2bca433a6..6ee08db606 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -171,7 +171,7 @@ module FatesInterfaceMod contains procedure :: InitializeInterfaceRegistry - procedure :: RegisterInterfaceVariables => Register + procedure :: Register => RegisterInterfaceVariables procedure, private :: DefineInterfaceRegistry procedure, private :: SetInterfaceVariable diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index c12c984f58..4232cece7b 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -31,7 +31,7 @@ module FatesInterfaceVariableTypeMod real(r8), pointer :: r83d(:,:,:) contains - procedure :: InitializeInterfaceVariable => Init + procedure :: Init => InitializeInterfaceVariable procedure :: Register => RegisterInterfaceVariable_int_scalar end type fates_interface_variable_type From b9f8503da543b201e49646e70d1d6390afb31be7 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 29 Aug 2025 15:15:48 -0700 Subject: [PATCH 042/331] correct regsiter procedure to set data as target --- main/FatesInterfaceMod.F90 | 4 ++-- main/FatesInterfaceVarTypeMod.F90 | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 6ee08db606..5db191a39c 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2794,8 +2794,8 @@ subroutine RegisterInterfaceVariables(this, key, data) class(fates_interface_type) :: this - character(len=*), intent(in) :: key ! variable registry key - class(*), pointer, intent(in) :: data ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key + class(*), target, intent(in) :: data ! data to be associated with key ! Get index from registry key and associate the given data pointer this%api_vars(GetRegistryIndex(key))%Register(data, active=.true.) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 4232cece7b..7d2cd0982b 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -18,6 +18,7 @@ module FatesInterfaceVariableTypeMod type, public :: fates_interface_variable_type character(len=48) :: variable_name ! common registry key + class(*), pointer :: data ! unlimited polymorphic data pointer logical :: active ! true if the variable is used by the host land model ! pointers to data (only one of these to be allocated per variable) @@ -66,8 +67,8 @@ subroutine RegisterInterfaceVariable(this, data, active) class(fates_interface_variable_type) :: this - class(*), pointer, intent(in) :: data - logical, intent(in) :: active + class(*), target, intent(in) :: data + logical, intent(in) :: active this%data => data this%active = active From acef35ed5e241a4b099877103b7f001ded5c3c03 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 29 Aug 2025 15:24:34 -0700 Subject: [PATCH 043/331] update interface variable type to remove old pointers --- main/FatesInterfaceVarTypeMod.F90 | 22 ++-------------------- 1 file changed, 2 insertions(+), 20 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 7d2cd0982b..6c571cd68d 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -20,17 +20,7 @@ module FatesInterfaceVariableTypeMod character(len=48) :: variable_name ! common registry key class(*), pointer :: data ! unlimited polymorphic data pointer logical :: active ! true if the variable is used by the host land model - - ! pointers to data (only one of these to be allocated per variable) - integer, pointer :: iscalar - integer, pointer :: int1d(:) - integer, pointer :: int2d(:,:) - integer, pointer :: int3d(:,:,:) - real(r8), pointer :: rscalar - real(r8), pointer :: r81d(:) - real(r8), pointer :: r82d(:,:) - real(r8), pointer :: r83d(:,:,:) - + contains procedure :: Init => InitializeInterfaceVariable procedure :: Register => RegisterInterfaceVariable_int_scalar @@ -47,15 +37,7 @@ subroutine InitializeInterfaceVariable(this, variable_name) character(len=*), intent(in) :: variable_name - nullify(this%iscalar) - nullify(this%int1d) - nullify(this%int2d) - nullify(this%int3d) - nullify(this%rscalar) - nullify(this%r81d) - nullify(this%r82d) - nullify(this%r83d) - + this%data => null() this%variable_name = variable_name this%active = .false. From b0cbd995160d78b5e72d1c4522713ed04eed7d01 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 29 Aug 2025 15:37:21 -0700 Subject: [PATCH 044/331] align registry procedures to use key instead of variable name --- main/FatesInterfaceMod.F90 | 10 +++++----- main/FatesInterfaceVarTypeMod.F90 | 12 +++++++----- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 5db191a39c..3d4c3a5fc5 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2755,8 +2755,8 @@ subroutine DefineInterfaceRegistry(this, initialize) ivar = 0 ! Define the interface registry names and indices - call this%DefineInterfaceVariable(variable_name='decomp_frac_moisture', index=ivar, initialize=initialize) - call this%DefineInterfaceVariable(variable_name='decomp_frac_temperature', index=ivar, initialize=initialize) + call this%DefineInterfaceVariable(key='decomp_frac_moisture', index=ivar, initialize=initialize) + call this%DefineInterfaceVariable(key='decomp_frac_temperature', index=ivar, initialize=initialize) ! Set the registry size based on the final update of ivar this%num_api_vars = ivar @@ -2766,12 +2766,12 @@ end subroutine DefineInterfaceRegistry ! ====================================================================================== -subroutine DefineInterfaceVariable(this, variable_name, index, initialize) +subroutine DefineInterfaceVariable(this, key, index, initialize) ! This procedure class(fates_interface_type) :: this - character(len=*), intent(in) :: variable_name + character(len=*), intent(in) :: key integer, intent(inout) :: index logical, intent(in) :: initialize @@ -2780,7 +2780,7 @@ subroutine DefineInterfaceVariable(this, variable_name, index, initialize) ! If we are initializing the if (initialize) then - call this%api_vars(index)%Init(variable_name) + call this%api_vars(index)%Init(key) end if end subroutine DefineInterfaceVariable diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 6c571cd68d..f834747d95 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -22,8 +22,8 @@ module FatesInterfaceVariableTypeMod logical :: active ! true if the variable is used by the host land model contains - procedure :: Init => InitializeInterfaceVariable - procedure :: Register => RegisterInterfaceVariable_int_scalar + procedure :: Initialize => InitializeInterfaceVariable + procedure :: Register => RegisterInterfaceVariable end type fates_interface_variable_type @@ -31,14 +31,14 @@ module FatesInterfaceVariableTypeMod ! ==================================================================================== - subroutine InitializeInterfaceVariable(this, variable_name) + subroutine InitializeInterfaceVariable(this, key) class(fates_interface_variable_type) :: this - character(len=*), intent(in) :: variable_name + character(len=*), intent(in) :: key this%data => null() - this%variable_name = variable_name + this%key = key this%active = .false. end subroutine InitializeInterfaceVariable @@ -57,4 +57,6 @@ subroutine RegisterInterfaceVariable(this, data, active) end subroutine RegisterInterfaceVariable + ! ==================================================================================== + end module FatesInterfaceVariableTypeMod \ No newline at end of file From 97050fcd1cc43cfe74271f471650fff5a9ad4cd2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 29 Aug 2025 15:44:51 -0700 Subject: [PATCH 045/331] update interface var type with key name --- main/FatesInterfaceVarTypeMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index f834747d95..51b6717811 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -17,9 +17,9 @@ module FatesInterfaceVariableTypeMod ! Interface variable registry type type, public :: fates_interface_variable_type - character(len=48) :: variable_name ! common registry key - class(*), pointer :: data ! unlimited polymorphic data pointer - logical :: active ! true if the variable is used by the host land model + character(len=48) :: key ! common registry key + class(*), pointer :: data ! unlimited polymorphic data pointer + logical :: active ! true if the variable is used by the host land model contains procedure :: Initialize => InitializeInterfaceVariable From f10088880e6032e1a65d14ae304232c9bad52adb Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 29 Aug 2025 16:18:09 -0700 Subject: [PATCH 046/331] build error corrections for the registry --- main/FatesInterfaceMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 3d4c3a5fc5..d5352e450d 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -163,8 +163,8 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - type(fates_interface_variable_type) :: api_vars(:) - + type(fates_interface_variable_type), allocatable :: api_vars(:) + ! The number of variables in the registry integer :: num_api_vars @@ -174,7 +174,7 @@ module FatesInterfaceMod procedure :: Register => RegisterInterfaceVariables procedure, private :: DefineInterfaceRegistry - procedure, private :: SetInterfaceVariable + procedure, private :: DefineInterfaceVariable procedure, private :: GetRegistryIndex end type fates_interface_type @@ -2731,7 +2731,7 @@ subroutine InitializeInterfaceRegistry(this) call this%DefineInterfaceRegistry(initialize=.false.) ! Allocate the registry - allocate(this%api_vars(this%num_hlm_vars)) + allocate(this%api_vars(this%num_api_vars)) ! Now set up the registry keys call this%DefineInterfaceRegistry(initialize=.true.) @@ -2780,7 +2780,7 @@ subroutine DefineInterfaceVariable(this, key, index, initialize) ! If we are initializing the if (initialize) then - call this%api_vars(index)%Init(key) + call this%api_vars(index)%Initialize(key) end if end subroutine DefineInterfaceVariable @@ -2798,7 +2798,7 @@ subroutine RegisterInterfaceVariables(this, key, data) class(*), target, intent(in) :: data ! data to be associated with key ! Get index from registry key and associate the given data pointer - this%api_vars(GetRegistryIndex(key))%Register(data, active=.true.) + call this%api_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) end subroutine RegisterInterfaceVariables @@ -2810,13 +2810,13 @@ integer function GetRegistryIndex(this, key) result(index) class(fates_interface_type) :: this - integer, intent(in) :: key + character(len=*), intent(in) :: key ! variable registry key to search integer :: ivar ! Iterator ! Iterate over the registry until the associated key is found do ivar = 1, this%num_api_vars - if (this%api_vars(ivar)%variable_name == key) then + if (this%api_vars(ivar)%key == key) then index = ivar return end if From af1521894d9fe00f0d55ecd4d58ddf7befdec07e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Sep 2025 12:35:58 -0700 Subject: [PATCH 047/331] Make 2d registration subroutine --- main/FatesInterfaceMod.F90 | 10 +++++----- main/FatesInterfaceVarTypeMod.F90 | 13 ++++++++----- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index d5352e450d..0695ce6031 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -171,7 +171,7 @@ module FatesInterfaceMod contains procedure :: InitializeInterfaceRegistry - procedure :: Register => RegisterInterfaceVariables + procedure :: Register => RegisterInterfaceVariables_2d procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable @@ -2787,20 +2787,20 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== - subroutine RegisterInterfaceVariables(this, key, data) + subroutine RegisterInterfaceVariables_2d(this, key, data) ! This procedure is called by the host land model to associate a data variable ! with a particular registry key class(fates_interface_type) :: this - character(len=*), intent(in) :: key ! variable registry key - class(*), target, intent(in) :: data ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key + class(*), target, intent(in) :: data(:,:) ! data to be associated with key ! Get index from registry key and associate the given data pointer call this%api_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) - end subroutine RegisterInterfaceVariables + end subroutine RegisterInterfaceVariables_2d ! ====================================================================================== diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 51b6717811..26942da4ce 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -18,12 +18,12 @@ module FatesInterfaceVariableTypeMod type, public :: fates_interface_variable_type character(len=48) :: key ! common registry key - class(*), pointer :: data ! unlimited polymorphic data pointer + class(*), pointer :: data(:,:) ! unlimited polymorphic data pointer logical :: active ! true if the variable is used by the host land model contains procedure :: Initialize => InitializeInterfaceVariable - procedure :: Register => RegisterInterfaceVariable + procedure :: Register => RegisterInterfaceVariable_2d end type fates_interface_variable_type @@ -45,17 +45,20 @@ end subroutine InitializeInterfaceVariable ! ==================================================================================== - subroutine RegisterInterfaceVariable(this, data, active) + subroutine RegisterInterfaceVariable_2d(this, data, active) class(fates_interface_variable_type) :: this - class(*), target, intent(in) :: data + class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active + ! TODO: add type check here to validate acceptable types? + this%data => data + ! allocate(this%data, source=data) this%active = active - end subroutine RegisterInterfaceVariable + end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== From ff881f017bbcd7e288ba1755a557299165e016f2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Sep 2025 14:29:43 -0700 Subject: [PATCH 048/331] Revert "remove area fraction from flux into litter pools now that subroutine does not sum to the site level" This reverts commit 11a697791d59a2e18a50b7b15683a1e931563844. --- biogeochem/FatesSoilBGCFluxMod.F90 | 39 ++++++++++++++++-------------- 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 1c0cb9954b..5e5efcdac0 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -644,6 +644,7 @@ subroutine FluxIntoLitterPools(csite, bc_in) real(r8) :: surface_prof_tot ! normalizes the surface_prof array integer :: nlev_eff_soil ! number of effective soil layers integer :: nlev_eff_decomp ! number of effective decomp layers + real(r8) :: area_frac ! fraction of site's area of current patch real(r8) :: z_decomp ! Used for calculating depth midpoints of decomp layers integer :: el ! Element index (C,N,P,etc) integer :: j ! Soil layer index @@ -705,6 +706,8 @@ subroutine FluxIntoLitterPools(csite, bc_in) ! Set a pointer to the output boundary condition for the current patch bc_out => currentPatch%bc_out + area_frac = currentPatch%area/area + ! Loop over the different elements. elemloop: do el = 1, num_elements @@ -744,33 +747,33 @@ subroutine FluxIntoLitterPools(csite, bc_in) do ic = 1, ncwd do id = 1,nlev_eff_decomp flux_cel_si(id) = flux_cel_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * surface_prof(id) + litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_flig * surface_prof(id) + litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id) end do do j = 1, nlev_eff_soil id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel + litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel * area_frac flux_lig_si(id) = flux_lig_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig + litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig * area_frac end do end do ! leaf and fine root fragmentation fluxes do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & - litt%leaf_fines_frag(ilabile) * surface_prof(id) + litt%leaf_fines_frag(ilabile) * area_frac* surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & - litt%leaf_fines_frag(icellulose) * surface_prof(id) + litt%leaf_fines_frag(icellulose) * area_frac* surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%leaf_fines_frag(ilignin) * surface_prof(id) + litt%leaf_fines_frag(ilignin) * area_frac* surface_prof(id) end do ! decaying seeds from the litter pool @@ -778,26 +781,26 @@ subroutine FluxIntoLitterPools(csite, bc_in) do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flab(ipft) * surface_prof(id) + EDPftvarcon_inst%lf_flab(ipft) * area_frac* surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_fcel(ipft) * surface_prof(id) + EDPftvarcon_inst%lf_fcel(ipft) * area_frac* surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flig(ipft) * surface_prof(id) + EDPftvarcon_inst%lf_flig(ipft) * area_frac* surface_prof(id) end do end do do j = 1, nlev_eff_soil id = bc_in%decomp_id(j) flux_lab_si(id) = flux_lab_si(id) + & - litt%root_fines_frag(ilabile,j) + litt%root_fines_frag(ilabile,j) * area_frac flux_cel_si(id) = flux_cel_si(id) + & - litt%root_fines_frag(icellulose,j) + litt%root_fines_frag(icellulose,j) * area_frac flux_lig_si(id) = flux_lig_si(id) + & - litt%root_fines_frag(ilignin,j) + litt%root_fines_frag(ilignin,j) * area_frac enddo ! Normalize all masses over the decomposition layer's depth @@ -868,17 +871,17 @@ subroutine FluxIntoLitterPools(csite, bc_in) end do if(tot_wood_c>nearzero) then - sum_N = sum_N + sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) - sum_N = sum_N + sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) end if if(tot_leaf_c>nearzero)then - sum_N = sum_N + sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) + sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) end if if(tot_fnrt_c>nearzero)then - sum_N = sum_N + sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) + sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) end if do ipft = 1,numpft - sum_N = sum_N + currentPatch%nitr_repro_stoich(ipft) * & + sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) end do From 7da4b03631344cab9111544a9d1da5c2c2209faf Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Sep 2025 14:33:07 -0700 Subject: [PATCH 049/331] Revert "move litter pointer assignment inside element loop" This reverts commit 16152e1e705f17c029ef4cf3fe123bdeebc1d0eb. --- biogeochem/FatesSoilBGCFluxMod.F90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 5e5efcdac0..3c4836f913 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -703,18 +703,16 @@ subroutine FluxIntoLitterPools(csite, bc_in) currentPatch => csite%oldest_patch fluxpatchloop: do while (associated(currentPatch)) - ! Set a pointer to the output boundary condition for the current patch - bc_out => currentPatch%bc_out + ! Set a pointer to the litter object + ! for the current element on the current + ! patch + litt => currentPatch%litter(el) + bc_out => currentPatch%bc_out area_frac = currentPatch%area/area ! Loop over the different elements. elemloop: do el = 1, num_elements - - ! Set a pointer to the litter object - ! for the current element on the current - ! patch - litt => currentPatch%litter(el) ! Zero out the boundary flux arrays ! Make a pointer to the cellulose, labile and lignin From cffdd594cc92f4b663b35ebdfb1594ed6e154492 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Sep 2025 14:37:08 -0700 Subject: [PATCH 050/331] Revert "whitespace clean up" This reverts commit 8f3192c5b66b0f75deedb97d0236cf4638543484. --- biogeochem/FatesSoilBGCFluxMod.F90 | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 3c4836f913..67990b2bc8 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -743,15 +743,18 @@ subroutine FluxIntoLitterPools(csite, bc_in) end select do ic = 1, ncwd + do id = 1,nlev_eff_decomp flux_cel_si(id) = flux_cel_si(id) + & litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id) + end do do j = 1, nlev_eff_soil + id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & @@ -759,11 +762,13 @@ subroutine FluxIntoLitterPools(csite, bc_in) flux_lig_si(id) = flux_lig_si(id) + & litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig * area_frac + end do end do ! leaf and fine root fragmentation fluxes do id = 1,nlev_eff_decomp + flux_lab_si(id) = flux_lab_si(id) + & litt%leaf_fines_frag(ilabile) * area_frac* surface_prof(id) @@ -772,8 +777,10 @@ subroutine FluxIntoLitterPools(csite, bc_in) flux_lig_si(id) = flux_lig_si(id) + & litt%leaf_fines_frag(ilignin) * area_frac* surface_prof(id) + end do + ! decaying seeds from the litter pool do ipft = 1,numpft do id = 1,nlev_eff_decomp @@ -823,6 +830,7 @@ subroutine FluxIntoLitterPools(csite, bc_in) if(trim(hlm_decomp).eq.'MIMICS') then + ! If we track nitrogen (ie cnp or other) then ! we diagnose the c-lig/n ratio directly from the pools if(element_pos(nitrogen_element)>0) then @@ -841,6 +849,7 @@ subroutine FluxIntoLitterPools(csite, bc_in) sum_N = 0._r8 + tot_leaf_c = 0._r8 tot_leaf_n = 0._r8 tot_fnrt_c = 0._r8 @@ -902,6 +911,10 @@ subroutine FluxIntoLitterPools(csite, bc_in) currentPatch => currentPatch%younger end do fluxpatchloop + + + + return end subroutine FluxIntoLitterPools From bc3e44b476cc356e02340426266300e2226ef1fa Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Sep 2025 14:37:23 -0700 Subject: [PATCH 051/331] Revert "Update the mimics portion of the fluxintolitterpools code to be within the previous patch loop structure" This reverts commit d2184ee71a15148c506339662a358a8005cb1a02. --- biogeochem/FatesSoilBGCFluxMod.F90 | 166 +++++++++++++++-------------- 1 file changed, 86 insertions(+), 80 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 67990b2bc8..98b69abc36 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -586,7 +586,7 @@ end subroutine EffluxIntoLitterPools ! ===================================================================================== - subroutine FluxIntoLitterPools(csite, bc_in) + subroutine FluxIntoLitterPools(csite, bc_in, bc_out) ! ----------------------------------------------------------------------------------- ! Created by Charlie Koven and Rosie Fisher, 2014-2015 @@ -822,96 +822,102 @@ subroutine FluxIntoLitterPools(csite, bc_in) end do elemloop - ! If we are coupled with MIMICS, then we need some assessment of litter quality - ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) - ! then we need to approximate this by estimating the mean C:N ratios of each - ! plant organ, and mulitplying that by the different C Fluxes to get a total - ! approximate N flux. Note, in C-only, we will not capture any re-absorption. - - if(trim(hlm_decomp).eq.'MIMICS') then - + currentPatch => currentPatch%younger - ! If we track nitrogen (ie cnp or other) then - ! we diagnose the c-lig/n ratio directly from the pools - if(element_pos(nitrogen_element)>0) then + end do fluxpatchloop - ! Sum totalN fluxes over depth [g/m2] - sum_N = sum((bc_out%litt_flux_cel_n_si(1:nlev_eff_soil) + & - bc_out%litt_flux_lig_n_si(1:nlev_eff_soil) + & - bc_out%litt_flux_lab_n_si(1:nlev_eff_soil)) * & - bc_in%dz_sisl(1:nlev_eff_soil)) - - else - - ! In this case (Carbon Only), we use the stoichiometry parameters to estimate - ! the C:N of live vegetation and the seedbank, and use that - ! as a proxy for the C:N of the litter flux + ! If we are coupled with MIMICS, then we need some assessment of litter quality + ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) + ! then we need to approximate this by estimating the mean C:N ratios of each + ! plant organ, and mulitplying that by the different C Fluxes to get a total + ! approximate N flux. Note, in C-only, we will not capture any re-absorption. + + if(trim(hlm_decomp).eq.'MIMICS') then - sum_N = 0._r8 - + ! If we track nitrogen (ie cnp or other) then + ! we diagnose the c-lig/n ratio directly from the pools + if(element_pos(nitrogen_element)>0) then - tot_leaf_c = 0._r8 - tot_leaf_n = 0._r8 - tot_fnrt_c = 0._r8 - tot_fnrt_n = 0._r8 - tot_wood_c = 0._r8 - tot_wood_n = 0._r8 - - ccohort => currentPatch%tallest - do while (associated(ccohort)) - ipft = ccohort%pft - leaf_c = ccohort%n * area_inv * ccohort%prt%GetState(leaf_organ, carbon12_element) - sapw_c = ccohort%n * area_inv * ccohort%prt%GetState(sapw_organ, carbon12_element) - fnrt_c = ccohort%n * area_inv * ccohort%prt%GetState(fnrt_organ, carbon12_element) - struct_c = ccohort%n * area_inv * ccohort%prt%GetState(struct_organ, carbon12_element) - leaf_n = leaf_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) - sapw_n = sapw_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) - fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) - struct_n = struct_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) - tot_leaf_c = tot_leaf_c + leaf_c - tot_leaf_n = tot_leaf_n + leaf_n - tot_fnrt_c = tot_fnrt_c + fnrt_c - tot_fnrt_n = tot_fnrt_n + fnrt_n - tot_wood_c = tot_wood_c + sapw_c + struct_c - tot_wood_n = tot_wood_n + sapw_n + struct_n - ccohort => ccohort%shorter - end do - - if(tot_wood_c>nearzero) then - sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) - sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) - end if - if(tot_leaf_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) - end if - if(tot_fnrt_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) - end if - do ipft = 1,numpft - sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & - (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) - end do + ! Sum totalN fluxes over depth [g/m2] + sum_N = sum((bc_out%litt_flux_cel_n_si(1:nlev_eff_soil) + & + bc_out%litt_flux_lig_n_si(1:nlev_eff_soil) + & + bc_out%litt_flux_lab_n_si(1:nlev_eff_soil)) * & + bc_in%dz_sisl(1:nlev_eff_soil)) + + else + + ! In this case (Carbon Only), we use the stoichiometry parameters to estimate + ! the C:N of live vegetation and the seedbank, and use that + ! as a proxy for the C:N of the litter flux - ! Convert from kg/m2/day -> g/m2/s - sum_N = sum_N * days_per_sec * g_per_kg + sum_N = 0._r8 + + currentPatch => csite%oldest_patch + do while (associated(currentPatch)) - end if + litt => currentPatch%litter(element_pos(carbon12_element)) + area_frac = currentPatch%area*area_inv - ! Sum over layers and multiply by depth g/m3/s * m -> g/m2/s - sum_ligC = sum(bc_out%litt_flux_lig_c_si(1:nlev_eff_soil) * bc_in%dz_sisl(1:nlev_eff_soil)) - - if(sum_N>nearzero)then - bc_out%litt_flux_ligc_per_n = sum_ligC / sum_N - else - bc_out%litt_flux_ligc_per_n = 0._r8 - end if + tot_leaf_c = 0._r8 + tot_leaf_n = 0._r8 + tot_fnrt_c = 0._r8 + tot_fnrt_n = 0._r8 + tot_wood_c = 0._r8 + tot_wood_n = 0._r8 - end if ! MIMICS check + ccohort => currentPatch%tallest + do while (associated(ccohort)) + ipft = ccohort%pft + leaf_c = ccohort%n * area_inv * ccohort%prt%GetState(leaf_organ, carbon12_element) + sapw_c = ccohort%n * area_inv * ccohort%prt%GetState(sapw_organ, carbon12_element) + fnrt_c = ccohort%n * area_inv * ccohort%prt%GetState(fnrt_organ, carbon12_element) + struct_c = ccohort%n * area_inv * ccohort%prt%GetState(struct_organ, carbon12_element) + leaf_n = leaf_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + sapw_n = sapw_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + struct_n = struct_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + tot_leaf_c = tot_leaf_c + leaf_c + tot_leaf_n = tot_leaf_n + leaf_n + tot_fnrt_c = tot_fnrt_c + fnrt_c + tot_fnrt_n = tot_fnrt_n + fnrt_n + tot_wood_c = tot_wood_c + sapw_c + struct_c + tot_wood_n = tot_wood_n + sapw_n + struct_n + ccohort => ccohort%shorter + end do - currentPatch => currentPatch%younger + if(tot_wood_c>nearzero) then + sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) + end if + if(tot_leaf_c>nearzero)then + sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) + end if + if(tot_fnrt_c>nearzero)then + sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) + end if + do ipft = 1,numpft + sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & + (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) + end do - end do fluxpatchloop + currentPatch => currentPatch%younger + end do + + ! Convert from kg/m2/day -> g/m2/s + sum_N = sum_N * days_per_sec * g_per_kg + + end if + ! Sum over layers and multiply by depth g/m3/s * m -> g/m2/s + sum_ligC = sum(bc_out%litt_flux_lig_c_si(1:nlev_eff_soil) * bc_in%dz_sisl(1:nlev_eff_soil)) + + if(sum_N>nearzero)then + bc_out%litt_flux_ligc_per_n = sum_ligC / sum_N + else + bc_out%litt_flux_ligc_per_n = 0._r8 + end if + + end if From ee6f38d006a3e47bce0f1cff2065b7c8b7dfef3e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Sep 2025 14:37:41 -0700 Subject: [PATCH 052/331] Revert "Update fluxintolitterpool non-mimics section to use the patch-level bc_out litter variables." This reverts commit aa269da3ec1d68fe1e159b2529872d9d29344f23. --- biogeochem/FatesSoilBGCFluxMod.F90 | 109 +++++++++++++++-------------- 1 file changed, 55 insertions(+), 54 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 98b69abc36..e0af2a9e0f 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -627,6 +627,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) ! !ARGUMENTS type(ed_site_type) , intent(inout) :: csite type(bc_in_type) , intent(in) :: bc_in + type(bc_out_type) , intent(inout),target :: bc_out ! !LOCAL VARIABLES: type (fates_patch_type), pointer :: currentPatch @@ -635,7 +636,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) real(r8), pointer :: flux_lab_si(:) real(r8), pointer :: flux_lig_si(:) type(litter_type), pointer :: litt - type(bc_out_type), pointer :: bc_out real(r8) :: surface_prof(bc_in%nlevsoil) ! this array is used to distribute ! fragmented litter on the surface @@ -700,48 +700,46 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) surface_prof(id) = surface_prof(id)/surface_prof_tot end do - currentPatch => csite%oldest_patch - fluxpatchloop: do while (associated(currentPatch)) + ! Loop over the different elements. + do el = 1, num_elements + + ! Zero out the boundary flux arrays + ! Make a pointer to the cellulose, labile and lignin + ! flux partitions. + + select case (element_list(el)) + case (carbon12_element) + bc_out%litt_flux_cel_c_si(:) = 0.0_r8 + bc_out%litt_flux_lig_c_si(:) = 0.0_r8 + bc_out%litt_flux_lab_c_si(:) = 0.0_r8 + flux_cel_si => bc_out%litt_flux_cel_c_si(:) + flux_lab_si => bc_out%litt_flux_lab_c_si(:) + flux_lig_si => bc_out%litt_flux_lig_c_si(:) + case (nitrogen_element) + bc_out%litt_flux_cel_n_si(:) = 0._r8 + bc_out%litt_flux_lig_n_si(:) = 0._r8 + bc_out%litt_flux_lab_n_si(:) = 0._r8 + flux_cel_si => bc_out%litt_flux_cel_n_si(:) + flux_lab_si => bc_out%litt_flux_lab_n_si(:) + flux_lig_si => bc_out%litt_flux_lig_n_si(:) + case (phosphorus_element) + bc_out%litt_flux_cel_p_si(:) = 0._r8 + bc_out%litt_flux_lig_p_si(:) = 0._r8 + bc_out%litt_flux_lab_p_si(:) = 0._r8 + flux_cel_si => bc_out%litt_flux_cel_p_si(:) + flux_lab_si => bc_out%litt_flux_lab_p_si(:) + flux_lig_si => bc_out%litt_flux_lig_p_si(:) + end select - ! Set a pointer to the litter object - ! for the current element on the current - ! patch - litt => currentPatch%litter(el) - bc_out => currentPatch%bc_out + currentPatch => csite%oldest_patch + do while (associated(currentPatch)) - area_frac = currentPatch%area/area - - ! Loop over the different elements. - elemloop: do el = 1, num_elements + ! Set a pointer to the litter object + ! for the current element on the current + ! patch + litt => currentPatch%litter(el) + area_frac = currentPatch%area/area - ! Zero out the boundary flux arrays - ! Make a pointer to the cellulose, labile and lignin - ! flux partitions. - - select case (element_list(el)) - case (carbon12_element) - bc_out%litt_flux_cel_c_si(:) = 0.0_r8 - bc_out%litt_flux_lig_c_si(:) = 0.0_r8 - bc_out%litt_flux_lab_c_si(:) = 0.0_r8 - flux_cel_si => bc_out%litt_flux_cel_c_si(:) - flux_lab_si => bc_out%litt_flux_lab_c_si(:) - flux_lig_si => bc_out%litt_flux_lig_c_si(:) - case (nitrogen_element) - bc_out%litt_flux_cel_n_si(:) = 0._r8 - bc_out%litt_flux_lig_n_si(:) = 0._r8 - bc_out%litt_flux_lab_n_si(:) = 0._r8 - flux_cel_si => bc_out%litt_flux_cel_n_si(:) - flux_lab_si => bc_out%litt_flux_lab_n_si(:) - flux_lig_si => bc_out%litt_flux_lig_n_si(:) - case (phosphorus_element) - bc_out%litt_flux_cel_p_si(:) = 0._r8 - bc_out%litt_flux_lig_p_si(:) = 0._r8 - bc_out%litt_flux_lab_p_si(:) = 0._r8 - flux_cel_si => bc_out%litt_flux_cel_p_si(:) - flux_lab_si => bc_out%litt_flux_lab_p_si(:) - flux_lig_si => bc_out%litt_flux_lig_p_si(:) - end select - do ic = 1, ncwd do id = 1,nlev_eff_decomp @@ -765,8 +763,12 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) end do end do + + + ! leaf and fine root fragmentation fluxes + do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & @@ -808,23 +810,22 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) litt%root_fines_frag(ilignin,j) * area_frac enddo - ! Normalize all masses over the decomposition layer's depth - ! Convert from kg/m2/day -> g/m3/s - - do id = 1,nlev_eff_decomp - flux_cel_si(id) = days_per_sec * g_per_kg * & - flux_cel_si(id) / bc_in%dz_decomp_sisl(id) - flux_lig_si(id) = days_per_sec * g_per_kg * & - flux_lig_si(id) / bc_in%dz_decomp_sisl(id) - flux_lab_si(id) = days_per_sec * g_per_kg * & - flux_lab_si(id) / bc_in%dz_decomp_sisl(id) - end do + currentPatch => currentPatch%younger + end do - end do elemloop + ! Normalize all masses over the decomposition layer's depth + ! Convert from kg/m2/day -> g/m3/s - currentPatch => currentPatch%younger + do id = 1,nlev_eff_decomp + flux_cel_si(id) = days_per_sec * g_per_kg * & + flux_cel_si(id) / bc_in%dz_decomp_sisl(id) + flux_lig_si(id) = days_per_sec * g_per_kg * & + flux_lig_si(id) / bc_in%dz_decomp_sisl(id) + flux_lab_si(id) = days_per_sec * g_per_kg * & + flux_lab_si(id) / bc_in%dz_decomp_sisl(id) + end do - end do fluxpatchloop + end do ! do elements ! If we are coupled with MIMICS, then we need some assessment of litter quality ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) From 06ac9b4fee6574a7c89ee97d6803a6c333f206c8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Sep 2025 14:38:53 -0700 Subject: [PATCH 053/331] Revert "remove now unused bc_out from flux into litter pool procedure" This reverts commit 9832f64239219052f089f927ae6188a831750eda. --- main/EDMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 31cf7befc2..7a5bd21840 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -794,7 +794,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! can remove it completely if/when this call is added in ELM to ! subroutine UpdateLitterFluxes(this,bounds_clump) in elmfates_interfaceMod.F90 - call FluxIntoLitterPools(currentsite, bc_in) + call FluxIntoLitterPools(currentsite, bc_in, bc_out) ! Update cohort number. From 98ca7bb50f8e5a9b1fce115d4ac5f626b95fa3eb Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 3 Sep 2025 16:17:09 -0700 Subject: [PATCH 054/331] create interface registry type to be used by both fates_interface_type and fates_patch_type --- main/FatesInterfaceTypesMod.F90 | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 22f032728c..81a6ae116f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -8,6 +8,7 @@ module FatesInterfaceTypesMod use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + implicit none private ! By default everything is private @@ -843,9 +844,29 @@ module FatesInterfaceTypesMod end type bc_pconst_type + ! Base type to be extended for the API registry + type, public :: fates_interface_registry_base_type + + integer :: num_api_vars + + ! container array of interface variables + type(fates_interface_variable_type), allocatable :: vars(:) + + contains + + procedure :: InitializeInterfaceRegistry + procedure :: Register => RegisterInterfaceVariables_1d, RegisterInterfaceVariables_2d + + procedure, private :: DefineInterfaceRegistry + procedure, private :: DefineInterfaceVariable + procedure, private :: GetRegistryIndex + + end type fates_interface_registry_base_type + public :: ZeroBCOutCarbonFluxes contains + ! ====================================================================================== From fcc0bc06de9355706b94f3fc7dc5a8d2edb0e882 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 3 Sep 2025 16:18:19 -0700 Subject: [PATCH 055/331] move the registry type-bound procedures from fatesinterfacemod --- main/FatesInterfaceMod.F90 | 121 +---------------------------- main/FatesInterfaceTypesMod.F90 | 132 +++++++++++++++++++++++++++++++- 2 files changed, 131 insertions(+), 122 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0695ce6031..69eb1b4132 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -114,7 +114,6 @@ module FatesInterfaceMod use FatesTwoStreamUtilsMod, only : TransferRadParams use LeafBiophysicsMod , only : lb_params use LeafBiophysicsMod , only : FvCB1980 - use FatesInterfaceVariableTypeMod, only : fates_interface_variable_type ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -163,20 +162,9 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - type(fates_interface_variable_type), allocatable :: api_vars(:) + ! type(fates_interface_variable_type), allocatable :: api_vars(:) + type(fates_interface_registry_base_type) :: api - ! The number of variables in the registry - integer :: num_api_vars - - contains - - procedure :: InitializeInterfaceRegistry - procedure :: Register => RegisterInterfaceVariables_2d - - procedure, private :: DefineInterfaceRegistry - procedure, private :: DefineInterfaceVariable - procedure, private :: GetRegistryIndex - end type fates_interface_type character(len=*), parameter :: sourcefile = & @@ -2719,111 +2707,6 @@ end subroutine FatesReadParameters ! ====================================================================================== -subroutine InitializeInterfaceRegistry(this) - - ! This initializes the interface registry - - class(fates_interface_type) :: this - - logical :: initialize - - ! First count up the keys defined in the registry - call this%DefineInterfaceRegistry(initialize=.false.) - - ! Allocate the registry - allocate(this%api_vars(this%num_api_vars)) - - ! Now set up the registry keys - call this%DefineInterfaceRegistry(initialize=.true.) - -end subroutine InitializeInterfaceRegistry - -! ====================================================================================== - -subroutine DefineInterfaceRegistry(this, initialize) - - ! This procedure defines the list of common names to be associated with FATES and HLM - ! variables. - - class(fates_interface_type) :: this - - logical, intent(in) :: initialize ! false = count up the keys in the registry - - integer :: ivar ! indices - - ! Set ivar to zero. This will be incremented via each call to SetInterfaceVariable - ivar = 0 - - ! Define the interface registry names and indices - call this%DefineInterfaceVariable(key='decomp_frac_moisture', index=ivar, initialize=initialize) - call this%DefineInterfaceVariable(key='decomp_frac_temperature', index=ivar, initialize=initialize) - - ! Set the registry size based on the final update of ivar - this%num_api_vars = ivar - - -end subroutine DefineInterfaceRegistry - -! ====================================================================================== - -subroutine DefineInterfaceVariable(this, key, index, initialize) - - ! This procedure - class(fates_interface_type) :: this - character(len=*), intent(in) :: key - integer, intent(inout) :: index - logical, intent(in) :: initialize - - ! Increment the index to return count - index = index + 1 - - ! If we are initializing the - if (initialize) then - call this%api_vars(index)%Initialize(key) - end if - -end subroutine DefineInterfaceVariable - -! ====================================================================================== - - subroutine RegisterInterfaceVariables_2d(this, key, data) - - ! This procedure is called by the host land model to associate a data variable - ! with a particular registry key - - class(fates_interface_type) :: this - - character(len=*), intent(in) :: key ! variable registry key - class(*), target, intent(in) :: data(:,:) ! data to be associated with key - - ! Get index from registry key and associate the given data pointer - call this%api_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) - - end subroutine RegisterInterfaceVariables_2d - -! ====================================================================================== - -integer function GetRegistryIndex(this, key) result(index) - - ! This procedure returns the index associated with the key provided - - class(fates_interface_type) :: this - - character(len=*), intent(in) :: key ! variable registry key to search - - integer :: ivar ! Iterator - - ! Iterate over the registry until the associated key is found - do ivar = 1, this%num_api_vars - if (this%api_vars(ivar)%key == key) then - index = ivar - return - end if - end do - -end function GetRegistryIndex - -! ====================================================================================== end module FatesInterfaceMod diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 81a6ae116f..159888dc34 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -7,7 +7,8 @@ module FatesInterfaceTypesMod use FatesGlobals , only : endrun => fates_endrun use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - + + use FatesInterfaceVariableTypeMod, only : fates_interface_variable_type implicit none @@ -868,9 +869,9 @@ module FatesInterfaceTypesMod contains - ! ====================================================================================== + ! ====================================================================================== - subroutine ZeroBCOutCarbonFluxes(bc_out) + subroutine ZeroBCOutCarbonFluxes(bc_out) ! !ARGUMENTS type(bc_out_type), intent(inout) :: bc_out @@ -882,4 +883,129 @@ subroutine ZeroBCOutCarbonFluxes(bc_out) end subroutine ZeroBCOutCarbonFluxes + ! ====================================================================================== + + subroutine InitializeInterfaceRegistry(this) + + ! This initializes the interface registry + + class(fates_interface_registry_base_type) :: this + + logical :: initialize + + ! First count up the keys defined in the registry + call this%DefineInterfaceRegistry(initialize=.false.) + + ! Allocate the registry + allocate(this%vars(this%num_api_vars)) + + ! Now set up the registry keys + call this%DefineInterfaceRegistry(initialize=.true.) + + end subroutine InitializeInterfaceRegistry + + ! ====================================================================================== + + subroutine DefineInterfaceRegistry(this, initialize) + + ! This procedure defines the list of common names to be associated with FATES and HLM + ! variables. + + class(fates_interface_registry_base_type) :: this + + logical, intent(in) :: initialize ! false = count up the keys in the registry + + integer :: ivar ! indices + + ! Set ivar to zero. This will be incremented via each call to SetInterfaceVariable + ivar = 0 + + ! Define the interface registry names and indices + call this%DefineInterfaceVariable(key='decomp_frac_moisture', index=ivar, initialize=initialize) + call this%DefineInterfaceVariable(key='decomp_frac_temperature', index=ivar, initialize=initialize) + + ! Set the registry size based on the final update of ivar + this%num_api_vars = ivar + + + end subroutine DefineInterfaceRegistry + + ! ====================================================================================== + + subroutine DefineInterfaceVariable(this, key, index, initialize) + + class(fates_interface_registry_base_type) :: this + + character(len=*), intent(in) :: key + integer, intent(inout) :: index + logical, intent(in) :: initialize + + ! Increment the index to return count + index = index + 1 + + ! If we are initializing the + if (initialize) then + call this%vars(index)%Initialize(key) + end if + + end subroutine DefineInterfaceVariable + + ! ====================================================================================== + + subroutine RegisterInterfaceVariables_1d(this, key, data) + + ! This procedure is called by the to associate a data variable + ! with a particular registry key + + class(fates_interface_registry_base_type) :: this + + character(len=*), intent(in) :: key ! variable registry key + class(*), target, intent(in) :: data(:) ! data to be associated with key + + ! Get index from registry key and associate the given data pointer + call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + + end subroutine RegisterInterfaceVariables_1d + + ! ====================================================================================== + + subroutine RegisterInterfaceVariables_2d(this, key, data) + + ! This procedure is called by the to associate a data variable + ! with a particular registry key + + class(fates_interface_registry_base_type) :: this + + character(len=*), intent(in) :: key ! variable registry key + class(*), target, intent(in) :: data(:,:) ! data to be associated with key + + ! Get index from registry key and associate the given data pointer + call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + + end subroutine RegisterInterfaceVariables_2d + + ! ====================================================================================== + + integer function GetRegistryIndex(this, key) result(index) + + ! This procedure returns the index associated with the key provided + + class(fates_interface_registry_base_type) :: this + + character(len=*), intent(in) :: key ! variable registry key to search + + integer :: ivar ! Iterator + + ! Iterate over the registry until the associated key is found + do ivar = 1, this%num_api_vars + if (this%vars(ivar)%key == key) then + index = ivar + return + end if + end do + + end function GetRegistryIndex + + ! ====================================================================================== + end module FatesInterfaceTypesMod From f869a0e082d307557c5833e32cc6a03591eb6cea Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 3 Sep 2025 16:19:03 -0700 Subject: [PATCH 056/331] implement the interface registry type in the patch type --- biogeochem/FatesPatchMod.F90 | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 8f561def0d..d3e4e5f8bd 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -34,6 +34,7 @@ module FatesPatchMod use FatesInterfaceTypesMod, only : numpft use FatesInterfaceTypesMod, only : bc_in_type use FatesInterfaceTypesMod, only : bc_out_type + use FatesInterfaceTypesMod, only : fates_interface_registry_base_type use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) use shr_log_mod, only : errMsg => shr_log_errMsg @@ -76,6 +77,9 @@ module FatesPatchMod ! TODO change this to a specific bc type for incremental refactor purposes if this method is picked type(bc_in_type) :: bc_in type(bc_out_type) :: bc_out + + ! API registry container + type(fates_interface_registry_base_type) :: api !--------------------------------------------------------------------------- @@ -275,6 +279,8 @@ module FatesPatchMod procedure :: Dump procedure :: CheckVars + procedure, private :: RegisterFatesInterfaceVariables + end type fates_patch_type contains @@ -310,6 +316,9 @@ subroutine Init(this, num_swb, num_levsoil) allocate(this%bc_out%litt_flux_lig_c_si(this%bc_in%nlevdecomp)) allocate(this%bc_out%litt_flux_lab_c_si(this%bc_in%nlevdecomp)) + ! Allocate API registry + call this%RegisterFatesInterfaceVariables() + ! initialize all values to nan call this%NanValues() @@ -1366,4 +1375,19 @@ end subroutine CheckVars !=========================================================================== + subroutine RegisterFatesInterfaceVariables(this) + + class(fates_patch_type) :: this + + ! Initialize the HLM-FATES interface variable registry for the FATES-side + call this%api%InitializeInterfaceRegistry() + + ! Register the FATES boundary condition data variables + call this%api%Register('decomp_frac_moisture', this%bc_in%w_scalar_sisl) + call this%api%Register('decomp_frac_temperature', this%bc_in%t_scalar_sisl) + + end subroutine RegisterFatesInterfaceVariables + +! ====================================================================================== + end module FatesPatchMod From 4a28e0444f364129bad460c8c4fe4b8679bc9913 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 3 Sep 2025 16:19:39 -0700 Subject: [PATCH 057/331] add a 1d variant of the register generic for the fates-side variables --- main/FatesInterfaceVarTypeMod.F90 | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 26942da4ce..b83e05522b 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -18,12 +18,12 @@ module FatesInterfaceVariableTypeMod type, public :: fates_interface_variable_type character(len=48) :: key ! common registry key - class(*), pointer :: data(:,:) ! unlimited polymorphic data pointer + class(*), pointer :: data ! unlimited polymorphic data pointer logical :: active ! true if the variable is used by the host land model contains procedure :: Initialize => InitializeInterfaceVariable - procedure :: Register => RegisterInterfaceVariable_2d + procedure :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d end type fates_interface_variable_type @@ -45,6 +45,21 @@ end subroutine InitializeInterfaceVariable ! ==================================================================================== + subroutine RegisterInterfaceVariable_1d(this, data, active) + + class(fates_interface_variable_type) :: this + + class(*), target, intent(in) :: data(:) + logical, intent(in) :: active + + this%data => data + this%active = active + + end subroutine RegisterInterfaceVariable_1d + + ! ==================================================================================== + + subroutine RegisterInterfaceVariable_2d(this, data, active) class(fates_interface_variable_type) :: this @@ -52,14 +67,10 @@ subroutine RegisterInterfaceVariable_2d(this, data, active) class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active - ! TODO: add type check here to validate acceptable types? - this%data => data - ! allocate(this%data, source=data) this%active = active end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== - end module FatesInterfaceVariableTypeMod \ No newline at end of file From 4d1154510f2b729a68671c1eda21794131a57d10 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 11:44:48 -0700 Subject: [PATCH 058/331] add explicit polymorphic pointers in the var type to handle different ranks --- main/FatesInterfaceVarTypeMod.F90 | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index b83e05522b..dcacffec96 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -17,13 +17,19 @@ module FatesInterfaceVariableTypeMod ! Interface variable registry type type, public :: fates_interface_variable_type - character(len=48) :: key ! common registry key - class(*), pointer :: data ! unlimited polymorphic data pointer - logical :: active ! true if the variable is used by the host land model + character(len=48) :: key ! common registry key + class(*), pointer :: data0d ! scalar polymorphic data pointer + class(*), pointer :: data1d(:) ! 1D polymorphic data pointer + class(*), pointer :: data2d(:,:) ! 2D polymorphic data pointer + class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer + logical :: active ! true if the variable is used by the host land model contains procedure :: Initialize => InitializeInterfaceVariable - procedure :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d + generic :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d + + procedure, private :: RegisterInterfaceVariable_1d + procedure, private :: RegisterInterfaceVariable_2d end type fates_interface_variable_type @@ -37,7 +43,10 @@ subroutine InitializeInterfaceVariable(this, key) character(len=*), intent(in) :: key - this%data => null() + this%data0d => null() + this%data1d => null() + this%data2d => null() + this%data3d => null() this%key = key this%active = .false. @@ -52,7 +61,7 @@ subroutine RegisterInterfaceVariable_1d(this, data, active) class(*), target, intent(in) :: data(:) logical, intent(in) :: active - this%data => data + this%data1d => data(:) this%active = active end subroutine RegisterInterfaceVariable_1d @@ -67,7 +76,7 @@ subroutine RegisterInterfaceVariable_2d(this, data, active) class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active - this%data => data + this%data2d => data(:,:) this%active = active end subroutine RegisterInterfaceVariable_2d From 849c4d502ed6838a59f8cad53ef1b2532919fb0c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 11:45:14 -0700 Subject: [PATCH 059/331] correct the definition of the generic registry procedure --- main/FatesInterfaceTypesMod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 159888dc34..393c3700e2 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -856,8 +856,10 @@ module FatesInterfaceTypesMod contains procedure :: InitializeInterfaceRegistry - procedure :: Register => RegisterInterfaceVariables_1d, RegisterInterfaceVariables_2d + generic :: Register => RegisterInterfaceVariables_1d, RegisterInterfaceVariables_2d + procedure, private :: RegisterInterfaceVariables_1d + procedure, private :: RegisterInterfaceVariables_2d procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable procedure, private :: GetRegistryIndex @@ -963,7 +965,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data) class(*), target, intent(in) :: data(:) ! data to be associated with key ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) end subroutine RegisterInterfaceVariables_1d @@ -980,7 +982,7 @@ subroutine RegisterInterfaceVariables_2d(this, key, data) class(*), target, intent(in) :: data(:,:) ! data to be associated with key ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) end subroutine RegisterInterfaceVariables_2d From 389f43349961ec96e69846a790e67b959b8f4643 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 12:06:39 -0700 Subject: [PATCH 060/331] minor formatting update --- main/FatesInterfaceTypesMod.F90 | 4 ++-- main/FatesInterfaceVarTypeMod.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 393c3700e2..ecd0a2b851 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -858,11 +858,11 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceRegistry generic :: Register => RegisterInterfaceVariables_1d, RegisterInterfaceVariables_2d - procedure, private :: RegisterInterfaceVariables_1d - procedure, private :: RegisterInterfaceVariables_2d procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable procedure, private :: GetRegistryIndex + procedure, private :: RegisterInterfaceVariables_1d + procedure, private :: RegisterInterfaceVariables_2d end type fates_interface_registry_base_type diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index dcacffec96..cedf770e5c 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -26,7 +26,7 @@ module FatesInterfaceVariableTypeMod contains procedure :: Initialize => InitializeInterfaceVariable - generic :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d + generic :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d procedure, private :: RegisterInterfaceVariable_1d procedure, private :: RegisterInterfaceVariable_2d From 3f3ec2cc92573589ae9f4d861ea376c8a831e828 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 14:13:32 -0700 Subject: [PATCH 061/331] add function to get the registry key from the given index --- main/FatesInterfaceTypesMod.F90 | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index ecd0a2b851..a8bcc147bb 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -861,6 +861,7 @@ module FatesInterfaceTypesMod procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable procedure, private :: GetRegistryIndex + procedure, private :: GetRegistryKey procedure, private :: RegisterInterfaceVariables_1d procedure, private :: RegisterInterfaceVariables_2d @@ -1009,5 +1010,36 @@ integer function GetRegistryIndex(this, key) result(index) end function GetRegistryIndex ! ====================================================================================== + + character(len=*) function GetRegistryKey(this, index) result(key) + + ! This procedure returns the index associated with the key provided + + class(fates_interface_registry_base_type) :: this + + integer, intent(in) :: index ! variable registry index + + key = this%vars(index)%key + + end function GetRegistryIndex + + ! ====================================================================================== + + subroutine UpdateInterfaceVariables(this) + + class(fates_interface_registry_base_type) :: this + + integer :: ivar ! Iterator + + ! Iterate over the registry and update all active variables + do ivar = 1, this%num_api_vars + if (this%vars(ivar)%active) then + call this%vars(ivar)%Update() + end if + end do + + end subroutine UpdateInterfaceVariables + + ! ====================================================================================== end module FatesInterfaceTypesMod From c8b88b5881cfc5a94311875e86ed66887712e031 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 14:26:28 -0700 Subject: [PATCH 062/331] start adding the interface update call for the hlm-fates interface during the dynamics update --- main/FatesInterfaceMod.F90 | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 69eb1b4132..fcb44a0024 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -162,7 +162,6 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - ! type(fates_interface_variable_type), allocatable :: api_vars(:) type(fates_interface_registry_base_type) :: api end type fates_interface_type @@ -185,6 +184,7 @@ module FatesInterfaceMod public :: set_bcs public :: UpdateFatesRMeansTStep public :: InitTimeAveragingGlobals + public :: UpdateInterfaceVariables private :: FatesReadParameters public :: DetermineGridCellNeighbors @@ -2707,6 +2707,41 @@ end subroutine FatesReadParameters ! ====================================================================================== +subroutine UpdateFatesInterfaceVariables(this) + + class(fates_interface_type), intent(inout) :: this + + class(fates_registry_base_type), pointer :: patch_api + class(fates_patch_type), pointer :: currentPatch + + integer :: s ! site index + integer :: i ! HLM registry index + integer :: j ! FATES registry index + + do s = 1, this%nsites + currentPatch => this%sites(s)%oldest_patch + patch_api => currentPatch%api + do while (associated(currentPatch)) + do i = 1, this%num_api_vars + + ! Don't assume the index in the registry is the same as in the interface + j = patch_api%GetRegistryIndex(patch_api%GetRegistryKey(i)) + + ! TODO: we need meta data here to correctly associate the right slice of data + + ! Update the patch boundary condition via the data pointer + patch_api%vars(j)%data = this%api%vars(i)%data(c,:) + + end do + currentPatch => currentPatch%younger + end do + end do + +end subroutine UpdateFatesInterfaceVariables + + +! ====================================================================================== + end module FatesInterfaceMod From 0c76c7ccaa56701b56299bb9e0a7cb260a50dba1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 14:35:18 -0700 Subject: [PATCH 063/331] removed unused update subroutine --- main/FatesInterfaceTypesMod.F90 | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index a8bcc147bb..a41225fcf3 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1025,21 +1025,4 @@ end function GetRegistryIndex ! ====================================================================================== - subroutine UpdateInterfaceVariables(this) - - class(fates_interface_registry_base_type) :: this - - integer :: ivar ! Iterator - - ! Iterate over the registry and update all active variables - do ivar = 1, this%num_api_vars - if (this%vars(ivar)%active) then - call this%vars(ivar)%Update() - end if - end do - - end subroutine UpdateInterfaceVariables - - ! ====================================================================================== - end module FatesInterfaceTypesMod From 0cefb87f6e24061b6d6cc8e338a3ab97c34d0ecf Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 14:36:21 -0700 Subject: [PATCH 064/331] correct end function name --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index a41225fcf3..6838d565a8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1021,7 +1021,7 @@ character(len=*) function GetRegistryKey(this, index) result(key) key = this%vars(index)%key - end function GetRegistryIndex + end function GetRegistryKey ! ====================================================================================== From be4111ec5286c0863854b78351b881a065b77c97 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 14:37:22 -0700 Subject: [PATCH 065/331] minor white space changes --- main/FatesInterfaceVarTypeMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index cedf770e5c..bacb2aafea 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -67,7 +67,6 @@ subroutine RegisterInterfaceVariable_1d(this, data, active) end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== - subroutine RegisterInterfaceVariable_2d(this, data, active) @@ -82,4 +81,5 @@ subroutine RegisterInterfaceVariable_2d(this, data, active) end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== + end module FatesInterfaceVariableTypeMod \ No newline at end of file From f1fa1d7ba3ee472c7872b9a3baf6f16dec39c781 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 15:37:51 -0700 Subject: [PATCH 066/331] simplify the call to update the data via the api pointers by passing the registry --- main/FatesInterfaceMod.F90 | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index fcb44a0024..bef09f1e28 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2711,28 +2711,23 @@ subroutine UpdateFatesInterfaceVariables(this) class(fates_interface_type), intent(inout) :: this - class(fates_registry_base_type), pointer :: patch_api + class(fates_interface_registry_base_type), pointer :: patch_api class(fates_patch_type), pointer :: currentPatch integer :: s ! site index integer :: i ! HLM registry index integer :: j ! FATES registry index + integer :: c = 1 ! column index, TODO: update do s = 1, this%nsites currentPatch => this%sites(s)%oldest_patch patch_api => currentPatch%api do while (associated(currentPatch)) - do i = 1, this%num_api_vars - - ! Don't assume the index in the registry is the same as in the interface - j = patch_api%GetRegistryIndex(patch_api%GetRegistryKey(i)) - ! TODO: we need meta data here to correctly associate the right slice of data - - ! Update the patch boundary condition via the data pointer - patch_api%vars(j)%data = this%api%vars(i)%data(c,:) + ! TODO: we need meta data here to correctly associate the right slice of data + ! Update the patch boundary condition via the data pointer + call patch_api%Update(this%api) - end do currentPatch => currentPatch%younger end do end do From 62b6b388a4d3bccfc7e1f95890a3aaeb0220126e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 15:38:39 -0700 Subject: [PATCH 067/331] fix getregistrykey output definition --- main/FatesInterfaceTypesMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 6838d565a8..d78a148457 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1011,13 +1011,14 @@ end function GetRegistryIndex ! ====================================================================================== - character(len=*) function GetRegistryKey(this, index) result(key) + function GetRegistryKey(this, index) result(key) ! This procedure returns the index associated with the key provided class(fates_interface_registry_base_type) :: this integer, intent(in) :: index ! variable registry index + character(len=:), allocatable :: key key = this%vars(index)%key From 1a02f4fc143748ae9acf387ad7cbe20640fd69bc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 15:40:13 -0700 Subject: [PATCH 068/331] Add the api update procedure. Now that the api type has been passed, make the GetRegistry functions private again --- main/FatesInterfaceTypesMod.F90 | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d78a148457..257c5cd99f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -856,14 +856,16 @@ module FatesInterfaceTypesMod contains procedure :: InitializeInterfaceRegistry + procedure :: Update => UpdateInterfaceVariables + generic :: Register => RegisterInterfaceVariables_1d, RegisterInterfaceVariables_2d procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable - procedure, private :: GetRegistryIndex - procedure, private :: GetRegistryKey procedure, private :: RegisterInterfaceVariables_1d procedure, private :: RegisterInterfaceVariables_2d + procedure, private :: GetRegistryIndex + procedure, private :: GetRegistryKey end type fates_interface_registry_base_type @@ -989,6 +991,27 @@ end subroutine RegisterInterfaceVariables_2d ! ====================================================================================== + subroutine UpdateInterfaceVariables(this, api) + + class(fates_interface_registry_base_type) :: this + + class(fates_interface_registry_base_type), intent(in) pointer :: api + + integer :: i + integer :: j + + do i = 1, this%num_api_vars + + ! Don't assume the index in the registry is the same as in the interface + j = api%GetRegistryIndex(api%GetRegistryKey(i)) + + call this%vars(i)%Update(api%vars(j)) + end do + + end subroutine UpdateInterfaceVariables + + ! ====================================================================================== + integer function GetRegistryIndex(this, key) result(index) ! This procedure returns the index associated with the key provided From 8266933f3131b9063198fe91711dbd76c602538c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 9 Sep 2025 15:52:42 -0700 Subject: [PATCH 069/331] Start sketch of update variable This will need new type data to appropriately update the values --- main/FatesInterfaceVarTypeMod.F90 | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index bacb2aafea..f7936fa393 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -26,7 +26,9 @@ module FatesInterfaceVariableTypeMod contains procedure :: Initialize => InitializeInterfaceVariable - generic :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d + procedure :: Update => UpdateInterfaceVariable + + generic :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d procedure, private :: RegisterInterfaceVariable_1d procedure, private :: RegisterInterfaceVariable_2d @@ -80,6 +82,33 @@ subroutine RegisterInterfaceVariable_2d(this, data, active) end subroutine RegisterInterfaceVariable_2d + ! ==================================================================================== + + subroutine UpdateInterfaceVariable(this, var) + + class(fates_interface_variable_type) :: this + + class(fates_interface_variable_type), intent(in) :: var + + ! TODO: add column index to the interface variable type to allow + ! for appropriate slicing of input pointer array + ! e.g. + ! if (this%rank == 1)) then + ! data_this => this%data1d + ! else if (this%rank == 2) then + ! data_this => this%data2d + ! end if + ! if (var%rank == 1)) then + ! data_var => var%data1d + ! else if (this%rank == 2) then + ! data_var => var%data2d(this%col,:) + ! end if + ! data_this = data_var + ! This isn't exactly right, but you get the idea + + + end subroutine UpdateInterfaceVariable + ! ==================================================================================== end module FatesInterfaceVariableTypeMod \ No newline at end of file From 06ed5bb63c46afffb8d39259dbaf0cd9c02faa1f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 00:04:41 -0700 Subject: [PATCH 070/331] add subgrid heirarchy index variables in the registry type --- main/FatesInterfaceTypesMod.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 257c5cd99f..9335193d91 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -848,7 +848,11 @@ module FatesInterfaceTypesMod ! Base type to be extended for the API registry type, public :: fates_interface_registry_base_type - integer :: num_api_vars + integer :: num_api_vars ! number of variables in the registry + + integer :: patch_id ! HLM patch ID associated with this patch + integer :: column_id ! HLM column ID associated with this patch + integer :: landunit_id ! HLM landunit ID associated with this patch ! container array of interface variables type(fates_interface_variable_type), allocatable :: vars(:) @@ -898,6 +902,12 @@ subroutine InitializeInterfaceRegistry(this) logical :: initialize + ! unset registry integers + this%num_api_vars = unset_int + this%patch_id = unset_int + this%column_id = unset_int + this%landunit_id = unset_int + ! First count up the keys defined in the registry call this%DefineInterfaceRegistry(initialize=.false.) From d4cc8a82e4f9a93084daeca8f8c8ba9ded2d56a1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 00:05:20 -0700 Subject: [PATCH 071/331] update the current patch registry column index via the site column_map --- main/FatesInterfaceMod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index bef09f1e28..422d74bbbd 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2724,6 +2724,11 @@ subroutine UpdateFatesInterfaceVariables(this) patch_api => currentPatch%api do while (associated(currentPatch)) + ! Transfer the column index to the patch registry + ! While this may be duplicative for older patches, we need + ! to ensure that the new patches are provided with the column index + patch_api%column_id = this%sites(s)%column_map(currentPatch%patchno) + ! TODO: we need meta data here to correctly associate the right slice of data ! Update the patch boundary condition via the data pointer call patch_api%Update(this%api) @@ -2734,9 +2739,6 @@ subroutine UpdateFatesInterfaceVariables(this) end subroutine UpdateFatesInterfaceVariables - ! ====================================================================================== - - end module FatesInterfaceMod From e1cc928af902169b8a9292cbd2447304e2eeba6c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 00:06:13 -0700 Subject: [PATCH 072/331] add variables to hold information about the ordering of the input data and associated dimensionality --- main/FatesInterfaceVarTypeMod.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index f7936fa393..8b85f469b6 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -14,6 +14,11 @@ module FatesInterfaceVariableTypeMod implicit none private + integer, parameter :: subgrid_gridcell = 0 + integer, parameter :: subgrid_landunit = 1 + integer, parameter :: subgrid_column = 2 + integer, parameter :: subgrid_patch = 3 + ! Interface variable registry type type, public :: fates_interface_variable_type @@ -23,6 +28,9 @@ module FatesInterfaceVariableTypeMod class(*), pointer :: data2d(:,:) ! 2D polymorphic data pointer class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer logical :: active ! true if the variable is used by the host land model + integer :: rank ! rank of the variable (0, 1, 2, or 3) + integer :: rank_dimension ! index of the rank dimension for the given subgrid + integer :: subgrid ! subgrid level (0 = gridcell, 1 = landunit, 2 = column, 3 = patch) contains procedure :: Initialize => InitializeInterfaceVariable @@ -103,7 +111,7 @@ subroutine UpdateInterfaceVariable(this, var) ! else if (this%rank == 2) then ! data_var => var%data2d(this%col,:) ! end if - ! data_this = data_var + ! data_this = data_var() ! This isn't exactly right, but you get the idea From 134f3435c193660a67be496b198a6287343752e1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 15:25:27 -0700 Subject: [PATCH 073/331] correct usage of unset integer constant --- main/FatesInterfaceTypesMod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 9335193d91..b308effacf 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -2,6 +2,7 @@ module FatesInterfaceTypesMod use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue,ifalse + use FatesConstantsMod , only : fates_unset_int use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun @@ -903,10 +904,10 @@ subroutine InitializeInterfaceRegistry(this) logical :: initialize ! unset registry integers - this%num_api_vars = unset_int - this%patch_id = unset_int - this%column_id = unset_int - this%landunit_id = unset_int + this%num_api_vars = fates_unset_int + this%patch_id = fates_unset_int + this%column_id = fates_unset_int + this%landunit_id = fates_unset_int ! First count up the keys defined in the registry call this%DefineInterfaceRegistry(initialize=.false.) @@ -1004,8 +1005,7 @@ end subroutine RegisterInterfaceVariables_2d subroutine UpdateInterfaceVariables(this, api) class(fates_interface_registry_base_type) :: this - - class(fates_interface_registry_base_type), intent(in) pointer :: api + class(fates_interface_registry_base_type), intent(in) :: api integer :: i integer :: j From c5f36836088e65aa89ea0b69bcb392262605e26f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 15:25:45 -0700 Subject: [PATCH 074/331] make update interface a type-bound procedure --- main/FatesInterfaceMod.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 422d74bbbd..094da647a1 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -164,6 +164,10 @@ module FatesInterfaceMod ! This is the interface registry which associates variables with a common keyword type(fates_interface_registry_base_type) :: api + contains + + procedure, public :: UpdateInterfaceVariables + end type fates_interface_type character(len=*), parameter :: sourcefile = & @@ -184,7 +188,6 @@ module FatesInterfaceMod public :: set_bcs public :: UpdateFatesRMeansTStep public :: InitTimeAveragingGlobals - public :: UpdateInterfaceVariables private :: FatesReadParameters public :: DetermineGridCellNeighbors @@ -2707,7 +2710,7 @@ end subroutine FatesReadParameters ! ====================================================================================== -subroutine UpdateFatesInterfaceVariables(this) +subroutine UpdateInterfaceVariables(this) class(fates_interface_type), intent(inout) :: this @@ -2737,7 +2740,7 @@ subroutine UpdateFatesInterfaceVariables(this) end do end do -end subroutine UpdateFatesInterfaceVariables +end subroutine UpdateInterfaceVariables ! ====================================================================================== From 47ce36803e984a6a438f2466c32fdb22d18d8351 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 15:55:45 -0700 Subject: [PATCH 075/331] removing the rank dimension integer as we are going to hold that the first dimension in the hlm arrays must be the subgrid index --- main/FatesInterfaceVarTypeMod.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 8b85f469b6..e65acccf31 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -29,7 +29,6 @@ module FatesInterfaceVariableTypeMod class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer logical :: active ! true if the variable is used by the host land model integer :: rank ! rank of the variable (0, 1, 2, or 3) - integer :: rank_dimension ! index of the rank dimension for the given subgrid integer :: subgrid ! subgrid level (0 = gridcell, 1 = landunit, 2 = column, 3 = patch) contains @@ -97,6 +96,13 @@ subroutine UpdateInterfaceVariable(this, var) class(fates_interface_variable_type) :: this class(fates_interface_variable_type), intent(in) :: var + + ! This update method assumes that the first rank of the HLM data arrays + ! corresponds to the subgrid level of the interface variable type. + ! E.g. col_cf%w_scalar(c,1:nlevsoil) shows that the first rank is the column index. + ! TODO: This should be held in an interface requirements document. + + ! TODO: add column index to the interface variable type to allow ! for appropriate slicing of input pointer array From 7be5145ef0c09bc6e2e0243e0d65104791f157a3 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 17:21:02 -0700 Subject: [PATCH 076/331] add subgrid parameter index values --- main/FatesInterfaceVarTypeMod.F90 | 33 ++++++++++++++++++------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index e65acccf31..e4bc8f259c 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -14,10 +14,11 @@ module FatesInterfaceVariableTypeMod implicit none private - integer, parameter :: subgrid_gridcell = 0 - integer, parameter :: subgrid_landunit = 1 - integer, parameter :: subgrid_column = 2 - integer, parameter :: subgrid_patch = 3 + integer, parameter, public :: subgrid_gridcell = 5 + integer, parameter, public :: subgrid_topounit = 4 + integer, parameter, public :: subgrid_landunit = 3 + integer, parameter, public :: subgrid_column = 2 + integer, parameter, public :: subgrid_patch = 1 ! Interface variable registry type type, public :: fates_interface_variable_type @@ -63,46 +64,50 @@ end subroutine InitializeInterfaceVariable ! ==================================================================================== - subroutine RegisterInterfaceVariable_1d(this, data, active) + subroutine RegisterInterfaceVariable_1d(this, data, active, subgrid_index) class(fates_interface_variable_type) :: this class(*), target, intent(in) :: data(:) logical, intent(in) :: active - + integer, intent(in) :: subgrid_index + this%data1d => data(:) this%active = active - + this%subgrid = subgrid_index + end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== - subroutine RegisterInterfaceVariable_2d(this, data, active) + subroutine RegisterInterfaceVariable_2d(this, data, active, subgrid_index) class(fates_interface_variable_type) :: this - class(*), target, intent(in) :: data(:,:) - logical, intent(in) :: active - + class(*), target, intent(in) :: data(:,:) + logical, intent(in) :: active + integer, intent(in) :: subgrid_index + this%data2d => data(:,:) this%active = active + this%subgrid = subgrid_index end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== - subroutine UpdateInterfaceVariable(this, var) + subroutine UpdateInterfaceVariable(this, var, subgrid_indices) class(fates_interface_variable_type) :: this class(fates_interface_variable_type), intent(in) :: var - + integer, intent(in) :: subgrid_indices(:) + ! This update method assumes that the first rank of the HLM data arrays ! corresponds to the subgrid level of the interface variable type. ! E.g. col_cf%w_scalar(c,1:nlevsoil) shows that the first rank is the column index. ! TODO: This should be held in an interface requirements document. - ! TODO: add column index to the interface variable type to allow ! for appropriate slicing of input pointer array From 95916a04e73846ce6b0d303e5c78e49d348b695c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 17:21:52 -0700 Subject: [PATCH 077/331] update the api registration procedure to pass in the subgrid index for the given variable --- main/FatesInterfaceTypesMod.F90 | 51 +++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 15 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index b308effacf..804f8cc376 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -286,6 +286,9 @@ module FatesInterfaceTypesMod integer, parameter, public :: fates_dispersal_cadence_monthly = 2 ! Disperse seeds monthly integer, parameter, public :: fates_dispersal_cadence_yearly = 3 ! Disperse seeds yearly + integer, parameter :: hlm_subgrid_levels = 5 ! The number of subgrid hierarchy levels that the HLM + ! Including the gridcell level, ELM = 5, CLM = 4 + ! ------------------------------------------------------------------------------------- ! These vectors are used for history output mapping ! CLM/ALM have limited support for multi-dimensional history output arrays. @@ -849,11 +852,9 @@ module FatesInterfaceTypesMod ! Base type to be extended for the API registry type, public :: fates_interface_registry_base_type - integer :: num_api_vars ! number of variables in the registry - - integer :: patch_id ! HLM patch ID associated with this patch - integer :: column_id ! HLM column ID associated with this patch - integer :: landunit_id ! HLM landunit ID associated with this patch + integer :: num_api_vars ! number of variables in the registry + integer :: subgrid_indices(hlm_subgrid_levels) ! HLM patch ID associated with this patch + ! 1 = patch, 2 = column, 3 = landunit, 4 = topounit, 5 = gridcell ! container array of interface variables type(fates_interface_variable_type), allocatable :: vars(:) @@ -968,35 +969,55 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== - subroutine RegisterInterfaceVariables_1d(this, key, data) + subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) ! This procedure is called by the to associate a data variable ! with a particular registry key - class(fates_interface_registry_base_type) :: this + use FatesInterfaceVariableTypeMod, only : subgrid_patch + + class(fates_interface_registry_base_type) :: thisA - character(len=*), intent(in) :: key ! variable registry key - class(*), target, intent(in) :: data(:) ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key + class(*), target, intent(in) :: data(:) ! data to be associated with key + integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable + + integer :: subgrid_index_use + + if (present(subgrid_index)) then + subgrid_index_use = subgrid_index + else + subgrid_index_use = subgrid_patch + end if ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., subgrid_index_use) end subroutine RegisterInterfaceVariables_1d ! ====================================================================================== - subroutine RegisterInterfaceVariables_2d(this, key, data) + subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) ! This procedure is called by the to associate a data variable ! with a particular registry key class(fates_interface_registry_base_type) :: this - character(len=*), intent(in) :: key ! variable registry key - class(*), target, intent(in) :: data(:,:) ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key + class(*), target, intent(in) :: data(:,:) ! data to be associated with key + integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable + + integer :: subgrid_index_use + + if (present(subgrid_index)) then + subgrid_index_use = subgrid_index + else + subgrid_index_use = subgrid_patch + end if ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., subgrid_index_use) end subroutine RegisterInterfaceVariables_2d @@ -1015,7 +1036,7 @@ subroutine UpdateInterfaceVariables(this, api) ! Don't assume the index in the registry is the same as in the interface j = api%GetRegistryIndex(api%GetRegistryKey(i)) - call this%vars(i)%Update(api%vars(j)) + call this%vars(i)%Update(api%vars(j), api%subgrid_indices) end do end subroutine UpdateInterfaceVariables From bad4850cad96cf5f57db5540c91f24fb64fd67f4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 17:22:45 -0700 Subject: [PATCH 078/331] implement the updated api registry assignment of the column index --- main/FatesInterfaceMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 094da647a1..afb24e9147 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2712,6 +2712,8 @@ end subroutine FatesReadParameters subroutine UpdateInterfaceVariables(this) + use FatesInterfaceVariableTypeMod, only : subgrid_column + class(fates_interface_type), intent(inout) :: this class(fates_interface_registry_base_type), pointer :: patch_api @@ -2730,7 +2732,7 @@ subroutine UpdateInterfaceVariables(this) ! Transfer the column index to the patch registry ! While this may be duplicative for older patches, we need ! to ensure that the new patches are provided with the column index - patch_api%column_id = this%sites(s)%column_map(currentPatch%patchno) + patch_api%subgrid_indices(subgrid_column) = this%sites(s)%column_map(currentPatch%patchno) ! TODO: we need meta data here to correctly associate the right slice of data ! Update the patch boundary condition via the data pointer From 4b964da0398c6ad2803cc85898a2567b54c7f052 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 10 Sep 2025 17:22:58 -0700 Subject: [PATCH 079/331] whitespace --- biogeochem/FatesPatchMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index d3e4e5f8bd..662cfc5f81 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -1378,7 +1378,7 @@ end subroutine CheckVars subroutine RegisterFatesInterfaceVariables(this) class(fates_patch_type) :: this - + ! Initialize the HLM-FATES interface variable registry for the FATES-side call this%api%InitializeInterfaceRegistry() From d2a41b1b7f82819508073f3d80baab0f97195844 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Sep 2025 11:28:17 -0700 Subject: [PATCH 080/331] adding comments and whitespace adjustments --- main/FatesInterfaceTypesMod.F90 | 21 ++++++++++++--------- main/FatesInterfaceVarTypeMod.F90 | 3 ++- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 804f8cc376..12d2136e70 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1002,6 +1002,8 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) ! This procedure is called by the to associate a data variable ! with a particular registry key + use FatesInterfaceVariableTypeMod, only : subgrid_patch + class(fates_interface_registry_base_type) :: this character(len=*), intent(in) :: key ! variable registry key @@ -1025,18 +1027,19 @@ end subroutine RegisterInterfaceVariables_2d subroutine UpdateInterfaceVariables(this, api) - class(fates_interface_registry_base_type) :: this - class(fates_interface_registry_base_type), intent(in) :: api + class(fates_interface_registry_base_type) :: this ! registry being updated + class(fates_interface_registry_base_type), intent(in) :: api ! registry update source integer :: i integer :: j do i = 1, this%num_api_vars - ! Don't assume the index in the registry is the same as in the interface - j = api%GetRegistryIndex(api%GetRegistryKey(i)) + ! Don't assume the index in the registry is the same as in the interface + j = api%GetRegistryIndex(api%GetRegistryKey(i)) - call this%vars(i)%Update(api%vars(j), api%subgrid_indices) + ! Update the registered variable and pass the subgrid indices information + call this%vars(i)%Update(api%vars(j), api%subgrid_indices) end do end subroutine UpdateInterfaceVariables @@ -1055,10 +1058,10 @@ integer function GetRegistryIndex(this, key) result(index) ! Iterate over the registry until the associated key is found do ivar = 1, this%num_api_vars - if (this%vars(ivar)%key == key) then - index = ivar - return - end if + if (this%vars(ivar)%key == key) then + index = ivar + return + end if end do end function GetRegistryIndex diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index e4bc8f259c..9bf4e6867e 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -20,7 +20,7 @@ module FatesInterfaceVariableTypeMod integer, parameter, public :: subgrid_column = 2 integer, parameter, public :: subgrid_patch = 1 - ! Interface variable registry type + ! Interface registry variable type type, public :: fates_interface_variable_type character(len=48) :: key ! common registry key @@ -109,6 +109,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) ! TODO: This should be held in an interface requirements document. + ! TODO: add column index to the interface variable type to allow ! for appropriate slicing of input pointer array ! e.g. From f35d8b7fe08021faa0edb3f546c40268a917d114 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Sep 2025 11:33:32 -0700 Subject: [PATCH 081/331] update the registry initialization to reflect the change to the subgrid index information --- main/FatesInterfaceTypesMod.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 12d2136e70..3c33f7cfd8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -906,9 +906,7 @@ subroutine InitializeInterfaceRegistry(this) ! unset registry integers this%num_api_vars = fates_unset_int - this%patch_id = fates_unset_int - this%column_id = fates_unset_int - this%landunit_id = fates_unset_int + this%subgrid_indices = fates_unset_int ! First count up the keys defined in the registry call this%DefineInterfaceRegistry(initialize=.false.) From a28b2ab3788b2259df55f63b030d26a3bc7a3e1c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Sep 2025 11:56:30 -0700 Subject: [PATCH 082/331] add missing rank update --- main/FatesInterfaceVarTypeMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 9bf4e6867e..fdde8a48bd 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -75,6 +75,7 @@ subroutine RegisterInterfaceVariable_1d(this, data, active, subgrid_index) this%data1d => data(:) this%active = active this%subgrid = subgrid_index + this%rank = rank(data) end subroutine RegisterInterfaceVariable_1d @@ -91,6 +92,7 @@ subroutine RegisterInterfaceVariable_2d(this, data, active, subgrid_index) this%data2d => data(:,:) this%active = active this%subgrid = subgrid_index + this%rank = rank(data) end subroutine RegisterInterfaceVariable_2d From f3c34e71e9b870a40d2132ce967c9943790e2feb Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Sep 2025 11:57:11 -0700 Subject: [PATCH 083/331] add case select logic and pointers to index into the source data pointer --- main/FatesInterfaceVarTypeMod.F90 | 60 ++++++++++++++++++++----------- 1 file changed, 39 insertions(+), 21 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index fdde8a48bd..496aa12c29 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -100,34 +100,52 @@ end subroutine RegisterInterfaceVariable_2d subroutine UpdateInterfaceVariable(this, var, subgrid_indices) - class(fates_interface_variable_type) :: this + class(fates_interface_variable_type) :: this ! variable being updated + class(fates_interface_variable_type), intent(in) :: var ! variable update source + integer, intent(in) :: subgrid_indices(:) ! subgrid indices for the update source + + class(*), pointer :: data_var0d => null() + class(*), pointer :: data_var1d(:) => null() + class(*), pointer :: data_var2d(:,:) => null() + class(*), pointer :: data_var3d(:,:,:) => null() - class(fates_interface_variable_type), intent(in) :: var - integer, intent(in) :: subgrid_indices(:) + integer :: index ! index for the subgrid level of the input interface variable ! This update method assumes that the first rank of the HLM data arrays ! corresponds to the subgrid level of the interface variable type. ! E.g. col_cf%w_scalar(c,1:nlevsoil) shows that the first rank is the column index. ! TODO: This should be held in an interface requirements document. - - - - ! TODO: add column index to the interface variable type to allow - ! for appropriate slicing of input pointer array - ! e.g. - ! if (this%rank == 1)) then - ! data_this => this%data1d - ! else if (this%rank == 2) then - ! data_this => this%data2d - ! end if - ! if (var%rank == 1)) then - ! data_var => var%data1d - ! else if (this%rank == 2) then - ! data_var => var%data2d(this%col,:) - ! end if - ! data_this = data_var() - ! This isn't exactly right, but you get the idea + ! Get the subgrid index for the updating variable + index = subgrid_indices(var%subgrid_index) + + ! Update the data pointer based on the rank of the source variable while indexing + ! into the appropriate subgrid level + ! TODO: This assumes HLM->FATES direction; Validate this for FATES->HLM direction + select case (var%rank) + case(0) + data_var0d => var%data0d + case(1) + data_var0d => var%data1d(index) + case(2) + data_var1d => var%data2d(index,:) + case(3) + data_var2d => var%data3d(index,:,:) + case default + call endrun(fates_log, 'FATES ERROR: Unsupported interface variable source rank in UpdateInterfaceVariable') + end select + + ! Update the data pointer of the target variable based on its rank + select case (this%rank) + case(0) + this%data0d = data_var0d + case(1) + this%data1d = data_var1d + case(2) + this%data2d = data_var2d + case default + call endrun(fates_log, 'FATES ERROR: Unsupported interface variable input rank in UpdateInterfaceVariable') + end select end subroutine UpdateInterfaceVariable From bcfcb309e8fca8f9c373fda9331da4a06dc8c065 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Sep 2025 13:06:04 -0700 Subject: [PATCH 084/331] add type-safe selection constructs to the update interface variable procedure --- main/FatesInterfaceVarTypeMod.F90 | 87 ++++++++++++++++++++++++++++--- 1 file changed, 79 insertions(+), 8 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 496aa12c29..8cf29b202c 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -4,7 +4,9 @@ module FatesInterfaceVariableTypeMod ! used to create an indexed list of associated HLM and FATES variables that are ! related across the application programming interface. ! This method is largely inspired by the FATES history infrastructure - + + use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesGlobals, only : fates_log use FatesGlobals, only : endrun => fates_endrun @@ -110,6 +112,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) class(*), pointer :: data_var3d(:,:,:) => null() integer :: index ! index for the subgrid level of the input interface variable + character(len=fates_long_string_length) :: msg_mismatch = 'FATES ERROR: Mismatched interface variable types' ! This update method assumes that the first rank of the HLM data arrays ! corresponds to the subgrid level of the interface variable type. @@ -117,7 +120,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) ! TODO: This should be held in an interface requirements document. ! Get the subgrid index for the updating variable - index = subgrid_indices(var%subgrid_index) + index = subgrid_indices(var%subgrid) ! Update the data pointer based on the rank of the source variable while indexing ! into the appropriate subgrid level @@ -132,19 +135,87 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) case(3) data_var2d => var%data3d(index,:,:) case default - call endrun(fates_log, 'FATES ERROR: Unsupported interface variable source rank in UpdateInterfaceVariable') + write(fates_log(),*) 'FATES ERROR: Unsupported interface variable input rank in UpdateInterfaceVariable' + call endrun(msg=errMsg(__FILE__, __LINE__)) end select - ! Update the data pointer of the target variable based on its rank + ! Update the data of the target variable using the source variable data pointer + ! Make sure the types match for the polymorphic data to allow for copying from the + ! source to the target. + ! Note that due to the use of polymorphic pointers, we must use select type constructs + ! to determine the actual type of the data being pointed to allowing for type-safe assignment. + ! This currently only supports real and integer types and no conversion between types + ! should be performed select case (this%rank) case(0) - this%data0d = data_var0d + select type(dest => this%data0d) + type is (real(r8)) + select type(source => data_var0d) + type is (real(r8)) + dest = source + class default + write(fates_log(),*), msg_mismatch + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + type is (integer) + select type(source => data_var0d) + type is (integer) + dest = source + class default + write(fates_log(),*), msg_mismatch + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + class default + write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select case(1) - this%data1d = data_var1d + select type(dest => this%data1d) + type is (real(r8)) + select type(source => data_var1d) + type is (real(r8)) + dest = source + class default + write(fates_log(),*), msg_mismatch + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + type is (integer) + select type(source => data_var1d) + type is (integer) + dest = source + class default + write(fates_log(),*), msg_mismatch + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + class default + write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select case(2) - this%data2d = data_var2d + select type(dest => this%data2d) + type is (real(r8)) + select type(source => data_var2d) + type is (real(r8)) + dest = source + class default + write(fates_log(),*), msg_mismatch + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + type is (integer) + select type(source => data_var2d) + type is (integer) + dest = source + class default + write(fates_log(),*), msg_mismatch + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + class default + write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select case default - call endrun(fates_log, 'FATES ERROR: Unsupported interface variable input rank in UpdateInterfaceVariable') + write(fates_log(),*) 'FATES ERROR: Unsupported interface variable target rank in UpdateInterfaceVariable' + call endrun(msg=errMsg(__FILE__, __LINE__)) end select end subroutine UpdateInterfaceVariable From 32371cfd716c41e41bf47ad0dbb14c04a78d4f9a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Sep 2025 22:52:17 -0700 Subject: [PATCH 085/331] move subgrid heirarchy values into fates interface types mod --- main/FatesInterfaceMod.F90 | 1 - main/FatesInterfaceTypesMod.F90 | 14 +++++++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index afb24e9147..ab8b017aa9 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2734,7 +2734,6 @@ subroutine UpdateInterfaceVariables(this) ! to ensure that the new patches are provided with the column index patch_api%subgrid_indices(subgrid_column) = this%sites(s)%column_map(currentPatch%patchno) - ! TODO: we need meta data here to correctly associate the right slice of data ! Update the patch boundary condition via the data pointer call patch_api%Update(this%api) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 3c33f7cfd8..832a786acc 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -288,6 +288,14 @@ module FatesInterfaceTypesMod integer, parameter :: hlm_subgrid_levels = 5 ! The number of subgrid hierarchy levels that the HLM ! Including the gridcell level, ELM = 5, CLM = 4 + + ! Subgrid levels for HLM-FATES interface variable + integer, parameter, public :: subgrid_gridcell = 5 + integer, parameter, public :: subgrid_topounit = 4 + integer, parameter, public :: subgrid_landunit = 3 + integer, parameter, public :: subgrid_column = 2 + integer, parameter, public :: subgrid_patch = 1 + ! ------------------------------------------------------------------------------------- ! These vectors are used for history output mapping @@ -974,7 +982,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) use FatesInterfaceVariableTypeMod, only : subgrid_patch - class(fates_interface_registry_base_type) :: thisA + class(fates_interface_registry_base_type) :: this character(len=*), intent(in) :: key ! variable registry key class(*), target, intent(in) :: data(:) ! data to be associated with key @@ -989,7 +997,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) end if ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., subgrid_index_use) + call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., subgrid_index=subgrid_index_use) end subroutine RegisterInterfaceVariables_1d @@ -1017,7 +1025,7 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) end if ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., subgrid_index_use) + call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., subgrid_index=subgrid_index_use) end subroutine RegisterInterfaceVariables_2d From 6e201bcc2ac34bd8c0780b9546d3ce8253b7a790 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Sep 2025 23:11:34 -0700 Subject: [PATCH 086/331] remove superseded transfer bc procedures --- main/EDTypesMod.F90 | 198 -------------------------------------------- 1 file changed, 198 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 1b88162ea4..ebd0ab6ff0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -877,202 +877,4 @@ function get_secondary_young_fraction(this) result(secondary_young_fraction) end function get_secondary_young_fraction - ! ====================================================================================== - - subroutine TransferBCIn_0D_int(this, tag, data) - - class(ed_site_type), intent(inout) :: this - character(len=*), intent(in) :: tag - integer, pointer, intent(in) :: data - - type(fates_patch_type), pointer :: currentPatch - - ! LOCAL - integer :: p ! patch index - - currentPatch => this%oldest_patch - - do while (associated(currentPatch)) - - p = this%patch_map(currentPatch%patchno) - - select case(trim(tag)) - - case('nlevdecomp') - currentPatch%bc_in%nlevdecomp = data - - ! NOTE: should the patch level bc subtypes actually be pointers to the - ! input values instead of copies of the pointer data? Or is not a good idea - ! since the HLM runs on a different time step than fates? - ! If these are not pointers then we really don't have a good way to avoid - ! memory duplicity. - - end select - - currentPatch => currentPatch%younger - - end do - - end subroutine TransferBCIn_0d_int - - ! ====================================================================================== - - ! ====================================================================================== - - subroutine TransferBCIn_1d(this, tag, data) - - class(ed_site_type), intent(inout) :: this - character(len=*), intent(in) :: tag - real(r8), pointer, intent(in) :: data(:) - - type(fates_patch_type), pointer :: currentPatch - - ! LOCAL - integer :: p ! patch index - - currentPatch => this%oldest_patch - - do while (associated(currentPatch)) - - p = this%patch_map(currentPatch%patchno) - - select case(trim(tag)) - - case('leaf_area_index') - currentPatch%bc_in%hlm_sp_tlai = data(p) - - ! NOTE: should the patch level bc subtypes actually be pointers to the - ! input values instead of copies of the pointer data? Or is not a good idea - ! since the HLM runs on a different time step than fates? - ! If these are not pointers then we really don't have a good way to avoid - ! memory duplicity. - - end select - - currentPatch => currentPatch%younger - - end do - - end subroutine TransferBCIn_1d - - ! ====================================================================================== - - subroutine TransferBCIn_2d(this, tag, data) - - class(ed_site_type), intent(inout) :: this - character(len=*), intent(in) :: tag - real(r8), pointer, intent(in) :: data(:,:) - - type(fates_patch_type), pointer :: currentPatch - - ! LOCAL - integer :: c ! HLM column index - - currentPatch => this%oldest_patch - - do while (associated(currentPatch)) - - c = this%column_map(currentPatch%patchno) - - select case(trim(tag)) - - case('decomp_frac_moisture') - currentPatch%bc_in%w_scalar_sisl = data(c,:) - case('decomp_frac_temperature') - currentPatch%bc_in%t_scalar_sisl = data(c,:) - - ! NOTE: should the patch level bc subtypes actually be pointers to the - ! input values instead of copies of the pointer data? Or is not a good idea - ! since the HLM runs on a different time step than fates? - ! If these are not pointers then we really don't have a good way to avoid - ! memory duplicity. - - end select - - currentPatch => currentPatch%younger - - end do - - end subroutine TransferBCIn_2d - -! ====================================================================================== - - subroutine TransferBCOut_1d(this, tag, data, dtime) - - class(ed_site_type), intent(inout) :: this - - character(len=*), intent(in) :: tag ! HLM-FATES common vocab string - real(r8), pointer, intent(inout) :: data(:) ! data pointer associated with tag - real(r8), intent(in) :: dtime ! HLM timestep size in seconds - - type(fates_patch_type), pointer :: currentPatch - - ! LOCAL - integer :: c ! HLM column index - - currentPatch => this%oldest_patch - - do while (associated(currentPatch)) - - c = this%column_map(currentPatch%patchno) - - select case(trim(tag)) - - case('litter_fall') - data(c) = data(c) + sum(currentPatch%bc_out%litt_flux_lab_c_si * currentPatch%bc_in%dz_decomp_sisl) & - + sum(currentPatch%bc_out%litt_flux_cel_c_si * currentPatch%bc_in%dz_decomp_sisl) & - + sum(currentPatch%bc_out%litt_flux_lig_c_si * currentPatch%bc_in%dz_decomp_sisl) - - end select - - currentPatch => currentPatch%younger - - end do - - end subroutine TransferBCOut_1d - -! ====================================================================================== - - subroutine TransferBCOut_2d(this, tag, data, dtime) - - class(ed_site_type), intent(inout) :: this - - character(len=*), intent(in) :: tag ! HLM-FATES common vocab string - real(r8), pointer, intent(inout) :: data(:,:) ! data pointer associated with tag - real(r8), intent(in) :: dtime ! HLM timestep size in seconds - - type(fates_patch_type), pointer :: currentPatch - - ! LOCAL - integer :: c ! HLM column index - - currentPatch => this%oldest_patch - - do while (associated(currentPatch)) - - c = this%column_map(currentPatch%patchno) - - select case(trim(tag)) - - ! For the decomposition carbon pools, the host land model uses - ! a 3D array, where the third dimension signifies the litter type. - ! The HLM sets up a pointer to a 2D slice of the variable so we - ! don't have to worry about that here. - ! We convert the bc_out from per second to per timestep - case('decomp_cpools_met') - data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lab_c_si * dtime - case('decomp_cpools_cel') - data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_cel_c_si * dtime - case('decomp_cpools_lig') - data(c,:) = data(c,:) + currentPatch%bc_out%litt_flux_lig_c_si * dtime - - end select - - currentPatch => currentPatch%younger - - end do - - end subroutine TransferBCOut_2d - - end module EDTypesMod From 1b475e34e97f31e14128be35a74be805b1f32eec Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 10:22:09 -0700 Subject: [PATCH 087/331] add intent in to all registry subroutines --- biogeochem/FatesPatchMod.F90 | 2 +- main/FatesInterfaceTypesMod.F90 | 18 +++++++++--------- main/FatesInterfaceVarTypeMod.F90 | 18 +++++++++--------- 3 files changed, 19 insertions(+), 19 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 662cfc5f81..285667ffd8 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -1377,7 +1377,7 @@ end subroutine CheckVars subroutine RegisterFatesInterfaceVariables(this) - class(fates_patch_type) :: this + class(fates_patch_type), intent(inout) :: this ! Initialize the HLM-FATES interface variable registry for the FATES-side call this%api%InitializeInterfaceRegistry() diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 832a786acc..31cdea537d 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -908,7 +908,7 @@ subroutine InitializeInterfaceRegistry(this) ! This initializes the interface registry - class(fates_interface_registry_base_type) :: this + class(fates_interface_registry_base_type), intent(inout) :: this logical :: initialize @@ -934,7 +934,7 @@ subroutine DefineInterfaceRegistry(this, initialize) ! This procedure defines the list of common names to be associated with FATES and HLM ! variables. - class(fates_interface_registry_base_type) :: this + class(fates_interface_registry_base_type), intent(inout) :: this logical, intent(in) :: initialize ! false = count up the keys in the registry @@ -957,7 +957,7 @@ end subroutine DefineInterfaceRegistry subroutine DefineInterfaceVariable(this, key, index, initialize) - class(fates_interface_registry_base_type) :: this + class(fates_interface_registry_base_type), intent(inout) :: this character(len=*), intent(in) :: key integer, intent(inout) :: index @@ -982,7 +982,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) use FatesInterfaceVariableTypeMod, only : subgrid_patch - class(fates_interface_registry_base_type) :: this + class(fates_interface_registry_base_type), intent(inout) :: this character(len=*), intent(in) :: key ! variable registry key class(*), target, intent(in) :: data(:) ! data to be associated with key @@ -1010,7 +1010,7 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) use FatesInterfaceVariableTypeMod, only : subgrid_patch - class(fates_interface_registry_base_type) :: this + class(fates_interface_registry_base_type), intent(inout) :: this character(len=*), intent(in) :: key ! variable registry key class(*), target, intent(in) :: data(:,:) ! data to be associated with key @@ -1033,8 +1033,8 @@ end subroutine RegisterInterfaceVariables_2d subroutine UpdateInterfaceVariables(this, api) - class(fates_interface_registry_base_type) :: this ! registry being updated - class(fates_interface_registry_base_type), intent(in) :: api ! registry update source + class(fates_interface_registry_base_type), intent(inout) :: this ! registry being updated + class(fates_interface_registry_base_type), intent(in) :: api ! registry update source integer :: i integer :: j @@ -1056,7 +1056,7 @@ integer function GetRegistryIndex(this, key) result(index) ! This procedure returns the index associated with the key provided - class(fates_interface_registry_base_type) :: this + class(fates_interface_registry_base_type), intent(in) :: this character(len=*), intent(in) :: key ! variable registry key to search @@ -1078,7 +1078,7 @@ function GetRegistryKey(this, index) result(key) ! This procedure returns the index associated with the key provided - class(fates_interface_registry_base_type) :: this + class(fates_interface_registry_base_type), intent(in) :: this integer, intent(in) :: index ! variable registry index character(len=:), allocatable :: key diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 8cf29b202c..7c543aa6dc 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -51,7 +51,7 @@ module FatesInterfaceVariableTypeMod subroutine InitializeInterfaceVariable(this, key) - class(fates_interface_variable_type) :: this + class(fates_interface_variable_type), intent(inout) :: this character(len=*), intent(in) :: key @@ -67,8 +67,8 @@ end subroutine InitializeInterfaceVariable ! ==================================================================================== subroutine RegisterInterfaceVariable_1d(this, data, active, subgrid_index) - - class(fates_interface_variable_type) :: this + + class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:) logical, intent(in) :: active @@ -84,8 +84,8 @@ end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== subroutine RegisterInterfaceVariable_2d(this, data, active, subgrid_index) - - class(fates_interface_variable_type) :: this + + class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active @@ -101,10 +101,10 @@ end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== subroutine UpdateInterfaceVariable(this, var, subgrid_indices) - - class(fates_interface_variable_type) :: this ! variable being updated - class(fates_interface_variable_type), intent(in) :: var ! variable update source - integer, intent(in) :: subgrid_indices(:) ! subgrid indices for the update source + + class(fates_interface_variable_type), intent(inout) :: this ! variable being updated + class(fates_interface_variable_type), intent(in) :: var ! variable update source + integer, intent(in) :: subgrid_indices(:) ! subgrid indices for the update source class(*), pointer :: data_var0d => null() class(*), pointer :: data_var1d(:) => null() From 16924aa0cd42f67457f729aefd97ed4cfbf9e655 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 10:22:39 -0700 Subject: [PATCH 088/331] remove defunct transferbcin/out procedures in patch type --- main/EDTypesMod.F90 | 9 --------- 1 file changed, 9 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index ebd0ab6ff0..90250515ca 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -609,15 +609,6 @@ module EDTypesMod procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction - procedure, private :: TransferBCIn_0d_int - procedure, private :: TransferBCIn_1d - procedure, private :: TransferBCIn_2d - generic, public :: TransferBCIn => TransferBCIn_0d_int, TransferBCIn_1d, TransferBCIn_2d - - procedure, private :: TransferBCOut_1d - procedure, private :: TransferBCOut_2d - generic, public :: TransferBCOut => TransferBCOut_1d, TransferBCOut_2d - end type ed_site_type ! Make public necessary subroutines and functions From c0014973e9b9643ef8d5fcfadc270f5e336316a3 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 10:46:33 -0700 Subject: [PATCH 089/331] add data size to the var type --- main/FatesInterfaceVarTypeMod.F90 | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 7c543aa6dc..b9a8b1fc42 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -12,6 +12,7 @@ module FatesInterfaceVariableTypeMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : fates_long_string_length + use FatesConstantsMod, only : fates_unset_int implicit none private @@ -31,8 +32,9 @@ module FatesInterfaceVariableTypeMod class(*), pointer :: data2d(:,:) ! 2D polymorphic data pointer class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer logical :: active ! true if the variable is used by the host land model - integer :: rank ! rank of the variable (0, 1, 2, or 3) + integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: subgrid ! subgrid level (0 = gridcell, 1 = landunit, 2 = column, 3 = patch) + integer, allocatable :: data_size(:) ! size of the first dimension of the variable contains procedure :: Initialize => InitializeInterfaceVariable @@ -55,13 +57,17 @@ subroutine InitializeInterfaceVariable(this, key) character(len=*), intent(in) :: key + allocate(this%data_size(3)) + + this%data_size = fates_unset_int + this%data_rank = fates_unset_int this%data0d => null() this%data1d => null() this%data2d => null() this%data3d => null() this%key = key this%active = .false. - + end subroutine InitializeInterfaceVariable ! ==================================================================================== @@ -77,7 +83,8 @@ subroutine RegisterInterfaceVariable_1d(this, data, active, subgrid_index) this%data1d => data(:) this%active = active this%subgrid = subgrid_index - this%rank = rank(data) + this%data_rank = rank(data) + this%data_size(1) = size(data, dim=1) end subroutine RegisterInterfaceVariable_1d @@ -94,8 +101,10 @@ subroutine RegisterInterfaceVariable_2d(this, data, active, subgrid_index) this%data2d => data(:,:) this%active = active this%subgrid = subgrid_index - this%rank = rank(data) - + this%data_rank = rank(data) + this%data_size(1) = size(data, dim=1) + this%data_size(2) = size(data, dim=2) + end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== @@ -116,7 +125,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) ! This update method assumes that the first rank of the HLM data arrays ! corresponds to the subgrid level of the interface variable type. - ! E.g. col_cf%w_scalar(c,1:nlevsoil) shows that the first rank is the column index. + ! E.g. col_cf%w_scalar(c,1:nlevsoil) shows that the first dimension is the column index. ! TODO: This should be held in an interface requirements document. ! Get the subgrid index for the updating variable @@ -125,7 +134,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) ! Update the data pointer based on the rank of the source variable while indexing ! into the appropriate subgrid level ! TODO: This assumes HLM->FATES direction; Validate this for FATES->HLM direction - select case (var%rank) + select case (var%data_rank) case(0) data_var0d => var%data0d case(1) @@ -146,7 +155,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) ! to determine the actual type of the data being pointed to allowing for type-safe assignment. ! This currently only supports real and integer types and no conversion between types ! should be performed - select case (this%rank) + select case (this%data_rank) case(0) select type(dest => this%data0d) type is (real(r8)) From 7cf0087f17bc116b4fec30fbd9272e3e25932e89 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 11:08:26 -0700 Subject: [PATCH 090/331] add dimension error diagnostics to the var type --- main/FatesInterfaceVarTypeMod.F90 | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index b9a8b1fc42..bc9569601e 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -178,7 +178,17 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' call endrun(msg=errMsg(__FILE__, __LINE__)) end select + case(1) + + ! Check that the dimensions of the source and target match + if (this%data_size(1) /= size(data_var1d)) then + write(fates_log(),*) 'FATES ERROR: Mismatched interface variable sizes in UpdateInterfaceVariable' + write(fates_log(),*) ' Target, size: ', this%key, this%data_size(1) + write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + select type(dest => this%data1d) type is (real(r8)) select type(source => data_var1d) @@ -201,6 +211,16 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) call endrun(msg=errMsg(__FILE__, __LINE__)) end select case(2) + + ! Check that the dimensions of the source and target match + if (this%data_size(1) /= size(data_var2d) .or. & + this%data_size(2) /= size(data_var2d, 2)) then + write(fates_log(),*) 'FATES ERROR: Mismatched interface variable sizes in UpdateInterfaceVariable' + write(fates_log(),*) ' Target, size: ', this%key, this%data_size(1), this%data_size(2) + write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1), var%data_size(2) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + select type(dest => this%data2d) type is (real(r8)) select type(source => data_var2d) From 05c8db93ef2058ae83f42f539f0a980e1f5087a9 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 11:32:28 -0700 Subject: [PATCH 091/331] convert variable size comparison error checking to a subroutine --- main/FatesInterfaceVarTypeMod.F90 | 49 ++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 14 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index bc9569601e..709cb845ce 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -41,9 +41,10 @@ module FatesInterfaceVariableTypeMod procedure :: Update => UpdateInterfaceVariable generic :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d - procedure, private :: RegisterInterfaceVariable_1d procedure, private :: RegisterInterfaceVariable_2d + + procedure, private :: CompareRegistryVariableSizes end type fates_interface_variable_type @@ -182,12 +183,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) case(1) ! Check that the dimensions of the source and target match - if (this%data_size(1) /= size(data_var1d)) then - write(fates_log(),*) 'FATES ERROR: Mismatched interface variable sizes in UpdateInterfaceVariable' - write(fates_log(),*) ' Target, size: ', this%key, this%data_size(1) - write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1) - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if + call this%CompareRegistryVariableSizes(var) select type(dest => this%data1d) type is (real(r8)) @@ -213,13 +209,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) case(2) ! Check that the dimensions of the source and target match - if (this%data_size(1) /= size(data_var2d) .or. & - this%data_size(2) /= size(data_var2d, 2)) then - write(fates_log(),*) 'FATES ERROR: Mismatched interface variable sizes in UpdateInterfaceVariable' - write(fates_log(),*) ' Target, size: ', this%key, this%data_size(1), this%data_size(2) - write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1), var%data_size(2) - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if + call this%CompareRegistryVariableSizes(var) select type(dest => this%data2d) type is (real(r8)) @@ -249,6 +239,37 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) end subroutine UpdateInterfaceVariable + ! ==================================================================================== + + subroutine CompareRegistryVariableSizes(this, var) + + class(fates_interface_variable_type), intent(in) :: this ! variable being updated + class(fates_interface_variable_type), intent(in) :: var ! variable update source + + if (this%data_size(1) /= var%data_size(1) .or. & + this%data_size(2) /= var%data_size(2) .or. & + this%data_size(3) /= var%data_size(3)) then + + write(fates_log(),*) 'FATES ERROR: Mismatched interface variable sizes in UpdateInterfaceVariable' + + if (this%data_rank == 1) then + write(fates_log(),*) ' Target, size: ', this%key, this%data_size(1) + write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1) + else if (this%data_rank == 2) then + write(fates_log(),*) ' Target, size: ', this%key, this%data_size(1), this%data_size(2) + write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1), var%data_size(2) + else if (this%data_rank == 3) then + write(fates_log(),*) ' Target, size: ', this%key, this%data_size(1), this%data_size(2), this%data_size(3) + write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1), var%data_size(2), var%data_size(3) + else + write(fates_log(),*) ' Unsupported interface variable rank in UpdateErrorMessage' + end if + + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine CompareRegistryVariableSizes + ! ==================================================================================== end module FatesInterfaceVariableTypeMod \ No newline at end of file From 1e6914f0fd16efcda1853a1a3e8b2346bc6ee9f2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 11:57:05 -0700 Subject: [PATCH 092/331] add scalar interface register subroutine --- main/FatesInterfaceTypesMod.F90 | 37 ++++++++++++++++++++++++++++--- main/FatesInterfaceVarTypeMod.F90 | 22 +++++++++++++++++- 2 files changed, 55 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 31cdea537d..301c35a606 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -872,12 +872,15 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceRegistry procedure :: Update => UpdateInterfaceVariables - generic :: Register => RegisterInterfaceVariables_1d, RegisterInterfaceVariables_2d + generic :: Register => RegisterInterfaceVariables_0d, & + RegisterInterfaceVariables_1d, & + RegisterInterfaceVariables_2d + procedure, private :: RegisterInterfaceVariables_0d + procedure, private :: RegisterInterfaceVariables_1d + procedure, private :: RegisterInterfaceVariables_2d procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable - procedure, private :: RegisterInterfaceVariables_1d - procedure, private :: RegisterInterfaceVariables_2d procedure, private :: GetRegistryIndex procedure, private :: GetRegistryKey @@ -975,6 +978,34 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== + subroutine RegisterInterfaceVariables_0d(this, key, data, subgrid_index) + + ! This procedure is called by the to associate a data variable + ! with a particular registry key + + use FatesInterfaceVariableTypeMod, only : subgrid_patch + + class(fates_interface_registry_base_type), intent(inout) :: this + + character(len=*), intent(in) :: key ! variable registry key + class(*), target, intent(in) :: data ! data to be associated with key + integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable + + integer :: subgrid_index_use + + if (present(subgrid_index)) then + subgrid_index_use = subgrid_index + else + subgrid_index_use = subgrid_patch + end if + + ! Get index from registry key and associate the given data pointer + call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true., subgrid_index=subgrid_index_use) + + end subroutine RegisterInterfaceVariables_0d + + ! ====================================================================================== + subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) ! This procedure is called by the to associate a data variable diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 709cb845ce..ec5844aa7d 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -40,7 +40,10 @@ module FatesInterfaceVariableTypeMod procedure :: Initialize => InitializeInterfaceVariable procedure :: Update => UpdateInterfaceVariable - generic :: Register => RegisterInterfaceVariable_1d, RegisterInterfaceVariable_2d + generic :: Register => RegisterInterfaceVariable_0d, & + RegisterInterfaceVariable_1d, & + RegisterInterfaceVariable_2d + procedure, private :: RegisterInterfaceVariable_0d procedure, private :: RegisterInterfaceVariable_1d procedure, private :: RegisterInterfaceVariable_2d @@ -71,6 +74,23 @@ subroutine InitializeInterfaceVariable(this, key) end subroutine InitializeInterfaceVariable + ! ==================================================================================== + + subroutine RegisterInterfaceVariable_0d(this, data, active, subgrid_index) + + class(fates_interface_variable_type), intent(inout) :: this + + class(*), target, intent(in) :: data + logical, intent(in) :: active + integer, intent(in) :: subgrid_index + + this%data0d => data + this%active = active + this%subgrid = subgrid_index + this%data_rank = rank(data) + + end subroutine RegisterInterfaceVariable_0d + ! ==================================================================================== subroutine RegisterInterfaceVariable_1d(this, data, active, subgrid_index) From 2e0028777ad690d974fb160852d0244476583ea7 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 12:05:21 -0700 Subject: [PATCH 093/331] add nlevsoil to patch-level bcin --- biogeochem/FatesPatchMod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 285667ffd8..70f012214d 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -561,6 +561,7 @@ subroutine NanValues(this) this%bc_in%w_scalar_sisl(:) = nan this%bc_in%t_scalar_sisl(:) = nan this%bc_in%nlevdecomp = fates_unset_int + this%bc_in%nlevsoil = fates_unset_int end subroutine NanValues @@ -654,6 +655,7 @@ subroutine ZeroValues(this) this%bc_in%w_scalar_sisl(:) = 0.0_r8 this%bc_in%t_scalar_sisl(:) = 0.0_r8 this%bc_in%nlevdecomp = 0.0_r8 + this%bc_in%nlevsoil = 0.0_r8 end subroutine ZeroValues @@ -1383,6 +1385,7 @@ subroutine RegisterFatesInterfaceVariables(this) call this%api%InitializeInterfaceRegistry() ! Register the FATES boundary condition data variables + call this%api%Register('soil_level_number', this%bc_in%nlevsoil) call this%api%Register('decomp_frac_moisture', this%bc_in%w_scalar_sisl) call this%api%Register('decomp_frac_temperature', this%bc_in%t_scalar_sisl) From caece8c31249f26ed325037141d8eb14178c93ba Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 14:37:48 -0700 Subject: [PATCH 094/331] add interface key names as parameter variables --- biogeochem/FatesPatchMod.F90 | 10 +++++++--- main/FatesInterfaceTypesMod.F90 | 15 +++++++-------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 70f012214d..a2e18a4ccb 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -1379,15 +1379,19 @@ end subroutine CheckVars subroutine RegisterFatesInterfaceVariables(this) + use FatesInterfaceTypesMod, only: hlm_fates_soil_level + use FatesInterfaceTypesMod, only: hlm_fates_decomp_frac_moisture + use FatesInterfaceTypesMod, only: hlm_fates_decomp_frac_temperature + class(fates_patch_type), intent(inout) :: this ! Initialize the HLM-FATES interface variable registry for the FATES-side call this%api%InitializeInterfaceRegistry() ! Register the FATES boundary condition data variables - call this%api%Register('soil_level_number', this%bc_in%nlevsoil) - call this%api%Register('decomp_frac_moisture', this%bc_in%w_scalar_sisl) - call this%api%Register('decomp_frac_temperature', this%bc_in%t_scalar_sisl) + call this%api%Register(hlm_fates_soil_level, this%bc_in%nlevsoil) + call this%api%Register(hlm_fates_decomp_frac_moisture, this%bc_in%w_scalar_sisl) + call this%api%Register(hlm_fates_decomp_frac_temperature, this%bc_in%t_scalar_sisl) end subroutine RegisterFatesInterfaceVariables diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 301c35a606..a79898761e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -290,12 +290,10 @@ module FatesInterfaceTypesMod ! Including the gridcell level, ELM = 5, CLM = 4 ! Subgrid levels for HLM-FATES interface variable - integer, parameter, public :: subgrid_gridcell = 5 - integer, parameter, public :: subgrid_topounit = 4 - integer, parameter, public :: subgrid_landunit = 3 - integer, parameter, public :: subgrid_column = 2 - integer, parameter, public :: subgrid_patch = 1 - + ! Registry keys parameters + character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' + character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' + character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' ! ------------------------------------------------------------------------------------- ! These vectors are used for history output mapping @@ -947,8 +945,9 @@ subroutine DefineInterfaceRegistry(this, initialize) ivar = 0 ! Define the interface registry names and indices - call this%DefineInterfaceVariable(key='decomp_frac_moisture', index=ivar, initialize=initialize) - call this%DefineInterfaceVariable(key='decomp_frac_temperature', index=ivar, initialize=initialize) + call this%DefineInterfaceVariable(key=hlm_fates_soil_level, index=ivar, initialize=initialize) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, index=ivar, initialize=initialize) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, index=ivar, initialize=initialize) ! Set the registry size based on the final update of ivar this%num_api_vars = ivar From bd50484561a14f03e823fee57f1b49dc46a39654 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 14:38:53 -0700 Subject: [PATCH 095/331] move subgrid index types into fatesinterfacetypesmod --- main/FatesInterfaceMod.F90 | 4 ++-- main/FatesInterfaceTypesMod.F90 | 33 +++++++++++++++++-------------- main/FatesInterfaceVarTypeMod.F90 | 16 ++++++++------- 3 files changed, 29 insertions(+), 24 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index ab8b017aa9..68cf409853 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2712,7 +2712,7 @@ end subroutine FatesReadParameters subroutine UpdateInterfaceVariables(this) - use FatesInterfaceVariableTypeMod, only : subgrid_column + use FatesInterfaceTypesMod, only : subgrid_column_index class(fates_interface_type), intent(inout) :: this @@ -2732,7 +2732,7 @@ subroutine UpdateInterfaceVariables(this) ! Transfer the column index to the patch registry ! While this may be duplicative for older patches, we need ! to ensure that the new patches are provided with the column index - patch_api%subgrid_indices(subgrid_column) = this%sites(s)%column_map(currentPatch%patchno) + patch_api%subgrid_indices(subgrid_column_index) = this%sites(s)%column_map(currentPatch%patchno) ! Update the patch boundary condition via the data pointer call patch_api%Update(this%api) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index a79898761e..0aa6d0a86a 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -290,6 +290,12 @@ module FatesInterfaceTypesMod ! Including the gridcell level, ELM = 5, CLM = 4 ! Subgrid levels for HLM-FATES interface variable + integer, parameter, public :: subgrid_gridcell_index = 5 + integer, parameter, public :: subgrid_topounit_index = 4 + integer, parameter, public :: subgrid_landunit_index = 3 + integer, parameter, public :: subgrid_column_index = 2 + integer, parameter, public :: subgrid_patch_index = 1 + ! Registry keys parameters character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' @@ -858,12 +864,14 @@ module FatesInterfaceTypesMod ! Base type to be extended for the API registry type, public :: fates_interface_registry_base_type + ! container array of interface variables + type(fates_interface_variable_type), allocatable :: vars(:) + + ! registry metadata integer :: num_api_vars ! number of variables in the registry integer :: subgrid_indices(hlm_subgrid_levels) ! HLM patch ID associated with this patch ! 1 = patch, 2 = column, 3 = landunit, 4 = topounit, 5 = gridcell - ! container array of interface variables - type(fates_interface_variable_type), allocatable :: vars(:) contains @@ -982,12 +990,10 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, subgrid_index) ! This procedure is called by the to associate a data variable ! with a particular registry key - use FatesInterfaceVariableTypeMod, only : subgrid_patch - class(fates_interface_registry_base_type), intent(inout) :: this - character(len=*), intent(in) :: key ! variable registry key class(*), target, intent(in) :: data ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable integer :: subgrid_index_use @@ -995,7 +1001,7 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, subgrid_index) if (present(subgrid_index)) then subgrid_index_use = subgrid_index else - subgrid_index_use = subgrid_patch + subgrid_index_use = subgrid_patch_index end if ! Get index from registry key and associate the given data pointer @@ -1010,12 +1016,10 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) ! This procedure is called by the to associate a data variable ! with a particular registry key - use FatesInterfaceVariableTypeMod, only : subgrid_patch - class(fates_interface_registry_base_type), intent(inout) :: this - character(len=*), intent(in) :: key ! variable registry key class(*), target, intent(in) :: data(:) ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable integer :: subgrid_index_use @@ -1023,7 +1027,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) if (present(subgrid_index)) then subgrid_index_use = subgrid_index else - subgrid_index_use = subgrid_patch + subgrid_index_use = subgrid_patch_index end if ! Get index from registry key and associate the given data pointer @@ -1038,12 +1042,10 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) ! This procedure is called by the to associate a data variable ! with a particular registry key - use FatesInterfaceVariableTypeMod, only : subgrid_patch - class(fates_interface_registry_base_type), intent(inout) :: this - character(len=*), intent(in) :: key ! variable registry key class(*), target, intent(in) :: data(:,:) ! data to be associated with key + character(len=*), intent(in) :: key ! variable registry key integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable integer :: subgrid_index_use @@ -1051,7 +1053,7 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) if (present(subgrid_index)) then subgrid_index_use = subgrid_index else - subgrid_index_use = subgrid_patch + subgrid_index_use = subgrid_patch_index end if ! Get index from registry key and associate the given data pointer @@ -1069,9 +1071,10 @@ subroutine UpdateInterfaceVariables(this, api) integer :: i integer :: j + ! Iterate over all registered variables do i = 1, this%num_api_vars - ! Don't assume the index in the registry is the same as in the interface + ! Don't assume the index in the calling registry is the same as in the input registry j = api%GetRegistryIndex(api%GetRegistryKey(i)) ! Update the registered variable and pass the subgrid indices information diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index ec5844aa7d..dc49697e93 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -17,12 +17,6 @@ module FatesInterfaceVariableTypeMod implicit none private - integer, parameter, public :: subgrid_gridcell = 5 - integer, parameter, public :: subgrid_topounit = 4 - integer, parameter, public :: subgrid_landunit = 3 - integer, parameter, public :: subgrid_column = 2 - integer, parameter, public :: subgrid_patch = 1 - ! Interface registry variable type type, public :: fates_interface_variable_type @@ -32,8 +26,8 @@ module FatesInterfaceVariableTypeMod class(*), pointer :: data2d(:,:) ! 2D polymorphic data pointer class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer logical :: active ! true if the variable is used by the host land model - integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: subgrid ! subgrid level (0 = gridcell, 1 = landunit, 2 = column, 3 = patch) + integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer, allocatable :: data_size(:) ! size of the first dimension of the variable contains @@ -151,6 +145,14 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) ! Get the subgrid index for the updating variable index = subgrid_indices(var%subgrid) + + ! Check that the index is valid + if (index == fates_unset_int) then + write(fates_log(),*) 'FATES ERROR: Unset subgrid index in UpdateInterfaceVariable' + write(fates_log(),*) ' Variable key, subgrid level: ', var%key, var%subgrid + write(fates_log(),*) ' API subgrid indices: ', subgrid_indices + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if ! Update the data pointer based on the rank of the source variable while indexing ! into the appropriate subgrid level From b4a3edcc01701a2c8f99f64e30cd79b1eab28763 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 15:50:37 -0700 Subject: [PATCH 096/331] move patch_api pointer update inside the do while --- main/FatesInterfaceMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 68cf409853..e46a3a0897 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2726,10 +2726,11 @@ subroutine UpdateInterfaceVariables(this) do s = 1, this%nsites currentPatch => this%sites(s)%oldest_patch - patch_api => currentPatch%api do while (associated(currentPatch)) - ! Transfer the column index to the patch registry + patch_api => currentPatch%api + + ! Transfer the column index to the HLM interface registry ! While this may be duplicative for older patches, we need ! to ensure that the new patches are provided with the column index patch_api%subgrid_indices(subgrid_column_index) = this%sites(s)%column_map(currentPatch%patchno) From 91e6307261a2ba32bd7b01245b5b2a019225b4be Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 15:51:27 -0700 Subject: [PATCH 097/331] todo comment updates --- main/FatesInterfaceMod.F90 | 6 ++++-- main/FatesInterfaceTypesMod.F90 | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index e46a3a0897..652258fec5 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2735,9 +2735,11 @@ subroutine UpdateInterfaceVariables(this) ! to ensure that the new patches are provided with the column index patch_api%subgrid_indices(subgrid_column_index) = this%sites(s)%column_map(currentPatch%patchno) - ! Update the patch boundary condition via the data pointer + ! Update the patch boundary condition via the HLM Interface data pointer call patch_api%Update(this%api) - + + ! TODO: Update the HLM interface variables with the patch variables here + currentPatch => currentPatch%younger end do end do diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 0aa6d0a86a..877143f5e6 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -868,6 +868,7 @@ module FatesInterfaceTypesMod type(fates_interface_variable_type), allocatable :: vars(:) ! registry metadata + ! TODO: make an extended type for the HLM interface that holds the subgrid info integer :: num_api_vars ! number of variables in the registry integer :: subgrid_indices(hlm_subgrid_levels) ! HLM patch ID associated with this patch ! 1 = patch, 2 = column, 3 = landunit, 4 = topounit, 5 = gridcell From 88d0bd40f6132cb80d72655f60ce3886c1dec483 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 15:51:42 -0700 Subject: [PATCH 098/331] removed unused indexers --- main/FatesInterfaceMod.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 652258fec5..f397bb5dce 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2720,9 +2720,6 @@ subroutine UpdateInterfaceVariables(this) class(fates_patch_type), pointer :: currentPatch integer :: s ! site index - integer :: i ! HLM registry index - integer :: j ! FATES registry index - integer :: c = 1 ! column index, TODO: update do s = 1, this%nsites currentPatch => this%sites(s)%oldest_patch From c6b3e9792ab2312fd0307b584838d9564e2847f1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 15:53:28 -0700 Subject: [PATCH 099/331] Correct which api has the subgrid indice update. Technically we don't really need a subgrid_indices array for the patch-side currently. --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index f397bb5dce..a998c9d27d 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2730,7 +2730,7 @@ subroutine UpdateInterfaceVariables(this) ! Transfer the column index to the HLM interface registry ! While this may be duplicative for older patches, we need ! to ensure that the new patches are provided with the column index - patch_api%subgrid_indices(subgrid_column_index) = this%sites(s)%column_map(currentPatch%patchno) + this%api%subgrid_indices(subgrid_column_index) = this%sites(s)%column_map(currentPatch%patchno) ! Update the patch boundary condition via the HLM Interface data pointer call patch_api%Update(this%api) From f5d74861d20ffa6fda1e0d35ff7df132a5816060 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 12 Sep 2025 16:27:20 -0700 Subject: [PATCH 100/331] adding comments for next steps --- biogeochem/FatesPatchMod.F90 | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index a2e18a4ccb..6c8f06e2fc 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -309,6 +309,18 @@ subroutine Init(this, num_swb, num_levsoil) allocate(this%sabs_dif(num_swb)) allocate(this%fragmentation_scaler(num_levsoil)) allocate(this%co_scr(max_cohort_per_patch)) + + ! Allocate API registry + call this%RegisterFatesInterfaceVariables() + + ! TODO: Create subroutine to update a subset of interface variables here + ! Problem: How do we get the HLM interface registry pointer? + ! Possible solution: move the boundary condition initialization into a different + ! procedure? Also have a separate registry for the scalars that are used for + ! allocations? + ! call this%InitializeInterfaceVariables() + + ! Allocate BC arrays. This must be done after the API registry is updated. allocate(this%bc_in%w_scalar_sisl(num_levsoil)) allocate(this%bc_in%t_scalar_sisl(num_levsoil)) @@ -316,9 +328,6 @@ subroutine Init(this, num_swb, num_levsoil) allocate(this%bc_out%litt_flux_lig_c_si(this%bc_in%nlevdecomp)) allocate(this%bc_out%litt_flux_lab_c_si(this%bc_in%nlevdecomp)) - ! Allocate API registry - call this%RegisterFatesInterfaceVariables() - ! initialize all values to nan call this%NanValues() From e9ada1422d4923009e47e3feded22418e1e51bb2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 17 Sep 2025 10:37:02 -0700 Subject: [PATCH 101/331] add update frequency to the registry variable type and and counters to the api registry type This will help next development steps in which the update of certain variables will be conducted prior to others --- main/FatesInterfaceTypesMod.F90 | 86 ++++++++++++++++++++++++++----- main/FatesInterfaceVarTypeMod.F90 | 12 +++-- 2 files changed, 82 insertions(+), 16 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 877143f5e6..f91362534e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -300,7 +300,13 @@ module FatesInterfaceTypesMod character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' - + + ! Registry update frequency parameters + integer, parameter :: registry_update_init = 1 ! variable only needs to be updated during initialization + integer, parameter :: registry_update_daily = 2 ! variable needs to be updated daily + integer, parameter :: registry_update_timestep = 3 ! variable needs to be updated at each timestep + integer, parameter :: registry_update_types_num = 3 ! number of update frequency types + ! ------------------------------------------------------------------------------------- ! These vectors are used for history output mapping ! CLM/ALM have limited support for multi-dimensional history output arrays. @@ -870,6 +876,9 @@ module FatesInterfaceTypesMod ! registry metadata ! TODO: make an extended type for the HLM interface that holds the subgrid info integer :: num_api_vars ! number of variables in the registry + integer :: num_api_vars_update_init ! number of variables that update only at initialization + integer :: num_api_vars_update_daily ! number of variables that update daily + integer :: subgrid_indices(hlm_subgrid_levels) ! HLM patch ID associated with this patch ! 1 = patch, 2 = column, 3 = landunit, 4 = topounit, 5 = gridcell @@ -922,17 +931,23 @@ subroutine InitializeInterfaceRegistry(this) logical :: initialize - ! unset registry integers - this%num_api_vars = fates_unset_int + ! initial registry integers + this%num_api_vars = 0 + this%num_api_vars_update_init = 0 + this%num_api_vars_update_daily = 0 this%subgrid_indices = fates_unset_int ! First count up the keys defined in the registry call this%DefineInterfaceRegistry(initialize=.false.) - ! Allocate the registry + ! Allocate the registry variables array allocate(this%vars(this%num_api_vars)) + + ! Allocate the index maps + allocate(this%index_filter_init(this%num_api_vars_update_init)) + allocate(this%index_filter_daily(this%num_api_vars_update_daily)) - ! Now set up the registry keys + ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) end subroutine InitializeInterfaceRegistry @@ -966,20 +981,65 @@ end subroutine DefineInterfaceRegistry ! ====================================================================================== - subroutine DefineInterfaceVariable(this, key, index, initialize) + subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequency) class(fates_interface_registry_base_type), intent(inout) :: this - character(len=*), intent(in) :: key - integer, intent(inout) :: index - logical, intent(in) :: initialize + character(len=*), intent(in) :: key + logical, intent(in) :: initialize + integer, intent(inout) :: index + integer, intent(in), optional :: update_frequency - ! Increment the index to return count - index = index + 1 + ! Local variables + integer :: index_type + integer :: update_frequency_local + + ! Increment the index + index = index + 1 - ! If we are initializing the + ! If not initializing, increment the registry count variables, otherwise initialize the variable at the correct index if (initialize) then - call this%vars(index)%Initialize(key) + + ! Initialize the variable + if (present(update_frequency)) then + select case (update_frequency) + case (registry_update_init) + update_frequency_local = registry_update_init + case (registry_update_daily) + update_frequency_local = registry_update_daily + case default + write(fates_log(),*) 'ERROR: Unrecognized update frequency in DefineInterfaceVariable(): ', update_frequency + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + else + ! Default to daily update frequency + update_frequency_local = registry_update_daily + end if + + call this%vars(index)%Initialize(key, update_frequency_local) + + ! Not initializing, just counting the variables + else + + ! Increment the total API count + this%num_api_vars = this%num_api_vars + 1 + + ! Increment the count for the update frequency counts, defaulting to daily if not specified + if (present(update_frequency)) then + select case (update_frequency) + case (registry_update_init) + this%num_api_vars_update_init = this%num_api_vars_update_init + 1 + case (registry_update_daily) + this%num_api_vars_update_daily = this%num_api_vars_update_daily + 1 + case default + write(fates_log(),*) 'ERROR: Unrecognized update frequency in DefineInterfaceVariable(): ', update_frequency + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + else + ! Default to daily update frequency + this%num_api_vars_update_daily = this%num_api_vars_update_daily + 1 + end if + end if end subroutine DefineInterfaceVariable diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index dc49697e93..9c21f21b69 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -28,6 +28,7 @@ module FatesInterfaceVariableTypeMod logical :: active ! true if the variable is used by the host land model integer :: subgrid ! subgrid level (0 = gridcell, 1 = landunit, 2 = column, 3 = patch) integer :: data_rank ! rank of the variable (0, 1, 2, or 3) + integer :: update_frequency ! frequency of updates integer, allocatable :: data_size(:) ! size of the first dimension of the variable contains @@ -49,23 +50,28 @@ module FatesInterfaceVariableTypeMod ! ==================================================================================== - subroutine InitializeInterfaceVariable(this, key) + subroutine InitializeInterfaceVariable(this, key, update_frequency) class(fates_interface_variable_type), intent(inout) :: this - character(len=*), intent(in) :: key + integer, intent(in) :: update_frequency + allocate(this%data_size(3)) + ! Initialize components that are set later this%data_size = fates_unset_int this%data_rank = fates_unset_int this%data0d => null() this%data1d => null() this%data2d => null() this%data3d => null() - this%key = key this%active = .false. + ! Initialize registry variable components that are updated at initialization + this%key = key + this%update_frequency = update_frequency + end subroutine InitializeInterfaceVariable ! ==================================================================================== From 8b2f8c3934c49349d54b430c785791a54caead1c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 17 Sep 2025 10:38:26 -0700 Subject: [PATCH 102/331] add filters to the registry api type to provide shorter loops during update calls --- main/FatesInterfaceTypesMod.F90 | 50 +++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f91362534e..50da92657a 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -881,6 +881,11 @@ module FatesInterfaceTypesMod integer :: subgrid_indices(hlm_subgrid_levels) ! HLM patch ID associated with this patch ! 1 = patch, 2 = column, 3 = landunit, 4 = topounit, 5 = gridcell + + ! Arrays that hold the indices of variables based on update frequency + integer, allocatable :: index_filter_init(:) ! index of variables that update only at initialization + integer, allocatable :: index_filter_daily(:) ! index of variables that update daily + ! integer, allocatable :: index_filter_timestep(:) ! index of variables that update at each timestep contains @@ -897,6 +902,7 @@ module FatesInterfaceTypesMod procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable + procedure, private :: SetFilterMapArrays procedure, private :: GetRegistryIndex procedure, private :: GetRegistryKey @@ -949,6 +955,9 @@ subroutine InitializeInterfaceRegistry(this) ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) + + ! Set filter map arrays + call this%SetFilterMapArrays() end subroutine InitializeInterfaceRegistry @@ -1044,6 +1053,47 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc end subroutine DefineInterfaceVariable + ! ====================================================================================== + + subroutine SetFilterMapArrays(this) + + class(fates_interface_registry_base_type), intent(inout) :: this + + integer :: index + integer :: count_init + integer :: count_daily + + ! Initialize counters + count_init = 0 + count_daily = 0 + + ! Iterate over all registered variables and populate the filter maps accordingly + do index = 1, this%num_api_vars + if (this%vars(index)%update_frequency == registry_update_init) then + count_init = count_init + 1 + this%index_filter_init(count_init) = index + else if (this%vars(index)%update_frequency == registry_update_daily) then + count_daily = count_daily + 1 + this%index_filter_daily(count_daily) = index + else + write(fates_log(),*) 'ERROR: Unrecognized update frequency in SetFilterMapArrays(): ', this%vars(index)%update_frequency + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end do + + ! Check that the counts match the expected sizes + if (count_init /= this%num_api_vars_update_init .or. & + count_daily /= this%num_api_vars_update_daily) then + + write(fates_log(),*) 'ERROR: Mismatch in initialization counts in SetFilterMapArrays(): ' + write(fates_log(),*) ' count_init = ', count_init, ' expected = ', this%num_api_vars_update_init + write(fates_log(),*) ' count_daily = ', count_daily, ' expected = ', this%num_api_vars_update_daily + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end if + + end subroutine SetFilterMapArrays + ! ====================================================================================== subroutine RegisterInterfaceVariables_0d(this, key, data, subgrid_index) From 09a11c3b878fc619a3b1495b0224ac786402a40c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 17 Sep 2025 10:39:21 -0700 Subject: [PATCH 103/331] update the definteinterface call to pass initialization update frequency for the soil level --- main/FatesInterfaceTypesMod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 50da92657a..ea2e20be81 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -978,13 +978,14 @@ subroutine DefineInterfaceRegistry(this, initialize) ivar = 0 ! Define the interface registry names and indices - call this%DefineInterfaceVariable(key=hlm_fates_soil_level, index=ivar, initialize=initialize) - call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, index=ivar, initialize=initialize) - call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, index=ivar, initialize=initialize) - - ! Set the registry size based on the final update of ivar - this%num_api_vars = ivar - + ! Variables that only need to be updated during initialization, such as dimensions + call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index = ivar, & + update_frequency=registry_update_init) + + + ! Variables that need to be updated daily + call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index = ivar) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index = ivar) end subroutine DefineInterfaceRegistry From 61ef4a369c31b0a10b1b3eb973fe137a71801af8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 17 Sep 2025 10:39:56 -0700 Subject: [PATCH 104/331] minor formatting changes --- main/FatesInterfaceTypesMod.F90 | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index ea2e20be81..14e17f92ab 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -893,9 +893,9 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceRegistry procedure :: Update => UpdateInterfaceVariables - generic :: Register => RegisterInterfaceVariables_0d, & - RegisterInterfaceVariables_1d, & - RegisterInterfaceVariables_2d + generic :: Register => RegisterInterfaceVariables_0d, & + RegisterInterfaceVariables_1d, & + RegisterInterfaceVariables_2d procedure, private :: RegisterInterfaceVariables_0d procedure, private :: RegisterInterfaceVariables_1d procedure, private :: RegisterInterfaceVariables_2d @@ -972,10 +972,7 @@ subroutine DefineInterfaceRegistry(this, initialize) logical, intent(in) :: initialize ! false = count up the keys in the registry - integer :: ivar ! indices - - ! Set ivar to zero. This will be incremented via each call to SetInterfaceVariable - ivar = 0 + integer :: ivar = 0 ! Index to be incremented for each call to DefineInterfaceVariable() ! Define the interface registry names and indices ! Variables that only need to be updated during initialization, such as dimensions @@ -1133,7 +1130,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) class(*), target, intent(in) :: data(:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable - + integer :: subgrid_index_use if (present(subgrid_index)) then @@ -1141,7 +1138,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) else subgrid_index_use = subgrid_patch_index end if - + ! Get index from registry key and associate the given data pointer call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., subgrid_index=subgrid_index_use) From d3227c87b8b2330db077a9d33da6e5634c9ce396 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 17 Sep 2025 10:47:43 -0700 Subject: [PATCH 105/331] initialize local variable to avoid implicit save --- main/FatesInterfaceTypesMod.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 14e17f92ab..99967637c4 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -972,17 +972,20 @@ subroutine DefineInterfaceRegistry(this, initialize) logical, intent(in) :: initialize ! false = count up the keys in the registry - integer :: ivar = 0 ! Index to be incremented for each call to DefineInterfaceVariable() + integer :: index ! Index to be incremented for each call to DefineInterfaceVariable() + + ! Initialize the index + index = 0 ! Define the interface registry names and indices ! Variables that only need to be updated during initialization, such as dimensions - call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index = ivar, & + call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index, & update_frequency=registry_update_init) ! Variables that need to be updated daily - call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index = ivar) - call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index = ivar) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index=index) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index=index) end subroutine DefineInterfaceRegistry From 5d34cd56994a13241002e6d990d3e2804517f7ec Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 17 Sep 2025 11:29:52 -0700 Subject: [PATCH 106/331] add registry procedure to update on the variables during initialization --- main/FatesInterfaceTypesMod.F90 | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 99967637c4..026b6d59d6 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -891,6 +891,7 @@ module FatesInterfaceTypesMod contains procedure :: InitializeInterfaceRegistry + procedure :: InitializeInterfaceVariables procedure :: Update => UpdateInterfaceVariables generic :: Register => RegisterInterfaceVariables_0d, & @@ -1173,6 +1174,33 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) end subroutine RegisterInterfaceVariables_2d + ! ====================================================================================== + + subroutine InitializeInterfaceVariables(this, api) + + class(fates_interface_registry_base_type), intent(inout) :: this ! registry being initialized + class(fates_interface_registry_base_type), intent(in) :: api ! registry updates source + + integer :: i, j + integer :: index_i, index_j + + ! Update the interface variables that are dimensions for fates boundary conditions + do i = 1, this%num_api_vars_update_init + + ! Get the index for the key associated with the current registry variable + j = api%GetRegistryIndex(api%GetRegistryKey(i)) + + ! Get the index for initialization-only variables + index_i = this%index_filter_init(i) + index_j = api%index_filter_init(j) + + ! Set the registry variables updated at initialization + call this%vars(index_i)%Update(api%vars(index_j), api%subgrid_indices) + + end do + + end subroutine InitializeInterfaceVariables + ! ====================================================================================== subroutine UpdateInterfaceVariables(this, api) From 3b0a12d5445561f7c6b289d9e50215342432e242 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 18 Sep 2025 16:46:23 -0700 Subject: [PATCH 107/331] minor move of use statment --- main/EDTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 90250515ca..55f08b5275 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -9,6 +9,7 @@ module EDTypesMod use FatesConstantsMod, only : secondaryland use FatesConstantsMod, only : secondary_age_threshold use FatesConstantsMod, only : nearzero + use FatesConstantsMod , only : n_landuse_cats use FatesGlobals, only : fates_log use FatesHydraulicsMemMod, only : ed_cohort_hydr_type use FatesHydraulicsMemMod, only : ed_site_hydr_type @@ -29,7 +30,6 @@ module EDTypesMod use FatesConstantsMod, only : fates_unset_r8 use FatesInterfaceTypesMod,only : bc_in_type use FatesInterfaceTypesMod,only : bc_out_type - use FatesConstantsMod , only : n_landuse_cats use FatesInterfaceTypesMod,only : hlm_parteh_mode use FatesCohortMod, only : fates_cohort_type use FatesPatchMod, only : fates_patch_type From 7cce54d1a893ed96272996868ca18e13f6116402 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 18 Sep 2025 16:47:03 -0700 Subject: [PATCH 108/331] add api registry pointer in the site type to point back to the interface api registry --- main/EDTypesMod.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 55f08b5275..e61065b9be 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -31,6 +31,7 @@ module EDTypesMod use FatesInterfaceTypesMod,only : bc_in_type use FatesInterfaceTypesMod,only : bc_out_type use FatesInterfaceTypesMod,only : hlm_parteh_mode + use FatesInterfaceTypesMod,only : fates_interface_registry_base_type use FatesCohortMod, only : fates_cohort_type use FatesPatchMod, only : fates_patch_type use EDParamsMod, only : nclmax, nlevleaf, maxpft @@ -327,10 +328,15 @@ module EDTypesMod type, public :: ed_site_type - ! POINTERS + !! POINTERS + + ! patch pointers type (fates_patch_type), pointer :: oldest_patch => null() ! pointer to oldest patch at the site type (fates_patch_type), pointer :: youngest_patch => null() ! pointer to yngest patch at the site + ! interface pointer + type(fates_interface_registry_base_type), pointer :: api => null() ! pointer to the fates interface type api + ! Resource management type (ed_resources_management_type) :: resources_management ! resources_management at the site @@ -339,6 +345,7 @@ module EDTypesMod ! position in history output fields !integer :: clump_id + ! Arrays that map the HLM subgrid index for each patch in this site integer, allocatable :: column_map(:) integer, allocatable :: patch_map(:) From 5c4e3a572cef6c9b3dab55d6638c3b17285cc44d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 18 Sep 2025 16:47:45 -0700 Subject: [PATCH 109/331] make the fates interface registry a pointer so that we can point the site api pointer at it --- main/FatesInterfaceMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a998c9d27d..68cf220c25 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -162,7 +162,8 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - type(fates_interface_registry_base_type) :: api + ! FATES sites have a pointer to this, hence the "target" attribute + type(fates_interface_registry_base_type), pointer :: api contains From 3c1fdbe756165a62ee2401d4955071043b9d98aa Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 18 Sep 2025 16:49:53 -0700 Subject: [PATCH 110/331] Rename the patch level type bound registry initialization subroutine --- biogeochem/FatesPatchMod.F90 | 5 +++-- main/FatesInterfaceTypesMod.F90 | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 6c8f06e2fc..d98d27d26a 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -279,7 +279,7 @@ module FatesPatchMod procedure :: Dump procedure :: CheckVars - procedure, private :: RegisterFatesInterfaceVariables + procedure, private :: InitializeInterfaceRegistry end type fates_patch_type @@ -1386,7 +1386,7 @@ end subroutine CheckVars !=========================================================================== - subroutine RegisterFatesInterfaceVariables(this) + subroutine InitializeInterfaceRegistry(this) use FatesInterfaceTypesMod, only: hlm_fates_soil_level use FatesInterfaceTypesMod, only: hlm_fates_decomp_frac_moisture @@ -1399,6 +1399,7 @@ subroutine RegisterFatesInterfaceVariables(this) ! Register the FATES boundary condition data variables call this%api%Register(hlm_fates_soil_level, this%bc_in%nlevsoil) + end subroutine InitializeInterfaceRegistry call this%api%Register(hlm_fates_decomp_frac_moisture, this%bc_in%w_scalar_sisl) call this%api%Register(hlm_fates_decomp_frac_temperature, this%bc_in%t_scalar_sisl) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 026b6d59d6..f6d9403f30 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1183,7 +1183,7 @@ subroutine InitializeInterfaceVariables(this, api) integer :: i, j integer :: index_i, index_j - + ! Update the interface variables that are dimensions for fates boundary conditions do i = 1, this%num_api_vars_update_init From 40a77f09b2f6b165d17609d1398ec88c69a273e8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 18 Sep 2025 16:51:18 -0700 Subject: [PATCH 111/331] Add patch level type bound procedure to initialize the interface variables and allocate patch bcs --- biogeochem/FatesPatchMod.F90 | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index d98d27d26a..44621fc07d 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -280,6 +280,7 @@ module FatesPatchMod procedure :: CheckVars procedure, private :: InitializeInterfaceRegistry + procedure, private :: InitializeInterfaceVariables end type fates_patch_type @@ -1389,22 +1390,41 @@ end subroutine CheckVars subroutine InitializeInterfaceRegistry(this) use FatesInterfaceTypesMod, only: hlm_fates_soil_level - use FatesInterfaceTypesMod, only: hlm_fates_decomp_frac_moisture - use FatesInterfaceTypesMod, only: hlm_fates_decomp_frac_temperature class(fates_patch_type), intent(inout) :: this - ! Initialize the HLM-FATES interface variable registry for the FATES-side + ! Initialize the patch-level interface variable registry for the FATES-side call this%api%InitializeInterfaceRegistry() - ! Register the FATES boundary condition data variables + ! Register the boundary condition data variables that are set during initialization only + ! See RegisterInterfaceVariables patch-type bound procedure for remaining variables registrations call this%api%Register(hlm_fates_soil_level, this%bc_in%nlevsoil) + end subroutine InitializeInterfaceRegistry + +! ====================================================================================== + + subroutine InitializeInterfaceVariables(this, input_api) + + use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_moisture + use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_temperature + + class(fates_patch_type), intent(inout) :: this + class(fates_interface_registry_base_type), intent(in) :: input_api + + ! Initialize interface variables + call this%api%InitializeInterfaceVariables(input_api) + + ! Allocate the boundary conditions array using the BCs set during initialization + allocate(this%bc_in%w_scalar_sisl(this%bc_in%nlevsoil)) + allocate(this%bc_in%t_scalar_sisl(this%bc_in%nlevsoil)) + + ! Register the boundary condintion variables not exclusively updated during initialization call this%api%Register(hlm_fates_decomp_frac_moisture, this%bc_in%w_scalar_sisl) call this%api%Register(hlm_fates_decomp_frac_temperature, this%bc_in%t_scalar_sisl) + + end subroutine InitializeInterfaceVariables - end subroutine RegisterFatesInterfaceVariables - ! ====================================================================================== end module FatesPatchMod From 6b08515e021e15dac00e680ebf59c04f1413186d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 18 Sep 2025 16:52:29 -0700 Subject: [PATCH 112/331] update the create and init patch subroutines to take in the api pointer from the site This could also site be pointers at the patch level, instead of the site level. --- biogeochem/FatesPatchMod.F90 | 36 ++++++++++++++---------------------- 1 file changed, 14 insertions(+), 22 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 44621fc07d..401b96caa6 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -288,7 +288,7 @@ module FatesPatchMod !=========================================================================== - subroutine Init(this, num_swb, num_levsoil) + subroutine Init(this, num_swb, num_levsoil, api_pointer) ! ! DESCRIPTION: ! Initialize a new patch - allocate arrays and set values to nan and/or 0.0 @@ -298,6 +298,7 @@ subroutine Init(this, num_swb, num_levsoil) class(fates_patch_type), intent(inout) :: this ! patch object integer, intent(in) :: num_swb ! number of shortwave broad-bands to track integer, intent(in) :: num_levsoil ! number of soil layers + class(fates_interface_registry_base_type), pointer, intent(in) :: api_pointer ! allocate arrays allocate(this%tr_soil_dir(num_swb)) @@ -311,24 +312,13 @@ subroutine Init(this, num_swb, num_levsoil) allocate(this%fragmentation_scaler(num_levsoil)) allocate(this%co_scr(max_cohort_per_patch)) - ! Allocate API registry - call this%RegisterFatesInterfaceVariables() - - ! TODO: Create subroutine to update a subset of interface variables here - ! Problem: How do we get the HLM interface registry pointer? - ! Possible solution: move the boundary condition initialization into a different - ! procedure? Also have a separate registry for the scalars that are used for - ! allocations? - ! call this%InitializeInterfaceVariables() - - ! Allocate BC arrays. This must be done after the API registry is updated. - allocate(this%bc_in%w_scalar_sisl(num_levsoil)) - allocate(this%bc_in%t_scalar_sisl(num_levsoil)) - - allocate(this%bc_out%litt_flux_cel_c_si(this%bc_in%nlevdecomp)) - allocate(this%bc_out%litt_flux_lig_c_si(this%bc_in%nlevdecomp)) - allocate(this%bc_out%litt_flux_lab_c_si(this%bc_in%nlevdecomp)) + ! Initialize the patch-level API registry + call this%InitializeInterfaceRegistry() + ! Initialize and register the variables in the API registry + ! This also allocates the boundary conditions + call this%InitializeInterfaceVariables(api_pointer) + ! initialize all values to nan call this%NanValues() @@ -759,7 +749,7 @@ end subroutine InitLitter !=========================================================================== subroutine Create(this, age, area, land_use_label, nocomp_pft, num_swb, num_pft, & - num_levsoil, current_tod, regeneration_model) + num_levsoil, current_tod, regeneration_model, api_pointer) ! ! DESCRIPTION: ! create a new patch with input and default values @@ -776,11 +766,13 @@ subroutine Create(this, age, area, land_use_label, nocomp_pft, num_swb, num_pft, integer, intent(in) :: num_levsoil ! number of soil layers integer, intent(in) :: current_tod ! time of day [seconds past 0Z] integer, intent(in) :: regeneration_model ! regeneration model version + + class(fates_interface_registry_base_type), pointer, intent(in) :: api_pointer ! initialize patch - ! sets all values to nan, then some values to zero - call this%Init(num_swb, num_levsoil) - + ! sets all values to nan, then some values to zero, and initialize interface registry + call this%Init(num_swb, num_levsoil, api_pointer) + ! initialize running means for patch call this%InitRunningMeans(current_tod, regeneration_model, num_pft) From 900f7e395f92367640a6596e086c4b97384329e1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 18 Sep 2025 16:53:45 -0700 Subject: [PATCH 113/331] Update all patch create calls with new site api pointer argument --- biogeochem/EDPatchDynamicsMod.F90 | 6 +++--- main/EDInitMod.F90 | 4 ++-- main/FatesInventoryInitMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6a4fa1034a..bd32f604b5 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -680,7 +680,7 @@ subroutine spawn_patches( currentSite, bc_in ) call newPatch%Create(age, site_areadis, i_landusechange_receiverpatchlabel, i_nocomp_pft, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, currentSite%api) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches @@ -1442,7 +1442,7 @@ subroutine spawn_patches( currentSite, bc_in ) call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, currentSite%api) ! Initialize the litter pools to zero do el=1,num_elements @@ -1735,7 +1735,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, a call new_patch%Create(0._r8, temp_area, & currentPatch%land_use_label, currentPatch%nocomp_pft_label, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, currentSite%api) ! Initialize the litter pools to zero, these ! pools will be populated shortly diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index be39037f00..c4b6075234 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -840,7 +840,7 @@ subroutine init_patches( nsites, sites, bc_in) call newp%Create(age, newparea, nocomp_bareground_land, nocomp_bareground, & num_swb, numpft, sites(s)%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, sites(s)%api) ! set pointers for first patch (or only patch, if nocomp is false) newp%patchno = 1 @@ -919,7 +919,7 @@ subroutine init_patches( nsites, sites, bc_in) call newp%Create(age, newparea, i_lu_state, nocomp_pft, & num_swb, numpft, sites(s)%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, sites(s)%api) if (is_first_patch) then !is this the first patch? ! set pointers for first patch (or only patch, if nocomp is false) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 6673f4b819..61a162a952 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -284,7 +284,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) allocate(newpatch) call newpatch%Create(age_init, area_init, primaryland, & fates_unset_int, num_swb, numpft, sites(s)%nlevsoil, & - hlm_current_tod, hlm_regeneration_model) + hlm_current_tod, hlm_regeneration_model, sites(s)%api) newpatch%patchno = ipa newpatch%younger => null() diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index c9e98c49ad..f81c348631 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -3112,7 +3112,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) ! make new patch call newp%Create(fates_unset_r8, fates_unset_r8, primaryland, & nocomp_pft, num_swb, numpft, sites(s)%nlevsoil, & - hlm_current_tod, hlm_regeneration_model) + hlm_current_tod, hlm_regeneration_model, sites(s)%api) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches From b7836757c24aba7278b3bda60daa565a77954ab4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 24 Sep 2025 14:29:10 -0700 Subject: [PATCH 114/331] remove bc and registry at the patch level This will be moved to site-level bcs --- biogeochem/FatesPatchMod.F90 | 76 ++---------------------------------- 1 file changed, 4 insertions(+), 72 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 401b96caa6..fb50bd297b 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -32,9 +32,6 @@ module FatesPatchMod use FatesRadiationMemMod, only : num_rad_stream_types use FatesInterfaceTypesMod, only : hlm_hio_ignore_val use FatesInterfaceTypesMod, only : numpft - use FatesInterfaceTypesMod, only : bc_in_type - use FatesInterfaceTypesMod, only : bc_out_type - use FatesInterfaceTypesMod, only : fates_interface_registry_base_type use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) use shr_log_mod, only : errMsg => shr_log_errMsg @@ -279,16 +276,13 @@ module FatesPatchMod procedure :: Dump procedure :: CheckVars - procedure, private :: InitializeInterfaceRegistry - procedure, private :: InitializeInterfaceVariables - end type fates_patch_type contains !=========================================================================== - subroutine Init(this, num_swb, num_levsoil, api_pointer) + subroutine Init(this, num_swb, num_levsoil) ! ! DESCRIPTION: ! Initialize a new patch - allocate arrays and set values to nan and/or 0.0 @@ -298,7 +292,6 @@ subroutine Init(this, num_swb, num_levsoil, api_pointer) class(fates_patch_type), intent(inout) :: this ! patch object integer, intent(in) :: num_swb ! number of shortwave broad-bands to track integer, intent(in) :: num_levsoil ! number of soil layers - class(fates_interface_registry_base_type), pointer, intent(in) :: api_pointer ! allocate arrays allocate(this%tr_soil_dir(num_swb)) @@ -312,13 +305,6 @@ subroutine Init(this, num_swb, num_levsoil, api_pointer) allocate(this%fragmentation_scaler(num_levsoil)) allocate(this%co_scr(max_cohort_per_patch)) - ! Initialize the patch-level API registry - call this%InitializeInterfaceRegistry() - - ! Initialize and register the variables in the API registry - ! This also allocates the boundary conditions - call this%InitializeInterfaceVariables(api_pointer) - ! initialize all values to nan call this%NanValues() @@ -557,12 +543,6 @@ subroutine NanValues(this) this%tfc_ros = nan this%frac_burnt = nan - ! Boundary conditions - this%bc_in%w_scalar_sisl(:) = nan - this%bc_in%t_scalar_sisl(:) = nan - this%bc_in%nlevdecomp = fates_unset_int - this%bc_in%nlevsoil = fates_unset_int - end subroutine NanValues !=========================================================================== @@ -651,12 +631,6 @@ subroutine ZeroValues(this) this%rx_fi = 0.0_r8 this%rx_frac_burnt = 0.0_r8 - ! Boundary conditions - this%bc_in%w_scalar_sisl(:) = 0.0_r8 - this%bc_in%t_scalar_sisl(:) = 0.0_r8 - this%bc_in%nlevdecomp = 0.0_r8 - this%bc_in%nlevsoil = 0.0_r8 - end subroutine ZeroValues !=========================================================================== @@ -749,7 +723,7 @@ end subroutine InitLitter !=========================================================================== subroutine Create(this, age, area, land_use_label, nocomp_pft, num_swb, num_pft, & - num_levsoil, current_tod, regeneration_model, api_pointer) + num_levsoil, current_tod, regeneration_model) ! ! DESCRIPTION: ! create a new patch with input and default values @@ -767,11 +741,9 @@ subroutine Create(this, age, area, land_use_label, nocomp_pft, num_swb, num_pft, integer, intent(in) :: current_tod ! time of day [seconds past 0Z] integer, intent(in) :: regeneration_model ! regeneration model version - class(fates_interface_registry_base_type), pointer, intent(in) :: api_pointer - ! initialize patch - ! sets all values to nan, then some values to zero, and initialize interface registry - call this%Init(num_swb, num_levsoil, api_pointer) + ! sets all values to nan, then some values to zero + call this%Init(num_swb, num_levsoil) ! initialize running means for patch call this%InitRunningMeans(current_tod, regeneration_model, num_pft) @@ -1377,46 +1349,6 @@ subroutine CheckVars(this, var_aliases, return_code) end subroutine CheckVars - !=========================================================================== - - subroutine InitializeInterfaceRegistry(this) - - use FatesInterfaceTypesMod, only: hlm_fates_soil_level - - class(fates_patch_type), intent(inout) :: this - - ! Initialize the patch-level interface variable registry for the FATES-side - call this%api%InitializeInterfaceRegistry() - - ! Register the boundary condition data variables that are set during initialization only - ! See RegisterInterfaceVariables patch-type bound procedure for remaining variables registrations - call this%api%Register(hlm_fates_soil_level, this%bc_in%nlevsoil) - - end subroutine InitializeInterfaceRegistry - -! ====================================================================================== - - subroutine InitializeInterfaceVariables(this, input_api) - - use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_moisture - use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_temperature - - class(fates_patch_type), intent(inout) :: this - class(fates_interface_registry_base_type), intent(in) :: input_api - - ! Initialize interface variables - call this%api%InitializeInterfaceVariables(input_api) - - ! Allocate the boundary conditions array using the BCs set during initialization - allocate(this%bc_in%w_scalar_sisl(this%bc_in%nlevsoil)) - allocate(this%bc_in%t_scalar_sisl(this%bc_in%nlevsoil)) - - ! Register the boundary condintion variables not exclusively updated during initialization - call this%api%Register(hlm_fates_decomp_frac_moisture, this%bc_in%w_scalar_sisl) - call this%api%Register(hlm_fates_decomp_frac_temperature, this%bc_in%t_scalar_sisl) - - end subroutine InitializeInterfaceVariables - ! ====================================================================================== end module FatesPatchMod From 8c8c904d874a3017a508ad6f327adcd30d7b2db9 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 25 Sep 2025 15:10:58 -0700 Subject: [PATCH 115/331] add bcs to site type and interface registry to site bound bcs --- main/EDTypesMod.F90 | 49 ++++++++++++++++++++++++++++++- main/FatesInterfaceTypesMod.F90 | 52 +++++++++++++++++++++++++++++++++ 2 files changed, 100 insertions(+), 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e61065b9be..c84d6b48ed 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -335,7 +335,11 @@ module EDTypesMod type (fates_patch_type), pointer :: youngest_patch => null() ! pointer to yngest patch at the site ! interface pointer - type(fates_interface_registry_base_type), pointer :: api => null() ! pointer to the fates interface type api + ! type(fates_interface_registry_base_type), pointer :: api => null() ! pointer to the fates interface type api + + ! Boundary conditions + type(bc_in_type) :: bc_in + type(bc_out_type) :: bc_out ! Resource management type (ed_resources_management_type) :: resources_management ! resources_management at the site @@ -625,6 +629,49 @@ module EDTypesMod contains + ! ============================================================================ + + subroutine InitializeBoundaryConditions(this, number_patches, nlevsoil) + + ! This subroutine intializes an array of each of the boundary condition + ! types where the length of the boundary condition is the maximum number of + ! patches on a given site. + + ! Inputs + class(ed_site_type), intent(inout) :: this + integer, intent(in) :: number_patches + integer, intent(in) :: nlevsoil(:) + + integer :: ifp, c + integer :: begc, endc + + ! Allocate the boundary condition arrays + allocate(this%bc_in(number_patches)) + allocate(this%bc_out(number_patches)) + + ! Get the bounds of the soil level array passed in + begc = lbound(nlevsoil) + endc = ubound(nlevsoil) + + ! Initialize the interface registry + do ifp = 1, number_patches + + ! Get the column index for this patch index + c = this%column_map(ifp) + + ! Check that the column index is between the expected bounds + if (c < begc .or. c > endc) then + write(fates_log(),*) 'index is not between array bounds: index, start, end: ' c, begc, endc + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Initialize the input boundary conditions + call this%bc_in(ifp)%Initialize(nlevsoil(c)) + + end do + + end subroutine InitializeBoundaryConditions + ! ============================================================================ subroutine set_patchno( currentSite, check , call_id) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f6d9403f30..3fb866b96b 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -628,6 +628,15 @@ module FatesInterfaceTypesMod real(r8),allocatable :: hlm_sp_tlai(:) ! Interpolated daily total LAI (leaf area index) input from HLM per patch/pft real(r8),allocatable :: hlm_sp_tsai(:) ! Interpolated sailt total SAI (stem area index) input from HLM per patch/pft real(r8),allocatable :: hlm_sp_htop(:) ! Interpolated daily canopy vegetation height input from HLM per patch/pft + + type(fates_interface_registry_base_type) :: API + + contains + + procedure :: Initialize => InitializeBCIn + + procedure, private :: IntializeDimensionVariables + procedure, private :: InitializeVariables => InitializeVariables_bcin end type bc_in_type @@ -914,6 +923,49 @@ module FatesInterfaceTypesMod contains + ! ====================================================================================== + + subroutine InitializeBCIn(this, nlevsoil) + + class(bc_in_type), intent(inout) :: this + integer, intent(in) :: nlevsoil + + ! Initialize the variables that act as dimensions for other boundary conditions + call this%IntializeDimensionVariables(nlevsoil) + + ! Initialize all remaining boundary condition input variables + call this%InitializeVariables() + + + end subroutine InitializeBCIn + + ! ====================================================================================== + + subroutine InitializeDimensionVariables(this, nlevsoil) + + class(bc_in_type), intent(inout) :: this + integer, intent(in) :: nlevsoil + + this%nlevsoil = nlevsoil + + end subroutine InitializeDimensionVariables + + ! ====================================================================================== + + subroutine InitializeVariables_bcin(this) + + class(bc_in_type), intent(inout) :: this + + ! Allocate the boundary condition variables + allocate(this%w_scalar_sisl(this%nlevsoil)) + allocate(this%t_scalar_sisl(this%nlevsoil)) + + ! Unset the values + this%w_scalar_sisl = nan + this%t_scalar_sisl = nan + + end subroutine InitializeVariables_bcin + ! ====================================================================================== subroutine ZeroBCOutCarbonFluxes(bc_out) From 00f816d429c5f508cdc9ae319f83f81710401e98 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 26 Sep 2025 16:16:32 -0700 Subject: [PATCH 116/331] remove subgrid index passing for eventual deprecation This data will be held at the registry level now --- main/FatesInterfaceTypesMod.F90 | 49 +++++-------------------------- main/FatesInterfaceVarTypeMod.F90 | 14 ++------- 2 files changed, 10 insertions(+), 53 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 3fb866b96b..d126cf234c 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -888,15 +888,11 @@ module FatesInterfaceTypesMod integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily - integer :: subgrid_indices(hlm_subgrid_levels) ! HLM patch ID associated with this patch - ! 1 = patch, 2 = column, 3 = landunit, 4 = topounit, 5 = gridcell - ! Arrays that hold the indices of variables based on update frequency integer, allocatable :: index_filter_init(:) ! index of variables that update only at initialization integer, allocatable :: index_filter_daily(:) ! index of variables that update daily ! integer, allocatable :: index_filter_timestep(:) ! index of variables that update at each timestep - contains procedure :: InitializeInterfaceRegistry @@ -994,8 +990,7 @@ subroutine InitializeInterfaceRegistry(this) this%num_api_vars = 0 this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 - this%subgrid_indices = fates_unset_int - + ! First count up the keys defined in the registry call this%DefineInterfaceRegistry(initialize=.false.) @@ -1150,79 +1145,49 @@ end subroutine SetFilterMapArrays ! ====================================================================================== - subroutine RegisterInterfaceVariables_0d(this, key, data, subgrid_index) + subroutine RegisterInterfaceVariables_0d(this, key, data) ! This procedure is called by the to associate a data variable ! with a particular registry key class(fates_interface_registry_base_type), intent(inout) :: this - class(*), target, intent(in) :: data ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key - integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable - - integer :: subgrid_index_use - if (present(subgrid_index)) then - subgrid_index_use = subgrid_index - else - subgrid_index_use = subgrid_patch_index - end if - ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true., subgrid_index=subgrid_index_use) + call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true.) end subroutine RegisterInterfaceVariables_0d ! ====================================================================================== - subroutine RegisterInterfaceVariables_1d(this, key, data, subgrid_index) + subroutine RegisterInterfaceVariables_1d(this, key, data) ! This procedure is called by the to associate a data variable ! with a particular registry key class(fates_interface_registry_base_type), intent(inout) :: this - class(*), target, intent(in) :: data(:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key - integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable - integer :: subgrid_index_use - - if (present(subgrid_index)) then - subgrid_index_use = subgrid_index - else - subgrid_index_use = subgrid_patch_index - end if - ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., subgrid_index=subgrid_index_use) + call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) end subroutine RegisterInterfaceVariables_1d ! ====================================================================================== - subroutine RegisterInterfaceVariables_2d(this, key, data, subgrid_index) + subroutine RegisterInterfaceVariables_2d(this, key, data) ! This procedure is called by the to associate a data variable ! with a particular registry key class(fates_interface_registry_base_type), intent(inout) :: this - class(*), target, intent(in) :: data(:,:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key - integer, intent(in), optional :: subgrid_index ! HLM subgrid index to associate with this variable - - integer :: subgrid_index_use - - if (present(subgrid_index)) then - subgrid_index_use = subgrid_index - else - subgrid_index_use = subgrid_patch_index - end if ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., subgrid_index=subgrid_index_use) + call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) end subroutine RegisterInterfaceVariables_2d diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 9c21f21b69..9ad9c7df82 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -76,34 +76,29 @@ end subroutine InitializeInterfaceVariable ! ==================================================================================== - subroutine RegisterInterfaceVariable_0d(this, data, active, subgrid_index) + subroutine RegisterInterfaceVariable_0d(this, data, active) class(fates_interface_variable_type), intent(inout) :: this - class(*), target, intent(in) :: data logical, intent(in) :: active - integer, intent(in) :: subgrid_index this%data0d => data this%active = active - this%subgrid = subgrid_index this%data_rank = rank(data) end subroutine RegisterInterfaceVariable_0d ! ==================================================================================== - subroutine RegisterInterfaceVariable_1d(this, data, active, subgrid_index) + subroutine RegisterInterfaceVariable_1d(this, data, active) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:) logical, intent(in) :: active - integer, intent(in) :: subgrid_index this%data1d => data(:) this%active = active - this%subgrid = subgrid_index this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) @@ -111,17 +106,14 @@ end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== - subroutine RegisterInterfaceVariable_2d(this, data, active, subgrid_index) + subroutine RegisterInterfaceVariable_2d(this, data, active) class(fates_interface_variable_type), intent(inout) :: this - class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active - integer, intent(in) :: subgrid_index this%data2d => data(:,:) this%active = active - this%subgrid = subgrid_index this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) this%data_size(2) = size(data, dim=2) From 804eafb8cf5ddff6dbd56c81330404d2bbdf3cd2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 26 Sep 2025 16:17:43 -0700 Subject: [PATCH 117/331] add subgrid index data to registry type --- main/FatesInterfaceTypesMod.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d126cf234c..05f4685554 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -893,6 +893,14 @@ module FatesInterfaceTypesMod integer, allocatable :: index_filter_daily(:) ! index of variables that update daily ! integer, allocatable :: index_filter_timestep(:) ! index of variables that update at each timestep + ! Subgrid index data + integer, private :: gidx + integer, private :: lidx + integer, private :: cidx + integer, private :: sidx + integer, private :: hpidx + integer, private :: fpidx + contains procedure :: InitializeInterfaceRegistry From 51d4d602b26c5af2f0473d51cf037f80bd018ac9 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 26 Sep 2025 16:18:36 -0700 Subject: [PATCH 118/331] add variable type array for both fates and hlm data on the registry --- main/FatesInterfaceTypesMod.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 05f4685554..b10c7b32d8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -879,11 +879,11 @@ module FatesInterfaceTypesMod ! Base type to be extended for the API registry type, public :: fates_interface_registry_base_type - ! container array of interface variables - type(fates_interface_variable_type), allocatable :: vars(:) + ! Container array of interface variables indexed by key + type(fates_interface_variable_type), allocatable :: hlm_vars(:) + type(fates_interface_variable_type), allocatable :: fates_vars(:) - ! registry metadata - ! TODO: make an extended type for the HLM interface that holds the subgrid info + ! Variable regsitry metadata integer :: num_api_vars ! number of variables in the registry integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily @@ -947,6 +947,9 @@ end subroutine InitializeBCIn subroutine InitializeDimensionVariables(this, nlevsoil) + ! Initialize input boundary conditions that are used as dimensions + ! for allocation of other boundary conditions + class(bc_in_type), intent(inout) :: this integer, intent(in) :: nlevsoil @@ -1002,8 +1005,9 @@ subroutine InitializeInterfaceRegistry(this) ! First count up the keys defined in the registry call this%DefineInterfaceRegistry(initialize=.false.) - ! Allocate the registry variables array - allocate(this%vars(this%num_api_vars)) + ! Allocate the registry variables arrays + allocate(this%fates_vars(this%num_api_vars)) + allocate(this%hlm_vars(this%num_api_vars)) ! Allocate the index maps allocate(this%index_filter_init(this%num_api_vars_update_init)) From 221e3860567d0624d259bc28545f5329a0561058 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 28 Sep 2025 10:04:08 -0700 Subject: [PATCH 119/331] remove the site-bound subgrid variables These are now held at the API level --- main/EDTypesMod.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index c84d6b48ed..037f1a76c0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -349,10 +349,6 @@ module EDTypesMod ! position in history output fields !integer :: clump_id - ! Arrays that map the HLM subgrid index for each patch in this site - integer, allocatable :: column_map(:) - integer, allocatable :: patch_map(:) - ! Global index of this site in the history output file integer :: h_gid From cfbe4410bbd5f013e8b9e2e4d05da275ebf38803 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 28 Sep 2025 10:06:39 -0700 Subject: [PATCH 120/331] change API to BC for naming consistency --- main/FatesInterfaceMod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 68cf220c25..c052f1ffeb 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -162,8 +162,7 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - ! FATES sites have a pointer to this, hence the "target" attribute - type(fates_interface_registry_base_type), pointer :: api + type(fates_interface_registry_base_type), allocatable :: BC(:) contains From 1fcc8ed05f24bde25cc16bccbde2caa9eba84cc2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 28 Sep 2025 10:07:13 -0700 Subject: [PATCH 121/331] make the site-level bcs allocatable --- main/EDTypesMod.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 037f1a76c0..ebccc9c41e 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -334,12 +334,9 @@ module EDTypesMod type (fates_patch_type), pointer :: oldest_patch => null() ! pointer to oldest patch at the site type (fates_patch_type), pointer :: youngest_patch => null() ! pointer to yngest patch at the site - ! interface pointer - ! type(fates_interface_registry_base_type), pointer :: api => null() ! pointer to the fates interface type api - ! Boundary conditions - type(bc_in_type) :: bc_in - type(bc_out_type) :: bc_out + type(bc_in_type), allocatable :: bc_in(:) + type(bc_out_type), allocatable :: bc_out(:) ! Resource management type (ed_resources_management_type) :: resources_management ! resources_management at the site From d863c915523ccb213efc93c26f5496c450572d13 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 28 Sep 2025 10:32:59 -0700 Subject: [PATCH 122/331] add registry initialization procedure at interface level --- main/FatesInterfaceMod.F90 | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index c052f1ffeb..a6bd942b83 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -162,7 +162,7 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - type(fates_interface_registry_base_type), allocatable :: BC(:) + type(fates_interface_registry_base_type), allocatable :: register(:) contains @@ -2708,6 +2708,31 @@ subroutine FatesReadParameters(param_reader) end subroutine FatesReadParameters +! ====================================================================================== + +subroutine InitializeInterfaceRegistry(this, number_clump_patches) + + ! This procedure intializes an interface registry for each patch index on the clump + + ! Arguments + class(fates_interface_type), intent(inout) :: this ! fates interface + integer, intent(in) :: number_clump_patches ! number of patches in this clump + + ! Locals + integer :: i + + ! Allocate interface registries for each patch on the clump + allocate(this%register(number_clump_patches)) + + ! Initialize each registry with a dictionary of keys to register fates and hlm variables against + ! The keys are defined in the registry type-bound procedures + do i = 1, number_clump_patches + call this%register(i)%InitializeInterfaceRegistry() + end do + +end subroutine InitializeInterfaceRegistry + + ! ====================================================================================== subroutine UpdateInterfaceVariables(this) From c6f702790b46117fe22d736ed288b8a3ca3e2a2c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 29 Sep 2025 16:47:41 -0700 Subject: [PATCH 123/331] add procedure to record the hlm subgrid indices for the register --- main/FatesInterfaceTypesMod.F90 | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index b10c7b32d8..d028a7c5d3 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -905,6 +905,7 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceRegistry procedure :: InitializeInterfaceVariables + procedure :: SetSubgridIndices procedure :: Update => UpdateInterfaceVariables generic :: Register => RegisterInterfaceVariables_0d, & @@ -1116,6 +1117,25 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== + subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch) + + class(fates_interface_registry_base_type), intent(inout) :: this + integer, intent(in) :: gridcell + integer, intent(in) :: topounit + integer, intent(in) :: landunit + integer, intent(in) :: column + integer, intent(in) :: hlmpatch + + this%gidx = gridcell + this%tidx = topounit + this%lidx = landunit + this%cidx = column + this%hpidx = hlmpatch + + end subroutine SetSubgridIndices + + ! ====================================================================================== + subroutine SetFilterMapArrays(this) class(fates_interface_registry_base_type), intent(inout) :: this From dfaa4dfe7030cbdef19c6f390b943848a56d110f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 10:50:54 -0700 Subject: [PATCH 124/331] change registry var update subroutine since both hlm and fates variables are held in the same container --- main/FatesInterfaceTypesMod.F90 | 13 ++----- main/FatesInterfaceVarTypeMod.F90 | 58 ++++++------------------------- 2 files changed, 14 insertions(+), 57 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d028a7c5d3..00f964dba7 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1252,22 +1252,15 @@ end subroutine InitializeInterfaceVariables ! ====================================================================================== - subroutine UpdateInterfaceVariables(this, api) + subroutine UpdateInterfaceVariables(this) - class(fates_interface_registry_base_type), intent(inout) :: this ! registry being updated - class(fates_interface_registry_base_type), intent(in) :: api ! registry update source + class(fates_interface_registry_base_type), intent(inout) :: this integer :: i - integer :: j ! Iterate over all registered variables do i = 1, this%num_api_vars - - ! Don't assume the index in the calling registry is the same as in the input registry - j = api%GetRegistryIndex(api%GetRegistryKey(i)) - - ! Update the registered variable and pass the subgrid indices information - call this%vars(i)%Update(api%vars(j), api%subgrid_indices) + this%fates_vars(i)%Update(hlm_vars(i)) end do end subroutine UpdateInterfaceVariables diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 9ad9c7df82..f55e97457e 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -122,11 +122,10 @@ end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== - subroutine UpdateInterfaceVariable(this, var, subgrid_indices) + subroutine UpdateInterfaceVariable(this, var) class(fates_interface_variable_type), intent(inout) :: this ! variable being updated class(fates_interface_variable_type), intent(in) :: var ! variable update source - integer, intent(in) :: subgrid_indices(:) ! subgrid indices for the update source class(*), pointer :: data_var0d => null() class(*), pointer :: data_var1d(:) => null() @@ -136,39 +135,9 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) integer :: index ! index for the subgrid level of the input interface variable character(len=fates_long_string_length) :: msg_mismatch = 'FATES ERROR: Mismatched interface variable types' - ! This update method assumes that the first rank of the HLM data arrays - ! corresponds to the subgrid level of the interface variable type. - ! E.g. col_cf%w_scalar(c,1:nlevsoil) shows that the first dimension is the column index. - ! TODO: This should be held in an interface requirements document. - - ! Get the subgrid index for the updating variable - index = subgrid_indices(var%subgrid) - - ! Check that the index is valid - if (index == fates_unset_int) then - write(fates_log(),*) 'FATES ERROR: Unset subgrid index in UpdateInterfaceVariable' - write(fates_log(),*) ' Variable key, subgrid level: ', var%key, var%subgrid - write(fates_log(),*) ' API subgrid indices: ', subgrid_indices - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - - ! Update the data pointer based on the rank of the source variable while indexing - ! into the appropriate subgrid level - ! TODO: This assumes HLM->FATES direction; Validate this for FATES->HLM direction - select case (var%data_rank) - case(0) - data_var0d => var%data0d - case(1) - data_var0d => var%data1d(index) - case(2) - data_var1d => var%data2d(index,:) - case(3) - data_var2d => var%data3d(index,:,:) - case default - write(fates_log(),*) 'FATES ERROR: Unsupported interface variable input rank in UpdateInterfaceVariable' - call endrun(msg=errMsg(__FILE__, __LINE__)) - end select - + ! Check that the dimensions of the source and target match + call this%CompareRegistryVariableSizes(var) + ! Update the data of the target variable using the source variable data pointer ! Make sure the types match for the polymorphic data to allow for copying from the ! source to the target. @@ -180,7 +149,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) case(0) select type(dest => this%data0d) type is (real(r8)) - select type(source => data_var0d) + select type(source => var%data0d) type is (real(r8)) dest = source class default @@ -188,7 +157,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) call endrun(msg=errMsg(__FILE__, __LINE__)) end select type is (integer) - select type(source => data_var0d) + select type(source => var%data0d) type is (integer) dest = source class default @@ -202,12 +171,9 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) case(1) - ! Check that the dimensions of the source and target match - call this%CompareRegistryVariableSizes(var) - select type(dest => this%data1d) type is (real(r8)) - select type(source => data_var1d) + select type(source => var%data1d) type is (real(r8)) dest = source class default @@ -215,7 +181,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) call endrun(msg=errMsg(__FILE__, __LINE__)) end select type is (integer) - select type(source => data_var1d) + select type(source => var%data1d) type is (integer) dest = source class default @@ -226,14 +192,12 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' call endrun(msg=errMsg(__FILE__, __LINE__)) end select + case(2) - ! Check that the dimensions of the source and target match - call this%CompareRegistryVariableSizes(var) - select type(dest => this%data2d) type is (real(r8)) - select type(source => data_var2d) + select type(source => var%data2d) type is (real(r8)) dest = source class default @@ -241,7 +205,7 @@ subroutine UpdateInterfaceVariable(this, var, subgrid_indices) call endrun(msg=errMsg(__FILE__, __LINE__)) end select type is (integer) - select type(source => data_var2d) + select type(source => var%data2d) type is (integer) dest = source class default From 799192030ea650a04c30ad72812ef26229ff35d7 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 10:51:23 -0700 Subject: [PATCH 125/331] Add a function to get the column index for this registry --- main/FatesInterfaceTypesMod.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 00f964dba7..efda6bbdb4 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1136,6 +1136,16 @@ end subroutine SetSubgridIndices ! ====================================================================================== + integer function GetColumnIndex(this) result(cidx) + + class(fates_interface_registry_base_type), intent(inout) :: this + + cidx = this%cidx + + end function GetColumnIndex + + ! ====================================================================================== + subroutine SetFilterMapArrays(this) class(fates_interface_registry_base_type), intent(inout) :: this From eac13000d207ca56a03ba66cf56942bb3ffcdef9 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 10:52:25 -0700 Subject: [PATCH 126/331] Update registration call at the regsitry level to direct where a variables is being sent --- main/FatesInterfaceTypesMod.F90 | 34 ++++++++++++++++++++++++--------- 1 file changed, 25 insertions(+), 9 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index efda6bbdb4..f02c1bf2c1 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1187,39 +1187,51 @@ end subroutine SetFilterMapArrays ! ====================================================================================== - subroutine RegisterInterfaceVariables_0d(this, key, data) + subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag) ! This procedure is called by the to associate a data variable ! with a particular registry key + ! Arguments class(fates_interface_registry_base_type), intent(inout) :: this class(*), target, intent(in) :: data ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key + logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + if (hlm_flag) then + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + else + call this%fates_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + end if + end subroutine RegisterInterfaceVariables_0d ! ====================================================================================== - subroutine RegisterInterfaceVariables_1d(this, key, data) + subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag) ! This procedure is called by the to associate a data variable ! with a particular registry key class(fates_interface_registry_base_type), intent(inout) :: this - class(*), target, intent(in) :: data(:) ! data to be associated with key + class(*), target, intent(in) :: data(:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key + logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + if (hlm_flag) then + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + else + call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + end if end subroutine RegisterInterfaceVariables_1d ! ====================================================================================== - subroutine RegisterInterfaceVariables_2d(this, key, data) + subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1227,18 +1239,22 @@ subroutine RegisterInterfaceVariables_2d(this, key, data) class(fates_interface_registry_base_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key + logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? ! Get index from registry key and associate the given data pointer - call this%vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + if (hlm_flag) then + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + else + call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + end if end subroutine RegisterInterfaceVariables_2d ! ====================================================================================== - subroutine InitializeInterfaceVariables(this, api) + subroutine InitializeInterfaceVariables(this) class(fates_interface_registry_base_type), intent(inout) :: this ! registry being initialized - class(fates_interface_registry_base_type), intent(in) :: api ! registry updates source integer :: i, j integer :: index_i, index_j From 22db15fd9fa965538cf784c1663bb9685663578b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 11:33:15 -0700 Subject: [PATCH 127/331] add number of patches to the interface type associated with the registry array --- main/FatesInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a6bd942b83..4f25fce66a 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -135,6 +135,7 @@ module FatesInterfaceMod ! grid-cell, this is intended to be migrated to columns integer :: nsites + integer :: npatches type(ed_site_type), pointer :: sites(:) From 01a267af93f53b7d901b78688d5b44a68ff4d808 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 11:34:12 -0700 Subject: [PATCH 128/331] add procedure to initialize fates boundary conditions --- main/FatesInterfaceMod.F90 | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 4f25fce66a..86d9c50c1a 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -167,6 +167,7 @@ module FatesInterfaceMod contains + procedure, public :: InitializeBoundaryConditions procedure, public :: UpdateInterfaceVariables end type fates_interface_type @@ -2734,6 +2735,41 @@ subroutine InitializeInterfaceRegistry(this, number_clump_patches) end subroutine InitializeInterfaceRegistry +! ====================================================================================== + +subroutine InitializeBoundaryConditions(this, patches_per_site) + + ! Arguments + class(fates_interface_type), intent(inout) :: this ! fates interface type + integer, intent(in) :: patches_per_site ! number of patches per site + + ! Locals + integer :: r ! registery iterator + integer :: s ! site iterator + integer :: ifp ! boundary condition iterator + + ! Allocate boundary conditions for all sites with the maximum number of patches per site + do s = 1, this%nsites + allocate(this%sites(s)%bc_in(patches_per_site)) + allocate(this%sites(s)%bc_out(patches_per_site)) + end do + + ! Register the input boundary conditions use for BC allocations + do r = 1, this%npatches + + ! TODO: when and how to update the registry metadata for the site index? + s = this%register(r)%GetSiteIndex() + ifp = this%register(r)%GetFatesPatchIndex() + + call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) + + ! Initialize the input boundary condition - this will call Update + call this%register(r)%InitializeBoundaryConditions() + + end do + +end subroutine InitializeBoundaryConditions + ! ====================================================================================== subroutine UpdateInterfaceVariables(this) From c69f80dc91b8ccf15a71aafba6695422d796322f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 11:34:41 -0700 Subject: [PATCH 129/331] add missing procedure statement for registry initialization --- main/FatesInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 86d9c50c1a..e2c43703a2 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -167,6 +167,7 @@ module FatesInterfaceMod contains + procedure, public :: InitializeInterfaceRegistry procedure, public :: InitializeBoundaryConditions procedure, public :: UpdateInterfaceVariables From 9195e2467575136c26efa1151ef07d53d6ffd813 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 16:42:50 -0700 Subject: [PATCH 130/331] remove extraneous bc type bound procedures due to simplification --- main/FatesInterfaceTypesMod.F90 | 37 ++------------------------------- 1 file changed, 2 insertions(+), 35 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f02c1bf2c1..58416f4951 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -634,9 +634,6 @@ module FatesInterfaceTypesMod contains procedure :: Initialize => InitializeBCIn - - procedure, private :: IntializeDimensionVariables - procedure, private :: InitializeVariables => InitializeVariables_bcin end type bc_in_type @@ -930,37 +927,7 @@ module FatesInterfaceTypesMod ! ====================================================================================== - subroutine InitializeBCIn(this, nlevsoil) - - class(bc_in_type), intent(inout) :: this - integer, intent(in) :: nlevsoil - - ! Initialize the variables that act as dimensions for other boundary conditions - call this%IntializeDimensionVariables(nlevsoil) - - ! Initialize all remaining boundary condition input variables - call this%InitializeVariables() - - - end subroutine InitializeBCIn - - ! ====================================================================================== - - subroutine InitializeDimensionVariables(this, nlevsoil) - - ! Initialize input boundary conditions that are used as dimensions - ! for allocation of other boundary conditions - - class(bc_in_type), intent(inout) :: this - integer, intent(in) :: nlevsoil - - this%nlevsoil = nlevsoil - - end subroutine InitializeDimensionVariables - - ! ====================================================================================== - - subroutine InitializeVariables_bcin(this) + subroutine InitializeBCIn(this) class(bc_in_type), intent(inout) :: this @@ -972,7 +939,7 @@ subroutine InitializeVariables_bcin(this) this%w_scalar_sisl = nan this%t_scalar_sisl = nan - end subroutine InitializeVariables_bcin + end subroutine InitializeBCIn ! ====================================================================================== From 718c92c98925bf09e4e3c740388d1c84859d3f63 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 16:44:09 -0700 Subject: [PATCH 131/331] update the initialize boundary conditions routine in the interface type --- main/FatesInterfaceMod.F90 | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index e2c43703a2..20441d5a71 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2740,6 +2740,10 @@ end subroutine InitializeInterfaceRegistry subroutine InitializeBoundaryConditions(this, patches_per_site) + use FatesInterfaceTypesMod, only : hlm_fates_soil_level + use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_moisture + use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_temperature + ! Arguments class(fates_interface_type), intent(inout) :: this ! fates interface type integer, intent(in) :: patches_per_site ! number of patches per site @@ -2762,12 +2766,33 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) s = this%register(r)%GetSiteIndex() ifp = this%register(r)%GetFatesPatchIndex() + ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) - ! Initialize the input boundary condition - this will call Update - call this%register(r)%InitializeBoundaryConditions() + ! Initialize the interface variables necessary for allocating boundary conditions + call this%register(r)%InitializeInterfaceVariables() + + end do + + ! Initialize the Boundary conditions + do s = 1, this%nsites + call this%sites(s)%InitializeBoundaryConditions(patches_per_site) + end do + + ! Register the boundary conditions + do r = 1, this%npatches + + ! Get the site and BC patch index associated with this registry index + s = this%register(r)%GetSiteIndex() + ifp = this%register(r)%GetFatesPatchIndex() + + ! Register the boundary conditions that are necessary for allocating other boundary conditions first + call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) end do + + end subroutine InitializeBoundaryConditions From 94f4e25aa54adce4273b3754d05fd149248d3590 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 16:44:52 -0700 Subject: [PATCH 132/331] simplify the site-level initialize boundary conditions call due to change in upstream registery initialization --- main/EDTypesMod.F90 | 22 ++-------------------- 1 file changed, 2 insertions(+), 20 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index ebccc9c41e..366283d125 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -624,7 +624,7 @@ module EDTypesMod ! ============================================================================ - subroutine InitializeBoundaryConditions(this, number_patches, nlevsoil) + subroutine InitializeBoundaryConditions(this, number_patches) ! This subroutine intializes an array of each of the boundary condition ! types where the length of the boundary condition is the maximum number of @@ -633,33 +633,15 @@ subroutine InitializeBoundaryConditions(this, number_patches, nlevsoil) ! Inputs class(ed_site_type), intent(inout) :: this integer, intent(in) :: number_patches - integer, intent(in) :: nlevsoil(:) integer :: ifp, c integer :: begc, endc - ! Allocate the boundary condition arrays - allocate(this%bc_in(number_patches)) - allocate(this%bc_out(number_patches)) - - ! Get the bounds of the soil level array passed in - begc = lbound(nlevsoil) - endc = ubound(nlevsoil) - ! Initialize the interface registry do ifp = 1, number_patches - ! Get the column index for this patch index - c = this%column_map(ifp) - - ! Check that the column index is between the expected bounds - if (c < begc .or. c > endc) then - write(fates_log(),*) 'index is not between array bounds: index, start, end: ' c, begc, endc - call endrun(msg=errMsg(__FILE__, __LINE__)) - end if - ! Initialize the input boundary conditions - call this%bc_in(ifp)%Initialize(nlevsoil(c)) + call this%bc_in(ifp)%Initialize() end do From 41c429cfce2de046848b05d9573bdfdfba98819b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 16:45:57 -0700 Subject: [PATCH 133/331] simplify the registry initialization of the BC variables due to inclusion of both fates and hlm variables in the registry structure --- main/FatesInterfaceTypesMod.F90 | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 58416f4951..dd92e5f2be 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1220,29 +1220,27 @@ end subroutine RegisterInterfaceVariables_2d ! ====================================================================================== subroutine InitializeInterfaceVariables(this) - + + ! Arguments class(fates_interface_registry_base_type), intent(inout) :: this ! registry being initialized + + ! Locals + integer :: i ! initialization iterator + integer :: j ! variable index - integer :: i, j - integer :: index_i, index_j - - ! Update the interface variables that are dimensions for fates boundary conditions + ! Update the boundary conditions necessary during initialization only do i = 1, this%num_api_vars_update_init - ! Get the index for the key associated with the current registry variable - j = api%GetRegistryIndex(api%GetRegistryKey(i)) - - ! Get the index for initialization-only variables - index_i = this%index_filter_init(i) - index_j = api%index_filter_init(j) - - ! Set the registry variables updated at initialization - call this%vars(index_i)%Update(api%vars(index_j), api%subgrid_indices) + ! Get the variable index from the init filter + j = this%index_filter_init(i) + + ! Update the variables + call this%fates_vars(j)%Update(hlm_vars(j)) end do - - end subroutine InitializeInterfaceVariables - + + end subroutine + ! ====================================================================================== subroutine UpdateInterfaceVariables(this) From faa3b39aa95cc8d726bba875489c48df7c98b877 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 16:51:53 -0700 Subject: [PATCH 134/331] Revert "Update all patch create calls with new site api pointer argument" This reverts commit 01e37e20debb810d2f1495f33c381b2b3e416f09. --- biogeochem/EDPatchDynamicsMod.F90 | 6 +++--- main/EDInitMod.F90 | 4 ++-- main/FatesInventoryInitMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index bd32f604b5..6a4fa1034a 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -680,7 +680,7 @@ subroutine spawn_patches( currentSite, bc_in ) call newPatch%Create(age, site_areadis, i_landusechange_receiverpatchlabel, i_nocomp_pft, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model, currentSite%api) + hlm_regeneration_model) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches @@ -1442,7 +1442,7 @@ subroutine spawn_patches( currentSite, bc_in ) call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model, currentSite%api) + hlm_regeneration_model) ! Initialize the litter pools to zero do el=1,num_elements @@ -1735,7 +1735,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, a call new_patch%Create(0._r8, temp_area, & currentPatch%land_use_label, currentPatch%nocomp_pft_label, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model, currentSite%api) + hlm_regeneration_model) ! Initialize the litter pools to zero, these ! pools will be populated shortly diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index c4b6075234..be39037f00 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -840,7 +840,7 @@ subroutine init_patches( nsites, sites, bc_in) call newp%Create(age, newparea, nocomp_bareground_land, nocomp_bareground, & num_swb, numpft, sites(s)%nlevsoil, hlm_current_tod, & - hlm_regeneration_model, sites(s)%api) + hlm_regeneration_model) ! set pointers for first patch (or only patch, if nocomp is false) newp%patchno = 1 @@ -919,7 +919,7 @@ subroutine init_patches( nsites, sites, bc_in) call newp%Create(age, newparea, i_lu_state, nocomp_pft, & num_swb, numpft, sites(s)%nlevsoil, hlm_current_tod, & - hlm_regeneration_model, sites(s)%api) + hlm_regeneration_model) if (is_first_patch) then !is this the first patch? ! set pointers for first patch (or only patch, if nocomp is false) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 61a162a952..6673f4b819 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -284,7 +284,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) allocate(newpatch) call newpatch%Create(age_init, area_init, primaryland, & fates_unset_int, num_swb, numpft, sites(s)%nlevsoil, & - hlm_current_tod, hlm_regeneration_model, sites(s)%api) + hlm_current_tod, hlm_regeneration_model) newpatch%patchno = ipa newpatch%younger => null() diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index f81c348631..c9e98c49ad 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -3112,7 +3112,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) ! make new patch call newp%Create(fates_unset_r8, fates_unset_r8, primaryland, & nocomp_pft, num_swb, numpft, sites(s)%nlevsoil, & - hlm_current_tod, hlm_regeneration_model, sites(s)%api) + hlm_current_tod, hlm_regeneration_model) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches From f007a19a08f32046f69c2ee6190833344f4aceeb Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 16:58:15 -0700 Subject: [PATCH 135/331] Revert "initial handover from site-level bc_in to patch level bc_in for fragmentation scalar only" This reverts commit 57a43e25a23ff5acd6422df41f0a33706f5c4019. --- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeochem/FatesPatchMod.F90 | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index b62b3e7522..f509aec000 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -3215,7 +3215,7 @@ subroutine fragmentation_scaler( currentPatch, bc_in) if ( use_hlm_soil_scalar ) then ! Calculate the fragmentation_scaler - currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,currentPatch%bc_in%t_scalar_sisl * currentPatch%bc_in%w_scalar_sisl)) + currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,bc_in%t_scalar_sisl * bc_in%w_scalar_sisl)) else diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index fb50bd297b..c0862fbab4 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -543,6 +543,10 @@ subroutine NanValues(this) this%tfc_ros = nan this%frac_burnt = nan + ! Boundary conditions + this%bc_in%w_scalar_sisl(:) = nan + this%bc_in%t_scalar_sisl(:) = nan + end subroutine NanValues !=========================================================================== From e0deb7c98b5d5e968b51cfbc36da207e3c816a8e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 17:01:42 -0700 Subject: [PATCH 136/331] manually revert the addition of boundary conditions to the patch structure --- biogeochem/FatesPatchMod.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index c0862fbab4..fb50bd297b 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -543,10 +543,6 @@ subroutine NanValues(this) this%tfc_ros = nan this%frac_burnt = nan - ! Boundary conditions - this%bc_in%w_scalar_sisl(:) = nan - this%bc_in%t_scalar_sisl(:) = nan - end subroutine NanValues !=========================================================================== From 7a462034f5bb54a02d646058f008c52e2c05a7a2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 30 Sep 2025 17:05:58 -0700 Subject: [PATCH 137/331] simplify the update interface variables call per combining fates and hlm variables in the same registry --- main/FatesInterfaceMod.F90 | 27 +++------------------------ 1 file changed, 3 insertions(+), 24 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 20441d5a71..9dfacc807b 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2800,33 +2800,12 @@ end subroutine InitializeBoundaryConditions subroutine UpdateInterfaceVariables(this) - use FatesInterfaceTypesMod, only : subgrid_column_index - class(fates_interface_type), intent(inout) :: this - - class(fates_interface_registry_base_type), pointer :: patch_api - class(fates_patch_type), pointer :: currentPatch - - integer :: s ! site index - - do s = 1, this%nsites - currentPatch => this%sites(s)%oldest_patch - do while (associated(currentPatch)) - patch_api => currentPatch%api + integer :: r ! site index - ! Transfer the column index to the HLM interface registry - ! While this may be duplicative for older patches, we need - ! to ensure that the new patches are provided with the column index - this%api%subgrid_indices(subgrid_column_index) = this%sites(s)%column_map(currentPatch%patchno) - - ! Update the patch boundary condition via the HLM Interface data pointer - call patch_api%Update(this%api) - - ! TODO: Update the HLM interface variables with the patch variables here - - currentPatch => currentPatch%younger - end do + do r = 1, this%npatches + call this%register(r)%Update() end do end subroutine UpdateInterfaceVariables From a27c1612c1a015bda89c68f3ae6a4970257269ce Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 1 Oct 2025 10:18:28 -0700 Subject: [PATCH 138/331] simplify boundary condition initialization --- main/FatesInterfaceMod.F90 | 25 +++++-------------------- 1 file changed, 5 insertions(+), 20 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 9dfacc807b..2f375af652 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2753,12 +2753,6 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) integer :: s ! site iterator integer :: ifp ! boundary condition iterator - ! Allocate boundary conditions for all sites with the maximum number of patches per site - do s = 1, this%nsites - allocate(this%sites(s)%bc_in(patches_per_site)) - allocate(this%sites(s)%bc_out(patches_per_site)) - end do - ! Register the input boundary conditions use for BC allocations do r = 1, this%npatches @@ -2766,33 +2760,24 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) s = this%register(r)%GetSiteIndex() ifp = this%register(r)%GetFatesPatchIndex() + ! Allocate boundary conditions for all sites with the maximum number of patches per site + allocate(this%sites(s)%bc_in(patches_per_site)) + allocate(this%sites(s)%bc_out(patches_per_site)) + ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) ! Initialize the interface variables necessary for allocating boundary conditions call this%register(r)%InitializeInterfaceVariables() - end do - - ! Initialize the Boundary conditions - do s = 1, this%nsites + ! Initialize the Boundary conditions call this%sites(s)%InitializeBoundaryConditions(patches_per_site) - end do - - ! Register the boundary conditions - do r = 1, this%npatches - - ! Get the site and BC patch index associated with this registry index - s = this%register(r)%GetSiteIndex() - ifp = this%register(r)%GetFatesPatchIndex() ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) end do - - end subroutine InitializeBoundaryConditions From a2ae541c0eaa34e7c84d264bfe21aa69077cc012 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 1 Oct 2025 10:19:23 -0700 Subject: [PATCH 139/331] minor reordering --- main/FatesInterfaceMod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 2f375af652..b11c7a61f7 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2756,11 +2756,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the input boundary conditions use for BC allocations do r = 1, this%npatches - ! TODO: when and how to update the registry metadata for the site index? - s = this%register(r)%GetSiteIndex() - ifp = this%register(r)%GetFatesPatchIndex() - ! Allocate boundary conditions for all sites with the maximum number of patches per site + s = this%register(r)%GetSiteIndex() allocate(this%sites(s)%bc_in(patches_per_site)) allocate(this%sites(s)%bc_out(patches_per_site)) @@ -2774,6 +2771,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%sites(s)%InitializeBoundaryConditions(patches_per_site) ! Register the boundary conditions that are necessary for allocating other boundary conditions first + ifp = this%register(r)%GetFatesPatchIndex() call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) From 422b82e41b7d21f0bcb079d193bd31cbb4b3ff6f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 10:15:41 -0700 Subject: [PATCH 140/331] remove defunct bc_in level registry --- main/FatesInterfaceTypesMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index dd92e5f2be..50ea95e72c 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -629,8 +629,6 @@ module FatesInterfaceTypesMod real(r8),allocatable :: hlm_sp_tsai(:) ! Interpolated sailt total SAI (stem area index) input from HLM per patch/pft real(r8),allocatable :: hlm_sp_htop(:) ! Interpolated daily canopy vegetation height input from HLM per patch/pft - type(fates_interface_registry_base_type) :: API - contains procedure :: Initialize => InitializeBCIn From 800140b74b3cfb79ead434f51783b137ac882404 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 10:17:57 -0700 Subject: [PATCH 141/331] update registry initiaization to setup registry for both hlm and fates vars This allows for the index to match for a given key --- main/FatesInterfaceTypesMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 50ea95e72c..8ace8d2882 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1052,7 +1052,8 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc update_frequency_local = registry_update_daily end if - call this%vars(index)%Initialize(key, update_frequency_local) + call this%hlm_vars(index)%Initialize(key, update_frequency_local) + call this%fates_vars(index)%Initialize(key, update_frequency_local) ! Not initializing, just counting the variables else From bb427e2c58d31647147ce298776997db46500a87 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 10:18:44 -0700 Subject: [PATCH 142/331] add missing topounit index to the registry metadata --- main/FatesInterfaceTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 8ace8d2882..cbe39938c4 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -890,6 +890,7 @@ module FatesInterfaceTypesMod ! Subgrid index data integer, private :: gidx + integer, private :: tidx integer, private :: lidx integer, private :: cidx integer, private :: sidx From 53783245ac9598118c4b30dcffe6a4605e6a7f5e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 10:54:02 -0700 Subject: [PATCH 143/331] update getregistryindex argument to use var type to find index --- main/FatesInterfaceTypesMod.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index cbe39938c4..b57d033989 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1167,9 +1167,9 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key, hlm_vars))%Register(data, active=.true.) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + call this%fates_vars(this%GetRegistryIndex(key, fates_vars))%Register(data, active=.true.) end if @@ -1189,9 +1189,9 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key, hlm_vars))%Register(data(:), active=.true.) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + call this%fates_vars(this%GetRegistryIndex(key, fates_vars))%Register(data(:), active=.true.) end if end subroutine RegisterInterfaceVariables_1d @@ -1210,9 +1210,9 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key, hlm_vars))%Register(data(:,:), active=.true.) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + call this%fates_vars(this%GetRegistryIndex(key, fates_vars))%Register(data(:,:), active=.true.) end if end subroutine RegisterInterfaceVariables_2d @@ -1258,12 +1258,12 @@ end subroutine UpdateInterfaceVariables ! ====================================================================================== - integer function GetRegistryIndex(this, key) result(index) + integer function GetRegistryIndex(this, vars, key) result(index) ! This procedure returns the index associated with the key provided class(fates_interface_registry_base_type), intent(in) :: this - + class(fates_interface_variable_type), intent(in) :: vars character(len=*), intent(in) :: key ! variable registry key to search integer :: ivar ! Iterator @@ -1280,12 +1280,12 @@ end function GetRegistryIndex ! ====================================================================================== - function GetRegistryKey(this, index) result(key) + function GetRegistryKey(this, vars, index) result(key) ! This procedure returns the index associated with the key provided class(fates_interface_registry_base_type), intent(in) :: this - + class(fates_interface_variable_type), intent(in) :: vars integer, intent(in) :: index ! variable registry index character(len=:), allocatable :: key From 5c105d0fda1719803f75aa85775d9951629433a5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:06:12 -0700 Subject: [PATCH 144/331] All key array to the registry type --- main/FatesInterfaceTypesMod.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index b57d033989..5650ada243 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -877,6 +877,9 @@ module FatesInterfaceTypesMod ! Container array of interface variables indexed by key type(fates_interface_variable_type), allocatable :: hlm_vars(:) type(fates_interface_variable_type), allocatable :: fates_vars(:) + + ! Arra of keys associated with the interface variables + character(len=48), allocatable :: key(:) ! Variable regsitry metadata integer :: num_api_vars ! number of variables in the registry @@ -975,6 +978,7 @@ subroutine InitializeInterfaceRegistry(this) ! Allocate the registry variables arrays allocate(this%fates_vars(this%num_api_vars)) allocate(this%hlm_vars(this%num_api_vars)) + allocate(this%key(this%num_api_vars)) ! Allocate the index maps allocate(this%index_filter_init(this%num_api_vars_update_init)) @@ -1053,6 +1057,10 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc update_frequency_local = registry_update_daily end if + ! Update the key array + this%key(index) = key + + ! Initialize the interface variables call this%hlm_vars(index)%Initialize(key, update_frequency_local) call this%fates_vars(index)%Initialize(key, update_frequency_local) From 2744f45c68ecf8f0df3ceca636b3a1c398cd0dd1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:07:20 -0700 Subject: [PATCH 145/331] Revert "update getregistryindex argument to use var type to find index" This reverts commit 0d0c9eb68712b239814596cc02835134eec38630. --- main/FatesInterfaceTypesMod.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 5650ada243..5b6b23d525 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1175,9 +1175,9 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key, hlm_vars))%Register(data, active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) else - call this%fates_vars(this%GetRegistryIndex(key, fates_vars))%Register(data, active=.true.) + call this%fates_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) end if @@ -1197,9 +1197,9 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key, hlm_vars))%Register(data(:), active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) else - call this%fates_vars(this%GetRegistryIndex(key, fates_vars))%Register(data(:), active=.true.) + call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) end if end subroutine RegisterInterfaceVariables_1d @@ -1218,9 +1218,9 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key, hlm_vars))%Register(data(:,:), active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) else - call this%fates_vars(this%GetRegistryIndex(key, fates_vars))%Register(data(:,:), active=.true.) + call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) end if end subroutine RegisterInterfaceVariables_2d @@ -1266,12 +1266,12 @@ end subroutine UpdateInterfaceVariables ! ====================================================================================== - integer function GetRegistryIndex(this, vars, key) result(index) + integer function GetRegistryIndex(this, key) result(index) ! This procedure returns the index associated with the key provided class(fates_interface_registry_base_type), intent(in) :: this - class(fates_interface_variable_type), intent(in) :: vars + character(len=*), intent(in) :: key ! variable registry key to search integer :: ivar ! Iterator @@ -1288,12 +1288,12 @@ end function GetRegistryIndex ! ====================================================================================== - function GetRegistryKey(this, vars, index) result(key) + function GetRegistryKey(this, index) result(key) ! This procedure returns the index associated with the key provided class(fates_interface_registry_base_type), intent(in) :: this - class(fates_interface_variable_type), intent(in) :: vars + integer, intent(in) :: index ! variable registry index character(len=:), allocatable :: key From 8d07565c4c57403ee2cebeb3c171251baa3a7624 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:09:04 -0700 Subject: [PATCH 146/331] update key/index get functions to use the registry array --- main/FatesInterfaceTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 5b6b23d525..8a98dec5b8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1278,7 +1278,7 @@ integer function GetRegistryIndex(this, key) result(index) ! Iterate over the registry until the associated key is found do ivar = 1, this%num_api_vars - if (this%vars(ivar)%key == key) then + if (this%key(ivar) == key) then index = ivar return end if @@ -1297,7 +1297,7 @@ function GetRegistryKey(this, index) result(key) integer, intent(in) :: index ! variable registry index character(len=:), allocatable :: key - key = this%vars(index)%key + key = this%key(index) end function GetRegistryKey From 2852c4fbe0de1b1b792db244e7f96ecab63e0c0a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:22:55 -0700 Subject: [PATCH 147/331] minor typo fix --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 8a98dec5b8..9a4976741b 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -878,7 +878,7 @@ module FatesInterfaceTypesMod type(fates_interface_variable_type), allocatable :: hlm_vars(:) type(fates_interface_variable_type), allocatable :: fates_vars(:) - ! Arra of keys associated with the interface variables + ! Array of keys associated with the interface variables character(len=48), allocatable :: key(:) ! Variable regsitry metadata From e44137340d87993d064324dfa7256510c285a4ac Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:25:14 -0700 Subject: [PATCH 148/331] add update frequency array to the registry type --- main/FatesInterfaceTypesMod.F90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 9a4976741b..0301e0c598 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -886,6 +886,9 @@ module FatesInterfaceTypesMod integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily + ! Array of update frequency values for each variable index + integer, allocatable :: update_frequency(:) + ! Arrays that hold the indices of variables based on update frequency integer, allocatable :: index_filter_init(:) ! index of variables that update only at initialization integer, allocatable :: index_filter_daily(:) ! index of variables that update daily @@ -1057,10 +1060,13 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc update_frequency_local = registry_update_daily end if - ! Update the key array + ! Set the key for each index this%key(index) = key - ! Initialize the interface variables + ! Set the update frequency array values + this%update_frequency(index) = update_frequency_local + + ! Initialize the interface variables and pass the key and update frequency to each for metadata call this%hlm_vars(index)%Initialize(key, update_frequency_local) call this%fates_vars(index)%Initialize(key, update_frequency_local) @@ -1135,14 +1141,14 @@ subroutine SetFilterMapArrays(this) ! Iterate over all registered variables and populate the filter maps accordingly do index = 1, this%num_api_vars - if (this%vars(index)%update_frequency == registry_update_init) then + if (this%update_frequency(index) == registry_update_init) then count_init = count_init + 1 this%index_filter_init(count_init) = index - else if (this%vars(index)%update_frequency == registry_update_daily) then + else if (this%update_frequency(index) == registry_update_daily) then count_daily = count_daily + 1 this%index_filter_daily(count_daily) = index else - write(fates_log(),*) 'ERROR: Unrecognized update frequency in SetFilterMapArrays(): ', this%vars(index)%update_frequency + write(fates_log(),*) 'ERROR: Unrecognized update frequency in SetFilterMapArrays(): ', this%update_frequency(index) call endrun(msg=errMsg(__FILE__, __LINE__)) end if end do From ce3ed034c2e166878bdcab622fac8b3f871dc6b3 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:28:06 -0700 Subject: [PATCH 149/331] add update frequency to the initialization --- main/FatesInterfaceTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 0301e0c598..de213b983b 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -982,6 +982,7 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%fates_vars(this%num_api_vars)) allocate(this%hlm_vars(this%num_api_vars)) allocate(this%key(this%num_api_vars)) + allocate(this%update_frequency(this%num_api_vars)) ! Allocate the index maps allocate(this%index_filter_init(this%num_api_vars_update_init)) From c17e209f9b9f44147dd9799713149533a8cf17f5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:28:48 -0700 Subject: [PATCH 150/331] unset the allocatable registry variable arrays --- main/FatesInterfaceTypesMod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index de213b983b..d02106ba10 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -987,6 +987,12 @@ subroutine InitializeInterfaceRegistry(this) ! Allocate the index maps allocate(this%index_filter_init(this%num_api_vars_update_init)) allocate(this%index_filter_daily(this%num_api_vars_update_daily)) + + ! Unset the allocatables not including the interface variables + this%key(:) = fates_unset_int + this%update_frequency(:) = fates_unset_int + this%index_filter_init(:) = fates_unset_int + this%index_filter_daily(:) = fates_unset_int ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) From a6fe6a09086847fe4a01d1e9dfdb141c7dda3a82 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:32:42 -0700 Subject: [PATCH 151/331] comment updates for registry initialization --- main/FatesInterfaceTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d02106ba10..d80e4c004f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -970,12 +970,12 @@ subroutine InitializeInterfaceRegistry(this) logical :: initialize - ! initial registry integers + ! initial registry counters this%num_api_vars = 0 this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 - ! First count up the keys defined in the registry + ! First count up the keys defined in the registry and the registry counters call this%DefineInterfaceRegistry(initialize=.false.) ! Allocate the registry variables arrays From 16e669c27e7f29b24e4a560f9a6558052e27670f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:36:36 -0700 Subject: [PATCH 152/331] minor typo correctoin --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d80e4c004f..5f9890c1c0 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -970,7 +970,7 @@ subroutine InitializeInterfaceRegistry(this) logical :: initialize - ! initial registry counters + ! Initialize registry counters this%num_api_vars = 0 this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 From e62091aca61ee0fde62903c32aeda23c0529e282 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:37:40 -0700 Subject: [PATCH 153/331] reorganize the interfact registry initialization --- main/FatesInterfaceTypesMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 5f9890c1c0..6e2d003b9d 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -984,10 +984,6 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%key(this%num_api_vars)) allocate(this%update_frequency(this%num_api_vars)) - ! Allocate the index maps - allocate(this%index_filter_init(this%num_api_vars_update_init)) - allocate(this%index_filter_daily(this%num_api_vars_update_daily)) - ! Unset the allocatables not including the interface variables this%key(:) = fates_unset_int this%update_frequency(:) = fates_unset_int @@ -996,6 +992,10 @@ subroutine InitializeInterfaceRegistry(this) ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) + + ! Allocate the index filter maps + allocate(this%index_filter_init(this%num_api_vars_update_init)) + allocate(this%index_filter_daily(this%num_api_vars_update_daily)) ! Set filter map arrays call this%SetFilterMapArrays() From 5e51c14330fae6c6be34d80c3e71e06a2d601059 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:39:09 -0700 Subject: [PATCH 154/331] simplify the registry index filter name --- main/FatesInterfaceTypesMod.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 6e2d003b9d..12ff8268c3 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -890,9 +890,9 @@ module FatesInterfaceTypesMod integer, allocatable :: update_frequency(:) ! Arrays that hold the indices of variables based on update frequency - integer, allocatable :: index_filter_init(:) ! index of variables that update only at initialization - integer, allocatable :: index_filter_daily(:) ! index of variables that update daily - ! integer, allocatable :: index_filter_timestep(:) ! index of variables that update at each timestep + integer, allocatable :: filter_init(:) ! index of variables that update only at initialization + integer, allocatable :: filter_daily(:) ! index of variables that update daily + ! integer, allocatable :: filter_timestep(:) ! index of variables that update at each timestep ! Subgrid index data integer, private :: gidx @@ -987,8 +987,8 @@ subroutine InitializeInterfaceRegistry(this) ! Unset the allocatables not including the interface variables this%key(:) = fates_unset_int this%update_frequency(:) = fates_unset_int - this%index_filter_init(:) = fates_unset_int - this%index_filter_daily(:) = fates_unset_int + this%filter_init(:) = fates_unset_int + this%filter_daily(:) = fates_unset_int ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) @@ -1150,10 +1150,10 @@ subroutine SetFilterMapArrays(this) do index = 1, this%num_api_vars if (this%update_frequency(index) == registry_update_init) then count_init = count_init + 1 - this%index_filter_init(count_init) = index + this%filter_init(count_init) = index else if (this%update_frequency(index) == registry_update_daily) then count_daily = count_daily + 1 - this%index_filter_daily(count_daily) = index + this%filter_daily(count_daily) = index else write(fates_log(),*) 'ERROR: Unrecognized update frequency in SetFilterMapArrays(): ', this%update_frequency(index) call endrun(msg=errMsg(__FILE__, __LINE__)) From baafded877f64213db8fe39d53234be7476f1d17 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:46:22 -0700 Subject: [PATCH 155/331] change index filter in the initialization --- main/FatesInterfaceTypesMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 12ff8268c3..f5a11b85af 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -994,8 +994,8 @@ subroutine InitializeInterfaceRegistry(this) call this%DefineInterfaceRegistry(initialize=.true.) ! Allocate the index filter maps - allocate(this%index_filter_init(this%num_api_vars_update_init)) - allocate(this%index_filter_daily(this%num_api_vars_update_daily)) + allocate(this%filter_init(this%num_api_vars_update_init)) + allocate(this%filter_daily(this%num_api_vars_update_daily)) ! Set filter map arrays call this%SetFilterMapArrays() @@ -1253,7 +1253,7 @@ subroutine InitializeInterfaceVariables(this) do i = 1, this%num_api_vars_update_init ! Get the variable index from the init filter - j = this%index_filter_init(i) + j = this%filter_init(i) ! Update the variables call this%fates_vars(j)%Update(hlm_vars(j)) From 4b0f8cfedf05b733bf968b8919ab9dd00b28c1e2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:52:50 -0700 Subject: [PATCH 156/331] remove unset for character array --- main/FatesInterfaceTypesMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f5a11b85af..fd22023481 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -985,7 +985,6 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%update_frequency(this%num_api_vars)) ! Unset the allocatables not including the interface variables - this%key(:) = fates_unset_int this%update_frequency(:) = fates_unset_int this%filter_init(:) = fates_unset_int this%filter_daily(:) = fates_unset_int From 35e954bfa0bb2ec3cfb0e8694bfa609e933ca67d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:57:48 -0700 Subject: [PATCH 157/331] correct update call to reference itself as an input --- main/FatesInterfaceTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index fd22023481..b969599282 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1255,7 +1255,7 @@ subroutine InitializeInterfaceVariables(this) j = this%filter_init(i) ! Update the variables - call this%fates_vars(j)%Update(hlm_vars(j)) + call this%fates_vars(j)%Update(this%hlm_vars(j)) end do @@ -1271,7 +1271,7 @@ subroutine UpdateInterfaceVariables(this) ! Iterate over all registered variables do i = 1, this%num_api_vars - this%fates_vars(i)%Update(hlm_vars(i)) + this%fates_vars(i)%Update(this%hlm_vars(i)) end do end subroutine UpdateInterfaceVariables From 841c8ceaa9bda6e617bdaf010f6cdfafb7e6c702 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 11:58:06 -0700 Subject: [PATCH 158/331] add missing call statement --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index b969599282..cab0406666 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1271,7 +1271,7 @@ subroutine UpdateInterfaceVariables(this) ! Iterate over all registered variables do i = 1, this%num_api_vars - this%fates_vars(i)%Update(this%hlm_vars(i)) + call this%fates_vars(i)%Update(this%hlm_vars(i)) end do end subroutine UpdateInterfaceVariables From 6babece67bcee5373bf90d2e2e35070712a01876 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 14:45:02 -0700 Subject: [PATCH 159/331] add procedure statement for initialize BCs to site type --- main/EDTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 366283d125..ccac0918bf 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -610,6 +610,7 @@ module EDTypesMod contains + procedure, public :: InitializeBoundaryConditions procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction From f4a1afbe7686bbe265e4d793d7a979f4b3db765c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 14:50:40 -0700 Subject: [PATCH 160/331] add get column function procedure statement to the registry type --- main/FatesInterfaceTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index cab0406666..c6c6804b55 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -908,6 +908,7 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceRegistry procedure :: InitializeInterfaceVariables procedure :: SetSubgridIndices + procedure :: GetColumnIndex procedure :: Update => UpdateInterfaceVariables generic :: Register => RegisterInterfaceVariables_0d, & From a8bfeea6c63a84c08367c30c9e95b7b8392da930 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 14:51:05 -0700 Subject: [PATCH 161/331] add get site and get fates patch index functions to registry type --- main/FatesInterfaceTypesMod.F90 | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index c6c6804b55..5852f75452 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -905,6 +905,8 @@ module FatesInterfaceTypesMod contains + procedure :: GetSiteIndex + procedure :: GetFatesPatchIndex procedure :: InitializeInterfaceRegistry procedure :: InitializeInterfaceVariables procedure :: SetSubgridIndices @@ -1113,6 +1115,7 @@ subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatc integer, intent(in) :: landunit integer, intent(in) :: column integer, intent(in) :: hlmpatch + integer, intent(in) :: hlmpatch this%gidx = gridcell this%tidx = topounit @@ -1134,6 +1137,26 @@ end function GetColumnIndex ! ====================================================================================== + integer function GetSiteIndex(this) result(sidx) + + class(fates_interface_registry_base_type), intent(inout) :: this + + sidx = this%sidx + + end function GetSiteIndex + + ! ====================================================================================== + + integer function GetFatesPatchIndex(this) result(fpidx) + + class(fates_interface_registry_base_type), intent(inout) :: this + + fpidx = this%fpidx + + end function GetFatesPatchIndex + + ! ====================================================================================== + subroutine SetFilterMapArrays(this) class(fates_interface_registry_base_type), intent(inout) :: this From cfd1294b5a8a778bfe3db7703502ecac95bb91ce Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 14:54:49 -0700 Subject: [PATCH 162/331] remove duplicate argument definition --- main/FatesInterfaceTypesMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 5852f75452..d415bb0a6e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1115,7 +1115,6 @@ subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatc integer, intent(in) :: landunit integer, intent(in) :: column integer, intent(in) :: hlmpatch - integer, intent(in) :: hlmpatch this%gidx = gridcell this%tidx = topounit From 648b92b1d48d26aacfcc9e0fb096fd9293cd65cd Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 2 Oct 2025 14:55:03 -0700 Subject: [PATCH 163/331] minor comment update --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b11c7a61f7..aad6b6dbd7 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2751,7 +2751,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Locals integer :: r ! registery iterator integer :: s ! site iterator - integer :: ifp ! boundary condition iterator + integer :: ifp ! boundary condition index ! Register the input boundary conditions use for BC allocations do r = 1, this%npatches From 98801e3224df2de1abf8a1ca6b05ebedec4a7379 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 15:31:51 -0700 Subject: [PATCH 164/331] move interface registry type filter unset after allocation --- main/FatesInterfaceTypesMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d415bb0a6e..6b558caddb 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -987,6 +987,10 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%key(this%num_api_vars)) allocate(this%update_frequency(this%num_api_vars)) + ! Allocate the index filter maps + allocate(this%filter_init(this%num_api_vars_update_init)) + allocate(this%filter_daily(this%num_api_vars_update_daily)) + ! Unset the allocatables not including the interface variables this%update_frequency(:) = fates_unset_int this%filter_init(:) = fates_unset_int @@ -995,10 +999,6 @@ subroutine InitializeInterfaceRegistry(this) ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) - ! Allocate the index filter maps - allocate(this%filter_init(this%num_api_vars_update_init)) - allocate(this%filter_daily(this%num_api_vars_update_daily)) - ! Set filter map arrays call this%SetFilterMapArrays() From 17ab7cbe820a93272ca4ec7c6c13ffb562956f80 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 15:32:12 -0700 Subject: [PATCH 165/331] move get index before registration call --- main/FatesInterfaceMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index aad6b6dbd7..c49c9377c5 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2761,6 +2761,9 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) allocate(this%sites(s)%bc_in(patches_per_site)) allocate(this%sites(s)%bc_out(patches_per_site)) + ! Get the fates boundary condition index + ifp = this%register(r)%GetFatesPatchIndex() + ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) @@ -2771,7 +2774,6 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%sites(s)%InitializeBoundaryConditions(patches_per_site) ! Register the boundary conditions that are necessary for allocating other boundary conditions first - ifp = this%register(r)%GetFatesPatchIndex() call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) From e11a6564e10bd1173049015cfbaf64b7b6f1b93e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 16:49:55 -0700 Subject: [PATCH 166/331] add more registry get functions --- main/FatesInterfaceTypesMod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 6b558caddb..eabf3e8c9f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -905,12 +905,15 @@ module FatesInterfaceTypesMod contains + procedure :: GetGridcellIndex + procedure :: GetLandunitIndex + procedure :: GetColumnIndex procedure :: GetSiteIndex + procedure :: GetHLMPatchIndex procedure :: GetFatesPatchIndex procedure :: InitializeInterfaceRegistry procedure :: InitializeInterfaceVariables procedure :: SetSubgridIndices - procedure :: GetColumnIndex procedure :: Update => UpdateInterfaceVariables generic :: Register => RegisterInterfaceVariables_0d, & From 26f8afac48ff12e40cf9b43b26222a9d7833b23a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 16:50:28 -0700 Subject: [PATCH 167/331] define registry get functions --- main/FatesInterfaceTypesMod.F90 | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index eabf3e8c9f..f30aa27d60 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1129,6 +1129,26 @@ end subroutine SetSubgridIndices ! ====================================================================================== + integer function GetGridcellIndex(this) result(gidx) + + class(fates_interface_registry_base_type), intent(inout) :: this + + gidx = this%gidx + + end function GetGridcellIndex + + ! ====================================================================================== + + integer function GetLandunitIndex(this) result(lidx) + + class(fates_interface_registry_base_type), intent(inout) :: this + + lidx = this%lidx + + end function GetLandunitIndex + + ! ====================================================================================== + integer function GetColumnIndex(this) result(cidx) class(fates_interface_registry_base_type), intent(inout) :: this @@ -1139,6 +1159,16 @@ end function GetColumnIndex ! ====================================================================================== + integer function GetHLMPatchIndex(this) result(hpidx) + + class(fates_interface_registry_base_type), intent(inout) :: this + + hpidx = this%hpidx + + end function GetHLMPatchIndex + + ! ====================================================================================== + integer function GetSiteIndex(this) result(sidx) class(fates_interface_registry_base_type), intent(inout) :: this From f4df8173921097fd0906926489e68609b4a24d77 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 16:50:54 -0700 Subject: [PATCH 168/331] update setsubgrid indices to have all optional arguments --- main/FatesInterfaceTypesMod.F90 | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f30aa27d60..7e1b3f807e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1113,17 +1113,21 @@ end subroutine DefineInterfaceVariable subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch) class(fates_interface_registry_base_type), intent(inout) :: this - integer, intent(in) :: gridcell - integer, intent(in) :: topounit - integer, intent(in) :: landunit - integer, intent(in) :: column - integer, intent(in) :: hlmpatch + integer, intent(in), optional :: gridcell + integer, intent(in), optional :: topounit + integer, intent(in), optional :: landunit + integer, intent(in), optional :: column + integer, intent(in), optional :: hlmpatch + integer, intent(in), optional :: fatespatch + integer, intent(in), optional :: site - this%gidx = gridcell - this%tidx = topounit - this%lidx = landunit - this%cidx = column - this%hpidx = hlmpatch + if (present(gridcell)) this%gidx = gridcell + if (present(topounit)) this%tidx = topounit + if (present(landunit)) this%lidx = landunit + if (present(column)) this%cidx = column + if (present(hlmpatch)) this%hpidx = hlmpatch + if (present(fatespatch)) this%fpidx = fatespatch + if (present(site)) this%sidx = site end subroutine SetSubgridIndices From fba9cf0a33bb3cb117bec7269bc56dd4daba1d5a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 16:51:18 -0700 Subject: [PATCH 169/331] update arguments to include fates patches and sites --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 7e1b3f807e..76ece35d71 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1110,7 +1110,7 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== - subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch) + subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch, fatespatch, site) class(fates_interface_registry_base_type), intent(inout) :: this integer, intent(in), optional :: gridcell From dd54e3e3f7827232163da15f03310d1b4dd85378 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 16:52:15 -0700 Subject: [PATCH 170/331] update interface registry initialization to set hlm patches indices and count --- main/FatesInterfaceMod.F90 | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index c49c9377c5..13a2243546 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2713,24 +2713,34 @@ end subroutine FatesReadParameters ! ====================================================================================== -subroutine InitializeInterfaceRegistry(this, number_clump_patches) +subroutine InitializeInterfaceRegistry(this, number_clump_patches, patchlist) ! This procedure intializes an interface registry for each patch index on the clump ! Arguments class(fates_interface_type), intent(inout) :: this ! fates interface integer, intent(in) :: number_clump_patches ! number of patches in this clump + integer, intent(in) :: patchlist(:) ! list of hlm patches for registry index ! Locals - integer :: i + integer :: r ! registry index ! Allocate interface registries for each patch on the clump allocate(this%register(number_clump_patches)) + + ! Set the number of vegetated patches to the interface type level + this%npatches = num_veg_patches ! Initialize each registry with a dictionary of keys to register fates and hlm variables against ! The keys are defined in the registry type-bound procedures - do i = 1, number_clump_patches - call this%register(i)%InitializeInterfaceRegistry() + do r = 1, number_clump_patches + + ! Initialize registry + call this%register(r)%InitializeInterfaceRegistry() + + ! Set the HLM patch index with the current registry + this%register(r)%SetSubgridIndices(hlmpatch=patchlist(r)) + end do end subroutine InitializeInterfaceRegistry From daced1baf465b190423323269d0016e129e7d996 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 16:57:16 -0700 Subject: [PATCH 171/331] add fates site initialization procedure --- main/FatesInterfaceMod.F90 | 40 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 13a2243546..956515d587 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2745,6 +2745,46 @@ subroutine InitializeInterfaceRegistry(this, number_clump_patches, patchlist) end subroutine InitializeInterfaceRegistry +! ====================================================================================== + +subroutine InitializeFatesSites(this) + + class(fates_interface_type), intent(inout) :: this ! fates interface + + ! Local + integer :: r ! interface registry index + integer :: g ! gridcell index + integer :: gc ! current gridcell index + integer :: s ! site counter/index + integer :: ifp ! fates patch counter/index + + ! Initialize the current gridcell index and the fates site counter + gc = fates_unset_int + s = 0 + ifp = 0 + + ! Iterate over the number of vegetated patches and determine + do r = 1, this%npatches + + ! Get the gridcell index + g = this%register(r)%GetGridcellIndex() + + ! Update the fates counter + ifp = ifp + 1 + + ! Iterate the fates site and reset the fates patch counter for each new gridcell index + if (gc /= g) then + gc = g + s = s + 1 + ifp = 1 + end if + + ! Set the site index for the current registry + this%register(r)%SetSubgridIndices(fatespatch=ifp, site=s) + + end do + +end subroutine InitializeFatesSites ! ====================================================================================== From 99c4c4ea346f0a622e36a8141c0d81cb66888892 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 17:01:10 -0700 Subject: [PATCH 172/331] minor comment update --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 956515d587..49d4ab37eb 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2779,7 +2779,7 @@ subroutine InitializeFatesSites(this) ifp = 1 end if - ! Set the site index for the current registry + ! Set the site and fates patch index for the current registry this%register(r)%SetSubgridIndices(fatespatch=ifp, site=s) end do From 1bdd664a964536b2be08e6c89eedb85897cc03f0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 Oct 2025 17:01:40 -0700 Subject: [PATCH 173/331] add site allocation commented out for later implementation --- main/FatesInterfaceMod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 49d4ab37eb..8e1801cb4e 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2783,6 +2783,12 @@ subroutine InitializeFatesSites(this) this%register(r)%SetSubgridIndices(fatespatch=ifp, site=s) end do + + ! Set the number of fates sites for the interface + ! this%nsites = s + + ! Allocate the sites + ! allocate(this%sites(this%nsites)) end subroutine InitializeFatesSites From 3056548ac730c7c33b50ac3b8ea28dd5be04f9b8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 09:47:37 -0700 Subject: [PATCH 174/331] add unset integer use statement --- main/FatesInterfaceMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 8e1801cb4e..f7586c2725 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -46,7 +46,8 @@ module FatesInterfaceMod use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun - use FatesConstantsMod , only : fates_unset_r8 + use FatesConstantsMod , only : fates_unset_r8 + use FatesConstantsMod , only : fates_unset_int use FatesLitterMod , only : ncwd use FatesLitterMod , only : ndcmpy use EDPftvarcon , only : FatesReportPFTParams From e16504aed3939be95a3f62835a757abe893a24ac Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 09:48:19 -0700 Subject: [PATCH 175/331] fix missing call statements --- main/FatesInterfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index f7586c2725..abf48a1eb5 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2740,7 +2740,7 @@ subroutine InitializeInterfaceRegistry(this, number_clump_patches, patchlist) call this%register(r)%InitializeInterfaceRegistry() ! Set the HLM patch index with the current registry - this%register(r)%SetSubgridIndices(hlmpatch=patchlist(r)) + call this%register(r)%SetSubgridIndices(hlmpatch=patchlist(r)) end do @@ -2781,7 +2781,7 @@ subroutine InitializeFatesSites(this) end if ! Set the site and fates patch index for the current registry - this%register(r)%SetSubgridIndices(fatespatch=ifp, site=s) + call this%register(r)%SetSubgridIndices(fatespatch=ifp, site=s) end do From 6c05c9c6bdc237025eefc8edbb64896f46ccfda2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 09:50:16 -0700 Subject: [PATCH 176/331] rename initialize interface registry argument --- main/FatesInterfaceMod.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index abf48a1eb5..cf94f7d502 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2714,27 +2714,27 @@ end subroutine FatesReadParameters ! ====================================================================================== -subroutine InitializeInterfaceRegistry(this, number_clump_patches, patchlist) +subroutine InitializeInterfaceRegistry(this, num_veg_patches, patchlist) ! This procedure intializes an interface registry for each patch index on the clump ! Arguments - class(fates_interface_type), intent(inout) :: this ! fates interface - integer, intent(in) :: number_clump_patches ! number of patches in this clump - integer, intent(in) :: patchlist(:) ! list of hlm patches for registry index + class(fates_interface_type), intent(inout) :: this ! fates interface + integer, intent(in) :: num_veg_patches ! number of veg patches in this clump + integer, intent(in) :: patchlist(:) ! list of hlm patches for registry index ! Locals integer :: r ! registry index - ! Allocate interface registries for each patch on the clump - allocate(this%register(number_clump_patches)) + ! Allocate interface registries for each vegetated patch on the clump + allocate(this%register(num_veg_patches)) ! Set the number of vegetated patches to the interface type level this%npatches = num_veg_patches ! Initialize each registry with a dictionary of keys to register fates and hlm variables against ! The keys are defined in the registry type-bound procedures - do r = 1, number_clump_patches + do r = 1, num_veg_patches ! Initialize registry call this%register(r)%InitializeInterfaceRegistry() From e6a807d1ff430648e9ad80076d355404d1239cf5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 09:52:17 -0700 Subject: [PATCH 177/331] add fates site initialization to procedure statement --- main/FatesInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index cf94f7d502..dcec24b699 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -169,6 +169,7 @@ module FatesInterfaceMod contains procedure, public :: InitializeInterfaceRegistry + procedure, public :: InitializeFatesSites procedure, public :: InitializeBoundaryConditions procedure, public :: UpdateInterfaceVariables From e3eb283d7395a8ba9b3c9c5ae6c89db6e3bf75f0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 15:00:09 -0700 Subject: [PATCH 178/331] comment update --- main/FatesInterfaceMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index dcec24b699..faa61eeb7d 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2733,11 +2733,11 @@ subroutine InitializeInterfaceRegistry(this, num_veg_patches, patchlist) ! Set the number of vegetated patches to the interface type level this%npatches = num_veg_patches - ! Initialize each registry with a dictionary of keys to register fates and hlm variables against - ! The keys are defined in the registry type-bound procedures + ! Initialize and set patch index for each registry which is associated with a vegetated patch do r = 1, num_veg_patches - ! Initialize registry + ! Initialize each registry with a dictionary of keys to register fates and hlm variables against + ! The keys are defined in the registry type-bound procedures call this%register(r)%InitializeInterfaceRegistry() ! Set the HLM patch index with the current registry From 7c4488958342d10921730c1ce59272ad00ff5fc7 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 15:02:33 -0700 Subject: [PATCH 179/331] remove the site-bound bc intialize wrapper Since we're in the registry loop, we'll hit all the bc indices, so we don't need an internal loop --- main/EDTypesMod.F90 | 26 -------------------------- main/FatesInterfaceMod.F90 | 2 +- 2 files changed, 1 insertion(+), 27 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index ccac0918bf..2c58b9965e 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -610,7 +610,6 @@ module EDTypesMod contains - procedure, public :: InitializeBoundaryConditions procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction @@ -623,31 +622,6 @@ module EDTypesMod contains - ! ============================================================================ - - subroutine InitializeBoundaryConditions(this, number_patches) - - ! This subroutine intializes an array of each of the boundary condition - ! types where the length of the boundary condition is the maximum number of - ! patches on a given site. - - ! Inputs - class(ed_site_type), intent(inout) :: this - integer, intent(in) :: number_patches - - integer :: ifp, c - integer :: begc, endc - - ! Initialize the interface registry - do ifp = 1, number_patches - - ! Initialize the input boundary conditions - call this%bc_in(ifp)%Initialize() - - end do - - end subroutine InitializeBoundaryConditions - ! ============================================================================ subroutine set_patchno( currentSite, check , call_id) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index faa61eeb7d..9524fbd452 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2829,7 +2829,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%register(r)%InitializeInterfaceVariables() ! Initialize the Boundary conditions - call this%sites(s)%InitializeBoundaryConditions(patches_per_site) + call this%sites(s)%bc_in(ifp)%Initialize() ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) From 835772771590de9cee16116b5f917e4af78ab153 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 15:03:34 -0700 Subject: [PATCH 180/331] avoid allocating a bc if it's already been allocated Since the registry is indexed by hlm vegetated patch, there are multiple times a site is associated with a registry --- main/FatesInterfaceMod.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 9524fbd452..26d3fee96a 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2814,10 +2814,16 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the input boundary conditions use for BC allocations do r = 1, this%npatches - ! Allocate boundary conditions for all sites with the maximum number of patches per site + ! Get the site associated with this registry s = this%register(r)%GetSiteIndex() - allocate(this%sites(s)%bc_in(patches_per_site)) - allocate(this%sites(s)%bc_out(patches_per_site)) + + ! Since the registry is indexed by vegetated patch, check that the site for this registry + ! hasn't already been allocated + if (.not.(allocated(this%sites(s)%bc_in))) then + ! Allocate boundary conditions for all sites with the maximum number of patches per site + allocate(this%sites(s)%bc_in(patches_per_site)) + allocate(this%sites(s)%bc_out(patches_per_site)) + end if ! Get the fates boundary condition index ifp = this%register(r)%GetFatesPatchIndex() From a95354c35a882084add12f8f7da43a0e7015b30e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 15:59:21 -0700 Subject: [PATCH 181/331] add nlevdecomp_full to the boundary conditions --- main/FatesInterfaceMod.F90 | 4 +++- main/FatesInterfaceTypesMod.F90 | 11 +++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 26d3fee96a..64e882bcc7 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2798,6 +2798,7 @@ end subroutine InitializeFatesSites subroutine InitializeBoundaryConditions(this, patches_per_site) + use FatesInterfaceTypesMod, only : hlm_fates_decomp_max use FatesInterfaceTypesMod, only : hlm_fates_soil_level use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_moisture use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_temperature @@ -2829,7 +2830,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ifp = this%register(r)%GetFatesPatchIndex() ! Register the boundary conditions that are necessary for allocating other boundary conditions first - call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_max, data=this%sites(s)%bc_in(ifp)%nlevdecomp_full, hlm_flag=.false.) ! Initialize the interface variables necessary for allocating boundary conditions call this%register(r)%InitializeInterfaceVariables() @@ -2838,6 +2839,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%sites(s)%bc_in(ifp)%Initialize() ! Register the boundary conditions that are necessary for allocating other boundary conditions first + call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 76ece35d71..02d15786b6 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -297,6 +297,7 @@ module FatesInterfaceTypesMod integer, parameter, public :: subgrid_patch_index = 1 ! Registry keys parameters + character(len=*), parameter, public :: hlm_fates_decomp_max = 'max_layers_decomp' character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' @@ -422,7 +423,8 @@ module FatesInterfaceTypesMod ! Soil layer structure integer :: nlevsoil ! the number of soil layers in this column - integer :: nlevdecomp ! the number of soil layers in the column + integer :: nlevdecomp ! the number of active soil layers in the column + integer :: nlevdecomp_full ! the maximum possible soil layers for any column ! that are biogeochemically active real(r8),allocatable :: zi_sisl(:) ! interface level below a "z" level (m) ! this contains a zero index for surface. @@ -943,8 +945,8 @@ subroutine InitializeBCIn(this) class(bc_in_type), intent(inout) :: this ! Allocate the boundary condition variables - allocate(this%w_scalar_sisl(this%nlevsoil)) - allocate(this%t_scalar_sisl(this%nlevsoil)) + allocate(this%w_scalar_sisl(this%nlevdecomp_full)) + allocate(this%t_scalar_sisl(this%nlevdecomp_full)) ! Unset the values this%w_scalar_sisl = nan @@ -1025,11 +1027,12 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Define the interface registry names and indices ! Variables that only need to be updated during initialization, such as dimensions - call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index, & + call this%DefineInterfaceVariable(key=hlm_fates_decomp_max, initialize=initialize, index=index, & update_frequency=registry_update_init) ! Variables that need to be updated daily + call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index=index) From fbd04a2882dc326aeb50c3533f178160620c95d5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 16:12:42 -0700 Subject: [PATCH 182/331] pass in the bc for the specific patch --- biogeochem/EDPhysiologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index f509aec000..78dbc94205 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -463,7 +463,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) !------------------------------------------------------------------------------------ ! Calculate the fragmentation rates - call fragmentation_scaler(currentPatch, bc_in) + call fragmentation_scaler(currentPatch, currentSite%bc_in(currentPatch%patchno)) do el = 1, num_elements From cbbe3ad7d3231d91349dfea10809b852e7b1ed6f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 Oct 2025 16:35:12 -0700 Subject: [PATCH 183/331] uncomment fates site initialization --- main/FatesInterfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 64e882bcc7..bbadbc0d74 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2787,10 +2787,10 @@ subroutine InitializeFatesSites(this) end do ! Set the number of fates sites for the interface - ! this%nsites = s + this%nsites = s ! Allocate the sites - ! allocate(this%sites(this%nsites)) + allocate(this%sites(this%nsites)) end subroutine InitializeFatesSites From 830f043a8b7d8241490ceb811a7188b23bb3c8c8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 09:51:02 -0700 Subject: [PATCH 184/331] minor comment correction --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 02d15786b6..c49474520d 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -944,7 +944,7 @@ subroutine InitializeBCIn(this) class(bc_in_type), intent(inout) :: this - ! Allocate the boundary condition variables + ! Allocate the boundary condition arrays allocate(this%w_scalar_sisl(this%nlevdecomp_full)) allocate(this%t_scalar_sisl(this%nlevdecomp_full)) From cd04b3678212a69c5b30620b819a4a640d0a55eb Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 09:52:54 -0700 Subject: [PATCH 185/331] add accumulate option to the registry and update procedure This is provided to allow certain interface variables to sum the current target value with the incoming source value. This will be use primarily for litter fluxes. --- main/FatesInterfaceTypesMod.F90 | 51 +++++++++++++++++++++++++------ main/FatesInterfaceVarTypeMod.F90 | 50 ++++++++++++++++++++++++------ 2 files changed, 83 insertions(+), 18 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index c49474520d..545b629758 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1237,7 +1237,7 @@ end subroutine SetFilterMapArrays ! ====================================================================================== - subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag) + subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1247,12 +1247,23 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag) class(*), target, intent(in) :: data ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? + logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? + + ! Local + logical :: accumulate_local + + ! Default accumulate to false + if (present(accumulate)) then + accumulate_local = accumulate + else + accumulate_local = .false. + end if ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data, active=.true., accumulate=accumulate_local) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data, active=.true.) + call this%fates_vars(this%GetRegistryIndex(key))%Register(data, active=.true., accumulate=accumulate_local) end if @@ -1260,7 +1271,7 @@ end subroutine RegisterInterfaceVariables_0d ! ====================================================================================== - subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag) + subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1269,19 +1280,30 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag) class(*), target, intent(in) :: data(:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? + logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? + ! Local + logical :: accumulate_local + + ! Default accumulate to false + if (present(accumulate)) then + accumulate_local = accumulate + else + accumulate_local = .false. + end if + ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true.) + call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) end if end subroutine RegisterInterfaceVariables_1d ! ====================================================================================== - subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag) + subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1290,12 +1312,23 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag) class(*), target, intent(in) :: data(:,:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? + logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? + ! Local + logical :: accumulate_local + + ! Default accumulate to false + if (present(accumulate)) then + accumulate_local = accumulate + else + accumulate_local = .false. + end if + ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true.) + call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) end if end subroutine RegisterInterfaceVariables_2d diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index f55e97457e..4e67323582 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -26,6 +26,7 @@ module FatesInterfaceVariableTypeMod class(*), pointer :: data2d(:,:) ! 2D polymorphic data pointer class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer logical :: active ! true if the variable is used by the host land model + logical :: accumulate ! If true, this variable should add the source to the target integer :: subgrid ! subgrid level (0 = gridcell, 1 = landunit, 2 = column, 3 = patch) integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: update_frequency ! frequency of updates @@ -67,6 +68,7 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency) this%data2d => null() this%data3d => null() this%active = .false. + this%accumulate = .false. ! Initialize registry variable components that are updated at initialization this%key = key @@ -76,29 +78,33 @@ end subroutine InitializeInterfaceVariable ! ==================================================================================== - subroutine RegisterInterfaceVariable_0d(this, data, active) + subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data logical, intent(in) :: active + logical, intent(in) :: accumulate this%data0d => data this%active = active + this%accumulate = accumulate this%data_rank = rank(data) end subroutine RegisterInterfaceVariable_0d ! ==================================================================================== - subroutine RegisterInterfaceVariable_1d(this, data, active) + subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:) logical, intent(in) :: active + logical, intent(in) :: accumulate this%data1d => data(:) this%active = active + this%accumulate = accumulate this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) @@ -106,14 +112,16 @@ end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== - subroutine RegisterInterfaceVariable_2d(this, data, active) + subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active + logical, intent(in) :: accumulate this%data2d => data(:,:) this%active = active + this%accumulate = accumulate this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) this%data_size(2) = size(data, dim=2) @@ -151,7 +159,11 @@ subroutine UpdateInterfaceVariable(this, var) type is (real(r8)) select type(source => var%data0d) type is (real(r8)) - dest = source + if (dest%accumulate) then + dest = dest + source + else + dest = source + end if class default write(fates_log(),*), msg_mismatch call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -159,7 +171,11 @@ subroutine UpdateInterfaceVariable(this, var) type is (integer) select type(source => var%data0d) type is (integer) - dest = source + if (dest%accumulate) then + dest = dest + source + else + dest = source + end if class default write(fates_log(),*), msg_mismatch call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -175,7 +191,11 @@ subroutine UpdateInterfaceVariable(this, var) type is (real(r8)) select type(source => var%data1d) type is (real(r8)) - dest = source + if (dest%accumulate) then + dest = dest + source + else + dest = source + end if class default write(fates_log(),*), msg_mismatch call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -183,7 +203,11 @@ subroutine UpdateInterfaceVariable(this, var) type is (integer) select type(source => var%data1d) type is (integer) - dest = source + if (dest%accumulate) then + dest = dest + source + else + dest = source + end if class default write(fates_log(),*), msg_mismatch call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -199,7 +223,11 @@ subroutine UpdateInterfaceVariable(this, var) type is (real(r8)) select type(source => var%data2d) type is (real(r8)) - dest = source + if (dest%accumulate) then + dest = dest + source + else + dest = source + end if class default write(fates_log(),*), msg_mismatch call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -207,7 +235,11 @@ subroutine UpdateInterfaceVariable(this, var) type is (integer) select type(source => var%data2d) type is (integer) - dest = source + if (dest%accumulate) then + dest = dest + source + else + dest = source + end if class default write(fates_log(),*), msg_mismatch call endrun(msg=errMsg(__FILE__, __LINE__)) From ca3f5801b984bc406dab88a10844c1cc5f40311a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 15:04:42 -0700 Subject: [PATCH 186/331] move interface registry parameters to its own module The number of key parameters is going to be large, so moving this into its own module is ideal --- main/FatesInterfaceParametersMod.F90 | 20 ++++++++++++++++++++ main/FatesInterfaceTypesMod.F90 | 13 +------------ 2 files changed, 21 insertions(+), 12 deletions(-) create mode 100644 main/FatesInterfaceParametersMod.F90 diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 new file mode 100644 index 0000000000..e9fda6c59e --- /dev/null +++ b/main/FatesInterfaceParametersMod.F90 @@ -0,0 +1,20 @@ +module FatesInterfaceParametersMod + + implicit none + private + + ! Registry keys parameters + character(len=*), parameter, public :: hlm_fates_decomp_max = 'max_layers_decomp' + character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' + character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' + character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' + character(len=*), parameter, public :: hlm_fates_litter_carbon_cellulose = 'litter_carbon_cellulose' + character(len=*), parameter, public :: hlm_fates_litter_carbon_lignin = 'litter_carbon_lignin' + character(len=*), parameter, public :: hlm_fates_litter_carbon_labile = 'litter_carbon_labile' + + ! Registry update frequency parameters + integer, parameter :: registry_update_init = 1 ! variable only needs to be updated during initialization + integer, parameter :: registry_update_daily = 2 ! variable needs to be updated daily + integer, parameter :: registry_update_timestep = 3 ! variable needs to be updated at each timestep + +end module FatesInterfaceParametersMod \ No newline at end of file diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 545b629758..545a845afc 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -10,6 +10,7 @@ module FatesInterfaceTypesMod use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use FatesInterfaceVariableTypeMod, only : fates_interface_variable_type + use FatesInterfaceParametersMod implicit none @@ -296,18 +297,6 @@ module FatesInterfaceTypesMod integer, parameter, public :: subgrid_column_index = 2 integer, parameter, public :: subgrid_patch_index = 1 - ! Registry keys parameters - character(len=*), parameter, public :: hlm_fates_decomp_max = 'max_layers_decomp' - character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' - character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' - character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' - - ! Registry update frequency parameters - integer, parameter :: registry_update_init = 1 ! variable only needs to be updated during initialization - integer, parameter :: registry_update_daily = 2 ! variable needs to be updated daily - integer, parameter :: registry_update_timestep = 3 ! variable needs to be updated at each timestep - integer, parameter :: registry_update_types_num = 3 ! number of update frequency types - ! ------------------------------------------------------------------------------------- ! These vectors are used for history output mapping ! CLM/ALM have limited support for multi-dimensional history output arrays. From 69489074bd8d7e2709cf2639a991bd68b6b27a89 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 15:07:28 -0700 Subject: [PATCH 187/331] add timestep to the update frequency option for the variables --- main/FatesInterfaceTypesMod.F90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 545a845afc..cbd46a0154 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -883,7 +883,7 @@ module FatesInterfaceTypesMod ! Arrays that hold the indices of variables based on update frequency integer, allocatable :: filter_init(:) ! index of variables that update only at initialization integer, allocatable :: filter_daily(:) ! index of variables that update daily - ! integer, allocatable :: filter_timestep(:) ! index of variables that update at each timestep + integer, allocatable :: filter_timestep(:) ! index of variables that update at each timestep ! Subgrid index data integer, private :: gidx @@ -1024,6 +1024,14 @@ subroutine DefineInterfaceRegistry(this, initialize) call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index=index) + + ! Variables that need to be updated with each timestep + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_cellulose, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_lignin, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_labile, initialize=initialize, index=index, + update_frequency=registry_update_timestep) end subroutine DefineInterfaceRegistry @@ -1087,6 +1095,8 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc this%num_api_vars_update_init = this%num_api_vars_update_init + 1 case (registry_update_daily) this%num_api_vars_update_daily = this%num_api_vars_update_daily + 1 + case (registry_update_timestep) + this%num_api_vars_update_init = this%num_api_vars_update_timestep + 1 case default write(fates_log(),*) 'ERROR: Unrecognized update frequency in DefineInterfaceVariable(): ', update_frequency call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -1192,10 +1202,12 @@ subroutine SetFilterMapArrays(this) integer :: index integer :: count_init integer :: count_daily + integer :: count_timestep ! Initialize counters count_init = 0 count_daily = 0 + count_timestep = 0 ! Iterate over all registered variables and populate the filter maps accordingly do index = 1, this%num_api_vars @@ -1205,6 +1217,9 @@ subroutine SetFilterMapArrays(this) else if (this%update_frequency(index) == registry_update_daily) then count_daily = count_daily + 1 this%filter_daily(count_daily) = index + else if (this%update_frequency(index) == registry_update_timestep) then + count_timestep = count_timestep + 1 + this%filter_timestep(count_timestep) = index else write(fates_log(),*) 'ERROR: Unrecognized update frequency in SetFilterMapArrays(): ', this%update_frequency(index) call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -1213,7 +1228,8 @@ subroutine SetFilterMapArrays(this) ! Check that the counts match the expected sizes if (count_init /= this%num_api_vars_update_init .or. & - count_daily /= this%num_api_vars_update_daily) then + count_daily /= this%num_api_vars_update_daily .or. + count_timestep /= this%num_api_vars_update_timestep) then write(fates_log(),*) 'ERROR: Mismatch in initialization counts in SetFilterMapArrays(): ' write(fates_log(),*) ' count_init = ', count_init, ' expected = ', this%num_api_vars_update_init From 8786bc5f045ee5e6f254673c838d4bbafefd0a6c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 15:12:22 -0700 Subject: [PATCH 188/331] register the boundary conditions assocaited with the litter carbon --- main/FatesInterfaceMod.F90 | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index bbadbc0d74..450efdb646 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2838,10 +2838,23 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Initialize the Boundary conditions call this%sites(s)%bc_in(ifp)%Initialize() - ! Register the boundary conditions that are necessary for allocating other boundary conditions first + ! Register the remaining boundary conditions + ! bc_in call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, + data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, + data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) + + ! bc_out + call this%register(r)%Register(key=hlm_fates_litter_carbon_cellulose, + data=this%sites(s)%bc_out(ifp)%litt_flux_cel_c_si, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_litter_carbon_lignin, + data=this%sites(s)%bc_out(ifp)%litt_flux_lig_c_si, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_litter_carbon_labile, + data=this%sites(s)%bc_out(ifp)%litt_flux_lab_c_si, hlm_flag=.false.) + + end do From 356c66bb82d852b7bacb719b355af19c4c99345a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 16:49:21 -0700 Subject: [PATCH 189/331] allow the interface variable update to be scaled --- main/FatesInterfaceVarTypeMod.F90 | 33 +++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 4e67323582..46a6df6e92 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -130,19 +130,32 @@ end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== - subroutine UpdateInterfaceVariable(this, var) + subroutine UpdateInterfaceVariable(this, var, scalar) + ! Arguments class(fates_interface_variable_type), intent(inout) :: this ! variable being updated class(fates_interface_variable_type), intent(in) :: var ! variable update source + real(r8), intent(in), optional :: scalar ! value to scale variable update + ! Locals class(*), pointer :: data_var0d => null() class(*), pointer :: data_var1d(:) => null() class(*), pointer :: data_var2d(:,:) => null() class(*), pointer :: data_var3d(:,:,:) => null() - integer :: index ! index for the subgrid level of the input interface variable + real(r8) :: scalar_local + integer :: index ! index for the subgrid level of the input interface variable + character(len=fates_long_string_length) :: msg_mismatch = 'FATES ERROR: Mismatched interface variable types' + ! Check if scalar is present and set default value to one + ! Currently this assumes that the only real values are to be scaled + if (present(scalar)) then + scalar_local = scalar + else + scalar_local = 1.0_r8 + end if + ! Check that the dimensions of the source and target match call this%CompareRegistryVariableSizes(var) @@ -160,9 +173,9 @@ subroutine UpdateInterfaceVariable(this, var) select type(source => var%data0d) type is (real(r8)) if (dest%accumulate) then - dest = dest + source + dest = dest + source * scalar_local else - dest = source + dest = source * scalar_local end if class default write(fates_log(),*), msg_mismatch @@ -172,9 +185,9 @@ subroutine UpdateInterfaceVariable(this, var) select type(source => var%data0d) type is (integer) if (dest%accumulate) then - dest = dest + source + dest = dest + source else - dest = source + dest = source end if class default write(fates_log(),*), msg_mismatch @@ -192,9 +205,9 @@ subroutine UpdateInterfaceVariable(this, var) select type(source => var%data1d) type is (real(r8)) if (dest%accumulate) then - dest = dest + source + dest = dest + source * scalar_local else - dest = source + dest = source * scalar_local end if class default write(fates_log(),*), msg_mismatch @@ -224,9 +237,9 @@ subroutine UpdateInterfaceVariable(this, var) select type(source => var%data2d) type is (real(r8)) if (dest%accumulate) then - dest = dest + source + dest = dest + source * scalar_local else - dest = source + dest = source * scalar_local end if class default write(fates_log(),*), msg_mismatch From 8dd05006858502fc6a3e4c70b45a0915f79bf226 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 17:02:18 -0700 Subject: [PATCH 190/331] add interface update procedure specific to the litter fluxes This could be generalized to account for a wider array of variables that update on the timestep if so desired --- main/FatesInterfaceMod.F90 | 18 +++++++++++++++++- main/FatesInterfaceTypesMod.F90 | 24 ++++++++++++++++++++++++ 2 files changed, 41 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 450efdb646..db8d3602c0 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2866,7 +2866,7 @@ subroutine UpdateInterfaceVariables(this) class(fates_interface_type), intent(inout) :: this - integer :: r ! site index + integer :: r ! registry interface index do r = 1, this%npatches call this%register(r)%Update() @@ -2876,4 +2876,20 @@ end subroutine UpdateInterfaceVariables ! ====================================================================================== +subroutine UpdateLitterFluxes(this, dtime) + + class(fates_interface_type), intent(inout) :: this + real(r8), intent(in) :: dtime ! HLM timestep + + ! Locals + integer :: r + + do r = 1, this%npatches + call this%register(r)%UpdateLitterFluxes(dtime) + end do + +end subroutine UpdateLitterFluxes + +! ====================================================================================== + end module FatesInterfaceMod diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index cbd46a0154..78025d08d4 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -905,6 +905,7 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceRegistry procedure :: InitializeInterfaceVariables procedure :: SetSubgridIndices + procedure :: UpdateLitterFluxes procedure :: Update => UpdateInterfaceVariables generic :: Register => RegisterInterfaceVariables_0d, & @@ -1377,6 +1378,29 @@ subroutine UpdateInterfaceVariables(this) end subroutine UpdateInterfaceVariables + ! ====================================================================================== + + subroutine UpdateLitterFluxes(this, dtime) + + ! Arguments + class(fates_interface_registry_base_type), intent(inout) :: this + real(r8), intent(in) :: dtime + + ! Locals + integer :: i + integer :: j + + ! Iterate over the litter flux filter + do i = 1, num_litter_fluxes + j = this%filter_litter_flux + + ! Update the hlm variables with the fates variables + call this%hlm_vars(j)%Update(fates_vars(j), scalar=dtime) + + end do + + end subroutine UpdateLitterFluxes + ! ====================================================================================== integer function GetRegistryIndex(this, key) result(index) From efdae7ae9e755773c68b3282d6cbf57f79567f60 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 Oct 2025 17:05:57 -0700 Subject: [PATCH 191/331] add timestep update to the registry procedures --- main/FatesInterfaceTypesMod.F90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 78025d08d4..0339f04d66 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -876,14 +876,15 @@ module FatesInterfaceTypesMod integer :: num_api_vars ! number of variables in the registry integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily + integer :: num_api_vars_update_timestep ! number of variables that update on the model timestep ! Array of update frequency values for each variable index integer, allocatable :: update_frequency(:) - ! Arrays that hold the indices of variables based on update frequency - integer, allocatable :: filter_init(:) ! index of variables that update only at initialization - integer, allocatable :: filter_daily(:) ! index of variables that update daily - integer, allocatable :: filter_timestep(:) ! index of variables that update at each timestep + ! Arrays that hold the registry indices of variables based on update frequency + integer, allocatable :: filter_init(:) ! registry index of variables that update only at initialization + integer, allocatable :: filter_daily(:) ! registry index of variables that update daily + integer, allocatable :: filter_timestep(:) ! registry index of variables that update at each timestep ! Subgrid index data integer, private :: gidx @@ -985,11 +986,13 @@ subroutine InitializeInterfaceRegistry(this) ! Allocate the index filter maps allocate(this%filter_init(this%num_api_vars_update_init)) allocate(this%filter_daily(this%num_api_vars_update_daily)) + allocate(this%filter_timestep(this%num_api_vars_update_timestep)) ! Unset the allocatables not including the interface variables this%update_frequency(:) = fates_unset_int this%filter_init(:) = fates_unset_int this%filter_daily(:) = fates_unset_int + this%filter_timestep(:) = fates_unset_int ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) @@ -1064,6 +1067,8 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc update_frequency_local = registry_update_init case (registry_update_daily) update_frequency_local = registry_update_daily + case (registry_update_timestep) + update_frequency_local = registry_update_timestep case default write(fates_log(),*) 'ERROR: Unrecognized update frequency in DefineInterfaceVariable(): ', update_frequency call endrun(msg=errMsg(__FILE__, __LINE__)) From ad1d6352cb9c8b4dd72e9cf54e57f0ecbd0ddeda Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 10 Oct 2025 11:24:32 -0700 Subject: [PATCH 192/331] add litter flux carbon filter to the registry --- main/FatesInterfaceTypesMod.F90 | 34 +++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 0339f04d66..1e4ee5731a 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -877,14 +877,18 @@ module FatesInterfaceTypesMod integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily integer :: num_api_vars_update_timestep ! number of variables that update on the model timestep + integer :: num_api_vars_litter_carbon ! number of variables that deal with litter, carbon - ! Array of update frequency values for each variable index + ! Array of update frequency values for each regsitry index integer, allocatable :: update_frequency(:) ! Arrays that hold the registry indices of variables based on update frequency integer, allocatable :: filter_init(:) ! registry index of variables that update only at initialization integer, allocatable :: filter_daily(:) ! registry index of variables that update daily integer, allocatable :: filter_timestep(:) ! registry index of variables that update at each timestep + + ! Filter arrays that hold the registry indices for litter fluxes + integer, allocatable :: filter_litter_carbon(:) ! Subgrid index data integer, private :: gidx @@ -973,6 +977,7 @@ subroutine InitializeInterfaceRegistry(this) this%num_api_vars = 0 this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 + this%num_api_vars_litter_carbon = 0 ! First count up the keys defined in the registry and the registry counters call this%DefineInterfaceRegistry(initialize=.false.) @@ -988,11 +993,15 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%filter_daily(this%num_api_vars_update_daily)) allocate(this%filter_timestep(this%num_api_vars_update_timestep)) + ! Allocate the litter flux filter + allocate(this%filter_litter_carbon(this%num_api_vars_litter_carbon)) + ! Unset the allocatables not including the interface variables this%update_frequency(:) = fates_unset_int this%filter_init(:) = fates_unset_int this%filter_daily(:) = fates_unset_int this%filter_timestep(:) = fates_unset_int + this%filter_litter_carbon(:) = fates_unset_int ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) @@ -1112,6 +1121,13 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc this%num_api_vars_update_daily = this%num_api_vars_update_daily + 1 end if + ! Update the litter flux counters + if (key == hlm_fates_litter_carbon_cellulose .or. & + key == hlm_fates_litter_carbon_labile .or. & + key == hlm_fates_litter_carbon_lignin) then + this%num_api_vars_litter_carbon = this%num_api_vars_litter_carbon + 1 + end if + end if end subroutine DefineInterfaceVariable @@ -1209,14 +1225,18 @@ subroutine SetFilterMapArrays(this) integer :: count_init integer :: count_daily integer :: count_timestep + integer :: count_litter_carbon ! Initialize counters count_init = 0 count_daily = 0 count_timestep = 0 + count_litter_carbon = 0 ! Iterate over all registered variables and populate the filter maps accordingly do index = 1, this%num_api_vars + + ! Frequency update if (this%update_frequency(index) == registry_update_init) then count_init = count_init + 1 this%filter_init(count_init) = index @@ -1230,6 +1250,16 @@ subroutine SetFilterMapArrays(this) write(fates_log(),*) 'ERROR: Unrecognized update frequency in SetFilterMapArrays(): ', this%update_frequency(index) call endrun(msg=errMsg(__FILE__, __LINE__)) end if + + ! Litter flux update + if (this%key(index) == hlm_fates_litter_carbon_cellulose .or. & + this%key(index) == hlm_fates_litter_carbon_labile .or. & + this%key(index) == hlm_fates_litter_carbon_lignin) then + count_litter_carbon = count_litter_carbon + 1 + this%filter_litter_carbon(count_litter_carbon) = index + end if + + end do ! Check that the counts match the expected sizes @@ -1397,7 +1427,7 @@ subroutine UpdateLitterFluxes(this, dtime) ! Iterate over the litter flux filter do i = 1, num_litter_fluxes - j = this%filter_litter_flux + j = this%filter_litter_flux(i) ! Update the hlm variables with the fates variables call this%hlm_vars(j)%Update(fates_vars(j), scalar=dtime) From ba0d9f0595d279f478e376594c9ff0b08c1b1392 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 10 Oct 2025 17:16:07 -0700 Subject: [PATCH 193/331] move initialization of boundary conditions to be a site-bound procedure --- main/EDTypesMod.F90 | 55 +++++++++++++++++++++++++++++++++ main/FatesInterfaceMod.F90 | 4 +-- main/FatesInterfaceTypesMod.F90 | 21 ------------- 3 files changed, 57 insertions(+), 23 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 2c58b9965e..16e8568f1b 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -610,6 +610,7 @@ module EDTypesMod contains + procedure, public :: InitializeBoundaryConditions procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction @@ -622,6 +623,60 @@ module EDTypesMod contains + ! ============================================================================ + + subroutine InitializeBoundaryConditions(this, ifp) + + ! Allocate and initialize boundary condition arrays to NaN. + ! Note that we use the full nlevdecomp size to match the HLM array sizes. + ! This may need to be setup with a more sophisticated approach if the HLMs + ! diverge in the dimensionality of the matching arrays. + + class(ed_site_type), intent(inout) :: this + integer, intent(in) :: ifp + + ! bc_in + allocate(this%bc_in(ifp)%w_scalar_sisl(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_in(ifp)%t_scalar_sisl(this%bc_in(ifp)%nlevdecomp_full)) + + this%bc_in(ifp)%w_scalar_sisl = nan + this%bc_in(ifp)%t_scalar_sisl = nan + + ! Litter fluxes, carbon + allocate(this%bc_out(ifp)%litt_flux_all_c(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_cel_c_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_lig_c_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_lab_c_si(this%bc_in(ifp)%nlevdecomp_full)) + + this%bc_out(ifp)%litt_flux_all_c = nan + this%bc_out(ifp)%litt_flux_cel_c_si = nan + this%bc_out(ifp)%litt_flux_lig_c_si = nan + this%bc_out(ifp)%litt_flux_lab_c_si = nan + + ! Litter fluxes, nitrogen + allocate(this%bc_out(ifp)%litt_flux_all_n(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_cel_n_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_lig_n_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_lab_n_si(this%bc_in(ifp)%nlevdecomp_full)) + + this%bc_out(ifp)%litt_flux_all_n = nan + this%bc_out(ifp)%litt_flux_cel_n_si = nan + this%bc_out(ifp)%litt_flux_lig_n_si = nan + this%bc_out(ifp)%litt_flux_lab_n_si = nan + + ! Litter fluxes, phosphorus + allocate(this%bc_out(ifp)%litt_flux_all_p(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_cel_p_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_lig_p_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_lab_p_si(this%bc_in(ifp)%nlevdecomp_full)) + + this%bc_out(ifp)%litt_flux_all_p = nan + this%bc_out(ifp)%litt_flux_cel_p_si = nan + this%bc_out(ifp)%litt_flux_lig_p_si = nan + this%bc_out(ifp)%litt_flux_lab_p_si = nan + + end subroutine InitializeBoundaryConditions + ! ============================================================================ subroutine set_patchno( currentSite, check , call_id) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index db8d3602c0..f49a3a22bd 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2835,8 +2835,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Initialize the interface variables necessary for allocating boundary conditions call this%register(r)%InitializeInterfaceVariables() - ! Initialize the Boundary conditions - call this%sites(s)%bc_in(ifp)%Initialize() + ! Initialize the currently registered boundary conditions + call this%sites(s)%InitializeBoundaryConditions(ifp) ! Register the remaining boundary conditions ! bc_in diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 1e4ee5731a..671ce73dd8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -620,10 +620,6 @@ module FatesInterfaceTypesMod real(r8),allocatable :: hlm_sp_tsai(:) ! Interpolated sailt total SAI (stem area index) input from HLM per patch/pft real(r8),allocatable :: hlm_sp_htop(:) ! Interpolated daily canopy vegetation height input from HLM per patch/pft - contains - - procedure :: Initialize => InitializeBCIn - end type bc_in_type @@ -932,23 +928,6 @@ module FatesInterfaceTypesMod contains - - ! ====================================================================================== - - subroutine InitializeBCIn(this) - - class(bc_in_type), intent(inout) :: this - - ! Allocate the boundary condition arrays - allocate(this%w_scalar_sisl(this%nlevdecomp_full)) - allocate(this%t_scalar_sisl(this%nlevdecomp_full)) - - ! Unset the values - this%w_scalar_sisl = nan - this%t_scalar_sisl = nan - - end subroutine InitializeBCIn - ! ====================================================================================== subroutine ZeroBCOutCarbonFluxes(bc_out) From ee17f6b48bf78e112e18b587971d02220079d375 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 10 Oct 2025 17:17:56 -0700 Subject: [PATCH 194/331] add local variable to improve legibility and maintainability --- main/EDTypesMod.F90 | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 16e8568f1b..4d7f90b73d 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -634,19 +634,22 @@ subroutine InitializeBoundaryConditions(this, ifp) class(ed_site_type), intent(inout) :: this integer, intent(in) :: ifp + integer :: nlevdecomp + + nlevdecomp = this%bc_in(ifp)%nlevdecomp_full ! bc_in - allocate(this%bc_in(ifp)%w_scalar_sisl(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_in(ifp)%t_scalar_sisl(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_in(ifp)%w_scalar_sisl(nlevdecomp)) + allocate(this%bc_in(ifp)%t_scalar_sisl(nlevdecomp)) this%bc_in(ifp)%w_scalar_sisl = nan this%bc_in(ifp)%t_scalar_sisl = nan ! Litter fluxes, carbon - allocate(this%bc_out(ifp)%litt_flux_all_c(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_cel_c_si(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_lig_c_si(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_lab_c_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_all_c(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_cel_c_si(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_lig_c_si(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_lab_c_si(nlevdecomp)) this%bc_out(ifp)%litt_flux_all_c = nan this%bc_out(ifp)%litt_flux_cel_c_si = nan @@ -654,10 +657,10 @@ subroutine InitializeBoundaryConditions(this, ifp) this%bc_out(ifp)%litt_flux_lab_c_si = nan ! Litter fluxes, nitrogen - allocate(this%bc_out(ifp)%litt_flux_all_n(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_cel_n_si(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_lig_n_si(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_lab_n_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_all_n(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_cel_n_si(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_lig_n_si(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_lab_n_si(nlevdecomp)) this%bc_out(ifp)%litt_flux_all_n = nan this%bc_out(ifp)%litt_flux_cel_n_si = nan @@ -665,10 +668,10 @@ subroutine InitializeBoundaryConditions(this, ifp) this%bc_out(ifp)%litt_flux_lab_n_si = nan ! Litter fluxes, phosphorus - allocate(this%bc_out(ifp)%litt_flux_all_p(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_cel_p_si(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_lig_p_si(this%bc_in(ifp)%nlevdecomp_full)) - allocate(this%bc_out(ifp)%litt_flux_lab_p_si(this%bc_in(ifp)%nlevdecomp_full)) + allocate(this%bc_out(ifp)%litt_flux_all_p(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_cel_p_si(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_lig_p_si(nlevdecomp)) + allocate(this%bc_out(ifp)%litt_flux_lab_p_si(nlevdecomp)) this%bc_out(ifp)%litt_flux_all_p = nan this%bc_out(ifp)%litt_flux_cel_p_si = nan From 67e45159249e6b6453d1837134c4abe9c6a5c1e5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 10 Oct 2025 17:20:37 -0700 Subject: [PATCH 195/331] add local pointers to simplify further --- main/EDTypesMod.F90 | 71 +++++++++++++++++++++++++-------------------- 1 file changed, 39 insertions(+), 32 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 4d7f90b73d..d6e198d314 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -634,49 +634,56 @@ subroutine InitializeBoundaryConditions(this, ifp) class(ed_site_type), intent(inout) :: this integer, intent(in) :: ifp + + ! Locals integer :: nlevdecomp + type(bc_in_type), pointer :: bc_in_ptr + type(bc_out_type), pointer :: bc_out_ptr + ! Use locals for convenience nlevdecomp = this%bc_in(ifp)%nlevdecomp_full - + bc_in_ptr => this%bc_in(ifp) + bc_out_ptr => this%bc_out(ifp) + ! bc_in - allocate(this%bc_in(ifp)%w_scalar_sisl(nlevdecomp)) - allocate(this%bc_in(ifp)%t_scalar_sisl(nlevdecomp)) + allocate(bc_in_ptr%w_scalar_sisl(nlevdecomp)) + allocate(bc_in_ptr%t_scalar_sisl(nlevdecomp)) - this%bc_in(ifp)%w_scalar_sisl = nan - this%bc_in(ifp)%t_scalar_sisl = nan + bc_in_ptr%w_scalar_sisl = nan + bc_in_ptr%t_scalar_sisl = nan ! Litter fluxes, carbon - allocate(this%bc_out(ifp)%litt_flux_all_c(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_cel_c_si(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_lig_c_si(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_lab_c_si(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_all_c(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_cel_c_si(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_lig_c_si(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_lab_c_si(nlevdecomp)) - this%bc_out(ifp)%litt_flux_all_c = nan - this%bc_out(ifp)%litt_flux_cel_c_si = nan - this%bc_out(ifp)%litt_flux_lig_c_si = nan - this%bc_out(ifp)%litt_flux_lab_c_si = nan + bc_out_ptr%litt_flux_all_c = nan + bc_out_ptr%litt_flux_cel_c_si = nan + bc_out_ptr%litt_flux_lig_c_si = nan + bc_out_ptr%litt_flux_lab_c_si = nan ! Litter fluxes, nitrogen - allocate(this%bc_out(ifp)%litt_flux_all_n(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_cel_n_si(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_lig_n_si(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_lab_n_si(nlevdecomp)) - - this%bc_out(ifp)%litt_flux_all_n = nan - this%bc_out(ifp)%litt_flux_cel_n_si = nan - this%bc_out(ifp)%litt_flux_lig_n_si = nan - this%bc_out(ifp)%litt_flux_lab_n_si = nan - + allocate(bc_out_ptr%litt_flux_all_n(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_cel_n_si(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_lig_n_si(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_lab_n_si(nlevdecomp)) + + bc_out_ptr%litt_flux_all_n = nan + bc_out_ptr%litt_flux_cel_n_si = nan + bc_out_ptr%litt_flux_lig_n_si = nan + bc_out_ptr%litt_flux_lab_n_si = nan + ! Litter fluxes, phosphorus - allocate(this%bc_out(ifp)%litt_flux_all_p(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_cel_p_si(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_lig_p_si(nlevdecomp)) - allocate(this%bc_out(ifp)%litt_flux_lab_p_si(nlevdecomp)) - - this%bc_out(ifp)%litt_flux_all_p = nan - this%bc_out(ifp)%litt_flux_cel_p_si = nan - this%bc_out(ifp)%litt_flux_lig_p_si = nan - this%bc_out(ifp)%litt_flux_lab_p_si = nan + allocate(bc_out_ptr%litt_flux_all_p(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_cel_p_si(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_lig_p_si(nlevdecomp)) + allocate(bc_out_ptr%litt_flux_lab_p_si(nlevdecomp)) + + bc_out_ptr%litt_flux_all_p = nan + bc_out_ptr%litt_flux_cel_p_si = nan + bc_out_ptr%litt_flux_lig_p_si = nan + bc_out_ptr%litt_flux_lab_p_si = nan end subroutine InitializeBoundaryConditions From 35252251ce16b8a1abe8423f045c384afb7cd702 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 09:53:36 -0700 Subject: [PATCH 196/331] move fluxintolitterpools calculations inside the patch loop Since the flux accumulation to the column level takes place during the update, and it is possible that a patches are on different columns in the future, we conduct the caculations at the patch-level --- biogeochem/FatesSoilBGCFluxMod.F90 | 64 +++++++++++++++++------------- 1 file changed, 36 insertions(+), 28 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index e0af2a9e0f..e43e62cc52 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -671,34 +671,41 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) ! how steep profile is for surface components (1/ e_folding depth) (1/m) real(r8), parameter :: surfprof_exp = 10. - ! This is the number of effective soil layers to transfer from - nlev_eff_soil = max(bc_in%max_rooting_depth_index_col, 1) + ! Loop over patches + currentPatch => csite%oldest_patch + flux_patch_loop: do while (associated(currentPatch)) - ! The decomposition layers are most likely the exact same layers - ! as the soil layers (same depths also), unless it is a simplified - ! single layer case, where nlevdecomp = 1 + bc_out => csite%bc_out(currentPatch%patchno) + bc_in => csite%bc_in(currentPatch%patchno) + + ! This is the number of effective soil layers to transfer from + nlev_eff_soil = max(bc_in%max_rooting_depth_index_col, 1) - nlev_eff_decomp = min(bc_in%nlevdecomp,nlev_eff_soil) + ! The decomposition layers are most likely the exact same layers + ! as the soil layers (same depths also), unless it is a simplified + ! single layer case, where nlevdecomp = 1 - ! define a single shallow surface profile for surface additions - ! (leaves, stems, and N deposition). This sends the above ground - ! mass into the soil pools using an exponential depth decay function. - ! Since it is sending an absolute mass [kg] into variable layer - ! widths, we multiply the profile by the layer width, so that - ! wider layers get proportionally more. After the masses - ! are sent, each layer will normalize by depth. + nlev_eff_decomp = min(bc_in%nlevdecomp,nlev_eff_soil) - surface_prof(:) = 0._r8 - z_decomp = 0._r8 - do id = 1,nlev_eff_decomp - z_decomp = z_decomp+0.5*bc_in%dz_decomp_sisl(id) - surface_prof(id) = exp(-surfprof_exp * z_decomp) * bc_in%dz_decomp_sisl(id) - z_decomp = z_decomp+0.5*bc_in%dz_decomp_sisl(id) - end do - surface_prof_tot = sum(surface_prof) - do id = 1,nlev_eff_decomp - surface_prof(id) = surface_prof(id)/surface_prof_tot - end do + ! define a single shallow surface profile for surface additions + ! (leaves, stems, and N deposition). This sends the above ground + ! mass into the soil pools using an exponential depth decay function. + ! Since it is sending an absolute mass [kg] into variable layer + ! widths, we multiply the profile by the layer width, so that + ! wider layers get proportionally more. After the masses + ! are sent, each layer will normalize by depth. + + surface_prof(:) = 0._r8 + z_decomp = 0._r8 + do id = 1,nlev_eff_decomp + z_decomp = z_decomp+0.5*bc_in%dz_decomp_sisl(id) + surface_prof(id) = exp(-surfprof_exp * z_decomp) * bc_in%dz_decomp_sisl(id) + z_decomp = z_decomp+0.5*bc_in%dz_decomp_sisl(id) + end do + surface_prof_tot = sum(surface_prof) + do id = 1,nlev_eff_decomp + surface_prof(id) = surface_prof(id)/surface_prof_tot + end do ! Loop over the different elements. do el = 1, num_elements @@ -810,9 +817,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) litt%root_fines_frag(ilignin,j) * area_frac enddo - currentPatch => currentPatch%younger - end do - ! Normalize all masses over the decomposition layer's depth ! Convert from kg/m2/day -> g/m3/s @@ -825,7 +829,11 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) flux_lab_si(id) / bc_in%dz_decomp_sisl(id) end do - end do ! do elements + end do flux_elem_loop + + ! Move to the next + currentPatch => currentPatch%younger + end do flux_patch_loop ! If we are coupled with MIMICS, then we need some assessment of litter quality ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) From cc6acbc7a2b69e61964fdeb652ec0a52f390f2a1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 09:55:39 -0700 Subject: [PATCH 197/331] remove the area fraction from the patch-level calculations This is not necessary here as we are summing at the patch level currently. Any scaling will happen during the accumulation update when passing to the hlm. --- biogeochem/FatesSoilBGCFluxMod.F90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index e43e62cc52..9d10e190c8 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -754,7 +754,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id) + litt%ag_cwd_frag(ic) * ED_val_cwd_flig * surface_prof(id) end do @@ -763,10 +763,10 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel * area_frac + litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel flux_lig_si(id) = flux_lig_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig * area_frac + litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig end do end do @@ -779,13 +779,13 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & - litt%leaf_fines_frag(ilabile) * area_frac* surface_prof(id) + litt%leaf_fines_frag(ilabile) * surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & - litt%leaf_fines_frag(icellulose) * area_frac* surface_prof(id) + litt%leaf_fines_frag(icellulose) * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%leaf_fines_frag(ilignin) * area_frac* surface_prof(id) + litt%leaf_fines_frag(ilignin) * surface_prof(id) end do @@ -795,26 +795,26 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flab(ipft) * area_frac* surface_prof(id) + EDPftvarcon_inst%lf_flab(ipft) * surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_fcel(ipft) * area_frac* surface_prof(id) + EDPftvarcon_inst%lf_fcel(ipft) * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flig(ipft) * area_frac* surface_prof(id) + EDPftvarcon_inst%lf_flig(ipft) * surface_prof(id) end do end do do j = 1, nlev_eff_soil id = bc_in%decomp_id(j) flux_lab_si(id) = flux_lab_si(id) + & - litt%root_fines_frag(ilabile,j) * area_frac + litt%root_fines_frag(ilabile,j) flux_cel_si(id) = flux_cel_si(id) + & - litt%root_fines_frag(icellulose,j) * area_frac + litt%root_fines_frag(icellulose,j) flux_lig_si(id) = flux_lig_si(id) + & - litt%root_fines_frag(ilignin,j) * area_frac + litt%root_fines_frag(ilignin,j) enddo ! Normalize all masses over the decomposition layer's depth From 7daf5a730d4a0184d3d0388a99eae6ccd3e865dc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 09:56:17 -0700 Subject: [PATCH 198/331] remove bcs from the argument as these are now site-level arrays --- biogeochem/FatesSoilBGCFluxMod.F90 | 102 ++++++++++++++--------------- 1 file changed, 50 insertions(+), 52 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 9d10e190c8..8d8de2357e 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -586,7 +586,7 @@ end subroutine EffluxIntoLitterPools ! ===================================================================================== - subroutine FluxIntoLitterPools(csite, bc_in, bc_out) + subroutine FluxIntoLitterPools(csite) ! ----------------------------------------------------------------------------------- ! Created by Charlie Koven and Rosie Fisher, 2014-2015 @@ -619,22 +619,21 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) use FatesConstantsMod, only : itrue use FatesGlobals, only : endrun => fates_endrun use EDParamsMod , only : ED_val_cwd_flig, ED_val_cwd_fcel - - implicit none ! !ARGUMENTS type(ed_site_type) , intent(inout) :: csite - type(bc_in_type) , intent(in) :: bc_in - type(bc_out_type) , intent(inout),target :: bc_out ! !LOCAL VARIABLES: type (fates_patch_type), pointer :: currentPatch type (fates_cohort_type), pointer :: ccohort + type(bc_out_type), pointer :: bc_out + type(bc_in_type), pointer :: bc_in real(r8), pointer :: flux_cel_si(:) real(r8), pointer :: flux_lab_si(:) real(r8), pointer :: flux_lig_si(:) + real(r8), pointer :: flux_all_si(:) type(litter_type), pointer :: litt real(r8) :: surface_prof(bc_in%nlevsoil) ! this array is used to distribute @@ -652,6 +651,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) integer :: ic ! CWD type index integer :: ipft ! PFT index + ! The following are used for the MIMICS ligC/N boundary condition real(r8) :: leaf_c, sapw_c ! leaf and sapwood carbon, per plant [kg] real(r8) :: fnrt_c, struct_c ! fineroot and struct carbon, per plant [kg] @@ -707,51 +707,49 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) surface_prof(id) = surface_prof(id)/surface_prof_tot end do - ! Loop over the different elements. - do el = 1, num_elements - - ! Zero out the boundary flux arrays - ! Make a pointer to the cellulose, labile and lignin - ! flux partitions. - - select case (element_list(el)) - case (carbon12_element) - bc_out%litt_flux_cel_c_si(:) = 0.0_r8 - bc_out%litt_flux_lig_c_si(:) = 0.0_r8 - bc_out%litt_flux_lab_c_si(:) = 0.0_r8 - flux_cel_si => bc_out%litt_flux_cel_c_si(:) - flux_lab_si => bc_out%litt_flux_lab_c_si(:) - flux_lig_si => bc_out%litt_flux_lig_c_si(:) - case (nitrogen_element) - bc_out%litt_flux_cel_n_si(:) = 0._r8 - bc_out%litt_flux_lig_n_si(:) = 0._r8 - bc_out%litt_flux_lab_n_si(:) = 0._r8 - flux_cel_si => bc_out%litt_flux_cel_n_si(:) - flux_lab_si => bc_out%litt_flux_lab_n_si(:) - flux_lig_si => bc_out%litt_flux_lig_n_si(:) - case (phosphorus_element) - bc_out%litt_flux_cel_p_si(:) = 0._r8 - bc_out%litt_flux_lig_p_si(:) = 0._r8 - bc_out%litt_flux_lab_p_si(:) = 0._r8 - flux_cel_si => bc_out%litt_flux_cel_p_si(:) - flux_lab_si => bc_out%litt_flux_lab_p_si(:) - flux_lig_si => bc_out%litt_flux_lig_p_si(:) - end select - - currentPatch => csite%oldest_patch - do while (associated(currentPatch)) + ! Loop over the different elements. + flux_elem_loop: do el = 1, num_elements + + ! Zero out the boundary flux arrays + ! Make a pointer to the cellulose, labile and lignin + ! flux partitions. + + select case (element_list(el)) + case (carbon12_element) + bc_out%litt_flux_cel_c_si(:) = 0.0_r8 + bc_out%litt_flux_lig_c_si(:) = 0.0_r8 + bc_out%litt_flux_lab_c_si(:) = 0.0_r8 + bc_out%litt_flux_all_c(:) = 0.0_r8 + flux_cel_si => bc_out%litt_flux_cel_c_si(:) + flux_lab_si => bc_out%litt_flux_lab_c_si(:) + flux_lig_si => bc_out%litt_flux_lig_c_si(:) + flux_all_si => bc_out%litt_flux_all_c(:) + case (nitrogen_element) + bc_out%litt_flux_cel_n_si(:) = 0._r8 + bc_out%litt_flux_lig_n_si(:) = 0._r8 + bc_out%litt_flux_lab_n_si(:) = 0._r8 + flux_cel_si => bc_out%litt_flux_cel_n_si(:) + flux_lab_si => bc_out%litt_flux_lab_n_si(:) + flux_lig_si => bc_out%litt_flux_lig_n_si(:) + case (phosphorus_element) + bc_out%litt_flux_cel_p_si(:) = 0._r8 + bc_out%litt_flux_lig_p_si(:) = 0._r8 + bc_out%litt_flux_lab_p_si(:) = 0._r8 + flux_cel_si => bc_out%litt_flux_cel_p_si(:) + flux_lab_si => bc_out%litt_flux_lab_p_si(:) + flux_lig_si => bc_out%litt_flux_lig_p_si(:) + end select ! Set a pointer to the litter object ! for the current element on the current ! patch litt => currentPatch%litter(el) - area_frac = currentPatch%area/area do ic = 1, ncwd do id = 1,nlev_eff_decomp flux_cel_si(id) = flux_cel_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) + litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & litt%ag_cwd_frag(ic) * ED_val_cwd_flig * surface_prof(id) @@ -760,7 +758,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) do j = 1, nlev_eff_soil - id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer + id = csite%bc_in(ifp)%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel @@ -808,7 +806,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) end do do j = 1, nlev_eff_soil - id = bc_in%decomp_id(j) + id = csite%bc_in(ifp)%decomp_id(j) flux_lab_si(id) = flux_lab_si(id) + & litt%root_fines_frag(ilabile,j) flux_cel_si(id) = flux_cel_si(id) + & @@ -817,17 +815,17 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) litt%root_fines_frag(ilignin,j) enddo - ! Normalize all masses over the decomposition layer's depth - ! Convert from kg/m2/day -> g/m3/s + ! Normalize all masses over the decomposition layer's depth + ! Convert from kg/m2/day -> g/m3/s - do id = 1,nlev_eff_decomp - flux_cel_si(id) = days_per_sec * g_per_kg * & - flux_cel_si(id) / bc_in%dz_decomp_sisl(id) - flux_lig_si(id) = days_per_sec * g_per_kg * & - flux_lig_si(id) / bc_in%dz_decomp_sisl(id) - flux_lab_si(id) = days_per_sec * g_per_kg * & - flux_lab_si(id) / bc_in%dz_decomp_sisl(id) - end do + do id = 1,nlev_eff_decomp + flux_cel_si(id) = days_per_sec * g_per_kg * & + flux_cel_si(id) / bc_in%dz_decomp_sisl(id) + flux_lig_si(id) = days_per_sec * g_per_kg * & + flux_lig_si(id) / bc_in%dz_decomp_sisl(id) + flux_lab_si(id) = days_per_sec * g_per_kg * & + flux_lab_si(id) / bc_in%dz_decomp_sisl(id) + end do end do flux_elem_loop From de54e8941692c40489028f61ce1725122bb5f677 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 10:03:11 -0700 Subject: [PATCH 199/331] add nitrogen and phosphorous interface definitions --- main/FatesInterfaceParametersMod.F90 | 18 +++++++++++++++--- main/FatesInterfaceTypesMod.F90 | 24 +++++++++++++++++++++++- 2 files changed, 38 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index e9fda6c59e..0f198ecbb8 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -3,15 +3,27 @@ module FatesInterfaceParametersMod implicit none private - ! Registry keys parameters - character(len=*), parameter, public :: hlm_fates_decomp_max = 'max_layers_decomp' + ! Registry key parameters + character(len=*), parameter, public :: hlm_fates_decomp= 'decomp_layers' + character(len=*), parameter, public :: hlm_fates_decomp_max = 'max_decomp_layers' + character(len=*), parameter, public :: hlm_fates_decomp_thickness= 'decomp_thickness' + character(len=*), parameter, public :: hlm_fates_decomp_id = 'decomp_id' character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' character(len=*), parameter, public :: hlm_fates_litter_carbon_cellulose = 'litter_carbon_cellulose' character(len=*), parameter, public :: hlm_fates_litter_carbon_lignin = 'litter_carbon_lignin' character(len=*), parameter, public :: hlm_fates_litter_carbon_labile = 'litter_carbon_labile' - + character(len=*), parameter, public :: hlm_fates_litter_carbon_total= 'litter_carbon_total' + character(len=*), parameter, public :: hlm_fates_litter_phosphorus_cellulose = 'litter_phosphorus_cellulose' + character(len=*), parameter, public :: hlm_fates_litter_phosphorus_lignin = 'litter_phosphorus_lignin' + character(len=*), parameter, public :: hlm_fates_litter_phosphorus_labile = 'litter_phosphorus_labile' + character(len=*), parameter, public :: hlm_fates_litter_phosphorus_total= 'litter_phosphorus_total' + character(len=*), parameter, public :: hlm_fates_litter_nitrogen_cellulose = 'litter_nitrogen_cellulose' + character(len=*), parameter, public :: hlm_fates_litter_nitrogen_lignin = 'litter_nitrogen_lignin' + character(len=*), parameter, public :: hlm_fates_litter_nitrogen_labile = 'litter_nitrogen_labile' + character(len=*), parameter, public :: hlm_fates_litter_nitrogen_total= 'litter_nitrogen_total' + ! Registry update frequency parameters integer, parameter :: registry_update_init = 1 ! variable only needs to be updated during initialization integer, parameter :: registry_update_daily = 2 ! variable needs to be updated daily diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 671ce73dd8..79bfcda467 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -699,8 +699,10 @@ module FatesInterfaceTypesMod real(r8), allocatable :: litt_flux_cel_p_si(:) ! cellulose phosphorus litter, fates->BGC g/m3/s real(r8), allocatable :: litt_flux_lig_p_si(:) ! lignin phosphorus litter, fates->BGC g/m3/s real(r8), allocatable :: litt_flux_lab_p_si(:) ! labile phosphorus litter, fates->BGC g/m3/s + real(r8), allocatable :: litt_flux_all_c(:) ! total litterfall carbon + real(r8), allocatable :: litt_flux_all_n(:) ! total litterfall nitrogen + real(r8), allocatable :: litt_flux_all_p(:) ! total litterfall phosphorus - ! MIMICS Boundary Conditions ! ----------------------------------------------------------------------------------- real(r8) :: litt_flux_ligc_per_n ! lignin carbon per total nitrogen @@ -1024,6 +1026,26 @@ subroutine DefineInterfaceRegistry(this, initialize) update_frequency=registry_update_timestep) call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_labile, initialize=initialize, index=index, update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_total, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + + call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_cellulose, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_lignin, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_labile, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_total, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + + call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_cellulose, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_lignin, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_labile, initialize=initialize, index=index, + update_frequency=registry_update_timestep) + call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_total, initialize=initialize, index=index, + update_frequency=registry_update_timestep) end subroutine DefineInterfaceRegistry From 82b2426b9c51e58beb3fd65ad73ad30e4b29ef8a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 15:44:46 -0700 Subject: [PATCH 200/331] set procedure calls to PascalCase --- main/FatesInterfaceTypesMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 79bfcda467..dc8e8e62aa 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1029,22 +1029,22 @@ subroutine DefineInterfaceRegistry(this, initialize) call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_total, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_cellulose, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_cellulose, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_lignin, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_lignin, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_labile, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_labile, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_phosphorus_total, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_total, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_cellulose, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_cellulose, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_lignin, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_lignin, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_labile, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_labile, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%defineinterfacevariable(key=hlm_fates_litter_nitrogen_total, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_total, initialize=initialize, index=index, update_frequency=registry_update_timestep) end subroutine DefineInterfaceRegistry From 8cc3757ffb3b2bc07c6adbfbfd551ea5726c5056 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 15:46:13 -0700 Subject: [PATCH 201/331] define and register more variables for the litter flux update --- main/FatesInterfaceMod.F90 | 7 +++++++ main/FatesInterfaceTypesMod.F90 | 5 +++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index f49a3a22bd..836ecd80ee 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2831,6 +2831,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%register(r)%Register(key=hlm_fates_decomp_max, data=this%sites(s)%bc_in(ifp)%nlevdecomp_full, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp, data=this%sites(s)%bc_in(ifp)%nlevdecomp, hlm_flag=.false.) ! Initialize the interface variables necessary for allocating boundary conditions call this%register(r)%InitializeInterfaceVariables() @@ -2840,7 +2841,11 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the remaining boundary conditions ! bc_in + call this%register(r)%Register(key=hlm_fates_decomp_thickness, data=this%sites(s)%bc_in(ifp)%dz_decomp_sisl, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_id, data=this%sites(s)%bc_in(ifp)%decomp_id, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, @@ -2853,6 +2858,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) data=this%sites(s)%bc_out(ifp)%litt_flux_lig_c_si, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_litter_carbon_labile, data=this%sites(s)%bc_out(ifp)%litt_flux_lab_c_si, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_litter_carbon_total, + data=this%sites(s)%bc_out(ifp)%litt_flux_all_c, hlm_flag=.false.) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index dc8e8e62aa..8522ccc979 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1012,10 +1012,11 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Variables that only need to be updated during initialization, such as dimensions call this%DefineInterfaceVariable(key=hlm_fates_decomp_max, initialize=initialize, index=index, & update_frequency=registry_update_init) - + call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_id, initialize=initialize, index=index) ! Variables that need to be updated daily - call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index=index) From a7236c6e56bfb8ec63489b341abc09c14d7558ac Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 15:49:22 -0700 Subject: [PATCH 202/331] make interface registry key array private Force access through get function --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 8522ccc979..210e9dd8bf 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -868,7 +868,7 @@ module FatesInterfaceTypesMod type(fates_interface_variable_type), allocatable :: fates_vars(:) ! Array of keys associated with the interface variables - character(len=48), allocatable :: key(:) + character(len=48), allocatable, private :: key(:) ! Variable regsitry metadata integer :: num_api_vars ! number of variables in the registry From 17e2d94f20919a9abd926dadd5884593c303cab0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 15:54:06 -0700 Subject: [PATCH 203/331] correct update call in litter flux subroutine Also adds update just for the total carbon. This is outside the filter of the individual fluxes --- main/FatesInterfaceTypesMod.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 210e9dd8bf..73aa50bb28 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1427,15 +1427,20 @@ subroutine UpdateLitterFluxes(this, dtime) integer :: i integer :: j - ! Iterate over the litter flux filter + ! Iterate over the litter flux filter to update the individual litter types do i = 1, num_litter_fluxes j = this%filter_litter_flux(i) ! Update the hlm variables with the fates variables - call this%hlm_vars(j)%Update(fates_vars(j), scalar=dtime) + call this%hlm_vars(j)%Update(this%fates_vars(j), scalar=dtime) end do + ! Update the HLM variable with the total litterfall + j = this%GetRegistryIndex(hlm_fates_litter_carbon_total) + call this%hlm_vars(j)%Update(this%fates_vars(j)) + + end subroutine UpdateLitterFluxes ! ====================================================================================== From 7acb7ba9b0fa2f52551bb8b700b901fc20e27822 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 15:54:42 -0700 Subject: [PATCH 204/331] update fluxintolitterpool call --- main/EDMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 7a5bd21840..1eadc4f828 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -794,7 +794,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! can remove it completely if/when this call is added in ELM to ! subroutine UpdateLitterFluxes(this,bounds_clump) in elmfates_interfaceMod.F90 - call FluxIntoLitterPools(currentsite, bc_in, bc_out) + call FluxIntoLitterPools(currentsite) ! Update cohort number. From 0de9053e2cb2386b748041187c8bd8442953e99b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 16:31:01 -0700 Subject: [PATCH 205/331] simplify registry call arguments using pointer association --- main/FatesInterfaceMod.F90 | 37 +++++++++++++++++++++++-------------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 836ecd80ee..c90da1ad8f 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2811,12 +2811,18 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) integer :: r ! registery iterator integer :: s ! site iterator integer :: ifp ! boundary condition index + type(bc_in_type), pointer :: bc_in + type(bc_out_type), pointer :: bc_out ! Register the input boundary conditions use for BC allocations do r = 1, this%npatches ! Get the site associated with this registry s = this%register(r)%GetSiteIndex() + ifp = this%register(r)%GetFatesPatchIndex() + + bc_in => this%sites(s)%bc_in(ifp) + bc_out => this%sites(s)%bc_out(ifp) ! Since the registry is indexed by vegetated patch, check that the site for this registry ! hasn't already been allocated @@ -2826,12 +2832,9 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) allocate(this%sites(s)%bc_out(patches_per_site)) end if - ! Get the fates boundary condition index - ifp = this%register(r)%GetFatesPatchIndex() - ! Register the boundary conditions that are necessary for allocating other boundary conditions first - call this%register(r)%Register(key=hlm_fates_decomp_max, data=this%sites(s)%bc_in(ifp)%nlevdecomp_full, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp, data=this%sites(s)%bc_in(ifp)%nlevdecomp, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_max, data=bc_in%nlevdecomp_full, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp, data=bc_in%nlevdecomp, hlm_flag=.false.) ! Initialize the interface variables necessary for allocating boundary conditions call this%register(r)%InitializeInterfaceVariables() @@ -2845,21 +2848,27 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%register(r)%Register(key=hlm_fates_decomp_id, data=this%sites(s)%bc_in(ifp)%decomp_id, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) - - call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, - data=this%sites(s)%bc_in(ifp)%w_scalar_sisl, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, - data=this%sites(s)%bc_in(ifp)%t_scalar_sisl, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_thickness, & + data=bc_in%dz_decomp_sisl, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_id, & + data=bc_in%decomp_id, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_soil_level, & + data=bc_in%nlevsoil, hlm_flag=.false.) + + call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, & + data=bc_in%w_scalar_sisl, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, & + data=bc_in%t_scalar_sisl, hlm_flag=.false.) ! bc_out call this%register(r)%Register(key=hlm_fates_litter_carbon_cellulose, - data=this%sites(s)%bc_out(ifp)%litt_flux_cel_c_si, hlm_flag=.false.) + data=bc_out%litt_flux_cel_c_si, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_litter_carbon_lignin, - data=this%sites(s)%bc_out(ifp)%litt_flux_lig_c_si, hlm_flag=.false.) + data=bc_out%litt_flux_lig_c_si, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_litter_carbon_labile, - data=this%sites(s)%bc_out(ifp)%litt_flux_lab_c_si, hlm_flag=.false.) + data=bc_out %litt_flux_lab_c_si, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_litter_carbon_total, - data=this%sites(s)%bc_out(ifp)%litt_flux_all_c, hlm_flag=.false.) + data=bc_out`%litt_flux_all_c, hlm_flag=.false.) From 2a857cccabf6120708d7eb01ea397e0f2266b5d1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 16:35:32 -0700 Subject: [PATCH 206/331] add max rooting depth to interface registry --- main/FatesInterfaceMod.F90 | 6 ++---- main/FatesInterfaceParametersMod.F90 | 1 + main/FatesInterfaceTypesMod.F90 | 2 ++ 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index c90da1ad8f..a13ebd02d6 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2844,10 +2844,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the remaining boundary conditions ! bc_in - call this%register(r)%Register(key=hlm_fates_decomp_thickness, data=this%sites(s)%bc_in(ifp)%dz_decomp_sisl, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_id, data=this%sites(s)%bc_in(ifp)%decomp_id, hlm_flag=.false.) - - call this%register(r)%Register(key=hlm_fates_soil_level, data=this%sites(s)%bc_in(ifp)%nlevsoil, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_rooting_max_depth, & + data=bc_in%max_rooting_depth_index_col, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_thickness, & data=bc_in%dz_decomp_sisl, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_id, & diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index 0f198ecbb8..7e6ebf0628 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -8,6 +8,7 @@ module FatesInterfaceParametersMod character(len=*), parameter, public :: hlm_fates_decomp_max = 'max_decomp_layers' character(len=*), parameter, public :: hlm_fates_decomp_thickness= 'decomp_thickness' character(len=*), parameter, public :: hlm_fates_decomp_id = 'decomp_id' + character(len=*), parameter, public :: hlm_fates_rooting_max_depth = 'rooting_max_depth' character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 73aa50bb28..46003d2838 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1012,6 +1012,8 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Variables that only need to be updated during initialization, such as dimensions call this%DefineInterfaceVariable(key=hlm_fates_decomp_max, initialize=initialize, index=index, & update_frequency=registry_update_init) + + call this%DefineInterfaceVariable(key=hlm_fates_rooting_max_depth, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_id, initialize=initialize, index=index) From 5af91a634a6538cec0ba6598d1723680900c3438 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 15 Oct 2025 22:23:20 -0700 Subject: [PATCH 207/331] register max thaw and calculate max rooting depth based on max thaw --- main/FatesInterfaceMod.F90 | 39 +++++++++++++++++++++++++--- main/FatesInterfaceParametersMod.F90 | 1 + main/FatesInterfaceTypesMod.F90 | 4 +++ 3 files changed, 41 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a13ebd02d6..0f5cb7dfa9 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2844,8 +2844,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the remaining boundary conditions ! bc_in - call this%register(r)%Register(key=hlm_fates_rooting_max_depth, & - data=bc_in%max_rooting_depth_index_col, hlm_flag=.false.) + call this%register(r)%Register(key=hlm_fates_thaw_max_depth_index, & + data=bc_in%max_thaw_depth_index_col, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_thickness, & data=bc_in%dz_decomp_sisl, hlm_flag=.false.) call this%register(r)%Register(key=hlm_fates_decomp_id, & @@ -2876,15 +2876,48 @@ end subroutine InitializeBoundaryConditions ! ====================================================================================== -subroutine UpdateInterfaceVariables(this) +subroutine UpdateInterfaceVariables(this, initialize) + ! Arguments class(fates_interface_type), intent(inout) :: this + logical, intent(in), optional :: initialize + + ! Locals + type(bc_in_type), pointer :: bc_in + type(bc_out_type), pointer :: bc_out + + logical :: initialize_local integer :: r ! registry interface index + ! Set the default initialize flag to false + if (present(initialize)) then + initialize_local = initialize + else + initialize_local = .false. + end if + do r = 1, this%npatches + + ! Update the interface variables for the current registry call this%register(r)%Update() + + ! Get the site associated with this registry + s = this%register(r)%GetSiteIndex() + ifp = this%register(r)%GetFatesPatchIndex() + + bc_in => this%sites(s)%bc_in(ifp) + + ! Calculate the maximum rooting depth index + if (initialize) then + bc_in%max_rooting_depth_index_col = bc_in%nlevdecomp + else + bc_in%max_rooting_depth_index_col = min(bc_in%nlevsoil, bc_in%max_thaw_depth_index) + end if + + end do + end subroutine UpdateInterfaceVariables diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index 7e6ebf0628..c8902a4490 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -9,6 +9,7 @@ module FatesInterfaceParametersMod character(len=*), parameter, public :: hlm_fates_decomp_thickness= 'decomp_thickness' character(len=*), parameter, public :: hlm_fates_decomp_id = 'decomp_id' character(len=*), parameter, public :: hlm_fates_rooting_max_depth = 'rooting_max_depth' + character(len=*), parameter, public :: hlm_fates_thaw_max_depth_index = 'prioryear_thaw_max_depth_index' character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' character(len=*), parameter, public :: hlm_fates_decomp_frac_temperature = 'decomp_frac_temperature' diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 46003d2838..0576e358ca 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -539,6 +539,10 @@ module FatesInterfaceTypesMod ! due to permafrost or bedrock constraints integer :: max_rooting_depth_index_col + ! The prior year maximum thaw depth index + ! Used to determine max_rooting_depth_index_col + integer :: max_thaw_depth_index + ! BGC Accounting real(r8) :: tot_het_resp ! total heterotrophic respiration (gC/m2/s) From 9b94bbb684c014c52e166b6de440c3fb307d1e54 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 08:42:30 -0700 Subject: [PATCH 208/331] rename interface registry instance for clarity --- main/FatesInterfaceMod.F90 | 48 +++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0f5cb7dfa9..2b3060db92 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2728,7 +2728,7 @@ subroutine InitializeInterfaceRegistry(this, num_veg_patches, patchlist) integer :: r ! registry index ! Allocate interface registries for each vegetated patch on the clump - allocate(this%register(num_veg_patches)) + allocate(this%registry(num_veg_patches)) ! Set the number of vegetated patches to the interface type level this%npatches = num_veg_patches @@ -2738,10 +2738,10 @@ subroutine InitializeInterfaceRegistry(this, num_veg_patches, patchlist) ! Initialize each registry with a dictionary of keys to register fates and hlm variables against ! The keys are defined in the registry type-bound procedures - call this%register(r)%InitializeInterfaceRegistry() + call this%registry(r)%InitializeInterfaceRegistry() ! Set the HLM patch index with the current registry - call this%register(r)%SetSubgridIndices(hlmpatch=patchlist(r)) + call this%registry(r)%SetSubgridIndices(hlmpatch=patchlist(r)) end do @@ -2769,7 +2769,7 @@ subroutine InitializeFatesSites(this) do r = 1, this%npatches ! Get the gridcell index - g = this%register(r)%GetGridcellIndex() + g = this%registry(r)%GetGridcellIndex() ! Update the fates counter ifp = ifp + 1 @@ -2782,7 +2782,7 @@ subroutine InitializeFatesSites(this) end if ! Set the site and fates patch index for the current registry - call this%register(r)%SetSubgridIndices(fatespatch=ifp, site=s) + call this%registry(r)%SetSubgridIndices(fatespatch=ifp, site=s) end do @@ -2818,8 +2818,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) do r = 1, this%npatches ! Get the site associated with this registry - s = this%register(r)%GetSiteIndex() - ifp = this%register(r)%GetFatesPatchIndex() + s = this%registry(r)%GetSiteIndex() + ifp = this%registry(r)%GetFatesPatchIndex() bc_in => this%sites(s)%bc_in(ifp) bc_out => this%sites(s)%bc_out(ifp) @@ -2833,39 +2833,39 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) end if ! Register the boundary conditions that are necessary for allocating other boundary conditions first - call this%register(r)%Register(key=hlm_fates_decomp_max, data=bc_in%nlevdecomp_full, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp, data=bc_in%nlevdecomp, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_decomp_max, data=bc_in%nlevdecomp_full, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_decomp, data=bc_in%nlevdecomp, hlm_flag=.false.) ! Initialize the interface variables necessary for allocating boundary conditions - call this%register(r)%InitializeInterfaceVariables() + call this%registry(r)%InitializeInterfaceVariables() ! Initialize the currently registered boundary conditions call this%sites(s)%InitializeBoundaryConditions(ifp) ! Register the remaining boundary conditions ! bc_in - call this%register(r)%Register(key=hlm_fates_thaw_max_depth_index, & + call this%registry(r)%Register(key=hlm_fates_thaw_max_depth_index, & data=bc_in%max_thaw_depth_index_col, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_thickness, & + call this%registry(r)%Register(key=hlm_fates_decomp_thickness, & data=bc_in%dz_decomp_sisl, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_id, & + call this%registry(r)%Register(key=hlm_fates_decomp_id, & data=bc_in%decomp_id, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_soil_level, & + call this%registry(r)%Register(key=hlm_fates_soil_level, & data=bc_in%nlevsoil, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_frac_moisture, & + call this%registry(r)%Register(key=hlm_fates_decomp_frac_moisture, & data=bc_in%w_scalar_sisl, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_decomp_frac_temperature, & + call this%registry(r)%Register(key=hlm_fates_decomp_frac_temperature, & data=bc_in%t_scalar_sisl, hlm_flag=.false.) ! bc_out - call this%register(r)%Register(key=hlm_fates_litter_carbon_cellulose, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_cellulose, data=bc_out%litt_flux_cel_c_si, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_litter_carbon_lignin, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_lignin, data=bc_out%litt_flux_lig_c_si, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_litter_carbon_labile, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, data=bc_out %litt_flux_lab_c_si, hlm_flag=.false.) - call this%register(r)%Register(key=hlm_fates_litter_carbon_total, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, data=bc_out`%litt_flux_all_c, hlm_flag=.false.) @@ -2900,11 +2900,11 @@ subroutine UpdateInterfaceVariables(this, initialize) do r = 1, this%npatches ! Update the interface variables for the current registry - call this%register(r)%Update() + call this%registry(r)%Update() ! Get the site associated with this registry - s = this%register(r)%GetSiteIndex() - ifp = this%register(r)%GetFatesPatchIndex() + s = this%registry(r)%GetSiteIndex() + ifp = this%registry(r)%GetFatesPatchIndex() bc_in => this%sites(s)%bc_in(ifp) @@ -2932,7 +2932,7 @@ subroutine UpdateLitterFluxes(this, dtime) integer :: r do r = 1, this%npatches - call this%register(r)%UpdateLitterFluxes(dtime) + call this%registry(r)%UpdateLitterFluxes(dtime) end do end subroutine UpdateLitterFluxes From b14bb0a79bd02d3b2d72b401ae94a5c636dde211 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 08:47:02 -0700 Subject: [PATCH 209/331] rename the interface registry type It doesn't look like we'll need extended types so remove "base" from the name --- main/EDTypesMod.F90 | 2 +- main/FatesInterfaceMod.F90 | 2 +- main/FatesInterfaceTypesMod.F90 | 42 ++++++++++++++++----------------- 3 files changed, 23 insertions(+), 23 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index d6e198d314..949f47b8a0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -31,7 +31,7 @@ module EDTypesMod use FatesInterfaceTypesMod,only : bc_in_type use FatesInterfaceTypesMod,only : bc_out_type use FatesInterfaceTypesMod,only : hlm_parteh_mode - use FatesInterfaceTypesMod,only : fates_interface_registry_base_type + use FatesInterfaceTypesMod,only : fates_interface_registry_type use FatesCohortMod, only : fates_cohort_type use FatesPatchMod, only : fates_patch_type use EDParamsMod, only : nclmax, nlevleaf, maxpft diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 2b3060db92..964fddb870 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -164,7 +164,7 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - type(fates_interface_registry_base_type), allocatable :: register(:) + type(fates_interface_registry_type), allocatable :: register(:) contains diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 0576e358ca..eb3249c462 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -865,7 +865,7 @@ module FatesInterfaceTypesMod end type bc_pconst_type ! Base type to be extended for the API registry - type, public :: fates_interface_registry_base_type + type, public :: fates_interface_registry_type ! Container array of interface variables indexed by key type(fates_interface_variable_type), allocatable :: hlm_vars(:) @@ -928,7 +928,7 @@ module FatesInterfaceTypesMod procedure, private :: GetRegistryIndex procedure, private :: GetRegistryKey - end type fates_interface_registry_base_type + end type fates_interface_registry_type public :: ZeroBCOutCarbonFluxes @@ -954,7 +954,7 @@ subroutine InitializeInterfaceRegistry(this) ! This initializes the interface registry - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this logical :: initialize @@ -1003,7 +1003,7 @@ subroutine DefineInterfaceRegistry(this, initialize) ! This procedure defines the list of common names to be associated with FATES and HLM ! variables. - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this logical, intent(in) :: initialize ! false = count up the keys in the registry @@ -1060,7 +1060,7 @@ end subroutine DefineInterfaceRegistry subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequency) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this character(len=*), intent(in) :: key logical, intent(in) :: initialize @@ -1144,7 +1144,7 @@ end subroutine DefineInterfaceVariable subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch, fatespatch, site) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this integer, intent(in), optional :: gridcell integer, intent(in), optional :: topounit integer, intent(in), optional :: landunit @@ -1167,7 +1167,7 @@ end subroutine SetSubgridIndices integer function GetGridcellIndex(this) result(gidx) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this gidx = this%gidx @@ -1177,7 +1177,7 @@ end function GetGridcellIndex integer function GetLandunitIndex(this) result(lidx) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this lidx = this%lidx @@ -1187,7 +1187,7 @@ end function GetLandunitIndex integer function GetColumnIndex(this) result(cidx) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this cidx = this%cidx @@ -1197,7 +1197,7 @@ end function GetColumnIndex integer function GetHLMPatchIndex(this) result(hpidx) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this hpidx = this%hpidx @@ -1207,7 +1207,7 @@ end function GetHLMPatchIndex integer function GetSiteIndex(this) result(sidx) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this sidx = this%sidx @@ -1217,7 +1217,7 @@ end function GetSiteIndex integer function GetFatesPatchIndex(this) result(fpidx) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this fpidx = this%fpidx @@ -1227,7 +1227,7 @@ end function GetFatesPatchIndex subroutine SetFilterMapArrays(this) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this integer :: index integer :: count_init @@ -1292,7 +1292,7 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate) ! with a particular registry key ! Arguments - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this class(*), target, intent(in) :: data ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? @@ -1325,7 +1325,7 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate) ! This procedure is called by the to associate a data variable ! with a particular registry key - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this class(*), target, intent(in) :: data(:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? @@ -1357,7 +1357,7 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate) ! This procedure is called by the to associate a data variable ! with a particular registry key - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) ! data to be associated with key character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? @@ -1387,7 +1387,7 @@ end subroutine RegisterInterfaceVariables_2d subroutine InitializeInterfaceVariables(this) ! Arguments - class(fates_interface_registry_base_type), intent(inout) :: this ! registry being initialized + class(fates_interface_registry_type), intent(inout) :: this ! registry being initialized ! Locals integer :: i ! initialization iterator @@ -1410,7 +1410,7 @@ subroutine InitializeInterfaceVariables(this) subroutine UpdateInterfaceVariables(this) - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this integer :: i @@ -1426,7 +1426,7 @@ end subroutine UpdateInterfaceVariables subroutine UpdateLitterFluxes(this, dtime) ! Arguments - class(fates_interface_registry_base_type), intent(inout) :: this + class(fates_interface_registry_type), intent(inout) :: this real(r8), intent(in) :: dtime ! Locals @@ -1455,7 +1455,7 @@ integer function GetRegistryIndex(this, key) result(index) ! This procedure returns the index associated with the key provided - class(fates_interface_registry_base_type), intent(in) :: this + class(fates_interface_registry_type), intent(in) :: this character(len=*), intent(in) :: key ! variable registry key to search @@ -1477,7 +1477,7 @@ function GetRegistryKey(this, index) result(key) ! This procedure returns the index associated with the key provided - class(fates_interface_registry_base_type), intent(in) :: this + class(fates_interface_registry_type), intent(in) :: this integer, intent(in) :: index ! variable registry index character(len=:), allocatable :: key From ce9cda99ac7a99477bfd894cccf9de9f2e6dead8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 08:48:17 -0700 Subject: [PATCH 210/331] rename registry definition in the interface type --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 964fddb870..cccdb006af 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -164,7 +164,7 @@ module FatesInterfaceMod type(bc_pconst_type) :: bc_pconst ! This is the interface registry which associates variables with a common keyword - type(fates_interface_registry_type), allocatable :: register(:) + type(fates_interface_registry_type), allocatable :: registry(:) contains From d14176a27456e8276fff631d0ef72241fb058aa4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 09:44:47 -0700 Subject: [PATCH 211/331] add private array to hold the registry index associated with a given patch on a given site --- main/EDTypesMod.F90 | 46 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 949f47b8a0..7582a9f991 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -28,6 +28,7 @@ module EDTypesMod use FatesConstantsMod, only : days_per_year use FatesRunningMeanMod, only : rmean_type,rmean_arr_type use FatesConstantsMod, only : fates_unset_r8 + use FatesConstantsMod, only : fates_unset_int use FatesInterfaceTypesMod,only : bc_in_type use FatesInterfaceTypesMod,only : bc_out_type use FatesInterfaceTypesMod,only : hlm_parteh_mode @@ -338,6 +339,9 @@ module EDTypesMod type(bc_in_type), allocatable :: bc_in(:) type(bc_out_type), allocatable :: bc_out(:) + ! Registry index array + integer, allocatable, private :: ridx(:) + ! Resource management type (ed_resources_management_type) :: resources_management ! resources_management at the site @@ -610,9 +614,12 @@ module EDTypesMod contains + procedure, public :: AllocateRegistryIndexArray procedure, public :: InitializeBoundaryConditions procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction + procedure, public :: GetRegistryIndex + procedure, public :: SetRegistryIndex end type ed_site_type @@ -623,6 +630,20 @@ module EDTypesMod contains + ! ============================================================================ + + subroutine AllocateRegistryIndexArray(this, patches_per_site) + + ! Arguments + class(ed_site_type), intent(inout) :: this + integer, intent(in) :: patches_per_site + + ! Allocate the registry index array + allocate(this%ridx(patches_per_site)) + this%ridx = fates_unset_int + + end subroutine AllocateRegistryIndexArray + ! ============================================================================ subroutine InitializeBoundaryConditions(this, ifp) @@ -687,6 +708,31 @@ subroutine InitializeBoundaryConditions(this, ifp) end subroutine InitializeBoundaryConditions + ! ============================================================================ + + integer function GetRegistryIndex(this, ifp) return(ridx) + + ! Arguments + class(ed_site_type), intent(in) :: this + integer, intent(in) :: ifp + + ridx = this%ridx(ifp) + + end function GetRegistryIndex + + ! ============================================================================ + + integer function SetRegistryIndex(this, ifp, ridx) + + ! Arguments + class(ed_site_type), intent(inout) :: this + integer, intent(in) :: ifp + integer, intent(in) :: ridx + + this%ridx(ifp) = ridx + + end function SetRegistryIndex + ! ============================================================================ subroutine set_patchno( currentSite, check , call_id) From bec6e5893120ca664b64d26c6bf794acfe21b5de Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 09:47:05 -0700 Subject: [PATCH 212/331] update the site initialization to store the registry associated with the sites and patches --- main/FatesInterfaceMod.F90 | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index cccdb006af..dc1659adab 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2751,7 +2751,8 @@ end subroutine InitializeInterfaceRegistry subroutine InitializeFatesSites(this) - class(fates_interface_type), intent(inout) :: this ! fates interface + class(fates_interface_type), intent(inout) :: this ! fates interface + integer, intent(in) :: patches_per_site ! number of patches per site ! Local integer :: r ! interface registry index @@ -2791,6 +2792,22 @@ subroutine InitializeFatesSites(this) ! Allocate the sites allocate(this%sites(this%nsites)) + + ! Iterator through the registries again and store the registry indices for each site + do r = 1, this%npatches + + ! Get the site index for the current registry + s = this%registry(r)%GetSiteIndex() + ifp = this%registry(r)%GetFatesPatchIndex() + + ! Allocate the registry index array for the current site if it hasn't already been allocated + if (.not.(allocated(this%sites(s)%ridx))) call this%sites(s)%AllocateRegistryIndexArray(patches_per_site) + + ! Store the registry index for the current site and fates patch index + this%sites(s)%SetRegisteryIndex(ifp, r) + + end do + end subroutine InitializeFatesSites From a61494e55de88e546ad4c926d1d217a1ca8f3327 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 09:48:32 -0700 Subject: [PATCH 213/331] Update the boundary condition initialization to utilize the site level knowlege of the registry index This simplifies the process somewhat by avoiding the check on the site bc allocation --- main/FatesInterfaceMod.F90 | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index dc1659adab..0c845acb51 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2749,7 +2749,7 @@ end subroutine InitializeInterfaceRegistry ! ====================================================================================== -subroutine InitializeFatesSites(this) +subroutine InitializeFatesSites(this, patches_per_site) class(fates_interface_type), intent(inout) :: this ! fates interface integer, intent(in) :: patches_per_site ! number of patches per site @@ -2832,22 +2832,21 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) type(bc_out_type), pointer :: bc_out ! Register the input boundary conditions use for BC allocations - do r = 1, this%npatches - - ! Get the site associated with this registry - s = this%registry(r)%GetSiteIndex() - ifp = this%registry(r)%GetFatesPatchIndex() + do s = 1, this%nsites + + ! Allocate boundary conditions for all sites with the maximum number of patches per site + allocate(this%sites(s)%bc_in(patches_per_site)) + allocate(this%sites(s)%bc_out(patches_per_site)) + ! Iterate over the maximum number of patches for the current site + do ifp = 1, patches_per_site + + ! Create convenience pointers to the current boundary conditions bc_in => this%sites(s)%bc_in(ifp) bc_out => this%sites(s)%bc_out(ifp) - ! Since the registry is indexed by vegetated patch, check that the site for this registry - ! hasn't already been allocated - if (.not.(allocated(this%sites(s)%bc_in))) then - ! Allocate boundary conditions for all sites with the maximum number of patches per site - allocate(this%sites(s)%bc_in(patches_per_site)) - allocate(this%sites(s)%bc_out(patches_per_site)) - end if + ! Get the site associated with this registry + r = this%sites(s)%GetRegistryIndex(ifp) ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%registry(r)%Register(key=hlm_fates_decomp_max, data=bc_in%nlevdecomp_full, hlm_flag=.false.) @@ -2885,8 +2884,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, data=bc_out`%litt_flux_all_c, hlm_flag=.false.) - - + end do end do end subroutine InitializeBoundaryConditions From 190da63a98c2cbc50d55ef827ea8bc173d69238f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 09:49:37 -0700 Subject: [PATCH 214/331] minor typo --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 0c845acb51..f143eaea4c 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2793,7 +2793,7 @@ subroutine InitializeFatesSites(this, patches_per_site) ! Allocate the sites allocate(this%sites(this%nsites)) - ! Iterator through the registries again and store the registry indices for each site + ! Iterate through the registries again and store the registry indices for each site do r = 1, this%npatches ! Get the site index for the current registry From f65b8912513414a2792d414bc6da740738e349b5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 09:55:45 -0700 Subject: [PATCH 215/331] typo --- main/FatesConstantsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 4d535f9de4..743a6c22df 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -108,7 +108,7 @@ module FatesConstantsMod integer, parameter, public :: ican_ustory = 2 ! nominal index for diagnostics that refer to understory layers ! (all layers that are not the top canopy layer) - ! Flags specifying how phosphorous uptake and turnover interacts + ! Flags specifying how phosphorus uptake and turnover interacts ! with the host model. integer, public, parameter :: prescribed_p_uptake = 1 integer, public, parameter :: coupled_p_uptake = 2 From 7666724729387d6b96a0769151bb0e38561cd944 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 13:55:22 -0700 Subject: [PATCH 216/331] Add totalling to the soil bg flux refactor --- biogeochem/FatesSoilBGCFluxMod.F90 | 9 +++++++-- main/FatesInterfaceMod.F90 | 21 +++++++++++++++++++-- 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 8d8de2357e..f58392a61f 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -827,9 +827,14 @@ subroutine FluxIntoLitterPools(csite) flux_lab_si(id) / bc_in%dz_decomp_sisl(id) end do - end do flux_elem_loop + ! Calculate the total flux of C into the litter pools + flux_all_si = sum(flux_cel_si(:) * bc_in%dz_decomp_sisl(:)) + & + sum(flux_lig_si(:) * bc_in%dz_decomp_sisl(:)) + & + sum(flux_lab_si(:) * bc_in%dz_decomp_sisl(:)) - ! Move to the next + end do flux_elem_loop + + ! Move to the next patch currentPatch => currentPatch%younger end do flux_patch_loop diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index f143eaea4c..8c63dc83a9 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2882,8 +2882,25 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, data=bc_out %litt_flux_lab_c_si, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, - data=bc_out`%litt_flux_all_c, hlm_flag=.false.) - + data=bc_out%litt_flux_all_c, hlm_flag=.false.) + + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_cellulose, + data=bc_out%litt_flux_cel_p_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_lignin, + data=bc_out%litt_flux_lig_p_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_labile, + data=bc_out %litt_flux_lab_p_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_total, + data=bc_out%litt_flux_all_p, hlm_flag=.false.) + + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_cellulose, + data=bc_out%litt_flux_cel_n_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_lignin, + data=bc_out%litt_flux_lig_n_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_labile, + data=bc_out %litt_flux_lab_n_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_total, + data=bc_out%litt_flux_all_n, hlm_flag=.false.) end do end do From f2886ecd5a93f2eb76c6f1e25ef16c05bae1bb75 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 15:21:58 -0700 Subject: [PATCH 217/331] correct litter flux all variable to be a scalar --- biogeochem/FatesSoilBGCFluxMod.F90 | 8 ++++++-- main/EDTypesMod.F90 | 3 --- main/FatesInterfaceTypesMod.F90 | 6 +++--- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index f58392a61f..749cf0fb50 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -719,25 +719,29 @@ subroutine FluxIntoLitterPools(csite) bc_out%litt_flux_cel_c_si(:) = 0.0_r8 bc_out%litt_flux_lig_c_si(:) = 0.0_r8 bc_out%litt_flux_lab_c_si(:) = 0.0_r8 - bc_out%litt_flux_all_c(:) = 0.0_r8 + bc_out%litt_flux_all_c = 0.0_r8 flux_cel_si => bc_out%litt_flux_cel_c_si(:) flux_lab_si => bc_out%litt_flux_lab_c_si(:) flux_lig_si => bc_out%litt_flux_lig_c_si(:) - flux_all_si => bc_out%litt_flux_all_c(:) + flux_all_si => bc_out%litt_flux_all_c case (nitrogen_element) bc_out%litt_flux_cel_n_si(:) = 0._r8 bc_out%litt_flux_lig_n_si(:) = 0._r8 bc_out%litt_flux_lab_n_si(:) = 0._r8 + bc_out%litt_flux_all_n = 0.0_r8 flux_cel_si => bc_out%litt_flux_cel_n_si(:) flux_lab_si => bc_out%litt_flux_lab_n_si(:) flux_lig_si => bc_out%litt_flux_lig_n_si(:) + flux_all_si => bc_out%litt_flux_all_n case (phosphorus_element) bc_out%litt_flux_cel_p_si(:) = 0._r8 bc_out%litt_flux_lig_p_si(:) = 0._r8 bc_out%litt_flux_lab_p_si(:) = 0._r8 + bc_out%litt_flux_all_p = 0.0_r8 flux_cel_si => bc_out%litt_flux_cel_p_si(:) flux_lab_si => bc_out%litt_flux_lab_p_si(:) flux_lig_si => bc_out%litt_flux_lig_p_si(:) + flux_all_si => bc_out%litt_flux_all_p end select ! Set a pointer to the litter object diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7582a9f991..e2ae000ce8 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -674,7 +674,6 @@ subroutine InitializeBoundaryConditions(this, ifp) bc_in_ptr%t_scalar_sisl = nan ! Litter fluxes, carbon - allocate(bc_out_ptr%litt_flux_all_c(nlevdecomp)) allocate(bc_out_ptr%litt_flux_cel_c_si(nlevdecomp)) allocate(bc_out_ptr%litt_flux_lig_c_si(nlevdecomp)) allocate(bc_out_ptr%litt_flux_lab_c_si(nlevdecomp)) @@ -685,7 +684,6 @@ subroutine InitializeBoundaryConditions(this, ifp) bc_out_ptr%litt_flux_lab_c_si = nan ! Litter fluxes, nitrogen - allocate(bc_out_ptr%litt_flux_all_n(nlevdecomp)) allocate(bc_out_ptr%litt_flux_cel_n_si(nlevdecomp)) allocate(bc_out_ptr%litt_flux_lig_n_si(nlevdecomp)) allocate(bc_out_ptr%litt_flux_lab_n_si(nlevdecomp)) @@ -696,7 +694,6 @@ subroutine InitializeBoundaryConditions(this, ifp) bc_out_ptr%litt_flux_lab_n_si = nan ! Litter fluxes, phosphorus - allocate(bc_out_ptr%litt_flux_all_p(nlevdecomp)) allocate(bc_out_ptr%litt_flux_cel_p_si(nlevdecomp)) allocate(bc_out_ptr%litt_flux_lig_p_si(nlevdecomp)) allocate(bc_out_ptr%litt_flux_lab_p_si(nlevdecomp)) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index eb3249c462..6d9fde3f15 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -703,9 +703,9 @@ module FatesInterfaceTypesMod real(r8), allocatable :: litt_flux_cel_p_si(:) ! cellulose phosphorus litter, fates->BGC g/m3/s real(r8), allocatable :: litt_flux_lig_p_si(:) ! lignin phosphorus litter, fates->BGC g/m3/s real(r8), allocatable :: litt_flux_lab_p_si(:) ! labile phosphorus litter, fates->BGC g/m3/s - real(r8), allocatable :: litt_flux_all_c(:) ! total litterfall carbon - real(r8), allocatable :: litt_flux_all_n(:) ! total litterfall nitrogen - real(r8), allocatable :: litt_flux_all_p(:) ! total litterfall phosphorus + real(r8) :: litt_flux_all_c ! total litterfall carbon + real(r8) :: litt_flux_all_n ! total litterfall nitrogen + real(r8) :: litt_flux_all_p ! total litterfall phosphorus ! MIMICS Boundary Conditions ! ----------------------------------------------------------------------------------- From b8b9404690ac6b9c60a4f6cded74b39196c9bf0f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 16 Oct 2025 15:22:21 -0700 Subject: [PATCH 218/331] Add N and P litter update call --- main/FatesInterfaceTypesMod.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 6d9fde3f15..0b297cd79e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1446,6 +1446,14 @@ subroutine UpdateLitterFluxes(this, dtime) j = this%GetRegistryIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) + if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then + j = this%GetRegistryIndex(hlm_fates_litter_phosphorus_total) + call this%hlm_vars(j)%Update(this%fates_vars(j)) + + j = this%GetRegistryIndex(hlm_fates_nitrogen_total) + call this%hlm_vars(j)%Update(this%fates_vars(j)) + end if + end subroutine UpdateLitterFluxes From ec8e8963002ce1bfaf96d7b8024481d9702b9d79 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:47:52 -0700 Subject: [PATCH 219/331] fix accumulate check --- main/FatesInterfaceVarTypeMod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 46a6df6e92..f662686e47 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -172,7 +172,7 @@ subroutine UpdateInterfaceVariable(this, var, scalar) type is (real(r8)) select type(source => var%data0d) type is (real(r8)) - if (dest%accumulate) then + if (this%accumulate) then dest = dest + source * scalar_local else dest = source * scalar_local @@ -184,7 +184,7 @@ subroutine UpdateInterfaceVariable(this, var, scalar) type is (integer) select type(source => var%data0d) type is (integer) - if (dest%accumulate) then + if (this%accumulate) then dest = dest + source else dest = source @@ -204,7 +204,7 @@ subroutine UpdateInterfaceVariable(this, var, scalar) type is (real(r8)) select type(source => var%data1d) type is (real(r8)) - if (dest%accumulate) then + if (this%accumulate) then dest = dest + source * scalar_local else dest = source * scalar_local @@ -216,7 +216,7 @@ subroutine UpdateInterfaceVariable(this, var, scalar) type is (integer) select type(source => var%data1d) type is (integer) - if (dest%accumulate) then + if (this%accumulate) then dest = dest + source else dest = source @@ -236,7 +236,7 @@ subroutine UpdateInterfaceVariable(this, var, scalar) type is (real(r8)) select type(source => var%data2d) type is (real(r8)) - if (dest%accumulate) then + if (this%accumulate) then dest = dest + source * scalar_local else dest = source * scalar_local @@ -248,7 +248,7 @@ subroutine UpdateInterfaceVariable(this, var, scalar) type is (integer) select type(source => var%data2d) type is (integer) - if (dest%accumulate) then + if (this%accumulate) then dest = dest + source else dest = source From d115d661f8bce89da6bbbc921bee44c7034235e8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:49:30 -0700 Subject: [PATCH 220/331] make registry update parameters public now that they have been moved to their own module --- main/FatesInterfaceParametersMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index c8902a4490..38936e8c06 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -27,8 +27,8 @@ module FatesInterfaceParametersMod character(len=*), parameter, public :: hlm_fates_litter_nitrogen_total= 'litter_nitrogen_total' ! Registry update frequency parameters - integer, parameter :: registry_update_init = 1 ! variable only needs to be updated during initialization - integer, parameter :: registry_update_daily = 2 ! variable needs to be updated daily - integer, parameter :: registry_update_timestep = 3 ! variable needs to be updated at each timestep + integer, parameter, public :: registry_update_init = 1 ! variable only needs to be updated during initialization + integer, parameter, public :: registry_update_daily = 2 ! variable needs to be updated daily + integer, parameter, public :: registry_update_timestep = 3 ! variable needs to be updated at each timestep end module FatesInterfaceParametersMod \ No newline at end of file From c7cf5135d2ca24200a77e37a6c7a372495265d1c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:51:33 -0700 Subject: [PATCH 221/331] update get interface registry variable and index names to provide distinction from the interface type bound getter --- main/FatesInterfaceTypesMod.F90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 0b297cd79e..58d9facc8b 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -925,8 +925,8 @@ module FatesInterfaceTypesMod procedure, private :: DefineInterfaceRegistry procedure, private :: DefineInterfaceVariable procedure, private :: SetFilterMapArrays - procedure, private :: GetRegistryIndex - procedure, private :: GetRegistryKey + procedure, private :: GetRegistryVariableIndex + procedure, private :: GetRegistryVariableKey end type fates_interface_registry_type @@ -1310,9 +1310,9 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data, active=.true., accumulate=accumulate_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data, active=.true., accumulate=accumulate_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local) end if @@ -1343,9 +1343,9 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) end if end subroutine RegisterInterfaceVariables_1d @@ -1375,9 +1375,9 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate) ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) else - call this%fates_vars(this%GetRegistryIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) end if end subroutine RegisterInterfaceVariables_2d @@ -1443,14 +1443,14 @@ subroutine UpdateLitterFluxes(this, dtime) end do ! Update the HLM variable with the total litterfall - j = this%GetRegistryIndex(hlm_fates_litter_carbon_total) + j = this%GetRegistryVariableIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then - j = this%GetRegistryIndex(hlm_fates_litter_phosphorus_total) + j = this%GetRegistryVariableIndex(hlm_fates_litter_phosphorus_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - j = this%GetRegistryIndex(hlm_fates_nitrogen_total) + j = this%GetRegistryVariableIndex(hlm_fates_litter_nitrogen_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) end if @@ -1459,7 +1459,7 @@ end subroutine UpdateLitterFluxes ! ====================================================================================== - integer function GetRegistryIndex(this, key) result(index) + integer function GetRegistryVariableIndex(this, key) result(index) ! This procedure returns the index associated with the key provided @@ -1477,11 +1477,11 @@ integer function GetRegistryIndex(this, key) result(index) end if end do - end function GetRegistryIndex + end function GetRegistryVariableIndex ! ====================================================================================== - function GetRegistryKey(this, index) result(key) + function GetRegistryVariableKey(this, index) result(key) ! This procedure returns the index associated with the key provided @@ -1492,7 +1492,7 @@ function GetRegistryKey(this, index) result(key) key = this%key(index) - end function GetRegistryKey + end function GetRegistryVariableKey ! ====================================================================================== From 1f0353e4ff65912ab29b54fd94833736527a0cc1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:53:12 -0700 Subject: [PATCH 222/331] correct procedure type for site type setter and getter --- main/EDTypesMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e2ae000ce8..50badcd777 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -707,7 +707,7 @@ end subroutine InitializeBoundaryConditions ! ============================================================================ - integer function GetRegistryIndex(this, ifp) return(ridx) + integer function GetRegistryIndex(this, ifp) result(ridx) ! Arguments class(ed_site_type), intent(in) :: this @@ -719,7 +719,7 @@ end function GetRegistryIndex ! ============================================================================ - integer function SetRegistryIndex(this, ifp, ridx) + subroutine SetRegistryIndex(this, ifp, ridx) ! Arguments class(ed_site_type), intent(inout) :: this @@ -728,7 +728,7 @@ integer function SetRegistryIndex(this, ifp, ridx) this%ridx(ifp) = ridx - end function SetRegistryIndex + end subroutine SetRegistryIndex ! ============================================================================ From d615c44fb864eca53828e64857843289db7ecf62 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:53:50 -0700 Subject: [PATCH 223/331] fix typo for setter call --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 8c63dc83a9..6ac5e29c41 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2804,7 +2804,7 @@ subroutine InitializeFatesSites(this, patches_per_site) if (.not.(allocated(this%sites(s)%ridx))) call this%sites(s)%AllocateRegistryIndexArray(patches_per_site) ! Store the registry index for the current site and fates patch index - this%sites(s)%SetRegisteryIndex(ifp, r) + call this%sites(s)%SetRegistryIndex(ifp, r) end do From f9686dbed8ccd19670c9b2e28f77892a19b27665 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:54:18 -0700 Subject: [PATCH 224/331] move allocate registry index array into its own site loop --- main/FatesInterfaceMod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 6ac5e29c41..f952677565 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2792,6 +2792,11 @@ subroutine InitializeFatesSites(this, patches_per_site) ! Allocate the sites allocate(this%sites(this%nsites)) + + ! Allocate the registry index array for the the sites + do s = 1, this%nsites + call this%sites(s)%AllocateRegistryIndexArray(patches_per_site) + end do ! Iterate through the registries again and store the registry indices for each site do r = 1, this%npatches @@ -2799,9 +2804,6 @@ subroutine InitializeFatesSites(this, patches_per_site) ! Get the site index for the current registry s = this%registry(r)%GetSiteIndex() ifp = this%registry(r)%GetFatesPatchIndex() - - ! Allocate the registry index array for the current site if it hasn't already been allocated - if (.not.(allocated(this%sites(s)%ridx))) call this%sites(s)%AllocateRegistryIndexArray(patches_per_site) ! Store the registry index for the current site and fates patch index call this%sites(s)%SetRegistryIndex(ifp, r) From bde252b51621a1110d63279001ba8a229530fe5a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:55:34 -0700 Subject: [PATCH 225/331] add cnp mode check for bc registration --- main/FatesInterfaceMod.F90 | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index f952677565..5dbded1d98 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2886,23 +2886,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, data=bc_out%litt_flux_all_c, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_cellulose, - data=bc_out%litt_flux_cel_p_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_lignin, - data=bc_out%litt_flux_lig_p_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_labile, - data=bc_out %litt_flux_lab_p_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_total, - data=bc_out%litt_flux_all_p, hlm_flag=.false.) - - call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_cellulose, - data=bc_out%litt_flux_cel_n_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_lignin, - data=bc_out%litt_flux_lig_n_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_labile, - data=bc_out %litt_flux_lab_n_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_total, - data=bc_out%litt_flux_all_n, hlm_flag=.false.) + if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then + end if end do end do From 89dfa22784b2117d4d9d2a1dcd36b7f1b75d92b6 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:56:25 -0700 Subject: [PATCH 226/331] correct missing line continuations --- main/FatesInterfaceMod.F90 | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 5dbded1d98..56f8e7aa88 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2877,16 +2877,33 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) data=bc_in%t_scalar_sisl, hlm_flag=.false.) ! bc_out - call this%registry(r)%Register(key=hlm_fates_litter_carbon_cellulose, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_cellulose, & data=bc_out%litt_flux_cel_c_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_carbon_lignin, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_lignin, & data=bc_out%litt_flux_lig_c_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, & data=bc_out %litt_flux_lab_c_si, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, + call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, & data=bc_out%litt_flux_all_c, hlm_flag=.false.) if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_cellulose, & + data=bc_out%litt_flux_cel_p_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_lignin, & + data=bc_out%litt_flux_lig_p_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_labile, & + data=bc_out %litt_flux_lab_p_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_total, & + data=bc_out%litt_flux_all_p, hlm_flag=.false.) + + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_cellulose, & + data=bc_out%litt_flux_cel_n_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_lignin, & + data=bc_out%litt_flux_lig_n_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_labile, & + data=bc_out %litt_flux_lab_n_si, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_total, & + data=bc_out%litt_flux_all_n, hlm_flag=.false.) end if end do end do From b41578f18692112a9a46be374c40d167cb603471 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:56:52 -0700 Subject: [PATCH 227/331] add missing local definitions in the updateinterfacevariables procedure --- main/FatesInterfaceMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 56f8e7aa88..9d2d7edc14 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2951,7 +2951,6 @@ subroutine UpdateInterfaceVariables(this, initialize) bc_in%max_rooting_depth_index_col = min(bc_in%nlevsoil, bc_in%max_thaw_depth_index) end if - end do From 08d8e19639f1fb326566663fed4346f760b578ab Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:57:09 -0700 Subject: [PATCH 228/331] add missing local definitions --- main/FatesInterfaceMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 9d2d7edc14..98c8d9aa9d 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2925,6 +2925,8 @@ subroutine UpdateInterfaceVariables(this, initialize) logical :: initialize_local integer :: r ! registry interface index + integer :: s ! site index + integer :: ifp ! fates patch index ! Set the default initialize flag to false if (present(initialize)) then From 1da692130c296c747113df1403e2e8474e1c4f37 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:57:34 -0700 Subject: [PATCH 229/331] add updatelitterfluxes to the interface type contains section --- main/FatesInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 98c8d9aa9d..9edf2f3d12 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -172,6 +172,7 @@ module FatesInterfaceMod procedure, public :: InitializeFatesSites procedure, public :: InitializeBoundaryConditions procedure, public :: UpdateInterfaceVariables + procedure, public :: UpdateLitterFluxes end type fates_interface_type From e006c50cd65c00d9f4a83898893462a27273216c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:58:37 -0700 Subject: [PATCH 230/331] use all fates interface parameters for the bc initialization This is expected to use most of the parameters defined in that module --- main/FatesInterfaceMod.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 9edf2f3d12..c3439465dc 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2818,10 +2818,7 @@ end subroutine InitializeFatesSites subroutine InitializeBoundaryConditions(this, patches_per_site) - use FatesInterfaceTypesMod, only : hlm_fates_decomp_max - use FatesInterfaceTypesMod, only : hlm_fates_soil_level - use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_moisture - use FatesInterfaceTypesMod, only : hlm_fates_decomp_frac_temperature + use FatesInterfaceParametersMod ! Arguments class(fates_interface_type), intent(inout) :: this ! fates interface type From e6e3604835b05bc237c0bf3a0d9f96a11caa1e5a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 14:59:46 -0700 Subject: [PATCH 231/331] correct local pointer dimension to be scalar --- biogeochem/FatesSoilBGCFluxMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 749cf0fb50..365c463a2b 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -633,7 +633,7 @@ subroutine FluxIntoLitterPools(csite) real(r8), pointer :: flux_cel_si(:) real(r8), pointer :: flux_lab_si(:) real(r8), pointer :: flux_lig_si(:) - real(r8), pointer :: flux_all_si(:) + real(r8), pointer :: flux_all_si type(litter_type), pointer :: litt real(r8) :: surface_prof(bc_in%nlevsoil) ! this array is used to distribute From ba288670b4c14f957739104f63f581614ecd2960 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:04:19 -0700 Subject: [PATCH 232/331] make surface_prof allocatable This needs to be set specifically for each patch now as a given patch might have a different nlevsoil --- biogeochem/FatesSoilBGCFluxMod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 365c463a2b..5f995f0c00 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -635,8 +635,8 @@ subroutine FluxIntoLitterPools(csite) real(r8), pointer :: flux_lig_si(:) real(r8), pointer :: flux_all_si type(litter_type), pointer :: litt - - real(r8) :: surface_prof(bc_in%nlevsoil) ! this array is used to distribute + + real(r8), allocatable :: surface_prof(:) ! this array is used to distribute ! fragmented litter on the surface ! into the soil/decomposition ! layers. It exponentially decays @@ -695,6 +695,7 @@ subroutine FluxIntoLitterPools(csite) ! wider layers get proportionally more. After the masses ! are sent, each layer will normalize by depth. + allocate(surface_prof(bc_in%nlevsoil)) surface_prof(:) = 0._r8 z_decomp = 0._r8 do id = 1,nlev_eff_decomp @@ -838,6 +839,8 @@ subroutine FluxIntoLitterPools(csite) end do flux_elem_loop + ! Deallocate temporary array + deallocate(surface_prof) ! Move to the next patch currentPatch => currentPatch%younger end do flux_patch_loop From 1c1620daccc5cead0aaaddf47ff434a4d5ba7971 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:05:15 -0700 Subject: [PATCH 233/331] move MIMICS section inside patch loop --- biogeochem/FatesSoilBGCFluxMod.F90 | 180 ++++++++++++++--------------- 1 file changed, 86 insertions(+), 94 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 5f995f0c00..99f209e120 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -842,105 +842,97 @@ subroutine FluxIntoLitterPools(csite) ! Deallocate temporary array deallocate(surface_prof) ! Move to the next patch - currentPatch => currentPatch%younger - end do flux_patch_loop - ! If we are coupled with MIMICS, then we need some assessment of litter quality - ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) - ! then we need to approximate this by estimating the mean C:N ratios of each - ! plant organ, and mulitplying that by the different C Fluxes to get a total - ! approximate N flux. Note, in C-only, we will not capture any re-absorption. + ! If we are coupled with MIMICS, then we need some assessment of litter quality + ! ie ligC/totalN. If we are not tracking N in the litter flux (ie C-only model) + ! then we need to approximate this by estimating the mean C:N ratios of each + ! plant organ, and mulitplying that by the different C Fluxes to get a total + ! approximate N flux. Note, in C-only, we will not capture any re-absorption. - if(trim(hlm_decomp).eq.'MIMICS') then - - ! If we track nitrogen (ie cnp or other) then - ! we diagnose the c-lig/n ratio directly from the pools - if(element_pos(nitrogen_element)>0) then - - ! Sum totalN fluxes over depth [g/m2] - sum_N = sum((bc_out%litt_flux_cel_n_si(1:nlev_eff_soil) + & - bc_out%litt_flux_lig_n_si(1:nlev_eff_soil) + & - bc_out%litt_flux_lab_n_si(1:nlev_eff_soil)) * & - bc_in%dz_sisl(1:nlev_eff_soil)) - - else - - ! In this case (Carbon Only), we use the stoichiometry parameters to estimate - ! the C:N of live vegetation and the seedbank, and use that - ! as a proxy for the C:N of the litter flux - - sum_N = 0._r8 - - currentPatch => csite%oldest_patch - do while (associated(currentPatch)) - - litt => currentPatch%litter(element_pos(carbon12_element)) - area_frac = currentPatch%area*area_inv - - tot_leaf_c = 0._r8 - tot_leaf_n = 0._r8 - tot_fnrt_c = 0._r8 - tot_fnrt_n = 0._r8 - tot_wood_c = 0._r8 - tot_wood_n = 0._r8 - - ccohort => currentPatch%tallest - do while (associated(ccohort)) - ipft = ccohort%pft - leaf_c = ccohort%n * area_inv * ccohort%prt%GetState(leaf_organ, carbon12_element) - sapw_c = ccohort%n * area_inv * ccohort%prt%GetState(sapw_organ, carbon12_element) - fnrt_c = ccohort%n * area_inv * ccohort%prt%GetState(fnrt_organ, carbon12_element) - struct_c = ccohort%n * area_inv * ccohort%prt%GetState(struct_organ, carbon12_element) - leaf_n = leaf_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) - sapw_n = sapw_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) - fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) - struct_n = struct_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) - tot_leaf_c = tot_leaf_c + leaf_c - tot_leaf_n = tot_leaf_n + leaf_n - tot_fnrt_c = tot_fnrt_c + fnrt_c - tot_fnrt_n = tot_fnrt_n + fnrt_n - tot_wood_c = tot_wood_c + sapw_c + struct_c - tot_wood_n = tot_wood_n + sapw_n + struct_n - ccohort => ccohort%shorter - end do - - if(tot_wood_c>nearzero) then - sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) - sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) - end if - if(tot_leaf_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) - end if - if(tot_fnrt_c>nearzero)then - sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) - end if - do ipft = 1,numpft - sum_N = sum_N + area_frac * currentPatch%nitr_repro_stoich(ipft) * & - (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) - end do - - currentPatch => currentPatch%younger - end do - - ! Convert from kg/m2/day -> g/m2/s - sum_N = sum_N * days_per_sec * g_per_kg - - end if - - ! Sum over layers and multiply by depth g/m3/s * m -> g/m2/s - sum_ligC = sum(bc_out%litt_flux_lig_c_si(1:nlev_eff_soil) * bc_in%dz_sisl(1:nlev_eff_soil)) - - if(sum_N>nearzero)then - bc_out%litt_flux_ligc_per_n = sum_ligC / sum_N - else - bc_out%litt_flux_ligc_per_n = 0._r8 - end if - - end if + if(trim(hlm_decomp).eq.'MIMICS') then + + ! If we track nitrogen (ie cnp or other) then + ! we diagnose the c-lig/n ratio directly from the pools + if(element_pos(nitrogen_element)>0) then + + ! Sum totalN fluxes over depth [g/m2] + sum_N = sum((bc_out%litt_flux_cel_n_si(1:nlev_eff_soil) + & + bc_out%litt_flux_lig_n_si(1:nlev_eff_soil) + & + bc_out%litt_flux_lab_n_si(1:nlev_eff_soil)) * & + bc_in%dz_sisl(1:nlev_eff_soil)) + + else + + ! In this case (Carbon Only), we use the stoichiometry parameters to estimate + ! the C:N of live vegetation and the seedbank, and use that + ! as a proxy for the C:N of the litter flux + + sum_N = 0._r8 + + litt => currentPatch%litter(element_pos(carbon12_element)) + + tot_leaf_c = 0._r8 + tot_leaf_n = 0._r8 + tot_fnrt_c = 0._r8 + tot_fnrt_n = 0._r8 + tot_wood_c = 0._r8 + tot_wood_n = 0._r8 + + ccohort => currentPatch%tallest + do while (associated(ccohort)) + ipft = ccohort%pft + leaf_c = ccohort%n * area_inv * ccohort%prt%GetState(leaf_organ, carbon12_element) + sapw_c = ccohort%n * area_inv * ccohort%prt%GetState(sapw_organ, carbon12_element) + fnrt_c = ccohort%n * area_inv * ccohort%prt%GetState(fnrt_organ, carbon12_element) + struct_c = ccohort%n * area_inv * ccohort%prt%GetState(struct_organ, carbon12_element) + leaf_n = leaf_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(leaf_organ)) + sapw_n = sapw_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(sapw_organ)) + fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(fnrt_organ)) + struct_n = struct_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(struct_organ)) + tot_leaf_c = tot_leaf_c + leaf_c + tot_leaf_n = tot_leaf_n + leaf_n + tot_fnrt_c = tot_fnrt_c + fnrt_c + tot_fnrt_n = tot_fnrt_n + fnrt_n + tot_wood_c = tot_wood_c + sapw_c + struct_c + tot_wood_n = tot_wood_n + sapw_n + struct_n + ccohort => ccohort%shorter + end do + + if(tot_wood_c>nearzero) then + sum_N = sum_N + sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) + end if + if(tot_leaf_c>nearzero)then + sum_N = sum_N + sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) + end if + if(tot_fnrt_c>nearzero)then + sum_N = sum_N + sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) + end if + do ipft = 1,numpft + sum_N = sum_N + currentPatch%nitr_repro_stoich(ipft) * & + (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) + end do + + ! Convert from kg/m2/day -> g/m2/s + sum_N = sum_N * days_per_sec * g_per_kg + + end if + + ! Sum over layers and multiply by depth g/m3/s * m -> g/m2/s + sum_ligC = sum(bc_out%litt_flux_lig_c_si(1:nlev_eff_soil) * bc_in%dz_sisl(1:nlev_eff_soil)) + + if(sum_N>nearzero)then + bc_out%litt_flux_ligc_per_n = sum_ligC / sum_N + else + bc_out%litt_flux_ligc_per_n = 0._r8 + end if + + end if + currentPatch => currentPatch%younger + end do flux_patch_loop - return end subroutine FluxIntoLitterPools From a6528acf672eb9703e316920b4bcd30a331ac78f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:06:09 -0700 Subject: [PATCH 234/331] make the bc_in shorthand an associate statement instead of a pointer --- biogeochem/FatesSoilBGCFluxMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 99f209e120..3b389d03e9 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -623,13 +623,11 @@ subroutine FluxIntoLitterPools(csite) implicit none ! !ARGUMENTS - type(ed_site_type) , intent(inout) :: csite + type(ed_site_type), target, intent(inout) :: csite ! !LOCAL VARIABLES: type (fates_patch_type), pointer :: currentPatch type (fates_cohort_type), pointer :: ccohort - type(bc_out_type), pointer :: bc_out - type(bc_in_type), pointer :: bc_in real(r8), pointer :: flux_cel_si(:) real(r8), pointer :: flux_lab_si(:) real(r8), pointer :: flux_lig_si(:) @@ -674,10 +672,11 @@ subroutine FluxIntoLitterPools(csite) ! Loop over patches currentPatch => csite%oldest_patch flux_patch_loop: do while (associated(currentPatch)) - - bc_out => csite%bc_out(currentPatch%patchno) - bc_in => csite%bc_in(currentPatch%patchno) + associate( & + bc_out => csite%bc_out(currentPatch%patchno), & + bc_in => csite%bc_in(currentPatch%patchno) & + ) ! This is the number of effective soil layers to transfer from nlev_eff_soil = max(bc_in%max_rooting_depth_index_col, 1) @@ -763,7 +762,7 @@ subroutine FluxIntoLitterPools(csite) do j = 1, nlev_eff_soil - id = csite%bc_in(ifp)%decomp_id(j) ! Map from soil layer to decomp layer + id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel @@ -811,7 +810,7 @@ subroutine FluxIntoLitterPools(csite) end do do j = 1, nlev_eff_soil - id = csite%bc_in(ifp)%decomp_id(j) + id = bc_in%decomp_id(j) flux_lab_si(id) = flux_lab_si(id) + & litt%root_fines_frag(ilabile,j) flux_cel_si(id) = flux_cel_si(id) + & @@ -929,6 +928,7 @@ subroutine FluxIntoLitterPools(csite) end if + end associate currentPatch => currentPatch%younger end do flux_patch_loop From 6ebb14b33b1128433171ab0b20d060a1b56cf0ce Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:06:29 -0700 Subject: [PATCH 235/331] add missing nan usage --- main/EDTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 50badcd777..f966eb7540 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -38,6 +38,7 @@ module EDTypesMod use EDParamsMod, only : nclmax, nlevleaf, maxpft use FatesConstantsMod, only : n_dbh_bins, n_dist_types use shr_log_mod, only : errMsg => shr_log_errMsg + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) use SFFireWeatherMod, only : fire_weather implicit none From 6f07228b1dc39f304360fadf8adbd086d3a810c6 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:07:26 -0700 Subject: [PATCH 236/331] move cnp flex mode use statement to the top of the module --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 58d9facc8b..c9633a87f5 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -8,7 +8,7 @@ module FatesInterfaceTypesMod use FatesGlobals , only : endrun => fates_endrun use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - + use PRTGenericMod , only : prt_cnp_flex_allom_hyp use FatesInterfaceVariableTypeMod, only : fates_interface_variable_type use FatesInterfaceParametersMod From 0abbe1a101f246e787e5258601caa71f882ed268 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:08:11 -0700 Subject: [PATCH 237/331] add bc_in initialization type bound proc --- main/FatesInterfaceTypesMod.F90 | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index c9633a87f5..c505e7794d 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -623,6 +623,10 @@ module FatesInterfaceTypesMod real(r8),allocatable :: hlm_sp_tlai(:) ! Interpolated daily total LAI (leaf area index) input from HLM per patch/pft real(r8),allocatable :: hlm_sp_tsai(:) ! Interpolated sailt total SAI (stem area index) input from HLM per patch/pft real(r8),allocatable :: hlm_sp_htop(:) ! Interpolated daily canopy vegetation height input from HLM per patch/pft + + contains + + procedure, public :: Initialize => InitializeBCIn end type bc_in_type @@ -950,6 +954,23 @@ end subroutine ZeroBCOutCarbonFluxes ! ====================================================================================== + subroutine InitializeBCIn(this) + + ! Arguments + class(bc_in_type), intent(inout) :: this + + ! Allocate boundary condition arrays + allocate(this%w_scalar_sisl(this%nlevdecomp_full)) + allocate(this%t_scalar_sisl(this%nlevdecomp_full)) + + this%w_scalar_sisl = nan + this%t_scalar_sisl = nan + + + end subroutine InitializeBCIn + + ! ====================================================================================== + subroutine InitializeInterfaceRegistry(this) ! This initializes the interface registry From f55a67bd1e65294b774763f449f90ab2a4343cb9 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:08:36 -0700 Subject: [PATCH 238/331] add bc_out init type bound proc --- main/FatesInterfaceTypesMod.F90 | 40 +++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index c505e7794d..db6e566ce7 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -831,6 +831,10 @@ module FatesInterfaceTypesMod real(r8) :: litter_cwd_c_si ! Total litter plus CWD carbon [Site-Level, gC m-2] real(r8) :: seed_c_si ! Total seed carbon [Site-Level, gC m-2] + contains + + procedure, public :: Initialize => InitializeBCOut + end type bc_out_type @@ -971,6 +975,42 @@ end subroutine InitializeBCIn ! ====================================================================================== + subroutine InitializeBCOut(this, bc_in) + + ! Arguments + class(bc_out_type), intent(inout) :: this + type(bc_in_type), intent(in) :: bc_in + + ! Allocate boundary condition arrays + allocate(this%litt_flux_cel_c_si(bc_in%nlevdecomp_full)) + allocate(this%litt_flux_lig_c_si(bc_in%nlevdecomp_full)) + allocate(this%litt_flux_lab_c_si(bc_in%nlevdecomp_full)) + + ! Nan the arrays + this%litt_flux_cel_c_si = nan + this%litt_flux_lig_c_si = nan + this%litt_flux_lab_c_si = nan + + if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then + allocate(this%litt_flux_cel_n_si(bc_in%nlevdecomp_full)) + allocate(this%litt_flux_lig_n_si(bc_in%nlevdecomp_full)) + allocate(this%litt_flux_lab_n_si(bc_in%nlevdecomp_full)) + allocate(this%litt_flux_cel_p_si(bc_in%nlevdecomp_full)) + allocate(this%litt_flux_lig_p_si(bc_in%nlevdecomp_full)) + allocate(this%litt_flux_lab_p_si(bc_in%nlevdecomp_full)) + + this%litt_flux_cel_n_si = nan + this%litt_flux_lig_n_si = nan + this%litt_flux_lab_n_si = nan + this%litt_flux_cel_p_si = nan + this%litt_flux_lig_p_si = nan + this%litt_flux_lab_p_si = nan + end if + + end subroutine InitializeBCOut + + ! ====================================================================================== + subroutine InitializeInterfaceRegistry(this) ! This initializes the interface registry From c51786900c977e28aca05cbc31b863b604402307 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:09:07 -0700 Subject: [PATCH 239/331] correct num of litter fluxes name --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index db6e566ce7..6971333271 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1495,7 +1495,7 @@ subroutine UpdateLitterFluxes(this, dtime) integer :: j ! Iterate over the litter flux filter to update the individual litter types - do i = 1, num_litter_fluxes + do i = 1, this%num_api_vars_litter_flux j = this%filter_litter_flux(i) ! Update the hlm variables with the fates variables From bfdffe4a2ad86c971d5ff9e402cc1ad7575378ad Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:10:17 -0700 Subject: [PATCH 240/331] change litter flux counter to be for all flux types, not just carbon --- main/FatesInterfaceTypesMod.F90 | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 6971333271..744260bae6 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -887,7 +887,7 @@ module FatesInterfaceTypesMod integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily integer :: num_api_vars_update_timestep ! number of variables that update on the model timestep - integer :: num_api_vars_litter_carbon ! number of variables that deal with litter, carbon + integer :: num_api_vars_litter_flux ! number of variables that deal with all litter fluxes ! Array of update frequency values for each regsitry index integer, allocatable :: update_frequency(:) @@ -898,7 +898,7 @@ module FatesInterfaceTypesMod integer, allocatable :: filter_timestep(:) ! registry index of variables that update at each timestep ! Filter arrays that hold the registry indices for litter fluxes - integer, allocatable :: filter_litter_carbon(:) + integer, allocatable :: filter_litter_flux(:) ! Subgrid index data integer, private :: gidx @@ -1023,7 +1023,7 @@ subroutine InitializeInterfaceRegistry(this) this%num_api_vars = 0 this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 - this%num_api_vars_litter_carbon = 0 + this%num_api_vars_litter_flux = 0 ! First count up the keys defined in the registry and the registry counters call this%DefineInterfaceRegistry(initialize=.false.) @@ -1040,14 +1040,14 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%filter_timestep(this%num_api_vars_update_timestep)) ! Allocate the litter flux filter - allocate(this%filter_litter_carbon(this%num_api_vars_litter_carbon)) + allocate(this%filter_litter_flux(this%num_api_vars_litter_flux)) ! Unset the allocatables not including the interface variables this%update_frequency(:) = fates_unset_int this%filter_init(:) = fates_unset_int this%filter_daily(:) = fates_unset_int this%filter_timestep(:) = fates_unset_int - this%filter_litter_carbon(:) = fates_unset_int + this%filter_litter_flux(:) = fates_unset_int ! Now initialize the registry keys call this%DefineInterfaceRegistry(initialize=.true.) @@ -1190,11 +1190,11 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc this%num_api_vars_update_daily = this%num_api_vars_update_daily + 1 end if - ! Update the litter flux counters + ! Update the litter flux counters not including the total flux counter if (key == hlm_fates_litter_carbon_cellulose .or. & key == hlm_fates_litter_carbon_labile .or. & key == hlm_fates_litter_carbon_lignin) then - this%num_api_vars_litter_carbon = this%num_api_vars_litter_carbon + 1 + this%num_api_vars_litter_flux= this%num_api_vars_litter_flux + 1 end if end if @@ -1294,13 +1294,13 @@ subroutine SetFilterMapArrays(this) integer :: count_init integer :: count_daily integer :: count_timestep - integer :: count_litter_carbon + integer :: count_litter_flux ! Initialize counters count_init = 0 count_daily = 0 count_timestep = 0 - count_litter_carbon = 0 + count_litter_flux= 0 ! Iterate over all registered variables and populate the filter maps accordingly do index = 1, this%num_api_vars @@ -1322,10 +1322,16 @@ subroutine SetFilterMapArrays(this) ! Litter flux update if (this%key(index) == hlm_fates_litter_carbon_cellulose .or. & + this%key(index) == hlm_fates_litter_nitrogen_cellulose .or. & + this%key(index) == hlm_fates_litter_phosphorus_cellulose .or. & this%key(index) == hlm_fates_litter_carbon_labile .or. & - this%key(index) == hlm_fates_litter_carbon_lignin) then - count_litter_carbon = count_litter_carbon + 1 - this%filter_litter_carbon(count_litter_carbon) = index + this%key(index) == hlm_fates_litter_nitrogen_labile .or. & + this%key(index) == hlm_fates_litter_phosphorus_labile .or. & + this%key(index) == hlm_fates_litter_carbon_lignin .or. & + this%key(index) == hlm_fates_litter_nitrogen_lignin .or. & + this%key(index) == hlm_fates_litter_phosphorus_lignin) then + count_litter_flux = count_litter_flux + 1 + this%filter_litter_flux(count_litter_flux) = index end if From c9824eb54c7f305f53b6e2c779e852b282e632f3 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:10:59 -0700 Subject: [PATCH 241/331] add model timestep variable counter --- main/FatesInterfaceTypesMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 744260bae6..994547995f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1023,6 +1023,7 @@ subroutine InitializeInterfaceRegistry(this) this%num_api_vars = 0 this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 + this%num_api_vars_update_timestep = 0 this%num_api_vars_litter_flux = 0 ! First count up the keys defined in the registry and the registry counters @@ -1180,7 +1181,7 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc case (registry_update_daily) this%num_api_vars_update_daily = this%num_api_vars_update_daily + 1 case (registry_update_timestep) - this%num_api_vars_update_init = this%num_api_vars_update_timestep + 1 + this%num_api_vars_update_timestep = this%num_api_vars_update_timestep + 1 case default write(fates_log(),*) 'ERROR: Unrecognized update frequency in DefineInterfaceVariable(): ', update_frequency call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -1339,12 +1340,13 @@ subroutine SetFilterMapArrays(this) ! Check that the counts match the expected sizes if (count_init /= this%num_api_vars_update_init .or. & - count_daily /= this%num_api_vars_update_daily .or. + count_daily /= this%num_api_vars_update_daily .or. & count_timestep /= this%num_api_vars_update_timestep) then write(fates_log(),*) 'ERROR: Mismatch in initialization counts in SetFilterMapArrays(): ' write(fates_log(),*) ' count_init = ', count_init, ' expected = ', this%num_api_vars_update_init write(fates_log(),*) ' count_daily = ', count_daily, ' expected = ', this%num_api_vars_update_daily + write(fates_log(),*) ' count_timestep = ', count_timestep, ' expected = ', this%num_api_vars_update_timestep call endrun(msg=errMsg(__FILE__, __LINE__)) end if From 015179b65926c0542d17caae1093ef38662cd360 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:11:36 -0700 Subject: [PATCH 242/331] add C and P variable definitions --- main/FatesInterfaceTypesMod.F90 | 35 ++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 994547995f..3e235085c7 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1098,22 +1098,25 @@ subroutine DefineInterfaceRegistry(this, initialize) call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_total, initialize=initialize, index=index, update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_cellulose, initialize=initialize, index=index, - update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_lignin, initialize=initialize, index=index, - update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_labile, initialize=initialize, index=index, - update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_total, initialize=initialize, index=index, - update_frequency=registry_update_timestep) - - call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_cellulose, initialize=initialize, index=index, - update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_lignin, initialize=initialize, index=index, - update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_labile, initialize=initialize, index=index, - update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_total, initialize=initialize, index=index, + ! Define the N and P litter fluxes if in CNP mode + ! We could define the interface variables always, even if not registered, but this helps reduce the memory needs + if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_cellulose, initialize=initialize, index=index, & + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_lignin, initialize=initialize, index=index, & + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_labile, initialize=initialize, index=index, & + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_total, initialize=initialize, index=index, & + update_frequency=registry_update_timestep) + + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_cellulose, initialize=initialize, index=index, & + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_lignin, initialize=initialize, index=index, & + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_labile, initialize=initialize, index=index, & + update_frequency=registry_update_timestep) + call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_total, initialize=initialize, index=index, & update_frequency=registry_update_timestep) end subroutine DefineInterfaceRegistry From f3511abd5c0dc68958f3b441024530f398783566 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:11:51 -0700 Subject: [PATCH 243/331] add missing end if --- main/FatesInterfaceTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 3e235085c7..f34f2072d7 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1118,6 +1118,7 @@ subroutine DefineInterfaceRegistry(this, initialize) update_frequency=registry_update_timestep) call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_total, initialize=initialize, index=index, & update_frequency=registry_update_timestep) + end if end subroutine DefineInterfaceRegistry From 08b30e040845e2713a2bf94822bcb3b6ff1fe5eb Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:12:08 -0700 Subject: [PATCH 244/331] add missing line continuations --- main/FatesInterfaceTypesMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f34f2072d7..f8026afa52 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1089,13 +1089,13 @@ subroutine DefineInterfaceRegistry(this, initialize) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index=index) ! Variables that need to be updated with each timestep - call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_cellulose, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_cellulose, initialize=initialize, index=index, & update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_lignin, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_lignin, initialize=initialize, index=index, & update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_labile, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_labile, initialize=initialize, index=index, & update_frequency=registry_update_timestep) - call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_total, initialize=initialize, index=index, + call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_total, initialize=initialize, index=index, & update_frequency=registry_update_timestep) ! Define the N and P litter fluxes if in CNP mode From a2eb3f6bb25790b27f05cec38b9939ccddc39e51 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:12:23 -0700 Subject: [PATCH 245/331] add bc initialization calls --- main/FatesInterfaceMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index c3439465dc..143b16033f 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2856,7 +2856,9 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%InitializeInterfaceVariables() ! Initialize the currently registered boundary conditions - call this%sites(s)%InitializeBoundaryConditions(ifp) + ! call this%sites(s)%InitializeBoundaryConditions(ifp) + call bc_in%Initialize() + call bc_out%Initialize(bc_in) ! Register the remaining boundary conditions ! bc_in From 543f33fa727b923e387e53a57cc6fc9e628ccea8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:12:54 -0700 Subject: [PATCH 246/331] correct thaw parameter name --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 143b16033f..811cd1e8a9 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2863,7 +2863,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the remaining boundary conditions ! bc_in call this%registry(r)%Register(key=hlm_fates_thaw_max_depth_index, & - data=bc_in%max_thaw_depth_index_col, hlm_flag=.false.) + data=bc_in%max_thaw_depth_index, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_decomp_thickness, & data=bc_in%dz_decomp_sisl, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_decomp_id, & From 45789688ec836834e6fe11ade743e9b46f8fff87 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 15:13:38 -0700 Subject: [PATCH 247/331] remove site-type bound BC initi procedure --- main/EDTypesMod.F90 | 63 --------------------------------------------- 1 file changed, 63 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index f966eb7540..4ceb6e0fe6 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -616,7 +616,6 @@ module EDTypesMod contains procedure, public :: AllocateRegistryIndexArray - procedure, public :: InitializeBoundaryConditions procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction procedure, public :: GetRegistryIndex @@ -646,68 +645,6 @@ subroutine AllocateRegistryIndexArray(this, patches_per_site) end subroutine AllocateRegistryIndexArray ! ============================================================================ - - subroutine InitializeBoundaryConditions(this, ifp) - - ! Allocate and initialize boundary condition arrays to NaN. - ! Note that we use the full nlevdecomp size to match the HLM array sizes. - ! This may need to be setup with a more sophisticated approach if the HLMs - ! diverge in the dimensionality of the matching arrays. - - class(ed_site_type), intent(inout) :: this - integer, intent(in) :: ifp - - ! Locals - integer :: nlevdecomp - type(bc_in_type), pointer :: bc_in_ptr - type(bc_out_type), pointer :: bc_out_ptr - - ! Use locals for convenience - nlevdecomp = this%bc_in(ifp)%nlevdecomp_full - bc_in_ptr => this%bc_in(ifp) - bc_out_ptr => this%bc_out(ifp) - - ! bc_in - allocate(bc_in_ptr%w_scalar_sisl(nlevdecomp)) - allocate(bc_in_ptr%t_scalar_sisl(nlevdecomp)) - - bc_in_ptr%w_scalar_sisl = nan - bc_in_ptr%t_scalar_sisl = nan - - ! Litter fluxes, carbon - allocate(bc_out_ptr%litt_flux_cel_c_si(nlevdecomp)) - allocate(bc_out_ptr%litt_flux_lig_c_si(nlevdecomp)) - allocate(bc_out_ptr%litt_flux_lab_c_si(nlevdecomp)) - - bc_out_ptr%litt_flux_all_c = nan - bc_out_ptr%litt_flux_cel_c_si = nan - bc_out_ptr%litt_flux_lig_c_si = nan - bc_out_ptr%litt_flux_lab_c_si = nan - - ! Litter fluxes, nitrogen - allocate(bc_out_ptr%litt_flux_cel_n_si(nlevdecomp)) - allocate(bc_out_ptr%litt_flux_lig_n_si(nlevdecomp)) - allocate(bc_out_ptr%litt_flux_lab_n_si(nlevdecomp)) - - bc_out_ptr%litt_flux_all_n = nan - bc_out_ptr%litt_flux_cel_n_si = nan - bc_out_ptr%litt_flux_lig_n_si = nan - bc_out_ptr%litt_flux_lab_n_si = nan - - ! Litter fluxes, phosphorus - allocate(bc_out_ptr%litt_flux_cel_p_si(nlevdecomp)) - allocate(bc_out_ptr%litt_flux_lig_p_si(nlevdecomp)) - allocate(bc_out_ptr%litt_flux_lab_p_si(nlevdecomp)) - - bc_out_ptr%litt_flux_all_p = nan - bc_out_ptr%litt_flux_cel_p_si = nan - bc_out_ptr%litt_flux_lig_p_si = nan - bc_out_ptr%litt_flux_lab_p_si = nan - - end subroutine InitializeBoundaryConditions - - ! ============================================================================ - integer function GetRegistryIndex(this, ifp) result(ridx) ! Arguments From ce0ce62db0ca8c2eb06fb24e7a7cb428f2376a5f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 21:33:56 -0700 Subject: [PATCH 248/331] move nlevsoil registration earlier and allocate decomp_id using it --- main/FatesInterfaceMod.F90 | 1 + main/FatesInterfaceTypesMod.F90 | 7 ++++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 811cd1e8a9..81639b6fda 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2851,6 +2851,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! Register the boundary conditions that are necessary for allocating other boundary conditions first call this%registry(r)%Register(key=hlm_fates_decomp_max, data=bc_in%nlevdecomp_full, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_decomp, data=bc_in%nlevdecomp, hlm_flag=.false.) + call this%registry(r)%Register(key=hlm_fates_soil_level, data=bc_in%nlevsoil, hlm_flag=.false.) ! Initialize the interface variables necessary for allocating boundary conditions call this%registry(r)%InitializeInterfaceVariables() diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f8026afa52..c16897d198 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -964,9 +964,14 @@ subroutine InitializeBCIn(this) class(bc_in_type), intent(inout) :: this ! Allocate boundary condition arrays + allocate(this%decomp_id(this%nlevsoil)) + this%decomp_id = fates_unset_int + + allocate(this%dz_decomp_sisl(this%nlevdecomp_full)) + this%dz_decomp_sisl = nan + allocate(this%w_scalar_sisl(this%nlevdecomp_full)) allocate(this%t_scalar_sisl(this%nlevdecomp_full)) - this%w_scalar_sisl = nan this%t_scalar_sisl = nan From f97adb59626111188c6963eb0859b734952f73fd Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 21:35:35 -0700 Subject: [PATCH 249/331] move nlevsoil registration earlier - delete old location --- main/FatesInterfaceMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 81639b6fda..928890d366 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2869,8 +2869,6 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) data=bc_in%dz_decomp_sisl, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_decomp_id, & data=bc_in%decomp_id, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_soil_level, & - data=bc_in%nlevsoil, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_decomp_frac_moisture, & data=bc_in%w_scalar_sisl, hlm_flag=.false.) From 959ada666b552bb5fcf1d6102a422196705015ea Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 21:36:07 -0700 Subject: [PATCH 250/331] remove decomp_id and calculate during initialization in the update procedure --- main/FatesInterfaceMod.F90 | 42 +++++++++++++++++++++++++++++++++++--- 1 file changed, 39 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 928890d366..e3bc745ee9 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2867,8 +2867,6 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) data=bc_in%max_thaw_depth_index, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_decomp_thickness, & data=bc_in%dz_decomp_sisl, hlm_flag=.false.) - call this%registry(r)%Register(key=hlm_fates_decomp_id, & - data=bc_in%decomp_id, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_decomp_frac_moisture, & data=bc_in%w_scalar_sisl, hlm_flag=.false.) @@ -2926,6 +2924,7 @@ subroutine UpdateInterfaceVariables(this, initialize) integer :: r ! registry interface index integer :: s ! site index integer :: ifp ! fates patch index + integer :: i ! layer index ! Set the default initialize flag to false if (present(initialize)) then @@ -2945,11 +2944,48 @@ subroutine UpdateInterfaceVariables(this, initialize) bc_in => this%sites(s)%bc_in(ifp) - ! Calculate the maximum rooting depth index + ! Calculate various bc_in variables that are based on other variables or namelist states if (initialize) then + + ! Check vertical soil carbon decomposition usage + if (hlm_use_vertsoilc == itrue) then + if(bc_in%nlevdecomp .ne. bc_in%nlevsoil) then + write(fates_log(), *) 'The host has signaled a vertically resolved' + write(fates_log(), *) 'soil decomposition model. Therefore, the ' + write(fates_log(), *) 'total number of soil layers should equal the' + write(fates_log(), *) 'total number of decomposition layers.' + write(fates_log(), *) 'nlevdecomp: ',bc_in%nlevdecomp + write(fates_log(), *) 'nlevsoil: ',bc_in%nlevsoil + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Set all decomposition layer ids to their respective soil layer index + do i = 1, bc_in%nlevsoil + bc_in%decomp_id(i) = i + end do + + else ! No vertical soil carbon decomposition usage + if(bc_in%nlevdecomp .ne. 1)then + write(fates_log(), *) 'The host has signaled a non-vertically resolved' + write(fates_log(), *) 'soil decomposition model. Therefore, the ' + write(fates_log(), *) 'total number of decomposition layers should be 1.' + write(fates_log(), *) 'nlevdecomp: ',bc_in%nlevdecomp + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + ! Set all decomposition layer ids to 1 + bc_in%decomp_id(:) = 1 + + end if + + ! On initialization, set the max rooting depth index to the maximum decomposition level bc_in%max_rooting_depth_index_col = bc_in%nlevdecomp + else + + ! Set the max rooting depth index to either to the soil depth or the max thaw depth last year, whichever is shallower bc_in%max_rooting_depth_index_col = min(bc_in%nlevsoil, bc_in%max_thaw_depth_index) + end if end do From 18e21d2679554c19fc362067546b881dcd5e6edc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 22:45:48 -0700 Subject: [PATCH 251/331] removing decomp_id and max rooting depth as registered interface variables These are calculated within fates --- main/FatesInterfaceParametersMod.F90 | 2 -- main/FatesInterfaceTypesMod.F90 | 1 - 2 files changed, 3 deletions(-) diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index 38936e8c06..333fd66b1a 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -7,8 +7,6 @@ module FatesInterfaceParametersMod character(len=*), parameter, public :: hlm_fates_decomp= 'decomp_layers' character(len=*), parameter, public :: hlm_fates_decomp_max = 'max_decomp_layers' character(len=*), parameter, public :: hlm_fates_decomp_thickness= 'decomp_thickness' - character(len=*), parameter, public :: hlm_fates_decomp_id = 'decomp_id' - character(len=*), parameter, public :: hlm_fates_rooting_max_depth = 'rooting_max_depth' character(len=*), parameter, public :: hlm_fates_thaw_max_depth_index = 'prioryear_thaw_max_depth_index' character(len=*), parameter, public :: hlm_fates_soil_level = 'soil_level_number' character(len=*), parameter, public :: hlm_fates_decomp_frac_moisture = 'decomp_frac_moisture' diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index c16897d198..96698a62d2 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1084,7 +1084,6 @@ subroutine DefineInterfaceRegistry(this, initialize) call this%DefineInterfaceVariable(key=hlm_fates_decomp_max, initialize=initialize, index=index, & update_frequency=registry_update_init) - call this%DefineInterfaceVariable(key=hlm_fates_rooting_max_depth, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_id, initialize=initialize, index=index) From 03bb72d19b2a0d00c856afc8ed1632c69909a998 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 22:53:01 -0700 Subject: [PATCH 252/331] whitespace --- main/EDTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 4ceb6e0fe6..5a61bd7146 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -645,6 +645,7 @@ subroutine AllocateRegistryIndexArray(this, patches_per_site) end subroutine AllocateRegistryIndexArray ! ============================================================================ + integer function GetRegistryIndex(this, ifp) result(ridx) ! Arguments From 070ff130053da96e01629f7455bead49a8f800ed Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 22:55:25 -0700 Subject: [PATCH 253/331] add init update frequency to soil level, decomp variables --- main/FatesInterfaceTypesMod.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 96698a62d2..109e3c2000 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1083,10 +1083,12 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Variables that only need to be updated during initialization, such as dimensions call this%DefineInterfaceVariable(key=hlm_fates_decomp_max, initialize=initialize, index=index, & update_frequency=registry_update_init) - - call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index) - call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index) - call this%DefineInterfaceVariable(key=hlm_fates_decomp_id, initialize=initialize, index=index) + call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index, & + update_frequency=registry_update_init) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index, & + update_frequency=registry_update_init) + call this%DefineInterfaceVariable(key=hlm_fates_decomp_id, initialize=initialize, index=index, & + update_frequency=registry_update_init) ! Variables that need to be updated daily call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index=index) From 0c1e317e9790502151b02842886b642649380d14 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 22:55:47 -0700 Subject: [PATCH 254/331] remove decomp id and add decomp --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 109e3c2000..a0baf1ca13 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1087,7 +1087,7 @@ subroutine DefineInterfaceRegistry(this, initialize) update_frequency=registry_update_init) call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index, & update_frequency=registry_update_init) - call this%DefineInterfaceVariable(key=hlm_fates_decomp_id, initialize=initialize, index=index, & + call this%DefineInterfaceVariable(key=hlm_fates_decomp, initialize=initialize, index=index, & update_frequency=registry_update_init) ! Variables that need to be updated daily From e29f95d27b5102ae2569144c0f8186dd4af3b3cd Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 19 Oct 2025 22:56:11 -0700 Subject: [PATCH 255/331] reorder definition calls --- main/FatesInterfaceTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index a0baf1ca13..fea4f21f1f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1083,12 +1083,12 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Variables that only need to be updated during initialization, such as dimensions call this%DefineInterfaceVariable(key=hlm_fates_decomp_max, initialize=initialize, index=index, & update_frequency=registry_update_init) + call this%DefineInterfaceVariable(key=hlm_fates_decomp, initialize=initialize, index=index, & + update_frequency=registry_update_init) call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index, & update_frequency=registry_update_init) call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index, & update_frequency=registry_update_init) - call this%DefineInterfaceVariable(key=hlm_fates_decomp, initialize=initialize, index=index, & - update_frequency=registry_update_init) ! Variables that need to be updated daily call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index=index) From dccda5de107fe621197df694aafdbdf9f1aec0f5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 20 Oct 2025 22:56:22 -0700 Subject: [PATCH 256/331] add rank write statment to comparison procedure --- main/FatesInterfaceVarTypeMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index f662686e47..2920284f95 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -292,6 +292,8 @@ subroutine CompareRegistryVariableSizes(this, var) write(fates_log(),*) ' Source, size: ', var%key, var%data_size(1), var%data_size(2), var%data_size(3) else write(fates_log(),*) ' Unsupported interface variable rank in UpdateErrorMessage' + write(fates_log(),*) ' Target key, rank: ', this%key, this%data_rank + write(fates_log(),*) ' Source key, rank: ', var%key, var%data_rank end if call endrun(msg=errMsg(__FILE__, __LINE__)) From f5697c816ff4bdd392d5f3aabe6edddc655c4379 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 20 Oct 2025 22:57:11 -0700 Subject: [PATCH 257/331] remove defunct bc init call --- main/FatesInterfaceMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index e3bc745ee9..fa778711ef 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2857,7 +2857,6 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%InitializeInterfaceVariables() ! Initialize the currently registered boundary conditions - ! call this%sites(s)%InitializeBoundaryConditions(ifp) call bc_in%Initialize() call bc_out%Initialize(bc_in) From d07ec469766e02fd58d55eb30451678e81502f58 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 20 Oct 2025 22:57:59 -0700 Subject: [PATCH 258/331] add max thaw depth interface definition --- main/FatesInterfaceTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index fea4f21f1f..7ff49f29ca 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1093,6 +1093,7 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Variables that need to be updated daily call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_moisture, initialize=initialize, index=index) call this%DefineInterfaceVariable(key=hlm_fates_decomp_frac_temperature, initialize=initialize, index=index) + call this%DefineInterfaceVariable(key=hlm_fates_thaw_max_depth_index, initialize=initialize, index=index) ! Variables that need to be updated with each timestep call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_cellulose, initialize=initialize, index=index, & From 6ebdb1dcf6b1871291fdaab9b9cae5a4fa0d91fc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 20 Oct 2025 22:58:54 -0700 Subject: [PATCH 259/331] add interface variable dimension initialization procedure and supporting filters and counters --- main/FatesInterfaceMod.F90 | 4 +- main/FatesInterfaceParametersMod.F90 | 1 + main/FatesInterfaceTypesMod.F90 | 59 ++++++++++++++++++++++++---- 3 files changed, 54 insertions(+), 10 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index fa778711ef..15651a993e 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2853,8 +2853,8 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_decomp, data=bc_in%nlevdecomp, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_soil_level, data=bc_in%nlevsoil, hlm_flag=.false.) - ! Initialize the interface variables necessary for allocating boundary conditions - call this%registry(r)%InitializeInterfaceVariables() + ! Initialize the interface variables necessary for allocating boundary conditions dimensions + call this%registry(r)%InitializeInterfaceVariablesDimensions() ! Initialize the currently registered boundary conditions call bc_in%Initialize() diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index 333fd66b1a..c77e83a0ec 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -25,6 +25,7 @@ module FatesInterfaceParametersMod character(len=*), parameter, public :: hlm_fates_litter_nitrogen_total= 'litter_nitrogen_total' ! Registry update frequency parameters + integer, parameter, public :: registry_update_init_dims = 0 ! variable dimension that needs to be updated during initialization integer, parameter, public :: registry_update_init = 1 ! variable only needs to be updated during initialization integer, parameter, public :: registry_update_daily = 2 ! variable needs to be updated daily integer, parameter, public :: registry_update_timestep = 3 ! variable needs to be updated at each timestep diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 7ff49f29ca..9d33a5034a 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -883,7 +883,8 @@ module FatesInterfaceTypesMod character(len=48), allocatable, private :: key(:) ! Variable regsitry metadata - integer :: num_api_vars ! number of variables in the registry + integer :: num_api_vars ! number of variables in the registry + integer :: num_api_vars_update_init_dims ! number of variables dimensions needed during initialization integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily integer :: num_api_vars_update_timestep ! number of variables that update on the model timestep @@ -893,6 +894,7 @@ module FatesInterfaceTypesMod integer, allocatable :: update_frequency(:) ! Arrays that hold the registry indices of variables based on update frequency + integer, allocatable :: filter_init_dims(:) ! registry index of variables dimensions that update at initialization integer, allocatable :: filter_init(:) ! registry index of variables that update only at initialization integer, allocatable :: filter_daily(:) ! registry index of variables that update daily integer, allocatable :: filter_timestep(:) ! registry index of variables that update at each timestep @@ -918,6 +920,7 @@ module FatesInterfaceTypesMod procedure :: GetHLMPatchIndex procedure :: GetFatesPatchIndex procedure :: InitializeInterfaceRegistry + procedure :: InitializeInterfaceVariablesDimensions procedure :: InitializeInterfaceVariables procedure :: SetSubgridIndices procedure :: UpdateLitterFluxes @@ -1026,6 +1029,7 @@ subroutine InitializeInterfaceRegistry(this) ! Initialize registry counters this%num_api_vars = 0 + this%num_api_vars_update_init_dims = 0 this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 this%num_api_vars_update_timestep = 0 @@ -1041,6 +1045,7 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%update_frequency(this%num_api_vars)) ! Allocate the index filter maps + allocate(this%filter_init_dims(this%num_api_vars_update_init_dims)) allocate(this%filter_init(this%num_api_vars_update_init)) allocate(this%filter_daily(this%num_api_vars_update_daily)) allocate(this%filter_timestep(this%num_api_vars_update_timestep)) @@ -1050,6 +1055,7 @@ subroutine InitializeInterfaceRegistry(this) ! Unset the allocatables not including the interface variables this%update_frequency(:) = fates_unset_int + this%filter_init_dims(:) = fates_unset_int this%filter_init(:) = fates_unset_int this%filter_daily(:) = fates_unset_int this%filter_timestep(:) = fates_unset_int @@ -1080,13 +1086,16 @@ subroutine DefineInterfaceRegistry(this, initialize) index = 0 ! Define the interface registry names and indices - ! Variables that only need to be updated during initialization, such as dimensions + ! Variables that need to be updated during initialization and are necessary for other boundary conditions + ! such as dimensions call this%DefineInterfaceVariable(key=hlm_fates_decomp_max, initialize=initialize, index=index, & - update_frequency=registry_update_init) + update_frequency=registry_update_init_dims) call this%DefineInterfaceVariable(key=hlm_fates_decomp, initialize=initialize, index=index, & - update_frequency=registry_update_init) + update_frequency=registry_update_init_dims) call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index, & - update_frequency=registry_update_init) + update_frequency=registry_update_init_dims) + + ! Variables that only need to be updated at initialization call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index, & update_frequency=registry_update_init) @@ -1153,6 +1162,8 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc ! Initialize the variable if (present(update_frequency)) then select case (update_frequency) + case (registry_update_init_dims) + update_frequency_local = registry_update_init_dims case (registry_update_init) update_frequency_local = registry_update_init case (registry_update_daily) @@ -1187,6 +1198,8 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc ! Increment the count for the update frequency counts, defaulting to daily if not specified if (present(update_frequency)) then select case (update_frequency) + case (registry_update_init_dims) + this%num_api_vars_update_init_dims = this%num_api_vars_update_init_dims + 1 case (registry_update_init) this%num_api_vars_update_init = this%num_api_vars_update_init + 1 case (registry_update_daily) @@ -1303,12 +1316,14 @@ subroutine SetFilterMapArrays(this) class(fates_interface_registry_type), intent(inout) :: this integer :: index + integer :: count_init_dims integer :: count_init integer :: count_daily integer :: count_timestep integer :: count_litter_flux ! Initialize counters + count_init_dims = 0 count_init = 0 count_daily = 0 count_timestep = 0 @@ -1318,7 +1333,10 @@ subroutine SetFilterMapArrays(this) do index = 1, this%num_api_vars ! Frequency update - if (this%update_frequency(index) == registry_update_init) then + if (this%update_frequency(index) == registry_update_init_dims) then + count_init_dims = count_init_dims + 1 + this%filter_init_dims(count_init_dims) = index + else if (this%update_frequency(index) == registry_update_init) then count_init = count_init + 1 this%filter_init(count_init) = index else if (this%update_frequency(index) == registry_update_daily) then @@ -1350,7 +1368,8 @@ subroutine SetFilterMapArrays(this) end do ! Check that the counts match the expected sizes - if (count_init /= this%num_api_vars_update_init .or. & + if (count_init_dims /= this%num_api_vars_update_init_dims .or. & + count_init /= this%num_api_vars_update_init .or. & count_daily /= this%num_api_vars_update_daily .or. & count_timestep /= this%num_api_vars_update_timestep) then @@ -1464,6 +1483,30 @@ end subroutine RegisterInterfaceVariables_2d ! ====================================================================================== + subroutine InitializeInterfaceVariablesDimensions(this) + + ! Arguments + class(fates_interface_registry_type), intent(inout) :: this ! registry being initialized + + ! Locals + integer :: i ! initialization iterator + integer :: j ! variable index + + ! Update the boundary conditions necessary during initialization only + do i = 1, this%num_api_vars_update_init_dims + + ! Get the variable index from the init filter + j = this%filter_init_dims(i) + + ! Update the variables + call this%fates_vars(j)%Update(this%hlm_vars(j)) + + end do + + end subroutine InitializeInterfaceVariablesDimensions + + ! ====================================================================================== + subroutine InitializeInterfaceVariables(this) ! Arguments @@ -1484,7 +1527,7 @@ subroutine InitializeInterfaceVariables(this) end do - end subroutine + end subroutine InitializeInterfaceVariables ! ====================================================================================== From 4907c1b6ecb7c4a8918b098f3de981236b7555ad Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 21 Oct 2025 23:08:41 -0700 Subject: [PATCH 260/331] correct initialization_local usage --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 15651a993e..9072fa9259 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2944,7 +2944,7 @@ subroutine UpdateInterfaceVariables(this, initialize) bc_in => this%sites(s)%bc_in(ifp) ! Calculate various bc_in variables that are based on other variables or namelist states - if (initialize) then + if (initialize_local) then ! Check vertical soil carbon decomposition usage if (hlm_use_vertsoilc == itrue) then From 536dfe344e5f09b8ea49646391fdffc5cef4bdf5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 23 Oct 2025 21:55:55 -0700 Subject: [PATCH 261/331] set default value for update interface variable optional argument --- main/FatesInterfaceMod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 9072fa9259..a14eb7061a 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2926,10 +2926,9 @@ subroutine UpdateInterfaceVariables(this, initialize) integer :: i ! layer index ! Set the default initialize flag to false + initialize_local = .false. if (present(initialize)) then initialize_local = initialize - else - initialize_local = .false. end if do r = 1, this%npatches From 8c1f4b848f79feb3c3e16d891446426337d896a3 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 10:03:18 -0700 Subject: [PATCH 262/331] unset scalar bc variables during initialization --- main/FatesInterfaceTypesMod.F90 | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 9d33a5034a..f188239cef 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -968,16 +968,16 @@ subroutine InitializeBCIn(this) ! Allocate boundary condition arrays allocate(this%decomp_id(this%nlevsoil)) - this%decomp_id = fates_unset_int - allocate(this%dz_decomp_sisl(this%nlevdecomp_full)) - this%dz_decomp_sisl = nan - allocate(this%w_scalar_sisl(this%nlevdecomp_full)) allocate(this%t_scalar_sisl(this%nlevdecomp_full)) + + ! Unset variables + this%decomp_id = fates_unset_int + this%dz_decomp_sisl = nan this%w_scalar_sisl = nan this%t_scalar_sisl = nan - + this%max_thaw_depth_index = fates_unset_int end subroutine InitializeBCIn @@ -994,10 +994,11 @@ subroutine InitializeBCOut(this, bc_in) allocate(this%litt_flux_lig_c_si(bc_in%nlevdecomp_full)) allocate(this%litt_flux_lab_c_si(bc_in%nlevdecomp_full)) - ! Nan the arrays + ! Unset the arrays this%litt_flux_cel_c_si = nan this%litt_flux_lig_c_si = nan this%litt_flux_lab_c_si = nan + this%litt_flux_all_c = nan if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then allocate(this%litt_flux_cel_n_si(bc_in%nlevdecomp_full)) @@ -1010,9 +1011,11 @@ subroutine InitializeBCOut(this, bc_in) this%litt_flux_cel_n_si = nan this%litt_flux_lig_n_si = nan this%litt_flux_lab_n_si = nan + this%litt_flux_all_n = nan this%litt_flux_cel_p_si = nan this%litt_flux_lig_p_si = nan this%litt_flux_lab_p_si = nan + this%litt_flux_all_p = nan end if end subroutine InitializeBCOut From 79e324cb81694f8752dc649638adead1f3e2baa9 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 10:03:32 -0700 Subject: [PATCH 263/331] white space fix --- main/FatesInterfaceMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a14eb7061a..24c70a9be6 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2878,7 +2878,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_litter_carbon_lignin, & data=bc_out%litt_flux_lig_c_si, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, & - data=bc_out %litt_flux_lab_c_si, hlm_flag=.false.) + data=bc_out%litt_flux_lab_c_si, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, & data=bc_out%litt_flux_all_c, hlm_flag=.false.) @@ -2888,7 +2888,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_lignin, & data=bc_out%litt_flux_lig_p_si, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_labile, & - data=bc_out %litt_flux_lab_p_si, hlm_flag=.false.) + data=bc_out%litt_flux_lab_p_si, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_total, & data=bc_out%litt_flux_all_p, hlm_flag=.false.) @@ -2897,7 +2897,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_lignin, & data=bc_out%litt_flux_lig_n_si, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_labile, & - data=bc_out %litt_flux_lab_n_si, hlm_flag=.false.) + data=bc_out%litt_flux_lab_n_si, hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_total, & data=bc_out%litt_flux_all_n, hlm_flag=.false.) end if From b87e1a7afd705a5e1d9851ae9e1a32f65d9fdce0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 15:50:35 -0700 Subject: [PATCH 264/331] add checkbounds to interface var type --- main/FatesInterfaceVarTypeMod.F90 | 45 +++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 2920284f95..7399332b04 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -33,6 +33,7 @@ module FatesInterfaceVariableTypeMod integer, allocatable :: data_size(:) ! size of the first dimension of the variable contains + procedure :: CheckBounds procedure :: Initialize => InitializeInterfaceVariable procedure :: Update => UpdateInterfaceVariable @@ -49,6 +50,50 @@ module FatesInterfaceVariableTypeMod contains + ! ==================================================================================== + + subroutine CheckBounds(this, var) + + class(fates_interface_variable_type), intent(in) :: this + class(fates_interface_variable_type), intent(in) :: var + + ! Locals + integer :: ub1, ub2 + integer :: lb1, lb2 + logical :: bounds_mismatch + + bounds_mismatch = .false. + + if (this%data_rank >= 1) then + ub1 = ubound(this%data1d, dim=1) + lb1 = lbound(this%data1d, dim=1) + ub2 = ubound(var%data1d, dim=1) + lb2 = lbound(var%data1d, dim=1) + if (ub1 /= ub2 .or. lb1 /= lb2) then + write(fates_log,*) 'Dimension 1 bounds mismatch for variable: ', this%key, + write(fates_log,*) 'Upper bounds: ', ub1, ', ', ub2 + write(fates_log,*) 'Lower bounds: ', lb1, ', ', lb2 + bounds_mismatch = .true. + end if + else if (this%data_rank >= 2) then + ub1 = ubound(this%data2d, dim=2) + lb1 = lbound(this%data2d, dim=2) + ub2 = ubound(var%data2d, dim=2) + lb2 = lbound(var%data2d, dim=2) + if (ub1 /= ub2 .or. lb1 /= lb2) then + write(fates_log,*) 'Dimension 2 bounds mismatch for variable: ', this%key, + write(fates_log,*) 'Upper bounds: ', ub1, ', ', ub2 + write(fates_log,*) 'Lower bounds: ', lb1, ', ', lb2 + bounds_mismatch = .true. + end if + end if + + if (bounds_mismatch) then + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine CheckBounds + ! ==================================================================================== subroutine InitializeInterfaceVariable(this, key, update_frequency) From 45b9d2376f1272e5b48610ad268beb0b251e62a0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 15:51:01 -0700 Subject: [PATCH 265/331] call check bounds --- main/FatesInterfaceTypesMod.F90 | 41 +++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index f188239cef..c7ca34a7ad 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -913,6 +913,7 @@ module FatesInterfaceTypesMod contains + procedure :: CheckInterfaceVariables procedure :: GetGridcellIndex procedure :: GetLandunitIndex procedure :: GetColumnIndex @@ -1072,6 +1073,46 @@ subroutine InitializeInterfaceRegistry(this) end subroutine InitializeInterfaceRegistry + ! ====================================================================================== + + subroutine CheckInterfaceVariables(this) + + ! This procedure checks the registered HLM and FATES interface variables for consistency + + class(fates_interface_registry_type), intent(inout) :: this + + integer :: i + + do i = 1, this%num_api_vars + + + ! Check that variable keys match + if (this%hlm_vars(i)%key /= this%fates_vars(i)%key) then + write(*,*) "Key mismatch for variable: ", this%key(i), this%hlm_vars(i)%key, this%fates_vars(i)%key + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Check that the rank matches + if (this%hlm_vars(i)%rank /= this%fates_vars(i)%rank) then + write(*,*) "Rank mismatch for variable: ", this%key(i) + end if + + ! Check that the bounds match + call this%hlm_vars(i)%CheckBounds(this%fates_vars(i)) + + ! Check that the size of the interface variables match + if (this%hlm_vars(i)%rank > 0) then + if (any(this%hlm_vars(i)%data_size(:) /= this%fates_vars(i)%data_size(:))) then + write(*,*) "Size mismatch: key, hlm size: ", this%key(i), this%hlm_vars(i)%data_size + write(*,*) "Size mismatch: key, fates size: ", this%key(i), this%fates_vars(i)%data_size + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + end do + + end subroutine CheckInterfaceVariables + ! ====================================================================================== subroutine DefineInterfaceRegistry(this, initialize) From fc2eb6d6aa4c8538114a22d3718795c29c03f197 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 15:51:33 -0700 Subject: [PATCH 266/331] add check interface variables call for all registries after fates registration --- main/FatesInterfaceMod.F90 | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 24c70a9be6..d393513f28 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2903,7 +2903,10 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) end if end do end do - + + ! Check the interface variables for consistency + call this%CheckInterfaceVariables() + end subroutine InitializeBoundaryConditions ! ====================================================================================== @@ -3009,4 +3012,18 @@ end subroutine UpdateLitterFluxes ! ====================================================================================== +subroutine CheckInterfaceVariables(this) + class(fates_interface_type), intent(inout) :: this + + ! Locals + integer :: r + + do r = 1, this%npatches + call this%registry(r)%CheckInterfaceVariables() + end do + +end subroutine CheckInterfaceVariables + +! ====================================================================================== + end module FatesInterfaceMod From 8dafc661163e0c829806b953a84f8fd028c734ad Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 16:08:36 -0700 Subject: [PATCH 267/331] add check interface variables type bound wrapper to interface type --- main/FatesInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index d393513f28..3211f93bc4 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -168,6 +168,7 @@ module FatesInterfaceMod contains + procedure :: CheckInterfaceVariables procedure, public :: InitializeInterfaceRegistry procedure, public :: InitializeFatesSites procedure, public :: InitializeBoundaryConditions From e5231bd76a08880f618a73ad8f05cc50d0ed2c46 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 16:09:02 -0700 Subject: [PATCH 268/331] correct rank check --- main/FatesInterfaceTypesMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index c7ca34a7ad..e0b2fc41ba 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1093,15 +1093,16 @@ subroutine CheckInterfaceVariables(this) end if ! Check that the rank matches - if (this%hlm_vars(i)%rank /= this%fates_vars(i)%rank) then + if (this%hlm_vars(i)%data_rank /= this%fates_vars(i)%data_rank) then write(*,*) "Rank mismatch for variable: ", this%key(i) + call endrun(msg=errMsg(__FILE__, __LINE__)) end if ! Check that the bounds match call this%hlm_vars(i)%CheckBounds(this%fates_vars(i)) ! Check that the size of the interface variables match - if (this%hlm_vars(i)%rank > 0) then + if (this%hlm_vars(i)%data_rank > 0) then if (any(this%hlm_vars(i)%data_size(:) /= this%fates_vars(i)%data_size(:))) then write(*,*) "Size mismatch: key, hlm size: ", this%key(i), this%hlm_vars(i)%data_size write(*,*) "Size mismatch: key, fates size: ", this%key(i), this%fates_vars(i)%data_size From cb06f419d5f6d76d1f9744dfe00a8708e14b7cb6 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 24 Oct 2025 16:09:26 -0700 Subject: [PATCH 269/331] fix write statements --- main/FatesInterfaceVarTypeMod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 7399332b04..c8cabbffeb 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -70,9 +70,9 @@ subroutine CheckBounds(this, var) ub2 = ubound(var%data1d, dim=1) lb2 = lbound(var%data1d, dim=1) if (ub1 /= ub2 .or. lb1 /= lb2) then - write(fates_log,*) 'Dimension 1 bounds mismatch for variable: ', this%key, - write(fates_log,*) 'Upper bounds: ', ub1, ', ', ub2 - write(fates_log,*) 'Lower bounds: ', lb1, ', ', lb2 + write(fates_log(),*) 'Dimension 1 bounds mismatch for variable: ', this%key + write(fates_log(),*) 'Upper bounds: ', ub1, ', ', ub2 + write(fates_log(),*) 'Lower bounds: ', lb1, ', ', lb2 bounds_mismatch = .true. end if else if (this%data_rank >= 2) then @@ -81,9 +81,9 @@ subroutine CheckBounds(this, var) ub2 = ubound(var%data2d, dim=2) lb2 = lbound(var%data2d, dim=2) if (ub1 /= ub2 .or. lb1 /= lb2) then - write(fates_log,*) 'Dimension 2 bounds mismatch for variable: ', this%key, - write(fates_log,*) 'Upper bounds: ', ub1, ', ', ub2 - write(fates_log,*) 'Lower bounds: ', lb1, ', ', lb2 + write(fates_log(),*) 'Dimension 2 bounds mismatch for variable: ', this%key + write(fates_log(),*) 'Upper bounds: ', ub1, ', ', ub2 + write(fates_log(),*) 'Lower bounds: ', lb1, ', ', lb2 bounds_mismatch = .true. end if end if From 922e109c0b893c2cf21f01b9e844389e89b756b3 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 26 Oct 2025 23:16:56 -0700 Subject: [PATCH 270/331] add dump procedure for diagnostics --- main/FatesInterfaceVarTypeMod.F90 | 53 ++++++++++++++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index c8cabbffeb..95b4bf932e 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -96,7 +96,58 @@ end subroutine CheckBounds ! ==================================================================================== - subroutine InitializeInterfaceVariable(this, key, update_frequency) + subroutine Dump(this) + + class(fates_interface_variable_type), intent(in) :: this + + write(fates_log(),*) 'FATES Interface Variable Dump:' + write(fates_log(),*) ' Key: ', this%key + write(fates_log(),*) ' Active: ', this%active + write(fates_log(),*) ' Accumulate: ', this%accumulate + write(fates_log(),*) ' Data Rank: ', this%data_rank + write(fates_log(),*) ' Data Size: ', this%data_size + + select case (this%data_rank) + case(0) + select type(var => this%data0d) + type is (real(r8)) + write(fates_log(),*) ' Data (real): ', var + type is (integer) + write(fates_log(),*) ' Data (integer): ', var + class default + write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + case(1) + select type(var => this%data1d) + type is (real(r8)) + write(fates_log(),*) ' Data (real): ', var + type is (integer) + write(fates_log(),*) ' Data (integer): ', var + class default + write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + case(2) + select type(var => this%data2d) + type is (real(r8)) + write(fates_log(),*) ' Data (real): ', var + type is (integer) + write(fates_log(),*) ' Data (integer): ', var + class default + write(fates_log(),*), 'FATES ERROR: Unsupported interface variable type' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + case default + write(fates_log(),*) 'FATES ERROR: Unsupported interface variable rank in Dump' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + end subroutine Dump + + ! ==================================================================================== + + subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) class(fates_interface_variable_type), intent(inout) :: this character(len=*), intent(in) :: key From 61de0719e55a9a85dfd540cf4062573e497be0a8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 26 Oct 2025 23:22:03 -0700 Subject: [PATCH 271/331] add boundary condition filter to registry --- main/FatesInterfaceParametersMod.F90 | 4 ++ main/FatesInterfaceTypesMod.F90 | 99 ++++++++++++++++++++++------ main/FatesInterfaceVarTypeMod.F90 | 4 +- 3 files changed, 87 insertions(+), 20 deletions(-) diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index c77e83a0ec..886803f2d7 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -29,5 +29,9 @@ module FatesInterfaceParametersMod integer, parameter, public :: registry_update_init = 1 ! variable only needs to be updated during initialization integer, parameter, public :: registry_update_daily = 2 ! variable needs to be updated daily integer, parameter, public :: registry_update_timestep = 3 ! variable needs to be updated at each timestep + + ! Registry boundary condition parameters + integer, parameter, public :: registry_bc_in = 0 + integer, parameter, public :: registry_bc_out = 1 end module FatesInterfaceParametersMod \ No newline at end of file diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index e0b2fc41ba..d8cbe6cfe8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -888,11 +888,16 @@ module FatesInterfaceTypesMod integer :: num_api_vars_update_init ! number of variables that update only at initialization integer :: num_api_vars_update_daily ! number of variables that update daily integer :: num_api_vars_update_timestep ! number of variables that update on the model timestep + integer :: num_api_vars_bc_in ! number of variables that are bc_in associated + integer :: num_api_vars_bc_out ! number of variables that are bc_ associated integer :: num_api_vars_litter_flux ! number of variables that deal with all litter fluxes ! Array of update frequency values for each regsitry index integer, allocatable :: update_frequency(:) + ! Array of boundary condition directions for each registry index + integer, allocatable :: bc_dir(:) + ! Arrays that hold the registry indices of variables based on update frequency integer, allocatable :: filter_init_dims(:) ! registry index of variables dimensions that update at initialization integer, allocatable :: filter_init(:) ! registry index of variables that update only at initialization @@ -902,6 +907,10 @@ module FatesInterfaceTypesMod ! Filter arrays that hold the registry indices for litter fluxes integer, allocatable :: filter_litter_flux(:) + ! Index arrays that map to the boundary condition types + integer, allocatable :: filter_bc_in(:) + integer, allocatable :: filter_bc_out(:) + ! Subgrid index data integer, private :: gidx integer, private :: tidx @@ -1037,6 +1046,8 @@ subroutine InitializeInterfaceRegistry(this) this%num_api_vars_update_init = 0 this%num_api_vars_update_daily = 0 this%num_api_vars_update_timestep = 0 + this%num_api_vars_bc_in = 0 + this%num_api_vars_bc_out = 0 this%num_api_vars_litter_flux = 0 ! First count up the keys defined in the registry and the registry counters @@ -1047,18 +1058,24 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%hlm_vars(this%num_api_vars)) allocate(this%key(this%num_api_vars)) allocate(this%update_frequency(this%num_api_vars)) + allocate(this%bc_dir(this%num_api_vars)) ! Allocate the index filter maps allocate(this%filter_init_dims(this%num_api_vars_update_init_dims)) allocate(this%filter_init(this%num_api_vars_update_init)) allocate(this%filter_daily(this%num_api_vars_update_daily)) allocate(this%filter_timestep(this%num_api_vars_update_timestep)) + + ! Allocate the boundary condition filter maps + allocate(this%filter_bc_in(this%num_api_vars_bc_in)) + allocate(this%filter_bc_out(this%num_api_vars_bc_out)) ! Allocate the litter flux filter allocate(this%filter_litter_flux(this%num_api_vars_litter_flux)) ! Unset the allocatables not including the interface variables this%update_frequency(:) = fates_unset_int + this%bc_dir(:) = fates_unset_int this%filter_init_dims(:) = fates_unset_int this%filter_init(:) = fates_unset_int this%filter_daily(:) = fates_unset_int @@ -1130,6 +1147,8 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Initialize the index index = 0 + associate(bc_in => registry_bc_in + bc_out => registry_bc_out) ! Define the interface registry names and indices ! Variables that need to be updated during initialization and are necessary for other boundary conditions ! such as dimensions @@ -1138,7 +1157,7 @@ subroutine DefineInterfaceRegistry(this, initialize) call this%DefineInterfaceVariable(key=hlm_fates_decomp, initialize=initialize, index=index, & update_frequency=registry_update_init_dims) call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index, & - update_frequency=registry_update_init_dims) + update_frequency=registry_update_init_dims, tofates) ! Variables that only need to be updated at initialization call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index, & @@ -1151,41 +1170,43 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Variables that need to be updated with each timestep call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_cellulose, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_lignin, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_labile, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_carbon_total, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) ! Define the N and P litter fluxes if in CNP mode ! We could define the interface variables always, even if not registered, but this helps reduce the memory needs if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_cellulose, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_lignin, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_labile, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_phosphorus_total, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_cellulose, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_lignin, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_labile, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) call this%DefineInterfaceVariable(key=hlm_fates_litter_nitrogen_total, initialize=initialize, index=index, & - update_frequency=registry_update_timestep) + update_frequency=registry_update_timestep, bc_dir=bc_out) end if + end associate + end subroutine DefineInterfaceRegistry ! ====================================================================================== - subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequency) + subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequency, bc_dir) class(fates_interface_registry_type), intent(inout) :: this @@ -1193,10 +1214,12 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc logical, intent(in) :: initialize integer, intent(inout) :: index integer, intent(in), optional :: update_frequency + integer, intent(in), optional :: bc_dir ! 0 = bc_in, 1 = bc_out, ! Local variables integer :: index_type integer :: update_frequency_local + integer :: bc_dir_local ! Increment the index index = index + 1 @@ -1229,10 +1252,17 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc ! Set the update frequency array values this%update_frequency(index) = update_frequency_local + + ! Set the boundary condition directionality for the variable index defaulting to bc_in + bc_dir_local = registry_bc_in + if (present(bc_dir)) then + bc_dir_local = bc_dir + end if + this%bc_dir(index) = bc_dir_local ! Initialize the interface variables and pass the key and update frequency to each for metadata - call this%hlm_vars(index)%Initialize(key, update_frequency_local) - call this%fates_vars(index)%Initialize(key, update_frequency_local) + call this%hlm_vars(index)%Initialize(key, update_frequency_local, bc_dir_local) + call this%fates_vars(index)%Initialize(key, update_frequency_local, bc_dir_local) ! Not initializing, just counting the variables else @@ -1259,6 +1289,22 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc ! Default to daily update frequency this%num_api_vars_update_daily = this%num_api_vars_update_daily + 1 end if + + ! Increment the count for the boundary condition counters + if (present(bc_dir)) then + select case (bc_dir) + case (registry_bc_in) + this%num_api_vars_bc_in + this%num_api_vars_bc_in + 1 + case (registry_bc_out) + this%num_api_vars_bc_out + this%num_api_vars_bc_out + 1 + case default + write(fates_log(), *) 'ERROR: Unrecognized bc_dir in DefineInterfaceVariable(): ', bc_dir + end select + else + ! defaults to bc_in + this%num_api_vars_bc_in + this%num_api_vars_bc_in + 1 + end if + ! Update the litter flux counters not including the total flux counter if (key == hlm_fates_litter_carbon_cellulose .or. & @@ -1365,6 +1411,8 @@ subroutine SetFilterMapArrays(this) integer :: count_init integer :: count_daily integer :: count_timestep + integer :: count_bc_in + integer :: count_bc_out integer :: count_litter_flux ! Initialize counters @@ -1372,6 +1420,8 @@ subroutine SetFilterMapArrays(this) count_init = 0 count_daily = 0 count_timestep = 0 + count_bc_in = 0 + count_bc_out = 0 count_litter_flux= 0 ! Iterate over all registered variables and populate the filter maps accordingly @@ -1394,6 +1444,15 @@ subroutine SetFilterMapArrays(this) write(fates_log(),*) 'ERROR: Unrecognized update frequency in SetFilterMapArrays(): ', this%update_frequency(index) call endrun(msg=errMsg(__FILE__, __LINE__)) end if + + ! Boundary condition filter update + if (this%bc_dir(index) == registry_bc_in) then + count_bc_in = count_bc_in + 1 + this%filter_bc_in(count_bc_in) = index + else if (this%bc_dir(index) == registry_bc_out) then + count_bc_out = count_bc_out + 1 + this%filter_bc_out(count_bc_out) = index + end if ! Litter flux update if (this%key(index) == hlm_fates_litter_carbon_cellulose .or. & @@ -1580,11 +1639,13 @@ subroutine UpdateInterfaceVariables(this) class(fates_interface_registry_type), intent(inout) :: this - integer :: i + integer :: n + integer :: ibc ! Iterate over all registered variables - do i = 1, this%num_api_vars - call this%fates_vars(i)%Update(this%hlm_vars(i)) + do n = 1, this%num_api_vars_bc_in + ibc = this%filter_bc_in(n) + call this%fates_vars(ibc)%Update(this%hlm_vars(ibc)) end do end subroutine UpdateInterfaceVariables diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 95b4bf932e..6e7134e39a 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -152,6 +152,7 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) class(fates_interface_variable_type), intent(inout) :: this character(len=*), intent(in) :: key integer, intent(in) :: update_frequency + integet, intent(in) :: bc_dir allocate(this%data_size(3)) @@ -166,9 +167,10 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) this%active = .false. this%accumulate = .false. - ! Initialize registry variable components that are updated at initialization + ! Initialize registry variable components that are updated at variable definition this%key = key this%update_frequency = update_frequency + this%bc_dir = bc_dir end subroutine InitializeInterfaceVariable From 7998d432072683b8e33250ebf3cc1189ee0c2e51 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 26 Oct 2025 23:22:41 -0700 Subject: [PATCH 272/331] add bc_dir to interface variable metadata --- main/FatesInterfaceVarTypeMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 6e7134e39a..b474aa6dc4 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -27,7 +27,7 @@ module FatesInterfaceVariableTypeMod class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer logical :: active ! true if the variable is used by the host land model logical :: accumulate ! If true, this variable should add the source to the target - integer :: subgrid ! subgrid level (0 = gridcell, 1 = landunit, 2 = column, 3 = patch) + integer :: bc_dir ! 0 if bc_in, 1 if bc_out integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: update_frequency ! frequency of updates integer, allocatable :: data_size(:) ! size of the first dimension of the variable From 04c4fc759bab7695bbfa51a7caa679bdaa212694 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 26 Oct 2025 23:22:54 -0700 Subject: [PATCH 273/331] add dump procedure statement --- main/FatesInterfaceVarTypeMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index b474aa6dc4..b1c1e3651c 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -36,6 +36,7 @@ module FatesInterfaceVariableTypeMod procedure :: CheckBounds procedure :: Initialize => InitializeInterfaceVariable procedure :: Update => UpdateInterfaceVariable + procedure :: Dump generic :: Register => RegisterInterfaceVariable_0d, & RegisterInterfaceVariable_1d, & From 888e5b68fc1f0cab64178016257a8dedb28fc182 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 26 Oct 2025 23:26:17 -0700 Subject: [PATCH 274/331] add fates patch active status flag for registry --- main/FatesInterfaceMod.F90 | 70 ++++++++++++++++++++++++++++++++- main/FatesInterfaceTypesMod.F90 | 26 ++++++++++++ 2 files changed, 94 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 3211f93bc4..ac8f00d1bc 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -166,12 +166,21 @@ module FatesInterfaceMod ! This is the interface registry which associates variables with a common keyword type(fates_interface_registry_type), allocatable :: registry(:) + ! Index filter array for registries that are active (i.e. has a FATES patch) + integer, allocatable :: filter_registry_active(:) + + ! Active vegetated patches + integer :: num_active_patches + + + contains procedure :: CheckInterfaceVariables procedure, public :: InitializeInterfaceRegistry procedure, public :: InitializeFatesSites procedure, public :: InitializeBoundaryConditions + procedure :: SetRegistryActiveState procedure, public :: UpdateInterfaceVariables procedure, public :: UpdateLitterFluxes @@ -2244,6 +2253,53 @@ end subroutine set_fates_ctrlparms ! ==================================================================================== + subroutine SetRegistryActiveState(this) + + ! Argument + class(fates_interface_type), intent(inout) :: this + + ! Locals + type(fates_patch_type), pointer :: currentPatch + + integer :: s ! site index + integer :: r ! registry index + integer :: i ! filter index + + ! Set all registries to inactive by default + do r = 1, this%npatches + call this%registry(r)%SetActiveState(active_state=.false.) + end do + + ! Set the active registry index filter to unset + this%filter_registry_active = fates_unset_int + + ! Set the active registry counter and filter index iterator to zero + this%num_active_patches = 0 + i = 0 + + ! Loop over sites and patches to set active registries and iterate the counter + do s = 1, this%nsites + currentPatch => this%sites(s)%oldest_patch + do while (associated(currentPatch)) + + ! Get the registry index for the current site + patch combo and set it to active + r = this%sites(s)%GetRegistryIndex(currentPatch%patchno) + call this%registry(r)%SetActiveState(active_state=.true.) + + ! Increment the active patch counter and update the active index filter + this%num_active_patches = this%num_active_patches + 1 + i = i + 1 + this%filter_registry_active(i) = r + + ! Move to the next patch + currentPatch => currentPatch%younger + end do + end do + + end subroutine SetRegistryActiveState + + ! ==================================================================================== + subroutine FatesReportParameters(masterproc) ! ----------------------------------------------------- @@ -2732,6 +2788,9 @@ subroutine InitializeInterfaceRegistry(this, num_veg_patches, patchlist) ! Allocate interface registries for each vegetated patch on the clump allocate(this%registry(num_veg_patches)) + ! Allocate the active registry filter array to the maximum number of possible active patches + allocate(this%filter_registry_active(num_veg_patches)) + ! Set the number of vegetated patches to the interface type level this%npatches = num_veg_patches @@ -3003,9 +3062,16 @@ subroutine UpdateLitterFluxes(this, dtime) real(r8), intent(in) :: dtime ! HLM timestep ! Locals - integer :: r + integer :: n ! active registry index iterator + integer :: r ! registry index + + ! Set the registry active state + call this%SetRegistryActiveState() - do r = 1, this%npatches + ! Loop through the active registries and update the litter fluxes + do n = 1, this%num_active_patches + r = this%filter_registry_active(n) + write(fates_log(),*) 'Updating litter fluxes: r, s, ifp ', r, this%registry(r)%GetSiteIndex(), this%registry(r)%GetFatesPatchIndex() call this%registry(r)%UpdateLitterFluxes(dtime) end do diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d8cbe6cfe8..3ff805194f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -875,6 +875,9 @@ module FatesInterfaceTypesMod ! Base type to be extended for the API registry type, public :: fates_interface_registry_type + ! Is registry have a FATES patch that exists? + logical, private :: active + ! Container array of interface variables indexed by key type(fates_interface_variable_type), allocatable :: hlm_vars(:) type(fates_interface_variable_type), allocatable :: fates_vars(:) @@ -923,6 +926,7 @@ module FatesInterfaceTypesMod contains procedure :: CheckInterfaceVariables + procedure :: GetActivateState procedure :: GetGridcellIndex procedure :: GetLandunitIndex procedure :: GetColumnIndex @@ -933,6 +937,7 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceVariablesDimensions procedure :: InitializeInterfaceVariables procedure :: SetSubgridIndices + procedure :: SetActiveState procedure :: UpdateLitterFluxes procedure :: Update => UpdateInterfaceVariables @@ -1340,6 +1345,27 @@ subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatc end subroutine SetSubgridIndices + ! ====================================================================================== + + subroutine SetActiveState(this, active_state) + + class(fates_interface_registry_type), intent(inout) :: this + logical, intent(in) :: active_state + + this%active = active_state + + end subroutine SetActiveState + + ! ====================================================================================== + + logical function GetActivateState(this) result(active_state) + + class(fates_interface_registry_type), intent(inout) :: this + + active_state = this%active + + end function GetActivateState + ! ====================================================================================== integer function GetGridcellIndex(this) result(gidx) From 99660bbe164baf9523fd3888a4f80f382b5b307e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 26 Oct 2025 23:27:07 -0700 Subject: [PATCH 275/331] move the check status out of the initialization --- main/FatesInterfaceMod.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index ac8f00d1bc..1bea42ab91 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2964,9 +2964,6 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) end do end do - ! Check the interface variables for consistency - call this%CheckInterfaceVariables() - end subroutine InitializeBoundaryConditions ! ====================================================================================== From 218eb042ef6aab4dd3b5f256ca76dcb89d7904a8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 26 Oct 2025 23:27:43 -0700 Subject: [PATCH 276/331] white space --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 1bea42ab91..e48ef63add 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2787,7 +2787,7 @@ subroutine InitializeInterfaceRegistry(this, num_veg_patches, patchlist) ! Allocate interface registries for each vegetated patch on the clump allocate(this%registry(num_veg_patches)) - + ! Allocate the active registry filter array to the maximum number of possible active patches allocate(this%filter_registry_active(num_veg_patches)) From d4bea1569819853f6d3ab69b06b58c66d7e9ae2a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 11:12:29 -0700 Subject: [PATCH 277/331] correct typo in argument definition --- main/FatesInterfaceVarTypeMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index b1c1e3651c..46f84e2ef6 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -153,7 +153,7 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) class(fates_interface_variable_type), intent(inout) :: this character(len=*), intent(in) :: key integer, intent(in) :: update_frequency - integet, intent(in) :: bc_dir + integer, intent(in) :: bc_dir allocate(this%data_size(3)) From d61c091ad137085323cdec438397799a74124854 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 11:13:43 -0700 Subject: [PATCH 278/331] whitespace --- main/FatesInterfaceTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 3ff805194f..6a53d836b7 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1064,7 +1064,7 @@ subroutine InitializeInterfaceRegistry(this) allocate(this%key(this%num_api_vars)) allocate(this%update_frequency(this%num_api_vars)) allocate(this%bc_dir(this%num_api_vars)) - + ! Allocate the index filter maps allocate(this%filter_init_dims(this%num_api_vars_update_init_dims)) allocate(this%filter_init(this%num_api_vars_update_init)) @@ -1365,7 +1365,7 @@ logical function GetActivateState(this) result(active_state) active_state = this%active end function GetActivateState - + ! ====================================================================================== integer function GetGridcellIndex(this) result(gidx) From 5690505f43e532c052468b16e670bbbdb1963ace Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 11:13:54 -0700 Subject: [PATCH 279/331] more whitespace --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 6a53d836b7..234eaaa8cd 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1148,7 +1148,7 @@ subroutine DefineInterfaceRegistry(this, initialize) logical, intent(in) :: initialize ! false = count up the keys in the registry integer :: index ! Index to be incremented for each call to DefineInterfaceVariable() - + ! Initialize the index index = 0 From 756fb77abb21bdc45ce5cde90f1af6911f743639 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 11:14:54 -0700 Subject: [PATCH 280/331] adjust order of key update and frequency in interface variable definition --- main/FatesInterfaceTypesMod.F90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 234eaaa8cd..1af32242da 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1232,7 +1232,11 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc ! If not initializing, increment the registry count variables, otherwise initialize the variable at the correct index if (initialize) then - ! Initialize the variable + ! Set the key for each index + this%key(index) = key + + ! Set the update frequency, default to daily update frequency + update_frequency_local = registry_update_daily if (present(update_frequency)) then select case (update_frequency) case (registry_update_init_dims) @@ -1248,14 +1252,7 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc call endrun(msg=errMsg(__FILE__, __LINE__)) end select else - ! Default to daily update frequency - update_frequency_local = registry_update_daily end if - - ! Set the key for each index - this%key(index) = key - - ! Set the update frequency array values this%update_frequency(index) = update_frequency_local ! Set the boundary condition directionality for the variable index defaulting to bc_in From af49ac2f9c0ea732b347f8566bcc0c96c2be6b79 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 11:22:59 -0700 Subject: [PATCH 281/331] correct associate statement missing line continuation --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 1af32242da..91d9cb029b 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1152,7 +1152,7 @@ subroutine DefineInterfaceRegistry(this, initialize) ! Initialize the index index = 0 - associate(bc_in => registry_bc_in + associate(bc_in => registry_bc_in, & bc_out => registry_bc_out) ! Define the interface registry names and indices ! Variables that need to be updated during initialization and are necessary for other boundary conditions From 48480534906aca2eed92b0896f75d4fb494a7ef5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 15:09:33 -0700 Subject: [PATCH 282/331] remove unnecessary bc_in dir argument in call --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 91d9cb029b..8a336fcf8d 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1162,7 +1162,7 @@ subroutine DefineInterfaceRegistry(this, initialize) call this%DefineInterfaceVariable(key=hlm_fates_decomp, initialize=initialize, index=index, & update_frequency=registry_update_init_dims) call this%DefineInterfaceVariable(key=hlm_fates_soil_level, initialize=initialize, index=index, & - update_frequency=registry_update_init_dims, tofates) + update_frequency=registry_update_init_dims) ! Variables that only need to be updated at initialization call this%DefineInterfaceVariable(key=hlm_fates_decomp_thickness, initialize=initialize, index=index, & From f8aea1dfcf200c8166d48dbbfbdcef1c853cf10c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 15:09:45 -0700 Subject: [PATCH 283/331] add missing endrun --- main/FatesInterfaceTypesMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 8a336fcf8d..579346ab5e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1301,6 +1301,7 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc this%num_api_vars_bc_out + this%num_api_vars_bc_out + 1 case default write(fates_log(), *) 'ERROR: Unrecognized bc_dir in DefineInterfaceVariable(): ', bc_dir + call endrun(msg=errMsg(__FILE__, __LINE__)) end select else ! defaults to bc_in From 4d47737046445168d5dc1b505b2f1bfac78a9f4a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 15:11:12 -0700 Subject: [PATCH 284/331] correct assignment statement for bc_in/out counter --- main/FatesInterfaceTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 579346ab5e..7e68089136 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1296,9 +1296,9 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc if (present(bc_dir)) then select case (bc_dir) case (registry_bc_in) - this%num_api_vars_bc_in + this%num_api_vars_bc_in + 1 + this%num_api_vars_bc_in = this%num_api_vars_bc_in + 1 case (registry_bc_out) - this%num_api_vars_bc_out + this%num_api_vars_bc_out + 1 + this%num_api_vars_bc_out = this%num_api_vars_bc_out + 1 case default write(fates_log(), *) 'ERROR: Unrecognized bc_dir in DefineInterfaceVariable(): ', bc_dir call endrun(msg=errMsg(__FILE__, __LINE__)) From 8af8bec962a0328615cc40f49b2eeda3454aaa2e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 15:15:43 -0700 Subject: [PATCH 285/331] correct default bc counter update --- main/FatesInterfaceTypesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 7e68089136..fc364d4e14 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1305,7 +1305,7 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc end select else ! defaults to bc_in - this%num_api_vars_bc_in + this%num_api_vars_bc_in + 1 + this%num_api_vars_bc_in = this%num_api_vars_bc_in + 1 end if From ab1572de367d0347b99308197009165761fa2f74 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 27 Oct 2025 15:53:18 -0700 Subject: [PATCH 286/331] remove defunct local pointers --- main/FatesInterfaceVarTypeMod.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 46f84e2ef6..e747be659e 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -237,14 +237,7 @@ subroutine UpdateInterfaceVariable(this, var, scalar) real(r8), intent(in), optional :: scalar ! value to scale variable update ! Locals - class(*), pointer :: data_var0d => null() - class(*), pointer :: data_var1d(:) => null() - class(*), pointer :: data_var2d(:,:) => null() - class(*), pointer :: data_var3d(:,:,:) => null() - real(r8) :: scalar_local - integer :: index ! index for the subgrid level of the input interface variable - character(len=fates_long_string_length) :: msg_mismatch = 'FATES ERROR: Mismatched interface variable types' ! Check if scalar is present and set default value to one From e1ff73b25dafb0fe29563f1a94c701b22f3637bc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 29 Oct 2025 22:20:41 -0700 Subject: [PATCH 287/331] adding temporary diagnostics --- biogeochem/FatesSoilBGCFluxMod.F90 | 8 ++++++++ main/FatesInterfaceTypesMod.F90 | 24 ++++++++++++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 3b389d03e9..de1977c6c3 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -673,6 +673,8 @@ subroutine FluxIntoLitterPools(csite) currentPatch => csite%oldest_patch flux_patch_loop: do while (associated(currentPatch)) + write(*,*) 'Entering FluxIntoLitterPools for patch ', currentPatch%patchno + associate( & bc_out => csite%bc_out(currentPatch%patchno), & bc_in => csite%bc_in(currentPatch%patchno) & @@ -835,6 +837,12 @@ subroutine FluxIntoLitterPools(csite) flux_all_si = sum(flux_cel_si(:) * bc_in%dz_decomp_sisl(:)) + & sum(flux_lig_si(:) * bc_in%dz_decomp_sisl(:)) + & sum(flux_lab_si(:) * bc_in%dz_decomp_sisl(:)) + ! if (flux_all_si > 1e35_r8) then + write(fates_log(), *) 'flux_all: ', flux_all_si + write(fates_log(), *) 'sum cel, lig, lab: ', sum(flux_cel_si), sum(flux_lig_si), sum(flux_lab_si) + write(fates_log(), *) 'sum dz: ', sum(bc_in%dz_decomp_sisl(:)) + ! call endrun(msg=errMsg(__FILE__, __LINE__)) + ! end if end do flux_elem_loop diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index fc364d4e14..ae3f4214fd 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1117,6 +1117,7 @@ subroutine CheckInterfaceVariables(this) ! Check that the rank matches if (this%hlm_vars(i)%data_rank /= this%fates_vars(i)%data_rank) then write(*,*) "Rank mismatch for variable: ", this%key(i) + write(*,*) "Rank: hlm, fates: ", this%hlm_vars(i)%data_rank, this%fates_vars(i)%data_rank call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -1691,11 +1692,19 @@ subroutine UpdateLitterFluxes(this, dtime) j = this%filter_litter_flux(i) ! Update the hlm variables with the fates variables + ! write(fates_log(),*) 'Updating litterfluxes: key:', this%GetRegistryVariableKey(j) call this%hlm_vars(j)%Update(this%fates_vars(j), scalar=dtime) + ! Dump HLM variable + ! write(fates_log(),*) 'Dumping HLM variable' + ! call this%hlm_vars(j)%Dump() + ! write(fates_log(),*) 'Dumping FATES variable' + ! call this%fates_vars(j)%Dump() + end do ! Update the HLM variable with the total litterfall + ! write(fates_log(),*) 'Updating total litterfall' j = this%GetRegistryVariableIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) @@ -1703,8 +1712,23 @@ subroutine UpdateLitterFluxes(this, dtime) j = this%GetRegistryVariableIndex(hlm_fates_litter_phosphorus_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) + ! Dump HLM variable + ! write(fates_log(),*) 'Dumping HLM variable' + ! call this%hlm_vars(j)%Dump() + ! write(fates_log(),*) 'Dumping FATES variable' + ! call this%fates_vars(j)%Dump() + j = this%GetRegistryVariableIndex(hlm_fates_litter_nitrogen_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) + + ! Dump HLM variable + ! write(fates_log(),*) 'Dumping HLM variable' + ! call this%hlm_vars(j)%Dump() + ! write(fates_log(),*) 'Dumping FATES variable' + ! call this%fates_vars(j)%Dump() + + ! write(fates_log(),*) 'Finished updating litter fluxes' + end if From f9aa65c64435a7633d091e4845ea47495670e769 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 29 Oct 2025 23:31:14 -0700 Subject: [PATCH 288/331] Revert "adding temporary diagnostics" This reverts commit 0d6156c59c39f95aed7c5d5528d4033c7849d1f2. --- biogeochem/FatesSoilBGCFluxMod.F90 | 8 -------- main/FatesInterfaceTypesMod.F90 | 24 ------------------------ 2 files changed, 32 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index de1977c6c3..3b389d03e9 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -673,8 +673,6 @@ subroutine FluxIntoLitterPools(csite) currentPatch => csite%oldest_patch flux_patch_loop: do while (associated(currentPatch)) - write(*,*) 'Entering FluxIntoLitterPools for patch ', currentPatch%patchno - associate( & bc_out => csite%bc_out(currentPatch%patchno), & bc_in => csite%bc_in(currentPatch%patchno) & @@ -837,12 +835,6 @@ subroutine FluxIntoLitterPools(csite) flux_all_si = sum(flux_cel_si(:) * bc_in%dz_decomp_sisl(:)) + & sum(flux_lig_si(:) * bc_in%dz_decomp_sisl(:)) + & sum(flux_lab_si(:) * bc_in%dz_decomp_sisl(:)) - ! if (flux_all_si > 1e35_r8) then - write(fates_log(), *) 'flux_all: ', flux_all_si - write(fates_log(), *) 'sum cel, lig, lab: ', sum(flux_cel_si), sum(flux_lig_si), sum(flux_lab_si) - write(fates_log(), *) 'sum dz: ', sum(bc_in%dz_decomp_sisl(:)) - ! call endrun(msg=errMsg(__FILE__, __LINE__)) - ! end if end do flux_elem_loop diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index ae3f4214fd..fc364d4e14 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1117,7 +1117,6 @@ subroutine CheckInterfaceVariables(this) ! Check that the rank matches if (this%hlm_vars(i)%data_rank /= this%fates_vars(i)%data_rank) then write(*,*) "Rank mismatch for variable: ", this%key(i) - write(*,*) "Rank: hlm, fates: ", this%hlm_vars(i)%data_rank, this%fates_vars(i)%data_rank call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -1692,19 +1691,11 @@ subroutine UpdateLitterFluxes(this, dtime) j = this%filter_litter_flux(i) ! Update the hlm variables with the fates variables - ! write(fates_log(),*) 'Updating litterfluxes: key:', this%GetRegistryVariableKey(j) call this%hlm_vars(j)%Update(this%fates_vars(j), scalar=dtime) - ! Dump HLM variable - ! write(fates_log(),*) 'Dumping HLM variable' - ! call this%hlm_vars(j)%Dump() - ! write(fates_log(),*) 'Dumping FATES variable' - ! call this%fates_vars(j)%Dump() - end do ! Update the HLM variable with the total litterfall - ! write(fates_log(),*) 'Updating total litterfall' j = this%GetRegistryVariableIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) @@ -1712,23 +1703,8 @@ subroutine UpdateLitterFluxes(this, dtime) j = this%GetRegistryVariableIndex(hlm_fates_litter_phosphorus_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - ! Dump HLM variable - ! write(fates_log(),*) 'Dumping HLM variable' - ! call this%hlm_vars(j)%Dump() - ! write(fates_log(),*) 'Dumping FATES variable' - ! call this%fates_vars(j)%Dump() - j = this%GetRegistryVariableIndex(hlm_fates_litter_nitrogen_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - - ! Dump HLM variable - ! write(fates_log(),*) 'Dumping HLM variable' - ! call this%hlm_vars(j)%Dump() - ! write(fates_log(),*) 'Dumping FATES variable' - ! call this%fates_vars(j)%Dump() - - ! write(fates_log(),*) 'Finished updating litter fluxes' - end if From 3b20dbfa5bbe38ad28ae2ddebfd6a4d728e6cd2d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 31 Oct 2025 16:10:35 -0700 Subject: [PATCH 289/331] remove defunct patch type components --- biogeochem/FatesPatchMod.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index fb50bd297b..e673110118 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -69,15 +69,7 @@ module FatesPatchMod type (fates_patch_type), pointer :: older => null() ! pointer to next older patch type (fates_patch_type), pointer :: younger => null() ! pointer to next younger patch type (fates_cohort_vec_type), pointer :: co_scr(:) ! Scratch vector of cohort properties - - ! BC data - ! TODO change this to a specific bc type for incremental refactor purposes if this method is picked - type(bc_in_type) :: bc_in - type(bc_out_type) :: bc_out - ! API registry container - type(fates_interface_registry_base_type) :: api - !--------------------------------------------------------------------------- ! INDICES From 47d8bf5077a8677ac1eac4a7b826be1825128853 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 4 Nov 2025 22:28:55 -0800 Subject: [PATCH 290/331] fix exact restart issue During restart initialize with the update procedure, but avoid setting the max rooting depth to the init value. --- main/FatesInterfaceMod.F90 | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index e48ef63add..851be68120 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2968,17 +2968,19 @@ end subroutine InitializeBoundaryConditions ! ====================================================================================== -subroutine UpdateInterfaceVariables(this, initialize) +subroutine UpdateInterfaceVariables(this, initialize, restarting) ! Arguments class(fates_interface_type), intent(inout) :: this logical, intent(in), optional :: initialize + logical, intent(in), optional :: restarting ! Locals type(bc_in_type), pointer :: bc_in type(bc_out_type), pointer :: bc_out logical :: initialize_local + logical :: restarting_local integer :: r ! registry interface index integer :: s ! site index @@ -2991,6 +2993,14 @@ subroutine UpdateInterfaceVariables(this, initialize) initialize_local = initialize end if + ! Set the default restart flag to false + ! If we are restarting we need to initialize as well + restarting_local = .false. + if (present(restarting)) then + restarting_local = restarting + intialize_local = .true. + end if + do r = 1, this%npatches ! Update the interface variables for the current registry @@ -3002,6 +3012,9 @@ subroutine UpdateInterfaceVariables(this, initialize) bc_in => this%sites(s)%bc_in(ifp) + ! Set the max rooting depth index to either to the soil depth or the max thaw depth last year, whichever is shallower + bc_in%max_rooting_depth_index_col = min(bc_in%nlevsoil, bc_in%max_thaw_depth_index) + ! Calculate various bc_in variables that are based on other variables or namelist states if (initialize_local) then @@ -3037,12 +3050,9 @@ subroutine UpdateInterfaceVariables(this, initialize) end if ! On initialization, set the max rooting depth index to the maximum decomposition level - bc_in%max_rooting_depth_index_col = bc_in%nlevdecomp - - else - - ! Set the max rooting depth index to either to the soil depth or the max thaw depth last year, whichever is shallower - bc_in%max_rooting_depth_index_col = min(bc_in%nlevsoil, bc_in%max_thaw_depth_index) + ! unless we are restarting + if (.not. restarting_local) bc_in%max_rooting_depth_index_col = bc_in%nlevdecomp + end if @@ -3068,7 +3078,7 @@ subroutine UpdateLitterFluxes(this, dtime) ! Loop through the active registries and update the litter fluxes do n = 1, this%num_active_patches r = this%filter_registry_active(n) - write(fates_log(),*) 'Updating litter fluxes: r, s, ifp ', r, this%registry(r)%GetSiteIndex(), this%registry(r)%GetFatesPatchIndex() + !write(fates_log(),*) 'Updating litter fluxes: r, s, ifp ', r, this%registry(r)%GetSiteIndex(), this%registry(r)%GetFatesPatchIndex() call this%registry(r)%UpdateLitterFluxes(dtime) end do From f2004c1fe9be34cf7f52a83b7866a81710bb7b85 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 4 Nov 2025 22:56:57 -0800 Subject: [PATCH 291/331] fix typo --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 851be68120..bd06eff2b9 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2998,7 +2998,7 @@ subroutine UpdateInterfaceVariables(this, initialize, restarting) restarting_local = .false. if (present(restarting)) then restarting_local = restarting - intialize_local = .true. + initialize_local = .true. end if do r = 1, this%npatches From dce62fa5823739e7253ace1cb120e7327f14fe7f Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 9 Nov 2025 22:41:26 -0800 Subject: [PATCH 292/331] add nitrogen and phosphorus to filter size accumulation --- main/FatesInterfaceTypesMod.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index fc364d4e14..859676ba3e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1312,7 +1312,13 @@ subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequenc ! Update the litter flux counters not including the total flux counter if (key == hlm_fates_litter_carbon_cellulose .or. & key == hlm_fates_litter_carbon_labile .or. & - key == hlm_fates_litter_carbon_lignin) then + key == hlm_fates_litter_carbon_lignin .or. & + key == hlm_fates_litter_nitrogen_cellulose .or. & + key == hlm_fates_litter_nitrogen_labile .or. & + key == hlm_fates_litter_nitrogen_lignin .or. & + key == hlm_fates_litter_phosphorus_cellulose .or. & + key == hlm_fates_litter_phosphorus_labile .or. & + key == hlm_fates_litter_phosphorus_lignin) then this%num_api_vars_litter_flux= this%num_api_vars_litter_flux + 1 end if From b2526d26df4fe0e35ab14230cef8b0fb275e838d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 10 Nov 2025 13:13:00 -0800 Subject: [PATCH 293/331] add checks to avoid nocomp bareground patch --- biogeochem/FatesSoilBGCFluxMod.F90 | 4 ++++ main/FatesInterfaceMod.F90 | 5 ++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 3b389d03e9..3d872ca034 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -677,6 +677,9 @@ subroutine FluxIntoLitterPools(csite) bc_out => csite%bc_out(currentPatch%patchno), & bc_in => csite%bc_in(currentPatch%patchno) & ) + + if(currentPatch%nocomp_pft_label .ne. nocomp_bareground)then + ! This is the number of effective soil layers to transfer from nlev_eff_soil = max(bc_in%max_rooting_depth_index_col, 1) @@ -927,6 +930,7 @@ subroutine FluxIntoLitterPools(csite) end if end if + end if end associate diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index bd06eff2b9..80083fa93f 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2282,6 +2282,8 @@ subroutine SetRegistryActiveState(this) currentPatch => this%sites(s)%oldest_patch do while (associated(currentPatch)) + if (currentPatch%nocomp_pft_label .ne. nocomp_bareground) then + ! Get the registry index for the current site + patch combo and set it to active r = this%sites(s)%GetRegistryIndex(currentPatch%patchno) call this%registry(r)%SetActiveState(active_state=.true.) @@ -2291,6 +2293,8 @@ subroutine SetRegistryActiveState(this) i = i + 1 this%filter_registry_active(i) = r + end if + ! Move to the next patch currentPatch => currentPatch%younger end do @@ -3078,7 +3082,6 @@ subroutine UpdateLitterFluxes(this, dtime) ! Loop through the active registries and update the litter fluxes do n = 1, this%num_active_patches r = this%filter_registry_active(n) - !write(fates_log(),*) 'Updating litter fluxes: r, s, ifp ', r, this%registry(r)%GetSiteIndex(), this%registry(r)%GetFatesPatchIndex() call this%registry(r)%UpdateLitterFluxes(dtime) end do From 623a009be21665520595729d2167ffb535eb3908 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 10 Nov 2025 13:13:44 -0800 Subject: [PATCH 294/331] add count check --- main/FatesInterfaceTypesMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 859676ba3e..3b16daa6aa 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1505,7 +1505,8 @@ subroutine SetFilterMapArrays(this) if (count_init_dims /= this%num_api_vars_update_init_dims .or. & count_init /= this%num_api_vars_update_init .or. & count_daily /= this%num_api_vars_update_daily .or. & - count_timestep /= this%num_api_vars_update_timestep) then + count_timestep /= this%num_api_vars_update_timestep .or. & + count_litter_flux /= this%num_api_vars_litter_flux) then write(fates_log(),*) 'ERROR: Mismatch in initialization counts in SetFilterMapArrays(): ' write(fates_log(),*) ' count_init = ', count_init, ' expected = ', this%num_api_vars_update_init From c3dd595707d2b34919308262ec78d8984e76b3f0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 16 Nov 2025 22:20:34 -0800 Subject: [PATCH 295/331] move check before associate --- biogeochem/FatesSoilBGCFluxMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 3d872ca034..ae8753f833 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -673,13 +673,13 @@ subroutine FluxIntoLitterPools(csite) currentPatch => csite%oldest_patch flux_patch_loop: do while (associated(currentPatch)) + if(currentPatch%nocomp_pft_label .ne. nocomp_bareground)then + associate( & bc_out => csite%bc_out(currentPatch%patchno), & bc_in => csite%bc_in(currentPatch%patchno) & ) - if(currentPatch%nocomp_pft_label .ne. nocomp_bareground)then - ! This is the number of effective soil layers to transfer from nlev_eff_soil = max(bc_in%max_rooting_depth_index_col, 1) @@ -930,9 +930,10 @@ subroutine FluxIntoLitterPools(csite) end if end if - end if end associate + end if + currentPatch => currentPatch%younger end do flux_patch_loop From ed44791ed2d9bc7d1f02be319833322ab67ee84c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 19 Nov 2025 15:59:42 -0800 Subject: [PATCH 296/331] add zero patchno check --- main/EDMainMod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 1eadc4f828..423fd3e586 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -779,6 +779,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) + + if (currentPatch%nocomp_pft_label .ne. nocomp_bareground) then call GenerateDamageAndLitterFluxes( currentSite, currentPatch) @@ -786,6 +788,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call PreDisturbanceIntegrateLitter(currentPatch ) + end if + currentPatch => currentPatch%older enddo From 27e4bf9315c1a667a5c97235533adc3564770de7 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Nov 2025 15:04:16 -0800 Subject: [PATCH 297/331] Register only the nlevdecomp indices Note that the array allocation matches the full depth set by the hlm, but we don't use the full depth --- main/FatesInterfaceMod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 80083fa93f..1da8b50310 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2892,6 +2892,7 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) integer :: r ! registery iterator integer :: s ! site iterator integer :: ifp ! boundary condition index + integer :: nlevdecomp type(bc_in_type), pointer :: bc_in type(bc_out_type), pointer :: bc_out @@ -2937,12 +2938,13 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) data=bc_in%t_scalar_sisl, hlm_flag=.false.) ! bc_out + nlevdecomp = bc_in%nlevdecomp call this%registry(r)%Register(key=hlm_fates_litter_carbon_cellulose, & - data=bc_out%litt_flux_cel_c_si, hlm_flag=.false.) + data=bc_out%litt_flux_cel_c_si(1:nlevdecomp), hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_carbon_lignin, & - data=bc_out%litt_flux_lig_c_si, hlm_flag=.false.) + data=bc_out%litt_flux_lig_c_si(1:nlevdecomp), hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, & - data=bc_out%litt_flux_lab_c_si, hlm_flag=.false.) + data=bc_out%litt_flux_lab_c_si(1:nlevdecomp), hlm_flag=.false.) call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, & data=bc_out%litt_flux_all_c, hlm_flag=.false.) From dbdbd6743bd84e93eeb0936e2f2367c888e039bc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Nov 2025 15:05:44 -0800 Subject: [PATCH 298/331] Add bareground patch data to registry --- main/FatesInterfaceTypesMod.F90 | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 3b16daa6aa..0d8c5027ec 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -922,6 +922,7 @@ module FatesInterfaceTypesMod integer, private :: sidx integer, private :: hpidx integer, private :: fpidx + logical, private :: bareground contains @@ -936,6 +937,7 @@ module FatesInterfaceTypesMod procedure :: InitializeInterfaceRegistry procedure :: InitializeInterfaceVariablesDimensions procedure :: InitializeInterfaceVariables + procedure :: IsBareground => HLMPatchIsBareground procedure :: SetSubgridIndices procedure :: SetActiveState procedure :: UpdateLitterFluxes @@ -1328,7 +1330,7 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== - subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch, fatespatch, site) + subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch, fatespatch, site, bareground) class(fates_interface_registry_type), intent(inout) :: this integer, intent(in), optional :: gridcell @@ -1338,6 +1340,7 @@ subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatc integer, intent(in), optional :: hlmpatch integer, intent(in), optional :: fatespatch integer, intent(in), optional :: site + logical, intent(in), optional :: bareground if (present(gridcell)) this%gidx = gridcell if (present(topounit)) this%tidx = topounit @@ -1346,6 +1349,7 @@ subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatc if (present(hlmpatch)) this%hpidx = hlmpatch if (present(fatespatch)) this%fpidx = fatespatch if (present(site)) this%sidx = site + if (present(bareground)) this%bareground = bareground end subroutine SetSubgridIndices @@ -1432,6 +1436,16 @@ end function GetFatesPatchIndex ! ====================================================================================== + logical function HLMPatchIsBareGround(this) result(bareground) + + class(fates_interface_registry_type), intent(inout) :: this + + bareground = this%bareground + + end function HLMPatchIsBareGround + + ! ====================================================================================== + subroutine SetFilterMapArrays(this) class(fates_interface_registry_type), intent(inout) :: this From 52d84db2d4849b0b210b419225969b8f2d250fc2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Dec 2025 21:59:35 -0800 Subject: [PATCH 299/331] reinstate area_frac --- biogeochem/FatesSoilBGCFluxMod.F90 | 31 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index ae8753f833..725aa9e64b 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -751,16 +751,16 @@ subroutine FluxIntoLitterPools(csite) ! for the current element on the current ! patch litt => currentPatch%litter(el) - + area_frac = currentPatch%area/area + do ic = 1, ncwd do id = 1,nlev_eff_decomp flux_cel_si(id) = flux_cel_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * surface_prof(id) + litt%ag_cwd_frag(ic) * ED_val_cwd_fcel * area_frac * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%ag_cwd_frag(ic) * ED_val_cwd_flig * surface_prof(id) - + litt%ag_cwd_frag(ic) * ED_val_cwd_flig * area_frac * surface_prof(id) end do do j = 1, nlev_eff_soil @@ -768,10 +768,10 @@ subroutine FluxIntoLitterPools(csite) id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer flux_cel_si(id) = flux_cel_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel + litt%bg_cwd_frag(ic,j) * ED_val_cwd_fcel * area_frac flux_lig_si(id) = flux_lig_si(id) + & - litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig + litt%bg_cwd_frag(ic,j) * ED_val_cwd_flig * area_frac end do end do @@ -784,13 +784,13 @@ subroutine FluxIntoLitterPools(csite) do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & - litt%leaf_fines_frag(ilabile) * surface_prof(id) + litt%leaf_fines_frag(ilabile) * area_frac * surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & - litt%leaf_fines_frag(icellulose) * surface_prof(id) + litt%leaf_fines_frag(icellulose) * area_frac * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & - litt%leaf_fines_frag(ilignin) * surface_prof(id) + litt%leaf_fines_frag(ilignin) * area_frac * surface_prof(id) end do @@ -800,26 +800,25 @@ subroutine FluxIntoLitterPools(csite) do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flab(ipft) * surface_prof(id) + EDPftvarcon_inst%lf_flab(ipft) * area_frac * surface_prof(id) flux_cel_si(id) = flux_cel_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_fcel(ipft) * surface_prof(id) - + EDPftvarcon_inst%lf_fcel(ipft) * area_frac * surface_prof(id) flux_lig_si(id) = flux_lig_si(id) + & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & - EDPftvarcon_inst%lf_flig(ipft) * surface_prof(id) + EDPftvarcon_inst%lf_flig(ipft) * area_frac * surface_prof(id) end do end do do j = 1, nlev_eff_soil id = bc_in%decomp_id(j) flux_lab_si(id) = flux_lab_si(id) + & - litt%root_fines_frag(ilabile,j) + litt%root_fines_frag(ilabile,j) * area_frac flux_cel_si(id) = flux_cel_si(id) + & - litt%root_fines_frag(icellulose,j) + litt%root_fines_frag(icellulose,j) * area_frac flux_lig_si(id) = flux_lig_si(id) + & - litt%root_fines_frag(ilignin,j) + litt%root_fines_frag(ilignin,j) * area_frac enddo ! Normalize all masses over the decomposition layer's depth From 04cc5914052dc64e04e438a2c446eacd29528dde Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Dec 2025 22:00:32 -0800 Subject: [PATCH 300/331] add conversion var type bound procedure --- main/FatesInterfaceVarTypeMod.F90 | 49 +++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index e747be659e..9d2a97d9d5 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -34,6 +34,7 @@ module FatesInterfaceVariableTypeMod contains procedure :: CheckBounds + procedure :: Convert => ConvertScaleInterfaceVariable procedure :: Initialize => InitializeInterfaceVariable procedure :: Update => UpdateInterfaceVariable procedure :: Dump @@ -97,6 +98,54 @@ end subroutine CheckBounds ! ==================================================================================== + subroutine ConvertScaleInterfaceVariable(this, scalar) + + ! This subroutine scales a given interface variable data. This + ! routine is provided primarily to allow for post accumulation conversion + ! of units and scaling of data as necessary. Note that this only provides + ! scaling for real data types currently. + + class(fates_interface_variable_type), intent(inout) :: this + real(r8), intent(in) :: scalar + + ! Locals + integer :: i + character(len=fates_long_string_length) :: err_msg = 'FATES Error: invalid interface type being scaled' + + select case (this%data_rank) + case(0) + select type(var => this%data0d) + type is (real(r8)) + var = var * scalar + class default + write(fates_log(),*), err_msg + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + case(1) + select type(var => this%data1d) + type is (real(r8)) + var = var * scalar + class default + write(fates_log(),*), err_msg + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + case(2) + select type(var => this%data2d) + type is (real(r8)) + var = var * scalar + class default + write(fates_log(),*), err_msg + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + case default + write(fates_log(),*) 'FATES ERROR: Unsupported interface variable rank in ConvertScaleInterfaceVariable' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + end subroutine ConvertScaleInterfaceVariable + + ! ==================================================================================== + subroutine Dump(this) class(fates_interface_variable_type), intent(in) :: this From 12eb316bbcf9852866ad013558fa4dd8d274c23b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Dec 2025 22:01:06 -0800 Subject: [PATCH 301/331] add normalization procedure for accumulated litter fluxes --- main/FatesInterfaceVarTypeMod.F90 | 40 +++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 9d2a97d9d5..ea8e77e59d 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -36,6 +36,7 @@ module FatesInterfaceVariableTypeMod procedure :: CheckBounds procedure :: Convert => ConvertScaleInterfaceVariable procedure :: Initialize => InitializeInterfaceVariable + procedure :: Normalize => NormalizeLitterVariable procedure :: Update => UpdateInterfaceVariable procedure :: Dump @@ -223,6 +224,45 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) this%bc_dir = bc_dir end subroutine InitializeInterfaceVariable + + ! ==================================================================================== + + subroutine NormalizeLitterVariable(this, norm_var) + + ! This subroutine is specifically set up to normalize the litter flux interface + ! variables by the decomposition thickness variable passed in as norm_factor. + ! It could be extended later to handle other normalization needs as necessary. + + class(fates_interface_variable_type), intent(inout) :: this + class(fates_interface_variable_type), intent(in) :: norm_var ! normalization interface variable + + ! Locals + integer :: i + character(len=fates_long_string_length) :: err_msg = 'FATES Error: invalid interface type being normalized' + + select case (this%data_rank) + case(1) + select type(var => this%data1d) + type is (real(r8)) + select type(norm => norm_var%data1d) + type is (real(r8)) + do i = lbound(var, dim=1), ubound(var, dim=1) + var(i) = var(i) / norm(i) + end do + class default + write(fates_log(),*), err_msg + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + class default + write(fates_log(),*), err_msg + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + case default + write(fates_log(),*) 'FATES ERROR: Unsupported interface variable rank in NormalizeLitterVariable' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + end subroutine NormalizeLitterVariable ! ==================================================================================== From 082bea0307897da0ba0223621b12a990e42566f0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Dec 2025 22:01:45 -0800 Subject: [PATCH 302/331] implement conversation and nomralization procedures --- main/FatesInterfaceMod.F90 | 24 ++++++++++++++++++++++- main/FatesInterfaceTypesMod.F90 | 34 +++++++++++++++++++++++++++++---- 2 files changed, 53 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 1da8b50310..b2e7c00a67 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -3077,6 +3077,8 @@ subroutine UpdateLitterFluxes(this, dtime) ! Locals integer :: n ! active registry index iterator integer :: r ! registry index + integer :: next_r + logical :: conversion_flag ! Set the registry active state call this%SetRegistryActiveState() @@ -3084,7 +3086,27 @@ subroutine UpdateLitterFluxes(this, dtime) ! Loop through the active registries and update the litter fluxes do n = 1, this%num_active_patches r = this%filter_registry_active(n) - call this%registry(r)%UpdateLitterFluxes(dtime) + + ! Set converstion flag to false by default + conversion_flag = .false. + + ! Look ahead and determine if the next registry is for a different column. + ! If so, we need to convert the accumulated litter fluxes + ! This is facilitated by the fact that the column indices are monotonically increasing per the HLM + if (n .lt. this%num_active_patches) then + next_r = this%filter_registry_active(n+1) + if (this%registry(r)%GetColumnIndex() .ne. this%registry(next_r)%GetColumnIndex()) then + conversion_flag = .true. + end if + else + conversion_flag = .true. + end if + + write(fates_log(),*) 'update litter flux, n, r, cflag: ', n, r, conversion_flag + write(fates_log(),*) 'update litter flux, s, c: ', this%registry(r)%GetSiteIndex(), this%registry(r)%GetColumnIndex() + + call this%registry(r)%UpdateLitterFluxes(conversion_flag) + end do end subroutine UpdateLitterFluxes diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 0d8c5027ec..d8d0106182 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1697,35 +1697,61 @@ end subroutine UpdateInterfaceVariables ! ====================================================================================== - subroutine UpdateLitterFluxes(this, dtime) + ! subroutine UpdateLitterFluxes(this, dtime) + subroutine UpdateLitterFluxes(this, conversion_flag) + + use FatesConstantsMod, only : days_per_sec + use FatesConstantsMod, only : g_per_kg ! Arguments class(fates_interface_registry_type), intent(inout) :: this - real(r8), intent(in) :: dtime + ! real(r8), intent(in) :: dtime + logical, intent(in) :: conversion_flag ! Locals integer :: i integer :: j + integer :: k + integer :: d + real(r8) :: conversion_factor ! Iterate over the litter flux filter to update the individual litter types do i = 1, this%num_api_vars_litter_flux j = this%filter_litter_flux(i) ! Update the hlm variables with the fates variables - call this%hlm_vars(j)%Update(this%fates_vars(j), scalar=dtime) + ! call this%hlm_vars(j)%Update(this%fates_vars(j), scalar=dtime) + call this%hlm_vars(j)%Update(this%fates_vars(j)) + + ! If the conversion flag is set, convert and scale the updated HLM litter flux interface variable + if (conversion_flag) then + + ! Convert from kgC/m2/s to gC/m2/day + call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) + + ! Get the index for the decomposition thickness key + d = this%GetRegistryVariableIndex(hlm_fates_decomp_thickness) + + ! Normalize the litter fluxes against the decomposition layer thicknesses + call this%hlm_vars(j)%Normalize(this%fates_vars(d)) + + end if end do ! Update the HLM variable with the total litterfall j = this%GetRegistryVariableIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) + if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then j = this%GetRegistryVariableIndex(hlm_fates_litter_phosphorus_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) + call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) j = this%GetRegistryVariableIndex(hlm_fates_litter_nitrogen_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) + call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) end if @@ -1743,7 +1769,7 @@ integer function GetRegistryVariableIndex(this, key) result(index) integer :: ivar ! Iterator - ! Iterate over the registry until the associated key is found + ! Iterate over the registry variables until the associated key is found do ivar = 1, this%num_api_vars if (this%key(ivar) == key) then index = ivar From 691d337c381ba6083f1c97ea00a44cd2e880230e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 7 Jan 2026 15:06:22 -0800 Subject: [PATCH 303/331] update all pool summation --- biogeochem/FatesSoilBGCFluxMod.F90 | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 725aa9e64b..b65e88d830 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -821,22 +821,26 @@ subroutine FluxIntoLitterPools(csite) litt%root_fines_frag(ilignin,j) * area_frac enddo - ! Normalize all masses over the decomposition layer's depth + ! write(fates_log(),*) 'FILP: pn, el, cel, lig, lab : ', currentPatch%patchno, el, sum(flux_cel_si(:)), sum(flux_lig_si(:)), sum(flux_lab_si(:)) ! Convert from kg/m2/day -> g/m3/s + ! flux_cel_si(:) = flux_cel_si(:) * days_per_sec * g_per_kg + ! flux_lig_si(:) = flux_lig_si(:) * days_per_sec * g_per_kg + ! flux_lab_si(:) = flux_lab_si(:) * days_per_sec * g_per_kg - do id = 1,nlev_eff_decomp - flux_cel_si(id) = days_per_sec * g_per_kg * & - flux_cel_si(id) / bc_in%dz_decomp_sisl(id) - flux_lig_si(id) = days_per_sec * g_per_kg * & - flux_lig_si(id) / bc_in%dz_decomp_sisl(id) - flux_lab_si(id) = days_per_sec * g_per_kg * & - flux_lab_si(id) / bc_in%dz_decomp_sisl(id) - end do + ! Calculate the total flux of C into the litter pools + flux_all_si = sum(flux_cel_si(:)) + sum(flux_lig_si(:)) + sum(flux_lab_si(:)) + write(fates_log(),*) 'FILP: p, el, cel, lig, lab: ', currentPatch%patchno, el, sum(flux_cel_si(:)), sum(flux_lig_si(:)), sum(flux_lab_si(:)) - ! Calculate the total flux of C into the litter pools - flux_all_si = sum(flux_cel_si(:) * bc_in%dz_decomp_sisl(:)) + & - sum(flux_lig_si(:) * bc_in%dz_decomp_sisl(:)) + & - sum(flux_lab_si(:) * bc_in%dz_decomp_sisl(:)) + ! Normalize all masses over the decomposition layer's depth + ! do id = 1,nlev_eff_decomp + ! flux_cel_si(id) = flux_cel_si(id) / bc_in%dz_decomp_sisl(id) + ! flux_lig_si(id) = flux_lig_si(id) / bc_in%dz_decomp_sisl(id) + ! flux_lab_si(id) = flux_lab_si(id) / bc_in%dz_decomp_sisl(id) + ! end do + + ! flux_all_si = sum(flux_cel_si(:) * bc_in%dz_decomp_sisl(:)) + & + ! sum(flux_lig_si(:) * bc_in%dz_decomp_sisl(:)) + & + ! sum(flux_lab_si(:) * bc_in%dz_decomp_sisl(:)) end do flux_elem_loop From 570563489bf31f841b7ddaaa7f71ba4cccff0bb4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 7 Jan 2026 15:07:25 -0800 Subject: [PATCH 304/331] add conversion flag check for parteh mode 2 --- main/FatesInterfaceTypesMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d8d0106182..2733c98bd4 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1747,11 +1747,11 @@ subroutine UpdateLitterFluxes(this, conversion_flag) if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then j = this%GetRegistryVariableIndex(hlm_fates_litter_phosphorus_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) + if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) j = this%GetRegistryVariableIndex(hlm_fates_litter_nitrogen_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) + if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) end if From 470b736c426b7f3b5ddcfa46dee060fcc60c0eec Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 13 Jan 2026 14:49:41 -0800 Subject: [PATCH 305/331] Add zero_first attribute to interface variable types --- main/FatesInterfaceVarTypeMod.F90 | 32 ++++++++++++++++++++++++++++--- 1 file changed, 29 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index ea8e77e59d..d190afeee9 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -27,6 +27,7 @@ module FatesInterfaceVariableTypeMod class(*), pointer :: data3d(:,:,:) ! 3D polymorphic data pointer logical :: active ! true if the variable is used by the host land model logical :: accumulate ! If true, this variable should add the source to the target + logical :: zero_first ! If true, zero the target variable before accumulation integer :: bc_dir ! 0 if bc_in, 1 if bc_out integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: update_frequency ! frequency of updates @@ -217,6 +218,7 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) this%data3d => null() this%active = .false. this%accumulate = .false. + this%zero_first = .false. ! Initialize registry variable components that are updated at variable definition this%key = key @@ -266,33 +268,37 @@ end subroutine NormalizeLitterVariable ! ==================================================================================== - subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate) + subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate, is_first) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data logical, intent(in) :: active logical, intent(in) :: accumulate + logical, intent(in) :: is_first this%data0d => data this%active = active this%accumulate = accumulate + this%zero_first = is_first this%data_rank = rank(data) end subroutine RegisterInterfaceVariable_0d ! ==================================================================================== - subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate) + subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:) logical, intent(in) :: active logical, intent(in) :: accumulate + logical, intent(in) :: is_first this%data1d => data(:) this%active = active this%accumulate = accumulate + this%zero_first = is_first this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) @@ -300,16 +306,18 @@ end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== - subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate) + subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate, is_first) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active logical, intent(in) :: accumulate + logical, intent(in) :: is_first this%data2d => data(:,:) this%active = active this%accumulate = accumulate + this%zero_first = is_first this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) this%data_size(2) = size(data, dim=2) @@ -354,6 +362,9 @@ subroutine UpdateInterfaceVariable(this, var, scalar) select type(source => var%data0d) type is (real(r8)) if (this%accumulate) then + if (this%zero_first) then + dest = 0.0_r8 + end if dest = dest + source * scalar_local else dest = source * scalar_local @@ -366,6 +377,9 @@ subroutine UpdateInterfaceVariable(this, var, scalar) select type(source => var%data0d) type is (integer) if (this%accumulate) then + if (this%zero_first) then + dest = 0 + end if dest = dest + source else dest = source @@ -386,6 +400,9 @@ subroutine UpdateInterfaceVariable(this, var, scalar) select type(source => var%data1d) type is (real(r8)) if (this%accumulate) then + if (this%zero_first) then + dest = 0.0_r8 + end if dest = dest + source * scalar_local else dest = source * scalar_local @@ -398,6 +415,9 @@ subroutine UpdateInterfaceVariable(this, var, scalar) select type(source => var%data1d) type is (integer) if (this%accumulate) then + if (this%zero_first) then + dest = 0 + end if dest = dest + source else dest = source @@ -418,6 +438,9 @@ subroutine UpdateInterfaceVariable(this, var, scalar) select type(source => var%data2d) type is (real(r8)) if (this%accumulate) then + if (this%zero_first) then + dest = 0.0_r8 + end if dest = dest + source * scalar_local else dest = source * scalar_local @@ -430,6 +453,9 @@ subroutine UpdateInterfaceVariable(this, var, scalar) select type(source => var%data2d) type is (integer) if (this%accumulate) then + if (this%zero_first) then + dest = 0 + end if dest = dest + source else dest = source From 4b59a725bafb0fde4445bb5e7f57dee52da1b554 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 13 Jan 2026 15:21:00 -0800 Subject: [PATCH 306/331] update register subroutines to accept and pass in the is_first optional flag --- main/FatesInterfaceTypesMod.F90 | 49 +++++++++++++++++++++++++-------- 1 file changed, 38 insertions(+), 11 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 2733c98bd4..d25c411c67 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1534,7 +1534,7 @@ end subroutine SetFilterMapArrays ! ====================================================================================== - subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate) + subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, is_first) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1545,10 +1545,12 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate) character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? + logical, intent(in), optional :: is_first ! Should the variable be zeroed first? ! Local logical :: accumulate_local - + logical :: is_first_local + ! Default accumulate to false if (present(accumulate)) then accumulate_local = accumulate @@ -1556,11 +1558,18 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate) accumulate_local = .false. end if + ! Default is_first to false + if (present(is_first)) then + is_first_local = is_first + else + is_first_local = .false. + end if + ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local, is_first=is_first_local) else - call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local, is_first=is_first_local) end if @@ -1568,7 +1577,7 @@ end subroutine RegisterInterfaceVariables_0d ! ====================================================================================== - subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate) + subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, is_first) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1578,9 +1587,11 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate) character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? + logical, intent(in), optional :: is_first ! Should the variable be zeroed first? ! Local logical :: accumulate_local + logical :: is_first_local ! Default accumulate to false if (present(accumulate)) then @@ -1588,19 +1599,26 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate) else accumulate_local = .false. end if + + ! Default is_first to false + if (present(is_first)) then + is_first_local = is_first + else + is_first_local = .false. + end if ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local, is_first=is_first_local) else - call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local, is_first=is_first_local) end if end subroutine RegisterInterfaceVariables_1d ! ====================================================================================== - subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate) + subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1610,9 +1628,11 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate) character(len=*), intent(in) :: key ! variable registry key logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? + logical, intent(in), optional :: is_first ! Should the variable be zeroed first? ! Local logical :: accumulate_local + logical :: is_first_local ! Default accumulate to false if (present(accumulate)) then @@ -1620,12 +1640,19 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate) else accumulate_local = .false. end if - + + ! Default is_first to false + if (present(is_first)) then + is_first_local = is_first + else + is_first_local = .false. + end if + ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local, is_first=is_first_local) else - call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local, is_first=is_first_local) end if end subroutine RegisterInterfaceVariables_2d From ba11f6d5e0ddab14ff21a66955a116b45d01ffd3 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 20 Jan 2026 16:07:06 -0800 Subject: [PATCH 307/331] Update conversion mechanism to be associated with Update subroutine --- main/FatesInterfaceMod.F90 | 38 +++++++---- main/FatesInterfaceTypesMod.F90 | 106 ++++++++++++++++++++++++++---- main/FatesInterfaceVarTypeMod.F90 | 58 ++++++++++------ 3 files changed, 154 insertions(+), 48 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b2e7c00a67..ccf26b398b 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2883,6 +2883,7 @@ end subroutine InitializeFatesSites subroutine InitializeBoundaryConditions(this, patches_per_site) use FatesInterfaceParametersMod + use FatesConstantsMod , only : days_per_sec ! Arguments class(fates_interface_type), intent(inout) :: this ! fates interface type @@ -2940,32 +2941,43 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) ! bc_out nlevdecomp = bc_in%nlevdecomp call this%registry(r)%Register(key=hlm_fates_litter_carbon_cellulose, & - data=bc_out%litt_flux_cel_c_si(1:nlevdecomp), hlm_flag=.false.) + data=bc_out%litt_flux_cel_c_si(1:nlevdecomp), hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_carbon_lignin, & - data=bc_out%litt_flux_lig_c_si(1:nlevdecomp), hlm_flag=.false.) + data=bc_out%litt_flux_lig_c_si(1:nlevdecomp), hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, & - data=bc_out%litt_flux_lab_c_si(1:nlevdecomp), hlm_flag=.false.) + data=bc_out%litt_flux_lab_c_si(1:nlevdecomp), hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, & - data=bc_out%litt_flux_all_c, hlm_flag=.false.) - + data=bc_out%litt_flux_all_c, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_cellulose, & - data=bc_out%litt_flux_cel_p_si, hlm_flag=.false.) + data=bc_out%litt_flux_cel_p_si, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_lignin, & - data=bc_out%litt_flux_lig_p_si, hlm_flag=.false.) + data=bc_out%litt_flux_lig_p_si, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_labile, & - data=bc_out%litt_flux_lab_p_si, hlm_flag=.false.) + data=bc_out%litt_flux_lab_p_si, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_total, & - data=bc_out%litt_flux_all_p, hlm_flag=.false.) + data=bc_out%litt_flux_all_p, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_cellulose, & - data=bc_out%litt_flux_cel_n_si, hlm_flag=.false.) + data=bc_out%litt_flux_cel_n_si, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_lignin, & - data=bc_out%litt_flux_lig_n_si, hlm_flag=.false.) + data=bc_out%litt_flux_lig_n_si, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_labile, & - data=bc_out%litt_flux_lab_n_si, hlm_flag=.false.) + data=bc_out%litt_flux_lab_n_si, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) call this%registry(r)%Register(key=hlm_fates_litter_nitrogen_total, & - data=bc_out%litt_flux_all_n, hlm_flag=.false.) + data=bc_out%litt_flux_all_n, hlm_flag=.false., & + conversion_factor=days_per_sec*g_per_kg) end if end do end do diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index d25c411c67..4fcc6cd57e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1534,7 +1534,7 @@ end subroutine SetFilterMapArrays ! ====================================================================================== - subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, is_first) + subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, is_first, is_last, conversion_factor) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1546,10 +1546,14 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? logical, intent(in), optional :: is_first ! Should the variable be zeroed first? - + logical, intent(in), optional :: is_last ! Should the variable be last in the update? + real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable + ! Local logical :: accumulate_local logical :: is_first_local + logical :: is_last_local + real(r8) :: conversion_factor_local ! Default accumulate to false if (present(accumulate)) then @@ -1564,12 +1568,34 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, else is_first_local = .false. end if + + ! Default is_last to false + if (present(is_last)) then + is_last_local = is_last + else + is_last_local = .false. + end if + + ! Default conversion factor to 1.0 + if (present(conversion_factor)) then + conversion_factor_local = conversion_factor + else + conversion_factor_local = 1.0_r8 + end if ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local, is_first=is_first_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., & + accumulate=accumulate_local, & + is_first=is_first_local, & + is_last=is_last_local, & + conversion_factor=conversion_factor_local) else - call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., accumulate=accumulate_local, is_first=is_first_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., & + accumulate=accumulate_local, & + is_first=is_first_local, & + is_last=is_last_local, & + conversion_factor=conversion_factor_local) end if @@ -1577,7 +1603,7 @@ end subroutine RegisterInterfaceVariables_0d ! ====================================================================================== - subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, is_first) + subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, is_first, is_last, conversion_factor) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1588,10 +1614,14 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? logical, intent(in), optional :: is_first ! Should the variable be zeroed first? + logical, intent(in), optional :: is_last ! Should the variable be last in the update? + real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable ! Local logical :: accumulate_local logical :: is_first_local + logical :: is_last_local + real(r8) :: conversion_factor_local ! Default accumulate to false if (present(accumulate)) then @@ -1607,18 +1637,40 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, is_first_local = .false. end if + ! Default is_last to false + if (present(is_last)) then + is_last_local = is_last + else + is_last_local = .false. + end if + + ! Default conversion factor to 1.0 + if (present(conversion_factor)) then + conversion_factor_local = conversion_factor + else + conversion_factor_local = 1.0_r8 + end if + ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local, is_first=is_first_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., & + accumulate=accumulate_local, & + is_first=is_first_local, & + is_last=is_last_local, & + conversion_factor=conversion_factor_local) else - call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., accumulate=accumulate_local, is_first=is_first_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., & + accumulate=accumulate_local, & + is_first=is_first_local, & + is_last=is_last_local, & + conversion_factor=conversion_factor_local) end if end subroutine RegisterInterfaceVariables_1d ! ====================================================================================== - subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first) + subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first, is_last, conversion_factor) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1629,10 +1681,14 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? logical, intent(in), optional :: is_first ! Should the variable be zeroed first? + logical, intent(in), optional :: is_last ! Should the variable be last in the update? + real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable ! Local logical :: accumulate_local logical :: is_first_local + logical :: is_last_local + real(r8) :: conversion_factor_local ! Default accumulate to false if (present(accumulate)) then @@ -1648,11 +1704,33 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first_local = .false. end if + ! Default is_last to false + if (present(is_last)) then + is_last_local = is_last + else + is_last_local = .false. + end if + + ! Default conversion factor to 1.0 + if (present(conversion_factor)) then + conversion_factor_local = conversion_factor + else + conversion_factor_local = 1.0_r8 + end if + ! Get index from registry key and associate the given data pointer if (hlm_flag) then - call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local, is_first=is_first_local) + call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., & + accumulate=accumulate_local, & + is_first=is_first_local, & + is_last=is_last_local, & + conversion_factor=conversion_factor_local) else - call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., accumulate=accumulate_local, is_first=is_first_local) + call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., & + accumulate=accumulate_local, & + is_first=is_first_local, & + is_last=is_last_local, & + conversion_factor=conversion_factor_local) end if end subroutine RegisterInterfaceVariables_2d @@ -1754,7 +1832,7 @@ subroutine UpdateLitterFluxes(this, conversion_flag) if (conversion_flag) then ! Convert from kgC/m2/s to gC/m2/day - call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) + ! call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) ! Get the index for the decomposition thickness key d = this%GetRegistryVariableIndex(hlm_fates_decomp_thickness) @@ -1769,16 +1847,16 @@ subroutine UpdateLitterFluxes(this, conversion_flag) ! Update the HLM variable with the total litterfall j = this%GetRegistryVariableIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) + ! if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then j = this%GetRegistryVariableIndex(hlm_fates_litter_phosphorus_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) + ! if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) j = this%GetRegistryVariableIndex(hlm_fates_litter_nitrogen_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) + ! if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) end if diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index d190afeee9..38fb10d245 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -5,7 +5,8 @@ module FatesInterfaceVariableTypeMod ! related across the application programming interface. ! This method is largely inspired by the FATES history infrastructure - use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use FatesGlobals, only : fates_log use FatesGlobals, only : endrun => fates_endrun @@ -28,9 +29,11 @@ module FatesInterfaceVariableTypeMod logical :: active ! true if the variable is used by the host land model logical :: accumulate ! If true, this variable should add the source to the target logical :: zero_first ! If true, zero the target variable before accumulation + logical :: last_patch ! True if the variable is associated with the last patch for the associated subgrid unit integer :: bc_dir ! 0 if bc_in, 1 if bc_out integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: update_frequency ! frequency of updates + real :: conversion_factor ! conversion factor to adjust units as necessary integer, allocatable :: data_size(:) ! size of the first dimension of the variable contains @@ -219,6 +222,7 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) this%active = .false. this%accumulate = .false. this%zero_first = .false. + this%conversion_factor = nan ! Initialize registry variable components that are updated at variable definition this%key = key @@ -268,25 +272,29 @@ end subroutine NormalizeLitterVariable ! ==================================================================================== - subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate, is_first) + subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate, is_first, is_last, conversion_factor) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data logical, intent(in) :: active logical, intent(in) :: accumulate logical, intent(in) :: is_first + logical, intent(in) :: is_last + real(r8), intent(in) :: conversion_factor this%data0d => data this%active = active this%accumulate = accumulate this%zero_first = is_first + this%last_patch = is_last this%data_rank = rank(data) + this%conversion_factor = conversion_factor end subroutine RegisterInterfaceVariable_0d ! ==================================================================================== - subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first) + subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first, is_last, conversion_factor) class(fates_interface_variable_type), intent(inout) :: this @@ -294,57 +302,55 @@ subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first logical, intent(in) :: active logical, intent(in) :: accumulate logical, intent(in) :: is_first + logical, intent(in) :: is_last + real(r8), intent(in) :: conversion_factor this%data1d => data(:) this%active = active this%accumulate = accumulate this%zero_first = is_first + this%last_patch = is_last this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) + this%conversion_factor = conversion_factor end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== - subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate, is_first) + subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate, is_first, is_last, conversion_factor) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active logical, intent(in) :: accumulate logical, intent(in) :: is_first + logical, intent(in) :: is_last + real(r8), intent(in) :: conversion_factor this%data2d => data(:,:) this%active = active this%accumulate = accumulate this%zero_first = is_first + this%last_patch = is_last this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) this%data_size(2) = size(data, dim=2) + this%conversion_factor = conversion_factor end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== - subroutine UpdateInterfaceVariable(this, var, scalar) + subroutine UpdateInterfaceVariable(this, var) ! Arguments class(fates_interface_variable_type), intent(inout) :: this ! variable being updated class(fates_interface_variable_type), intent(in) :: var ! variable update source - real(r8), intent(in), optional :: scalar ! value to scale variable update ! Locals - real(r8) :: scalar_local character(len=fates_long_string_length) :: msg_mismatch = 'FATES ERROR: Mismatched interface variable types' - ! Check if scalar is present and set default value to one - ! Currently this assumes that the only real values are to be scaled - if (present(scalar)) then - scalar_local = scalar - else - scalar_local = 1.0_r8 - end if - ! Check that the dimensions of the source and target match call this%CompareRegistryVariableSizes(var) @@ -365,9 +371,13 @@ subroutine UpdateInterfaceVariable(this, var, scalar) if (this%zero_first) then dest = 0.0_r8 end if - dest = dest + source * scalar_local + dest = dest + source else - dest = source * scalar_local + dest = source + end if + ! Apply conversion factor if this is the last patch associated with the subgrid unit + if (this%last_patch) then + dest = dest * var%conversion_factor end if class default write(fates_log(),*), msg_mismatch @@ -403,9 +413,12 @@ subroutine UpdateInterfaceVariable(this, var, scalar) if (this%zero_first) then dest = 0.0_r8 end if - dest = dest + source * scalar_local + dest = dest + source else - dest = source * scalar_local + dest = source + end if + if (this%last_patch) then + dest = dest * var%conversion_factor end if class default write(fates_log(),*), msg_mismatch @@ -441,9 +454,12 @@ subroutine UpdateInterfaceVariable(this, var, scalar) if (this%zero_first) then dest = 0.0_r8 end if - dest = dest + source * scalar_local + dest = dest + source else - dest = source * scalar_local + dest = source + end if + if (this%last_patch) then + dest = dest * var%conversion_factor end if class default write(fates_log(),*), msg_mismatch From 8b45cf7310a2d8b48d46b58677cac9c808a0709b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sat, 24 Jan 2026 12:47:05 -0800 Subject: [PATCH 308/331] type fix --- main/FatesInterfaceMod.F90 | 4 ++++ main/FatesInterfaceVarTypeMod.F90 | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index ccf26b398b..4e8fbd1b92 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2943,15 +2943,19 @@ subroutine InitializeBoundaryConditions(this, patches_per_site) call this%registry(r)%Register(key=hlm_fates_litter_carbon_cellulose, & data=bc_out%litt_flux_cel_c_si(1:nlevdecomp), hlm_flag=.false., & conversion_factor=days_per_sec*g_per_kg) + call this%registry(r)%Register(key=hlm_fates_litter_carbon_lignin, & data=bc_out%litt_flux_lig_c_si(1:nlevdecomp), hlm_flag=.false., & conversion_factor=days_per_sec*g_per_kg) + call this%registry(r)%Register(key=hlm_fates_litter_carbon_labile, & data=bc_out%litt_flux_lab_c_si(1:nlevdecomp), hlm_flag=.false., & conversion_factor=days_per_sec*g_per_kg) + call this%registry(r)%Register(key=hlm_fates_litter_carbon_total, & data=bc_out%litt_flux_all_c, hlm_flag=.false., & conversion_factor=days_per_sec*g_per_kg) + if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then call this%registry(r)%Register(key=hlm_fates_litter_phosphorus_cellulose, & data=bc_out%litt_flux_cel_p_si, hlm_flag=.false., & diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 38fb10d245..67b10852e0 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -33,7 +33,7 @@ module FatesInterfaceVariableTypeMod integer :: bc_dir ! 0 if bc_in, 1 if bc_out integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: update_frequency ! frequency of updates - real :: conversion_factor ! conversion factor to adjust units as necessary + real(r8) :: conversion_factor ! conversion factor to adjust units as necessary integer, allocatable :: data_size(:) ! size of the first dimension of the variable contains From 06b6cb8b38707502ad220fbe44208b1de0403cc7 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:04:19 -0800 Subject: [PATCH 309/331] Add interface parameter for subgrid integer ids --- main/FatesInterfaceParametersMod.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index 886803f2d7..f3e09091a9 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -33,5 +33,12 @@ module FatesInterfaceParametersMod ! Registry boundary condition parameters integer, parameter, public :: registry_bc_in = 0 integer, parameter, public :: registry_bc_out = 1 + + ! Registry subgrid object parameters + integer, parameter, public :: registry_var_intid_allsubgrids = 999 + integer, parameter, public :: registry_var_intid_gridcell = 0 + integer, parameter, public :: registry_var_intid_topounit = 1 + integer, parameter, public :: registry_var_intid_landunit = 2 + integer, parameter, public :: registry_var_intid_column = 3 end module FatesInterfaceParametersMod \ No newline at end of file From 21e89870965c3e8ffe5fae3a9377f1c421c512d1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:09:04 -0800 Subject: [PATCH 310/331] add subgrid_type optional argument for interface variable registration --- main/FatesInterfaceTypesMod.F90 | 68 +++++++++++++++++-------------- main/FatesInterfaceVarTypeMod.F90 | 20 +++++---- 2 files changed, 48 insertions(+), 40 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 4fcc6cd57e..325998edb3 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1534,7 +1534,7 @@ end subroutine SetFilterMapArrays ! ====================================================================================== - subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, is_first, is_last, conversion_factor) + subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, is_first, subgrid_type, conversion_factor) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1546,13 +1546,13 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? logical, intent(in), optional :: is_first ! Should the variable be zeroed first? - logical, intent(in), optional :: is_last ! Should the variable be last in the update? - real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable + integer, intent(in), optional :: subgrid_type ! The subgrid integer id associated with this HLM variable + real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable ! Local logical :: accumulate_local logical :: is_first_local - logical :: is_last_local + integer :: subgrid_type_local real(r8) :: conversion_factor_local ! Default accumulate to false @@ -1570,10 +1570,10 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, end if ! Default is_last to false - if (present(is_last)) then - is_last_local = is_last + if (present(subgrid_type)) then + subgrid_type_local = subgrid_type else - is_last_local = .false. + subgrid_type_local = fates_unset_int end if ! Default conversion factor to 1.0 @@ -1588,13 +1588,13 @@ subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., & accumulate=accumulate_local, & is_first=is_first_local, & - is_last=is_last_local, & + subgrid_type=subgrid_type_local, & conversion_factor=conversion_factor_local) else call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data, active=.true., & accumulate=accumulate_local, & is_first=is_first_local, & - is_last=is_last_local, & + subgrid_type=subgrid_type_local, & conversion_factor=conversion_factor_local) end if @@ -1603,8 +1603,7 @@ end subroutine RegisterInterfaceVariables_0d ! ====================================================================================== - subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, is_first, is_last, conversion_factor) - + subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, is_first, subgrid_type, conversion_factor) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1614,13 +1613,13 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? logical, intent(in), optional :: is_first ! Should the variable be zeroed first? - logical, intent(in), optional :: is_last ! Should the variable be last in the update? - real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable + integer, intent(in), optional :: subgrid_type ! The subgrid integer id associated with this HLM variable + real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable ! Local logical :: accumulate_local logical :: is_first_local - logical :: is_last_local + integer :: subgrid_type_local real(r8) :: conversion_factor_local ! Default accumulate to false @@ -1636,12 +1635,19 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, else is_first_local = .false. end if - - ! Default is_last to false - if (present(is_last)) then - is_last_local = is_last + + ! Default subgrid_type to fates_unset_int + if (present(subgrid_type)) then + subgrid_type_local = subgrid_type + else + subgrid_type_local = fates_unset_int + end if + + ! Default conversion factor to 1.0 + if (present(conversion_factor)) then + conversion_factor_local = conversion_factor else - is_last_local = .false. + conversion_factor_local = 1.0_r8 end if ! Default conversion factor to 1.0 @@ -1656,13 +1662,13 @@ subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., & accumulate=accumulate_local, & is_first=is_first_local, & - is_last=is_last_local, & + subgrid_type=subgrid_type_local, & conversion_factor=conversion_factor_local) else call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:), active=.true., & accumulate=accumulate_local, & is_first=is_first_local, & - is_last=is_last_local, & + subgrid_type=subgrid_type_local, & conversion_factor=conversion_factor_local) end if @@ -1670,7 +1676,7 @@ end subroutine RegisterInterfaceVariables_1d ! ====================================================================================== - subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first, is_last, conversion_factor) + subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first, subgrid_type, conversion_factor) ! This procedure is called by the to associate a data variable ! with a particular registry key @@ -1681,13 +1687,13 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, logical, intent(in) :: hlm_flag ! Is the variable being register from the HLM? logical, intent(in), optional :: accumulate ! Should the variable accumulate during the update? logical, intent(in), optional :: is_first ! Should the variable be zeroed first? - logical, intent(in), optional :: is_last ! Should the variable be last in the update? - real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable + integer, intent(in), optional :: subgrid_type ! The subgrid integer id associated with this HLM variable + real(r8), intent(in), optional :: conversion_factor ! Conversion factor for the variable ! Local logical :: accumulate_local logical :: is_first_local - logical :: is_last_local + integer :: subgrid_type_local real(r8) :: conversion_factor_local ! Default accumulate to false @@ -1704,11 +1710,11 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first_local = .false. end if - ! Default is_last to false - if (present(is_last)) then - is_last_local = is_last + ! Default subgrid_type to fates_unset_int + if (present(subgrid_type)) then + subgrid_type_local = subgrid_type else - is_last_local = .false. + subgrid_type_local = fates_unset_int end if ! Default conversion factor to 1.0 @@ -1723,13 +1729,13 @@ subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, call this%hlm_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., & accumulate=accumulate_local, & is_first=is_first_local, & - is_last=is_last_local, & + subgrid_type=subgrid_type_local, & conversion_factor=conversion_factor_local) else call this%fates_vars(this%GetRegistryVariableIndex(key))%Register(data(:,:), active=.true., & accumulate=accumulate_local, & is_first=is_first_local, & - is_last=is_last_local, & + subgrid_type=subgrid_type_local, & conversion_factor=conversion_factor_local) end if diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 67b10852e0..408370790e 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -33,6 +33,7 @@ module FatesInterfaceVariableTypeMod integer :: bc_dir ! 0 if bc_in, 1 if bc_out integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: update_frequency ! frequency of updates + integer :: subgrid_type ! subgrid integer ID associated with this variable real(r8) :: conversion_factor ! conversion factor to adjust units as necessary integer, allocatable :: data_size(:) ! size of the first dimension of the variable @@ -223,6 +224,7 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) this%accumulate = .false. this%zero_first = .false. this%conversion_factor = nan + this%subgrid_type = fates_unset_int ! Initialize registry variable components that are updated at variable definition this%key = key @@ -272,29 +274,29 @@ end subroutine NormalizeLitterVariable ! ==================================================================================== - subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate, is_first, is_last, conversion_factor) + subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate, is_first, subgrid_type, conversion_factor) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data logical, intent(in) :: active logical, intent(in) :: accumulate logical, intent(in) :: is_first - logical, intent(in) :: is_last + integer, intent(in) :: subgrid_type real(r8), intent(in) :: conversion_factor this%data0d => data this%active = active this%accumulate = accumulate this%zero_first = is_first - this%last_patch = is_last this%data_rank = rank(data) this%conversion_factor = conversion_factor + this%subgrid_type = subgrid_type end subroutine RegisterInterfaceVariable_0d ! ==================================================================================== - subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first, is_last, conversion_factor) + subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first, subgrid_type, conversion_factor) class(fates_interface_variable_type), intent(inout) :: this @@ -302,40 +304,40 @@ subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first logical, intent(in) :: active logical, intent(in) :: accumulate logical, intent(in) :: is_first - logical, intent(in) :: is_last + integer, intent(in) :: subgrid_type real(r8), intent(in) :: conversion_factor this%data1d => data(:) this%active = active this%accumulate = accumulate this%zero_first = is_first - this%last_patch = is_last this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) this%conversion_factor = conversion_factor + this%subgrid_type = subgrid_type end subroutine RegisterInterfaceVariable_1d ! ==================================================================================== - subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate, is_first, is_last, conversion_factor) + subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate, is_first, subgrid_type, conversion_factor) class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active logical, intent(in) :: accumulate logical, intent(in) :: is_first - logical, intent(in) :: is_last + integer, intent(in) :: subgrid_type real(r8), intent(in) :: conversion_factor this%data2d => data(:,:) this%active = active this%accumulate = accumulate this%zero_first = is_first - this%last_patch = is_last this%data_rank = rank(data) this%data_size(1) = size(data, dim=1) this%data_size(2) = size(data, dim=2) + this%subgrid_type = subgrid_type this%conversion_factor = conversion_factor end subroutine RegisterInterfaceVariable_2d From a6c8824adc3d15d840846563b4969f2ab911d1b4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:12:24 -0800 Subject: [PATCH 311/331] add issubgridtype function --- main/FatesInterfaceVarTypeMod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 408370790e..3a07c24a44 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -41,6 +41,7 @@ module FatesInterfaceVariableTypeMod procedure :: CheckBounds procedure :: Convert => ConvertScaleInterfaceVariable procedure :: Initialize => InitializeInterfaceVariable + procedure :: IsSubgridType procedure :: Normalize => NormalizeLitterVariable procedure :: Update => UpdateInterfaceVariable procedure :: Dump @@ -233,6 +234,17 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) end subroutine InitializeInterfaceVariable + ! ==================================================================================== + + logical function IsSubgridType(this, subgrid_type) + + class(fates_interface_variable_type), intent(in) :: this + integer, intent(in) :: subgrid_type + + IsSubgridType = (this%subgrid_type == subgrid_type) + + end function IsSubgridType + ! ==================================================================================== subroutine NormalizeLitterVariable(this, norm_var) From 61b72cb626c8837553779e156044dfa35aa1d152 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:13:17 -0800 Subject: [PATCH 312/331] add is_last to interface var type --- main/FatesInterfaceVarTypeMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 3a07c24a44..e9d6ef0462 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -29,7 +29,7 @@ module FatesInterfaceVariableTypeMod logical :: active ! true if the variable is used by the host land model logical :: accumulate ! If true, this variable should add the source to the target logical :: zero_first ! If true, zero the target variable before accumulation - logical :: last_patch ! True if the variable is associated with the last patch for the associated subgrid unit + logical :: is_last ! True if the variable is associated with the last patch for the associated subgrid unit integer :: bc_dir ! 0 if bc_in, 1 if bc_out integer :: data_rank ! rank of the variable (0, 1, 2, or 3) integer :: update_frequency ! frequency of updates @@ -224,6 +224,7 @@ subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) this%active = .false. this%accumulate = .false. this%zero_first = .false. + this%is_last = .false. this%conversion_factor = nan this%subgrid_type = fates_unset_int From 21023c40933b208716c41c2d526d28dbe6377fb1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:13:43 -0800 Subject: [PATCH 313/331] add setlaststate to interface var type --- main/FatesInterfaceVarTypeMod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index e9d6ef0462..b1951f3ef0 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -45,6 +45,7 @@ module FatesInterfaceVariableTypeMod procedure :: Normalize => NormalizeLitterVariable procedure :: Update => UpdateInterfaceVariable procedure :: Dump + procedure :: SetLastState generic :: Register => RegisterInterfaceVariable_0d, & RegisterInterfaceVariable_1d, & @@ -355,6 +356,17 @@ subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate, is_first end subroutine RegisterInterfaceVariable_2d + ! ==================================================================================== + + subroutine SetLastState(this, last_state) + + class(fates_interface_variable_type), intent(inout) :: this + logical, intent(in) :: last_state + + this%is_last = last_state + + end subroutine SetLastState + ! ==================================================================================== subroutine UpdateInterfaceVariable(this, var) From 127f12e756f759f74e99691da91a59c5c77698c4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:15:04 -0800 Subject: [PATCH 314/331] update the interface var update subroutine to new is_last variable --- main/FatesInterfaceVarTypeMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index b1951f3ef0..2250203561 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -403,7 +403,7 @@ subroutine UpdateInterfaceVariable(this, var) dest = source end if ! Apply conversion factor if this is the last patch associated with the subgrid unit - if (this%last_patch) then + if (this%is_last) then dest = dest * var%conversion_factor end if class default @@ -444,7 +444,7 @@ subroutine UpdateInterfaceVariable(this, var) else dest = source end if - if (this%last_patch) then + if (this%is_last) then dest = dest * var%conversion_factor end if class default @@ -485,7 +485,7 @@ subroutine UpdateInterfaceVariable(this, var) else dest = source end if - if (this%last_patch) then + if (this%is_last) then dest = dest * var%conversion_factor end if class default From e0ead67f597967a29f9768256b56310588979d57 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:16:11 -0800 Subject: [PATCH 315/331] add setlaststate to the interface type --- main/FatesInterfaceTypesMod.F90 | 63 +++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 325998edb3..9f2f09e2c8 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -924,6 +924,12 @@ module FatesInterfaceTypesMod integer, private :: fpidx logical, private :: bareground + ! Subgrid last state data + integer, private :: is_last_in_gridcell + integer, private :: is_last_in_topounit + integer, private :: is_last_in_landunit + integer, private :: is_last_in_column + contains procedure :: CheckInterfaceVariables @@ -940,6 +946,7 @@ module FatesInterfaceTypesMod procedure :: IsBareground => HLMPatchIsBareground procedure :: SetSubgridIndices procedure :: SetActiveState + procedure :: SetLastState procedure :: UpdateLitterFluxes procedure :: Update => UpdateInterfaceVariables @@ -1366,6 +1373,62 @@ end subroutine SetActiveState ! ====================================================================================== + subroutine SetLastState(this, subgrid_type) + + ! Set the registry last state flag based on the subgrid type being processed + ! If a subgrid_type is not provided, then reset all last state flags to false + + class(fates_interface_registry_type), intent(inout) :: this + integer, intent(in), optional :: subgrid_type + + ! Local variables + integer :: n + logical :: last_state_local + integer :: subgrid_type_local + + ! If a subgrid type is provided, we set the last state flag for that type at the register level + ! and update the associated local subgrid type variable. + if (present(subgrid_type)) then + select case (subgrid_type) + case(registry_var_intid_gridcell) + this%is_last_in_gridcell = .true. + subgrid_type_local = registry_var_intid_gridcell + case(registry_var_intid_topounit) + this%is_last_in_topounit = .true. + subgrid_type_local = registry_var_intid_topounit + case(registry_var_intid_landunit) + this%is_last_in_landunit = .true. + subgrid_type_local = registry_var_intid_landunit + case(registry_var_intid_column) + this%is_last_in_column = .true. + subgrid_type_local = registry_var_intid_column + case default + write(fates_log(),*) 'ERROR: unrecognised subgrid_type provided to SetLastState()' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + last_state_local = .true. + else + this%is_last_in_gridcell = .false. + this%is_last_in_topounit = .false. + this%is_last_in_landunit = .false. + this%is_last_in_column = .false. + last_state_local = .false. + subgrid_type_local = fates_unset_int + end if + + ! Set the last state flags in the interface variables associated with the subgrid type + ! or if no subgrid type is provided, set all last state flags to false + do n = 1, this%num_api_vars + if (this%hlm_vars(n)%IsSubgridType(subgrid_type_local) .or. subgrid_type_local == fates_unset_int) then + ! write(fates_log(),*) 'SLS: n, lsl, stl: ' , n, last_state_local, subgrid_type_local + call this%hlm_vars(n)%SetLastState(last_state_local) + end if + end do + + end subroutine SetLastState + + ! ====================================================================================== + logical function GetActivateState(this) result(active_state) class(fates_interface_registry_type), intent(inout) :: this From ba475705fc570ee48eda3473ff74f9a4257316ba Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 27 Jan 2026 16:17:25 -0800 Subject: [PATCH 316/331] add interface level subroutine to set last state --- main/FatesInterfaceMod.F90 | 49 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 4e8fbd1b92..71c037cc57 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -181,6 +181,7 @@ module FatesInterfaceMod procedure, public :: InitializeFatesSites procedure, public :: InitializeBoundaryConditions procedure :: SetRegistryActiveState + procedure :: SetRegistryLastState procedure, public :: UpdateInterfaceVariables procedure, public :: UpdateLitterFluxes @@ -2302,6 +2303,51 @@ subroutine SetRegistryActiveState(this) end subroutine SetRegistryActiveState + ! ==================================================================================== + + subroutine SetRegistryLastState(this) + + use FatesInterfaceParametersMod, only : registry_var_intid_column + + ! Argument + class(fates_interface_type), intent(inout) :: this + + ! Locals + integer :: n ! loop index + integer :: r, r_next ! registry index + integer :: c, c_next ! column index + + ! Loop over all active registries and set the last state to the current state + do n = 1, this%num_active_patches + + ! Set the registry indices for the current and previous active registry + r = this%filter_registry_active(n) + + ! Set last in subgrid state to false by default + call this%registry(r)%SetLastState() + + ! Get the column index for the current and previous active registry + c = this%registry(r)%GetColumnIndex() + + ! If the next index is greater than the current, set the previous last state to true + if (n .lt. this%num_active_patches) then + r_next = this%filter_registry_active(n+1) + c_next = this%registry(r_next)%GetColumnIndex() + if (c_next .ne. c) call this%registry(r)%SetLastState(registry_var_intid_column) + ! if (c_next .ne. c) write(fates_log(),*) 'SRLS: n, r, c: ', n, r, c + else + call this%registry(r)%SetLastState(registry_var_intid_column) + ! write(fates_log(),*) 'SRLS: n, r, c: ', n, r, c + end if + + ! ! If this is the last active registry, set its last state to true for all subgrid cases + ! if (n .eq. this%num_active_patches) call this%registry(r)%SetLastState(registry_var_intid_column) + ! if (n .eq. this%num_active_patches) write(fates_log(),*) 'SRLS: n, rp, cp: ', n, r_prev, c_prev + + end do + + end subroutine SetRegistryLastState + ! ==================================================================================== subroutine FatesReportParameters(masterproc) @@ -3098,6 +3144,9 @@ subroutine UpdateLitterFluxes(this, dtime) ! Set the registry active state call this%SetRegistryActiveState() + + ! Set the registry last state + call this%SetRegistryLastState() ! Loop through the active registries and update the litter fluxes do n = 1, this%num_active_patches From e64db778e304822f069f5e73decedd6ed27b3c7e Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 09:46:14 -0800 Subject: [PATCH 317/331] remove temporary diagnostics from fatessoilbgcfluxmod --- biogeochem/FatesSoilBGCFluxMod.F90 | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index b65e88d830..7100359ed9 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -821,26 +821,8 @@ subroutine FluxIntoLitterPools(csite) litt%root_fines_frag(ilignin,j) * area_frac enddo - ! write(fates_log(),*) 'FILP: pn, el, cel, lig, lab : ', currentPatch%patchno, el, sum(flux_cel_si(:)), sum(flux_lig_si(:)), sum(flux_lab_si(:)) - ! Convert from kg/m2/day -> g/m3/s - ! flux_cel_si(:) = flux_cel_si(:) * days_per_sec * g_per_kg - ! flux_lig_si(:) = flux_lig_si(:) * days_per_sec * g_per_kg - ! flux_lab_si(:) = flux_lab_si(:) * days_per_sec * g_per_kg - ! Calculate the total flux of C into the litter pools flux_all_si = sum(flux_cel_si(:)) + sum(flux_lig_si(:)) + sum(flux_lab_si(:)) - write(fates_log(),*) 'FILP: p, el, cel, lig, lab: ', currentPatch%patchno, el, sum(flux_cel_si(:)), sum(flux_lig_si(:)), sum(flux_lab_si(:)) - - ! Normalize all masses over the decomposition layer's depth - ! do id = 1,nlev_eff_decomp - ! flux_cel_si(id) = flux_cel_si(id) / bc_in%dz_decomp_sisl(id) - ! flux_lig_si(id) = flux_lig_si(id) / bc_in%dz_decomp_sisl(id) - ! flux_lab_si(id) = flux_lab_si(id) / bc_in%dz_decomp_sisl(id) - ! end do - - ! flux_all_si = sum(flux_cel_si(:) * bc_in%dz_decomp_sisl(:)) + & - ! sum(flux_lig_si(:) * bc_in%dz_decomp_sisl(:)) + & - ! sum(flux_lab_si(:) * bc_in%dz_decomp_sisl(:)) end do flux_elem_loop From 067e7ee0b9ff5a11500f1d80d93e477273c2f03d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 09:47:36 -0800 Subject: [PATCH 318/331] reinstate area_frac in MIMICS portion of fluxintolitterpools --- biogeochem/FatesSoilBGCFluxMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 7100359ed9..4da6180516 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -886,17 +886,17 @@ subroutine FluxIntoLitterPools(csite) end do if(tot_wood_c>nearzero) then - sum_N = sum_N + sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) - sum_N = sum_N + sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + area_frac*sum(litt%ag_cwd_frag)*(tot_wood_n/tot_wood_c) + sum_N = sum_N + area_frac*sum(litt%bg_cwd_frag)*(tot_wood_n/tot_wood_c) end if if(tot_leaf_c>nearzero)then - sum_N = sum_N + sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) + sum_N = sum_N + area_frac*sum(litt%leaf_fines_frag)*(tot_leaf_n / tot_leaf_c) end if if(tot_fnrt_c>nearzero)then - sum_N = sum_N + sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) + sum_N = sum_N + area_frac*sum(litt%root_fines_frag)*(tot_fnrt_n / tot_fnrt_c) end if do ipft = 1,numpft - sum_N = sum_N + currentPatch%nitr_repro_stoich(ipft) * & + sum_N = sum_N + area_frac*currentPatch%nitr_repro_stoich(ipft) * & (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) end do From bb5b4f0c055364cc25f6cfff5674d7189c083895 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 09:53:55 -0800 Subject: [PATCH 319/331] add comments to the new site type procedures --- main/EDTypesMod.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5a61bd7146..544defe5e0 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -633,6 +633,9 @@ module EDTypesMod ! ============================================================================ subroutine AllocateRegistryIndexArray(this, patches_per_site) + + ! Allocates an array that maps the local patch number on a site to its + ! associated registry index ! Arguments class(ed_site_type), intent(inout) :: this @@ -647,6 +650,9 @@ end subroutine AllocateRegistryIndexArray ! ============================================================================ integer function GetRegistryIndex(this, ifp) result(ridx) + + ! Gets the registry index for a given local patch number from the + ! site object registry index mapping array ! Arguments class(ed_site_type), intent(in) :: this @@ -659,6 +665,9 @@ end function GetRegistryIndex ! ============================================================================ subroutine SetRegistryIndex(this, ifp, ridx) + + ! Sets the registry index for a given local patch number in the + ! site object registry index mapping array ! Arguments class(ed_site_type), intent(inout) :: this From 34b0a1ebe6498c2fe67a0c9b4d6fb60fd8dffb19 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 09:56:26 -0800 Subject: [PATCH 320/331] remove unused interface parameter --- main/FatesInterfaceParametersMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/main/FatesInterfaceParametersMod.F90 b/main/FatesInterfaceParametersMod.F90 index f3e09091a9..31e4d8c0ae 100644 --- a/main/FatesInterfaceParametersMod.F90 +++ b/main/FatesInterfaceParametersMod.F90 @@ -35,7 +35,6 @@ module FatesInterfaceParametersMod integer, parameter, public :: registry_bc_out = 1 ! Registry subgrid object parameters - integer, parameter, public :: registry_var_intid_allsubgrids = 999 integer, parameter, public :: registry_var_intid_gridcell = 0 integer, parameter, public :: registry_var_intid_topounit = 1 integer, parameter, public :: registry_var_intid_landunit = 2 From 2b51cf4bdaf25323308d8088a72c5f1605fce97c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 10:26:16 -0800 Subject: [PATCH 321/331] add descriptive comments to the new fates interface registry procedures --- main/FatesInterfaceMod.F90 | 36 +++++++++++++++++++++++++++++++----- 1 file changed, 31 insertions(+), 5 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 71c037cc57..b184981cc0 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2255,6 +2255,12 @@ end subroutine set_fates_ctrlparms ! ==================================================================================== subroutine SetRegistryActiveState(this) + + ! This subroutine determines if a registry is active, i.e. whether it is associated + ! with a FATES patch. Registries are allocated during initialization to the maximum + ! number of possible patches, but not all FATES patches will necessarily be created + ! particularly during a cold start. As such, we need a procedure to determine with + ! each API update, which registries are active to avoid passing invalid data. ! Argument class(fates_interface_type), intent(inout) :: this @@ -2306,6 +2312,13 @@ end subroutine SetRegistryActiveState ! ==================================================================================== subroutine SetRegistryLastState(this) + + ! This procedure determines when a registry is the last in a series to be associated + ! with a specific subgrid object index (e.g. column index). The API design currently + ! implements any unit conversion or scaling as a last step after all data associated + ! with the specific subgrid object has been passed to the HLM. As such, we need to + ! identify when the next registry index in the series is associated with a different + ! subgrid object index. use FatesInterfaceParametersMod, only : registry_var_intid_column @@ -2861,6 +2874,10 @@ end subroutine InitializeInterfaceRegistry ! ====================================================================================== subroutine InitializeFatesSites(this, patches_per_site) + + ! This procedure initializes the FATES sites by iterating through the number of + ! vegetated patches and incrementing the number of sites when a new gridcell index + ! is encountered. class(fates_interface_type), intent(inout) :: this ! fates interface integer, intent(in) :: patches_per_site ! number of patches per site @@ -2927,6 +2944,11 @@ end subroutine InitializeFatesSites ! ====================================================================================== subroutine InitializeBoundaryConditions(this, patches_per_site) + + ! This procedure initializes the boundary conditions arrays with the maximum number + ! of possible patches for each FATES site. It then registers the boundary condition + ! variables for each patch. Conversion factors are applied as necessary during + ! registration, which will be utilized during the update API calls. use FatesInterfaceParametersMod use FatesConstantsMod , only : days_per_sec @@ -3037,6 +3059,11 @@ end subroutine InitializeBoundaryConditions ! ====================================================================================== subroutine UpdateInterfaceVariables(this, initialize, restarting) + + ! This procedure is responsible for updating the bulk of the interface variables by + ! iterating through each registry entry. It also handles special updates during + ! initialization and restart relating to the maximum rooting depth index, nlevdecomp + ! and the decomp_id. ! Arguments class(fates_interface_type), intent(inout) :: this @@ -3121,17 +3148,16 @@ subroutine UpdateInterfaceVariables(this, initialize, restarting) ! unless we are restarting if (.not. restarting_local) bc_in%max_rooting_depth_index_col = bc_in%nlevdecomp - end if - end do - end subroutine UpdateInterfaceVariables ! ====================================================================================== subroutine UpdateLitterFluxes(this, dtime) + + ! This procedure handles the updating of litter fluxes from FATES to the HLM. class(fates_interface_type), intent(inout) :: this real(r8), intent(in) :: dtime ! HLM timestep @@ -3167,8 +3193,8 @@ subroutine UpdateLitterFluxes(this, dtime) conversion_flag = .true. end if - write(fates_log(),*) 'update litter flux, n, r, cflag: ', n, r, conversion_flag - write(fates_log(),*) 'update litter flux, s, c: ', this%registry(r)%GetSiteIndex(), this%registry(r)%GetColumnIndex() + ! write(fates_log(),*) 'update litter flux, n, r, cflag: ', n, r, conversion_flag + ! write(fates_log(),*) 'update litter flux, s, c: ', this%registry(r)%GetSiteIndex(), this%registry(r)%GetColumnIndex() call this%registry(r)%UpdateLitterFluxes(conversion_flag) From 32c24650e02974e0b4244f59e1e7855845361ae4 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 10:37:40 -0800 Subject: [PATCH 322/331] remove subgrid level parameters Moved to the interfaceparameter module --- main/FatesInterfaceTypesMod.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 9f2f09e2c8..06c53db330 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -287,16 +287,6 @@ module FatesInterfaceTypesMod integer, parameter, public :: fates_dispersal_cadence_monthly = 2 ! Disperse seeds monthly integer, parameter, public :: fates_dispersal_cadence_yearly = 3 ! Disperse seeds yearly - integer, parameter :: hlm_subgrid_levels = 5 ! The number of subgrid hierarchy levels that the HLM - ! Including the gridcell level, ELM = 5, CLM = 4 - - ! Subgrid levels for HLM-FATES interface variable - integer, parameter, public :: subgrid_gridcell_index = 5 - integer, parameter, public :: subgrid_topounit_index = 4 - integer, parameter, public :: subgrid_landunit_index = 3 - integer, parameter, public :: subgrid_column_index = 2 - integer, parameter, public :: subgrid_patch_index = 1 - ! ------------------------------------------------------------------------------------- ! These vectors are used for history output mapping ! CLM/ALM have limited support for multi-dimensional history output arrays. From 29e9a20307a2dac73039bbf2cdf9238a573e1e9c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 11:04:22 -0800 Subject: [PATCH 323/331] add descriptive comments to the new interfacetypemod procedures --- main/FatesInterfaceTypesMod.F90 | 70 ++++++++++++++++++++++++++++----- 1 file changed, 61 insertions(+), 9 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 06c53db330..7ee95a5a59 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -976,6 +976,12 @@ end subroutine ZeroBCOutCarbonFluxes ! ====================================================================================== subroutine InitializeBCIn(this) + + ! This procedure initializes the input boundary condition structure by allocating + ! the associated variables arrays and unsetting their values. Note that some of the + ! input boundary conditions are used to initialize the output boundary conditions + ! and as such, this initialization must occur prior to the output boundary condition + ! initialization. ! Arguments class(bc_in_type), intent(inout) :: this @@ -999,6 +1005,12 @@ end subroutine InitializeBCIn subroutine InitializeBCOut(this, bc_in) + ! This procedure initializes the output boundary condition structure by allocating + ! the associated variables arrays and unsetting their values. Note that the input + ! boundary conditions are needed to determine the set the size of some of the output + ! boundary condition arrays and as such, this procedure should be called after + ! the input boundary condition initialization. + ! Arguments class(bc_out_type), intent(inout) :: this type(bc_in_type), intent(in) :: bc_in @@ -1038,7 +1050,9 @@ end subroutine InitializeBCOut subroutine InitializeInterfaceRegistry(this) - ! This initializes the interface registry + ! This initializes the interface registry with the associated variable counters, filters, + ! and metadata. This procedure calls the interface registry definition procedure which + ! is necessary to allow for the registration of the HLM and FATES variables. class(fates_interface_registry_type), intent(inout) :: this @@ -1139,8 +1153,12 @@ end subroutine CheckInterfaceVariables subroutine DefineInterfaceRegistry(this, initialize) - ! This procedure defines the list of common names to be associated with FATES and HLM - ! variables. + ! This procedure defines the list of common names (i.e. "keys") to be associated with + ! FATES and HLM variables. All new keys, regardless of whether or not they are used + ! in a particular run mode or by a specific host land model, must be defined here. + ! For a future update, this procedure could be split in a manner similar to the fates + ! history interface module, where related keys are grouped together in separate procedure + ! calls to provide clarity to the developer and/or definion based on run mode . class(fates_interface_registry_type), intent(inout) :: this @@ -1153,6 +1171,7 @@ subroutine DefineInterfaceRegistry(this, initialize) associate(bc_in => registry_bc_in, & bc_out => registry_bc_out) + ! Define the interface registry names and indices ! Variables that need to be updated during initialization and are necessary for other boundary conditions ! such as dimensions @@ -1211,6 +1230,10 @@ end subroutine DefineInterfaceRegistry ! ====================================================================================== subroutine DefineInterfaceVariable(this, key, initialize, index, update_frequency, bc_dir) + + ! This procedure initializes the interface variables for this registry passing the + ! key associated with the variables along with other relavant data. The procedure + ! also increments various registry counters depending on the input arguments. class(fates_interface_registry_type), intent(inout) :: this @@ -1328,6 +1351,10 @@ end subroutine DefineInterfaceVariable ! ====================================================================================== subroutine SetSubgridIndices(this, gridcell, topounit, landunit, column, hlmpatch, fatespatch, site, bareground) + + ! This procedure sets the associated HLM subgrid index values for the calling registry. + ! This is provided so that the FATES registry and interface variable subroutines can + ! have access to the HLM subgrid indices as needed internal to the FATES code. class(fates_interface_registry_type), intent(inout) :: this integer, intent(in), optional :: gridcell @@ -1354,6 +1381,8 @@ end subroutine SetSubgridIndices subroutine SetActiveState(this, active_state) + ! This procedure sets the registry active state flag for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this logical, intent(in) :: active_state @@ -1421,6 +1450,8 @@ end subroutine SetLastState logical function GetActivateState(this) result(active_state) + ! This procedure gets the registry active state flag for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this active_state = this%active @@ -1431,6 +1462,8 @@ end function GetActivateState integer function GetGridcellIndex(this) result(gidx) + ! This procedure gets the HLM gridcell index for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this gidx = this%gidx @@ -1441,6 +1474,8 @@ end function GetGridcellIndex integer function GetLandunitIndex(this) result(lidx) + ! This procedure gets the HLM landunit index for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this lidx = this%lidx @@ -1451,6 +1486,8 @@ end function GetLandunitIndex integer function GetColumnIndex(this) result(cidx) + ! This procedure gets the HLM column index for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this cidx = this%cidx @@ -1461,6 +1498,8 @@ end function GetColumnIndex integer function GetHLMPatchIndex(this) result(hpidx) + ! This procedure gets the HLM patch index for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this hpidx = this%hpidx @@ -1471,6 +1510,8 @@ end function GetHLMPatchIndex integer function GetSiteIndex(this) result(sidx) + ! This procedure gets the FATES site index for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this sidx = this%sidx @@ -1481,6 +1522,8 @@ end function GetSiteIndex integer function GetFatesPatchIndex(this) result(fpidx) + ! This procedure gets the FATES patch index for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this fpidx = this%fpidx @@ -1491,6 +1534,8 @@ end function GetFatesPatchIndex logical function HLMPatchIsBareGround(this) result(bareground) + ! This procedure gets the HLM bareground flag for the calling registry. + class(fates_interface_registry_type), intent(inout) :: this bareground = this%bareground @@ -1500,6 +1545,10 @@ end function HLMPatchIsBareGround ! ====================================================================================== subroutine SetFilterMapArrays(this) + + ! This procedure sets the filter mapping arrays for the interface registry. These + ! filters are provided as a mean to quickly access the registry indices for specific + ! variable types (e.g. those that update on the model timestep) class(fates_interface_registry_type), intent(inout) :: this @@ -1589,8 +1638,7 @@ end subroutine SetFilterMapArrays subroutine RegisterInterfaceVariables_0d(this, key, data, hlm_flag, accumulate, is_first, subgrid_type, conversion_factor) - ! This procedure is called by the to associate a data variable - ! with a particular registry key + ! This procedure associates a scalar data variable with a particular registry key ! Arguments class(fates_interface_registry_type), intent(inout) :: this @@ -1657,8 +1705,8 @@ end subroutine RegisterInterfaceVariables_0d ! ====================================================================================== subroutine RegisterInterfaceVariables_1d(this, key, data, hlm_flag, accumulate, is_first, subgrid_type, conversion_factor) - ! This procedure is called by the to associate a data variable - ! with a particular registry key + + ! This procedure associates 1D array data variable with a particular registry key class(fates_interface_registry_type), intent(inout) :: this class(*), target, intent(in) :: data(:) ! data to be associated with key @@ -1731,8 +1779,7 @@ end subroutine RegisterInterfaceVariables_1d subroutine RegisterInterfaceVariables_2d(this, key, data, hlm_flag, accumulate, is_first, subgrid_type, conversion_factor) - ! This procedure is called by the to associate a data variable - ! with a particular registry key + ! This procedure associates 2D array data variable with a particular registry key class(fates_interface_registry_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) ! data to be associated with key @@ -1797,6 +1844,9 @@ end subroutine RegisterInterfaceVariables_2d ! ====================================================================================== subroutine InitializeInterfaceVariablesDimensions(this) + + ! This procedure initializes the interface variables that are used as dimensions + ! for initializing other interface variables. ! Arguments class(fates_interface_registry_type), intent(inout) :: this ! registry being initialized @@ -1821,6 +1871,8 @@ end subroutine InitializeInterfaceVariablesDimensions ! ====================================================================================== subroutine InitializeInterfaceVariables(this) + + ! This procedure updates the interface variables that are used during initialization. ! Arguments class(fates_interface_registry_type), intent(inout) :: this ! registry being initialized From 106dfff06b546cd2038faaa984c2e44c770ad602 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 15:06:52 -0800 Subject: [PATCH 324/331] add more descriptive comments for the new interfacetype module procedures --- main/FatesInterfaceTypesMod.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 7ee95a5a59..7b90ded913 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1897,6 +1897,8 @@ end subroutine InitializeInterfaceVariables ! ====================================================================================== subroutine UpdateInterfaceVariables(this) + + ! This procedure updates BC input interface variables class(fates_interface_registry_type), intent(inout) :: this @@ -1916,6 +1918,11 @@ end subroutine UpdateInterfaceVariables ! subroutine UpdateLitterFluxes(this, dtime) subroutine UpdateLitterFluxes(this, conversion_flag) + ! This procedure updates the litter flux output boundary conditions + ! This procedure is separated from other update calls as it happens + ! on the model time-step and has specific update calls for the total + ! litterfall per nutrient type based on run mode + use FatesConstantsMod, only : days_per_sec use FatesConstantsMod, only : g_per_kg From 3a033661e446a0c4a79cdc88a61c954a51bf578a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 15:26:43 -0800 Subject: [PATCH 325/331] add descriptive comments to the new interfacevartype procedures --- main/FatesInterfaceVarTypeMod.F90 | 47 ++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index 2250203561..a0cece4cca 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -2,7 +2,7 @@ module FatesInterfaceVariableTypeMod ! This module contains the type definition and associated type-bound procedures ! used to create an indexed list of associated HLM and FATES variables that are - ! related across the application programming interface. + ! related across the HLM-FATES application programming interface (API). ! This method is largely inspired by the FATES history infrastructure use shr_log_mod , only : errMsg => shr_log_errMsg @@ -19,6 +19,11 @@ module FatesInterfaceVariableTypeMod private ! Interface registry variable type + ! This defined type holds the pointer to HLM or FATES variable that is + ! associated with a common "key" name (defined in the interface parameter types). + ! It also includes a set of data characterizing the type of data not defined by + ! type or rank (e.g. HLM subgrid association, update frequency, etc). + type, public :: fates_interface_variable_type character(len=48) :: key ! common registry key @@ -63,6 +68,9 @@ module FatesInterfaceVariableTypeMod ! ==================================================================================== subroutine CheckBounds(this, var) + + ! This procedure checks that the data bounds of the calling variable are consistent + ! with the data bounds of the input argument variable class(fates_interface_variable_type), intent(in) :: this class(fates_interface_variable_type), intent(in) :: var @@ -155,6 +163,10 @@ end subroutine ConvertScaleInterfaceVariable ! ==================================================================================== subroutine Dump(this) + + ! This procedure will print output to the log file. Developers should use this + ! procedure for diagnostic purposes when attempt to review interface variable + ! data as it includes select type statements to resolve the polymorphic data types. class(fates_interface_variable_type), intent(in) :: this @@ -206,6 +218,10 @@ end subroutine Dump ! ==================================================================================== subroutine InitializeInterfaceVariable(this, key, update_frequency, bc_dir) + + ! This procedure initializes an interface variable assigning its key + ! update frequency and boundary condition direction. It also unsets + ! all other variables including the data pointers. class(fates_interface_variable_type), intent(inout) :: this character(len=*), intent(in) :: key @@ -239,6 +255,9 @@ end subroutine InitializeInterfaceVariable ! ==================================================================================== logical function IsSubgridType(this, subgrid_type) + + ! This procedure will check if the subgrid type of the interface variable + ! matches the input argument subgrid type class(fates_interface_variable_type), intent(in) :: this integer, intent(in) :: subgrid_type @@ -289,6 +308,10 @@ end subroutine NormalizeLitterVariable ! ==================================================================================== subroutine RegisterInterfaceVariable_0d(this, data, active, accumulate, is_first, subgrid_type, conversion_factor) + + ! This procedure registers the interface variable by associating the data pointer with + ! the scalar input data argument. It also sets a number of required and optional arguments + ! for metadata associated with the variable. class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data @@ -312,6 +335,10 @@ end subroutine RegisterInterfaceVariable_0d subroutine RegisterInterfaceVariable_1d(this, data, active, accumulate, is_first, subgrid_type, conversion_factor) + ! This procedure registers the interface variable by associating the data pointer with + ! the 1D array input data argument. It also sets a number of required and optional arguments + ! for metadata associated with the variable. + class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:) @@ -336,6 +363,10 @@ end subroutine RegisterInterfaceVariable_1d subroutine RegisterInterfaceVariable_2d(this, data, active, accumulate, is_first, subgrid_type, conversion_factor) + ! This procedure registers the interface variable by associating the data pointer with + ! the 2D array input data argument. It also sets a number of required and optional arguments + ! for metadata associated with the variable. + class(fates_interface_variable_type), intent(inout) :: this class(*), target, intent(in) :: data(:,:) logical, intent(in) :: active @@ -359,6 +390,8 @@ end subroutine RegisterInterfaceVariable_2d ! ==================================================================================== subroutine SetLastState(this, last_state) + + ! This procedure sets the last state logical metadata for the calling interface variable class(fates_interface_variable_type), intent(inout) :: this logical, intent(in) :: last_state @@ -370,6 +403,15 @@ end subroutine SetLastState ! ==================================================================================== subroutine UpdateInterfaceVariable(this, var) + + ! This is the main procedure that drives the updates between the HLM and FATES. + ! It updates the calling interface variable data with data from the argument + ! interface variable. Directionality of the update is from the argument to the + ! caller. The bulk of the code here is type selects to handle the polymorphic + ! data pointers in the interface variables types. + ! This procedure utilizes metadata stored in the interface variables to determine + ! how updates should be handled, for example whether or not to zero the calling + ! interface variable data prior to adding the argument variable data to it. ! Arguments class(fates_interface_variable_type), intent(inout) :: this ! variable being updated @@ -521,6 +563,9 @@ end subroutine UpdateInterfaceVariable ! ==================================================================================== subroutine CompareRegistryVariableSizes(this, var) + + ! This procedure checks to make sure that the ranks and size of the + ! data associated with the interface variables is the same. class(fates_interface_variable_type), intent(in) :: this ! variable being updated class(fates_interface_variable_type), intent(in) :: var ! variable update source From 0a468c9fd939ce523749d49c8df3c49c3d6796aa Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 28 Jan 2026 15:57:16 -0800 Subject: [PATCH 326/331] remove unused conversion calls These are now handled in Update automatically --- main/FatesInterfaceTypesMod.F90 | 6 ------ 1 file changed, 6 deletions(-) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 7b90ded913..14e147a1a7 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1949,9 +1949,6 @@ subroutine UpdateLitterFluxes(this, conversion_flag) ! If the conversion flag is set, convert and scale the updated HLM litter flux interface variable if (conversion_flag) then - ! Convert from kgC/m2/s to gC/m2/day - ! call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) - ! Get the index for the decomposition thickness key d = this%GetRegistryVariableIndex(hlm_fates_decomp_thickness) @@ -1965,16 +1962,13 @@ subroutine UpdateLitterFluxes(this, conversion_flag) ! Update the HLM variable with the total litterfall j = this%GetRegistryVariableIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - ! if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) if (hlm_parteh_mode == prt_cnp_flex_allom_hyp) then j = this%GetRegistryVariableIndex(hlm_fates_litter_phosphorus_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - ! if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) j = this%GetRegistryVariableIndex(hlm_fates_litter_nitrogen_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) - ! if (conversion_flag) call this%hlm_vars(j)%Convert(days_per_sec * g_per_kg) end if From 82137a95e5d09b579e2cea1c6c536e2b1bf18b17 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 1 Feb 2026 11:47:03 -0800 Subject: [PATCH 327/331] change conversion (normalization_flag) to be an output of the update procedure --- main/FatesInterfaceMod.F90 | 21 +-------------------- main/FatesInterfaceTypesMod.F90 | 22 ++++++++++++---------- main/FatesInterfaceVarTypeMod.F90 | 12 ++++++++---- 3 files changed, 21 insertions(+), 34 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b184981cc0..6cdde56391 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -3166,7 +3166,6 @@ subroutine UpdateLitterFluxes(this, dtime) integer :: n ! active registry index iterator integer :: r ! registry index integer :: next_r - logical :: conversion_flag ! Set the registry active state call this%SetRegistryActiveState() @@ -3178,25 +3177,7 @@ subroutine UpdateLitterFluxes(this, dtime) do n = 1, this%num_active_patches r = this%filter_registry_active(n) - ! Set converstion flag to false by default - conversion_flag = .false. - - ! Look ahead and determine if the next registry is for a different column. - ! If so, we need to convert the accumulated litter fluxes - ! This is facilitated by the fact that the column indices are monotonically increasing per the HLM - if (n .lt. this%num_active_patches) then - next_r = this%filter_registry_active(n+1) - if (this%registry(r)%GetColumnIndex() .ne. this%registry(next_r)%GetColumnIndex()) then - conversion_flag = .true. - end if - else - conversion_flag = .true. - end if - - ! write(fates_log(),*) 'update litter flux, n, r, cflag: ', n, r, conversion_flag - ! write(fates_log(),*) 'update litter flux, s, c: ', this%registry(r)%GetSiteIndex(), this%registry(r)%GetColumnIndex() - - call this%registry(r)%UpdateLitterFluxes(conversion_flag) + call this%registry(r)%UpdateLitterFluxes() end do diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 14e147a1a7..aaed3585fe 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -1916,7 +1916,7 @@ end subroutine UpdateInterfaceVariables ! ====================================================================================== ! subroutine UpdateLitterFluxes(this, dtime) - subroutine UpdateLitterFluxes(this, conversion_flag) + subroutine UpdateLitterFluxes(this) ! This procedure updates the litter flux output boundary conditions ! This procedure is separated from other update calls as it happens @@ -1929,37 +1929,39 @@ subroutine UpdateLitterFluxes(this, conversion_flag) ! Arguments class(fates_interface_registry_type), intent(inout) :: this ! real(r8), intent(in) :: dtime - logical, intent(in) :: conversion_flag ! Locals integer :: i integer :: j integer :: k - integer :: d - real(r8) :: conversion_factor + logical :: normalization_flag ! Iterate over the litter flux filter to update the individual litter types do i = 1, this%num_api_vars_litter_flux j = this%filter_litter_flux(i) ! Update the hlm variables with the fates variables - ! call this%hlm_vars(j)%Update(this%fates_vars(j), scalar=dtime) - call this%hlm_vars(j)%Update(this%fates_vars(j)) + call this%hlm_vars(j)%Update(this%fates_vars(j), normalization_flag) - ! If the conversion flag is set, convert and scale the updated HLM litter flux interface variable - if (conversion_flag) then + ! If the normalization flag is set, scale the updated HLM litter flux interface variable + ! by the decomposition layer thickness. + ! The normalization factor could be set during the registration call in a manner similar + ! to the unit conversation factor, but given that not all interface variables may need normalization + ! and the normalization factor is not necessarily a simple standard constant, we handle it here for now. + if (normalization_flag) then ! Get the index for the decomposition thickness key - d = this%GetRegistryVariableIndex(hlm_fates_decomp_thickness) + k = this%GetRegistryVariableIndex(hlm_fates_decomp_thickness) ! Normalize the litter fluxes against the decomposition layer thicknesses - call this%hlm_vars(j)%Normalize(this%fates_vars(d)) + call this%hlm_vars(j)%Normalize(this%fates_vars(k)) end if end do ! Update the HLM variable with the total litterfall + ! These are not currently included in the litter flux filter as these are not normalized j = this%GetRegistryVariableIndex(hlm_fates_litter_carbon_total) call this%hlm_vars(j)%Update(this%fates_vars(j)) diff --git a/main/FatesInterfaceVarTypeMod.F90 b/main/FatesInterfaceVarTypeMod.F90 index a0cece4cca..fbb965e033 100644 --- a/main/FatesInterfaceVarTypeMod.F90 +++ b/main/FatesInterfaceVarTypeMod.F90 @@ -402,7 +402,7 @@ end subroutine SetLastState ! ==================================================================================== - subroutine UpdateInterfaceVariable(this, var) + subroutine UpdateInterfaceVariable(this, var, is_last) ! This is the main procedure that drives the updates between the HLM and FATES. ! It updates the calling interface variable data with data from the argument @@ -414,15 +414,19 @@ subroutine UpdateInterfaceVariable(this, var) ! interface variable data prior to adding the argument variable data to it. ! Arguments - class(fates_interface_variable_type), intent(inout) :: this ! variable being updated - class(fates_interface_variable_type), intent(in) :: var ! variable update source + class(fates_interface_variable_type), intent(inout) :: this ! variable being updated + class(fates_interface_variable_type), intent(in) :: var ! variable update source + logical, intent(out), optional :: is_last ! true if last patch for subgrid unit ! Locals character(len=fates_long_string_length) :: msg_mismatch = 'FATES ERROR: Mismatched interface variable types' ! Check that the dimensions of the source and target match call this%CompareRegistryVariableSizes(var) - + + ! If the is_last argument is present, output the is_last flag state for this variable + if (present(is_last)) is_last = this%is_last + ! Update the data of the target variable using the source variable data pointer ! Make sure the types match for the polymorphic data to allow for copying from the ! source to the target. From e073d06f4f47ca1efe631c3c0862508283a06300 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux <7565064+glemieux@users.noreply.github.com> Date: Wed, 25 Feb 2026 14:31:56 -0800 Subject: [PATCH 328/331] Add comment about active register bareground check --- main/FatesInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 6cdde56391..0b165a97bc 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2289,6 +2289,7 @@ subroutine SetRegistryActiveState(this) currentPatch => this%sites(s)%oldest_patch do while (associated(currentPatch)) + ! This check is necessary until FATES no longer instantiates a bareground patch if (currentPatch%nocomp_pft_label .ne. nocomp_bareground) then ! Get the registry index for the current site + patch combo and set it to active From 8e048e61621638780c7f1184cfe989de6a53f2d5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 27 Feb 2026 16:46:52 -0800 Subject: [PATCH 329/331] remove bareground check by passing the fully bc_array into fragmentation scalar proc --- biogeochem/EDPhysiologyMod.F90 | 7 ++++--- main/EDMainMod.F90 | 4 ---- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 78dbc94205..2e93f003c5 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -452,7 +452,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) ! !ARGUMENTS type(ed_site_type), intent(inout) :: currentSite type(fates_patch_type), intent(inout) :: currentPatch - type(bc_in_type), intent(in) :: bc_in + type(bc_in_type), intent(in) :: bc_in(:) ! ! !LOCAL VARIABLES: @@ -3192,7 +3192,7 @@ subroutine fragmentation_scaler( currentPatch, bc_in) ! ! !ARGUMENTS type(fates_patch_type), intent(inout) :: currentPatch - type(bc_in_type), intent(in) :: bc_in + type(bc_in_type), intent(in) :: bc_in(:) ! ! !LOCAL VARIABLES: @@ -3215,7 +3215,8 @@ subroutine fragmentation_scaler( currentPatch, bc_in) if ( use_hlm_soil_scalar ) then ! Calculate the fragmentation_scaler - currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,bc_in%t_scalar_sisl * bc_in%w_scalar_sisl)) + currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,bc_in(currentPatch%patchno)%t_scalar_sisl * & + bc_in(currentPatch%patchno)%w_scalar_sisl)) else diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 423fd3e586..bcf70a71fd 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -780,16 +780,12 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) - if (currentPatch%nocomp_pft_label .ne. nocomp_bareground) then - call GenerateDamageAndLitterFluxes( currentSite, currentPatch) call PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in) call PreDisturbanceIntegrateLitter(currentPatch ) - end if - currentPatch => currentPatch%older enddo From 9bcf1cf5df6ab103d0273cbc85ae22a4d74708f5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 1 Mar 2026 22:39:15 -0800 Subject: [PATCH 330/331] fix bad merge --- biogeochem/EDPhysiologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 1de1f39fa1..84e4844fdc 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -457,7 +457,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) !------------------------------------------------------------------------------------ ! Calculate the fragmentation rates - call fragmentation_scaler(currentPatch, currentSite%bc_in(currentPatch%patchno)) + call fragmentation_scaler(currentPatch, currentSite%bc_in) do el = 1, num_elements From 336b87f29e3d57d19cdd8625e57985502da1d913 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 1 Mar 2026 22:40:21 -0800 Subject: [PATCH 331/331] manually revert bc_in back to non-array --- biogeochem/EDPhysiologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 84e4844fdc..601bb48fe8 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -446,7 +446,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) ! !ARGUMENTS type(ed_site_type), intent(inout) :: currentSite type(fates_patch_type), intent(inout) :: currentPatch - type(bc_in_type), intent(in) :: bc_in(:) + type(bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: