ISAJET/utils/cern_lib/sorttf.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1  2000/07/25 14:53:05  mclareni
   6 * Version 7.51 from author
   7 *
   8 *
   9 *#include "sys/CERNLIB_machine.h"
  10 #include "isajet/pilot.h"
  11 #if defined(CERNLIB_NOCERN)
  12       SUBROUTINE SORTTF(A,INDEX,N1)
  13 C=======================================================================
  14 C          Given real array and corresponding index INDEX, find new
  15 C          INDEX for which A is sorted into ascending order.
  16 C
  17 C          From CERN PROGLIB# M101
  18 C=======================================================================
  19       DIMENSION A(N1),INDEX(N1)
  20 C
  21       N = N1
  22       DO 3 I1=2,N
  23       I3 = I1
  24       I33 = INDEX(I3)
  25       AI = A(I33)
  26     1 I2 = I3/2
  27       IF (I2) 3,3,2
  28     2 I22 = INDEX(I2)
  29       IF (AI.LE.A (I22)) GO TO 3
  30       INDEX (I3) = I22
  31       I3 = I2
  32       GO TO 1
  33     3 INDEX (I3) = I33
  34     4 I3 = INDEX (N)
  35       INDEX (N) = INDEX (1)
  36       AI = A(I3)
  37       N = N-1
  38       IF (N-1) 12,12,5
  39     5 I1 = 1
  40     6 I2 = I1 + I1
  41       IF (I2.LE.N) I22= INDEX(I2)
  42       IF (I2-N) 7,9,11
  43     7 I222 = INDEX (I2+1)
  44       IF (A(I22)-A(I222)) 8,9,9
  45     8 I2 = I2+1
  46       I22 = I222
  47     9 IF (AI-A(I22)) 10,11,11
  48    10 INDEX(I1) = I22
  49       I1 = I2
  50       GO TO 6
  51    11 INDEX (I1) = I3
  52       GO TO 4
  53    12 INDEX (1) = I3
  54       RETURN
  55       END
  56 #endif