LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ ctfttp()

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.
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 207 of file ctfttp.f.

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