Skip to content

Commit bea1fb1

Browse files
ckovenckoven
authored
Merge pull request #372 from rgknox/rgknox-memleak-fixes
memory leak fix
2 parents 12f1965 + f25e25d commit bea1fb1

File tree

2 files changed

+136
-83
lines changed

2 files changed

+136
-83
lines changed

‎biogeochem/EDCohortDynamicsMod.F90‎

Lines changed: 88 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -382,7 +382,7 @@ subroutine zero_cohort(cc_p)
382382
end subroutine zero_cohort
383383

384384
!-------------------------------------------------------------------------------------!
385-
subroutine terminate_cohorts( currentSite, patchptr, level )
385+
subroutine terminate_cohorts( currentSite, currentPatch, level )
386386
!
387387
! !DESCRIPTION:
388388
! terminates cohorts when they get too small
@@ -392,7 +392,7 @@ subroutine terminate_cohorts( currentSite, patchptr, level )
392392
!
393393
! !ARGUMENTS
394394
type (ed_site_type) , intent(inout), target :: currentSite
395-
type (ed_patch_type), intent(inout), target :: patchptr
395+
type (ed_patch_type), intent(inout), target :: currentPatch
396396
integer , intent(in) :: level
397397

398398
! Important point regarding termination levels. Termination is typically
@@ -405,20 +405,21 @@ subroutine terminate_cohorts( currentSite, patchptr, level )
405405

406406
!
407407
! !LOCAL VARIABLES:
408-
type (ed_patch_type) , pointer :: currentPatch
409408
type (ed_cohort_type) , pointer :: currentCohort
410-
type (ed_cohort_type) , pointer :: nextc
409+
type (ed_cohort_type) , pointer :: shorterCohort
410+
type (ed_cohort_type) , pointer :: tallerCohort
411+
411412
integer :: terminate ! do we terminate (1) or not (0)
412413
integer :: c ! counter for litter size class.
413414
integer :: levcan ! canopy level
414415
!----------------------------------------------------------------------
415416

416-
currentPatch => patchptr
417-
currentCohort => currentPatch%tallest
418417

418+
currentCohort => currentPatch%shortest
419419
do while (associated(currentCohort))
420-
nextc => currentCohort%shorter
420+
421421
terminate = 0
422+
tallerCohort => currentCohort%taller
422423

423424
! Check if number density is so low is breaks math (level 1)
424425
if (currentcohort%n < min_n_safemath .and. level == 1) then
@@ -488,16 +489,7 @@ subroutine terminate_cohorts( currentSite, patchptr, level )
488489
currentSite%termination_carbonflux(levcan) = currentSite%termination_carbonflux(levcan) + &
489490
currentCohort%n * currentCohort%b_total()
490491

491-
if (.not. associated(currentCohort%taller)) then
492-
currentPatch%tallest => currentCohort%shorter
493-
else
494-
currentCohort%taller%shorter => currentCohort%shorter
495-
endif
496-
if (.not. associated(currentCohort%shorter)) then
497-
currentPatch%shortest => currentCohort%taller
498-
else
499-
currentCohort%shorter%taller => currentCohort%taller
500-
endif
492+
501493

502494
!put the litter from the terminated cohorts straight into the fragmenting pools
503495
if (currentCohort%n.gt.0.0_r8) then
@@ -533,18 +525,40 @@ subroutine terminate_cohorts( currentSite, patchptr, level )
533525
currentSite%root_litter_diagnostic_input_carbonflux(currentCohort%pft) + &
534526
currentCohort%n * (currentCohort%br+currentCohort%bstore) * hlm_days_per_year / AREA
535527

536-
if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort)
537-
538-
deallocate(currentCohort)
528+
end if
529+
530+
! Set pointers and remove the current cohort from the list
531+
shorterCohort => currentCohort%shorter
532+
533+
if (.not. associated(tallerCohort)) then
534+
currentPatch%tallest => shorterCohort
535+
if(associated(shorterCohort)) shorterCohort%taller => null()
536+
else
537+
tallerCohort%shorter => shorterCohort
539538
endif
539+
540+
if (.not. associated(shorterCohort)) then
541+
currentPatch%shortest => tallerCohort
542+
if(associated(tallerCohort)) tallerCohort%shorter => null()
543+
else
544+
shorterCohort%taller => tallerCohort
545+
endif
546+
547+
! At this point, nothing should be pointing to current Cohort
548+
if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(currentCohort)
549+
deallocate(currentCohort)
550+
nullify(currentCohort)
551+
540552
endif
541-
currentCohort => nextc
553+
currentCohort => tallerCohort
542554
enddo
543555

544556
end subroutine terminate_cohorts
545557

546558
!-------------------------------------------------------------------------------------!
547-
subroutine fuse_cohorts(patchptr, bc_in)
559+
560+
subroutine fuse_cohorts(currentPatch, bc_in)
561+
548562
!
549563
! !DESCRIPTION:
550564
! Join similar cohorts to reduce total number
@@ -554,15 +568,20 @@ subroutine fuse_cohorts(patchptr, bc_in)
554568
use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
555569
!
556570
! !ARGUMENTS
557-
type (ed_patch_type), intent(inout), target :: patchptr
571+
type (ed_patch_type), intent(inout), target :: currentPatch
558572
type (bc_in_type), intent(in) :: bc_in
559573
!
574+
560575
! !LOCAL VARIABLES:
561-
type (ed_patch_type) , pointer :: currentPatch
562-
type (ed_cohort_type) , pointer :: currentCohort, nextc, nextnextc
576+
type (ed_cohort_type) , pointer :: currentCohort
577+
type (ed_cohort_type) , pointer :: nextc
578+
type (ed_cohort_type) , pointer :: nextnextc
579+
580+
type (ed_cohort_type) , pointer :: shorterCohort
581+
type (ed_cohort_type) , pointer :: tallerCohort
582+
563583
integer :: i
564584
integer :: fusion_took_place
565-
integer :: maxcohorts ! maximum total no of cohorts.
566585
integer :: iterate ! do we need to keep fusing to get below maxcohorts?
567586
integer :: nocohorts
568587
real(r8) :: newn
@@ -582,31 +601,30 @@ subroutine fuse_cohorts(patchptr, bc_in)
582601
!because c_area and biomass are non-linear with dbh, this causes several mass inconsistancies
583602
!in theory, all of this routine therefore causes minor losses of C and area, but these are below
584603
!detection limit normally.
604+
585605
iterate = 1
586606
fusion_took_place = 0
587-
currentPatch => patchptr
588-
maxcohorts = maxCohortsPerPatch
589607

590608
!---------------------------------------------------------------------!
591609
! Keep doing this until nocohorts <= maxcohorts !
592610
!---------------------------------------------------------------------!
593-
611+
594612
if (associated(currentPatch%shortest)) then
595613
do while(iterate == 1)
596-
614+
597615
currentCohort => currentPatch%tallest
598-
616+
599617
! The following logic continues the loop while the current cohort is not the shortest cohort
600618
! if they point to the same target (ie equivalence), then the loop ends.
601619
! This loop is different than the simple "continue while associated" loop in that
602620
! it omits the last cohort (because it has already been compared by that point)
603-
621+
604622
do while ( .not.associated(currentCohort,currentPatch%shortest) )
605623

606624
nextc => currentPatch%tallest
607625

608626
do while (associated(nextc))
609-
nextnextc => nextc%shorter
627+
nextnextc => nextc%shorter
610628
diff = abs((currentCohort%dbh - nextc%dbh)/(0.5*(currentCohort%dbh + nextc%dbh)))
611629

612630
!Criteria used to divide up the height continuum into different cohorts.
@@ -698,10 +716,10 @@ subroutine fuse_cohorts(patchptr, bc_in)
698716
! recent canopy history
699717
currentCohort%canopy_layer_yesterday = (currentCohort%n*currentCohort%canopy_layer_yesterday + &
700718
nextc%n*nextc%canopy_layer_yesterday)/newn
701-
719+
702720
! Flux and biophysics variables have not been calculated for recruits we just default to
703721
! their initization values, which should be the same for eahc
704-
722+
705723
if ( .not.currentCohort%isnew) then
706724

707725
currentCohort%md = (currentCohort%n*currentCohort%md + &
@@ -798,41 +816,56 @@ subroutine fuse_cohorts(patchptr, bc_in)
798816
nextc%n*nextc%year_net_uptake(i))/newn
799817
endif
800818
enddo
801-
819+
802820
end if !(currentCohort%isnew)
803821

804822
currentCohort%n = newn
805-
!remove fused cohort from the list
806-
nextc%taller%shorter => nextnextc
807-
if (.not. associated(nextc%shorter)) then !this is the shortest cohort.
808-
currentPatch%shortest => nextc%taller
809-
else
810-
nextnextc%taller => nextc%taller
811-
endif
812823

813-
if (associated(nextc)) then
814-
if(hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nextc)
815-
deallocate(nextc)
824+
! Set pointers and remove the current cohort from the list
825+
826+
shorterCohort => nextc%shorter
827+
tallerCohort => nextc%taller
828+
829+
if (.not. associated(tallerCohort)) then
830+
currentPatch%tallest => shorterCohort
831+
if(associated(shorterCohort)) shorterCohort%taller => null()
832+
else
833+
tallerCohort%shorter => shorterCohort
816834
endif
835+
836+
if (.not. associated(shorterCohort)) then
837+
currentPatch%shortest => tallerCohort
838+
if(associated(tallerCohort)) tallerCohort%shorter => null()
839+
else
840+
shorterCohort%taller => tallerCohort
841+
endif
842+
843+
! At this point, nothing should be pointing to current Cohort
844+
if (hlm_use_planthydro.eq.itrue) call DeallocateHydrCohort(nextc)
845+
deallocate(nextc)
846+
nullify(nextc)
817847

818848
endif ! if( currentCohort%isnew.eqv.nextc%isnew ) then
819-
820849
endif !canopy layer
821850
endif !pft
822851
endif !index no.
823852
endif !diff
824-
825-
if (associated(nextc)) then
826-
nextc => nextc%shorter
827-
else
828-
nextc => nextnextc !if we have removed next
829-
endif
830-
853+
854+
nextc => nextnextc
855+
831856
enddo !end checking nextc cohort loop
832857

858+
! Ususally we always point to the next cohort. But remember ...
859+
! this loop exits when current becomes the shortest, not when
860+
! it finishes and becomes the null pointer. If there is no
861+
! shorter cohort, then it is shortest, and will exit
862+
! Note also that it is possible that it entered here as the shortest
863+
! which is possible if nextc was the shortest and was removed.
864+
833865
if (associated (currentCohort%shorter)) then
834866
currentCohort => currentCohort%shorter
835867
endif
868+
836869
enddo !end currentCohort cohort loop
837870

838871
!---------------------------------------------------------------------!
@@ -845,7 +878,7 @@ subroutine fuse_cohorts(patchptr, bc_in)
845878
currentCohort => currentCohort%shorter
846879
enddo
847880

848-
if (nocohorts > maxcohorts) then
881+
if (nocohorts > maxCohortsPerPatch) then
849882
iterate = 1
850883
!---------------------------------------------------------------------!
851884
! Making profile tolerance larger means that more fusion will happen !

0 commit comments

Comments
 (0)