LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine ctrttf ( character  TRANSR,
character  UPLO,
integer  N,
complex, dimension( 0: lda-1, 0: * )  A,
integer  LDA,
complex, dimension( 0: * )  ARF,
integer  INFO 
)

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

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

Purpose: 
 CTRTTF copies a triangular matrix A from standard full format (TR)
 to rectangular full packed format (TF) .
Parameters
[in]TRANSR
          TRANSR is CHARACTER*1
          = 'N':  ARF in Normal mode is wanted;
          = 'C':  ARF in Conjugate Transpose mode 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]A
          A is COMPLEX array, dimension ( LDA, N )
          On entry, 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 matrix A.  LDA >= max(1,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.
Date
June 2016
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 218 of file ctrttf.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: