version 1.1, 2010/01/26 15:22:46
|
version 1.8, 2011/07/22 07:38:11
|
Line 1
|
Line 1
|
SUBROUTINE DSPTRD( UPLO, N, AP, D, E, TAU, INFO ) |
SUBROUTINE DSPTRD( UPLO, N, AP, D, E, TAU, INFO ) |
* |
* |
* -- LAPACK routine (version 3.2) -- |
* -- LAPACK routine (version 3.3.1) -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* November 2006 |
* -- April 2011 -- |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
CHARACTER UPLO |
CHARACTER UPLO |
Line 73
|
Line 73
|
* |
* |
* Each H(i) has the form |
* Each H(i) has the form |
* |
* |
* H(i) = I - tau * v * v' |
* H(i) = I - tau * v * v**T |
* |
* |
* where tau is a real scalar, and v is a real vector with |
* where tau is a real scalar, and v is a real vector with |
* v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP, |
* v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP, |
Line 86
|
Line 86
|
* |
* |
* Each H(i) has the form |
* Each H(i) has the form |
* |
* |
* H(i) = I - tau * v * v' |
* H(i) = I - tau * v * v**T |
* |
* |
* where tau is a real scalar, and v is a real vector with |
* where tau is a real scalar, and v is a real vector with |
* v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP, |
* v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP, |
Line 141
|
Line 141
|
I1 = N*( N-1 ) / 2 + 1 |
I1 = N*( N-1 ) / 2 + 1 |
DO 10 I = N - 1, 1, -1 |
DO 10 I = N - 1, 1, -1 |
* |
* |
* Generate elementary reflector H(i) = I - tau * v * v' |
* Generate elementary reflector H(i) = I - tau * v * v**T |
* to annihilate A(1:i-1,i+1) |
* to annihilate A(1:i-1,i+1) |
* |
* |
CALL DLARFG( I, AP( I1+I-1 ), AP( I1 ), 1, TAUI ) |
CALL DLARFG( I, AP( I1+I-1 ), AP( I1 ), 1, TAUI ) |
Line 158
|
Line 158
|
CALL DSPMV( UPLO, I, TAUI, AP, AP( I1 ), 1, ZERO, TAU, |
CALL DSPMV( UPLO, I, TAUI, AP, AP( I1 ), 1, ZERO, TAU, |
$ 1 ) |
$ 1 ) |
* |
* |
* Compute w := y - 1/2 * tau * (y'*v) * v |
* Compute w := y - 1/2 * tau * (y**T *v) * v |
* |
* |
ALPHA = -HALF*TAUI*DDOT( I, TAU, 1, AP( I1 ), 1 ) |
ALPHA = -HALF*TAUI*DDOT( I, TAU, 1, AP( I1 ), 1 ) |
CALL DAXPY( I, ALPHA, AP( I1 ), 1, TAU, 1 ) |
CALL DAXPY( I, ALPHA, AP( I1 ), 1, TAU, 1 ) |
* |
* |
* Apply the transformation as a rank-2 update: |
* Apply the transformation as a rank-2 update: |
* A := A - v * w' - w * v' |
* A := A - v * w**T - w * v**T |
* |
* |
CALL DSPR2( UPLO, I, -ONE, AP( I1 ), 1, TAU, 1, AP ) |
CALL DSPR2( UPLO, I, -ONE, AP( I1 ), 1, TAU, 1, AP ) |
* |
* |
Line 184
|
Line 184
|
DO 20 I = 1, N - 1 |
DO 20 I = 1, N - 1 |
I1I1 = II + N - I + 1 |
I1I1 = II + N - I + 1 |
* |
* |
* Generate elementary reflector H(i) = I - tau * v * v' |
* Generate elementary reflector H(i) = I - tau * v * v**T |
* to annihilate A(i+2:n,i) |
* to annihilate A(i+2:n,i) |
* |
* |
CALL DLARFG( N-I, AP( II+1 ), AP( II+2 ), 1, TAUI ) |
CALL DLARFG( N-I, AP( II+1 ), AP( II+2 ), 1, TAUI ) |
Line 201
|
Line 201
|
CALL DSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1, |
CALL DSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1, |
$ ZERO, TAU( I ), 1 ) |
$ ZERO, TAU( I ), 1 ) |
* |
* |
* Compute w := y - 1/2 * tau * (y'*v) * v |
* Compute w := y - 1/2 * tau * (y**T *v) * v |
* |
* |
ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, AP( II+1 ), |
ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, AP( II+1 ), |
$ 1 ) |
$ 1 ) |
CALL DAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 ) |
CALL DAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 ) |
* |
* |
* Apply the transformation as a rank-2 update: |
* Apply the transformation as a rank-2 update: |
* A := A - v * w' - w * v' |
* A := A - v * w**T - w * v**T |
* |
* |
CALL DSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1, |
CALL DSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1, |
$ AP( I1I1 ) ) |
$ AP( I1I1 ) ) |