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