From 41850960f957cfdcdabb3525faddb9f1075912e9 Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Tue, 5 Dec 2023 12:31:35 -0500 Subject: [PATCH] feat(ArrayHandlers): support 1D logical array resizing, add tests (#1483) --- autotest/TestArrayHandlers.f90 | 184 ++++++++++++++++++++++++++++---- src/Utilities/ArrayHandlers.f90 | 80 +++++++------- 2 files changed, 205 insertions(+), 59 deletions(-) diff --git a/autotest/TestArrayHandlers.f90 b/autotest/TestArrayHandlers.f90 index 46fe44a155b..a10f4a7f8b6 100644 --- a/autotest/TestArrayHandlers.f90 +++ b/autotest/TestArrayHandlers.f90 @@ -1,7 +1,7 @@ module TestArrayHandlers - use KindModule, only: I4B, DP + use KindModule, only: I4B, DP, LGP use testdrive, only: error_type, unittest_type, new_unittest, check, test_failed - use ArrayHandlersModule, only: ExpandArray2D + use ArrayHandlersModule, only: ExpandArray, ExpandArray2D use ConstantsModule, only: LINELENGTH implicit none private @@ -12,33 +12,152 @@ module TestArrayHandlers subroutine collect_arrayhandlers(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & + new_unittest("ExpandArray_int", test_ExpandArray_int), & + new_unittest("ExpandArray_dbl", test_ExpandArray_dbl), & + new_unittest("ExpandArray_log", test_ExpandArray_log), & new_unittest("ExpandArray2D_int", test_ExpandArray2D_int), & new_unittest("ExpandArray2D_dbl", test_ExpandArray2D_dbl) & ] end subroutine collect_arrayhandlers + subroutine test_ExpandArray_int(error) + type(error_type), allocatable, intent(out) :: error + integer(I4B), allocatable :: array(:) + + ! allocate array + allocate (array(2)) + array(1) = 0 + array(2) = 1 + + ! resize array + call ExpandArray(array, 3) + + ! check that array has been resized + call check(error, size(array, 1) == 5, "1d int array resize failed") + if (allocated(error)) return + + ! set new array elements + array(3) = 2 + array(4) = 3 + array(5) = 4 + + ! check array contents + call check(error, & + array(1) == 0 .and. & + array(2) == 1 .and. & + array(3) == 2 .and. & + array(4) == 3 .and. & + array(5) == 4, & + "1d int array repopulation failed") + if (allocated(error)) return + + deallocate (array) + + end subroutine test_ExpandArray_int + + subroutine test_ExpandArray_dbl(error) + type(error_type), allocatable, intent(out) :: error + real(DP), allocatable :: array(:) + + ! allocate array + allocate (array(2)) + array(1) = 0.5_DP + array(2) = 0.7_DP + + ! resize array + call ExpandArray(array, 1) + + ! check that array has been resized + call check(error, size(array, 1) == 3, "1d dbl array resize failed") + if (allocated(error)) return + + ! set new array element + array(3) = 0.1_DP + + ! check array contents + call check(error, & + array(1) == 0.5_DP .and. & + array(2) == 0.7_DP .and. & + array(3) == 0.1_DP, & + "1d dbl array repopulation failed") + if (allocated(error)) return + + deallocate (array) + + end subroutine test_ExpandArray_dbl + + subroutine test_ExpandArray_log(error) + type(error_type), allocatable, intent(out) :: error + logical(LGP), allocatable :: array(:) + + ! allocate array + allocate (array(2)) + array(1) = .true. + array(2) = .false. + + ! resize array + call ExpandArray(array, 1) + + ! check that array has been resized + call check(error, size(array, 1) == 3, "1d logical array resize failed") + if (allocated(error)) return + + ! set an element in the array + array(3) = .true. + + ! check array contents + call check(error, & + array(1) .and. & + .not. array(2) .and. & + array(3), & + "1d logical array repopulation failed") + if (allocated(error)) return + + deallocate (array) + + end subroutine test_ExpandArray_log + subroutine test_ExpandArray2D_int(error) type(error_type), allocatable, intent(out) :: error integer(I4B), allocatable :: array(:, :) ! allocate array allocate (array(2, 2)) + array(1, :) = (/1, 2/) + array(2, :) = (/2, 3/) ! check initial array size - call check(error, size(array, 1) == 2) - call check(error, size(array, 2) == 2) + call check(error, size(array, 1) == 2 .and. size(array, 2) == 2) if (allocated(error)) return ! resize array - call ExpandArray2D(array, 2, 2) + call ExpandArray2D(array, 1, 1) + + ! check that array has been resized + call check(error, & + size(array, 1) == 3 .and. size(array, 2) == 3, & + "2d int array resize failed") + if (allocated(error)) return + + ! add new array elements + array(3, :) = (/3, 4, 5/) - ! check that arrays have been resized - call check(error, size(array, 1) == 4) - call check(error, size(array, 2) == 4) - if (allocated(error)) then - call test_failed(error, "2d int array not resized correctly") - return - end if + ! check array contents + call check(error, & + array(1, 1) == 1 .and. & + array(1, 2) == 2 .and. & + ! can't guarantee unassigned item value + ! array(1, 3) == 0 .and. & + array(2, 1) == 2 .and. & + array(2, 2) == 3 .and. & + ! can't guarantee unassigned item value + ! array(2, 3) == 0 .and. & + array(3, 1) == 3 .and. & + array(3, 2) == 4 .and. & + array(3, 3) == 5, & + "2d int array repopulation failed") + + deallocate (array) end subroutine test_ExpandArray2D_int @@ -48,22 +167,41 @@ subroutine test_ExpandArray2D_dbl(error) ! allocate array allocate (array(2, 2)) + array(1, :) = (/1.0_DP, 2.0_DP/) + array(2, :) = (/2.0_DP, 3.0_DP/) ! check initial array size - call check(error, size(array, 1) == 2) - call check(error, size(array, 2) == 2) + call check(error, size(array, 1) == 2 .and. size(array, 2) == 2) if (allocated(error)) return ! resize array - call ExpandArray2D(array, 2, 2) - - ! check that arrays have been resized - call check(error, size(array, 1) == 4) - call check(error, size(array, 2) == 4) - if (allocated(error)) then - call test_failed(error, "2d dbl array not resized correctly") - return - end if + call ExpandArray2D(array, 1, 1) + + ! check that array has been resized + call check(error, & + size(array, 1) == 3 .and. size(array, 2) == 3, & + "2d dbl array resize failed") + if (allocated(error)) return + + ! set new array elements + array(3, :) = (/3.0_DP, 4.0_DP, 5.0_DP/) + + ! check array contents + call check(error, & + array(1, 1) == 1.0_DP .and. & + array(1, 2) == 2.0_DP .and. & + ! can't guarantee unassigned item value + ! array(1, 3) == 0.0_DP .and. & + array(2, 1) == 2.0_DP .and. & + array(2, 2) == 3.0_DP .and. & + ! can't guarantee unassigned item value + ! array(2, 3) == 0.0_DP .and. & + array(3, 1) == 3.0_DP .and. & + array(3, 2) == 4.0_DP .and. & + array(3, 3) == 5.0_DP, & + "2d dbl array repopulation failed") + + deallocate (array) end subroutine test_ExpandArray2D_dbl end module TestArrayHandlers diff --git a/src/Utilities/ArrayHandlers.f90 b/src/Utilities/ArrayHandlers.f90 index 8977e419042..920abb49867 100644 --- a/src/Utilities/ArrayHandlers.f90 +++ b/src/Utilities/ArrayHandlers.f90 @@ -4,6 +4,7 @@ module ArrayHandlersModule use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DZERO, DTEN use SimVariablesModule, only: iout use GenericUtilitiesModule, only: sim_message, stop_with_error + implicit none private public :: ExpandArray, ExpandArray2D, ExpandArrayWrapper, ExtendPtrArray public :: ConcatArray @@ -19,7 +20,8 @@ module ArrayHandlersModule ! IMPORTANT: Do not use pointers to elements of arrays when using ! ExpandArray to increase the array size! The locations of array ! elements in memory are changed when ExpandArray is invoked. - module procedure expand_integer, expand_double, expand_character + module procedure expand_integer, expand_double, expand_logical, & + expand_character end interface ExpandArray interface ExpandArray2D @@ -47,7 +49,6 @@ module ArrayHandlersModule contains subroutine expand_integer_wrapper(nsize, array, minvalue, loginc) - implicit none ! -- dummy integer(I4B), intent(in) :: nsize integer(I4B), allocatable, intent(inout) :: array(:) @@ -99,15 +100,12 @@ subroutine expand_integer_wrapper(nsize, array, minvalue, loginc) array(n) = 0 end do end if - ! - ! -- return - return + end subroutine expand_integer_wrapper ! -- Specific procedures that implement ExpandArray for allocatable arrays subroutine expand_integer(array, increment) - implicit none ! -- dummy integer(I4B), allocatable, intent(inout) :: array(:) integer(I4B), optional, intent(in) :: increment @@ -134,12 +132,10 @@ subroutine expand_integer(array, increment) else allocate (array(inclocal)) end if - ! - return + end subroutine expand_integer subroutine expand_double(array, increment) - implicit none ! -- dummy real(DP), allocatable, intent(inout) :: array(:) integer(I4B), optional, intent(in) :: increment @@ -166,12 +162,40 @@ subroutine expand_double(array, increment) else allocate (array(inclocal)) end if - ! - return + end subroutine expand_double + subroutine expand_logical(array, increment) + ! -- dummy + logical(LGP), allocatable, intent(inout) :: array(:) + integer(I4B), optional, intent(in) :: increment + ! -- local + integer(I4B) :: inclocal, isize, newsize + logical(LGP), allocatable, dimension(:) :: array_temp + ! + ! -- initialize + if (present(increment)) then + inclocal = increment + else + inclocal = 1 + end if + ! + ! -- increase size of array by inclocal, retaining + ! contained data + if (allocated(array)) then + isize = size(array) + newsize = isize + inclocal + allocate (array_temp(newsize)) + array_temp(1:isize) = array + deallocate (array) + call move_alloc(array_temp, array) + else + allocate (array(inclocal)) + end if + + end subroutine expand_logical + subroutine expand_character(array, increment) - implicit none ! -- dummy character(len=*), allocatable, intent(inout) :: array(:) integer(I4B), optional, intent(in) :: increment @@ -227,14 +251,12 @@ subroutine expand_character(array, increment) else allocate (array(inclocal)) end if - ! - return + end subroutine expand_character ! -- Specific procedures that implement ExtendArray2D subroutine expand_integer_2d(array, increment1, increment2) - implicit none ! -- dummy integer(I4B), allocatable, intent(inout) :: array(:, :) integer(I4B), optional, intent(in) :: increment1 @@ -269,12 +291,10 @@ subroutine expand_integer_2d(array, increment1, increment2) else allocate (array(inclocal1, inclocal2)) end if - ! - return + end subroutine expand_integer_2d subroutine expand_double_2d(array, increment1, increment2) - implicit none ! -- dummy real(DP), allocatable, intent(inout) :: array(:, :) integer(I4B), optional, intent(in) :: increment1 @@ -309,14 +329,12 @@ subroutine expand_double_2d(array, increment1, increment2) else allocate (array(inclocal1, inclocal2)) end if - ! - return + end subroutine expand_double_2d ! -- Specific procedures that implement ExtendPtrArray for pointer arrays subroutine extend_double(array, increment) - implicit none ! -- dummy real(DP), dimension(:), pointer, contiguous, intent(inout) :: array integer(I4B), optional, intent(in) :: increment @@ -375,7 +393,6 @@ subroutine extend_double(array, increment) end subroutine extend_double subroutine extend_integer(array, increment) - implicit none ! -- dummy integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: array integer(I4B), optional, intent(in) :: increment @@ -433,8 +450,6 @@ subroutine extend_integer(array, increment) end subroutine extend_integer - !> @brief Grows or allocates the array with the passed increment, - !< the old value of the array pointer is rendered invalid subroutine extend_string(array, increment) character(len=*), dimension(:), pointer, contiguous :: array integer(I4B), optional :: increment @@ -464,6 +479,7 @@ subroutine extend_string(array, increment) end subroutine extend_string + !> @brief Concatenate integer arrays. subroutine concat_integer(array, array_to_add) integer(I4B), dimension(:), pointer, contiguous :: array integer(I4B), dimension(:), pointer, contiguous :: array_to_add @@ -478,10 +494,8 @@ subroutine concat_integer(array, array_to_add) end subroutine concat_integer + !> @brief Find the 1st array element containing str, or -1 if not found. function ifind_character(array, str) - ! -- Find the first array element containing str - ! -- Return -1 if not found. - implicit none ! -- return integer(I4B) :: ifind_character ! -- dummy @@ -496,13 +510,10 @@ function ifind_character(array, str) exit findloop end if end do findloop - return end function ifind_character + !> @brief Find the first element containing str, or -1 if not found. function ifind_integer(iarray, ival) - ! -- Find the first array element containing str - ! -- Return -1 if not found. - implicit none ! -- return integer(I4B) :: ifind_integer ! -- dummy @@ -517,12 +528,10 @@ function ifind_integer(iarray, ival) exit findloop end if end do findloop - return end function ifind_integer + !> @brief Remove the element at ipos from the array. subroutine remove_character(array, ipos) - !remove the ipos position from array - implicit none ! -- dummy character(len=*), allocatable, intent(inout) :: array(:) integer(I4B), intent(in) :: ipos @@ -569,8 +578,7 @@ subroutine remove_character(array, ipos) end if end do deallocate (array_temp) - ! - return + end subroutine remove_character end module ArrayHandlersModule