Correct bug 0090 Need to unscale if necessary when there is an error in DHGEQZ (QZ...

 * bug report by Hong Bo Peng Sandgren, on 03-19-2012.
 * See link:http://icl.cs.utk.edu/lapack-forum/archives/lapack/msg01257.html[LAPACK Mailing list msg 01257]

I am doing some work with DGGEV. When I check the return msg and the actual code, I found something may be wrong. Here is part of comments in the header of DGGEV.F.

*  INFO    (output) INTEGER
*          = 0:  successful exit
*          < 0:  if INFO = -i, the i-th argument had an illegal value.
*          = 1,...,N:
*                The QZ iteration failed.  No eigenvectors have been
*                calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
*                should be correct for j=INFO+1,...,N.
*          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
*                =N+2: error return from DTGEVC.

When INFO = 1...N, there is an error in DHGEQZ (QZ iteration failed). From the code, we can see it jumps to label 110 then set WORK(1) and return.
But in case of we scaled the matrix, we still need to undo scale for the output array ALPHAR, ALPHAI and BETA for those values j=INFO+1,...,N.

In DGEEVX, we can see that it jumps to label 50 in case of DHSEQR failure and then undo scale before return.

diff --git a/SRC/cggev.f b/SRC/cggev.f
index e8eba2be44accb3c7388042cca2439ad1b41fa18..3fb5608dc013596bb556e458f539231601d58e78 100644 (file)
--- a/SRC/cggev.f
+++ b/SRC/cggev.f
@@ -541,6 +541,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+   70 CONTINUE
 *
       IF( ILASCL )
      $   CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
@@ -548,9 +550,7 @@
       IF( ILBSCL )
      $   CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
 *
-   70 CONTINUE
       WORK( 1 ) = LWKOPT
-*
       RETURN
 *
 *     End of CGGEV

diff --git a/SRC/cggevx.f b/SRC/cggevx.f
index fe09a24fcbaec8412a58e8f936c188b46568d78c..cf4b5cee9a9c18e8cf24b9efb445f06fcc690f81 100644 (file)
--- a/SRC/cggevx.f
+++ b/SRC/cggevx.f
@@ -787,6 +787,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+   90 CONTINUE
 *
       IF( ILASCL )
      $   CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
@@ -794,9 +796,7 @@
       IF( ILBSCL )
      $   CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
 *
-   90 CONTINUE
       WORK( 1 ) = MAXWRK
-*
       RETURN
 *
 *     End of CGGEVX

diff --git a/SRC/dggev.f b/SRC/dggev.f
index 82b7c695136f64450372364e2dad870d567e5902..39a87a178b6defe3ff12d1737c61fae187fb4c02 100644 (file)
--- a/SRC/dggev.f
+++ b/SRC/dggev.f
@@ -572,6 +572,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+  110 CONTINUE
 *
       IF( ILASCL ) THEN
          CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
@@ -581,11 +583,8 @@
       IF( ILBSCL ) THEN
          CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
       END IF
-*
-  110 CONTINUE
 *
       WORK( 1 ) = MAXWRK
-*
       RETURN
 *
 *     End of DGGEV

diff --git a/SRC/dggevx.f b/SRC/dggevx.f
index fbde01836028cdd733f9169b44a1449a7a7882f0..549cd2eec0a16390127c9641fe10dedb92a3b20b 100644 (file)
--- a/SRC/dggevx.f
+++ b/SRC/dggevx.f
@@ -848,6 +848,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+  130 CONTINUE
 *
       IF( ILASCL ) THEN
          CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
@@ -858,9 +860,7 @@
          CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
       END IF
 *
-  130 CONTINUE
       WORK( 1 ) = MAXWRK
-*
       RETURN
 *
 *     End of DGGEVX

diff --git a/SRC/sggev.f b/SRC/sggev.f
index 6b23a3d2fbfc45826dcb98d757f4d97f18885aaf..216b23ef4c51aa935d246961cb6b273ded1b31bc 100644 (file)
--- a/SRC/sggev.f
+++ b/SRC/sggev.f
@@ -572,6 +572,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+  110 CONTINUE
 *
       IF( ILASCL ) THEN
          CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
@@ -581,11 +583,8 @@
       IF( ILBSCL ) THEN
          CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
       END IF
-*
-  110 CONTINUE
 *
       WORK( 1 ) = MAXWRK
-*
       RETURN
 *
 *     End of SGGEV

diff --git a/SRC/sggevx.f b/SRC/sggevx.f
index 8ecaa54e793434a9038ed820897c7ccc5ec55a18..ca7a4cc8e22966b2eb1f8629fdb091eaead29611 100644 (file)
--- a/SRC/sggevx.f
+++ b/SRC/sggevx.f
@@ -846,6 +846,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+  130 CONTINUE
 *
       IF( ILASCL ) THEN
          CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
@@ -856,9 +858,7 @@
          CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
       END IF
 *
-  130 CONTINUE
       WORK( 1 ) = MAXWRK
-*
       RETURN
 *
 *     End of SGGEVX

diff --git a/SRC/zggev.f b/SRC/zggev.f
index e656115c2fa7891901b138deb83f7b56345c28f6..7f1c6dbf5eb72ea176e487b4064e2a262425548f 100644 (file)
--- a/SRC/zggev.f
+++ b/SRC/zggev.f
@@ -541,6 +541,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+   70 CONTINUE
 *
       IF( ILASCL )
      $   CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
@@ -548,9 +550,7 @@
       IF( ILBSCL )
      $   CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
 *
-   70 CONTINUE
       WORK( 1 ) = LWKOPT
-*
       RETURN
 *
 *     End of ZGGEV

diff --git a/SRC/zggevx.f b/SRC/zggevx.f
index 04a1421a1b6e9f225f0c3642596a90db27098dbc..ec1ad8c8e034d894c42e42240ad98f041d249d7e 100644 (file)
--- a/SRC/zggevx.f
+++ b/SRC/zggevx.f
@@ -787,6 +787,8 @@
       END IF
 *
 *     Undo scaling if necessary
+*
+   90 CONTINUE
 *
       IF( ILASCL )
      $   CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
@@ -794,9 +796,7 @@
       IF( ILBSCL )
      $   CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
 *
-   90 CONTINUE
       WORK( 1 ) = MAXWRK
-*
       RETURN
 *
 *     End of ZGGEVX