📄 zlarfx.f
字号:
SUBROUTINE ZLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
*
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* September 30, 1994
*
* .. Scalar Arguments ..
CHARACTER SIDE
INTEGER LDC, M, N
COMPLEX*16 TAU
* ..
* .. Array Arguments ..
COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
* ..
*
* Purpose
* =======
*
* ZLARFX applies a complex elementary reflector H to a complex m by n
* matrix C, from either the left or the right. H is represented in the
* form
*
* H = I - tau * v * v'
*
* where tau is a complex scalar and v is a complex vector.
*
* If tau = 0, then H is taken to be the unit matrix
*
* This version uses inline code if H has order < 11.
*
* Arguments
* =========
*
* SIDE (input) CHARACTER*1
* = 'L': form H * C
* = 'R': form C * H
*
* M (input) INTEGER
* The number of rows of the matrix C.
*
* N (input) INTEGER
* The number of columns of the matrix C.
*
* V (input) COMPLEX*16 array, dimension (M) if SIDE = 'L'
* or (N) if SIDE = 'R'
* The vector v in the representation of H.
*
* TAU (input) COMPLEX*16
* The value tau in the representation of H.
*
* C (input/output) COMPLEX*16 array, dimension (LDC,N)
* On entry, the m by n matrix C.
* On exit, C is overwritten by the matrix H * C if SIDE = 'L',
* or C * H if SIDE = 'R'.
*
* LDC (input) INTEGER
* The leading dimension of the array C. LDA >= max(1,M).
*
* WORK (workspace) COMPLEX*16 array, dimension (N) if SIDE = 'L'
* or (M) if SIDE = 'R'
* WORK is not referenced if H has order < 11.
*
* =====================================================================
*
* .. Parameters ..
COMPLEX*16 ZERO, ONE
PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
$ ONE = ( 1.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
INTEGER J
COMPLEX*16 SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
$ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL ZGEMV, ZGERC
* ..
* .. Intrinsic Functions ..
INTRINSIC DCONJG
* ..
* .. Executable Statements ..
*
IF( TAU.EQ.ZERO )
$ RETURN
IF( LSAME( SIDE, 'L' ) ) THEN
*
* Form H * C, where H has order m.
*
GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
$ 170, 190 )M
*
* Code for general M
*
* w := C'*v
*
CALL ZGEMV( 'Conjugate transpose', M, N, ONE, C, LDC, V, 1,
$ ZERO, WORK, 1 )
*
* C := C - tau * v * w'
*
CALL ZGERC( M, N, -TAU, V, 1, WORK, 1, C, LDC )
GO TO 410
10 CONTINUE
*
* Special code for 1 x 1 Householder
*
T1 = ONE - TAU*V( 1 )*DCONJG( V( 1 ) )
DO 20 J = 1, N
C( 1, J ) = T1*C( 1, J )
20 CONTINUE
GO TO 410
30 CONTINUE
*
* Special code for 2 x 2 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
DO 40 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
40 CONTINUE
GO TO 410
50 CONTINUE
*
* Special code for 3 x 3 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
V3 = DCONJG( V( 3 ) )
T3 = TAU*DCONJG( V3 )
DO 60 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
C( 3, J ) = C( 3, J ) - SUM*T3
60 CONTINUE
GO TO 410
70 CONTINUE
*
* Special code for 4 x 4 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
V3 = DCONJG( V( 3 ) )
T3 = TAU*DCONJG( V3 )
V4 = DCONJG( V( 4 ) )
T4 = TAU*DCONJG( V4 )
DO 80 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
$ V4*C( 4, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
C( 3, J ) = C( 3, J ) - SUM*T3
C( 4, J ) = C( 4, J ) - SUM*T4
80 CONTINUE
GO TO 410
90 CONTINUE
*
* Special code for 5 x 5 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
V3 = DCONJG( V( 3 ) )
T3 = TAU*DCONJG( V3 )
V4 = DCONJG( V( 4 ) )
T4 = TAU*DCONJG( V4 )
V5 = DCONJG( V( 5 ) )
T5 = TAU*DCONJG( V5 )
DO 100 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
$ V4*C( 4, J ) + V5*C( 5, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
C( 3, J ) = C( 3, J ) - SUM*T3
C( 4, J ) = C( 4, J ) - SUM*T4
C( 5, J ) = C( 5, J ) - SUM*T5
100 CONTINUE
GO TO 410
110 CONTINUE
*
* Special code for 6 x 6 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
V3 = DCONJG( V( 3 ) )
T3 = TAU*DCONJG( V3 )
V4 = DCONJG( V( 4 ) )
T4 = TAU*DCONJG( V4 )
V5 = DCONJG( V( 5 ) )
T5 = TAU*DCONJG( V5 )
V6 = DCONJG( V( 6 ) )
T6 = TAU*DCONJG( V6 )
DO 120 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
$ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
C( 3, J ) = C( 3, J ) - SUM*T3
C( 4, J ) = C( 4, J ) - SUM*T4
C( 5, J ) = C( 5, J ) - SUM*T5
C( 6, J ) = C( 6, J ) - SUM*T6
120 CONTINUE
GO TO 410
130 CONTINUE
*
* Special code for 7 x 7 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
V3 = DCONJG( V( 3 ) )
T3 = TAU*DCONJG( V3 )
V4 = DCONJG( V( 4 ) )
T4 = TAU*DCONJG( V4 )
V5 = DCONJG( V( 5 ) )
T5 = TAU*DCONJG( V5 )
V6 = DCONJG( V( 6 ) )
T6 = TAU*DCONJG( V6 )
V7 = DCONJG( V( 7 ) )
T7 = TAU*DCONJG( V7 )
DO 140 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
$ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
$ V7*C( 7, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
C( 3, J ) = C( 3, J ) - SUM*T3
C( 4, J ) = C( 4, J ) - SUM*T4
C( 5, J ) = C( 5, J ) - SUM*T5
C( 6, J ) = C( 6, J ) - SUM*T6
C( 7, J ) = C( 7, J ) - SUM*T7
140 CONTINUE
GO TO 410
150 CONTINUE
*
* Special code for 8 x 8 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
V3 = DCONJG( V( 3 ) )
T3 = TAU*DCONJG( V3 )
V4 = DCONJG( V( 4 ) )
T4 = TAU*DCONJG( V4 )
V5 = DCONJG( V( 5 ) )
T5 = TAU*DCONJG( V5 )
V6 = DCONJG( V( 6 ) )
T6 = TAU*DCONJG( V6 )
V7 = DCONJG( V( 7 ) )
T7 = TAU*DCONJG( V7 )
V8 = DCONJG( V( 8 ) )
T8 = TAU*DCONJG( V8 )
DO 160 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
$ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
$ V7*C( 7, J ) + V8*C( 8, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
C( 3, J ) = C( 3, J ) - SUM*T3
C( 4, J ) = C( 4, J ) - SUM*T4
C( 5, J ) = C( 5, J ) - SUM*T5
C( 6, J ) = C( 6, J ) - SUM*T6
C( 7, J ) = C( 7, J ) - SUM*T7
C( 8, J ) = C( 8, J ) - SUM*T8
160 CONTINUE
GO TO 410
170 CONTINUE
*
* Special code for 9 x 9 Householder
*
V1 = DCONJG( V( 1 ) )
T1 = TAU*DCONJG( V1 )
V2 = DCONJG( V( 2 ) )
T2 = TAU*DCONJG( V2 )
V3 = DCONJG( V( 3 ) )
T3 = TAU*DCONJG( V3 )
V4 = DCONJG( V( 4 ) )
T4 = TAU*DCONJG( V4 )
V5 = DCONJG( V( 5 ) )
T5 = TAU*DCONJG( V5 )
V6 = DCONJG( V( 6 ) )
T6 = TAU*DCONJG( V6 )
V7 = DCONJG( V( 7 ) )
T7 = TAU*DCONJG( V7 )
V8 = DCONJG( V( 8 ) )
T8 = TAU*DCONJG( V8 )
V9 = DCONJG( V( 9 ) )
T9 = TAU*DCONJG( V9 )
DO 180 J = 1, N
SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
$ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
$ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
C( 1, J ) = C( 1, J ) - SUM*T1
C( 2, J ) = C( 2, J ) - SUM*T2
C( 3, J ) = C( 3, J ) - SUM*T3
C( 4, J ) = C( 4, J ) - SUM*T4
C( 5, J ) = C( 5, J ) - SUM*T5
C( 6, J ) = C( 6, J ) - SUM*T6
C( 7, J ) = C( 7, J ) - SUM*T7
C( 8, J ) = C( 8, J ) - SUM*T8
C( 9, J ) = C( 9, J ) - SUM*T9
180 CONTINUE
GO TO 410
190 CONTINUE
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -