From 678e812e8569fb9b3462975b0ac48d0efdc767ee Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 10 May 2023 09:46:55 -0400 Subject: [PATCH] Fixed issue that was causing a segfault when an append operation was done using an unallocated source array --- src/base/base_module.f90 | 20 +++++++++++++++----- src/swiftest/swiftest_module.f90 | 4 ++-- src/swiftest/swiftest_util.f90 | 8 ++++++-- 3 files changed, 23 insertions(+), 9 deletions(-) diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index 8a1982c33..c2b91e6bf 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -295,12 +295,14 @@ subroutine base_util_append_arr_char_string(arr, source, nold, lsource_mask) implicit none ! Arguments character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array - character(len=STRMAX), dimension(:), intent(in) :: source !! Array to append + character(len=STRMAX), dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig + if (.not.allocated(source)) return + if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else @@ -338,12 +340,14 @@ subroutine base_util_append_arr_DP(arr, source, nold, lsource_mask) implicit none ! Arguments real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:), intent(in) :: source !! Array to append + real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig + if (.not.allocated(source)) return + if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else @@ -381,12 +385,14 @@ subroutine base_util_append_arr_DPvec(arr, source, nold, lsource_mask) implicit none ! Arguments real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:,:), intent(in) :: source !! Array to append + real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig + if (.not.allocated(source)) return + if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else @@ -426,12 +432,14 @@ subroutine base_util_append_arr_I4B(arr, source, nold, lsource_mask) implicit none ! Arguments integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: source !! Array to append + integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig + if (.not.allocated(source)) return + if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else @@ -469,12 +477,14 @@ subroutine base_util_append_arr_logical(arr, source, nold, lsource_mask) implicit none ! Arguments logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - logical, dimension(:), intent(in) :: source !! Array to append + logical, dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig + if (.not.allocated(source)) return + if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 6555617bb..c86f86dd1 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -1132,7 +1132,7 @@ end subroutine swiftest_user_kick_getacch_body module subroutine swiftest_util_append_arr_info(arr, source, nold, lsource_mask) implicit none type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_particle_info), dimension(:), intent(in) :: source !! Array to append + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_arr_info @@ -1140,7 +1140,7 @@ end subroutine swiftest_util_append_arr_info module subroutine swiftest_util_append_arr_kin(arr, source, nold, lsource_mask) implicit none type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_kinship), dimension(:), intent(in) :: source !! Array to append + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_arr_kin diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 879f6c8f3..31b1dc3dd 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -23,13 +23,15 @@ module subroutine swiftest_util_append_arr_info(arr, source, nold, lsource_mask) implicit none ! Arguments type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_particle_info), dimension(:), intent(in) :: source !! Array to append + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig, i integer(I4B), dimension(:), allocatable :: idx + if (.not.allocated(source)) return + if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else @@ -70,12 +72,14 @@ module subroutine swiftest_util_append_arr_kin(arr, source, nold, lsource_mask) implicit none ! Arguments type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_kinship), dimension(:), intent(in) :: source !! Array to append + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig + if (.not.allocated(source)) return + if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else