Add a BLAS3-based triangular Sylvester equation solver (Reference-LAPACK PR 651)
This commit is contained in:
Martin Kroeker
GitHub
parent
92174725d9
commit
13f3bbece1
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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, ''', ''',
|
||||
|
|
|
|||
|
|
@ -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
|
||||
*
|
||||
|
|
|
|||
|
|
@ -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, ''', ''',
|
||||
|
|
|
|||
|
|
@ -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
|
||||
*
|
||||
|
|
|
|||
|
|
@ -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, ''', ''',
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue