Merge branch 'master' of https://git.cern.ch/reps/AliRoot
[u/mrichter/AliRoot.git] / MICROCERN / sortzv.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
fe4da5cc 4#include "kerngen/pilot.h"
5 SUBROUTINE SORTZV (A,INDEX,N1,MODE,NWAY,NSORT)
6C
7C CERN PROGLIB# M101 SORTZV .VERSION KERNFOR 3.15 820113
8C ORIG. 02/10/75
9C
10 DIMENSION A(N1),INDEX(N1)
11C
12C
13 N = N1
14 IF (N.LE.0) RETURN
15 IF (NSORT.NE.0) GO TO 2
16 DO 1 I=1,N
17 1 INDEX(I)=I
18C
19 2 IF (N.EQ.1) RETURN
20 IF (MODE) 10,20,30
21 10 CALL SORTTI (A,INDEX,N)
22 GO TO 40
23C
24 20 CALL SORTTC(A,INDEX,N)
25 GO TO 40
26C
27 30 CALL SORTTF (A,INDEX,N)
28C
29 40 IF (NWAY.EQ.0) GO TO 50
30 N2 = N/2
31 DO 41 I=1,N2
32 ISWAP = INDEX(I)
33 K = N+1-I
34 INDEX(I) = INDEX(K)
35 41 INDEX(K) = ISWAP
36 50 RETURN
37 END
38* ========================================
39 SUBROUTINE SORTTF (A,INDEX,N1)
40C
41 DIMENSION A(N1),INDEX(N1)
42C
43 N = N1
44 DO 3 I1=2,N
45 I3 = I1
46 I33 = INDEX(I3)
47 AI = A(I33)
48 1 I2 = I3/2
49 IF (I2) 3,3,2
50 2 I22 = INDEX(I2)
51 IF (AI.LE.A (I22)) GO TO 3
52 INDEX (I3) = I22
53 I3 = I2
54 GO TO 1
55 3 INDEX (I3) = I33
56 4 I3 = INDEX (N)
57 INDEX (N) = INDEX (1)
58 AI = A(I3)
59 N = N-1
60 IF (N-1) 12,12,5
61 5 I1 = 1
62 6 I2 = I1 + I1
63 IF (I2.LE.N) I22= INDEX(I2)
64 IF (I2-N) 7,9,11
65 7 I222 = INDEX (I2+1)
66 IF (A(I22)-A(I222)) 8,9,9
67 8 I2 = I2+1
68 I22 = I222
69 9 IF (AI-A(I22)) 10,11,11
70 10 INDEX(I1) = I22
71 I1 = I2
72 GO TO 6
73 11 INDEX (I1) = I3
74 GO TO 4
75 12 INDEX (1) = I3
76 RETURN
77 END
78* ========================================
79 SUBROUTINE SORTTI (A,INDEX,N1)
80C
81 INTEGER A,AI
82 DIMENSION A(N1),INDEX(N1)
83C
84 N = N1
85 DO 3 I1=2,N
86 I3 = I1
87 I33 = INDEX(I3)
88 AI = A(I33)
89 1 I2 = I3/2
90 IF (I2) 3,3,2
91 2 I22 = INDEX(I2)
92 IF (AI.LE.A (I22)) GO TO 3
93 INDEX (I3) = I22
94 I3 = I2
95 GO TO 1
96 3 INDEX (I3) = I33
97 4 I3 = INDEX (N)
98 INDEX (N) = INDEX (1)
99 AI = A(I3)
100 N = N-1
101 IF (N-1) 12,12,5
102 5 I1 = 1
103 6 I2 = I1 + I1
104 IF (I2.LE.N) I22= INDEX(I2)
105 IF (I2-N) 7,9,11
106 7 I222 = INDEX (I2+1)
107 IF (A(I22)-A(I222)) 8,9,9
108 8 I2 = I2+1
109 I22 = I222
110 9 IF (AI-A(I22)) 10,11,11
111 10 INDEX(I1) = I22
112 I1 = I2
113 GO TO 6
114 11 INDEX (I1) = I3
115 GO TO 4
116 12 INDEX (1) = I3
117 RETURN
118 END
119* ========================================
120 SUBROUTINE SORTTC (A,INDEX,N1)
121C
122 INTEGER A,AI
123 DIMENSION A(N1),INDEX(N1)
124C
125 N = N1
126 DO 3 I1=2,N
127 I3 = I1
128 I33 = INDEX(I3)
129 AI = A(I33)
130 1 I2 = I3/2
131 IF (I2) 3,3,2
132 2 I22 = INDEX(I2)
133 IF(ICMPCH(AI,A(I22)))3,3,21
134 21 INDEX (I3) = I22
135 I3 = I2
136 GO TO 1
137 3 INDEX (I3) = I33
138 4 I3 = INDEX (N)
139 INDEX (N) = INDEX (1)
140 AI = A(I3)
141 N = N-1
142 IF (N-1) 12,12,5
143 5 I1 = 1
144 6 I2 = I1 + I1
145 IF (I2.LE.N) I22= INDEX(I2)
146 IF (I2-N) 7,9,11
147 7 I222 = INDEX (I2+1)
148 IF (ICMPCH(A(I22),A(I222))) 8,9,9
149 8 I2 = I2+1
150 I22 = I222
151 9 IF (ICMPCH(AI,A(I22))) 10,11,11
152 10 INDEX(I1) = I22
153 I1 = I2
154 GO TO 6
155 11 INDEX (I1) = I3
156 GO TO 4
157 12 INDEX (1) = I3
158 RETURN
159 END
160* ========================================
161 FUNCTION ICMPCH(IC1,IC2)
162C FUNCTION TO COMPARE TWO 4 CHARACTER EBCDIC STRINGS - IC1,IC2
163C ICMPCH=-1 IF HEX VALUE OF IC1 IS LESS THAN IC2
164C ICMPCH=0 IF HEX VALUES OF IC1 AND IC2 ARE THE SAME
165C ICMPCH=+1 IF HEX VALUES OF IC1 IS GREATER THAN IC2
166 I1=IC1
167 I2=IC2
168 IF(I1.GE.0.AND.I2.GE.0)GOTO 40
169 IF(I1.GE.0)GOTO 60
170 IF(I2.GE.0)GOTO 80
171 I1=-I1
172 I2=-I2
173 IF(I1-I2)80,70,60
174 40 IF(I1-I2)60,70,80
175 60 ICMPCH=-1
176 RETURN
177 70 ICMPCH=0
178 RETURN
179 80 ICMPCH=1
180 RETURN
181 END