Changes needed by ICC/IFC compiler (Intel)
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / m / sortrq.F
CommitLineData
fe4da5cc 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
16C
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
25C
26C SUBDIVIDE THE INTERVAL L,R
27C L : LOWER LIMIT OF THE INTERVAL (INPUT)
28C R : UPPER LIMIT OF THE INTERVAL (INPUT)
29C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
30C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
31C
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
42C
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
57C
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
69C 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