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