[u/mrichter/AliRoot.git] / MICROCERN / sortzv.F

*
* $Id$
*
#include "kerngen/pilot.h"
      SUBROUTINE SORTZV (A,INDEX,N1,MODE,NWAY,NSORT)
C
C CERN PROGLIB# M101    SORTZV          .VERSION KERNFOR  3.15  820113
C ORIG. 02/10/75
C
      DIMENSION A(N1),INDEX(N1)
C
C
      N = N1
      IF (N.LE.0)            RETURN
      IF (NSORT.NE.0) GO TO 2
      DO 1 I=1,N
    1 INDEX(I)=I
C
    2 IF (N.EQ.1)            RETURN
      IF (MODE)    10,20,30
   10 CALL SORTTI (A,INDEX,N)
      GO TO 40
C
   20 CALL SORTTC(A,INDEX,N)
      GO TO 40
C
   30 CALL SORTTF (A,INDEX,N)
C
   40 IF (NWAY.EQ.0) GO TO 50
      N2 = N/2
      DO 41 I=1,N2
      ISWAP = INDEX(I)
      K = N+1-I
      INDEX(I) = INDEX(K)
   41 INDEX(K) = ISWAP
   50 RETURN
      END
*     ========================================
      SUBROUTINE SORTTF (A,INDEX,N1)
C
      DIMENSION A(N1),INDEX(N1)
C
      N = N1
      DO 3 I1=2,N
      I3 = I1
      I33 = INDEX(I3)
      AI = A(I33)
    1 I2 = I3/2
      IF (I2) 3,3,2
    2 I22 = INDEX(I2)
      IF (AI.LE.A (I22)) GO TO 3
      INDEX (I3) = I22
      I3 = I2
      GO TO 1
    3 INDEX (I3) = I33
    4 I3 = INDEX (N)
      INDEX (N) = INDEX (1)
      AI = A(I3)
      N = N-1
      IF (N-1) 12,12,5
    5 I1 = 1
    6 I2 = I1 + I1
      IF (I2.LE.N) I22= INDEX(I2)
      IF (I2-N) 7,9,11
    7 I222 = INDEX (I2+1)
      IF (A(I22)-A(I222)) 8,9,9
    8 I2 = I2+1
      I22 = I222
    9 IF (AI-A(I22)) 10,11,11
   10 INDEX(I1) = I22
      I1 = I2
      GO TO 6
   11 INDEX (I1) = I3
      GO TO 4
   12 INDEX (1) = I3
      RETURN
      END
*     ========================================
      SUBROUTINE SORTTI (A,INDEX,N1)
C
      INTEGER A,AI
      DIMENSION A(N1),INDEX(N1)
C
      N = N1
      DO 3 I1=2,N
      I3 = I1
      I33 = INDEX(I3)
      AI = A(I33)
    1 I2 = I3/2
      IF (I2) 3,3,2
    2 I22 = INDEX(I2)
      IF (AI.LE.A (I22)) GO TO 3
      INDEX (I3) = I22
      I3 = I2
      GO TO 1
    3 INDEX (I3) = I33
    4 I3 = INDEX (N)
      INDEX (N) = INDEX (1)
      AI = A(I3)
      N = N-1
      IF (N-1) 12,12,5
    5 I1 = 1
    6 I2 = I1 + I1
      IF (I2.LE.N) I22= INDEX(I2)
      IF (I2-N) 7,9,11
    7 I222 = INDEX (I2+1)
      IF (A(I22)-A(I222)) 8,9,9
    8 I2 = I2+1
      I22 = I222
    9 IF (AI-A(I22)) 10,11,11
   10 INDEX(I1) = I22
      I1 = I2
      GO TO 6
   11 INDEX (I1) = I3
      GO TO 4
   12 INDEX (1) = I3
      RETURN
      END
*     ========================================
      SUBROUTINE SORTTC (A,INDEX,N1)
C
      INTEGER A,AI
      DIMENSION A(N1),INDEX(N1)
C
      N = N1
      DO 3 I1=2,N
      I3 = I1
      I33 = INDEX(I3)
      AI = A(I33)
    1 I2 = I3/2
      IF (I2) 3,3,2
    2 I22 = INDEX(I2)
      IF(ICMPCH(AI,A(I22)))3,3,21
   21 INDEX (I3) = I22
      I3 = I2
      GO TO 1
    3 INDEX (I3) = I33
    4 I3 = INDEX (N)
      INDEX (N) = INDEX (1)
      AI = A(I3)
      N = N-1
      IF (N-1) 12,12,5
    5 I1 = 1
    6 I2 = I1 + I1
      IF (I2.LE.N) I22= INDEX(I2)
      IF (I2-N) 7,9,11
    7 I222 = INDEX (I2+1)
      IF (ICMPCH(A(I22),A(I222))) 8,9,9
    8 I2 = I2+1
      I22 = I222
    9 IF (ICMPCH(AI,A(I22))) 10,11,11
   10 INDEX(I1) = I22
      I1 = I2
      GO TO 6
   11 INDEX (I1) = I3
      GO TO 4
   12 INDEX (1) = I3
      RETURN
      END
*     ========================================
      FUNCTION ICMPCH(IC1,IC2)
C     FUNCTION TO COMPARE TWO 4 CHARACTER EBCDIC STRINGS - IC1,IC2
C     ICMPCH=-1 IF HEX VALUE OF IC1 IS LESS THAN IC2
C     ICMPCH=0  IF HEX VALUES OF IC1 AND IC2 ARE THE SAME
C     ICMPCH=+1 IF HEX VALUES OF IC1 IS GREATER THAN IC2
      I1=IC1
      I2=IC2
      IF(I1.GE.0.AND.I2.GE.0)GOTO 40
      IF(I1.GE.0)GOTO 60
      IF(I2.GE.0)GOTO 80
      I1=-I1
      I2=-I2
      IF(I1-I2)80,70,60
 40   IF(I1-I2)60,70,80
 60   ICMPCH=-1
      RETURN
 70   ICMPCH=0
      RETURN
 80   ICMPCH=1
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
fe4da5cc	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