Add xGGHD3: blocked Hessenberg reduction, code from Daniel Kressner.

Add xGGES3 and xGGEV3: computation of the Schur form, the Schur vectors, and
   the generalized eigenvalues using the blocked Hessenberg reduction.

1 files changed, 42 insertions, 14 deletions

diff --git a/TESTING/EIG/schkee.f b/TESTING/EIG/schkee.f
index 5b6a9ba1..d323d200 100644
--- a/TESTING/EIG/schkee.f
+++ b/TESTING/EIG/schkee.f
@@ -44,7 +44,7 @@
 *>     Test SGEESX
 *>
 *> SGG (Generalized Nonsymmetric Eigenvalue Problem):
-*>     Test SGGHRD, SGGBAL, SGGBAK, SHGEQZ, and STGEVC
+*>     Test SGGHD3, SGGBAL, SGGBAK, SHGEQZ, and STGEVC
 *>     and the driver routines SGEGS and SGEGV
 *>
 *> SGS (Generalized Nonsymmetric Schur form Driver):
@@ -493,38 +493,41 @@
 *> line 8:  MXBVAL, INTEGER array, dimension (NPARMS)
 *>          The values for MAXB, used in determining minimum blocksize.
 *>
-*> line 9:  NBCOL, INTEGER array, dimension (NPARMS)
+*> line 9:  IACC22, INTEGER array, dimension (NPARMS)
+*>          select structured matrix multiply: 1 or 2)
+*>
+*> line 10: NBCOL, INTEGER array, dimension (NPARMS)
 *>          The values for NBCOL, the minimum column dimension for
 *>          blocks.
 *>
-*> line 10: THRESH
+*> line 11: THRESH
 *>          Threshold value for the test ratios.  Information will be
 *>          printed about each test for which the test ratio is greater
 *>          than or equal to the threshold.
 *>
-*> line 11: TSTCHK, LOGICAL
+*> line 12: TSTCHK, LOGICAL
 *>          Flag indicating whether or not to test the LAPACK routines.
 *>
-*> line 12: TSTDRV, LOGICAL
+*> line 13: TSTDRV, LOGICAL
 *>          Flag indicating whether or not to test the driver routines.
 *>
-*> line 13: TSTERR, LOGICAL
+*> line 14: TSTERR, LOGICAL
 *>          Flag indicating whether or not to test the error exits for
 *>          the LAPACK routines and driver routines.
 *>
-*> line 14: NEWSD, INTEGER
+*> line 15: NEWSD, INTEGER
 *>          A code indicating how to set the random number seed.
 *>          = 0:  Set the seed to a default value before each run
 *>          = 1:  Initialize the seed to a default value only before the
 *>                first run
 *>          = 2:  Like 1, but use the seed values on the next line
 *>
-*> If line 14 was 2:
+*> If line 15 was 2:
 *>
-*> line 15: INTEGER array, dimension (4)
+*> line 16: INTEGER array, dimension (4)
 *>          Four integer values for the random number seed.
 *>
-*> lines 15-EOF:  Lines specifying matrix types, as for NEP.
+*> lines 17-EOF:  Lines specifying matrix types, as for NEP.
 *>          The 3-character path name is 'SGG' for the generalized
 *>          eigenvalue problem routines and driver routines.
 *>
@@ -1104,7 +1107,8 @@
      $                   SCKCSD, SCKGLM, SCKGQR, SCKGSV, SCKLSE, SDRGES,
      $                   SDRGEV, SDRGSX, SDRGVX, SDRVBD, SDRVES, SDRVEV,
      $                   SDRVGG, SDRVSG, SDRVST, SDRVSX, SDRVVX, SERRBD,
-     $                   SERRED, SERRGG, SERRHS, SERRST, ILAVER, XLAENV
+     $                   SERRED, SERRGG, SERRHS, SERRST, ILAVER, XLAENV,
+     $                   SDRGES3, SDRGEV3
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          LEN, MIN
@@ -1630,7 +1634,7 @@
 *
 *        Read the values for IACC22.
 *
-         IF( NEP ) THEN
+         IF( NEP .OR. SGG ) THEN
             READ( NIN, FMT = * )( IACC22( I ), I = 1, NPARMS )
             DO 620 I = 1, NPARMS
                IF( IACC22( I ).LT.0 ) THEN
@@ -2097,6 +2101,7 @@
 *           NBMIN = minimum block size
 *           NS    = number of shifts
 *           MAXB  = minimum submatrix size
+*           IACC22: structured matrix multiply
 *           NBCOL = minimum column dimension for blocks
 *
          MAXTYP = 26
@@ -2109,6 +2114,7 @@
             CALL XLAENV( 2, NBMIN( I ) )
             CALL XLAENV( 4, NSVAL( I ) )
             CALL XLAENV( 8, MXBVAL( I ) )
+            CALL XLAENV( 16, IACC22( I ) )
             CALL XLAENV( 5, NBCOL( I ) )
 *
             IF( NEWSD.EQ.0 ) THEN
@@ -2117,7 +2123,7 @@
   340          CONTINUE
             END IF
             WRITE( NOUT, FMT = 9996 )C3, NBVAL( I ), NBMIN( I ),
-     $         NSVAL( I ), MXBVAL( I ), NBCOL( I )
+     $         NSVAL( I ), MXBVAL( I ), IACC22( I ), NBCOL( I )
             TSTDIF = .FALSE.
             THRSHN = 10.
             IF( TSTCHK ) THEN
@@ -2170,6 +2176,17 @@
 *
             IF( INFO.NE.0 )
      $         WRITE( NOUT, FMT = 9980 )'SDRGES', INFO
+*     
+*     Blocked version
+*            
+            CALL SDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT,
+     $                    A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
+     $                    A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ),
+     $                    D( 1, 1 ), D( 1, 2 ), D( 1, 3 ), WORK, LWORK,
+     $                    RESULT, LOGWRK, INFO )
+*
+            IF( INFO.NE.0 )
+     $         WRITE( NOUT, FMT = 9980 )'SDRGES3', INFO
          END IF
          WRITE( NOUT, FMT = 9973 )
          GO TO 10
@@ -2224,6 +2241,17 @@
      $                   WORK, LWORK, RESULT, INFO )
             IF( INFO.NE.0 )
      $         WRITE( NOUT, FMT = 9980 )'SDRGEV', INFO
+*     
+* Blocked version
+*
+            CALL SDRGEV3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT,
+     $                    A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
+     $                    A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ),
+     $                    A( 1, 9 ), NMAX, D( 1, 1 ), D( 1, 2 ),
+     $                    D( 1, 3 ), D( 1, 4 ), D( 1, 5 ), D( 1, 6 ),
+     $                    WORK, LWORK, RESULT, INFO )
+            IF( INFO.NE.0 )
+     $         WRITE( NOUT, FMT = 9980 )'SDRGEV3', INFO
          END IF
          WRITE( NOUT, FMT = 9973 )
          GO TO 10
@@ -2395,7 +2423,7 @@
  9999 FORMAT( / ' Execution not attempted due to input errors' )
  9997 FORMAT( / / 1X, A3, ':  NB =', I4, ', NBMIN =', I4, ', NX =', I4 )
  9996 FORMAT( / / 1X, A3, ':  NB =', I4, ', NBMIN =', I4, ', NS =', I4,
-     $      ', MAXB =', I4, ', NBCOL =', I4 )
+     $      ', MAXB =', I4, ', IACC22 =', I4, ', NBCOL =', I4 )
  9995 FORMAT( / / 1X, A3, ':  NB =', I4, ', NBMIN =', I4, ', NX =', I4,
      $      ', NRHS =', I4 )
  9994 FORMAT( / / ' End of tests' )