Merging the VirtualMC branch to the main development branch (HEAD)
[u/mrichter/AliRoot.git] / MICROCERN / sortzv.F
1 *
2 * $Id$
3 *
4 * $Log$
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 *
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