diff --git a/lapack-netlib/SRC/cgelqt3.f b/lapack-netlib/SRC/cgelqt3.f index 1dfbd3f2b..553087bf4 100644 --- a/lapack-netlib/SRC/cgelqt3.f +++ b/lapack-netlib/SRC/cgelqt3.f @@ -159,7 +159,8 @@ * * Compute Householder transform when M=1 * - CALL CLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T ) + CALL CLARFG( N, A( 1, 1 ), A( 1, MIN( 2, N ) ), LDA, + & T( 1, 1 ) ) T(1,1)=CONJG(T(1,1)) * ELSE diff --git a/lapack-netlib/SRC/dgelqt3.f b/lapack-netlib/SRC/dgelqt3.f index 5bcc06a80..ee3bdceb4 100644 --- a/lapack-netlib/SRC/dgelqt3.f +++ b/lapack-netlib/SRC/dgelqt3.f @@ -173,7 +173,8 @@ * * Compute Householder transform when M=1 * - CALL DLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T ) + CALL DLARFG( N, A ( 1, 1 ), A( 1, MIN( 2, N ) ), LDA, + & T( 1, 1) ) * ELSE * diff --git a/lapack-netlib/SRC/dlatrs.f b/lapack-netlib/SRC/dlatrs.f index be156bee2..b282f4227 100644 --- a/lapack-netlib/SRC/dlatrs.f +++ b/lapack-netlib/SRC/dlatrs.f @@ -261,6 +261,9 @@ DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS, $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX * .. +* .. Local Arrays .. + DOUBLE PRECISION WORK(1) +* .. * .. External Functions .. LOGICAL LSAME INTEGER IDAMAX @@ -362,7 +365,7 @@ * A is upper triangular. * DO J = 2, N - TMAX = MAX( DLANGE( 'M', J-1, 1, A( 1, J ), 1, SUMJ ), + TMAX = MAX( DLANGE( 'M', J-1, 1, A( 1, J ), 1, WORK ), $ TMAX ) END DO ELSE @@ -371,7 +374,7 @@ * DO J = 1, N - 1 TMAX = MAX( DLANGE( 'M', N-J, 1, A( J+1, J ), 1, - $ SUMJ ), TMAX ) + $ WORK ), TMAX ) END DO END IF * diff --git a/lapack-netlib/SRC/dtrsyl3.f b/lapack-netlib/SRC/dtrsyl3.f index c44ec3808..31a5230ba 100644 --- a/lapack-netlib/SRC/dtrsyl3.f +++ b/lapack-netlib/SRC/dtrsyl3.f @@ -1220,7 +1220,7 @@ * SCALOC = MIN( BIGNUM / SCAL, ONE / BUF ) BUF = BUF * SCALOC - CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK ) + CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) ) END IF * * Combine with buffer scaling factor. SCALE will be flushed if diff --git a/lapack-netlib/SRC/sgelqt3.f b/lapack-netlib/SRC/sgelqt3.f index 23816b4c8..82f5c1cf4 100644 --- a/lapack-netlib/SRC/sgelqt3.f +++ b/lapack-netlib/SRC/sgelqt3.f @@ -158,7 +158,8 @@ * * Compute Householder transform when M=1 * - CALL SLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T ) + CALL SLARFG( N, A( 1, 1 ), A( 1, MIN( 2, N ) ), LDA, + & T( 1, 1 ) ) * ELSE * diff --git a/lapack-netlib/SRC/slatrs.f b/lapack-netlib/SRC/slatrs.f index 0761d656f..9765ea3d7 100644 --- a/lapack-netlib/SRC/slatrs.f +++ b/lapack-netlib/SRC/slatrs.f @@ -261,6 +261,9 @@ REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS, $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX * .. +* .. Local Arrays .. + REAL WORK (1) +* .. * .. External Functions .. LOGICAL LSAME INTEGER ISAMAX @@ -362,7 +365,7 @@ * A is upper triangular. * DO J = 2, N - TMAX = MAX( SLANGE( 'M', J-1, 1, A( 1, J ), 1, SUMJ ), + TMAX = MAX( SLANGE( 'M', J-1, 1, A( 1, J ), 1, WORK ), $ TMAX ) END DO ELSE @@ -371,7 +374,7 @@ * DO J = 1, N - 1 TMAX = MAX( SLANGE( 'M', N-J, 1, A( J+1, J ), 1, - $ SUMJ ), TMAX ) + $ WORK ), TMAX ) END DO END IF * diff --git a/lapack-netlib/SRC/strsyl3.f b/lapack-netlib/SRC/strsyl3.f index 28762c2ed..ef3f2da83 100644 --- a/lapack-netlib/SRC/strsyl3.f +++ b/lapack-netlib/SRC/strsyl3.f @@ -1223,7 +1223,7 @@ * SCALOC = MIN( BIGNUM / SCAL, ONE / BUF ) BUF = BUF * SCALOC - CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK ) + CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) ) END IF * * Combine with buffer scaling factor. SCALE will be flushed if diff --git a/lapack-netlib/SRC/zgelqt3.f b/lapack-netlib/SRC/zgelqt3.f index 629a09472..1a71dc44e 100644 --- a/lapack-netlib/SRC/zgelqt3.f +++ b/lapack-netlib/SRC/zgelqt3.f @@ -174,7 +174,8 @@ * * Compute Householder transform when M=1 * - CALL ZLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T ) + CALL ZLARFG( N, A( 1, 1 ), A( 1, MIN( 2, N ) ), LDA, + & T( 1, 1 ) ) T(1,1)=CONJG(T(1,1)) * ELSE diff --git a/lapack-netlib/TESTING/EIG/cerrst.f b/lapack-netlib/TESTING/EIG/cerrst.f index ba97afbe5..1748a2aad 100644 --- a/lapack-netlib/TESTING/EIG/cerrst.f +++ b/lapack-netlib/TESTING/EIG/cerrst.f @@ -160,13 +160,13 @@ * SRNAMT = 'CHETD2' INFOT = 1 - CALL CHETD2( '/', 0, A, 1, D, E, TAU, W, 1, INFO ) + CALL CHETD2( '/', 0, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'CHETD2', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CHETD2( 'U', -1, A, 1, D, E, TAU, W, 1, INFO ) + CALL CHETD2( 'U', -1, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'CHETD2', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CHETD2( 'U', 2, A, 1, D, E, TAU, W, 1, INFO ) + CALL CHETD2( 'U', 2, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'CHETD2', INFOT, NOUT, LERR, OK ) NT = NT + 3 * diff --git a/lapack-netlib/TESTING/EIG/derrst.f b/lapack-netlib/TESTING/EIG/derrst.f index a55b6eea9..059538644 100644 --- a/lapack-netlib/TESTING/EIG/derrst.f +++ b/lapack-netlib/TESTING/EIG/derrst.f @@ -161,13 +161,13 @@ * SRNAMT = 'DSYTD2' INFOT = 1 - CALL DSYTD2( '/', 0, A, 1, D, E, TAU, W, 1, INFO ) + CALL DSYTD2( '/', 0, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'DSYTD2', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL DSYTD2( 'U', -1, A, 1, D, E, TAU, W, 1, INFO ) + CALL DSYTD2( 'U', -1, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'DSYTD2', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DSYTD2( 'U', 2, A, 1, D, E, TAU, W, 1, INFO ) + CALL DSYTD2( 'U', 2, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'DSYTD2', INFOT, NOUT, LERR, OK ) NT = NT + 3 * diff --git a/lapack-netlib/TESTING/EIG/serrst.f b/lapack-netlib/TESTING/EIG/serrst.f index 8c9c0f306..b87fc42ef 100644 --- a/lapack-netlib/TESTING/EIG/serrst.f +++ b/lapack-netlib/TESTING/EIG/serrst.f @@ -161,13 +161,13 @@ * SRNAMT = 'SSYTD2' INFOT = 1 - CALL SSYTD2( '/', 0, A, 1, D, E, TAU, W, 1, INFO ) + CALL SSYTD2( '/', 0, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'SSYTD2', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL SSYTD2( 'U', -1, A, 1, D, E, TAU, W, 1, INFO ) + CALL SSYTD2( 'U', -1, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'SSYTD2', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SSYTD2( 'U', 2, A, 1, D, E, TAU, W, 1, INFO ) + CALL SSYTD2( 'U', 2, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'SSYTD2', INFOT, NOUT, LERR, OK ) NT = NT + 3 * diff --git a/lapack-netlib/TESTING/EIG/zerrst.f b/lapack-netlib/TESTING/EIG/zerrst.f index 948f94bc2..d7b41c053 100644 --- a/lapack-netlib/TESTING/EIG/zerrst.f +++ b/lapack-netlib/TESTING/EIG/zerrst.f @@ -160,13 +160,13 @@ * SRNAMT = 'ZHETD2' INFOT = 1 - CALL ZHETD2( '/', 0, A, 1, D, E, TAU, W, 1, INFO ) + CALL ZHETD2( '/', 0, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'ZHETD2', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZHETD2( 'U', -1, A, 1, D, E, TAU, W, 1, INFO ) + CALL ZHETD2( 'U', -1, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'ZHETD2', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZHETD2( 'U', 2, A, 1, D, E, TAU, W, 1, INFO ) + CALL ZHETD2( 'U', 2, A, 1, D, E, TAU, INFO ) CALL CHKXER( 'ZHETD2', INFOT, NOUT, LERR, OK ) NT = NT + 3 * diff --git a/lapack-netlib/TESTING/LIN/cchktr.f b/lapack-netlib/TESTING/LIN/cchktr.f index 4b09361d8..2953a2bd5 100644 --- a/lapack-netlib/TESTING/LIN/cchktr.f +++ b/lapack-netlib/TESTING/LIN/cchktr.f @@ -201,7 +201,8 @@ * .. Local Arrays .. CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ), SCALE3( 2 ) + REAL RESULT( NTESTS ), RWORK2( 2*NMAX ), + $ SCALE3( 2 ) * .. * .. External Functions .. LOGICAL LSAME @@ -542,10 +543,10 @@ SRNAMT = 'CLATRS3' CALL CCOPY( N, X, 1, B, 1 ) CALL CCOPY( N, X, 1, B( N+1 ), 1 ) - CALL CSCAL( N, BIGNUM, B( N+1 ), 1 ) + CALL CSSCAL( N, BIGNUM, B( N+1 ), 1 ) CALL CLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA, - $ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX, - $ INFO ) + $ B, MAX(1, N), SCALE3, RWORK, RWORK2, + $ 2*NMAX, INFO ) * * Check error code from CLATRS3. * diff --git a/lapack-netlib/TESTING/LIN/cerrtr.f b/lapack-netlib/TESTING/LIN/cerrtr.f index 9ba784f62..ab83357f8 100644 --- a/lapack-netlib/TESTING/LIN/cerrtr.f +++ b/lapack-netlib/TESTING/LIN/cerrtr.f @@ -70,7 +70,7 @@ * .. Local Scalars .. CHARACTER*2 C2 INTEGER INFO - REAL RCOND, SCALE + REAL RCOND, SCALE, SCALES(0) * .. * .. Local Arrays .. REAL R1( NMAX ), R2( NMAX ), RW( NMAX ) @@ -245,40 +245,40 @@ * SRNAMT = 'CLATRS3' INFOT = 1 - CALL CLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL CLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 6 - CALL CLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 14 - CALL CLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 0, INFO ) + CALL CLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 0, INFO ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) * * Test error exits for the packed triangular routines. diff --git a/lapack-netlib/TESTING/LIN/derrtr.f b/lapack-netlib/TESTING/LIN/derrtr.f index d0580497d..878d9070c 100644 --- a/lapack-netlib/TESTING/LIN/derrtr.f +++ b/lapack-netlib/TESTING/LIN/derrtr.f @@ -71,7 +71,7 @@ * .. Local Scalars .. CHARACTER*2 C2 INTEGER INFO - DOUBLE PRECISION RCOND, SCALE + DOUBLE PRECISION RCOND, SCALE, SCALES(0) * .. * .. Local Arrays .. INTEGER IW( NMAX ) @@ -250,40 +250,40 @@ * SRNAMT = 'DLATRS3' INFOT = 1 - CALL DLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL DLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL DLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 6 - CALL DLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 14 - CALL DLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 0, INFO ) + CALL DLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 0, INFO ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) * ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN diff --git a/lapack-netlib/TESTING/LIN/serrtr.f b/lapack-netlib/TESTING/LIN/serrtr.f index af1ce0a8e..391b54c3f 100644 --- a/lapack-netlib/TESTING/LIN/serrtr.f +++ b/lapack-netlib/TESTING/LIN/serrtr.f @@ -71,7 +71,7 @@ * .. Local Scalars .. CHARACTER*2 C2 INTEGER INFO - REAL RCOND, SCALE + REAL RCOND, SCALE, SCALES(0) * .. * .. Local Arrays .. INTEGER IW( NMAX ) @@ -250,40 +250,40 @@ * SRNAMT = 'SLATRS3' INFOT = 1 - CALL SLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL SLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL SLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 6 - CALL SLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, W, - $ W( 2 ), 1, INFO ) + CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES, + $ W, W( 2 ), 1, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 14 - CALL SLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, W, - $ W( 2 ), 0, INFO ) + CALL SLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES, + $ W, W( 2 ), 0, INFO ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) * ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN diff --git a/lapack-netlib/TESTING/LIN/zchktr.f b/lapack-netlib/TESTING/LIN/zchktr.f index 275ca2857..4af538124 100644 --- a/lapack-netlib/TESTING/LIN/zchktr.f +++ b/lapack-netlib/TESTING/LIN/zchktr.f @@ -201,7 +201,8 @@ * .. Local Arrays .. CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ), SCALE3( 2 ) + DOUBLE PRECISION RESULT( NTESTS ), RWORK2( 2*NMAX), + $ SCALE3( 2 ) * .. * .. External Functions .. LOGICAL LSAME @@ -544,8 +545,8 @@ CALL ZCOPY( N, X, 1, B( N+1 ), 1 ) CALL ZDSCAL( N, BIGNUM, B( N+1 ), 1 ) CALL ZLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA, - $ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX, - $ INFO ) + $ B, MAX(1, N), SCALE3, RWORK, RWORK2, + $ 2*NMAX, INFO ) * * Check error code from ZLATRS3. * diff --git a/lapack-netlib/TESTING/LIN/zerrtr.f b/lapack-netlib/TESTING/LIN/zerrtr.f index 211b92154..640c39793 100644 --- a/lapack-netlib/TESTING/LIN/zerrtr.f +++ b/lapack-netlib/TESTING/LIN/zerrtr.f @@ -70,7 +70,7 @@ * .. Local Scalars .. CHARACTER*2 C2 INTEGER INFO - DOUBLE PRECISION RCOND, SCALE + DOUBLE PRECISION RCOND, SCALE, SCALES(0) * .. * .. Local Arrays .. DOUBLE PRECISION R1( NMAX ), R2( NMAX ), RW( NMAX ) @@ -245,40 +245,40 @@ * SRNAMT = 'ZLATRS3' INFOT = 1 - CALL ZLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL ZLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 6 - CALL ZLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, RW, - $ RW( 2 ), 1, INFO ) + CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES, + $ RW, RW( 2 ), 1, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) INFOT = 14 - CALL ZLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, RW, - $ RW( 2 ), 0, INFO ) + CALL ZLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES, + $ RW, RW( 2 ), 0, INFO ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) * * Test error exits for the packed triangular routines.