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

◆ ctfttr()

subroutine ctfttr ( character  transr,
character  uplo,
integer  n,
complex, dimension( 0: * )  arf,
complex, dimension( 0: lda-1, 0: * )  a,
integer  lda,
integer  info 
)

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

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

Purpose:
 CTFTTR copies a triangular matrix A from rectangular full packed
 format (TF) to standard full format (TR).
Parameters
[in]TRANSR
          TRANSR is CHARACTER*1
          = 'N':  ARF is in Normal format;
          = 'C':  ARF is in Conjugate-transpose format;
[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]ARF
          ARF is COMPLEX array, dimension ( N*(N+1)/2 ),
          On entry, the upper or lower triangular matrix A stored in
          RFP format. For a further discussion see Notes below.
[out]A
          A is COMPLEX array, dimension ( LDA, N )
          On exit, the triangular matrix A.  If UPLO = 'U', the
          leading N-by-N upper triangular part of the array A contains
          the upper triangular matrix, and the strictly lower
          triangular part of A is not referenced.  If UPLO = 'L', the
          leading N-by-N lower triangular part of the array A contains
          the lower triangular matrix, and the strictly upper
          triangular part of A is not referenced.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[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 215 of file ctfttr.f.

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*
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: