base_util_spill_arr_I8B Subroutine

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

Performs a spill operation on a single array of type I4B This is the inverse of a spill operation

Arguments

TypeIntentOptionalAttributesName
integer(kind=I8B), intent(inout), dimension(:), allocatable:: keeps

Array of values to keep

integer(kind=I8B), intent(inout), dimension(:), allocatable:: discards

Array of 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_i8b~~CalledByGraph proc~base_util_spill_arr_i8b base_util_spill_arr_I8B interface~util_spill util_spill interface~util_spill->proc~base_util_spill_arr_i8b

Contents


Source Code

      subroutine base_util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive)
         !! author: David A. Minton 
         !! 
         !! Performs a spill operation on a single array of type I4B 
         !! This is the inverse of a spill operation 
         implicit none
         ! Arguments
         integer(I8B), dimension(:), allocatable, intent(inout) :: keeps       
            !! Array of values to keep  
         integer(I8B), dimension(:), allocatable, intent(inout) :: discards    
            !! Array of 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) :: nspill, nkeep, nlist
         integer(I8B), 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(nspill))
         else if (size(discards) /= nspill) then
            deallocate(discards)
            allocate(discards(nspill))
         end if

         discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist))
         if (ldestructive) then
            if (nkeep > 0) then
               allocate(tmp(nkeep))
               tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist))
               call move_alloc(tmp, keeps)
            else
               deallocate(keeps)
            end if
         end if

         return
      end subroutine base_util_spill_arr_I8B