1: *> \brief \b ZSYCONVF_ROOK
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZSYCONVF_ROOK + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconvf_rook.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconvf_rook.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconvf_rook.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
22: *
23: * .. Scalar Arguments ..
24: * CHARACTER UPLO, WAY
25: * INTEGER INFO, LDA, N
26: * ..
27: * .. Array Arguments ..
28: * INTEGER IPIV( * )
29: * COMPLEX*16 A( LDA, * ), E( * )
30: * ..
31: *
32: *
33: *> \par Purpose:
34: * =============
35: *>
36: *> \verbatim
37: *> If parameter WAY = 'C':
38: *> ZSYCONVF_ROOK converts the factorization output format used in
39: *> ZSYTRF_ROOK provided on entry in parameter A into the factorization
40: *> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
41: *> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and
42: *> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
43: *>
44: *> If parameter WAY = 'R':
45: *> ZSYCONVF_ROOK performs the conversion in reverse direction, i.e.
46: *> converts the factorization output format used in ZSYTRF_RK
47: *> (or ZSYTRF_BK) provided on entry in parameters A and E into
48: *> the factorization output format used in ZSYTRF_ROOK that is stored
49: *> on exit in parameter A. IPIV format for ZSYTRF_ROOK and
50: *> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
51: *>
52: *> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between
53: *> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK).
54: *> \endverbatim
55: *
56: * Arguments:
57: * ==========
58: *
59: *> \param[in] UPLO
60: *> \verbatim
61: *> UPLO is CHARACTER*1
62: *> Specifies whether the details of the factorization are
63: *> stored as an upper or lower triangular matrix A.
64: *> = 'U': Upper triangular
65: *> = 'L': Lower triangular
66: *> \endverbatim
67: *>
68: *> \param[in] WAY
69: *> \verbatim
70: *> WAY is CHARACTER*1
71: *> = 'C': Convert
72: *> = 'R': Revert
73: *> \endverbatim
74: *>
75: *> \param[in] N
76: *> \verbatim
77: *> N is INTEGER
78: *> The order of the matrix A. N >= 0.
79: *> \endverbatim
80: *>
81: *> \param[in,out] A
82: *> \verbatim
83: *> A is COMPLEX*16 array, dimension (LDA,N)
84: *>
85: *> 1) If WAY ='C':
86: *>
87: *> On entry, contains factorization details in format used in
88: *> ZSYTRF_ROOK:
89: *> a) all elements of the symmetric block diagonal
90: *> matrix D on the diagonal of A and on superdiagonal
91: *> (or subdiagonal) of A, and
92: *> b) If UPLO = 'U': multipliers used to obtain factor U
93: *> in the superdiagonal part of A.
94: *> If UPLO = 'L': multipliers used to obtain factor L
95: *> in the superdiagonal part of A.
96: *>
97: *> On exit, contains factorization details in format used in
98: *> ZSYTRF_RK or ZSYTRF_BK:
99: *> a) ONLY diagonal elements of the symmetric block diagonal
100: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
101: *> (superdiagonal (or subdiagonal) elements of D
102: *> are stored on exit in array E), and
103: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
104: *> If UPLO = 'L': factor L in the subdiagonal part of A.
105: *>
106: *> 2) If WAY = 'R':
107: *>
108: *> On entry, contains factorization details in format used in
109: *> ZSYTRF_RK or ZSYTRF_BK:
110: *> a) ONLY diagonal elements of the symmetric block diagonal
111: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
112: *> (superdiagonal (or subdiagonal) elements of D
113: *> are stored on exit in array E), and
114: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
115: *> If UPLO = 'L': factor L in the subdiagonal part of A.
116: *>
117: *> On exit, contains factorization details in format used in
118: *> ZSYTRF_ROOK:
119: *> a) all elements of the symmetric block diagonal
120: *> matrix D on the diagonal of A and on superdiagonal
121: *> (or subdiagonal) of A, and
122: *> b) If UPLO = 'U': multipliers used to obtain factor U
123: *> in the superdiagonal part of A.
124: *> If UPLO = 'L': multipliers used to obtain factor L
125: *> in the superdiagonal part of A.
126: *> \endverbatim
127: *>
128: *> \param[in] LDA
129: *> \verbatim
130: *> LDA is INTEGER
131: *> The leading dimension of the array A. LDA >= max(1,N).
132: *> \endverbatim
133: *>
134: *> \param[in,out] E
135: *> \verbatim
136: *> E is COMPLEX*16 array, dimension (N)
137: *>
138: *> 1) If WAY ='C':
139: *>
140: *> On entry, just a workspace.
141: *>
142: *> On exit, contains the superdiagonal (or subdiagonal)
143: *> elements of the symmetric block diagonal matrix D
144: *> with 1-by-1 or 2-by-2 diagonal blocks, where
145: *> If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
146: *> If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
147: *>
148: *> 2) If WAY = 'R':
149: *>
150: *> On entry, contains the superdiagonal (or subdiagonal)
151: *> elements of the symmetric block diagonal matrix D
152: *> with 1-by-1 or 2-by-2 diagonal blocks, where
153: *> If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
154: *> If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
155: *>
156: *> On exit, is not changed
157: *> \endverbatim
158: *.
159: *> \param[in] IPIV
160: *> \verbatim
161: *> IPIV is INTEGER array, dimension (N)
162: *> On entry, details of the interchanges and the block
163: *> structure of D as determined:
164: *> 1) by ZSYTRF_ROOK, if WAY ='C';
165: *> 2) by ZSYTRF_RK (or ZSYTRF_BK), if WAY ='R'.
166: *> The IPIV format is the same for all these routines.
167: *>
168: *> On exit, is not changed.
169: *> \endverbatim
170: *>
171: *> \param[out] INFO
172: *> \verbatim
173: *> INFO is INTEGER
174: *> = 0: successful exit
175: *> < 0: if INFO = -i, the i-th argument had an illegal value
176: *> \endverbatim
177: *
178: * Authors:
179: * ========
180: *
181: *> \author Univ. of Tennessee
182: *> \author Univ. of California Berkeley
183: *> \author Univ. of Colorado Denver
184: *> \author NAG Ltd.
185: *
186: *> \ingroup complex16SYcomputational
187: *
188: *> \par Contributors:
189: * ==================
190: *>
191: *> \verbatim
192: *>
193: *> November 2017, Igor Kozachenko,
194: *> Computer Science Division,
195: *> University of California, Berkeley
196: *>
197: *> \endverbatim
198: * =====================================================================
199: SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
200: *
201: * -- LAPACK computational routine --
202: * -- LAPACK is a software package provided by Univ. of Tennessee, --
203: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
204: *
205: * .. Scalar Arguments ..
206: CHARACTER UPLO, WAY
207: INTEGER INFO, LDA, N
208: * ..
209: * .. Array Arguments ..
210: INTEGER IPIV( * )
211: COMPLEX*16 A( LDA, * ), E( * )
212: * ..
213: *
214: * =====================================================================
215: *
216: * .. Parameters ..
217: COMPLEX*16 ZERO
218: PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
219: * ..
220: * .. External Functions ..
221: LOGICAL LSAME
222: EXTERNAL LSAME
223: *
224: * .. External Subroutines ..
225: EXTERNAL ZSWAP, XERBLA
226: * .. Local Scalars ..
227: LOGICAL UPPER, CONVERT
228: INTEGER I, IP, IP2
229: * ..
230: * .. Executable Statements ..
231: *
232: INFO = 0
233: UPPER = LSAME( UPLO, 'U' )
234: CONVERT = LSAME( WAY, 'C' )
235: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
236: INFO = -1
237: ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
238: INFO = -2
239: ELSE IF( N.LT.0 ) THEN
240: INFO = -3
241: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
242: INFO = -5
243:
244: END IF
245: IF( INFO.NE.0 ) THEN
246: CALL XERBLA( 'ZSYCONVF_ROOK', -INFO )
247: RETURN
248: END IF
249: *
250: * Quick return if possible
251: *
252: IF( N.EQ.0 )
253: $ RETURN
254: *
255: IF( UPPER ) THEN
256: *
257: * Begin A is UPPER
258: *
259: IF ( CONVERT ) THEN
260: *
261: * Convert A (A is upper)
262: *
263: *
264: * Convert VALUE
265: *
266: * Assign superdiagonal entries of D to array E and zero out
267: * corresponding entries in input storage A
268: *
269: I = N
270: E( 1 ) = ZERO
271: DO WHILE ( I.GT.1 )
272: IF( IPIV( I ).LT.0 ) THEN
273: E( I ) = A( I-1, I )
274: E( I-1 ) = ZERO
275: A( I-1, I ) = ZERO
276: I = I - 1
277: ELSE
278: E( I ) = ZERO
279: END IF
280: I = I - 1
281: END DO
282: *
283: * Convert PERMUTATIONS
284: *
285: * Apply permutations to submatrices of upper part of A
286: * in factorization order where i decreases from N to 1
287: *
288: I = N
289: DO WHILE ( I.GE.1 )
290: IF( IPIV( I ).GT.0 ) THEN
291: *
292: * 1-by-1 pivot interchange
293: *
294: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
295: *
296: IP = IPIV( I )
297: IF( I.LT.N ) THEN
298: IF( IP.NE.I ) THEN
299: CALL ZSWAP( N-I, A( I, I+1 ), LDA,
300: $ A( IP, I+1 ), LDA )
301: END IF
302: END IF
303: *
304: ELSE
305: *
306: * 2-by-2 pivot interchange
307: *
308: * Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
309: * in A(1:i,N-i:N)
310: *
311: IP = -IPIV( I )
312: IP2 = -IPIV( I-1 )
313: IF( I.LT.N ) THEN
314: IF( IP.NE.I ) THEN
315: CALL ZSWAP( N-I, A( I, I+1 ), LDA,
316: $ A( IP, I+1 ), LDA )
317: END IF
318: IF( IP2.NE.(I-1) ) THEN
319: CALL ZSWAP( N-I, A( I-1, I+1 ), LDA,
320: $ A( IP2, I+1 ), LDA )
321: END IF
322: END IF
323: I = I - 1
324: *
325: END IF
326: I = I - 1
327: END DO
328: *
329: ELSE
330: *
331: * Revert A (A is upper)
332: *
333: *
334: * Revert PERMUTATIONS
335: *
336: * Apply permutations to submatrices of upper part of A
337: * in reverse factorization order where i increases from 1 to N
338: *
339: I = 1
340: DO WHILE ( I.LE.N )
341: IF( IPIV( I ).GT.0 ) THEN
342: *
343: * 1-by-1 pivot interchange
344: *
345: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
346: *
347: IP = IPIV( I )
348: IF( I.LT.N ) THEN
349: IF( IP.NE.I ) THEN
350: CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
351: $ A( I, I+1 ), LDA )
352: END IF
353: END IF
354: *
355: ELSE
356: *
357: * 2-by-2 pivot interchange
358: *
359: * Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
360: * in A(1:i,N-i:N)
361: *
362: I = I + 1
363: IP = -IPIV( I )
364: IP2 = -IPIV( I-1 )
365: IF( I.LT.N ) THEN
366: IF( IP2.NE.(I-1) ) THEN
367: CALL ZSWAP( N-I, A( IP2, I+1 ), LDA,
368: $ A( I-1, I+1 ), LDA )
369: END IF
370: IF( IP.NE.I ) THEN
371: CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
372: $ A( I, I+1 ), LDA )
373: END IF
374: END IF
375: *
376: END IF
377: I = I + 1
378: END DO
379: *
380: * Revert VALUE
381: * Assign superdiagonal entries of D from array E to
382: * superdiagonal entries of A.
383: *
384: I = N
385: DO WHILE ( I.GT.1 )
386: IF( IPIV( I ).LT.0 ) THEN
387: A( I-1, I ) = E( I )
388: I = I - 1
389: END IF
390: I = I - 1
391: END DO
392: *
393: * End A is UPPER
394: *
395: END IF
396: *
397: ELSE
398: *
399: * Begin A is LOWER
400: *
401: IF ( CONVERT ) THEN
402: *
403: * Convert A (A is lower)
404: *
405: *
406: * Convert VALUE
407: * Assign subdiagonal entries of D to array E and zero out
408: * corresponding entries in input storage A
409: *
410: I = 1
411: E( N ) = ZERO
412: DO WHILE ( I.LE.N )
413: IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
414: E( I ) = A( I+1, I )
415: E( I+1 ) = ZERO
416: A( I+1, I ) = ZERO
417: I = I + 1
418: ELSE
419: E( I ) = ZERO
420: END IF
421: I = I + 1
422: END DO
423: *
424: * Convert PERMUTATIONS
425: *
426: * Apply permutations to submatrices of lower part of A
427: * in factorization order where i increases from 1 to N
428: *
429: I = 1
430: DO WHILE ( I.LE.N )
431: IF( IPIV( I ).GT.0 ) THEN
432: *
433: * 1-by-1 pivot interchange
434: *
435: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
436: *
437: IP = IPIV( I )
438: IF ( I.GT.1 ) THEN
439: IF( IP.NE.I ) THEN
440: CALL ZSWAP( I-1, A( I, 1 ), LDA,
441: $ A( IP, 1 ), LDA )
442: END IF
443: END IF
444: *
445: ELSE
446: *
447: * 2-by-2 pivot interchange
448: *
449: * Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
450: * in A(i:N,1:i-1)
451: *
452: IP = -IPIV( I )
453: IP2 = -IPIV( I+1 )
454: IF ( I.GT.1 ) THEN
455: IF( IP.NE.I ) THEN
456: CALL ZSWAP( I-1, A( I, 1 ), LDA,
457: $ A( IP, 1 ), LDA )
458: END IF
459: IF( IP2.NE.(I+1) ) THEN
460: CALL ZSWAP( I-1, A( I+1, 1 ), LDA,
461: $ A( IP2, 1 ), LDA )
462: END IF
463: END IF
464: I = I + 1
465: *
466: END IF
467: I = I + 1
468: END DO
469: *
470: ELSE
471: *
472: * Revert A (A is lower)
473: *
474: *
475: * Revert PERMUTATIONS
476: *
477: * Apply permutations to submatrices of lower part of A
478: * in reverse factorization order where i decreases from N to 1
479: *
480: I = N
481: DO WHILE ( I.GE.1 )
482: IF( IPIV( I ).GT.0 ) THEN
483: *
484: * 1-by-1 pivot interchange
485: *
486: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
487: *
488: IP = IPIV( I )
489: IF ( I.GT.1 ) THEN
490: IF( IP.NE.I ) THEN
491: CALL ZSWAP( I-1, A( IP, 1 ), LDA,
492: $ A( I, 1 ), LDA )
493: END IF
494: END IF
495: *
496: ELSE
497: *
498: * 2-by-2 pivot interchange
499: *
500: * Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
501: * in A(i:N,1:i-1)
502: *
503: I = I - 1
504: IP = -IPIV( I )
505: IP2 = -IPIV( I+1 )
506: IF ( I.GT.1 ) THEN
507: IF( IP2.NE.(I+1) ) THEN
508: CALL ZSWAP( I-1, A( IP2, 1 ), LDA,
509: $ A( I+1, 1 ), LDA )
510: END IF
511: IF( IP.NE.I ) THEN
512: CALL ZSWAP( I-1, A( IP, 1 ), LDA,
513: $ A( I, 1 ), LDA )
514: END IF
515: END IF
516: *
517: END IF
518: I = I - 1
519: END DO
520: *
521: * Revert VALUE
522: * Assign subdiagonal entries of D from array E to
523: * subgiagonal entries of A.
524: *
525: I = 1
526: DO WHILE ( I.LE.N-1 )
527: IF( IPIV( I ).LT.0 ) THEN
528: A( I + 1, I ) = E( I )
529: I = I + 1
530: END IF
531: I = I + 1
532: END DO
533: *
534: END IF
535: *
536: * End A is LOWER
537: *
538: END IF
539:
540: RETURN
541: *
542: * End of ZSYCONVF_ROOK
543: *
544: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zsyconvf_rook.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack