This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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