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/dlaqr2.f | |
| parent | e58b61578b55644f6391f3333262b72c1dc88437 (diff) | |
| download | lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.gz lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.bz2 lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.zip | |
Diffstat (limited to 'SRC/dlaqr2.f')
| -rw-r--r-- | SRC/dlaqr2.f | 32 |
1 files changed, 14 insertions, 18 deletions
diff --git a/SRC/dlaqr2.f b/SRC/dlaqr2.f index 6ddb3309..257e25c1 100644 --- a/SRC/dlaqr2.f +++ b/SRC/dlaqr2.f @@ -2,8 +2,8 @@ $ IHIZ, Z, LDZ, NS, ND, SR, SI, 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 .. @@ -82,7 +82,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) DOUBLE PRECISION array, dimension (LDZ,IHI) +* Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N) * IF WANTZ is .TRUE., then on output, the orthogonal * similarity transformation mentioned above has been * accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. @@ -176,7 +176,7 @@ * .. * .. External Subroutines .. EXTERNAL DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR, - $ DLANV2, DLARF, DLARFG, DLASET, DORGHR, DTREXC + $ DLANV2, DLARF, DLARFG, DLASET, DORMHR, DTREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT @@ -195,9 +195,10 @@ CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO ) LWK1 = INT( WORK( 1 ) ) * -* ==== Workspace query call to DORGHR ==== +* ==== Workspace query call to DORMHR ==== * - CALL DORGHR( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO ) + CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * * ==== Optimal workspace ==== @@ -216,6 +217,7 @@ * ... for an empty active block ... ==== NS = 0 ND = 0 + WORK( 1 ) = ONE IF( KTOP.GT.KBOT ) $ RETURN * ... nor for an empty deflation window. ==== @@ -255,6 +257,7 @@ IF( KWTOP.GT.KTOP ) $ H( KWTOP, KWTOP-1 ) = ZERO END IF + WORK( 1 ) = ONE RETURN END IF * @@ -332,7 +335,7 @@ NS = NS - 2 ELSE * -* ==== Undflatable. Move them up out of the way. +* ==== Undeflatable. Move them up out of the way. * . Fortunately, DTREXC does the right thing with * . ILST in case of a rare exchange failure. ==== * @@ -478,18 +481,11 @@ $ LDH+1 ) * * ==== Accumulate orthogonal matrix in order update -* . H and Z, if requested. (A modified version -* . of DORGHR 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 DORGHR( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), - $ LWORK-JW, INFO ) - CALL DGEMM( 'N', 'N', JW, NS, NS, ONE, V, LDV, T, LDT, ZERO, - $ WV, LDWV ) - CALL DLACPY( 'A', JW, NS, WV, LDWV, V, LDV ) - END IF + IF( NS.GT.1 .AND. S.NE.ZERO ) + $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== * |