4 #include "kerngen/pilot.h"
5 SUBROUTINE SORTZV (A,INDEX,N1,MODE,NWAY,NSORT)
7 C CERN PROGLIB# M101 SORTZV .VERSION KERNFOR 3.15 820113
10 DIMENSION A(N1),INDEX(N1)
15 IF (NSORT.NE.0) GO TO 2
21 10 CALL SORTTI (A,INDEX,N)
24 20 CALL SORTTC(A,INDEX,N)
27 30 CALL SORTTF (A,INDEX,N)
29 40 IF (NWAY.EQ.0) GO TO 50
38 * ========================================
39 SUBROUTINE SORTTF (A,INDEX,N1)
41 DIMENSION A(N1),INDEX(N1)
51 IF (AI.LE.A (I22)) GO TO 3
63 IF (I2.LE.N) I22= INDEX(I2)
66 IF (A(I22)-A(I222)) 8,9,9
69 9 IF (AI-A(I22)) 10,11,11
78 * ========================================
79 SUBROUTINE SORTTI (A,INDEX,N1)
82 DIMENSION A(N1),INDEX(N1)
92 IF (AI.LE.A (I22)) GO TO 3
104 IF (I2.LE.N) I22= INDEX(I2)
106 7 I222 = INDEX (I2+1)
107 IF (A(I22)-A(I222)) 8,9,9
110 9 IF (AI-A(I22)) 10,11,11
119 * ========================================
120 SUBROUTINE SORTTC (A,INDEX,N1)
123 DIMENSION A(N1),INDEX(N1)
133 IF(ICMPCH(AI,A(I22)))3,3,21
139 INDEX (N) = INDEX (1)
145 IF (I2.LE.N) I22= INDEX(I2)
147 7 I222 = INDEX (I2+1)
148 IF (ICMPCH(A(I22),A(I222))) 8,9,9
151 9 IF (ICMPCH(AI,A(I22))) 10,11,11
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
168 IF(I1.GE.0.AND.I2.GE.0)GOTO 40