+++ /dev/null
-*> \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
OSDN Git Service
