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

Add a BLAS3-based triangular Sylvester equation solver (Reference-LAPACK PR 651)

tags/v0.3.22^2
Martin Kroeker GitHub 3 years ago
parent
92174725d9
commit
13f3bbece1
No known key found for this signature in database GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 358 additions and 57 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +44
    -10
      lapack-netlib/TESTING/LIN/cchktr.f
  2. +44
    -3
      lapack-netlib/TESTING/LIN/cerrtr.f
  3. +45
    -11
      lapack-netlib/TESTING/LIN/dchktr.f
  4. +44
    -3
      lapack-netlib/TESTING/LIN/derrtr.f
  5. +46
    -11
      lapack-netlib/TESTING/LIN/schktr.f
  6. +44
    -3
      lapack-netlib/TESTING/LIN/serrtr.f
  7. +47
    -13
      lapack-netlib/TESTING/LIN/zchktr.f
  8. +44
    -3
      lapack-netlib/TESTING/LIN/zerrtr.f

+ 44
- 10
lapack-netlib/TESTING/LIN/cchktr.f View File

@@ -31,7 +31,7 @@
*>
*> \verbatim
*>
*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS
*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS(3)
*> \endverbatim
*
* Arguments:
@@ -184,7 +184,7 @@
INTEGER NTYPE1, NTYPES
PARAMETER ( NTYPE1 = 10, NTYPES = 18 )
INTEGER NTESTS
PARAMETER ( NTESTS = 9 )
PARAMETER ( NTESTS = 10 )
INTEGER NTRAN
PARAMETER ( NTRAN = 3 )
REAL ONE, ZERO
@@ -195,13 +195,13 @@
CHARACTER*3 PATH
INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
$ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN
REAL AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
$ RCONDO, SCALE
REAL AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC,
$ RCONDI, RCONDO, RES, SCALE, SLAMCH
* ..
* .. Local Arrays ..
CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
INTEGER ISEED( 4 ), ISEEDY( 4 )
REAL RESULT( NTESTS )
REAL RESULT( NTESTS ), SCALE3( 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -210,9 +210,9 @@
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRTR, CGET04,
$ CLACPY, CLARHS, CLATRS, CLATTR, CTRCON, CTRRFS,
$ CTRT01, CTRT02, CTRT03, CTRT05, CTRT06, CTRTRI,
$ CTRTRS, XLAENV
$ CLACPY, CLARHS, CLATRS, CLATRS3, CLATTR,
$ CSSCAL, CTRCON, CTRRFS, CTRT01, CTRT02, CTRT03,
$ CTRT05, CTRT06, CTRTRI, CTRTRS, XLAENV, SLAMCH
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -236,6 +236,7 @@
*
PATH( 1: 1 ) = 'Complex precision'
PATH( 2: 3 ) = 'TR'
BIGNUM = SLAMCH('Overflow') / SLAMCH('Precision')
NRUN = 0
NFAIL = 0
NERRS = 0
@@ -380,7 +381,7 @@
* This line is needed on a Sun SPARCstation.
*
IF( N.GT.0 )
$ DUMMY = A( 1 )
$ DUMMY = REAL( A( 1 ) )
*
CALL CTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA,
$ X, LDA, B, LDA, WORK, RWORK,
@@ -535,6 +536,32 @@
$ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
$ RESULT( 9 ) )
*
*+ TEST 10
* Solve op(A)*X = B.
*
SRNAMT = 'CLATRS3'
CALL CCOPY( N, X, 1, B, 1 )
CALL CCOPY( N, X, 1, B, 1 )
CALL CSCAL( 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 )
*
* Check error code from CLATRS3.
*
IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'CLATRS3', INFO, 0,
$ UPLO // TRANS // DIAG // 'Y', N, N,
$ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
CALL CTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3( 1 ), RWORK, ONE, B( 1 ), LDA,
$ X, LDA, WORK, RESULT( 10 ) )
CALL CSSCAL( N, BIGNUM, X, 1 )
CALL CTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA,
$ X, LDA, WORK, RESULT( 10 ) )
RESULT( 10 ) = MAX( RESULT( 10 ), RES )
*
* Print information about the tests that did not pass
* the threshold.
*
@@ -552,7 +579,14 @@
$ DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 2
IF( RESULT( 10 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )'CLATRS3', UPLO, TRANS,
$ DIAG, 'N', N, IMAT, 10, RESULT( 10 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 3
90 CONTINUE
100 CONTINUE
110 CONTINUE


+ 44
- 3
lapack-netlib/TESTING/LIN/cerrtr.f View File

@@ -82,9 +82,10 @@
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, CLATBS, CLATPS, CLATRS, CTBCON,
$ CTBRFS, CTBTRS, CTPCON, CTPRFS, CTPTRI, CTPTRS,
$ CTRCON, CTRRFS, CTRTI2, CTRTRI, CTRTRS
EXTERNAL ALAESM, CHKXER, CLATBS, CLATPS, CLATRS,
$ CLATRS3, CTBCON, CTBRFS, CTBTRS, CTPCON,
$ CTPRFS, CTPTRI, CTPTRS, CTRCON, CTRRFS, CTRTI2,
$ CTRTRI, CTRTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -240,6 +241,46 @@
CALL CLATRS( 'U', 'N', 'N', 'N', 2, A, 1, X, SCALE, RW, INFO )
CALL CHKXER( 'CLATRS', INFOT, NOUT, LERR, OK )
*
* CLATRS3
*
SRNAMT = 'CLATRS3'
INFOT = 1
CALL CLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, 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 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 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 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 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 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 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 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 CHKXER( 'CLATRS3', INFOT, NOUT, LERR, OK )
*
* Test error exits for the packed triangular routines.
*
ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN


+ 45
- 11
lapack-netlib/TESTING/LIN/dchktr.f View File

@@ -30,7 +30,7 @@
*>
*> \verbatim
*>
*> DCHKTR tests DTRTRI, -TRS, -RFS, and -CON, and DLATRS
*> DCHKTR tests DTRTRI, -TRS, -RFS, and -CON, and DLATRS(3)
*> \endverbatim
*
* Arguments:
@@ -187,7 +187,7 @@
INTEGER NTYPE1, NTYPES
PARAMETER ( NTYPE1 = 10, NTYPES = 18 )
INTEGER NTESTS
PARAMETER ( NTESTS = 9 )
PARAMETER ( NTESTS = 10 )
INTEGER NTRAN
PARAMETER ( NTRAN = 3 )
DOUBLE PRECISION ONE, ZERO
@@ -198,13 +198,13 @@
CHARACTER*3 PATH
INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
$ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN
DOUBLE PRECISION AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
$ RCONDO, SCALE
DOUBLE PRECISION AINVNM, ANORM, BIGNUM, DLAMCH, DUMMY, RCOND,
$ RCONDC, RCONDI, RCONDO, RES, SCALE
* ..
* .. Local Arrays ..
CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
INTEGER ISEED( 4 ), ISEEDY( 4 )
DOUBLE PRECISION RESULT( NTESTS )
DOUBLE PRECISION RESULT( NTESTS ), SCALE3( 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -213,9 +213,9 @@
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, DCOPY, DERRTR, DGET04,
$ DLACPY, DLARHS, DLATRS, DLATTR, DTRCON, DTRRFS,
$ DTRT01, DTRT02, DTRT03, DTRT05, DTRT06, DTRTRI,
$ DTRTRS, XLAENV
$ DLACPY, DLAMCH, DSCAL, DLARHS, DLATRS, DLATRS3,
$ DLATTR, DTRCON, DTRRFS, DTRT01, DTRT02, DTRT03,
$ DTRT05, DTRT06, DTRTRI, DTRTRS, XLAENV
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -239,6 +239,7 @@
*
PATH( 1: 1 ) = 'Double precision'
PATH( 2: 3 ) = 'TR'
BIGNUM = DLAMCH('Overflow') / DLAMCH('Precision')
NRUN = 0
NFAIL = 0
NERRS = 0
@@ -539,6 +540,32 @@
$ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
$ RESULT( 9 ) )
*
*+ TEST 10
* Solve op(A)*X = B
*
SRNAMT = 'DLATRS3'
CALL DCOPY( N, X, 1, B, 1 )
CALL DCOPY( N, X, 1, B( N+1 ), 1 )
CALL DSCAL( N, BIGNUM, B( N+1 ), 1 )
CALL DLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA,
$ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX,
$ INFO )
*
* Check error code from DLATRS3.
*
IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'DLATRS3', INFO, 0,
$ UPLO // TRANS // DIAG // 'N', N, N,
$ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
CALL DTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3( 1 ), RWORK, ONE, B( 1 ), LDA,
$ X, LDA, WORK, RESULT( 10 ) )
CALL DSCAL( N, BIGNUM, X, 1 )
CALL DTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA,
$ X, LDA, WORK, RES )
RESULT( 10 ) = MAX( RESULT( 10 ), RES )
*
* Print information about the tests that did not pass
* the threshold.
*
@@ -556,7 +583,14 @@
$ DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 2
IF( RESULT( 10 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )'DLATRS3', UPLO, TRANS,
$ DIAG, 'N', N, IMAT, 10, RESULT( 10 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 3
90 CONTINUE
100 CONTINUE
110 CONTINUE
@@ -569,8 +603,8 @@
9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, ', NB=',
$ I4, ', type ', I2, ', test(', I2, ')= ', G12.5 )
9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1,
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ',
$ test(', I2, ')= ', G12.5 )
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ', test(',
$ I2, ')= ', G12.5 )
9997 FORMAT( ' NORM=''', A1, ''', UPLO =''', A1, ''', N=', I5, ',',
$ 11X, ' type ', I2, ', test(', I2, ')=', G12.5 )
9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''',


+ 44
- 3
lapack-netlib/TESTING/LIN/derrtr.f View File

@@ -83,9 +83,10 @@
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, DLATBS, DLATPS, DLATRS, DTBCON,
$ DTBRFS, DTBTRS, DTPCON, DTPRFS, DTPTRI, DTPTRS,
$ DTRCON, DTRRFS, DTRTI2, DTRTRI, DTRTRS
EXTERNAL ALAESM, CHKXER, DLATBS, DLATPS, DLATRS,
$ DLATRS3, DTBCON, DTBRFS, DTBTRS, DTPCON,
$ DTPRFS, DTPTRI, DTPTRS, DTRCON, DTRRFS,
$ DTRTI2, DTRTRI, DTRTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -244,6 +245,46 @@
INFOT = 7
CALL DLATRS( 'U', 'N', 'N', 'N', 2, A, 1, X, SCALE, W, INFO )
CALL CHKXER( 'DLATRS', INFOT, NOUT, LERR, OK )
*
* DLATRS3
*
SRNAMT = 'DLATRS3'
INFOT = 1
CALL DLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, 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 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 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 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 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 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 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 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 CHKXER( 'DLATRS3', INFOT, NOUT, LERR, OK )
*
ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN
*


+ 46
- 11
lapack-netlib/TESTING/LIN/schktr.f View File

@@ -30,7 +30,7 @@
*>
*> \verbatim
*>
*> SCHKTR tests STRTRI, -TRS, -RFS, and -CON, and SLATRS
*> SCHKTR tests STRTRI, -TRS, -RFS, and -CON, and SLATRS(3)
*> \endverbatim
*
* Arguments:
@@ -187,7 +187,7 @@
INTEGER NTYPE1, NTYPES
PARAMETER ( NTYPE1 = 10, NTYPES = 18 )
INTEGER NTESTS
PARAMETER ( NTESTS = 9 )
PARAMETER ( NTESTS = 10 )
INTEGER NTRAN
PARAMETER ( NTRAN = 3 )
REAL ONE, ZERO
@@ -198,13 +198,13 @@
CHARACTER*3 PATH
INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
$ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN
REAL AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
$ RCONDO, SCALE
REAL AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC,
$ RCONDI, RCONDO, RES, SCALE, SLAMCH
* ..
* .. Local Arrays ..
CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
INTEGER ISEED( 4 ), ISEEDY( 4 )
REAL RESULT( NTESTS )
REAL RESULT( NTESTS ), SCALE3( 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -213,9 +213,9 @@
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, SCOPY, SERRTR, SGET04,
$ SLACPY, SLARHS, SLATRS, SLATTR, STRCON, STRRFS,
$ STRT01, STRT02, STRT03, STRT05, STRT06, STRTRI,
$ STRTRS, XLAENV
$ SLACPY, SLARHS, SLATRS, SLATRS3, SLATTR, SSCAL,
$ STRCON, STRRFS, STRT01, STRT02, STRT03, STRT05,
$ STRT06, STRTRI, STRTRS, XLAENV, SLAMCH
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -239,6 +239,7 @@
*
PATH( 1: 1 ) = 'Single precision'
PATH( 2: 3 ) = 'TR'
BIGNUM = SLAMCH('Overflow') / SLAMCH('Precision')
NRUN = 0
NFAIL = 0
NERRS = 0
@@ -539,6 +540,33 @@
$ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
$ RESULT( 9 ) )
*
*+ TEST 10
* Solve op(A)*X = B
*
SRNAMT = 'SLATRS3'
CALL SCOPY( N, X, 1, B, 1 )
CALL SCOPY( N, X, 1, B( N+1 ), 1 )
CALL SSCAL( N, BIGNUM, B( N+1 ), 1 )
CALL SLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA,
$ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX,
$ INFO )
*
* Check error code from SLATRS3.
*
IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'SLATRS3', INFO, 0,
$ UPLO // TRANS // DIAG // 'Y', N, N,
$ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
*
CALL STRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3 ( 1 ), RWORK, ONE, B( N+1 ), LDA,
$ X, LDA, WORK, RESULT( 10 ) )
CALL SSCAL( N, BIGNUM, X, 1 )
CALL STRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA,
$ X, LDA, WORK, RES )
RESULT( 10 ) = MAX( RESULT( 10 ), RES )
*
* Print information about the tests that did not pass
* the threshold.
*
@@ -556,7 +584,14 @@
$ DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 2
IF( RESULT( 10 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )'SLATRS3', UPLO, TRANS,
$ DIAG, 'N', N, IMAT, 10, RESULT( 10 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 3
90 CONTINUE
100 CONTINUE
110 CONTINUE
@@ -569,8 +604,8 @@
9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, ', NB=',
$ I4, ', type ', I2, ', test(', I2, ')= ', G12.5 )
9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1,
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ',
$ test(', I2, ')= ', G12.5 )
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ', test(',
$ I2, ')= ', G12.5 )
9997 FORMAT( ' NORM=''', A1, ''', UPLO =''', A1, ''', N=', I5, ',',
$ 11X, ' type ', I2, ', test(', I2, ')=', G12.5 )
9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''',


+ 44
- 3
lapack-netlib/TESTING/LIN/serrtr.f View File

@@ -83,9 +83,10 @@
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, SLATBS, SLATPS, SLATRS, STBCON,
$ STBRFS, STBTRS, STPCON, STPRFS, STPTRI, STPTRS,
$ STRCON, STRRFS, STRTI2, STRTRI, STRTRS
EXTERNAL ALAESM, CHKXER, SLATBS, SLATPS, SLATRS,
$ SLATRS3, STBCON, STBRFS, STBTRS, STPCON,
$ STPRFS, STPTRI, STPTRS, STRCON, STRRFS, STRTI2,
$ STRTRI, STRTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -244,6 +245,46 @@
INFOT = 7
CALL SLATRS( 'U', 'N', 'N', 'N', 2, A, 1, X, SCALE, W, INFO )
CALL CHKXER( 'SLATRS', INFOT, NOUT, LERR, OK )
*
* SLATRS3
*
SRNAMT = 'SLATRS3'
INFOT = 1
CALL SLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, 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 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 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 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 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 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 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 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 CHKXER( 'SLATRS3', INFOT, NOUT, LERR, OK )
*
ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN
*


+ 47
- 13
lapack-netlib/TESTING/LIN/zchktr.f View File

@@ -31,7 +31,7 @@
*>
*> \verbatim
*>
*> ZCHKTR tests ZTRTRI, -TRS, -RFS, and -CON, and ZLATRS
*> ZCHKTR tests ZTRTRI, -TRS, -RFS, and -CON, and ZLATRS(3)
*> \endverbatim
*
* Arguments:
@@ -184,7 +184,7 @@
INTEGER NTYPE1, NTYPES
PARAMETER ( NTYPE1 = 10, NTYPES = 18 )
INTEGER NTESTS
PARAMETER ( NTESTS = 9 )
PARAMETER ( NTESTS = 10 )
INTEGER NTRAN
PARAMETER ( NTRAN = 3 )
DOUBLE PRECISION ONE, ZERO
@@ -195,13 +195,13 @@
CHARACTER*3 PATH
INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
$ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN
DOUBLE PRECISION AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
$ RCONDO, SCALE
DOUBLE PRECISION AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC,
$ RCONDI, RCONDO, RES, SCALE, DLAMCH
* ..
* .. Local Arrays ..
CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
INTEGER ISEED( 4 ), ISEEDY( 4 )
DOUBLE PRECISION RESULT( NTESTS )
DOUBLE PRECISION RESULT( NTESTS ), SCALE3( 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -209,10 +209,10 @@
EXTERNAL LSAME, ZLANTR
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZCOPY, ZERRTR,
$ ZGET04, ZLACPY, ZLARHS, ZLATRS, ZLATTR, ZTRCON,
$ ZTRRFS, ZTRT01, ZTRT02, ZTRT03, ZTRT05, ZTRT06,
$ ZTRTRI, ZTRTRS
EXTERNAL ALAERH, ALAHD, ALASUM, DLAMCH, XLAENV, ZCOPY,
$ ZDSCAL, ZERRTR, ZGET04, ZLACPY, ZLARHS, ZLATRS,
$ ZLATRS3, ZLATTR, ZTRCON, ZTRRFS, ZTRT01,
$ ZTRT02, ZTRT03, ZTRT05, ZTRT06, ZTRTRI, ZTRTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -236,6 +236,7 @@
*
PATH( 1: 1 ) = 'Zomplex precision'
PATH( 2: 3 ) = 'TR'
BIGNUM = DLAMCH('Overflow') / DLAMCH('Precision')
NRUN = 0
NFAIL = 0
NERRS = 0
@@ -380,7 +381,7 @@
* This line is needed on a Sun SPARCstation.
*
IF( N.GT.0 )
$ DUMMY = A( 1 )
$ DUMMY = DBLE( A( 1 ) )
*
CALL ZTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA,
$ X, LDA, B, LDA, WORK, RWORK,
@@ -535,6 +536,32 @@
$ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
$ RESULT( 9 ) )
*
*+ TEST 10
* Solve op(A)*X = B
*
SRNAMT = 'ZLATRS3'
CALL ZCOPY( N, X, 1, B, 1 )
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 )
*
* Check error code from ZLATRS3.
*
IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'ZLATRS3', INFO, 0,
$ UPLO // TRANS // DIAG // 'N', N, N,
$ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3( 1 ), RWORK, ONE, B( 1 ), LDA,
$ X, LDA, WORK, RESULT( 10 ) )
CALL ZDSCAL( N, BIGNUM, X, 1 )
CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
$ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA,
$ X, LDA, WORK, RES )
RESULT( 10 ) = MAX( RESULT( 10 ), RES )
*
* Print information about the tests that did not pass
* the threshold.
*
@@ -552,7 +579,14 @@
$ DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 2
IF( RESULT( 10 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )'ZLATRS3', UPLO, TRANS,
$ DIAG, 'N', N, IMAT, 10, RESULT( 10 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 3
90 CONTINUE
100 CONTINUE
110 CONTINUE
@@ -565,8 +599,8 @@
9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, ', NB=',
$ I4, ', type ', I2, ', test(', I2, ')= ', G12.5 )
9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1,
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ',
$ test(', I2, ')= ', G12.5 )
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ', test(',
$ I2, ')= ', G12.5 )
9997 FORMAT( ' NORM=''', A1, ''', UPLO =''', A1, ''', N=', I5, ',',
$ 11X, ' type ', I2, ', test(', I2, ')=', G12.5 )
9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''',


+ 44
- 3
lapack-netlib/TESTING/LIN/zerrtr.f View File

@@ -82,9 +82,10 @@
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, ZLATBS, ZLATPS, ZLATRS, ZTBCON,
$ ZTBRFS, ZTBTRS, ZTPCON, ZTPRFS, ZTPTRI, ZTPTRS,
$ ZTRCON, ZTRRFS, ZTRTI2, ZTRTRI, ZTRTRS
EXTERNAL ALAESM, CHKXER, ZLATBS, ZLATPS, ZLATRS,
$ ZLATRS3, ZTBCON, ZTBRFS, ZTBTRS, ZTPCON,
$ ZTPRFS, ZTPTRI, ZTPTRS, ZTRCON, ZTRRFS, ZTRTI2,
$ ZTRTRI, ZTRTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
@@ -240,6 +241,46 @@
CALL ZLATRS( 'U', 'N', 'N', 'N', 2, A, 1, X, SCALE, RW, INFO )
CALL CHKXER( 'ZLATRS', INFOT, NOUT, LERR, OK )
*
* ZLATRS3
*
SRNAMT = 'ZLATRS3'
INFOT = 1
CALL ZLATRS3( '/', 'N', 'N', 'N', 0, 0, A, 1, X, 1, SCALE, 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 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 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 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 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 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 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 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 CHKXER( 'ZLATRS3', INFOT, NOUT, LERR, OK )
*
* Test error exits for the packed triangular routines.
*
ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN


Write Preview
Loading…
Cancel
Save