Merge branch 'master' into rgknox-init-cleanups

components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90

@@ -67,7 +67,7 @@ subroutine canopy_structure( currentSite )
     use clm_varpar,  only : nlevcan_ed
     use EDParamsMod, only : ED_val_comp_excln, ED_val_ag_biomass
     use SFParamsMod, only : SF_val_cwd_frac
-    use EDtypesMod , only : ncwd
+    use EDtypesMod , only : ncwd, min_patch_area
     !
     ! !ARGUMENTS    
     type(ed_site_type) , intent(inout), target   :: currentSite
@@ -99,12 +99,15 @@ subroutine canopy_structure( currentSite )
 
     new_total_area_check = 0._r8
     do while (associated(currentPatch)) ! Patch loop    
+
+       if (currentPatch%area .gt. min_patch_area) then  ! avoid numerical weirdness that shouldn't be happening anyway
+
        excess_area = 1.0_r8   
 
        ! Does any layer have excess area in it? Keep going until it does not...
 
        do while(excess_area > 0.000001_r8)
-          
+
           ! Calculate the area currently in each canopy layer. 
           z = 1 
           arealayer = 0.0_r8
@@ -555,6 +558,11 @@ subroutine canopy_structure( currentSite )
          ! write(iulog,*) 'end patch loop',currentSite%clmgcell
        endif
 
+       else !terminate  logic to only do if patch_area_sufficiently large
+          write(iulog,*) 'canopy_structure: patch area too small.', currentPatch%area
+       end if 
+
+
        currentPatch => currentPatch%younger
     enddo !patch  
 

components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90

@@ -1158,6 +1158,9 @@ subroutine fuse_2_patches(dp, rp)
     type (ed_cohort_type), pointer :: storebigcohort  
     integer :: c,p !counters for pft and litter size class. 
     integer :: tnull,snull  ! are the tallest and shortest cohorts associated?
+    type(ed_patch_type), pointer :: youngerp   ! pointer to the patch younger than donor
+    type(ed_patch_type), pointer :: olderp     ! pointer to the patch older than donor
+    type(ed_site_type),  pointer :: csite      ! pointer to the donor patch's site
     !---------------------------------------------------------------------
 
     !area weighted average of ages & litter & seed bank
@@ -1253,25 +1256,47 @@ subroutine fuse_2_patches(dp, rp)
 
     call patch_pft_size_profile(rp) ! Recalculate the patch size profile for the resulting patch
 
-    ! FIX(SPM,032414) dangerous code here.  Passing in dp as a pointer allows the code below
-    ! to effect the currentPatch that is the actual argument when in reality, dp should be 
-    ! intent in only with these pointers being set on the actual argument
-    ! outside of this routine (in fuse_patches).  basically this should be split
-    ! into a copy, then change pointers, then delete.
-
-    if(associated(dp%younger)) then 
-       dp%younger%older => dp%older
-    else 
-       dp%siteptr%youngest_patch => dp%older !youngest
-    endif
-    if(associated(dp%older)) then 
-       dp%older%younger => dp%younger
-    else 
-       dp%siteptr%oldest_patch => dp%younger  !oldest
-    endif
+    ! Define some aliases for the donor patches younger and older neighbors
+    ! which may or may not exist.  After we set them, we will remove the donor
+    ! And then we will go about re-setting the map.
+    csite => dp%siteptr
+    if(associated(dp%older))then
+       olderp => dp%older
+    else
+       olderp => null()
+    end if
+    if(associated(dp%younger))then
+       youngerp => dp%younger
+    else
+       youngerp => null()
+    end if
 
+    ! We have no need for the dp pointer anymore, we have passed on it's legacy
     deallocate(dp)
 
+
+    if(associated(youngerp))then
+       ! Update the younger patch's new older patch (because it isn't dp anymore)
+       youngerp%older => olderp
+    else
+       ! There was no younger patch than dp, so the head of the young order needs
+       ! to be set, and it is set as the patch older than dp.  That patch
+       ! already knows it's older patch (so no need to set or change it)
+       csite%youngest_patch => olderp
+    end if
+
+
+    if(associated(olderp))then
+       ! Update the older patch's new younger patch (becuase it isn't dp anymore)
+       olderp%younger => youngerp
+    else
+       ! There was no patch older than dp, so the head of the old patch order needs
+       ! to be set, and it is set as the patch younger than dp.  That patch already
+       ! knows it's younger patch, no need to set
+       csite%oldest_patch => youngerp
+    end if
+
+
   end subroutine fuse_2_patches
 
   ! ============================================================================
@@ -1287,7 +1312,7 @@ subroutine terminate_patches(cs_pnt)
     !
     ! !LOCAL VARIABLES:
     type(ed_site_type),  pointer :: currentSite
-    type(ed_patch_type), pointer :: currentPatch
+    type(ed_patch_type), pointer :: currentPatch, tmpptr
     real(r8) areatot ! variable for checking whether the total patch area is wrong. 
     !---------------------------------------------------------------------
 
@@ -1299,15 +1324,22 @@ subroutine terminate_patches(cs_pnt)
     currentPatch => currentSite%youngest_patch
     do while(associated(currentPatch)) 
        if(currentPatch%area <= min_patch_area)then
-          if(associated(currentPatch%older).and.currentPatch%patchno /= currentSite%youngest_patch%patchno)then
+          if ( currentPatch%patchno /= currentSite%youngest_patch%patchno) then
             ! Do not force the fusion of the youngest patch to its neighbour. 
             ! This is only really meant for very old patches. 
-             write(iulog,*) 'fusing patches because one is too small',currentPatch%area, currentPatch%lai, &
-                  currentPatch%older%area,currentPatch%older%lai,currentPatch%seed_bank(1)
-             call fuse_2_patches(currentPatch%older, currentPatch)
-             deallocate(currentPatch%older)
-             write(iulog,*) 'after fusion',currentPatch%area,currentPatch%seed_bank(1)
-           endif
+             if(associated(currentPatch%older) )then
+                write(iulog,*) 'fusing to older patch because this one is too small',currentPatch%area, currentPatch%lai, &
+                     currentPatch%older%area,currentPatch%older%lai,currentPatch%seed_bank(1)
+                call fuse_2_patches(currentPatch%older, currentPatch)
+                write(iulog,*) 'after fusion to older patch',currentPatch%area,currentPatch%seed_bank(1)
+             else
+                write(iulog,*) 'fusing to younger patch because oldest one is too small',currentPatch%area, currentPatch%lai
+                tmpptr => currentPatch%younger
+                call fuse_2_patches(currentPatch, currentPatch%younger)
+                write(iulog,*) 'after fusion to younger patch'
+                currentPatch => tmpptr
+             endif
+          endif
        endif
 
        currentPatch => currentPatch%older