base_util_spill_arr_logical Subroutine

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

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

Arguments

Type IntentOptional Attributes Name
logical, intent(inout), dimension(:), allocatable :: keeps

Array of values to keep

logical, 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 no


Called by

proc~~base_util_spill_arr_logical~~CalledByGraph proc~base_util_spill_arr_logical base_util_spill_arr_logical interface~util_spill~2 util_spill interface~util_spill~2->proc~base_util_spill_arr_logical

Source Code

      subroutine base_util_spill_arr_logical(keeps, discards, lspill_list, ldestructive)
         !! author: David A. Minton 
         !! 
         !! Performs a spill operation on a single array of logicals 
         !! This is the inverse of a spill operation 
         implicit none
         ! Arguments
         logical, dimension(:), allocatable, intent(inout) :: keeps        
            !! Array of values to keep  
         logical, 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 no 
         ! Internals
         integer(I4B) :: nspill, nkeep, nlist
         logical, 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_logical