diff options
author | Julie <julie@cs.utk.edu> | 2016-11-11 00:08:21 -0600 |
---|---|---|
committer | Julie <julie@cs.utk.edu> | 2016-11-11 00:08:21 -0600 |
commit | 4da53d9e73211a35a57bfd42cc827caf45188450 (patch) | |
tree | 2f54cef6934a1b68a32ebf16c31ed7269fb374e3 /TESTING/LIN | |
parent | 5bb749aeff27bb0c8742ecc0aff4cae43c53298e (diff) | |
parent | f9c3afd2ecda142d2e54a1fad7b7b6c157626166 (diff) | |
download | lapack-4da53d9e73211a35a57bfd42cc827caf45188450.tar.gz lapack-4da53d9e73211a35a57bfd42cc827caf45188450.tar.bz2 lapack-4da53d9e73211a35a57bfd42cc827caf45188450.zip |
Merging changes
cosmetic changes
Diffstat (limited to 'TESTING/LIN')
56 files changed, 787 insertions, 787 deletions
diff --git a/TESTING/LIN/aladhd.f b/TESTING/LIN/aladhd.f index 3a53e0bd..a45a56f3 100644 --- a/TESTING/LIN/aladhd.f +++ b/TESTING/LIN/aladhd.f @@ -279,7 +279,7 @@ * ELSE IF( LSAMEN( 2, P2, 'HA' ) ) THEN * -* HA: Hermitian +* HA: Hermitian * Aasen algorithm WRITE( IOUNIT, FMT = 9971 )PATH, 'Hermitian' * @@ -294,9 +294,9 @@ WRITE( IOUNIT, FMT = 9978 )5 WRITE( IOUNIT, FMT = 9976 )6 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) - - - ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. + + + ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. $ LSAMEN( 2, P2, 'HP' ) ) THEN * * HE: Hermitian indefinite full diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f index 65d3eadd..c5dd3330 100644 --- a/TESTING/LIN/cchkaa.f +++ b/TESTING/LIN/cchkaa.f @@ -987,7 +987,7 @@ * QX: QRT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL CCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -998,7 +998,7 @@ * TQ: LQT routines for general matrices * IF( TSTCHK ) THEN - CALL CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -1009,7 +1009,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -1020,7 +1020,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/cchklqt.f b/TESTING/LIN/cchklqt.f index d6c4f7e1..04f3cbfc 100644 --- a/TESTING/LIN/cchklqt.f +++ b/TESTING/LIN/cchklqt.f @@ -2,15 +2,15 @@ * * =========== 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 CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test CGELQT and CUNMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL CLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/cchklqtp.f b/TESTING/LIN/cchklqtp.f index 5e573e4c..46aa97b1 100644 --- a/TESTING/LIN/cchklqtp.f +++ b/TESTING/LIN/cchklqtp.f @@ -2,13 +2,13 @@ * * =========== 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 CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL CLQT05( M, N, L, NB, RESULT ) * @@ -212,4 +212,4 @@ * * End of CCHKLQTP * - END
\ No newline at end of file + END diff --git a/TESTING/LIN/cchktsqr.f b/TESTING/LIN/cchktsqr.f index 8c55f399..9a761348 100644 --- a/TESTING/LIN/cchktsqr.f +++ b/TESTING/LIN/cchktsqr.f @@ -2,15 +2,15 @@ * * =========== 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 CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ REAL RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, CERRTSQR, $ CTSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL CTSQR01( 'TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -196,9 +196,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL CTSQR01( 'SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * diff --git a/TESTING/LIN/cdrvhe_aa.f b/TESTING/LIN/cdrvhe_aa.f index 511761f0..38ebca59 100644 --- a/TESTING/LIN/cdrvhe_aa.f +++ b/TESTING/LIN/cdrvhe_aa.f @@ -465,10 +465,10 @@ c END IF END IF * * Check error code from CHESV_AA . -* +* IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'CHESV_AA', INFO, K, - $ UPLO, N, N, -1, -1, NRHS, + CALL ALAERH( PATH, 'CHESV_AA', INFO, K, + $ UPLO, N, N, -1, -1, NRHS, $ IMAT, NFAIL, NERRS, NOUT ) GO TO 120 ELSE IF( INFO.NE.0 ) THEN @@ -479,7 +479,7 @@ c END IF * residual. * CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/cdrvls.f b/TESTING/LIN/cdrvls.f index af55dbaa..de9890f4 100644 --- a/TESTING/LIN/cdrvls.f +++ b/TESTING/LIN/cdrvls.f @@ -262,8 +262,8 @@ * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASVM, CERRLS, CGELS, CGELSD, - $ CGELSS, CGELSY, CGEMM, CGETSLS, CLACPY, - $ CLARNV, CQRT13, CQRT15, CQRT16, CSSCAL, + $ CGELSS, CGELSY, CGEMM, CGETSLS, CLACPY, + $ CLARNV, CQRT13, CQRT15, CQRT16, CSSCAL, $ SAXPY, XLAENV * .. * .. Intrinsic Functions .. @@ -490,7 +490,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'DGETSLS ' - CALL CGETSLS( TRANS, M, N, NRHS, A, + CALL CGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'CGETSLS ', INFO, 0, @@ -773,8 +773,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/cerrlqt.f b/TESTING/LIN/cerrlqt.f index 008cb0a9..8308d109 100644 --- a/TESTING/LIN/cerrlqt.f +++ b/TESTING/LIN/cerrlqt.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 CERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, CGELQT3, CGELQT, - $ CGEMLQT + $ CGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/cerrlqtp.f b/TESTING/LIN/cerrlqtp.f index 45797ddb..04dffb84 100644 --- a/TESTING/LIN/cerrlqtp.f +++ b/TESTING/LIN/cerrlqtp.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 CERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, CTPLQT2, CTPLQT, - $ CTPMLQT + $ CTPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'CTPMLQT' INFOT = 1 - CALL CTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL CTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL CTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL CTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL CTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL CTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL CTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/cerrtsqr.f b/TESTING/LIN/cerrtsqr.f index 3ca8b379..b8b42dcc 100644 --- a/TESTING/LIN/cerrtsqr.f +++ b/TESTING/LIN/cerrtsqr.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 CERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Zenver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Zenver +*> \author NAG Ltd. * *> \date November 2011 * diff --git a/TESTING/LIN/chet01_aa.f b/TESTING/LIN/chet01_aa.f index 1fa87527..8f797f11 100644 --- a/TESTING/LIN/chet01_aa.f +++ b/TESTING/LIN/chet01_aa.f @@ -8,7 +8,7 @@ * Definition: * =========== * -* SUBROUTINE CHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, +* SUBROUTINE CHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, * C, LDC, RWORK, RESID ) * * .. Scalar Arguments .. @@ -145,7 +145,7 @@ * * .. Parameters .. COMPLEX CZERO, CONE - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), + PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), $ CONE = ( 1.0E+0, 0.0E+0 ) ) REAL ZERO, ONE PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) diff --git a/TESTING/LIN/clqt04.f b/TESTING/LIN/clqt04.f index cdab2dfd..f1b722b0 100644 --- a/TESTING/LIN/clqt04.f +++ b/TESTING/LIN/clqt04.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 CLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | 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 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -112,11 +112,11 @@ EXTERNAL SLAMCH, CLANGE, CLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = SLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -124,8 +124,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -143,7 +143,7 @@ * Generate the n-by-n matrix Q * CALL CLASET( 'Full', N, N, CZERO, ONE, Q, N ) - CALL CGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL CGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy L @@ -179,7 +179,7 @@ * * Apply Q to C as Q*C * - CALL CGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL CGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -198,7 +198,7 @@ * * Apply Q to D as QT*D * - CALL CGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, + CALL CGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -209,7 +209,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -221,8 +221,8 @@ * * Apply Q to C as C*Q * - CALL CGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL CGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -240,8 +240,8 @@ * * Apply Q to D as D*QT * - CALL CGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL CGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/clqt05.f b/TESTING/LIN/clqt05.f index 22ffcc05..3eed9f3a 100644 --- a/TESTING/LIN/clqt05.f +++ b/TESTING/LIN/clqt05.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 CLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -61,17 +61,17 @@ *> RESULT(2) = | I - Q^H Q | *> 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 * @@ -92,11 +92,11 @@ REAL RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -119,7 +119,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = SLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -133,7 +133,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -151,7 +151,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL CLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL CLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -204,7 +204,7 @@ CALL CLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL CTPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -226,18 +226,18 @@ * Apply Q to C as QT*C * CALL CTPMLQT( 'L','C',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL CGEMM('C','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = CLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -269,8 +269,8 @@ * Apply Q to D as D*QT * CALL CTPMLQT('R','C',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -286,4 +286,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END
\ No newline at end of file + END diff --git a/TESTING/LIN/ctsqr01.f b/TESTING/LIN/ctsqr01.f index a94f89f2..a437386b 100644 --- a/TESTING/LIN/ctsqr01.f +++ b/TESTING/LIN/ctsqr01.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 CTSQR01(TSSW, M,N, MB, NB, RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, MB * .. Return values .. * REAL 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 * @@ -97,9 +97,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -122,24 +122,24 @@ EXTERNAL SLAMCH, CLANGE, CLANSY, 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') -* + TS = LSAME(TSSW, 'TS') +* * TEST MATRICES WITH HALF OF MATRIX BEING ZEROS * TESTZEROS = .FALSE. -* +* EPS = SLAMCH( 'Epsilon' ) K = MIN(M,N) L = MAX(M,N,1) @@ -148,14 +148,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 @@ -183,7 +183,7 @@ * CALL CLASET( 'Full', M, M, CZERO, ONE, Q, M ) srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL CGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -220,7 +220,7 @@ * Apply Q to C as Q*C * srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -240,7 +240,7 @@ * Apply Q to C as QT*C * srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -251,7 +251,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 * @@ -264,8 +264,8 @@ * Apply Q to D as D*Q * srnamt = 'CGEMQR' - CALL CGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL CGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| * @@ -283,8 +283,8 @@ * * Apply Q to D as D*QT * - CALL CGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL CGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| * @@ -307,7 +307,7 @@ * CALL CLASET( 'Full', N, N, CZERO, ONE, Q, N ) srnamt = 'CGEMLQ' - CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -343,7 +343,7 @@ * * Apply Q to C as Q*C * - CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -362,7 +362,7 @@ * * Apply Q to D as QT*D * - CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -373,7 +373,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 * @@ -385,8 +385,8 @@ * * Apply Q to C as C*Q * - CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -404,8 +404,8 @@ * * Apply Q to D as D*QT * - CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| * @@ -424,4 +424,4 @@ DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) * RETURN - END
\ No newline at end of file + END diff --git a/TESTING/LIN/dchkaa.f b/TESTING/LIN/dchkaa.f index f0442845..85d2b2a4 100644 --- a/TESTING/LIN/dchkaa.f +++ b/TESTING/LIN/dchkaa.f @@ -676,9 +676,9 @@ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) * IF( TSTCHK ) THEN - CALL DCHKSY_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, + CALL DCHKSY_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, $ NSVAL, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), + $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) ELSE @@ -910,7 +910,7 @@ * QX: QRT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -921,7 +921,7 @@ * TQ: LQT routines for general matrices * IF( TSTCHK ) THEN - CALL DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -932,7 +932,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -943,7 +943,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/dchklqt.f b/TESTING/LIN/dchklqt.f index 1726090e..9a9ba65a 100644 --- a/TESTING/LIN/dchklqt.f +++ b/TESTING/LIN/dchklqt.f @@ -2,15 +2,15 @@ * * =========== 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 DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test DGELQT and DGEMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL DLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/dchklqtp.f b/TESTING/LIN/dchklqtp.f index 1cc82ec5..d4b486ca 100644 --- a/TESTING/LIN/dchklqtp.f +++ b/TESTING/LIN/dchklqtp.f @@ -2,13 +2,13 @@ * * =========== 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 DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL DLQT05( M, N, L, NB, RESULT ) * diff --git a/TESTING/LIN/dchksy_aa.f b/TESTING/LIN/dchksy_aa.f index f9c51f50..5bfe71c6 100644 --- a/TESTING/LIN/dchksy_aa.f +++ b/TESTING/LIN/dchksy_aa.f @@ -430,7 +430,7 @@ * SRNAMT = 'DSYTRF_AA' LWORK = N*NB + N - CALL DSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, + CALL DSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, $ LWORK, INFO ) * * Adjust the expected value of INFO to account for @@ -456,8 +456,8 @@ * Check error code from DSYTRF and handle error. * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'DSYTRF_AA', INFO, K, UPLO, - $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, + CALL ALAERH( PATH, 'DSYTRF_AA', INFO, K, UPLO, + $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, $ NOUT ) END IF * @@ -517,7 +517,7 @@ * SRNAMT = 'DSYTRS_AA' LWORK = 3*N-2 - CALL DSYTRS_AA( UPLO, N, NRHS, AFAC, LDA, + CALL DSYTRS_AA( UPLO, N, NRHS, AFAC, LDA, $ IWORK, X, LDA, WORK, LWORK, $ INFO ) * diff --git a/TESTING/LIN/dchktsqr.f b/TESTING/LIN/dchktsqr.f index 0c3de46e..0e2d0ef2 100644 --- a/TESTING/LIN/dchktsqr.f +++ b/TESTING/LIN/dchktsqr.f @@ -2,15 +2,15 @@ * * =========== 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 DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ DOUBLE PRECISION RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, $ DTSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL DTSQR01( 'TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -196,9 +196,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL DTSQR01( 'SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -254,4 +254,4 @@ * * End of DCHKQRT * - END
\ No newline at end of file + END diff --git a/TESTING/LIN/ddrvls.f b/TESTING/LIN/ddrvls.f index 2a194551..d11f910e 100644 --- a/TESTING/LIN/ddrvls.f +++ b/TESTING/LIN/ddrvls.f @@ -234,9 +234,9 @@ * .. Local Scalars .. CHARACTER TRANS CHARACTER*3 PATH - INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, + INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, + $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, + $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, $ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS DOUBLE PRECISION EPS, NORMA, NORMB, RCOND * .. @@ -324,7 +324,7 @@ LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2,LWTS) - $ + $ * DO 120 IRANK = 1, 2 DO 110 ISCALE = 1, 3 @@ -484,7 +484,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'DGETSLS ' - CALL DGETSLS( TRANS, M, N, NRHS, A, + CALL DGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'DGETSLS ', INFO, 0, @@ -765,8 +765,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/ddrvsy_aa.f b/TESTING/LIN/ddrvsy_aa.f index 03aab49e..be5d6eb3 100644 --- a/TESTING/LIN/ddrvsy_aa.f +++ b/TESTING/LIN/ddrvsy_aa.f @@ -467,7 +467,7 @@ c END IF * residual. * CALL DSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/derrlqt.f b/TESTING/LIN/derrlqt.f index 5a768f01..926f4197 100644 --- a/TESTING/LIN/derrlqt.f +++ b/TESTING/LIN/derrlqt.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 DERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, DGELQT3, DGELQT, - $ DGEMLQT + $ DGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/derrlqtp.f b/TESTING/LIN/derrlqtp.f index ae118af9..b642c349 100644 --- a/TESTING/LIN/derrlqtp.f +++ b/TESTING/LIN/derrlqtp.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 DERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, DTPLQT2, DTPLQT, - $ DTPMLQT + $ DTPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'DTPMLQT' INFOT = 1 - CALL DTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL DTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL DTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL DTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL DTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL DTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL DTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL DTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/derrtsqr.f b/TESTING/LIN/derrtsqr.f index aa9f3674..4a5ad5e6 100644 --- a/TESTING/LIN/derrtsqr.f +++ b/TESTING/LIN/derrtsqr.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 DERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * diff --git a/TESTING/LIN/dlqt04.f b/TESTING/LIN/dlqt04.f index 216ef3ea..9e6e11cf 100644 --- a/TESTING/LIN/dlqt04.f +++ b/TESTING/LIN/dlqt04.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 DLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | 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 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays DOUBLE PRECISION, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -109,11 +109,11 @@ EXTERNAL DLAMCH, DLANGE, DLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = DLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -121,8 +121,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -140,7 +140,7 @@ * Generate the n-by-n matrix Q * CALL DLASET( 'Full', N, N, ZERO, ONE, Q, N ) - CALL DGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL DGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy R @@ -176,7 +176,7 @@ * * Apply Q to C as Q*C * - CALL DGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL DGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -195,7 +195,7 @@ * * Apply Q to D as QT*D * - CALL DGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, + CALL DGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -206,7 +206,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -218,8 +218,8 @@ * * Apply Q to C as C*Q * - CALL DGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL DGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -237,8 +237,8 @@ * * Apply Q to D as D*QT * - CALL DGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL DGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/dlqt05.f b/TESTING/LIN/dlqt05.f index b357dcb5..88681eba 100644 --- a/TESTING/LIN/dlqt05.f +++ b/TESTING/LIN/dlqt05.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 DLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -61,17 +61,17 @@ *> RESULT(2) = | I - Q^H Q | *> 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 * @@ -92,11 +92,11 @@ DOUBLE PRECISION RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays DOUBLE PRECISION, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -117,7 +117,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = DLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -131,7 +131,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -149,7 +149,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL DLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL DLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -201,7 +201,7 @@ CALL DLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL DTPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -223,18 +223,18 @@ * Apply Q to C as QT*C * CALL DTPMLQT( 'L','T',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL DGEMM('T','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = DLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -266,8 +266,8 @@ * Apply Q to D as D*QT * CALL DTPMLQT('R','T',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -283,4 +283,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END
\ No newline at end of file + END diff --git a/TESTING/LIN/dtplqt.f b/TESTING/LIN/dtplqt.f index 27965442..a233eb18 100644 --- a/TESTING/LIN/dtplqt.f +++ b/TESTING/LIN/dtplqt.f @@ -2,41 +2,41 @@ * * =========== 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/ * *> \htmlonly -*> Download DTPQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> +*> Download DTPQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, * INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L, MB * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> DTPLQT computes a blocked LQ factorization of a real -*> "triangular-pentagonal" matrix C, which is composed of a -*> triangular block A and pentagonal block B, using the compact +*> DTPLQT computes a blocked LQ factorization of a real +*> "triangular-pentagonal" matrix C, which is composed of a +*> triangular block A and pentagonal block B, using the compact *> WY representation for Q. *> \endverbatim * @@ -47,7 +47,7 @@ *> \verbatim *> M is INTEGER *> The number of rows of the matrix B, and the order of the -*> triangular matrix A. +*> triangular matrix A. *> M >= 0. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[in,out] B *> \verbatim *> B is DOUBLE PRECISION array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -105,7 +105,7 @@ *> The lower triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See Further Details. *> \endverbatim -*> +*> *> \param[in] LDT *> \verbatim *> LDT is INTEGER @@ -127,10 +127,10 @@ * 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 November 2013 * @@ -141,45 +141,45 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ] [ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L *> upper trapezoidal matrix B2: -*> [ B ] = [ B1 ] [ B2 ] +*> [ B ] = [ B1 ] [ B2 ] *> [ B1 ] <- M-by-(N-L) rectangular *> [ B2 ] <- M-by-L upper trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C -*> [ C ] = [ A ] [ B ] +*> [ C ] = [ A ] [ B ] *> [ A ] <- lower triangular N-by-N *> [ B ] <- M-by-N pentagonal *> *> so that W can be represented as -*> [ W ] = [ I ] [ V ] +*> [ W ] = [ I ] [ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, -*> [ V ] = [ V1 ] [ V2 ] +*> we call V above. Note that V has the same form as B; that is, +*> [ V ] = [ V1 ] [ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> *> The number of blocks is B = ceiling(M/MB), where each -*> block is of order MB except for the last block, which is of order +*> block is of order MB except for the last block, which is of order *> IB = M - (M-1)*MB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB *> for the last block) T's are stored in the MB-by-N matrix T as *> *> T = [T1 T2 ... TB]. @@ -240,7 +240,7 @@ IF( M.EQ.0 .OR. N.EQ.0 ) RETURN * DO I = 1, M, MB -* +* * Compute the QR factorization of the current block * IB = MIN( M-I+1, MB ) @@ -251,20 +251,20 @@ LB = NB-N+L-I+1 END IF * - CALL DTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, + CALL DTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, $ T(1, I ), LDT, IINFO ) * * Update by applying H**T to B(I+IB:M,:) from the right * IF( I+IB.LE.M ) THEN CALL DTPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB, - $ B( I, 1 ), LDB, T( 1, I ), LDT, - $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, + $ B( I, 1 ), LDB, T( 1, I ), LDT, + $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, $ WORK, M-I-IB+1) END IF END DO RETURN -* +* * End of DTPLQT * END 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 diff --git a/TESTING/LIN/schkaa.f b/TESTING/LIN/schkaa.f index fef5de04..0d53dedc 100644 --- a/TESTING/LIN/schkaa.f +++ b/TESTING/LIN/schkaa.f @@ -906,7 +906,7 @@ * QX: QRT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL SCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -917,7 +917,7 @@ * TQ: LQT routines for general matrices * IF( TSTCHK ) THEN - CALL SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -928,7 +928,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -939,7 +939,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/schklqt.f b/TESTING/LIN/schklqt.f index fd449b1a..5e96546d 100644 --- a/TESTING/LIN/schklqt.f +++ b/TESTING/LIN/schklqt.f @@ -2,15 +2,15 @@ * * =========== 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 SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test DGELQT and DGEMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL SLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/schklqtp.f b/TESTING/LIN/schklqtp.f index d85ef8d1..be6b84ba 100644 --- a/TESTING/LIN/schklqtp.f +++ b/TESTING/LIN/schklqtp.f @@ -2,13 +2,13 @@ * * =========== 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 SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL SLQT05( M, N, L, NB, RESULT ) * diff --git a/TESTING/LIN/schksy_aa.f b/TESTING/LIN/schksy_aa.f index b1eca4ce..75a9ebaa 100644 --- a/TESTING/LIN/schksy_aa.f +++ b/TESTING/LIN/schksy_aa.f @@ -431,7 +431,7 @@ * SRNAMT = 'SSYTRF_AA' LWORK = N*NB + N - CALL SSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, + CALL SSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, $ LWORK, INFO ) * * Adjust the expected value of INFO to account for @@ -457,8 +457,8 @@ * Check error code from SSYTRF and handle error. * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'SSYTRF_AA', INFO, K, UPLO, - $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, + CALL ALAERH( PATH, 'SSYTRF_AA', INFO, K, UPLO, + $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, $ NOUT ) END IF * @@ -518,7 +518,7 @@ * SRNAMT = 'SSYTRS_AA' LWORK = 3*N-2 - CALL SSYTRS_AA( UPLO, N, NRHS, AFAC, LDA, + CALL SSYTRS_AA( UPLO, N, NRHS, AFAC, LDA, $ IWORK, X, LDA, WORK, LWORK, $ INFO ) * @@ -526,7 +526,7 @@ * IF( INFO.NE.0 ) THEN CALL ALAERH( PATH, 'SSYTRS_AA', INFO, 0, - $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ UPLO, N, N, -1, -1, NRHS, IMAT, $ NFAIL, NERRS, NOUT ) END IF * diff --git a/TESTING/LIN/schktsqr.f b/TESTING/LIN/schktsqr.f index a4303143..3bb238ff 100644 --- a/TESTING/LIN/schktsqr.f +++ b/TESTING/LIN/schktsqr.f @@ -2,15 +2,15 @@ * * =========== 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 SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ REAL RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, SERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, SERRTSQR, $ STSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test SGEQR and SGEMQR -* +* CALL STSQR01('TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -197,7 +197,7 @@ END DO NRUN = NRUN + NTESTS END DO - END DO + END DO END IF END DO END DO @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test SGEQR and SGEMQR -* +* CALL STSQR01('SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * diff --git a/TESTING/LIN/sdrvls.f b/TESTING/LIN/sdrvls.f index 372ec9fc..03598937 100644 --- a/TESTING/LIN/sdrvls.f +++ b/TESTING/LIN/sdrvls.f @@ -234,9 +234,9 @@ * .. Local Scalars .. CHARACTER TRANS CHARACTER*3 PATH - INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, + INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, + $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, + $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, $ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS REAL EPS, NORMA, NORMB, RCOND * .. @@ -324,7 +324,7 @@ LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2,LWTS) - $ + $ * DO 120 IRANK = 1, 2 DO 110 ISCALE = 1, 3 @@ -446,7 +446,7 @@ CALL XLAENV( 1, MB ) DO 62 IMB = 1, NNB NB = NBVAL( IMB ) - CALL XLAENV( 2, NB ) + CALL XLAENV( 2, NB ) * DO 60 ITRAN = 1, 2 IF( ITRAN.EQ.1 ) THEN @@ -484,7 +484,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'SGETSLS ' - CALL SGETSLS( TRANS, M, N, NRHS, A, + CALL SGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'SGETSLS ', INFO, 0, @@ -765,8 +765,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/sdrvsy_aa.f b/TESTING/LIN/sdrvsy_aa.f index 001c67c1..3fef3c70 100644 --- a/TESTING/LIN/sdrvsy_aa.f +++ b/TESTING/LIN/sdrvsy_aa.f @@ -455,8 +455,8 @@ c END IF * Check error code from SSYSV_AA . * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'SSYSV_AA ', INFO, K, - $ UPLO, N, N, -1, -1, NRHS, + CALL ALAERH( PATH, 'SSYSV_AA ', INFO, K, + $ UPLO, N, N, -1, -1, NRHS, $ IMAT, NFAIL, NERRS, NOUT ) GO TO 120 ELSE IF( INFO.NE.0 ) THEN @@ -467,7 +467,7 @@ c END IF * residual. * CALL SSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/serrlqt.f b/TESTING/LIN/serrlqt.f index 2c2c575b..d73f990d 100644 --- a/TESTING/LIN/serrlqt.f +++ b/TESTING/LIN/serrlqt.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 SERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, SGELQT3, SGELQT, - $ SGEMLQT + $ SGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/serrlqtp.f b/TESTING/LIN/serrlqtp.f index 319ee91c..782de113 100644 --- a/TESTING/LIN/serrlqtp.f +++ b/TESTING/LIN/serrlqtp.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 SERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, STPLQT2, STPLQT, - $ STPMLQT + $ STPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'STPMLQT' INFOT = 1 - CALL STPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL STPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL STPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL STPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL STPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL STPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL STPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL STPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL STPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL STPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/serrtsqr.f b/TESTING/LIN/serrtsqr.f index 0ba37978..eddadbee 100644 --- a/TESTING/LIN/serrtsqr.f +++ b/TESTING/LIN/serrtsqr.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 SERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * diff --git a/TESTING/LIN/slqt04.f b/TESTING/LIN/slqt04.f index debae5ca..2f4637b9 100644 --- a/TESTING/LIN/slqt04.f +++ b/TESTING/LIN/slqt04.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 SLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB, LDT * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | 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 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays REAL, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -109,11 +109,11 @@ EXTERNAL SLAMCH, SLANGE, SLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = SLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -121,8 +121,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -140,7 +140,7 @@ * Generate the n-by-n matrix Q * CALL SLASET( 'Full', N, N, ZERO, ONE, Q, N ) - CALL SGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL SGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy R @@ -176,7 +176,7 @@ * * Apply Q to C as Q*C * - CALL SGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL SGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -195,7 +195,7 @@ * * Apply Q to D as QT*D * - CALL SGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, + CALL SGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -206,7 +206,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -218,8 +218,8 @@ * * Apply Q to C as C*Q * - CALL SGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL SGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -237,8 +237,8 @@ * * Apply Q to D as D*QT * - CALL SGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL SGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/slqt05.f b/TESTING/LIN/slqt05.f index 5ad3a4b2..7ce36c75 100644 --- a/TESTING/LIN/slqt05.f +++ b/TESTING/LIN/slqt05.f @@ -2,12 +2,12 @@ * =========== * * SUBROUTINE SLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -38,7 +38,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -54,17 +54,17 @@ *> RESULT(2) = | I - Q^H Q | *> 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 * @@ -85,11 +85,11 @@ REAL RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays REAL, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -110,7 +110,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = SLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -124,7 +124,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -142,7 +142,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL SLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL SLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -194,7 +194,7 @@ CALL SLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL STPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -216,18 +216,18 @@ * Apply Q to C as QT*C * CALL STPMLQT( 'L','T',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL SGEMM('T','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = SLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -259,8 +259,8 @@ * Apply Q to D as D*QT * CALL STPMLQT('R','T',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -276,4 +276,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END
\ No newline at end of file + END diff --git a/TESTING/LIN/stplqt.f b/TESTING/LIN/stplqt.f index adbbfe8b..4e03ae65 100644 --- a/TESTING/LIN/stplqt.f +++ b/TESTING/LIN/stplqt.f @@ -3,23 +3,23 @@ * * SUBROUTINE STPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, * INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L, MB * .. * .. Array Arguments .. * REAL A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> STPLQT computes a blocked LQ factorization of a real -*> "triangular-pentagonal" matrix C, which is composed of a -*> triangular block A and pentagonal block B, using the compact +*> STPLQT computes a blocked LQ factorization of a real +*> "triangular-pentagonal" matrix C, which is composed of a +*> triangular block A and pentagonal block B, using the compact *> WY representation for Q. *> \endverbatim * @@ -30,7 +30,7 @@ *> \verbatim *> M is INTEGER *> The number of rows of the matrix B, and the order of the -*> triangular matrix A. +*> triangular matrix A. *> M >= 0. *> \endverbatim *> @@ -71,7 +71,7 @@ *> \param[in,out] B *> \verbatim *> B is REAL array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -88,7 +88,7 @@ *> The lower triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See Further Details. *> \endverbatim -*> +*> *> \param[in] LDT *> \verbatim *> LDT is INTEGER @@ -110,10 +110,10 @@ * 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 November 2013 * @@ -124,45 +124,45 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ] [ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L *> upper trapezoidal matrix B2: -*> [ B ] = [ B1 ] [ B2 ] +*> [ B ] = [ B1 ] [ B2 ] *> [ B1 ] <- M-by-(N-L) rectangular *> [ B2 ] <- M-by-L upper trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C -*> [ C ] = [ A ] [ B ] +*> [ C ] = [ A ] [ B ] *> [ A ] <- lower triangular N-by-N *> [ B ] <- M-by-N pentagonal *> *> so that W can be represented as -*> [ W ] = [ I ] [ V ] +*> [ W ] = [ I ] [ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, -*> [ V ] = [ V1 ] [ V2 ] +*> we call V above. Note that V has the same form as B; that is, +*> [ V ] = [ V1 ] [ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> *> The number of blocks is B = ceiling(M/MB), where each -*> block is of order MB except for the last block, which is of order +*> block is of order MB except for the last block, which is of order *> IB = M - (M-1)*MB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB *> for the last block) T's are stored in the MB-by-N matrix T as *> *> T = [T1 T2 ... TB]. @@ -223,7 +223,7 @@ IF( M.EQ.0 .OR. N.EQ.0 ) RETURN * DO I = 1, M, MB -* +* * Compute the QR factorization of the current block * IB = MIN( M-I+1, MB ) @@ -234,20 +234,20 @@ LB = NB-N+L-I+1 END IF * - CALL STPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, + CALL STPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, $ T(1, I ), LDT, IINFO ) * * Update by applying H**T to B(I+IB:M,:) from the right * IF( I+IB.LE.M ) THEN CALL STPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB, - $ B( I, 1 ), LDB, T( 1, I ), LDT, - $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, + $ B( I, 1 ), LDB, T( 1, I ), LDT, + $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, $ WORK, M-I-IB+1) END IF END DO RETURN -* +* * End of STPLQT * END diff --git a/TESTING/LIN/stsqr01.f b/TESTING/LIN/stsqr01.f index dbaf3aac..4cebfc88 100644 --- a/TESTING/LIN/stsqr01.f +++ b/TESTING/LIN/stsqr01.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 STSQR01(TSSW, M,N, MB, NB, RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, MB * .. Return values .. * REAL 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 REAL, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -123,24 +123,24 @@ EXTERNAL SLAMCH, SLARNV, SLANGE, SLANSY, 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') -* + TS = LSAME(TSSW, 'TS') +* * TEST MATRICES WITH HALF OF MATRIX BEING ZEROS * TESTZEROS = .FALSE. -* +* EPS = SLAMCH( '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 SLASET( 'Full', M, M, ZERO, ONE, Q, M ) srnamt = 'SGEMQR' - CALL SGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL SGEMQR( '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 = 'DGEQR' - CALL SGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMQR( '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 = 'DGEQR' - CALL SGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMQR( '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 = 'DGEQR' - CALL SGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL SGEMQR( '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 SGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL SGEMQR( '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 SLASET( 'Full', N, N, ZERO, ONE, Q, N ) srnamt = 'SGEMQR' - CALL SGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL SGEMLQ( '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 SGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMLQ( '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 SGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMLQ( '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 SGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL SGEMLQ( '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 SGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL SGEMLQ( '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 diff --git a/TESTING/LIN/zchkaa.f b/TESTING/LIN/zchkaa.f index 22885568..283e3162 100644 --- a/TESTING/LIN/zchkaa.f +++ b/TESTING/LIN/zchkaa.f @@ -651,7 +651,7 @@ * IF( TSTCHK ) THEN CALL ZCHKHE_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, - $ NSVAL, THRESH, TSTERR, LDA, + $ NSVAL, THRESH, TSTERR, LDA, $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) @@ -661,8 +661,8 @@ * IF( TSTDRV ) THEN CALL ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, - $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), + $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), + $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9988 )PATH @@ -1042,7 +1042,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -1053,7 +1053,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/zchkhe_aa.f b/TESTING/LIN/zchkhe_aa.f index 02901d01..26baae13 100644 --- a/TESTING/LIN/zchkhe_aa.f +++ b/TESTING/LIN/zchkhe_aa.f @@ -225,7 +225,7 @@ * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRHE, ZGET04, $ ZHECON, ZHERFS, ZHET01, ZHETRF_AA, ZHETRI2, - $ ZHETRS_AA, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, + $ ZHETRS_AA, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, $ ZLATMS, ZPOT02, ZPOT03, ZPOT05 * .. * .. Intrinsic Functions .. @@ -432,7 +432,7 @@ * LWORK = ( NB+1 )*LDA SRNAMT = 'ZHETRF_AA' - CALL ZHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, + CALL ZHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, $ LWORK, INFO ) * * Adjust the expected value of INFO to account for @@ -458,8 +458,8 @@ * Check error code from ZHETRF and handle error. * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'ZHETRF_AA', INFO, K, UPLO, - $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, + CALL ALAERH( PATH, 'ZHETRF_AA', INFO, K, UPLO, + $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, $ NOUT ) END IF * @@ -513,7 +513,7 @@ * SRNAMT = 'ZLARHS' CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, - $ KL, KU, NRHS, A, LDA, XACT, LDA, + $ KL, KU, NRHS, A, LDA, XACT, LDA, $ B, LDA, ISEED, INFO ) CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) * diff --git a/TESTING/LIN/zchklqt.f b/TESTING/LIN/zchklqt.f index e15793be..31c885bc 100644 --- a/TESTING/LIN/zchklqt.f +++ b/TESTING/LIN/zchklqt.f @@ -2,15 +2,15 @@ * * =========== 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 ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test ZGELQT and ZUNMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL ZLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/zchklqtp.f b/TESTING/LIN/zchklqtp.f index 10f7363a..efde54bd 100644 --- a/TESTING/LIN/zchklqtp.f +++ b/TESTING/LIN/zchklqtp.f @@ -2,13 +2,13 @@ * * =========== 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 ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL ZLQT05( M, N, L, NB, RESULT ) * @@ -212,4 +212,4 @@ * * End of ZCHKLQTP * - END
\ No newline at end of file + END diff --git a/TESTING/LIN/zchktsqr.f b/TESTING/LIN/zchktsqr.f index c79a92b7..6d8fc99b 100644 --- a/TESTING/LIN/zchktsqr.f +++ b/TESTING/LIN/zchktsqr.f @@ -2,15 +2,15 @@ * * =========== 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 ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,17 @@ * 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 November 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ DOUBLE PRECISION RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, $ DTSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test ZGEQR and ZGEMQR -* +* CALL ZTSQR01( 'TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -196,9 +196,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test ZGELQ and ZGEMLQ -* +* CALL ZTSQR01( 'SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * diff --git a/TESTING/LIN/zdrvhe_aa.f b/TESTING/LIN/zdrvhe_aa.f index e9a93491..3a43cf79 100644 --- a/TESTING/LIN/zdrvhe_aa.f +++ b/TESTING/LIN/zdrvhe_aa.f @@ -150,7 +150,7 @@ * * ===================================================================== SUBROUTINE ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, - $ NMAX, A, AFAC, AINV, B, X, XACT, WORK, + $ NMAX, A, AFAC, AINV, B, X, XACT, WORK, $ RWORK, IWORK, NOUT ) * * -- LAPACK test routine (version 3.7.0) -- @@ -201,7 +201,7 @@ * .. * .. External Subroutines .. EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04, - $ ZHESV_AA, ZHET01_AA, ZHETRF_AA, + $ ZHESV_AA, ZHET01_AA, ZHETRF_AA, $ ZHETRI2, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS, $ ZPOT02 * .. @@ -475,7 +475,7 @@ c END IF * residual. * CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/zdrvls.f b/TESTING/LIN/zdrvls.f index 1ffa585f..63fcc69e 100644 --- a/TESTING/LIN/zdrvls.f +++ b/TESTING/LIN/zdrvls.f @@ -488,7 +488,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'DGETSLS ' - CALL ZGETSLS( TRANS, M, N, NRHS, A, + CALL ZGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'ZGETSLS ', INFO, 0, @@ -771,8 +771,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/zerrlqt.f b/TESTING/LIN/zerrlqt.f index fd6b4527..f65f8951 100644 --- a/TESTING/LIN/zerrlqt.f +++ b/TESTING/LIN/zerrlqt.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 ZERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, ZGELQT3, ZGELQT, - $ ZGEMLQT + $ ZGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/zerrlqtp.f b/TESTING/LIN/zerrlqtp.f index 25a079ec..6e00e4f9 100644 --- a/TESTING/LIN/zerrlqtp.f +++ b/TESTING/LIN/zerrlqtp.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 ZERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * 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 November 2011 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, ZTPLQT2, ZTPLQT, - $ ZTPMLQT + $ ZTPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'ZTPMLQT' INFOT = 1 - CALL ZTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL ZTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL ZTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL ZTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL ZTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL ZTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL ZTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/zerrtsqr.f b/TESTING/LIN/zerrtsqr.f index 19c99805..3aa3e4a5 100644 --- a/TESTING/LIN/zerrtsqr.f +++ b/TESTING/LIN/zerrtsqr.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 ZERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Zenver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Zenver +*> \author NAG Ltd. * *> \date November 2011 * diff --git a/TESTING/LIN/zhet01_aa.f b/TESTING/LIN/zhet01_aa.f index 13bf991e..d1328c88 100644 --- a/TESTING/LIN/zhet01_aa.f +++ b/TESTING/LIN/zhet01_aa.f @@ -145,7 +145,7 @@ * * .. Parameters .. COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), + PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), $ CONE = ( 1.0D+0, 0.0D+0 ) ) DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) diff --git a/TESTING/LIN/zlqt04.f b/TESTING/LIN/zlqt04.f index a1aff90e..4571215e 100644 --- a/TESTING/LIN/zlqt04.f +++ b/TESTING/LIN/zlqt04.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 ZLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | 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 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -112,11 +112,11 @@ EXTERNAL DLAMCH, ZLANGE, ZLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = DLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -124,8 +124,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -143,7 +143,7 @@ * Generate the n-by-n matrix Q * CALL ZLASET( 'Full', N, N, CZERO, ONE, Q, N ) - CALL ZGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL ZGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy L @@ -179,7 +179,7 @@ * * Apply Q to C as Q*C * - CALL ZGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL ZGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -198,7 +198,7 @@ * * Apply Q to D as QT*D * - CALL ZGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, + CALL ZGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -209,7 +209,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -221,8 +221,8 @@ * * Apply Q to C as C*Q * - CALL ZGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL ZGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -240,8 +240,8 @@ * * Apply Q to D as D*QT * - CALL ZGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL ZGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/zlqt05.f b/TESTING/LIN/zlqt05.f index 676c95b8..196750fd 100644 --- a/TESTING/LIN/zlqt05.f +++ b/TESTING/LIN/zlqt05.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 ZLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -61,17 +61,17 @@ *> RESULT(2) = | I - Q^H Q | *> 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 * @@ -92,11 +92,11 @@ DOUBLE PRECISION RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -119,7 +119,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = DLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -133,7 +133,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -151,7 +151,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL ZLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL ZLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -204,7 +204,7 @@ CALL ZLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL ZTPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -226,18 +226,18 @@ * Apply Q to C as QT*C * CALL ZTPMLQT( 'L','C',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL ZGEMM('C','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = ZLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -269,8 +269,8 @@ * Apply Q to D as D*QT * CALL ZTPMLQT('R','C',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -286,4 +286,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END
\ No newline at end of file + END diff --git a/TESTING/LIN/ztsqr01.f b/TESTING/LIN/ztsqr01.f index 5f39ae7e..38ace9c8 100644 --- a/TESTING/LIN/ztsqr01.f +++ b/TESTING/LIN/ztsqr01.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 ZTSQR01(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 * @@ -97,9 +97,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -122,24 +122,24 @@ EXTERNAL DLAMCH, ZLANGE, ZLANSY, 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') -* + 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) @@ -148,14 +148,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 @@ -183,7 +183,7 @@ * CALL ZLASET( 'Full', M, M, CZERO, ONE, Q, M ) srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -220,7 +220,7 @@ * Apply Q to C as Q*C * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -240,7 +240,7 @@ * Apply Q to C as QT*C * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -251,7 +251,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 * @@ -264,8 +264,8 @@ * Apply Q to D as D*Q * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| * @@ -283,8 +283,8 @@ * * Apply Q to D as D*QT * - CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| * @@ -307,7 +307,7 @@ * CALL ZLASET( 'Full', N, N, CZERO, ONE, Q, N ) srnamt = 'ZGEMLQ' - CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -343,7 +343,7 @@ * * Apply Q to C as Q*C * - CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -362,7 +362,7 @@ * * Apply Q to D as QT*D * - CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -373,7 +373,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 * @@ -385,8 +385,8 @@ * * Apply Q to C as C*Q * - CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -404,8 +404,8 @@ * * Apply Q to D as D*QT * - CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| * @@ -424,4 +424,4 @@ DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) * RETURN - END
\ No newline at end of file + END |