Test [sd]trsyl3

Author: angsch

TESTING/EIG/CMakeLists.txt

@@ -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

TESTING/EIG/Makefile

@@ -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 \

TESTING/EIG/dchkec.f

@@ -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
@@ -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 )
@@ -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
 *

TESTING/EIG/derrec.f

@@ -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:
@@ -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
@@ -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'