Merge branch 'master' of https://git.cern.ch/reps/AliRoot
[u/mrichter/AliRoot.git] / MICROCERN / sortzv.F
1 *
2 * $Id$
3 *
4 #include "kerngen/pilot.h"
5       SUBROUTINE SORTZV (A,INDEX,N1,MODE,NWAY,NSORT)
6 C
7 C CERN PROGLIB# M101    SORTZV          .VERSION KERNFOR  3.15  820113
8 C ORIG. 02/10/75
9 C
10       DIMENSION A(N1),INDEX(N1)
11 C
12 C
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
18 C
19     2 IF (N.EQ.1)            RETURN
20       IF (MODE)    10,20,30
21    10 CALL SORTTI (A,INDEX,N)
22       GO TO 40
23 C
24    20 CALL SORTTC(A,INDEX,N)
25       GO TO 40
26 C
27    30 CALL SORTTF (A,INDEX,N)
28 C
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)
40 C
41       DIMENSION A(N1),INDEX(N1)
42 C
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)
80 C
81       INTEGER A,AI
82       DIMENSION A(N1),INDEX(N1)
83 C
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)
121 C
122       INTEGER A,AI
123       DIMENSION A(N1),INDEX(N1)
124 C
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)
162 C     FUNCTION TO COMPARE TWO 4 CHARACTER EBCDIC STRINGS - IC1,IC2
163 C     ICMPCH=-1 IF HEX VALUE OF IC1 IS LESS THAN IC2
164 C     ICMPCH=0  IF HEX VALUES OF IC1 AND IC2 ARE THE SAME
165 C     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