diff options
| author | julie <julielangou@users.noreply.github.com> | 2012-07-27 06:42:44 +0000 |
|---|---|---|
| committer | julie <julielangou@users.noreply.github.com> | 2012-07-27 06:42:44 +0000 |
| commit | 199c646448f65fb375a8aaf7383c705dab58f550 (patch) | |
| tree | 5681fbfbb7d700a8a1da347fa25f90a2967c14a2 /TESTING/EIG/cckcsd.f | |
| parent | 2a180a73cd84e5bfdd306d649e1713e144a6f132 (diff) | |
| download | lapack-199c646448f65fb375a8aaf7383c705dab58f550.tar.gz lapack-199c646448f65fb375a8aaf7383c705dab58f550.tar.bz2 lapack-199c646448f65fb375a8aaf7383c705dab58f550.zip | |
Commit Brian Sutton new CS Decomposition routines.
All the routines from the SRC folder have been updated to integrate the current Doxygen layout.
Everything seems to be fine, all tests passed without problem.
Diffstat (limited to 'TESTING/EIG/cckcsd.f')
| -rw-r--r-- | TESTING/EIG/cckcsd.f | 28 |
1 files changed, 20 insertions, 8 deletions
diff --git a/TESTING/EIG/cckcsd.f b/TESTING/EIG/cckcsd.f index c6cb13b0..a4146c74 100644 --- a/TESTING/EIG/cckcsd.f +++ b/TESTING/EIG/cckcsd.f @@ -205,13 +205,16 @@ * * .. Parameters .. INTEGER NTESTS - PARAMETER ( NTESTS = 9 ) + PARAMETER ( NTESTS = 15 ) INTEGER NTYPES - PARAMETER ( NTYPES = 3 ) - REAL GAPDIGIT, ORTH, PIOVER2, TEN + PARAMETER ( NTYPES = 4 ) + REAL GAPDIGIT, ORTH, PIOVER2, REALONE, REALZERO, TEN PARAMETER ( GAPDIGIT = 10.0E0, ORTH = 1.0E-4, $ PIOVER2 = 1.57079632679489662E0, - $ TEN = 10.0D0 ) + $ REALONE = 1.0E0, REALZERO = 0.0E0, + $ TEN = 10.0E0 ) + COMPLEX ONE, ZERO + PARAMETER ( ONE = (1.0E0,0.0E0), ZERO = (0.0E0,0.0E0) ) * .. * .. Local Scalars .. LOGICAL FIRSTT @@ -231,8 +234,8 @@ INTRINSIC ABS, MIN * .. * .. External Functions .. - REAL SLARND - EXTERNAL SLARND + REAL SLARAN, SLARND + EXTERNAL SLARAN, SLARND * .. * .. Executable Statements .. * @@ -286,7 +289,7 @@ $ ORTH*SLARND(2,ISEED) END DO END DO - ELSE + ELSE IF( IMAT.EQ.3 ) THEN R = MIN( P, M-P, Q, M-Q ) DO I = 1, R+1 THETA(I) = TEN**(-SLARND(1,ISEED)*GAPDIGIT) @@ -298,9 +301,18 @@ THETA(I) = PIOVER2 * THETA(I) / THETA(R+1) END DO CALL CLACSG( M, P, Q, THETA, ISEED, X, LDX, WORK ) + ELSE + CALL CLASET( 'F', M, M, ZERO, ONE, X, LDX ) + DO I = 1, M + J = INT( SLARAN( ISEED ) * M ) + 1 + IF( J .NE. I ) THEN + CALL CSROT( M, X(1+(I-1)*LDX), 1, X(1+(J-1)*LDX), + $ 1, REALZERO, REALONE ) + END IF + END DO END IF * - NT = 9 + NT = 15 * CALL CCSDTS( M, P, Q, X, XF, LDX, U1, LDU1, U2, LDU2, V1T, $ LDV1T, V2T, LDV2T, THETA, IWORK, WORK, LWORK, |