LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine ctfttp ( character  TRANSR,
character  UPLO,
integer  N,
complex, dimension( 0: * )  ARF,
complex, dimension( 0: * )  AP,
integer  INFO 
)

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

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

Purpose: 
 CTFTTP copies a triangular matrix A from rectangular full packed
 format (TF) to standard packed format (TP).
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]AP
          AP is COMPLEX array, dimension ( N*(N+1)/2 ),
          On exit, 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]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
September 2012
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 210 of file ctfttp.f.

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