var/da/da_tracing/da_trace_int_sort.inc

   1 subroutine da_trace_int_sort(&
   2    key, &
   3    n, &
   4    index)
   5
   6    !----------------------------------------------------------------------
   7    ! Purpose: sort integers for tracing
   8    !----------------------------------------------------------------------
   9
  10    implicit none
  11
  12    integer, intent(in)          :: n      ! The number of items to be sorted.
  13    integer, intent(in)          :: key(:)
  14    integer, intent(out) :: index(:)
  15
  16    integer :: head       ! heaps are tree structures: head and child refer
  17    integer :: child      ! to related items within the tree
  18    integer :: i
  19    integer :: dum        ! used to swap index items
  20
  21
  22    ! initialise index:
  23    do i=1,n
  24       index(i)=i
  25    end do
  26
  27    ! Do heapsort: Create the heap...
  28    makeheap : do i=n/2,1,-1
  29       head=i
  30       sift1 : do
  31          ! find the largest out of the head and its two children...
  32          child=head*2
  33          if (child>n) exit sift1
  34          if (child<n) then
  35             if (key(index(child+1))>key(index(child))) child=child+1
  36          end if
  37          ! if the head is the largest, then sift is done...
  38          if (key(index(head))>=key(index(child))) exit sift1
  39          ! otherwise swap to put the largest child at the head,
  40          ! and prepare to repeat the procedure for the head in its new
  41          ! subordinate position.
  42          dum=index(child)
  43          index(child)=index(head)
  44          index(head)=dum
  45          head=child
  46       end do sift1
  47    end do makeheap
  48
  49    ! Retire heads of the heap, which are the largest, and
  50    ! stack them at the end of the array.
  51    retire : do i=n,2,-1
  52       dum=index(1)
  53       index(1)=index(i)
  54       index(i)=dum
  55       head=1
  56          ! second sift is similar to first...
  57       sift2: do
  58          child=head*2
  59          if (child>(i-1)) exit sift2
  60          if (child<(i-1)) then
  61             if (key(index(child+1))>key(index(child))) child=child+1
  62          end if
  63          if (key(index(head))>=key(index(child))) exit sift2
  64          dum=index(child)
  65          index(child)=index(head)
  66          index(head)=dum
  67          head=child
  68       end do sift2
  69    end do retire
  70
  71 end subroutine da_trace_int_sort
  72
  73