LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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 complexOTHERcomputational
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
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
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