MINICERN/packlib/kernlib/kerngen/tcgen/sortzv.F

   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