Annotation of rpl/lapack/lapack/zungr2.f, revision 1.8
1.1 bertrand 1: SUBROUTINE ZUNGR2( M, N, K, A, LDA, TAU, WORK, INFO )
2: *
1.8 ! bertrand 3: * -- LAPACK routine (version 3.3.1) --
1.1 bertrand 4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8 ! bertrand 6: * -- April 2011 --
1.1 bertrand 7: *
8: * .. Scalar Arguments ..
9: INTEGER INFO, K, LDA, M, N
10: * ..
11: * .. Array Arguments ..
12: COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
13: * ..
14: *
15: * Purpose
16: * =======
17: *
18: * ZUNGR2 generates an m by n complex matrix Q with orthonormal rows,
19: * which is defined as the last m rows of a product of k elementary
20: * reflectors of order n
21: *
1.8 ! bertrand 22: * Q = H(1)**H H(2)**H . . . H(k)**H
1.1 bertrand 23: *
24: * as returned by ZGERQF.
25: *
26: * Arguments
27: * =========
28: *
29: * M (input) INTEGER
30: * The number of rows of the matrix Q. M >= 0.
31: *
32: * N (input) INTEGER
33: * The number of columns of the matrix Q. N >= M.
34: *
35: * K (input) INTEGER
36: * The number of elementary reflectors whose product defines the
37: * matrix Q. M >= K >= 0.
38: *
39: * A (input/output) COMPLEX*16 array, dimension (LDA,N)
40: * On entry, the (m-k+i)-th row must contain the vector which
41: * defines the elementary reflector H(i), for i = 1,2,...,k, as
42: * returned by ZGERQF in the last k rows of its array argument
43: * A.
44: * On exit, the m-by-n matrix Q.
45: *
46: * LDA (input) INTEGER
47: * The first dimension of the array A. LDA >= max(1,M).
48: *
49: * TAU (input) COMPLEX*16 array, dimension (K)
50: * TAU(i) must contain the scalar factor of the elementary
51: * reflector H(i), as returned by ZGERQF.
52: *
53: * WORK (workspace) COMPLEX*16 array, dimension (M)
54: *
55: * INFO (output) INTEGER
56: * = 0: successful exit
57: * < 0: if INFO = -i, the i-th argument has an illegal value
58: *
59: * =====================================================================
60: *
61: * .. Parameters ..
62: COMPLEX*16 ONE, ZERO
63: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
64: $ ZERO = ( 0.0D+0, 0.0D+0 ) )
65: * ..
66: * .. Local Scalars ..
67: INTEGER I, II, J, L
68: * ..
69: * .. External Subroutines ..
70: EXTERNAL XERBLA, ZLACGV, ZLARF, ZSCAL
71: * ..
72: * .. Intrinsic Functions ..
73: INTRINSIC DCONJG, MAX
74: * ..
75: * .. Executable Statements ..
76: *
77: * Test the input arguments
78: *
79: INFO = 0
80: IF( M.LT.0 ) THEN
81: INFO = -1
82: ELSE IF( N.LT.M ) THEN
83: INFO = -2
84: ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
85: INFO = -3
86: ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
87: INFO = -5
88: END IF
89: IF( INFO.NE.0 ) THEN
90: CALL XERBLA( 'ZUNGR2', -INFO )
91: RETURN
92: END IF
93: *
94: * Quick return if possible
95: *
96: IF( M.LE.0 )
97: $ RETURN
98: *
99: IF( K.LT.M ) THEN
100: *
101: * Initialise rows 1:m-k to rows of the unit matrix
102: *
103: DO 20 J = 1, N
104: DO 10 L = 1, M - K
105: A( L, J ) = ZERO
106: 10 CONTINUE
107: IF( J.GT.N-M .AND. J.LE.N-K )
108: $ A( M-N+J, J ) = ONE
109: 20 CONTINUE
110: END IF
111: *
112: DO 40 I = 1, K
113: II = M - K + I
114: *
1.8 ! bertrand 115: * Apply H(i)**H to A(1:m-k+i,1:n-k+i) from the right
1.1 bertrand 116: *
117: CALL ZLACGV( N-M+II-1, A( II, 1 ), LDA )
118: A( II, N-M+II ) = ONE
119: CALL ZLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA,
120: $ DCONJG( TAU( I ) ), A, LDA, WORK )
121: CALL ZSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA )
122: CALL ZLACGV( N-M+II-1, A( II, 1 ), LDA )
123: A( II, N-M+II ) = ONE - DCONJG( TAU( I ) )
124: *
125: * Set A(m-k+i,n-k+i+1:n) to zero
126: *
127: DO 30 L = N - M + II + 1, N
128: A( II, L ) = ZERO
129: 30 CONTINUE
130: 40 CONTINUE
131: RETURN
132: *
133: * End of ZUNGR2
134: *
135: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zungr2.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack