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