From 4e69321c76ce93797227d22d23ded107b180cd86 Mon Sep 17 00:00:00 2001 From: ckoven Date: Wed, 14 Aug 2019 22:49:52 -0700 Subject: [PATCH 1/3] first attempt to sort patches by biomass during census init w/o any age info --- main/FatesInventoryInitMod.F90 | 79 ++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index e7d45f1708..6c790a22b4 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -92,6 +92,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) use EDCohortDynamicsMod, only : fuse_cohorts use EDCohortDynamicsMod, only : sort_cohorts use EDcohortDynamicsMod, only : count_cohorts + use EDPatchDynamicsMod, only : patch_pft_size_profile ! Arguments integer, intent(in) :: nsites @@ -104,6 +105,8 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) type(ed_cohort_type), pointer :: currentcohort type(ed_patch_type), pointer :: newpatch type(ed_patch_type), pointer :: olderpatch + type(ed_patch_type), pointer :: head_of_unsorted_patch_list + type(ed_patch_type), pointer :: next_in_unsorted_patch_list integer :: sitelist_file_unit ! fortran file unit for site list integer :: pss_file_unit ! fortran file unit for the pss file integer :: css_file_unit ! fortran file unit for the css file @@ -371,6 +374,82 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) deallocate(patch_pointer_vec,patch_name_vec) + ! now that we've read in the patch and cohort info, check to see if there is any real age info + if ( (sites(s)%youngest_patch%age .eq. sites(s)%oldest_patch%age) .and. & + associated(sites(s)%youngest_patch%older) ) then + + ! so there are at least two patches and the oldest and youngest are the same age. + ! this means that sorting by age wasn't very useful. try sorting by total biomass instead + + ! first calculate the biomass in each patch. simplest way is to use the patch fusion criteria + currentpatch => sites(s)%youngest_patch + do while(associated(currentpatch)) + call patch_pft_size_profile(currentPatch) + currentPatch => currentpatch%older + enddo + + ! now we need to sort them. + ! first generate a new head of the linked list. + head_of_unsorted_patch_list => sites(s)%youngest_patch%older + + ! reset the site-level patch linked list, keeping only the youngest patch. + sites(s)%youngest_patch%older => null() + sites(s)%youngest_patch%younger => null() + sites(s)%oldest_patch => sites(s)%youngest_patch + + ! loop through each patch in the unsorted LL, peel it off, + ! and insert it into the new, sorted LL + do while(associated(head_of_unsorted_patch_list)) + + ! first keep track of the next patch in the old (unsorted) linked list + next_in_unsorted_patch_list => head_of_unsorted_patch_list%older + + ! check the two end-cases + + ! Youngest Patch + if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) <= & + sum(sites(s)%youngest_patch%pft_agb_profile(:,:)))then + head_of_unsorted_patch_list%older => sites(s)%youngest_patch + head_of_unsorted_patch_list%younger => null() + sites(s)%youngest_patch%younger => head_of_unsorted_patch_list + sites(s)%youngest_patch => head_of_unsorted_patch_list + + ! Oldest Patch + else if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) > & + sum(sites(s)%oldest_patch%pft_agb_profile(:,:)))then + head_of_unsorted_patch_list%older => null() + head_of_unsorted_patch_list%younger => sites(s)%oldest_patch + sites(s)%oldest_patch%older => head_of_unsorted_patch_list + sites(s)%oldest_patch => head_of_unsorted_patch_list + + ! Somewhere in the middle + else + currentpatch => sites(s)%youngest_patch + do while(associated(currentpatch)) + olderpatch => currentpatch%older + if(associated(currentpatch%older)) then + if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) >= & + sum(currentpatch%pft_agb_profile(:,:)) .and. & + sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) < & + sum(olderpatch%pft_agb_profile(:,:))) then + ! Set the new patches pointers + head_of_unsorted_patch_list%older => currentpatch%older + head_of_unsorted_patch_list%younger => currentpatch + ! Fix the patch's older pointer + currentpatch%older => head_of_unsorted_patch_list + ! Fix the older patch's younger pointer + olderpatch%younger => head_of_unsorted_patch_list + end if + end if + currentPatch => olderpatch + enddo + end if + + ! now work through to the next element in the unsorted linked list + head_of_unsorted_patch_list => next_in_unsorted_patch_list + end do + endif + ! Report Basal Area (as a check on if things were read in) ! ------------------------------------------------------------------------------ basal_area_pref = 0.0_r8 From 304aab98e5195cc45b67b6b42acc1991ccb81ee0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 2 Oct 2019 14:05:15 -0700 Subject: [PATCH 2/3] adding loop exit to reduce sort time --- main/FatesInventoryInitMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index fab14619a3..0fa35afc0d 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -448,6 +448,8 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) currentpatch%older => head_of_unsorted_patch_list ! Fix the older patch's younger pointer olderpatch%younger => head_of_unsorted_patch_list + ! Exit the loop once head sorted to avoid later re-sort + exit end if end if currentPatch => olderpatch From 7bbcd3ca2fcf70b34a5fde8fecfd1e0fc850ceb8 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 2 Oct 2019 16:07:20 -0700 Subject: [PATCH 3/3] changing loop entry into nearzero comparison --- main/FatesInventoryInitMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 0fa35afc0d..8fc3524789 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -104,6 +104,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! !USES: use shr_file_mod, only : shr_file_getUnit use shr_file_mod, only : shr_file_freeUnit + use FatesConstantsMod, only : nearzero use EDPatchDynamicsMod, only : create_patch use EDPatchDynamicsMod, only : fuse_patches use EDCohortDynamicsMod, only : fuse_cohorts @@ -384,7 +385,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) deallocate(patch_pointer_vec,patch_name_vec) ! now that we've read in the patch and cohort info, check to see if there is any real age info - if ( (sites(s)%youngest_patch%age .eq. sites(s)%oldest_patch%age) .and. & + if ( abs(sites(s)%youngest_patch%age - sites(s)%oldest_patch%age) <= nearzero .and. & associated(sites(s)%youngest_patch%older) ) then ! so there are at least two patches and the oldest and youngest are the same age.