Ed Anderson Bug Fix - Jan 26 2015

Also in TESTING/EIG, I fixed two bugs in s/d chkhs; the diff of schkhs is:
790c790
<             CALL SLACPY( ' ', N, N, U, LDU, UZ, LDU )
---
>             CALL SLACPY( ' ', N, N, U, LDU, UZ, LDA )
831c831
<      $                 ABS( WI1( J )-WI3( J ) ) )
---
>      $                 ABS( WR1( J )-WR3( J ) ) )
In further testing, I was able to produce a test case where Test 8 fails comparing
the eigenvalues from xHSEQR(‘E’,’N’) with the eigenvalues from xHSEQR(‘S’,’V’).
The eigenvalues were the same, but in a different order.  It appears that xHSEQR
does some rearrangement of the Schur matrix and so we should not expect the
eigenvalues to be in the same order, although I am trying to confirm this
with the authors.  In the meantime, I have modified xCHKEE and xCHKHS to
compute the eigenvalues from xHSEQR(‘S’,’N’) in a separate array W2 (or
WR2 and WI2) so that test 8 can compare the eigenvalues from xHSEQR(‘S’,’N’)
with the eigenvalues from xHSEQR(‘S’,’V’).

diff --git a/TESTING/EIG/dchkhs.f b/TESTING/EIG/dchkhs.f
index 6115b0b314637bf645d3ff7f7fe3de36e455b788..89b3f9df851e2e7c278300ecffbd11a97ff17011 100644 (file)
--- a/TESTING/EIG/dchkhs.f
+++ b/TESTING/EIG/dchkhs.f
@@ -10,9 +10,9 @@
 *
 *       SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
 *                          NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, WR1,
-*                          WI1, WR3, WI3, EVECTL, EVECTR, EVECTY, EVECTX,
-*                          UU, TAU, WORK, NWORK, IWORK, SELECT, RESULT,
-*                          INFO )
+*                          WI1, WR2, WI2, WR3, WI3, EVECTL, EVECTR, EVECTY,
+*                          EVECTX, UU, TAU, WORK, NWORK, IWORK, SELECT,
+*                          RESULT, INFO )
 * 
 *       .. Scalar Arguments ..
 *       INTEGER            INFO, LDA, LDU, NOUNIT, NSIZES, NTYPES, NWORK
@@ -26,8 +26,8 @@
 *      $                   EVECTY( LDU, * ), H( LDA, * ), RESULT( 14 ),
 *      $                   T1( LDA, * ), T2( LDA, * ), TAU( * ),
 *      $                   U( LDU, * ), UU( LDU, * ), UZ( LDU, * ),
-*      $                   WI1( * ), WI3( * ), WORK( * ), WR1( * ),
-*      $                   WR3( * ), Z( LDU, * )
+*      $                   WI1( * ), WI2( * ), WI3( * ), WORK( * ),
+*      $                   WR1( * ), WR2( * ), WR3( * ), Z( LDU, * )
 *       ..
 *  
 *
@@ -268,6 +268,13 @@
 *>           On exit, WR1 + WI1*i are the eigenvalues of the matrix in A.
 *>           Modified.
 *>
+*>  WR2    - DOUBLE PRECISION array, dimension (max(NN))
+*>  WI2    - DOUBLE PRECISION array, dimension (max(NN))
+*>           The real and imaginary parts of the eigenvalues of A,
+*>           as computed when T is computed but not Z.
+*>           On exit, WR2 + WI2*i are the eigenvalues of the matrix in A.
+*>           Modified.
+*>
 *>  WR3    - DOUBLE PRECISION array, dimension (max(NN))
 *>  WI3    - DOUBLE PRECISION array, dimension (max(NN))
 *>           Like WR1, WI1, these arrays contain the eigenvalues of A,
@@ -401,9 +408,9 @@
 *  =====================================================================
       SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
      $                   NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, WR1,
-     $                   WI1, WR3, WI3, EVECTL, EVECTR, EVECTY, EVECTX,
-     $                   UU, TAU, WORK, NWORK, IWORK, SELECT, RESULT,
-     $                   INFO )
+     $                   WI1, WR2, WI2, WR3, WI3, EVECTL, EVECTR,
+     $                   EVECTY, EVECTX, UU, TAU, WORK, NWORK, IWORK,
+     $                   SELECT, RESULT, INFO )
 *
 *  -- LAPACK test routine (version 3.4.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -422,8 +429,8 @@
      $                   EVECTY( LDU, * ), H( LDA, * ), RESULT( 14 ),
      $                   T1( LDA, * ), T2( LDA, * ), TAU( * ),
      $                   U( LDU, * ), UU( LDU, * ), UZ( LDU, * ),
-     $                   WI1( * ), WI3( * ), WORK( * ), WR1( * ),
-     $                   WR3( * ), Z( LDU, * )
+     $                   WI1( * ), WI2( * ), WI3( * ), WORK( * ),
+     $                   WR1( * ), WR2( * ), WR3( * ), Z( LDU, * )
 *     ..
 *
 *  =====================================================================
@@ -770,11 +777,11 @@
                END IF
             END IF
 *
-*           Eigenvalues (WR1,WI1) and Full Schur Form (T2)
+*           Eigenvalues (WR2,WI2) and Full Schur Form (T2)
 *
             CALL DLACPY( ' ', N, N, H, LDA, T2, LDA )
 *
-            CALL DHSEQR( 'S', 'N', N, ILO, IHI, T2, LDA, WR1, WI1, UZ,
+            CALL DHSEQR( 'S', 'N', N, ILO, IHI, T2, LDA, WR2, WI2, UZ,
      $                   LDU, WORK, NWORK, IINFO )
             IF( IINFO.NE.0 .AND. IINFO.LE.N+2 ) THEN
                WRITE( NOUNIT, FMT = 9999 )'DHSEQR(S)', IINFO, N, JTYPE,
@@ -787,7 +794,7 @@
 *           (UZ)
 *
             CALL DLACPY( ' ', N, N, H, LDA, T1, LDA )
-            CALL DLACPY( ' ', N, N, U, LDU, UZ, LDA )
+            CALL DLACPY( ' ', N, N, U, LDU, UZ, LDU )
 *
             CALL DHSEQR( 'S', 'V', N, ILO, IHI, T1, LDA, WR1, WI1, UZ,
      $                   LDU, WORK, NWORK, IINFO )
@@ -820,15 +827,15 @@
 *
             CALL DGET10( N, N, T2, LDA, T1, LDA, WORK, RESULT( 7 ) )
 *
-*           Do Test 8: | W3 - W1 | / ( max(|W1|,|W3|) ulp )
+*           Do Test 8: | W2 - W1 | / ( max(|W1|,|W2|) ulp )
 *
             TEMP1 = ZERO
             TEMP2 = ZERO
             DO 130 J = 1, N
                TEMP1 = MAX( TEMP1, ABS( WR1( J ) )+ABS( WI1( J ) ),
-     $                 ABS( WR3( J ) )+ABS( WI3( J ) ) )
-               TEMP2 = MAX( TEMP2, ABS( WR1( J )-WR3( J ) )+
-     $                 ABS( WR1( J )-WR3( J ) ) )
+     $                 ABS( WR2( J ) )+ABS( WI2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( WR1( J )-WR2( J ) )+
+     &                 ABS( WI1( J )-WI2( J ) ) )
   130       CONTINUE
 *
             RESULT( 8 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )

diff --git a/TESTING/EIG/schkhs.f b/TESTING/EIG/schkhs.f
index 2d9605a5be53374d6a6bdc7e494736cea4050cf2..002e4f4ee75a31278cb521333c206ac5cbe60e79 100644 (file)
--- a/TESTING/EIG/schkhs.f
+++ b/TESTING/EIG/schkhs.f
@@ -10,9 +10,9 @@
 *
 *       SUBROUTINE SCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
 *                          NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, WR1,
-*                          WI1, WR3, WI3, EVECTL, EVECTR, EVECTY, EVECTX,
-*                          UU, TAU, WORK, NWORK, IWORK, SELECT, RESULT,
-*                          INFO )
+*                          WI1, WR2, WI2, WR3, WI3, EVECTL, EVECTR, EVECTY,
+*                          EVECTX, UU, TAU, WORK, NWORK, IWORK, SELECT,
+*                          RESULT, INFO )
 * 
 *       .. Scalar Arguments ..
 *       INTEGER            INFO, LDA, LDU, NOUNIT, NSIZES, NTYPES, NWORK
@@ -26,8 +26,8 @@
 *      $                   EVECTY( LDU, * ), H( LDA, * ), RESULT( 14 ),
 *      $                   T1( LDA, * ), T2( LDA, * ), TAU( * ),
 *      $                   U( LDU, * ), UU( LDU, * ), UZ( LDU, * ),
-*      $                   WI1( * ), WI3( * ), WORK( * ), WR1( * ),
-*      $                   WR3( * ), Z( LDU, * )
+*      $                   WI1( * ), WI2( * ), WI3( * ), WORK( * ),
+*      $                   WR1( * ), WR2( * ), WR3( * ), Z( LDU, * )
 *       ..
 *  
 *
@@ -268,6 +268,13 @@
 *>           On exit, WR1 + WI1*i are the eigenvalues of the matrix in A.
 *>           Modified.
 *>
+*>  WR2    - REAL array, dimension (max(NN))
+*>  WI2    - REAL array, dimension (max(NN))
+*>           The real and imaginary parts of the eigenvalues of A,
+*>           as computed when T is computed but not Z.
+*>           On exit, WR2 + WI2*i are the eigenvalues of the matrix in A.
+*>           Modified.
+*>
 *>  WR3    - REAL array, dimension (max(NN))
 *>  WI3    - REAL array, dimension (max(NN))
 *>           Like WR1, WI1, these arrays contain the eigenvalues of A,
@@ -401,9 +408,9 @@
 *  =====================================================================
       SUBROUTINE SCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
      $                   NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, WR1,
-     $                   WI1, WR3, WI3, EVECTL, EVECTR, EVECTY, EVECTX,
-     $                   UU, TAU, WORK, NWORK, IWORK, SELECT, RESULT,
-     $                   INFO )
+     $                   WI1, WR2, WI2, WR3, WI3, EVECTL, EVECTR,
+     $                   EVECTY, EVECTX, UU, TAU, WORK, NWORK, IWORK,
+     $                   SELECT, RESULT, INFO )
 *
 *  -- LAPACK test routine (version 3.4.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -422,8 +429,8 @@
      $                   EVECTY( LDU, * ), H( LDA, * ), RESULT( 14 ),
      $                   T1( LDA, * ), T2( LDA, * ), TAU( * ),
      $                   U( LDU, * ), UU( LDU, * ), UZ( LDU, * ),
-     $                   WI1( * ), WI3( * ), WORK( * ), WR1( * ),
-     $                   WR3( * ), Z( LDU, * )
+     $                   WI1( * ), WI2( * ), WI3( * ), WORK( * ),
+     $                   WR1( * ), WR2( * ), WR3( * ), Z( LDU, * )
 *     ..
 *
 *  =====================================================================
@@ -770,11 +777,11 @@
                END IF
             END IF
 *
-*           Eigenvalues (WR1,WI1) and Full Schur Form (T2)
+*           Eigenvalues (WR2,WI2) and Full Schur Form (T2)
 *
             CALL SLACPY( ' ', N, N, H, LDA, T2, LDA )
 *
-            CALL SHSEQR( 'S', 'N', N, ILO, IHI, T2, LDA, WR1, WI1, UZ,
+            CALL SHSEQR( 'S', 'N', N, ILO, IHI, T2, LDA, WR2, WI2, UZ,
      $                   LDU, WORK, NWORK, IINFO )
             IF( IINFO.NE.0 .AND. IINFO.LE.N+2 ) THEN
                WRITE( NOUNIT, FMT = 9999 )'SHSEQR(S)', IINFO, N, JTYPE,
@@ -787,7 +794,7 @@
 *           (UZ)
 *
             CALL SLACPY( ' ', N, N, H, LDA, T1, LDA )
-            CALL SLACPY( ' ', N, N, U, LDU, UZ, LDA )
+            CALL SLACPY( ' ', N, N, U, LDU, UZ, LDU )
 *
             CALL SHSEQR( 'S', 'V', N, ILO, IHI, T1, LDA, WR1, WI1, UZ,
      $                   LDU, WORK, NWORK, IINFO )
@@ -820,15 +827,15 @@
 *
             CALL SGET10( N, N, T2, LDA, T1, LDA, WORK, RESULT( 7 ) )
 *
-*           Do Test 8: | W3 - W1 | / ( max(|W1|,|W3|) ulp )
+*           Do Test 8: | W2 - W1 | / ( max(|W1|,|W2|) ulp )
 *
             TEMP1 = ZERO
             TEMP2 = ZERO
             DO 130 J = 1, N
                TEMP1 = MAX( TEMP1, ABS( WR1( J ) )+ABS( WI1( J ) ),
-     $                 ABS( WR3( J ) )+ABS( WI3( J ) ) )
-               TEMP2 = MAX( TEMP2, ABS( WR1( J )-WR3( J ) )+
-     $                 ABS( WR1( J )-WR3( J ) ) )
+     $                 ABS( WR2( J ) )+ABS( WI2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( WR1( J )-WR2( J ) )+
+     $                 ABS( WI1( J )-WI2( J ) ) )
   130       CONTINUE
 *
             RESULT( 8 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )