MINICERN/mathlib/gen/m/sortrq.F

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