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

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