From 48b55cd96eb881484d35b826153dd4a42f946ae4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Jul 2021 16:36:01 -0400 Subject: [PATCH] Fixed memory allocation issues with empty encounter lists --- src/symba/symba_encounter_check.f90 | 31 ++++++++++++++++++----------- src/symba/symba_util.f90 | 16 +++++++++++---- 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index ce3855e02..1a9d8c68f 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -17,6 +17,7 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc logical :: lany_encounter !! Returns true if there is at least one close encounter ! Internals integer(I8B) :: k + integer(I4B) :: nenc real(DP), dimension(NDIM) :: xr, vr logical, dimension(:), allocatable :: lencounter, loc_lvdotr @@ -34,17 +35,20 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc end associate end do - lany_encounter = any(lencounter(:)) + nenc = count(lencounter(:)) + lany_encounter = nenc > 0 if (lany_encounter) then - associate(plplenc_list => system%plplenc_list, nenc => system%plplenc_list%nenc) - call plplenc_list%resize(count(lencounter(:))) - plplenc_list%status(1:nenc) = ACTIVE - plplenc_list%level(1:nenc) = irec + associate(plplenc_list => system%plplenc_list) + call plplenc_list%resize(nenc) plplenc_list%lvdotr(1:nenc) = pack(loc_lvdotr(:), lencounter(:)) plplenc_list%index1(1:nenc) = pack(pl%k_plpl(1,:), lencounter(:)) plplenc_list%index2(1:nenc) = pack(pl%k_plpl(2,:), lencounter(:)) - pl%lencounter(plplenc_list%index1(1:nenc)) = .true. - pl%lencounter(plplenc_list%index2(1:nenc)) = .true. + do k = 1, nenc + plplenc_list%status(k) = ACTIVE + plplenc_list%level(k) = irec + pl%lencounter(plplenc_list%index1(k)) = .true. + pl%lencounter(plplenc_list%index2(k)) = .true. + end do end associate end if end associate @@ -142,7 +146,7 @@ module function symba_encounter_check_tp(self, system, dt, irec) result(lany_enc logical :: lany_encounter !! Returns true if there is at least one close encounter ! Internals real(DP) :: r2crit, vdotr, r2, v2, tmin, r2min, term2 - integer(I4B) :: i, j + integer(I4B) :: i, j, k,nenc real(DP), dimension(NDIM) :: xr, vr logical, dimension(:,:), allocatable :: lencounter, loc_lvdotr @@ -160,10 +164,11 @@ module function symba_encounter_check_tp(self, system, dt, irec) result(lany_enc end do end do - lany_encounter = any(lencounter(:,:)) + nenc = count(lencounter(:,:)) + lany_encounter = nenc > 0 if (lany_encounter) then - associate(pltpenc_list => system%pltpenc_list, nenc => system%pltpenc_list%nenc) - call pltpenc_list%resize(count(lencounter(:,:))) + associate(pltpenc_list => system%pltpenc_list) + call pltpenc_list%resize(nenc) pltpenc_list%status(1:nenc) = ACTIVE pltpenc_list%level(1:nenc) = irec pltpenc_list%lvdotr(1:nenc) = pack(loc_lvdotr(:,:), lencounter(:,:)) @@ -172,7 +177,9 @@ module function symba_encounter_check_tp(self, system, dt, irec) result(lany_enc select type(pl) class is (symba_pl) pl%lencounter(:) = .false. - pl%lencounter(pltpenc_list%index1(1:nenc)) = .true. + do k = 1, nenc + pl%lencounter(pltpenc_list%index1(k)) = .true. + end do end select end associate end if diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 10fb36a2d..7a6f17cbf 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -59,13 +59,21 @@ module subroutine symba_util_resize_pltpenc(self, nrequested) ! Internals class(symba_pltpenc), allocatable :: enc_temp integer(I4B) :: nold + logical :: lmalloc - nold = size(self%status) + lmalloc = allocated(self%status) + if (lmalloc) then + nold = size(self%status) + else + nold = 0 + end if if (nrequested > nold) then - allocate(enc_temp, source=self) + if (lmalloc) allocate(enc_temp, source=self) call self%setup(2 * nrequested) - call self%copy(enc_temp) - deallocate(enc_temp) + if (lmalloc) then + call self%copy(enc_temp) + deallocate(enc_temp) + end if else self%status(nrequested+1:nold) = INACTIVE end if