floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix actual arguments in some LAPACK procedure calls (Reference-LAPACK PR 885) (#4155) 

* Fix actual arguments (Reference-LAPACK PR 885)
This commit is contained in:
Martin Kroeker 2023-07-22 23:14:25 +02:00 committed by GitHub
parent bd01dc354b
commit 25037ae875
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
18 changed files with 117 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lapack-netlib/SRC/cgelqt3.f
View File

@ -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

3
lapack-netlib/SRC/dgelqt3.f
View File

@ -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
*

7
lapack-netlib/SRC/dlatrs.f
View File

@ -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
*

2
lapack-netlib/SRC/dtrsyl3.f
View File

@ -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

3
lapack-netlib/SRC/sgelqt3.f
View File

@ -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
*

7
lapack-netlib/SRC/slatrs.f
View File

@ -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
*

2
lapack-netlib/SRC/strsyl3.f
View File

@ -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

3
lapack-netlib/SRC/zgelqt3.f
View File

@ -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

6
lapack-netlib/TESTING/EIG/cerrst.f
View File

@ -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
*

6
lapack-netlib/TESTING/EIG/derrst.f
View File

@ -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
*

6
lapack-netlib/TESTING/EIG/serrst.f
View File

@ -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
*

6
lapack-netlib/TESTING/EIG/zerrst.f
View File

@ -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
*

9
lapack-netlib/TESTING/LIN/cchktr.f
View File

@ -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.
*

38
lapack-netlib/TESTING/LIN/cerrtr.f
View File

@ -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.

38
lapack-netlib/TESTING/LIN/derrtr.f
View File

@ -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

38
lapack-netlib/TESTING/LIN/serrtr.f
View File

@ -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

7
lapack-netlib/TESTING/LIN/zchktr.f
View File

@ -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.
*

38
lapack-netlib/TESTING/LIN/zerrtr.f
View File

@ -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.