diff options
Diffstat (limited to 'TESTING/LIN/dtsqr01.f')
| -rw-r--r-- | TESTING/LIN/dtsqr01.f | 72 |
1 files changed, 36 insertions, 36 deletions
diff --git a/TESTING/LIN/dtsqr01.f b/TESTING/LIN/dtsqr01.f index 29d4b63e..a9ac1635 100644 --- a/TESTING/LIN/dtsqr01.f +++ b/TESTING/LIN/dtsqr01.f @@ -2,19 +2,19 @@ * * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * SUBROUTINE DTSQR01(TSSW, M,N, MB, NB, RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, MB * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -65,17 +65,17 @@ *> RESULT(2) = | I - Q^H Q | or | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -99,9 +99,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays DOUBLE PRECISION, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -123,24 +123,24 @@ EXTERNAL DLAMCH, DLANGE, DLANSY, LSAME, ILAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. Scalars in Common .. CHARACTER*32 srnamt * .. * .. Common blocks .. - COMMON / srnamc / srnamt + COMMON / srnamc / srnamt * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / + DATA ISEED / 1988, 1989, 1990, 1991 / * * TEST TALL SKINNY OR SHORT WIDE * TS = LSAME(TSSW, 'TS') -* +* * TEST MATRICES WITH HALF OF MATRIX BEING ZEROS * TESTZEROS = .FALSE. -* +* EPS = DLAMCH( 'Epsilon' ) K = MIN(M,N) L = MAX(M,N,1) @@ -149,14 +149,14 @@ IF((K.GE.MNB).OR.(MNB.GE.L))THEN LT=MAX(1,L)*MNB+5 ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 + LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 END IF * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ WORK(LWORK), T(LT), C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -184,7 +184,7 @@ * CALL DLASET( 'Full', M, M, ZERO, ONE, Q, M ) srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL DGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -221,7 +221,7 @@ * Apply Q to C as Q*C * srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -241,7 +241,7 @@ * Apply Q to C as QT*C * srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -252,7 +252,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -265,8 +265,8 @@ * Apply Q to D as D*Q * srnamt = 'DGEMQR' - CALL DGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL DGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| * @@ -284,8 +284,8 @@ * * Apply Q to D as D*QT * - CALL DGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL DGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| * @@ -308,7 +308,7 @@ * CALL DLASET( 'Full', N, N, ZERO, ONE, Q, N ) srnamt = 'DGEMLQ' - CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -344,7 +344,7 @@ * * Apply Q to C as Q*C * - CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -363,7 +363,7 @@ * * Apply Q to D as QT*D * - CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -374,7 +374,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,N)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -386,8 +386,8 @@ * * Apply Q to C as C*Q * - CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -405,8 +405,8 @@ * * Apply Q to D as D*QT * - CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| * @@ -425,4 +425,4 @@ DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) * RETURN - END
\ No newline at end of file + END |