SRC/ctrttf.f

   1 *> \brief \b CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF).
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CTRTTF + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrttf.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrttf.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrttf.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CTRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          TRANSR, UPLO
  25 *       INTEGER            INFO, N, LDA
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       COMPLEX            A( 0: LDA-1, 0: * ), ARF( 0: * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> CTRTTF copies a triangular matrix A from standard full format (TR)
  38 *> to rectangular full packed format (TF) .
  39 *> \endverbatim
  40 *
  41 *  Arguments:
  42 *  ==========
  43 *
  44 *> \param[in] TRANSR
  45 *> \verbatim
  46 *>          TRANSR is CHARACTER*1
  47 *>          = 'N':  ARF in Normal mode is wanted;
  48 *>          = 'C':  ARF in Conjugate Transpose mode is wanted;
  49 *> \endverbatim
  50 *>
  51 *> \param[in] UPLO
  52 *> \verbatim
  53 *>          UPLO is CHARACTER*1
  54 *>          = 'U':  A is upper triangular;
  55 *>          = 'L':  A is lower triangular.
  56 *> \endverbatim
  57 *>
  58 *> \param[in] N
  59 *> \verbatim
  60 *>          N is INTEGER
  61 *>          The order of the matrix A.  N >= 0.
  62 *> \endverbatim
  63 *>
  64 *> \param[in] A
  65 *> \verbatim
  66 *>          A is COMPLEX array, dimension ( LDA, N )
  67 *>          On entry, the triangular matrix A.  If UPLO = 'U', the
  68 *>          leading N-by-N upper triangular part of the array A contains
  69 *>          the upper triangular matrix, and the strictly lower
  70 *>          triangular part of A is not referenced.  If UPLO = 'L', the
  71 *>          leading N-by-N lower triangular part of the array A contains
  72 *>          the lower triangular matrix, and the strictly upper
  73 *>          triangular part of A is not referenced.
  74 *> \endverbatim
  75 *>
  76 *> \param[in] LDA
  77 *> \verbatim
  78 *>          LDA is INTEGER
  79 *>          The leading dimension of the matrix A.  LDA >= max(1,N).
  80 *> \endverbatim
  81 *>
  82 *> \param[out] ARF
  83 *> \verbatim
  84 *>          ARF is COMPLEX array, dimension ( N*(N+1)/2 ),
  85 *>          On exit, the upper or lower triangular matrix A stored in
  86 *>          RFP format. For a further discussion see Notes below.
  87 *> \endverbatim
  88 *>
  89 *> \param[out] INFO
  90 *> \verbatim
  91 *>          INFO is INTEGER
  92 *>          = 0:  successful exit
  93 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  94 *> \endverbatim
  95 *
  96 *  Authors:
  97 *  ========
  98 *
  99 *> \author Univ. of Tennessee
 100 *> \author Univ. of California Berkeley
 101 *> \author Univ. of Colorado Denver
 102 *> \author NAG Ltd.
 103 *
 104 *> \date June 2016
 105 *
 106 *> \ingroup complexOTHERcomputational
 107 *
 108 *> \par Further Details:
 109 *  =====================
 110 *>
 111 *> \verbatim
 112 *>
 113 *>  We first consider Standard Packed Format when N is even.
 114 *>  We give an example where N = 6.
 115 *>
 116 *>      AP is Upper             AP is Lower
 117 *>
 118 *>   00 01 02 03 04 05       00
 119 *>      11 12 13 14 15       10 11
 120 *>         22 23 24 25       20 21 22
 121 *>            33 34 35       30 31 32 33
 122 *>               44 45       40 41 42 43 44
 123 *>                  55       50 51 52 53 54 55
 124 *>
 125 *>
 126 *>  Let TRANSR = 'N'. RFP holds AP as follows:
 127 *>  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
 128 *>  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
 129 *>  conjugate-transpose of the first three columns of AP upper.
 130 *>  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
 131 *>  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
 132 *>  conjugate-transpose of the last three columns of AP lower.
 133 *>  To denote conjugate we place -- above the element. This covers the
 134 *>  case N even and TRANSR = 'N'.
 135 *>
 136 *>         RFP A                   RFP A
 137 *>
 138 *>                                -- -- --
 139 *>        03 04 05                33 43 53
 140 *>                                   -- --
 141 *>        13 14 15                00 44 54
 142 *>                                      --
 143 *>        23 24 25                10 11 55
 144 *>
 145 *>        33 34 35                20 21 22
 146 *>        --
 147 *>        00 44 45                30 31 32
 148 *>        -- --
 149 *>        01 11 55                40 41 42
 150 *>        -- -- --
 151 *>        02 12 22                50 51 52
 152 *>
 153 *>  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
 154 *>  transpose of RFP A above. One therefore gets:
 155 *>
 156 *>
 157 *>           RFP A                   RFP A
 158 *>
 159 *>     -- -- -- --                -- -- -- -- -- --
 160 *>     03 13 23 33 00 01 02    33 00 10 20 30 40 50
 161 *>     -- -- -- -- --                -- -- -- -- --
 162 *>     04 14 24 34 44 11 12    43 44 11 21 31 41 51
 163 *>     -- -- -- -- -- --                -- -- -- --
 164 *>     05 15 25 35 45 55 22    53 54 55 22 32 42 52
 165 *>
 166 *>
 167 *>  We next  consider Standard Packed Format when N is odd.
 168 *>  We give an example where N = 5.
 169 *>
 170 *>     AP is Upper                 AP is Lower
 171 *>
 172 *>   00 01 02 03 04              00
 173 *>      11 12 13 14              10 11
 174 *>         22 23 24              20 21 22
 175 *>            33 34              30 31 32 33
 176 *>               44              40 41 42 43 44
 177 *>
 178 *>
 179 *>  Let TRANSR = 'N'. RFP holds AP as follows:
 180 *>  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
 181 *>  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
 182 *>  conjugate-transpose of the first two   columns of AP upper.
 183 *>  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
 184 *>  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
 185 *>  conjugate-transpose of the last two   columns of AP lower.
 186 *>  To denote conjugate we place -- above the element. This covers the
 187 *>  case N odd  and TRANSR = 'N'.
 188 *>
 189 *>         RFP A                   RFP A
 190 *>
 191 *>                                   -- --
 192 *>        02 03 04                00 33 43
 193 *>                                      --
 194 *>        12 13 14                10 11 44
 195 *>
 196 *>        22 23 24                20 21 22
 197 *>        --
 198 *>        00 33 34                30 31 32
 199 *>        -- --
 200 *>        01 11 44                40 41 42
 201 *>
 202 *>  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
 203 *>  transpose of RFP A above. One therefore gets:
 204 *>
 205 *>
 206 *>           RFP A                   RFP A
 207 *>
 208 *>     -- -- --                   -- -- -- -- -- --
 209 *>     02 12 22 00 01             00 10 20 30 40 50
 210 *>     -- -- -- --                   -- -- -- -- --
 211 *>     03 13 23 33 11             33 11 21 31 41 51
 212 *>     -- -- -- -- --                   -- -- -- --
 213 *>     04 14 24 34 44             43 44 22 32 42 52
 214 *> \endverbatim
 215 *>
 216 *  =====================================================================
 217       SUBROUTINE CTRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO )
 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 *
 537       END