base_util_spill_arr_DPvec Subroutine

public subroutine base_util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive)

Performs a spill operation on a single array of DP vectors with shape (NDIM, n) This is the inverse of a spill operation

Arguments

TypeIntentOptionalAttributesName
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


Called by

proc~~base_util_spill_arr_dpvec~~CalledByGraph proc~base_util_spill_arr_dpvec base_util_spill_arr_DPvec interface~util_spill util_spill interface~util_spill->proc~base_util_spill_arr_dpvec

Contents


Source Code

      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