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

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

Browse Source
This commit is contained in:
Martin Kroeker
2022-11-13 23:18:09 +01:00
committed by GitHub
parent 92174725d9
commit 13f3bbece1
8 changed files with 358 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
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, ''', ''',