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

 * 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.

8 files changed, 16 insertions, 18 deletions

diff --git a/SRC/cggev.f b/SRC/cggev.f
index e8eba2be..3fb5608d 100644
--- a/SRC/cggev.f
+++ b/SRC/cggev.f
@@ -542,15 +542,15 @@
 *
 *     Undo scaling if necessary
 *
+   70 CONTINUE
+*
       IF( ILASCL )
      $   CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
 *
       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 fe09a24f..cf4b5cee 100644
--- a/SRC/cggevx.f
+++ b/SRC/cggevx.f
@@ -788,15 +788,15 @@
 *
 *     Undo scaling if necessary
 *
+   90 CONTINUE
+*
       IF( ILASCL )
      $   CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
 *
       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 82b7c695..39a87a17 100644
--- a/SRC/dggev.f
+++ b/SRC/dggev.f
@@ -573,6 +573,8 @@
 *
 *     Undo scaling if necessary
 *
+  110 CONTINUE
+*
       IF( ILASCL ) THEN
          CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
          CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
@@ -582,10 +584,7 @@
          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 fbde0183..549cd2ee 100644
--- a/SRC/dggevx.f
+++ b/SRC/dggevx.f
@@ -849,6 +849,8 @@
 *
 *     Undo scaling if necessary
 *
+  130 CONTINUE
+*
       IF( ILASCL ) THEN
          CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
          CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, 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 6b23a3d2..216b23ef 100644
--- a/SRC/sggev.f
+++ b/SRC/sggev.f
@@ -573,6 +573,8 @@
 *
 *     Undo scaling if necessary
 *
+  110 CONTINUE
+*
       IF( ILASCL ) THEN
          CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
          CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
@@ -582,10 +584,7 @@
          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 8ecaa54e..ca7a4cc8 100644
--- a/SRC/sggevx.f
+++ b/SRC/sggevx.f
@@ -847,6 +847,8 @@
 *
 *     Undo scaling if necessary
 *
+  130 CONTINUE
+*
       IF( ILASCL ) THEN
          CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
          CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, 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 e656115c..7f1c6dbf 100644
--- a/SRC/zggev.f
+++ b/SRC/zggev.f
@@ -542,15 +542,15 @@
 *
 *     Undo scaling if necessary
 *
+   70 CONTINUE
+*
       IF( ILASCL )
      $   CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
 *
       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 04a1421a..ec1ad8c8 100644
--- a/SRC/zggevx.f
+++ b/SRC/zggevx.f
@@ -788,15 +788,15 @@
 *
 *     Undo scaling if necessary
 *
+   90 CONTINUE
+*
       IF( ILASCL )
      $   CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
 *
       IF( ILBSCL )
      $   CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
 *
-   90 CONTINUE
       WORK( 1 ) = MAXWRK
-*
       RETURN
 *
 *     End of ZGGEVX