| *> \brief \b DLASRT sorts numbers in increasing or decreasing order. |
| * |
| * =========== DOCUMENTATION =========== |
| * |
| * Online html documentation available at |
| * http://www.netlib.org/lapack/explore-html/ |
| * |
| *> \htmlonly |
| *> Download DLASRT + dependencies |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasrt.f"> |
| *> [TGZ]</a> |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasrt.f"> |
| *> [ZIP]</a> |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasrt.f"> |
| *> [TXT]</a> |
| *> \endhtmlonly |
| * |
| * Definition: |
| * =========== |
| * |
| * SUBROUTINE DLASRT( ID, N, D, INFO ) |
| * |
| * .. Scalar Arguments .. |
| * CHARACTER ID |
| * INTEGER INFO, N |
| * .. |
| * .. Array Arguments .. |
| * DOUBLE PRECISION D( * ) |
| * .. |
| * |
| * |
| *> \par Purpose: |
| * ============= |
| *> |
| *> \verbatim |
| *> |
| *> Sort the numbers in D in increasing order (if ID = 'I') or |
| *> in decreasing order (if ID = 'D' ). |
| *> |
| *> Use Quick Sort, reverting to Insertion sort on arrays of |
| *> size <= 20. Dimension of STACK limits N to about 2**32. |
| *> \endverbatim |
| * |
| * Arguments: |
| * ========== |
| * |
| *> \param[in] ID |
| *> \verbatim |
| *> ID is CHARACTER*1 |
| *> = 'I': sort D in increasing order; |
| *> = 'D': sort D in decreasing order. |
| *> \endverbatim |
| *> |
| *> \param[in] N |
| *> \verbatim |
| *> N is INTEGER |
| *> The length of the array D. |
| *> \endverbatim |
| *> |
| *> \param[in,out] D |
| *> \verbatim |
| *> D is DOUBLE PRECISION array, dimension (N) |
| *> On entry, the array to be sorted. |
| *> On exit, D has been sorted into increasing order |
| *> (D(1) <= ... <= D(N) ) or into decreasing order |
| *> (D(1) >= ... >= D(N) ), depending on ID. |
| *> \endverbatim |
| *> |
| *> \param[out] INFO |
| *> \verbatim |
| *> INFO is INTEGER |
| *> = 0: successful exit |
| *> < 0: if INFO = -i, the i-th argument had an illegal value |
| *> \endverbatim |
| * |
| * Authors: |
| * ======== |
| * |
| *> \author Univ. of Tennessee |
| *> \author Univ. of California Berkeley |
| *> \author Univ. of Colorado Denver |
| *> \author NAG Ltd. |
| * |
| *> \date September 2012 |
| * |
| *> \ingroup auxOTHERcomputational |
| * |
| * ===================================================================== |
| SUBROUTINE DLASRT( ID, N, D, INFO ) |
| * |
| * -- LAPACK computational routine (version 3.4.2) -- |
| * -- LAPACK is a software package provided by Univ. of Tennessee, -- |
| * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
| * September 2012 |
| * |
| * .. Scalar Arguments .. |
| CHARACTER ID |
| INTEGER INFO, N |
| * .. |
| * .. Array Arguments .. |
| DOUBLE PRECISION D( * ) |
| * .. |
| * |
| * ===================================================================== |
| * |
| * .. Parameters .. |
| INTEGER SELECT |
| PARAMETER ( SELECT = 20 ) |
| * .. |
| * .. Local Scalars .. |
| INTEGER DIR, ENDD, I, J, START, STKPNT |
| DOUBLE PRECISION D1, D2, D3, DMNMX, TMP |
| * .. |
| * .. Local Arrays .. |
| INTEGER STACK( 2, 32 ) |
| * .. |
| * .. External Functions .. |
| LOGICAL LSAME |
| EXTERNAL LSAME |
| * .. |
| * .. External Subroutines .. |
| EXTERNAL XERBLA |
| * .. |
| * .. Executable Statements .. |
| * |
| * Test the input paramters. |
| * |
| INFO = 0 |
| DIR = -1 |
| IF( LSAME( ID, 'D' ) ) THEN |
| DIR = 0 |
| ELSE IF( LSAME( ID, 'I' ) ) THEN |
| DIR = 1 |
| END IF |
| IF( DIR.EQ.-1 ) THEN |
| INFO = -1 |
| ELSE IF( N.LT.0 ) THEN |
| INFO = -2 |
| END IF |
| IF( INFO.NE.0 ) THEN |
| CALL XERBLA( 'DLASRT', -INFO ) |
| RETURN |
| END IF |
| * |
| * Quick return if possible |
| * |
| IF( N.LE.1 ) |
| $ RETURN |
| * |
| STKPNT = 1 |
| STACK( 1, 1 ) = 1 |
| STACK( 2, 1 ) = N |
| 10 CONTINUE |
| START = STACK( 1, STKPNT ) |
| ENDD = STACK( 2, STKPNT ) |
| STKPNT = STKPNT - 1 |
| IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN |
| * |
| * Do Insertion sort on D( START:ENDD ) |
| * |
| IF( DIR.EQ.0 ) THEN |
| * |
| * Sort into decreasing order |
| * |
| DO 30 I = START + 1, ENDD |
| DO 20 J = I, START + 1, -1 |
| IF( D( J ).GT.D( J-1 ) ) THEN |
| DMNMX = D( J ) |
| D( J ) = D( J-1 ) |
| D( J-1 ) = DMNMX |
| ELSE |
| GO TO 30 |
| END IF |
| 20 CONTINUE |
| 30 CONTINUE |
| * |
| ELSE |
| * |
| * Sort into increasing order |
| * |
| DO 50 I = START + 1, ENDD |
| DO 40 J = I, START + 1, -1 |
| IF( D( J ).LT.D( J-1 ) ) THEN |
| DMNMX = D( J ) |
| D( J ) = D( J-1 ) |
| D( J-1 ) = DMNMX |
| ELSE |
| GO TO 50 |
| END IF |
| 40 CONTINUE |
| 50 CONTINUE |
| * |
| END IF |
| * |
| ELSE IF( ENDD-START.GT.SELECT ) THEN |
| * |
| * Partition D( START:ENDD ) and stack parts, largest one first |
| * |
| * Choose partition entry as median of 3 |
| * |
| D1 = D( START ) |
| D2 = D( ENDD ) |
| I = ( START+ENDD ) / 2 |
| D3 = D( I ) |
| IF( D1.LT.D2 ) THEN |
| IF( D3.LT.D1 ) THEN |
| DMNMX = D1 |
| ELSE IF( D3.LT.D2 ) THEN |
| DMNMX = D3 |
| ELSE |
| DMNMX = D2 |
| END IF |
| ELSE |
| IF( D3.LT.D2 ) THEN |
| DMNMX = D2 |
| ELSE IF( D3.LT.D1 ) THEN |
| DMNMX = D3 |
| ELSE |
| DMNMX = D1 |
| END IF |
| END IF |
| * |
| IF( DIR.EQ.0 ) THEN |
| * |
| * Sort into decreasing order |
| * |
| I = START - 1 |
| J = ENDD + 1 |
| 60 CONTINUE |
| 70 CONTINUE |
| J = J - 1 |
| IF( D( J ).LT.DMNMX ) |
| $ GO TO 70 |
| 80 CONTINUE |
| I = I + 1 |
| IF( D( I ).GT.DMNMX ) |
| $ GO TO 80 |
| IF( I.LT.J ) THEN |
| TMP = D( I ) |
| D( I ) = D( J ) |
| D( J ) = TMP |
| GO TO 60 |
| END IF |
| IF( J-START.GT.ENDD-J-1 ) THEN |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = START |
| STACK( 2, STKPNT ) = J |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = J + 1 |
| STACK( 2, STKPNT ) = ENDD |
| ELSE |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = J + 1 |
| STACK( 2, STKPNT ) = ENDD |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = START |
| STACK( 2, STKPNT ) = J |
| END IF |
| ELSE |
| * |
| * Sort into increasing order |
| * |
| I = START - 1 |
| J = ENDD + 1 |
| 90 CONTINUE |
| 100 CONTINUE |
| J = J - 1 |
| IF( D( J ).GT.DMNMX ) |
| $ GO TO 100 |
| 110 CONTINUE |
| I = I + 1 |
| IF( D( I ).LT.DMNMX ) |
| $ GO TO 110 |
| IF( I.LT.J ) THEN |
| TMP = D( I ) |
| D( I ) = D( J ) |
| D( J ) = TMP |
| GO TO 90 |
| END IF |
| IF( J-START.GT.ENDD-J-1 ) THEN |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = START |
| STACK( 2, STKPNT ) = J |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = J + 1 |
| STACK( 2, STKPNT ) = ENDD |
| ELSE |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = J + 1 |
| STACK( 2, STKPNT ) = ENDD |
| STKPNT = STKPNT + 1 |
| STACK( 1, STKPNT ) = START |
| STACK( 2, STKPNT ) = J |
| END IF |
| END IF |
| END IF |
| IF( STKPNT.GT.0 ) |
| $ GO TO 10 |
| RETURN |
| * |
| * End of DLASRT |
| * |
| END |