version 1.5, 2010/08/07 13:22:19
|
version 1.9, 2011/07/22 07:38:07
|
Line 2
|
Line 2
|
$ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, |
$ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, |
$ LDU, NV, WV, LDWV, NH, WH, LDWH ) |
$ LDU, NV, WV, LDWV, NH, WH, LDWH ) |
* |
* |
* -- LAPACK auxiliary routine (version 3.2) -- |
* -- LAPACK auxiliary routine (version 3.3.0) -- |
* -- 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 |
* November 2010 |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, |
INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, |
Line 453
|
Line 453
|
* ==== Special case: 2-by-2 reflection (if needed) ==== |
* ==== Special case: 2-by-2 reflection (if needed) ==== |
* |
* |
K = KRCOL + 3*( M22-1 ) |
K = KRCOL + 3*( M22-1 ) |
IF( BMP22 .AND. ( V( 1, M22 ).NE.ZERO ) ) THEN |
IF( BMP22 ) THEN |
DO 100 J = JTOP, MIN( KBOT, K+3 ) |
IF ( V( 1, M22 ).NE.ZERO ) THEN |
REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )* |
DO 100 J = JTOP, MIN( KBOT, K+3 ) |
$ H( J, K+2 ) ) |
REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )* |
H( J, K+1 ) = H( J, K+1 ) - REFSUM |
$ H( J, K+2 ) ) |
H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 ) |
H( J, K+1 ) = H( J, K+1 ) - REFSUM |
100 CONTINUE |
H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 ) |
* |
100 CONTINUE |
IF( ACCUM ) THEN |
* |
KMS = K - INCOL |
IF( ACCUM ) THEN |
DO 110 J = MAX( 1, KTOP-INCOL ), KDU |
KMS = K - INCOL |
REFSUM = V( 1, M22 )*( U( J, KMS+1 )+V( 2, M22 )* |
DO 110 J = MAX( 1, KTOP-INCOL ), KDU |
$ U( J, KMS+2 ) ) |
REFSUM = V( 1, M22 )*( U( J, KMS+1 )+ |
U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM |
$ V( 2, M22 )*U( J, KMS+2 ) ) |
U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M22 ) |
U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM |
|
U( J, KMS+2 ) = U( J, KMS+2 ) - |
|
$ REFSUM*V( 2, M22 ) |
110 CONTINUE |
110 CONTINUE |
ELSE IF( WANTZ ) THEN |
ELSE IF( WANTZ ) THEN |
DO 120 J = ILOZ, IHIZ |
DO 120 J = ILOZ, IHIZ |
REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )* |
REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )* |
$ Z( J, K+2 ) ) |
$ Z( J, K+2 ) ) |
Z( J, K+1 ) = Z( J, K+1 ) - REFSUM |
Z( J, K+1 ) = Z( J, K+1 ) - REFSUM |
Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 ) |
Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 ) |
120 CONTINUE |
120 CONTINUE |
|
END IF |
END IF |
END IF |
END IF |
END IF |
* |
* |
Line 639
|
Line 642
|
CALL DLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ), |
CALL DLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ), |
$ LDH, WH( KZS+1, 1 ), LDWH ) |
$ LDH, WH( KZS+1, 1 ), LDWH ) |
* |
* |
* ==== Multiply by U21' ==== |
* ==== Multiply by U21**T ==== |
* |
* |
CALL DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH ) |
CALL DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH ) |
CALL DTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE, |
CALL DTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE, |
$ U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ), |
$ U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ), |
$ LDWH ) |
$ LDWH ) |
* |
* |
* ==== Multiply top of H by U11' ==== |
* ==== Multiply top of H by U11**T ==== |
* |
* |
CALL DGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU, |
CALL DGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU, |
$ H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH ) |
$ H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH ) |
Line 656
|
Line 659
|
CALL DLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH, |
CALL DLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH, |
$ WH( I2+1, 1 ), LDWH ) |
$ WH( I2+1, 1 ), LDWH ) |
* |
* |
* ==== Multiply by U21' ==== |
* ==== Multiply by U21**T ==== |
* |
* |
CALL DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE, |
CALL DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE, |
$ U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH ) |
$ U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH ) |