Annotation of rpl/lapack/lapack/zlarf.f, revision 1.7
1.1 bertrand 1: SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
2: IMPLICIT NONE
3: *
4: * -- LAPACK auxiliary routine (version 3.2) --
5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7: * November 2006
8: *
9: * .. Scalar Arguments ..
10: CHARACTER SIDE
11: INTEGER INCV, LDC, M, N
12: COMPLEX*16 TAU
13: * ..
14: * .. Array Arguments ..
15: COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
16: * ..
17: *
18: * Purpose
19: * =======
20: *
21: * ZLARF applies a complex elementary reflector H to a complex M-by-N
22: * matrix C, from either the left or the right. H is represented in the
23: * form
24: *
25: * H = I - tau * v * v'
26: *
27: * where tau is a complex scalar and v is a complex vector.
28: *
29: * If tau = 0, then H is taken to be the unit matrix.
30: *
31: * To apply H' (the conjugate transpose of H), supply conjg(tau) instead
32: * tau.
33: *
34: * Arguments
35: * =========
36: *
37: * SIDE (input) CHARACTER*1
38: * = 'L': form H * C
39: * = 'R': form C * H
40: *
41: * M (input) INTEGER
42: * The number of rows of the matrix C.
43: *
44: * N (input) INTEGER
45: * The number of columns of the matrix C.
46: *
47: * V (input) COMPLEX*16 array, dimension
48: * (1 + (M-1)*abs(INCV)) if SIDE = 'L'
49: * or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
50: * The vector v in the representation of H. V is not used if
51: * TAU = 0.
52: *
53: * INCV (input) INTEGER
54: * The increment between elements of v. INCV <> 0.
55: *
56: * TAU (input) COMPLEX*16
57: * The value tau in the representation of H.
58: *
59: * C (input/output) COMPLEX*16 array, dimension (LDC,N)
60: * On entry, the M-by-N matrix C.
61: * On exit, C is overwritten by the matrix H * C if SIDE = 'L',
62: * or C * H if SIDE = 'R'.
63: *
64: * LDC (input) INTEGER
65: * The leading dimension of the array C. LDC >= max(1,M).
66: *
67: * WORK (workspace) COMPLEX*16 array, dimension
68: * (N) if SIDE = 'L'
69: * or (M) if SIDE = 'R'
70: *
71: * =====================================================================
72: *
73: * .. Parameters ..
74: COMPLEX*16 ONE, ZERO
75: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
76: $ ZERO = ( 0.0D+0, 0.0D+0 ) )
77: * ..
78: * .. Local Scalars ..
79: LOGICAL APPLYLEFT
80: INTEGER I, LASTV, LASTC
81: * ..
82: * .. External Subroutines ..
83: EXTERNAL ZGEMV, ZGERC
84: * ..
85: * .. External Functions ..
86: LOGICAL LSAME
87: INTEGER ILAZLR, ILAZLC
88: EXTERNAL LSAME, ILAZLR, ILAZLC
89: * ..
90: * .. Executable Statements ..
91: *
92: APPLYLEFT = LSAME( SIDE, 'L' )
93: LASTV = 0
94: LASTC = 0
95: IF( TAU.NE.ZERO ) THEN
96: ! Set up variables for scanning V. LASTV begins pointing to the end
97: ! of V.
98: IF( APPLYLEFT ) THEN
99: LASTV = M
100: ELSE
101: LASTV = N
102: END IF
103: IF( INCV.GT.0 ) THEN
104: I = 1 + (LASTV-1) * INCV
105: ELSE
106: I = 1
107: END IF
108: ! Look for the last non-zero row in V.
109: DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
110: LASTV = LASTV - 1
111: I = I - INCV
112: END DO
113: IF( APPLYLEFT ) THEN
114: ! Scan for the last non-zero column in C(1:lastv,:).
115: LASTC = ILAZLC(LASTV, N, C, LDC)
116: ELSE
117: ! Scan for the last non-zero row in C(:,1:lastv).
118: LASTC = ILAZLR(M, LASTV, C, LDC)
119: END IF
120: END IF
121: ! Note that lastc.eq.0 renders the BLAS operations null; no special
122: ! case is needed at this level.
123: IF( APPLYLEFT ) THEN
124: *
125: * Form H * C
126: *
127: IF( LASTV.GT.0 ) THEN
128: *
129: * w(1:lastc,1) := C(1:lastv,1:lastc)' * v(1:lastv,1)
130: *
131: CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
132: $ C, LDC, V, INCV, ZERO, WORK, 1 )
133: *
134: * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)'
135: *
136: CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
137: END IF
138: ELSE
139: *
140: * Form C * H
141: *
142: IF( LASTV.GT.0 ) THEN
143: *
144: * w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
145: *
146: CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
147: $ V, INCV, ZERO, WORK, 1 )
148: *
149: * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)'
150: *
151: CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
152: END IF
153: END IF
154: RETURN
155: *
156: * End of ZLARF
157: *
158: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlarf.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack