1: *> \brief \b ZTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR).
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZTFTTR + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztfttr.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztfttr.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztfttr.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZTFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
22: *
23: * .. Scalar Arguments ..
24: * CHARACTER TRANSR, UPLO
25: * INTEGER INFO, N, LDA
26: * ..
27: * .. Array Arguments ..
28: * COMPLEX*16 A( 0: LDA-1, 0: * ), ARF( 0: * )
29: * ..
30: *
31: *
32: *> \par Purpose:
33: * =============
34: *>
35: *> \verbatim
36: *>
37: *> ZTFTTR copies a triangular matrix A from rectangular full packed
38: *> format (TF) to standard full format (TR).
39: *> \endverbatim
40: *
41: * Arguments:
42: * ==========
43: *
44: *> \param[in] TRANSR
45: *> \verbatim
46: *> TRANSR is CHARACTER*1
47: *> = 'N': ARF is in Normal format;
48: *> = 'C': ARF is in Conjugate-transpose format;
49: *> \endverbatim
50: *>
51: *> \param[in] UPLO
52: *> \verbatim
53: *> UPLO is CHARACTER*1
54: *> = 'U': A is upper triangular;
55: *> = 'L': A is lower triangular.
56: *> \endverbatim
57: *>
58: *> \param[in] N
59: *> \verbatim
60: *> N is INTEGER
61: *> The order of the matrix A. N >= 0.
62: *> \endverbatim
63: *>
64: *> \param[in] ARF
65: *> \verbatim
66: *> ARF is COMPLEX*16 array, dimension ( N*(N+1)/2 ),
67: *> On entry, the upper or lower triangular matrix A stored in
68: *> RFP format. For a further discussion see Notes below.
69: *> \endverbatim
70: *>
71: *> \param[out] A
72: *> \verbatim
73: *> A is COMPLEX*16 array, dimension ( LDA, N )
74: *> On exit, the triangular matrix A. If UPLO = 'U', the
75: *> leading N-by-N upper triangular part of the array A contains
76: *> the upper triangular matrix, and the strictly lower
77: *> triangular part of A is not referenced. If UPLO = 'L', the
78: *> leading N-by-N lower triangular part of the array A contains
79: *> the lower triangular matrix, and the strictly upper
80: *> triangular part of A is not referenced.
81: *> \endverbatim
82: *>
83: *> \param[in] LDA
84: *> \verbatim
85: *> LDA is INTEGER
86: *> The leading dimension of the array A. LDA >= max(1,N).
87: *> \endverbatim
88: *>
89: *> \param[out] INFO
90: *> \verbatim
91: *> INFO is INTEGER
92: *> = 0: successful exit
93: *> < 0: if INFO = -i, the i-th argument had an illegal value
94: *> \endverbatim
95: *
96: * Authors:
97: * ========
98: *
99: *> \author Univ. of Tennessee
100: *> \author Univ. of California Berkeley
101: *> \author Univ. of Colorado Denver
102: *> \author NAG Ltd.
103: *
104: *> \ingroup complex16OTHERcomputational
105: *
106: *> \par Further Details:
107: * =====================
108: *>
109: *> \verbatim
110: *>
111: *> We first consider Standard Packed Format when N is even.
112: *> We give an example where N = 6.
113: *>
114: *> AP is Upper AP is Lower
115: *>
116: *> 00 01 02 03 04 05 00
117: *> 11 12 13 14 15 10 11
118: *> 22 23 24 25 20 21 22
119: *> 33 34 35 30 31 32 33
120: *> 44 45 40 41 42 43 44
121: *> 55 50 51 52 53 54 55
122: *>
123: *>
124: *> Let TRANSR = 'N'. RFP holds AP as follows:
125: *> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
126: *> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
127: *> conjugate-transpose of the first three columns of AP upper.
128: *> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
129: *> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
130: *> conjugate-transpose of the last three columns of AP lower.
131: *> To denote conjugate we place -- above the element. This covers the
132: *> case N even and TRANSR = 'N'.
133: *>
134: *> RFP A RFP A
135: *>
136: *> -- -- --
137: *> 03 04 05 33 43 53
138: *> -- --
139: *> 13 14 15 00 44 54
140: *> --
141: *> 23 24 25 10 11 55
142: *>
143: *> 33 34 35 20 21 22
144: *> --
145: *> 00 44 45 30 31 32
146: *> -- --
147: *> 01 11 55 40 41 42
148: *> -- -- --
149: *> 02 12 22 50 51 52
150: *>
151: *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
152: *> transpose of RFP A above. One therefore gets:
153: *>
154: *>
155: *> RFP A RFP A
156: *>
157: *> -- -- -- -- -- -- -- -- -- --
158: *> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
159: *> -- -- -- -- -- -- -- -- -- --
160: *> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
161: *> -- -- -- -- -- -- -- -- -- --
162: *> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
163: *>
164: *>
165: *> We next consider Standard Packed Format when N is odd.
166: *> We give an example where N = 5.
167: *>
168: *> AP is Upper AP is Lower
169: *>
170: *> 00 01 02 03 04 00
171: *> 11 12 13 14 10 11
172: *> 22 23 24 20 21 22
173: *> 33 34 30 31 32 33
174: *> 44 40 41 42 43 44
175: *>
176: *>
177: *> Let TRANSR = 'N'. RFP holds AP as follows:
178: *> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
179: *> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
180: *> conjugate-transpose of the first two columns of AP upper.
181: *> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
182: *> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
183: *> conjugate-transpose of the last two columns of AP lower.
184: *> To denote conjugate we place -- above the element. This covers the
185: *> case N odd and TRANSR = 'N'.
186: *>
187: *> RFP A RFP A
188: *>
189: *> -- --
190: *> 02 03 04 00 33 43
191: *> --
192: *> 12 13 14 10 11 44
193: *>
194: *> 22 23 24 20 21 22
195: *> --
196: *> 00 33 34 30 31 32
197: *> -- --
198: *> 01 11 44 40 41 42
199: *>
200: *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
201: *> transpose of RFP A above. One therefore gets:
202: *>
203: *>
204: *> RFP A RFP A
205: *>
206: *> -- -- -- -- -- -- -- -- --
207: *> 02 12 22 00 01 00 10 20 30 40 50
208: *> -- -- -- -- -- -- -- -- --
209: *> 03 13 23 33 11 33 11 21 31 41 51
210: *> -- -- -- -- -- -- -- -- --
211: *> 04 14 24 34 44 43 44 22 32 42 52
212: *> \endverbatim
213: *>
214: * =====================================================================
215: SUBROUTINE ZTFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
216: *
217: * -- LAPACK computational routine --
218: * -- LAPACK is a software package provided by Univ. of Tennessee, --
219: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
220: *
221: * .. Scalar Arguments ..
222: CHARACTER TRANSR, UPLO
223: INTEGER INFO, N, LDA
224: * ..
225: * .. Array Arguments ..
226: COMPLEX*16 A( 0: LDA-1, 0: * ), ARF( 0: * )
227: * ..
228: *
229: * =====================================================================
230: *
231: * .. Parameters ..
232: * ..
233: * .. Local Scalars ..
234: LOGICAL LOWER, NISODD, NORMALTRANSR
235: INTEGER N1, N2, K, NT, NX2, NP1X2
236: INTEGER I, J, L, IJ
237: * ..
238: * .. External Functions ..
239: LOGICAL LSAME
240: EXTERNAL LSAME
241: * ..
242: * .. External Subroutines ..
243: EXTERNAL XERBLA
244: * ..
245: * .. Intrinsic Functions ..
246: INTRINSIC DCONJG, MAX, MOD
247: * ..
248: * .. Executable Statements ..
249: *
250: * Test the input parameters.
251: *
252: INFO = 0
253: NORMALTRANSR = LSAME( TRANSR, 'N' )
254: LOWER = LSAME( UPLO, 'L' )
255: IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN
256: INFO = -1
257: ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
258: INFO = -2
259: ELSE IF( N.LT.0 ) THEN
260: INFO = -3
261: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
262: INFO = -6
263: END IF
264: IF( INFO.NE.0 ) THEN
265: CALL XERBLA( 'ZTFTTR', -INFO )
266: RETURN
267: END IF
268: *
269: * Quick return if possible
270: *
271: IF( N.LE.1 ) THEN
272: IF( N.EQ.1 ) THEN
273: IF( NORMALTRANSR ) THEN
274: A( 0, 0 ) = ARF( 0 )
275: ELSE
276: A( 0, 0 ) = DCONJG( ARF( 0 ) )
277: END IF
278: END IF
279: RETURN
280: END IF
281: *
282: * Size of array ARF(1:2,0:nt-1)
283: *
284: NT = N*( N+1 ) / 2
285: *
286: * set N1 and N2 depending on LOWER: for N even N1=N2=K
287: *
288: IF( LOWER ) THEN
289: N2 = N / 2
290: N1 = N - N2
291: ELSE
292: N1 = N / 2
293: N2 = N - N1
294: END IF
295: *
296: * If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
297: * If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
298: * N--by--(N+1)/2.
299: *
300: IF( MOD( N, 2 ).EQ.0 ) THEN
301: K = N / 2
302: NISODD = .FALSE.
303: IF( .NOT.LOWER )
304: $ NP1X2 = N + N + 2
305: ELSE
306: NISODD = .TRUE.
307: IF( .NOT.LOWER )
308: $ NX2 = N + N
309: END IF
310: *
311: IF( NISODD ) THEN
312: *
313: * N is odd
314: *
315: IF( NORMALTRANSR ) THEN
316: *
317: * N is odd and TRANSR = 'N'
318: *
319: IF( LOWER ) THEN
320: *
321: * SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
322: * T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
323: * T1 -> a(0), T2 -> a(n), S -> a(n1); lda=n
324: *
325: IJ = 0
326: DO J = 0, N2
327: DO I = N1, N2 + J
328: A( N2+J, I ) = DCONJG( ARF( IJ ) )
329: IJ = IJ + 1
330: END DO
331: DO I = J, N - 1
332: A( I, J ) = ARF( IJ )
333: IJ = IJ + 1
334: END DO
335: END DO
336: *
337: ELSE
338: *
339: * SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
340: * T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
341: * T1 -> a(n2), T2 -> a(n1), S -> a(0); lda=n
342: *
343: IJ = NT - N
344: DO J = N - 1, N1, -1
345: DO I = 0, J
346: A( I, J ) = ARF( IJ )
347: IJ = IJ + 1
348: END DO
349: DO L = J - N1, N1 - 1
350: A( J-N1, L ) = DCONJG( ARF( IJ ) )
351: IJ = IJ + 1
352: END DO
353: IJ = IJ - NX2
354: END DO
355: *
356: END IF
357: *
358: ELSE
359: *
360: * N is odd and TRANSR = 'C'
361: *
362: IF( LOWER ) THEN
363: *
364: * SRPA for LOWER, TRANSPOSE and N is odd
365: * T1 -> A(0,0) , T2 -> A(1,0) , S -> A(0,n1)
366: * T1 -> A(0+0) , T2 -> A(1+0) , S -> A(0+n1*n1); lda=n1
367: *
368: IJ = 0
369: DO J = 0, N2 - 1
370: DO I = 0, J
371: A( J, I ) = DCONJG( ARF( IJ ) )
372: IJ = IJ + 1
373: END DO
374: DO I = N1 + J, N - 1
375: A( I, N1+J ) = ARF( IJ )
376: IJ = IJ + 1
377: END DO
378: END DO
379: DO J = N2, N - 1
380: DO I = 0, N1 - 1
381: A( J, I ) = DCONJG( ARF( IJ ) )
382: IJ = IJ + 1
383: END DO
384: END DO
385: *
386: ELSE
387: *
388: * SRPA for UPPER, TRANSPOSE and N is odd
389: * T1 -> A(0,n1+1), T2 -> A(0,n1), S -> A(0,0)
390: * T1 -> A(n2*n2), T2 -> A(n1*n2), S -> A(0); lda = n2
391: *
392: IJ = 0
393: DO J = 0, N1
394: DO I = N1, N - 1
395: A( J, I ) = DCONJG( ARF( IJ ) )
396: IJ = IJ + 1
397: END DO
398: END DO
399: DO J = 0, N1 - 1
400: DO I = 0, J
401: A( I, J ) = ARF( IJ )
402: IJ = IJ + 1
403: END DO
404: DO L = N2 + J, N - 1
405: A( N2+J, L ) = DCONJG( ARF( IJ ) )
406: IJ = IJ + 1
407: END DO
408: END DO
409: *
410: END IF
411: *
412: END IF
413: *
414: ELSE
415: *
416: * N is even
417: *
418: IF( NORMALTRANSR ) THEN
419: *
420: * N is even and TRANSR = 'N'
421: *
422: IF( LOWER ) THEN
423: *
424: * SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
425: * T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
426: * T1 -> a(1), T2 -> a(0), S -> a(k+1); lda=n+1
427: *
428: IJ = 0
429: DO J = 0, K - 1
430: DO I = K, K + J
431: A( K+J, I ) = DCONJG( ARF( IJ ) )
432: IJ = IJ + 1
433: END DO
434: DO I = J, N - 1
435: A( I, J ) = ARF( IJ )
436: IJ = IJ + 1
437: END DO
438: END DO
439: *
440: ELSE
441: *
442: * SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
443: * T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
444: * T1 -> a(k+1), T2 -> a(k), S -> a(0); lda=n+1
445: *
446: IJ = NT - N - 1
447: DO J = N - 1, K, -1
448: DO I = 0, J
449: A( I, J ) = ARF( IJ )
450: IJ = IJ + 1
451: END DO
452: DO L = J - K, K - 1
453: A( J-K, L ) = DCONJG( ARF( IJ ) )
454: IJ = IJ + 1
455: END DO
456: IJ = IJ - NP1X2
457: END DO
458: *
459: END IF
460: *
461: ELSE
462: *
463: * N is even and TRANSR = 'C'
464: *
465: IF( LOWER ) THEN
466: *
467: * SRPA for LOWER, TRANSPOSE and N is even (see paper, A=B)
468: * T1 -> A(0,1) , T2 -> A(0,0) , S -> A(0,k+1) :
469: * T1 -> A(0+k) , T2 -> A(0+0) , S -> A(0+k*(k+1)); lda=k
470: *
471: IJ = 0
472: J = K
473: DO I = K, N - 1
474: A( I, J ) = ARF( IJ )
475: IJ = IJ + 1
476: END DO
477: DO J = 0, K - 2
478: DO I = 0, J
479: A( J, I ) = DCONJG( ARF( IJ ) )
480: IJ = IJ + 1
481: END DO
482: DO I = K + 1 + J, N - 1
483: A( I, K+1+J ) = ARF( IJ )
484: IJ = IJ + 1
485: END DO
486: END DO
487: DO J = K - 1, N - 1
488: DO I = 0, K - 1
489: A( J, I ) = DCONJG( ARF( IJ ) )
490: IJ = IJ + 1
491: END DO
492: END DO
493: *
494: ELSE
495: *
496: * SRPA for UPPER, TRANSPOSE and N is even (see paper, A=B)
497: * T1 -> A(0,k+1) , T2 -> A(0,k) , S -> A(0,0)
498: * T1 -> A(0+k*(k+1)) , T2 -> A(0+k*k) , S -> A(0+0)); lda=k
499: *
500: IJ = 0
501: DO J = 0, K
502: DO I = K, N - 1
503: A( J, I ) = DCONJG( ARF( IJ ) )
504: IJ = IJ + 1
505: END DO
506: END DO
507: DO J = 0, K - 2
508: DO I = 0, J
509: A( I, J ) = ARF( IJ )
510: IJ = IJ + 1
511: END DO
512: DO L = K + 1 + J, N - 1
513: A( K+1+J, L ) = DCONJG( ARF( IJ ) )
514: IJ = IJ + 1
515: END DO
516: END DO
517: *
518: * Note that here J = K-1
519: *
520: DO I = 0, J
521: A( I, J ) = ARF( IJ )
522: IJ = IJ + 1
523: END DO
524: *
525: END IF
526: *
527: END IF
528: *
529: END IF
530: *
531: RETURN
532: *
533: * End of ZTFTTR
534: *
535: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ztfttr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack