LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ctfttr.f
Go to the documentation of this file.
1*> \brief \b CTFTTR 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 CTFTTR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctfttr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctfttr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctfttr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CTFTTR( 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 A( 0: LDA-1, 0: * ), ARF( 0: * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CTFTTR 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 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 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 tfttr
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 ctfttr( 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 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 conjg, 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( 'CTFTTR', -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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 CTFTTR
534*
535 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ctfttr
subroutine ctfttr(transr, uplo, n, arf, a, lda, info)
CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition ctfttr.f:216