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 * 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)) T(1,1)=CONJG(T(1,1))
* *
ELSE ELSE

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

@ -173,7 +173,8 @@
* *
* Compute Householder transform when M=1 * 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 ELSE
* *

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

@ -261,6 +261,9 @@
DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS, DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
$ TMAX, TSCAL, USCAL, XBND, XJ, XMAX $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
* .. * ..
* .. Local Arrays ..
DOUBLE PRECISION WORK(1)
* ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER IDAMAX INTEGER IDAMAX
@ -362,7 +365,7 @@
* A is upper triangular. * A is upper triangular.
* *
DO J = 2, N 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 ) $ TMAX )
END DO END DO
ELSE ELSE
@ -371,7 +374,7 @@
* *
DO J = 1, N - 1 DO J = 1, N - 1
TMAX = MAX( DLANGE( 'M', N-J, 1, A( J+1, J ), 1, TMAX = MAX( DLANGE( 'M', N-J, 1, A( J+1, J ), 1,
$ SUMJ ), TMAX ) $ WORK ), TMAX )
END DO END DO
END IF END IF
* *

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

@ -1220,7 +1220,7 @@
* *
SCALOC = MIN( BIGNUM / SCAL, ONE / BUF ) SCALOC = MIN( BIGNUM / SCAL, ONE / BUF )
BUF = BUF * SCALOC 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 END IF
* *
* Combine with buffer scaling factor. SCALE will be flushed 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 * 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 ELSE
* *

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

@ -261,6 +261,9 @@
REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS, REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
$ TMAX, TSCAL, USCAL, XBND, XJ, XMAX $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
* .. * ..
* .. Local Arrays ..
REAL WORK (1)
* ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ISAMAX INTEGER ISAMAX
@ -362,7 +365,7 @@
* A is upper triangular. * A is upper triangular.
* *
DO J = 2, N 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 ) $ TMAX )
END DO END DO
ELSE ELSE
@ -371,7 +374,7 @@
* *
DO J = 1, N - 1 DO J = 1, N - 1
TMAX = MAX( SLANGE( 'M', N-J, 1, A( J+1, J ), 1, TMAX = MAX( SLANGE( 'M', N-J, 1, A( J+1, J ), 1,
$ SUMJ ), TMAX ) $ WORK ), TMAX )
END DO END DO
END IF END IF
* *

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

@ -1223,7 +1223,7 @@
* *
SCALOC = MIN( BIGNUM / SCAL, ONE / BUF ) SCALOC = MIN( BIGNUM / SCAL, ONE / BUF )
BUF = BUF * SCALOC 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 END IF
* *
* Combine with buffer scaling factor. SCALE will be flushed 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 * 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)) T(1,1)=CONJG(T(1,1))
* *
ELSE ELSE

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

@ -160,13 +160,13 @@
* *
SRNAMT = 'CHETD2' SRNAMT = 'CHETD2'
INFOT = 1 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 ) CALL CHKXER( 'CHETD2', INFOT, NOUT, LERR, OK )
INFOT = 2 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 ) CALL CHKXER( 'CHETD2', INFOT, NOUT, LERR, OK )
INFOT = 4 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 ) CALL CHKXER( 'CHETD2', INFOT, NOUT, LERR, OK )
NT = NT + 3 NT = NT + 3
* *

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

@ -161,13 +161,13 @@
* *
SRNAMT = 'DSYTD2' SRNAMT = 'DSYTD2'
INFOT = 1 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 ) CALL CHKXER( 'DSYTD2', INFOT, NOUT, LERR, OK )
INFOT = 2 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 ) CALL CHKXER( 'DSYTD2', INFOT, NOUT, LERR, OK )
INFOT = 4 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 ) CALL CHKXER( 'DSYTD2', INFOT, NOUT, LERR, OK )
NT = NT + 3 NT = NT + 3
* *

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

@ -161,13 +161,13 @@
* *
SRNAMT = 'SSYTD2' SRNAMT = 'SSYTD2'
INFOT = 1 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 ) CALL CHKXER( 'SSYTD2', INFOT, NOUT, LERR, OK )
INFOT = 2 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 ) CALL CHKXER( 'SSYTD2', INFOT, NOUT, LERR, OK )
INFOT = 4 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 ) CALL CHKXER( 'SSYTD2', INFOT, NOUT, LERR, OK )
NT = NT + 3 NT = NT + 3
* *

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

@ -160,13 +160,13 @@
* *
SRNAMT = 'ZHETD2' SRNAMT = 'ZHETD2'
INFOT = 1 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 ) CALL CHKXER( 'ZHETD2', INFOT, NOUT, LERR, OK )
INFOT = 2 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 ) CALL CHKXER( 'ZHETD2', INFOT, NOUT, LERR, OK )
INFOT = 4 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 ) CALL CHKXER( 'ZHETD2', INFOT, NOUT, LERR, OK )
NT = NT + 3 NT = NT + 3
* *

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

@ -201,7 +201,8 @@
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
INTEGER ISEED( 4 ), ISEEDY( 4 ) INTEGER ISEED( 4 ), ISEEDY( 4 )
REAL RESULT( NTESTS ), SCALE3( 2 ) REAL RESULT( NTESTS ), RWORK2( 2*NMAX ),
$ SCALE3( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -542,10 +543,10 @@
SRNAMT = 'CLATRS3' SRNAMT = 'CLATRS3'
CALL CCOPY( N, X, 1, B, 1 ) CALL CCOPY( N, X, 1, B, 1 )
CALL CCOPY( N, X, 1, B( N+1 ), 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, CALL CLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA,
$ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX, $ B, MAX(1, N), SCALE3, RWORK, RWORK2,
$ INFO ) $ 2*NMAX, INFO )
* *
* Check error code from CLATRS3. * Check error code from CLATRS3.
* *

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

@ -70,7 +70,7 @@
* .. Local Scalars .. * .. Local Scalars ..
CHARACTER*2 C2 CHARACTER*2 C2
INTEGER INFO INTEGER INFO
REAL RCOND, SCALE REAL RCOND, SCALE, SCALES(0)
* .. * ..
* .. Local Arrays .. * .. Local Arrays ..
REAL R1( NMAX ), R2( NMAX ), RW( NMAX ) REAL R1( NMAX ), R2( NMAX ), RW( NMAX )
@ -245,40 +245,40 @@
* *
SRNAMT = 'CLATRS3' SRNAMT = 'CLATRS3'
INFOT = 1 INFOT = 1
CALL CLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, CALL CLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 2 INFOT = 2
CALL CLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, CALL CLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 3 INFOT = 3
CALL CLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, RW, CALL CLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 4 INFOT = 4
CALL CLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, RW, CALL CLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 5 INFOT = 5
CALL CLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, RW, CALL CLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 6 INFOT = 6
CALL CLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, RW, CALL CLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 8 INFOT = 8
CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, RW, CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 10 INFOT = 10
CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, RW, CALL CLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 14 INFOT = 14
CALL CLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, RW, CALL CLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 0, INFO ) $ RW, RW( 2 ), 0, INFO )
CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
* *
* Test error exits for the packed triangular routines. * Test error exits for the packed triangular routines.

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

@ -71,7 +71,7 @@
* .. Local Scalars .. * .. Local Scalars ..
CHARACTER*2 C2 CHARACTER*2 C2
INTEGER INFO INTEGER INFO
DOUBLE PRECISION RCOND, SCALE DOUBLE PRECISION RCOND, SCALE, SCALES(0)
* .. * ..
* .. Local Arrays .. * .. Local Arrays ..
INTEGER IW( NMAX ) INTEGER IW( NMAX )
@ -250,40 +250,40 @@
* *
SRNAMT = 'DLATRS3' SRNAMT = 'DLATRS3'
INFOT = 1 INFOT = 1
CALL DLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, CALL DLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 2 INFOT = 2
CALL DLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, CALL DLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 3 INFOT = 3
CALL DLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, W, CALL DLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 4 INFOT = 4
CALL DLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, W, CALL DLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 5 INFOT = 5
CALL DLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, W, CALL DLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 6 INFOT = 6
CALL DLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, W, CALL DLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 8 INFOT = 8
CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, W, CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 10 INFOT = 10
CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, W, CALL DLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 14 INFOT = 14
CALL DLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, W, CALL DLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 0, INFO ) $ W, W( 2 ), 0, INFO )
CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
* *
ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN

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

@ -71,7 +71,7 @@
* .. Local Scalars .. * .. Local Scalars ..
CHARACTER*2 C2 CHARACTER*2 C2
INTEGER INFO INTEGER INFO
REAL RCOND, SCALE REAL RCOND, SCALE, SCALES(0)
* .. * ..
* .. Local Arrays .. * .. Local Arrays ..
INTEGER IW( NMAX ) INTEGER IW( NMAX )
@ -250,40 +250,40 @@
* *
SRNAMT = 'SLATRS3' SRNAMT = 'SLATRS3'
INFOT = 1 INFOT = 1
CALL SLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, CALL SLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 2 INFOT = 2
CALL SLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, W, CALL SLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 3 INFOT = 3
CALL SLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, W, CALL SLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 4 INFOT = 4
CALL SLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, W, CALL SLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 5 INFOT = 5
CALL SLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, W, CALL SLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 6 INFOT = 6
CALL SLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, W, CALL SLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 8 INFOT = 8
CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, W, CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 10 INFOT = 10
CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, W, CALL SLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES,
$ W( 2 ), 1, INFO ) $ W, W( 2 ), 1, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 14 INFOT = 14
CALL SLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, W, CALL SLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES,
$ W( 2 ), 0, INFO ) $ W, W( 2 ), 0, INFO )
CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
* *
ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN

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

@ -201,7 +201,8 @@
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
INTEGER ISEED( 4 ), ISEEDY( 4 ) INTEGER ISEED( 4 ), ISEEDY( 4 )
DOUBLE PRECISION RESULT( NTESTS ), SCALE3( 2 ) DOUBLE PRECISION RESULT( NTESTS ), RWORK2( 2*NMAX),
$ SCALE3( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
@ -544,8 +545,8 @@
CALL ZCOPY( N, X, 1, B( N+1 ), 1 ) CALL ZCOPY( N, X, 1, B( N+1 ), 1 )
CALL ZDSCAL( N, BIGNUM, B( N+1 ), 1 ) CALL ZDSCAL( N, BIGNUM, B( N+1 ), 1 )
CALL ZLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA, CALL ZLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA,
$ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX, $ B, MAX(1, N), SCALE3, RWORK, RWORK2,
$ INFO ) $ 2*NMAX, INFO )
* *
* Check error code from ZLATRS3. * Check error code from ZLATRS3.
* *

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

@ -70,7 +70,7 @@
* .. Local Scalars .. * .. Local Scalars ..
CHARACTER*2 C2 CHARACTER*2 C2
INTEGER INFO INTEGER INFO
DOUBLE PRECISION RCOND, SCALE DOUBLE PRECISION RCOND, SCALE, SCALES(0)
* .. * ..
* .. Local Arrays .. * .. Local Arrays ..
DOUBLE PRECISION R1( NMAX ), R2( NMAX ), RW( NMAX ) DOUBLE PRECISION R1( NMAX ), R2( NMAX ), RW( NMAX )
@ -245,40 +245,40 @@
* *
SRNAMT = 'ZLATRS3' SRNAMT = 'ZLATRS3'
INFOT = 1 INFOT = 1
CALL ZLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 2 INFOT = 2
CALL ZLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( 'U', '/', 'N', 'N', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 3 INFOT = 3
CALL ZLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( 'U', 'N', '/', 'N', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 4 INFOT = 4
CALL ZLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( 'U', 'N', 'N', '/', 0, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 5 INFOT = 5
CALL ZLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 6 INFOT = 6
CALL ZLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( 'U', 'N', 'N', 'N', 0, -1, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 8 INFOT = 8
CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 10 INFOT = 10
CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALE, RW, CALL ZLATRS3( 'U', 'N', 'N', 'N', 2, 0, A, 2, X, 1, SCALES,
$ RW( 2 ), 1, INFO ) $ RW, RW( 2 ), 1, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
INFOT = 14 INFOT = 14
CALL ZLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALE, RW, CALL ZLATRS3( 'U', 'N', 'N', 'N', 1, 0, A, 1, X, 1, SCALES,
$ RW( 2 ), 0, INFO ) $ RW, RW( 2 ), 0, INFO )
CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
* *
* Test error exits for the packed triangular routines. * Test error exits for the packed triangular routines.