base_util_spill_arr_DP Subroutine

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

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

Arguments

Type IntentOptional Attributes Name
real(kind=DP), intent(inout), dimension(:), allocatable :: keeps

Array of values to keep

real(kind=DP), intent(inout), dimension(:), allocatable :: discards

Array of discards

logical, intent(in), dimension(:) :: lspill_list

Logical array of bodies to spill into the discardss

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_dp~~CalledByGraph proc~base_util_spill_arr_dp base_util_spill_arr_DP interface~util_spill util_spill interface~util_spill->proc~base_util_spill_arr_dp

Source Code

      subroutine base_util_spill_arr_DP(keeps, discards, lspill_list, ldestructive)
         !! author: David A. Minton 
         !! 
         !! Performs a spill operation on a single array of type DP 
         !! 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 of discards 
         logical,  dimension(:),              intent(in)    :: lspill_list  
            !! Logical array of bodies to spill into the discardss 
         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
         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(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_DP