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

◆ ctpttf()

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

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

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

Purpose:
 CTPTTF 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 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 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 206 of file ctpttf.f.

207*
208* -- LAPACK computational routine --
209* -- LAPACK is a software package provided by Univ. of Tennessee, --
210* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
211*
212* .. Scalar Arguments ..
213 CHARACTER TRANSR, UPLO
214 INTEGER INFO, N
215* ..
216* .. Array Arguments ..
217 COMPLEX AP( 0: * ), ARF( 0: * )
218*
219* =====================================================================
220*
221* .. Parameters ..
222* ..
223* .. Local Scalars ..
224 LOGICAL LOWER, NISODD, NORMALTRANSR
225 INTEGER N1, N2, K, NT
226 INTEGER I, J, IJ
227 INTEGER IJP, JP, LDA, JS
228* ..
229* .. External Functions ..
230 LOGICAL LSAME
231 EXTERNAL lsame
232* ..
233* .. External Subroutines ..
234 EXTERNAL xerbla
235* ..
236* .. Intrinsic Functions ..
237 INTRINSIC conjg, mod
238* ..
239* .. Executable Statements ..
240*
241* Test the input parameters.
242*
243 info = 0
244 normaltransr = lsame( transr, 'N' )
245 lower = lsame( uplo, 'L' )
246 IF( .NOT.normaltransr .AND. .NOT.lsame( transr, 'C' ) ) THEN
247 info = -1
248 ELSE IF( .NOT.lower .AND. .NOT.lsame( uplo, 'U' ) ) THEN
249 info = -2
250 ELSE IF( n.LT.0 ) THEN
251 info = -3
252 END IF
253 IF( info.NE.0 ) THEN
254 CALL xerbla( 'CTPTTF', -info )
255 RETURN
256 END IF
257*
258* Quick return if possible
259*
260 IF( n.EQ.0 )
261 $ RETURN
262*
263 IF( n.EQ.1 ) THEN
264 IF( normaltransr ) THEN
265 arf( 0 ) = ap( 0 )
266 ELSE
267 arf( 0 ) = conjg( ap( 0 ) )
268 END IF
269 RETURN
270 END IF
271*
272* Size of array ARF(0:NT-1)
273*
274 nt = n*( n+1 ) / 2
275*
276* Set N1 and N2 depending on LOWER
277*
278 IF( lower ) THEN
279 n2 = n / 2
280 n1 = n - n2
281 ELSE
282 n1 = n / 2
283 n2 = n - n1
284 END IF
285*
286* If N is odd, set NISODD = .TRUE.
287* If N is even, set K = N/2 and NISODD = .FALSE.
288*
289* set lda of ARF^C; ARF^C is (0:(N+1)/2-1,0:N-noe)
290* where noe = 0 if n is even, noe = 1 if n is odd
291*
292 IF( mod( n, 2 ).EQ.0 ) THEN
293 k = n / 2
294 nisodd = .false.
295 lda = n + 1
296 ELSE
297 nisodd = .true.
298 lda = n
299 END IF
300*
301* ARF^C has lda rows and n+1-noe cols
302*
303 IF( .NOT.normaltransr )
304 $ lda = ( n+1 ) / 2
305*
306* start execution: there are eight cases
307*
308 IF( nisodd ) THEN
309*
310* N is odd
311*
312 IF( normaltransr ) THEN
313*
314* N is odd and TRANSR = 'N'
315*
316 IF( lower ) THEN
317*
318* SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
319* T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
320* T1 -> a(0), T2 -> a(n), S -> a(n1); lda = n
321*
322 ijp = 0
323 jp = 0
324 DO j = 0, n2
325 DO i = j, n - 1
326 ij = i + jp
327 arf( ij ) = ap( ijp )
328 ijp = ijp + 1
329 END DO
330 jp = jp + lda
331 END DO
332 DO i = 0, n2 - 1
333 DO j = 1 + i, n2
334 ij = i + j*lda
335 arf( ij ) = conjg( ap( ijp ) )
336 ijp = ijp + 1
337 END DO
338 END DO
339*
340 ELSE
341*
342* SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
343* T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
344* T1 -> a(n2), T2 -> a(n1), S -> a(0)
345*
346 ijp = 0
347 DO j = 0, n1 - 1
348 ij = n2 + j
349 DO i = 0, j
350 arf( ij ) = conjg( ap( ijp ) )
351 ijp = ijp + 1
352 ij = ij + lda
353 END DO
354 END DO
355 js = 0
356 DO j = n1, n - 1
357 ij = js
358 DO ij = js, js + j
359 arf( ij ) = ap( ijp )
360 ijp = ijp + 1
361 END DO
362 js = js + lda
363 END DO
364*
365 END IF
366*
367 ELSE
368*
369* N is odd and TRANSR = 'C'
370*
371 IF( lower ) THEN
372*
373* SRPA for LOWER, TRANSPOSE and N is odd
374* T1 -> A(0,0) , T2 -> A(1,0) , S -> A(0,n1)
375* T1 -> a(0+0) , T2 -> a(1+0) , S -> a(0+n1*n1); lda=n1
376*
377 ijp = 0
378 DO i = 0, n2
379 DO ij = i*( lda+1 ), n*lda - 1, lda
380 arf( ij ) = conjg( ap( ijp ) )
381 ijp = ijp + 1
382 END DO
383 END DO
384 js = 1
385 DO j = 0, n2 - 1
386 DO ij = js, js + n2 - j - 1
387 arf( ij ) = ap( ijp )
388 ijp = ijp + 1
389 END DO
390 js = js + lda + 1
391 END DO
392*
393 ELSE
394*
395* SRPA for UPPER, TRANSPOSE and N is odd
396* T1 -> A(0,n1+1), T2 -> A(0,n1), S -> A(0,0)
397* T1 -> a(n2*n2), T2 -> a(n1*n2), S -> a(0); lda = n2
398*
399 ijp = 0
400 js = n2*lda
401 DO j = 0, n1 - 1
402 DO ij = js, js + j
403 arf( ij ) = ap( ijp )
404 ijp = ijp + 1
405 END DO
406 js = js + lda
407 END DO
408 DO i = 0, n1
409 DO ij = i, i + ( n1+i )*lda, lda
410 arf( ij ) = conjg( ap( ijp ) )
411 ijp = ijp + 1
412 END DO
413 END DO
414*
415 END IF
416*
417 END IF
418*
419 ELSE
420*
421* N is even
422*
423 IF( normaltransr ) THEN
424*
425* N is even and TRANSR = 'N'
426*
427 IF( lower ) THEN
428*
429* SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
430* T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
431* T1 -> a(1), T2 -> a(0), S -> a(k+1)
432*
433 ijp = 0
434 jp = 0
435 DO j = 0, k - 1
436 DO i = j, n - 1
437 ij = 1 + i + jp
438 arf( ij ) = ap( ijp )
439 ijp = ijp + 1
440 END DO
441 jp = jp + lda
442 END DO
443 DO i = 0, k - 1
444 DO j = i, k - 1
445 ij = i + j*lda
446 arf( ij ) = conjg( ap( ijp ) )
447 ijp = ijp + 1
448 END DO
449 END DO
450*
451 ELSE
452*
453* SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
454* T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
455* T1 -> a(k+1), T2 -> a(k), S -> a(0)
456*
457 ijp = 0
458 DO j = 0, k - 1
459 ij = k + 1 + j
460 DO i = 0, j
461 arf( ij ) = conjg( ap( ijp ) )
462 ijp = ijp + 1
463 ij = ij + lda
464 END DO
465 END DO
466 js = 0
467 DO j = k, n - 1
468 ij = js
469 DO ij = js, js + j
470 arf( ij ) = ap( ijp )
471 ijp = ijp + 1
472 END DO
473 js = js + lda
474 END DO
475*
476 END IF
477*
478 ELSE
479*
480* N is even and TRANSR = 'C'
481*
482 IF( lower ) THEN
483*
484* SRPA for LOWER, TRANSPOSE and N is even (see paper)
485* T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
486* T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
487*
488 ijp = 0
489 DO i = 0, k - 1
490 DO ij = i + ( i+1 )*lda, ( n+1 )*lda - 1, lda
491 arf( ij ) = conjg( ap( ijp ) )
492 ijp = ijp + 1
493 END DO
494 END DO
495 js = 0
496 DO j = 0, k - 1
497 DO ij = js, js + k - j - 1
498 arf( ij ) = ap( ijp )
499 ijp = ijp + 1
500 END DO
501 js = js + lda + 1
502 END DO
503*
504 ELSE
505*
506* SRPA for UPPER, TRANSPOSE and N is even (see paper)
507* T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
508* T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
509*
510 ijp = 0
511 js = ( k+1 )*lda
512 DO j = 0, k - 1
513 DO ij = js, js + j
514 arf( ij ) = ap( ijp )
515 ijp = ijp + 1
516 END DO
517 js = js + lda
518 END DO
519 DO i = 0, k - 1
520 DO ij = i, i + ( k+i )*lda, lda
521 arf( ij ) = conjg( ap( ijp ) )
522 ijp = ijp + 1
523 END DO
524 END DO
525*
526 END IF
527*
528 END IF
529*
530 END IF
531*
532 RETURN
533*
534* End of CTPTTF
535*
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: