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: *> \date November 2017
187: *
188: *> \ingroup complex16SYcomputational
189: *
190: *> \par Contributors:
191: * ==================
192: *>
193: *> \verbatim
194: *>
195: *> November 2017, Igor Kozachenko,
196: *> Computer Science Division,
197: *> University of California, Berkeley
198: *>
199: *> \endverbatim
200: * =====================================================================
201: SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
202: *
203: * -- LAPACK computational routine (version 3.8.0) --
204: * -- LAPACK is a software package provided by Univ. of Tennessee, --
205: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
206: * November 2017
207: *
208: * .. Scalar Arguments ..
209: CHARACTER UPLO, WAY
210: INTEGER INFO, LDA, N
211: * ..
212: * .. Array Arguments ..
213: INTEGER IPIV( * )
214: COMPLEX*16 A( LDA, * ), E( * )
215: * ..
216: *
217: * =====================================================================
218: *
219: * .. Parameters ..
220: COMPLEX*16 ZERO
221: PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
222: * ..
223: * .. External Functions ..
224: LOGICAL LSAME
225: EXTERNAL LSAME
226: *
227: * .. External Subroutines ..
228: EXTERNAL ZSWAP, XERBLA
229: * .. Local Scalars ..
230: LOGICAL UPPER, CONVERT
231: INTEGER I, IP, IP2
232: * ..
233: * .. Executable Statements ..
234: *
235: INFO = 0
236: UPPER = LSAME( UPLO, 'U' )
237: CONVERT = LSAME( WAY, 'C' )
238: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
239: INFO = -1
240: ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
241: INFO = -2
242: ELSE IF( N.LT.0 ) THEN
243: INFO = -3
244: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
245: INFO = -5
246:
247: END IF
248: IF( INFO.NE.0 ) THEN
249: CALL XERBLA( 'ZSYCONVF_ROOK', -INFO )
250: RETURN
251: END IF
252: *
253: * Quick return if possible
254: *
255: IF( N.EQ.0 )
256: $ RETURN
257: *
258: IF( UPPER ) THEN
259: *
260: * Begin A is UPPER
261: *
262: IF ( CONVERT ) THEN
263: *
264: * Convert A (A is upper)
265: *
266: *
267: * Convert VALUE
268: *
269: * Assign superdiagonal entries of D to array E and zero out
270: * corresponding entries in input storage A
271: *
272: I = N
273: E( 1 ) = ZERO
274: DO WHILE ( I.GT.1 )
275: IF( IPIV( I ).LT.0 ) THEN
276: E( I ) = A( I-1, I )
277: E( I-1 ) = ZERO
278: A( I-1, I ) = ZERO
279: I = I - 1
280: ELSE
281: E( I ) = ZERO
282: END IF
283: I = I - 1
284: END DO
285: *
286: * Convert PERMUTATIONS
287: *
288: * Apply permutations to submatrices of upper part of A
289: * in factorization order where i decreases from N to 1
290: *
291: I = N
292: DO WHILE ( I.GE.1 )
293: IF( IPIV( I ).GT.0 ) THEN
294: *
295: * 1-by-1 pivot interchange
296: *
297: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
298: *
299: IP = IPIV( I )
300: IF( I.LT.N ) THEN
301: IF( IP.NE.I ) THEN
302: CALL ZSWAP( N-I, A( I, I+1 ), LDA,
303: $ A( IP, I+1 ), LDA )
304: END IF
305: END IF
306: *
307: ELSE
308: *
309: * 2-by-2 pivot interchange
310: *
311: * Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
312: * in A(1:i,N-i:N)
313: *
314: IP = -IPIV( I )
315: IP2 = -IPIV( I-1 )
316: IF( I.LT.N ) THEN
317: IF( IP.NE.I ) THEN
318: CALL ZSWAP( N-I, A( I, I+1 ), LDA,
319: $ A( IP, I+1 ), LDA )
320: END IF
321: IF( IP2.NE.(I-1) ) THEN
322: CALL ZSWAP( N-I, A( I-1, I+1 ), LDA,
323: $ A( IP2, I+1 ), LDA )
324: END IF
325: END IF
326: I = I - 1
327: *
328: END IF
329: I = I - 1
330: END DO
331: *
332: ELSE
333: *
334: * Revert A (A is upper)
335: *
336: *
337: * Revert PERMUTATIONS
338: *
339: * Apply permutations to submatrices of upper part of A
340: * in reverse factorization order where i increases from 1 to N
341: *
342: I = 1
343: DO WHILE ( I.LE.N )
344: IF( IPIV( I ).GT.0 ) THEN
345: *
346: * 1-by-1 pivot interchange
347: *
348: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
349: *
350: IP = IPIV( I )
351: IF( I.LT.N ) THEN
352: IF( IP.NE.I ) THEN
353: CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
354: $ A( I, I+1 ), LDA )
355: END IF
356: END IF
357: *
358: ELSE
359: *
360: * 2-by-2 pivot interchange
361: *
362: * Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
363: * in A(1:i,N-i:N)
364: *
365: I = I + 1
366: IP = -IPIV( I )
367: IP2 = -IPIV( I-1 )
368: IF( I.LT.N ) THEN
369: IF( IP2.NE.(I-1) ) THEN
370: CALL ZSWAP( N-I, A( IP2, I+1 ), LDA,
371: $ A( I-1, I+1 ), LDA )
372: END IF
373: IF( IP.NE.I ) THEN
374: CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
375: $ A( I, I+1 ), LDA )
376: END IF
377: END IF
378: *
379: END IF
380: I = I + 1
381: END DO
382: *
383: * Revert VALUE
384: * Assign superdiagonal entries of D from array E to
385: * superdiagonal entries of A.
386: *
387: I = N
388: DO WHILE ( I.GT.1 )
389: IF( IPIV( I ).LT.0 ) THEN
390: A( I-1, I ) = E( I )
391: I = I - 1
392: END IF
393: I = I - 1
394: END DO
395: *
396: * End A is UPPER
397: *
398: END IF
399: *
400: ELSE
401: *
402: * Begin A is LOWER
403: *
404: IF ( CONVERT ) THEN
405: *
406: * Convert A (A is lower)
407: *
408: *
409: * Convert VALUE
410: * Assign subdiagonal entries of D to array E and zero out
411: * corresponding entries in input storage A
412: *
413: I = 1
414: E( N ) = ZERO
415: DO WHILE ( I.LE.N )
416: IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
417: E( I ) = A( I+1, I )
418: E( I+1 ) = ZERO
419: A( I+1, I ) = ZERO
420: I = I + 1
421: ELSE
422: E( I ) = ZERO
423: END IF
424: I = I + 1
425: END DO
426: *
427: * Convert PERMUTATIONS
428: *
429: * Apply permutations to submatrices of lower part of A
430: * in factorization order where i increases from 1 to N
431: *
432: I = 1
433: DO WHILE ( I.LE.N )
434: IF( IPIV( I ).GT.0 ) THEN
435: *
436: * 1-by-1 pivot interchange
437: *
438: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
439: *
440: IP = IPIV( I )
441: IF ( I.GT.1 ) THEN
442: IF( IP.NE.I ) THEN
443: CALL ZSWAP( I-1, A( I, 1 ), LDA,
444: $ A( IP, 1 ), LDA )
445: END IF
446: END IF
447: *
448: ELSE
449: *
450: * 2-by-2 pivot interchange
451: *
452: * Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
453: * in A(i:N,1:i-1)
454: *
455: IP = -IPIV( I )
456: IP2 = -IPIV( I+1 )
457: IF ( I.GT.1 ) THEN
458: IF( IP.NE.I ) THEN
459: CALL ZSWAP( I-1, A( I, 1 ), LDA,
460: $ A( IP, 1 ), LDA )
461: END IF
462: IF( IP2.NE.(I+1) ) THEN
463: CALL ZSWAP( I-1, A( I+1, 1 ), LDA,
464: $ A( IP2, 1 ), LDA )
465: END IF
466: END IF
467: I = I + 1
468: *
469: END IF
470: I = I + 1
471: END DO
472: *
473: ELSE
474: *
475: * Revert A (A is lower)
476: *
477: *
478: * Revert PERMUTATIONS
479: *
480: * Apply permutations to submatrices of lower part of A
481: * in reverse factorization order where i decreases from N to 1
482: *
483: I = N
484: DO WHILE ( I.GE.1 )
485: IF( IPIV( I ).GT.0 ) THEN
486: *
487: * 1-by-1 pivot interchange
488: *
489: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
490: *
491: IP = IPIV( I )
492: IF ( I.GT.1 ) THEN
493: IF( IP.NE.I ) THEN
494: CALL ZSWAP( I-1, A( IP, 1 ), LDA,
495: $ A( I, 1 ), LDA )
496: END IF
497: END IF
498: *
499: ELSE
500: *
501: * 2-by-2 pivot interchange
502: *
503: * Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
504: * in A(i:N,1:i-1)
505: *
506: I = I - 1
507: IP = -IPIV( I )
508: IP2 = -IPIV( I+1 )
509: IF ( I.GT.1 ) THEN
510: IF( IP2.NE.(I+1) ) THEN
511: CALL ZSWAP( I-1, A( IP2, 1 ), LDA,
512: $ A( I+1, 1 ), LDA )
513: END IF
514: IF( IP.NE.I ) THEN
515: CALL ZSWAP( I-1, A( IP, 1 ), LDA,
516: $ A( I, 1 ), LDA )
517: END IF
518: END IF
519: *
520: END IF
521: I = I - 1
522: END DO
523: *
524: * Revert VALUE
525: * Assign subdiagonal entries of D from array E to
526: * subgiagonal entries of A.
527: *
528: I = 1
529: DO WHILE ( I.LE.N-1 )
530: IF( IPIV( I ).LT.0 ) THEN
531: A( I + 1, I ) = E( I )
532: I = I + 1
533: END IF
534: I = I + 1
535: END DO
536: *
537: END IF
538: *
539: * End A is LOWER
540: *
541: END IF
542:
543: RETURN
544: *
545: * End of ZSYCONVF_ROOK
546: *
547: 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