From 46e1b19474b5150ce94f35cc0ec52e08c729985c Mon Sep 17 00:00:00 2001 From: julie Date: Fri, 23 Sep 2011 15:26:46 +0000 Subject: Commit patch sent by Sven. Patch was based on 3.3.0, so required a little bit of merging. Thank you Sven for the corrections. Julie JL TESTING/EIG zerrgg.f Declare ILO, IHI SRC --- I have corrected all the following warnings and errors: c/d/s/zsysv.f, Unused external reference ILAENV >JL OK c/d/s/zsysv.f, Unused local variable NB >JL ALREADY CORRECTED sgsvj0.f, Unused intrinsic AMIN1 > JL OK d/sorbdb.f, Unused intrinsic MIN > JL OK sorcsd.f, Unused intrinsic SIN sorcsd.f, Unused intrinsic COS > JL OK MERGE cpoequb.f, Unused intrinsic AIMAG cpoequb.f, Unused intrinsic REAL cpoequb.f, Unused local variable ZDUM zgeequb.f, REAL --> DBLE > JL OK sorcsd.f, line 330: Inconsistent data type REAL (previously INTEGER) for argument 14 in reference to SORBDB sorcsd.f, line 340: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR sorcsd.f, line 345: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR sorcsd.f, line 356: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ sorcsd.f, line 363: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ sorcsd.f, line 369: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ sorcsd.f, line 374: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ sorcsd.f, line 385: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR sorcsd.f, line 392: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR sorcsd.f, line 399: Inconsistent data type REAL (previously INTEGER) for argument 9 in reference to SBBCSD > JL OK MERGE ila(s/d/c/z)lr.f In the WHILE loop, at about line 59 I inserted IF (I.EQ.0) THEN EXIT END IF since, otherwise when I = 0, A(0,J) is referenced. > JL OK TESTING/MATGEN -------------- s/dlatm7.f line 187: I replaced IF( N.GT.1 ) THEN by IF( N.GT.1 .AND. RANK.GT.1 ) THEN Otherwise I get a division by zero. > JL OK s/dlaror.f I moved: INFO = 0 from line 125 to line 121 in front of IF( N.EQ.0 .OR. M.EQ.0 ) $ RETURN otherwise INFO is not defined on return when N or M are zero. Similar change for c/zlaror.f > JL OK TESTING/LIN ----------- s/derrsy.f In calls to S/DSYTRI2: I replaced IW by IW(1) since the dummy argument (LWORK) is a scalar. > JL OK c/zerrrfp.f I made ALPHA and BETA REAL/DOUBLE and introduced COMPLEX/COMPLEX*16 CALPHA since calls to C/ZHFRK need real alpha and beta. In calls to CTFSM, I then replaced ALPHA with CALPHA. In cerrrfp.f, I replaced 1.0D0 with 1.0E0 (not strictly necessary, but cleaner). > JL OK dpot06.f Removed the unused declaration of LSAME > JL OK d/zdrvac.f Removed the unused declaration of LSAME > JL OK MERGE s/d/c/z/ckcsd.f Removed the unused declarations of S/D/C/ZLANGE, SIN and COS > JL OK c/zgennd.f Removed the unused variable OUT > JL already DONE Corrected the following warnings and errors: dchksy.f, Unused local variable MYWORK > JL already DONE ddrvgbx.f, line 792: Different number of arguments from the first call of DGBT02 > JL OK cdrvgbx.f, line 726: Inconsistent data type REAL (previously COMPLEX) for argument 4 in reference to CLASET cdrvgbx.f, line 728: Inconsistent data type REAL (previously COMPLEX) for argument 4 in reference to CLASET cdrvgbx.f, line 780: Inconsistent data type REAL (previously COMPLEX) for argument 10 in reference to CGBT01 cdrvgbx.f, line 794: Different number of arguments from the first call of CGBT02 > JL OK zdrvgbx.f, line 726: Inconsistent data type DOUBLE PRECISION (previously COMPLEX(KIND(0d0))) for argument 4 in reference to ZLASET zdrvgbx.f, line 728: Inconsistent data type DOUBLE PRECISION (previously COMPLEX(KIND(0d0))) for argument 4 in reference to ZLASET zdrvgbx.f, line 780: Inconsistent data type DOUBLE PRECISION (previously COMPLEX(KIND(0d0))) for argument 10 in reference to ZGBT01 zdrvgbx.f, line 794: Different number of arguments from the first call of ZGBT02 > JL OK TESTING/EIG ----------- s/d/c/zchkee.f I inserted CALL XLAENV( 12, 1 ) at line 1208, since IPARMS(ISPEC) with ISPEC = 12 needs to be set. (I think I had to do this with them all, certainly with zchkee.f) > JL OK zchkee.f cchkee.f c/zchkee.f In line 2316, the 15th argument of C/ZCKCSD should be real, not complex, so I replaced A(1,7) by RWORK. > JL OK c/zcsdts.f In calls to C/ZHERK I have replaced ONE by REALONE as arguments 5 and 8 should be real. > JL OK s/d/c/zcsdts.f Division by zero occurs at line 155 in computing EPS when M = 0, so I have modified EPS2 = MAX( ULP, CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) ) to IF (M.GT.0) THEN EPS2 = MAX( ULP, $ CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) ) ELSE EPS2 = ULP END IF > JL OK SRC/VARIANTS/lu/CR ------------------ s/d/c/zgetrf Removed the unused intrinsic MOD > JL OK --- TESTING/EIG/cchkee.f | 3 ++- TESTING/EIG/cckcsd.f | 6 +++--- TESTING/EIG/ccsdts.f | 28 ++++++++++++++++------------ TESTING/EIG/cerrgg.f | 4 ++-- TESTING/EIG/dckcsd.f | 6 +++--- TESTING/EIG/dcsdts.f | 8 ++++++-- TESTING/EIG/sckcsd.f | 6 +++--- TESTING/EIG/scsdts.f | 8 ++++++-- TESTING/EIG/zchkee.f | 3 ++- TESTING/EIG/zckcsd.f | 6 +++--- TESTING/EIG/zcsdts.f | 28 ++++++++++++++++------------ TESTING/LIN/cdrvgbx.f | 14 ++++++++------ TESTING/LIN/ddrvgbx.f | 2 +- TESTING/LIN/derrsy.f | 6 +++--- TESTING/LIN/dpot06.f | 3 +-- TESTING/LIN/serrsy.f | 6 +++--- TESTING/LIN/zdrvac.f | 4 ---- TESTING/LIN/zdrvgbx.f | 14 ++++++++------ TESTING/LIN/zerrrfp.f | 28 +++++++++++++++------------- TESTING/MATGEN/claror.f | 2 +- TESTING/MATGEN/dlaror.f | 2 +- TESTING/MATGEN/dlatm7.f | 2 +- TESTING/MATGEN/slaror.f | 2 +- TESTING/MATGEN/zlaror.f | 2 +- 24 files changed, 106 insertions(+), 87 deletions(-) (limited to 'TESTING') diff --git a/TESTING/EIG/cchkee.f b/TESTING/EIG/cchkee.f index aef0b0be..7370a65d 100644 --- a/TESTING/EIG/cchkee.f +++ b/TESTING/EIG/cchkee.f @@ -1204,6 +1204,7 @@ * READ( NIN, FMT = * )THRESH CALL XLAENV( 1, 1 ) + CALL XLAENV( 12, 1 ) TSTERR = .TRUE. CALL CCHKEC( THRESH, TSTERR, NIN, NOUT ) GO TO 380 @@ -2314,7 +2315,7 @@ $ CALL CERRGG( 'CSD', NOUT ) CALL CCKCSD( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), - $ A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), IWORK, WORK, + $ A( 1, 5 ), A( 1, 6 ), RWORK, IWORK, WORK, $ DR( 1, 1 ), NIN, NOUT, INFO ) IF( INFO.NE.0 ) $ WRITE( NOUT, FMT = 9980 )'CCKCSD', INFO diff --git a/TESTING/EIG/cckcsd.f b/TESTING/EIG/cckcsd.f index e081652e..f454e3c0 100644 --- a/TESTING/EIG/cckcsd.f +++ b/TESTING/EIG/cckcsd.f @@ -128,11 +128,11 @@ $ CLASET * .. * .. Intrinsic Functions .. - INTRINSIC ABS, COS, MIN, SIN + INTRINSIC ABS, MIN * .. * .. External Functions .. - REAL CLANGE, SLARND - EXTERNAL CLANGE, SLARND + REAL SLARND + EXTERNAL SLARND * .. * .. Executable Statements .. * diff --git a/TESTING/EIG/ccsdts.f b/TESTING/EIG/ccsdts.f index 6054f5aa..e4362fa8 100644 --- a/TESTING/EIG/ccsdts.f +++ b/TESTING/EIG/ccsdts.f @@ -150,10 +150,14 @@ ULP = SLAMCH( 'Precision' ) ULPINV = REALONE / ULP CALL CLASET( 'Full', M, M, ZERO, ONE, WORK, LDX ) - CALL CHERK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX, - $ ONE, WORK, LDX ) - EPS2 = MAX( ULP, - $ CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) ) + CALL CHERK( 'Upper', 'Conjugate transpose', M, M, -REALONE, + $ X, LDX, REALONE, WORK, LDX ) + IF (M.GT.0) THEN + EPS2 = MAX( ULP, + $ CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) ) + ELSE + EPS2 = ULP + END IF R = MIN( P, M-P, Q, M-Q ) * * Copy the matrix X to the array XF. @@ -252,8 +256,8 @@ * Compute I - U1'*U1 * CALL CLASET( 'Full', P, P, ZERO, ONE, WORK, LDU1 ) - CALL CHERK( 'Upper', 'Conjugate transpose', P, P, -ONE, U1, LDU1, - $ ONE, WORK, LDU1 ) + CALL CHERK( 'Upper', 'Conjugate transpose', P, P, -REALONE, + $ U1, LDU1, REALONE, WORK, LDU1 ) * * Compute norm( I - U'*U ) / ( MAX(1,P) * ULP ) . * @@ -263,8 +267,8 @@ * Compute I - U2'*U2 * CALL CLASET( 'Full', M-P, M-P, ZERO, ONE, WORK, LDU2 ) - CALL CHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -ONE, U2, - $ LDU2, ONE, WORK, LDU2 ) + CALL CHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -REALONE, + $ U2, LDU2, REALONE, WORK, LDU2 ) * * Compute norm( I - U2'*U2 ) / ( MAX(1,M-P) * ULP ) . * @@ -274,8 +278,8 @@ * Compute I - V1T*V1T' * CALL CLASET( 'Full', Q, Q, ZERO, ONE, WORK, LDV1T ) - CALL CHERK( 'Upper', 'No transpose', Q, Q, -ONE, V1T, LDV1T, ONE, - $ WORK, LDV1T ) + CALL CHERK( 'Upper', 'No transpose', Q, Q, -REALONE, + $ V1T, LDV1T, REALONE, WORK, LDV1T ) * * Compute norm( I - V1T*V1T' ) / ( MAX(1,Q) * ULP ) . * @@ -285,8 +289,8 @@ * Compute I - V2T*V2T' * CALL CLASET( 'Full', M-Q, M-Q, ZERO, ONE, WORK, LDV2T ) - CALL CHERK( 'Upper', 'No transpose', M-Q, M-Q, -ONE, V2T, LDV2T, - $ ONE, WORK, LDV2T ) + CALL CHERK( 'Upper', 'No transpose', M-Q, M-Q, -REALONE, + $ V2T, LDV2T, REALONE, WORK, LDV2T ) * * Compute norm( I - V2T*V2T' ) / ( MAX(1,M-Q) * ULP ) . * diff --git a/TESTING/EIG/cerrgg.f b/TESTING/EIG/cerrgg.f index 3a2532e6..5da0ccbf 100644 --- a/TESTING/EIG/cerrgg.f +++ b/TESTING/EIG/cerrgg.f @@ -35,8 +35,8 @@ * .. * .. Local Scalars .. CHARACTER*2 C2 - INTEGER DUMMYK, DUMMYL, I, IFST, ILST, INFO, J, M, - $ NCYCLE, NT, SDIM + INTEGER DUMMYK, DUMMYL, I, IFST, IHI, ILO, ILST, INFO, + $ J, M, NCYCLE, NT, SDIM REAL ANRM, BNRM, DIF, SCALE, TOLA, TOLB * .. * .. Local Arrays .. diff --git a/TESTING/EIG/dckcsd.f b/TESTING/EIG/dckcsd.f index 9981b4a9..9fdd5539 100644 --- a/TESTING/EIG/dckcsd.f +++ b/TESTING/EIG/dckcsd.f @@ -128,11 +128,11 @@ $ DLASET * .. * .. Intrinsic Functions .. - INTRINSIC ABS, COS, MIN, SIN + INTRINSIC ABS, MIN * .. * .. External Functions .. - DOUBLE PRECISION DLANGE, DLARND - EXTERNAL DLANGE, DLARND + DOUBLE PRECISION DLARND + EXTERNAL DLARND * .. * .. Executable Statements .. * diff --git a/TESTING/EIG/dcsdts.f b/TESTING/EIG/dcsdts.f index 83e5ab99..3b6762f0 100644 --- a/TESTING/EIG/dcsdts.f +++ b/TESTING/EIG/dcsdts.f @@ -152,8 +152,12 @@ CALL DLASET( 'Full', M, M, ZERO, ONE, WORK, LDX ) CALL DSYRK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX, $ ONE, WORK, LDX ) - EPS2 = MAX( ULP, - $ DLANGE( '1', M, M, WORK, LDX, RWORK ) / DBLE( M ) ) + IF (M.GT.0) THEN + EPS2 = MAX( ULP, + $ DLANGE( '1', M, M, WORK, LDX, RWORK ) / DBLE( M ) ) + ELSE + EPS2 = ULP + END IF R = MIN( P, M-P, Q, M-Q ) * * Copy the matrix X to the array XF. diff --git a/TESTING/EIG/sckcsd.f b/TESTING/EIG/sckcsd.f index 9c768be1..d6f4c22c 100644 --- a/TESTING/EIG/sckcsd.f +++ b/TESTING/EIG/sckcsd.f @@ -128,11 +128,11 @@ $ SLASET * .. * .. Intrinsic Functions .. - INTRINSIC ABS, COS, MIN, SIN + INTRINSIC ABS, MIN * .. * .. External Functions .. - REAL SLANGE, SLARND - EXTERNAL SLANGE, SLARND + REAL SLARND + EXTERNAL SLARND * .. * .. Executable Statements .. * diff --git a/TESTING/EIG/scsdts.f b/TESTING/EIG/scsdts.f index 214a0d6e..390c4354 100644 --- a/TESTING/EIG/scsdts.f +++ b/TESTING/EIG/scsdts.f @@ -152,8 +152,12 @@ CALL SLASET( 'Full', M, M, ZERO, ONE, WORK, LDX ) CALL SSYRK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX, $ ONE, WORK, LDX ) - EPS2 = MAX( ULP, - $ SLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) ) + IF (M.GT.0) THEN + EPS2 = MAX( ULP, + $ SLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) ) + ELSE + EPS2 = ULP + END IF R = MIN( P, M-P, Q, M-Q ) * * Copy the matrix X to the array XF. diff --git a/TESTING/EIG/zchkee.f b/TESTING/EIG/zchkee.f index dd3547e6..51f6a79b 100644 --- a/TESTING/EIG/zchkee.f +++ b/TESTING/EIG/zchkee.f @@ -1204,6 +1204,7 @@ * READ( NIN, FMT = * )THRESH CALL XLAENV( 1, 1 ) + CALL XLAENV( 12, 1 ) TSTERR = .TRUE. CALL ZCHKEC( THRESH, TSTERR, NIN, NOUT ) GO TO 380 @@ -2314,7 +2315,7 @@ $ CALL ZERRGG( 'CSD', NOUT ) CALL ZCKCSD( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), - $ A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), IWORK, WORK, + $ A( 1, 5 ), A( 1, 6 ), RWORK, IWORK, WORK, $ DR( 1, 1 ), NIN, NOUT, INFO ) IF( INFO.NE.0 ) $ WRITE( NOUT, FMT = 9980 )'ZCKCSD', INFO diff --git a/TESTING/EIG/zckcsd.f b/TESTING/EIG/zckcsd.f index 8f43067b..83b63045 100644 --- a/TESTING/EIG/zckcsd.f +++ b/TESTING/EIG/zckcsd.f @@ -128,11 +128,11 @@ $ ZLASET * .. * .. Intrinsic Functions .. - INTRINSIC ABS, COS, MIN, SIN + INTRINSIC ABS, MIN * .. * .. External Functions .. - DOUBLE PRECISION ZLANGE, DLARND - EXTERNAL ZLANGE, DLARND + DOUBLE PRECISION DLARND + EXTERNAL DLARND * .. * .. Executable Statements .. * diff --git a/TESTING/EIG/zcsdts.f b/TESTING/EIG/zcsdts.f index 3436d9ef..2aa7c448 100644 --- a/TESTING/EIG/zcsdts.f +++ b/TESTING/EIG/zcsdts.f @@ -150,10 +150,14 @@ ULP = DLAMCH( 'Precision' ) ULPINV = REALONE / ULP CALL ZLASET( 'Full', M, M, ZERO, ONE, WORK, LDX ) - CALL ZHERK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX, - $ ONE, WORK, LDX ) - EPS2 = MAX( ULP, - $ ZLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) ) + CALL ZHERK( 'Upper', 'Conjugate transpose', M, M, -REALONE, + $ X, LDX, REALONE, WORK, LDX ) + IF (M.GT.0) THEN + EPS2 = MAX( ULP, + $ ZLANGE( '1', M, M, WORK, LDX, RWORK ) / DBLE( M ) ) + ELSE + EPS2 = ULP + END IF R = MIN( P, M-P, Q, M-Q ) * * Copy the matrix X to the array XF. @@ -252,8 +256,8 @@ * Compute I - U1'*U1 * CALL ZLASET( 'Full', P, P, ZERO, ONE, WORK, LDU1 ) - CALL ZHERK( 'Upper', 'Conjugate transpose', P, P, -ONE, U1, LDU1, - $ ONE, WORK, LDU1 ) + CALL ZHERK( 'Upper', 'Conjugate transpose', P, P, -REALONE, + $ U1, LDU1, REALONE, WORK, LDU1 ) * * Compute norm( I - U'*U ) / ( MAX(1,P) * ULP ) . * @@ -263,8 +267,8 @@ * Compute I - U2'*U2 * CALL ZLASET( 'Full', M-P, M-P, ZERO, ONE, WORK, LDU2 ) - CALL ZHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -ONE, U2, - $ LDU2, ONE, WORK, LDU2 ) + CALL ZHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -REALONE, + $ U2, LDU2, REALONE, WORK, LDU2 ) * * Compute norm( I - U2'*U2 ) / ( MAX(1,M-P) * ULP ) . * @@ -274,8 +278,8 @@ * Compute I - V1T*V1T' * CALL ZLASET( 'Full', Q, Q, ZERO, ONE, WORK, LDV1T ) - CALL ZHERK( 'Upper', 'No transpose', Q, Q, -ONE, V1T, LDV1T, ONE, - $ WORK, LDV1T ) + CALL ZHERK( 'Upper', 'No transpose', Q, Q, -REALONE, + $ V1T, LDV1T, REALONE, WORK, LDV1T ) * * Compute norm( I - V1T*V1T' ) / ( MAX(1,Q) * ULP ) . * @@ -285,8 +289,8 @@ * Compute I - V2T*V2T' * CALL ZLASET( 'Full', M-Q, M-Q, ZERO, ONE, WORK, LDV2T ) - CALL ZHERK( 'Upper', 'No transpose', M-Q, M-Q, -ONE, V2T, LDV2T, - $ ONE, WORK, LDV2T ) + CALL ZHERK( 'Upper', 'No transpose', M-Q, M-Q, -REALONE, + $ V2T, LDV2T, REALONE, WORK, LDV2T ) * * Compute norm( I - V2T*V2T' ) / ( MAX(1,M-Q) * ULP ) . * diff --git a/TESTING/LIN/cdrvgbx.f b/TESTING/LIN/cdrvgbx.f index 3ba557cc..7bcb609a 100644 --- a/TESTING/LIN/cdrvgbx.f +++ b/TESTING/LIN/cdrvgbx.f @@ -723,9 +723,12 @@ c write(*,*) 'begin cgbsvxx testing' CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB ) IF( .NOT.PREFAC ) - $ CALL CLASET( 'Full', 2*KL+KU+1, N, ZERO, ZERO, - $ AFB, LDAFB ) - CALL CLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDB ) + $ CALL CLASET( 'Full', 2*KL+KU+1, N, + $ CMPLX( ZERO ), CMPLX( ZERO ), + $ AFB, LDAFB ) + CALL CLASET( 'Full', N, NRHS, + $ CMPLX( ZERO ), CMPLX( ZERO ), + $ X, LDB ) IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN * * Equilibrate the matrix if FACT = 'F' and @@ -778,7 +781,7 @@ c write(*,*) 'begin cgbsvxx testing' * residual. * CALL CGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB, - $ IWORK, RWORK( 2*NRHS+1 ), RESULT( 1 ) ) + $ IWORK, WORK( 2*NRHS+1 ), RESULT( 1 ) ) K1 = 1 ELSE K1 = 2 @@ -792,8 +795,7 @@ c write(*,*) 'begin cgbsvxx testing' CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, WORK, $ LDB ) CALL CGBT02( TRANS, N, N, KL, KU, NRHS, ASAV, - $ LDA, X, LDB, WORK, LDB, RWORK( 2*NRHS+1 ), - $ RESULT( 2 ) ) + $ LDA, X, LDB, WORK, LDB, RESULT( 2 ) ) * * Check solution from generated exact solution. * diff --git a/TESTING/LIN/ddrvgbx.f b/TESTING/LIN/ddrvgbx.f index dc0be900..4be73fe5 100644 --- a/TESTING/LIN/ddrvgbx.f +++ b/TESTING/LIN/ddrvgbx.f @@ -791,7 +791,7 @@ $ LDB ) CALL DGBT02( TRANS, N, N, KL, KU, NRHS, ASAV, $ LDA, X, LDB, WORK, LDB, - $ WORK, RESULT( 2 ) ) + $ RESULT( 2 ) ) * * Check solution from generated exact solution. * diff --git a/TESTING/LIN/derrsy.f b/TESTING/LIN/derrsy.f index 36186814..8083b9ee 100644 --- a/TESTING/LIN/derrsy.f +++ b/TESTING/LIN/derrsy.f @@ -134,13 +134,13 @@ * SRNAMT = 'DSYTRI2' INFOT = 1 - CALL DSYTRI2( '/', 0, A, 1, IP, W, IW, INFO ) + CALL DSYTRI2( '/', 0, A, 1, IP, W, IW(1), INFO ) CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO ) + CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW(1), INFO ) CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO ) + CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO ) CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK ) * * DSYTRS diff --git a/TESTING/LIN/dpot06.f b/TESTING/LIN/dpot06.f index d1c2df51..b5ca5cad 100644 --- a/TESTING/LIN/dpot06.f +++ b/TESTING/LIN/dpot06.f @@ -80,10 +80,9 @@ DOUBLE PRECISION ANORM, BNORM, EPS, XNORM * .. * .. External Functions .. - LOGICAL LSAME INTEGER IDAMAX DOUBLE PRECISION DLAMCH, DLANSY - EXTERNAL LSAME, IDAMAX, DLAMCH, DLANSY + EXTERNAL IDAMAX, DLAMCH, DLANSY * .. * .. External Subroutines .. EXTERNAL DSYMM diff --git a/TESTING/LIN/serrsy.f b/TESTING/LIN/serrsy.f index 0f64e6de..7e218ef2 100644 --- a/TESTING/LIN/serrsy.f +++ b/TESTING/LIN/serrsy.f @@ -134,13 +134,13 @@ * SRNAMT = 'SSYTRI2' INFOT = 1 - CALL SSYTRI2( '/', 0, A, 1, IP, W, IW, INFO ) + CALL SSYTRI2( '/', 0, A, 1, IP, W, IW(1), INFO ) CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO ) + CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW(1), INFO ) CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO ) + CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO ) CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK ) * * SSYTRS diff --git a/TESTING/LIN/zdrvac.f b/TESTING/LIN/zdrvac.f index e637598f..04bdcf79 100644 --- a/TESTING/LIN/zdrvac.f +++ b/TESTING/LIN/zdrvac.f @@ -100,10 +100,6 @@ * .. Local Variables .. INTEGER ITER, KASE * .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. * .. External Subroutines .. EXTERNAL ALAERH, ZLACPY, ZLAIPD, $ ZLARHS, ZLATB4, ZLATMS, diff --git a/TESTING/LIN/zdrvgbx.f b/TESTING/LIN/zdrvgbx.f index 416dd75c..2ef7b8a5 100644 --- a/TESTING/LIN/zdrvgbx.f +++ b/TESTING/LIN/zdrvgbx.f @@ -723,9 +723,12 @@ c write(*,*) 'begin zgbsvxx testing' CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB ) IF( .NOT.PREFAC ) - $ CALL ZLASET( 'Full', 2*KL+KU+1, N, ZERO, ZERO, - $ AFB, LDAFB ) - CALL ZLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDB ) + $ CALL ZLASET( 'Full', 2*KL+KU+1, N, + $ DCMPLX( ZERO ), DCMPLX( ZERO ), + $ AFB, LDAFB ) + CALL ZLASET( 'Full', N, NRHS, + $ DCMPLX( ZERO ), DCMPLX( ZERO ), + $ X, LDB ) IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN * * Equilibrate the matrix if FACT = 'F' and @@ -778,7 +781,7 @@ c write(*,*) 'begin zgbsvxx testing' * residual. * CALL ZGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB, - $ IWORK, RWORK( 2*NRHS+1 ), RESULT( 1 ) ) + $ IWORK, WORK( 2*NRHS+1 ), RESULT( 1 ) ) K1 = 1 ELSE K1 = 2 @@ -792,8 +795,7 @@ c write(*,*) 'begin zgbsvxx testing' CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB, WORK, $ LDB ) CALL ZGBT02( TRANS, N, N, KL, KU, NRHS, ASAV, - $ LDA, X, LDB, WORK, LDB, RWORK( 2*NRHS+1 ), - $ RESULT( 2 ) ) + $ LDA, X, LDB, WORK, LDB, RESULT( 2 ) ) * * Check solution from generated exact solution. * diff --git a/TESTING/LIN/zerrrfp.f b/TESTING/LIN/zerrrfp.f index 96b02dbd..078018c8 100644 --- a/TESTING/LIN/zerrrfp.f +++ b/TESTING/LIN/zerrrfp.f @@ -30,7 +30,8 @@ * .. * .. Local Scalars .. INTEGER INFO - COMPLEX*16 ALPHA, BETA + DOUBLE PRECISION ALPHA, BETA + COMPLEX*16 CALPHA * .. * .. Local Arrays .. COMPLEX*16 A( 1, 1), B( 1, 1) @@ -56,10 +57,11 @@ * NOUT = NUNIT OK = .TRUE. - A( 1, 1 ) = DCMPLX( 1.D0 , 1.D0 ) - B( 1, 1 ) = DCMPLX( 1.D0 , 1.D0 ) - ALPHA = DCMPLX( 1.D0 , 1.D0 ) - BETA = DCMPLX( 1.D0 , 1.D0 ) + A( 1, 1 ) = DCMPLX( 1.0D0 , 1.0D0 ) + B( 1, 1 ) = DCMPLX( 1.0D0 , 1.0D0 ) + ALPHA = 1.0D0 + CALPHA = DCMPLX( 1.0D0 , 1.0D0 ) + BETA = 1.0D0 * SRNAMT = 'ZPFTRF' INFOT = 1 @@ -102,28 +104,28 @@ * SRNAMT = 'ZTFSM ' INFOT = 1 - CALL ZTFSM( '/', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) + CALL ZTFSM( '/', 'L', 'U', 'C', 'U', 0, 0, CALPHA, A, B, 1 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZTFSM( 'N', '/', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) + CALL ZTFSM( 'N', '/', 'U', 'C', 'U', 0, 0, CALPHA, A, B, 1 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL ZTFSM( 'N', 'L', '/', 'C', 'U', 0, 0, ALPHA, A, B, 1 ) + CALL ZTFSM( 'N', 'L', '/', 'C', 'U', 0, 0, CALPHA, A, B, 1 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 ) + CALL ZTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, CALPHA, A, B, 1 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZTFSM( 'N', 'L', 'U', 'C', '/', 0, 0, ALPHA, A, B, 1 ) + CALL ZTFSM( 'N', 'L', 'U', 'C', '/', 0, 0, CALPHA, A, B, 1 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) INFOT = 6 - CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', -1, 0, ALPHA, A, B, 1 ) + CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', -1, 0, CALPHA, A, B, 1 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, -1, ALPHA, A, B, 1 ) + CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, -1, CALPHA, A, B, 1 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 0 ) + CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, 0, CALPHA, A, B, 0 ) CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK ) * SRNAMT = 'ZTFTRI' diff --git a/TESTING/MATGEN/claror.f b/TESTING/MATGEN/claror.f index f1648bef..d1d04d26 100644 --- a/TESTING/MATGEN/claror.f +++ b/TESTING/MATGEN/claror.f @@ -137,6 +137,7 @@ * .. * .. Executable Statements .. * + INFO = 0 IF( N.EQ.0 .OR. M.EQ.0 ) $ RETURN * @@ -153,7 +154,6 @@ * * Check for argument errors. * - INFO = 0 IF( ITYPE.EQ.0 ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN diff --git a/TESTING/MATGEN/dlaror.f b/TESTING/MATGEN/dlaror.f index c844af7d..468e37cd 100644 --- a/TESTING/MATGEN/dlaror.f +++ b/TESTING/MATGEN/dlaror.f @@ -118,6 +118,7 @@ * .. * .. Executable Statements .. * + INFO = 0 IF( N.EQ.0 .OR. M.EQ.0 ) $ RETURN * @@ -132,7 +133,6 @@ * * Check for argument errors. * - INFO = 0 IF( ITYPE.EQ.0 ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN diff --git a/TESTING/MATGEN/dlatm7.f b/TESTING/MATGEN/dlatm7.f index e21ad3c9..683d46be 100644 --- a/TESTING/MATGEN/dlatm7.f +++ b/TESTING/MATGEN/dlatm7.f @@ -184,7 +184,7 @@ * 160 CONTINUE D( 1 ) = ONE - IF( N.GT.1 ) THEN + IF( N.GT.1 .AND. RANK.GT.1 ) THEN ALPHA = COND**( -ONE / DBLE( RANK-1 ) ) DO 170 I = 2, RANK D( I ) = ALPHA**( I-1 ) diff --git a/TESTING/MATGEN/slaror.f b/TESTING/MATGEN/slaror.f index a18cdc10..4e5bef53 100644 --- a/TESTING/MATGEN/slaror.f +++ b/TESTING/MATGEN/slaror.f @@ -118,6 +118,7 @@ * .. * .. Executable Statements .. * + INFO = 0 IF( N.EQ.0 .OR. M.EQ.0 ) $ RETURN * @@ -132,7 +133,6 @@ * * Check for argument errors. * - INFO = 0 IF( ITYPE.EQ.0 ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN diff --git a/TESTING/MATGEN/zlaror.f b/TESTING/MATGEN/zlaror.f index f739c7ec..73f75136 100644 --- a/TESTING/MATGEN/zlaror.f +++ b/TESTING/MATGEN/zlaror.f @@ -137,6 +137,7 @@ * .. * .. Executable Statements .. * + INFO = 0 IF( N.EQ.0 .OR. M.EQ.0 ) $ RETURN * @@ -153,7 +154,6 @@ * * Check for argument errors. * - INFO = 0 IF( ITYPE.EQ.0 ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN -- cgit v1.2.3