Merge removal of redundent fusion, commit 'd8a9ee5', into andre-ed-cl…

…m-16x

Test suite: ed - yellowstone gnu, intel, pgi
Test baseline: none
Test status: all tests pass

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

@@ -1,4 +1,3 @@
-
 module EDCanopyStructureMod
 
   ! ============================================================================

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

@@ -13,6 +13,7 @@ module EDCohortDynamicsMod
   use EDTypesMod            , only : fusetol, nclmax
   use EDtypesMod            , only : ncwd, numcohortsperpatch, udata
   use EDtypesMod            , only : sclass_ed,nlevsclass_ed,AREA
+  use EDtypesMod            , only : min_npm2, min_nppatch, min_n_safemath
   !
   implicit none
   private
@@ -488,47 +489,55 @@ subroutine terminate_cohorts( patchptr )
        nextc      => currentCohort%shorter    
        terminate = 0 
 
-       ! Not enough n or dbh
-       if (currentCohort%n/currentPatch%area <= 0.00001_r8 .or. currentCohort%dbh <  &
-            0.00001_r8.and.currentCohort%bstore < 0._r8) then
-          terminate = 1
-
-          if ( DEBUG ) then
-             write(iulog,*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh
-          endif
-
-       endif
-
-       ! In the third canopy layer
-       if (currentCohort%canopy_layer > NCLMAX) then 
-          terminate = 1
-
-          if ( DEBUG ) then
-            write(iulog,*) 'terminating cohorts 2', currentCohort%canopy_layer
-          endif
-
+       ! Check if number density is so low is breaks math
+       if (currentcohort%n <  min_n_safemath) then
+         terminate = 1
+	 if ( DEBUG ) then
+             write(iulog,*) 'terminating cohorts 0',currentCohort%n/currentPatch%area,currentCohort%dbh
+         endif
        endif
 
-       ! live biomass pools are terminally depleted
-       if (currentCohort%balive < 1e-10_r8 .or. currentCohort%bstore < 1e-10_r8) then 
-          terminate = 1  
-
-          if ( DEBUG ) then
-            write(iulog,*) 'terminating cohorts 3', currentCohort%balive,currentCohort%bstore
-          endif
-
-       endif
-
-       ! Total cohort biomass is negative
-       if (currentCohort%balive+currentCohort%bdead+currentCohort%bstore < 0._r8) then
-          terminate = 1
-
-          if ( DEBUG ) then
-            write(iulog,*) 'terminating cohorts 4', currentCohort%balive, currentCohort%bstore, currentCohort%bdead, &
+       ! The rest of these are only allowed if we are not dealing with a recruit
+       if (.not.currentCohort%isnew) then
+
+         ! Not enough n or dbh
+         if  (currentCohort%n/currentPatch%area <= min_npm2 .or.	&  !
+              currentCohort%n <= min_nppatch .or. &
+              (currentCohort%dbh < 0.00001_r8.and.currentCohort%bstore < 0._r8) ) then 
+            terminate = 1
+
+            if ( DEBUG ) then
+               write(iulog,*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh
+            endif
+         endif
+
+         ! In the third canopy layer
+         if (currentCohort%canopy_layer > NCLMAX) then 
+           terminate = 1
+           if ( DEBUG ) then
+             write(iulog,*) 'terminating cohorts 2', currentCohort%canopy_layer
+           endif
+         endif
+
+         ! live biomass pools are terminally depleted
+         if (currentCohort%balive < 1e-10_r8 .or. currentCohort%bstore < 1e-10_r8) then 
+            terminate = 1  
+            if ( DEBUG ) then
+              write(iulog,*) 'terminating cohorts 3', currentCohort%balive,currentCohort%bstore
+            endif
+         endif
+
+         ! Total cohort biomass is negative
+         if (currentCohort%balive+currentCohort%bdead+currentCohort%bstore < 0._r8) then
+            terminate = 1
+            if ( DEBUG ) then
+            write(iulog,*) 'terminating cohorts 4', currentCohort%balive, &
+                           currentCohort%bstore, currentCohort%bdead, &
                            currentCohort%balive+currentCohort%bdead+&
                            currentCohort%bstore, currentCohort%n
-          endif
+            endif
 
+         endif
        endif
 
        if (terminate == 1) then 
@@ -644,8 +653,9 @@ subroutine fuse_cohorts(patchptr)
                          if( (.not.(currentCohort%isnew) .and. .not.(nextc%isnew) ) .or. & 
 			          ( currentCohort%isnew .and. nextc%isnew ) ) then
 
+                         newn = currentCohort%n + nextc%n
                          fusion_took_place = 1         
-                         newn = currentCohort%n + nextc%n    ! sum individuals in both cohorts.     
+
 
                          currentCohort%balive    = (currentCohort%n*currentCohort%balive    + nextc%n*nextc%balive)/newn
                          currentCohort%bdead     = (currentCohort%n*currentCohort%bdead     + nextc%n*nextc%bdead)/newn

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

@@ -11,6 +11,7 @@ module EDPatchDynamicsMod
   use EDCohortDynamicsMod  , only : fuse_cohorts, sort_cohorts, insert_cohort
   use EDtypesMod           , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, numPatchesPerGridCell
   use EDTypesMod           , only : ed_site_type, ed_patch_type, ed_cohort_type, udata
+  use EDTypesMod           , only : min_patch_area
   !
   implicit none
   private
@@ -27,6 +28,7 @@ module EDPatchDynamicsMod
 
   private:: fuse_2_patches
 
+
   ! 10/30/09: Created by Rosie Fisher
   ! ============================================================================
 
@@ -1285,7 +1287,7 @@ subroutine terminate_patches(cs_pnt)
     !fuse patches if one of them is very small.... 
     currentPatch => currentSite%youngest_patch
     do while(associated(currentPatch)) 
-       if(currentPatch%area <= 0.001_r8)then
+       if(currentPatch%area <= min_patch_area)then
           if(associated(currentPatch%older).and.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. 

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

@@ -14,7 +14,8 @@ module EDPhysiologyMod
   use WaterstateType      , only : waterstate_type
   use pftconMod           , only : pftcon
   use EDEcophysContype    , only : EDecophyscon
-  use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort, create_cohort, fuse_cohorts, sort_cohorts
+  use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort
+  use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts
   use EDPhenologyType     , only : ed_phenology_type
   use EDTypesMod          , only : dg_sf, dinc_ed, external_recruitment
   use EDTypesMod          , only : ncwd, nlevcan_ed, n_sub, numpft_ed, senes
@@ -1016,23 +1017,17 @@ subroutine recruitment( t, currentPatch )
           cohortstatus = currentPatch%siteptr%dstatus
        endif
 
-       if (temp_cohort%n > 0.0_r8)then
-
-          if ( DEBUG ) write(iulog,*) 'EDPhysiologyMod.F90 call create_cohort '
-
-          call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, &
-               temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore,  &
-               temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p)
-
+       if (temp_cohort%n > 0.0_r8 )then
+           if ( DEBUG ) write(iulog,*) 'EDPhysiologyMod.F90 call create_cohort '
+           call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, &
+                temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore,  &
+                temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p)
        endif
 
     enddo  !pft loop
 
     deallocate(temp_cohort) ! delete temporary cohort
 
-    call fuse_cohorts(currentPatch)
-    call sort_cohorts(currentPatch)
-
   end subroutine recruitment
 
   ! ============================================================================

components/clm/src/ED/main/EDMainMod.F90

@@ -176,15 +176,16 @@ subroutine ed_ecosystem_dynamics(currentSite, &
     currentPatch => currentSite%oldest_patch
     do while (associated(currentPatch))
 
-       ! kills cohorts that are too small
-       call terminate_cohorts(currentPatch)       
-
        ! puts cohorts in right order
        call sort_cohorts(currentPatch)            
 
        ! fuses similar cohorts
        call fuse_cohorts(currentPatch)            
 
+       ! kills cohorts that are too small
+       call terminate_cohorts(currentPatch)
+
+
        currentPatch => currentPatch%younger
     enddo
 

components/clm/src/ED/main/EDTypesMod.F90

@@ -65,6 +65,14 @@ module EDTypesMod
   integer , parameter :: N_HITE_BINS          = 60         ! no. of hite bins used to distribute LAI
   integer , parameter :: N_DBH_BINS           = 5          ! no. of dbh bins used when comparing patches
 
+
+  real(r8), parameter :: min_npm2       = 1.0d-5   ! minimum cohort number density per m2 before termination
+  real(r8), parameter :: min_patch_area = 0.001_r8 ! smallest allowable patch area before termination
+  real(r8), parameter :: min_nppatch    = 1.0d-8   ! minimum number of cohorts per patch (min_npm2*min_patch_area)
+  real(r8), parameter :: min_n_safemath = 1.0d-15  ! in some cases, we want to immediately remove super small
+                                                   ! number densities of cohorts to prevent FPEs, this is usually
+                                                   ! just relevant in the first day after recruitment
+
   character*4 yearchar                    
 
   !the lower limit of the size classes of ED cohorts