Changes needed by ICC/IFC compiler (Intel)
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / m / sortdq.F
CommitLineData
fe4da5cc 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 SORTDQ(A,NC,NR,NS)
14 DOUBLE PRECISION A(NC,NR),X
15#if defined(CERNLIB_CRAY)
16 DOUBLE PRECISION TEMP
17#endif
18 INTEGER LT(20),RT(20),R
19C
20 NCS = ABS(NS)
21 LEVEL=1
22 LT(1)=1
23 RT(1)=NR
24 10 L=LT(LEVEL)
25 R=RT(LEVEL)
26 LEVEL=LEVEL-1
27 20 IF(R.LE.L) IF(LEVEL) 90,90,10
28C
29C SUBDIVIDE THE INTERVAL L,R
30C L : LOWER LIMIT OF THE INTERVAL (INPUT)
31C R : UPPER LIMIT OF THE INTERVAL (INPUT)
32C J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT)
33C I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT)
34C
35 I=L
36 J=R
37 M=(L+R)/2
38 X=A(NCS,M)
39 30 IF(A(NCS,I).GE.X) GO TO 40
40 I=I+1
41 GO TO 30
42 40 IF(A(NCS,J).LE.X) GO TO 50
43 J=J-1
44 GO TO 40
45C
46 50 IF(I.GT.J) GO TO 70
47#if defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC)
48 CALL USWOP(A(1,I),A(1,J),2*NC)
49#endif
50#if defined(CERNLIB_CRAY)
51 DO 60 K=1, NC
52 TEMP = A(K,I)
53 A(K,I) = A(K,J)
54 A(K,J) = TEMP
55 60 CONTINUE
56#endif
57 I=I+1
58 J=J-1
59 IF(I.LE.J) GO TO 30
60C
61 70 LEVEL=LEVEL+1
62 IF((R-I).GE.(J-L)) GO TO 80
63 LT(LEVEL)=L
64 RT(LEVEL)=J
65 L=I
66 GO TO 20
67 80 LT(LEVEL)=I
68 RT(LEVEL)=R
69 R=J
70 GO TO 20
71 90 IF(NS.GT.0) RETURN
72C REVERSE THE ORDER OF THE ROWS IF NS NEGATIVE
73 NRH=NR/2
74 DO 110 I=1,NRH
75#if (defined(CERNLIB_DOUBLE)||defined(CERNLIB_CDC))&&(!defined(CERNLIB_QMIBMVF))
76 CALL USWOP(A(1,I),A(1,NR+1-I),2*NC)
77#endif
78#if defined(CERNLIB_CRAY)||defined(CERNLIB_QMIBMVF)
79 DO 100 K=1, NC
80 TEMP = A(K,I)
81 A(K,I) = A(K,NR+1-I)
82 A(K,NR+1-I) = TEMP
83 100 CONTINUE
84#endif
85 110 CONTINUE
86 END