mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2025-10-31 13:10:19 -04:00
020264e99e
Compiles and runs OK on Aubrey. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/map65@410 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
288 lines
6.4 KiB
Fortran
288 lines
6.4 KiB
Fortran
subroutine ssort (x,y,n,kflag)
|
|
c***purpose sort an array and optionally make the same interchanges in
|
|
c an auxiliary array. the array may be sorted in increasing
|
|
c or decreasing order. a slightly modified quicksort
|
|
c algorithm is used.
|
|
c
|
|
c ssort sorts array x and optionally makes the same interchanges in
|
|
c array y. the array x may be sorted in increasing order or
|
|
c decreasing order. a slightly modified quicksort algorithm is used.
|
|
c
|
|
c description of parameters
|
|
c x - array of values to be sorted
|
|
c y - array to be (optionally) carried along
|
|
c n - number of values in array x to be sorted
|
|
c kflag - control parameter
|
|
c = 2 means sort x in increasing order and carry y along.
|
|
c = 1 means sort x in increasing order (ignoring y)
|
|
c = -1 means sort x in decreasing order (ignoring y)
|
|
c = -2 means sort x in decreasing order and carry y along.
|
|
|
|
integer kflag, n
|
|
! real x(n), y(n)
|
|
! real r, t, tt, tty, ty
|
|
integer x(n), y(n)
|
|
integer r, t, tt, tty, ty
|
|
integer i, ij, j, k, kk, l, m, nn
|
|
integer il(21), iu(21)
|
|
|
|
nn = n
|
|
if (nn .lt. 1) then
|
|
! print*,'ssort: The number of sort elements is not positive.'
|
|
! print*,'ssort: n = ',nn,' kflag = ',kflag
|
|
return
|
|
endif
|
|
c
|
|
kk = abs(kflag)
|
|
if (kk.ne.1 .and. kk.ne.2) then
|
|
print *,
|
|
+ 'the sort control parameter, k, is not 2, 1, -1, or -2.'
|
|
return
|
|
endif
|
|
c
|
|
c alter array x to get decreasing order if needed
|
|
c
|
|
if (kflag .le. -1) then
|
|
do 10 i=1,nn
|
|
x(i) = -x(i)
|
|
10 continue
|
|
endif
|
|
c
|
|
if (kk .eq. 2) go to 100
|
|
c
|
|
c sort x only
|
|
c
|
|
m = 1
|
|
i = 1
|
|
j = nn
|
|
r = 0.375e0
|
|
c
|
|
20 if (i .eq. j) go to 60
|
|
if (r .le. 0.5898437e0) then
|
|
r = r+3.90625e-2
|
|
else
|
|
r = r-0.21875e0
|
|
endif
|
|
c
|
|
30 k = i
|
|
c
|
|
c select a central element of the array and save it in location t
|
|
c
|
|
ij = i + int((j-i)*r)
|
|
t = x(ij)
|
|
c
|
|
c if first element of array is greater than t, interchange with t
|
|
c
|
|
if (x(i) .gt. t) then
|
|
x(ij) = x(i)
|
|
x(i) = t
|
|
t = x(ij)
|
|
endif
|
|
l = j
|
|
c
|
|
c if last element of array is less than than t, interchange with t
|
|
c
|
|
if (x(j) .lt. t) then
|
|
x(ij) = x(j)
|
|
x(j) = t
|
|
t = x(ij)
|
|
c
|
|
c if first element of array is greater than t, interchange with t
|
|
c
|
|
if (x(i) .gt. t) then
|
|
x(ij) = x(i)
|
|
x(i) = t
|
|
t = x(ij)
|
|
endif
|
|
endif
|
|
c
|
|
c find an element in the second half of the array which is smaller
|
|
c than t
|
|
c
|
|
40 l = l-1
|
|
if (x(l) .gt. t) go to 40
|
|
c
|
|
c find an element in the first half of the array which is greater
|
|
c than t
|
|
c
|
|
50 k = k+1
|
|
if (x(k) .lt. t) go to 50
|
|
c
|
|
c interchange these elements
|
|
c
|
|
if (k .le. l) then
|
|
tt = x(l)
|
|
x(l) = x(k)
|
|
x(k) = tt
|
|
go to 40
|
|
endif
|
|
c
|
|
c save upper and lower subscripts of the array yet to be sorted
|
|
c
|
|
if (l-i .gt. j-k) then
|
|
il(m) = i
|
|
iu(m) = l
|
|
i = k
|
|
m = m+1
|
|
else
|
|
il(m) = k
|
|
iu(m) = j
|
|
j = l
|
|
m = m+1
|
|
endif
|
|
go to 70
|
|
c
|
|
c begin again on another portion of the unsorted array
|
|
c
|
|
60 m = m-1
|
|
if (m .eq. 0) go to 190
|
|
i = il(m)
|
|
j = iu(m)
|
|
c
|
|
70 if (j-i .ge. 1) go to 30
|
|
if (i .eq. 1) go to 20
|
|
i = i-1
|
|
c
|
|
80 i = i+1
|
|
if (i .eq. j) go to 60
|
|
t = x(i+1)
|
|
if (x(i) .le. t) go to 80
|
|
k = i
|
|
c
|
|
90 x(k+1) = x(k)
|
|
k = k-1
|
|
if (t .lt. x(k)) go to 90
|
|
x(k+1) = t
|
|
go to 80
|
|
c
|
|
c sort x and carry y along
|
|
c
|
|
100 m = 1
|
|
i = 1
|
|
j = nn
|
|
r = 0.375e0
|
|
c
|
|
110 if (i .eq. j) go to 150
|
|
if (r .le. 0.5898437e0) then
|
|
r = r+3.90625e-2
|
|
else
|
|
r = r-0.21875e0
|
|
endif
|
|
c
|
|
120 k = i
|
|
c
|
|
c select a central element of the array and save it in location t
|
|
c
|
|
ij = i + int((j-i)*r)
|
|
t = x(ij)
|
|
ty = y(ij)
|
|
c
|
|
c if first element of array is greater than t, interchange with t
|
|
c
|
|
if (x(i) .gt. t) then
|
|
x(ij) = x(i)
|
|
x(i) = t
|
|
t = x(ij)
|
|
y(ij) = y(i)
|
|
y(i) = ty
|
|
ty = y(ij)
|
|
endif
|
|
l = j
|
|
c
|
|
c if last element of array is less than t, interchange with t
|
|
c
|
|
if (x(j) .lt. t) then
|
|
x(ij) = x(j)
|
|
x(j) = t
|
|
t = x(ij)
|
|
y(ij) = y(j)
|
|
y(j) = ty
|
|
ty = y(ij)
|
|
c
|
|
c if first element of array is greater than t, interchange with t
|
|
c
|
|
if (x(i) .gt. t) then
|
|
x(ij) = x(i)
|
|
x(i) = t
|
|
t = x(ij)
|
|
y(ij) = y(i)
|
|
y(i) = ty
|
|
ty = y(ij)
|
|
endif
|
|
endif
|
|
c
|
|
c find an element in the second half of the array which is smaller
|
|
c than t
|
|
c
|
|
130 l = l-1
|
|
if (x(l) .gt. t) go to 130
|
|
c
|
|
c find an element in the first half of the array which is greater
|
|
c than t
|
|
c
|
|
140 k = k+1
|
|
if (x(k) .lt. t) go to 140
|
|
c
|
|
c interchange these elements
|
|
c
|
|
if (k .le. l) then
|
|
tt = x(l)
|
|
x(l) = x(k)
|
|
x(k) = tt
|
|
tty = y(l)
|
|
y(l) = y(k)
|
|
y(k) = tty
|
|
go to 130
|
|
endif
|
|
c
|
|
c save upper and lower subscripts of the array yet to be sorted
|
|
c
|
|
if (l-i .gt. j-k) then
|
|
il(m) = i
|
|
iu(m) = l
|
|
i = k
|
|
m = m+1
|
|
else
|
|
il(m) = k
|
|
iu(m) = j
|
|
j = l
|
|
m = m+1
|
|
endif
|
|
go to 160
|
|
c
|
|
c begin again on another portion of the unsorted array
|
|
c
|
|
150 m = m-1
|
|
if (m .eq. 0) go to 190
|
|
i = il(m)
|
|
j = iu(m)
|
|
c
|
|
160 if (j-i .ge. 1) go to 120
|
|
if (i .eq. 1) go to 110
|
|
i = i-1
|
|
c
|
|
170 i = i+1
|
|
if (i .eq. j) go to 150
|
|
t = x(i+1)
|
|
ty = y(i+1)
|
|
if (x(i) .le. t) go to 170
|
|
k = i
|
|
c
|
|
180 x(k+1) = x(k)
|
|
y(k+1) = y(k)
|
|
k = k-1
|
|
if (t .lt. x(k)) go to 180
|
|
x(k+1) = t
|
|
y(k+1) = ty
|
|
go to 170
|
|
c
|
|
c clean up
|
|
c
|
|
190 if (kflag .le. -1) then
|
|
do 200 i=1,nn
|
|
x(i) = -x(i)
|
|
200 continue
|
|
endif
|
|
return
|
|
end
|