diff options
| author | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
|---|---|---|
| committer | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
| commit | ff981f106bde4ce6a74aa4f4a572c943f5a395b2 (patch) | |
| tree | a386cad907bcaefd6893535c31d67ec9468e693e /SRC/claqr2.f | |
| parent | e58b61578b55644f6391f3333262b72c1dc88437 (diff) | |
| download | lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.gz lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.bz2 lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.zip | |
Diffstat (limited to 'SRC/claqr2.f')
| -rw-r--r-- | SRC/claqr2.f | 35 |
1 files changed, 15 insertions, 20 deletions
diff --git a/SRC/claqr2.f b/SRC/claqr2.f index 2bdea99a..4b980bb1 100644 --- a/SRC/claqr2.f +++ b/SRC/claqr2.f @@ -2,8 +2,8 @@ $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* -- LAPACK auxiliary routine (version 3.2) -- +* Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.. * November 2006 * * .. Scalar Arguments .. @@ -81,7 +81,7 @@ * Specify the rows of Z to which transformations must be * applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. * -* Z (input/output) COMPLEX array, dimension (LDZ,IHI) +* Z (input/output) COMPLEX array, dimension (LDZ,N) * IF WANTZ is .TRUE., then on output, the unitary * similarity transformation mentioned above has been * accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. @@ -152,7 +152,7 @@ * Karen Braman and Ralph Byers, Department of Mathematics, * University of Kansas, USA * -* ================================================================== +* ================================================================ * .. Parameters .. COMPLEX ZERO, ONE PARAMETER ( ZERO = ( 0.0e0, 0.0e0 ), @@ -172,7 +172,7 @@ * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLARF, - $ CLARFG, CLASET, CTREXC, CUNGHR, SLABAD + $ CLARFG, CLASET, CTREXC, CUNMHR, SLABAD * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL @@ -197,9 +197,10 @@ CALL CGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO ) LWK1 = INT( WORK( 1 ) ) * -* ==== Workspace query call to CUNGHR ==== +* ==== Workspace query call to CUNMHR ==== * - CALL CUNGHR( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO ) + CALL CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * * ==== Optimal workspace ==== @@ -218,6 +219,7 @@ * ... for an empty active block ... ==== NS = 0 ND = 0 + WORK( 1 ) = ONE IF( KTOP.GT.KBOT ) $ RETURN * ... nor for an empty deflation window. ==== @@ -251,12 +253,12 @@ ND = 0 IF( CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP, $ KWTOP ) ) ) ) THEN - NS = 0 ND = 1 IF( KWTOP.GT.KTOP ) $ H( KWTOP, KWTOP-1 ) = ZERO END IF + WORK( 1 ) = ONE RETURN END IF * @@ -292,7 +294,7 @@ NS = NS - 1 ELSE * -* ==== One undflatable eigenvalue. Move it up out of the +* ==== One undeflatable eigenvalue. Move it up out of the * . way. (CTREXC can not fail in this case.) ==== * IFST = NS @@ -365,18 +367,11 @@ $ LDH+1 ) * * ==== Accumulate orthogonal matrix in order update -* . H and Z, if requested. (A modified version -* . of CUNGHR that accumulates block Householder -* . transformations into V directly might be -* . marginally more efficient than the following.) ==== +* . H and Z, if requested. ==== * - IF( NS.GT.1 .AND. S.NE.ZERO ) THEN - CALL CUNGHR( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), - $ LWORK-JW, INFO ) - CALL CGEMM( 'N', 'N', JW, NS, NS, ONE, V, LDV, T, LDT, ZERO, - $ WV, LDWV ) - CALL CLACPY( 'A', JW, NS, WV, LDWV, V, LDV ) - END IF + IF( NS.GT.1 .AND. S.NE.ZERO ) + $ CALL CUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== * |