[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgen / sortzv.F

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