OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
Browse Source

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

* Fix actual arguments (Reference-LAPACK PR 885)
tags/v0.3.24
Martin Kroeker GitHub 2 years ago
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
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +2
    -1
      lapack-netlib/SRC/cgelqt3.f
  2. +2
    -1
      lapack-netlib/SRC/dgelqt3.f
  3. +5
    -2
      lapack-netlib/SRC/dlatrs.f
  4. +1
    -1
      lapack-netlib/SRC/dtrsyl3.f
  5. +2
    -1
      lapack-netlib/SRC/sgelqt3.f
  6. +5
    -2
      lapack-netlib/SRC/slatrs.f
  7. +1
    -1
      lapack-netlib/SRC/strsyl3.f
  8. +2
    -1
      lapack-netlib/SRC/zgelqt3.f
  9. +3
    -3
      lapack-netlib/TESTING/EIG/cerrst.f
  10. +3
    -3
      lapack-netlib/TESTING/EIG/derrst.f
  11. +3
    -3
      lapack-netlib/TESTING/EIG/serrst.f
  12. +3
    -3
      lapack-netlib/TESTING/EIG/zerrst.f
  13. +5
    -4
      lapack-netlib/TESTING/LIN/cchktr.f
  14. +19
    -19
      lapack-netlib/TESTING/LIN/cerrtr.f
  15. +19
    -19
      lapack-netlib/TESTING/LIN/derrtr.f
  16. +19
    -19
      lapack-netlib/TESTING/LIN/serrtr.f
  17. +4
    -3
      lapack-netlib/TESTING/LIN/zchktr.f
  18. +19
    -19
      lapack-netlib/TESTING/LIN/zerrtr.f

+ 2
- 1
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


+ 2
- 1
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
*


+ 5
- 2
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
*


+ 1
- 1
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


+ 2
- 1
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
*


+ 5
- 2
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
*


+ 1
- 1
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


+ 2
- 1
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


+ 3
- 3
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
*


+ 3
- 3
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
*


+ 3
- 3
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
*


+ 3
- 3
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
*


+ 5
- 4
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.
*


+ 19
- 19
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.


+ 19
- 19
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


+ 19
- 19
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


+ 4
- 3
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.
*


+ 19
- 19
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.


Write Preview
Loading…
Cancel
Save