From 157df2b583043b84e0468aad4c0d8d6aadec1148 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 15:41:14 -0700 Subject: [PATCH 1/8] condense common code into a new subroutine --- biogeochem/EDPatchDynamicsMod.F90 | 77 +++++++++++-------------------- 1 file changed, 27 insertions(+), 50 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e610e7c22a..ca997a5c63 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -774,24 +774,7 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call newPatch%tveg24%CopyFromDonor(currentPatch%tveg24) - call newPatch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - - - if ( regeneration_model == TRS_regeneration ) then - call newPatch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call newPatch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call newPatch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) - do pft = 1,numpft - call newPatch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call newPatch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) - enddo - end if + call CopyPatchMeansTimers(newPatch, currentPatch) call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) @@ -1410,22 +1393,8 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call buffer_patch%tveg24%CopyFromDonor(copyPatch%tveg24) - call buffer_patch%tveg_lpa%CopyFromDonor(copyPatch%tveg_lpa) - call buffer_patch%tveg_longterm%CopyFromDonor(copyPatch%tveg_longterm) - - if ( regeneration_model == TRS_regeneration ) then - call buffer_patch%seedling_layer_par24%CopyFromDonor(copyPatch%seedling_layer_par24) - call buffer_patch%sdlng_mort_par%CopyFromDonor(copyPatch%sdlng_mort_par) - call buffer_patch%sdlng2sap_par%CopyFromDonor(copyPatch%sdlng2sap_par) - do pft = 1,numpft - call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(copyPatch%sdlng_emerg_smp(pft)%p) - call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(copyPatch%sdlng_mdd(pft)%p) - enddo - end if + call CopyPatchMeansTimers() + buffer_patch_used = .false. currentPatch => currentSite%oldest_patch @@ -1669,23 +1638,8 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) new_patch%tallest => null() new_patch%shortest => null() - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call new_patch%tveg24%CopyFromDonor(currentPatch%tveg24) - call new_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call new_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + call CopyPatchMeansTimers(new_patch, currentPatch) - if ( regeneration_model == TRS_regeneration ) then - call new_patch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call new_patch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call new_patch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) - do pft = 1,numpft - call new_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call new_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) - enddo - end if - currentPatch%burnt_frac_litter(:) = 0._r8 call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) @@ -3953,4 +3907,27 @@ subroutine InsertPatch(currentSite, newPatch) end subroutine InsertPatch + ! ===================================================================================== + + subroutine CopyPatchMeansTimers(bufferPatch, currentPatch) + + type(fates_patch_type), intent(inout) :: bufferPatch, currentPatch + + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + call bufferPatch%tveg24%CopyFromDonor(currentPatch%tveg24) + call bufferPatch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) + call bufferPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + + if ( regeneration_model == TRS_regeneration ) then + call bufferPatch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) + call bufferPatch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) + call bufferPatch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) + do pft = 1,numpft + call bufferPatch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) + call bufferPatch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) + enddo + end if + end module EDPatchDynamicsMod From 44fc070aa56a46d7ee33811be0e9254f0adc3edc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 16:02:26 -0700 Subject: [PATCH 2/8] move CopyPatchMeansTimers around to find more common patterns --- biogeochem/EDPatchDynamicsMod.F90 | 75 ++++++++++++++++++------------- 1 file changed, 44 insertions(+), 31 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ca997a5c63..843d520b87 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -742,10 +742,13 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%burnt_frac_litter(:) = 0._r8 end if + call CopyPatchMeansTimers(newPatch, currentPatch) + + call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis) ! Transfer in litter fluxes from plants in various contexts of death and destruction - select case(i_disturbance_type) case (dtype_ilog) call logging_litter_fluxes(currentSite, currentPatch, & @@ -774,10 +777,6 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - call CopyPatchMeansTimers(newPatch, currentPatch) - - call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - ! -------------------------------------------------------------------------- ! The newly formed patch from disturbance (newPatch), has now been given ! some litter from dead plants and pre-existing litter from the donor patches. @@ -1378,9 +1377,6 @@ subroutine spawn_patches( currentSite, bc_in) hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) - ! make a note that this buffer patch has not been put into the linked list - buffer_patch_in_linked_list = .false. - ! Initialize the litter pools to zero do el=1,num_elements call buffer_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & @@ -1393,8 +1389,10 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - call CopyPatchMeansTimers() + call CopyPatchMeansTimers(buffer_patch, currentPatch) + ! make a note that this buffer patch has not been put into the linked list + buffer_patch_in_linked_list = .false. buffer_patch_used = .false. currentPatch => currentSite%oldest_patch @@ -1634,15 +1632,15 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) init_seed=0._r8, & init_seed_germ=0._r8) end do - new_patch%tallest => null() new_patch%shortest => null() call CopyPatchMeansTimers(new_patch, currentPatch) - currentPatch%burnt_frac_litter(:) = 0._r8 call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) + currentPatch%burnt_frac_litter(:) = 0._r8 + ! Next, we loop through the cohorts in the donor patch, copy them with ! area modified number density into the new-patch, and apply survivorship. ! ------------------------------------------------------------------------- @@ -3909,25 +3907,40 @@ end subroutine InsertPatch ! ===================================================================================== - subroutine CopyPatchMeansTimers(bufferPatch, currentPatch) - - type(fates_patch_type), intent(inout) :: bufferPatch, currentPatch - - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call bufferPatch%tveg24%CopyFromDonor(currentPatch%tveg24) - call bufferPatch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call bufferPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - - if ( regeneration_model == TRS_regeneration ) then - call bufferPatch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call bufferPatch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call bufferPatch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) - do pft = 1,numpft - call bufferPatch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call bufferPatch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) - enddo - end if + subroutine CopyPatchMeansTimers(dp, rp) + + ! !DESCRIPTION: + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + ! + ! !ARGUMENTS: + type (fates_patch_type) , pointer :: dp ! Donor Patch + type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + + call rp%tveg24%CopyFromDonor(dp%tveg24) + call rp%tveg_lpa%CopyFromDonor(dp%tveg_lpa) + call rp%tveg_longterm%CopyFromDonor(dp%tveg_longterm) + + if ( regeneration_model == TRS_regeneration ) then + call rp%seedling_layer_par24%CopyFromDonor(dp%seedling_layer_par24) + call rp%sdlng_mort_par%CopyFromDonor(dp%sdlng_mort_par) + call rp%sdlng2sap_par%CopyFromDonor(dp%sdlng2sap_par) + do pft = 1,numpft + call rp%sdlng_emerg_smp(pft)%p%CopyFromDonor(dp%sdlng_emerg_smp(pft)%p) + call rp%sdlng_mdd(pft)%p%CopyFromDonor(dp%sdlng_mdd(pft)%p) + enddo + end if + + ! ===================================================================================== + + subroutine newsub(dp, rp) + + ! !DESCRIPTION: + ! + ! !ARGUMENTS: + type (fates_patch_type) , pointer :: dp ! Donor Patch + type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + end module EDPatchDynamicsMod From 63045a99745b65128a73002c3fed17ae0b1ed60b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 16:10:39 -0700 Subject: [PATCH 3/8] remove subroutine stub --- biogeochem/EDPatchDynamicsMod.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 843d520b87..6e187e2f6e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3932,15 +3932,5 @@ subroutine CopyPatchMeansTimers(dp, rp) enddo end if - ! ===================================================================================== - - subroutine newsub(dp, rp) - - ! !DESCRIPTION: - ! - ! !ARGUMENTS: - type (fates_patch_type) , pointer :: dp ! Donor Patch - type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch - end module EDPatchDynamicsMod From c19d973fec104f251da09b248310156427b07470 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 16:11:46 -0700 Subject: [PATCH 4/8] remove duplicate tveg_longterm update that has been condensed --- biogeochem/EDPatchDynamicsMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6e187e2f6e..085291fdbe 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -744,8 +744,6 @@ subroutine spawn_patches( currentSite, bc_in) call CopyPatchMeansTimers(newPatch, currentPatch) - call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis) ! Transfer in litter fluxes from plants in various contexts of death and destruction From e36df6621e51b45c5c7a983b782ede14df5ad42b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 May 2024 22:52:56 -0700 Subject: [PATCH 5/8] fix missing end subroutine --- biogeochem/EDPatchDynamicsMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c46540170f..1b16d30e0c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3951,5 +3951,6 @@ subroutine CopyPatchMeansTimers(dp, rp) enddo end if + end subroutine CopyPatchMeansTimers end module EDPatchDynamicsMod From 19e0b167c78cdef8fe8366fad05962e1fe65fdda Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 09:39:39 -0700 Subject: [PATCH 6/8] remove target and fix missing indexing definition --- biogeochem/EDPatchDynamicsMod.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 1b16d30e0c..54dee697fe 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1621,8 +1621,8 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) ! ! !ARGUMENTS: type(ed_site_type),intent(inout) :: currentSite - type(fates_patch_type) , intent(inout), target :: currentPatch ! Donor Patch - type(fates_patch_type) , intent(inout), target :: new_patch ! New Patch + type(fates_patch_type) , intent(inout), pointer :: currentPatch ! Donor Patch + type(fates_patch_type) , intent(inout), pointer :: new_patch ! New Patch real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch ! ! !LOCAL VARIABLES: @@ -3937,6 +3937,9 @@ subroutine CopyPatchMeansTimers(dp, rp) type (fates_patch_type) , pointer :: dp ! Donor Patch type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + ! LOCAL: + integer :: ipft ! pft index + call rp%tveg24%CopyFromDonor(dp%tveg24) call rp%tveg_lpa%CopyFromDonor(dp%tveg_lpa) call rp%tveg_longterm%CopyFromDonor(dp%tveg_longterm) @@ -3945,9 +3948,9 @@ subroutine CopyPatchMeansTimers(dp, rp) call rp%seedling_layer_par24%CopyFromDonor(dp%seedling_layer_par24) call rp%sdlng_mort_par%CopyFromDonor(dp%sdlng_mort_par) call rp%sdlng2sap_par%CopyFromDonor(dp%sdlng2sap_par) - do pft = 1,numpft - call rp%sdlng_emerg_smp(pft)%p%CopyFromDonor(dp%sdlng_emerg_smp(pft)%p) - call rp%sdlng_mdd(pft)%p%CopyFromDonor(dp%sdlng_mdd(pft)%p) + do ipft = 1,numpft + call rp%sdlng_emerg_smp(ipft)%p%CopyFromDonor(dp%sdlng_emerg_smp(ipft)%p) + call rp%sdlng_mdd(ipft)%p%CopyFromDonor(dp%sdlng_mdd(ipft)%p) enddo end if From 69558bc5175a70d7261cb080186b3f291c917462 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 10:20:28 -0700 Subject: [PATCH 7/8] fix patch name typo --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 54dee697fe..028c69cf9a 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1411,7 +1411,7 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - call CopyPatchMeansTimers(buffer_patch, currentPatch) + call CopyPatchMeansTimers(buffer_patch, copyPatch) ! make a note that this buffer patch has not been put into the linked list buffer_patch_in_linked_list = .false. From c090218c60416b9cc2a99fbd91925eeaa1691aaa Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 13:48:04 -0700 Subject: [PATCH 8/8] fix incorrect argument order for new subroutine --- biogeochem/EDPatchDynamicsMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 028c69cf9a..f2621a2bba 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -764,7 +764,7 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%burnt_frac_litter(:) = 0._r8 end if - call CopyPatchMeansTimers(newPatch, currentPatch) + call CopyPatchMeansTimers(currentPatch, newPatch) call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis) @@ -1411,7 +1411,7 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - call CopyPatchMeansTimers(buffer_patch, copyPatch) + call CopyPatchMeansTimers(copyPatch, buffer_patch) ! make a note that this buffer patch has not been put into the linked list buffer_patch_in_linked_list = .false. @@ -1654,7 +1654,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) new_patch%tallest => null() new_patch%shortest => null() - call CopyPatchMeansTimers(new_patch, currentPatch) + call CopyPatchMeansTimers(currentPatch, new_patch) call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) @@ -3934,8 +3934,8 @@ subroutine CopyPatchMeansTimers(dp, rp) ! -------------------------------------------------------------------------- ! ! !ARGUMENTS: - type (fates_patch_type) , pointer :: dp ! Donor Patch - type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + type (fates_patch_type), intent(in) :: dp ! Donor Patch + type (fates_patch_type), intent(inout) :: rp ! Recipient Patch ! LOCAL: integer :: ipft ! pft index