1: *> \brief \b ZLAUNHR_COL_GETRFNP2
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZLAUNHR_COL_GETRFNP2 + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaunhr_col_getrfnp2.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaunhr_col_getrfnp2.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaunhr_col_getrfnp2.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * RECURSIVE SUBROUTINE ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO )
22: *
23: * .. Scalar Arguments ..
24: * INTEGER INFO, LDA, M, N
25: * ..
26: * .. Array Arguments ..
27: * COMPLEX*16 A( LDA, * ), D( * )
28: * ..
29: *
30: *
31: *> \par Purpose:
32: * =============
33: *>
34: *> \verbatim
35: *>
36: *> ZLAUNHR_COL_GETRFNP2 computes the modified LU factorization without
37: *> pivoting of a complex general M-by-N matrix A. The factorization has
38: *> the form:
39: *>
40: *> A - S = L * U,
41: *>
42: *> where:
43: *> S is a m-by-n diagonal sign matrix with the diagonal D, so that
44: *> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed
45: *> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing
46: *> i-1 steps of Gaussian elimination. This means that the diagonal
47: *> element at each step of "modified" Gaussian elimination is at
48: *> least one in absolute value (so that division-by-zero not
49: *> possible during the division by the diagonal element);
50: *>
51: *> L is a M-by-N lower triangular matrix with unit diagonal elements
52: *> (lower trapezoidal if M > N);
53: *>
54: *> and U is a M-by-N upper triangular matrix
55: *> (upper trapezoidal if M < N).
56: *>
57: *> This routine is an auxiliary routine used in the Householder
58: *> reconstruction routine ZUNHR_COL. In ZUNHR_COL, this routine is
59: *> applied to an M-by-N matrix A with orthonormal columns, where each
60: *> element is bounded by one in absolute value. With the choice of
61: *> the matrix S above, one can show that the diagonal element at each
62: *> step of Gaussian elimination is the largest (in absolute value) in
63: *> the column on or below the diagonal, so that no pivoting is required
64: *> for numerical stability [1].
65: *>
66: *> For more details on the Householder reconstruction algorithm,
67: *> including the modified LU factorization, see [1].
68: *>
69: *> This is the recursive version of the LU factorization algorithm.
70: *> Denote A - S by B. The algorithm divides the matrix B into four
71: *> submatrices:
72: *>
73: *> [ B11 | B12 ] where B11 is n1 by n1,
74: *> B = [ -----|----- ] B21 is (m-n1) by n1,
75: *> [ B21 | B22 ] B12 is n1 by n2,
76: *> B22 is (m-n1) by n2,
77: *> with n1 = min(m,n)/2, n2 = n-n1.
78: *>
79: *>
80: *> The subroutine calls itself to factor B11, solves for B21,
81: *> solves for B12, updates B22, then calls itself to factor B22.
82: *>
83: *> For more details on the recursive LU algorithm, see [2].
84: *>
85: *> ZLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked
86: *> routine ZLAUNHR_COL_GETRFNP, which uses blocked code calling
87: *. Level 3 BLAS to update the submatrix. However, ZLAUNHR_COL_GETRFNP2
88: *> is self-sufficient and can be used without ZLAUNHR_COL_GETRFNP.
89: *>
90: *> [1] "Reconstructing Householder vectors from tall-skinny QR",
91: *> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen,
92: *> E. Solomonik, J. Parallel Distrib. Comput.,
93: *> vol. 85, pp. 3-31, 2015.
94: *>
95: *> [2] "Recursion leads to automatic variable blocking for dense linear
96: *> algebra algorithms", F. Gustavson, IBM J. of Res. and Dev.,
97: *> vol. 41, no. 6, pp. 737-755, 1997.
98: *> \endverbatim
99: *
100: * Arguments:
101: * ==========
102: *
103: *> \param[in] M
104: *> \verbatim
105: *> M is INTEGER
106: *> The number of rows of the matrix A. M >= 0.
107: *> \endverbatim
108: *>
109: *> \param[in] N
110: *> \verbatim
111: *> N is INTEGER
112: *> The number of columns of the matrix A. N >= 0.
113: *> \endverbatim
114: *>
115: *> \param[in,out] A
116: *> \verbatim
117: *> A is COMPLEX*16 array, dimension (LDA,N)
118: *> On entry, the M-by-N matrix to be factored.
119: *> On exit, the factors L and U from the factorization
120: *> A-S=L*U; the unit diagonal elements of L are not stored.
121: *> \endverbatim
122: *>
123: *> \param[in] LDA
124: *> \verbatim
125: *> LDA is INTEGER
126: *> The leading dimension of the array A. LDA >= max(1,M).
127: *> \endverbatim
128: *>
129: *> \param[out] D
130: *> \verbatim
131: *> D is COMPLEX*16 array, dimension min(M,N)
132: *> The diagonal elements of the diagonal M-by-N sign matrix S,
133: *> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can be
134: *> only ( +1.0, 0.0 ) or (-1.0, 0.0 ).
135: *> \endverbatim
136: *>
137: *> \param[out] INFO
138: *> \verbatim
139: *> INFO is INTEGER
140: *> = 0: successful exit
141: *> < 0: if INFO = -i, the i-th argument had an illegal value
142: *> \endverbatim
143: *>
144: * Authors:
145: * ========
146: *
147: *> \author Univ. of Tennessee
148: *> \author Univ. of California Berkeley
149: *> \author Univ. of Colorado Denver
150: *> \author NAG Ltd.
151: *
152: *> \date November 2019
153: *
154: *> \ingroup complex16GEcomputational
155: *
156: *> \par Contributors:
157: * ==================
158: *>
159: *> \verbatim
160: *>
161: *> November 2019, Igor Kozachenko,
162: *> Computer Science Division,
163: *> University of California, Berkeley
164: *>
165: *> \endverbatim
166: *
167: * =====================================================================
168: RECURSIVE SUBROUTINE ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO )
169: IMPLICIT NONE
170: *
171: * -- LAPACK computational routine (version 3.9.0) --
172: * -- LAPACK is a software package provided by Univ. of Tennessee, --
173: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
174: * November 2019
175: *
176: * .. Scalar Arguments ..
177: INTEGER INFO, LDA, M, N
178: * ..
179: * .. Array Arguments ..
180: COMPLEX*16 A( LDA, * ), D( * )
181: * ..
182: *
183: * =====================================================================
184: *
185: * .. Parameters ..
186: DOUBLE PRECISION ONE
187: PARAMETER ( ONE = 1.0D+0 )
188: COMPLEX*16 CONE
189: PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) )
190: * ..
191: * .. Local Scalars ..
192: DOUBLE PRECISION SFMIN
193: INTEGER I, IINFO, N1, N2
194: COMPLEX*16 Z
195: * ..
196: * .. External Functions ..
197: DOUBLE PRECISION DLAMCH
198: EXTERNAL DLAMCH
199: * ..
200: * .. External Subroutines ..
201: EXTERNAL ZGEMM, ZSCAL, ZTRSM, XERBLA
202: * ..
203: * .. Intrinsic Functions ..
204: INTRINSIC ABS, DBLE, DCMPLX, DIMAG, DSIGN, MAX, MIN
205: * ..
206: * .. Statement Functions ..
207: DOUBLE PRECISION CABS1
208: * ..
209: * .. Statement Function definitions ..
210: CABS1( Z ) = ABS( DBLE( Z ) ) + ABS( DIMAG( Z ) )
211: * ..
212: * .. Executable Statements ..
213: *
214: * Test the input parameters
215: *
216: INFO = 0
217: IF( M.LT.0 ) THEN
218: INFO = -1
219: ELSE IF( N.LT.0 ) THEN
220: INFO = -2
221: ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
222: INFO = -4
223: END IF
224: IF( INFO.NE.0 ) THEN
225: CALL XERBLA( 'ZLAUNHR_COL_GETRFNP2', -INFO )
226: RETURN
227: END IF
228: *
229: * Quick return if possible
230: *
231: IF( MIN( M, N ).EQ.0 )
232: $ RETURN
233:
234: IF ( M.EQ.1 ) THEN
235: *
236: * One row case, (also recursion termination case),
237: * use unblocked code
238: *
239: * Transfer the sign
240: *
241: D( 1 ) = DCMPLX( -DSIGN( ONE, DBLE( A( 1, 1 ) ) ) )
242: *
243: * Construct the row of U
244: *
245: A( 1, 1 ) = A( 1, 1 ) - D( 1 )
246: *
247: ELSE IF( N.EQ.1 ) THEN
248: *
249: * One column case, (also recursion termination case),
250: * use unblocked code
251: *
252: * Transfer the sign
253: *
254: D( 1 ) = DCMPLX( -DSIGN( ONE, DBLE( A( 1, 1 ) ) ) )
255: *
256: * Construct the row of U
257: *
258: A( 1, 1 ) = A( 1, 1 ) - D( 1 )
259: *
260: * Scale the elements 2:M of the column
261: *
262: * Determine machine safe minimum
263: *
264: SFMIN = DLAMCH('S')
265: *
266: * Construct the subdiagonal elements of L
267: *
268: IF( CABS1( A( 1, 1 ) ) .GE. SFMIN ) THEN
269: CALL ZSCAL( M-1, CONE / A( 1, 1 ), A( 2, 1 ), 1 )
270: ELSE
271: DO I = 2, M
272: A( I, 1 ) = A( I, 1 ) / A( 1, 1 )
273: END DO
274: END IF
275: *
276: ELSE
277: *
278: * Divide the matrix B into four submatrices
279: *
280: N1 = MIN( M, N ) / 2
281: N2 = N-N1
282:
283: *
284: * Factor B11, recursive call
285: *
286: CALL ZLAUNHR_COL_GETRFNP2( N1, N1, A, LDA, D, IINFO )
287: *
288: * Solve for B21
289: *
290: CALL ZTRSM( 'R', 'U', 'N', 'N', M-N1, N1, CONE, A, LDA,
291: $ A( N1+1, 1 ), LDA )
292: *
293: * Solve for B12
294: *
295: CALL ZTRSM( 'L', 'L', 'N', 'U', N1, N2, CONE, A, LDA,
296: $ A( 1, N1+1 ), LDA )
297: *
298: * Update B22, i.e. compute the Schur complement
299: * B22 := B22 - B21*B12
300: *
301: CALL ZGEMM( 'N', 'N', M-N1, N2, N1, -CONE, A( N1+1, 1 ), LDA,
302: $ A( 1, N1+1 ), LDA, CONE, A( N1+1, N1+1 ), LDA )
303: *
304: * Factor B22, recursive call
305: *
306: CALL ZLAUNHR_COL_GETRFNP2( M-N1, N2, A( N1+1, N1+1 ), LDA,
307: $ D( N1+1 ), IINFO )
308: *
309: END IF
310: RETURN
311: *
312: * End of ZLAUNHR_COL_GETRFNP2
313: *
314: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlaunhr_col_getrfnp2.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack