1 *> \brief \b DLASRT sorts numbers in increasing or decreasing order.
3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download DLASRT + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasrt.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasrt.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasrt.f">
21 * SUBROUTINE DLASRT( ID, N, D, INFO )
23 * .. Scalar Arguments ..
27 * .. Array Arguments ..
28 * DOUBLE PRECISION D( * )
37 *> Sort the numbers in D in increasing order (if ID = 'I') or
38 *> in decreasing order (if ID = 'D' ).
40 *> Use Quick Sort, reverting to Insertion sort on arrays of
41 *> size <= 20. Dimension of STACK limits N to about 2**32.
50 *> = 'I': sort D in increasing order;
51 *> = 'D': sort D in decreasing order.
57 *> The length of the array D.
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.
72 *> = 0: successful exit
73 *> < 0: if INFO = -i, the i-th argument had an illegal value
79 *> \author Univ. of Tennessee
80 *> \author Univ. of California Berkeley
81 *> \author Univ. of Colorado Denver
86 *> \ingroup auxOTHERcomputational
88 * =====================================================================
89 SUBROUTINE DLASRT( ID, N, D, INFO )
91 * -- LAPACK computational routine (version 3.6.1) --
92 * -- LAPACK is a software package provided by Univ. of Tennessee, --
93 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
96 * .. Scalar Arguments ..
100 * .. Array Arguments ..
101 DOUBLE PRECISION D( * )
104 * =====================================================================
108 PARAMETER ( SELECT = 20 )
110 * .. Local Scalars ..
111 INTEGER DIR, ENDD, I, J, START, STKPNT
112 DOUBLE PRECISION D1, D2, D3, DMNMX, TMP
115 INTEGER STACK( 2, 32 )
117 * .. External Functions ..
121 * .. External Subroutines ..
124 * .. Executable Statements ..
126 * Test the input parameters.
130 IF( LSAME( ID, 'D' ) ) THEN
132 ELSE IF( LSAME( ID, 'I' ) ) THEN
137 ELSE IF( N.LT.0 ) THEN
141 CALL XERBLA( 'DLASRT', -INFO )
145 * Quick return if possible
154 START = STACK( 1, STKPNT )
155 ENDD = STACK( 2, STKPNT )
157 IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN
159 * Do Insertion sort on D( START:ENDD )
163 * Sort into decreasing order
165 DO 30 I = START + 1, ENDD
166 DO 20 J = I, START + 1, -1
167 IF( D( J ).GT.D( J-1 ) ) THEN
179 * Sort into increasing order
181 DO 50 I = START + 1, ENDD
182 DO 40 J = I, START + 1, -1
183 IF( D( J ).LT.D( J-1 ) ) THEN
195 ELSE IF( ENDD-START.GT.SELECT ) THEN
197 * Partition D( START:ENDD ) and stack parts, largest one first
199 * Choose partition entry as median of 3
203 I = ( START+ENDD ) / 2
208 ELSE IF( D3.LT.D2 ) THEN
216 ELSE IF( D3.LT.D1 ) THEN
225 * Sort into decreasing order
232 IF( D( J ).LT.DMNMX )
236 IF( D( I ).GT.DMNMX )
244 IF( J-START.GT.ENDD-J-1 ) THEN
246 STACK( 1, STKPNT ) = START
247 STACK( 2, STKPNT ) = J
249 STACK( 1, STKPNT ) = J + 1
250 STACK( 2, STKPNT ) = ENDD
253 STACK( 1, STKPNT ) = J + 1
254 STACK( 2, STKPNT ) = ENDD
256 STACK( 1, STKPNT ) = START
257 STACK( 2, STKPNT ) = J
261 * Sort into increasing order
268 IF( D( J ).GT.DMNMX )
272 IF( D( I ).LT.DMNMX )
280 IF( J-START.GT.ENDD-J-1 ) THEN
282 STACK( 1, STKPNT ) = START
283 STACK( 2, STKPNT ) = J
285 STACK( 1, STKPNT ) = J + 1
286 STACK( 2, STKPNT ) = ENDD
289 STACK( 1, STKPNT ) = J + 1
290 STACK( 2, STKPNT ) = ENDD
292 STACK( 1, STKPNT ) = START
293 STACK( 2, STKPNT ) = J