MINICERN/mathlib/gen/m/sortiq.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:51  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_QMIBMVF)
  11 @PROCESS DIRECTIVE('*VDIR:') VECTOR
  12 #endif
  13       SUBROUTINE SORTIQ(A,NC,NR,NS)
  14       INTEGER A(NC,NR),X,LT(20),RT(20),R
  15 #if defined(CERNLIB_CRAY)
  16       INTEGER TEMP
  17 #endif
  18 C
  19       NCS = ABS(NS)
  20       LEVEL=1
  21       LT(1)=1
  22       RT(1)=NR
  23    10 L=LT(LEVEL)
  24       R=RT(LEVEL)
  25       LEVEL=LEVEL-1
  26    20 IF(R.LE.L) IF(LEVEL) 90,90,10
  27 C
  28 C   SUBDIVIDE THE INTERVAL L,R
  29 C     L : LOWER LIMIT OF THE INTERVAL (INPUT)
  30 C     R : UPPER LIMIT OF THE INTERVAL (INPUT)
  31 C     J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
  32 C     I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
  33 C
  34       I=L
  35       J=R
  36       M=(L+R)/2
  37       X=A(NCS,M)
  38    30 IF(A(NCS,I).GE.X) GO TO 40
  39       I=I+1
  40       GO TO 30
  41    40 IF(A(NCS,J).LE.X) GO TO 50
  42       J=J-1
  43       GO TO 40
  44 C
  45    50 IF(I.GT.J) GO TO 70
  46 #if defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC)
  47       CALL USWOP(A(1,I),A(1,J),NC)
  48 #endif
  49 #if defined(CERNLIB_CRAY)
  50       DO 60 K=1, NC
  51         TEMP   = A(K,I)
  52         A(K,I) = A(K,J)
  53         A(K,J) = TEMP
  54    60 CONTINUE
  55 #endif
  56       I=I+1
  57       J=J-1
  58       IF(I.LE.J) GO TO 30
  59 C
  60    70 LEVEL=LEVEL+1
  61       IF((R-I).GE.(J-L)) GO TO 80
  62       LT(LEVEL)=L
  63       RT(LEVEL)=J
  64       L=I
  65       GO TO 20
  66    80 LT(LEVEL)=I
  67       RT(LEVEL)=R
  68       R=J
  69       GO TO 20
  70    90 IF(NS.GT.0) RETURN
  71 C   REVERSE THE ORDER OF THE ROWS IF NS NEGATIVE
  72       NRH=NR/2
  73       DO 110 I=1,NRH
  74 #if (defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_QMIBMVF))
  75         CALL USWOP(A(1,I),A(1,NR+1-I),NC)
  76 #endif
  77 #if defined(CERNLIB_CRAY)||defined(CERNLIB_QMIBMVF)
  78         DO 100 K=1, NC
  79           TEMP = A(K,I)
  80           A(K,I) = A(K,NR+1-I)
  81           A(K,NR+1-I) = TEMP
  82   100   CONTINUE
  83 #endif
  84   110 CONTINUE
  85       END