LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ ztpttf()

subroutine ztpttf ( character transr,
character uplo,
integer n,
complex*16, dimension( 0: * ) ap,
complex*16, dimension( 0: * ) arf,
integer info )

ZTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF).

Download ZTPTTF + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> ZTPTTF copies a triangular matrix A from standard packed format (TP)
!> to rectangular full packed format (TF).
!>
Parameters
[in]TRANSR
!>          TRANSR is CHARACTER*1
!>          = 'N':  ARF in Normal format is wanted;
!>          = 'C':  ARF in Conjugate-transpose format is wanted.
!>
[in]UPLO
!>          UPLO is CHARACTER*1
!>          = 'U':  A is upper triangular;
!>          = 'L':  A is lower triangular.
!>
[in]N
!>          N is INTEGER
!>          The order of the matrix A.  N >= 0.
!>
[in]AP
!>          AP is COMPLEX*16 array, dimension ( N*(N+1)/2 ),
!>          On entry, the upper or lower triangular matrix A, packed
!>          columnwise in a linear array. The j-th column of A is stored
!>          in the array AP as follows:
!>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
!>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
!>
[out]ARF
!>          ARF is COMPLEX*16 array, dimension ( N*(N+1)/2 ),
!>          On exit, the upper or lower triangular matrix A stored in
!>          RFP format. For a further discussion see Notes below.
!>
[out]INFO
!>          INFO is INTEGER
!>          = 0:  successful exit
!>          < 0:  if INFO = -i, the i-th argument had an illegal value
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  We first consider Standard Packed Format when N is even.
!>  We give an example where N = 6.
!>
!>      AP is Upper             AP is Lower
!>
!>   00 01 02 03 04 05       00
!>      11 12 13 14 15       10 11
!>         22 23 24 25       20 21 22
!>            33 34 35       30 31 32 33
!>               44 45       40 41 42 43 44
!>                  55       50 51 52 53 54 55
!>
!>
!>  Let TRANSR = 'N'. RFP holds AP as follows:
!>  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
!>  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
!>  conjugate-transpose of the first three columns of AP upper.
!>  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
!>  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
!>  conjugate-transpose of the last three columns of AP lower.
!>  To denote conjugate we place -- above the element. This covers the
!>  case N even and TRANSR = 'N'.
!>
!>         RFP A                   RFP A
!>
!>                                -- -- --
!>        03 04 05                33 43 53
!>                                   -- --
!>        13 14 15                00 44 54
!>                                      --
!>        23 24 25                10 11 55
!>
!>        33 34 35                20 21 22
!>        --
!>        00 44 45                30 31 32
!>        -- --
!>        01 11 55                40 41 42
!>        -- -- --
!>        02 12 22                50 51 52
!>
!>  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
!>  transpose of RFP A above. One therefore gets:
!>
!>
!>           RFP A                   RFP A
!>
!>     -- -- -- --                -- -- -- -- -- --
!>     03 13 23 33 00 01 02    33 00 10 20 30 40 50
!>     -- -- -- -- --                -- -- -- -- --
!>     04 14 24 34 44 11 12    43 44 11 21 31 41 51
!>     -- -- -- -- -- --                -- -- -- --
!>     05 15 25 35 45 55 22    53 54 55 22 32 42 52
!>
!>
!>  We next  consider Standard Packed Format when N is odd.
!>  We give an example where N = 5.
!>
!>     AP is Upper                 AP is Lower
!>
!>   00 01 02 03 04              00
!>      11 12 13 14              10 11
!>         22 23 24              20 21 22
!>            33 34              30 31 32 33
!>               44              40 41 42 43 44
!>
!>
!>  Let TRANSR = 'N'. RFP holds AP as follows:
!>  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
!>  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
!>  conjugate-transpose of the first two   columns of AP upper.
!>  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
!>  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
!>  conjugate-transpose of the last two   columns of AP lower.
!>  To denote conjugate we place -- above the element. This covers the
!>  case N odd  and TRANSR = 'N'.
!>
!>         RFP A                   RFP A
!>
!>                                   -- --
!>        02 03 04                00 33 43
!>                                      --
!>        12 13 14                10 11 44
!>
!>        22 23 24                20 21 22
!>        --
!>        00 33 34                30 31 32
!>        -- --
!>        01 11 44                40 41 42
!>
!>  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
!>  transpose of RFP A above. One therefore gets:
!>
!>
!>           RFP A                   RFP A
!>
!>     -- -- --                   -- -- -- -- -- --
!>     02 12 22 00 01             00 10 20 30 40 50
!>     -- -- -- --                   -- -- -- -- --
!>     03 13 23 33 11             33 11 21 31 41 51
!>     -- -- -- -- --                   -- -- -- --
!>     04 14 24 34 44             43 44 22 32 42 52
!>

Definition at line 204 of file ztpttf.f.

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*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: