Skip to content

Add level-3 BLAS triangular Sylvester equation solver #651

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 8 commits into from
Oct 6, 2022
Merged

Add level-3 BLAS triangular Sylvester equation solver #651

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
cda8a83
Add level-3 BLAS triangular Sylvester equation solver
angsch Feb 19, 2022
833cd58
Test [sd]trsyl3
angsch Aug 2, 2022
46275f0
LAPACKE interface of [sd]trsyl3
angsch Jul 17, 2022
079c185
Add ztrsyl3 and corresponding tests
angsch Jul 22, 2022
05f9e54
Add ctrsyl3 and corresponding tests
angsch Jul 30, 2022
8f44109
LAPACKE interface of [cz]trsyl3
angsch Jul 26, 2022
1c1263e
Use unblocked code if insufficient workspace is provided
angsch Aug 21, 2022
970a772
Add BLAS-3 robust triangular solver T*X = B*diag(s1, ..., sN)
angsch Sep 4, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Test [sd]trsyl3
  • Loading branch information
@angsch
angsch committed Sep 14, 2022
commit 833cd585b59cfca09da4abf75442be7632404ae6
2 changes: 1 addition & 1 deletion TESTING/EIG/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ set(SEIGTST schkee.F
sget54.f sglmts.f sgqrts.f sgrqts.f sgsvts3.f
shst01.f slarfy.f slarhs.f slatm4.f slctes.f slctsx.f slsets.f sort01.f
sort03.f ssbt21.f ssgt01.f sslect.f sspt21.f sstt21.f
sstt22.f ssyt21.f ssyt22.f)
sstt22.f ssyl01.f ssyt21.f ssyt22.f)

set(CEIGTST cchkee.F
cbdt01.f cbdt02.f cbdt03.f cbdt05.f
Expand Down
2 changes: 1 addition & 1 deletion TESTING/EIG/Makefile
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,7 @@ SEIGTST = schkee.o \
sget54.o sglmts.o sgqrts.o sgrqts.o sgsvts3.o \
shst01.o slarfy.o slarhs.o slatm4.o slctes.o slctsx.o slsets.o sort01.o \
sort03.o ssbt21.o ssgt01.o sslect.o sspt21.o sstt21.o \
sstt22.o ssyt21.o ssyt22.o
sstt22.o ssyl01.o ssyt21.o ssyt22.o

CEIGTST = cchkee.o \
cbdt01.o cbdt02.o cbdt03.o cbdt05.o \
Expand Down
46 changes: 34 additions & 12 deletions TESTING/EIG/dchkec.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -90,21 +90,23 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
LOGICAL OK
CHARACTER*3 PATH
INTEGER KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
$ KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
$ LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
$ NLASY2, NTESTS, NTRSYL, KTGEXC, LTGEXC
$ KTRSEN, KTRSNA, KTRSYL, KTRSYL3, LLAEXC,
$ LLALN2, LLANV2, LLAQTR, LLASY2, LTREXC, LTRSYL,
$ NLANV2, NLAQTR, NLASY2, NTESTS, NTRSYL, KTGEXC,
$ LTGEXC
DOUBLE PRECISION EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
$ RTREXC, RTRSYL, SFMIN, RTGEXC
$ RTREXC, SFMIN, RTGEXC
* ..
* .. Local Arrays ..
INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
$ NLALN2( 2 ), NTGEXC( 2 ), NTREXC( 3 ),
$ NTRSEN( 3 ), NTRSNA( 3 )
DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 )
INTEGER FTRSYL( 3 ), ITRSYL( 2 ), LTRSEN( 3 ),
$ LTRSNA( 3 ), NLAEXC( 2 ), NLALN2( 2 ),
$ NTGEXC( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
$ NTRSNA( 3 )
DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 ), RTRSYL( 2 )
* ..
* .. External Subroutines ..
EXTERNAL DERREC, DGET31, DGET32, DGET33, DGET34, DGET35,
$ DGET36, DGET37, DGET38, DGET39, DGET40
$ DGET36, DGET37, DGET38, DGET39, DGET40, DSYL01
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH
Expand Down Expand Up @@ -153,10 +155,24 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
WRITE( NOUT, FMT = 9996 )RLAEXC, LLAEXC, NLAEXC, KLAEXC
END IF
*
CALL DGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL )
IF( RTRSYL.GT.THRESH ) THEN
CALL DGET35( RTRSYL( 1 ), LTRSYL, NTRSYL, KTRSYL )
IF( RTRSYL( 1 ).GT.THRESH ) THEN
OK = .FALSE.
WRITE( NOUT, FMT = 9995 )RTRSYL, LTRSYL, NTRSYL, KTRSYL
WRITE( NOUT, FMT = 9995 )RTRSYL( 1 ), LTRSYL, NTRSYL, KTRSYL
END IF
*
CALL DSYL01( THRESH, FTRSYL, RTRSYL, ITRSYL, KTRSYL3 )
IF( FTRSYL( 1 ).GT.0 ) THEN
OK = .FALSE.
WRITE( NOUT, FMT = 9970 )FTRSYL( 1 ), RTRSYL( 1 ), THRESH
END IF
IF( FTRSYL( 2 ).GT.0 ) THEN
OK = .FALSE.
WRITE( NOUT, FMT = 9971 )FTRSYL( 2 ), RTRSYL( 2 ), THRESH
END IF
IF( FTRSYL( 3 ).GT.0 ) THEN
OK = .FALSE.
WRITE( NOUT, FMT = 9972 )FTRSYL( 3 )
END IF
*
CALL DGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN )
Expand Down Expand Up @@ -228,6 +244,12 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
$ 's than', F8.2, / / )
9986 FORMAT( ' Error in DTGEXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N',
$ 'INFO=', 2I8, ' KNT=', I8 )
9972 FORMAT( 'DTRSYL and DTRSYL3 compute an inconsistent result ',
$ 'factor in ', I8, ' tests.')
9971 FORMAT( 'Error in DTRSYL3: ', I8, ' tests fail the threshold.', /
$ 'Maximum test ratio =', D12.3, ' threshold =', D12.3 )
9970 FORMAT( 'Error in DTRSYL: ', I8, ' tests fail the threshold.', /
$ 'Maximum test ratio =', D12.3, ' threshold =', D12.3 )
*
* End of DCHKEC
*
Expand Down
41 changes: 39 additions & 2 deletions TESTING/EIG/derrec.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
*>
*> DERREC tests the error exits for the routines for eigen- condition
*> estimation for DOUBLE PRECISION matrices:
*> DTRSYL, DTREXC, DTRSNA and DTRSEN.
*> DTRSYL, DTRSYL3, DTREXC, DTRSNA and DTRSEN.
*> \endverbatim
*
* Arguments:
Expand Down Expand Up @@ -82,7 +82,7 @@ SUBROUTINE DERREC( PATH, NUNIT )
$ WI( NMAX ), WORK( NMAX ), WR( NMAX )
* ..
* .. External Subroutines ..
EXTERNAL CHKXER, DTREXC, DTRSEN, DTRSNA, DTRSYL
EXTERNAL CHKXER, DTREXC, DTRSEN, DTRSNA, DTRSYL, DTRSYL3
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
Expand Down Expand Up @@ -141,6 +141,43 @@ SUBROUTINE DERREC( PATH, NUNIT )
CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
NT = NT + 8
*
* Test DTRSYL3
*
SRNAMT = 'DTRSYL3'
INFOT = 1
CALL DTRSYL3( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL DTRSYL3( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL DTRSYL3( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
INFOT = 4
CALL DTRSYL3( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL DTRSYL3( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
INFOT = 7
CALL DTRSYL3( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
INFOT = 9
CALL DTRSYL3( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
INFOT = 11
CALL DTRSYL3( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE,
$ IWORK, NMAX, WORK, NMAX, INFO )
CALL CHKXER( 'DTRSYL3', INFOT, NOUT, LERR, OK )
NT = NT + 8
*
* Test DTREXC
*
SRNAMT = 'DTREXC'
Expand Down
Loading