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