X-Git-Url: http://git.osdn.net/view?p=bytom%2Fvapor.git;a=blobdiff_plain;f=vendor%2Fgonum.org%2Fv1%2Fgonum%2Flapack%2Finternal%2Ftestdata%2Fdlasqtest%2Fdlasrt.f;fp=vendor%2Fgonum.org%2Fv1%2Fgonum%2Flapack%2Finternal%2Ftestdata%2Fdlasqtest%2Fdlasrt.f;h=0000000000000000000000000000000000000000;hp=f5d0e6cd1a8ceb180ec14fbf9293ab55ac4b6f94;hb=d09b7a78d44dc259725902b8141cdba0d716b121;hpb=ee01d543fdfe1fd0a4d548965c66f7923ea7b062 diff --git a/vendor/gonum.org/v1/gonum/lapack/internal/testdata/dlasqtest/dlasrt.f b/vendor/gonum.org/v1/gonum/lapack/internal/testdata/dlasqtest/dlasrt.f deleted file mode 100644 index f5d0e6cd..00000000 --- a/vendor/gonum.org/v1/gonum/lapack/internal/testdata/dlasqtest/dlasrt.f +++ /dev/null @@ -1,303 +0,0 @@ -*> \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 -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \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