1*> \brief \b DLASRT sorts numbers in increasing or decreasing order.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DLASRT + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasrt.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasrt.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasrt.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DLASRT( ID, N, D, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          ID
25*       INTEGER            INFO, N
26*       ..
27*       .. Array Arguments ..
28*       DOUBLE PRECISION   D( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> Sort the numbers in D in increasing order (if ID = 'I') or
38*> in decreasing order (if ID = 'D' ).
39*>
40*> Use Quick Sort, reverting to Insertion sort on arrays of
41*> size <= 20. Dimension of STACK limits N to about 2**32.
42*> \endverbatim
43*
44*  Arguments:
45*  ==========
46*
47*> \param[in] ID
48*> \verbatim
49*>          ID is CHARACTER*1
50*>          = 'I': sort D in increasing order;
51*>          = 'D': sort D in decreasing order.
52*> \endverbatim
53*>
54*> \param[in] N
55*> \verbatim
56*>          N is INTEGER
57*>          The length of the array D.
58*> \endverbatim
59*>
60*> \param[in,out] D
61*> \verbatim
62*>          D is DOUBLE PRECISION array, dimension (N)
63*>          On entry, the array to be sorted.
64*>          On exit, D has been sorted into increasing order
65*>          (D(1) <= ... <= D(N) ) or into decreasing order
66*>          (D(1) >= ... >= D(N) ), depending on ID.
67*> \endverbatim
68*>
69*> \param[out] INFO
70*> \verbatim
71*>          INFO is INTEGER
72*>          = 0:  successful exit
73*>          < 0:  if INFO = -i, the i-th argument had an illegal value
74*> \endverbatim
75*
76*  Authors:
77*  ========
78*
79*> \author Univ. of Tennessee
80*> \author Univ. of California Berkeley
81*> \author Univ. of Colorado Denver
82*> \author NAG Ltd.
83*
84*> \date September 2012
85*
86*> \ingroup auxOTHERcomputational
87*
88*  =====================================================================
89      SUBROUTINE DLASRT( ID, N, D, INFO )
90*
91*  -- LAPACK computational routine (version 3.4.2) --
92*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
93*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94*     September 2012
95*
96*     .. Scalar Arguments ..
97      CHARACTER          ID
98      INTEGER            INFO, N
99*     ..
100*     .. Array Arguments ..
101      DOUBLE PRECISION   D( * )
102*     ..
103*
104*  =====================================================================
105*
106*     .. Parameters ..
107      INTEGER            SELECT
108      PARAMETER          ( SELECT = 20 )
109*     ..
110*     .. Local Scalars ..
111      INTEGER            DIR, ENDD, I, J, START, STKPNT
112      DOUBLE PRECISION   D1, D2, D3, DMNMX, TMP
113*     ..
114*     .. Local Arrays ..
115      INTEGER            STACK( 2, 32 )
116*     ..
117*     .. External Functions ..
118      LOGICAL            LSAME
119      EXTERNAL           LSAME
120*     ..
121*     .. External Subroutines ..
122      EXTERNAL           XERBLA
123*     ..
124*     .. Executable Statements ..
125*
126*     Test the input paramters.
127*
128      INFO = 0
129      DIR = -1
130      IF( LSAME( ID, 'D' ) ) THEN
131         DIR = 0
132      ELSE IF( LSAME( ID, 'I' ) ) THEN
133         DIR = 1
134      END IF
135      IF( DIR.EQ.-1 ) THEN
136         INFO = -1
137      ELSE IF( N.LT.0 ) THEN
138         INFO = -2
139      END IF
140      IF( INFO.NE.0 ) THEN
141         CALL XERBLA( 'DLASRT', -INFO )
142         RETURN
143      END IF
144*
145*     Quick return if possible
146*
147      IF( N.LE.1 )
148     $   RETURN
149*
150      STKPNT = 1
151      STACK( 1, 1 ) = 1
152      STACK( 2, 1 ) = N
153   10 CONTINUE
154      START = STACK( 1, STKPNT )
155      ENDD = STACK( 2, STKPNT )
156      STKPNT = STKPNT - 1
157      IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN
158*
159*        Do Insertion sort on D( START:ENDD )
160*
161         IF( DIR.EQ.0 ) THEN
162*
163*           Sort into decreasing order
164*
165            DO 30 I = START + 1, ENDD
166               DO 20 J = I, START + 1, -1
167                  IF( D( J ).GT.D( J-1 ) ) THEN
168                     DMNMX = D( J )
169                     D( J ) = D( J-1 )
170                     D( J-1 ) = DMNMX
171                  ELSE
172                     GO TO 30
173                  END IF
174   20          CONTINUE
175   30       CONTINUE
176*
177         ELSE
178*
179*           Sort into increasing order
180*
181            DO 50 I = START + 1, ENDD
182               DO 40 J = I, START + 1, -1
183                  IF( D( J ).LT.D( J-1 ) ) THEN
184                     DMNMX = D( J )
185                     D( J ) = D( J-1 )
186                     D( J-1 ) = DMNMX
187                  ELSE
188                     GO TO 50
189                  END IF
190   40          CONTINUE
191   50       CONTINUE
192*
193         END IF
194*
195      ELSE IF( ENDD-START.GT.SELECT ) THEN
196*
197*        Partition D( START:ENDD ) and stack parts, largest one first
198*
199*        Choose partition entry as median of 3
200*
201         D1 = D( START )
202         D2 = D( ENDD )
203         I = ( START+ENDD ) / 2
204         D3 = D( I )
205         IF( D1.LT.D2 ) THEN
206            IF( D3.LT.D1 ) THEN
207               DMNMX = D1
208            ELSE IF( D3.LT.D2 ) THEN
209               DMNMX = D3
210            ELSE
211               DMNMX = D2
212            END IF
213         ELSE
214            IF( D3.LT.D2 ) THEN
215               DMNMX = D2
216            ELSE IF( D3.LT.D1 ) THEN
217               DMNMX = D3
218            ELSE
219               DMNMX = D1
220            END IF
221         END IF
222*
223         IF( DIR.EQ.0 ) THEN
224*
225*           Sort into decreasing order
226*
227            I = START - 1
228            J = ENDD + 1
229   60       CONTINUE
230   70       CONTINUE
231            J = J - 1
232            IF( D( J ).LT.DMNMX )
233     $         GO TO 70
234   80       CONTINUE
235            I = I + 1
236            IF( D( I ).GT.DMNMX )
237     $         GO TO 80
238            IF( I.LT.J ) THEN
239               TMP = D( I )
240               D( I ) = D( J )
241               D( J ) = TMP
242               GO TO 60
243            END IF
244            IF( J-START.GT.ENDD-J-1 ) THEN
245               STKPNT = STKPNT + 1
246               STACK( 1, STKPNT ) = START
247               STACK( 2, STKPNT ) = J
248               STKPNT = STKPNT + 1
249               STACK( 1, STKPNT ) = J + 1
250               STACK( 2, STKPNT ) = ENDD
251            ELSE
252               STKPNT = STKPNT + 1
253               STACK( 1, STKPNT ) = J + 1
254               STACK( 2, STKPNT ) = ENDD
255               STKPNT = STKPNT + 1
256               STACK( 1, STKPNT ) = START
257               STACK( 2, STKPNT ) = J
258            END IF
259         ELSE
260*
261*           Sort into increasing order
262*
263            I = START - 1
264            J = ENDD + 1
265   90       CONTINUE
266  100       CONTINUE
267            J = J - 1
268            IF( D( J ).GT.DMNMX )
269     $         GO TO 100
270  110       CONTINUE
271            I = I + 1
272            IF( D( I ).LT.DMNMX )
273     $         GO TO 110
274            IF( I.LT.J ) THEN
275               TMP = D( I )
276               D( I ) = D( J )
277               D( J ) = TMP
278               GO TO 90
279            END IF
280            IF( J-START.GT.ENDD-J-1 ) THEN
281               STKPNT = STKPNT + 1
282               STACK( 1, STKPNT ) = START
283               STACK( 2, STKPNT ) = J
284               STKPNT = STKPNT + 1
285               STACK( 1, STKPNT ) = J + 1
286               STACK( 2, STKPNT ) = ENDD
287            ELSE
288               STKPNT = STKPNT + 1
289               STACK( 1, STKPNT ) = J + 1
290               STACK( 2, STKPNT ) = ENDD
291               STKPNT = STKPNT + 1
292               STACK( 1, STKPNT ) = START
293               STACK( 2, STKPNT ) = J
294            END IF
295         END IF
296      END IF
297      IF( STKPNT.GT.0 )
298     $   GO TO 10
299      RETURN
300*
301*     End of DLASRT
302*
303      END
304