-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathHeapSort.f90
165 lines (130 loc) · 4.06 KB
/
HeapSort.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
!*************************************************************************
Subroutine HeapSort(n,ra,rb,ia)
Implicit Real(8) (A-H,O-Z)
Real(8) ra(n),rb(n,n),tmp(n,n)
Integer(4) ia(n)
! HeapSort algorithm from "Numerical Recipes in F90"
! Sorts an array ra(1:n) into ascending numerical order using the Heapsort algorithm. n is
! input; ra is replaced on output by its sorted rearrangement.
! rb the second nxn array with columns sorted as ra. ia - indexes of permutations
! CITED REFERENCES AND FURTHER READING:
! Knuth, D.E. 1973, Sorting and Searching, vol. 3 of The Art of Computer Programming (Reading,
! MA: Addison-Wesley), x5.2.3. [1]
! Sedgewick, R. 1988, Algorithms, 2nd ed. (Reading, MA: Addison-Wesley), Chapter 11. [2]
! 8.4 Indexing and Ranking
if (n.lt.2) return
Do i=1,n
ia(i)=i
Enddo
!The index l will be decremented from its initial value down to 1 during the \hiring" (heap
!creation) phase. Once it reaches 1, the index ir will be decremented from its initial value
!down to 1 during the \retirement-and-promotion" (heap selection) phase.
l=n/2+1
ir=n
10 continue
if(l.gt.1)then !Still in hiring phase.
l=l-1
rra=ra(l)
iia=ia(l) !*
else !In retirement-and-promotion phase.
rra=ra(ir) !Clear a space at end of array.
iia=ia(ir) !*
ra(ir)=ra(1) !Retire the top of the heap into it.
ia(ir)=ia(1) !*
ir=ir-1 !Decrease the size of the corporation.
if(ir.eq.1)then !Done with the last promotion.
ra(1)=rra !The least competent worker of all!
ia(1)=iia !*
Goto 30
endif
endif
i=l !Whether in the hiring phase or promotion phase, we here
!set up to sift down element
j=l+l !rra to its proper level.
20 if(j.le.ir)then !Do while j.le.ir:"
if(j.lt.ir)then
if(ra(j).lt.ra(j+1))j=j+1 !Compare to the better underling.
endif
if(rra.lt.ra(j))then !Demote rra.
ra(i)=ra(j)
ia(i)=ia(j) !*
i=j
j=j+j
else !This is rra's level. Set j to terminate the sift-down.
j=ir+1
endif
goto 20
endif
ra(i)=rra !Put rra into its slot.
ia(i)=iia !*
goto 10
! Permutations of the second aray
30 Continue
Do i=1,n
j=ia(i)
tmp(1:n,i)=rb(1:n,j)
Enddo
rb=tmp
END
!*************************************************************************
Subroutine HeapSort1(n,ra,ia)
Implicit Real(8) (A-H,O-Z)
Real(8) ra(n)
Integer(4) ia(n)
! HeapSort algorithm from "Numerical Recipes in F90"
! Sorts an array ra(1:n) into ascending numerical order using the Heapsort algorithm. n is
! input; ra is replaced on output by its sorted rearrangement.
! rb the second nxn array with columns sorted as ra. ia - indexes of permutations
! CITED REFERENCES AND FURTHER READING:
! Knuth, D.E. 1973, Sorting and Searching, vol. 3 of The Art of Computer Programming (Reading,
! MA: Addison-Wesley), x5.2.3. [1]
! Sedgewick, R. 1988, Algorithms, 2nd ed. (Reading, MA: Addison-Wesley), Chapter 11. [2]
! 8.4 Indexing and Ranking
if (n.lt.2) return
Do i=1,n
ia(i)=i
Enddo
!The index l will be decremented from its initial value down to 1 during the \hiring" (heap
!creation) phase. Once it reaches 1, the index ir will be decremented from its initial value
!down to 1 during the \retirement-and-promotion" (heap selection) phase.
l=n/2+1
ir=n
10 continue
if(l.gt.1)then !Still in hiring phase.
l=l-1
rra=ra(l)
iia=ia(l) !*
else !In retirement-and-promotion phase.
rra=ra(ir) !Clear a space at end of array.
iia=ia(ir) !*
ra(ir)=ra(1) !Retire the top of the heap into it.
ia(ir)=ia(1) !*
ir=ir-1 !Decrease the size of the corporation.
if(ir.eq.1)then !Done with the last promotion.
ra(1)=rra !The least competent worker of all!
ia(1)=iia !*
Goto 30
endif
endif
i=l !Whether in the hiring phase or promotion phase, we here
!set up to sift down element
j=l+l !rra to its proper level.
20 if(j.le.ir)then !Do while j.le.ir:"
if(j.lt.ir)then
if(ra(j).lt.ra(j+1))j=j+1 !Compare to the better underling.
endif
if(rra.lt.ra(j))then !Demote rra.
ra(i)=ra(j)
ia(i)=ia(j) !*
i=j
j=j+j
else !This is rra's level. Set j to terminate the sift-down.
j=ir+1
endif
goto 20
endif
ra(i)=rra !Put rra into its slot.
ia(i)=iia !*
goto 10
30 Continue
END