From aa37c3dcbc86052dc3ceb990ab66398f58b78d2c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 13 Oct 2021 18:59:03 -0400 Subject: [PATCH] Fixed bad spill operation on the symba_kinship type --- src/symba/symba_util.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 445b672e0..f429b74b7 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1102,6 +1102,7 @@ module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestru logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not ! Internals integer(I4B) :: nspill, nkeep, nlist + type(symba_kinship), dimension(:), allocatable :: tmp nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1118,7 +1119,9 @@ module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestru discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) if (ldestructive) then if (nkeep > 0) then - keeps(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) else deallocate(keeps) end if