kdtree2_priority_queue_module Module Reference

Data Types
type	kdtree2_result
type	pq

Functions/Subroutines
type(pq) function, public	pq_create (results_in)
subroutine, public	pq_max (a, e)
real(kdkind) function, public	pq_maxpri (a)
subroutine, public	pq_extract_max (a, e)
real(kdkind) function, public	pq_insert (a, dis, idx)
real(kdkind) function, public	pq_replace_max (a, dis, idx)
subroutine, public	pq_delete (a, i)

Function/Subroutine Documentation

pq_create()

type(pq) function, public kdtree2_priority_queue_module::pq_create

(

type(kdtree2_result), dimension(:), target

results_in

)

Definition at line 100 of file kdtree2.f90.

    !
    ! Create a priority queue from ALREADY allocated
    ! array pointers for storage.  NOTE! It will NOT
    ! add any alements to the heap, i.e. any existing
    ! data in the input arrays will NOT be used and may
    ! be overwritten.
    ! 
    ! usage:
    !    real(kdkind), pointer :: x(:)
    !    integer, pointer :: k(:)
    !    allocate(x(1000),k(1000))
    !    pq => pq_create(x,k)
    !
    type(kdtree2_result), target:: results_in(:) 
    type(pq) :: res
    !
    !
    integer :: nalloc
 
    nalloc = size(results_in,1)
    if (nalloc .lt. 1) then
       write (*,*) 'PQ_CREATE: error, input arrays must be allocated.'
    end if
    res%elems => results_in
    res%heap_size = 0
    return

Referenced by kdtree2_module::kdtree2_n_nearest(), and kdtree2_module::kdtree2_n_nearest_around_point().

Here is the caller graph for this function:

pq_delete()

subroutine, public kdtree2_priority_queue_module::pq_delete	(	type(pq), pointer	a,
		integer	i
	)

Definition at line 455 of file kdtree2.f90.

    ! 
    ! delete item with index 'i'
    !
    type(pq),pointer :: a
    integer           :: i
 
    if ((i .lt. 1) .or. (i .gt. a%heap_size)) then
       write (*,*) 'PQ_DELETE: error, attempt to remove out of bounds element.'
       stop
    endif
 
    ! swap the item to be deleted with the last element
    ! and shorten heap by one.
    a%elems(i) = a%elems(a%heap_size) 
    a%heap_size = a%heap_size - 1
 
    call heapify(a,i)
 

pq_extract_max()

subroutine, public kdtree2_priority_queue_module::pq_extract_max	(	type(pq), pointer	a,
		type(kdtree2_result), intent(out)	e
	)

Definition at line 269 of file kdtree2.f90.

    !
    ! return the priority and payload of maximum priority
    ! element, and remove it from the queue.
    ! (equivalent to 'pop()' on a stack)
    !
    type(pq),pointer :: a
    type(kdtree2_result), intent(out) :: e
    
    if (a%heap_size .ge. 1) then
       !
       ! return max as first element
       !
       e = a%elems(1) 
       
       !
       ! move last element to first
       !
       a%elems(1) = a%elems(a%heap_size) 
       a%heap_size = a%heap_size-1
       call heapify(a,1)
       return
    else
       write (*,*) 'PQ_EXTRACT_MAX: error, attempted to pop non-positive PQ'
       stop
    end if
    

Referenced by pq_replace_max().

Here is the caller graph for this function:

pq_insert()

real(kdkind) function, public kdtree2_priority_queue_module::pq_insert	(	type(pq), pointer	a,
		real(kdkind), intent(in)	dis,
		integer, intent(in)	idx
	)

Definition at line 299 of file kdtree2.f90.

    !
    ! Insert a new element and return the new maximum priority,
    ! which may or may not be the same as the old maximum priority.
    !
    type(pq),pointer  :: a
    real(kdkind), intent(in) :: dis
    integer, intent(in) :: idx
    !    type(kdtree2_result), intent(in) :: e
    !
    integer :: i, isparent
    real(kdkind)    :: parentdis
    !
 
    !    if (a%heap_size .ge. a%max_elems) then
    !       write (*,*) 'PQ_INSERT: error, attempt made to insert element on full PQ'
    !       stop
    !    else
    a%heap_size = a%heap_size + 1
    i = a%heap_size
 
    do while (i .gt. 1)
       isparent = int(i/2)
       parentdis = a%elems(isparent)%dis
       if (dis .gt. parentdis) then
          ! move what was in i's parent into i.
          a%elems(i)%dis = parentdis
          a%elems(i)%idx = a%elems(isparent)%idx
          i = isparent
       else
          exit
       endif
    end do
 
    ! insert the element at the determined position
    a%elems(i)%dis = dis
    a%elems(i)%idx = idx
 
    pq_insert = a%elems(1)%dis 
    return
    !    end if
 

References pq_insert().

Referenced by pq_insert(), and pq_replace_max().

Here is the call graph for this function:

Here is the caller graph for this function:

pq_max()

subroutine, public kdtree2_priority_queue_module::pq_max	(	type(pq), pointer	a,
		type(kdtree2_result), intent(out)	e
	)

Definition at line 239 of file kdtree2.f90.

    !
    ! return the priority and its payload of the maximum priority element
    ! on the queue, which should be the first one, if it is 
    ! in heapified form.
    !
    type(pq),pointer :: a
    type(kdtree2_result),intent(out)  :: e
 
    if (a%heap_size .gt. 0) then
       e = a%elems(1) 
    else
       write (*,*) 'PQ_MAX: ERROR, heap_size < 1'
       stop
    endif
    return

pq_maxpri()

real(kdkind) function, public kdtree2_priority_queue_module::pq_maxpri

(

type(pq), pointer

a

)

Definition at line 257 of file kdtree2.f90.

    type(pq), pointer :: a
 
    if (a%heap_size .gt. 0) then
       pq_maxpri = a%elems(1)%dis
    else
       write (*,*) 'PQ_MAX_PRI: ERROR, heapsize < 1'
       stop
    endif
    return

References pq_maxpri().

Referenced by pq_maxpri().

Here is the call graph for this function:

Here is the caller graph for this function:

pq_replace_max()

real(kdkind) function, public kdtree2_priority_queue_module::pq_replace_max	(	type(pq), pointer	a,
		real(kdkind), intent(in)	dis,
		integer, intent(in)	idx
	)

Definition at line 384 of file kdtree2.f90.

    !
    ! Replace the extant maximum priority element
    ! in the PQ with (dis,idx).  Return
    ! the new maximum priority, which may be larger
    ! or smaller than the old one.
    !
    type(pq),pointer         :: a
    real(kdkind), intent(in) :: dis
    integer, intent(in) :: idx
!    type(kdtree2_result), intent(in) :: e
    ! not tested as well!
 
    integer :: parent, child, N
    real(kdkind)    :: prichild, prichildp1
 
    type(kdtree2_result) :: etmp
    
    if (.true.) then
       n=a%heap_size
       if (n .ge. 1) then
          parent =1
          child=2
 
          loop: do while (child .le. n)
             prichild = a%elems(child)%dis
 
             !
             ! posibly child+1 has higher priority, and if
             ! so, get it, and increment child.
             !
 
             if (child .lt. n) then
                prichildp1 = a%elems(child+1)%dis
                if (prichild .lt. prichildp1) then
                   child = child+1
                   prichild = prichildp1
                endif
             endif
 
             if (dis .ge. prichild) then
                exit loop  
                ! we have a proper place for our new element, 
                ! bigger than either children's priority.
             else
                ! move child into parent.
                a%elems(parent) = a%elems(child) 
                parent = child
                child = 2*parent
             end if
          end do loop
          a%elems(parent)%dis = dis
          a%elems(parent)%idx = idx
          pq_replace_max = a%elems(1)%dis
       else
          a%elems(1)%dis = dis
          a%elems(1)%idx = idx
          pq_replace_max = dis
       endif
    else
       !
       ! slower version using elementary pop and push operations.
       !
       call pq_extract_max(a,etmp) 
       etmp%dis = dis
       etmp%idx = idx
       pq_replace_max = pq_insert(a,dis,idx)
    endif
    return

References pq_extract_max(), pq_insert(), and pq_replace_max().

Referenced by pq_replace_max().

Here is the call graph for this function:

Here is the caller graph for this function: