LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: