Performs a spill operation on a single array of DP vectors with shape (NDIM, n) This is the inverse of a spill operation
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=DP), | intent(inout), | dimension(:,:), allocatable | :: | keeps |
Array of values to keep |
|
| real(kind=DP), | intent(inout), | dimension(:,:), allocatable | :: | discards |
Array discards |
|
| logical, | intent(in), | dimension(:) | :: | lspill_list |
Logical array of bodies to spill into the discards |
|
| logical, | intent(in) | :: | ldestructive |
Logical flag indicating whether or not this operation should alter the keeps array or not |
subroutine base_util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) !! author: David A. Minton !! !! Performs a spill operation on a single array of DP vectors with shape (NDIM, n) !! This is the inverse of a spill operation implicit none ! Arguments real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep real(DP), dimension(:,:), allocatable, intent(inout) :: discards !! Array discards logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not ! Internals integer(I4B) :: i, nspill, nkeep, nlist real(DP), dimension(:,:), allocatable :: tmp !! Array of values to keep nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) nlist = size(lspill_list(:)) if (.not.allocated(keeps) .or. nspill == 0) return if (size(keeps) < nkeep) return if (.not.allocated(discards)) then allocate(discards(NDIM, nspill)) else if (size(discards, dim=2) /= nspill) then deallocate(discards) allocate(discards(NDIM, nspill)) end if do i = 1, NDIM discards(i,:) = pack(keeps(i,1:nlist), lspill_list(1:nlist)) end do if (ldestructive) then if (nkeep > 0) then allocate(tmp(NDIM, nkeep)) do i = 1, NDIM tmp(i, :) = pack(keeps(i, 1:nlist), .not. lspill_list(1:nlist)) end do call move_alloc(tmp, keeps) else deallocate(keeps) end if end if return end subroutine base_util_spill_arr_DPvec