diff -uNr LAPACK.orig/BLAS/TESTING/cblat2.f LAPACK/BLAS/TESTING/cblat2.f
--- LAPACK.orig/BLAS/TESTING/cblat2.f Thu Nov 4 14:23:26 1999
+++ LAPACK/BLAS/TESTING/cblat2.f Fri May 25 15:57:46 2001
@@ -64,6 +64,10 @@
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
@@ -126,7 +130,7 @@
*
READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT
- OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT
*
* Read name and unit number for snapshot output file and open file.
@@ -135,7 +139,7 @@
READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0
IF( TRACE )THEN
- OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+ OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF
* Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI
diff -uNr LAPACK.orig/BLAS/TESTING/cblat3.f LAPACK/BLAS/TESTING/cblat3.f
--- LAPACK.orig/BLAS/TESTING/cblat3.f Thu Nov 4 14:23:26 1999
+++ LAPACK/BLAS/TESTING/cblat3.f Fri May 25 15:58:08 2001
@@ -46,6 +46,10 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
diff -uNr LAPACK.orig/BLAS/TESTING/dblat2.f LAPACK/BLAS/TESTING/dblat2.f
--- LAPACK.orig/BLAS/TESTING/dblat2.f Thu Nov 4 14:23:27 1999
+++ LAPACK/BLAS/TESTING/dblat2.f Fri May 25 15:57:41 2001
@@ -63,6 +63,10 @@
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
@@ -121,7 +125,7 @@
*
READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT
- OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT
*
* Read name and unit number for snapshot output file and open file.
@@ -130,7 +134,7 @@
READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0
IF( TRACE )THEN
- OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+ OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF
* Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI
diff -uNr LAPACK.orig/BLAS/TESTING/dblat3.f LAPACK/BLAS/TESTING/dblat3.f
--- LAPACK.orig/BLAS/TESTING/dblat3.f Thu Nov 4 14:23:27 1999
+++ LAPACK/BLAS/TESTING/dblat3.f Fri May 25 15:58:04 2001
@@ -43,6 +43,10 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
@@ -96,7 +100,7 @@
*
READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT
- OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT
*
* Read name and unit number for snapshot output file and open file.
@@ -105,7 +109,7 @@
READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0
IF( TRACE )THEN
- OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+ OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF
* Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI
diff -uNr LAPACK.orig/BLAS/TESTING/sblat2.f LAPACK/BLAS/TESTING/sblat2.f
--- LAPACK.orig/BLAS/TESTING/sblat2.f Thu Nov 4 14:23:26 1999
+++ LAPACK/BLAS/TESTING/sblat2.f Fri May 25 15:57:34 2001
@@ -63,6 +63,10 @@
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
@@ -121,7 +125,7 @@
*
READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT
- OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT
*
* Read name and unit number for snapshot output file and open file.
@@ -130,7 +134,7 @@
READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0
IF( TRACE )THEN
- OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+ OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF
* Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI
diff -uNr LAPACK.orig/BLAS/TESTING/sblat3.f LAPACK/BLAS/TESTING/sblat3.f
--- LAPACK.orig/BLAS/TESTING/sblat3.f Thu Nov 4 14:23:26 1999
+++ LAPACK/BLAS/TESTING/sblat3.f Fri May 25 15:58:00 2001
@@ -43,6 +43,10 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
diff -uNr LAPACK.orig/BLAS/TESTING/zblat2.f LAPACK/BLAS/TESTING/zblat2.f
--- LAPACK.orig/BLAS/TESTING/zblat2.f Thu Nov 4 14:23:27 1999
+++ LAPACK/BLAS/TESTING/zblat2.f Fri May 25 15:57:52 2001
@@ -64,6 +64,10 @@
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
@@ -127,7 +131,7 @@
*
READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT
- OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT
*
* Read name and unit number for snapshot output file and open file.
@@ -136,7 +140,7 @@
READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0
IF( TRACE )THEN
- OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+ OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF
* Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI
diff -uNr LAPACK.orig/BLAS/TESTING/zblat3.f LAPACK/BLAS/TESTING/zblat3.f
--- LAPACK.orig/BLAS/TESTING/zblat3.f Thu Nov 4 14:23:27 1999
+++ LAPACK/BLAS/TESTING/zblat3.f Fri May 25 15:58:16 2001
@@ -46,6 +46,10 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
*
+* 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
+* can be run multiple times without deleting generated
+* output files (susan)
+*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 5 )
@@ -104,7 +108,7 @@
*
READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT
- OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT
*
* Read name and unit number for snapshot output file and open file.
@@ -113,7 +117,7 @@
READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0
IF( TRACE )THEN
- OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+ OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF
* Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI
@@ -1962,6 +1966,7 @@
* 3-19-92: Initialize ALPHA, BETA, RALPHA, and RBETA (eca)
* 3-19-92: Fix argument 12 in calls to ZSYMM and ZHEMM
* with INFOT = 9 (eca)
+* 10-9-00: Declared INTRINSIC DCMPLX (susan)
*
* .. Scalar Arguments ..
INTEGER ISNUM, NOUT
@@ -1980,6 +1985,8 @@
* .. External Subroutines ..
EXTERNAL ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM,
$ ZSYR2K, ZSYRK, ZTRMM, ZTRSM
+* .. Intrinsic Functions ..
+ INTRINSIC DCMPLX
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Executable Statements ..
diff -uNr LAPACK.orig/INSTALL/make.inc.LINUX LAPACK/INSTALL/make.inc.LINUX
--- LAPACK.orig/INSTALL/make.inc.LINUX Thu Nov 4 14:23:30 1999
+++ LAPACK/INSTALL/make.inc.LINUX Fri May 25 15:58:36 2001
@@ -17,7 +17,7 @@
# desired load options for your machine.
#
FORTRAN = g77
-OPTS = -funroll-all-loops -fno-f2c -O3
+OPTS = -funroll-all-loops -O3
DRVOPTS = $(OPTS)
NOOPT =
LOADER = g77
diff -uNr LAPACK.orig/SRC/cbdsqr.f LAPACK/SRC/cbdsqr.f
--- LAPACK.orig/SRC/cbdsqr.f Thu Nov 4 14:23:31 1999
+++ LAPACK/SRC/cbdsqr.f Fri May 25 15:59:05 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -18,14 +18,26 @@
* Purpose
* =======
*
-* CBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
-*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given complex input matrices U, VT, and C.
+* CBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**H
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**H*VT instead of
+* P**H, for given complex input matrices U and VT. When U and VT are
+* the unitary matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by CGEBRD, then
+*
+* A = (U*Q) * S * (P**H*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**H*C
+* for a given complex input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -61,18 +73,17 @@
* order.
*
* E (input/output) REAL array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) COMPLEX array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**H * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -81,21 +92,22 @@
* U (input/output) COMPLEX array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) COMPLEX array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**H * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* RWORK (workspace) REAL array, dimension (4*N)
+* RWORK (workspace) REAL array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/SRC/cgebd2.f LAPACK/SRC/cgebd2.f
--- LAPACK.orig/SRC/cgebd2.f Thu Nov 4 14:24:07 1999
+++ LAPACK/SRC/cgebd2.f Fri May 25 15:59:27 2001
@@ -3,7 +3,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* May 7, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
@@ -172,8 +172,9 @@
*
* Apply H(i)' to A(i:m,i+1:n) from the left
*
- CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
- $ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
+ IF( I.LT.N )
+ $ CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
+ $ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
A( I, I ) = D( I )
*
IF( I.LT.N ) THEN
@@ -215,8 +216,9 @@
*
* Apply G(i) to A(i+1:m,i:n) from the right
*
- CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAUP( I ),
- $ A( MIN( I+1, M ), I ), LDA, WORK )
+ IF( I.LT.M )
+ $ CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
+ $ TAUP( I ), A( MIN( I+1, M ), I ), LDA, WORK )
CALL CLACGV( N-I+1, A( I, I ), LDA )
A( I, I ) = D( I )
*
diff -uNr LAPACK.orig/SRC/cgees.f LAPACK/SRC/cgees.f
--- LAPACK.orig/SRC/cgees.f Thu Nov 4 14:24:08 1999
+++ LAPACK/SRC/cgees.f Fri May 25 15:59:55 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SORT
@@ -89,10 +90,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (N)
*
@@ -120,11 +120,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTST, WANTVS
+ LOGICAL SCALEA, WANTST, WANTVS
INTEGER HSWORK, I, IBAL, ICOND, IERR, IEVAL, IHI, ILO,
$ ITAU, IWRK, K, MAXB, MAXWRK, MINWRK
REAL ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
@@ -150,7 +152,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVS = LSAME( JOBVS, 'V' )
WANTST = LSAME( SORT, 'S' )
IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
@@ -177,7 +178,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'CGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 2*N )
IF( .NOT.WANTVS ) THEN
@@ -196,19 +197,17 @@
MAXWRK = MAX( MAXWRK, HSWORK, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGEES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/cgeesx.f LAPACK/SRC/cgeesx.f
--- LAPACK.orig/SRC/cgeesx.f Thu Nov 4 14:24:08 1999
+++ LAPACK/SRC/cgeesx.f Fri May 25 16:00:18 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SENSE, SORT
@@ -119,6 +120,10 @@
* this routine. Note that 2*SDIM*(N-SDIM) <= N*N/2.
* For good performance, LWORK must generally be larger.
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* RWORK (workspace) REAL array, dimension (N)
*
* BWORK (workspace) LOGICAL array, dimension (N)
@@ -144,6 +149,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
@@ -211,7 +218,7 @@
* in the code.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'CGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 2*N )
IF( .NOT.WANTVS ) THEN
@@ -229,18 +236,24 @@
HSWORK = MAX( K*( K+2 ), 2*N )
MAXWRK = MAX( MAXWRK, HSWORK, 1 )
END IF
+*
+* Estimate the workspace needed by CTRSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, (N*N+1)/2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ & INFO = -15
END IF
- IF( LWORK.LT.MINWRK ) THEN
- INFO = -15
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGEESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/cgeev.f LAPACK/SRC/cgeev.f
--- LAPACK.orig/SRC/cgeev.f Thu Nov 4 14:24:08 1999
+++ LAPACK/SRC/cgeev.f Fri May 25 16:00:48 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -85,10 +86,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (2*N)
*
@@ -103,11 +103,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
+ LOGICAL SCALEA, WANTVL, WANTVR
CHARACTER SIDE
INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
$ IWRK, K, MAXB, MAXWRK, MINWRK, NOUT
@@ -136,7 +138,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
@@ -165,7 +166,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'CGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 2*N )
@@ -185,19 +186,17 @@
MAXWRK = MAX( MAXWRK, HSWORK, 2*N )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGEEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/cgeevx.f LAPACK/SRC/cgeevx.f
--- LAPACK.orig/SRC/cgeevx.f Thu Nov 4 14:24:08 1999
+++ LAPACK/SRC/cgeevx.f Fri May 25 16:01:10 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -166,10 +167,9 @@
* LWORK >= N*N+2*N.
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (2*N)
*
@@ -184,12 +184,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
- $ WNTSNN, WNTSNV
+ LOGICAL SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, WNTSNN,
+ $ WNTSNV
CHARACTER JOB, SIDE
INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXB,
$ MAXWRK, MINWRK, NOUT
@@ -219,7 +221,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
WNTSNN = LSAME( SENSE, 'N' )
@@ -259,7 +260,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'CGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 2*N )
@@ -293,19 +294,17 @@
MAXWRK = MAX( MAXWRK, 2*N, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -20
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGEEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/cgegs.f LAPACK/SRC/cgegs.f
--- LAPACK.orig/SRC/cgegs.f Thu Nov 4 14:24:08 1999
+++ LAPACK/SRC/cgegs.f Fri May 25 16:01:59 2001
@@ -5,7 +5,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR
@@ -23,83 +23,70 @@
*
* This routine is deprecated and has been replaced by routine CGGES.
*
-* CGEGS computes for a pair of N-by-N complex nonsymmetric matrices A,
-* B: the generalized eigenvalues (alpha, beta), the complex Schur
-* form (A, B), and optionally left and/or right Schur vectors
-* (VSL and VSR).
-*
-* (If only the generalized eigenvalues are needed, use the driver CGEGV
-* instead.)
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* The (generalized) Schur form of a pair of matrices is the result of
-* multiplying both matrices on the left by one unitary matrix and
-* both on the right by another unitary matrix, these two unitary
-* matrices being chosen so as to bring the pair of matrices into
-* upper triangular form with the diagonal elements of B being
-* non-negative real numbers (this is also called complex Schur form.)
-*
-* The left and right Schur vectors are the columns of VSL and VSR,
-* respectively, where VSL and VSR are the unitary matrices
-* which reduce A and B to Schur form:
-*
-* Schur form of (A,B) = ( (VSL)**H A (VSR), (VSL)**H B (VSR) )
+* CGEGS computes the eigenvalues, Schur form, and, optionally, the
+* left and or/right Schur vectors of a complex matrix pair (A,B).
+* Given two square matrices A and B, the generalized Schur
+* factorization has the form
+*
+* A = Q*S*Z**H, B = Q*T*Z**H
+*
+* where Q and Z are unitary matrices and S and T are upper triangular.
+* The columns of Q are the left Schur vectors
+* and the columns of Z are the right Schur vectors.
+*
+* If only the eigenvalues of (A,B) are needed, the driver routine
+* CGEGV should be used instead. See CGEGV for a description of the
+* eigenvalues of the generalized nonsymmetric eigenvalue problem
+* (GNEP).
*
* Arguments
* =========
*
* JOBVSL (input) CHARACTER*1
* = 'N': do not compute the left Schur vectors;
-* = 'V': compute the left Schur vectors.
+* = 'V': compute the left Schur vectors (returned in VSL).
*
* JOBVSR (input) CHARACTER*1
* = 'N': do not compute the right Schur vectors;
-* = 'V': compute the right Schur vectors.
+* = 'V': compute the right Schur vectors (returned in VSR).
*
* N (input) INTEGER
* The order of the matrices A, B, VSL, and VSR. N >= 0.
*
* A (input/output) COMPLEX array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose generalized
-* eigenvalues and (optionally) Schur vectors are to be
-* computed.
-* On exit, the generalized Schur form of A.
+* On entry, the matrix A.
+* On exit, the upper triangular matrix S from the generalized
+* Schur factorization.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) COMPLEX array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) Schur vectors are
-* to be computed.
-* On exit, the generalized Schur form of B.
+* On entry, the matrix B.
+* On exit, the upper triangular matrix T from the generalized
+* Schur factorization.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHA (output) COMPLEX array, dimension (N)
+* The complex scalars alpha that define the eigenvalues of
+* GNEP. ALPHA(j) = S(j,j), the diagonal element of the Schur
+* form of A.
+*
* BETA (output) COMPLEX array, dimension (N)
-* On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
-* generalized eigenvalues. ALPHA(j), j=1,...,N and BETA(j),
-* j=1,...,N are the diagonals of the complex Schur form (A,B)
-* output by CGEGS. The BETA(j) will be non-negative real.
-*
-* Note: the quotients ALPHA(j)/BETA(j) may easily over- or
-* underflow, and BETA(j) may even be zero. Thus, the user
-* should avoid naively computing the ratio alpha/beta.
-* However, ALPHA will be always less than and usually
-* comparable with norm(A) in magnitude, and BETA always less
-* than and usually comparable with norm(B).
+* The non-negative real scalars beta that define the
+* eigenvalues of GNEP. BETA(j) = T(j,j), the diagonal element
+* of the triangular factor T.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
*
* VSL (output) COMPLEX array, dimension (LDVSL,N)
-* If JOBVSL = 'V', VSL will contain the left Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSL = 'V', the matrix of left Schur vectors Q.
* Not referenced if JOBVSL = 'N'.
*
* LDVSL (input) INTEGER
@@ -107,8 +94,7 @@
* if JOBVSL = 'V', LDVSL >= N.
*
* VSR (output) COMPLEX array, dimension (LDVSR,N)
-* If JOBVSR = 'V', VSR will contain the right Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSR = 'V', the matrix of right Schur vectors Z.
* Not referenced if JOBVSR = 'N'.
*
* LDVSR (input) INTEGER
diff -uNr LAPACK.orig/SRC/cgegv.f LAPACK/SRC/cgegv.f
--- LAPACK.orig/SRC/cgegv.f Thu Nov 4 14:24:08 1999
+++ LAPACK/SRC/cgegv.f Fri May 25 16:02:21 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -22,22 +22,28 @@
*
* This routine is deprecated and has been replaced by routine CGGEV.
*
-* CGEGV computes for a pair of N-by-N complex nonsymmetric matrices A
-* and B, the generalized eigenvalues (alpha, beta), and optionally,
-* the left and/or right generalized eigenvectors (VL and VR).
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* A right generalized eigenvector corresponding to a generalized
-* eigenvalue w for a pair of matrices (A,B) is a vector r such
-* that (A - w B) r = 0 . A left generalized eigenvector is a vector
-* l such that l**H * (A - w B) = 0, where l**H is the
-* conjugate-transpose of l.
+* CGEGV computes the eigenvalues and, optionally, the left and/or right
+* eigenvectors of a complex matrix pair (A,B).
+* Given two square matrices A and B,
+* the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+* eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+* that
+* A*x = lambda*B*x.
+*
+* An alternate form is to find the eigenvalues mu and corresponding
+* eigenvectors y such that
+* mu*A*y = B*y.
+*
+* These two forms are equivalent with mu = 1/lambda and x = y if
+* neither lambda nor mu is zero. In order to deal with the case that
+* lambda or mu is zero or small, two values alpha and beta are returned
+* for each eigenvalue, such that lambda = alpha/beta and
+* mu = beta/alpha.
+*
+* The vectors x and y in the above equations are right eigenvectors of
+* the matrix pair (A,B). Vectors u and v satisfying
+* u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+* are left eigenvectors of (A,B).
*
* Note: this routine performs "full balancing" on A and B -- see
* "Further Details", below.
@@ -47,56 +53,62 @@
*
* JOBVL (input) CHARACTER*1
* = 'N': do not compute the left generalized eigenvectors;
-* = 'V': compute the left generalized eigenvectors.
+* = 'V': compute the left generalized eigenvectors (returned
+* in VL).
*
* JOBVR (input) CHARACTER*1
* = 'N': do not compute the right generalized eigenvectors;
-* = 'V': compute the right generalized eigenvectors.
+* = 'V': compute the right generalized eigenvectors (returned
+* in VR).
*
* N (input) INTEGER
* The order of the matrices A, B, VL, and VR. N >= 0.
*
* A (input/output) COMPLEX array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of A on exit, see "Further
-* Details", below.)
+* On entry, the matrix A.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit A
+* contains the Schur form of A from the generalized Schur
+* factorization of the pair (A,B) after balancing. If no
+* eigenvectors were computed, then only the diagonal elements
+* of the Schur form will be correct. See CGGHRD and CHGEQZ
+* for details.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) COMPLEX array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of B on exit, see "Further
-* Details", below.)
+* On entry, the matrix B.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+* upper triangular matrix obtained from B in the generalized
+* Schur factorization of the pair (A,B) after balancing.
+* If no eigenvectors were computed, then only the diagonal
+* elements of B will be correct. See CGGHRD and CHGEQZ for
+* details.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHA (output) COMPLEX array, dimension (N)
-* BETA (output) COMPLEX array, dimension (N)
-* On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
-* generalized eigenvalues.
+* The complex scalars alpha that define the eigenvalues of
+* GNEP.
*
-* Note: the quotients ALPHA(j)/BETA(j) may easily over- or
-* underflow, and BETA(j) may even be zero. Thus, the user
-* should avoid naively computing the ratio alpha/beta.
-* However, ALPHA will be always less than and usually
-* comparable with norm(A) in magnitude, and BETA always less
-* than and usually comparable with norm(B).
+* BETA (output) COMPLEX array, dimension (N)
+* The complex scalars beta that define the eigenvalues of GNEP.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
+
*
* VL (output) COMPLEX array, dimension (LDVL,N)
-* If JOBVL = 'V', the left generalized eigenvectors. (See
-* "Purpose", above.)
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVL = 'V', the left eigenvectors u(j) are stored
+* in the columns of VL, in the same order as their eigenvalues.
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvectors
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVL = 'N'.
*
* LDVL (input) INTEGER
@@ -104,12 +116,12 @@
* if JOBVL = 'V', LDVL >= N.
*
* VR (output) COMPLEX array, dimension (LDVR,N)
-* If JOBVR = 'V', the right generalized eigenvectors. (See
-* "Purpose", above.)
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVR = 'V', the right eigenvectors x(j) are stored
+* in the columns of VR, in the same order as their eigenvalues.
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvectors
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVR = 'N'.
*
* LDVR (input) INTEGER
diff -uNr LAPACK.orig/SRC/cgelsd.f LAPACK/SRC/cgelsd.f
--- LAPACK.orig/SRC/cgelsd.f Thu Nov 4 14:26:25 1999
+++ LAPACK/SRC/cgelsd.f Fri May 25 16:03:27 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -64,7 +65,8 @@
*
* A (input/output) COMPLEX array, dimension (LDA,N)
* On entry, the M-by-N matrix A.
-* On exit, A has been destroyed.
+* On exit, the first min(m,n) rows of A are overwritten with
+* its right singular vectors, stored rowwise.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
@@ -96,32 +98,24 @@
* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*
* LWORK (input) INTEGER
-* The dimension of the array WORK. LWORK must be at least 1.
+* The dimension of the array WORK. LWORK >= 1.
* The exact minimum amount of workspace needed depends on M,
-* N and NRHS. As long as LWORK is at least
-* 2 * N + N * NRHS
-* if M is greater than or equal to N or
-* 2 * M + M * NRHS
-* if M is less than N, the code will execute correctly.
+* N and NRHS.
+* If M >= N, LWORK >= 2*N + N*NRHS.
+* If M < N, LWORK >= 2*M + M*NRHS.
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
-*
-*
-* RWORK (workspace) REAL array, dimension at least
-* 10*N + 2*N*SMLSIZ + 8*N*NLVL + 3*SMLSIZ*NRHS +
-* (SMLSIZ+1)**2
-* if M is greater than or equal to N or
-* 10*M + 2*M*SMLSIZ + 8*M*NLVL + 3*SMLSIZ*NRHS +
-* (SMLSIZ+1)**2
-* if M is less than N, the code will execute correctly.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
+* RWORK (workspace) REAL array, dimension (LRWORK)
+* If M >= N, LRWORK >= 8*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS.
+* If M < N, LRWORK >= 8*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS.
* SMLSIZ is returned by ILAENV and is equal to the maximum
* size of the subproblems at the bottom of the computation
* tree (usually about 25), and
-* NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+* NLVL = INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1
*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
* LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
@@ -145,13 +139,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
COMPLEX CZERO
PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY
INTEGER IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
$ LDWORK, MAXMN, MAXWRK, MINMN, MINWRK, MM,
$ MNTHR, NRWORK, NWORK, SMLSIZ
@@ -179,7 +174,6 @@
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
MNTHR = ILAENV( 6, 'CGELSD', ' ', M, N, NRHS, -1 )
- LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@@ -263,20 +257,17 @@
END IF
MINWRK = MIN( MINWRK, MAXWRK )
WORK( 1 ) = CMPLX( MAXWRK, 0 )
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGELSD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- GO TO 10
END IF
-*
-* Quick return if possible.
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
diff -uNr LAPACK.orig/SRC/cgelss.f LAPACK/SRC/cgelss.f
--- LAPACK.orig/SRC/cgelss.f Thu Nov 4 14:24:09 1999
+++ LAPACK/SRC/cgelss.f Fri May 25 16:03:50 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -87,10 +87,9 @@
* LWORK >= 2*min(M,N) + max(M,N,NRHS)
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (5*min(M,N))
*
@@ -164,7 +163,7 @@
* immediately following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -235,19 +234,18 @@
MINWRK = MAX( MINWRK, 1 )
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGELSS', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
-*
-* Quick return if possible
-*
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
@@ -512,8 +510,8 @@
DO 40 I = 1, NRHS, CHUNK
BL = MIN( NRHS-I+1, CHUNK )
CALL CGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, CZERO, WORK( IWORK ), N )
- CALL CLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ $ B( 1, I ), LDB, CZERO, WORK( IWORK ), M )
+ CALL CLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/SRC/cgesdd.f LAPACK/SRC/cgesdd.f
--- LAPACK.orig/SRC/cgesdd.f Thu Nov 11 20:32:54 1999
+++ LAPACK/SRC/cgesdd.f Fri May 25 16:08:03 2001
@@ -1,10 +1,11 @@
- SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
- $ LWORK, RWORK, IWORK, INFO )
+ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT,
+ $ WORK, LWORK, RWORK, IWORK, INFO )
*
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBZ
@@ -119,12 +120,14 @@
* if JOBZ = 'S' or 'A',
* LWORK >= min(M,N)*min(M,N)+2*min(M,N)+max(M,N).
* For good performance, LWORK should generally be larger.
-* If LWORK < 0 but other input arguments are legal, WORK(1)
-* returns the optimal LWORK.
+*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (LRWORK)
-* If JOBZ = 'N', LRWORK >= 7*min(M,N).
-* Otherwise, LRWORK >= 5*min(M,N)*min(M,N) + 5*min(M,N)
+* If JOBZ = 'N', LRWORK >= 5*min(M,N).
+* Otherwise, LRWORK >= 5*min(M,N)*min(M,N) + 7*min(M,N)
*
* IWORK (workspace) INTEGER array, dimension (8*min(M,N))
*
@@ -143,14 +146,16 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
COMPLEX CZERO, CONE
- PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ),
- $ CONE = ( 1.0E0, 0.0E0 ) )
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
+ $ CONE = ( 1.0E+0, 0.0E+0 ) )
REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
+ LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
INTEGER BLK, CHUNK, I, IE, IERR, IL, IR, IRU, IRVT,
$ ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT,
$ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK,
@@ -162,15 +167,17 @@
REAL DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL CGEBRD, CGELQF, CGEMM, CGEQRF, CLACP2, CLACPY,
- $ CLACRM, CLARCM, CLASCL, CLASET, CUNGBR, CUNGLQ,
- $ CUNGQR, CUNMBR, SBDSDC, SLASCL, XERBLA
+ EXTERNAL CGEBRD, CGELQF, CGEMM, CGEQRF,
+ $ CLACP2, CLACPY, CLACRM, CLARCM,
+ $ CLASCL, CLASET, CUNGBR, CUNGLQ,
+ $ CUNGQR, CUNMBR, SBDSDC, SLASCL,
+ $ XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
REAL CLANGE, SLAMCH
- EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH
+ EXTERNAL CLANGE, SLAMCH, ILAENV, LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, SQRT
@@ -181,8 +188,8 @@
*
INFO = 0
MINMN = MIN( M, N )
- MNTHR1 = INT( MINMN*17.0E0 / 9.0E0 )
- MNTHR2 = INT( MINMN*5.0E0 / 3.0E0 )
+ MNTHR1 = INT( MINMN*17.0 / 9.0 )
+ MNTHR2 = INT( MINMN*5.0 / 3.0 )
WNTQA = LSAME( JOBZ, 'A' )
WNTQS = LSAME( JOBZ, 'S' )
WNTQAS = WNTQA .OR. WNTQS
@@ -190,7 +197,6 @@
WNTQN = LSAME( JOBZ, 'N' )
MINWRK = 1
MAXWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
*
IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN
INFO = -1
@@ -221,19 +227,21 @@
IF( M.GE.N ) THEN
*
* There is no complex work space needed for bidiagonal SVD
-* The real work space needed for bidiagonal SVD is BDSPAC,
-* BDSPAC = 3*N*N + 4*N
+* The real work space needed for bidiagonal SVD is BDSPAC
+* for computing singular values and singular vectors; BDSPAN
+* for computing singular values only.
+* BDSPAC = 5*N*N + 7*N
+* BDSPAN = MAX(7*N+4, 3*N+2+SMLSIZ*(SMLSIZ+8))
*
IF( M.GE.MNTHR1 ) THEN
IF( WNTQN ) THEN
*
* Path 1 (M much larger than N, JOBZ='N')
*
- WRKBL = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 2*N+2*N*
- $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) )
- MAXWRK = WRKBL
+ MAXWRK = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1,
+ $ -1 )
+ MAXWRK = MAX( MAXWRK, 2*N+2*N*
+ $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) )
MINWRK = 3*N
ELSE IF( WNTQO ) THEN
*
@@ -335,8 +343,11 @@
ELSE
*
* There is no complex work space needed for bidiagonal SVD
-* The real work space needed for bidiagonal SVD is BDSPAC,
-* BDSPAC = 3*M*M + 4*M
+* The real work space needed for bidiagonal SVD is BDSPAC
+* for computing singular values and singular vectors; BDSPAN
+* for computing singular values only.
+* BDSPAC = 5*M*M + 7*M
+* BDSPAN = MAX(7*M+4, 3*M+2+SMLSIZ*(SMLSIZ+8))
*
IF( N.GE.MNTHR1 ) THEN
IF( WNTQN ) THEN
@@ -447,24 +458,21 @@
END IF
END IF
MAXWRK = MAX( MAXWRK, MINWRK )
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGESDD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
@@ -529,7 +537,7 @@
*
* Perform bidiagonal SVD, compute singular values only
* (CWorkspace: 0)
-* (RWorkspace: need BDSPAC)
+* (RWorkspace: need BDSPAN)
*
CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -844,7 +852,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1040,7 +1048,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1205,8 +1213,8 @@
ELSE
*
* A has more columns than rows. If A has sufficiently more
-* columns than rows, first reduce using the LQ decomposition
-* (if sufficient workspace available)
+* columns than rows, first reduce using the LQ decomposition (if
+* sufficient workspace available)
*
IF( N.GE.MNTHR1 ) THEN
*
@@ -1245,7 +1253,7 @@
*
* Perform bidiagonal SVD, compute singular values only
* (CWorkspace: 0)
-* (RWorkspace: need BDSPAC)
+* (RWorkspace: need BDSPAN)
*
CALL SBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1531,8 +1539,8 @@
* (CWorkspace: need M*M)
* (RWorkspace: 0)
*
- CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT,
- $ VT, LDVT, CZERO, A, LDA )
+ CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ),
+ $ LDWKVT, VT, LDVT, CZERO, A, LDA )
*
* Copy right singular vectors of A from A to VT
*
@@ -1567,7 +1575,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1763,7 +1771,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1934,9 +1942,15 @@
IF( ANRM.GT.BIGNUM )
$ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
+ $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1,
+ $ RWORK( IE ), MINMN, IERR )
IF( ANRM.LT.SMLNUM )
$ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
+ $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1,
+ $ RWORK( IE ), MINMN, IERR )
END IF
*
* Return optimal workspace in WORK(1)
diff -uNr LAPACK.orig/SRC/cgesvd.f LAPACK/SRC/cgesvd.f
--- LAPACK.orig/SRC/cgesvd.f Thu Nov 4 14:24:09 1999
+++ LAPACK/SRC/cgesvd.f Fri May 25 16:08:29 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBU, JOBVT
@@ -114,12 +115,12 @@
* LWORK >= 2*MIN(M,N)+MAX(M,N).
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
-* RWORK (workspace) REAL array, dimension (5*min(M,N))
+* RWORK (workspace) REAL array, dimension
+* (5*min(M,N))
* On exit, if INFO > 0, RWORK(1:MIN(M,N)-1) contains the
* unconverged superdiagonal elements of an upper bidiagonal
* matrix B whose diagonal is in S (not necessarily sorted).
@@ -137,6 +138,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
COMPLEX CZERO, CONE
PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ),
$ CONE = ( 1.0E0, 0.0E0 ) )
@@ -144,8 +147,8 @@
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
- $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
+ LOGICAL WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS, WNTVA,
+ $ WNTVAS, WNTVN, WNTVO, WNTVS
INTEGER BLK, CHUNK, I, IE, IERR, IR, IRWORK, ISCL,
$ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
$ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
@@ -188,7 +191,7 @@
WNTVO = LSAME( JOBVT, 'O' )
WNTVN = LSAME( JOBVT, 'N' )
MINWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
+ MAXWRK = 1
*
IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
INFO = -1
@@ -216,8 +219,7 @@
* real workspace. NB refers to the optimal block size for the
* immediately following subroutine, as returned by ILAENV.)
*
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
- $ N.GT.0 ) THEN
+ IF( INFO.EQ.0 .AND. M.GT.0 .AND. N.GT.0 ) THEN
IF( M.GE.N ) THEN
*
* Space needed for CBDSQR is BDSPAC = 5*N
@@ -543,24 +545,21 @@
MAXWRK = MAX( MINWRK, MAXWRK )
END IF
END IF
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGESVD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
diff -uNr LAPACK.orig/SRC/cggbak.f LAPACK/SRC/cggbak.f
--- LAPACK.orig/SRC/cggbak.f Thu Nov 4 14:24:10 1999
+++ LAPACK/SRC/cggbak.f Fri May 25 16:09:01 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* February 1, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB, SIDE
@@ -109,10 +109,15 @@
INFO = -3
ELSE IF( ILO.LT.1 ) THEN
INFO = -4
- ELSE IF( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) THEN
+ ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
+ INFO = -4
+ ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
+ $ THEN
+ INFO = -5
+ ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
INFO = -5
ELSE IF( M.LT.0 ) THEN
- INFO = -6
+ INFO = -8
ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
INFO = -10
END IF
diff -uNr LAPACK.orig/SRC/cggbal.f LAPACK/SRC/cggbal.f
--- LAPACK.orig/SRC/cggbal.f Thu Nov 4 14:24:10 1999
+++ LAPACK/SRC/cggbal.f Fri May 25 16:09:22 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 12, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB
@@ -150,7 +150,7 @@
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -5
+ INFO = -6
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGGBAL', -INFO )
@@ -197,8 +197,8 @@
IF( L.NE.1 )
$ GO TO 30
*
- RSCALE( 1 ) = 1
- LSCALE( 1 ) = 1
+ RSCALE( 1 ) = ONE
+ LSCALE( 1 ) = ONE
GO TO 190
*
30 CONTINUE
@@ -256,7 +256,7 @@
* Permute rows M and I
*
160 CONTINUE
- LSCALE( M ) = I
+ LSCALE( M ) = REAL( I )
IF( I.EQ.M )
$ GO TO 170
CALL CSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
@@ -265,7 +265,7 @@
* Permute columns M and J
*
170 CONTINUE
- RSCALE( M ) = J
+ RSCALE( M ) = REAL( J )
IF( J.EQ.M )
$ GO TO 180
CALL CSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
@@ -437,7 +437,7 @@
DO 360 I = ILO, IHI
IRAB = ICAMAX( N-ILO+1, A( I, ILO ), LDA )
RAB = ABS( A( I, IRAB+ILO-1 ) )
- IRAB = ICAMAX( N-ILO+1, B( I, ILO ), LDA )
+ IRAB = ICAMAX( N-ILO+1, B( I, ILO ), LDB )
RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
diff -uNr LAPACK.orig/SRC/cgges.f LAPACK/SRC/cgges.f
--- LAPACK.orig/SRC/cgges.f Thu Nov 4 14:26:17 1999
+++ LAPACK/SRC/cgges.f Fri May 25 16:09:43 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SORT
@@ -145,10 +146,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (8*N)
*
@@ -173,6 +173,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
COMPLEX CZERO, CONE
@@ -181,7 +183,7 @@
* ..
* .. Local Scalars ..
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, WANTST
+ $ WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKMIN,
$ LWKOPT
@@ -237,7 +239,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -264,7 +265,7 @@
* following subroutine, as returned by ILAENV.)
*
LWKMIN = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
LWKMIN = MAX( 1, 2*N )
LWKOPT = N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 )
IF( ILVSL ) THEN
@@ -272,21 +273,17 @@
$ -1 ) )
END IF
WORK( 1 ) = LWKOPT
+ IF( LWORK.LT.LWKMIN .AND. LWORK.NE.LQUERV )
+ $ INFO = -18
END IF
*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
- $ INFO = -18
+* Quick return if possible
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGGES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
- WORK( 1 ) = LWKOPT
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/cggesx.f LAPACK/SRC/cggesx.f
--- LAPACK.orig/SRC/cggesx.f Thu Nov 4 14:26:17 1999
+++ LAPACK/SRC/cggesx.f Fri May 25 16:10:00 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
@@ -167,6 +168,10 @@
* If SENSE = 'E', 'V', or 'B',
* LWORK >= MAX(2*N, 2*SDIM*(N-SDIM)).
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* RWORK (workspace) REAL array, dimension ( 8*N )
* Real workspace.
*
@@ -198,6 +203,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
COMPLEX CZERO, CONE
@@ -304,14 +311,22 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
MINWRK = MAX( 1, 2*N )
MAXWRK = N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 )
IF( ILVSL ) THEN
MAXWRK = MAX( MAXWRK, N+N*ILAENV( 1, 'CUNGQR', ' ', N, 1, N,
$ -1 ) )
END IF
+*
+* Estimate the workspace needed by CTGSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, (N*N+1)/2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -21
END IF
IF( .NOT.WANTSN ) THEN
LIWMIN = N+2
@@ -319,21 +334,18 @@
LIWMIN = 1
END IF
IWORK( 1 ) = LIWMIN
-*
- IF( INFO.EQ.0 .AND. LWORK.LT.MINWRK ) THEN
- INFO = -21
- ELSE IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
+ IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
IF( LIWORK.LT.LIWMIN )
$ INFO = -24
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGGESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/cggev.f LAPACK/SRC/cggev.f
--- LAPACK.orig/SRC/cggev.f Thu Nov 4 14:26:17 1999
+++ LAPACK/SRC/cggev.f Fri May 25 16:10:19 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -113,10 +114,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace/output) REAL array, dimension (8*N)
*
@@ -133,6 +133,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
COMPLEX CZERO, CONE
@@ -140,7 +142,7 @@
$ CONE = ( 1.0E0, 0.0E0 ) )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR
CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
@@ -202,7 +204,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -228,25 +229,21 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
LWKMIN = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
LWKOPT = N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 )
LWKMIN = MAX( 1, 2*N )
WORK( 1 ) = LWKOPT
+ IF( LWORK.LT.LWKMIN .AND. LWORK.NE.LQUERV )
+ $ INFO = -15
END IF
*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
- $ INFO = -15
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGGEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
- WORK( 1 ) = LWKOPT
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/cggevx.f LAPACK/SRC/cggevx.f
--- LAPACK.orig/SRC/cggevx.f Thu Nov 4 14:26:17 1999
+++ LAPACK/SRC/cggevx.f Fri May 25 16:11:36 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -194,10 +195,9 @@
* If SENSE = 'N' or 'E', LWORK >= 2*N.
* If SENSE = 'V' or 'B', LWORK >= 2*N*N+2*N.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (6*N)
* Real workspace.
@@ -247,6 +247,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
COMPLEX CZERO, CONE
@@ -254,8 +256,8 @@
$ CONE = ( 1.0E+0, 0.0E+0 ) )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY,
- $ WANTSB, WANTSE, WANTSN, WANTSV
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, WANTSB,
+ $ WANTSE, WANTSN, WANTSV
CHARACTER CHTEMP
INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
$ ITAU, IWRK, IWRK1, J, JC, JR, M, MAXWRK, MINWRK
@@ -321,7 +323,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC,
$ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
$ THEN
@@ -354,7 +355,7 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 )
IF( WANTSE ) THEN
MINWRK = MAX( 1, 2*N )
@@ -363,21 +364,17 @@
MAXWRK = MAX( MAXWRK, 2*N*N+2*N )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -25
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -25
- END IF
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGGEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/cgghrd.f LAPACK/SRC/cgghrd.f
--- LAPACK.orig/SRC/cgghrd.f Thu Nov 4 14:25:42 1999
+++ LAPACK/SRC/cgghrd.f Fri May 25 16:11:54 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -20,16 +20,29 @@
*
* CGGHRD reduces a pair of complex matrices (A,B) to generalized upper
* Hessenberg form using unitary transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are unitary, and ' means conjugate transpose.
+* general matrix and B is upper triangular. The form of the generalized
+* eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the unitary matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**H*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**H*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**H*x.
*
* The unitary matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
* postmultiplied into input matrices Q1 and Z1, so that
-*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**H = (Q1*Q) * H * (Z1*Z)**H
+* Q1 * B * Z1**H = (Q1*Q) * T * (Z1*Z)**H
+* If Q1 is the unitary matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then CGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -53,10 +66,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to CGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to CGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) COMPLEX array, dimension (LDA, N)
@@ -70,33 +84,28 @@
*
* B (input/output) COMPLEX array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**H B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) COMPLEX array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the unitary matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain a unitary matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the unitary matrix Q1, typically
+* from the QR factorization of B.
+* On exit, if COMPQ='I', the unitary matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) COMPLEX array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the unitary matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain a unitary matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the unitary matrix Z1.
+* On exit, if COMPZ='I', the unitary matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/SRC/chbgst.f LAPACK/SRC/chbgst.f
--- LAPACK.orig/SRC/chbgst.f Thu Nov 4 14:23:31 1999
+++ LAPACK/SRC/chbgst.f Fri May 25 16:12:55 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 9, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO, VECT
@@ -131,7 +131,7 @@
INFO = -3
ELSE IF( KA.LT.0 ) THEN
INFO = -4
- ELSE IF( KB.LT.0 ) THEN
+ ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
INFO = -5
ELSE IF( LDAB.LT.KA+1 ) THEN
INFO = -7
diff -uNr LAPACK.orig/SRC/chgeqz.f LAPACK/SRC/chgeqz.f
--- LAPACK.orig/SRC/chgeqz.f Thu Nov 4 14:24:13 1999
+++ LAPACK/SRC/chgeqz.f Fri May 25 16:12:16 2001
@@ -1,43 +1,64 @@
- SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,
$ RWORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
REAL RWORK( * )
- COMPLEX A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), WORK( * ), Z( LDZ, * )
+ COMPLEX ALPHA( * ), BETA( * ), H( LDH, * ),
+ $ Q( LDQ, * ), T( LDT, * ), WORK( * ),
+ $ Z( LDZ, * )
* ..
*
* Purpose
* =======
*
-* CHGEQZ implements a single-shift version of the QZ
-* method for finding the generalized eigenvalues w(i)=ALPHA(i)/BETA(i)
-* of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* If JOB='S', then the pair (A,B) is simultaneously
-* reduced to Schur form (i.e., A and B are both upper triangular) by
-* applying one unitary tranformation (usually called Q) on the left and
-* another (usually called Z) on the right. The diagonal elements of
-* A are then ALPHA(1),...,ALPHA(N), and of B are BETA(1),...,BETA(N).
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the unitary
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* CHGEQZ computes the eigenvalues of a complex matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the single-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a complex matrix pair (A,B):
+*
+* A = Q1*H*Z1**H, B = Q1*T*Z1**H,
+*
+* as computed by CGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**H, T = Q*P*Z**H,
+*
+* where Q and Z are unitary matrices and S and P are upper triangular.
+*
+* Optionally, the unitary matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* unitary matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the unitary matrices from CGGHRD that reduced
+* the matrix pair (A,B) to generalized Hessenberg form, then the output
+* matrices Q1*Q and Z1*Z are the unitary factors from the generalized
+* Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**H, B = (Q1*Q)*P*(Z1*Z)**H.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T)
+* (equivalently, of (A,B)) are computed as a pair of complex values
+* (alpha,beta). If beta is nonzero, lambda = alpha / beta is an
+* eigenvalue of the generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* The values of alpha and beta for the i-th eigenvalue can be read
+* directly from the generalized Schur form: alpha = S(i,i),
+* beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -47,83 +68,88 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHA and BETA. A and B will not
-* necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHA and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Computer eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the conjugate
-* transpose of the unitary tranformation that is
-* applied to the left side of A and B to reduce them
-* to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain a unitary matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the unitary
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain a unitary matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) COMPLEX array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit A will have been destroyed.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) COMPLEX array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit B will have been destroyed.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) COMPLEX array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper triangular
+* matrix S from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of H matches that of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) COMPLEX array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of T matches that of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHA (output) COMPLEX array, dimension (N)
-* The diagonal elements of A when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues.
+* The complex scalars alpha that define the eigenvalues of
+* GNEP. ALPHA(i) = S(i,i) in the generalized Schur
+* factorization.
*
* BETA (output) COMPLEX array, dimension (N)
-* The diagonal elements of B when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues. A and B are normalized
-* so that BETA(1),...,BETA(N) are non-negative real numbers.
+* The real non-negative scalars beta that define the
+* eigenvalues of GNEP. BETA(i) = P(i,i) in the generalized
+* Schur factorization.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
*
* Q (input/output) COMPLEX array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the conjugate transpose of the
-* unitary transformations which are applied to A and B on
-* the left will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Q1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) COMPLEX array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the unitary transformations which
-* are applied to A and B on the right will be applied to the
-* array Z on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Z1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of right Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -145,13 +171,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -178,7 +203,7 @@
REAL ABSB, ANORM, ASCALE, ATOL, BNORM, BSCALE, BTOL,
$ C, SAFMIN, TEMP, TEMP2, TEMPR, ULP
COMPLEX ABI22, AD11, AD12, AD21, AD22, CTEMP, CTEMP2,
- $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T,
+ $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T1,
$ U12, X
* ..
* .. External Functions ..
@@ -255,9 +280,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -14
@@ -293,8 +318,8 @@
IN = IHI + 1 - ILO
SAFMIN = SLAMCH( 'S' )
ULP = SLAMCH( 'E' )*SLAMCH( 'B' )
- ANORM = CLANHS( 'F', IN, A( ILO, ILO ), LDA, RWORK )
- BNORM = CLANHS( 'F', IN, B( ILO, ILO ), LDB, RWORK )
+ ANORM = CLANHS( 'F', IN, H( ILO, ILO ), LDH, RWORK )
+ BNORM = CLANHS( 'F', IN, T( ILO, ILO ), LDT, RWORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -304,23 +329,23 @@
* Set Eigenvalues IHI+1:N
*
DO 10 J = IHI + 1, N
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = CONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = CONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL CSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL CSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL CSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL CSCAL( J, SIGNBC, H( 1, J ), 1 )
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL CSCAL( N, SIGNBC, Z( 1, J ), 1 )
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
10 CONTINUE
*
* If IHI < ILO, skip QZ steps
@@ -365,22 +390,22 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
* Special case: j=ILAST
*
IF( ILAST.EQ.ILO ) THEN
GO TO 60
ELSE
- IF( ABS1( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = CZERO
+ IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = CZERO
GO TO 60
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = CZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = CZERO
GO TO 50
END IF
*
@@ -388,30 +413,30 @@
*
DO 40 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS1( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = CZERO
+ IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = CZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = CZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = CZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- IF( ABS1( A( J, J-1 ) )*( ASCALE*ABS1( A( J+1,
- $ J ) ) ).LE.ABS1( A( J, J ) )*( ASCALE*ATOL ) )
+ IF( ABS1( H( J, J-1 ) )*( ASCALE*ABS1( H( J+1,
+ $ J ) ) ).LE.ABS1( H( J, J ) )*( ASCALE*ATOL ) )
$ ILAZR2 = .TRUE.
END IF
*
@@ -423,21 +448,21 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 20 JCH = J, ILAST - 1
- CTEMP = A( JCH, JCH )
- CALL CLARTG( CTEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = CZERO
- CALL CROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL CROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ CTEMP = H( JCH, JCH )
+ CALL CLARTG( CTEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = CZERO
+ CALL CROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL CROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, CONJG( S ) )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
- IF( ABS1( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS1( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 60
ELSE
@@ -445,35 +470,35 @@
GO TO 70
END IF
END IF
- B( JCH+1, JCH+1 ) = CZERO
+ T( JCH+1, JCH+1 ) = CZERO
20 CONTINUE
GO TO 50
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 30 JCH = J, ILAST - 1
- CTEMP = B( JCH, JCH+1 )
- CALL CLARTG( CTEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = CZERO
+ CTEMP = T( JCH, JCH+1 )
+ CALL CLARTG( CTEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = CZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL CROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL CROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL CROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL CROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, CONJG( S ) )
- CTEMP = A( JCH+1, JCH )
- CALL CLARTG( CTEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = CZERO
- CALL CROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL CROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ CTEMP = H( JCH+1, JCH )
+ CALL CLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = CZERO
+ CALL CROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL CROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL CROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -497,42 +522,42 @@
INFO = 2*N + 1
GO TO 210
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
50 CONTINUE
- CTEMP = A( ILAST, ILAST )
- CALL CLARTG( CTEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = CZERO
- CALL CROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL CROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ CTEMP = H( ILAST, ILAST )
+ CALL CLARTG( CTEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = CZERO
+ CALL CROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL CROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL CROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
*
60 CONTINUE
- ABSB = ABS( B( ILAST, ILAST ) )
+ ABSB = ABS( T( ILAST, ILAST ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = CONJG( B( ILAST, ILAST ) / ABSB )
- B( ILAST, ILAST ) = ABSB
+ SIGNBC = CONJG( T( ILAST, ILAST ) / ABSB )
+ T( ILAST, ILAST ) = ABSB
IF( ILSCHR ) THEN
- CALL CSCAL( ILAST-IFRSTM, SIGNBC, B( IFRSTM, ILAST ), 1 )
- CALL CSCAL( ILAST+1-IFRSTM, SIGNBC, A( IFRSTM, ILAST ),
+ CALL CSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 )
+ CALL CSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ),
$ 1 )
ELSE
- A( ILAST, ILAST ) = A( ILAST, ILAST )*SIGNBC
+ H( ILAST, ILAST ) = H( ILAST, ILAST )*SIGNBC
END IF
IF( ILZ )
$ CALL CSCAL( N, SIGNBC, Z( 1, ILAST ), 1 )
ELSE
- B( ILAST, ILAST ) = CZERO
+ T( ILAST, ILAST ) = CZERO
END IF
- ALPHA( ILAST ) = A( ILAST, ILAST )
- BETA( ILAST ) = B( ILAST, ILAST )
+ ALPHA( ILAST ) = H( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -565,7 +590,7 @@
* Compute the Shift.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.NE.IITER ) THEN
@@ -577,33 +602,33 @@
* We factor B as U*D, where U has unit diagonals, and
* compute (A*inv(D))*inv(U).
*
- U12 = ( BSCALE*B( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
+ U12 = ( BSCALE*T( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
ABI22 = AD22 - U12*AD21
*
- T = HALF*( AD11+ABI22 )
- RTDISC = SQRT( T**2+AD12*AD21-AD11*AD22 )
- TEMP = REAL( T-ABI22 )*REAL( RTDISC ) +
- $ AIMAG( T-ABI22 )*AIMAG( RTDISC )
+ T1 = HALF*( AD11+ABI22 )
+ RTDISC = SQRT( T1**2+AD12*AD21-AD11*AD22 )
+ TEMP = REAL( T1-ABI22 )*REAL( RTDISC ) +
+ $ AIMAG( T1-ABI22 )*AIMAG( RTDISC )
IF( TEMP.LE.ZERO ) THEN
- SHIFT = T + RTDISC
+ SHIFT = T1 + RTDISC
ELSE
- SHIFT = T - RTDISC
+ SHIFT = T1 - RTDISC
END IF
ELSE
*
* Exceptional shift. Chosen for no particularly good reason.
*
- ESHIFT = ESHIFT + CONJG( ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) ) )
+ ESHIFT = ESHIFT + CONJG( ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) ) )
SHIFT = ESHIFT
END IF
*
@@ -611,46 +636,46 @@
*
DO 80 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- CTEMP = ASCALE*A( J, J ) - SHIFT*( BSCALE*B( J, J ) )
+ CTEMP = ASCALE*H( J, J ) - SHIFT*( BSCALE*T( J, J ) )
TEMP = ABS1( CTEMP )
- TEMP2 = ASCALE*ABS1( A( J+1, J ) )
+ TEMP2 = ASCALE*ABS1( H( J+1, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS1( A( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
+ IF( ABS1( H( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
$ GO TO 90
80 CONTINUE
*
ISTART = IFIRST
- CTEMP = ASCALE*A( IFIRST, IFIRST ) -
- $ SHIFT*( BSCALE*B( IFIRST, IFIRST ) )
+ CTEMP = ASCALE*H( IFIRST, IFIRST ) -
+ $ SHIFT*( BSCALE*T( IFIRST, IFIRST ) )
90 CONTINUE
*
* Do an implicit-shift QZ sweep.
*
* Initial Q
*
- CTEMP2 = ASCALE*A( ISTART+1, ISTART )
+ CTEMP2 = ASCALE*H( ISTART+1, ISTART )
CALL CLARTG( CTEMP, CTEMP2, C, S, CTEMP3 )
*
* Sweep
*
DO 150 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- CTEMP = A( J, J-1 )
- CALL CLARTG( CTEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = CZERO
+ CTEMP = H( J, J-1 )
+ CALL CLARTG( CTEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = CZERO
END IF
*
DO 100 JC = J, ILASTM
- CTEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -CONJG( S )*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = CTEMP
- CTEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -CONJG( S )*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = CTEMP2
+ CTEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -CONJG( S )*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = CTEMP
+ CTEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -CONJG( S )*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = CTEMP2
100 CONTINUE
IF( ILQ ) THEN
DO 110 JR = 1, N
@@ -660,19 +685,19 @@
110 CONTINUE
END IF
*
- CTEMP = B( J+1, J+1 )
- CALL CLARTG( CTEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = CZERO
+ CTEMP = T( J+1, J+1 )
+ CALL CLARTG( CTEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = CZERO
*
DO 120 JR = IFRSTM, MIN( J+2, ILAST )
- CTEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -CONJG( S )*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = CTEMP
+ CTEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -CONJG( S )*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = CTEMP
120 CONTINUE
DO 130 JR = IFRSTM, J
- CTEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -CONJG( S )*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = CTEMP
+ CTEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -CONJG( S )*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = CTEMP
130 CONTINUE
IF( ILZ ) THEN
DO 140 JR = 1, N
@@ -700,23 +725,23 @@
* Set Eigenvalues 1:ILO-1
*
DO 200 J = 1, ILO - 1
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = CONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = CONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL CSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL CSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL CSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL CSCAL( J, SIGNBC, H( 1, J ), 1 )
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL CSCAL( N, SIGNBC, Z( 1, J ), 1 )
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
200 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/SRC/clasr.f LAPACK/SRC/clasr.f
--- LAPACK.orig/SRC/clasr.f Thu Nov 4 14:24:17 1999
+++ LAPACK/SRC/clasr.f Fri May 25 16:12:37 2001
@@ -3,7 +3,7 @@
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER DIRECT, PIVOT, SIDE
@@ -17,42 +17,77 @@
* Purpose
* =======
*
-* CLASR performs the transformation
+* CLASR applies a sequence of real plane rotations to a complex matrix
+* A, from either the left or the right.
*
-* A := P*A, when SIDE = 'L' or 'l' ( Left-hand side )
+* When SIDE = 'L', the transformation takes the form
*
-* A := A*P', when SIDE = 'R' or 'r' ( Right-hand side )
+* A := P*A
*
-* where A is an m by n complex matrix and P is an orthogonal matrix,
-* consisting of a sequence of plane rotations determined by the
-* parameters PIVOT and DIRECT as follows ( z = m when SIDE = 'L' or 'l'
-* and z = n when SIDE = 'R' or 'r' ):
+* and when SIDE = 'R', the transformation takes the form
*
-* When DIRECT = 'F' or 'f' ( Forward sequence ) then
-*
-* P = P( z - 1 )*...*P( 2 )*P( 1 ),
-*
-* and when DIRECT = 'B' or 'b' ( Backward sequence ) then
-*
-* P = P( 1 )*P( 2 )*...*P( z - 1 ),
-*
-* where P( k ) is a plane rotation matrix for the following planes:
-*
-* when PIVOT = 'V' or 'v' ( Variable pivot ),
-* the plane ( k, k + 1 )
-*
-* when PIVOT = 'T' or 't' ( Top pivot ),
-* the plane ( 1, k + 1 )
-*
-* when PIVOT = 'B' or 'b' ( Bottom pivot ),
-* the plane ( k, z )
-*
-* c( k ) and s( k ) must contain the cosine and sine that define the
-* matrix P( k ). The two by two plane rotation part of the matrix
-* P( k ), R( k ), is assumed to be of the form
-*
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
+* A := A*P**T
+*
+* where P is an orthogonal matrix consisting of a sequence of z plane
+* rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+* and P**T is the transpose of P.
+*
+* When DIRECT = 'F' (Forward sequence), then
+*
+* P = P(z-1) * ... * P(2) * P(1)
+*
+* and when DIRECT = 'B' (Backward sequence), then
+*
+* P = P(1) * P(2) * ... * P(z-1)
+*
+* where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+*
+* R(k) = ( c(k) s(k) )
+* = ( -s(k) c(k) ).
+*
+* When PIVOT = 'V' (Variable pivot), the rotation is performed
+* for the plane (k,k+1), i.e., P(k) has the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears as a rank-2 modification to the identity matrix in
+* rows and columns k and k+1.
+*
+* When PIVOT = 'T' (Top pivot), the rotation is performed for the
+* plane (1,k+1), so P(k) has the form
+*
+* P(k) = ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears in rows and columns 1 and k+1.
+*
+* Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+* performed for the plane (k,z), giving P(k) the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+*
+* where R(k) appears in rows and columns k and z. The rotations are
+* performed without ever forming P(k) explicitly.
*
* Arguments
* =========
@@ -61,13 +96,13 @@
* Specifies whether the plane rotation matrix P is applied to
* A on the left or the right.
* = 'L': Left, compute A := P*A
-* = 'R': Right, compute A:= A*P'
+* = 'R': Right, compute A:= A*P**T
*
* DIRECT (input) CHARACTER*1
* Specifies whether P is a forward or backward sequence of
* plane rotations.
-* = 'F': Forward, P = P( z - 1 )*...*P( 2 )*P( 1 )
-* = 'B': Backward, P = P( 1 )*P( 2 )*...*P( z - 1 )
+* = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+* = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
*
* PIVOT (input) CHARACTER*1
* Specifies the plane for which P(k) is a plane rotation
@@ -84,18 +119,22 @@
* The number of columns of the matrix A. If n <= 1, an
* immediate return is effected.
*
-* C, S (input) REAL arrays, dimension
+* C (input) REAL array, dimension
+* (M-1) if SIDE = 'L'
+* (N-1) if SIDE = 'R'
+* The cosines c(k) of the plane rotations.
+*
+* S (input) REAL array, dimension
* (M-1) if SIDE = 'L'
* (N-1) if SIDE = 'R'
-* c(k) and s(k) contain the cosine and sine that define the
-* matrix P(k). The two by two plane rotation part of the
-* matrix P(k), R(k), is assumed to be of the form
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
+* The sines s(k) of the plane rotations. The 2-by-2 plane
+* rotation part of the matrix P(k), R(k), has the form
+* R(k) = ( c(k) s(k) )
+* ( -s(k) c(k) ).
*
* A (input/output) COMPLEX array, dimension (LDA,N)
-* The m by n matrix A. On exit, A is overwritten by P*A if
-* SIDE = 'R' or by A*P' if SIDE = 'L'.
+* The M-by-N matrix A. On exit, A is overwritten by P*A if
+* SIDE = 'R' or by A*P**T if SIDE = 'L'.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
diff -uNr LAPACK.orig/SRC/ctgevc.f LAPACK/SRC/ctgevc.f
--- LAPACK.orig/SRC/ctgevc.f Thu Nov 4 14:26:09 1999
+++ LAPACK/SRC/ctgevc.f Fri May 25 16:13:37 2001
@@ -1,19 +1,19 @@
- SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
REAL RWORK( * )
- COMPLEX A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ COMPLEX P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -21,28 +21,30 @@
* Purpose
* =======
*
-* CTGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of complex upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* CTGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of complex matrices (S,P), where S and P are upper triangular.
+* Matrix pairs of this type are produced by the generalized Schur
+* factorization of a complex matrix pair (A,B):
+*
+* A = Q*S*Z**H, B = Q*P*Z**H
+*
+* as computed by CGGHRD + CHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input unitary
-* matrices. If (A,B) was obtained from the generalized Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal elements of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the unitary factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
*
* Arguments
* =========
@@ -54,66 +56,66 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* computed. The eigenvector corresponding to the j-th
+* eigenvalue is computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
-*
-* A (input) COMPLEX array, dimension (LDA,N)
-* The upper triangular matrix A.
-*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1,N).
+* The order of the matrices S and P. N >= 0.
*
-* B (input) COMPLEX array, dimension (LDB,N)
-* The upper triangular matrix B. B must have real diagonal
-* elements.
+* S (input) COMPLEX array, dimension (LDS,N)
+* The upper triangular matrix S from a generalized Schur
+* factorization, as computed by CHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) COMPLEX array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by CHGEQZ. P must have real
+* diagonal elements.
*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) COMPLEX array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the unitary matrix Q
* of left Schur vectors returned by CHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'l' or 'B' or 'b', LDVL >= N.
*
* VR (input/output) COMPLEX array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
* contain an N-by-N matrix Q (usually the unitary matrix Z
* of right Schur vectors returned by CHGEQZ).
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the right eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
@@ -180,7 +182,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -211,9 +213,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -237,7 +239,7 @@
*
ILBBAD = .FALSE.
DO 20 J = 1, N
- IF( AIMAG( B( J, J ) ).NE.ZERO )
+ IF( AIMAG( P( J, J ) ).NE.ZERO )
$ ILBBAD = .TRUE.
20 CONTINUE
*
@@ -275,19 +277,19 @@
* part of A and B to check for possible overflow in the triangular
* solver.
*
- ANORM = ABS1( A( 1, 1 ) )
- BNORM = ABS1( B( 1, 1 ) )
+ ANORM = ABS1( S( 1, 1 ) )
+ BNORM = ABS1( P( 1, 1 ) )
RWORK( 1 ) = ZERO
RWORK( N+1 ) = ZERO
DO 40 J = 2, N
RWORK( J ) = ZERO
RWORK( N+J ) = ZERO
DO 30 I = 1, J - 1
- RWORK( J ) = RWORK( J ) + ABS1( A( I, J ) )
- RWORK( N+J ) = RWORK( N+J ) + ABS1( B( I, J ) )
+ RWORK( J ) = RWORK( J ) + ABS1( S( I, J ) )
+ RWORK( N+J ) = RWORK( N+J ) + ABS1( P( I, J ) )
30 CONTINUE
- ANORM = MAX( ANORM, RWORK( J )+ABS1( A( J, J ) ) )
- BNORM = MAX( BNORM, RWORK( N+J )+ABS1( B( J, J ) ) )
+ ANORM = MAX( ANORM, RWORK( J )+ABS1( S( J, J ) ) )
+ BNORM = MAX( BNORM, RWORK( N+J )+ABS1( P( J, J ) ) )
40 CONTINUE
*
ASCALE = ONE / MAX( ANORM, SAFMIN )
@@ -309,8 +311,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG + 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( REAL( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( REAL( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -326,10 +328,10 @@
* H
* y ( a A - b B ) = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( REAL( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*REAL( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( REAL( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*REAL( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -380,7 +382,7 @@
*
* Compute
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
* (Scale if necessary)
*
@@ -396,16 +398,16 @@
SUMB = CZERO
*
DO 80 JR = JE, J - 1
- SUMA = SUMA + CONJG( A( JR, J ) )*WORK( JR )
- SUMB = SUMB + CONJG( B( JR, J ) )*WORK( JR )
+ SUMA = SUMA + CONJG( S( JR, J ) )*WORK( JR )
+ SUMB = SUMB + CONJG( P( JR, J ) )*WORK( JR )
80 CONTINUE
SUM = ACOEFF*SUMA - CONJG( BCOEFF )*SUMB
*
-* Form x(j) = - SUM / conjg( a*A(j,j) - b*B(j,j) )
+* Form x(j) = - SUM / conjg( a*S(j,j) - b*P(j,j) )
*
* with scaling and perturbation of the denominator
*
- D = CONJG( ACOEFF*A( J, J )-BCOEFF*B( J, J ) )
+ D = CONJG( ACOEFF*S( J, J )-BCOEFF*P( J, J ) )
IF( ABS1( D ).LE.DMIN )
$ D = CMPLX( DMIN )
*
@@ -475,8 +477,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG - 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( REAL( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( REAL( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -492,10 +494,10 @@
*
* ( a A - b B ) x = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( REAL( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*REAL( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( REAL( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*REAL( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -542,7 +544,7 @@
* WORK(j+1:JE) contains x
*
DO 170 JR = 1, JE - 1
- WORK( JR ) = ACOEFF*A( JR, JE ) - BCOEFF*B( JR, JE )
+ WORK( JR ) = ACOEFF*S( JR, JE ) - BCOEFF*P( JR, JE )
170 CONTINUE
WORK( JE ) = CONE
*
@@ -551,7 +553,7 @@
* Form x(j) := - w(j) / d
* with scaling and perturbation of the denominator
*
- D = ACOEFF*A( J, J ) - BCOEFF*B( J, J )
+ D = ACOEFF*S( J, J ) - BCOEFF*P( J, J )
IF( ABS1( D ).LE.DMIN )
$ D = CMPLX( DMIN )
*
@@ -568,7 +570,7 @@
*
IF( J.GT.1 ) THEN
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( ABS1( WORK( J ) ).GT.ONE ) THEN
TEMP = ONE / ABS1( WORK( J ) )
@@ -583,8 +585,8 @@
CA = ACOEFF*WORK( J )
CB = BCOEFF*WORK( J )
DO 200 JR = 1, J - 1
- WORK( JR ) = WORK( JR ) + CA*A( JR, J ) -
- $ CB*B( JR, J )
+ WORK( JR ) = WORK( JR ) + CA*S( JR, J ) -
+ $ CB*P( JR, J )
200 CONTINUE
END IF
210 CONTINUE
diff -uNr LAPACK.orig/SRC/ctrevc.f LAPACK/SRC/ctrevc.f
--- LAPACK.orig/SRC/ctrevc.f Thu Nov 4 14:24:23 1999
+++ LAPACK/SRC/ctrevc.f Fri May 25 16:13:56 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -22,20 +22,23 @@
*
* CTREVC computes some or all of the right and/or left eigenvectors of
* a complex upper triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input unitary
-* matrix. If T was obtained from the Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of the vector y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the unitary factor that reduces a matrix A to
+* Schur form T, then Q*X and Q*Y are the matrices of right and left
+* eigenvectors of A.
*
* Arguments
* =========
@@ -48,17 +51,17 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed using the matrices supplied in
+* VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* The eigenvector corresponding to the j-th eigenvalue is
+* computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -76,19 +79,16 @@
* Schur vectors returned by CHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL is lower triangular. The i-th column
-* VL(i) of VL is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VL, in the same order as their
* eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) COMPLEX array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -96,19 +96,16 @@
* Schur vectors returned by CHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR is upper triangular. The i-th column
-* VR(i) of VR is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VR, in the same order as their
* eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B'; LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/SRC/ctrsen.f LAPACK/SRC/ctrsen.f
--- LAPACK.orig/SRC/ctrsen.f Thu Nov 4 14:24:24 1999
+++ LAPACK/SRC/ctrsen.f Fri May 25 16:14:15 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, JOB
@@ -93,14 +93,13 @@
* If JOB = 'N' or 'E', SEP is not referenced.
*
* WORK (workspace/output) COMPLEX array, dimension (LWORK)
-* If JOB = 'N', WORK is not referenced. Otherwise,
-* on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*
* LWORK (input) INTEGER
* The dimension of the array WORK.
* If JOB = 'N', LWORK >= 1;
-* if JOB = 'E', LWORK = M*(N-M);
-* if JOB = 'V' or 'B', LWORK >= 2*M*(N-M).
+* if JOB = 'E', LWORK = max(1,M*(N-M));
+* if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
*
* If LWORK = -1, then a workspace query is assumed; the routine
* only calculates the optimal size of the WORK array, returns
diff -uNr LAPACK.orig/SRC/ctrsyl.f LAPACK/SRC/ctrsyl.f
--- LAPACK.orig/SRC/ctrsyl.f Thu Nov 4 14:24:24 1999
+++ LAPACK/SRC/ctrsyl.f Fri May 25 16:14:25 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 9, 2001
*
* .. Scalar Arguments ..
CHARACTER TRANA, TRANB
@@ -119,11 +119,9 @@
NOTRNB = LSAME( TRANB, 'N' )
*
INFO = 0
- IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'T' ) .AND. .NOT.
- $ LSAME( TRANA, 'C' ) ) THEN
+ IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'C' ) ) THEN
INFO = -1
- ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'T' ) .AND. .NOT.
- $ LSAME( TRANB, 'C' ) ) THEN
+ ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'C' ) ) THEN
INFO = -2
ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
INFO = -3
diff -uNr LAPACK.orig/SRC/dbdsqr.f LAPACK/SRC/dbdsqr.f
--- LAPACK.orig/SRC/dbdsqr.f Thu Nov 4 14:24:42 1999
+++ LAPACK/SRC/dbdsqr.f Fri May 25 15:59:00 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -18,14 +18,26 @@
* Purpose
* =======
*
-* DBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
+* DBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**T
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**T*VT instead of
+* P**T, for given real input matrices U and VT. When U and VT are the
+* orthogonal matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by DGEBRD, then
*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given real input matrices U, VT, and C.
+* A = (U*Q) * S * (P**T*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+* for a given real input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -61,18 +73,17 @@
* order.
*
* E (input/output) DOUBLE PRECISION array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**T * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -81,21 +92,22 @@
* U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**T * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+* WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/SRC/dgebd2.f LAPACK/SRC/dgebd2.f
--- LAPACK.orig/SRC/dgebd2.f Thu Nov 4 14:24:42 1999
+++ LAPACK/SRC/dgebd2.f Fri May 25 15:59:22 2001
@@ -3,7 +3,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* February 29, 1992
+* May 7, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
@@ -169,8 +169,9 @@
*
* Apply H(i) to A(i:m,i+1:n) from the left
*
- CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
- $ A( I, I+1 ), LDA, WORK )
+ IF( I.LT.N )
+ $ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
+ $ A( I, I+1 ), LDA, WORK )
A( I, I ) = D( I )
*
IF( I.LT.N ) THEN
@@ -207,8 +208,9 @@
*
* Apply G(i) to A(i+1:m,i:n) from the right
*
- CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAUP( I ),
- $ A( MIN( I+1, M ), I ), LDA, WORK )
+ IF( I.LT.M )
+ $ CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
+ $ TAUP( I ), A( MIN( I+1, M ), I ), LDA, WORK )
A( I, I ) = D( I )
*
IF( I.LT.M ) THEN
diff -uNr LAPACK.orig/SRC/dgees.f LAPACK/SRC/dgees.f
--- LAPACK.orig/SRC/dgees.f Thu Nov 4 14:24:43 1999
+++ LAPACK/SRC/dgees.f Fri May 25 15:59:50 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SORT
@@ -110,10 +111,9 @@
* The dimension of the array WORK. LWORK >= max(1,3*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* BWORK (workspace) LOGICAL array, dimension (N)
* Not referenced if SORT = 'N'.
@@ -138,12 +138,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTST,
- $ WANTVS
+ LOGICAL CURSL, LASTSL, LST2SL, SCALEA, WANTST, WANTVS
INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
$ IHI, ILO, INXT, IP, ITAU, IWRK, K, MAXB,
$ MAXWRK, MINWRK
@@ -154,8 +155,8 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY,
- $ DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
+ EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD,
+ $ DLACPY, DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -171,7 +172,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVS = LSAME( JOBVS, 'V' )
WANTST = LSAME( SORT, 'S' )
IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
@@ -197,7 +197,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 3*N )
IF( .NOT.WANTVS ) THEN
@@ -216,19 +216,18 @@
MAXWRK = MAX( MAXWRK, N+HSWORK, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGEES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/dgeesx.f LAPACK/SRC/dgeesx.f
--- LAPACK.orig/SRC/dgeesx.f Thu Nov 4 14:24:43 1999
+++ LAPACK/SRC/dgeesx.f Fri May 25 16:00:13 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SENSE, SORT
@@ -140,6 +141,10 @@
* N+2*SDIM*(N-SDIM) <= N+N*N/2.
* For good performance, LWORK must generally be larger.
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* IWORK (workspace/output) INTEGER array, dimension (LIWORK)
* Not referenced if SENSE = 'N' or 'E'.
* On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
@@ -171,6 +176,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
@@ -186,8 +193,8 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY,
- $ DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
+ EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD,
+ $ DLACPY, DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -239,7 +246,7 @@
* in the code.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 3*N )
IF( .NOT.WANTVS ) THEN
@@ -257,21 +264,25 @@
HSWORK = MAX( K*( K+2 ), 2*N )
MAXWRK = MAX( MAXWRK, N+HSWORK, 1 )
END IF
+*
+* Estimate the workspace needed by DTRSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, N+( N*N+1 ) / 2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -16
END IF
- IF( LWORK.LT.MINWRK ) THEN
- INFO = -16
- END IF
- IF( LIWORK.LT.1 ) THEN
- INFO = -18
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGEESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/dgeev.f LAPACK/SRC/dgeev.f
--- LAPACK.orig/SRC/dgeev.f Wed Dec 8 16:00:35 1999
+++ LAPACK/SRC/dgeev.f Fri May 25 16:00:43 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* December 8, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -98,10 +99,9 @@
* if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
* performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -114,11 +114,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
+ LOGICAL SCALEA, WANTVL, WANTVR
CHARACTER SIDE
INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
$ MAXB, MAXWRK, MINWRK, NOUT
@@ -130,8 +132,9 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG,
- $ DLASCL, DORGHR, DROT, DSCAL, DTREVC, XERBLA
+ EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
+ $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
+ $ XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -148,7 +151,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
@@ -176,7 +178,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 3*N )
@@ -197,19 +199,18 @@
MAXWRK = MAX( MAXWRK, 4*N )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGEEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/dgeevx.f LAPACK/SRC/dgeevx.f
--- LAPACK.orig/SRC/dgeevx.f Thu Nov 4 14:24:43 1999
+++ LAPACK/SRC/dgeevx.f Fri May 25 16:01:05 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -179,10 +180,9 @@
* LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (2*N-2)
* If SENSE = 'N' or 'E', not referenced.
@@ -198,12 +198,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
- $ WNTSNN, WNTSNV
+ LOGICAL SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, WNTSNN,
+ $ WNTSNV
CHARACTER JOB, SIDE
INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXB,
$ MAXWRK, MINWRK, NOUT
@@ -215,9 +217,9 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG,
- $ DLASCL, DORGHR, DROT, DSCAL, DTREVC, DTRSNA,
- $ XERBLA
+ EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
+ $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
+ $ DTRSNA, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -234,7 +236,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
WNTSNN = LSAME( SENSE, 'N' )
@@ -274,7 +275,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 2*N )
@@ -308,19 +309,18 @@
MAXWRK = MAX( MAXWRK, 3*N, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -21
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -21
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGEEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/dgegs.f LAPACK/SRC/dgegs.f
--- LAPACK.orig/SRC/dgegs.f Thu Nov 4 14:24:43 1999
+++ LAPACK/SRC/dgegs.f Fri May 25 16:01:53 2001
@@ -5,7 +5,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR
@@ -22,105 +22,75 @@
*
* This routine is deprecated and has been replaced by routine DGGES.
*
-* DGEGS computes for a pair of N-by-N real nonsymmetric matrices A, B:
-* the generalized eigenvalues (alphar +/- alphai*i, beta), the real
-* Schur form (A, B), and optionally left and/or right Schur vectors
-* (VSL and VSR).
-*
-* (If only the generalized eigenvalues are needed, use the driver DGEGV
-* instead.)
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* The (generalized) Schur form of a pair of matrices is the result of
-* multiplying both matrices on the left by one orthogonal matrix and
-* both on the right by another orthogonal matrix, these two orthogonal
-* matrices being chosen so as to bring the pair of matrices into
-* (real) Schur form.
-*
-* A pair of matrices A, B is in generalized real Schur form if B is
-* upper triangular with non-negative diagonal and A is block upper
-* triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
-* to real generalized eigenvalues, while 2-by-2 blocks of A will be
-* "standardized" by making the corresponding elements of B have the
-* form:
-* [ a 0 ]
-* [ 0 b ]
-*
-* and the pair of corresponding 2-by-2 blocks in A and B will
-* have a complex conjugate pair of generalized eigenvalues.
-*
-* The left and right Schur vectors are the columns of VSL and VSR,
-* respectively, where VSL and VSR are the orthogonal matrices
-* which reduce A and B to Schur form:
-*
-* Schur form of (A,B) = ( (VSL)**T A (VSR), (VSL)**T B (VSR) )
+* DGEGS computes the eigenvalues, real Schur form, and, optionally,
+* left and or/right Schur vectors of a real matrix pair (A,B).
+* Given two square matrices A and B, the generalized real Schur
+* factorization has the form
+*
+* A = Q*S*Z**T, B = Q*T*Z**T
+*
+* where Q and Z are orthogonal matrices, T is upper triangular, and S
+* is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
+* blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
+* of eigenvalues of (A,B). The columns of Q are the left Schur vectors
+* and the columns of Z are the right Schur vectors.
+*
+* If only the eigenvalues of (A,B) are needed, the driver routine
+* DGEGV should be used instead. See DGEGV for a description of the
+* eigenvalues of the generalized nonsymmetric eigenvalue problem
+* (GNEP).
*
* Arguments
* =========
*
* JOBVSL (input) CHARACTER*1
* = 'N': do not compute the left Schur vectors;
-* = 'V': compute the left Schur vectors.
+* = 'V': compute the left Schur vectors (returned in VSL).
*
* JOBVSR (input) CHARACTER*1
* = 'N': do not compute the right Schur vectors;
-* = 'V': compute the right Schur vectors.
+* = 'V': compute the right Schur vectors (returned in VSR).
*
* N (input) INTEGER
* The order of the matrices A, B, VSL, and VSR. N >= 0.
*
* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose generalized
-* eigenvalues and (optionally) Schur vectors are to be
-* computed.
-* On exit, the generalized Schur form of A.
-* Note: to avoid overflow, the Frobenius norm of the matrix
-* A should be less than the overflow threshold.
+* On entry, the matrix A.
+* On exit, the upper quasi-triangular matrix S from the
+* generalized real Schur factorization.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) Schur vectors are
-* to be computed.
-* On exit, the generalized Schur form of B.
-* Note: to avoid overflow, the Frobenius norm of the matrix
-* B should be less than the overflow threshold.
+* On entry, the matrix B.
+* On exit, the upper triangular matrix T from the generalized
+* real Schur factorization.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+* The real parts of each scalar alpha defining an eigenvalue
+* of GNEP.
+*
* ALPHAI (output) DOUBLE PRECISION array, dimension (N)
-* BETA (output) DOUBLE PRECISION array, dimension (N)
-* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-* be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
-* j=1,...,N and BETA(j),j=1,...,N are the diagonals of the
-* complex Schur form (A,B) that would result if the 2-by-2
-* diagonal blocks of the real Schur form of (A,B) were further
-* reduced to triangular form using 2-by-2 complex unitary
-* transformations. If ALPHAI(j) is zero, then the j-th
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
* eigenvalue is real; if positive, then the j-th and (j+1)-st
-* eigenvalues are a complex conjugate pair, with ALPHAI(j+1)
-* negative.
+* eigenvalues are a complex conjugate pair, with
+* ALPHAI(j+1) = -ALPHAI(j).
*
-* Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-* may easily over- or underflow, and BETA(j) may even be zero.
-* Thus, the user should avoid naively computing the ratio
-* alpha/beta. However, ALPHAR and ALPHAI will be always less
-* than and usually comparable with norm(A) in magnitude, and
-* BETA always less than and usually comparable with norm(B).
+* BETA (output) DOUBLE PRECISION array, dimension (N)
+* The scalars beta that define the eigenvalues of GNEP.
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
-* If JOBVSL = 'V', VSL will contain the left Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSL = 'V', the matrix of left Schur vectors Q.
* Not referenced if JOBVSL = 'N'.
*
* LDVSL (input) INTEGER
@@ -128,8 +98,7 @@
* if JOBVSL = 'V', LDVSL >= N.
*
* VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
-* If JOBVSR = 'V', VSR will contain the right Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSR = 'V', the matrix of right Schur vectors Z.
* Not referenced if JOBVSR = 'N'.
*
* LDVSR (input) INTEGER
diff -uNr LAPACK.orig/SRC/dgegv.f LAPACK/SRC/dgegv.f
--- LAPACK.orig/SRC/dgegv.f Thu Nov 4 14:25:43 1999
+++ LAPACK/SRC/dgegv.f Fri May 25 16:02:16 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -21,23 +21,32 @@
*
* This routine is deprecated and has been replaced by routine DGGEV.
*
-* DGEGV computes for a pair of n-by-n real nonsymmetric matrices A and
-* B, the generalized eigenvalues (alphar +/- alphai*i, beta), and
-* optionally, the left and/or right generalized eigenvectors (VL and
-* VR).
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* A right generalized eigenvector corresponding to a generalized
-* eigenvalue w for a pair of matrices (A,B) is a vector r such
-* that (A - w B) r = 0 . A left generalized eigenvector is a vector
-* l such that l**H * (A - w B) = 0, where l**H is the
-* conjugate-transpose of l.
+* DGEGV computes the eigenvalues and, optionally, the left and/or right
+* eigenvectors of a real matrix pair (A,B).
+* Given two square matrices A and B,
+* the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+* eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+* that
+*
+* A*x = lambda*B*x.
+*
+* An alternate form is to find the eigenvalues mu and corresponding
+* eigenvectors y such that
+*
+* mu*A*y = B*y.
+*
+* These two forms are equivalent with mu = 1/lambda and x = y if
+* neither lambda nor mu is zero. In order to deal with the case that
+* lambda or mu is zero or small, two values alpha and beta are returned
+* for each eigenvalue, such that lambda = alpha/beta and
+* mu = beta/alpha.
+*
+* The vectors x and y in the above equations are right eigenvectors of
+* the matrix pair (A,B). Vectors u and v satisfying
+*
+* u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+*
+* are left eigenvectors of (A,B).
*
* Note: this routine performs "full balancing" on A and B -- see
* "Further Details", below.
@@ -47,63 +56,75 @@
*
* JOBVL (input) CHARACTER*1
* = 'N': do not compute the left generalized eigenvectors;
-* = 'V': compute the left generalized eigenvectors.
+* = 'V': compute the left generalized eigenvectors (returned
+* in VL).
*
* JOBVR (input) CHARACTER*1
* = 'N': do not compute the right generalized eigenvectors;
-* = 'V': compute the right generalized eigenvectors.
+* = 'V': compute the right generalized eigenvectors (returned
+* in VR).
*
* N (input) INTEGER
* The order of the matrices A, B, VL, and VR. N >= 0.
*
* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of A on exit, see "Further
-* Details", below.)
+* On entry, the matrix A.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit A
+* contains the real Schur form of A from the generalized Schur
+* factorization of the pair (A,B) after balancing.
+* If no eigenvectors were computed, then only the diagonal
+* blocks from the Schur form will be correct. See DGGHRD and
+* DHGEQZ for details.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of B on exit, see "Further
-* Details", below.)
+* On entry, the matrix B.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+* upper triangular matrix obtained from B in the generalized
+* Schur factorization of the pair (A,B) after balancing.
+* If no eigenvectors were computed, then only those elements of
+* B corresponding to the diagonal blocks from the Schur form of
+* A will be correct. See DGGHRD and DHGEQZ for details.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+* The real parts of each scalar alpha defining an eigenvalue of
+* GNEP.
+*
* ALPHAI (output) DOUBLE PRECISION array, dimension (N)
-* BETA (output) DOUBLE PRECISION array, dimension (N)
-* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-* be the generalized eigenvalues. If ALPHAI(j) is zero, then
-* the j-th eigenvalue is real; if positive, then the j-th and
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+* eigenvalue is real; if positive, then the j-th and
* (j+1)-st eigenvalues are a complex conjugate pair, with
-* ALPHAI(j+1) negative.
+* ALPHAI(j+1) = -ALPHAI(j).
*
-* Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-* may easily over- or underflow, and BETA(j) may even be zero.
-* Thus, the user should avoid naively computing the ratio
-* alpha/beta. However, ALPHAR and ALPHAI will be always less
-* than and usually comparable with norm(A) in magnitude, and
-* BETA always less than and usually comparable with norm(B).
+* BETA (output) DOUBLE PRECISION array, dimension (N)
+* The scalars beta that define the eigenvalues of GNEP.
+*
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
-* If JOBVL = 'V', the left generalized eigenvectors. (See
-* "Purpose", above.) Real eigenvectors take one column,
-* complex take two columns, the first for the real part and
-* the second for the imaginary part. Complex eigenvectors
-* correspond to an eigenvalue with positive imaginary part.
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVL = 'V', the left eigenvectors u(j) are stored
+* in the columns of VL, in the same order as their eigenvalues.
+* If the j-th eigenvalue is real, then u(j) = VL(:,j).
+* If the j-th and (j+1)-st eigenvalues form a complex conjugate
+* pair, then
+* u(j) = VL(:,j) + i*VL(:,j+1)
+* and
+* u(j+1) = VL(:,j) - i*VL(:,j+1).
+*
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvectors
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVL = 'N'.
*
* LDVL (input) INTEGER
@@ -111,15 +132,19 @@
* if JOBVL = 'V', LDVL >= N.
*
* VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
-* If JOBVR = 'V', the right generalized eigenvectors. (See
-* "Purpose", above.) Real eigenvectors take one column,
-* complex take two columns, the first for the real part and
-* the second for the imaginary part. Complex eigenvectors
-* correspond to an eigenvalue with positive imaginary part.
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVR = 'V', the right eigenvectors x(j) are stored
+* in the columns of VR, in the same order as their eigenvalues.
+* If the j-th eigenvalue is real, then x(j) = VR(:,j).
+* If the j-th and (j+1)-st eigenvalues form a complex conjugate
+* pair, then
+* x(j) = VR(:,j) + i*VR(:,j+1)
+* and
+* x(j+1) = VR(:,j) - i*VR(:,j+1).
+*
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvalues
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVR = 'N'.
*
* LDVR (input) INTEGER
diff -uNr LAPACK.orig/SRC/dgelsd.f LAPACK/SRC/dgelsd.f
--- LAPACK.orig/SRC/dgelsd.f Thu Nov 4 14:26:25 1999
+++ LAPACK/SRC/dgelsd.f Fri May 25 16:03:10 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -61,9 +62,10 @@
* The number of right hand sides, i.e., the number of columns
* of the matrices B and X. NRHS >= 0.
*
-* A (input) DOUBLE PRECISION array, dimension (LDA,N)
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
* On entry, the M-by-N matrix A.
-* On exit, A has been destroyed.
+* On exit, the first min(m,n) rows of A are overwritten with
+* its right singular vectors, stored rowwise.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
@@ -95,23 +97,20 @@
* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*
* LWORK (input) INTEGER
-* The dimension of the array WORK. LWORK must be at least 1.
+* The dimension of the array WORK. LWORK >= 1.
* The exact minimum amount of workspace needed depends on M,
-* N and NRHS. As long as LWORK is at least
-* 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
-* if M is greater than or equal to N or
-* 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
-* if M is less than N, the code will execute correctly.
+* N and NRHS.
+* If M >= N, LWORK >= 11*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS.
+* If M < N, LWORK >= 11*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS.
* SMLSIZ is returned by ILAENV and is equal to the maximum
* size of the subproblems at the bottom of the computation
* tree (usually about 25), and
-* NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+* NLVL = INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
* LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
@@ -135,14 +134,15 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE, TWO
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY
INTEGER IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
$ LDWORK, MAXMN, MAXWRK, MINMN, MINWRK, MM,
- $ MNTHR, NLVL, NWORK, SMLSIZ, WLALSD
+ $ MNTHR, NLVL, NWORK, SMLSIZ
DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
* ..
* .. External Subroutines ..
@@ -165,7 +165,6 @@
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
MNTHR = ILAENV( 6, 'DGELSD', ' ', M, N, NRHS, -1 )
- LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@@ -189,8 +188,8 @@
*
MINWRK = 1
MINMN = MAX( 1, MINMN )
- NLVL = MAX( INT( LOG( DBLE( MINMN ) / DBLE( SMLSIZ+1 ) ) /
- $ LOG( TWO ) ) + 1, 0 )
+ NLVL = INT( LOG( DBLE( MINMN ) / DBLE( SMLSIZ+1 ) ) / LOG( TWO ) )
+ $ + 1
*
IF( INFO.EQ.0 ) THEN
MAXWRK = 0
@@ -215,12 +214,11 @@
$ ILAENV( 1, 'DORMBR', 'QLT', MM, NRHS, N, -1 ) )
MAXWRK = MAX( MAXWRK, 3*N+( N-1 )*
$ ILAENV( 1, 'DORMBR', 'PLN', N, NRHS, N, -1 ) )
- WLALSD = 9*N+2*N*SMLSIZ+8*N*NLVL+N*NRHS+(SMLSIZ+1)**2
- MAXWRK = MAX( MAXWRK, 3*N+WLALSD )
- MINWRK = MAX( 3*N+MM, 3*N+NRHS, 3*N+WLALSD )
+ MAXWRK = MAX( MAXWRK, 3*N+8*N+2*N*SMLSIZ+8*N*NLVL+N*NRHS )
+ MINWRK = MAX( 3*N+MM, 3*N+NRHS,
+ $ 3*N+8*N+2*N*SMLSIZ+8*N*NLVL+N*NRHS )
END IF
IF( N.GT.M ) THEN
- WLALSD = 9*M+2*M*SMLSIZ+8*M*NLVL+M*NRHS+(SMLSIZ+1)**2
IF( N.GE.MNTHR ) THEN
*
* Path 2a - underdetermined, with many more columns
@@ -240,7 +238,8 @@
END IF
MAXWRK = MAX( MAXWRK, M+NRHS*
$ ILAENV( 1, 'DORMLQ', 'LT', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M+4*M+WLALSD )
+ MAXWRK = MAX( MAXWRK, M*M+4*M+8*M+2*M*SMLSIZ+8*M*NLVL+M*
+ $ NRHS )
ELSE
*
* Path 2 - remaining underdetermined cases.
@@ -251,26 +250,26 @@
$ ILAENV( 1, 'DORMBR', 'QLT', M, NRHS, N, -1 ) )
MAXWRK = MAX( MAXWRK, 3*M+M*
$ ILAENV( 1, 'DORMBR', 'PLN', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*M+WLALSD )
+ MAXWRK = MAX( MAXWRK, 3*M+8*M+2*M*SMLSIZ+8*M*NLVL+M*
+ $ NRHS )
END IF
- MINWRK = MAX( 3*M+NRHS, 3*M+M, 3*M+WLALSD )
+ MINWRK = MAX( 3*M+NRHS, 3*M+M,
+ $ 3*M+8*M+2*M*SMLSIZ+8*M*NLVL+M*NRHS )
END IF
MINWRK = MIN( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGELSD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- GO TO 10
END IF
-*
-* Quick return if possible.
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
diff -uNr LAPACK.orig/SRC/dgelss.f LAPACK/SRC/dgelss.f
--- LAPACK.orig/SRC/dgelss.f Thu Nov 4 14:24:44 1999
+++ LAPACK/SRC/dgelss.f Fri May 25 16:03:46 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -86,10 +86,9 @@
* LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -156,7 +155,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -229,20 +228,18 @@
END IF
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- MINWRK = MAX( MINWRK, 1 )
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGELSS', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
-*
-* Quick return if possible
-*
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
@@ -491,8 +488,8 @@
DO 40 I = 1, NRHS, CHUNK
BL = MIN( NRHS-I+1, CHUNK )
CALL DGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, ZERO, WORK( IWORK ), N )
- CALL DLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M )
+ CALL DLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/SRC/dgesdd.f LAPACK/SRC/dgesdd.f
--- LAPACK.orig/SRC/dgesdd.f Thu Nov 11 20:32:31 1999
+++ LAPACK/SRC/dgesdd.f Fri May 25 16:07:58 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBZ
@@ -116,16 +117,20 @@
* LWORK (input) INTEGER
* The dimension of the array WORK. LWORK >= 1.
* If JOBZ = 'N',
-* LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)).
+* LWORK >= max(14*min(M,N)+4, 10*min(M,N)+2+
+* SMLSIZ*(SMLSIZ+8)) + max(M,N)
+* where SMLSIZ is returned by ILAENV and is equal to the
+* maximum size of the subproblems at the bottom of the
+* computation tree (usually about 25).
* If JOBZ = 'O',
-* LWORK >= 3*min(M,N)*min(M,N) +
-* max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
+* LWORK >= 5*min(M,N)*min(M,N) + max(M,N) + 9*min(M,N).
* If JOBZ = 'S' or 'A'
-* LWORK >= 3*min(M,N)*min(M,N) +
-* max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).
+* LWORK >= 4*min(M,N)*min(M,N) + max(M,N) + 9*min(M,N).
* For good performance, LWORK should generally be larger.
-* If LWORK < 0 but other input arguments are legal, WORK(1)
-* returns the optimal LWORK.
+*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (8*min(M,N))
*
@@ -144,15 +149,17 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
- INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IL,
+ LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
+ INTEGER BDSPAC, BDSPAN, BLK, CHUNK, I, IE, IERR, IL,
$ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT,
$ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK,
- $ MNTHR, NWORK, WRKBL
+ $ MNTHR, NWORK, SMLSIZ, WRKBL
DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM
* ..
* .. Local Arrays ..
@@ -168,7 +175,7 @@
LOGICAL LSAME
INTEGER ILAENV
DOUBLE PRECISION DLAMCH, DLANGE
- EXTERNAL DLAMCH, DLANGE, ILAENV, LSAME
+ EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, INT, MAX, MIN, SQRT
@@ -187,7 +194,6 @@
WNTQN = LSAME( JOBZ, 'N' )
MINWRK = 1
MAXWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
*
IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN
INFO = -1
@@ -206,6 +212,8 @@
INFO = -10
END IF
*
+ SMLSIZ = ILAENV( 9, 'DGESDD', ' ', 0, 0, 0, 0 )
+*
* Compute workspace
* (Note: Comments in the code beginning "Workspace:" describe the
* minimal amount of workspace needed at that point in the code,
@@ -218,22 +226,19 @@
*
* Compute space needed for DBDSDC
*
- IF( WNTQN ) THEN
- BDSPAC = 7*N
- ELSE
- BDSPAC = 3*N*N + 4*N
- END IF
+ BDSPAC = 3*N*N + 7*N
+ BDSPAN = MAX( 12*N+4, 8*N+2+SMLSIZ*( SMLSIZ+8 ) )
IF( M.GE.MNTHR ) THEN
IF( WNTQN ) THEN
*
* Path 1 (M much larger than N, JOBZ='N')
*
- WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+N )
- MINWRK = BDSPAC + N
+ MAXWRK = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1,
+ $ -1 )
+ MAXWRK = MAX( MAXWRK, 3*N+2*N*
+ $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC )
+ MINWRK = BDSPAC
ELSE IF( WNTQO ) THEN
*
* Path 2 (M much larger than N, JOBZ='O')
@@ -247,9 +252,9 @@
$ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
+ WRKBL = MAX( WRKBL, BDSPAC+2*N )
MAXWRK = WRKBL + 2*N*N
- MINWRK = BDSPAC + 2*N*N + 3*N
+ MINWRK = BDSPAC + 2*N*N + 2*N
ELSE IF( WNTQS ) THEN
*
* Path 3 (M much larger than N, JOBZ='S')
@@ -263,9 +268,9 @@
$ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
+ WRKBL = MAX( WRKBL, BDSPAC+2*N )
MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 3*N
+ MINWRK = BDSPAC + N*N + 2*N
ELSE IF( WNTQA ) THEN
*
* Path 4 (M much larger than N, JOBZ='A')
@@ -279,9 +284,9 @@
$ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 3*N
+ WRKBL = MAX( WRKBL, BDSPAC+2*N )
+ MAXWRK = N*N + WRKBL
+ MINWRK = BDSPAC + N*N + M + N
END IF
ELSE
*
@@ -289,53 +294,47 @@
*
WRKBL = 3*N + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1,
$ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- ELSE IF( WNTQO ) THEN
+ IF( WNTQO ) THEN
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
+ WRKBL = MAX( WRKBL, BDSPAC+2*N+M )
MAXWRK = WRKBL + M*N
- MINWRK = 3*N + MAX( M, N*N+BDSPAC )
+ MINWRK = BDSPAC + N*N + 2*N + M
ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*N+N*
+ $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*N+N*
+ $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*N+M )
+ MINWRK = BDSPAC + 2*N + M
ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*N+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( MAXWRK, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*N+M*
+ $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*N+N*
+ $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*N+M )
+ MINWRK = BDSPAC + 2*N + M
END IF
END IF
ELSE
*
* Compute space needed for DBDSDC
*
- IF( WNTQN ) THEN
- BDSPAC = 7*M
- ELSE
- BDSPAC = 3*M*M + 4*M
- END IF
+ BDSPAC = 3*M*M + 7*M
+ BDSPAN = MAX( 12*M+4, 8*M+2+SMLSIZ*( SMLSIZ+8 ) )
IF( N.GE.MNTHR ) THEN
IF( WNTQN ) THEN
*
* Path 1t (N much larger than M, JOBZ='N')
*
- WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+M )
- MINWRK = BDSPAC + M
+ MAXWRK = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1,
+ $ -1 )
+ MAXWRK = MAX( MAXWRK, 3*M+2*M*
+ $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC )
+ MINWRK = BDSPAC
ELSE IF( WNTQO ) THEN
*
* Path 2t (N much larger than M, JOBZ='O')
@@ -349,9 +348,9 @@
$ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + 2*M*M
- MINWRK = BDSPAC + 2*M*M + 3*M
+ MINWRK = BDSPAC + 2*M*M + 2*M
ELSE IF( WNTQS ) THEN
*
* Path 3t (N much larger than M, JOBZ='S')
@@ -365,9 +364,9 @@
$ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
+ MINWRK = BDSPAC + M*M + 2*M
ELSE IF( WNTQA ) THEN
*
* Path 4t (N much larger than M, JOBZ='A')
@@ -381,9 +380,9 @@
$ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
+ MINWRK = BDSPAC + M*M + M + N
END IF
ELSE
*
@@ -391,52 +390,47 @@
*
WRKBL = 3*M + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1,
$ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- ELSE IF( WNTQO ) THEN
+ IF( WNTQO ) THEN
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + M*N
- MINWRK = 3*M + MAX( N, M*M+BDSPAC )
+ MINWRK = BDSPAC + M*M + 2*M + N
ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*M+M*
+ $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*M+M*
+ $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*M )
+ MINWRK = BDSPAC + 2*M + N
ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'DORMBR', 'PRT', N, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*M+M*
+ $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*M+N*
+ $ ILAENV( 1, 'DORMBR', 'PRT', N, N, M, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*M )
+ MINWRK = BDSPAC + 2*M + N
END IF
END IF
END IF
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGESDD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
@@ -497,7 +491,7 @@
NWORK = IE + N
*
* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
@@ -512,10 +506,10 @@
*
* WORK(IR) is LDWRKR by N
*
- IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN
+ IF( LWORK.GE.LDA*N+4*N*N+9*N ) THEN
LDWRKR = LDA
ELSE
- LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N
+ LDWRKR = ( LWORK-4*N*N-9*N ) / N
END IF
ITAU = IR + LDWRKR*N
NWORK = ITAU + N
@@ -557,7 +551,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in WORK(IU) and computing right
* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
+* (Workspace: need 2*N*N+BDSPAC)
*
CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
$ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -633,7 +627,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagoal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
+* (Workspace: need N*N+BDSPAC)
*
CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
$ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -681,7 +675,7 @@
CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
*
* Generate Q in U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( NWORK ), LWORK-NWORK+1, IERR )
*
@@ -703,7 +697,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in WORK(IU) and computing right
* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
+* (Workspace: need N*N+BDSPAC)
*
CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
$ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -754,13 +748,13 @@
IF( WNTQN ) THEN
*
* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
ELSE IF( WNTQO ) THEN
IU = NWORK
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*N*N+9*N ) THEN
*
* WORK( IU ) is M by N
*
@@ -785,7 +779,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in WORK(IU) and computing right
* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
+* (Workspace: need N*N+BDSPAC)
*
CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ),
$ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ),
@@ -798,7 +792,7 @@
$ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
*
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*N*N+9*N ) THEN
*
* Overwrite WORK(IU) by left singular vectors of A
* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
@@ -838,7 +832,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL DLASET( 'F', M, N, ZERO, ZERO, U, LDU )
CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
@@ -855,12 +849,12 @@
CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
$ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
+ ELSE
*
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL DLASET( 'F', M, M, ZERO, ZERO, U, LDU )
CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
@@ -925,7 +919,7 @@
NWORK = IE + M
*
* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL DBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
@@ -941,7 +935,7 @@
* IVT is M by M
*
IL = IVT + M*M
- IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+4*M*M+9*M ) THEN
*
* WORK(IL) is M by N
*
@@ -986,7 +980,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U, and computing right singular
* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
+* (Workspace: need 2*M*M+BDSPAC)
*
CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
$ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ),
@@ -1061,7 +1055,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
+* (Workspace: need M*M+BDSPAC)
*
CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT,
$ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -1108,7 +1102,7 @@
CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
*
* Generate Q in VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
*
CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( NWORK ), LWORK-NWORK+1, IERR )
@@ -1131,7 +1125,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
+* (Workspace: need M*M+BDSPAC)
*
CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
$ WORK( IVT ), LDWKVT, DUM, IDUM,
@@ -1182,14 +1176,14 @@
IF( WNTQN ) THEN
*
* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL DBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
ELSE IF( WNTQO ) THEN
LDWKVT = M
IVT = NWORK
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*M*M+9*M ) THEN
*
* WORK( IVT ) is M by N
*
@@ -1224,7 +1218,7 @@
$ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
*
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*M*M+9*M ) THEN
*
* Overwrite WORK(IVT) by left singular vectors of A
* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
@@ -1263,7 +1257,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL DLASET( 'F', M, N, ZERO, ZERO, VT, LDVT )
CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
@@ -1280,12 +1274,12 @@
CALL DORMBR( 'P', 'R', 'T', M, N, M, A, LDA,
$ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
+ ELSE
*
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL DLASET( 'F', N, N, ZERO, ZERO, VT, LDVT )
CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
@@ -1319,9 +1313,15 @@
IF( ANRM.GT.BIGNUM )
$ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
+ $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ),
+ $ MINMN, IERR )
IF( ANRM.LT.SMLNUM )
$ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
+ $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ),
+ $ MINMN, IERR )
END IF
*
* Return optimal workspace in WORK(1)
diff -uNr LAPACK.orig/SRC/dgesvd.f LAPACK/SRC/dgesvd.f
--- LAPACK.orig/SRC/dgesvd.f Thu Nov 4 14:24:44 1999
+++ LAPACK/SRC/dgesvd.f Fri May 25 16:08:25 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBU, JOBVT
@@ -118,10 +119,9 @@
* LWORK >= MAX(3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit.
@@ -134,12 +134,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
- $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
+ LOGICAL WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS, WNTVA,
+ $ WNTVAS, WNTVN, WNTVO, WNTVS
INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
$ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
$ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
@@ -181,7 +183,7 @@
WNTVO = LSAME( JOBVT, 'O' )
WNTVN = LSAME( JOBVT, 'N' )
MINWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
+ MAXWRK = 1
*
IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
INFO = -1
@@ -208,8 +210,7 @@
* NB refers to the optimal block size for the immediately
* following subroutine, as returned by ILAENV.)
*
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
- $ N.GT.0 ) THEN
+ IF( INFO.EQ.0 .AND. M.GT.0 .AND. N.GT.0 ) THEN
IF( M.GE.N ) THEN
*
* Compute space needed for DBDSQR
@@ -557,24 +558,22 @@
MAXWRK = MAX( MAXWRK, MINWRK )
END IF
END IF
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGESVD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
diff -uNr LAPACK.orig/SRC/dggbak.f LAPACK/SRC/dggbak.f
--- LAPACK.orig/SRC/dggbak.f Thu Nov 4 14:24:45 1999
+++ LAPACK/SRC/dggbak.f Fri May 25 16:08:56 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* February 1, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB, SIDE
@@ -108,10 +108,15 @@
INFO = -3
ELSE IF( ILO.LT.1 ) THEN
INFO = -4
- ELSE IF( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) THEN
+ ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
+ INFO = -4
+ ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
+ $ THEN
+ INFO = -5
+ ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
INFO = -5
ELSE IF( M.LT.0 ) THEN
- INFO = -6
+ INFO = -8
ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
INFO = -10
END IF
diff -uNr LAPACK.orig/SRC/dggbal.f LAPACK/SRC/dggbal.f
--- LAPACK.orig/SRC/dggbal.f Thu Nov 4 14:25:44 1999
+++ LAPACK/SRC/dggbal.f Fri May 25 16:09:17 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 12, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB
@@ -141,7 +141,7 @@
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -5
+ INFO = -6
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGGBAL', -INFO )
@@ -188,8 +188,8 @@
IF( L.NE.1 )
$ GO TO 30
*
- RSCALE( 1 ) = 1
- LSCALE( 1 ) = 1
+ RSCALE( 1 ) = ONE
+ LSCALE( 1 ) = ONE
GO TO 190
*
30 CONTINUE
@@ -247,7 +247,7 @@
* Permute rows M and I
*
160 CONTINUE
- LSCALE( M ) = I
+ LSCALE( M ) = DBLE( I )
IF( I.EQ.M )
$ GO TO 170
CALL DSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
@@ -256,7 +256,7 @@
* Permute columns M and J
*
170 CONTINUE
- RSCALE( M ) = J
+ RSCALE( M ) = DBLE( J )
IF( J.EQ.M )
$ GO TO 180
CALL DSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
@@ -424,7 +424,7 @@
DO 360 I = ILO, IHI
IRAB = IDAMAX( N-ILO+1, A( I, ILO ), LDA )
RAB = ABS( A( I, IRAB+ILO-1 ) )
- IRAB = IDAMAX( N-ILO+1, B( I, ILO ), LDA )
+ IRAB = IDAMAX( N-ILO+1, B( I, ILO ), LDB )
RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
diff -uNr LAPACK.orig/SRC/dgges.f LAPACK/SRC/dgges.f
--- LAPACK.orig/SRC/dgges.f Thu Nov 4 14:26:18 1999
+++ LAPACK/SRC/dgges.f Fri May 25 16:09:38 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SORT
@@ -158,10 +159,9 @@
* LWORK (input) INTEGER
* The dimension of the array WORK. LWORK >= 8*N+16.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* BWORK (workspace) LOGICAL array, dimension (N)
* Not referenced if SORT = 'N'.
@@ -184,12 +184,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, LST2SL, WANTST
+ $ LST2SL, WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, MAXWRK,
$ MINWRK
@@ -245,7 +247,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -272,7 +273,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MINWRK = 7*( N+1 ) + 16
MAXWRK = 7*( N+1 ) + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) +
$ 16
@@ -281,19 +282,18 @@
$ ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -19
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -19
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGGES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/dggesx.f LAPACK/SRC/dggesx.f
--- LAPACK.orig/SRC/dggesx.f Thu Nov 4 14:26:18 1999
+++ LAPACK/SRC/dggesx.f Fri May 25 16:09:56 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
@@ -185,6 +186,10 @@
* If SENSE = 'E', 'V', or 'B',
* LWORK >= MAX( 8*(N+1)+16, 2*SDIM*(N-SDIM) ).
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
* Not referenced if SENSE = 'N'.
*
@@ -227,6 +232,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
* ..
@@ -330,7 +337,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
MINWRK = 8*( N+1 ) + 16
MAXWRK = 7*( N+1 ) + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) +
$ 16
@@ -338,7 +345,15 @@
MAXWRK = MAX( MAXWRK, 8*( N+1 )+N*
$ ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 )+16 )
END IF
+*
+* Estimate the workspace needed by DTGSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, 2*N+( N*N+1 ) / 2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -22
END IF
IF( .NOT.WANTSN ) THEN
LIWMIN = 1
@@ -346,21 +361,19 @@
LIWMIN = N + 6
END IF
IWORK( 1 ) = LIWMIN
-*
- IF( INFO.EQ.0 .AND. LWORK.LT.MINWRK ) THEN
- INFO = -22
- ELSE IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
+ IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
IF( LIWORK.LT.LIWMIN )
$ INFO = -24
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGGESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/dggev.f LAPACK/SRC/dggev.f
--- LAPACK.orig/SRC/dggev.f Thu Nov 4 14:26:18 1999
+++ LAPACK/SRC/dggev.f Fri May 25 16:10:14 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -123,10 +124,9 @@
* The dimension of the array WORK. LWORK >= max(1,8*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -141,11 +141,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR
CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, MAXWRK,
@@ -157,8 +159,9 @@
LOGICAL LDUMMA( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY,
- $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA
+ EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
+ $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
+ $ XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -199,7 +202,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -225,24 +227,22 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 7*N + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 8*N )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -16
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -16
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGGEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/dggevx.f LAPACK/SRC/dggevx.f
--- LAPACK.orig/SRC/dggevx.f Thu Nov 4 14:26:18 1999
+++ LAPACK/SRC/dggevx.f Fri May 25 16:11:31 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -212,10 +213,9 @@
* If SENSE = 'E', LWORK >= 12*N.
* If SENSE = 'V' or 'B', LWORK >= 2*N*N+12*N+16.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (N+6)
* If SENSE = 'E', IWORK is not referenced.
@@ -262,12 +262,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY, PAIR,
- $ WANTSB, WANTSE, WANTSN, WANTSV
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, PAIR, WANTSB,
+ $ WANTSE, WANTSN, WANTSV
CHARACTER CHTEMP
INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
$ ITAU, IWRK, IWRK1, J, JC, JR, M, MAXWRK,
@@ -279,9 +281,9 @@
LOGICAL LDUMMA( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY,
- $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, DTGSNA,
- $ XERBLA
+ EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
+ $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
+ $ DTGSNA, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -327,7 +329,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC,
$ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
$ THEN
@@ -360,7 +361,7 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 5*N + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 6*N )
IF( WANTSE ) THEN
@@ -370,24 +371,20 @@
MAXWRK = MAX( MAXWRK, 2*N*N+12*N+16 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -26
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -26
- END IF
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGGEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
-*
*
* Get machine constants
*
diff -uNr LAPACK.orig/SRC/dgghrd.f LAPACK/SRC/dgghrd.f
--- LAPACK.orig/SRC/dgghrd.f Thu Nov 4 14:25:43 1999
+++ LAPACK/SRC/dgghrd.f Fri May 25 16:11:50 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -20,16 +20,32 @@
*
* DGGHRD reduces a pair of real matrices (A,B) to generalized upper
* Hessenberg form using orthogonal transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are orthogonal, and ' means transpose.
+* general matrix and B is upper triangular. The form of the
+* generalized eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the orthogonal matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**T*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**T*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**T*x.
*
* The orthogonal matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
* postmultiplied into input matrices Q1 and Z1, so that
*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+*
+* Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+*
+* If Q1 is the orthogonal matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then DGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -53,10 +69,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to DGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to SGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
@@ -70,33 +87,28 @@
*
* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**T B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the orthogonal matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain an orthogonal matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+* typically from the QR factorization of B.
+* On exit, if COMPQ='I', the orthogonal matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the orthogonal matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain an orthogonal matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+* On exit, if COMPZ='I', the orthogonal matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/SRC/dhgeqz.f LAPACK/SRC/dhgeqz.f
--- LAPACK.orig/SRC/dhgeqz.f Thu Nov 4 14:24:45 1999
+++ LAPACK/SRC/dhgeqz.f Fri May 25 16:12:11 2001
@@ -1,56 +1,75 @@
- SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
$ LWORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), Q( LDQ, * ), WORK( * ),
- $ Z( LDZ, * )
+ DOUBLE PRECISION ALPHAI( * ), ALPHAR( * ), BETA( * ),
+ $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
+ $ WORK( * ), Z( LDZ, * )
* ..
*
* Purpose
* =======
*
-* DHGEQZ implements a single-/double-shift version of the QZ method for
-* finding the generalized eigenvalues
-*
-* w(j)=(ALPHAR(j) + i*ALPHAI(j))/BETAR(j) of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* In addition, the pair A,B may be reduced to generalized Schur form:
-* B is upper triangular, and A is block upper triangular, where the
-* diagonal blocks are either 1-by-1 or 2-by-2, the 2-by-2 blocks having
-* complex generalized eigenvalues (see the description of the argument
-* JOB.)
-*
-* If JOB='S', then the pair (A,B) is simultaneously reduced to Schur
-* form by applying one orthogonal tranformation (usually called Q) on
-* the left and another (usually called Z) on the right. The 2-by-2
-* upper-triangular diagonal blocks of B corresponding to 2-by-2 blocks
-* of A will be reduced to positive diagonal matrices. (I.e.,
-* if A(j+1,j) is non-zero, then B(j+1,j)=B(j,j+1)=0 and B(j,j) and
-* B(j+1,j+1) will be positive.)
-*
-* If JOB='E', then at each iteration, the same transformations
-* are computed, but they are only applied to those parts of A and B
-* which are needed to compute ALPHAR, ALPHAI, and BETAR.
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the orthogonal
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* DHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the double-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a real matrix pair (A,B):
+*
+* A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+*
+* as computed by DGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**T, T = Q*P*Z**T,
+*
+* where Q and Z are orthogonal matrices, P is an upper triangular
+* matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+* diagonal blocks.
+*
+* The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+* (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+* eigenvalues.
+*
+* Additionally, the 2-by-2 upper triangular diagonal blocks of P
+* corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+* form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+* P(j,j) > 0, and P(j+1,j+1) > 0.
+*
+* Optionally, the orthogonal matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced
+* the matrix pair (A,B) to generalized upper Hessenberg form, then the
+* output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+* generalized Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
+* of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
+* complex and beta real.
+* If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+* generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* Real eigenvalues can be read directly from the generalized Schur
+* form:
+* alpha = S(i,i), beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -60,114 +79,98 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHAR, ALPHAI, and BETA. A and B will
-* not necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHAR, ALPHAI, and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Compute eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the transpose of
-* the orthogonal tranformation that is applied to the
-* left side of A and B to reduce them to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain an orthogonal matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the orthogonal
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Z is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain an orthogonal matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to generalized Schur form.
-* If JOB='E', then on exit A will have been destroyed.
-* The diagonal blocks will be correct, but the off-diagonal
-* portion will be meaningless.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero. 2-by-2 blocks in B
-* corresponding to 2-by-2 blocks in A will be reduced to
-* positive diagonal form. (I.e., if A(j+1,j) is non-zero,
-* then B(j+1,j)=B(j,j+1)=0 and B(j,j) and B(j+1,j+1) will be
-* positive.)
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to Schur form.
-* If JOB='E', then on exit B will have been destroyed.
-* Elements corresponding to diagonal blocks of A will be
-* correct, but the off-diagonal portion will be meaningless.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) DOUBLE PRECISION array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper quasi-triangular
+* matrix S from the generalized Schur factorization;
+* 2-by-2 diagonal blocks (corresponding to complex conjugate
+* pairs of eigenvalues) are returned in standard form, with
+* H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+* If JOB = 'E', the diagonal blocks of H match those of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) DOUBLE PRECISION array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization;
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of S
+* are reduced to positive diagonal form, i.e., if H(j+1,j) is
+* non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+* T(j+1,j+1) > 0.
+* If JOB = 'E', the diagonal blocks of T match those of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHAR (output) DOUBLE PRECISION array, dimension (N)
-* ALPHAR(1:N) will be set to real parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=A(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The real parts of each scalar alpha defining an eigenvalue
+* of GNEP.
*
* ALPHAI (output) DOUBLE PRECISION array, dimension (N)
-* ALPHAI(1:N) will be set to imaginary parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=0.
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP.
+* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+* positive, then the j-th and (j+1)-st eigenvalues are a
+* complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
*
* BETA (output) DOUBLE PRECISION array, dimension (N)
-* BETA(1:N) will be set to the (real) diagonal elements of B
-* that would result from reducing A and B to Schur form and
-* then further reducing them both to triangular form using
-* unitary transformations s.t. the diagonal of B was
-* non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then BETA(j)=B(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
-* (Note that BETA(1:N) will always be non-negative, and no
-* BETAI is necessary.)
+* The scalars beta that define the eigenvalues of GNEP.
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the transpose of the orthogonal
-* transformations which are applied to A and B on the left
-* will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+* of left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the orthogonal transformations
-* which are applied to A and B on the right will be applied
-* to the array Z on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of
+* right Schur vectors of (H,T), and if COMPZ = 'V', the
+* orthogonal matrix of right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -187,13 +190,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -225,7 +227,7 @@
$ B1R, B22, B2A, B2I, B2R, BN, BNORM, BSCALE,
$ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
$ CQ, CR, CZ, ESHIFT, S, S1, S1INV, S2, SAFMAX,
- $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T,
+ $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T1,
$ TAU, TEMP, TEMP2, TEMPI, TEMPR, U1, U12, U12L,
$ U2, ULP, VS, W11, W12, W21, W22, WABS, WI, WR,
$ WR2
@@ -302,9 +304,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -15
@@ -340,8 +342,8 @@
SAFMIN = DLAMCH( 'S' )
SAFMAX = ONE / SAFMIN
ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
- ANORM = DLANHS( 'F', IN, A( ILO, ILO ), LDA, WORK )
- BNORM = DLANHS( 'F', IN, B( ILO, ILO ), LDB, WORK )
+ ANORM = DLANHS( 'F', IN, H( ILO, ILO ), LDH, WORK )
+ BNORM = DLANHS( 'F', IN, T( ILO, ILO ), LDT, WORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -350,15 +352,15 @@
* Set Eigenvalues IHI+1:N
*
DO 30 J = IHI + 1, N
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 10 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
10 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 20 JR = 1, N
@@ -366,9 +368,9 @@
20 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
30 CONTINUE
*
* If IHI < ILO, skip QZ steps
@@ -408,8 +410,8 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
IF( ILAST.EQ.ILO ) THEN
*
@@ -417,14 +419,14 @@
*
GO TO 80
ELSE
- IF( ABS( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = ZERO
+ IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = ZERO
GO TO 80
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = ZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = ZERO
GO TO 70
END IF
*
@@ -432,36 +434,36 @@
*
DO 60 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = ZERO
+ IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = ZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = ZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = ZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- TEMP = ABS( A( J, J-1 ) )
- TEMP2 = ABS( A( J, J ) )
+ TEMP = ABS( H( J, J-1 ) )
+ TEMP2 = ABS( H( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( TEMP*( ASCALE*ABS( A( J+1, J ) ) ).LE.TEMP2*
+ IF( TEMP*( ASCALE*ABS( H( J+1, J ) ) ).LE.TEMP2*
$ ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
END IF
*
@@ -473,21 +475,21 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 40 JCH = J, ILAST - 1
- TEMP = A( JCH, JCH )
- CALL DLARTG( TEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = ZERO
- CALL DROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL DROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ TEMP = H( JCH, JCH )
+ CALL DLARTG( TEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = ZERO
+ CALL DROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL DROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
- IF( ABS( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 80
ELSE
@@ -495,35 +497,35 @@
GO TO 110
END IF
END IF
- B( JCH+1, JCH+1 ) = ZERO
+ T( JCH+1, JCH+1 ) = ZERO
40 CONTINUE
GO TO 70
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 50 JCH = J, ILAST - 1
- TEMP = B( JCH, JCH+1 )
- CALL DLARTG( TEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = ZERO
+ TEMP = T( JCH, JCH+1 )
+ CALL DLARTG( TEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = ZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL DROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL DROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL DROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL DROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
- TEMP = A( JCH+1, JCH )
- CALL DLARTG( TEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = ZERO
- CALL DROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL DROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ TEMP = H( JCH+1, JCH )
+ CALL DLARTG( TEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = ZERO
+ CALL DROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL DROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL DROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -547,34 +549,34 @@
INFO = N + 1
GO TO 420
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
70 CONTINUE
- TEMP = A( ILAST, ILAST )
- CALL DLARTG( TEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = ZERO
- CALL DROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL DROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ TEMP = H( ILAST, ILAST )
+ CALL DLARTG( TEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = ZERO
+ CALL DROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL DROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL DROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
* and BETA
*
80 CONTINUE
- IF( B( ILAST, ILAST ).LT.ZERO ) THEN
+ IF( T( ILAST, ILAST ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 90 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
90 CONTINUE
ELSE
- A( ILAST, ILAST ) = -A( ILAST, ILAST )
- B( ILAST, ILAST ) = -B( ILAST, ILAST )
+ H( ILAST, ILAST ) = -H( ILAST, ILAST )
+ T( ILAST, ILAST ) = -T( ILAST, ILAST )
END IF
IF( ILZ ) THEN
DO 100 J = 1, N
@@ -582,9 +584,9 @@
100 CONTINUE
END IF
END IF
- ALPHAR( ILAST ) = A( ILAST, ILAST )
+ ALPHAR( ILAST ) = H( ILAST, ILAST )
ALPHAI( ILAST ) = ZERO
- BETA( ILAST ) = B( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -617,7 +619,7 @@
* Compute single shifts.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.EQ.IITER ) THEN
@@ -625,10 +627,10 @@
* Exceptional shift. Chosen for no particularly good reason.
* (Single shift only.)
*
- IF( ( DBLE( MAXIT )*SAFMIN )*ABS( A( ILAST-1, ILAST ) ).LT.
- $ ABS( B( ILAST-1, ILAST-1 ) ) ) THEN
- ESHIFT = ESHIFT + A( ILAST-1, ILAST ) /
- $ B( ILAST-1, ILAST-1 )
+ IF( ( DBLE( MAXIT )*SAFMIN )*ABS( H( ILAST-1, ILAST ) ).LT.
+ $ ABS( T( ILAST-1, ILAST-1 ) ) ) THEN
+ ESHIFT = ESHIFT + H( ILAST-1, ILAST ) /
+ $ T( ILAST-1, ILAST-1 )
ELSE
ESHIFT = ESHIFT + ONE / ( SAFMIN*DBLE( MAXIT ) )
END IF
@@ -641,8 +643,8 @@
* bottom-right 2x2 block of A and B. The first eigenvalue
* returned by DLAG2 is the Wilkinson shift (AEP p.512),
*
- CALL DLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ S2, WR, WR2, WI )
*
TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
@@ -669,14 +671,14 @@
*
DO 120 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- TEMP = ABS( S1*A( J, J-1 ) )
- TEMP2 = ABS( S1*A( J, J )-WR*B( J, J ) )
+ TEMP = ABS( S1*H( J, J-1 ) )
+ TEMP2 = ABS( S1*H( J, J )-WR*T( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS( ( ASCALE*A( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
+ IF( ABS( ( ASCALE*H( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
$ TEMP2 )GO TO 130
120 CONTINUE
*
@@ -687,26 +689,26 @@
*
* Initial Q
*
- TEMP = S1*A( ISTART, ISTART ) - WR*B( ISTART, ISTART )
- TEMP2 = S1*A( ISTART+1, ISTART )
+ TEMP = S1*H( ISTART, ISTART ) - WR*T( ISTART, ISTART )
+ TEMP2 = S1*H( ISTART+1, ISTART )
CALL DLARTG( TEMP, TEMP2, C, S, TEMPR )
*
* Sweep
*
DO 190 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- TEMP = A( J, J-1 )
- CALL DLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
END IF
*
DO 140 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
140 CONTINUE
IF( ILQ ) THEN
DO 150 JR = 1, N
@@ -716,19 +718,19 @@
150 CONTINUE
END IF
*
- TEMP = B( J+1, J+1 )
- CALL DLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 160 JR = IFRSTM, MIN( J+2, ILAST )
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
160 CONTINUE
DO 170 JR = IFRSTM, J
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
170 CONTINUE
IF( ILZ ) THEN
DO 180 JR = 1, N
@@ -759,8 +761,8 @@
* B = ( ) with B11 non-negative.
* ( 0 B22 )
*
- CALL DLASV2( B( ILAST-1, ILAST-1 ), B( ILAST-1, ILAST ),
- $ B( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
+ CALL DLASV2( T( ILAST-1, ILAST-1 ), T( ILAST-1, ILAST ),
+ $ T( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
*
IF( B11.LT.ZERO ) THEN
CR = -CR
@@ -769,17 +771,17 @@
B22 = -B22
END IF
*
- CALL DROT( ILASTM+1-IFIRST, A( ILAST-1, ILAST-1 ), LDA,
- $ A( ILAST, ILAST-1 ), LDA, CL, SL )
- CALL DROT( ILAST+1-IFRSTM, A( IFRSTM, ILAST-1 ), 1,
- $ A( IFRSTM, ILAST ), 1, CR, SR )
+ CALL DROT( ILASTM+1-IFIRST, H( ILAST-1, ILAST-1 ), LDH,
+ $ H( ILAST, ILAST-1 ), LDH, CL, SL )
+ CALL DROT( ILAST+1-IFRSTM, H( IFRSTM, ILAST-1 ), 1,
+ $ H( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILAST.LT.ILASTM )
- $ CALL DROT( ILASTM-ILAST, B( ILAST-1, ILAST+1 ), LDB,
- $ B( ILAST, ILAST+1 ), LDA, CL, SL )
+ $ CALL DROT( ILASTM-ILAST, T( ILAST-1, ILAST+1 ), LDT,
+ $ T( ILAST, ILAST+1 ), LDH, CL, SL )
IF( IFRSTM.LT.ILAST-1 )
- $ CALL DROT( IFIRST-IFRSTM, B( IFRSTM, ILAST-1 ), 1,
- $ B( IFRSTM, ILAST ), 1, CR, SR )
+ $ CALL DROT( IFIRST-IFRSTM, T( IFRSTM, ILAST-1 ), 1,
+ $ T( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILQ )
$ CALL DROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
@@ -788,17 +790,17 @@
$ CALL DROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
$ SR )
*
- B( ILAST-1, ILAST-1 ) = B11
- B( ILAST-1, ILAST ) = ZERO
- B( ILAST, ILAST-1 ) = ZERO
- B( ILAST, ILAST ) = B22
+ T( ILAST-1, ILAST-1 ) = B11
+ T( ILAST-1, ILAST ) = ZERO
+ T( ILAST, ILAST-1 ) = ZERO
+ T( ILAST, ILAST ) = B22
*
* If B22 is negative, negate column ILAST
*
IF( B22.LT.ZERO ) THEN
DO 210 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
210 CONTINUE
*
IF( ILZ ) THEN
@@ -812,8 +814,8 @@
*
* Recompute shift
*
- CALL DLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ TEMP, WR, TEMP2, WI )
*
* If standardization has perturbed the shift onto real line,
@@ -825,10 +827,10 @@
*
* Do EISPACK (QZVAL) computation of alpha and beta
*
- A11 = A( ILAST-1, ILAST-1 )
- A21 = A( ILAST, ILAST-1 )
- A12 = A( ILAST-1, ILAST )
- A22 = A( ILAST, ILAST )
+ A11 = H( ILAST-1, ILAST-1 )
+ A21 = H( ILAST, ILAST-1 )
+ A12 = H( ILAST-1, ILAST )
+ A22 = H( ILAST, ILAST )
*
* Compute complex Givens rotation on right
* (Assume some element of C = (sA - wB) > unfl )
@@ -845,10 +847,10 @@
*
IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
$ ABS( C22R )+ABS( C22I ) ) THEN
- T = DLAPY3( C12, C11R, C11I )
- CZ = C12 / T
- SZR = -C11R / T
- SZI = -C11I / T
+ T1 = DLAPY3( C12, C11R, C11I )
+ CZ = C12 / T1
+ SZR = -C11R / T1
+ SZI = -C11I / T1
ELSE
CZ = DLAPY2( C22R, C22I )
IF( CZ.LE.SAFMIN ) THEN
@@ -858,10 +860,10 @@
ELSE
TEMPR = C22R / CZ
TEMPI = C22I / CZ
- T = DLAPY2( CZ, C21 )
- CZ = CZ / T
- SZR = -C21*TEMPR / T
- SZI = C21*TEMPI / T
+ T1 = DLAPY2( CZ, C21 )
+ CZ = CZ / T1
+ SZR = -C21*TEMPR / T1
+ SZI = C21*TEMPI / T1
END IF
END IF
*
@@ -895,10 +897,10 @@
SQI = TEMPI*A2R - TEMPR*A2I
END IF
END IF
- T = DLAPY3( CQ, SQR, SQI )
- CQ = CQ / T
- SQR = SQR / T
- SQI = SQI / T
+ T1 = DLAPY3( CQ, SQR, SQI )
+ CQ = CQ / T1
+ SQR = SQR / T1
+ SQI = SQI / T1
*
* Compute diagonal elements of QBZ
*
@@ -950,26 +952,26 @@
*
* We assume that the block is at least 3x3
*
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- U12 = B( ILAST-1, ILAST ) / B( ILAST, ILAST )
- AD11L = ( ASCALE*A( IFIRST, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD21L = ( ASCALE*A( IFIRST+1, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD12L = ( ASCALE*A( IFIRST, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD22L = ( ASCALE*A( IFIRST+1, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD32L = ( ASCALE*A( IFIRST+2, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- U12L = B( IFIRST, IFIRST+1 ) / B( IFIRST+1, IFIRST+1 )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ U12 = T( ILAST-1, ILAST ) / T( ILAST, ILAST )
+ AD11L = ( ASCALE*H( IFIRST, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD21L = ( ASCALE*H( IFIRST+1, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD12L = ( ASCALE*H( IFIRST, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD22L = ( ASCALE*H( IFIRST+1, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD32L = ( ASCALE*H( IFIRST+2, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ U12L = T( IFIRST, IFIRST+1 ) / T( IFIRST+1, IFIRST+1 )
*
V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
$ AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
@@ -991,27 +993,27 @@
* Zero (j-1)st column of A
*
IF( J.GT.ISTART ) THEN
- V( 1 ) = A( J, J-1 )
- V( 2 ) = A( J+1, J-1 )
- V( 3 ) = A( J+2, J-1 )
+ V( 1 ) = H( J, J-1 )
+ V( 2 ) = H( J+1, J-1 )
+ V( 3 ) = H( J+2, J-1 )
*
- CALL DLARFG( 3, A( J, J-1 ), V( 2 ), 1, TAU )
+ CALL DLARFG( 3, H( J, J-1 ), V( 2 ), 1, TAU )
V( 1 ) = ONE
- A( J+1, J-1 ) = ZERO
- A( J+2, J-1 ) = ZERO
+ H( J+1, J-1 ) = ZERO
+ H( J+2, J-1 ) = ZERO
END IF
*
DO 230 JC = J, ILASTM
- TEMP = TAU*( A( J, JC )+V( 2 )*A( J+1, JC )+V( 3 )*
- $ A( J+2, JC ) )
- A( J, JC ) = A( J, JC ) - TEMP
- A( J+1, JC ) = A( J+1, JC ) - TEMP*V( 2 )
- A( J+2, JC ) = A( J+2, JC ) - TEMP*V( 3 )
- TEMP2 = TAU*( B( J, JC )+V( 2 )*B( J+1, JC )+V( 3 )*
- $ B( J+2, JC ) )
- B( J, JC ) = B( J, JC ) - TEMP2
- B( J+1, JC ) = B( J+1, JC ) - TEMP2*V( 2 )
- B( J+2, JC ) = B( J+2, JC ) - TEMP2*V( 3 )
+ TEMP = TAU*( H( J, JC )+V( 2 )*H( J+1, JC )+V( 3 )*
+ $ H( J+2, JC ) )
+ H( J, JC ) = H( J, JC ) - TEMP
+ H( J+1, JC ) = H( J+1, JC ) - TEMP*V( 2 )
+ H( J+2, JC ) = H( J+2, JC ) - TEMP*V( 3 )
+ TEMP2 = TAU*( T( J, JC )+V( 2 )*T( J+1, JC )+V( 3 )*
+ $ T( J+2, JC ) )
+ T( J, JC ) = T( J, JC ) - TEMP2
+ T( J+1, JC ) = T( J+1, JC ) - TEMP2*V( 2 )
+ T( J+2, JC ) = T( J+2, JC ) - TEMP2*V( 3 )
230 CONTINUE
IF( ILQ ) THEN
DO 240 JR = 1, N
@@ -1028,27 +1030,27 @@
* Swap rows to pivot
*
ILPIVT = .FALSE.
- TEMP = MAX( ABS( B( J+1, J+1 ) ), ABS( B( J+1, J+2 ) ) )
- TEMP2 = MAX( ABS( B( J+2, J+1 ) ), ABS( B( J+2, J+2 ) ) )
+ TEMP = MAX( ABS( T( J+1, J+1 ) ), ABS( T( J+1, J+2 ) ) )
+ TEMP2 = MAX( ABS( T( J+2, J+1 ) ), ABS( T( J+2, J+2 ) ) )
IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
SCALE = ZERO
U1 = ONE
U2 = ZERO
GO TO 250
ELSE IF( TEMP.GE.TEMP2 ) THEN
- W11 = B( J+1, J+1 )
- W21 = B( J+2, J+1 )
- W12 = B( J+1, J+2 )
- W22 = B( J+2, J+2 )
- U1 = B( J+1, J )
- U2 = B( J+2, J )
+ W11 = T( J+1, J+1 )
+ W21 = T( J+2, J+1 )
+ W12 = T( J+1, J+2 )
+ W22 = T( J+2, J+2 )
+ U1 = T( J+1, J )
+ U2 = T( J+2, J )
ELSE
- W21 = B( J+1, J+1 )
- W11 = B( J+2, J+1 )
- W22 = B( J+1, J+2 )
- W12 = B( J+2, J+2 )
- U2 = B( J+1, J )
- U1 = B( J+2, J )
+ W21 = T( J+1, J+1 )
+ W11 = T( J+2, J+1 )
+ W22 = T( J+1, J+2 )
+ W12 = T( J+2, J+2 )
+ U2 = T( J+1, J )
+ U1 = T( J+2, J )
END IF
*
* Swap columns if nec.
@@ -1098,9 +1100,9 @@
*
* Compute Householder Vector
*
- T = SQRT( SCALE**2+U1**2+U2**2 )
- TAU = ONE + SCALE / T
- VS = -ONE / ( SCALE+T )
+ T1 = SQRT( SCALE**2+U1**2+U2**2 )
+ TAU = ONE + SCALE / T1
+ VS = -ONE / ( SCALE+T1 )
V( 1 ) = ONE
V( 2 ) = VS*U1
V( 3 ) = VS*U2
@@ -1108,18 +1110,18 @@
* Apply transformations from the right.
*
DO 260 JR = IFRSTM, MIN( J+3, ILAST )
- TEMP = TAU*( A( JR, J )+V( 2 )*A( JR, J+1 )+V( 3 )*
- $ A( JR, J+2 ) )
- A( JR, J ) = A( JR, J ) - TEMP
- A( JR, J+1 ) = A( JR, J+1 ) - TEMP*V( 2 )
- A( JR, J+2 ) = A( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( H( JR, J )+V( 2 )*H( JR, J+1 )+V( 3 )*
+ $ H( JR, J+2 ) )
+ H( JR, J ) = H( JR, J ) - TEMP
+ H( JR, J+1 ) = H( JR, J+1 ) - TEMP*V( 2 )
+ H( JR, J+2 ) = H( JR, J+2 ) - TEMP*V( 3 )
260 CONTINUE
DO 270 JR = IFRSTM, J + 2
- TEMP = TAU*( B( JR, J )+V( 2 )*B( JR, J+1 )+V( 3 )*
- $ B( JR, J+2 ) )
- B( JR, J ) = B( JR, J ) - TEMP
- B( JR, J+1 ) = B( JR, J+1 ) - TEMP*V( 2 )
- B( JR, J+2 ) = B( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( T( JR, J )+V( 2 )*T( JR, J+1 )+V( 3 )*
+ $ T( JR, J+2 ) )
+ T( JR, J ) = T( JR, J ) - TEMP
+ T( JR, J+1 ) = T( JR, J+1 ) - TEMP*V( 2 )
+ T( JR, J+2 ) = T( JR, J+2 ) - TEMP*V( 3 )
270 CONTINUE
IF( ILZ ) THEN
DO 280 JR = 1, N
@@ -1130,8 +1132,8 @@
Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
280 CONTINUE
END IF
- B( J+1, J ) = ZERO
- B( J+2, J ) = ZERO
+ T( J+1, J ) = ZERO
+ T( J+2, J ) = ZERO
290 CONTINUE
*
* Last elements: Use Givens rotations
@@ -1139,17 +1141,17 @@
* Rotations from the left
*
J = ILAST - 1
- TEMP = A( J, J-1 )
- CALL DLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
*
DO 300 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
300 CONTINUE
IF( ILQ ) THEN
DO 310 JR = 1, N
@@ -1161,19 +1163,19 @@
*
* Rotations from the right.
*
- TEMP = B( J+1, J+1 )
- CALL DLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 320 JR = IFRSTM, ILAST
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
320 CONTINUE
DO 330 JR = IFRSTM, ILAST - 1
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
330 CONTINUE
IF( ILZ ) THEN
DO 340 JR = 1, N
@@ -1207,15 +1209,15 @@
* Set Eigenvalues 1:ILO-1
*
DO 410 J = 1, ILO - 1
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 390 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
390 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 400 JR = 1, N
@@ -1223,9 +1225,9 @@
400 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
410 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/SRC/dlasr.f LAPACK/SRC/dlasr.f
--- LAPACK.orig/SRC/dlasr.f Thu Nov 4 14:24:50 1999
+++ LAPACK/SRC/dlasr.f Fri May 25 16:12:31 2001
@@ -3,7 +3,7 @@
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER DIRECT, PIVOT, SIDE
@@ -16,44 +16,77 @@
* Purpose
* =======
*
-* DLASR performs the transformation
-*
-* A := P*A, when SIDE = 'L' or 'l' ( Left-hand side )
-*
-* A := A*P', when SIDE = 'R' or 'r' ( Right-hand side )
-*
-* where A is an m by n real matrix and P is an orthogonal matrix,
-* consisting of a sequence of plane rotations determined by the
-* parameters PIVOT and DIRECT as follows ( z = m when SIDE = 'L' or 'l'
-* and z = n when SIDE = 'R' or 'r' ):
-*
-* When DIRECT = 'F' or 'f' ( Forward sequence ) then
-*
-* P = P( z - 1 )*...*P( 2 )*P( 1 ),
-*
-* and when DIRECT = 'B' or 'b' ( Backward sequence ) then
-*
-* P = P( 1 )*P( 2 )*...*P( z - 1 ),
-*
-* where P( k ) is a plane rotation matrix for the following planes:
-*
-* when PIVOT = 'V' or 'v' ( Variable pivot ),
-* the plane ( k, k + 1 )
-*
-* when PIVOT = 'T' or 't' ( Top pivot ),
-* the plane ( 1, k + 1 )
-*
-* when PIVOT = 'B' or 'b' ( Bottom pivot ),
-* the plane ( k, z )
-*
-* c( k ) and s( k ) must contain the cosine and sine that define the
-* matrix P( k ). The two by two plane rotation part of the matrix
-* P( k ), R( k ), is assumed to be of the form
-*
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
-*
-* This version vectorises across rows of the array A when SIDE = 'L'.
+* DLASR applies a sequence of plane rotations to a real matrix A,
+* from either the left or the right.
+*
+* When SIDE = 'L', the transformation takes the form
+*
+* A := P*A
+*
+* and when SIDE = 'R', the transformation takes the form
+*
+* A := A*P**T
+*
+* where P is an orthogonal matrix consisting of a sequence of z plane
+* rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+* and P**T is the transpose of P.
+*
+* When DIRECT = 'F' (Forward sequence), then
+*
+* P = P(z-1) * ... * P(2) * P(1)
+*
+* and when DIRECT = 'B' (Backward sequence), then
+*
+* P = P(1) * P(2) * ... * P(z-1)
+*
+* where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+*
+* R(k) = ( c(k) s(k) )
+* = ( -s(k) c(k) ).
+*
+* When PIVOT = 'V' (Variable pivot), the rotation is performed
+* for the plane (k,k+1), i.e., P(k) has the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears as a rank-2 modification to the identity matrix in
+* rows and columns k and k+1.
+*
+* When PIVOT = 'T' (Top pivot), the rotation is performed for the
+* plane (1,k+1), so P(k) has the form
+*
+* P(k) = ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears in rows and columns 1 and k+1.
+*
+* Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+* performed for the plane (k,z), giving P(k) the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+*
+* where R(k) appears in rows and columns k and z. The rotations are
+* performed without ever forming P(k) explicitly.
*
* Arguments
* =========
@@ -62,13 +95,13 @@
* Specifies whether the plane rotation matrix P is applied to
* A on the left or the right.
* = 'L': Left, compute A := P*A
-* = 'R': Right, compute A:= A*P'
+* = 'R': Right, compute A:= A*P**T
*
* DIRECT (input) CHARACTER*1
* Specifies whether P is a forward or backward sequence of
* plane rotations.
-* = 'F': Forward, P = P( z - 1 )*...*P( 2 )*P( 1 )
-* = 'B': Backward, P = P( 1 )*P( 2 )*...*P( z - 1 )
+* = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+* = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
*
* PIVOT (input) CHARACTER*1
* Specifies the plane for which P(k) is a plane rotation
@@ -85,18 +118,22 @@
* The number of columns of the matrix A. If n <= 1, an
* immediate return is effected.
*
-* C, S (input) DOUBLE PRECISION arrays, dimension
+* C (input) DOUBLE PRECISION array, dimension
+* (M-1) if SIDE = 'L'
+* (N-1) if SIDE = 'R'
+* The cosines c(k) of the plane rotations.
+*
+* S (input) DOUBLE PRECISION array, dimension
* (M-1) if SIDE = 'L'
* (N-1) if SIDE = 'R'
-* c(k) and s(k) contain the cosine and sine that define the
-* matrix P(k). The two by two plane rotation part of the
-* matrix P(k), R(k), is assumed to be of the form
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
+* The sines s(k) of the plane rotations. The 2-by-2 plane
+* rotation part of the matrix P(k), R(k), has the form
+* R(k) = ( c(k) s(k) )
+* ( -s(k) c(k) ).
*
* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-* The m by n matrix A. On exit, A is overwritten by P*A if
-* SIDE = 'R' or by A*P' if SIDE = 'L'.
+* The M-by-N matrix A. On exit, A is overwritten by P*A if
+* SIDE = 'R' or by A*P**T if SIDE = 'L'.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
diff -uNr LAPACK.orig/SRC/dsbgst.f LAPACK/SRC/dsbgst.f
--- LAPACK.orig/SRC/dsbgst.f Thu Nov 4 14:23:31 1999
+++ LAPACK/SRC/dsbgst.f Fri May 25 16:12:50 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 9, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO, VECT
@@ -125,7 +125,7 @@
INFO = -3
ELSE IF( KA.LT.0 ) THEN
INFO = -4
- ELSE IF( KB.LT.0 ) THEN
+ ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
INFO = -5
ELSE IF( LDAB.LT.KA+1 ) THEN
INFO = -7
diff -uNr LAPACK.orig/SRC/dstebz.f LAPACK/SRC/dstebz.f
--- LAPACK.orig/SRC/dstebz.f Thu Nov 4 14:24:57 1999
+++ LAPACK/SRC/dstebz.f Fri May 25 16:13:23 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-18-00: Increase FUDGE factor for T3E (eca)
*
* .. Scalar Arguments ..
CHARACTER ORDER, RANGE
@@ -175,7 +176,7 @@
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
$ HALF = 1.0D0 / TWO )
DOUBLE PRECISION FUDGE, RELFAC
- PARAMETER ( FUDGE = 2.0D0, RELFAC = 2.0D0 )
+ PARAMETER ( FUDGE = 2.1D0, RELFAC = 2.0D0 )
* ..
* .. Local Scalars ..
LOGICAL NCNVRG, TOOFEW
diff -uNr LAPACK.orig/SRC/dtgevc.f LAPACK/SRC/dtgevc.f
--- LAPACK.orig/SRC/dtgevc.f Thu Nov 4 14:26:09 1999
+++ LAPACK/SRC/dtgevc.f Fri May 25 16:13:33 2001
@@ -1,18 +1,18 @@
- SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ DOUBLE PRECISION P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -20,35 +20,31 @@
* Purpose
* =======
*
-* DTGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of real upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* DTGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of real matrices (S,P), where S is a quasi-triangular matrix
+* and P is upper triangular. Matrix pairs of this type are produced by
+* the generalized Schur factorization of a matrix pair (A,B):
+*
+* A = Q*S*Z**T, B = Q*P*Z**T
+*
+* as computed by DGGHRD + DHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input orthogonal
-* matrices. If (A,B) was obtained from the generalized real-Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
-*
-* A must be block upper triangular, with 1-by-1 and 2-by-2 diagonal
-* blocks. Corresponding to each 2-by-2 diagonal block is a complex
-* conjugate pair of eigenvalues and eigenvectors; only one
-* eigenvector of the pair is computed, namely the one corresponding
-* to the eigenvalue with positive imaginary part.
-*
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal blocks of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the orthogonal factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
+*
* Arguments
* =========
*
@@ -59,78 +55,84 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to the real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must
-* be set to .TRUE..
+* computed. If w(j) is a real eigenvalue, the corresponding
+* real eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector
+* is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+* and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+* set to .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
+* The order of the matrices S and P. N >= 0.
*
-* A (input) DOUBLE PRECISION array, dimension (LDA,N)
-* The upper quasi-triangular matrix A.
+* S (input) DOUBLE PRECISION array, dimension (LDS,N)
+* The upper quasi-triangular matrix S from a generalized Schur
+* factorization, as computed by DHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) DOUBLE PRECISION array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by DHGEQZ.
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+* of S must be in positive diagonal form.
*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1, N).
-*
-* B (input) DOUBLE PRECISION array, dimension (LDB,N)
-* The upper triangular matrix B. If A has a 2-by-2 diagonal
-* block, then the corresponding 2-by-2 block of B must be
-* diagonal with positive elements.
-*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the orthogonal matrix Q
* of left Schur vectors returned by DHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
*
+* Not referenced if SIDE = 'R'.
+*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-* contain an N-by-N matrix Q (usually the orthogonal matrix Z
+* contain an N-by-N matrix Z (usually the orthogonal matrix Z
* of right Schur vectors returned by DHGEQZ).
+*
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
-* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
-* SELECT, stored consecutively in the columns of
-* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+* if HOWMNY = 'B' or 'b', the matrix Z*X;
+* if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+* specified by SELECT, stored consecutively in the
+* columns of VR, in the same order as their
+* eigenvalues.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
+*
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
@@ -199,7 +201,7 @@
* partial sums. Since FORTRAN arrays are stored columnwise, this has
* the advantage that at each step, the elements of C that are accessed
* are adjacent to one another, whereas with the rowwise method, the
-* elements accessed at a step are spaced LDA (and LDB) words apart.
+* elements accessed at a step are spaced LDS (and LDP) words apart.
*
* When finding left eigenvectors, the matrix in question is the
* transpose of the one in storage, so the rowwise method then
@@ -226,8 +228,8 @@
$ XSCALE
* ..
* .. Local Arrays ..
- DOUBLE PRECISION BDIAG( 2 ), SUM( 2, 2 ), SUMA( 2, 2 ),
- $ SUMB( 2, 2 )
+ DOUBLE PRECISION BDIAG( 2 ), SUM( 2, 2 ), SUMS( 2, 2 ),
+ $ SUMP( 2, 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -235,7 +237,7 @@
EXTERNAL LSAME, DLAMCH
* ..
* .. External Subroutines ..
- EXTERNAL DGEMV, DLACPY, DLAG2, DLALN2, XERBLA
+ EXTERNAL DGEMV, DLABAD, DLACPY, DLAG2, DLALN2, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN
@@ -252,7 +254,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -284,9 +286,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -305,7 +307,7 @@
GO TO 10
END IF
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO )
+ IF( S( J+1, J ).NE.ZERO )
$ ILCPLX = .TRUE.
END IF
IF( ILCPLX ) THEN
@@ -325,11 +327,11 @@
ILABAD = .FALSE.
ILBBAD = .FALSE.
DO 20 J = 1, N - 1
- IF( A( J+1, J ).NE.ZERO ) THEN
- IF( B( J, J ).EQ.ZERO .OR. B( J+1, J+1 ).EQ.ZERO .OR.
- $ B( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
+ IF( S( J+1, J ).NE.ZERO ) THEN
+ IF( P( J, J ).EQ.ZERO .OR. P( J+1, J+1 ).EQ.ZERO .OR.
+ $ P( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
IF( J.LT.N-1 ) THEN
- IF( A( J+2, J+1 ).NE.ZERO )
+ IF( S( J+2, J+1 ).NE.ZERO )
$ ILABAD = .TRUE.
END IF
END IF
@@ -372,30 +374,30 @@
* blocks) of A and B to check for possible overflow in the
* triangular solver.
*
- ANORM = ABS( A( 1, 1 ) )
+ ANORM = ABS( S( 1, 1 ) )
IF( N.GT.1 )
- $ ANORM = ANORM + ABS( A( 2, 1 ) )
- BNORM = ABS( B( 1, 1 ) )
+ $ ANORM = ANORM + ABS( S( 2, 1 ) )
+ BNORM = ABS( P( 1, 1 ) )
WORK( 1 ) = ZERO
WORK( N+1 ) = ZERO
*
DO 50 J = 2, N
TEMP = ZERO
TEMP2 = ZERO
- IF( A( J, J-1 ).EQ.ZERO ) THEN
+ IF( S( J, J-1 ).EQ.ZERO ) THEN
IEND = J - 1
ELSE
IEND = J - 2
END IF
DO 30 I = 1, IEND
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
30 CONTINUE
WORK( J ) = TEMP
WORK( N+J ) = TEMP2
DO 40 I = IEND + 1, MIN( J+1, N )
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
40 CONTINUE
ANORM = MAX( ANORM, TEMP )
BNORM = MAX( BNORM, TEMP2 )
@@ -425,7 +427,7 @@
END IF
NW = 1
IF( JE.LT.N ) THEN
- IF( A( JE+1, JE ).NE.ZERO ) THEN
+ IF( S( JE+1, JE ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -444,8 +446,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -472,10 +474,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -517,7 +519,7 @@
*
* Complex eigenvalue
*
- CALL DLAG2( A( JE, JE ), LDA, B( JE, JE ), LDB,
+ CALL DLAG2( S( JE, JE ), LDS, P( JE, JE ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
BCOEFI = -BCOEFI
@@ -549,9 +551,9 @@
*
* Compute first two components of eigenvector
*
- TEMP = ACOEF*A( JE+1, JE )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE+1, JE )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GT.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -560,10 +562,10 @@
ELSE
WORK( 2*N+JE+1 ) = ONE
WORK( 3*N+JE+1 ) = ZERO
- TEMP = ACOEF*A( JE, JE+1 )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE+1, JE+1 )-ACOEF*
- $ A( JE+1, JE+1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE+1, JE+1 ) / TEMP
+ TEMP = ACOEF*S( JE, JE+1 )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE+1, JE+1 )-ACOEF*
+ $ S( JE+1, JE+1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE+1, JE+1 ) / TEMP
END IF
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
$ ABS( WORK( 2*N+JE+1 ) )+ABS( WORK( 3*N+JE+1 ) ) )
@@ -586,11 +588,11 @@
END IF
*
NA = 1
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO ) THEN
+ IF( S( J+1, J ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
NA = 2
END IF
END IF
@@ -616,13 +618,13 @@
* Compute dot products
*
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
*
* To reduce the op count, this is done as
*
* _ j-1 _ j-1
-* a*conjg( sum A(k,j)*x(k) ) - b*conjg( sum B(k,j)*x(k) )
+* a*conjg( sum S(k,j)*x(k) ) - b*conjg( sum P(k,j)*x(k) )
* k=je k=je
*
* which may cause underflow problems if A or B are close
@@ -659,15 +661,15 @@
*$PL$ CMCHAR='*'
*
DO 110 JA = 1, NA
- SUMA( JA, JW ) = ZERO
- SUMB( JA, JW ) = ZERO
+ SUMS( JA, JW ) = ZERO
+ SUMP( JA, JW ) = ZERO
*
DO 100 JR = JE, J - 1
- SUMA( JA, JW ) = SUMA( JA, JW ) +
- $ A( JR, J+JA-1 )*
+ SUMS( JA, JW ) = SUMS( JA, JW ) +
+ $ S( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
- SUMB( JA, JW ) = SUMB( JA, JW ) +
- $ B( JR, J+JA-1 )*
+ SUMP( JA, JW ) = SUMP( JA, JW ) +
+ $ P( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
100 CONTINUE
110 CONTINUE
@@ -687,15 +689,15 @@
*
DO 130 JA = 1, NA
IF( ILCPLX ) THEN
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 ) -
- $ BCOEFI*SUMB( JA, 2 )
- SUM( JA, 2 ) = -ACOEF*SUMA( JA, 2 ) +
- $ BCOEFR*SUMB( JA, 2 ) +
- $ BCOEFI*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 ) -
+ $ BCOEFI*SUMP( JA, 2 )
+ SUM( JA, 2 ) = -ACOEF*SUMS( JA, 2 ) +
+ $ BCOEFR*SUMP( JA, 2 ) +
+ $ BCOEFI*SUMP( JA, 1 )
ELSE
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 )
END IF
130 CONTINUE
*
@@ -703,7 +705,7 @@
* Solve ( a A - b B ) y = SUM(,)
* with scaling and perturbation of the denominator
*
- CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, A( J, J ), LDA,
+ CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS,
$ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR,
$ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP,
$ IINFO )
@@ -790,7 +792,7 @@
END IF
NW = 1
IF( JE.GT.1 ) THEN
- IF( A( JE, JE-1 ).NE.ZERO ) THEN
+ IF( S( JE, JE-1 ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -809,8 +811,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- unit eigenvector
*
@@ -839,10 +841,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -885,14 +887,14 @@
* (See "Further Details", above.)
*
DO 260 JR = 1, JE - 1
- WORK( 2*N+JR ) = BCOEFR*B( JR, JE ) -
- $ ACOEF*A( JR, JE )
+ WORK( 2*N+JR ) = BCOEFR*P( JR, JE ) -
+ $ ACOEF*S( JR, JE )
260 CONTINUE
ELSE
*
* Complex eigenvalue
*
- CALL DLAG2( A( JE-1, JE-1 ), LDA, B( JE-1, JE-1 ), LDB,
+ CALL DLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
IF( BCOEFI.EQ.ZERO ) THEN
@@ -924,9 +926,9 @@
* Compute first two components of eigenvector
* and contribution to sums
*
- TEMP = ACOEF*A( JE, JE-1 )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE, JE-1 )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GE.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -935,10 +937,10 @@
ELSE
WORK( 2*N+JE-1 ) = ONE
WORK( 3*N+JE-1 ) = ZERO
- TEMP = ACOEF*A( JE-1, JE )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE-1, JE-1 )-ACOEF*
- $ A( JE-1, JE-1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE-1, JE-1 ) / TEMP
+ TEMP = ACOEF*S( JE-1, JE )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE-1, JE-1 )-ACOEF*
+ $ S( JE-1, JE-1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE-1, JE-1 ) / TEMP
END IF
*
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
@@ -958,12 +960,12 @@
CRE2B = BCOEFR*WORK( 2*N+JE ) - BCOEFI*WORK( 3*N+JE )
CIM2B = BCOEFI*WORK( 2*N+JE ) + BCOEFR*WORK( 3*N+JE )
DO 270 JR = 1, JE - 2
- WORK( 2*N+JR ) = -CREALA*A( JR, JE-1 ) +
- $ CREALB*B( JR, JE-1 ) -
- $ CRE2A*A( JR, JE ) + CRE2B*B( JR, JE )
- WORK( 3*N+JR ) = -CIMAGA*A( JR, JE-1 ) +
- $ CIMAGB*B( JR, JE-1 ) -
- $ CIM2A*A( JR, JE ) + CIM2B*B( JR, JE )
+ WORK( 2*N+JR ) = -CREALA*S( JR, JE-1 ) +
+ $ CREALB*P( JR, JE-1 ) -
+ $ CRE2A*S( JR, JE ) + CRE2B*P( JR, JE )
+ WORK( 3*N+JR ) = -CIMAGA*S( JR, JE-1 ) +
+ $ CIMAGB*P( JR, JE-1 ) -
+ $ CIM2A*S( JR, JE ) + CIM2B*P( JR, JE )
270 CONTINUE
END IF
*
@@ -978,23 +980,23 @@
* next iteration to process it (when it will be j:j+1)
*
IF( .NOT.IL2BY2 .AND. J.GT.1 ) THEN
- IF( A( J, J-1 ).NE.ZERO ) THEN
+ IF( S( J, J-1 ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
GO TO 370
END IF
END IF
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( IL2BY2 ) THEN
NA = 2
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
ELSE
NA = 1
END IF
*
* Compute x(j) (and x(j+1), if 2-by-2 block)
*
- CALL DLALN2( .FALSE., NA, NW, DMIN, ACOEF, A( J, J ),
- $ LDA, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
+ CALL DLALN2( .FALSE., NA, NW, DMIN, ACOEF, S( J, J ),
+ $ LDS, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
$ N, BCOEFR, BCOEFI, SUM, 2, SCALE, TEMP,
$ IINFO )
IF( SCALE.LT.ONE ) THEN
@@ -1014,7 +1016,7 @@
300 CONTINUE
310 CONTINUE
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( J.GT.1 ) THEN
*
@@ -1052,19 +1054,19 @@
$ BCOEFR*WORK( 3*N+J+JA-1 )
DO 340 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
WORK( 3*N+JR ) = WORK( 3*N+JR ) -
- $ CIMAGA*A( JR, J+JA-1 ) +
- $ CIMAGB*B( JR, J+JA-1 )
+ $ CIMAGA*S( JR, J+JA-1 ) +
+ $ CIMAGB*P( JR, J+JA-1 )
340 CONTINUE
ELSE
CREALA = ACOEF*WORK( 2*N+J+JA-1 )
CREALB = BCOEFR*WORK( 2*N+J+JA-1 )
DO 350 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
350 CONTINUE
END IF
360 CONTINUE
diff -uNr LAPACK.orig/SRC/dtrevc.f LAPACK/SRC/dtrevc.f
--- LAPACK.orig/SRC/dtrevc.f Thu Nov 4 14:24:59 1999
+++ LAPACK/SRC/dtrevc.f Fri May 25 16:13:52 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -21,28 +21,23 @@
*
* DTREVC computes some or all of the right and/or left eigenvectors of
* a real upper quasi-triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a real general matrix: A = Q*T*Q**T, as computed by DHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input orthogonal
-* matrix. If T was obtained from the real-Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
-*
-* T must be in Schur canonical form (as returned by DHSEQR), that is,
-* block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-* 2-by-2 diagonal block has its diagonal elements equal and its
-* off-diagonal elements of opposite sign. Corresponding to each 2-by-2
-* diagonal block is a complex conjugate pair of eigenvalues and
-* eigenvectors; only one eigenvector of the pair is computed, namely
-* the one corresponding to the eigenvalue with positive imaginary part.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal blocks of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the orthogonal factor that reduces a matrix
+* A to Schur form T, then Q*X and Q*Y are the matrices of right and
+* left eigenvectors of A.
*
* Arguments
* =========
@@ -55,21 +50,21 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input/output) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to a real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE.. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must be
-* set to .TRUE.; then on exit SELECT(j) is .TRUE. and
-* SELECT(j+1) is .FALSE..
+* If w(j) is a real eigenvalue, the corresponding real
+* eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector is
+* computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+* on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+* .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -86,15 +81,6 @@
* of Schur vectors returned by DHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL has the same quasi-lower triangular form
-* as T'. If T(i,i) is a real eigenvalue, then
-* the i-th column VL(i) of VL is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VL(i)+sqrt(-1)*VL(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -103,11 +89,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -115,15 +101,6 @@
* of Schur vectors returned by DHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR has the same quasi-upper triangular form
-* as T. If T(i,i) is a real eigenvalue, then
-* the i-th column VR(i) of VR is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VR(i)+sqrt(-1)*VR(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -132,11 +109,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/SRC/dtrsen.f LAPACK/SRC/dtrsen.f
--- LAPACK.orig/SRC/dtrsen.f Thu Nov 4 14:24:59 1999
+++ LAPACK/SRC/dtrsen.f Fri May 25 16:14:10 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, JOB
@@ -118,8 +118,8 @@
* LWORK (input) INTEGER
* The dimension of the array WORK.
* If JOB = 'N', LWORK >= max(1,N);
-* if JOB = 'E', LWORK >= M*(N-M);
-* if JOB = 'V' or 'B', LWORK >= 2*M*(N-M).
+* if JOB = 'E', LWORK >= max(1,M*(N-M));
+* if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
*
* If LWORK = -1, then a workspace query is assumed; the routine
* only calculates the optimal size of the WORK array, returns
@@ -127,12 +127,12 @@
* message related to LWORK is issued by XERBLA.
*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
-* IF JOB = 'N' or 'E', IWORK is not referenced.
+* On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*
* LIWORK (input) INTEGER
* The dimension of the array IWORK.
* If JOB = 'N' or 'E', LIWORK >= 1;
-* if JOB = 'V' or 'B', LIWORK >= M*(N-M).
+* if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
*
* If LIWORK = -1, then a workspace query is assumed; the
* routine only calculates the optimal size of the IWORK array,
diff -uNr LAPACK.orig/SRC/sbdsqr.f LAPACK/SRC/sbdsqr.f
--- LAPACK.orig/SRC/sbdsqr.f Thu Nov 4 14:25:42 1999
+++ LAPACK/SRC/sbdsqr.f Fri May 25 15:58:54 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -18,14 +18,26 @@
* Purpose
* =======
*
-* SBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
-*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given real input matrices U, VT, and C.
+* SBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**T
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**T*VT instead of
+* P**T, for given real input matrices U and VT. When U and VT are the
+* orthogonal matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by SGEBRD, then
+*
+* A = (U*Q) * S * (P**T*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+* for a given real input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -61,18 +73,17 @@
* order.
*
* E (input/output) REAL array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) REAL array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**T * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -81,21 +92,22 @@
* U (input/output) REAL array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) REAL array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**T * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* WORK (workspace) REAL array, dimension (4*N)
+* WORK (workspace) REAL array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/SRC/sgebd2.f LAPACK/SRC/sgebd2.f
--- LAPACK.orig/SRC/sgebd2.f Thu Nov 4 14:23:33 1999
+++ LAPACK/SRC/sgebd2.f Fri May 25 15:59:24 2001
@@ -3,7 +3,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* February 29, 1992
+* May 7, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
@@ -169,8 +169,9 @@
*
* Apply H(i) to A(i:m,i+1:n) from the left
*
- CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
- $ A( I, I+1 ), LDA, WORK )
+ IF( I.LT.N )
+ $ CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
+ $ A( I, I+1 ), LDA, WORK )
A( I, I ) = D( I )
*
IF( I.LT.N ) THEN
@@ -207,8 +208,9 @@
*
* Apply G(i) to A(i+1:m,i:n) from the right
*
- CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAUP( I ),
- $ A( MIN( I+1, M ), I ), LDA, WORK )
+ IF( I.LT.M )
+ $ CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
+ $ TAUP( I ), A( MIN( I+1, M ), I ), LDA, WORK )
A( I, I ) = D( I )
*
IF( I.LT.M ) THEN
diff -uNr LAPACK.orig/SRC/sgees.f LAPACK/SRC/sgees.f
--- LAPACK.orig/SRC/sgees.f Thu Nov 4 14:23:33 1999
+++ LAPACK/SRC/sgees.f Fri May 25 15:59:45 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SORT
@@ -110,10 +111,9 @@
* The dimension of the array WORK. LWORK >= max(1,3*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* BWORK (workspace) LOGICAL array, dimension (N)
* Not referenced if SORT = 'N'.
@@ -138,12 +138,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTST,
- $ WANTVS
+ LOGICAL CURSL, LASTSL, LST2SL, SCALEA, WANTST, WANTVS
INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
$ IHI, ILO, INXT, IP, ITAU, IWRK, K, MAXB,
$ MAXWRK, MINWRK
@@ -171,7 +172,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVS = LSAME( JOBVS, 'V' )
WANTST = LSAME( SORT, 'S' )
IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
@@ -197,7 +197,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 3*N )
IF( .NOT.WANTVS ) THEN
@@ -216,19 +216,17 @@
MAXWRK = MAX( MAXWRK, N+HSWORK, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGEES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/sgeesx.f LAPACK/SRC/sgeesx.f
--- LAPACK.orig/SRC/sgeesx.f Thu Nov 4 14:23:34 1999
+++ LAPACK/SRC/sgeesx.f Fri May 25 16:00:09 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SENSE, SORT
@@ -140,6 +141,10 @@
* N+2*SDIM*(N-SDIM) <= N+N*N/2.
* For good performance, LWORK must generally be larger.
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* IWORK (workspace/output) INTEGER array, dimension (LIWORK)
* Not referenced if SENSE = 'N' or 'E'.
* On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
@@ -171,6 +176,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
@@ -239,7 +246,7 @@
* in the code.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 3*N )
IF( .NOT.WANTVS ) THEN
@@ -257,21 +264,24 @@
HSWORK = MAX( K*( K+2 ), 2*N )
MAXWRK = MAX( MAXWRK, N+HSWORK, 1 )
END IF
+*
+* Estimate the workspace needed by STRSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, N+(N*N+1)/2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -16
END IF
- IF( LWORK.LT.MINWRK ) THEN
- INFO = -16
- END IF
- IF( LIWORK.LT.1 ) THEN
- INFO = -18
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGEESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/sgeev.f LAPACK/SRC/sgeev.f
--- LAPACK.orig/SRC/sgeev.f Wed Dec 8 16:00:09 1999
+++ LAPACK/SRC/sgeev.f Fri May 25 16:00:38 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* December 8, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -98,10 +99,9 @@
* if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
* performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -114,11 +114,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
+ LOGICAL SCALEA, WANTVL, WANTVR
CHARACTER SIDE
INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
$ MAXB, MAXWRK, MINWRK, NOUT
@@ -149,7 +151,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
@@ -177,7 +178,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 3*N )
@@ -198,19 +199,17 @@
MAXWRK = MAX( MAXWRK, 4*N )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGEEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/sgeevx.f LAPACK/SRC/sgeevx.f
--- LAPACK.orig/SRC/sgeevx.f Thu Nov 4 14:23:34 1999
+++ LAPACK/SRC/sgeevx.f Fri May 25 16:00:59 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -179,10 +180,9 @@
* LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (2*N-2)
* If SENSE = 'N' or 'E', not referenced.
@@ -198,12 +198,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
- $ WNTSNN, WNTSNV
+ LOGICAL SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, WNTSNN,
+ $ WNTSNV
CHARACTER JOB, SIDE
INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXB,
$ MAXWRK, MINWRK, NOUT
@@ -234,7 +236,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
WNTSNN = LSAME( SENSE, 'N' )
@@ -273,7 +274,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 2*N )
@@ -307,19 +308,17 @@
MAXWRK = MAX( MAXWRK, 3*N, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -21
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -21
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGEEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/sgegs.f LAPACK/SRC/sgegs.f
--- LAPACK.orig/SRC/sgegs.f Thu Nov 4 14:23:34 1999
+++ LAPACK/SRC/sgegs.f Fri May 25 16:01:48 2001
@@ -5,7 +5,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR
@@ -22,105 +22,75 @@
*
* This routine is deprecated and has been replaced by routine SGGES.
*
-* SGEGS computes for a pair of N-by-N real nonsymmetric matrices A, B:
-* the generalized eigenvalues (alphar +/- alphai*i, beta), the real
-* Schur form (A, B), and optionally left and/or right Schur vectors
-* (VSL and VSR).
-*
-* (If only the generalized eigenvalues are needed, use the driver SGEGV
-* instead.)
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* The (generalized) Schur form of a pair of matrices is the result of
-* multiplying both matrices on the left by one orthogonal matrix and
-* both on the right by another orthogonal matrix, these two orthogonal
-* matrices being chosen so as to bring the pair of matrices into
-* (real) Schur form.
-*
-* A pair of matrices A, B is in generalized real Schur form if B is
-* upper triangular with non-negative diagonal and A is block upper
-* triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
-* to real generalized eigenvalues, while 2-by-2 blocks of A will be
-* "standardized" by making the corresponding elements of B have the
-* form:
-* [ a 0 ]
-* [ 0 b ]
-*
-* and the pair of corresponding 2-by-2 blocks in A and B will
-* have a complex conjugate pair of generalized eigenvalues.
-*
-* The left and right Schur vectors are the columns of VSL and VSR,
-* respectively, where VSL and VSR are the orthogonal matrices
-* which reduce A and B to Schur form:
-*
-* Schur form of (A,B) = ( (VSL)**T A (VSR), (VSL)**T B (VSR) )
+* SGEGS computes the eigenvalues, real Schur form, and, optionally,
+* left and or/right Schur vectors of a real matrix pair (A,B).
+* Given two square matrices A and B, the generalized real Schur
+* factorization has the form
+*
+* A = Q*S*Z**T, B = Q*T*Z**T
+*
+* where Q and Z are orthogonal matrices, T is upper triangular, and S
+* is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
+* blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
+* of eigenvalues of (A,B). The columns of Q are the left Schur vectors
+* and the columns of Z are the right Schur vectors.
+*
+* If only the eigenvalues of (A,B) are needed, the driver routine
+* SGEGV should be used instead. See SGEGV for a description of the
+* eigenvalues of the generalized nonsymmetric eigenvalue problem
+* (GNEP).
*
* Arguments
* =========
*
* JOBVSL (input) CHARACTER*1
* = 'N': do not compute the left Schur vectors;
-* = 'V': compute the left Schur vectors.
+* = 'V': compute the left Schur vectors (returned in VSL).
*
* JOBVSR (input) CHARACTER*1
* = 'N': do not compute the right Schur vectors;
-* = 'V': compute the right Schur vectors.
+* = 'V': compute the right Schur vectors (returned in VSR).
*
* N (input) INTEGER
* The order of the matrices A, B, VSL, and VSR. N >= 0.
*
* A (input/output) REAL array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose generalized
-* eigenvalues and (optionally) Schur vectors are to be
-* computed.
-* On exit, the generalized Schur form of A.
-* Note: to avoid overflow, the Frobenius norm of the matrix
-* A should be less than the overflow threshold.
+* On entry, the matrix A.
+* On exit, the upper quasi-triangular matrix S from the
+* generalized real Schur factorization.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) REAL array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) Schur vectors are
-* to be computed.
-* On exit, the generalized Schur form of B.
-* Note: to avoid overflow, the Frobenius norm of the matrix
-* B should be less than the overflow threshold.
+* On entry, the matrix B.
+* On exit, the upper triangular matrix T from the generalized
+* real Schur factorization.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHAR (output) REAL array, dimension (N)
+* The real parts of each scalar alpha defining an eigenvalue
+* of GNEP.
+*
* ALPHAI (output) REAL array, dimension (N)
-* BETA (output) REAL array, dimension (N)
-* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-* be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
-* j=1,...,N and BETA(j),j=1,...,N are the diagonals of the
-* complex Schur form (A,B) that would result if the 2-by-2
-* diagonal blocks of the real Schur form of (A,B) were further
-* reduced to triangular form using 2-by-2 complex unitary
-* transformations. If ALPHAI(j) is zero, then the j-th
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
* eigenvalue is real; if positive, then the j-th and (j+1)-st
-* eigenvalues are a complex conjugate pair, with ALPHAI(j+1)
-* negative.
+* eigenvalues are a complex conjugate pair, with
+* ALPHAI(j+1) = -ALPHAI(j).
*
-* Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-* may easily over- or underflow, and BETA(j) may even be zero.
-* Thus, the user should avoid naively computing the ratio
-* alpha/beta. However, ALPHAR and ALPHAI will be always less
-* than and usually comparable with norm(A) in magnitude, and
-* BETA always less than and usually comparable with norm(B).
+* BETA (output) REAL array, dimension (N)
+* The scalars beta that define the eigenvalues of GNEP.
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* VSL (output) REAL array, dimension (LDVSL,N)
-* If JOBVSL = 'V', VSL will contain the left Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSL = 'V', the matrix of left Schur vectors Q.
* Not referenced if JOBVSL = 'N'.
*
* LDVSL (input) INTEGER
@@ -128,8 +98,7 @@
* if JOBVSL = 'V', LDVSL >= N.
*
* VSR (output) REAL array, dimension (LDVSR,N)
-* If JOBVSR = 'V', VSR will contain the right Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSR = 'V', the matrix of right Schur vectors Z.
* Not referenced if JOBVSR = 'N'.
*
* LDVSR (input) INTEGER
diff -uNr LAPACK.orig/SRC/sgegv.f LAPACK/SRC/sgegv.f
--- LAPACK.orig/SRC/sgegv.f Thu Nov 4 14:25:42 1999
+++ LAPACK/SRC/sgegv.f Fri May 25 16:02:12 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -21,23 +21,32 @@
*
* This routine is deprecated and has been replaced by routine SGGEV.
*
-* SGEGV computes for a pair of n-by-n real nonsymmetric matrices A and
-* B, the generalized eigenvalues (alphar +/- alphai*i, beta), and
-* optionally, the left and/or right generalized eigenvectors (VL and
-* VR).
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* A right generalized eigenvector corresponding to a generalized
-* eigenvalue w for a pair of matrices (A,B) is a vector r such
-* that (A - w B) r = 0 . A left generalized eigenvector is a vector
-* l such that l**H * (A - w B) = 0, where l**H is the
-* conjugate-transpose of l.
+* SGEGV computes the eigenvalues and, optionally, the left and/or right
+* eigenvectors of a real matrix pair (A,B).
+* Given two square matrices A and B,
+* the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+* eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+* that
+*
+* A*x = lambda*B*x.
+*
+* An alternate form is to find the eigenvalues mu and corresponding
+* eigenvectors y such that
+*
+* mu*A*y = B*y.
+*
+* These two forms are equivalent with mu = 1/lambda and x = y if
+* neither lambda nor mu is zero. In order to deal with the case that
+* lambda or mu is zero or small, two values alpha and beta are returned
+* for each eigenvalue, such that lambda = alpha/beta and
+* mu = beta/alpha.
+*
+* The vectors x and y in the above equations are right eigenvectors of
+* the matrix pair (A,B). Vectors u and v satisfying
+*
+* u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+*
+* are left eigenvectors of (A,B).
*
* Note: this routine performs "full balancing" on A and B -- see
* "Further Details", below.
@@ -47,63 +56,75 @@
*
* JOBVL (input) CHARACTER*1
* = 'N': do not compute the left generalized eigenvectors;
-* = 'V': compute the left generalized eigenvectors.
+* = 'V': compute the left generalized eigenvectors (returned
+* in VL).
*
* JOBVR (input) CHARACTER*1
* = 'N': do not compute the right generalized eigenvectors;
-* = 'V': compute the right generalized eigenvectors.
+* = 'V': compute the right generalized eigenvectors (returned
+* in VR).
*
* N (input) INTEGER
* The order of the matrices A, B, VL, and VR. N >= 0.
*
* A (input/output) REAL array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of A on exit, see "Further
-* Details", below.)
+* On entry, the matrix A.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit A
+* contains the real Schur form of A from the generalized Schur
+* factorization of the pair (A,B) after balancing.
+* If no eigenvectors were computed, then only the diagonal
+* blocks from the Schur form will be correct. See SGGHRD and
+* SHGEQZ for details.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) REAL array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of B on exit, see "Further
-* Details", below.)
+* On entry, the matrix B.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+* upper triangular matrix obtained from B in the generalized
+* Schur factorization of the pair (A,B) after balancing.
+* If no eigenvectors were computed, then only those elements of
+* B corresponding to the diagonal blocks from the Schur form of
+* A will be correct. See SGGHRD and SHGEQZ for details.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHAR (output) REAL array, dimension (N)
+* The real parts of each scalar alpha defining an eigenvalue of
+* GNEP.
+*
* ALPHAI (output) REAL array, dimension (N)
-* BETA (output) REAL array, dimension (N)
-* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-* be the generalized eigenvalues. If ALPHAI(j) is zero, then
-* the j-th eigenvalue is real; if positive, then the j-th and
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP. If ALPHAI(j) is zero, then the j-th
+* eigenvalue is real; if positive, then the j-th and
* (j+1)-st eigenvalues are a complex conjugate pair, with
-* ALPHAI(j+1) negative.
+* ALPHAI(j+1) = -ALPHAI(j).
*
-* Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-* may easily over- or underflow, and BETA(j) may even be zero.
-* Thus, the user should avoid naively computing the ratio
-* alpha/beta. However, ALPHAR and ALPHAI will be always less
-* than and usually comparable with norm(A) in magnitude, and
-* BETA always less than and usually comparable with norm(B).
+* BETA (output) REAL array, dimension (N)
+* The scalars beta that define the eigenvalues of GNEP.
+*
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* VL (output) REAL array, dimension (LDVL,N)
-* If JOBVL = 'V', the left generalized eigenvectors. (See
-* "Purpose", above.) Real eigenvectors take one column,
-* complex take two columns, the first for the real part and
-* the second for the imaginary part. Complex eigenvectors
-* correspond to an eigenvalue with positive imaginary part.
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVL = 'V', the left eigenvectors u(j) are stored
+* in the columns of VL, in the same order as their eigenvalues.
+* If the j-th eigenvalue is real, then u(j) = VL(:,j).
+* If the j-th and (j+1)-st eigenvalues form a complex conjugate
+* pair, then
+* u(j) = VL(:,j) + i*VL(:,j+1)
+* and
+* u(j+1) = VL(:,j) - i*VL(:,j+1).
+*
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvectors
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVL = 'N'.
*
* LDVL (input) INTEGER
@@ -111,15 +132,19 @@
* if JOBVL = 'V', LDVL >= N.
*
* VR (output) REAL array, dimension (LDVR,N)
-* If JOBVR = 'V', the right generalized eigenvectors. (See
-* "Purpose", above.) Real eigenvectors take one column,
-* complex take two columns, the first for the real part and
-* the second for the imaginary part. Complex eigenvectors
-* correspond to an eigenvalue with positive imaginary part.
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVR = 'V', the right eigenvectors x(j) are stored
+* in the columns of VR, in the same order as their eigenvalues.
+* If the j-th eigenvalue is real, then x(j) = VR(:,j).
+* If the j-th and (j+1)-st eigenvalues form a complex conjugate
+* pair, then
+* x(j) = VR(:,j) + i*VR(:,j+1)
+* and
+* x(j+1) = VR(:,j) - i*VR(:,j+1).
+*
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvalues
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVR = 'N'.
*
* LDVR (input) INTEGER
diff -uNr LAPACK.orig/SRC/sgelsd.f LAPACK/SRC/sgelsd.f
--- LAPACK.orig/SRC/sgelsd.f Thu Nov 4 14:26:24 1999
+++ LAPACK/SRC/sgelsd.f Fri May 25 16:03:05 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -61,9 +62,10 @@
* The number of right hand sides, i.e., the number of columns
* of the matrices B and X. NRHS >= 0.
*
-* A (input) REAL array, dimension (LDA,N)
+* A (input/output) REAL array, dimension (LDA,N)
* On entry, the M-by-N matrix A.
-* On exit, A has been destroyed.
+* On exit, the first min(m,n) rows of A are overwritten with
+* its right singular vectors, stored rowwise.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
@@ -95,24 +97,20 @@
* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*
* LWORK (input) INTEGER
-* The dimension of the array WORK. LWORK must be at least 1.
+* The dimension of the array WORK. LWORK >= 1.
* The exact minimum amount of workspace needed depends on M,
-* N and NRHS. As long as LWORK is at least
-* 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
-* if M is greater than or equal to N or
-* 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
-* if M is less than N, the code will execute correctly.
+* N and NRHS.
+* If M >= N, LWORK >= 11*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS.
+* If M < N, LWORK >= 11*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS.
* SMLSIZ is returned by ILAENV and is equal to the maximum
* size of the subproblems at the bottom of the computation
* tree (usually about 25), and
-* NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+* NLVL = INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
-*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
* LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
@@ -136,14 +134,15 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE, TWO
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY
INTEGER IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
$ LDWORK, MAXMN, MAXWRK, MINMN, MINWRK, MM,
- $ MNTHR, NLVL, NWORK, SMLSIZ, WLALSD
+ $ MNTHR, NLVL, NWORK, SMLSIZ
REAL ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
* ..
* .. External Subroutines ..
@@ -166,7 +165,6 @@
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
MNTHR = ILAENV( 6, 'SGELSD', ' ', M, N, NRHS, -1 )
- LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@@ -190,8 +188,8 @@
*
MINWRK = 1
MINMN = MAX( 1, MINMN )
- NLVL = MAX( INT( LOG( REAL( MINMN ) / REAL( SMLSIZ+1 ) ) /
- $ LOG( TWO ) ) + 1, 0 )
+ NLVL = INT( LOG( REAL( MINMN ) / REAL( SMLSIZ+1 ) ) /
+ $ LOG( TWO ) ) + 1
*
IF( INFO.EQ.0 ) THEN
MAXWRK = 0
@@ -216,12 +214,11 @@
$ ILAENV( 1, 'SORMBR', 'QLT', MM, NRHS, N, -1 ) )
MAXWRK = MAX( MAXWRK, 3*N+( N-1 )*
$ ILAENV( 1, 'SORMBR', 'PLN', N, NRHS, N, -1 ) )
- WLALSD = 9*N+2*N*SMLSIZ+8*N*NLVL+N*NRHS+(SMLSIZ+1)**2
- MAXWRK = MAX( MAXWRK, 3*N+WLALSD )
- MINWRK = MAX( 3*N+MM, 3*N+NRHS, 3*N+WLALSD )
+ MAXWRK = MAX( MAXWRK, 3*N+8*N+2*N*SMLSIZ+8*N*NLVL+N*NRHS )
+ MINWRK = MAX( 3*N+MM, 3*N+NRHS,
+ $ 3*N+8*N+2*N*SMLSIZ+8*N*NLVL+N*NRHS )
END IF
IF( N.GT.M ) THEN
- WLALSD = 9*M+2*M*SMLSIZ+8*M*NLVL+M*NRHS+(SMLSIZ+1)**2
IF( N.GE.MNTHR ) THEN
*
* Path 2a - underdetermined, with many more columns
@@ -241,7 +238,8 @@
END IF
MAXWRK = MAX( MAXWRK, M+NRHS*
$ ILAENV( 1, 'SORMLQ', 'LT', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, M*M+4*M+WLALSD )
+ MAXWRK = MAX( MAXWRK, M*M+4*M+8*M+2*M*SMLSIZ+8*M*NLVL+M*
+ $ NRHS )
ELSE
*
* Path 2 - remaining underdetermined cases.
@@ -252,26 +250,25 @@
$ ILAENV( 1, 'SORMBR', 'QLT', M, NRHS, N, -1 ) )
MAXWRK = MAX( MAXWRK, 3*M+M*
$ ILAENV( 1, 'SORMBR', 'PLN', N, NRHS, M, -1 ) )
- MAXWRK = MAX( MAXWRK, 3*M+WLALSD )
+ MAXWRK = MAX( MAXWRK, 3*M+8*M+2*M*SMLSIZ+8*M*NLVL+M*
+ $ NRHS )
END IF
- MINWRK = MAX( 3*M+NRHS, 3*M+M, 3*M+WLALSD )
+ MINWRK = MAX( 3*M+NRHS, 3*M+M,
+ $ 3*M+8*M+2*M*SMLSIZ+8*M*NLVL+M*NRHS )
END IF
MINWRK = MIN( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGELSD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- GO TO 10
END IF
-*
-* Quick return if possible.
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
diff -uNr LAPACK.orig/SRC/sgelss.f LAPACK/SRC/sgelss.f
--- LAPACK.orig/SRC/sgelss.f Thu Nov 4 14:23:34 1999
+++ LAPACK/SRC/sgelss.f Fri May 25 16:03:41 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -86,10 +86,9 @@
* LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -156,7 +155,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -229,20 +228,18 @@
END IF
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- MINWRK = MAX( MINWRK, 1 )
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGELSS', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
-*
-* Quick return if possible
-*
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
@@ -491,8 +488,8 @@
DO 40 I = 1, NRHS, CHUNK
BL = MIN( NRHS-I+1, CHUNK )
CALL SGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, ZERO, WORK( IWORK ), N )
- CALL SLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M )
+ CALL SLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/SRC/sgesdd.f LAPACK/SRC/sgesdd.f
--- LAPACK.orig/SRC/sgesdd.f Thu Nov 11 20:32:10 1999
+++ LAPACK/SRC/sgesdd.f Fri May 25 16:07:52 2001
@@ -1,10 +1,11 @@
- SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
- $ LWORK, IWORK, INFO )
+ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT,
+ $ WORK, LWORK, IWORK, INFO )
*
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBZ
@@ -116,16 +117,20 @@
* LWORK (input) INTEGER
* The dimension of the array WORK. LWORK >= 1.
* If JOBZ = 'N',
-* LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)).
+* LWORK >= max(14*min(M,N)+4, 10*min(M,N)+2+
+* SMLSIZ*(SMLSIZ+8)) + max(M,N)
+* where SMLSIZ is returned by ILAENV and is equal to the
+* maximum size of the subproblems at the bottom of the
+* computation tree (usually about 25).
* If JOBZ = 'O',
-* LWORK >= 3*min(M,N)*min(M,N) +
-* max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
+* LWORK >= 5*min(M,N)*min(M,N) + max(M,N) + 9*min(M,N).
* If JOBZ = 'S' or 'A'
-* LWORK >= 3*min(M,N)*min(M,N) +
-* max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).
+* LWORK >= 4*min(M,N)*min(M,N) + max(M,N) + 9*min(M,N).
* For good performance, LWORK should generally be larger.
-* If LWORK < 0 but other input arguments are legal, WORK(1)
-* returns the optimal LWORK.
+*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (8*min(M,N))
*
@@ -144,15 +149,17 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
- INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IL,
+ LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
+ INTEGER BDSPAC, BDSPAN, BLK, CHUNK, I, IE, IERR, IL,
$ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT,
$ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK,
- $ MNTHR, NWORK, WRKBL
+ $ MNTHR, NWORK, SMLSIZ, WRKBL
REAL ANRM, BIGNUM, EPS, SMLNUM
* ..
* .. Local Arrays ..
@@ -168,10 +175,10 @@
LOGICAL LSAME
INTEGER ILAENV
REAL SLAMCH, SLANGE
- EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE
+ EXTERNAL SLAMCH, SLANGE, ILAENV, LSAME
* ..
* .. Intrinsic Functions ..
- INTRINSIC INT, MAX, MIN, REAL, SQRT
+ INTRINSIC REAL, INT, MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
@@ -179,7 +186,7 @@
*
INFO = 0
MINMN = MIN( M, N )
- MNTHR = INT( MINMN*11.0E0 / 6.0E0 )
+ MNTHR = INT( MINMN*11.0 / 6.0 )
WNTQA = LSAME( JOBZ, 'A' )
WNTQS = LSAME( JOBZ, 'S' )
WNTQAS = WNTQA .OR. WNTQS
@@ -187,7 +194,6 @@
WNTQN = LSAME( JOBZ, 'N' )
MINWRK = 1
MAXWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
*
IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN
INFO = -1
@@ -206,6 +212,8 @@
INFO = -10
END IF
*
+ SMLSIZ = ILAENV( 9, 'SGESDD', ' ', 0, 0, 0, 0 )
+*
* Compute workspace
* (Note: Comments in the code beginning "Workspace:" describe the
* minimal amount of workspace needed at that point in the code,
@@ -218,22 +226,19 @@
*
* Compute space needed for SBDSDC
*
- IF( WNTQN ) THEN
- BDSPAC = 7*N
- ELSE
- BDSPAC = 3*N*N + 4*N
- END IF
+ BDSPAC = 3*N*N + 7*N
+ BDSPAN = MAX( 12*N+4, 8*N+2+SMLSIZ*( SMLSIZ+8 ) )
IF( M.GE.MNTHR ) THEN
IF( WNTQN ) THEN
*
* Path 1 (M much larger than N, JOBZ='N')
*
- WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*N+2*N*
- $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+N )
- MINWRK = BDSPAC + N
+ MAXWRK = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1,
+ $ -1 )
+ MAXWRK = MAX( MAXWRK, 3*N+2*N*
+ $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC )
+ MINWRK = BDSPAC
ELSE IF( WNTQO ) THEN
*
* Path 2 (M much larger than N, JOBZ='O')
@@ -247,9 +252,9 @@
$ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
+ WRKBL = MAX( WRKBL, BDSPAC+2*N )
MAXWRK = WRKBL + 2*N*N
- MINWRK = BDSPAC + 2*N*N + 3*N
+ MINWRK = BDSPAC + 2*N*N + 2*N
ELSE IF( WNTQS ) THEN
*
* Path 3 (M much larger than N, JOBZ='S')
@@ -263,9 +268,9 @@
$ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
+ WRKBL = MAX( WRKBL, BDSPAC+2*N )
MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 3*N
+ MINWRK = BDSPAC + N*N + 2*N
ELSE IF( WNTQA ) THEN
*
* Path 4 (M much larger than N, JOBZ='A')
@@ -279,9 +284,9 @@
$ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
- MAXWRK = WRKBL + N*N
- MINWRK = BDSPAC + N*N + 3*N
+ WRKBL = MAX( WRKBL, BDSPAC+2*N )
+ MAXWRK = N*N + WRKBL
+ MINWRK = BDSPAC + N*N + M + N
END IF
ELSE
*
@@ -289,53 +294,47 @@
*
WRKBL = 3*N + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1,
$ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
- ELSE IF( WNTQO ) THEN
+ IF( WNTQO ) THEN
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) )
WRKBL = MAX( WRKBL, 3*N+N*
$ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*N )
+ WRKBL = MAX( WRKBL, BDSPAC+2*N+M )
MAXWRK = WRKBL + M*N
- MINWRK = 3*N + MAX( M, N*N+BDSPAC )
+ MINWRK = BDSPAC + N*N + 2*N + M
ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*N+N*
+ $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*N+N*
+ $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*N+M )
+ MINWRK = BDSPAC + 2*N + M
ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*N+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*N+N*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
- MAXWRK = MAX( MAXWRK, BDSPAC+3*N )
- MINWRK = 3*N + MAX( M, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*N+M*
+ $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*N+N*
+ $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*N+M )
+ MINWRK = BDSPAC + 2*N + M
END IF
END IF
ELSE
*
* Compute space needed for SBDSDC
*
- IF( WNTQN ) THEN
- BDSPAC = 7*M
- ELSE
- BDSPAC = 3*M*M + 4*M
- END IF
+ BDSPAC = 3*M*M + 7*M
+ BDSPAN = MAX( 12*M+4, 8*M+2+SMLSIZ*( SMLSIZ+8 ) )
IF( N.GE.MNTHR ) THEN
IF( WNTQN ) THEN
*
* Path 1t (N much larger than M, JOBZ='N')
*
- WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 3*M+2*M*
- $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+M )
- MINWRK = BDSPAC + M
+ MAXWRK = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1,
+ $ -1 )
+ MAXWRK = MAX( MAXWRK, 3*M+2*M*
+ $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC )
+ MINWRK = BDSPAC
ELSE IF( WNTQO ) THEN
*
* Path 2t (N much larger than M, JOBZ='O')
@@ -349,9 +348,9 @@
$ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + 2*M*M
- MINWRK = BDSPAC + 2*M*M + 3*M
+ MINWRK = BDSPAC + 2*M*M + 2*M
ELSE IF( WNTQS ) THEN
*
* Path 3t (N much larger than M, JOBZ='S')
@@ -365,9 +364,9 @@
$ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
+ MINWRK = BDSPAC + M*M + 2*M
ELSE IF( WNTQA ) THEN
*
* Path 4t (N much larger than M, JOBZ='A')
@@ -381,9 +380,9 @@
$ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + M*M
- MINWRK = BDSPAC + M*M + 3*M
+ MINWRK = BDSPAC + M*M + M + N
END IF
ELSE
*
@@ -391,52 +390,46 @@
*
WRKBL = 3*M + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1,
$ -1 )
- IF( WNTQN ) THEN
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
- ELSE IF( WNTQO ) THEN
+ IF( WNTQO ) THEN
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
WRKBL = MAX( WRKBL, 3*M+M*
$ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) )
- WRKBL = MAX( WRKBL, BDSPAC+3*M )
+ WRKBL = MAX( WRKBL, BDSPAC+2*M )
MAXWRK = WRKBL + M*N
- MINWRK = 3*M + MAX( N, M*M+BDSPAC )
+ MINWRK = BDSPAC + M*M + 2*M + N
ELSE IF( WNTQS ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*M+M*
+ $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*M+M*
+ $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*M )
+ MINWRK = BDSPAC + 2*M + N
ELSE IF( WNTQA ) THEN
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
- WRKBL = MAX( WRKBL, 3*M+M*
- $ ILAENV( 1, 'SORMBR', 'PRT', N, N, M, -1 ) )
- MAXWRK = MAX( WRKBL, BDSPAC+3*M )
- MINWRK = 3*M + MAX( N, BDSPAC )
+ MAXWRK = MAX( MAXWRK, 3*M+M*
+ $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) )
+ MAXWRK = MAX( MAXWRK, 3*M+N*
+ $ ILAENV( 1, 'SORMBR', 'PRT', N, N, M, -1 ) )
+ MAXWRK = MAX( MAXWRK, BDSPAC+2*M )
+ MINWRK = BDSPAC + 2*M + N
END IF
END IF
END IF
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGESDD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
@@ -497,7 +490,7 @@
NWORK = IE + N
*
* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
@@ -512,10 +505,10 @@
*
* WORK(IR) is LDWRKR by N
*
- IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN
+ IF( LWORK.GE.LDA*N+4*N*N+9*N ) THEN
LDWRKR = LDA
ELSE
- LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N
+ LDWRKR = ( LWORK-4*N*N-9*N ) / N
END IF
ITAU = IR + LDWRKR*N
NWORK = ITAU + N
@@ -557,7 +550,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in WORK(IU) and computing right
* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
+* (Workspace: need 2*N*N+BDSPAC)
*
CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
$ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -633,7 +626,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagoal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
+* (Workspace: need N*N+BDSPAC)
*
CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
$ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -681,7 +674,7 @@
CALL SLACPY( 'L', M, N, A, LDA, U, LDU )
*
* Generate Q in U
-* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+* (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( NWORK ), LWORK-NWORK+1, IERR )
*
@@ -703,7 +696,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in WORK(IU) and computing right
* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
+* (Workspace: need N*N+BDSPAC)
*
CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N,
$ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -754,13 +747,13 @@
IF( WNTQN ) THEN
*
* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
ELSE IF( WNTQO ) THEN
IU = NWORK
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*N*N+9*N ) THEN
*
* WORK( IU ) is M by N
*
@@ -785,7 +778,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in WORK(IU) and computing right
* singular vectors of bidiagonal matrix in VT
-* (Workspace: need N+N*N+BDSPAC)
+* (Workspace: need N*N+BDSPAC)
*
CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ),
$ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ),
@@ -798,7 +791,7 @@
$ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
*
- IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*N*N+9*N ) THEN
*
* Overwrite WORK(IU) by left singular vectors of A
* (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
@@ -838,7 +831,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL SLASET( 'F', M, N, ZERO, ZERO, U, LDU )
CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
@@ -855,12 +848,12 @@
CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA,
$ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
+ ELSE
*
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need N+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL SLASET( 'F', M, M, ZERO, ZERO, U, LDU )
CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT,
@@ -925,7 +918,7 @@
NWORK = IE + M
*
* Perform bidiagonal SVD, computing singular values only
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL SBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
@@ -941,7 +934,7 @@
* IVT is M by M
*
IL = IVT + M*M
- IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+4*M*M+9*M ) THEN
*
* WORK(IL) is M by N
*
@@ -986,7 +979,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U, and computing right singular
* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
+* (Workspace: need 2*M*M+BDSPAC)
*
CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
$ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ),
@@ -1061,7 +1054,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
+* (Workspace: need M*M+BDSPAC)
*
CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT,
$ LDVT, DUM, IDUM, WORK( NWORK ), IWORK,
@@ -1108,7 +1101,7 @@
CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT )
*
* Generate Q in VT
-* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+* (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
*
CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( NWORK ), LWORK-NWORK+1, IERR )
@@ -1131,7 +1124,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in WORK(IVT)
-* (Workspace: need M+M*M+BDSPAC)
+* (Workspace: need M*M+BDSPAC)
*
CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU,
$ WORK( IVT ), LDWKVT, DUM, IDUM,
@@ -1182,14 +1175,14 @@
IF( WNTQN ) THEN
*
* Perform bidiagonal SVD, only computing singular values
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAN)
*
CALL SBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, WORK( NWORK ), IWORK, INFO )
ELSE IF( WNTQO ) THEN
LDWKVT = M
IVT = NWORK
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*M*M+9*M ) THEN
*
* WORK( IVT ) is M by N
*
@@ -1224,7 +1217,7 @@
$ WORK( ITAUQ ), U, LDU, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
*
- IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN
+ IF( LWORK.GE.M*N+3*M*M+9*M ) THEN
*
* Overwrite WORK(IVT) by left singular vectors of A
* (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
@@ -1263,7 +1256,7 @@
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL SLASET( 'F', M, N, ZERO, ZERO, VT, LDVT )
CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
@@ -1280,12 +1273,12 @@
CALL SORMBR( 'P', 'R', 'T', M, N, M, A, LDA,
$ WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
$ LWORK-NWORK+1, IERR )
- ELSE IF( WNTQA ) THEN
+ ELSE
*
* Perform bidiagonal SVD, computing left singular vectors
* of bidiagonal matrix in U and computing right singular
* vectors of bidiagonal matrix in VT
-* (Workspace: need M+BDSPAC)
+* (Workspace: need BDSPAC)
*
CALL SLASET( 'F', N, N, ZERO, ZERO, VT, LDVT )
CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT,
@@ -1319,9 +1312,15 @@
IF( ANRM.GT.BIGNUM )
$ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
+ $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ),
+ $ MINMN, IERR )
IF( ANRM.LT.SMLNUM )
$ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
+ $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ),
+ $ MINMN, IERR )
END IF
*
* Return optimal workspace in WORK(1)
diff -uNr LAPACK.orig/SRC/sgesvd.f LAPACK/SRC/sgesvd.f
--- LAPACK.orig/SRC/sgesvd.f Thu Nov 4 14:23:35 1999
+++ LAPACK/SRC/sgesvd.f Fri May 25 16:08:20 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBU, JOBVT
@@ -118,10 +119,9 @@
* LWORK >= MAX(3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit.
@@ -134,12 +134,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
- $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
+ LOGICAL WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS, WNTVA,
+ $ WNTVAS, WNTVN, WNTVO, WNTVS
INTEGER BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
$ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
$ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
@@ -181,7 +183,7 @@
WNTVO = LSAME( JOBVT, 'O' )
WNTVN = LSAME( JOBVT, 'N' )
MINWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
+ MAXWRK = 1
*
IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
INFO = -1
@@ -208,8 +210,7 @@
* NB refers to the optimal block size for the immediately
* following subroutine, as returned by ILAENV.)
*
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
- $ N.GT.0 ) THEN
+ IF( INFO.EQ.0 .AND. M.GT.0 .AND. N.GT.0 ) THEN
IF( M.GE.N ) THEN
*
* Compute space needed for SBDSQR
@@ -557,24 +558,21 @@
MAXWRK = MAX( MAXWRK, MINWRK )
END IF
END IF
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGESVD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
diff -uNr LAPACK.orig/SRC/sggbak.f LAPACK/SRC/sggbak.f
--- LAPACK.orig/SRC/sggbak.f Thu Nov 4 14:23:36 1999
+++ LAPACK/SRC/sggbak.f Fri May 25 16:08:51 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* February 1, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB, SIDE
@@ -108,10 +108,15 @@
INFO = -3
ELSE IF( ILO.LT.1 ) THEN
INFO = -4
- ELSE IF( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) THEN
+ ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
+ INFO = -4
+ ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
+ $ THEN
+ INFO = -5
+ ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
INFO = -5
ELSE IF( M.LT.0 ) THEN
- INFO = -6
+ INFO = -8
ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
INFO = -10
END IF
diff -uNr LAPACK.orig/SRC/sggbal.f LAPACK/SRC/sggbal.f
--- LAPACK.orig/SRC/sggbal.f Thu Nov 4 14:25:42 1999
+++ LAPACK/SRC/sggbal.f Fri May 25 16:09:11 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 12, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB
@@ -141,7 +141,7 @@
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -5
+ INFO = -6
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGGBAL', -INFO )
@@ -188,8 +188,8 @@
IF( L.NE.1 )
$ GO TO 30
*
- RSCALE( 1 ) = 1
- LSCALE( 1 ) = 1
+ RSCALE( 1 ) = ONE
+ LSCALE( 1 ) = ONE
GO TO 190
*
30 CONTINUE
@@ -247,7 +247,7 @@
* Permute rows M and I
*
160 CONTINUE
- LSCALE( M ) = I
+ LSCALE( M ) = REAL( I )
IF( I.EQ.M )
$ GO TO 170
CALL SSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
@@ -256,7 +256,7 @@
* Permute columns M and J
*
170 CONTINUE
- RSCALE( M ) = J
+ RSCALE( M ) = REAL( J )
IF( J.EQ.M )
$ GO TO 180
CALL SSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
@@ -424,7 +424,7 @@
DO 360 I = ILO, IHI
IRAB = ISAMAX( N-ILO+1, A( I, ILO ), LDA )
RAB = ABS( A( I, IRAB+ILO-1 ) )
- IRAB = ISAMAX( N-ILO+1, B( I, ILO ), LDA )
+ IRAB = ISAMAX( N-ILO+1, B( I, ILO ), LDB )
RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
diff -uNr LAPACK.orig/SRC/sgges.f LAPACK/SRC/sgges.f
--- LAPACK.orig/SRC/sgges.f Thu Nov 4 14:26:20 1999
+++ LAPACK/SRC/sgges.f Fri May 25 16:09:33 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SORT
@@ -158,10 +159,9 @@
* LWORK (input) INTEGER
* The dimension of the array WORK. LWORK >= 8*N+16.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* BWORK (workspace) LOGICAL array, dimension (N)
* Not referenced if SORT = 'N'.
@@ -184,12 +184,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
* ..
* .. Local Scalars ..
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, LST2SL, WANTST
+ $ LST2SL, WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, MAXWRK,
$ MINWRK
@@ -245,7 +247,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -272,7 +273,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MINWRK = 7*( N+1 ) + 16
MAXWRK = 7*( N+1 ) + N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 ) +
$ 16
@@ -281,19 +282,17 @@
$ ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 ) )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -19
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -19
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGGES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/sggesx.f LAPACK/SRC/sggesx.f
--- LAPACK.orig/SRC/sggesx.f Thu Nov 4 14:26:20 1999
+++ LAPACK/SRC/sggesx.f Fri May 25 16:09:52 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
@@ -185,6 +186,10 @@
* If SENSE = 'E', 'V', or 'B',
* LWORK >= MAX( 8*(N+1)+16, 2*SDIM*(N-SDIM) ).
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
* Not referenced if SENSE = 'N'.
*
@@ -227,6 +232,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
* ..
@@ -330,7 +337,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
MINWRK = 8*( N+1 ) + 16
MAXWRK = 7*( N+1 ) + N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 ) +
$ 16
@@ -338,7 +345,15 @@
MAXWRK = MAX( MAXWRK, 8*( N+1 )+N*
$ ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 )+16 )
END IF
+*
+* Estimate the workspace needed by STGSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, 2*N+(N*N+1)/2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -22
END IF
IF( .NOT.WANTSN ) THEN
LIWMIN = 1
@@ -346,21 +361,18 @@
LIWMIN = N + 6
END IF
IWORK( 1 ) = LIWMIN
-*
- IF( INFO.EQ.0 .AND. LWORK.LT.MINWRK ) THEN
- INFO = -22
- ELSE IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
+ IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
IF( LIWORK.LT.LIWMIN )
$ INFO = -24
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGGESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/sggev.f LAPACK/SRC/sggev.f
--- LAPACK.orig/SRC/sggev.f Thu Nov 4 14:26:20 1999
+++ LAPACK/SRC/sggev.f Fri May 25 16:10:10 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -123,10 +124,9 @@
* The dimension of the array WORK. LWORK >= max(1,8*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -141,11 +141,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR
CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, MAXWRK,
@@ -200,7 +202,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -226,24 +227,21 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 7*N + N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 8*N )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -16
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -16
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGGEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/sggevx.f LAPACK/SRC/sggevx.f
--- LAPACK.orig/SRC/sggevx.f Thu Nov 4 14:26:20 1999
+++ LAPACK/SRC/sggevx.f Fri May 25 16:11:25 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -212,10 +213,9 @@
* If SENSE = 'E', LWORK >= 12*N.
* If SENSE = 'V' or 'B', LWORK >= 2*N*N+12*N+16.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* IWORK (workspace) INTEGER array, dimension (N+6)
* If SENSE = 'E', IWORK is not referenced.
@@ -262,12 +262,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY, PAIR,
- $ WANTSB, WANTSE, WANTSN, WANTSV
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, PAIR, WANTSB,
+ $ WANTSE, WANTSN, WANTSV
CHARACTER CHTEMP
INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
$ ITAU, IWRK, IWRK1, J, JC, JR, M, MAXWRK,
@@ -327,7 +329,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC,
$ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
$ THEN
@@ -360,7 +361,7 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 5*N + N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 6*N )
IF( WANTSE ) THEN
@@ -370,24 +371,19 @@
MAXWRK = MAX( MAXWRK, 2*N*N+12*N+16 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -26
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -26
- END IF
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGGEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV ) RETURN
IF( N.EQ.0 )
$ RETURN
-*
*
* Get machine constants
*
diff -uNr LAPACK.orig/SRC/sgghrd.f LAPACK/SRC/sgghrd.f
--- LAPACK.orig/SRC/sgghrd.f Thu Nov 4 14:25:44 1999
+++ LAPACK/SRC/sgghrd.f Fri May 25 16:11:45 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -20,16 +20,32 @@
*
* SGGHRD reduces a pair of real matrices (A,B) to generalized upper
* Hessenberg form using orthogonal transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are orthogonal, and ' means transpose.
+* general matrix and B is upper triangular. The form of the
+* generalized eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the orthogonal matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**T*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**T*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**T*x.
*
* The orthogonal matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
-* postmultiplied into input matrices Q1 and Z1, so that
+* postmultiplied into input matrices Q1 and Z1, so that
*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+*
+* Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+*
+* If Q1 is the orthogonal matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then SGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -53,10 +69,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to SGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to SGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) REAL array, dimension (LDA, N)
@@ -70,33 +87,28 @@
*
* B (input/output) REAL array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**T B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) REAL array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the orthogonal matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain an orthogonal matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+* typically from the QR factorization of B.
+* On exit, if COMPQ='I', the orthogonal matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) REAL array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the orthogonal matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain an orthogonal matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+* On exit, if COMPZ='I', the orthogonal matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/SRC/shgeqz.f LAPACK/SRC/shgeqz.f
--- LAPACK.orig/SRC/shgeqz.f Thu Nov 4 14:23:36 1999
+++ LAPACK/SRC/shgeqz.f Fri May 25 16:12:05 2001
@@ -1,56 +1,75 @@
- SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
$ LWORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), Q( LDQ, * ), WORK( * ),
- $ Z( LDZ, * )
+ REAL ALPHAI( * ), ALPHAR( * ), BETA( * ),
+ $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
+ $ WORK( * ), Z( LDZ, * )
* ..
*
* Purpose
* =======
*
-* SHGEQZ implements a single-/double-shift version of the QZ method for
-* finding the generalized eigenvalues
-*
-* w(j)=(ALPHAR(j) + i*ALPHAI(j))/BETAR(j) of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* In addition, the pair A,B may be reduced to generalized Schur form:
-* B is upper triangular, and A is block upper triangular, where the
-* diagonal blocks are either 1-by-1 or 2-by-2, the 2-by-2 blocks having
-* complex generalized eigenvalues (see the description of the argument
-* JOB.)
-*
-* If JOB='S', then the pair (A,B) is simultaneously reduced to Schur
-* form by applying one orthogonal tranformation (usually called Q) on
-* the left and another (usually called Z) on the right. The 2-by-2
-* upper-triangular diagonal blocks of B corresponding to 2-by-2 blocks
-* of A will be reduced to positive diagonal matrices. (I.e.,
-* if A(j+1,j) is non-zero, then B(j+1,j)=B(j,j+1)=0 and B(j,j) and
-* B(j+1,j+1) will be positive.)
-*
-* If JOB='E', then at each iteration, the same transformations
-* are computed, but they are only applied to those parts of A and B
-* which are needed to compute ALPHAR, ALPHAI, and BETAR.
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the orthogonal
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* SHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the double-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a real matrix pair (A,B):
+*
+* A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+*
+* as computed by SGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**T, T = Q*P*Z**T,
+*
+* where Q and Z are orthogonal matrices, P is an upper triangular
+* matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+* diagonal blocks.
+*
+* The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+* (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+* eigenvalues.
+*
+* Additionally, the 2-by-2 upper triangular diagonal blocks of P
+* corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+* form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+* P(j,j) > 0, and P(j+1,j+1) > 0.
+*
+* Optionally, the orthogonal matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced
+* the matrix pair (A,B) to generalized upper Hessenberg form, then the
+* output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+* generalized Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
+* of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
+* complex and beta real.
+* If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+* generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* Real eigenvalues can be read directly from the generalized Schur
+* form:
+* alpha = S(i,i), beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -60,114 +79,98 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHAR, ALPHAI, and BETA. A and B will
-* not necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHAR, ALPHAI, and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Compute eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the transpose of
-* the orthogonal tranformation that is applied to the
-* left side of A and B to reduce them to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain an orthogonal matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the orthogonal
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Z is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain an orthogonal matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) REAL array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to generalized Schur form.
-* If JOB='E', then on exit A will have been destroyed.
-* The diagonal blocks will be correct, but the off-diagonal
-* portion will be meaningless.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) REAL array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero. 2-by-2 blocks in B
-* corresponding to 2-by-2 blocks in A will be reduced to
-* positive diagonal form. (I.e., if A(j+1,j) is non-zero,
-* then B(j+1,j)=B(j,j+1)=0 and B(j,j) and B(j+1,j+1) will be
-* positive.)
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to Schur form.
-* If JOB='E', then on exit B will have been destroyed.
-* Elements corresponding to diagonal blocks of A will be
-* correct, but the off-diagonal portion will be meaningless.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) REAL array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper quasi-triangular
+* matrix S from the generalized Schur factorization;
+* 2-by-2 diagonal blocks (corresponding to complex conjugate
+* pairs of eigenvalues) are returned in standard form, with
+* H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+* If JOB = 'E', the diagonal blocks of H match those of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) REAL array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization;
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of S
+* are reduced to positive diagonal form, i.e., if H(j+1,j) is
+* non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+* T(j+1,j+1) > 0.
+* If JOB = 'E', the diagonal blocks of T match those of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHAR (output) REAL array, dimension (N)
-* ALPHAR(1:N) will be set to real parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=A(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The real parts of each scalar alpha defining an eigenvalue
+* of GNEP.
*
* ALPHAI (output) REAL array, dimension (N)
-* ALPHAI(1:N) will be set to imaginary parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=0.
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP.
+* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+* positive, then the j-th and (j+1)-st eigenvalues are a
+* complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
*
* BETA (output) REAL array, dimension (N)
-* BETA(1:N) will be set to the (real) diagonal elements of B
-* that would result from reducing A and B to Schur form and
-* then further reducing them both to triangular form using
-* unitary transformations s.t. the diagonal of B was
-* non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then BETA(j)=B(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
-* (Note that BETA(1:N) will always be non-negative, and no
-* BETAI is necessary.)
+* The scalars beta that define the eigenvalues of GNEP.
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* Q (input/output) REAL array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the transpose of the orthogonal
-* transformations which are applied to A and B on the left
-* will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+* of left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) REAL array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the orthogonal transformations
-* which are applied to A and B on the right will be applied
-* to the array Z on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of
+* right Schur vectors of (H,T), and if COMPZ = 'V', the
+* orthogonal matrix of right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -187,13 +190,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -225,7 +227,7 @@
$ B1R, B22, B2A, B2I, B2R, BN, BNORM, BSCALE,
$ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
$ CQ, CR, CZ, ESHIFT, S, S1, S1INV, S2, SAFMAX,
- $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T,
+ $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T1,
$ TAU, TEMP, TEMP2, TEMPI, TEMPR, U1, U12, U12L,
$ U2, ULP, VS, W11, W12, W21, W22, WABS, WI, WR,
$ WR2
@@ -302,9 +304,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -15
@@ -340,8 +342,8 @@
SAFMIN = SLAMCH( 'S' )
SAFMAX = ONE / SAFMIN
ULP = SLAMCH( 'E' )*SLAMCH( 'B' )
- ANORM = SLANHS( 'F', IN, A( ILO, ILO ), LDA, WORK )
- BNORM = SLANHS( 'F', IN, B( ILO, ILO ), LDB, WORK )
+ ANORM = SLANHS( 'F', IN, H( ILO, ILO ), LDH, WORK )
+ BNORM = SLANHS( 'F', IN, T( ILO, ILO ), LDT, WORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -350,15 +352,15 @@
* Set Eigenvalues IHI+1:N
*
DO 30 J = IHI + 1, N
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 10 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
10 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 20 JR = 1, N
@@ -366,9 +368,9 @@
20 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
30 CONTINUE
*
* If IHI < ILO, skip QZ steps
@@ -408,8 +410,8 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
IF( ILAST.EQ.ILO ) THEN
*
@@ -417,14 +419,14 @@
*
GO TO 80
ELSE
- IF( ABS( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = ZERO
+ IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = ZERO
GO TO 80
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = ZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = ZERO
GO TO 70
END IF
*
@@ -432,36 +434,36 @@
*
DO 60 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = ZERO
+ IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = ZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = ZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = ZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- TEMP = ABS( A( J, J-1 ) )
- TEMP2 = ABS( A( J, J ) )
+ TEMP = ABS( H( J, J-1 ) )
+ TEMP2 = ABS( H( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( TEMP*( ASCALE*ABS( A( J+1, J ) ) ).LE.TEMP2*
+ IF( TEMP*( ASCALE*ABS( H( J+1, J ) ) ).LE.TEMP2*
$ ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
END IF
*
@@ -473,21 +475,21 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 40 JCH = J, ILAST - 1
- TEMP = A( JCH, JCH )
- CALL SLARTG( TEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = ZERO
- CALL SROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL SROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ TEMP = H( JCH, JCH )
+ CALL SLARTG( TEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = ZERO
+ CALL SROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL SROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
- IF( ABS( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 80
ELSE
@@ -495,35 +497,35 @@
GO TO 110
END IF
END IF
- B( JCH+1, JCH+1 ) = ZERO
+ T( JCH+1, JCH+1 ) = ZERO
40 CONTINUE
GO TO 70
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 50 JCH = J, ILAST - 1
- TEMP = B( JCH, JCH+1 )
- CALL SLARTG( TEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = ZERO
+ TEMP = T( JCH, JCH+1 )
+ CALL SLARTG( TEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = ZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL SROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL SROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL SROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL SROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
- TEMP = A( JCH+1, JCH )
- CALL SLARTG( TEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = ZERO
- CALL SROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL SROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ TEMP = H( JCH+1, JCH )
+ CALL SLARTG( TEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = ZERO
+ CALL SROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL SROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL SROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -547,34 +549,34 @@
INFO = N + 1
GO TO 420
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
70 CONTINUE
- TEMP = A( ILAST, ILAST )
- CALL SLARTG( TEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = ZERO
- CALL SROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL SROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ TEMP = H( ILAST, ILAST )
+ CALL SLARTG( TEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = ZERO
+ CALL SROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL SROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL SROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
* and BETA
*
80 CONTINUE
- IF( B( ILAST, ILAST ).LT.ZERO ) THEN
+ IF( T( ILAST, ILAST ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 90 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
90 CONTINUE
ELSE
- A( ILAST, ILAST ) = -A( ILAST, ILAST )
- B( ILAST, ILAST ) = -B( ILAST, ILAST )
+ H( ILAST, ILAST ) = -H( ILAST, ILAST )
+ T( ILAST, ILAST ) = -T( ILAST, ILAST )
END IF
IF( ILZ ) THEN
DO 100 J = 1, N
@@ -582,9 +584,9 @@
100 CONTINUE
END IF
END IF
- ALPHAR( ILAST ) = A( ILAST, ILAST )
+ ALPHAR( ILAST ) = H( ILAST, ILAST )
ALPHAI( ILAST ) = ZERO
- BETA( ILAST ) = B( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -617,7 +619,7 @@
* Compute single shifts.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.EQ.IITER ) THEN
@@ -625,10 +627,10 @@
* Exceptional shift. Chosen for no particularly good reason.
* (Single shift only.)
*
- IF( ( REAL( MAXIT )*SAFMIN )*ABS( A( ILAST-1, ILAST ) ).LT.
- $ ABS( B( ILAST-1, ILAST-1 ) ) ) THEN
- ESHIFT = ESHIFT + A( ILAST-1, ILAST ) /
- $ B( ILAST-1, ILAST-1 )
+ IF( ( REAL( MAXIT )*SAFMIN )*ABS( H( ILAST-1, ILAST ) ).LT.
+ $ ABS( T( ILAST-1, ILAST-1 ) ) ) THEN
+ ESHIFT = ESHIFT + H( ILAST-1, ILAST ) /
+ $ T( ILAST-1, ILAST-1 )
ELSE
ESHIFT = ESHIFT + ONE / ( SAFMIN*REAL( MAXIT ) )
END IF
@@ -641,8 +643,8 @@
* bottom-right 2x2 block of A and B. The first eigenvalue
* returned by SLAG2 is the Wilkinson shift (AEP p.512),
*
- CALL SLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL SLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ S2, WR, WR2, WI )
*
TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
@@ -669,14 +671,14 @@
*
DO 120 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- TEMP = ABS( S1*A( J, J-1 ) )
- TEMP2 = ABS( S1*A( J, J )-WR*B( J, J ) )
+ TEMP = ABS( S1*H( J, J-1 ) )
+ TEMP2 = ABS( S1*H( J, J )-WR*T( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS( ( ASCALE*A( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
+ IF( ABS( ( ASCALE*H( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
$ TEMP2 )GO TO 130
120 CONTINUE
*
@@ -687,26 +689,26 @@
*
* Initial Q
*
- TEMP = S1*A( ISTART, ISTART ) - WR*B( ISTART, ISTART )
- TEMP2 = S1*A( ISTART+1, ISTART )
+ TEMP = S1*H( ISTART, ISTART ) - WR*T( ISTART, ISTART )
+ TEMP2 = S1*H( ISTART+1, ISTART )
CALL SLARTG( TEMP, TEMP2, C, S, TEMPR )
*
* Sweep
*
DO 190 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- TEMP = A( J, J-1 )
- CALL SLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL SLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
END IF
*
DO 140 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
140 CONTINUE
IF( ILQ ) THEN
DO 150 JR = 1, N
@@ -716,19 +718,19 @@
150 CONTINUE
END IF
*
- TEMP = B( J+1, J+1 )
- CALL SLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL SLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 160 JR = IFRSTM, MIN( J+2, ILAST )
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
160 CONTINUE
DO 170 JR = IFRSTM, J
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
170 CONTINUE
IF( ILZ ) THEN
DO 180 JR = 1, N
@@ -759,8 +761,8 @@
* B = ( ) with B11 non-negative.
* ( 0 B22 )
*
- CALL SLASV2( B( ILAST-1, ILAST-1 ), B( ILAST-1, ILAST ),
- $ B( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
+ CALL SLASV2( T( ILAST-1, ILAST-1 ), T( ILAST-1, ILAST ),
+ $ T( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
*
IF( B11.LT.ZERO ) THEN
CR = -CR
@@ -769,17 +771,17 @@
B22 = -B22
END IF
*
- CALL SROT( ILASTM+1-IFIRST, A( ILAST-1, ILAST-1 ), LDA,
- $ A( ILAST, ILAST-1 ), LDA, CL, SL )
- CALL SROT( ILAST+1-IFRSTM, A( IFRSTM, ILAST-1 ), 1,
- $ A( IFRSTM, ILAST ), 1, CR, SR )
+ CALL SROT( ILASTM+1-IFIRST, H( ILAST-1, ILAST-1 ), LDH,
+ $ H( ILAST, ILAST-1 ), LDH, CL, SL )
+ CALL SROT( ILAST+1-IFRSTM, H( IFRSTM, ILAST-1 ), 1,
+ $ H( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILAST.LT.ILASTM )
- $ CALL SROT( ILASTM-ILAST, B( ILAST-1, ILAST+1 ), LDB,
- $ B( ILAST, ILAST+1 ), LDA, CL, SL )
+ $ CALL SROT( ILASTM-ILAST, T( ILAST-1, ILAST+1 ), LDT,
+ $ T( ILAST, ILAST+1 ), LDH, CL, SL )
IF( IFRSTM.LT.ILAST-1 )
- $ CALL SROT( IFIRST-IFRSTM, B( IFRSTM, ILAST-1 ), 1,
- $ B( IFRSTM, ILAST ), 1, CR, SR )
+ $ CALL SROT( IFIRST-IFRSTM, T( IFRSTM, ILAST-1 ), 1,
+ $ T( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILQ )
$ CALL SROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
@@ -788,17 +790,17 @@
$ CALL SROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
$ SR )
*
- B( ILAST-1, ILAST-1 ) = B11
- B( ILAST-1, ILAST ) = ZERO
- B( ILAST, ILAST-1 ) = ZERO
- B( ILAST, ILAST ) = B22
+ T( ILAST-1, ILAST-1 ) = B11
+ T( ILAST-1, ILAST ) = ZERO
+ T( ILAST, ILAST-1 ) = ZERO
+ T( ILAST, ILAST ) = B22
*
* If B22 is negative, negate column ILAST
*
IF( B22.LT.ZERO ) THEN
DO 210 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
210 CONTINUE
*
IF( ILZ ) THEN
@@ -812,8 +814,8 @@
*
* Recompute shift
*
- CALL SLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL SLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ TEMP, WR, TEMP2, WI )
*
* If standardization has perturbed the shift onto real line,
@@ -825,10 +827,10 @@
*
* Do EISPACK (QZVAL) computation of alpha and beta
*
- A11 = A( ILAST-1, ILAST-1 )
- A21 = A( ILAST, ILAST-1 )
- A12 = A( ILAST-1, ILAST )
- A22 = A( ILAST, ILAST )
+ A11 = H( ILAST-1, ILAST-1 )
+ A21 = H( ILAST, ILAST-1 )
+ A12 = H( ILAST-1, ILAST )
+ A22 = H( ILAST, ILAST )
*
* Compute complex Givens rotation on right
* (Assume some element of C = (sA - wB) > unfl )
@@ -845,10 +847,10 @@
*
IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
$ ABS( C22R )+ABS( C22I ) ) THEN
- T = SLAPY3( C12, C11R, C11I )
- CZ = C12 / T
- SZR = -C11R / T
- SZI = -C11I / T
+ T1 = SLAPY3( C12, C11R, C11I )
+ CZ = C12 / T1
+ SZR = -C11R / T1
+ SZI = -C11I / T1
ELSE
CZ = SLAPY2( C22R, C22I )
IF( CZ.LE.SAFMIN ) THEN
@@ -858,10 +860,10 @@
ELSE
TEMPR = C22R / CZ
TEMPI = C22I / CZ
- T = SLAPY2( CZ, C21 )
- CZ = CZ / T
- SZR = -C21*TEMPR / T
- SZI = C21*TEMPI / T
+ T1 = SLAPY2( CZ, C21 )
+ CZ = CZ / T1
+ SZR = -C21*TEMPR / T1
+ SZI = C21*TEMPI / T1
END IF
END IF
*
@@ -895,10 +897,10 @@
SQI = TEMPI*A2R - TEMPR*A2I
END IF
END IF
- T = SLAPY3( CQ, SQR, SQI )
- CQ = CQ / T
- SQR = SQR / T
- SQI = SQI / T
+ T1 = SLAPY3( CQ, SQR, SQI )
+ CQ = CQ / T1
+ SQR = SQR / T1
+ SQI = SQI / T1
*
* Compute diagonal elements of QBZ
*
@@ -950,26 +952,26 @@
*
* We assume that the block is at least 3x3
*
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- U12 = B( ILAST-1, ILAST ) / B( ILAST, ILAST )
- AD11L = ( ASCALE*A( IFIRST, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD21L = ( ASCALE*A( IFIRST+1, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD12L = ( ASCALE*A( IFIRST, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD22L = ( ASCALE*A( IFIRST+1, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD32L = ( ASCALE*A( IFIRST+2, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- U12L = B( IFIRST, IFIRST+1 ) / B( IFIRST+1, IFIRST+1 )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ U12 = T( ILAST-1, ILAST ) / T( ILAST, ILAST )
+ AD11L = ( ASCALE*H( IFIRST, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD21L = ( ASCALE*H( IFIRST+1, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD12L = ( ASCALE*H( IFIRST, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD22L = ( ASCALE*H( IFIRST+1, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD32L = ( ASCALE*H( IFIRST+2, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ U12L = T( IFIRST, IFIRST+1 ) / T( IFIRST+1, IFIRST+1 )
*
V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
$ AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
@@ -991,27 +993,27 @@
* Zero (j-1)st column of A
*
IF( J.GT.ISTART ) THEN
- V( 1 ) = A( J, J-1 )
- V( 2 ) = A( J+1, J-1 )
- V( 3 ) = A( J+2, J-1 )
+ V( 1 ) = H( J, J-1 )
+ V( 2 ) = H( J+1, J-1 )
+ V( 3 ) = H( J+2, J-1 )
*
- CALL SLARFG( 3, A( J, J-1 ), V( 2 ), 1, TAU )
+ CALL SLARFG( 3, H( J, J-1 ), V( 2 ), 1, TAU )
V( 1 ) = ONE
- A( J+1, J-1 ) = ZERO
- A( J+2, J-1 ) = ZERO
+ H( J+1, J-1 ) = ZERO
+ H( J+2, J-1 ) = ZERO
END IF
*
DO 230 JC = J, ILASTM
- TEMP = TAU*( A( J, JC )+V( 2 )*A( J+1, JC )+V( 3 )*
- $ A( J+2, JC ) )
- A( J, JC ) = A( J, JC ) - TEMP
- A( J+1, JC ) = A( J+1, JC ) - TEMP*V( 2 )
- A( J+2, JC ) = A( J+2, JC ) - TEMP*V( 3 )
- TEMP2 = TAU*( B( J, JC )+V( 2 )*B( J+1, JC )+V( 3 )*
- $ B( J+2, JC ) )
- B( J, JC ) = B( J, JC ) - TEMP2
- B( J+1, JC ) = B( J+1, JC ) - TEMP2*V( 2 )
- B( J+2, JC ) = B( J+2, JC ) - TEMP2*V( 3 )
+ TEMP = TAU*( H( J, JC )+V( 2 )*H( J+1, JC )+V( 3 )*
+ $ H( J+2, JC ) )
+ H( J, JC ) = H( J, JC ) - TEMP
+ H( J+1, JC ) = H( J+1, JC ) - TEMP*V( 2 )
+ H( J+2, JC ) = H( J+2, JC ) - TEMP*V( 3 )
+ TEMP2 = TAU*( T( J, JC )+V( 2 )*T( J+1, JC )+V( 3 )*
+ $ T( J+2, JC ) )
+ T( J, JC ) = T( J, JC ) - TEMP2
+ T( J+1, JC ) = T( J+1, JC ) - TEMP2*V( 2 )
+ T( J+2, JC ) = T( J+2, JC ) - TEMP2*V( 3 )
230 CONTINUE
IF( ILQ ) THEN
DO 240 JR = 1, N
@@ -1028,27 +1030,27 @@
* Swap rows to pivot
*
ILPIVT = .FALSE.
- TEMP = MAX( ABS( B( J+1, J+1 ) ), ABS( B( J+1, J+2 ) ) )
- TEMP2 = MAX( ABS( B( J+2, J+1 ) ), ABS( B( J+2, J+2 ) ) )
+ TEMP = MAX( ABS( T( J+1, J+1 ) ), ABS( T( J+1, J+2 ) ) )
+ TEMP2 = MAX( ABS( T( J+2, J+1 ) ), ABS( T( J+2, J+2 ) ) )
IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
SCALE = ZERO
U1 = ONE
U2 = ZERO
GO TO 250
ELSE IF( TEMP.GE.TEMP2 ) THEN
- W11 = B( J+1, J+1 )
- W21 = B( J+2, J+1 )
- W12 = B( J+1, J+2 )
- W22 = B( J+2, J+2 )
- U1 = B( J+1, J )
- U2 = B( J+2, J )
+ W11 = T( J+1, J+1 )
+ W21 = T( J+2, J+1 )
+ W12 = T( J+1, J+2 )
+ W22 = T( J+2, J+2 )
+ U1 = T( J+1, J )
+ U2 = T( J+2, J )
ELSE
- W21 = B( J+1, J+1 )
- W11 = B( J+2, J+1 )
- W22 = B( J+1, J+2 )
- W12 = B( J+2, J+2 )
- U2 = B( J+1, J )
- U1 = B( J+2, J )
+ W21 = T( J+1, J+1 )
+ W11 = T( J+2, J+1 )
+ W22 = T( J+1, J+2 )
+ W12 = T( J+2, J+2 )
+ U2 = T( J+1, J )
+ U1 = T( J+2, J )
END IF
*
* Swap columns if nec.
@@ -1098,9 +1100,9 @@
*
* Compute Householder Vector
*
- T = SQRT( SCALE**2+U1**2+U2**2 )
- TAU = ONE + SCALE / T
- VS = -ONE / ( SCALE+T )
+ T1 = SQRT( SCALE**2+U1**2+U2**2 )
+ TAU = ONE + SCALE / T1
+ VS = -ONE / ( SCALE+T1 )
V( 1 ) = ONE
V( 2 ) = VS*U1
V( 3 ) = VS*U2
@@ -1108,18 +1110,18 @@
* Apply transformations from the right.
*
DO 260 JR = IFRSTM, MIN( J+3, ILAST )
- TEMP = TAU*( A( JR, J )+V( 2 )*A( JR, J+1 )+V( 3 )*
- $ A( JR, J+2 ) )
- A( JR, J ) = A( JR, J ) - TEMP
- A( JR, J+1 ) = A( JR, J+1 ) - TEMP*V( 2 )
- A( JR, J+2 ) = A( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( H( JR, J )+V( 2 )*H( JR, J+1 )+V( 3 )*
+ $ H( JR, J+2 ) )
+ H( JR, J ) = H( JR, J ) - TEMP
+ H( JR, J+1 ) = H( JR, J+1 ) - TEMP*V( 2 )
+ H( JR, J+2 ) = H( JR, J+2 ) - TEMP*V( 3 )
260 CONTINUE
DO 270 JR = IFRSTM, J + 2
- TEMP = TAU*( B( JR, J )+V( 2 )*B( JR, J+1 )+V( 3 )*
- $ B( JR, J+2 ) )
- B( JR, J ) = B( JR, J ) - TEMP
- B( JR, J+1 ) = B( JR, J+1 ) - TEMP*V( 2 )
- B( JR, J+2 ) = B( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( T( JR, J )+V( 2 )*T( JR, J+1 )+V( 3 )*
+ $ T( JR, J+2 ) )
+ T( JR, J ) = T( JR, J ) - TEMP
+ T( JR, J+1 ) = T( JR, J+1 ) - TEMP*V( 2 )
+ T( JR, J+2 ) = T( JR, J+2 ) - TEMP*V( 3 )
270 CONTINUE
IF( ILZ ) THEN
DO 280 JR = 1, N
@@ -1130,8 +1132,8 @@
Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
280 CONTINUE
END IF
- B( J+1, J ) = ZERO
- B( J+2, J ) = ZERO
+ T( J+1, J ) = ZERO
+ T( J+2, J ) = ZERO
290 CONTINUE
*
* Last elements: Use Givens rotations
@@ -1139,17 +1141,17 @@
* Rotations from the left
*
J = ILAST - 1
- TEMP = A( J, J-1 )
- CALL SLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL SLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
*
DO 300 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
300 CONTINUE
IF( ILQ ) THEN
DO 310 JR = 1, N
@@ -1161,19 +1163,19 @@
*
* Rotations from the right.
*
- TEMP = B( J+1, J+1 )
- CALL SLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL SLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 320 JR = IFRSTM, ILAST
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
320 CONTINUE
DO 330 JR = IFRSTM, ILAST - 1
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
330 CONTINUE
IF( ILZ ) THEN
DO 340 JR = 1, N
@@ -1207,15 +1209,15 @@
* Set Eigenvalues 1:ILO-1
*
DO 410 J = 1, ILO - 1
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 390 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
390 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 400 JR = 1, N
@@ -1223,9 +1225,9 @@
400 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
410 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/SRC/slasr.f LAPACK/SRC/slasr.f
--- LAPACK.orig/SRC/slasr.f Thu Nov 4 14:23:40 1999
+++ LAPACK/SRC/slasr.f Fri May 25 16:12:26 2001
@@ -3,7 +3,7 @@
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER DIRECT, PIVOT, SIDE
@@ -16,44 +16,77 @@
* Purpose
* =======
*
-* SLASR performs the transformation
-*
-* A := P*A, when SIDE = 'L' or 'l' ( Left-hand side )
-*
-* A := A*P', when SIDE = 'R' or 'r' ( Right-hand side )
-*
-* where A is an m by n real matrix and P is an orthogonal matrix,
-* consisting of a sequence of plane rotations determined by the
-* parameters PIVOT and DIRECT as follows ( z = m when SIDE = 'L' or 'l'
-* and z = n when SIDE = 'R' or 'r' ):
-*
-* When DIRECT = 'F' or 'f' ( Forward sequence ) then
-*
-* P = P( z - 1 )*...*P( 2 )*P( 1 ),
-*
-* and when DIRECT = 'B' or 'b' ( Backward sequence ) then
-*
-* P = P( 1 )*P( 2 )*...*P( z - 1 ),
-*
-* where P( k ) is a plane rotation matrix for the following planes:
-*
-* when PIVOT = 'V' or 'v' ( Variable pivot ),
-* the plane ( k, k + 1 )
-*
-* when PIVOT = 'T' or 't' ( Top pivot ),
-* the plane ( 1, k + 1 )
-*
-* when PIVOT = 'B' or 'b' ( Bottom pivot ),
-* the plane ( k, z )
-*
-* c( k ) and s( k ) must contain the cosine and sine that define the
-* matrix P( k ). The two by two plane rotation part of the matrix
-* P( k ), R( k ), is assumed to be of the form
-*
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
-*
-* This version vectorises across rows of the array A when SIDE = 'L'.
+* SLASR applies a sequence of plane rotations to a real matrix A,
+* from either the left or the right.
+*
+* When SIDE = 'L', the transformation takes the form
+*
+* A := P*A
+*
+* and when SIDE = 'R', the transformation takes the form
+*
+* A := A*P**T
+*
+* where P is an orthogonal matrix consisting of a sequence of z plane
+* rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+* and P**T is the transpose of P.
+*
+* When DIRECT = 'F' (Forward sequence), then
+*
+* P = P(z-1) * ... * P(2) * P(1)
+*
+* and when DIRECT = 'B' (Backward sequence), then
+*
+* P = P(1) * P(2) * ... * P(z-1)
+*
+* where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+*
+* R(k) = ( c(k) s(k) )
+* = ( -s(k) c(k) ).
+*
+* When PIVOT = 'V' (Variable pivot), the rotation is performed
+* for the plane (k,k+1), i.e., P(k) has the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears as a rank-2 modification to the identity matrix in
+* rows and columns k and k+1.
+*
+* When PIVOT = 'T' (Top pivot), the rotation is performed for the
+* plane (1,k+1), so P(k) has the form
+*
+* P(k) = ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears in rows and columns 1 and k+1.
+*
+* Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+* performed for the plane (k,z), giving P(k) the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+*
+* where R(k) appears in rows and columns k and z. The rotations are
+* performed without ever forming P(k) explicitly.
*
* Arguments
* =========
@@ -62,13 +95,13 @@
* Specifies whether the plane rotation matrix P is applied to
* A on the left or the right.
* = 'L': Left, compute A := P*A
-* = 'R': Right, compute A:= A*P'
+* = 'R': Right, compute A:= A*P**T
*
* DIRECT (input) CHARACTER*1
* Specifies whether P is a forward or backward sequence of
* plane rotations.
-* = 'F': Forward, P = P( z - 1 )*...*P( 2 )*P( 1 )
-* = 'B': Backward, P = P( 1 )*P( 2 )*...*P( z - 1 )
+* = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+* = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
*
* PIVOT (input) CHARACTER*1
* Specifies the plane for which P(k) is a plane rotation
@@ -85,18 +118,22 @@
* The number of columns of the matrix A. If n <= 1, an
* immediate return is effected.
*
-* C, S (input) REAL arrays, dimension
+* C (input) REAL array, dimension
+* (M-1) if SIDE = 'L'
+* (N-1) if SIDE = 'R'
+* The cosines c(k) of the plane rotations.
+*
+* S (input) REAL array, dimension
* (M-1) if SIDE = 'L'
* (N-1) if SIDE = 'R'
-* c(k) and s(k) contain the cosine and sine that define the
-* matrix P(k). The two by two plane rotation part of the
-* matrix P(k), R(k), is assumed to be of the form
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
+* The sines s(k) of the plane rotations. The 2-by-2 plane
+* rotation part of the matrix P(k), R(k), has the form
+* R(k) = ( c(k) s(k) )
+* ( -s(k) c(k) ).
*
* A (input/output) REAL array, dimension (LDA,N)
-* The m by n matrix A. On exit, A is overwritten by P*A if
-* SIDE = 'R' or by A*P' if SIDE = 'L'.
+* The M-by-N matrix A. On exit, A is overwritten by P*A if
+* SIDE = 'R' or by A*P**T if SIDE = 'L'.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
diff -uNr LAPACK.orig/SRC/ssbgst.f LAPACK/SRC/ssbgst.f
--- LAPACK.orig/SRC/ssbgst.f Thu Nov 4 14:23:32 1999
+++ LAPACK/SRC/ssbgst.f Fri May 25 16:12:46 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 9, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO, VECT
@@ -125,7 +125,7 @@
INFO = -3
ELSE IF( KA.LT.0 ) THEN
INFO = -4
- ELSE IF( KB.LT.0 ) THEN
+ ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
INFO = -5
ELSE IF( LDAB.LT.KA+1 ) THEN
INFO = -7
diff -uNr LAPACK.orig/SRC/sstebz.f LAPACK/SRC/sstebz.f
--- LAPACK.orig/SRC/sstebz.f Thu Nov 4 14:24:00 1999
+++ LAPACK/SRC/sstebz.f Fri May 25 16:13:18 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-18-00: Increase FUDGE factor for T3E (eca)
*
* .. Scalar Arguments ..
CHARACTER ORDER, RANGE
@@ -175,7 +176,7 @@
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
$ HALF = 1.0E0 / TWO )
REAL FUDGE, RELFAC
- PARAMETER ( FUDGE = 2.0E0, RELFAC = 2.0E0 )
+ PARAMETER ( FUDGE = 2.1E0, RELFAC = 2.0E0 )
* ..
* .. Local Scalars ..
LOGICAL NCNVRG, TOOFEW
diff -uNr LAPACK.orig/SRC/stgevc.f LAPACK/SRC/stgevc.f
--- LAPACK.orig/SRC/stgevc.f Thu Nov 4 14:26:09 1999
+++ LAPACK/SRC/stgevc.f Fri May 25 16:13:28 2001
@@ -1,18 +1,18 @@
- SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
- REAL A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ REAL P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -20,34 +20,30 @@
* Purpose
* =======
*
-* STGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of real upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* STGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of real matrices (S,P), where S is a quasi-triangular matrix
+* and P is upper triangular. Matrix pairs of this type are produced by
+* the generalized Schur factorization of a matrix pair (A,B):
+*
+* A = Q*S*Z**T, B = Q*P*Z**T
+*
+* as computed by SGGHRD + SHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input orthogonal
-* matrices. If (A,B) was obtained from the generalized real-Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
-*
-* A must be block upper triangular, with 1-by-1 and 2-by-2 diagonal
-* blocks. Corresponding to each 2-by-2 diagonal block is a complex
-* conjugate pair of eigenvalues and eigenvectors; only one
-* eigenvector of the pair is computed, namely the one corresponding
-* to the eigenvalue with positive imaginary part.
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal blocks of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the orthogonal factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
*
* Arguments
* =========
@@ -59,78 +55,84 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to the real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must
-* be set to .TRUE..
+* computed. If w(j) is a real eigenvalue, the corresponding
+* real eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector
+* is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+* and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+* set to .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
+* The order of the matrices S and P. N >= 0.
*
-* A (input) REAL array, dimension (LDA,N)
-* The upper quasi-triangular matrix A.
+* S (input) REAL array, dimension (LDS,N)
+* The upper quasi-triangular matrix S from a generalized Schur
+* factorization, as computed by SHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) REAL array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by SHGEQZ.
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+* of S must be in positive diagonal form.
*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1, N).
-*
-* B (input) REAL array, dimension (LDB,N)
-* The upper triangular matrix B. If A has a 2-by-2 diagonal
-* block, then the corresponding 2-by-2 block of B must be
-* diagonal with positive elements.
-*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) REAL array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the orthogonal matrix Q
* of left Schur vectors returned by SHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
*
+* Not referenced if SIDE = 'R'.
+*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) REAL array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-* contain an N-by-N matrix Q (usually the orthogonal matrix Z
+* contain an N-by-N matrix Z (usually the orthogonal matrix Z
* of right Schur vectors returned by SHGEQZ).
+*
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
-* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
-* SELECT, stored consecutively in the columns of
-* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+* if HOWMNY = 'B' or 'b', the matrix Z*X;
+* if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+* specified by SELECT, stored consecutively in the
+* columns of VR, in the same order as their
+* eigenvalues.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
+*
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
@@ -199,7 +201,7 @@
* partial sums. Since FORTRAN arrays are stored columnwise, this has
* the advantage that at each step, the elements of C that are accessed
* are adjacent to one another, whereas with the rowwise method, the
-* elements accessed at a step are spaced LDA (and LDB) words apart.
+* elements accessed at a step are spaced LDS (and LDP) words apart.
*
* When finding left eigenvectors, the matrix in question is the
* transpose of the one in storage, so the rowwise method then
@@ -226,8 +228,8 @@
$ XSCALE
* ..
* .. Local Arrays ..
- REAL BDIAG( 2 ), SUM( 2, 2 ), SUMA( 2, 2 ),
- $ SUMB( 2, 2 )
+ REAL BDIAG( 2 ), SUM( 2, 2 ), SUMS( 2, 2 ),
+ $ SUMP( 2, 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -252,7 +254,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -284,9 +286,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -305,7 +307,7 @@
GO TO 10
END IF
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO )
+ IF( S( J+1, J ).NE.ZERO )
$ ILCPLX = .TRUE.
END IF
IF( ILCPLX ) THEN
@@ -325,11 +327,11 @@
ILABAD = .FALSE.
ILBBAD = .FALSE.
DO 20 J = 1, N - 1
- IF( A( J+1, J ).NE.ZERO ) THEN
- IF( B( J, J ).EQ.ZERO .OR. B( J+1, J+1 ).EQ.ZERO .OR.
- $ B( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
+ IF( S( J+1, J ).NE.ZERO ) THEN
+ IF( P( J, J ).EQ.ZERO .OR. P( J+1, J+1 ).EQ.ZERO .OR.
+ $ P( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
IF( J.LT.N-1 ) THEN
- IF( A( J+2, J+1 ).NE.ZERO )
+ IF( S( J+2, J+1 ).NE.ZERO )
$ ILABAD = .TRUE.
END IF
END IF
@@ -372,30 +374,30 @@
* blocks) of A and B to check for possible overflow in the
* triangular solver.
*
- ANORM = ABS( A( 1, 1 ) )
+ ANORM = ABS( S( 1, 1 ) )
IF( N.GT.1 )
- $ ANORM = ANORM + ABS( A( 2, 1 ) )
- BNORM = ABS( B( 1, 1 ) )
+ $ ANORM = ANORM + ABS( S( 2, 1 ) )
+ BNORM = ABS( P( 1, 1 ) )
WORK( 1 ) = ZERO
WORK( N+1 ) = ZERO
*
DO 50 J = 2, N
TEMP = ZERO
TEMP2 = ZERO
- IF( A( J, J-1 ).EQ.ZERO ) THEN
+ IF( S( J, J-1 ).EQ.ZERO ) THEN
IEND = J - 1
ELSE
IEND = J - 2
END IF
DO 30 I = 1, IEND
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
30 CONTINUE
WORK( J ) = TEMP
WORK( N+J ) = TEMP2
DO 40 I = IEND + 1, MIN( J+1, N )
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
40 CONTINUE
ANORM = MAX( ANORM, TEMP )
BNORM = MAX( BNORM, TEMP2 )
@@ -425,7 +427,7 @@
END IF
NW = 1
IF( JE.LT.N ) THEN
- IF( A( JE+1, JE ).NE.ZERO ) THEN
+ IF( S( JE+1, JE ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -444,8 +446,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -472,10 +474,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -517,7 +519,7 @@
*
* Complex eigenvalue
*
- CALL SLAG2( A( JE, JE ), LDA, B( JE, JE ), LDB,
+ CALL SLAG2( S( JE, JE ), LDS, P( JE, JE ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
BCOEFI = -BCOEFI
@@ -549,9 +551,9 @@
*
* Compute first two components of eigenvector
*
- TEMP = ACOEF*A( JE+1, JE )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE+1, JE )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GT.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -560,10 +562,10 @@
ELSE
WORK( 2*N+JE+1 ) = ONE
WORK( 3*N+JE+1 ) = ZERO
- TEMP = ACOEF*A( JE, JE+1 )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE+1, JE+1 )-ACOEF*
- $ A( JE+1, JE+1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE+1, JE+1 ) / TEMP
+ TEMP = ACOEF*S( JE, JE+1 )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE+1, JE+1 )-ACOEF*
+ $ S( JE+1, JE+1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE+1, JE+1 ) / TEMP
END IF
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
$ ABS( WORK( 2*N+JE+1 ) )+ABS( WORK( 3*N+JE+1 ) ) )
@@ -586,11 +588,11 @@
END IF
*
NA = 1
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO ) THEN
+ IF( S( J+1, J ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
NA = 2
END IF
END IF
@@ -616,13 +618,13 @@
* Compute dot products
*
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
*
* To reduce the op count, this is done as
*
* _ j-1 _ j-1
-* a*conjg( sum A(k,j)*x(k) ) - b*conjg( sum B(k,j)*x(k) )
+* a*conjg( sum S(k,j)*x(k) ) - b*conjg( sum P(k,j)*x(k) )
* k=je k=je
*
* which may cause underflow problems if A or B are close
@@ -659,15 +661,15 @@
*$PL$ CMCHAR='*'
*
DO 110 JA = 1, NA
- SUMA( JA, JW ) = ZERO
- SUMB( JA, JW ) = ZERO
+ SUMS( JA, JW ) = ZERO
+ SUMP( JA, JW ) = ZERO
*
DO 100 JR = JE, J - 1
- SUMA( JA, JW ) = SUMA( JA, JW ) +
- $ A( JR, J+JA-1 )*
+ SUMS( JA, JW ) = SUMS( JA, JW ) +
+ $ S( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
- SUMB( JA, JW ) = SUMB( JA, JW ) +
- $ B( JR, J+JA-1 )*
+ SUMP( JA, JW ) = SUMP( JA, JW ) +
+ $ P( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
100 CONTINUE
110 CONTINUE
@@ -687,15 +689,15 @@
*
DO 130 JA = 1, NA
IF( ILCPLX ) THEN
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 ) -
- $ BCOEFI*SUMB( JA, 2 )
- SUM( JA, 2 ) = -ACOEF*SUMA( JA, 2 ) +
- $ BCOEFR*SUMB( JA, 2 ) +
- $ BCOEFI*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 ) -
+ $ BCOEFI*SUMP( JA, 2 )
+ SUM( JA, 2 ) = -ACOEF*SUMS( JA, 2 ) +
+ $ BCOEFR*SUMP( JA, 2 ) +
+ $ BCOEFI*SUMP( JA, 1 )
ELSE
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 )
END IF
130 CONTINUE
*
@@ -703,7 +705,7 @@
* Solve ( a A - b B ) y = SUM(,)
* with scaling and perturbation of the denominator
*
- CALL SLALN2( .TRUE., NA, NW, DMIN, ACOEF, A( J, J ), LDA,
+ CALL SLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS,
$ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR,
$ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP,
$ IINFO )
@@ -790,7 +792,7 @@
END IF
NW = 1
IF( JE.GT.1 ) THEN
- IF( A( JE, JE-1 ).NE.ZERO ) THEN
+ IF( S( JE, JE-1 ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -809,8 +811,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- unit eigenvector
*
@@ -839,10 +841,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -885,14 +887,14 @@
* (See "Further Details", above.)
*
DO 260 JR = 1, JE - 1
- WORK( 2*N+JR ) = BCOEFR*B( JR, JE ) -
- $ ACOEF*A( JR, JE )
+ WORK( 2*N+JR ) = BCOEFR*P( JR, JE ) -
+ $ ACOEF*S( JR, JE )
260 CONTINUE
ELSE
*
* Complex eigenvalue
*
- CALL SLAG2( A( JE-1, JE-1 ), LDA, B( JE-1, JE-1 ), LDB,
+ CALL SLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
IF( BCOEFI.EQ.ZERO ) THEN
@@ -924,9 +926,9 @@
* Compute first two components of eigenvector
* and contribution to sums
*
- TEMP = ACOEF*A( JE, JE-1 )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE, JE-1 )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GE.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -935,10 +937,10 @@
ELSE
WORK( 2*N+JE-1 ) = ONE
WORK( 3*N+JE-1 ) = ZERO
- TEMP = ACOEF*A( JE-1, JE )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE-1, JE-1 )-ACOEF*
- $ A( JE-1, JE-1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE-1, JE-1 ) / TEMP
+ TEMP = ACOEF*S( JE-1, JE )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE-1, JE-1 )-ACOEF*
+ $ S( JE-1, JE-1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE-1, JE-1 ) / TEMP
END IF
*
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
@@ -958,12 +960,12 @@
CRE2B = BCOEFR*WORK( 2*N+JE ) - BCOEFI*WORK( 3*N+JE )
CIM2B = BCOEFI*WORK( 2*N+JE ) + BCOEFR*WORK( 3*N+JE )
DO 270 JR = 1, JE - 2
- WORK( 2*N+JR ) = -CREALA*A( JR, JE-1 ) +
- $ CREALB*B( JR, JE-1 ) -
- $ CRE2A*A( JR, JE ) + CRE2B*B( JR, JE )
- WORK( 3*N+JR ) = -CIMAGA*A( JR, JE-1 ) +
- $ CIMAGB*B( JR, JE-1 ) -
- $ CIM2A*A( JR, JE ) + CIM2B*B( JR, JE )
+ WORK( 2*N+JR ) = -CREALA*S( JR, JE-1 ) +
+ $ CREALB*P( JR, JE-1 ) -
+ $ CRE2A*S( JR, JE ) + CRE2B*P( JR, JE )
+ WORK( 3*N+JR ) = -CIMAGA*S( JR, JE-1 ) +
+ $ CIMAGB*P( JR, JE-1 ) -
+ $ CIM2A*S( JR, JE ) + CIM2B*P( JR, JE )
270 CONTINUE
END IF
*
@@ -978,23 +980,23 @@
* next iteration to process it (when it will be j:j+1)
*
IF( .NOT.IL2BY2 .AND. J.GT.1 ) THEN
- IF( A( J, J-1 ).NE.ZERO ) THEN
+ IF( S( J, J-1 ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
GO TO 370
END IF
END IF
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( IL2BY2 ) THEN
NA = 2
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
ELSE
NA = 1
END IF
*
* Compute x(j) (and x(j+1), if 2-by-2 block)
*
- CALL SLALN2( .FALSE., NA, NW, DMIN, ACOEF, A( J, J ),
- $ LDA, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
+ CALL SLALN2( .FALSE., NA, NW, DMIN, ACOEF, S( J, J ),
+ $ LDS, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
$ N, BCOEFR, BCOEFI, SUM, 2, SCALE, TEMP,
$ IINFO )
IF( SCALE.LT.ONE ) THEN
@@ -1014,7 +1016,7 @@
300 CONTINUE
310 CONTINUE
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( J.GT.1 ) THEN
*
@@ -1052,19 +1054,19 @@
$ BCOEFR*WORK( 3*N+J+JA-1 )
DO 340 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
WORK( 3*N+JR ) = WORK( 3*N+JR ) -
- $ CIMAGA*A( JR, J+JA-1 ) +
- $ CIMAGB*B( JR, J+JA-1 )
+ $ CIMAGA*S( JR, J+JA-1 ) +
+ $ CIMAGB*P( JR, J+JA-1 )
340 CONTINUE
ELSE
CREALA = ACOEF*WORK( 2*N+J+JA-1 )
CREALB = BCOEFR*WORK( 2*N+J+JA-1 )
DO 350 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
350 CONTINUE
END IF
360 CONTINUE
diff -uNr LAPACK.orig/SRC/strevc.f LAPACK/SRC/strevc.f
--- LAPACK.orig/SRC/strevc.f Thu Nov 4 14:24:06 1999
+++ LAPACK/SRC/strevc.f Fri May 25 16:13:46 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -21,28 +21,23 @@
*
* STREVC computes some or all of the right and/or left eigenvectors of
* a real upper quasi-triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a real general matrix: A = Q*T*Q**T, as computed by SHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input orthogonal
-* matrix. If T was obtained from the real-Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
-*
-* T must be in Schur canonical form (as returned by SHSEQR), that is,
-* block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-* 2-by-2 diagonal block has its diagonal elements equal and its
-* off-diagonal elements of opposite sign. Corresponding to each 2-by-2
-* diagonal block is a complex conjugate pair of eigenvalues and
-* eigenvectors; only one eigenvector of the pair is computed, namely
-* the one corresponding to the eigenvalue with positive imaginary part.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal blocks of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the orthogonal factor that reduces a matrix
+* A to Schur form T, then Q*X and Q*Y are the matrices of right and
+* left eigenvectors of A.
*
* Arguments
* =========
@@ -55,21 +50,21 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input/output) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to a real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE.. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must be
-* set to .TRUE.; then on exit SELECT(j) is .TRUE. and
-* SELECT(j+1) is .FALSE..
+* If w(j) is a real eigenvalue, the corresponding real
+* eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector is
+* computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+* on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+* .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -86,15 +81,6 @@
* of Schur vectors returned by SHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL has the same quasi-lower triangular form
-* as T'. If T(i,i) is a real eigenvalue, then
-* the i-th column VL(i) of VL is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VL(i)+sqrt(-1)*VL(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -103,11 +89,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) REAL array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -115,15 +101,6 @@
* of Schur vectors returned by SHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR has the same quasi-upper triangular form
-* as T. If T(i,i) is a real eigenvalue, then
-* the i-th column VR(i) of VR is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VR(i)+sqrt(-1)*VR(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -132,11 +109,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/SRC/strsen.f LAPACK/SRC/strsen.f
--- LAPACK.orig/SRC/strsen.f Thu Nov 4 14:24:06 1999
+++ LAPACK/SRC/strsen.f Fri May 25 16:14:06 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, JOB
@@ -118,8 +118,8 @@
* LWORK (input) INTEGER
* The dimension of the array WORK.
* If JOB = 'N', LWORK >= max(1,N);
-* if JOB = 'E', LWORK >= M*(N-M);
-* if JOB = 'V' or 'B', LWORK >= 2*M*(N-M).
+* if JOB = 'E', LWORK >= max(1,M*(N-M));
+* if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
*
* If LWORK = -1, then a workspace query is assumed; the routine
* only calculates the optimal size of the WORK array, returns
@@ -127,12 +127,12 @@
* message related to LWORK is issued by XERBLA.
*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
-* IF JOB = 'N' or 'E', IWORK is not referenced.
+* On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*
* LIWORK (input) INTEGER
* The dimension of the array IWORK.
* If JOB = 'N' or 'E', LIWORK >= 1;
-* if JOB = 'V' or 'B', LIWORK >= M*(N-M).
+* if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
*
* If LIWORK = -1, then a workspace query is assumed; the
* routine only calculates the optimal size of the IWORK array,
diff -uNr LAPACK.orig/SRC/zbdsqr.f LAPACK/SRC/zbdsqr.f
--- LAPACK.orig/SRC/zbdsqr.f Thu Nov 4 14:25:42 1999
+++ LAPACK/SRC/zbdsqr.f Fri May 25 15:59:12 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -18,14 +18,26 @@
* Purpose
* =======
*
-* ZBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
-*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given complex input matrices U, VT, and C.
+* ZBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**H
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**H*VT instead of
+* P**H, for given complex input matrices U and VT. When U and VT are
+* the unitary matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by ZGEBRD, then
+*
+* A = (U*Q) * S * (P**H*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**H*C
+* for a given complex input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -61,18 +73,17 @@
* order.
*
* E (input/output) DOUBLE PRECISION array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) COMPLEX*16 array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**H * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -81,21 +92,22 @@
* U (input/output) COMPLEX*16 array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) COMPLEX*16 array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**H * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* RWORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+* RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/SRC/zgebd2.f LAPACK/SRC/zgebd2.f
--- LAPACK.orig/SRC/zgebd2.f Thu Nov 4 14:25:01 1999
+++ LAPACK/SRC/zgebd2.f Fri May 25 15:59:31 2001
@@ -3,7 +3,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* May 7, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
@@ -172,8 +172,9 @@
*
* Apply H(i)' to A(i:m,i+1:n) from the left
*
- CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
- $ DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
+ IF( I.LT.N )
+ $ CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
+ $ DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
A( I, I ) = D( I )
*
IF( I.LT.N ) THEN
@@ -215,8 +216,9 @@
*
* Apply G(i) to A(i+1:m,i:n) from the right
*
- CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAUP( I ),
- $ A( MIN( I+1, M ), I ), LDA, WORK )
+ IF( I.LT.M )
+ $ CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
+ $ TAUP( I ), A( MIN( I+1, M ), I ), LDA, WORK )
CALL ZLACGV( N-I+1, A( I, I ), LDA )
A( I, I ) = D( I )
*
diff -uNr LAPACK.orig/SRC/zgees.f LAPACK/SRC/zgees.f
--- LAPACK.orig/SRC/zgees.f Thu Nov 4 14:25:01 1999
+++ LAPACK/SRC/zgees.f Fri May 25 16:00:01 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SORT
@@ -89,10 +90,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (N)
*
@@ -120,11 +120,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTST, WANTVS
+ LOGICAL SCALEA, WANTST, WANTVS
INTEGER HSWORK, I, IBAL, ICOND, IERR, IEVAL, IHI, ILO,
$ ITAU, IWRK, K, MAXB, MAXWRK, MINWRK
DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
@@ -133,8 +135,8 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEQR,
- $ ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
+ EXTERNAL DLABAD, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD,
+ $ ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -150,7 +152,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVS = LSAME( JOBVS, 'V' )
WANTST = LSAME( SORT, 'S' )
IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
@@ -177,7 +178,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 2*N )
IF( .NOT.WANTVS ) THEN
@@ -196,19 +197,18 @@
MAXWRK = MAX( MAXWRK, HSWORK, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGEES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/zgeesx.f LAPACK/SRC/zgeesx.f
--- LAPACK.orig/SRC/zgeesx.f Thu Nov 4 14:25:01 1999
+++ LAPACK/SRC/zgeesx.f Fri May 25 16:00:23 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SENSE, SORT
@@ -119,6 +120,10 @@
* this routine. Note that 2*SDIM*(N-SDIM) <= N*N/2.
* For good performance, LWORK must generally be larger.
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* RWORK (workspace) DOUBLE PRECISION array, dimension (N)
*
* BWORK (workspace) LOGICAL array, dimension (N)
@@ -144,6 +149,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
@@ -158,8 +165,8 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD,
- $ ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
+ EXTERNAL DLABAD, DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL,
+ $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -211,7 +218,7 @@
* in the code.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
MINWRK = MAX( 1, 2*N )
IF( .NOT.WANTVS ) THEN
@@ -229,18 +236,25 @@
HSWORK = MAX( K*( K+2 ), 2*N )
MAXWRK = MAX( MAXWRK, HSWORK, 1 )
END IF
+*
+* Estimate the workspace needed by ZTRSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, ( N*N+1 ) / 2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -15
END IF
- IF( LWORK.LT.MINWRK ) THEN
- INFO = -15
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGEESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/zgeev.f LAPACK/SRC/zgeev.f
--- LAPACK.orig/SRC/zgeev.f Thu Nov 4 14:25:01 1999
+++ LAPACK/SRC/zgeev.f Fri May 25 16:00:53 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -85,10 +86,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
*
@@ -103,11 +103,13 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
+ LOGICAL SCALEA, WANTVL, WANTVR
CHARACTER SIDE
INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
$ IWRK, K, MAXB, MAXWRK, MINWRK, NOUT
@@ -119,8 +121,8 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEQR,
- $ ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR
+ EXTERNAL DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
+ $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -136,7 +138,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
@@ -165,7 +166,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 2*N )
@@ -185,19 +186,18 @@
MAXWRK = MAX( MAXWRK, HSWORK, 2*N )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGEEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/zgeevx.f LAPACK/SRC/zgeevx.f
--- LAPACK.orig/SRC/zgeevx.f Thu Nov 4 14:25:01 1999
+++ LAPACK/SRC/zgeevx.f Fri May 25 16:01:18 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -166,10 +167,9 @@
* LWORK >= N*N+2*N.
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
*
@@ -184,12 +184,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
- $ WNTSNN, WNTSNV
+ LOGICAL SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, WNTSNN,
+ $ WNTSNV
CHARACTER JOB, SIDE
INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXB,
$ MAXWRK, MINWRK, NOUT
@@ -201,9 +203,9 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
- $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZTRSNA,
- $ ZUNGHR
+ EXTERNAL DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL,
+ $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC,
+ $ ZTRSNA, ZUNGHR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -219,7 +221,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
WANTVL = LSAME( JOBVL, 'V' )
WANTVR = LSAME( JOBVR, 'V' )
WNTSNN = LSAME( SENSE, 'N' )
@@ -260,7 +261,7 @@
* the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = MAX( 1, 2*N )
@@ -294,19 +295,18 @@
MAXWRK = MAX( MAXWRK, 2*N, 1 )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -20
END IF
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -20
- END IF
+*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGEEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/zgegs.f LAPACK/SRC/zgegs.f
--- LAPACK.orig/SRC/zgegs.f Thu Nov 4 14:25:01 1999
+++ LAPACK/SRC/zgegs.f Fri May 25 16:02:04 2001
@@ -5,7 +5,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR
@@ -23,83 +23,71 @@
*
* This routine is deprecated and has been replaced by routine ZGGES.
*
-* ZGEGS computes for a pair of N-by-N complex nonsymmetric matrices A,
-* B: the generalized eigenvalues (alpha, beta), the complex Schur
-* form (A, B), and optionally left and/or right Schur vectors
-* (VSL and VSR).
-*
-* (If only the generalized eigenvalues are needed, use the driver ZGEGV
-* instead.)
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* The (generalized) Schur form of a pair of matrices is the result of
-* multiplying both matrices on the left by one unitary matrix and
-* both on the right by another unitary matrix, these two unitary
-* matrices being chosen so as to bring the pair of matrices into
-* upper triangular form with the diagonal elements of B being
-* non-negative real numbers (this is also called complex Schur form.)
-*
-* The left and right Schur vectors are the columns of VSL and VSR,
-* respectively, where VSL and VSR are the unitary matrices
-* which reduce A and B to Schur form:
-*
-* Schur form of (A,B) = ( (VSL)**H A (VSR), (VSL)**H B (VSR) )
+* ZGEGS computes the eigenvalues, Schur form, and, optionally, the
+* left and or/right Schur vectors of a complex matrix pair (A,B).
+* Given two square matrices A and B, the generalized Schur
+* factorization has the form
+*
+* A = Q*S*Z**H, B = Q*T*Z**H
+*
+* where Q and Z are unitary matrices and S and T are upper triangular.
+* The columns of Q are the left Schur vectors
+* and the columns of Z are the right Schur vectors.
+*
+* If only the eigenvalues of (A,B) are needed, the driver routine
+* ZGEGV should be used instead. See ZGEGV for a description of the
+* eigenvalues of the generalized nonsymmetric eigenvalue problem
+* (GNEP).
*
* Arguments
* =========
*
* JOBVSL (input) CHARACTER*1
* = 'N': do not compute the left Schur vectors;
-* = 'V': compute the left Schur vectors.
+* = 'V': compute the left Schur vectors (returned in VSL).
*
* JOBVSR (input) CHARACTER*1
* = 'N': do not compute the right Schur vectors;
-* = 'V': compute the right Schur vectors.
+* = 'V': compute the right Schur vectors (returned in VSR).
*
* N (input) INTEGER
* The order of the matrices A, B, VSL, and VSR. N >= 0.
*
* A (input/output) COMPLEX*16 array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose generalized
-* eigenvalues and (optionally) Schur vectors are to be
-* computed.
-* On exit, the generalized Schur form of A.
+* On entry, the matrix A.
+* On exit, the upper triangular matrix S from the generalized
+* Schur factorization.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) COMPLEX*16 array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) Schur vectors are
-* to be computed.
-* On exit, the generalized Schur form of B.
+* On entry, the matrix B.
+* On exit, the upper triangular matrix T from the generalized
+* Schur factorization.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHA (output) COMPLEX*16 array, dimension (N)
+* The complex scalars alpha that define the eigenvalues of
+* GNEP. ALPHA(j) = S(j,j), the diagonal element of the Schur
+* form of A.
+*
* BETA (output) COMPLEX*16 array, dimension (N)
-* On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
-* generalized eigenvalues. ALPHA(j), j=1,...,N and BETA(j),
-* j=1,...,N are the diagonals of the complex Schur form (A,B)
-* output by ZGEGS. The BETA(j) will be non-negative real.
-*
-* Note: the quotients ALPHA(j)/BETA(j) may easily over- or
-* underflow, and BETA(j) may even be zero. Thus, the user
-* should avoid naively computing the ratio alpha/beta.
-* However, ALPHA will be always less than and usually
-* comparable with norm(A) in magnitude, and BETA always less
-* than and usually comparable with norm(B).
+* The non-negative real scalars beta that define the
+* eigenvalues of GNEP. BETA(j) = T(j,j), the diagonal element
+* of the triangular factor T.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
+*
*
* VSL (output) COMPLEX*16 array, dimension (LDVSL,N)
-* If JOBVSL = 'V', VSL will contain the left Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSL = 'V', the matrix of left Schur vectors Q.
* Not referenced if JOBVSL = 'N'.
*
* LDVSL (input) INTEGER
@@ -107,8 +95,7 @@
* if JOBVSL = 'V', LDVSL >= N.
*
* VSR (output) COMPLEX*16 array, dimension (LDVSR,N)
-* If JOBVSR = 'V', VSR will contain the right Schur vectors.
-* (See "Purpose", above.)
+* If JOBVSR = 'V', the matrix of right Schur vectors Z.
* Not referenced if JOBVSR = 'N'.
*
* LDVSR (input) INTEGER
diff -uNr LAPACK.orig/SRC/zgegv.f LAPACK/SRC/zgegv.f
--- LAPACK.orig/SRC/zgegv.f Thu Nov 4 14:25:45 1999
+++ LAPACK/SRC/zgegv.f Fri May 25 16:02:27 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -22,22 +22,28 @@
*
* This routine is deprecated and has been replaced by routine ZGGEV.
*
-* ZGEGV computes for a pair of N-by-N complex nonsymmetric matrices A
-* and B, the generalized eigenvalues (alpha, beta), and optionally,
-* the left and/or right generalized eigenvectors (VL and VR).
-*
-* A generalized eigenvalue for a pair of matrices (A,B) is, roughly
-* speaking, a scalar w or a ratio alpha/beta = w, such that A - w*B
-* is singular. It is usually represented as the pair (alpha,beta),
-* as there is a reasonable interpretation for beta=0, and even for
-* both being zero. A good beginning reference is the book, "Matrix
-* Computations", by G. Golub & C. van Loan (Johns Hopkins U. Press)
-*
-* A right generalized eigenvector corresponding to a generalized
-* eigenvalue w for a pair of matrices (A,B) is a vector r such
-* that (A - w B) r = 0 . A left generalized eigenvector is a vector
-* l such that l**H * (A - w B) = 0, where l**H is the
-* conjugate-transpose of l.
+* ZGEGV computes the eigenvalues and, optionally, the left and/or right
+* eigenvectors of a complex matrix pair (A,B).
+* Given two square matrices A and B,
+* the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
+* eigenvalues lambda and corresponding (non-zero) eigenvectors x such
+* that
+* A*x = lambda*B*x.
+*
+* An alternate form is to find the eigenvalues mu and corresponding
+* eigenvectors y such that
+* mu*A*y = B*y.
+*
+* These two forms are equivalent with mu = 1/lambda and x = y if
+* neither lambda nor mu is zero. In order to deal with the case that
+* lambda or mu is zero or small, two values alpha and beta are returned
+* for each eigenvalue, such that lambda = alpha/beta and
+* mu = beta/alpha.
+*
+* The vectors x and y in the above equations are right eigenvectors of
+* the matrix pair (A,B). Vectors u and v satisfying
+* u**H*A = lambda*u**H*B or mu*v**H*A = v**H*B
+* are left eigenvectors of (A,B).
*
* Note: this routine performs "full balancing" on A and B -- see
* "Further Details", below.
@@ -47,56 +53,61 @@
*
* JOBVL (input) CHARACTER*1
* = 'N': do not compute the left generalized eigenvectors;
-* = 'V': compute the left generalized eigenvectors.
+* = 'V': compute the left generalized eigenvectors (returned
+* in VL).
*
* JOBVR (input) CHARACTER*1
* = 'N': do not compute the right generalized eigenvectors;
-* = 'V': compute the right generalized eigenvectors.
+* = 'V': compute the right generalized eigenvectors (returned
+* in VR).
*
* N (input) INTEGER
* The order of the matrices A, B, VL, and VR. N >= 0.
*
* A (input/output) COMPLEX*16 array, dimension (LDA, N)
-* On entry, the first of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of A on exit, see "Further
-* Details", below.)
+* On entry, the matrix A.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit A
+* contains the Schur form of A from the generalized Schur
+* factorization of the pair (A,B) after balancing. If no
+* eigenvectors were computed, then only the diagonal elements
+* of the Schur form will be correct. See ZGGHRD and ZHGEQZ
+* for details.
*
* LDA (input) INTEGER
* The leading dimension of A. LDA >= max(1,N).
*
* B (input/output) COMPLEX*16 array, dimension (LDB, N)
-* On entry, the second of the pair of matrices whose
-* generalized eigenvalues and (optionally) generalized
-* eigenvectors are to be computed.
-* On exit, the contents will have been destroyed. (For a
-* description of the contents of B on exit, see "Further
-* Details", below.)
+* On entry, the matrix B.
+* If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
+* upper triangular matrix obtained from B in the generalized
+* Schur factorization of the pair (A,B) after balancing.
+* If no eigenvectors were computed, then only the diagonal
+* elements of B will be correct. See ZGGHRD and ZHGEQZ for
+* details.
*
* LDB (input) INTEGER
* The leading dimension of B. LDB >= max(1,N).
*
* ALPHA (output) COMPLEX*16 array, dimension (N)
-* BETA (output) COMPLEX*16 array, dimension (N)
-* On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
-* generalized eigenvalues.
+* The complex scalars alpha that define the eigenvalues of
+* GNEP.
*
-* Note: the quotients ALPHA(j)/BETA(j) may easily over- or
-* underflow, and BETA(j) may even be zero. Thus, the user
-* should avoid naively computing the ratio alpha/beta.
-* However, ALPHA will be always less than and usually
-* comparable with norm(A) in magnitude, and BETA always less
-* than and usually comparable with norm(B).
+* BETA (output) COMPLEX*16 array, dimension (N)
+* The complex scalars beta that define the eigenvalues of GNEP.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
*
* VL (output) COMPLEX*16 array, dimension (LDVL,N)
-* If JOBVL = 'V', the left generalized eigenvectors. (See
-* "Purpose", above.)
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVL = 'V', the left eigenvectors u(j) are stored
+* in the columns of VL, in the same order as their eigenvalues.
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvectors
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVL = 'N'.
*
* LDVL (input) INTEGER
@@ -104,12 +115,12 @@
* if JOBVL = 'V', LDVL >= N.
*
* VR (output) COMPLEX*16 array, dimension (LDVR,N)
-* If JOBVR = 'V', the right generalized eigenvectors. (See
-* "Purpose", above.)
-* Each eigenvector will be scaled so the largest component
-* will have abs(real part) + abs(imag. part) = 1, *except*
-* that for eigenvalues with alpha=beta=0, a zero vector will
-* be returned as the corresponding eigenvector.
+* If JOBVR = 'V', the right eigenvectors x(j) are stored
+* in the columns of VR, in the same order as their eigenvalues.
+* Each eigenvector is scaled so that its largest component has
+* abs(real part) + abs(imag. part) = 1, except for eigenvectors
+* corresponding to an eigenvalue with alpha = beta = 0, which
+* are set to zero.
* Not referenced if JOBVR = 'N'.
*
* LDVR (input) INTEGER
@@ -123,8 +134,8 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
* To compute the optimal value of LWORK, call ILAENV to get
-* blocksizes (for ZGEQRF, ZUNMQR, and CUNGQR.) Then compute:
-* NB -- MAX of the blocksizes for ZGEQRF, ZUNMQR, and CUNGQR;
+* blocksizes (for ZGEQRF, ZUNMQR, and ZUNGQR.) Then compute:
+* NB -- MAX of the blocksizes for ZGEQRF, ZUNMQR, and ZUNGQR;
* The optimal LWORK is MAX( 2*N, N*(NB+1) ).
*
* If LWORK = -1, then a workspace query is assumed; the routine
diff -uNr LAPACK.orig/SRC/zgelsd.f LAPACK/SRC/zgelsd.f
--- LAPACK.orig/SRC/zgelsd.f Thu Nov 4 14:26:26 1999
+++ LAPACK/SRC/zgelsd.f Fri May 25 16:03:34 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -62,9 +63,10 @@
* The number of right hand sides, i.e., the number of columns
* of the matrices B and X. NRHS >= 0.
*
-* A (input) COMPLEX*16 array, dimension (LDA,N)
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
* On entry, the M-by-N matrix A.
-* On exit, A has been destroyed.
+* On exit, the first min(m,n) rows of A are overwritten with
+* its right singular vectors, stored rowwise.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
@@ -96,31 +98,24 @@
* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*
* LWORK (input) INTEGER
-* The dimension of the array WORK. LWORK must be at least 1.
+* The dimension of the array WORK. LWORK >= 1.
* The exact minimum amount of workspace needed depends on M,
-* N and NRHS. As long as LWORK is at least
-* 2 * N + N * NRHS
-* if M is greater than or equal to N or
-* 2 * M + M * NRHS
-* if M is less than N, the code will execute correctly.
+* N and NRHS.
+* If M >= N, LWORK >= 2*N + N*NRHS.
+* If M < N, LWORK >= 2*M + M*NRHS.
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
-*
-* RWORK (workspace) DOUBLE PRECISION array, dimension at least
-* 10*N + 2*N*SMLSIZ + 8*N*NLVL + 3*SMLSIZ*NRHS +
-* (SMLSIZ+1)**2
-* if M is greater than or equal to N or
-* 10*M + 2*M*SMLSIZ + 8*M*NLVL + 3*SMLSIZ*NRHS +
-* (SMLSIZ+1)**2
-* if M is less than N, the code will execute correctly.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
+* RWORK (workspace) DOUBLE PRECISION array, dimension (LRWORK)
+* If M >= N, LRWORK >= 8*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS.
+* If M < N, LRWORK >= 8*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS.
* SMLSIZ is returned by ILAENV and is equal to the maximum
* size of the subproblems at the bottom of the computation
* tree (usually about 25), and
-* NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+* NLVL = INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1
*
* IWORK (workspace) INTEGER array, dimension (LIWORK)
* LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
@@ -144,13 +139,14 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
COMPLEX*16 CZERO
PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY
INTEGER IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
$ LDWORK, MAXMN, MAXWRK, MINMN, MINWRK, MM,
$ MNTHR, NRWORK, NWORK, SMLSIZ
@@ -177,7 +173,6 @@
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
MNTHR = ILAENV( 6, 'ZGELSD', ' ', M, N, NRHS, -1 )
- LQUERY = ( LWORK.EQ.-1 )
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
@@ -261,20 +256,18 @@
END IF
MINWRK = MIN( MINWRK, MAXWRK )
WORK( 1 ) = DCMPLX( MAXWRK, 0 )
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -12
- END IF
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -12
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGELSD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- GO TO 10
END IF
-*
-* Quick return if possible.
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
diff -uNr LAPACK.orig/SRC/zgelss.f LAPACK/SRC/zgelss.f
--- LAPACK.orig/SRC/zgelss.f Thu Nov 4 14:25:02 1999
+++ LAPACK/SRC/zgelss.f Fri May 25 16:04:00 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -87,10 +87,9 @@
* LWORK >= 2*min(M,N) + max(M,N,NRHS)
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (5*min(M,N))
*
@@ -164,7 +163,7 @@
* immediately following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -232,22 +231,20 @@
MAXWRK = MAX( MAXWRK, N*NRHS )
END IF
END IF
- MINWRK = MAX( MINWRK, 1 )
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGELSS', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
-*
-* Quick return if possible
-*
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RANK = 0
RETURN
@@ -512,8 +509,8 @@
DO 40 I = 1, NRHS, CHUNK
BL = MIN( NRHS-I+1, CHUNK )
CALL ZGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, CZERO, WORK( IWORK ), N )
- CALL ZLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ $ B( 1, I ), LDB, CZERO, WORK( IWORK ), M )
+ CALL ZLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/SRC/zgesdd.f LAPACK/SRC/zgesdd.f
--- LAPACK.orig/SRC/zgesdd.f Thu Nov 11 20:33:19 1999
+++ LAPACK/SRC/zgesdd.f Fri May 25 16:08:08 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBZ
@@ -119,12 +120,14 @@
* if JOBZ = 'S' or 'A',
* LWORK >= min(M,N)*min(M,N)+2*min(M,N)+max(M,N).
* For good performance, LWORK should generally be larger.
-* If LWORK < 0 but other input arguments are legal, WORK(1)
-* returns the optimal LWORK.
+*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (LRWORK)
-* If JOBZ = 'N', LRWORK >= 7*min(M,N).
-* Otherwise, LRWORK >= 5*min(M,N)*min(M,N) + 5*min(M,N)
+* If JOBZ = 'N', LRWORK >= 5*min(M,N).
+* Otherwise, LRWORK >= 5*min(M,N)*min(M,N) + 7*min(M,N)
*
* IWORK (workspace) INTEGER array, dimension (8*min(M,N))
*
@@ -143,14 +146,16 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
COMPLEX*16 CZERO, CONE
- PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ),
- $ CONE = ( 1.0D0, 0.0D0 ) )
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
+ $ CONE = ( 1.0D+0, 0.0D+0 ) )
DOUBLE PRECISION ZERO, ONE
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
+ LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS
INTEGER BLK, CHUNK, I, IE, IERR, IL, IR, IRU, IRVT,
$ ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT,
$ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK,
@@ -162,15 +167,15 @@
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF, ZGEMM,
- $ ZGEQRF, ZLACP2, ZLACPY, ZLACRM, ZLARCM, ZLASCL,
+ EXTERNAL DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF, ZGEMM,
+ $ ZGEQRF, ZLACP2, ZLACPY, ZLACRM, ZLARCM, ZLASCL,
$ ZLASET, ZUNGBR, ZUNGLQ, ZUNGQR, ZUNMBR
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
DOUBLE PRECISION DLAMCH, ZLANGE
- EXTERNAL DLAMCH, ILAENV, LSAME, ZLANGE
+ EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE
* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, SQRT
@@ -190,7 +195,6 @@
WNTQN = LSAME( JOBZ, 'N' )
MINWRK = 1
MAXWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
*
IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN
INFO = -1
@@ -221,19 +225,21 @@
IF( M.GE.N ) THEN
*
* There is no complex work space needed for bidiagonal SVD
-* The real work space needed for bidiagonal SVD is BDSPAC,
-* BDSPAC = 3*N*N + 4*N
+* The real work space needed for bidiagonal SVD is BDSPAC
+* for computing singular values and singular vectors; BDSPAN
+* for computing singular values only.
+* BDSPAC = 5*N*N + 7*N
+* BDSPAN = MAX(7*N+4, 3*N+2+SMLSIZ*(SMLSIZ+8))
*
IF( M.GE.MNTHR1 ) THEN
IF( WNTQN ) THEN
*
* Path 1 (M much larger than N, JOBZ='N')
*
- WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1,
- $ -1 )
- WRKBL = MAX( WRKBL, 2*N+2*N*
- $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
- MAXWRK = WRKBL
+ MAXWRK = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1,
+ $ -1 )
+ MAXWRK = MAX( MAXWRK, 2*N+2*N*
+ $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
MINWRK = 3*N
ELSE IF( WNTQO ) THEN
*
@@ -335,8 +341,11 @@
ELSE
*
* There is no complex work space needed for bidiagonal SVD
-* The real work space needed for bidiagonal SVD is BDSPAC,
-* BDSPAC = 3*M*M + 4*M
+* The real work space needed for bidiagonal SVD is BDSPAC
+* for computing singular values and singular vectors; BDSPAN
+* for computing singular values only.
+* BDSPAC = 5*M*M + 7*M
+* BDSPAN = MAX(7*M+4, 3*M+2+SMLSIZ*(SMLSIZ+8))
*
IF( N.GE.MNTHR1 ) THEN
IF( WNTQN ) THEN
@@ -447,24 +456,22 @@
END IF
END IF
MAXWRK = MAX( MAXWRK, MINWRK )
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGESDD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
@@ -529,7 +536,7 @@
*
* Perform bidiagonal SVD, compute singular values only
* (CWorkspace: 0)
-* (RWorkspace: need BDSPAC)
+* (RWorkspace: need BDSPAN)
*
CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -844,7 +851,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1040,7 +1047,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1205,8 +1212,8 @@
ELSE
*
* A has more columns than rows. If A has sufficiently more
-* columns than rows, first reduce using the LQ decomposition
-* (if sufficient workspace available)
+* columns than rows, first reduce using the LQ decomposition (if
+* sufficient workspace available)
*
IF( N.GE.MNTHR1 ) THEN
*
@@ -1245,7 +1252,7 @@
*
* Perform bidiagonal SVD, compute singular values only
* (CWorkspace: 0)
-* (RWorkspace: need BDSPAC)
+* (RWorkspace: need BDSPAN)
*
CALL DBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1567,7 +1574,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1763,7 +1770,7 @@
*
* Compute singular values only
* (Cworkspace: 0)
-* (Rworkspace: need BDSPAC)
+* (Rworkspace: need BDSPAN)
*
CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1,
$ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
@@ -1934,9 +1941,15 @@
IF( ANRM.GT.BIGNUM )
$ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
+ $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1,
+ $ RWORK( IE ), MINMN, IERR )
IF( ANRM.LT.SMLNUM )
$ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
+ IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
+ $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1,
+ $ RWORK( IE ), MINMN, IERR )
END IF
*
* Return optimal workspace in WORK(1)
diff -uNr LAPACK.orig/SRC/zgesvd.f LAPACK/SRC/zgesvd.f
--- LAPACK.orig/SRC/zgesvd.f Thu Nov 4 14:25:03 1999
+++ LAPACK/SRC/zgesvd.f Fri May 25 16:08:34 2001
@@ -4,7 +4,8 @@
* -- LAPACK driver routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBU, JOBVT
@@ -114,12 +115,12 @@
* LWORK >= 2*MIN(M,N)+MAX(M,N).
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
-* RWORK (workspace) DOUBLE PRECISION array, dimension (5*min(M,N))
+* RWORK (workspace) DOUBLE PRECISION array, dimension
+* (5*min(M,N))
* On exit, if INFO > 0, RWORK(1:MIN(M,N)-1) contains the
* unconverged superdiagonal elements of an upper bidiagonal
* matrix B whose diagonal is in S (not necessarily sorted).
@@ -137,6 +138,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
COMPLEX*16 CZERO, CONE
PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ),
$ CONE = ( 1.0D0, 0.0D0 ) )
@@ -144,8 +147,8 @@
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
- $ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
+ LOGICAL WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS, WNTVA,
+ $ WNTVAS, WNTVN, WNTVO, WNTVS
INTEGER BLK, CHUNK, I, IE, IERR, IR, IRWORK, ISCL,
$ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
$ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
@@ -188,7 +191,7 @@
WNTVO = LSAME( JOBVT, 'O' )
WNTVN = LSAME( JOBVT, 'N' )
MINWRK = 1
- LQUERY = ( LWORK.EQ.-1 )
+ MAXWRK = 1
*
IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
INFO = -1
@@ -216,8 +219,7 @@
* real workspace. NB refers to the optimal block size for the
* immediately following subroutine, as returned by ILAENV.)
*
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
- $ N.GT.0 ) THEN
+ IF( INFO.EQ.0 .AND. M.GT.0 .AND. N.GT.0 ) THEN
IF( M.GE.N ) THEN
*
* Space needed for ZBDSQR is BDSPAC = 5*N
@@ -543,24 +545,22 @@
MAXWRK = MAX( MINWRK, MAXWRK )
END IF
END IF
+ END IF
+ IF( INFO.EQ.0 ) THEN
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -13
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -13
- END IF
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGESVD', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
- IF( LWORK.GE.1 )
- $ WORK( 1 ) = ONE
RETURN
END IF
*
diff -uNr LAPACK.orig/SRC/zggbak.f LAPACK/SRC/zggbak.f
--- LAPACK.orig/SRC/zggbak.f Thu Nov 4 14:25:03 1999
+++ LAPACK/SRC/zggbak.f Fri May 25 16:09:06 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* February 1, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB, SIDE
@@ -109,10 +109,15 @@
INFO = -3
ELSE IF( ILO.LT.1 ) THEN
INFO = -4
- ELSE IF( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) THEN
+ ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
+ INFO = -4
+ ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
+ $ THEN
+ INFO = -5
+ ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
INFO = -5
ELSE IF( M.LT.0 ) THEN
- INFO = -6
+ INFO = -8
ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
INFO = -10
END IF
diff -uNr LAPACK.orig/SRC/zggbal.f LAPACK/SRC/zggbal.f
--- LAPACK.orig/SRC/zggbal.f Thu Nov 4 14:25:45 1999
+++ LAPACK/SRC/zggbal.f Fri May 25 16:09:27 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 12, 2001
*
* .. Scalar Arguments ..
CHARACTER JOB
@@ -150,7 +150,7 @@
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
- INFO = -5
+ INFO = -6
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGGBAL', -INFO )
@@ -197,8 +197,8 @@
IF( L.NE.1 )
$ GO TO 30
*
- RSCALE( 1 ) = 1
- LSCALE( 1 ) = 1
+ RSCALE( 1 ) = ONE
+ LSCALE( 1 ) = ONE
GO TO 190
*
30 CONTINUE
@@ -256,7 +256,7 @@
* Permute rows M and I
*
160 CONTINUE
- LSCALE( M ) = I
+ LSCALE( M ) = DBLE( I )
IF( I.EQ.M )
$ GO TO 170
CALL ZSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
@@ -265,7 +265,7 @@
* Permute columns M and J
*
170 CONTINUE
- RSCALE( M ) = J
+ RSCALE( M ) = DBLE( J )
IF( J.EQ.M )
$ GO TO 180
CALL ZSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
@@ -437,7 +437,7 @@
DO 360 I = ILO, IHI
IRAB = IZAMAX( N-ILO+1, A( I, ILO ), LDA )
RAB = ABS( A( I, IRAB+ILO-1 ) )
- IRAB = IZAMAX( N-ILO+1, B( I, ILO ), LDA )
+ IRAB = IZAMAX( N-ILO+1, B( I, ILO ), LDB )
RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
diff -uNr LAPACK.orig/SRC/zgges.f LAPACK/SRC/zgges.f
--- LAPACK.orig/SRC/zgges.f Thu Nov 4 14:26:21 1999
+++ LAPACK/SRC/zgges.f Fri May 25 16:09:47 2001
@@ -6,6 +6,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SORT
@@ -145,10 +146,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (8*N)
*
@@ -173,6 +173,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
COMPLEX*16 CZERO, CONE
@@ -181,7 +183,7 @@
* ..
* .. Local Scalars ..
LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
- $ LQUERY, WANTST
+ $ WANTST
INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
$ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKMIN,
$ LWKOPT
@@ -193,8 +195,9 @@
DOUBLE PRECISION DIF( 2 )
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ,
- $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR
+ EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
+ $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR,
+ $ ZUNMQR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -236,7 +239,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -263,7 +265,7 @@
* following subroutine, as returned by ILAENV.)
*
LWKMIN = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
LWKMIN = MAX( 1, 2*N )
LWKOPT = N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 )
IF( ILVSL ) THEN
@@ -271,21 +273,18 @@
$ -1 ) )
END IF
WORK( 1 ) = LWKOPT
+ IF( LWORK.LT.LWKMIN .AND. LWORK.NE.LQUERV )
+ $ INFO = -18
END IF
*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
- $ INFO = -18
+* Quick return if possible
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGGES ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
- WORK( 1 ) = LWKOPT
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/zggesx.f LAPACK/SRC/zggesx.f
--- LAPACK.orig/SRC/zggesx.f Thu Nov 4 14:26:21 1999
+++ LAPACK/SRC/zggesx.f Fri May 25 16:10:05 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Do WS calculations if LWORK = -1 (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
@@ -167,6 +168,10 @@
* If SENSE = 'E', 'V', or 'B',
* LWORK >= MAX(2*N, 2*SDIM*(N-SDIM)).
*
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
+*
* RWORK (workspace) DOUBLE PRECISION array, dimension ( 8*N )
* Real workspace.
*
@@ -198,6 +203,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
COMPLEX*16 CZERO, CONE
@@ -217,8 +224,9 @@
DOUBLE PRECISION DIF( 2 )
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ,
- $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR
+ EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
+ $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR,
+ $ ZUNMQR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -303,14 +311,22 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+ IF( INFO.EQ.0 ) THEN
MINWRK = MAX( 1, 2*N )
MAXWRK = N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 )
IF( ILVSL ) THEN
MAXWRK = MAX( MAXWRK, N+N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N,
$ -1 ) )
END IF
+*
+* Estimate the workspace needed by ZTGSEN.
+*
+ IF( WANTST ) THEN
+ MAXWRK = MAX( MAXWRK, ( N*N+1 ) / 2 )
+ END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -21
END IF
IF( .NOT.WANTSN ) THEN
LIWMIN = N + 2
@@ -318,21 +334,19 @@
LIWMIN = 1
END IF
IWORK( 1 ) = LIWMIN
-*
- IF( INFO.EQ.0 .AND. LWORK.LT.MINWRK ) THEN
- INFO = -21
- ELSE IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
+ IF( INFO.EQ.0 .AND. IJOB.GE.1 ) THEN
IF( LIWORK.LT.LIWMIN )
$ INFO = -24
END IF
*
+* Quick returns
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGGESX', -INFO )
RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 ) THEN
SDIM = 0
RETURN
diff -uNr LAPACK.orig/SRC/zggev.f LAPACK/SRC/zggev.f
--- LAPACK.orig/SRC/zggev.f Thu Nov 4 14:26:21 1999
+++ LAPACK/SRC/zggev.f Fri May 25 16:10:25 2001
@@ -5,6 +5,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER JOBVL, JOBVR
@@ -113,10 +114,9 @@
* The dimension of the array WORK. LWORK >= max(1,2*N).
* For good performance, LWORK must generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace/output) DOUBLE PRECISION array, dimension (8*N)
*
@@ -133,6 +133,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
COMPLEX*16 CZERO, CONE
@@ -140,7 +142,7 @@
$ CONE = ( 1.0D0, 0.0D0 ) )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR
CHARACTER CHTEMP
INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
$ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
@@ -153,8 +155,9 @@
LOGICAL LDUMMA( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ,
- $ ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR
+ EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
+ $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
+ $ ZUNMQR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -201,7 +204,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( IJOBVL.LE.0 ) THEN
INFO = -1
ELSE IF( IJOBVR.LE.0 ) THEN
@@ -227,25 +229,22 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
LWKMIN = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
LWKOPT = N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 )
LWKMIN = MAX( 1, 2*N )
WORK( 1 ) = LWKOPT
+ IF( LWORK.LT.LWKMIN .AND. LWORK.NE.LQUERV )
+ $ INFO = -15
END IF
*
- IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
- $ INFO = -15
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGGEV ', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
- WORK( 1 ) = LWKOPT
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/zggevx.f LAPACK/SRC/zggevx.f
--- LAPACK.orig/SRC/zggevx.f Thu Nov 4 14:26:21 1999
+++ LAPACK/SRC/zggevx.f Fri May 25 16:11:40 2001
@@ -7,6 +7,7 @@
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
+* 8-15-00: Improve consistency of WS calculations (eca)
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -194,10 +195,9 @@
* If SENSE = 'N' or 'E', LWORK >= 2*N.
* If SENSE = 'V' or 'B', LWORK >= 2*N*N+2*N.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (6*N)
* Real workspace.
@@ -247,6 +247,8 @@
* =====================================================================
*
* .. Parameters ..
+ INTEGER LQUERV
+ PARAMETER ( LQUERV = -1 )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
COMPLEX*16 CZERO, CONE
@@ -254,8 +256,8 @@
$ CONE = ( 1.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
- LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY,
- $ WANTSB, WANTSE, WANTSN, WANTSV
+ LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, WANTSB,
+ $ WANTSE, WANTSN, WANTSV
CHARACTER CHTEMP
INTEGER I, ICOLS, IERR, IJOBVL, IJOBVR, IN, IROWS,
$ ITAU, IWRK, IWRK1, J, JC, JR, M, MAXWRK, MINWRK
@@ -267,9 +269,9 @@
LOGICAL LDUMMA( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL DLASCL, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
- $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZTGSNA,
- $ ZUNGQR, ZUNMQR
+ EXTERNAL DLABAD, DLASCL, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL,
+ $ ZGGHRD, ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC,
+ $ ZTGSNA, ZUNGQR, ZUNMQR
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -321,7 +323,6 @@
* Test the input arguments
*
INFO = 0
- LQUERY = ( LWORK.EQ.-1 )
IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC,
$ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
$ THEN
@@ -354,7 +355,7 @@
* computed assuming ILO = 1 and IHI = N, the worst case.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 )
IF( WANTSE ) THEN
MINWRK = MAX( 1, 2*N )
@@ -363,21 +364,18 @@
MAXWRK = MAX( MAXWRK, 2*N*N+2*N )
END IF
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV )
+ $ INFO = -25
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
- INFO = -25
- END IF
+* Quick returns
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGGEVX', -INFO )
RETURN
- ELSE IF( LQUERY ) THEN
- RETURN
END IF
-*
-* Quick return if possible
-*
+ IF( LWORK.EQ.LQUERV )
+ $ RETURN
IF( N.EQ.0 )
$ RETURN
*
diff -uNr LAPACK.orig/SRC/zgghrd.f LAPACK/SRC/zgghrd.f
--- LAPACK.orig/SRC/zgghrd.f Thu Nov 4 14:25:45 1999
+++ LAPACK/SRC/zgghrd.f Fri May 25 16:11:59 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -20,16 +20,29 @@
*
* ZGGHRD reduces a pair of complex matrices (A,B) to generalized upper
* Hessenberg form using unitary transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are unitary, and ' means conjugate transpose.
+* general matrix and B is upper triangular. The form of the
+* generalized eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the unitary matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**H*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**H*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**H*x.
*
* The unitary matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
* postmultiplied into input matrices Q1 and Z1, so that
-*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**H = (Q1*Q) * H * (Z1*Z)**H
+* Q1 * B * Z1**H = (Q1*Q) * T * (Z1*Z)**H
+* If Q1 is the unitary matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then ZGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -53,10 +66,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to ZGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to ZGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) COMPLEX*16 array, dimension (LDA, N)
@@ -70,33 +84,28 @@
*
* B (input/output) COMPLEX*16 array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**H B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) COMPLEX*16 array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the unitary matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain a unitary matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the unitary matrix Q1, typically
+* from the QR factorization of B.
+* On exit, if COMPQ='I', the unitary matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) COMPLEX*16 array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the unitary matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain a unitary matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the unitary matrix Z1.
+* On exit, if COMPZ='I', the unitary matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/SRC/zhbgst.f LAPACK/SRC/zhbgst.f
--- LAPACK.orig/SRC/zhbgst.f Thu Nov 4 14:23:32 1999
+++ LAPACK/SRC/zhbgst.f Fri May 25 16:13:00 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 9, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO, VECT
@@ -131,7 +131,7 @@
INFO = -3
ELSE IF( KA.LT.0 ) THEN
INFO = -4
- ELSE IF( KB.LT.0 ) THEN
+ ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
INFO = -5
ELSE IF( LDAB.LT.KA+1 ) THEN
INFO = -7
diff -uNr LAPACK.orig/SRC/zhgeqz.f LAPACK/SRC/zhgeqz.f
--- LAPACK.orig/SRC/zhgeqz.f Thu Nov 4 14:25:05 1999
+++ LAPACK/SRC/zhgeqz.f Fri May 25 16:12:21 2001
@@ -1,43 +1,64 @@
- SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,
$ RWORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
DOUBLE PRECISION RWORK( * )
- COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), WORK( * ), Z( LDZ, * )
+ COMPLEX*16 ALPHA( * ), BETA( * ), H( LDH, * ),
+ $ Q( LDQ, * ), T( LDT, * ), WORK( * ),
+ $ Z( LDZ, * )
* ..
*
* Purpose
* =======
*
-* ZHGEQZ implements a single-shift version of the QZ
-* method for finding the generalized eigenvalues w(i)=ALPHA(i)/BETA(i)
-* of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* If JOB='S', then the pair (A,B) is simultaneously
-* reduced to Schur form (i.e., A and B are both upper triangular) by
-* applying one unitary tranformation (usually called Q) on the left and
-* another (usually called Z) on the right. The diagonal elements of
-* A are then ALPHA(1),...,ALPHA(N), and of B are BETA(1),...,BETA(N).
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the unitary
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* ZHGEQZ computes the eigenvalues of a complex matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the single-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a complex matrix pair (A,B):
+*
+* A = Q1*H*Z1**H, B = Q1*T*Z1**H,
+*
+* as computed by ZGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**H, T = Q*P*Z**H,
+*
+* where Q and Z are unitary matrices and S and P are upper triangular.
+*
+* Optionally, the unitary matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* unitary matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the unitary matrices from ZGGHRD that reduced
+* the matrix pair (A,B) to generalized Hessenberg form, then the output
+* matrices Q1*Q and Z1*Z are the unitary factors from the generalized
+* Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**H, B = (Q1*Q)*P*(Z1*Z)**H.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T)
+* (equivalently, of (A,B)) are computed as a pair of complex values
+* (alpha,beta). If beta is nonzero, lambda = alpha / beta is an
+* eigenvalue of the generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* The values of alpha and beta for the i-th eigenvalue can be read
+* directly from the generalized Schur form: alpha = S(i,i),
+* beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -47,83 +68,88 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHA and BETA. A and B will not
-* necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHA and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Computer eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the conjugate
-* transpose of the unitary tranformation that is
-* applied to the left side of A and B to reduce them
-* to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain a unitary matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the unitary
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain a unitary matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) COMPLEX*16 array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit A will have been destroyed.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) COMPLEX*16 array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit B will have been destroyed.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) COMPLEX*16 array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper triangular
+* matrix S from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of H matches that of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) COMPLEX*16 array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of T matches that of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHA (output) COMPLEX*16 array, dimension (N)
-* The diagonal elements of A when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues.
+* The complex scalars alpha that define the eigenvalues of
+* GNEP. ALPHA(i) = S(i,i) in the generalized Schur
+* factorization.
*
* BETA (output) COMPLEX*16 array, dimension (N)
-* The diagonal elements of B when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues. A and B are normalized
-* so that BETA(1),...,BETA(N) are non-negative real numbers.
+* The real non-negative scalars beta that define the
+* eigenvalues of GNEP. BETA(i) = P(i,i) in the generalized
+* Schur factorization.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
*
* Q (input/output) COMPLEX*16 array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the conjugate transpose of the
-* unitary transformations which are applied to A and B on
-* the left will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Q1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) COMPLEX*16 array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the unitary transformations which
-* are applied to A and B on the right will be applied to the
-* array Z on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Z1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of right Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -145,13 +171,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -178,7 +203,7 @@
DOUBLE PRECISION ABSB, ANORM, ASCALE, ATOL, BNORM, BSCALE, BTOL,
$ C, SAFMIN, TEMP, TEMP2, TEMPR, ULP
COMPLEX*16 ABI22, AD11, AD12, AD21, AD22, CTEMP, CTEMP2,
- $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T,
+ $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T1,
$ U12, X
* ..
* .. External Functions ..
@@ -256,9 +281,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -14
@@ -294,8 +319,8 @@
IN = IHI + 1 - ILO
SAFMIN = DLAMCH( 'S' )
ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
- ANORM = ZLANHS( 'F', IN, A( ILO, ILO ), LDA, RWORK )
- BNORM = ZLANHS( 'F', IN, B( ILO, ILO ), LDB, RWORK )
+ ANORM = ZLANHS( 'F', IN, H( ILO, ILO ), LDH, RWORK )
+ BNORM = ZLANHS( 'F', IN, T( ILO, ILO ), LDT, RWORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -305,23 +330,23 @@
* Set Eigenvalues IHI+1:N
*
DO 10 J = IHI + 1, N
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = DCONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = DCONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL ZSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL ZSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL ZSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL ZSCAL( J, SIGNBC, H( 1, J ), 1 )
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL ZSCAL( N, SIGNBC, Z( 1, J ), 1 )
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
10 CONTINUE
*
* If IHI < ILO, skip QZ steps
@@ -366,22 +391,22 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
* Special case: j=ILAST
*
IF( ILAST.EQ.ILO ) THEN
GO TO 60
ELSE
- IF( ABS1( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = CZERO
+ IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = CZERO
GO TO 60
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = CZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = CZERO
GO TO 50
END IF
*
@@ -389,30 +414,30 @@
*
DO 40 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS1( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = CZERO
+ IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = CZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = CZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = CZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- IF( ABS1( A( J, J-1 ) )*( ASCALE*ABS1( A( J+1,
- $ J ) ) ).LE.ABS1( A( J, J ) )*( ASCALE*ATOL ) )
+ IF( ABS1( H( J, J-1 ) )*( ASCALE*ABS1( H( J+1,
+ $ J ) ) ).LE.ABS1( H( J, J ) )*( ASCALE*ATOL ) )
$ ILAZR2 = .TRUE.
END IF
*
@@ -424,21 +449,21 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 20 JCH = J, ILAST - 1
- CTEMP = A( JCH, JCH )
- CALL ZLARTG( CTEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = CZERO
- CALL ZROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL ZROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ CTEMP = H( JCH, JCH )
+ CALL ZLARTG( CTEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = CZERO
+ CALL ZROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL ZROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, DCONJG( S ) )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
- IF( ABS1( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS1( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 60
ELSE
@@ -446,35 +471,35 @@
GO TO 70
END IF
END IF
- B( JCH+1, JCH+1 ) = CZERO
+ T( JCH+1, JCH+1 ) = CZERO
20 CONTINUE
GO TO 50
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 30 JCH = J, ILAST - 1
- CTEMP = B( JCH, JCH+1 )
- CALL ZLARTG( CTEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = CZERO
+ CTEMP = T( JCH, JCH+1 )
+ CALL ZLARTG( CTEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = CZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL ZROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL ZROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL ZROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL ZROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, DCONJG( S ) )
- CTEMP = A( JCH+1, JCH )
- CALL ZLARTG( CTEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = CZERO
- CALL ZROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL ZROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ CTEMP = H( JCH+1, JCH )
+ CALL ZLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = CZERO
+ CALL ZROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL ZROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL ZROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -498,42 +523,42 @@
INFO = 2*N + 1
GO TO 210
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
50 CONTINUE
- CTEMP = A( ILAST, ILAST )
- CALL ZLARTG( CTEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = CZERO
- CALL ZROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL ZROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ CTEMP = H( ILAST, ILAST )
+ CALL ZLARTG( CTEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = CZERO
+ CALL ZROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL ZROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL ZROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
*
60 CONTINUE
- ABSB = ABS( B( ILAST, ILAST ) )
+ ABSB = ABS( T( ILAST, ILAST ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = DCONJG( B( ILAST, ILAST ) / ABSB )
- B( ILAST, ILAST ) = ABSB
+ SIGNBC = DCONJG( T( ILAST, ILAST ) / ABSB )
+ T( ILAST, ILAST ) = ABSB
IF( ILSCHR ) THEN
- CALL ZSCAL( ILAST-IFRSTM, SIGNBC, B( IFRSTM, ILAST ), 1 )
- CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, A( IFRSTM, ILAST ),
+ CALL ZSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 )
+ CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ),
$ 1 )
ELSE
- A( ILAST, ILAST ) = A( ILAST, ILAST )*SIGNBC
+ H( ILAST, ILAST ) = H( ILAST, ILAST )*SIGNBC
END IF
IF( ILZ )
$ CALL ZSCAL( N, SIGNBC, Z( 1, ILAST ), 1 )
ELSE
- B( ILAST, ILAST ) = CZERO
+ T( ILAST, ILAST ) = CZERO
END IF
- ALPHA( ILAST ) = A( ILAST, ILAST )
- BETA( ILAST ) = B( ILAST, ILAST )
+ ALPHA( ILAST ) = H( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -566,7 +591,7 @@
* Compute the Shift.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.NE.IITER ) THEN
@@ -578,33 +603,33 @@
* We factor B as U*D, where U has unit diagonals, and
* compute (A*inv(D))*inv(U).
*
- U12 = ( BSCALE*B( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
+ U12 = ( BSCALE*T( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
ABI22 = AD22 - U12*AD21
*
- T = HALF*( AD11+ABI22 )
- RTDISC = SQRT( T**2+AD12*AD21-AD11*AD22 )
- TEMP = DBLE( T-ABI22 )*DBLE( RTDISC ) +
- $ DIMAG( T-ABI22 )*DIMAG( RTDISC )
+ T1 = HALF*( AD11+ABI22 )
+ RTDISC = SQRT( T1**2+AD12*AD21-AD11*AD22 )
+ TEMP = DBLE( T1-ABI22 )*DBLE( RTDISC ) +
+ $ DIMAG( T1-ABI22 )*DIMAG( RTDISC )
IF( TEMP.LE.ZERO ) THEN
- SHIFT = T + RTDISC
+ SHIFT = T1 + RTDISC
ELSE
- SHIFT = T - RTDISC
+ SHIFT = T1 - RTDISC
END IF
ELSE
*
* Exceptional shift. Chosen for no particularly good reason.
*
- ESHIFT = ESHIFT + DCONJG( ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) ) )
+ ESHIFT = ESHIFT + DCONJG( ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) ) )
SHIFT = ESHIFT
END IF
*
@@ -612,46 +637,46 @@
*
DO 80 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- CTEMP = ASCALE*A( J, J ) - SHIFT*( BSCALE*B( J, J ) )
+ CTEMP = ASCALE*H( J, J ) - SHIFT*( BSCALE*T( J, J ) )
TEMP = ABS1( CTEMP )
- TEMP2 = ASCALE*ABS1( A( J+1, J ) )
+ TEMP2 = ASCALE*ABS1( H( J+1, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS1( A( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
+ IF( ABS1( H( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
$ GO TO 90
80 CONTINUE
*
ISTART = IFIRST
- CTEMP = ASCALE*A( IFIRST, IFIRST ) -
- $ SHIFT*( BSCALE*B( IFIRST, IFIRST ) )
+ CTEMP = ASCALE*H( IFIRST, IFIRST ) -
+ $ SHIFT*( BSCALE*T( IFIRST, IFIRST ) )
90 CONTINUE
*
* Do an implicit-shift QZ sweep.
*
* Initial Q
*
- CTEMP2 = ASCALE*A( ISTART+1, ISTART )
+ CTEMP2 = ASCALE*H( ISTART+1, ISTART )
CALL ZLARTG( CTEMP, CTEMP2, C, S, CTEMP3 )
*
* Sweep
*
DO 150 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- CTEMP = A( J, J-1 )
- CALL ZLARTG( CTEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = CZERO
+ CTEMP = H( J, J-1 )
+ CALL ZLARTG( CTEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = CZERO
END IF
*
DO 100 JC = J, ILASTM
- CTEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -DCONJG( S )*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = CTEMP
- CTEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -DCONJG( S )*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = CTEMP2
+ CTEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -DCONJG( S )*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = CTEMP
+ CTEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -DCONJG( S )*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = CTEMP2
100 CONTINUE
IF( ILQ ) THEN
DO 110 JR = 1, N
@@ -661,19 +686,19 @@
110 CONTINUE
END IF
*
- CTEMP = B( J+1, J+1 )
- CALL ZLARTG( CTEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = CZERO
+ CTEMP = T( J+1, J+1 )
+ CALL ZLARTG( CTEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = CZERO
*
DO 120 JR = IFRSTM, MIN( J+2, ILAST )
- CTEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -DCONJG( S )*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = CTEMP
+ CTEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -DCONJG( S )*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = CTEMP
120 CONTINUE
DO 130 JR = IFRSTM, J
- CTEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -DCONJG( S )*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = CTEMP
+ CTEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -DCONJG( S )*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = CTEMP
130 CONTINUE
IF( ILZ ) THEN
DO 140 JR = 1, N
@@ -701,23 +726,23 @@
* Set Eigenvalues 1:ILO-1
*
DO 200 J = 1, ILO - 1
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = DCONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = DCONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL ZSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL ZSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL ZSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL ZSCAL( J, SIGNBC, H( 1, J ), 1 )
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL ZSCAL( N, SIGNBC, Z( 1, J ), 1 )
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
200 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/SRC/zlasr.f LAPACK/SRC/zlasr.f
--- LAPACK.orig/SRC/zlasr.f Thu Nov 4 14:25:06 1999
+++ LAPACK/SRC/zlasr.f Fri May 25 16:12:41 2001
@@ -3,7 +3,7 @@
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1992
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER DIRECT, PIVOT, SIDE
@@ -17,42 +17,77 @@
* Purpose
* =======
*
-* ZLASR performs the transformation
+* ZLASR applies a sequence of real plane rotations to a complex matrix
+* A, from either the left or the right.
*
-* A := P*A, when SIDE = 'L' or 'l' ( Left-hand side )
+* When SIDE = 'L', the transformation takes the form
*
-* A := A*P', when SIDE = 'R' or 'r' ( Right-hand side )
+* A := P*A
*
-* where A is an m by n complex matrix and P is an orthogonal matrix,
-* consisting of a sequence of plane rotations determined by the
-* parameters PIVOT and DIRECT as follows ( z = m when SIDE = 'L' or 'l'
-* and z = n when SIDE = 'R' or 'r' ):
+* and when SIDE = 'R', the transformation takes the form
*
-* When DIRECT = 'F' or 'f' ( Forward sequence ) then
-*
-* P = P( z - 1 )*...*P( 2 )*P( 1 ),
-*
-* and when DIRECT = 'B' or 'b' ( Backward sequence ) then
-*
-* P = P( 1 )*P( 2 )*...*P( z - 1 ),
-*
-* where P( k ) is a plane rotation matrix for the following planes:
-*
-* when PIVOT = 'V' or 'v' ( Variable pivot ),
-* the plane ( k, k + 1 )
-*
-* when PIVOT = 'T' or 't' ( Top pivot ),
-* the plane ( 1, k + 1 )
-*
-* when PIVOT = 'B' or 'b' ( Bottom pivot ),
-* the plane ( k, z )
-*
-* c( k ) and s( k ) must contain the cosine and sine that define the
-* matrix P( k ). The two by two plane rotation part of the matrix
-* P( k ), R( k ), is assumed to be of the form
-*
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
+* A := A*P**T
+*
+* where P is an orthogonal matrix consisting of a sequence of z plane
+* rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
+* and P**T is the transpose of P.
+*
+* When DIRECT = 'F' (Forward sequence), then
+*
+* P = P(z-1) * ... * P(2) * P(1)
+*
+* and when DIRECT = 'B' (Backward sequence), then
+*
+* P = P(1) * P(2) * ... * P(z-1)
+*
+* where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
+*
+* R(k) = ( c(k) s(k) )
+* = ( -s(k) c(k) ).
+*
+* When PIVOT = 'V' (Variable pivot), the rotation is performed
+* for the plane (k,k+1), i.e., P(k) has the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears as a rank-2 modification to the identity matrix in
+* rows and columns k and k+1.
+*
+* When PIVOT = 'T' (Top pivot), the rotation is performed for the
+* plane (1,k+1), so P(k) has the form
+*
+* P(k) = ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+*
+* where R(k) appears in rows and columns 1 and k+1.
+*
+* Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
+* performed for the plane (k,z), giving P(k) the form
+*
+* P(k) = ( 1 )
+* ( ... )
+* ( 1 )
+* ( c(k) s(k) )
+* ( 1 )
+* ( ... )
+* ( 1 )
+* ( -s(k) c(k) )
+*
+* where R(k) appears in rows and columns k and z. The rotations are
+* performed without ever forming P(k) explicitly.
*
* Arguments
* =========
@@ -61,13 +96,13 @@
* Specifies whether the plane rotation matrix P is applied to
* A on the left or the right.
* = 'L': Left, compute A := P*A
-* = 'R': Right, compute A:= A*P'
+* = 'R': Right, compute A:= A*P**T
*
* DIRECT (input) CHARACTER*1
* Specifies whether P is a forward or backward sequence of
* plane rotations.
-* = 'F': Forward, P = P( z - 1 )*...*P( 2 )*P( 1 )
-* = 'B': Backward, P = P( 1 )*P( 2 )*...*P( z - 1 )
+* = 'F': Forward, P = P(z-1)*...*P(2)*P(1)
+* = 'B': Backward, P = P(1)*P(2)*...*P(z-1)
*
* PIVOT (input) CHARACTER*1
* Specifies the plane for which P(k) is a plane rotation
@@ -84,18 +119,22 @@
* The number of columns of the matrix A. If n <= 1, an
* immediate return is effected.
*
-* C, S (input) DOUBLE PRECISION arrays, dimension
+* C (input) DOUBLE PRECISION array, dimension
+* (M-1) if SIDE = 'L'
+* (N-1) if SIDE = 'R'
+* The cosines c(k) of the plane rotations.
+*
+* S (input) DOUBLE PRECISION array, dimension
* (M-1) if SIDE = 'L'
* (N-1) if SIDE = 'R'
-* c(k) and s(k) contain the cosine and sine that define the
-* matrix P(k). The two by two plane rotation part of the
-* matrix P(k), R(k), is assumed to be of the form
-* R( k ) = ( c( k ) s( k ) ).
-* ( -s( k ) c( k ) )
+* The sines s(k) of the plane rotations. The 2-by-2 plane
+* rotation part of the matrix P(k), R(k), has the form
+* R(k) = ( c(k) s(k) )
+* ( -s(k) c(k) ).
*
* A (input/output) COMPLEX*16 array, dimension (LDA,N)
-* The m by n matrix A. On exit, A is overwritten by P*A if
-* SIDE = 'R' or by A*P' if SIDE = 'L'.
+* The M-by-N matrix A. On exit, A is overwritten by P*A if
+* SIDE = 'R' or by A*P**T if SIDE = 'L'.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
diff -uNr LAPACK.orig/SRC/ztgevc.f LAPACK/SRC/ztgevc.f
--- LAPACK.orig/SRC/ztgevc.f Thu Nov 4 14:26:09 1999
+++ LAPACK/SRC/ztgevc.f Fri May 25 16:13:41 2001
@@ -1,19 +1,19 @@
- SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
DOUBLE PRECISION RWORK( * )
- COMPLEX*16 A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ COMPLEX*16 P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -21,28 +21,30 @@
* Purpose
* =======
*
-* ZTGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of complex upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* ZTGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of complex matrices (S,P), where S and P are upper triangular.
+* Matrix pairs of this type are produced by the generalized Schur
+* factorization of a complex matrix pair (A,B):
+*
+* A = Q*S*Z**H, B = Q*P*Z**H
+*
+* as computed by ZGGHRD + ZHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input unitary
-* matrices. If (A,B) was obtained from the generalized Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal elements of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the unitary factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
*
* Arguments
* =========
@@ -54,66 +56,66 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* computed. The eigenvector corresponding to the j-th
+* eigenvalue is computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
-*
-* A (input) COMPLEX*16 array, dimension (LDA,N)
-* The upper triangular matrix A.
-*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1,N).
+* The order of the matrices S and P. N >= 0.
*
-* B (input) COMPLEX*16 array, dimension (LDB,N)
-* The upper triangular matrix B. B must have real diagonal
-* elements.
+* S (input) COMPLEX*16 array, dimension (LDS,N)
+* The upper triangular matrix S from a generalized Schur
+* factorization, as computed by ZHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) COMPLEX*16 array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by ZHGEQZ. P must have real
+* diagonal elements.
*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) COMPLEX*16 array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the unitary matrix Q
* of left Schur vectors returned by ZHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'l' or 'B' or 'b', LDVL >= N.
*
* VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
* contain an N-by-N matrix Q (usually the unitary matrix Z
* of right Schur vectors returned by ZHGEQZ).
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the right eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
@@ -180,7 +182,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -211,9 +213,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -237,7 +239,7 @@
*
ILBBAD = .FALSE.
DO 20 J = 1, N
- IF( DIMAG( B( J, J ) ).NE.ZERO )
+ IF( DIMAG( P( J, J ) ).NE.ZERO )
$ ILBBAD = .TRUE.
20 CONTINUE
*
@@ -275,19 +277,19 @@
* part of A and B to check for possible overflow in the triangular
* solver.
*
- ANORM = ABS1( A( 1, 1 ) )
- BNORM = ABS1( B( 1, 1 ) )
+ ANORM = ABS1( S( 1, 1 ) )
+ BNORM = ABS1( P( 1, 1 ) )
RWORK( 1 ) = ZERO
RWORK( N+1 ) = ZERO
DO 40 J = 2, N
RWORK( J ) = ZERO
RWORK( N+J ) = ZERO
DO 30 I = 1, J - 1
- RWORK( J ) = RWORK( J ) + ABS1( A( I, J ) )
- RWORK( N+J ) = RWORK( N+J ) + ABS1( B( I, J ) )
+ RWORK( J ) = RWORK( J ) + ABS1( S( I, J ) )
+ RWORK( N+J ) = RWORK( N+J ) + ABS1( P( I, J ) )
30 CONTINUE
- ANORM = MAX( ANORM, RWORK( J )+ABS1( A( J, J ) ) )
- BNORM = MAX( BNORM, RWORK( N+J )+ABS1( B( J, J ) ) )
+ ANORM = MAX( ANORM, RWORK( J )+ABS1( S( J, J ) ) )
+ BNORM = MAX( BNORM, RWORK( N+J )+ABS1( P( J, J ) ) )
40 CONTINUE
*
ASCALE = ONE / MAX( ANORM, SAFMIN )
@@ -309,8 +311,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG + 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( DBLE( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( DBLE( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -326,10 +328,10 @@
* H
* y ( a A - b B ) = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( DBLE( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*DBLE( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( DBLE( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*DBLE( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -380,7 +382,7 @@
*
* Compute
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
* (Scale if necessary)
*
@@ -396,16 +398,16 @@
SUMB = CZERO
*
DO 80 JR = JE, J - 1
- SUMA = SUMA + DCONJG( A( JR, J ) )*WORK( JR )
- SUMB = SUMB + DCONJG( B( JR, J ) )*WORK( JR )
+ SUMA = SUMA + DCONJG( S( JR, J ) )*WORK( JR )
+ SUMB = SUMB + DCONJG( P( JR, J ) )*WORK( JR )
80 CONTINUE
SUM = ACOEFF*SUMA - DCONJG( BCOEFF )*SUMB
*
-* Form x(j) = - SUM / conjg( a*A(j,j) - b*B(j,j) )
+* Form x(j) = - SUM / conjg( a*S(j,j) - b*P(j,j) )
*
* with scaling and perturbation of the denominator
*
- D = DCONJG( ACOEFF*A( J, J )-BCOEFF*B( J, J ) )
+ D = DCONJG( ACOEFF*S( J, J )-BCOEFF*P( J, J ) )
IF( ABS1( D ).LE.DMIN )
$ D = DCMPLX( DMIN )
*
@@ -475,8 +477,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG - 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( DBLE( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( DBLE( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -492,10 +494,10 @@
*
* ( a A - b B ) x = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( DBLE( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*DBLE( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( DBLE( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*DBLE( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -542,7 +544,7 @@
* WORK(j+1:JE) contains x
*
DO 170 JR = 1, JE - 1
- WORK( JR ) = ACOEFF*A( JR, JE ) - BCOEFF*B( JR, JE )
+ WORK( JR ) = ACOEFF*S( JR, JE ) - BCOEFF*P( JR, JE )
170 CONTINUE
WORK( JE ) = CONE
*
@@ -551,7 +553,7 @@
* Form x(j) := - w(j) / d
* with scaling and perturbation of the denominator
*
- D = ACOEFF*A( J, J ) - BCOEFF*B( J, J )
+ D = ACOEFF*S( J, J ) - BCOEFF*P( J, J )
IF( ABS1( D ).LE.DMIN )
$ D = DCMPLX( DMIN )
*
@@ -568,7 +570,7 @@
*
IF( J.GT.1 ) THEN
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( ABS1( WORK( J ) ).GT.ONE ) THEN
TEMP = ONE / ABS1( WORK( J ) )
@@ -583,8 +585,8 @@
CA = ACOEFF*WORK( J )
CB = BCOEFF*WORK( J )
DO 200 JR = 1, J - 1
- WORK( JR ) = WORK( JR ) + CA*A( JR, J ) -
- $ CB*B( JR, J )
+ WORK( JR ) = WORK( JR ) + CA*S( JR, J ) -
+ $ CB*P( JR, J )
200 CONTINUE
END IF
210 CONTINUE
diff -uNr LAPACK.orig/SRC/ztrevc.f LAPACK/SRC/ztrevc.f
--- LAPACK.orig/SRC/ztrevc.f Thu Nov 4 14:25:39 1999
+++ LAPACK/SRC/ztrevc.f Fri May 25 16:14:01 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -22,20 +22,23 @@
*
* ZTREVC computes some or all of the right and/or left eigenvectors of
* a complex upper triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input unitary
-* matrix. If T was obtained from the Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of the vector y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the unitary factor that reduces a matrix A to
+* Schur form T, then Q*X and Q*Y are the matrices of right and left
+* eigenvectors of A.
*
* Arguments
* =========
@@ -48,17 +51,17 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed using the matrices supplied in
+* VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* The eigenvector corresponding to the j-th eigenvalue is
+* computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -76,19 +79,16 @@
* Schur vectors returned by ZHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL is lower triangular. The i-th column
-* VL(i) of VL is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VL, in the same order as their
* eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -96,19 +96,16 @@
* Schur vectors returned by ZHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR is upper triangular. The i-th column
-* VR(i) of VR is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VR, in the same order as their
* eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B'; LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/SRC/ztrsen.f LAPACK/SRC/ztrsen.f
--- LAPACK.orig/SRC/ztrsen.f Thu Nov 4 14:25:39 1999
+++ LAPACK/SRC/ztrsen.f Fri May 25 16:14:20 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, JOB
@@ -93,14 +93,13 @@
* If JOB = 'N' or 'E', SEP is not referenced.
*
* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
-* If JOB = 'N', WORK is not referenced. Otherwise,
-* on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*
* LWORK (input) INTEGER
* The dimension of the array WORK.
* If JOB = 'N', LWORK >= 1;
-* if JOB = 'E', LWORK = M*(N-M);
-* if JOB = 'V' or 'B', LWORK >= 2*M*(N-M).
+* if JOB = 'E', LWORK = max(1,M*(N-M));
+* if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
*
* If LWORK = -1, then a workspace query is assumed; the routine
* only calculates the optimal size of the WORK array, returns
diff -uNr LAPACK.orig/SRC/ztrsyl.f LAPACK/SRC/ztrsyl.f
--- LAPACK.orig/SRC/ztrsyl.f Thu Nov 4 14:25:39 1999
+++ LAPACK/SRC/ztrsyl.f Fri May 25 16:14:31 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* January 9, 2001
*
* .. Scalar Arguments ..
CHARACTER TRANA, TRANB
@@ -119,11 +119,9 @@
NOTRNB = LSAME( TRANB, 'N' )
*
INFO = 0
- IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'T' ) .AND. .NOT.
- $ LSAME( TRANA, 'C' ) ) THEN
+ IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'C' ) ) THEN
INFO = -1
- ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'T' ) .AND. .NOT.
- $ LSAME( TRANB, 'C' ) ) THEN
+ ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'C' ) ) THEN
INFO = -2
ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
INFO = -3
diff -uNr LAPACK.orig/TESTING/EIG/cerrgg.f LAPACK/TESTING/EIG/cerrgg.f
--- LAPACK.orig/TESTING/EIG/cerrgg.f Thu Nov 4 14:27:30 1999
+++ LAPACK/TESTING/EIG/cerrgg.f Fri May 25 16:17:13 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 9, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -245,24 +245,24 @@
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'CGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL CGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 0, B,
+ CALL CGGSVD( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B,
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'CGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 12
- CALL CGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 0, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
+ CALL CGGSVD( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B,
+ $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'CGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL CGGSVD( 'U', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 0, V, 1, Q, 1, W, RW, IW, INFO )
+ CALL CGGSVD( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'CGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL CGGSVD( 'N', 'V', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 0, Q, 1, W, RW, IW, INFO )
+ CALL CGGSVD( 'N', 'V', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 2, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'CGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL CGGSVD( 'N', 'N', 'Q', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 1, Q, 0, W, RW, IW, INFO )
+ CALL CGGSVD( 'N', 'N', 'Q', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 2, V, 2, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'CGGSVD', INFOT, NOUT, LERR, OK )
NT = NT + 11
*
@@ -300,28 +300,28 @@
$ INFO )
CALL CHKXER( 'CGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL CGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 0, B, 1, TOLA, TOLB,
+ CALL CGGSVP( 'N', 'N', 'N', 2, 1, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'CGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL CGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 1, B, 0, TOLA, TOLB,
+ CALL CGGSVP( 'N', 'N', 'N', 1, 2, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'CGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL CGGSVP( 'U', 'N', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 0, V, 1, Q, 1, IW, RW, TAU, W,
+ CALL CGGSVP( 'U', 'N', 'N', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'CGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL CGGSVP( 'N', 'V', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 0, Q, 1, IW, RW, TAU, W,
+ CALL CGGSVP( 'N', 'V', 'N', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 2, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'CGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL CGGSVP( 'N', 'N', 'Q', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 0, IW, RW, TAU, W,
+ CALL CGGSVP( 'N', 'N', 'Q', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 2, V, 2, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'CGGSVP', INFOT, NOUT, LERR, OK )
NT = NT + 11
diff -uNr LAPACK.orig/TESTING/EIG/derrgg.f LAPACK/TESTING/EIG/derrgg.f
--- LAPACK.orig/TESTING/EIG/derrgg.f Thu Nov 4 14:27:53 1999
+++ LAPACK/TESTING/EIG/derrgg.f Fri May 25 16:17:09 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 9, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -244,24 +244,24 @@
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'DGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL DGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 0, B,
+ CALL DGGSVD( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B,
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'DGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 12
- CALL DGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 0, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
+ CALL DGGSVD( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B,
+ $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'DGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL DGGSVD( 'U', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 0, V, 1, Q, 1, W, IW, INFO )
+ CALL DGGSVD( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'DGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL DGGSVD( 'N', 'V', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 0, Q, 1, W, IW, INFO )
+ CALL DGGSVD( 'N', 'V', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B,
+ $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'DGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL DGGSVD( 'N', 'N', 'Q', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 1, Q, 0, W, IW, INFO )
+ CALL DGGSVD( 'N', 'N', 'Q', 1, 2, 1, DUMMYK, DUMMYL, A, 1, B,
+ $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'DGGSVD', INFOT, NOUT, LERR, OK )
NT = NT + 11
*
@@ -299,28 +299,28 @@
$ INFO )
CALL CHKXER( 'DGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL DGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 0, B, 1, TOLA, TOLB,
+ CALL DGGSVP( 'N', 'N', 'N', 2, 1, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'DGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL DGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 1, B, 0, TOLA, TOLB,
+ CALL DGGSVP( 'N', 'N', 'N', 1, 2, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'DGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL DGGSVP( 'U', 'N', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 0, V, 1, Q, 1, IW, TAU, W,
+ CALL DGGSVP( 'U', 'N', 'N', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'DGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL DGGSVP( 'N', 'V', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 0, Q, 1, IW, TAU, W,
+ CALL DGGSVP( 'N', 'V', 'N', 1, 2, 1, A, 1, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'DGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL DGGSVP( 'N', 'N', 'Q', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 0, IW, TAU, W,
+ CALL DGGSVP( 'N', 'N', 'Q', 1, 1, 2, A, 1, B, 1, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'DGGSVP', INFOT, NOUT, LERR, OK )
NT = NT + 11
@@ -501,11 +501,11 @@
CALL CHKXER( 'DGGRQF', INFOT, NOUT, LERR, OK )
NT = NT + 6
*
-* Test error exits for the DGS, DGV, DGX, and DXV paths.
+* Test error exits for the SGS, SGV, SGX, and SXV paths.
*
- ELSE IF( LSAMEN( 3, PATH, 'DGS' ) .OR.
- $ LSAMEN( 3, PATH, 'DGV' ) .OR.
- $ LSAMEN( 3, PATH, 'DGX' ) .OR. LSAMEN( 3, PATH, 'DXV' ) )
+ ELSE IF( LSAMEN( 3, PATH, 'SGS' ) .OR.
+ $ LSAMEN( 3, PATH, 'SGV' ) .OR.
+ $ LSAMEN( 3, PATH, 'SGX' ) .OR. LSAMEN( 3, PATH, 'SXV' ) )
$ THEN
*
* DGGES
diff -uNr LAPACK.orig/TESTING/EIG/serrgg.f LAPACK/TESTING/EIG/serrgg.f
--- LAPACK.orig/TESTING/EIG/serrgg.f Thu Nov 4 14:27:25 1999
+++ LAPACK/TESTING/EIG/serrgg.f Fri May 25 16:17:05 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 9, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -244,24 +244,24 @@
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'SGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL SGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 0, B,
+ CALL SGGSVD( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B,
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'SGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 12
- CALL SGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 0, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
+ CALL SGGSVD( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B,
+ $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'SGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL SGGSVD( 'U', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 0, V, 1, Q, 1, W, IW, INFO )
+ CALL SGGSVD( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'SGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL SGGSVD( 'N', 'V', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 0, Q, 1, W, IW, INFO )
+ CALL SGGSVD( 'N', 'V', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B,
+ $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'SGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL SGGSVD( 'N', 'N', 'Q', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 1, Q, 0, W, IW, INFO )
+ CALL SGGSVD( 'N', 'N', 'Q', 1, 2, 1, DUMMYK, DUMMYL, A, 1, B,
+ $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, INFO )
CALL CHKXER( 'SGGSVD', INFOT, NOUT, LERR, OK )
NT = NT + 11
*
@@ -299,28 +299,28 @@
$ INFO )
CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL SGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 0, B, 1, TOLA, TOLB,
+ CALL SGGSVP( 'N', 'N', 'N', 2, 1, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL SGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 1, B, 0, TOLA, TOLB,
+ CALL SGGSVP( 'N', 'N', 'N', 1, 2, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL SGGSVP( 'U', 'N', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 0, V, 1, Q, 1, IW, TAU, W,
+ CALL SGGSVP( 'U', 'N', 'N', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL SGGSVP( 'N', 'V', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 0, Q, 1, IW, TAU, W,
+ CALL SGGSVP( 'N', 'V', 'N', 1, 2, 1, A, 1, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL SGGSVP( 'N', 'N', 'Q', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 0, IW, TAU, W,
+ CALL SGGSVP( 'N', 'N', 'Q', 1, 1, 2, A, 1, B, 1, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
$ INFO )
CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
NT = NT + 11
diff -uNr LAPACK.orig/TESTING/EIG/zerrgg.f LAPACK/TESTING/EIG/zerrgg.f
--- LAPACK.orig/TESTING/EIG/zerrgg.f Thu Nov 4 14:27:40 1999
+++ LAPACK/TESTING/EIG/zerrgg.f Fri May 25 16:17:20 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 9, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -245,24 +245,24 @@
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'ZGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL ZGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 0, B,
+ CALL ZGGSVD( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B,
$ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'ZGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 12
- CALL ZGGSVD( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 0, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
+ CALL ZGGSVD( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B,
+ $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'ZGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL ZGGSVD( 'U', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 0, V, 1, Q, 1, W, RW, IW, INFO )
+ CALL ZGGSVD( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'ZGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL ZGGSVD( 'N', 'V', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 0, Q, 1, W, RW, IW, INFO )
+ CALL ZGGSVD( 'N', 'V', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 2, V, 1, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'ZGGSVD', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL ZGGSVD( 'N', 'N', 'Q', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
- $ 1, R1, R2, U, 1, V, 1, Q, 0, W, RW, IW, INFO )
+ CALL ZGGSVD( 'N', 'N', 'Q', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B,
+ $ 2, R1, R2, U, 2, V, 2, Q, 1, W, RW, IW, INFO )
CALL CHKXER( 'ZGGSVD', INFOT, NOUT, LERR, OK )
NT = NT + 11
*
@@ -300,28 +300,28 @@
$ INFO )
CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL ZGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 0, B, 1, TOLA, TOLB,
+ CALL ZGGSVP( 'N', 'N', 'N', 2, 1, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL ZGGSVP( 'N', 'N', 'N', 0, 0, 0, A, 1, B, 0, TOLA, TOLB,
+ CALL ZGGSVP( 'N', 'N', 'N', 1, 2, 1, A, 1, B, 1, TOLA, TOLB,
$ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 16
- CALL ZGGSVP( 'U', 'N', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 0, V, 1, Q, 1, IW, RW, TAU, W,
+ CALL ZGGSVP( 'U', 'N', 'N', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 18
- CALL ZGGSVP( 'N', 'V', 'N', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 0, Q, 1, IW, RW, TAU, W,
+ CALL ZGGSVP( 'N', 'V', 'N', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 2, V, 1, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
INFOT = 20
- CALL ZGGSVP( 'N', 'N', 'Q', 0, 0, 0, A, 1, B, 1, TOLA, TOLB,
- $ DUMMYK, DUMMYL, U, 1, V, 1, Q, 0, IW, RW, TAU, W,
+ CALL ZGGSVP( 'N', 'N', 'Q', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
+ $ DUMMYK, DUMMYL, U, 2, V, 2, Q, 1, IW, RW, TAU, W,
$ INFO )
CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
NT = NT + 11
@@ -518,11 +518,11 @@
CALL CHKXER( 'ZGGRQF', INFOT, NOUT, LERR, OK )
NT = NT + 6
*
-* Test error exits for the ZGS, ZGV, ZGX, and ZXV paths.
+* Test error exits for the CGS, CGV, CGX, and CXV paths.
*
- ELSE IF( LSAMEN( 3, PATH, 'ZGS' ) .OR.
- $ LSAMEN( 3, PATH, 'ZGV' ) .OR.
- $ LSAMEN( 3, PATH, 'ZGX' ) .OR. LSAMEN( 3, PATH, 'ZXV' ) )
+ ELSE IF( LSAMEN( 3, PATH, 'CGS' ) .OR.
+ $ LSAMEN( 3, PATH, 'CGV' ) .OR.
+ $ LSAMEN( 3, PATH, 'CGX' ) .OR. LSAMEN( 3, PATH, 'CXV' ) )
$ THEN
*
* ZGGES
diff -uNr LAPACK.orig/TESTING/LIN/cerrqp.f LAPACK/TESTING/LIN/cerrqp.f
--- LAPACK.orig/TESTING/LIN/cerrqp.f Thu Nov 4 14:26:53 1999
+++ LAPACK/TESTING/LIN/cerrqp.f Fri May 25 16:15:32 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 6, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -28,7 +28,7 @@
*
* .. Parameters ..
INTEGER NMAX
- PARAMETER ( NMAX = 2 )
+ PARAMETER ( NMAX = 3 )
* ..
* .. Local Scalars ..
CHARACTER*2 C2
@@ -98,10 +98,10 @@
CALL CGEQP3( 1, -1, A, 1, IP, TAU, W, LW, RW, INFO )
CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 4
- CALL CGEQP3( 1, 1, A, 0, IP, TAU, W, LW, RW, INFO )
+ CALL CGEQP3( 2, 3, A, 1, IP, TAU, W, LW, RW, INFO )
CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL CGEQP3( 2, 2, A, 2, IP, TAU, W, LW-1, RW, INFO )
+ CALL CGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, RW, INFO )
CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
END IF
*
diff -uNr LAPACK.orig/TESTING/LIN/derrqp.f LAPACK/TESTING/LIN/derrqp.f
--- LAPACK.orig/TESTING/LIN/derrqp.f Thu Nov 4 14:27:03 1999
+++ LAPACK/TESTING/LIN/derrqp.f Fri May 25 16:15:28 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 6, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -13,7 +13,7 @@
* Purpose
* =======
*
-* DERRQP tests the error exits for DGEQPF and SGEQP3.
+* DERRQP tests the error exits for DGEQPF and DGEQP3.
*
* Arguments
* =========
@@ -28,7 +28,7 @@
*
* .. Parameters ..
INTEGER NMAX
- PARAMETER ( NMAX = 2 )
+ PARAMETER ( NMAX = 3 )
* ..
* .. Local Scalars ..
CHARACTER*2 C2
@@ -93,10 +93,10 @@
CALL DGEQP3( 1, -1, A, 1, IP, TAU, W, LW, INFO )
CALL CHKXER( 'DGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 4
- CALL DGEQP3( 1, 2, A, 0, IP, TAU, W, LW, INFO )
+ CALL DGEQP3( 2, 3, A, 1, IP, TAU, W, LW, INFO )
CALL CHKXER( 'DGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL DGEQP3( 2, 2, A, 2, IP, TAU, W, LW-1, INFO )
+ CALL DGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, INFO )
CALL CHKXER( 'DGEQP3', INFOT, NOUT, LERR, OK )
END IF
*
diff -uNr LAPACK.orig/TESTING/LIN/serrqp.f LAPACK/TESTING/LIN/serrqp.f
--- LAPACK.orig/TESTING/LIN/serrqp.f Thu Nov 4 14:26:44 1999
+++ LAPACK/TESTING/LIN/serrqp.f Fri May 25 16:15:23 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 6, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -28,7 +28,7 @@
*
* .. Parameters ..
INTEGER NMAX
- PARAMETER ( NMAX = 2 )
+ PARAMETER ( NMAX = 3 )
* ..
* .. Local Scalars ..
CHARACTER*2 C2
@@ -93,10 +93,10 @@
CALL SGEQP3( 1, -1, A, 1, IP, TAU, W, LW, INFO )
CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 4
- CALL SGEQP3( 1, 2, A, 0, IP, TAU, W, LW, INFO )
+ CALL SGEQP3( 2, 3, A, 1, IP, TAU, W, LW, INFO )
CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL SGEQP3( 2, 2, A, 2, IP, TAU, W, LW-1, INFO )
+ CALL SGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, INFO )
CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
END IF
*
diff -uNr LAPACK.orig/TESTING/LIN/zerrqp.f LAPACK/TESTING/LIN/zerrqp.f
--- LAPACK.orig/TESTING/LIN/zerrqp.f Thu Nov 4 14:27:13 1999
+++ LAPACK/TESTING/LIN/zerrqp.f Fri May 25 16:15:36 2001
@@ -3,7 +3,7 @@
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* October 6, 2000
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
@@ -28,7 +28,7 @@
*
* .. Parameters ..
INTEGER NMAX
- PARAMETER ( NMAX = 2 )
+ PARAMETER ( NMAX = 3 )
* ..
* .. Local Scalars ..
CHARACTER*2 C2
@@ -98,10 +98,10 @@
CALL ZGEQP3( 1, -1, A, 1, IP, TAU, W, LW, RW, INFO )
CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 4
- CALL ZGEQP3( 1, 1, A, 0, IP, TAU, W, LW, RW, INFO )
+ CALL ZGEQP3( 2, 3, A, 1, IP, TAU, W, LW, RW, INFO )
CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
INFOT = 8
- CALL ZGEQP3( 2, 2, A, 2, IP, TAU, W, LW-1, RW, INFO )
+ CALL ZGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, RW, INFO )
CALL CHKXER( 'ZGEQP3', INFOT, NOUT, LERR, OK )
END IF
*
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/cbdsqr.f LAPACK/TIMING/EIG/EIGSRC/cbdsqr.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/cbdsqr.f Thu Nov 4 14:28:26 1999
+++ LAPACK/TIMING/EIG/EIGSRC/cbdsqr.f Fri May 25 16:19:57 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -26,14 +26,26 @@
* Purpose
* =======
*
-* CBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
-*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given complex input matrices U, VT, and C.
+* CBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**H
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**H*VT instead of
+* P**H, for given complex input matrices U and VT. When U and VT are
+* the unitary matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by CGEBRD, then
+*
+* A = (U*Q) * S * (P**H*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**H*C
+* for a given complex input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -69,18 +81,17 @@
* order.
*
* E (input/output) REAL array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) COMPLEX array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**H * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -89,21 +100,22 @@
* U (input/output) COMPLEX array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) COMPLEX array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**H * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* RWORK (workspace) REAL array, dimension (4*N)
+* RWORK (workspace) REAL array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/cgghrd.f LAPACK/TIMING/EIG/EIGSRC/cgghrd.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/cgghrd.f Thu Nov 4 14:28:26 1999
+++ LAPACK/TIMING/EIG/EIGSRC/cgghrd.f Fri May 25 16:20:17 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -33,16 +33,29 @@
*
* CGGHRD reduces a pair of complex matrices (A,B) to generalized upper
* Hessenberg form using unitary transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are unitary, and ' means conjugate transpose.
+* general matrix and B is upper triangular. The form of the generalized
+* eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the unitary matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**H*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**H*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**H*x.
*
* The unitary matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
* postmultiplied into input matrices Q1 and Z1, so that
-*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**H = (Q1*Q) * H * (Z1*Z)**H
+* Q1 * B * Z1**H = (Q1*Q) * T * (Z1*Z)**H
+* If Q1 is the unitary matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then CGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -66,10 +79,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to CGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to CGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) COMPLEX array, dimension (LDA, N)
@@ -83,33 +97,28 @@
*
* B (input/output) COMPLEX array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**H B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) COMPLEX array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the unitary matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain a unitary matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the unitary matrix Q1, typically
+* from the QR factorization of B.
+* On exit, if COMPQ='I', the unitary matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) COMPLEX array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the unitary matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain a unitary matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the unitary matrix Z1.
+* On exit, if COMPZ='I', the unitary matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/chgeqz.f LAPACK/TIMING/EIG/EIGSRC/chgeqz.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/chgeqz.f Thu Nov 4 14:28:26 1999
+++ LAPACK/TIMING/EIG/EIGSRC/chgeqz.f Fri May 25 16:20:35 2001
@@ -1,20 +1,21 @@
- SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,
$ RWORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
REAL RWORK( * )
- COMPLEX A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), WORK( * ), Z( LDZ, * )
+ COMPLEX ALPHA( * ), BETA( * ), H( LDH, * ),
+ $ Q( LDQ, * ), T( LDT, * ), WORK( * ),
+ $ Z( LDZ, * )
* ..
*
* ----------------------- Begin Timing Code ------------------------
@@ -34,24 +35,44 @@
* Purpose
* =======
*
-* CHGEQZ implements a single-shift version of the QZ
-* method for finding the generalized eigenvalues w(i)=ALPHA(i)/BETA(i)
-* of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* If JOB='S', then the pair (A,B) is simultaneously
-* reduced to Schur form (i.e., A and B are both upper triangular) by
-* applying one unitary tranformation (usually called Q) on the left and
-* another (usually called Z) on the right. The diagonal elements of
-* A are then ALPHA(1),...,ALPHA(N), and of B are BETA(1),...,BETA(N).
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the unitary
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* CHGEQZ computes the eigenvalues of a complex matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the single-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a complex matrix pair (A,B):
+*
+* A = Q1*H*Z1**H, B = Q1*T*Z1**H,
+*
+* as computed by CGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**H, T = Q*P*Z**H,
+*
+* where Q and Z are unitary matrices and S and P are upper triangular.
+*
+* Optionally, the unitary matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* unitary matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the unitary matrices from CGGHRD that reduced
+* the matrix pair (A,B) to generalized Hessenberg form, then the output
+* matrices Q1*Q and Z1*Z are the unitary factors from the generalized
+* Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**H, B = (Q1*Q)*P*(Z1*Z)**H.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T)
+* (equivalently, of (A,B)) are computed as a pair of complex values
+* (alpha,beta). If beta is nonzero, lambda = alpha / beta is an
+* eigenvalue of the generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* The values of alpha and beta for the i-th eigenvalue can be read
+* directly from the generalized Schur form: alpha = S(i,i),
+* beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -61,83 +82,88 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHA and BETA. A and B will not
-* necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHA and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Computer eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the conjugate
-* transpose of the unitary tranformation that is
-* applied to the left side of A and B to reduce them
-* to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain a unitary matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the unitary
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain a unitary matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) COMPLEX array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit A will have been destroyed.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) COMPLEX array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit B will have been destroyed.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) COMPLEX array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper triangular
+* matrix S from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of H matches that of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) COMPLEX array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of T matches that of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHA (output) COMPLEX array, dimension (N)
-* The diagonal elements of A when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues.
+* The complex scalars alpha that define the eigenvalues of
+* GNEP. ALPHA(i) = S(i,i) in the generalized Schur
+* factorization.
*
* BETA (output) COMPLEX array, dimension (N)
-* The diagonal elements of B when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues. A and B are normalized
-* so that BETA(1),...,BETA(N) are non-negative real numbers.
+* The real non-negative scalars beta that define the
+* eigenvalues of GNEP. BETA(i) = P(i,i) in the generalized
+* Schur factorization.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
*
* Q (input/output) COMPLEX array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the conjugate transpose of the
-* unitary transformations which are applied to A and B on
-* the left will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Q1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) COMPLEX array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the unitary transformations which
-* are applied to A and B on the right will be applied to the
-* array Z on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Z1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of right Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -159,13 +185,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -192,7 +217,7 @@
REAL ABSB, ANORM, ASCALE, ATOL, BNORM, BSCALE, BTOL,
$ C, OPST, SAFMIN, TEMP, TEMP2, TEMPR, ULP
COMPLEX ABI22, AD11, AD12, AD21, AD22, CTEMP, CTEMP2,
- $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T,
+ $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T1,
$ U12, X
* ..
* .. External Functions ..
@@ -278,9 +303,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -14
@@ -316,8 +341,8 @@
IN = IHI + 1 - ILO
SAFMIN = SLAMCH( 'S' )
ULP = SLAMCH( 'E' )*SLAMCH( 'B' )
- ANORM = CLANHS( 'F', IN, A( ILO, ILO ), LDA, RWORK )
- BNORM = CLANHS( 'F', IN, B( ILO, ILO ), LDB, RWORK )
+ ANORM = CLANHS( 'F', IN, H( ILO, ILO ), LDH, RWORK )
+ BNORM = CLANHS( 'F', IN, T( ILO, ILO ), LDT, RWORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -334,18 +359,18 @@
* Set Eigenvalues IHI+1:N
*
DO 10 J = IHI + 1, N
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = CONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = CONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL CSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL CSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL CSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL CSCAL( J, SIGNBC, H( 1, J ), 1 )
* ----------------- Begin Timing Code ---------------------
OPST = OPST + REAL( 12*( J-1 ) )
* ------------------ End Timing Code ----------------------
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL CSCAL( N, SIGNBC, Z( 1, J ), 1 )
@@ -353,10 +378,10 @@
OPST = OPST + REAL( 6*NZ+13 )
* -------------------- End Timing Code -----------------------
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
10 CONTINUE
*
* If IHI < ILO, skip QZ steps
@@ -401,22 +426,22 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
* Special case: j=ILAST
*
IF( ILAST.EQ.ILO ) THEN
GO TO 60
ELSE
- IF( ABS1( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = CZERO
+ IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = CZERO
GO TO 60
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = CZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = CZERO
GO TO 50
END IF
*
@@ -424,30 +449,30 @@
*
DO 40 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS1( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = CZERO
+ IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = CZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = CZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = CZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- IF( ABS1( A( J, J-1 ) )*( ASCALE*ABS1( A( J+1,
- $ J ) ) ).LE.ABS1( A( J, J ) )*( ASCALE*ATOL ) )
+ IF( ABS1( H( J, J-1 ) )*( ASCALE*ABS1( H( J+1,
+ $ J ) ) ).LE.ABS1( H( J, J ) )*( ASCALE*ATOL ) )
$ ILAZR2 = .TRUE.
END IF
*
@@ -459,24 +484,24 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 20 JCH = J, ILAST - 1
- CTEMP = A( JCH, JCH )
- CALL CLARTG( CTEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = CZERO
- CALL CROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL CROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ CTEMP = H( JCH, JCH )
+ CALL CLARTG( CTEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = CZERO
+ CALL CROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL CROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, CONJG( S ) )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
* --------------- Begin Timing Code -----------------
OPST = OPST + REAL( 32+40*( ILASTM-JCH )+20*NQ )
* ---------------- End Timing Code ------------------
- IF( ABS1( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS1( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 60
ELSE
@@ -484,35 +509,35 @@
GO TO 70
END IF
END IF
- B( JCH+1, JCH+1 ) = CZERO
+ T( JCH+1, JCH+1 ) = CZERO
20 CONTINUE
GO TO 50
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 30 JCH = J, ILAST - 1
- CTEMP = B( JCH, JCH+1 )
- CALL CLARTG( CTEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = CZERO
+ CTEMP = T( JCH, JCH+1 )
+ CALL CLARTG( CTEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = CZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL CROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL CROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL CROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL CROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, CONJG( S ) )
- CTEMP = A( JCH+1, JCH )
- CALL CLARTG( CTEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = CZERO
- CALL CROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL CROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ CTEMP = H( JCH+1, JCH )
+ CALL CLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = CZERO
+ CALL CROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL CROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL CROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -542,40 +567,40 @@
INFO = 2*N + 1
GO TO 210
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
50 CONTINUE
- CTEMP = A( ILAST, ILAST )
- CALL CLARTG( CTEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = CZERO
- CALL CROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL CROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ CTEMP = H( ILAST, ILAST )
+ CALL CLARTG( CTEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = CZERO
+ CALL CROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL CROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL CROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
* --------------------- Begin Timing Code -----------------------
OPST = OPST + REAL( 32+40*( ILAST-IFRSTM )+20*NZ )
* ---------------------- End Timing Code ------------------------
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
*
60 CONTINUE
- ABSB = ABS( B( ILAST, ILAST ) )
+ ABSB = ABS( T( ILAST, ILAST ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = CONJG( B( ILAST, ILAST ) / ABSB )
- B( ILAST, ILAST ) = ABSB
+ SIGNBC = CONJG( T( ILAST, ILAST ) / ABSB )
+ T( ILAST, ILAST ) = ABSB
IF( ILSCHR ) THEN
- CALL CSCAL( ILAST-IFRSTM, SIGNBC, B( IFRSTM, ILAST ), 1 )
- CALL CSCAL( ILAST+1-IFRSTM, SIGNBC, A( IFRSTM, ILAST ),
+ CALL CSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 )
+ CALL CSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ),
$ 1 )
* ----------------- Begin Timing Code ---------------------
OPST = OPST + REAL( 12*( ILAST-IFRSTM ) )
* ------------------ End Timing Code ----------------------
ELSE
- A( ILAST, ILAST ) = A( ILAST, ILAST )*SIGNBC
+ H( ILAST, ILAST ) = H( ILAST, ILAST )*SIGNBC
END IF
IF( ILZ )
$ CALL CSCAL( N, SIGNBC, Z( 1, ILAST ), 1 )
@@ -583,10 +608,10 @@
OPST = OPST + REAL( 6*NZ+13 )
* -------------------- End Timing Code -----------------------
ELSE
- B( ILAST, ILAST ) = CZERO
+ T( ILAST, ILAST ) = CZERO
END IF
- ALPHA( ILAST ) = A( ILAST, ILAST )
- BETA( ILAST ) = B( ILAST, ILAST )
+ ALPHA( ILAST ) = H( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -619,7 +644,7 @@
* Compute the Shift.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.NE.IITER ) THEN
@@ -631,26 +656,26 @@
* We factor B as U*D, where U has unit diagonals, and
* compute (A*inv(D))*inv(U).
*
- U12 = ( BSCALE*B( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
+ U12 = ( BSCALE*T( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
ABI22 = AD22 - U12*AD21
*
- T = HALF*( AD11+ABI22 )
- RTDISC = SQRT( T**2+AD12*AD21-AD11*AD22 )
- TEMP = REAL( T-ABI22 )*REAL( RTDISC ) +
- $ AIMAG( T-ABI22 )*AIMAG( RTDISC )
+ T1 = HALF*( AD11+ABI22 )
+ RTDISC = SQRT( T1**2+AD12*AD21-AD11*AD22 )
+ TEMP = REAL( T1-ABI22 )*REAL( RTDISC ) +
+ $ AIMAG( T1-ABI22 )*AIMAG( RTDISC )
IF( TEMP.LE.ZERO ) THEN
- SHIFT = T + RTDISC
+ SHIFT = T1 + RTDISC
ELSE
- SHIFT = T - RTDISC
+ SHIFT = T1 - RTDISC
END IF
*
* ------------------- Begin Timing Code ----------------------
@@ -661,8 +686,8 @@
*
* Exceptional shift. Chosen for no particularly good reason.
*
- ESHIFT = ESHIFT + CONJG( ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) ) )
+ ESHIFT = ESHIFT + CONJG( ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) ) )
SHIFT = ESHIFT
*
* ------------------- Begin Timing Code ----------------------
@@ -675,21 +700,21 @@
*
DO 80 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- CTEMP = ASCALE*A( J, J ) - SHIFT*( BSCALE*B( J, J ) )
+ CTEMP = ASCALE*H( J, J ) - SHIFT*( BSCALE*T( J, J ) )
TEMP = ABS1( CTEMP )
- TEMP2 = ASCALE*ABS1( A( J+1, J ) )
+ TEMP2 = ASCALE*ABS1( H( J+1, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS1( A( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
+ IF( ABS1( H( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
$ GO TO 90
80 CONTINUE
*
ISTART = IFIRST
- CTEMP = ASCALE*A( IFIRST, IFIRST ) -
- $ SHIFT*( BSCALE*B( IFIRST, IFIRST ) )
+ CTEMP = ASCALE*H( IFIRST, IFIRST ) -
+ $ SHIFT*( BSCALE*T( IFIRST, IFIRST ) )
*
* --------------------- Begin Timing Code -----------------------
OPST = OPST - REAL( 6 )
@@ -701,7 +726,7 @@
*
* Initial Q
*
- CTEMP2 = ASCALE*A( ISTART+1, ISTART )
+ CTEMP2 = ASCALE*H( ISTART+1, ISTART )
*
* --------------------- Begin Timing Code -----------------------
OPST = OPST + REAL( 2+( ILAST-ISTART )*18 )
@@ -713,18 +738,18 @@
*
DO 150 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- CTEMP = A( J, J-1 )
- CALL CLARTG( CTEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = CZERO
+ CTEMP = H( J, J-1 )
+ CALL CLARTG( CTEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = CZERO
END IF
*
DO 100 JC = J, ILASTM
- CTEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -CONJG( S )*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = CTEMP
- CTEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -CONJG( S )*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = CTEMP2
+ CTEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -CONJG( S )*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = CTEMP
+ CTEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -CONJG( S )*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = CTEMP2
100 CONTINUE
IF( ILQ ) THEN
DO 110 JR = 1, N
@@ -734,19 +759,19 @@
110 CONTINUE
END IF
*
- CTEMP = B( J+1, J+1 )
- CALL CLARTG( CTEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = CZERO
+ CTEMP = T( J+1, J+1 )
+ CALL CLARTG( CTEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = CZERO
*
DO 120 JR = IFRSTM, MIN( J+2, ILAST )
- CTEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -CONJG( S )*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = CTEMP
+ CTEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -CONJG( S )*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = CTEMP
120 CONTINUE
DO 130 JR = IFRSTM, J
- CTEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -CONJG( S )*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = CTEMP
+ CTEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -CONJG( S )*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = CTEMP
130 CONTINUE
IF( ILZ ) THEN
DO 140 JR = 1, N
@@ -792,18 +817,18 @@
* Set Eigenvalues 1:ILO-1
*
DO 200 J = 1, ILO - 1
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = CONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = CONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL CSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL CSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL CSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL CSCAL( J, SIGNBC, H( 1, J ), 1 )
* ----------------- Begin Timing Code ---------------------
OPST = OPST + REAL( 12*( J-1 ) )
* ------------------ End Timing Code ----------------------
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL CSCAL( N, SIGNBC, Z( 1, J ), 1 )
@@ -811,10 +836,10 @@
OPST = OPST + REAL( 6*NZ+13 )
* -------------------- End Timing Code -----------------------
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
200 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/ctgevc.f LAPACK/TIMING/EIG/EIGSRC/ctgevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/ctgevc.f Thu Nov 4 14:28:30 1999
+++ LAPACK/TIMING/EIG/EIGSRC/ctgevc.f Fri May 25 16:20:48 2001
@@ -1,19 +1,19 @@
- SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
REAL RWORK( * )
- COMPLEX A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ COMPLEX P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -34,28 +34,30 @@
* Purpose
* =======
*
-* CTGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of complex upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* CTGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of complex matrices (S,P), where S and P are upper triangular.
+* Matrix pairs of this type are produced by the generalized Schur
+* factorization of a complex matrix pair (A,B):
+*
+* A = Q*S*Z**H, B = Q*P*Z**H
+*
+* as computed by CGGHRD + CHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input unitary
-* matrices. If (A,B) was obtained from the generalized Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal elements of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the unitary factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
*
* Arguments
* =========
@@ -67,70 +69,69 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* computed. The eigenvector corresponding to the j-th
+* eigenvalue is computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
-*
-* A (input) COMPLEX array, dimension (LDA,N)
-* The upper triangular matrix A.
-*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1,N).
+* The order of the matrices S and P. N >= 0.
*
-* B (input) COMPLEX array, dimension (LDB,N)
-* The upper triangular matrix B. B must have real diagonal
-* elements.
+* S (input) COMPLEX array, dimension (LDS,N)
+* The upper triangular matrix S from a generalized Schur
+* factorization, as computed by CHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) COMPLEX array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by CHGEQZ. P must have real
+* diagonal elements.
*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) COMPLEX array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the unitary matrix Q
* of left Schur vectors returned by CHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'l' or 'B' or 'b', LDVL >= N.
*
* VR (input/output) COMPLEX array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
* contain an N-by-N matrix Q (usually the unitary matrix Z
* of right Schur vectors returned by CHGEQZ).
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the right eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The number of columns in the arrays VL and/or VR. MM >= M.
*
* M (output) INTEGER
* The number of columns in the arrays VL and/or VR actually
@@ -194,7 +195,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -225,9 +226,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -251,7 +252,7 @@
*
ILBBAD = .FALSE.
DO 20 J = 1, N
- IF( AIMAG( B( J, J ) ).NE.ZERO )
+ IF( AIMAG( P( J, J ) ).NE.ZERO )
$ ILBBAD = .TRUE.
20 CONTINUE
*
@@ -289,19 +290,19 @@
* part of A and B to check for possible overflow in the triangular
* solver.
*
- ANORM = ABS1( A( 1, 1 ) )
- BNORM = ABS1( B( 1, 1 ) )
+ ANORM = ABS1( S( 1, 1 ) )
+ BNORM = ABS1( P( 1, 1 ) )
RWORK( 1 ) = ZERO
RWORK( N+1 ) = ZERO
DO 40 J = 2, N
RWORK( J ) = ZERO
RWORK( N+J ) = ZERO
DO 30 I = 1, J - 1
- RWORK( J ) = RWORK( J ) + ABS1( A( I, J ) )
- RWORK( N+J ) = RWORK( N+J ) + ABS1( B( I, J ) )
+ RWORK( J ) = RWORK( J ) + ABS1( S( I, J ) )
+ RWORK( N+J ) = RWORK( N+J ) + ABS1( P( I, J ) )
30 CONTINUE
- ANORM = MAX( ANORM, RWORK( J )+ABS1( A( J, J ) ) )
- BNORM = MAX( BNORM, RWORK( N+J )+ABS1( B( J, J ) ) )
+ ANORM = MAX( ANORM, RWORK( J )+ABS1( S( J, J ) ) )
+ BNORM = MAX( BNORM, RWORK( N+J )+ABS1( P( J, J ) ) )
40 CONTINUE
*
ASCALE = ONE / MAX( ANORM, SAFMIN )
@@ -326,8 +327,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG + 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( REAL( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( REAL( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -343,10 +344,10 @@
* H
* y ( a A - b B ) = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( REAL( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*REAL( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( REAL( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*REAL( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -403,7 +404,7 @@
*
* Compute
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
* (Scale if necessary)
*
@@ -422,16 +423,16 @@
SUMB = CZERO
*
DO 80 JR = JE, J - 1
- SUMA = SUMA + CONJG( A( JR, J ) )*WORK( JR )
- SUMB = SUMB + CONJG( B( JR, J ) )*WORK( JR )
+ SUMA = SUMA + CONJG( S( JR, J ) )*WORK( JR )
+ SUMB = SUMB + CONJG( P( JR, J ) )*WORK( JR )
80 CONTINUE
SUM = ACOEFF*SUMA - CONJG( BCOEFF )*SUMB
*
-* Form x(j) = - SUM / conjg( a*A(j,j) - b*B(j,j) )
+* Form x(j) = - SUM / conjg( a*S(j,j) - b*P(j,j) )
*
* with scaling and perturbation of the denominator
*
- D = CONJG( ACOEFF*A( J, J )-BCOEFF*B( J, J ) )
+ D = CONJG( ACOEFF*S( J, J )-BCOEFF*P( J, J ) )
IF( ABS1( D ).LE.DMIN )
$ D = CMPLX( DMIN )
*
@@ -511,8 +512,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG - 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( REAL( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( REAL( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -528,10 +529,10 @@
*
* ( a A - b B ) x = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( REAL( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*REAL( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( REAL( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*REAL( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -584,7 +585,7 @@
* WORK(j+1:JE) contains x
*
DO 170 JR = 1, JE - 1
- WORK( JR ) = ACOEFF*A( JR, JE ) - BCOEFF*B( JR, JE )
+ WORK( JR ) = ACOEFF*S( JR, JE ) - BCOEFF*P( JR, JE )
170 CONTINUE
WORK( JE ) = CONE
*
@@ -593,7 +594,7 @@
* Form x(j) := - w(j) / d
* with scaling and perturbation of the denominator
*
- D = ACOEFF*A( J, J ) - BCOEFF*B( J, J )
+ D = ACOEFF*S( J, J ) - BCOEFF*P( J, J )
IF( ABS1( D ).LE.DMIN )
$ D = CMPLX( DMIN )
*
@@ -615,7 +616,7 @@
*
IF( J.GT.1 ) THEN
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( ABS1( WORK( J ) ).GT.ONE ) THEN
TEMP = ONE / ABS1( WORK( J ) )
@@ -635,8 +636,8 @@
CA = ACOEFF*WORK( J )
CB = BCOEFF*WORK( J )
DO 200 JR = 1, J - 1
- WORK( JR ) = WORK( JR ) + CA*A( JR, J ) -
- $ CB*B( JR, J )
+ WORK( JR ) = WORK( JR ) + CA*S( JR, J ) -
+ $ CB*P( JR, J )
200 CONTINUE
END IF
210 CONTINUE
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/ctrevc.f LAPACK/TIMING/EIG/EIGSRC/ctrevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/ctrevc.f Thu Nov 4 14:28:30 1999
+++ LAPACK/TIMING/EIG/EIGSRC/ctrevc.f Fri May 25 16:21:06 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -31,20 +31,23 @@
*
* CTREVC computes some or all of the right and/or left eigenvectors of
* a complex upper triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input unitary
-* matrix. If T was obtained from the Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of the vector y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the unitary factor that reduces a matrix A to
+* Schur form T, then Q*X and Q*Y are the matrices of right and left
+* eigenvectors of A.
*
* Arguments
* =========
@@ -57,17 +60,17 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed using the matrices supplied in
+* VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* The eigenvector corresponding to the j-th eigenvalue is
+* computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -85,19 +88,16 @@
* Schur vectors returned by CHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL is lower triangular. The i-th column
-* VL(i) of VL is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VL, in the same order as their
* eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) COMPLEX array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -105,19 +105,16 @@
* Schur vectors returned by CHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR is upper triangular. The i-th column
-* VR(i) of VR is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VR, in the same order as their
* eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B'; LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/dbdsqr.f LAPACK/TIMING/EIG/EIGSRC/dbdsqr.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/dbdsqr.f Thu Nov 4 14:28:31 1999
+++ LAPACK/TIMING/EIG/EIGSRC/dbdsqr.f Fri May 25 16:19:53 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -26,14 +26,26 @@
* Purpose
* =======
*
-* DBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
+* DBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**T
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**T*VT instead of
+* P**T, for given real input matrices U and VT. When U and VT are the
+* orthogonal matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by DGEBRD, then
*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given real input matrices U, VT, and C.
+* A = (U*Q) * S * (P**T*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+* for a given real input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -69,18 +81,17 @@
* order.
*
* E (input/output) DOUBLE PRECISION array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**T * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -89,21 +100,22 @@
* U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**T * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+* WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/dgghrd.f LAPACK/TIMING/EIG/EIGSRC/dgghrd.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/dgghrd.f Thu Nov 4 14:28:31 1999
+++ LAPACK/TIMING/EIG/EIGSRC/dgghrd.f Fri May 25 16:20:14 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -33,16 +33,32 @@
*
* DGGHRD reduces a pair of real matrices (A,B) to generalized upper
* Hessenberg form using orthogonal transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are orthogonal, and ' means transpose.
+* general matrix and B is upper triangular. The form of the
+* generalized eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the orthogonal matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**T*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**T*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**T*x.
*
* The orthogonal matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
* postmultiplied into input matrices Q1 and Z1, so that
*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+*
+* Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+*
+* If Q1 is the orthogonal matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then DGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -66,10 +82,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to DGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to SGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
@@ -83,33 +100,28 @@
*
* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**T B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the orthogonal matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain an orthogonal matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+* typically from the QR factorization of B.
+* On exit, if COMPQ='I', the orthogonal matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the orthogonal matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain an orthogonal matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+* On exit, if COMPZ='I', the orthogonal matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/dhgeqz.f LAPACK/TIMING/EIG/EIGSRC/dhgeqz.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/dhgeqz.f Thu Nov 4 14:28:33 1999
+++ LAPACK/TIMING/EIG/EIGSRC/dhgeqz.f Fri May 25 16:20:32 2001
@@ -1,20 +1,20 @@
- SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
$ LWORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), Q( LDQ, * ), WORK( * ),
- $ Z( LDZ, * )
+ DOUBLE PRECISION ALPHAI( * ), ALPHAR( * ), BETA( * ),
+ $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
+ $ WORK( * ), Z( LDZ, * )
* ..
* ---------------------- Begin Timing Code -------------------------
* Common block to return operation count and iteration count
@@ -32,37 +32,56 @@
* Purpose
* =======
*
-* DHGEQZ implements a single-/double-shift version of the QZ method for
-* finding the generalized eigenvalues
-*
-* w(j)=(ALPHAR(j) + i*ALPHAI(j))/BETAR(j) of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* In addition, the pair A,B may be reduced to generalized Schur form:
-* B is upper triangular, and A is block upper triangular, where the
-* diagonal blocks are either 1-by-1 or 2-by-2, the 2-by-2 blocks having
-* complex generalized eigenvalues (see the description of the argument
-* JOB.)
-*
-* If JOB='S', then the pair (A,B) is simultaneously reduced to Schur
-* form by applying one orthogonal tranformation (usually called Q) on
-* the left and another (usually called Z) on the right. The 2-by-2
-* upper-triangular diagonal blocks of B corresponding to 2-by-2 blocks
-* of A will be reduced to positive diagonal matrices. (I.e.,
-* if A(j+1,j) is non-zero, then B(j+1,j)=B(j,j+1)=0 and B(j,j) and
-* B(j+1,j+1) will be positive.)
-*
-* If JOB='E', then at each iteration, the same transformations
-* are computed, but they are only applied to those parts of A and B
-* which are needed to compute ALPHAR, ALPHAI, and BETAR.
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the orthogonal
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* DHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the double-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a real matrix pair (A,B):
+*
+* A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+*
+* as computed by DGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**T, T = Q*P*Z**T,
+*
+* where Q and Z are orthogonal matrices, P is an upper triangular
+* matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+* diagonal blocks.
+*
+* The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+* (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+* eigenvalues.
+*
+* Additionally, the 2-by-2 upper triangular diagonal blocks of P
+* corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+* form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+* P(j,j) > 0, and P(j+1,j+1) > 0.
+*
+* Optionally, the orthogonal matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced
+* the matrix pair (A,B) to generalized upper Hessenberg form, then the
+* output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+* generalized Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
+* of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
+* complex and beta real.
+* If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+* generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* Real eigenvalues can be read directly from the generalized Schur
+* form:
+* alpha = S(i,i), beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -72,114 +91,98 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHAR, ALPHAI, and BETA. A and B will
-* not necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHAR, ALPHAI, and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Compute eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the transpose of
-* the orthogonal tranformation that is applied to the
-* left side of A and B to reduce them to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain an orthogonal matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the orthogonal
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Z is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain an orthogonal matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to generalized Schur form.
-* If JOB='E', then on exit A will have been destroyed.
-* The diagonal blocks will be correct, but the off-diagonal
-* portion will be meaningless.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero. 2-by-2 blocks in B
-* corresponding to 2-by-2 blocks in A will be reduced to
-* positive diagonal form. (I.e., if A(j+1,j) is non-zero,
-* then B(j+1,j)=B(j,j+1)=0 and B(j,j) and B(j+1,j+1) will be
-* positive.)
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to Schur form.
-* If JOB='E', then on exit B will have been destroyed.
-* Elements corresponding to diagonal blocks of A will be
-* correct, but the off-diagonal portion will be meaningless.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) DOUBLE PRECISION array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper quasi-triangular
+* matrix S from the generalized Schur factorization;
+* 2-by-2 diagonal blocks (corresponding to complex conjugate
+* pairs of eigenvalues) are returned in standard form, with
+* H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+* If JOB = 'E', the diagonal blocks of H match those of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) DOUBLE PRECISION array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization;
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of S
+* are reduced to positive diagonal form, i.e., if H(j+1,j) is
+* non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+* T(j+1,j+1) > 0.
+* If JOB = 'E', the diagonal blocks of T match those of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHAR (output) DOUBLE PRECISION array, dimension (N)
-* ALPHAR(1:N) will be set to real parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=A(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The real parts of each scalar alpha defining an eigenvalue
+* of GNEP.
*
* ALPHAI (output) DOUBLE PRECISION array, dimension (N)
-* ALPHAI(1:N) will be set to imaginary parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=0.
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP.
+* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+* positive, then the j-th and (j+1)-st eigenvalues are a
+* complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
*
* BETA (output) DOUBLE PRECISION array, dimension (N)
-* BETA(1:N) will be set to the (real) diagonal elements of B
-* that would result from reducing A and B to Schur form and
-* then further reducing them both to triangular form using
-* unitary transformations s.t. the diagonal of B was
-* non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then BETA(j)=B(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
-* (Note that BETA(1:N) will always be non-negative, and no
-* BETAI is necessary.)
+* The scalars beta that define the eigenvalues of GNEP.
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the transpose of the orthogonal
-* transformations which are applied to A and B on the left
-* will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+* of left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the orthogonal transformations
-* which are applied to A and B on the right will be applied
-* to the array Z on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of
+* right Schur vectors of (H,T), and if COMPZ = 'V', the
+* orthogonal matrix of right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -199,13 +202,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -237,7 +239,7 @@
$ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
$ CQ, CR, CZ, ESHIFT, OPST, S, S1, S1INV, S2,
$ SAFMAX, SAFMIN, SCALE, SL, SQI, SQR, SR, SZI,
- $ SZR, T, TAU, TEMP, TEMP2, TEMPI, TEMPR, U1,
+ $ SZR, T1, TAU, TEMP, TEMP2, TEMPI, TEMPR, U1,
$ U12, U12L, U2, ULP, VS, W11, W12, W21, W22,
$ WABS, WI, WR, WR2
* ..
@@ -319,9 +321,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -15
@@ -360,8 +362,8 @@
SAFMIN = DLAMCH( 'S' )
SAFMAX = ONE / SAFMIN
ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
- ANORM = DLANHS( 'F', IN, A( ILO, ILO ), LDA, WORK )
- BNORM = DLANHS( 'F', IN, B( ILO, ILO ), LDB, WORK )
+ ANORM = DLANHS( 'F', IN, H( ILO, ILO ), LDH, WORK )
+ BNORM = DLANHS( 'F', IN, T( ILO, ILO ), LDT, WORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -370,15 +372,15 @@
* Set Eigenvalues IHI+1:N
*
DO 30 J = IHI + 1, N
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 10 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
10 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 20 JR = 1, N
@@ -386,9 +388,9 @@
20 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
30 CONTINUE
*
* ---------------------- Begin Timing Code -------------------------
@@ -435,8 +437,8 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
IF( ILAST.EQ.ILO ) THEN
*
@@ -444,14 +446,14 @@
*
GO TO 80
ELSE
- IF( ABS( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = ZERO
+ IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = ZERO
GO TO 80
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = ZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = ZERO
GO TO 70
END IF
*
@@ -459,36 +461,36 @@
*
DO 60 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = ZERO
+ IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = ZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = ZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = ZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- TEMP = ABS( A( J, J-1 ) )
- TEMP2 = ABS( A( J, J ) )
+ TEMP = ABS( H( J, J-1 ) )
+ TEMP2 = ABS( H( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( TEMP*( ASCALE*ABS( A( J+1, J ) ) ).LE.TEMP2*
+ IF( TEMP*( ASCALE*ABS( H( J+1, J ) ) ).LE.TEMP2*
$ ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
END IF
*
@@ -500,26 +502,26 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 40 JCH = J, ILAST - 1
- TEMP = A( JCH, JCH )
- CALL DLARTG( TEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = ZERO
- CALL DROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL DROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ TEMP = H( JCH, JCH )
+ CALL DLARTG( TEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = ZERO
+ CALL DROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL DROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
*
* --------------- Begin Timing Code -----------------
OPST = OPST + DBLE( 7+12*( ILASTM-JCH )+6*NQ )
* ---------------- End Timing Code ------------------
*
- IF( ABS( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 80
ELSE
@@ -527,35 +529,35 @@
GO TO 110
END IF
END IF
- B( JCH+1, JCH+1 ) = ZERO
+ T( JCH+1, JCH+1 ) = ZERO
40 CONTINUE
GO TO 70
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 50 JCH = J, ILAST - 1
- TEMP = B( JCH, JCH+1 )
- CALL DLARTG( TEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = ZERO
+ TEMP = T( JCH, JCH+1 )
+ CALL DLARTG( TEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = ZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL DROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL DROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL DROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL DROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
- TEMP = A( JCH+1, JCH )
- CALL DLARTG( TEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = ZERO
- CALL DROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL DROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ TEMP = H( JCH+1, JCH )
+ CALL DLARTG( TEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = ZERO
+ CALL DROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL DROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL DROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -585,18 +587,18 @@
INFO = N + 1
GO TO 420
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
70 CONTINUE
- TEMP = A( ILAST, ILAST )
- CALL DLARTG( TEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = ZERO
- CALL DROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL DROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ TEMP = H( ILAST, ILAST )
+ CALL DLARTG( TEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = ZERO
+ CALL DROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL DROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL DROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
*
@@ -605,19 +607,19 @@
* ---------------------- End Timing Code ------------------------
*
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
* and BETA
*
80 CONTINUE
- IF( B( ILAST, ILAST ).LT.ZERO ) THEN
+ IF( T( ILAST, ILAST ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 90 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
90 CONTINUE
ELSE
- A( ILAST, ILAST ) = -A( ILAST, ILAST )
- B( ILAST, ILAST ) = -B( ILAST, ILAST )
+ H( ILAST, ILAST ) = -H( ILAST, ILAST )
+ T( ILAST, ILAST ) = -T( ILAST, ILAST )
END IF
IF( ILZ ) THEN
DO 100 J = 1, N
@@ -625,9 +627,9 @@
100 CONTINUE
END IF
END IF
- ALPHAR( ILAST ) = A( ILAST, ILAST )
+ ALPHAR( ILAST ) = H( ILAST, ILAST )
ALPHAI( ILAST ) = ZERO
- BETA( ILAST ) = B( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -660,7 +662,7 @@
* Compute single shifts.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.EQ.IITER ) THEN
@@ -668,10 +670,10 @@
* Exceptional shift. Chosen for no particularly good reason.
* (Single shift only.)
*
- IF( ( DBLE( MAXIT )*SAFMIN )*ABS( A( ILAST-1, ILAST ) ).LT.
- $ ABS( B( ILAST-1, ILAST-1 ) ) ) THEN
- ESHIFT = ESHIFT + A( ILAST-1, ILAST ) /
- $ B( ILAST-1, ILAST-1 )
+ IF( ( DBLE( MAXIT )*SAFMIN )*ABS( H( ILAST-1, ILAST ) ).LT.
+ $ ABS( T( ILAST-1, ILAST-1 ) ) ) THEN
+ ESHIFT = ESHIFT + H( ILAST-1, ILAST ) /
+ $ T( ILAST-1, ILAST-1 )
ELSE
ESHIFT = ESHIFT + ONE / ( SAFMIN*DBLE( MAXIT ) )
END IF
@@ -688,8 +690,8 @@
* bottom-right 2x2 block of A and B. The first eigenvalue
* returned by DLAG2 is the Wilkinson shift (AEP p.512),
*
- CALL DLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ S2, WR, WR2, WI )
*
TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
@@ -721,14 +723,14 @@
*
DO 120 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- TEMP = ABS( S1*A( J, J-1 ) )
- TEMP2 = ABS( S1*A( J, J )-WR*B( J, J ) )
+ TEMP = ABS( S1*H( J, J-1 ) )
+ TEMP2 = ABS( S1*H( J, J )-WR*T( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS( ( ASCALE*A( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
+ IF( ABS( ( ASCALE*H( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
$ TEMP2 )GO TO 130
120 CONTINUE
*
@@ -739,26 +741,26 @@
*
* Initial Q
*
- TEMP = S1*A( ISTART, ISTART ) - WR*B( ISTART, ISTART )
- TEMP2 = S1*A( ISTART+1, ISTART )
+ TEMP = S1*H( ISTART, ISTART ) - WR*T( ISTART, ISTART )
+ TEMP2 = S1*H( ISTART+1, ISTART )
CALL DLARTG( TEMP, TEMP2, C, S, TEMPR )
*
* Sweep
*
DO 190 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- TEMP = A( J, J-1 )
- CALL DLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
END IF
*
DO 140 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
140 CONTINUE
IF( ILQ ) THEN
DO 150 JR = 1, N
@@ -768,19 +770,19 @@
150 CONTINUE
END IF
*
- TEMP = B( J+1, J+1 )
- CALL DLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 160 JR = IFRSTM, MIN( J+2, ILAST )
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
160 CONTINUE
DO 170 JR = IFRSTM, J
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
170 CONTINUE
IF( ILZ ) THEN
DO 180 JR = 1, N
@@ -816,8 +818,8 @@
* B = ( ) with B11 non-negative.
* ( 0 B22 )
*
- CALL DLASV2( B( ILAST-1, ILAST-1 ), B( ILAST-1, ILAST ),
- $ B( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
+ CALL DLASV2( T( ILAST-1, ILAST-1 ), T( ILAST-1, ILAST ),
+ $ T( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
*
IF( B11.LT.ZERO ) THEN
CR = -CR
@@ -826,17 +828,17 @@
B22 = -B22
END IF
*
- CALL DROT( ILASTM+1-IFIRST, A( ILAST-1, ILAST-1 ), LDA,
- $ A( ILAST, ILAST-1 ), LDA, CL, SL )
- CALL DROT( ILAST+1-IFRSTM, A( IFRSTM, ILAST-1 ), 1,
- $ A( IFRSTM, ILAST ), 1, CR, SR )
+ CALL DROT( ILASTM+1-IFIRST, H( ILAST-1, ILAST-1 ), LDH,
+ $ H( ILAST, ILAST-1 ), LDH, CL, SL )
+ CALL DROT( ILAST+1-IFRSTM, H( IFRSTM, ILAST-1 ), 1,
+ $ H( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILAST.LT.ILASTM )
- $ CALL DROT( ILASTM-ILAST, B( ILAST-1, ILAST+1 ), LDB,
- $ B( ILAST, ILAST+1 ), LDA, CL, SL )
+ $ CALL DROT( ILASTM-ILAST, T( ILAST-1, ILAST+1 ), LDT,
+ $ T( ILAST, ILAST+1 ), LDH, CL, SL )
IF( IFRSTM.LT.ILAST-1 )
- $ CALL DROT( IFIRST-IFRSTM, B( IFRSTM, ILAST-1 ), 1,
- $ B( IFRSTM, ILAST ), 1, CR, SR )
+ $ CALL DROT( IFIRST-IFRSTM, T( IFRSTM, ILAST-1 ), 1,
+ $ T( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILQ )
$ CALL DROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
@@ -845,17 +847,17 @@
$ CALL DROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
$ SR )
*
- B( ILAST-1, ILAST-1 ) = B11
- B( ILAST-1, ILAST ) = ZERO
- B( ILAST, ILAST-1 ) = ZERO
- B( ILAST, ILAST ) = B22
+ T( ILAST-1, ILAST-1 ) = B11
+ T( ILAST-1, ILAST ) = ZERO
+ T( ILAST, ILAST-1 ) = ZERO
+ T( ILAST, ILAST ) = B22
*
* If B22 is negative, negate column ILAST
*
IF( B22.LT.ZERO ) THEN
DO 210 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
210 CONTINUE
*
IF( ILZ ) THEN
@@ -869,8 +871,8 @@
*
* Recompute shift
*
- CALL DLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ TEMP, WR, TEMP2, WI )
*
* ------------------- Begin Timing Code ----------------------
@@ -887,10 +889,10 @@
*
* Do EISPACK (QZVAL) computation of alpha and beta
*
- A11 = A( ILAST-1, ILAST-1 )
- A21 = A( ILAST, ILAST-1 )
- A12 = A( ILAST-1, ILAST )
- A22 = A( ILAST, ILAST )
+ A11 = H( ILAST-1, ILAST-1 )
+ A21 = H( ILAST, ILAST-1 )
+ A12 = H( ILAST-1, ILAST )
+ A22 = H( ILAST, ILAST )
*
* Compute complex Givens rotation on right
* (Assume some element of C = (sA - wB) > unfl )
@@ -907,10 +909,10 @@
*
IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
$ ABS( C22R )+ABS( C22I ) ) THEN
- T = DLAPY3( C12, C11R, C11I )
- CZ = C12 / T
- SZR = -C11R / T
- SZI = -C11I / T
+ T1 = DLAPY3( C12, C11R, C11I )
+ CZ = C12 / T1
+ SZR = -C11R / T1
+ SZI = -C11I / T1
ELSE
CZ = DLAPY2( C22R, C22I )
IF( CZ.LE.SAFMIN ) THEN
@@ -920,10 +922,10 @@
ELSE
TEMPR = C22R / CZ
TEMPI = C22I / CZ
- T = DLAPY2( CZ, C21 )
- CZ = CZ / T
- SZR = -C21*TEMPR / T
- SZI = C21*TEMPI / T
+ T1 = DLAPY2( CZ, C21 )
+ CZ = CZ / T1
+ SZR = -C21*TEMPR / T1
+ SZI = C21*TEMPI / T1
END IF
END IF
*
@@ -957,10 +959,10 @@
SQI = TEMPI*A2R - TEMPR*A2I
END IF
END IF
- T = DLAPY3( CQ, SQR, SQI )
- CQ = CQ / T
- SQR = SQR / T
- SQI = SQI / T
+ T1 = DLAPY3( CQ, SQR, SQI )
+ CQ = CQ / T1
+ SQR = SQR / T1
+ SQI = SQI / T1
*
* Compute diagonal elements of QBZ
*
@@ -1016,26 +1018,26 @@
*
* We assume that the block is at least 3x3
*
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- U12 = B( ILAST-1, ILAST ) / B( ILAST, ILAST )
- AD11L = ( ASCALE*A( IFIRST, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD21L = ( ASCALE*A( IFIRST+1, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD12L = ( ASCALE*A( IFIRST, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD22L = ( ASCALE*A( IFIRST+1, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD32L = ( ASCALE*A( IFIRST+2, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- U12L = B( IFIRST, IFIRST+1 ) / B( IFIRST+1, IFIRST+1 )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ U12 = T( ILAST-1, ILAST ) / T( ILAST, ILAST )
+ AD11L = ( ASCALE*H( IFIRST, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD21L = ( ASCALE*H( IFIRST+1, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD12L = ( ASCALE*H( IFIRST, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD22L = ( ASCALE*H( IFIRST+1, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD32L = ( ASCALE*H( IFIRST+2, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ U12L = T( IFIRST, IFIRST+1 ) / T( IFIRST+1, IFIRST+1 )
*
V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
$ AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
@@ -1057,27 +1059,27 @@
* Zero (j-1)st column of A
*
IF( J.GT.ISTART ) THEN
- V( 1 ) = A( J, J-1 )
- V( 2 ) = A( J+1, J-1 )
- V( 3 ) = A( J+2, J-1 )
+ V( 1 ) = H( J, J-1 )
+ V( 2 ) = H( J+1, J-1 )
+ V( 3 ) = H( J+2, J-1 )
*
- CALL DLARFG( 3, A( J, J-1 ), V( 2 ), 1, TAU )
+ CALL DLARFG( 3, H( J, J-1 ), V( 2 ), 1, TAU )
V( 1 ) = ONE
- A( J+1, J-1 ) = ZERO
- A( J+2, J-1 ) = ZERO
+ H( J+1, J-1 ) = ZERO
+ H( J+2, J-1 ) = ZERO
END IF
*
DO 230 JC = J, ILASTM
- TEMP = TAU*( A( J, JC )+V( 2 )*A( J+1, JC )+V( 3 )*
- $ A( J+2, JC ) )
- A( J, JC ) = A( J, JC ) - TEMP
- A( J+1, JC ) = A( J+1, JC ) - TEMP*V( 2 )
- A( J+2, JC ) = A( J+2, JC ) - TEMP*V( 3 )
- TEMP2 = TAU*( B( J, JC )+V( 2 )*B( J+1, JC )+V( 3 )*
- $ B( J+2, JC ) )
- B( J, JC ) = B( J, JC ) - TEMP2
- B( J+1, JC ) = B( J+1, JC ) - TEMP2*V( 2 )
- B( J+2, JC ) = B( J+2, JC ) - TEMP2*V( 3 )
+ TEMP = TAU*( H( J, JC )+V( 2 )*H( J+1, JC )+V( 3 )*
+ $ H( J+2, JC ) )
+ H( J, JC ) = H( J, JC ) - TEMP
+ H( J+1, JC ) = H( J+1, JC ) - TEMP*V( 2 )
+ H( J+2, JC ) = H( J+2, JC ) - TEMP*V( 3 )
+ TEMP2 = TAU*( T( J, JC )+V( 2 )*T( J+1, JC )+V( 3 )*
+ $ T( J+2, JC ) )
+ T( J, JC ) = T( J, JC ) - TEMP2
+ T( J+1, JC ) = T( J+1, JC ) - TEMP2*V( 2 )
+ T( J+2, JC ) = T( J+2, JC ) - TEMP2*V( 3 )
230 CONTINUE
IF( ILQ ) THEN
DO 240 JR = 1, N
@@ -1094,27 +1096,27 @@
* Swap rows to pivot
*
ILPIVT = .FALSE.
- TEMP = MAX( ABS( B( J+1, J+1 ) ), ABS( B( J+1, J+2 ) ) )
- TEMP2 = MAX( ABS( B( J+2, J+1 ) ), ABS( B( J+2, J+2 ) ) )
+ TEMP = MAX( ABS( T( J+1, J+1 ) ), ABS( T( J+1, J+2 ) ) )
+ TEMP2 = MAX( ABS( T( J+2, J+1 ) ), ABS( T( J+2, J+2 ) ) )
IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
SCALE = ZERO
U1 = ONE
U2 = ZERO
GO TO 250
ELSE IF( TEMP.GE.TEMP2 ) THEN
- W11 = B( J+1, J+1 )
- W21 = B( J+2, J+1 )
- W12 = B( J+1, J+2 )
- W22 = B( J+2, J+2 )
- U1 = B( J+1, J )
- U2 = B( J+2, J )
+ W11 = T( J+1, J+1 )
+ W21 = T( J+2, J+1 )
+ W12 = T( J+1, J+2 )
+ W22 = T( J+2, J+2 )
+ U1 = T( J+1, J )
+ U2 = T( J+2, J )
ELSE
- W21 = B( J+1, J+1 )
- W11 = B( J+2, J+1 )
- W22 = B( J+1, J+2 )
- W12 = B( J+2, J+2 )
- U2 = B( J+1, J )
- U1 = B( J+2, J )
+ W21 = T( J+1, J+1 )
+ W11 = T( J+2, J+1 )
+ W22 = T( J+1, J+2 )
+ W12 = T( J+2, J+2 )
+ U2 = T( J+1, J )
+ U1 = T( J+2, J )
END IF
*
* Swap columns if nec.
@@ -1164,9 +1166,9 @@
*
* Compute Householder Vector
*
- T = SQRT( SCALE**2+U1**2+U2**2 )
- TAU = ONE + SCALE / T
- VS = -ONE / ( SCALE+T )
+ T1 = SQRT( SCALE**2+U1**2+U2**2 )
+ TAU = ONE + SCALE / T1
+ VS = -ONE / ( SCALE+T1 )
V( 1 ) = ONE
V( 2 ) = VS*U1
V( 3 ) = VS*U2
@@ -1174,18 +1176,18 @@
* Apply transformations from the right.
*
DO 260 JR = IFRSTM, MIN( J+3, ILAST )
- TEMP = TAU*( A( JR, J )+V( 2 )*A( JR, J+1 )+V( 3 )*
- $ A( JR, J+2 ) )
- A( JR, J ) = A( JR, J ) - TEMP
- A( JR, J+1 ) = A( JR, J+1 ) - TEMP*V( 2 )
- A( JR, J+2 ) = A( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( H( JR, J )+V( 2 )*H( JR, J+1 )+V( 3 )*
+ $ H( JR, J+2 ) )
+ H( JR, J ) = H( JR, J ) - TEMP
+ H( JR, J+1 ) = H( JR, J+1 ) - TEMP*V( 2 )
+ H( JR, J+2 ) = H( JR, J+2 ) - TEMP*V( 3 )
260 CONTINUE
DO 270 JR = IFRSTM, J + 2
- TEMP = TAU*( B( JR, J )+V( 2 )*B( JR, J+1 )+V( 3 )*
- $ B( JR, J+2 ) )
- B( JR, J ) = B( JR, J ) - TEMP
- B( JR, J+1 ) = B( JR, J+1 ) - TEMP*V( 2 )
- B( JR, J+2 ) = B( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( T( JR, J )+V( 2 )*T( JR, J+1 )+V( 3 )*
+ $ T( JR, J+2 ) )
+ T( JR, J ) = T( JR, J ) - TEMP
+ T( JR, J+1 ) = T( JR, J+1 ) - TEMP*V( 2 )
+ T( JR, J+2 ) = T( JR, J+2 ) - TEMP*V( 3 )
270 CONTINUE
IF( ILZ ) THEN
DO 280 JR = 1, N
@@ -1196,8 +1198,8 @@
Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
280 CONTINUE
END IF
- B( J+1, J ) = ZERO
- B( J+2, J ) = ZERO
+ T( J+1, J ) = ZERO
+ T( J+2, J ) = ZERO
290 CONTINUE
*
* Last elements: Use Givens rotations
@@ -1205,17 +1207,17 @@
* Rotations from the left
*
J = ILAST - 1
- TEMP = A( J, J-1 )
- CALL DLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
*
DO 300 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
300 CONTINUE
IF( ILQ ) THEN
DO 310 JR = 1, N
@@ -1227,19 +1229,19 @@
*
* Rotations from the right.
*
- TEMP = B( J+1, J+1 )
- CALL DLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 320 JR = IFRSTM, ILAST
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
320 CONTINUE
DO 330 JR = IFRSTM, ILAST - 1
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
330 CONTINUE
IF( ILZ ) THEN
DO 340 JR = 1, N
@@ -1290,15 +1292,15 @@
* Set Eigenvalues 1:ILO-1
*
DO 410 J = 1, ILO - 1
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 390 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
390 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 400 JR = 1, N
@@ -1306,9 +1308,9 @@
400 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
410 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/dtgevc.f LAPACK/TIMING/EIG/EIGSRC/dtgevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/dtgevc.f Thu Nov 4 14:28:32 1999
+++ LAPACK/TIMING/EIG/EIGSRC/dtgevc.f Fri May 25 16:20:45 2001
@@ -1,18 +1,18 @@
- SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
- DOUBLE PRECISION A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ DOUBLE PRECISION P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -33,35 +33,31 @@
* Purpose
* =======
*
-* DTGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of real upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* DTGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of real matrices (S,P), where S is a quasi-triangular matrix
+* and P is upper triangular. Matrix pairs of this type are produced by
+* the generalized Schur factorization of a matrix pair (A,B):
+*
+* A = Q*S*Z**T, B = Q*P*Z**T
+*
+* as computed by DGGHRD + DHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input orthogonal
-* matrices. If (A,B) was obtained from the generalized real-Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
-*
-* A must be block upper triangular, with 1-by-1 and 2-by-2 diagonal
-* blocks. Corresponding to each 2-by-2 diagonal block is a complex
-* conjugate pair of eigenvalues and eigenvectors; only one
-* eigenvector of the pair is computed, namely the one corresponding
-* to the eigenvalue with positive imaginary part.
-*
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal blocks of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the orthogonal factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
+*
* Arguments
* =========
*
@@ -72,78 +68,84 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to the real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must
-* be set to .TRUE..
+* computed. If w(j) is a real eigenvalue, the corresponding
+* real eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector
+* is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+* and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+* set to .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
+* The order of the matrices S and P. N >= 0.
*
-* A (input) DOUBLE PRECISION array, dimension (LDA,N)
-* The upper quasi-triangular matrix A.
+* S (input) DOUBLE PRECISION array, dimension (LDS,N)
+* The upper quasi-triangular matrix S from a generalized Schur
+* factorization, as computed by DHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) DOUBLE PRECISION array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by DHGEQZ.
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+* of S must be in positive diagonal form.
*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1,N).
-*
-* B (input) DOUBLE PRECISION array, dimension (LDB,N)
-* The upper triangular matrix B. If A has a 2-by-2 diagonal
-* block, then the corresponding 2-by-2 block of B must be
-* diagonal with positive elements.
-*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the orthogonal matrix Q
* of left Schur vectors returned by DHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
*
+* Not referenced if SIDE = 'R'.
+*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-* contain an N-by-N matrix Q (usually the orthogonal matrix Z
+* contain an N-by-N matrix Z (usually the orthogonal matrix Z
* of right Schur vectors returned by DHGEQZ).
+*
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
-* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
-* SELECT, stored consecutively in the columns of
-* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+* if HOWMNY = 'B' or 'b', the matrix Z*X;
+* if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+* specified by SELECT, stored consecutively in the
+* columns of VR, in the same order as their
+* eigenvalues.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
+*
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
@@ -212,7 +214,7 @@
* partial sums. Since FORTRAN arrays are stored columnwise, this has
* the advantage that at each step, the elements of C that are accessed
* are adjacent to one another, whereas with the rowwise method, the
-* elements accessed at a step are spaced LDA (and LDB) words apart.
+* elements accessed at a step are spaced LDS (and LDP) words apart.
*
* When finding left eigenvectors, the matrix in question is the
* transpose of the one in storage, so the rowwise method then
@@ -239,8 +241,8 @@
$ TEMP2R, ULP, XMAX, XSCALE
* ..
* .. Local Arrays ..
- DOUBLE PRECISION BDIAG( 2 ), SUM( 2, 2 ), SUMA( 2, 2 ),
- $ SUMB( 2, 2 )
+ DOUBLE PRECISION BDIAG( 2 ), SUM( 2, 2 ), SUMS( 2, 2 ),
+ $ SUMP( 2, 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -265,7 +267,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -297,9 +299,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -318,7 +320,7 @@
GO TO 10
END IF
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO )
+ IF( S( J+1, J ).NE.ZERO )
$ ILCPLX = .TRUE.
END IF
IF( ILCPLX ) THEN
@@ -338,11 +340,11 @@
ILABAD = .FALSE.
ILBBAD = .FALSE.
DO 20 J = 1, N - 1
- IF( A( J+1, J ).NE.ZERO ) THEN
- IF( B( J, J ).EQ.ZERO .OR. B( J+1, J+1 ).EQ.ZERO .OR.
- $ B( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
+ IF( S( J+1, J ).NE.ZERO ) THEN
+ IF( P( J, J ).EQ.ZERO .OR. P( J+1, J+1 ).EQ.ZERO .OR.
+ $ P( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
IF( J.LT.N-1 ) THEN
- IF( A( J+2, J+1 ).NE.ZERO )
+ IF( S( J+2, J+1 ).NE.ZERO )
$ ILABAD = .TRUE.
END IF
END IF
@@ -385,30 +387,30 @@
* blocks) of A and B to check for possible overflow in the
* triangular solver.
*
- ANORM = ABS( A( 1, 1 ) )
+ ANORM = ABS( S( 1, 1 ) )
IF( N.GT.1 )
- $ ANORM = ANORM + ABS( A( 2, 1 ) )
- BNORM = ABS( B( 1, 1 ) )
+ $ ANORM = ANORM + ABS( S( 2, 1 ) )
+ BNORM = ABS( P( 1, 1 ) )
WORK( 1 ) = ZERO
WORK( N+1 ) = ZERO
*
DO 50 J = 2, N
TEMP = ZERO
TEMP2 = ZERO
- IF( A( J, J-1 ).EQ.ZERO ) THEN
+ IF( S( J, J-1 ).EQ.ZERO ) THEN
IEND = J - 1
ELSE
IEND = J - 2
END IF
DO 30 I = 1, IEND
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
30 CONTINUE
WORK( J ) = TEMP
WORK( N+J ) = TEMP2
DO 40 I = IEND + 1, MIN( J+1, N )
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
40 CONTINUE
ANORM = MAX( ANORM, TEMP )
BNORM = MAX( BNORM, TEMP2 )
@@ -442,7 +444,7 @@
END IF
NW = 1
IF( JE.LT.N ) THEN
- IF( A( JE+1, JE ).NE.ZERO ) THEN
+ IF( S( JE+1, JE ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -461,8 +463,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- returns unit eigenvector
*
@@ -489,10 +491,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -534,7 +536,7 @@
*
* Complex eigenvalue
*
- CALL DLAG2( A( JE, JE ), LDA, B( JE, JE ), LDB,
+ CALL DLAG2( S( JE, JE ), LDS, P( JE, JE ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
BCOEFI = -BCOEFI
@@ -566,9 +568,9 @@
*
* Compute first two components of eigenvector
*
- TEMP = ACOEF*A( JE+1, JE )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE+1, JE )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GT.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -577,10 +579,10 @@
ELSE
WORK( 2*N+JE+1 ) = ONE
WORK( 3*N+JE+1 ) = ZERO
- TEMP = ACOEF*A( JE, JE+1 )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE+1, JE+1 )-ACOEF*
- $ A( JE+1, JE+1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE+1, JE+1 ) / TEMP
+ TEMP = ACOEF*S( JE, JE+1 )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE+1, JE+1 )-ACOEF*
+ $ S( JE+1, JE+1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE+1, JE+1 ) / TEMP
END IF
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
$ ABS( WORK( 2*N+JE+1 ) )+ABS( WORK( 3*N+JE+1 ) ) )
@@ -610,11 +612,11 @@
END IF
*
NA = 1
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO ) THEN
+ IF( S( J+1, J ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
NA = 2
* ---------------- Begin Timing Code ----------------
IN2BY2 = IN2BY2 + 1
@@ -646,13 +648,13 @@
* Compute dot products
*
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
*
* To reduce the op count, this is done as
*
* _ j-1 _ j-1
-* a*conjg( sum A(k,j)*x(k) ) - b*conjg( sum B(k,j)*x(k) )
+* a*conjg( sum S(k,j)*x(k) ) - b*conjg( sum P(k,j)*x(k) )
* k=je k=je
*
* which may cause underflow problems if A or B are close
@@ -689,15 +691,15 @@
*$PL$ CMCHAR='*'
*
DO 110 JA = 1, NA
- SUMA( JA, JW ) = ZERO
- SUMB( JA, JW ) = ZERO
+ SUMS( JA, JW ) = ZERO
+ SUMP( JA, JW ) = ZERO
*
DO 100 JR = JE, J - 1
- SUMA( JA, JW ) = SUMA( JA, JW ) +
- $ A( JR, J+JA-1 )*
+ SUMS( JA, JW ) = SUMS( JA, JW ) +
+ $ S( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
- SUMB( JA, JW ) = SUMB( JA, JW ) +
- $ B( JR, J+JA-1 )*
+ SUMP( JA, JW ) = SUMP( JA, JW ) +
+ $ P( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
100 CONTINUE
110 CONTINUE
@@ -717,15 +719,15 @@
*
DO 130 JA = 1, NA
IF( ILCPLX ) THEN
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 ) -
- $ BCOEFI*SUMB( JA, 2 )
- SUM( JA, 2 ) = -ACOEF*SUMA( JA, 2 ) +
- $ BCOEFR*SUMB( JA, 2 ) +
- $ BCOEFI*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 ) -
+ $ BCOEFI*SUMP( JA, 2 )
+ SUM( JA, 2 ) = -ACOEF*SUMS( JA, 2 ) +
+ $ BCOEFR*SUMP( JA, 2 ) +
+ $ BCOEFI*SUMP( JA, 1 )
ELSE
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 )
END IF
130 CONTINUE
*
@@ -733,7 +735,7 @@
* Solve ( a A - b B ) y = SUM(,)
* with scaling and perturbation of the denominator
*
- CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, A( J, J ), LDA,
+ CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS,
$ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR,
$ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP,
$ IINFO )
@@ -859,7 +861,7 @@
END IF
NW = 1
IF( JE.GT.1 ) THEN
- IF( A( JE, JE-1 ).NE.ZERO ) THEN
+ IF( S( JE, JE-1 ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -878,8 +880,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- returns unit eigenvector
*
@@ -908,10 +910,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -954,14 +956,14 @@
* (See "Further Details", above.)
*
DO 260 JR = 1, JE - 1
- WORK( 2*N+JR ) = BCOEFR*B( JR, JE ) -
- $ ACOEF*A( JR, JE )
+ WORK( 2*N+JR ) = BCOEFR*P( JR, JE ) -
+ $ ACOEF*S( JR, JE )
260 CONTINUE
ELSE
*
* Complex eigenvalue
*
- CALL DLAG2( A( JE-1, JE-1 ), LDA, B( JE-1, JE-1 ), LDB,
+ CALL DLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
IF( BCOEFI.EQ.ZERO ) THEN
@@ -993,9 +995,9 @@
* Compute first two components of eigenvector
* and contribution to sums
*
- TEMP = ACOEF*A( JE, JE-1 )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE, JE-1 )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GE.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -1004,10 +1006,10 @@
ELSE
WORK( 2*N+JE-1 ) = ONE
WORK( 3*N+JE-1 ) = ZERO
- TEMP = ACOEF*A( JE-1, JE )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE-1, JE-1 )-ACOEF*
- $ A( JE-1, JE-1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE-1, JE-1 ) / TEMP
+ TEMP = ACOEF*S( JE-1, JE )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE-1, JE-1 )-ACOEF*
+ $ S( JE-1, JE-1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE-1, JE-1 ) / TEMP
END IF
*
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
@@ -1027,12 +1029,12 @@
CRE2B = BCOEFR*WORK( 2*N+JE ) - BCOEFI*WORK( 3*N+JE )
CIM2B = BCOEFI*WORK( 2*N+JE ) + BCOEFR*WORK( 3*N+JE )
DO 270 JR = 1, JE - 2
- WORK( 2*N+JR ) = -CREALA*A( JR, JE-1 ) +
- $ CREALB*B( JR, JE-1 ) -
- $ CRE2A*A( JR, JE ) + CRE2B*B( JR, JE )
- WORK( 3*N+JR ) = -CIMAGA*A( JR, JE-1 ) +
- $ CIMAGB*B( JR, JE-1 ) -
- $ CIM2A*A( JR, JE ) + CIM2B*B( JR, JE )
+ WORK( 2*N+JR ) = -CREALA*S( JR, JE-1 ) +
+ $ CREALB*P( JR, JE-1 ) -
+ $ CRE2A*S( JR, JE ) + CRE2B*P( JR, JE )
+ WORK( 3*N+JR ) = -CIMAGA*S( JR, JE-1 ) +
+ $ CIMAGB*P( JR, JE-1 ) -
+ $ CIM2A*S( JR, JE ) + CIM2B*P( JR, JE )
270 CONTINUE
END IF
*
@@ -1054,7 +1056,7 @@
* next iteration to process it (when it will be j:j+1)
*
IF( .NOT.IL2BY2 .AND. J.GT.1 ) THEN
- IF( A( J, J-1 ).NE.ZERO ) THEN
+ IF( S( J, J-1 ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
* -------------- Begin Timing Code -----------------
IN2BY2 = IN2BY2 + 1
@@ -1062,18 +1064,18 @@
GO TO 370
END IF
END IF
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( IL2BY2 ) THEN
NA = 2
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
ELSE
NA = 1
END IF
*
* Compute x(j) (and x(j+1), if 2-by-2 block)
*
- CALL DLALN2( .FALSE., NA, NW, DMIN, ACOEF, A( J, J ),
- $ LDA, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
+ CALL DLALN2( .FALSE., NA, NW, DMIN, ACOEF, S( J, J ),
+ $ LDS, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
$ N, BCOEFR, BCOEFI, SUM, 2, SCALE, TEMP,
$ IINFO )
IF( SCALE.LT.ONE ) THEN
@@ -1096,7 +1098,7 @@
300 CONTINUE
310 CONTINUE
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( J.GT.1 ) THEN
*
@@ -1137,19 +1139,19 @@
$ BCOEFR*WORK( 3*N+J+JA-1 )
DO 340 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
WORK( 3*N+JR ) = WORK( 3*N+JR ) -
- $ CIMAGA*A( JR, J+JA-1 ) +
- $ CIMAGB*B( JR, J+JA-1 )
+ $ CIMAGA*S( JR, J+JA-1 ) +
+ $ CIMAGB*P( JR, J+JA-1 )
340 CONTINUE
ELSE
CREALA = ACOEF*WORK( 2*N+J+JA-1 )
CREALB = BCOEFR*WORK( 2*N+J+JA-1 )
DO 350 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
350 CONTINUE
END IF
360 CONTINUE
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/dtrevc.f LAPACK/TIMING/EIG/EIGSRC/dtrevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/dtrevc.f Thu Nov 4 14:28:33 1999
+++ LAPACK/TIMING/EIG/EIGSRC/dtrevc.f Fri May 25 16:21:00 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -30,28 +30,23 @@
*
* DTREVC computes some or all of the right and/or left eigenvectors of
* a real upper quasi-triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a real general matrix: A = Q*T*Q**T, as computed by DHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input orthogonal
-* matrix. If T was obtained from the real-Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
-*
-* T must be in Schur canonical form (as returned by DHSEQR), that is,
-* block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-* 2-by-2 diagonal block has its diagonal elements equal and its
-* off-diagonal elements of opposite sign. Corresponding to each 2-by-2
-* diagonal block is a complex conjugate pair of eigenvalues and
-* eigenvectors; only one eigenvector of the pair is computed, namely
-* the one corresponding to the eigenvalue with positive imaginary part.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal blocks of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the orthogonal factor that reduces a matrix
+* A to Schur form T, then Q*X and Q*Y are the matrices of right and
+* left eigenvectors of A.
*
* Arguments
* =========
@@ -64,21 +59,21 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input/output) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to a real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE.. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must be
-* set to .TRUE.; then on exit SELECT(j) is .TRUE. and
-* SELECT(j+1) is .FALSE..
+* If w(j) is a real eigenvalue, the corresponding real
+* eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector is
+* computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+* on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+* .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -95,15 +90,6 @@
* of Schur vectors returned by DHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL has the same quasi-lower triangular form
-* as T'. If T(i,i) is a real eigenvalue, then
-* the i-th column VL(i) of VL is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VL(i)+sqrt(-1)*VL(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -112,11 +98,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -124,15 +110,6 @@
* of Schur vectors returned by DHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR has the same quasi-upper triangular form
-* as T. If T(i,i) is a real eigenvalue, then
-* the i-th column VR(i) of VR is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VR(i)+sqrt(-1)*VR(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -141,11 +118,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/sbdsqr.f LAPACK/TIMING/EIG/EIGSRC/sbdsqr.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/sbdsqr.f Thu Nov 4 14:28:32 1999
+++ LAPACK/TIMING/EIG/EIGSRC/sbdsqr.f Fri May 25 16:19:49 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -26,14 +26,26 @@
* Purpose
* =======
*
-* SBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
+* SBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**T
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**T*VT instead of
+* P**T, for given real input matrices U and VT. When U and VT are the
+* orthogonal matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by SGEBRD, then
*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given real input matrices U, VT, and C.
+* A = (U*Q) * S * (P**T*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**T*C
+* for a given real input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -69,18 +81,17 @@
* order.
*
* E (input/output) REAL array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) REAL array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**T * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -89,21 +100,22 @@
* U (input/output) REAL array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) REAL array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**T * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* WORK (workspace) REAL array, dimension (4*N)
+* WORK (workspace) REAL array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/sgghrd.f LAPACK/TIMING/EIG/EIGSRC/sgghrd.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/sgghrd.f Thu Nov 4 14:28:29 1999
+++ LAPACK/TIMING/EIG/EIGSRC/sgghrd.f Fri May 25 16:20:10 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -33,16 +33,32 @@
*
* SGGHRD reduces a pair of real matrices (A,B) to generalized upper
* Hessenberg form using orthogonal transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are orthogonal, and ' means transpose.
+* general matrix and B is upper triangular. The form of the
+* generalized eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the orthogonal matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**T*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**T*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**T*x.
*
* The orthogonal matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
* postmultiplied into input matrices Q1 and Z1, so that
*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
+*
+* Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
+*
+* If Q1 is the orthogonal matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then SGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -66,10 +82,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to SGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to SGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) REAL array, dimension (LDA, N)
@@ -83,33 +100,28 @@
*
* B (input/output) REAL array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**T B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) REAL array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the orthogonal matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain an orthogonal matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the orthogonal matrix Q1,
+* typically from the QR factorization of B.
+* On exit, if COMPQ='I', the orthogonal matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) REAL array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the orthogonal matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain an orthogonal matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1.
+* On exit, if COMPZ='I', the orthogonal matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/shgeqz.f LAPACK/TIMING/EIG/EIGSRC/shgeqz.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/shgeqz.f Thu Nov 4 14:28:33 1999
+++ LAPACK/TIMING/EIG/EIGSRC/shgeqz.f Fri May 25 16:20:29 2001
@@ -1,20 +1,20 @@
- SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
$ LWORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
- REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
- $ B( LDB, * ), BETA( * ), Q( LDQ, * ), WORK( * ),
- $ Z( LDZ, * )
+ REAL ALPHAI( * ), ALPHAR( * ), BETA( * ),
+ $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
+ $ WORK( * ), Z( LDZ, * )
* ..
* ---------------------- Begin Timing Code -------------------------
* Common block to return operation count and iteration count
@@ -32,37 +32,56 @@
* Purpose
* =======
*
-* SHGEQZ implements a single-/double-shift version of the QZ method for
-* finding the generalized eigenvalues
-*
-* w(j)=(ALPHAR(j) + i*ALPHAI(j))/BETAR(j) of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* In addition, the pair A,B may be reduced to generalized Schur form:
-* B is upper triangular, and A is block upper triangular, where the
-* diagonal blocks are either 1-by-1 or 2-by-2, the 2-by-2 blocks having
-* complex generalized eigenvalues (see the description of the argument
-* JOB.)
-*
-* If JOB='S', then the pair (A,B) is simultaneously reduced to Schur
-* form by applying one orthogonal tranformation (usually called Q) on
-* the left and another (usually called Z) on the right. The 2-by-2
-* upper-triangular diagonal blocks of B corresponding to 2-by-2 blocks
-* of A will be reduced to positive diagonal matrices. (I.e.,
-* if A(j+1,j) is non-zero, then B(j+1,j)=B(j,j+1)=0 and B(j,j) and
-* B(j+1,j+1) will be positive.)
-*
-* If JOB='E', then at each iteration, the same transformations
-* are computed, but they are only applied to those parts of A and B
-* which are needed to compute ALPHAR, ALPHAI, and BETAR.
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the orthogonal
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* SHGEQZ computes the eigenvalues of a real matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the double-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a real matrix pair (A,B):
+*
+* A = Q1*H*Z1**T, B = Q1*T*Z1**T,
+*
+* as computed by SGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**T, T = Q*P*Z**T,
+*
+* where Q and Z are orthogonal matrices, P is an upper triangular
+* matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
+* diagonal blocks.
+*
+* The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
+* (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
+* eigenvalues.
+*
+* Additionally, the 2-by-2 upper triangular diagonal blocks of P
+* corresponding to 2-by-2 blocks of S are reduced to positive diagonal
+* form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
+* P(j,j) > 0, and P(j+1,j+1) > 0.
+*
+* Optionally, the orthogonal matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* orthogonal matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the orthogonal matrices from SGGHRD that reduced
+* the matrix pair (A,B) to generalized upper Hessenberg form, then the
+* output matrices Q1*Q and Z1*Z are the orthogonal factors from the
+* generalized Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**T, B = (Q1*Q)*P*(Z1*Z)**T.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
+* of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
+* complex and beta real.
+* If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
+* generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* Real eigenvalues can be read directly from the generalized Schur
+* form:
+* alpha = S(i,i), beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -72,114 +91,98 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHAR, ALPHAI, and BETA. A and B will
-* not necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHAR, ALPHAI, and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Compute eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the transpose of
-* the orthogonal tranformation that is applied to the
-* left side of A and B to reduce them to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain an orthogonal matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the orthogonal
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Z is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain an orthogonal matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) REAL array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to generalized Schur form.
-* If JOB='E', then on exit A will have been destroyed.
-* The diagonal blocks will be correct, but the off-diagonal
-* portion will be meaningless.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) REAL array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero. 2-by-2 blocks in B
-* corresponding to 2-by-2 blocks in A will be reduced to
-* positive diagonal form. (I.e., if A(j+1,j) is non-zero,
-* then B(j+1,j)=B(j,j+1)=0 and B(j,j) and B(j+1,j+1) will be
-* positive.)
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to Schur form.
-* If JOB='E', then on exit B will have been destroyed.
-* Elements corresponding to diagonal blocks of A will be
-* correct, but the off-diagonal portion will be meaningless.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) REAL array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper quasi-triangular
+* matrix S from the generalized Schur factorization;
+* 2-by-2 diagonal blocks (corresponding to complex conjugate
+* pairs of eigenvalues) are returned in standard form, with
+* H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
+* If JOB = 'E', the diagonal blocks of H match those of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) REAL array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization;
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of S
+* are reduced to positive diagonal form, i.e., if H(j+1,j) is
+* non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
+* T(j+1,j+1) > 0.
+* If JOB = 'E', the diagonal blocks of T match those of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHAR (output) REAL array, dimension (N)
-* ALPHAR(1:N) will be set to real parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=A(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The real parts of each scalar alpha defining an eigenvalue
+* of GNEP.
*
* ALPHAI (output) REAL array, dimension (N)
-* ALPHAI(1:N) will be set to imaginary parts of the diagonal
-* elements of A that would result from reducing A and B to
-* Schur form and then further reducing them both to triangular
-* form using unitary transformations s.t. the diagonal of B
-* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=0.
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
+* The imaginary parts of each scalar alpha defining an
+* eigenvalue of GNEP.
+* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+* positive, then the j-th and (j+1)-st eigenvalues are a
+* complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
*
* BETA (output) REAL array, dimension (N)
-* BETA(1:N) will be set to the (real) diagonal elements of B
-* that would result from reducing A and B to Schur form and
-* then further reducing them both to triangular form using
-* unitary transformations s.t. the diagonal of B was
-* non-negative real. Thus, if A(j,j) is in a 1-by-1 block
-* (i.e., A(j+1,j)=A(j,j+1)=0), then BETA(j)=B(j,j).
-* Note that the (real or complex) values
-* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
-* generalized eigenvalues of the matrix pencil A - wB.
-* (Note that BETA(1:N) will always be non-negative, and no
-* BETAI is necessary.)
+* The scalars beta that define the eigenvalues of GNEP.
+* Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
+* beta = BETA(j) represent the j-th eigenvalue of the matrix
+* pair (A,B), in one of the forms lambda = alpha/beta or
+* mu = beta/alpha. Since either lambda or mu may overflow,
+* they should not, in general, be computed.
*
* Q (input/output) REAL array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the transpose of the orthogonal
-* transformations which are applied to A and B on the left
-* will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
+* of left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) REAL array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the orthogonal transformations
-* which are applied to A and B on the right will be applied
-* to the array Z on the right.
+* On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
+* the reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the orthogonal matrix of
+* right Schur vectors of (H,T), and if COMPZ = 'V', the
+* orthogonal matrix of right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -199,13 +202,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHAR(i), ALPHAI(i), and
* BETA(i), i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -237,7 +239,7 @@
$ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
$ CQ, CR, CZ, ESHIFT, OPST, S, S1, S1INV, S2,
$ SAFMAX, SAFMIN, SCALE, SL, SQI, SQR, SR, SZI,
- $ SZR, T, TAU, TEMP, TEMP2, TEMPI, TEMPR, U1,
+ $ SZR, T1, TAU, TEMP, TEMP2, TEMPI, TEMPR, U1,
$ U12, U12L, U2, ULP, VS, W11, W12, W21, W22,
$ WABS, WI, WR, WR2
* ..
@@ -319,9 +321,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -15
@@ -360,8 +362,8 @@
SAFMIN = SLAMCH( 'S' )
SAFMAX = ONE / SAFMIN
ULP = SLAMCH( 'E' )*SLAMCH( 'B' )
- ANORM = SLANHS( 'F', IN, A( ILO, ILO ), LDA, WORK )
- BNORM = SLANHS( 'F', IN, B( ILO, ILO ), LDB, WORK )
+ ANORM = SLANHS( 'F', IN, H( ILO, ILO ), LDH, WORK )
+ BNORM = SLANHS( 'F', IN, T( ILO, ILO ), LDT, WORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -370,15 +372,15 @@
* Set Eigenvalues IHI+1:N
*
DO 30 J = IHI + 1, N
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 10 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
10 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 20 JR = 1, N
@@ -386,9 +388,9 @@
20 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
30 CONTINUE
*
* ---------------------- Begin Timing Code -------------------------
@@ -435,8 +437,8 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
IF( ILAST.EQ.ILO ) THEN
*
@@ -444,14 +446,14 @@
*
GO TO 80
ELSE
- IF( ABS( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = ZERO
+ IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = ZERO
GO TO 80
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = ZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = ZERO
GO TO 70
END IF
*
@@ -459,36 +461,36 @@
*
DO 60 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = ZERO
+ IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = ZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = ZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = ZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- TEMP = ABS( A( J, J-1 ) )
- TEMP2 = ABS( A( J, J ) )
+ TEMP = ABS( H( J, J-1 ) )
+ TEMP2 = ABS( H( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( TEMP*( ASCALE*ABS( A( J+1, J ) ) ).LE.TEMP2*
+ IF( TEMP*( ASCALE*ABS( H( J+1, J ) ) ).LE.TEMP2*
$ ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
END IF
*
@@ -500,26 +502,26 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 40 JCH = J, ILAST - 1
- TEMP = A( JCH, JCH )
- CALL SLARTG( TEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = ZERO
- CALL SROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL SROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ TEMP = H( JCH, JCH )
+ CALL SLARTG( TEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = ZERO
+ CALL SROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL SROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
*
* --------------- Begin Timing Code -----------------
OPST = OPST + REAL( 7+12*( ILASTM-JCH )+6*NQ )
* ---------------- End Timing Code ------------------
*
- IF( ABS( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 80
ELSE
@@ -527,35 +529,35 @@
GO TO 110
END IF
END IF
- B( JCH+1, JCH+1 ) = ZERO
+ T( JCH+1, JCH+1 ) = ZERO
40 CONTINUE
GO TO 70
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 50 JCH = J, ILAST - 1
- TEMP = B( JCH, JCH+1 )
- CALL SLARTG( TEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = ZERO
+ TEMP = T( JCH, JCH+1 )
+ CALL SLARTG( TEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = ZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL SROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL SROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL SROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL SROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, S )
- TEMP = A( JCH+1, JCH )
- CALL SLARTG( TEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = ZERO
- CALL SROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL SROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ TEMP = H( JCH+1, JCH )
+ CALL SLARTG( TEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = ZERO
+ CALL SROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL SROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL SROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -585,18 +587,18 @@
INFO = N + 1
GO TO 420
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
70 CONTINUE
- TEMP = A( ILAST, ILAST )
- CALL SLARTG( TEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = ZERO
- CALL SROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL SROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ TEMP = H( ILAST, ILAST )
+ CALL SLARTG( TEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = ZERO
+ CALL SROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL SROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL SROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
*
@@ -605,19 +607,19 @@
* ---------------------- End Timing Code ------------------------
*
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
* and BETA
*
80 CONTINUE
- IF( B( ILAST, ILAST ).LT.ZERO ) THEN
+ IF( T( ILAST, ILAST ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 90 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
90 CONTINUE
ELSE
- A( ILAST, ILAST ) = -A( ILAST, ILAST )
- B( ILAST, ILAST ) = -B( ILAST, ILAST )
+ H( ILAST, ILAST ) = -H( ILAST, ILAST )
+ T( ILAST, ILAST ) = -T( ILAST, ILAST )
END IF
IF( ILZ ) THEN
DO 100 J = 1, N
@@ -625,9 +627,9 @@
100 CONTINUE
END IF
END IF
- ALPHAR( ILAST ) = A( ILAST, ILAST )
+ ALPHAR( ILAST ) = H( ILAST, ILAST )
ALPHAI( ILAST ) = ZERO
- BETA( ILAST ) = B( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -660,7 +662,7 @@
* Compute single shifts.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.EQ.IITER ) THEN
@@ -668,10 +670,10 @@
* Exceptional shift. Chosen for no particularly good reason.
* (Single shift only.)
*
- IF( ( REAL( MAXIT )*SAFMIN )*ABS( A( ILAST-1, ILAST ) ).LT.
- $ ABS( B( ILAST-1, ILAST-1 ) ) ) THEN
- ESHIFT = ESHIFT + A( ILAST-1, ILAST ) /
- $ B( ILAST-1, ILAST-1 )
+ IF( ( REAL( MAXIT )*SAFMIN )*ABS( H( ILAST-1, ILAST ) ).LT.
+ $ ABS( T( ILAST-1, ILAST-1 ) ) ) THEN
+ ESHIFT = ESHIFT + H( ILAST-1, ILAST ) /
+ $ T( ILAST-1, ILAST-1 )
ELSE
ESHIFT = ESHIFT + ONE / ( SAFMIN*REAL( MAXIT ) )
END IF
@@ -688,8 +690,8 @@
* bottom-right 2x2 block of A and B. The first eigenvalue
* returned by SLAG2 is the Wilkinson shift (AEP p.512),
*
- CALL SLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL SLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ S2, WR, WR2, WI )
*
TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
@@ -721,14 +723,14 @@
*
DO 120 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- TEMP = ABS( S1*A( J, J-1 ) )
- TEMP2 = ABS( S1*A( J, J )-WR*B( J, J ) )
+ TEMP = ABS( S1*H( J, J-1 ) )
+ TEMP2 = ABS( S1*H( J, J )-WR*T( J, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS( ( ASCALE*A( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
+ IF( ABS( ( ASCALE*H( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
$ TEMP2 )GO TO 130
120 CONTINUE
*
@@ -739,26 +741,26 @@
*
* Initial Q
*
- TEMP = S1*A( ISTART, ISTART ) - WR*B( ISTART, ISTART )
- TEMP2 = S1*A( ISTART+1, ISTART )
+ TEMP = S1*H( ISTART, ISTART ) - WR*T( ISTART, ISTART )
+ TEMP2 = S1*H( ISTART+1, ISTART )
CALL SLARTG( TEMP, TEMP2, C, S, TEMPR )
*
* Sweep
*
DO 190 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- TEMP = A( J, J-1 )
- CALL SLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL SLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
END IF
*
DO 140 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
140 CONTINUE
IF( ILQ ) THEN
DO 150 JR = 1, N
@@ -768,19 +770,19 @@
150 CONTINUE
END IF
*
- TEMP = B( J+1, J+1 )
- CALL SLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL SLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 160 JR = IFRSTM, MIN( J+2, ILAST )
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
160 CONTINUE
DO 170 JR = IFRSTM, J
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
170 CONTINUE
IF( ILZ ) THEN
DO 180 JR = 1, N
@@ -816,8 +818,8 @@
* B = ( ) with B11 non-negative.
* ( 0 B22 )
*
- CALL SLASV2( B( ILAST-1, ILAST-1 ), B( ILAST-1, ILAST ),
- $ B( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
+ CALL SLASV2( T( ILAST-1, ILAST-1 ), T( ILAST-1, ILAST ),
+ $ T( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
*
IF( B11.LT.ZERO ) THEN
CR = -CR
@@ -826,17 +828,17 @@
B22 = -B22
END IF
*
- CALL SROT( ILASTM+1-IFIRST, A( ILAST-1, ILAST-1 ), LDA,
- $ A( ILAST, ILAST-1 ), LDA, CL, SL )
- CALL SROT( ILAST+1-IFRSTM, A( IFRSTM, ILAST-1 ), 1,
- $ A( IFRSTM, ILAST ), 1, CR, SR )
+ CALL SROT( ILASTM+1-IFIRST, H( ILAST-1, ILAST-1 ), LDH,
+ $ H( ILAST, ILAST-1 ), LDH, CL, SL )
+ CALL SROT( ILAST+1-IFRSTM, H( IFRSTM, ILAST-1 ), 1,
+ $ H( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILAST.LT.ILASTM )
- $ CALL SROT( ILASTM-ILAST, B( ILAST-1, ILAST+1 ), LDB,
- $ B( ILAST, ILAST+1 ), LDA, CL, SL )
+ $ CALL SROT( ILASTM-ILAST, T( ILAST-1, ILAST+1 ), LDT,
+ $ T( ILAST, ILAST+1 ), LDH, CL, SL )
IF( IFRSTM.LT.ILAST-1 )
- $ CALL SROT( IFIRST-IFRSTM, B( IFRSTM, ILAST-1 ), 1,
- $ B( IFRSTM, ILAST ), 1, CR, SR )
+ $ CALL SROT( IFIRST-IFRSTM, T( IFRSTM, ILAST-1 ), 1,
+ $ T( IFRSTM, ILAST ), 1, CR, SR )
*
IF( ILQ )
$ CALL SROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
@@ -845,17 +847,17 @@
$ CALL SROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
$ SR )
*
- B( ILAST-1, ILAST-1 ) = B11
- B( ILAST-1, ILAST ) = ZERO
- B( ILAST, ILAST-1 ) = ZERO
- B( ILAST, ILAST ) = B22
+ T( ILAST-1, ILAST-1 ) = B11
+ T( ILAST-1, ILAST ) = ZERO
+ T( ILAST, ILAST-1 ) = ZERO
+ T( ILAST, ILAST ) = B22
*
* If B22 is negative, negate column ILAST
*
IF( B22.LT.ZERO ) THEN
DO 210 J = IFRSTM, ILAST
- A( J, ILAST ) = -A( J, ILAST )
- B( J, ILAST ) = -B( J, ILAST )
+ H( J, ILAST ) = -H( J, ILAST )
+ T( J, ILAST ) = -T( J, ILAST )
210 CONTINUE
*
IF( ILZ ) THEN
@@ -869,8 +871,8 @@
*
* Recompute shift
*
- CALL SLAG2( A( ILAST-1, ILAST-1 ), LDA,
- $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ CALL SLAG2( H( ILAST-1, ILAST-1 ), LDH,
+ $ T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
$ TEMP, WR, TEMP2, WI )
*
* ------------------- Begin Timing Code ----------------------
@@ -887,10 +889,10 @@
*
* Do EISPACK (QZVAL) computation of alpha and beta
*
- A11 = A( ILAST-1, ILAST-1 )
- A21 = A( ILAST, ILAST-1 )
- A12 = A( ILAST-1, ILAST )
- A22 = A( ILAST, ILAST )
+ A11 = H( ILAST-1, ILAST-1 )
+ A21 = H( ILAST, ILAST-1 )
+ A12 = H( ILAST-1, ILAST )
+ A22 = H( ILAST, ILAST )
*
* Compute complex Givens rotation on right
* (Assume some element of C = (sA - wB) > unfl )
@@ -907,10 +909,10 @@
*
IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
$ ABS( C22R )+ABS( C22I ) ) THEN
- T = SLAPY3( C12, C11R, C11I )
- CZ = C12 / T
- SZR = -C11R / T
- SZI = -C11I / T
+ T1 = SLAPY3( C12, C11R, C11I )
+ CZ = C12 / T1
+ SZR = -C11R / T1
+ SZI = -C11I / T1
ELSE
CZ = SLAPY2( C22R, C22I )
IF( CZ.LE.SAFMIN ) THEN
@@ -920,10 +922,10 @@
ELSE
TEMPR = C22R / CZ
TEMPI = C22I / CZ
- T = SLAPY2( CZ, C21 )
- CZ = CZ / T
- SZR = -C21*TEMPR / T
- SZI = C21*TEMPI / T
+ T1 = SLAPY2( CZ, C21 )
+ CZ = CZ / T1
+ SZR = -C21*TEMPR / T1
+ SZI = C21*TEMPI / T1
END IF
END IF
*
@@ -957,10 +959,10 @@
SQI = TEMPI*A2R - TEMPR*A2I
END IF
END IF
- T = SLAPY3( CQ, SQR, SQI )
- CQ = CQ / T
- SQR = SQR / T
- SQI = SQI / T
+ T1 = SLAPY3( CQ, SQR, SQI )
+ CQ = CQ / T1
+ SQR = SQR / T1
+ SQI = SQI / T1
*
* Compute diagonal elements of QBZ
*
@@ -1016,26 +1018,26 @@
*
* We assume that the block is at least 3x3
*
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- U12 = B( ILAST-1, ILAST ) / B( ILAST, ILAST )
- AD11L = ( ASCALE*A( IFIRST, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD21L = ( ASCALE*A( IFIRST+1, IFIRST ) ) /
- $ ( BSCALE*B( IFIRST, IFIRST ) )
- AD12L = ( ASCALE*A( IFIRST, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD22L = ( ASCALE*A( IFIRST+1, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- AD32L = ( ASCALE*A( IFIRST+2, IFIRST+1 ) ) /
- $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
- U12L = B( IFIRST, IFIRST+1 ) / B( IFIRST+1, IFIRST+1 )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ U12 = T( ILAST-1, ILAST ) / T( ILAST, ILAST )
+ AD11L = ( ASCALE*H( IFIRST, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD21L = ( ASCALE*H( IFIRST+1, IFIRST ) ) /
+ $ ( BSCALE*T( IFIRST, IFIRST ) )
+ AD12L = ( ASCALE*H( IFIRST, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD22L = ( ASCALE*H( IFIRST+1, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ AD32L = ( ASCALE*H( IFIRST+2, IFIRST+1 ) ) /
+ $ ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
+ U12L = T( IFIRST, IFIRST+1 ) / T( IFIRST+1, IFIRST+1 )
*
V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
$ AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
@@ -1057,27 +1059,27 @@
* Zero (j-1)st column of A
*
IF( J.GT.ISTART ) THEN
- V( 1 ) = A( J, J-1 )
- V( 2 ) = A( J+1, J-1 )
- V( 3 ) = A( J+2, J-1 )
+ V( 1 ) = H( J, J-1 )
+ V( 2 ) = H( J+1, J-1 )
+ V( 3 ) = H( J+2, J-1 )
*
- CALL SLARFG( 3, A( J, J-1 ), V( 2 ), 1, TAU )
+ CALL SLARFG( 3, H( J, J-1 ), V( 2 ), 1, TAU )
V( 1 ) = ONE
- A( J+1, J-1 ) = ZERO
- A( J+2, J-1 ) = ZERO
+ H( J+1, J-1 ) = ZERO
+ H( J+2, J-1 ) = ZERO
END IF
*
DO 230 JC = J, ILASTM
- TEMP = TAU*( A( J, JC )+V( 2 )*A( J+1, JC )+V( 3 )*
- $ A( J+2, JC ) )
- A( J, JC ) = A( J, JC ) - TEMP
- A( J+1, JC ) = A( J+1, JC ) - TEMP*V( 2 )
- A( J+2, JC ) = A( J+2, JC ) - TEMP*V( 3 )
- TEMP2 = TAU*( B( J, JC )+V( 2 )*B( J+1, JC )+V( 3 )*
- $ B( J+2, JC ) )
- B( J, JC ) = B( J, JC ) - TEMP2
- B( J+1, JC ) = B( J+1, JC ) - TEMP2*V( 2 )
- B( J+2, JC ) = B( J+2, JC ) - TEMP2*V( 3 )
+ TEMP = TAU*( H( J, JC )+V( 2 )*H( J+1, JC )+V( 3 )*
+ $ H( J+2, JC ) )
+ H( J, JC ) = H( J, JC ) - TEMP
+ H( J+1, JC ) = H( J+1, JC ) - TEMP*V( 2 )
+ H( J+2, JC ) = H( J+2, JC ) - TEMP*V( 3 )
+ TEMP2 = TAU*( T( J, JC )+V( 2 )*T( J+1, JC )+V( 3 )*
+ $ T( J+2, JC ) )
+ T( J, JC ) = T( J, JC ) - TEMP2
+ T( J+1, JC ) = T( J+1, JC ) - TEMP2*V( 2 )
+ T( J+2, JC ) = T( J+2, JC ) - TEMP2*V( 3 )
230 CONTINUE
IF( ILQ ) THEN
DO 240 JR = 1, N
@@ -1094,27 +1096,27 @@
* Swap rows to pivot
*
ILPIVT = .FALSE.
- TEMP = MAX( ABS( B( J+1, J+1 ) ), ABS( B( J+1, J+2 ) ) )
- TEMP2 = MAX( ABS( B( J+2, J+1 ) ), ABS( B( J+2, J+2 ) ) )
+ TEMP = MAX( ABS( T( J+1, J+1 ) ), ABS( T( J+1, J+2 ) ) )
+ TEMP2 = MAX( ABS( T( J+2, J+1 ) ), ABS( T( J+2, J+2 ) ) )
IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
SCALE = ZERO
U1 = ONE
U2 = ZERO
GO TO 250
ELSE IF( TEMP.GE.TEMP2 ) THEN
- W11 = B( J+1, J+1 )
- W21 = B( J+2, J+1 )
- W12 = B( J+1, J+2 )
- W22 = B( J+2, J+2 )
- U1 = B( J+1, J )
- U2 = B( J+2, J )
+ W11 = T( J+1, J+1 )
+ W21 = T( J+2, J+1 )
+ W12 = T( J+1, J+2 )
+ W22 = T( J+2, J+2 )
+ U1 = T( J+1, J )
+ U2 = T( J+2, J )
ELSE
- W21 = B( J+1, J+1 )
- W11 = B( J+2, J+1 )
- W22 = B( J+1, J+2 )
- W12 = B( J+2, J+2 )
- U2 = B( J+1, J )
- U1 = B( J+2, J )
+ W21 = T( J+1, J+1 )
+ W11 = T( J+2, J+1 )
+ W22 = T( J+1, J+2 )
+ W12 = T( J+2, J+2 )
+ U2 = T( J+1, J )
+ U1 = T( J+2, J )
END IF
*
* Swap columns if nec.
@@ -1164,9 +1166,9 @@
*
* Compute Householder Vector
*
- T = SQRT( SCALE**2+U1**2+U2**2 )
- TAU = ONE + SCALE / T
- VS = -ONE / ( SCALE+T )
+ T1 = SQRT( SCALE**2+U1**2+U2**2 )
+ TAU = ONE + SCALE / T1
+ VS = -ONE / ( SCALE+T1 )
V( 1 ) = ONE
V( 2 ) = VS*U1
V( 3 ) = VS*U2
@@ -1174,18 +1176,18 @@
* Apply transformations from the right.
*
DO 260 JR = IFRSTM, MIN( J+3, ILAST )
- TEMP = TAU*( A( JR, J )+V( 2 )*A( JR, J+1 )+V( 3 )*
- $ A( JR, J+2 ) )
- A( JR, J ) = A( JR, J ) - TEMP
- A( JR, J+1 ) = A( JR, J+1 ) - TEMP*V( 2 )
- A( JR, J+2 ) = A( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( H( JR, J )+V( 2 )*H( JR, J+1 )+V( 3 )*
+ $ H( JR, J+2 ) )
+ H( JR, J ) = H( JR, J ) - TEMP
+ H( JR, J+1 ) = H( JR, J+1 ) - TEMP*V( 2 )
+ H( JR, J+2 ) = H( JR, J+2 ) - TEMP*V( 3 )
260 CONTINUE
DO 270 JR = IFRSTM, J + 2
- TEMP = TAU*( B( JR, J )+V( 2 )*B( JR, J+1 )+V( 3 )*
- $ B( JR, J+2 ) )
- B( JR, J ) = B( JR, J ) - TEMP
- B( JR, J+1 ) = B( JR, J+1 ) - TEMP*V( 2 )
- B( JR, J+2 ) = B( JR, J+2 ) - TEMP*V( 3 )
+ TEMP = TAU*( T( JR, J )+V( 2 )*T( JR, J+1 )+V( 3 )*
+ $ T( JR, J+2 ) )
+ T( JR, J ) = T( JR, J ) - TEMP
+ T( JR, J+1 ) = T( JR, J+1 ) - TEMP*V( 2 )
+ T( JR, J+2 ) = T( JR, J+2 ) - TEMP*V( 3 )
270 CONTINUE
IF( ILZ ) THEN
DO 280 JR = 1, N
@@ -1196,8 +1198,8 @@
Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
280 CONTINUE
END IF
- B( J+1, J ) = ZERO
- B( J+2, J ) = ZERO
+ T( J+1, J ) = ZERO
+ T( J+2, J ) = ZERO
290 CONTINUE
*
* Last elements: Use Givens rotations
@@ -1205,17 +1207,17 @@
* Rotations from the left
*
J = ILAST - 1
- TEMP = A( J, J-1 )
- CALL SLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = ZERO
+ TEMP = H( J, J-1 )
+ CALL SLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = ZERO
*
DO 300 JC = J, ILASTM
- TEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = TEMP
- TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = TEMP2
+ TEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = TEMP
+ TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = TEMP2
300 CONTINUE
IF( ILQ ) THEN
DO 310 JR = 1, N
@@ -1227,19 +1229,19 @@
*
* Rotations from the right.
*
- TEMP = B( J+1, J+1 )
- CALL SLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = ZERO
+ TEMP = T( J+1, J+1 )
+ CALL SLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = ZERO
*
DO 320 JR = IFRSTM, ILAST
- TEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = TEMP
+ TEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = TEMP
320 CONTINUE
DO 330 JR = IFRSTM, ILAST - 1
- TEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = TEMP
+ TEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = TEMP
330 CONTINUE
IF( ILZ ) THEN
DO 340 JR = 1, N
@@ -1290,15 +1292,15 @@
* Set Eigenvalues 1:ILO-1
*
DO 410 J = 1, ILO - 1
- IF( B( J, J ).LT.ZERO ) THEN
+ IF( T( J, J ).LT.ZERO ) THEN
IF( ILSCHR ) THEN
DO 390 JR = 1, J
- A( JR, J ) = -A( JR, J )
- B( JR, J ) = -B( JR, J )
+ H( JR, J ) = -H( JR, J )
+ T( JR, J ) = -T( JR, J )
390 CONTINUE
ELSE
- A( J, J ) = -A( J, J )
- B( J, J ) = -B( J, J )
+ H( J, J ) = -H( J, J )
+ T( J, J ) = -T( J, J )
END IF
IF( ILZ ) THEN
DO 400 JR = 1, N
@@ -1306,9 +1308,9 @@
400 CONTINUE
END IF
END IF
- ALPHAR( J ) = A( J, J )
+ ALPHAR( J ) = H( J, J )
ALPHAI( J ) = ZERO
- BETA( J ) = B( J, J )
+ BETA( J ) = T( J, J )
410 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/stgevc.f LAPACK/TIMING/EIG/EIGSRC/stgevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/stgevc.f Thu Nov 4 14:28:30 1999
+++ LAPACK/TIMING/EIG/EIGSRC/stgevc.f Fri May 25 16:20:41 2001
@@ -1,18 +1,18 @@
- SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
- REAL A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ REAL P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -33,35 +33,31 @@
* Purpose
* =======
*
-* STGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of real upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* STGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of real matrices (S,P), where S is a quasi-triangular matrix
+* and P is upper triangular. Matrix pairs of this type are produced by
+* the generalized Schur factorization of a matrix pair (A,B):
+*
+* A = Q*S*Z**T, B = Q*P*Z**T
+*
+* as computed by SGGHRD + SHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input orthogonal
-* matrices. If (A,B) was obtained from the generalized real-Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
-*
-* A must be block upper triangular, with 1-by-1 and 2-by-2 diagonal
-* blocks. Corresponding to each 2-by-2 diagonal block is a complex
-* conjugate pair of eigenvalues and eigenvectors; only one
-* eigenvector of the pair is computed, namely the one corresponding
-* to the eigenvalue with positive imaginary part.
-*
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal blocks of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the orthogonal factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
+*
* Arguments
* =========
*
@@ -72,78 +68,84 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to the real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must
-* be set to .TRUE..
+* computed. If w(j) is a real eigenvalue, the corresponding
+* real eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector
+* is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
+* and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
+* set to .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
+* The order of the matrices S and P. N >= 0.
*
-* A (input) REAL array, dimension (LDA,N)
-* The upper quasi-triangular matrix A.
+* S (input) REAL array, dimension (LDS,N)
+* The upper quasi-triangular matrix S from a generalized Schur
+* factorization, as computed by SHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) REAL array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by SHGEQZ.
+* 2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
+* of S must be in positive diagonal form.
*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1,N).
-*
-* B (input) REAL array, dimension (LDB,N)
-* The upper triangular matrix B. If A has a 2-by-2 diagonal
-* block, then the corresponding 2-by-2 block of B must be
-* diagonal with positive elements.
-*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) REAL array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the orthogonal matrix Q
* of left Schur vectors returned by SHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
*
+* Not referenced if SIDE = 'R'.
+*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) REAL array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-* contain an N-by-N matrix Q (usually the orthogonal matrix Z
+* contain an N-by-N matrix Z (usually the orthogonal matrix Z
* of right Schur vectors returned by SHGEQZ).
+*
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
-* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
-* SELECT, stored consecutively in the columns of
-* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
+* if HOWMNY = 'B' or 'b', the matrix Z*X;
+* if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
+* specified by SELECT, stored consecutively in the
+* columns of VR, in the same order as their
+* eigenvalues.
*
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
+*
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
@@ -212,7 +214,7 @@
* partial sums. Since FORTRAN arrays are stored columnwise, this has
* the advantage that at each step, the elements of C that are accessed
* are adjacent to one another, whereas with the rowwise method, the
-* elements accessed at a step are spaced LDA (and LDB) words apart.
+* elements accessed at a step are spaced LDS (and LDP) words apart.
*
* When finding left eigenvectors, the matrix in question is the
* transpose of the one in storage, so the rowwise method then
@@ -239,8 +241,8 @@
$ TEMP2R, ULP, XMAX, XSCALE
* ..
* .. Local Arrays ..
- REAL BDIAG( 2 ), SUM( 2, 2 ), SUMA( 2, 2 ),
- $ SUMB( 2, 2 )
+ REAL BDIAG( 2 ), SUM( 2, 2 ), SUMS( 2, 2 ),
+ $ SUMP( 2, 2 )
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -265,7 +267,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -297,9 +299,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -318,7 +320,7 @@
GO TO 10
END IF
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO )
+ IF( S( J+1, J ).NE.ZERO )
$ ILCPLX = .TRUE.
END IF
IF( ILCPLX ) THEN
@@ -338,11 +340,11 @@
ILABAD = .FALSE.
ILBBAD = .FALSE.
DO 20 J = 1, N - 1
- IF( A( J+1, J ).NE.ZERO ) THEN
- IF( B( J, J ).EQ.ZERO .OR. B( J+1, J+1 ).EQ.ZERO .OR.
- $ B( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
+ IF( S( J+1, J ).NE.ZERO ) THEN
+ IF( P( J, J ).EQ.ZERO .OR. P( J+1, J+1 ).EQ.ZERO .OR.
+ $ P( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
IF( J.LT.N-1 ) THEN
- IF( A( J+2, J+1 ).NE.ZERO )
+ IF( S( J+2, J+1 ).NE.ZERO )
$ ILABAD = .TRUE.
END IF
END IF
@@ -385,30 +387,30 @@
* blocks) of A and B to check for possible overflow in the
* triangular solver.
*
- ANORM = ABS( A( 1, 1 ) )
+ ANORM = ABS( S( 1, 1 ) )
IF( N.GT.1 )
- $ ANORM = ANORM + ABS( A( 2, 1 ) )
- BNORM = ABS( B( 1, 1 ) )
+ $ ANORM = ANORM + ABS( S( 2, 1 ) )
+ BNORM = ABS( P( 1, 1 ) )
WORK( 1 ) = ZERO
WORK( N+1 ) = ZERO
*
DO 50 J = 2, N
TEMP = ZERO
TEMP2 = ZERO
- IF( A( J, J-1 ).EQ.ZERO ) THEN
+ IF( S( J, J-1 ).EQ.ZERO ) THEN
IEND = J - 1
ELSE
IEND = J - 2
END IF
DO 30 I = 1, IEND
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
30 CONTINUE
WORK( J ) = TEMP
WORK( N+J ) = TEMP2
DO 40 I = IEND + 1, MIN( J+1, N )
- TEMP = TEMP + ABS( A( I, J ) )
- TEMP2 = TEMP2 + ABS( B( I, J ) )
+ TEMP = TEMP + ABS( S( I, J ) )
+ TEMP2 = TEMP2 + ABS( P( I, J ) )
40 CONTINUE
ANORM = MAX( ANORM, TEMP )
BNORM = MAX( BNORM, TEMP2 )
@@ -442,7 +444,7 @@
END IF
NW = 1
IF( JE.LT.N ) THEN
- IF( A( JE+1, JE ).NE.ZERO ) THEN
+ IF( S( JE+1, JE ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -461,8 +463,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- returns unit eigenvector
*
@@ -489,10 +491,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -534,7 +536,7 @@
*
* Complex eigenvalue
*
- CALL SLAG2( A( JE, JE ), LDA, B( JE, JE ), LDB,
+ CALL SLAG2( S( JE, JE ), LDS, P( JE, JE ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
BCOEFI = -BCOEFI
@@ -566,9 +568,9 @@
*
* Compute first two components of eigenvector
*
- TEMP = ACOEF*A( JE+1, JE )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE+1, JE )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GT.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -577,10 +579,10 @@
ELSE
WORK( 2*N+JE+1 ) = ONE
WORK( 3*N+JE+1 ) = ZERO
- TEMP = ACOEF*A( JE, JE+1 )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE+1, JE+1 )-ACOEF*
- $ A( JE+1, JE+1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE+1, JE+1 ) / TEMP
+ TEMP = ACOEF*S( JE, JE+1 )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE+1, JE+1 )-ACOEF*
+ $ S( JE+1, JE+1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE+1, JE+1 ) / TEMP
END IF
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
$ ABS( WORK( 2*N+JE+1 ) )+ABS( WORK( 3*N+JE+1 ) ) )
@@ -610,11 +612,11 @@
END IF
*
NA = 1
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( J.LT.N ) THEN
- IF( A( J+1, J ).NE.ZERO ) THEN
+ IF( S( J+1, J ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
NA = 2
* ---------------- Begin Timing Code ----------------
IN2BY2 = IN2BY2 + 1
@@ -646,13 +648,13 @@
* Compute dot products
*
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
*
* To reduce the op count, this is done as
*
* _ j-1 _ j-1
-* a*conjg( sum A(k,j)*x(k) ) - b*conjg( sum B(k,j)*x(k) )
+* a*conjg( sum S(k,j)*x(k) ) - b*conjg( sum P(k,j)*x(k) )
* k=je k=je
*
* which may cause underflow problems if A or B are close
@@ -689,15 +691,15 @@
*$PL$ CMCHAR='*'
*
DO 110 JA = 1, NA
- SUMA( JA, JW ) = ZERO
- SUMB( JA, JW ) = ZERO
+ SUMS( JA, JW ) = ZERO
+ SUMP( JA, JW ) = ZERO
*
DO 100 JR = JE, J - 1
- SUMA( JA, JW ) = SUMA( JA, JW ) +
- $ A( JR, J+JA-1 )*
+ SUMS( JA, JW ) = SUMS( JA, JW ) +
+ $ S( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
- SUMB( JA, JW ) = SUMB( JA, JW ) +
- $ B( JR, J+JA-1 )*
+ SUMP( JA, JW ) = SUMP( JA, JW ) +
+ $ P( JR, J+JA-1 )*
$ WORK( ( JW+1 )*N+JR )
100 CONTINUE
110 CONTINUE
@@ -717,15 +719,15 @@
*
DO 130 JA = 1, NA
IF( ILCPLX ) THEN
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 ) -
- $ BCOEFI*SUMB( JA, 2 )
- SUM( JA, 2 ) = -ACOEF*SUMA( JA, 2 ) +
- $ BCOEFR*SUMB( JA, 2 ) +
- $ BCOEFI*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 ) -
+ $ BCOEFI*SUMP( JA, 2 )
+ SUM( JA, 2 ) = -ACOEF*SUMS( JA, 2 ) +
+ $ BCOEFR*SUMP( JA, 2 ) +
+ $ BCOEFI*SUMP( JA, 1 )
ELSE
- SUM( JA, 1 ) = -ACOEF*SUMA( JA, 1 ) +
- $ BCOEFR*SUMB( JA, 1 )
+ SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
+ $ BCOEFR*SUMP( JA, 1 )
END IF
130 CONTINUE
*
@@ -733,7 +735,7 @@
* Solve ( a A - b B ) y = SUM(,)
* with scaling and perturbation of the denominator
*
- CALL SLALN2( .TRUE., NA, NW, DMIN, ACOEF, A( J, J ), LDA,
+ CALL SLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS,
$ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR,
$ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP,
$ IINFO )
@@ -859,7 +861,7 @@
END IF
NW = 1
IF( JE.GT.1 ) THEN
- IF( A( JE, JE-1 ).NE.ZERO ) THEN
+ IF( S( JE, JE-1 ).NE.ZERO ) THEN
ILCPLX = .TRUE.
NW = 2
END IF
@@ -878,8 +880,8 @@
* (c) complex eigenvalue.
*
IF( .NOT.ILCPLX ) THEN
- IF( ABS( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( B( JE, JE ) ).LE.SAFMIN ) THEN
+ IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- returns unit eigenvector
*
@@ -908,10 +910,10 @@
*
* Real eigenvalue
*
- TEMP = ONE / MAX( ABS( A( JE, JE ) )*ASCALE,
- $ ABS( B( JE, JE ) )*BSCALE, SAFMIN )
- SALFAR = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*B( JE, JE ) )*BSCALE
+ TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
+ $ ABS( P( JE, JE ) )*BSCALE, SAFMIN )
+ SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*P( JE, JE ) )*BSCALE
ACOEF = SBETA*ASCALE
BCOEFR = SALFAR*BSCALE
BCOEFI = ZERO
@@ -954,14 +956,14 @@
* (See "Further Details", above.)
*
DO 260 JR = 1, JE - 1
- WORK( 2*N+JR ) = BCOEFR*B( JR, JE ) -
- $ ACOEF*A( JR, JE )
+ WORK( 2*N+JR ) = BCOEFR*P( JR, JE ) -
+ $ ACOEF*S( JR, JE )
260 CONTINUE
ELSE
*
* Complex eigenvalue
*
- CALL SLAG2( A( JE-1, JE-1 ), LDA, B( JE-1, JE-1 ), LDB,
+ CALL SLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP,
$ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
$ BCOEFI )
IF( BCOEFI.EQ.ZERO ) THEN
@@ -993,9 +995,9 @@
* Compute first two components of eigenvector
* and contribution to sums
*
- TEMP = ACOEF*A( JE, JE-1 )
- TEMP2R = ACOEF*A( JE, JE ) - BCOEFR*B( JE, JE )
- TEMP2I = -BCOEFI*B( JE, JE )
+ TEMP = ACOEF*S( JE, JE-1 )
+ TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
+ TEMP2I = -BCOEFI*P( JE, JE )
IF( ABS( TEMP ).GE.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
WORK( 2*N+JE ) = ONE
WORK( 3*N+JE ) = ZERO
@@ -1004,10 +1006,10 @@
ELSE
WORK( 2*N+JE-1 ) = ONE
WORK( 3*N+JE-1 ) = ZERO
- TEMP = ACOEF*A( JE-1, JE )
- WORK( 2*N+JE ) = ( BCOEFR*B( JE-1, JE-1 )-ACOEF*
- $ A( JE-1, JE-1 ) ) / TEMP
- WORK( 3*N+JE ) = BCOEFI*B( JE-1, JE-1 ) / TEMP
+ TEMP = ACOEF*S( JE-1, JE )
+ WORK( 2*N+JE ) = ( BCOEFR*P( JE-1, JE-1 )-ACOEF*
+ $ S( JE-1, JE-1 ) ) / TEMP
+ WORK( 3*N+JE ) = BCOEFI*P( JE-1, JE-1 ) / TEMP
END IF
*
XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
@@ -1027,12 +1029,12 @@
CRE2B = BCOEFR*WORK( 2*N+JE ) - BCOEFI*WORK( 3*N+JE )
CIM2B = BCOEFI*WORK( 2*N+JE ) + BCOEFR*WORK( 3*N+JE )
DO 270 JR = 1, JE - 2
- WORK( 2*N+JR ) = -CREALA*A( JR, JE-1 ) +
- $ CREALB*B( JR, JE-1 ) -
- $ CRE2A*A( JR, JE ) + CRE2B*B( JR, JE )
- WORK( 3*N+JR ) = -CIMAGA*A( JR, JE-1 ) +
- $ CIMAGB*B( JR, JE-1 ) -
- $ CIM2A*A( JR, JE ) + CIM2B*B( JR, JE )
+ WORK( 2*N+JR ) = -CREALA*S( JR, JE-1 ) +
+ $ CREALB*P( JR, JE-1 ) -
+ $ CRE2A*S( JR, JE ) + CRE2B*P( JR, JE )
+ WORK( 3*N+JR ) = -CIMAGA*S( JR, JE-1 ) +
+ $ CIMAGB*P( JR, JE-1 ) -
+ $ CIM2A*S( JR, JE ) + CIM2B*P( JR, JE )
270 CONTINUE
END IF
*
@@ -1054,7 +1056,7 @@
* next iteration to process it (when it will be j:j+1)
*
IF( .NOT.IL2BY2 .AND. J.GT.1 ) THEN
- IF( A( J, J-1 ).NE.ZERO ) THEN
+ IF( S( J, J-1 ).NE.ZERO ) THEN
IL2BY2 = .TRUE.
* -------------- Begin Timing Code -----------------
IN2BY2 = IN2BY2 + 1
@@ -1062,18 +1064,18 @@
GO TO 370
END IF
END IF
- BDIAG( 1 ) = B( J, J )
+ BDIAG( 1 ) = P( J, J )
IF( IL2BY2 ) THEN
NA = 2
- BDIAG( 2 ) = B( J+1, J+1 )
+ BDIAG( 2 ) = P( J+1, J+1 )
ELSE
NA = 1
END IF
*
* Compute x(j) (and x(j+1), if 2-by-2 block)
*
- CALL SLALN2( .FALSE., NA, NW, DMIN, ACOEF, A( J, J ),
- $ LDA, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
+ CALL SLALN2( .FALSE., NA, NW, DMIN, ACOEF, S( J, J ),
+ $ LDS, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
$ N, BCOEFR, BCOEFI, SUM, 2, SCALE, TEMP,
$ IINFO )
IF( SCALE.LT.ONE ) THEN
@@ -1096,7 +1098,7 @@
300 CONTINUE
310 CONTINUE
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( J.GT.1 ) THEN
*
@@ -1137,19 +1139,19 @@
$ BCOEFR*WORK( 3*N+J+JA-1 )
DO 340 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
WORK( 3*N+JR ) = WORK( 3*N+JR ) -
- $ CIMAGA*A( JR, J+JA-1 ) +
- $ CIMAGB*B( JR, J+JA-1 )
+ $ CIMAGA*S( JR, J+JA-1 ) +
+ $ CIMAGB*P( JR, J+JA-1 )
340 CONTINUE
ELSE
CREALA = ACOEF*WORK( 2*N+J+JA-1 )
CREALB = BCOEFR*WORK( 2*N+J+JA-1 )
DO 350 JR = 1, J - 1
WORK( 2*N+JR ) = WORK( 2*N+JR ) -
- $ CREALA*A( JR, J+JA-1 ) +
- $ CREALB*B( JR, J+JA-1 )
+ $ CREALA*S( JR, J+JA-1 ) +
+ $ CREALB*P( JR, J+JA-1 )
350 CONTINUE
END IF
360 CONTINUE
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/strevc.f LAPACK/TIMING/EIG/EIGSRC/strevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/strevc.f Thu Nov 4 14:28:33 1999
+++ LAPACK/TIMING/EIG/EIGSRC/strevc.f Fri May 25 16:20:57 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -30,28 +30,23 @@
*
* STREVC computes some or all of the right and/or left eigenvectors of
* a real upper quasi-triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a real general matrix: A = Q*T*Q**T, as computed by SHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input orthogonal
-* matrix. If T was obtained from the real-Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
-*
-* T must be in Schur canonical form (as returned by SHSEQR), that is,
-* block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-* 2-by-2 diagonal block has its diagonal elements equal and its
-* off-diagonal elements of opposite sign. Corresponding to each 2-by-2
-* diagonal block is a complex conjugate pair of eigenvalues and
-* eigenvectors; only one eigenvector of the pair is computed, namely
-* the one corresponding to the eigenvalue with positive imaginary part.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal blocks of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the orthogonal factor that reduces a matrix
+* A to Schur form T, then Q*X and Q*Y are the matrices of right and
+* left eigenvectors of A.
*
* Arguments
* =========
@@ -64,21 +59,21 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input/output) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the real eigenvector corresponding to a real
-* eigenvalue w(j), SELECT(j) must be set to .TRUE.. To select
-* the complex eigenvector corresponding to a complex conjugate
-* pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must be
-* set to .TRUE.; then on exit SELECT(j) is .TRUE. and
-* SELECT(j+1) is .FALSE..
+* If w(j) is a real eigenvalue, the corresponding real
+* eigenvector is computed if SELECT(j) is .TRUE..
+* If w(j) and w(j+1) are the real and imaginary parts of a
+* complex eigenvalue, the corresponding complex eigenvector is
+* computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
+* on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
+* .FALSE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -95,15 +90,6 @@
* of Schur vectors returned by SHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL has the same quasi-lower triangular form
-* as T'. If T(i,i) is a real eigenvalue, then
-* the i-th column VL(i) of VL is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VL(i)+sqrt(-1)*VL(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -112,11 +98,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part, and the second the imaginary part.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) REAL array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -124,15 +110,6 @@
* of Schur vectors returned by SHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR has the same quasi-upper triangular form
-* as T. If T(i,i) is a real eigenvalue, then
-* the i-th column VR(i) of VR is its
-* corresponding eigenvector. If T(i:i+1,i:i+1)
-* is a 2-by-2 block whose eigenvalues are
-* complex-conjugate eigenvalues of T, then
-* VR(i)+sqrt(-1)*VR(i+1) is the complex
-* eigenvector corresponding to the eigenvalue
-* with positive real part.
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
@@ -141,11 +118,11 @@
* A complex eigenvector corresponding to a complex eigenvalue
* is stored in two consecutive columns, the first holding the
* real part and the second the imaginary part.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/zbdsqr.f LAPACK/TIMING/EIG/EIGSRC/zbdsqr.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/zbdsqr.f Thu Nov 4 14:28:30 1999
+++ LAPACK/TIMING/EIG/EIGSRC/zbdsqr.f Fri May 25 16:20:01 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
CHARACTER UPLO
@@ -26,14 +26,26 @@
* Purpose
* =======
*
-* ZBDSQR computes the singular value decomposition (SVD) of a real
-* N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
-* denotes the transpose of P), where S is a diagonal matrix with
-* non-negative diagonal elements (the singular values of B), and Q
-* and P are orthogonal matrices.
+* ZBDSQR computes the singular values and, optionally, the right and/or
+* left singular vectors from the singular value decomposition (SVD) of
+* a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
+* zero-shift QR algorithm. The SVD of B has the form
+*
+* B = Q * S * P**H
+*
+* where S is the diagonal matrix of singular values, Q is an orthogonal
+* matrix of left singular vectors, and P is an orthogonal matrix of
+* right singular vectors. If left singular vectors are requested, this
+* subroutine actually returns U*Q instead of Q, and, if right singular
+* vectors are requested, this subroutine returns P**H*VT instead of
+* P**H, for given complex input matrices U and VT. When U and VT are
+* the unitary matrices that reduce a general matrix A to bidiagonal
+* form: A = U*B*VT, as computed by ZGEBRD, then
*
-* The routine computes S, and optionally computes U * Q, P' * VT,
-* or Q' * C, for given complex input matrices U, VT, and C.
+* A = (U*Q) * S * (P**H*VT)
+*
+* is the SVD of A. Optionally, the subroutine may also compute Q**H*C
+* for a given complex input matrix C.
*
* See "Computing Small Singular Values of Bidiagonal Matrices With
* Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
@@ -69,18 +81,17 @@
* order.
*
* E (input/output) DOUBLE PRECISION array, dimension (N)
-* On entry, the elements of E contain the
-* offdiagonal elements of of the bidiagonal matrix whose SVD
-* is desired. On normal exit (INFO = 0), E is destroyed.
-* If the algorithm does not converge (INFO > 0), D and E
+* On entry, the N-1 offdiagonal elements of the bidiagonal
+* matrix B.
+* On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
* will contain the diagonal and superdiagonal elements of a
* bidiagonal matrix orthogonally equivalent to the one given
* as input. E(N) is used for workspace.
*
* VT (input/output) COMPLEX*16 array, dimension (LDVT, NCVT)
* On entry, an N-by-NCVT matrix VT.
-* On exit, VT is overwritten by P' * VT.
-* VT is not referenced if NCVT = 0.
+* On exit, VT is overwritten by P**H * VT.
+* Not referenced if NCVT = 0.
*
* LDVT (input) INTEGER
* The leading dimension of the array VT.
@@ -89,21 +100,22 @@
* U (input/output) COMPLEX*16 array, dimension (LDU, N)
* On entry, an NRU-by-N matrix U.
* On exit, U is overwritten by U * Q.
-* U is not referenced if NRU = 0.
+* Not referenced if NRU = 0.
*
* LDU (input) INTEGER
* The leading dimension of the array U. LDU >= max(1,NRU).
*
* C (input/output) COMPLEX*16 array, dimension (LDC, NCC)
* On entry, an N-by-NCC matrix C.
-* On exit, C is overwritten by Q' * C.
-* C is not referenced if NCC = 0.
+* On exit, C is overwritten by Q**H * C.
+* Not referenced if NCC = 0.
*
* LDC (input) INTEGER
* The leading dimension of the array C.
* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
*
-* RWORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+* RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+* if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
*
* INFO (output) INTEGER
* = 0: successful exit
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/zgghrd.f LAPACK/TIMING/EIG/EIGSRC/zgghrd.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/zgghrd.f Thu Nov 4 14:28:32 1999
+++ LAPACK/TIMING/EIG/EIGSRC/zgghrd.f Fri May 25 16:20:24 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* September 30, 1994
+* April 26, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ
@@ -33,16 +33,29 @@
*
* ZGGHRD reduces a pair of complex matrices (A,B) to generalized upper
* Hessenberg form using unitary transformations, where A is a
-* general matrix and B is upper triangular: Q' * A * Z = H and
-* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
-* and Q and Z are unitary, and ' means conjugate transpose.
+* general matrix and B is upper triangular. The form of the
+* generalized eigenvalue problem is
+* A*x = lambda*B*x,
+* and B is typically made upper triangular by computing its QR
+* factorization and moving the unitary matrix Q to the left side
+* of the equation.
+*
+* This subroutine simultaneously reduces A to a Hessenberg matrix H:
+* Q**H*A*Z = H
+* and transforms B to another upper triangular matrix T:
+* Q**H*B*Z = T
+* in order to reduce the problem to its standard form
+* H*y = lambda*T*y
+* where y = Z**H*x.
*
* The unitary matrices Q and Z are determined as products of Givens
* rotations. They may either be formed explicitly, or they may be
* postmultiplied into input matrices Q1 and Z1, so that
-*
-* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
-* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+* Q1 * A * Z1**H = (Q1*Q) * H * (Z1*Z)**H
+* Q1 * B * Z1**H = (Q1*Q) * T * (Z1*Z)**H
+* If Q1 is the unitary matrix from the QR factorization of B in the
+* original equation A*x = lambda*B*x, then ZGGHRD reduces the original
+* problem to generalized Hessenberg form.
*
* Arguments
* =========
@@ -66,10 +79,11 @@
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
-* by a previous call to ZGGBAL; otherwise they should be set
-* to 1 and N respectively.
+* ILO and IHI mark the rows and columns of A which are to be
+* reduced. It is assumed that A is already upper triangular
+* in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are
+* normally set by a previous call to ZGGBAL; otherwise they
+* should be set to 1 and N respectively.
* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
*
* A (input/output) COMPLEX*16 array, dimension (LDA, N)
@@ -83,33 +97,28 @@
*
* B (input/output) COMPLEX*16 array, dimension (LDB, N)
* On entry, the N-by-N upper triangular matrix B.
-* On exit, the upper triangular matrix T = Q' B Z. The
+* On exit, the upper triangular matrix T = Q**H B Z. The
* elements below the diagonal are set to zero.
*
* LDB (input) INTEGER
* The leading dimension of the array B. LDB >= max(1,N).
*
* Q (input/output) COMPLEX*16 array, dimension (LDQ, N)
-* If COMPQ='N': Q is not referenced.
-* If COMPQ='I': on entry, Q need not be set, and on exit it
-* contains the unitary matrix Q, where Q'
-* is the product of the Givens transformations
-* which are applied to A and B on the left.
-* If COMPQ='V': on entry, Q must contain a unitary matrix
-* Q1, and on exit this is overwritten by Q1*Q.
+* On entry, if COMPQ = 'V', the unitary matrix Q1, typically
+* from the QR factorization of B.
+* On exit, if COMPQ='I', the unitary matrix Q, and if
+* COMPQ = 'V', the product Q1*Q.
+* Not referenced if COMPQ='N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q.
* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
*
* Z (input/output) COMPLEX*16 array, dimension (LDZ, N)
-* If COMPZ='N': Z is not referenced.
-* If COMPZ='I': on entry, Z need not be set, and on exit it
-* contains the unitary matrix Z, which is
-* the product of the Givens transformations
-* which are applied to A and B on the right.
-* If COMPZ='V': on entry, Z must contain a unitary matrix
-* Z1, and on exit this is overwritten by Z1*Z.
+* On entry, if COMPZ = 'V', the unitary matrix Z1.
+* On exit, if COMPZ='I', the unitary matrix Z, and if
+* COMPZ = 'V', the product Z1*Z.
+* Not referenced if COMPZ='N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z.
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/zhgeqz.f LAPACK/TIMING/EIG/EIGSRC/zhgeqz.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/zhgeqz.f Thu Nov 4 14:28:33 1999
+++ LAPACK/TIMING/EIG/EIGSRC/zhgeqz.f Fri May 25 16:20:38 2001
@@ -1,20 +1,21 @@
- SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
$ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,
$ RWORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 3, 2001
*
* .. Scalar Arguments ..
CHARACTER COMPQ, COMPZ, JOB
- INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+ INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
* ..
* .. Array Arguments ..
DOUBLE PRECISION RWORK( * )
- COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
- $ BETA( * ), Q( LDQ, * ), WORK( * ), Z( LDZ, * )
+ COMPLEX*16 ALPHA( * ), BETA( * ), H( LDH, * ),
+ $ Q( LDQ, * ), T( LDT, * ), WORK( * ),
+ $ Z( LDZ, * )
* ..
*
* ----------------------- Begin Timing Code ------------------------
@@ -34,24 +35,44 @@
* Purpose
* =======
*
-* ZHGEQZ implements a single-shift version of the QZ
-* method for finding the generalized eigenvalues w(i)=ALPHA(i)/BETA(i)
-* of the equation
-*
-* det( A - w(i) B ) = 0
-*
-* If JOB='S', then the pair (A,B) is simultaneously
-* reduced to Schur form (i.e., A and B are both upper triangular) by
-* applying one unitary tranformation (usually called Q) on the left and
-* another (usually called Z) on the right. The diagonal elements of
-* A are then ALPHA(1),...,ALPHA(N), and of B are BETA(1),...,BETA(N).
-*
-* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the unitary
-* transformations used to reduce (A,B) are accumulated into the arrays
-* Q and Z s.t.:
-*
-* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
-* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+* ZHGEQZ computes the eigenvalues of a complex matrix pair (H,T),
+* where H is an upper Hessenberg matrix and T is upper triangular,
+* using the single-shift QZ method.
+* Matrix pairs of this type are produced by the reduction to
+* generalized upper Hessenberg form of a complex matrix pair (A,B):
+*
+* A = Q1*H*Z1**H, B = Q1*T*Z1**H,
+*
+* as computed by ZGGHRD.
+*
+* If JOB='S', then the Hessenberg-triangular pair (H,T) is
+* also reduced to generalized Schur form,
+*
+* H = Q*S*Z**H, T = Q*P*Z**H,
+*
+* where Q and Z are unitary matrices and S and P are upper triangular.
+*
+* Optionally, the unitary matrix Q from the generalized Schur
+* factorization may be postmultiplied into an input matrix Q1, and the
+* unitary matrix Z may be postmultiplied into an input matrix Z1.
+* If Q1 and Z1 are the unitary matrices from ZGGHRD that reduced
+* the matrix pair (A,B) to generalized Hessenberg form, then the output
+* matrices Q1*Q and Z1*Z are the unitary factors from the generalized
+* Schur factorization of (A,B):
+*
+* A = (Q1*Q)*S*(Z1*Z)**H, B = (Q1*Q)*P*(Z1*Z)**H.
+*
+* To avoid overflow, eigenvalues of the matrix pair (H,T)
+* (equivalently, of (A,B)) are computed as a pair of complex values
+* (alpha,beta). If beta is nonzero, lambda = alpha / beta is an
+* eigenvalue of the generalized nonsymmetric eigenvalue problem (GNEP)
+* A*x = lambda*B*x
+* and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
+* alternate form of the GNEP
+* mu*A*y = B*y.
+* The values of alpha and beta for the i-th eigenvalue can be read
+* directly from the generalized Schur form: alpha = S(i,i),
+* beta = P(i,i).
*
* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
@@ -61,83 +82,88 @@
* =========
*
* JOB (input) CHARACTER*1
-* = 'E': compute only ALPHA and BETA. A and B will not
-* necessarily be put into generalized Schur form.
-* = 'S': put A and B into generalized Schur form, as well
-* as computing ALPHA and BETA.
+* = 'E': Compute eigenvalues only;
+* = 'S': Computer eigenvalues and the Schur form.
*
* COMPQ (input) CHARACTER*1
-* = 'N': do not modify Q.
-* = 'V': multiply the array Q on the right by the conjugate
-* transpose of the unitary tranformation that is
-* applied to the left side of A and B to reduce them
-* to Schur form.
-* = 'I': like COMPQ='V', except that Q will be initialized to
-* the identity first.
+* = 'N': Left Schur vectors (Q) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Q
+* of left Schur vectors of (H,T) is returned;
+* = 'V': Q must contain a unitary matrix Q1 on entry and
+* the product Q1*Q is returned.
*
* COMPZ (input) CHARACTER*1
-* = 'N': do not modify Z.
-* = 'V': multiply the array Z on the right by the unitary
-* tranformation that is applied to the right side of
-* A and B to reduce them to Schur form.
-* = 'I': like COMPZ='V', except that Z will be initialized to
-* the identity first.
+* = 'N': Right Schur vectors (Z) are not computed;
+* = 'I': Q is initialized to the unit matrix and the matrix Z
+* of right Schur vectors of (H,T) is returned;
+* = 'V': Z must contain a unitary matrix Z1 on entry and
+* the product Z1*Z is returned.
*
* N (input) INTEGER
-* The order of the matrices A, B, Q, and Z. N >= 0.
+* The order of the matrices H, T, Q, and Z. N >= 0.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
-* It is assumed that A is already upper triangular in rows and
-* columns 1:ILO-1 and IHI+1:N.
-* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-* A (input/output) COMPLEX*16 array, dimension (LDA, N)
-* On entry, the N-by-N upper Hessenberg matrix A. Elements
-* below the subdiagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit A will have been destroyed.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max( 1, N ).
-*
-* B (input/output) COMPLEX*16 array, dimension (LDB, N)
-* On entry, the N-by-N upper triangular matrix B. Elements
-* below the diagonal must be zero.
-* If JOB='S', then on exit A and B will have been
-* simultaneously reduced to upper triangular form.
-* If JOB='E', then on exit B will have been destroyed.
+* ILO and IHI mark the rows and columns of H which are in
+* Hessenberg form. It is assumed that A is already upper
+* triangular in rows and columns 1:ILO-1 and IHI+1:N.
+* If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
+*
+* H (input/output) COMPLEX*16 array, dimension (LDH, N)
+* On entry, the N-by-N upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper triangular
+* matrix S from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of H matches that of S, but
+* the rest of H is unspecified.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max( 1, N ).
+*
+* T (input/output) COMPLEX*16 array, dimension (LDT, N)
+* On entry, the N-by-N upper triangular matrix T.
+* On exit, if JOB = 'S', T contains the upper triangular
+* matrix P from the generalized Schur factorization.
+* If JOB = 'E', the diagonal of T matches that of P, but
+* the rest of T is unspecified.
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max( 1, N ).
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max( 1, N ).
*
* ALPHA (output) COMPLEX*16 array, dimension (N)
-* The diagonal elements of A when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues.
+* The complex scalars alpha that define the eigenvalues of
+* GNEP. ALPHA(i) = S(i,i) in the generalized Schur
+* factorization.
*
* BETA (output) COMPLEX*16 array, dimension (N)
-* The diagonal elements of B when the pair (A,B) has been
-* reduced to Schur form. ALPHA(i)/BETA(i) i=1,...,N
-* are the generalized eigenvalues. A and B are normalized
-* so that BETA(1),...,BETA(N) are non-negative real numbers.
+* The real non-negative scalars beta that define the
+* eigenvalues of GNEP. BETA(i) = P(i,i) in the generalized
+* Schur factorization.
+*
+* Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
+* represent the j-th eigenvalue of the matrix pair (A,B), in
+* one of the forms lambda = alpha/beta or mu = beta/alpha.
+* Since either lambda or mu may overflow, they should not,
+* in general, be computed.
*
* Q (input/output) COMPLEX*16 array, dimension (LDQ, N)
-* If COMPQ='N', then Q will not be referenced.
-* If COMPQ='V' or 'I', then the conjugate transpose of the
-* unitary transformations which are applied to A and B on
-* the left will be applied to the array Q on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Q1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of left Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* left Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDQ (input) INTEGER
* The leading dimension of the array Q. LDQ >= 1.
* If COMPQ='V' or 'I', then LDQ >= N.
*
* Z (input/output) COMPLEX*16 array, dimension (LDZ, N)
-* If COMPZ='N', then Z will not be referenced.
-* If COMPZ='V' or 'I', then the unitary transformations which
-* are applied to A and B on the right will be applied to the
-* array Z on the right.
+* On entry, if COMPZ = 'V', the unitary matrix Z1 used in the
+* reduction of (A,B) to generalized Hessenberg form.
+* On exit, if COMPZ = 'I', the unitary matrix of right Schur
+* vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
+* right Schur vectors of (A,B).
+* Not referenced if COMPZ = 'N'.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1.
@@ -159,13 +185,12 @@
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
-* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* = 1,...,N: the QZ iteration did not converge. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO+1,...,N should be correct.
-* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* = N+1,...,2*N: the shift calculation failed. (H,T) is not
* in Schur form, but ALPHA(i) and BETA(i),
* i=INFO-N+1,...,N should be correct.
-* > 2*N: various "impossible" errors.
*
* Further Details
* ===============
@@ -192,7 +217,7 @@
DOUBLE PRECISION ABSB, ANORM, ASCALE, ATOL, BNORM, BSCALE, BTOL,
$ C, OPST, SAFMIN, TEMP, TEMP2, TEMPR, ULP
COMPLEX*16 ABI22, AD11, AD12, AD21, AD22, CTEMP, CTEMP2,
- $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T,
+ $ CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T1,
$ U12, X
* ..
* .. External Functions ..
@@ -279,9 +304,9 @@
INFO = -5
ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
INFO = -6
- ELSE IF( LDA.LT.N ) THEN
+ ELSE IF( LDH.LT.N ) THEN
INFO = -8
- ELSE IF( LDB.LT.N ) THEN
+ ELSE IF( LDT.LT.N ) THEN
INFO = -10
ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
INFO = -14
@@ -317,8 +342,8 @@
IN = IHI + 1 - ILO
SAFMIN = DLAMCH( 'S' )
ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
- ANORM = ZLANHS( 'F', IN, A( ILO, ILO ), LDA, RWORK )
- BNORM = ZLANHS( 'F', IN, B( ILO, ILO ), LDB, RWORK )
+ ANORM = ZLANHS( 'F', IN, H( ILO, ILO ), LDH, RWORK )
+ BNORM = ZLANHS( 'F', IN, T( ILO, ILO ), LDT, RWORK )
ATOL = MAX( SAFMIN, ULP*ANORM )
BTOL = MAX( SAFMIN, ULP*BNORM )
ASCALE = ONE / MAX( SAFMIN, ANORM )
@@ -335,18 +360,18 @@
* Set Eigenvalues IHI+1:N
*
DO 10 J = IHI + 1, N
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = DCONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = DCONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL ZSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL ZSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL ZSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL ZSCAL( J, SIGNBC, H( 1, J ), 1 )
* ----------------- Begin Timing Code ---------------------
OPST = OPST + DBLE( 12*( J-1 ) )
* ------------------ End Timing Code ----------------------
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL ZSCAL( N, SIGNBC, Z( 1, J ), 1 )
@@ -354,10 +379,10 @@
OPST = OPST + DBLE( 6*NZ+13 )
* -------------------- End Timing Code -----------------------
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
10 CONTINUE
*
* If IHI < ILO, skip QZ steps
@@ -402,22 +427,22 @@
* Split the matrix if possible.
*
* Two tests:
-* 1: A(j,j-1)=0 or j=ILO
-* 2: B(j,j)=0
+* 1: H(j,j-1)=0 or j=ILO
+* 2: T(j,j)=0
*
* Special case: j=ILAST
*
IF( ILAST.EQ.ILO ) THEN
GO TO 60
ELSE
- IF( ABS1( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
- A( ILAST, ILAST-1 ) = CZERO
+ IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ H( ILAST, ILAST-1 ) = CZERO
GO TO 60
END IF
END IF
*
- IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
- B( ILAST, ILAST ) = CZERO
+ IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
+ T( ILAST, ILAST ) = CZERO
GO TO 50
END IF
*
@@ -425,30 +450,30 @@
*
DO 40 J = ILAST - 1, ILO, -1
*
-* Test 1: for A(j,j-1)=0 or j=ILO
+* Test 1: for H(j,j-1)=0 or j=ILO
*
IF( J.EQ.ILO ) THEN
ILAZRO = .TRUE.
ELSE
- IF( ABS1( A( J, J-1 ) ).LE.ATOL ) THEN
- A( J, J-1 ) = CZERO
+ IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN
+ H( J, J-1 ) = CZERO
ILAZRO = .TRUE.
ELSE
ILAZRO = .FALSE.
END IF
END IF
*
-* Test 2: for B(j,j)=0
+* Test 2: for T(j,j)=0
*
- IF( ABS( B( J, J ) ).LT.BTOL ) THEN
- B( J, J ) = CZERO
+ IF( ABS( T( J, J ) ).LT.BTOL ) THEN
+ T( J, J ) = CZERO
*
* Test 1a: Check for 2 consecutive small subdiagonals in A
*
ILAZR2 = .FALSE.
IF( .NOT.ILAZRO ) THEN
- IF( ABS1( A( J, J-1 ) )*( ASCALE*ABS1( A( J+1,
- $ J ) ) ).LE.ABS1( A( J, J ) )*( ASCALE*ATOL ) )
+ IF( ABS1( H( J, J-1 ) )*( ASCALE*ABS1( H( J+1,
+ $ J ) ) ).LE.ABS1( H( J, J ) )*( ASCALE*ATOL ) )
$ ILAZR2 = .TRUE.
END IF
*
@@ -460,24 +485,24 @@
*
IF( ILAZRO .OR. ILAZR2 ) THEN
DO 20 JCH = J, ILAST - 1
- CTEMP = A( JCH, JCH )
- CALL ZLARTG( CTEMP, A( JCH+1, JCH ), C, S,
- $ A( JCH, JCH ) )
- A( JCH+1, JCH ) = CZERO
- CALL ZROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
- $ A( JCH+1, JCH+1 ), LDA, C, S )
- CALL ZROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
- $ B( JCH+1, JCH+1 ), LDB, C, S )
+ CTEMP = H( JCH, JCH )
+ CALL ZLARTG( CTEMP, H( JCH+1, JCH ), C, S,
+ $ H( JCH, JCH ) )
+ H( JCH+1, JCH ) = CZERO
+ CALL ZROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
+ $ H( JCH+1, JCH+1 ), LDH, C, S )
+ CALL ZROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
+ $ T( JCH+1, JCH+1 ), LDT, C, S )
IF( ILQ )
$ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, DCONJG( S ) )
IF( ILAZR2 )
- $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
ILAZR2 = .FALSE.
* --------------- Begin Timing Code -----------------
OPST = OPST + DBLE( 32+40*( ILASTM-JCH )+20*NQ )
* ---------------- End Timing Code ------------------
- IF( ABS1( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( ABS1( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
IF( JCH+1.GE.ILAST ) THEN
GO TO 60
ELSE
@@ -485,35 +510,35 @@
GO TO 70
END IF
END IF
- B( JCH+1, JCH+1 ) = CZERO
+ T( JCH+1, JCH+1 ) = CZERO
20 CONTINUE
GO TO 50
ELSE
*
-* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
-* Then process as in the case B(ILAST,ILAST)=0
+* Only test 2 passed -- chase the zero to T(ILAST,ILAST)
+* Then process as in the case T(ILAST,ILAST)=0
*
DO 30 JCH = J, ILAST - 1
- CTEMP = B( JCH, JCH+1 )
- CALL ZLARTG( CTEMP, B( JCH+1, JCH+1 ), C, S,
- $ B( JCH, JCH+1 ) )
- B( JCH+1, JCH+1 ) = CZERO
+ CTEMP = T( JCH, JCH+1 )
+ CALL ZLARTG( CTEMP, T( JCH+1, JCH+1 ), C, S,
+ $ T( JCH, JCH+1 ) )
+ T( JCH+1, JCH+1 ) = CZERO
IF( JCH.LT.ILASTM-1 )
- $ CALL ZROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
- $ B( JCH+1, JCH+2 ), LDB, C, S )
- CALL ZROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
- $ A( JCH+1, JCH-1 ), LDA, C, S )
+ $ CALL ZROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+ $ T( JCH+1, JCH+2 ), LDT, C, S )
+ CALL ZROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
+ $ H( JCH+1, JCH-1 ), LDH, C, S )
IF( ILQ )
$ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
$ C, DCONJG( S ) )
- CTEMP = A( JCH+1, JCH )
- CALL ZLARTG( CTEMP, A( JCH+1, JCH-1 ), C, S,
- $ A( JCH+1, JCH ) )
- A( JCH+1, JCH-1 ) = CZERO
- CALL ZROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
- $ A( IFRSTM, JCH-1 ), 1, C, S )
- CALL ZROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
- $ B( IFRSTM, JCH-1 ), 1, C, S )
+ CTEMP = H( JCH+1, JCH )
+ CALL ZLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S,
+ $ H( JCH+1, JCH ) )
+ H( JCH+1, JCH-1 ) = CZERO
+ CALL ZROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
+ $ H( IFRSTM, JCH-1 ), 1, C, S )
+ CALL ZROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
+ $ T( IFRSTM, JCH-1 ), 1, C, S )
IF( ILZ )
$ CALL ZROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
$ C, S )
@@ -543,40 +568,40 @@
INFO = 2*N + 1
GO TO 210
*
-* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
* 1x1 block.
*
50 CONTINUE
- CTEMP = A( ILAST, ILAST )
- CALL ZLARTG( CTEMP, A( ILAST, ILAST-1 ), C, S,
- $ A( ILAST, ILAST ) )
- A( ILAST, ILAST-1 ) = CZERO
- CALL ZROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
- $ A( IFRSTM, ILAST-1 ), 1, C, S )
- CALL ZROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
- $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ CTEMP = H( ILAST, ILAST )
+ CALL ZLARTG( CTEMP, H( ILAST, ILAST-1 ), C, S,
+ $ H( ILAST, ILAST ) )
+ H( ILAST, ILAST-1 ) = CZERO
+ CALL ZROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
+ $ H( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL ZROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
+ $ T( IFRSTM, ILAST-1 ), 1, C, S )
IF( ILZ )
$ CALL ZROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
* --------------------- Begin Timing Code -----------------------
OPST = OPST + DBLE( 32+40*( ILAST-IFRSTM )+20*NZ )
* ---------------------- End Timing Code ------------------------
*
-* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
+* H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
*
60 CONTINUE
- ABSB = ABS( B( ILAST, ILAST ) )
+ ABSB = ABS( T( ILAST, ILAST ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = DCONJG( B( ILAST, ILAST ) / ABSB )
- B( ILAST, ILAST ) = ABSB
+ SIGNBC = DCONJG( T( ILAST, ILAST ) / ABSB )
+ T( ILAST, ILAST ) = ABSB
IF( ILSCHR ) THEN
- CALL ZSCAL( ILAST-IFRSTM, SIGNBC, B( IFRSTM, ILAST ), 1 )
- CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, A( IFRSTM, ILAST ),
+ CALL ZSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 )
+ CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ),
$ 1 )
* ----------------- Begin Timing Code ---------------------
OPST = OPST + DBLE( 12*( ILAST-IFRSTM ) )
* ------------------ End Timing Code ----------------------
ELSE
- A( ILAST, ILAST ) = A( ILAST, ILAST )*SIGNBC
+ H( ILAST, ILAST ) = H( ILAST, ILAST )*SIGNBC
END IF
IF( ILZ )
$ CALL ZSCAL( N, SIGNBC, Z( 1, ILAST ), 1 )
@@ -584,10 +609,10 @@
OPST = OPST + DBLE( 6*NZ+13 )
* -------------------- End Timing Code -----------------------
ELSE
- B( ILAST, ILAST ) = CZERO
+ T( ILAST, ILAST ) = CZERO
END IF
- ALPHA( ILAST ) = A( ILAST, ILAST )
- BETA( ILAST ) = B( ILAST, ILAST )
+ ALPHA( ILAST ) = H( ILAST, ILAST )
+ BETA( ILAST ) = T( ILAST, ILAST )
*
* Go to next block -- exit if finished.
*
@@ -620,7 +645,7 @@
* Compute the Shift.
*
* At this point, IFIRST < ILAST, and the diagonal elements of
-* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
* magnitude)
*
IF( ( IITER / 10 )*10.NE.IITER ) THEN
@@ -632,26 +657,26 @@
* We factor B as U*D, where U has unit diagonals, and
* compute (A*inv(D))*inv(U).
*
- U12 = ( BSCALE*B( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
- AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
- AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
- $ ( BSCALE*B( ILAST, ILAST ) )
+ U12 = ( BSCALE*T( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
+ AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
+ $ ( BSCALE*T( ILAST, ILAST ) )
ABI22 = AD22 - U12*AD21
*
- T = HALF*( AD11+ABI22 )
- RTDISC = SQRT( T**2+AD12*AD21-AD11*AD22 )
- TEMP = DBLE( T-ABI22 )*DBLE( RTDISC ) +
- $ DIMAG( T-ABI22 )*DIMAG( RTDISC )
+ T1 = HALF*( AD11+ABI22 )
+ RTDISC = SQRT( T1**2+AD12*AD21-AD11*AD22 )
+ TEMP = DBLE( T1-ABI22 )*DBLE( RTDISC ) +
+ $ DIMAG( T1-ABI22 )*DIMAG( RTDISC )
IF( TEMP.LE.ZERO ) THEN
- SHIFT = T + RTDISC
+ SHIFT = T1 + RTDISC
ELSE
- SHIFT = T - RTDISC
+ SHIFT = T1 - RTDISC
END IF
*
* ------------------- Begin Timing Code ----------------------
@@ -662,8 +687,8 @@
*
* Exceptional shift. Chosen for no particularly good reason.
*
- ESHIFT = ESHIFT + DCONJG( ( ASCALE*A( ILAST-1, ILAST ) ) /
- $ ( BSCALE*B( ILAST-1, ILAST-1 ) ) )
+ ESHIFT = ESHIFT + DCONJG( ( ASCALE*H( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*T( ILAST-1, ILAST-1 ) ) )
SHIFT = ESHIFT
*
* ------------------- Begin Timing Code ----------------------
@@ -676,21 +701,21 @@
*
DO 80 J = ILAST - 1, IFIRST + 1, -1
ISTART = J
- CTEMP = ASCALE*A( J, J ) - SHIFT*( BSCALE*B( J, J ) )
+ CTEMP = ASCALE*H( J, J ) - SHIFT*( BSCALE*T( J, J ) )
TEMP = ABS1( CTEMP )
- TEMP2 = ASCALE*ABS1( A( J+1, J ) )
+ TEMP2 = ASCALE*ABS1( H( J+1, J ) )
TEMPR = MAX( TEMP, TEMP2 )
IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
TEMP = TEMP / TEMPR
TEMP2 = TEMP2 / TEMPR
END IF
- IF( ABS1( A( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
+ IF( ABS1( H( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
$ GO TO 90
80 CONTINUE
*
ISTART = IFIRST
- CTEMP = ASCALE*A( IFIRST, IFIRST ) -
- $ SHIFT*( BSCALE*B( IFIRST, IFIRST ) )
+ CTEMP = ASCALE*H( IFIRST, IFIRST ) -
+ $ SHIFT*( BSCALE*T( IFIRST, IFIRST ) )
*
* --------------------- Begin Timing Code -----------------------
OPST = OPST - DBLE( 6 )
@@ -702,7 +727,7 @@
*
* Initial Q
*
- CTEMP2 = ASCALE*A( ISTART+1, ISTART )
+ CTEMP2 = ASCALE*H( ISTART+1, ISTART )
*
* --------------------- Begin Timing Code -----------------------
OPST = OPST + DBLE( 2+( ILAST-ISTART )*18 )
@@ -714,18 +739,18 @@
*
DO 150 J = ISTART, ILAST - 1
IF( J.GT.ISTART ) THEN
- CTEMP = A( J, J-1 )
- CALL ZLARTG( CTEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
- A( J+1, J-1 ) = CZERO
+ CTEMP = H( J, J-1 )
+ CALL ZLARTG( CTEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
+ H( J+1, J-1 ) = CZERO
END IF
*
DO 100 JC = J, ILASTM
- CTEMP = C*A( J, JC ) + S*A( J+1, JC )
- A( J+1, JC ) = -DCONJG( S )*A( J, JC ) + C*A( J+1, JC )
- A( J, JC ) = CTEMP
- CTEMP2 = C*B( J, JC ) + S*B( J+1, JC )
- B( J+1, JC ) = -DCONJG( S )*B( J, JC ) + C*B( J+1, JC )
- B( J, JC ) = CTEMP2
+ CTEMP = C*H( J, JC ) + S*H( J+1, JC )
+ H( J+1, JC ) = -DCONJG( S )*H( J, JC ) + C*H( J+1, JC )
+ H( J, JC ) = CTEMP
+ CTEMP2 = C*T( J, JC ) + S*T( J+1, JC )
+ T( J+1, JC ) = -DCONJG( S )*T( J, JC ) + C*T( J+1, JC )
+ T( J, JC ) = CTEMP2
100 CONTINUE
IF( ILQ ) THEN
DO 110 JR = 1, N
@@ -735,19 +760,19 @@
110 CONTINUE
END IF
*
- CTEMP = B( J+1, J+1 )
- CALL ZLARTG( CTEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
- B( J+1, J ) = CZERO
+ CTEMP = T( J+1, J+1 )
+ CALL ZLARTG( CTEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
+ T( J+1, J ) = CZERO
*
DO 120 JR = IFRSTM, MIN( J+2, ILAST )
- CTEMP = C*A( JR, J+1 ) + S*A( JR, J )
- A( JR, J ) = -DCONJG( S )*A( JR, J+1 ) + C*A( JR, J )
- A( JR, J+1 ) = CTEMP
+ CTEMP = C*H( JR, J+1 ) + S*H( JR, J )
+ H( JR, J ) = -DCONJG( S )*H( JR, J+1 ) + C*H( JR, J )
+ H( JR, J+1 ) = CTEMP
120 CONTINUE
DO 130 JR = IFRSTM, J
- CTEMP = C*B( JR, J+1 ) + S*B( JR, J )
- B( JR, J ) = -DCONJG( S )*B( JR, J+1 ) + C*B( JR, J )
- B( JR, J+1 ) = CTEMP
+ CTEMP = C*T( JR, J+1 ) + S*T( JR, J )
+ T( JR, J ) = -DCONJG( S )*T( JR, J+1 ) + C*T( JR, J )
+ T( JR, J+1 ) = CTEMP
130 CONTINUE
IF( ILZ ) THEN
DO 140 JR = 1, N
@@ -793,18 +818,18 @@
* Set Eigenvalues 1:ILO-1
*
DO 200 J = 1, ILO - 1
- ABSB = ABS( B( J, J ) )
+ ABSB = ABS( T( J, J ) )
IF( ABSB.GT.SAFMIN ) THEN
- SIGNBC = DCONJG( B( J, J ) / ABSB )
- B( J, J ) = ABSB
+ SIGNBC = DCONJG( T( J, J ) / ABSB )
+ T( J, J ) = ABSB
IF( ILSCHR ) THEN
- CALL ZSCAL( J-1, SIGNBC, B( 1, J ), 1 )
- CALL ZSCAL( J, SIGNBC, A( 1, J ), 1 )
+ CALL ZSCAL( J-1, SIGNBC, T( 1, J ), 1 )
+ CALL ZSCAL( J, SIGNBC, H( 1, J ), 1 )
* ----------------- Begin Timing Code ---------------------
OPST = OPST + DBLE( 12*( J-1 ) )
* ------------------ End Timing Code ----------------------
ELSE
- A( J, J ) = A( J, J )*SIGNBC
+ H( J, J ) = H( J, J )*SIGNBC
END IF
IF( ILZ )
$ CALL ZSCAL( N, SIGNBC, Z( 1, J ), 1 )
@@ -812,10 +837,10 @@
OPST = OPST + DBLE( 6*NZ+13 )
* -------------------- End Timing Code -----------------------
ELSE
- B( J, J ) = CZERO
+ T( J, J ) = CZERO
END IF
- ALPHA( J ) = A( J, J )
- BETA( J ) = B( J, J )
+ ALPHA( J ) = H( J, J )
+ BETA( J ) = T( J, J )
200 CONTINUE
*
* Normal Termination
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/ztgevc.f LAPACK/TIMING/EIG/EIGSRC/ztgevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/ztgevc.f Thu Nov 4 14:28:33 1999
+++ LAPACK/TIMING/EIG/EIGSRC/ztgevc.f Fri May 25 16:20:52 2001
@@ -1,19 +1,19 @@
- SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
+ SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
$ LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO )
*
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 4, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
- INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
+ INTEGER INFO, LDP, LDS, LDVL, LDVR, M, MM, N
* ..
* .. Array Arguments ..
LOGICAL SELECT( * )
DOUBLE PRECISION RWORK( * )
- COMPLEX*16 A( LDA, * ), B( LDB, * ), VL( LDVL, * ),
+ COMPLEX*16 P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
$ VR( LDVR, * ), WORK( * )
* ..
*
@@ -34,28 +34,30 @@
* Purpose
* =======
*
-* ZTGEVC computes some or all of the right and/or left generalized
-* eigenvectors of a pair of complex upper triangular matrices (A,B).
-*
-* The right generalized eigenvector x and the left generalized
-* eigenvector y of (A,B) corresponding to a generalized eigenvalue
-* w are defined by:
-*
-* (A - wB) * x = 0 and y**H * (A - wB) = 0
-*
+* ZTGEVC computes some or all of the right and/or left eigenvectors of
+* a pair of complex matrices (S,P), where S and P are upper triangular.
+* Matrix pairs of this type are produced by the generalized Schur
+* factorization of a complex matrix pair (A,B):
+*
+* A = Q*S*Z**H, B = Q*P*Z**H
+*
+* as computed by ZGGHRD + ZHGEQZ.
+*
+* The right eigenvector x and the left eigenvector y of (S,P)
+* corresponding to an eigenvalue w are defined by:
+*
+* S*x = w*P*x, (y**H)*S = w*(y**H)*P,
+*
* where y**H denotes the conjugate tranpose of y.
-*
-* If an eigenvalue w is determined by zero diagonal elements of both A
-* and B, a unit vector is returned as the corresponding eigenvector.
-*
-* If all eigenvectors are requested, the routine may either return
-* the matrices X and/or Y of right or left eigenvectors of (A,B), or
-* the products Z*X and/or Q*Y, where Z and Q are input unitary
-* matrices. If (A,B) was obtained from the generalized Schur
-* factorization of an original pair of matrices
-* (A0,B0) = (Q*A*Z**H,Q*B*Z**H),
-* then Z*X and Q*Y are the matrices of right or left eigenvectors of
-* A.
+* The eigenvalues are not input to this routine, but are computed
+* directly from the diagonal elements of S and P.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of (S,P), or the products Z*X and/or Q*Y,
+* where Z and Q are input matrices.
+* If Q and Z are the unitary factors from the generalized Schur
+* factorization of a matrix pair (A,B), then Z*X and Q*Y
+* are the matrices of right and left eigenvectors of (A,B).
*
* Arguments
* =========
@@ -67,70 +69,69 @@
*
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
-* = 'B': compute all right and/or left eigenvectors, and
-* backtransform them using the input matrices supplied
-* in VR and/or VL;
+* = 'B': compute all right and/or left eigenvectors,
+* backtransformed by the matrices in VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
* specified by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY='S', SELECT specifies the eigenvectors to be
-* computed.
-* If HOWMNY='A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* computed. The eigenvector corresponding to the j-th
+* eigenvalue is computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
-* The order of the matrices A and B. N >= 0.
-*
-* A (input) COMPLEX*16 array, dimension (LDA,N)
-* The upper triangular matrix A.
-*
-* LDA (input) INTEGER
-* The leading dimension of array A. LDA >= max(1,N).
+* The order of the matrices S and P. N >= 0.
*
-* B (input) COMPLEX*16 array, dimension (LDB,N)
-* The upper triangular matrix B. B must have real diagonal
-* elements.
+* S (input) COMPLEX*16 array, dimension (LDS,N)
+* The upper triangular matrix S from a generalized Schur
+* factorization, as computed by ZHGEQZ.
+*
+* LDS (input) INTEGER
+* The leading dimension of array S. LDS >= max(1,N).
+*
+* P (input) COMPLEX*16 array, dimension (LDP,N)
+* The upper triangular matrix P from a generalized Schur
+* factorization, as computed by ZHGEQZ. P must have real
+* diagonal elements.
*
-* LDB (input) INTEGER
-* The leading dimension of array B. LDB >= max(1,N).
+* LDP (input) INTEGER
+* The leading dimension of array P. LDP >= max(1,N).
*
* VL (input/output) COMPLEX*16 array, dimension (LDVL,MM)
* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
* contain an N-by-N matrix Q (usually the unitary matrix Q
* of left Schur vectors returned by ZHGEQZ).
* On exit, if SIDE = 'L' or 'B', VL contains:
-* if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Q*Y;
-* if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VL, in the same order as their eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of array VL.
-* LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'l' or 'B' or 'b', LDVL >= N.
*
* VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
* contain an N-by-N matrix Q (usually the unitary matrix Z
* of right Schur vectors returned by ZHGEQZ).
* On exit, if SIDE = 'R' or 'B', VR contains:
-* if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
+* if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
* if HOWMNY = 'B', the matrix Z*X;
-* if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
+* if HOWMNY = 'S', the right eigenvectors of (S,P) specified by
* SELECT, stored consecutively in the columns of
* VR, in the same order as their eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B', LDVR >= N.
*
* MM (input) INTEGER
-* The leading dimension of the array VR.
-* LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The number of columns in the arrays VL and/or VR. MM >= M.
*
* M (output) INTEGER
* The number of columns in the arrays VL and/or VR actually
@@ -194,7 +195,7 @@
IHWMNY = 2
ILALL = .FALSE.
ILBACK = .FALSE.
- ELSE IF( LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'T' ) ) THEN
+ ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
IHWMNY = 3
ILALL = .TRUE.
ILBACK = .TRUE.
@@ -225,9 +226,9 @@
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -4
- ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
INFO = -6
- ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
@@ -251,7 +252,7 @@
*
ILBBAD = .FALSE.
DO 20 J = 1, N
- IF( DIMAG( B( J, J ) ).NE.ZERO )
+ IF( DIMAG( P( J, J ) ).NE.ZERO )
$ ILBBAD = .TRUE.
20 CONTINUE
*
@@ -289,19 +290,19 @@
* part of A and B to check for possible overflow in the triangular
* solver.
*
- ANORM = ABS1( A( 1, 1 ) )
- BNORM = ABS1( B( 1, 1 ) )
+ ANORM = ABS1( S( 1, 1 ) )
+ BNORM = ABS1( P( 1, 1 ) )
RWORK( 1 ) = ZERO
RWORK( N+1 ) = ZERO
DO 40 J = 2, N
RWORK( J ) = ZERO
RWORK( N+J ) = ZERO
DO 30 I = 1, J - 1
- RWORK( J ) = RWORK( J ) + ABS1( A( I, J ) )
- RWORK( N+J ) = RWORK( N+J ) + ABS1( B( I, J ) )
+ RWORK( J ) = RWORK( J ) + ABS1( S( I, J ) )
+ RWORK( N+J ) = RWORK( N+J ) + ABS1( P( I, J ) )
30 CONTINUE
- ANORM = MAX( ANORM, RWORK( J )+ABS1( A( J, J ) ) )
- BNORM = MAX( BNORM, RWORK( N+J )+ABS1( B( J, J ) ) )
+ ANORM = MAX( ANORM, RWORK( J )+ABS1( S( J, J ) ) )
+ BNORM = MAX( BNORM, RWORK( N+J )+ABS1( P( J, J ) ) )
40 CONTINUE
*
ASCALE = ONE / MAX( ANORM, SAFMIN )
@@ -326,8 +327,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG + 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( DBLE( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( DBLE( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -343,10 +344,10 @@
* H
* y ( a A - b B ) = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( DBLE( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*DBLE( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( DBLE( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*DBLE( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -403,7 +404,7 @@
*
* Compute
* j-1
-* SUM = sum conjg( a*A(k,j) - b*B(k,j) )*x(k)
+* SUM = sum conjg( a*S(k,j) - b*P(k,j) )*x(k)
* k=je
* (Scale if necessary)
*
@@ -422,16 +423,16 @@
SUMB = CZERO
*
DO 80 JR = JE, J - 1
- SUMA = SUMA + DCONJG( A( JR, J ) )*WORK( JR )
- SUMB = SUMB + DCONJG( B( JR, J ) )*WORK( JR )
+ SUMA = SUMA + DCONJG( S( JR, J ) )*WORK( JR )
+ SUMB = SUMB + DCONJG( P( JR, J ) )*WORK( JR )
80 CONTINUE
SUM = ACOEFF*SUMA - DCONJG( BCOEFF )*SUMB
*
-* Form x(j) = - SUM / conjg( a*A(j,j) - b*B(j,j) )
+* Form x(j) = - SUM / conjg( a*S(j,j) - b*P(j,j) )
*
* with scaling and perturbation of the denominator
*
- D = DCONJG( ACOEFF*A( J, J )-BCOEFF*B( J, J ) )
+ D = DCONJG( ACOEFF*S( J, J )-BCOEFF*P( J, J ) )
IF( ABS1( D ).LE.DMIN )
$ D = DCMPLX( DMIN )
*
@@ -511,8 +512,8 @@
IF( ILCOMP ) THEN
IEIG = IEIG - 1
*
- IF( ABS1( A( JE, JE ) ).LE.SAFMIN .AND.
- $ ABS( DBLE( B( JE, JE ) ) ).LE.SAFMIN ) THEN
+ IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
+ $ ABS( DBLE( P( JE, JE ) ) ).LE.SAFMIN ) THEN
*
* Singular matrix pencil -- return unit eigenvector
*
@@ -528,10 +529,10 @@
*
* ( a A - b B ) x = 0
*
- TEMP = ONE / MAX( ABS1( A( JE, JE ) )*ASCALE,
- $ ABS( DBLE( B( JE, JE ) ) )*BSCALE, SAFMIN )
- SALPHA = ( TEMP*A( JE, JE ) )*ASCALE
- SBETA = ( TEMP*DBLE( B( JE, JE ) ) )*BSCALE
+ TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
+ $ ABS( DBLE( P( JE, JE ) ) )*BSCALE, SAFMIN )
+ SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
+ SBETA = ( TEMP*DBLE( P( JE, JE ) ) )*BSCALE
ACOEFF = SBETA*ASCALE
BCOEFF = SALPHA*BSCALE
*
@@ -584,7 +585,7 @@
* WORK(j+1:JE) contains x
*
DO 170 JR = 1, JE - 1
- WORK( JR ) = ACOEFF*A( JR, JE ) - BCOEFF*B( JR, JE )
+ WORK( JR ) = ACOEFF*S( JR, JE ) - BCOEFF*P( JR, JE )
170 CONTINUE
WORK( JE ) = CONE
*
@@ -593,7 +594,7 @@
* Form x(j) := - w(j) / d
* with scaling and perturbation of the denominator
*
- D = ACOEFF*A( J, J ) - BCOEFF*B( J, J )
+ D = ACOEFF*S( J, J ) - BCOEFF*P( J, J )
IF( ABS1( D ).LE.DMIN )
$ D = DCMPLX( DMIN )
*
@@ -615,7 +616,7 @@
*
IF( J.GT.1 ) THEN
*
-* w = w + x(j)*(a A(*,j) - b B(*,j) ) with scaling
+* w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
*
IF( ABS1( WORK( J ) ).GT.ONE ) THEN
TEMP = ONE / ABS1( WORK( J ) )
@@ -635,8 +636,8 @@
CA = ACOEFF*WORK( J )
CB = BCOEFF*WORK( J )
DO 200 JR = 1, J - 1
- WORK( JR ) = WORK( JR ) + CA*A( JR, J ) -
- $ CB*B( JR, J )
+ WORK( JR ) = WORK( JR ) + CA*S( JR, J ) -
+ $ CB*P( JR, J )
200 CONTINUE
END IF
210 CONTINUE
diff -uNr LAPACK.orig/TIMING/EIG/EIGSRC/ztrevc.f LAPACK/TIMING/EIG/EIGSRC/ztrevc.f
--- LAPACK.orig/TIMING/EIG/EIGSRC/ztrevc.f Thu Nov 4 14:28:34 1999
+++ LAPACK/TIMING/EIG/EIGSRC/ztrevc.f Fri May 25 16:21:10 2001
@@ -4,7 +4,7 @@
* -- LAPACK routine (instrumented to count operations, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* June 30, 1999
+* May 7, 2001
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
@@ -31,20 +31,23 @@
*
* ZTREVC computes some or all of the right and/or left eigenvectors of
* a complex upper triangular matrix T.
-*
+* Matrices of this type are produced by the Schur factorization of
+* a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR.
+*
* The right eigenvector x and the left eigenvector y of T corresponding
* to an eigenvalue w are defined by:
-*
-* T*x = w*x, y'*T = w*y'
-*
-* where y' denotes the conjugate transpose of the vector y.
-*
-* If all eigenvectors are requested, the routine may either return the
-* matrices X and/or Y of right or left eigenvectors of T, or the
-* products Q*X and/or Q*Y, where Q is an input unitary
-* matrix. If T was obtained from the Schur factorization of an
-* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
-* right or left eigenvectors of A.
+*
+* T*x = w*x, (y**H)*T = w*(y**H)
+*
+* where y**H denotes the conjugate transpose of the vector y.
+* The eigenvalues are not input to this routine, but are read directly
+* from the diagonal of T.
+*
+* This routine returns the matrices X and/or Y of right and left
+* eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
+* input matrix. If Q is the unitary factor that reduces a matrix A to
+* Schur form T, then Q*X and Q*Y are the matrices of right and left
+* eigenvectors of A.
*
* Arguments
* =========
@@ -57,17 +60,17 @@
* HOWMNY (input) CHARACTER*1
* = 'A': compute all right and/or left eigenvectors;
* = 'B': compute all right and/or left eigenvectors,
-* and backtransform them using the input matrices
-* supplied in VR and/or VL;
+* backtransformed using the matrices supplied in
+* VR and/or VL;
* = 'S': compute selected right and/or left eigenvectors,
-* specified by the logical array SELECT.
+* as indicated by the logical array SELECT.
*
* SELECT (input) LOGICAL array, dimension (N)
* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
* computed.
-* If HOWMNY = 'A' or 'B', SELECT is not referenced.
-* To select the eigenvector corresponding to the j-th
-* eigenvalue, SELECT(j) must be set to .TRUE..
+* The eigenvector corresponding to the j-th eigenvalue is
+* computed if SELECT(j) = .TRUE..
+* Not referenced if HOWMNY = 'A' or 'B'.
*
* N (input) INTEGER
* The order of the matrix T. N >= 0.
@@ -85,19 +88,16 @@
* Schur vectors returned by ZHSEQR).
* On exit, if SIDE = 'L' or 'B', VL contains:
* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-* VL is lower triangular. The i-th column
-* VL(i) of VL is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*Y;
* if HOWMNY = 'S', the left eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VL, in the same order as their
* eigenvalues.
-* If SIDE = 'R', VL is not referenced.
+* Not referenced if SIDE = 'R'.
*
* LDVL (input) INTEGER
-* The leading dimension of the array VL. LDVL >= max(1,N) if
-* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+* The leading dimension of the array VL. LDVL >= 1, and if
+* SIDE = 'L' or 'B', LDVL >= N.
*
* VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
@@ -105,19 +105,16 @@
* Schur vectors returned by ZHSEQR).
* On exit, if SIDE = 'R' or 'B', VR contains:
* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-* VR is upper triangular. The i-th column
-* VR(i) of VR is the eigenvector corresponding
-* to T(i,i).
* if HOWMNY = 'B', the matrix Q*X;
* if HOWMNY = 'S', the right eigenvectors of T specified by
* SELECT, stored consecutively in the columns
* of VR, in the same order as their
* eigenvalues.
-* If SIDE = 'L', VR is not referenced.
+* Not referenced if SIDE = 'L'.
*
* LDVR (input) INTEGER
-* The leading dimension of the array VR. LDVR >= max(1,N) if
-* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+* The leading dimension of the array VR. LDVR >= 1, and if
+* SIDE = 'R' or 'B'; LDVR >= N.
*
* MM (input) INTEGER
* The number of columns in the arrays VL and/or VR. MM >= M.
diff -uNr LAPACK.orig/TIMING/LIN/LINSRC/cgelss.f LAPACK/TIMING/LIN/LINSRC/cgelss.f
--- LAPACK.orig/TIMING/LIN/LINSRC/cgelss.f Thu Nov 4 14:28:16 1999
+++ LAPACK/TIMING/LIN/LINSRC/cgelss.f Fri May 25 16:21:43 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (instrumented to count ops, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -98,10 +98,9 @@
* LWORK >= 2*min(M,N) + max(M,N,NRHS)
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) REAL array, dimension (5*min(M,N))
*
@@ -187,7 +186,7 @@
* immediately following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -255,13 +254,12 @@
MAXWRK = MAX( MAXWRK, N*NRHS )
END IF
END IF
- MINWRK = MAX( MINWRK, 1 )
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGELSS', -INFO )
RETURN
@@ -632,10 +630,10 @@
$ SOPBL3( 'CGEMM ', M, BL, M )
T1 = SECOND( )
CALL CGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, CZERO, WORK( IWORK ), N )
+ $ B( 1, I ), LDB, CZERO, WORK( IWORK ), M )
T2 = SECOND( )
TIMNG( GEMM ) = TIMNG( GEMM ) + ( T2-T1 )
- CALL CLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ CALL CLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/TIMING/LIN/LINSRC/dgelss.f LAPACK/TIMING/LIN/LINSRC/dgelss.f
--- LAPACK.orig/TIMING/LIN/LINSRC/dgelss.f Thu Nov 4 14:28:17 1999
+++ LAPACK/TIMING/LIN/LINSRC/dgelss.f Fri May 25 16:21:40 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (instrumented to count ops, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -97,10 +97,9 @@
* LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -178,7 +177,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -251,11 +250,10 @@
END IF
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- MINWRK = MAX( MINWRK, 1 )
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGELSS', -INFO )
RETURN
@@ -613,10 +611,10 @@
$ DOPBL3( 'DGEMM ', M, BL, M )
T1 = DSECND( )
CALL DGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, ZERO, WORK( IWORK ), N )
+ $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M )
T2 = DSECND( )
TIMNG( GEMM ) = TIMNG( GEMM ) + ( T2-T1 )
- CALL DLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ CALL DLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/TIMING/LIN/LINSRC/sgelss.f LAPACK/TIMING/LIN/LINSRC/sgelss.f
--- LAPACK.orig/TIMING/LIN/LINSRC/sgelss.f Thu Nov 4 14:28:18 1999
+++ LAPACK/TIMING/LIN/LINSRC/sgelss.f Fri May 25 16:21:36 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (instrumented to count ops, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -97,10 +97,9 @@
* LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* INFO (output) INTEGER
* = 0: successful exit
@@ -178,7 +177,7 @@
* following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -251,11 +250,10 @@
END IF
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- MINWRK = MAX( MINWRK, 1 )
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGELSS', -INFO )
RETURN
@@ -613,10 +611,10 @@
$ SOPBL3( 'SGEMM ', M, BL, M )
T1 = SECOND( )
CALL SGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, ZERO, WORK( IWORK ), N )
+ $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M )
T2 = SECOND( )
TIMNG( GEMM ) = TIMNG( GEMM ) + ( T2-T1 )
- CALL SLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ CALL SLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/TIMING/LIN/LINSRC/zgelss.f LAPACK/TIMING/LIN/LINSRC/zgelss.f
--- LAPACK.orig/TIMING/LIN/LINSRC/zgelss.f Thu Nov 4 14:28:18 1999
+++ LAPACK/TIMING/LIN/LINSRC/zgelss.f Fri May 25 16:21:47 2001
@@ -4,7 +4,7 @@
* -- LAPACK driver routine (instrumented to count ops, version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
-* October 31, 1999
+* April 25, 2001
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -98,10 +98,9 @@
* LWORK >= 2*min(M,N) + max(M,N,NRHS)
* For good performance, LWORK should generally be larger.
*
-* If LWORK = -1, then a workspace query is assumed; the routine
-* only calculates the optimal size of the WORK array, returns
-* this value as the first entry of the WORK array, and no error
-* message related to LWORK is issued by XERBLA.
+* If LWORK = -1, a workspace query is assumed. The optimal
+* size for the WORK array is calculated and stored in WORK(1),
+* and no other work except argument checking is performed.
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (5*min(M,N))
*
@@ -186,7 +185,7 @@
* immediately following subroutine, as returned by ILAENV.)
*
MINWRK = 1
- IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ IF( INFO.EQ.0 ) THEN
MAXWRK = 0
MM = M
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -254,13 +253,12 @@
MAXWRK = MAX( MAXWRK, N*NRHS )
END IF
END IF
- MINWRK = MAX( MINWRK, 1 )
MAXWRK = MAX( MINWRK, MAXWRK )
WORK( 1 ) = MAXWRK
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -12
END IF
*
- IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
- $ INFO = -12
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGELSS', -INFO )
RETURN
@@ -631,10 +629,10 @@
$ DOPBL3( 'ZGEMM ', M, BL, M )
T1 = DSECND( )
CALL ZGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), LDWORK,
- $ B( 1, I ), LDB, CZERO, WORK( IWORK ), N )
+ $ B( 1, I ), LDB, CZERO, WORK( IWORK ), M )
T2 = DSECND( )
TIMNG( GEMM ) = TIMNG( GEMM ) + ( T2-T1 )
- CALL ZLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+ CALL ZLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
diff -uNr LAPACK.orig/TIMING/Makefile LAPACK/TIMING/Makefile
--- LAPACK.orig/TIMING/Makefile Thu Nov 4 14:27:54 1999
+++ LAPACK/TIMING/Makefile Fri May 25 16:17:35 2001
@@ -141,242 +141,242 @@
stime.out: stime.in xlintims
@echo Timing square REAL LAPACK linear equation routines
- xlintims < stime.in > $@ 2>&1
+ ./xlintims < stime.in > $@ 2>&1
STIME.out: STIME.in xlintims
@echo Timing square REAL LAPACK linear equation routines
- xlintims < STIME.in > $@ 2>&1
+ ./xlintims < STIME.in > $@ 2>&1
sband.out: sband.in xlintims
@echo Timing banded REAL LAPACK linear equation routines
- xlintims < sband.in > $@ 2>&1
+ ./xlintims < sband.in > $@ 2>&1
SBAND.out: SBAND.in xlintims
@echo Timing banded REAL LAPACK linear equation routines
- xlintims < SBAND.in > $@ 2>&1
+ ./xlintims < SBAND.in > $@ 2>&1
stime2.out: stime2.in xlintims
@echo Timing rectangular REAL LAPACK linear equation routines
- xlintims < stime2.in > $@ 2>&1
+ ./xlintims < stime2.in > $@ 2>&1
STIME2.out: STIME2.in xlintims
@echo Timing rectangular REAL LAPACK linear equation routines
- xlintims < STIME2.in > $@ 2>&1
+ ./xlintims < STIME2.in > $@ 2>&1
#
# ======== COMPLEX LIN TIMINGS ==========================
ctime.out: ctime.in xlintimc
@echo Timing square COMPLEX LAPACK linear equation routines
- xlintimc < ctime.in > $@ 2>&1
+ ./xlintimc < ctime.in > $@ 2>&1
CTIME.out: CTIME.in xlintimc
@echo Timing square COMPLEX LAPACK linear equation routines
- xlintimc < CTIME.in > $@ 2>&1
+ ./xlintimc < CTIME.in > $@ 2>&1
cband.out: cband.in xlintimc
@echo Timing banded COMPLEX LAPACK linear equation routines
- xlintimc < cband.in > $@ 2>&1
+ ./xlintimc < cband.in > $@ 2>&1
CBAND.out: CBAND.in xlintimc
@echo Timing banded COMPLEX LAPACK linear equation routines
- xlintimc < CBAND.in > $@ 2>&1
+ ./xlintimc < CBAND.in > $@ 2>&1
ctime2.out: ctime2.in xlintimc
@echo Timing rectangular COMPLEX LAPACK linear equation routines
- xlintimc < ctime2.in > $@ 2>&1
+ ./xlintimc < ctime2.in > $@ 2>&1
CTIME2.out: CTIME2.in xlintimc
@echo Timing rectangular COMPLEX LAPACK linear equation routines
- xlintimc < CTIME2.in > $@ 2>&1
+ ./xlintimc < CTIME2.in > $@ 2>&1
#
# ======== DOUBLE LIN TIMINGS ===========================
dtime.out: dtime.in xlintimd
@echo Timing square DOUBLE PRECISION LAPACK linear equation routines
- xlintimd < dtime.in > $@ 2>&1
+ ./xlintimd < dtime.in > $@ 2>&1
DTIME.out: DTIME.in xlintimd
@echo Timing square DOUBLE PRECISION LAPACK linear equation routines
- xlintimd < DTIME.in > $@ 2>&1
+ ./xlintimd < DTIME.in > $@ 2>&1
dband.out: dband.in xlintimd
@echo Timing banded DOUBLE PRECISION LAPACK linear equation routines
- xlintimd < dband.in > $@ 2>&1
+ ./xlintimd < dband.in > $@ 2>&1
DBAND.out: dband.in xlintimd
@echo Timing banded DOUBLE PRECISION LAPACK linear equation routines
- xlintimd < DBAND.in > $@ 2>&1
+ ./xlintimd < DBAND.in > $@ 2>&1
dtime2.out: dtime2.in xlintimd
@echo Timing rectangular DOUBLE PRECISION LAPACK linear equation routines
- xlintimd < dtime2.in > $@ 2>&1
+ ./xlintimd < dtime2.in > $@ 2>&1
DTIME2.out: DTIME2.in xlintimd
@echo Timing rectangular DOUBLE PRECISION LAPACK linear equation routines
- xlintimd < DTIME2.in > $@ 2>&1
+ ./xlintimd < DTIME2.in > $@ 2>&1
#
# ======== COMPLEX16 LIN TIMINGS ========================
ztime.out: ztime.in xlintimz
@echo Timing square COMPLEX16 LAPACK linear equation routines
- xlintimz < ztime.in > $@ 2>&1
+ ./xlintimz < ztime.in > $@ 2>&1
ZTIME.out: ztime.in xlintimz
@echo Timing square COMPLEX16 LAPACK linear equation routines
- xlintimz < ZTIME.in > $@ 2>&1
+ ./xlintimz < ZTIME.in > $@ 2>&1
zband.out: zband.in xlintimz
@echo Timing banded COMPLEX16 LAPACK linear equation routines
- xlintimz < zband.in > $@ 2>&1
+ ./xlintimz < zband.in > $@ 2>&1
ZBAND.out: ZBAND.in xlintimz
@echo Timing banded COMPLEX16 LAPACK linear equation routines
- xlintimz < ZBAND.in > $@ 2>&1
+ ./xlintimz < ZBAND.in > $@ 2>&1
ztime2.out: ztime2.in xlintimz
@echo Timing rectangular COMPLEX16 LAPACK linear equation routines
- xlintimz < ztime2.in > $@ 2>&1
+ ./xlintimz < ztime2.in > $@ 2>&1
ZTIME2.out: ZTIME2.in xlintimz
@echo Timing rectangular COMPLEX16 LAPACK linear equation routines
- xlintimz < ZTIME2.in > $@ 2>&1
+ ./xlintimz < ZTIME2.in > $@ 2>&1
#
#
# ======== SINGLE EIG TIMINGS ===========================
#
sgeptim.out: sgeptim.in xeigtims
@echo GEP: Timing REAL Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtims < sgeptim.in > $@ 2>&1
+ ./xeigtims < sgeptim.in > $@ 2>&1
SGEPTIM.out: SGEPTIM.in xeigtims
@echo GEP: Timing REAL Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtims < SGEPTIM.in > $@ 2>&1
+ ./xeigtims < SGEPTIM.in > $@ 2>&1
sneptim.out: sneptim.in xeigtims
@echo NEP: Timing REAL Nonsymmetric Eigenvalue Problem routines
- xeigtims < sneptim.in > $@ 2>&1
+ ./xeigtims < sneptim.in > $@ 2>&1
SNEPTIM.out: SNEPTIM.in xeigtims
@echo NEP: Timing REAL Nonsymmetric Eigenvalue Problem routines
- xeigtims < SNEPTIM.in > $@ 2>&1
+ ./xeigtims < SNEPTIM.in > $@ 2>&1
sseptim.out: sseptim.in xeigtims
@echo SEP: Timing REAL Symmetric Eigenvalue Problem routines
- xeigtims < sseptim.in > $@ 2>&1
+ ./xeigtims < sseptim.in > $@ 2>&1
SSEPTIM.out: SSEPTIM.in xeigtims
@echo SEP: Timing REAL Symmetric Eigenvalue Problem routines
- xeigtims < SSEPTIM.in > $@ 2>&1
+ ./xeigtims < SSEPTIM.in > $@ 2>&1
ssvdtim.out: ssvdtim.in xeigtims
@echo SVD: Timing REAL Singular Value Decomposition routines
- xeigtims < ssvdtim.in > $@ 2>&1
+ ./xeigtims < ssvdtim.in > $@ 2>&1
SSVDTIM.out: SSVDTIM.in xeigtims
@echo SVD: Timing REAL Singular Value Decomposition routines
- xeigtims < SSVDTIM.in > $@ 2>&1
+ ./xeigtims < SSVDTIM.in > $@ 2>&1
#
# ======== COMPLEX EIG TIMINGS ===========================
#
cgeptim.out: cgeptim.in xeigtimc
@echo GEP: Timing COMPLEX Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtimc < cgeptim.in > $@ 2>&1
+ ./xeigtimc < cgeptim.in > $@ 2>&1
CGEPTIM.out: CGEPTIM.in xeigtimc
@echo GEP: Timing COMPLEX Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtimc < cgeptim.in > $@ 2>&1
+ ./xeigtimc < cgeptim.in > $@ 2>&1
cneptim.out: cneptim.in xeigtimc
@echo NEP: Timing COMPLEX Nonsymmetric Eigenvalue Problem routines
- xeigtimc < cneptim.in > $@ 2>&1
+ ./xeigtimc < cneptim.in > $@ 2>&1
CNEPTIM.out: CNEPTIM.in xeigtimc
@echo NEP: Timing COMPLEX Nonsymmetric Eigenvalue Problem routines
- xeigtimc < CNEPTIM.in > $@ 2>&1
+ ./xeigtimc < CNEPTIM.in > $@ 2>&1
cseptim.out: cseptim.in xeigtimc
@echo SEP: Timing COMPLEX Symmetric Eigenvalue Problem routines
- xeigtimc < cseptim.in > $@ 2>&1
+ ./xeigtimc < cseptim.in > $@ 2>&1
CSEPTIM.out: CSEPTIM.in xeigtimc
@echo SEP: Timing COMPLEX Symmetric Eigenvalue Problem routines
- xeigtimc < CSEPTIM.in > $@ 2>&1
+ ./xeigtimc < CSEPTIM.in > $@ 2>&1
csvdtim.out: csvdtim.in xeigtimc
@echo SVD: Timing COMPLEX Singular Value Decomposition routines
- xeigtimc < csvdtim.in > $@ 2>&1
+ ./xeigtimc < csvdtim.in > $@ 2>&1
CSVDTIM.out: CSVDTIM.in xeigtimc
@echo SVD: Timing COMPLEX Singular Value Decomposition routines
- xeigtimc < CSVDTIM.in > $@ 2>&1
+ ./xeigtimc < CSVDTIM.in > $@ 2>&1
#
# ======== DOUBLE EIG TIMINGS ===========================
#
dgeptim.out: dgeptim.in xeigtimd
@echo GEP: Timing DOUBLE PRECISION Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtimd < dgeptim.in > $@ 2>&1
+ ./xeigtimd < dgeptim.in > $@ 2>&1
DGEPTIM.out: DGEPTIM.in xeigtimd
@echo GEP: Timing DOUBLE PRECISION Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtimd < dgeptim.in > $@ 2>&1
+ ./xeigtimd < dgeptim.in > $@ 2>&1
dneptim.out: dneptim.in xeigtimd
@echo NEP: Timing DOUBLE PRECISION Nonsymmetric Eigenvalue Problem routines
- xeigtimd < dneptim.in > $@ 2>&1
+ ./xeigtimd < dneptim.in > $@ 2>&1
DNEPTIM.out: DNEPTIM.in xeigtimd
@echo NEP: Timing DOUBLE PRECISION Nonsymmetric Eigenvalue Problem routines
- xeigtimd < DNEPTIM.in > $@ 2>&1
+ ./xeigtimd < DNEPTIM.in > $@ 2>&1
dseptim.out: dseptim.in xeigtimd
@echo SEP: Timing DOUBLE PRECISION Symmetric Eigenvalue Problem routines
- xeigtimd < dseptim.in > $@ 2>&1
+ ./xeigtimd < dseptim.in > $@ 2>&1
DSEPTIM.out: DSEPTIM.in xeigtimd
@echo SEP: Timing DOUBLE PRECISION Symmetric Eigenvalue Problem routines
- xeigtimd < DSEPTIM.in > $@ 2>&1
+ ./xeigtimd < DSEPTIM.in > $@ 2>&1
dsvdtim.out: dsvdtim.in xeigtimd
@echo SVD: Timing DOUBLE PRECISION Singular Value Decomposition routines
- xeigtimd < dsvdtim.in > $@ 2>&1
+ ./xeigtimd < dsvdtim.in > $@ 2>&1
DSVDTIM.out: DSVDTIM.in xeigtimd
@echo SVD: Timing DOUBLE PRECISION Singular Value Decomposition routines
- xeigtimd < DSVDTIM.in > $@ 2>&1
+ ./xeigtimd < DSVDTIM.in > $@ 2>&1
#
# ======== COMPLEX16 EIG TIMINGS ===========================
#
zgeptim.out: zgeptim.in xeigtimz
@echo GEP: Timing COMPLEX16 Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtimz < zgeptim.in > $@ 2>&1
+ ./xeigtimz < zgeptim.in > $@ 2>&1
ZGEPTIM.out: ZGEPTIM.in xeigtimz
@echo GEP: Timing COMPLEX16 Generalized Nonsymmetric Eigenvalue Problem routines
- xeigtimz < zgeptim.in > $@ 2>&1
+ ./xeigtimz < zgeptim.in > $@ 2>&1
zneptim.out: zneptim.in xeigtimz
@echo NEP: Timing COMPLEX16 Nonsymmetric Eigenvalue Problem routines
- xeigtimz < zneptim.in > $@ 2>&1
+ ./xeigtimz < zneptim.in > $@ 2>&1
ZNEPTIM.out: ZNEPTIM.in xeigtimz
@echo NEP: Timing COMPLEX16 Nonsymmetric Eigenvalue Problem routines
- xeigtimz < ZNEPTIM.in > $@ 2>&1
+ ./xeigtimz < ZNEPTIM.in > $@ 2>&1
zseptim.out: zseptim.in xeigtimz
@echo SEP: Timing COMPLEX16 Symmetric Eigenvalue Problem routines
- xeigtimz < zseptim.in > $@ 2>&1
+ ./xeigtimz < zseptim.in > $@ 2>&1
ZSEPTIM.out: ZSEPTIM.in xeigtimz
@echo SEP: Timing COMPLEX16 Symmetric Eigenvalue Problem routines
- xeigtimz < ZSEPTIM.in > $@ 2>&1
+ ./xeigtimz < ZSEPTIM.in > $@ 2>&1
zsvdtim.out: zsvdtim.in xeigtimz
@echo SVD: Timing COMPLEX16 Singular Value Decomposition routines
- xeigtimz < zsvdtim.in > $@ 2>&1
+ ./xeigtimz < zsvdtim.in > $@ 2>&1
ZSVDTIM.out: ZSVDTIM.in xeigtimz
@echo SVD: Timing COMPLEX16 Singular Value Decomposition routines
- xeigtimz < ZSVDTIM.in > $@ 2>&1
+ ./xeigtimz < ZSVDTIM.in > $@ 2>&1
# ==============================================================================
xlintims: