SRC/stpttf.f

   1 *> \brief \b STPTTF copies a triangular matrix from the standard packed format (TP) 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 STPTTF + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpttf.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpttf.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpttf.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE STPTTF( TRANSR, UPLO, N, AP, ARF, INFO )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          TRANSR, UPLO
  25 *       INTEGER            INFO, N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       REAL               AP( 0: * ), ARF( 0: * )
  29 *
  30 *
  31 *> \par Purpose:
  32 *  =============
  33 *>
  34 *> \verbatim
  35 *>
  36 *> STPTTF copies a triangular matrix A from standard packed format (TP)
  37 *> to rectangular full packed format (TF).
  38 *> \endverbatim
  39 *
  40 *  Arguments:
  41 *  ==========
  42 *
  43 *> \param[in] TRANSR
  44 *> \verbatim
  45 *>          TRANSR is CHARACTER*1
  46 *>          = 'N':  ARF in Normal format is wanted;
  47 *>          = 'T':  ARF in Conjugate-transpose format is wanted.
  48 *> \endverbatim
  49 *>
  50 *> \param[in] UPLO
  51 *> \verbatim
  52 *>          UPLO is CHARACTER*1
  53 *>          = 'U':  A is upper triangular;
  54 *>          = 'L':  A is lower triangular.
  55 *> \endverbatim
  56 *>
  57 *> \param[in] N
  58 *> \verbatim
  59 *>          N is INTEGER
  60 *>          The order of the matrix A.  N >= 0.
  61 *> \endverbatim
  62 *>
  63 *> \param[in] AP
  64 *> \verbatim
  65 *>          AP is REAL array, dimension ( N*(N+1)/2 ),
  66 *>          On entry, the upper or lower triangular matrix A, packed
  67 *>          columnwise in a linear array. The j-th column of A is stored
  68 *>          in the array AP as follows:
  69 *>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
  70 *>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
  71 *> \endverbatim
  72 *>
  73 *> \param[out] ARF
  74 *> \verbatim
  75 *>          ARF is REAL array, dimension ( N*(N+1)/2 ),
  76 *>          On exit, the upper or lower triangular matrix A stored in
  77 *>          RFP format. For a further discussion see Notes below.
  78 *> \endverbatim
  79 *>
  80 *> \param[out] INFO
  81 *> \verbatim
  82 *>          INFO is INTEGER
  83 *>          = 0:  successful exit
  84 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  85 *> \endverbatim
  86 *
  87 *  Authors:
  88 *  ========
  89 *
  90 *> \author Univ. of Tennessee
  91 *> \author Univ. of California Berkeley
  92 *> \author Univ. of Colorado Denver
  93 *> \author NAG Ltd.
  94 *
  95 *> \date September 2012
  96 *
  97 *> \ingroup realOTHERcomputational
  98 *
  99 *> \par Further Details:
 100 *  =====================
 101 *>
 102 *> \verbatim
 103 *>
 104 *>  We first consider Rectangular Full Packed (RFP) Format when N is
 105 *>  even. We give an example where N = 6.
 106 *>
 107 *>      AP is Upper             AP is Lower
 108 *>
 109 *>   00 01 02 03 04 05       00
 110 *>      11 12 13 14 15       10 11
 111 *>         22 23 24 25       20 21 22
 112 *>            33 34 35       30 31 32 33
 113 *>               44 45       40 41 42 43 44
 114 *>                  55       50 51 52 53 54 55
 115 *>
 116 *>
 117 *>  Let TRANSR = 'N'. RFP holds AP as follows:
 118 *>  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
 119 *>  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
 120 *>  the transpose of the first three columns of AP upper.
 121 *>  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
 122 *>  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
 123 *>  the transpose of the last three columns of AP lower.
 124 *>  This covers the case N even and TRANSR = 'N'.
 125 *>
 126 *>         RFP A                   RFP A
 127 *>
 128 *>        03 04 05                33 43 53
 129 *>        13 14 15                00 44 54
 130 *>        23 24 25                10 11 55
 131 *>        33 34 35                20 21 22
 132 *>        00 44 45                30 31 32
 133 *>        01 11 55                40 41 42
 134 *>        02 12 22                50 51 52
 135 *>
 136 *>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
 137 *>  transpose of RFP A above. One therefore gets:
 138 *>
 139 *>
 140 *>           RFP A                   RFP A
 141 *>
 142 *>     03 13 23 33 00 01 02    33 00 10 20 30 40 50
 143 *>     04 14 24 34 44 11 12    43 44 11 21 31 41 51
 144 *>     05 15 25 35 45 55 22    53 54 55 22 32 42 52
 145 *>
 146 *>
 147 *>  We then consider Rectangular Full Packed (RFP) Format when N is
 148 *>  odd. We give an example where N = 5.
 149 *>
 150 *>     AP is Upper                 AP is Lower
 151 *>
 152 *>   00 01 02 03 04              00
 153 *>      11 12 13 14              10 11
 154 *>         22 23 24              20 21 22
 155 *>            33 34              30 31 32 33
 156 *>               44              40 41 42 43 44
 157 *>
 158 *>
 159 *>  Let TRANSR = 'N'. RFP holds AP as follows:
 160 *>  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
 161 *>  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
 162 *>  the transpose of the first two columns of AP upper.
 163 *>  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
 164 *>  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
 165 *>  the transpose of the last two columns of AP lower.
 166 *>  This covers the case N odd and TRANSR = 'N'.
 167 *>
 168 *>         RFP A                   RFP A
 169 *>
 170 *>        02 03 04                00 33 43
 171 *>        12 13 14                10 11 44
 172 *>        22 23 24                20 21 22
 173 *>        00 33 34                30 31 32
 174 *>        01 11 44                40 41 42
 175 *>
 176 *>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
 177 *>  transpose of RFP A above. One therefore gets:
 178 *>
 179 *>           RFP A                   RFP A
 180 *>
 181 *>     02 12 22 00 01             00 10 20 30 40 50
 182 *>     03 13 23 33 11             33 11 21 31 41 51
 183 *>     04 14 24 34 44             43 44 22 32 42 52
 184 *> \endverbatim
 185 *>
 186 *  =====================================================================
 187       SUBROUTINE STPTTF( TRANSR, UPLO, N, AP, ARF, INFO )
 188 *
 189 *  -- LAPACK computational routine (version 3.4.2) --
 190 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 191 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 192 *     September 2012
 193 *
 194 *     .. Scalar Arguments ..
 195       CHARACTER          TRANSR, UPLO
 196       INTEGER            INFO, N
 197 *     ..
 198 *     .. Array Arguments ..
 199       REAL               AP( 0: * ), ARF( 0: * )
 200 *
 201 *  =====================================================================
 202 *
 203 *     .. Parameters ..
 204 *     ..
 205 *     .. Local Scalars ..
 206       LOGICAL            LOWER, NISODD, NORMALTRANSR
 207       INTEGER            N1, N2, K, NT
 208       INTEGER            I, J, IJ
 209       INTEGER            IJP, JP, LDA, JS
 210 *     ..
 211 *     .. External Functions ..
 212       LOGICAL            LSAME
 213       EXTERNAL           LSAME
 214 *     ..
 215 *     .. External Subroutines ..
 216       EXTERNAL           XERBLA
 217 *     ..
 218 *     .. Intrinsic Functions ..
 219       INTRINSIC          MOD
 220 *     ..
 221 *     .. Executable Statements ..
 222 *
 223 *     Test the input parameters.
 224 *
 225       INFO = 0
 226       NORMALTRANSR = LSAME( TRANSR, 'N' )
 227       LOWER = LSAME( UPLO, 'L' )
 228       IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
 229          INFO = -1
 230       ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
 231          INFO = -2
 232       ELSE IF( N.LT.0 ) THEN
 233          INFO = -3
 234       END IF
 235       IF( INFO.NE.0 ) THEN
 236          CALL XERBLA( 'STPTTF', -INFO )
 237          RETURN
 238       END IF
 239 *
 240 *     Quick return if possible
 241 *
 242       IF( N.EQ.0 )
 243      $   RETURN
 244 *
 245       IF( N.EQ.1 ) THEN
 246          IF( NORMALTRANSR ) THEN
 247             ARF( 0 ) = AP( 0 )
 248          ELSE
 249             ARF( 0 ) = AP( 0 )
 250          END IF
 251          RETURN
 252       END IF
 253 *
 254 *     Size of array ARF(0:NT-1)
 255 *
 256       NT = N*( N+1 ) / 2
 257 *
 258 *     Set N1 and N2 depending on LOWER
 259 *
 260       IF( LOWER ) THEN
 261          N2 = N / 2
 262          N1 = N - N2
 263       ELSE
 264          N1 = N / 2
 265          N2 = N - N1
 266       END IF
 267 *
 268 *     If N is odd, set NISODD = .TRUE.
 269 *     If N is even, set K = N/2 and NISODD = .FALSE.
 270 *
 271 *     set lda of ARF^C; ARF^C is (0:(N+1)/2-1,0:N-noe)
 272 *     where noe = 0 if n is even, noe = 1 if n is odd
 273 *
 274       IF( MOD( N, 2 ).EQ.0 ) THEN
 275          K = N / 2
 276          NISODD = .FALSE.
 277          LDA = N + 1
 278       ELSE
 279          NISODD = .TRUE.
 280          LDA = N
 281       END IF
 282 *
 283 *     ARF^C has lda rows and n+1-noe cols
 284 *
 285       IF( .NOT.NORMALTRANSR )
 286      $   LDA = ( N+1 ) / 2
 287 *
 288 *     start execution: there are eight cases
 289 *
 290       IF( NISODD ) THEN
 291 *
 292 *        N is odd
 293 *
 294          IF( NORMALTRANSR ) THEN
 295 *
 296 *           N is odd and TRANSR = 'N'
 297 *
 298             IF( LOWER ) THEN
 299 *
 300 *              N is odd, TRANSR = 'N', and UPLO = 'L'
 301 *
 302                IJP = 0
 303                JP = 0
 304                DO J = 0, N2
 305                   DO I = J, N - 1
 306                      IJ = I + JP
 307                      ARF( IJ ) = AP( IJP )
 308                      IJP = IJP + 1
 309                   END DO
 310                   JP = JP + LDA
 311                END DO
 312                DO I = 0, N2 - 1
 313                   DO J = 1 + I, N2
 314                      IJ = I + J*LDA
 315                      ARF( IJ ) = AP( IJP )
 316                      IJP = IJP + 1
 317                   END DO
 318                END DO
 319 *
 320             ELSE
 321 *
 322 *              N is odd, TRANSR = 'N', and UPLO = 'U'
 323 *
 324                IJP = 0
 325                DO J = 0, N1 - 1
 326                   IJ = N2 + J
 327                   DO I = 0, J
 328                      ARF( IJ ) = AP( IJP )
 329                      IJP = IJP + 1
 330                      IJ = IJ + LDA
 331                   END DO
 332                END DO
 333                JS = 0
 334                DO J = N1, N - 1
 335                   IJ = JS
 336                   DO IJ = JS, JS + J
 337                      ARF( IJ ) = AP( IJP )
 338                      IJP = IJP + 1
 339                   END DO
 340                   JS = JS + LDA
 341                END DO
 342 *
 343             END IF
 344 *
 345          ELSE
 346 *
 347 *           N is odd and TRANSR = 'T'
 348 *
 349             IF( LOWER ) THEN
 350 *
 351 *              N is odd, TRANSR = 'T', and UPLO = 'L'
 352 *
 353                IJP = 0
 354                DO I = 0, N2
 355                   DO IJ = I*( LDA+1 ), N*LDA - 1, LDA
 356                      ARF( IJ ) = AP( IJP )
 357                      IJP = IJP + 1
 358                   END DO
 359                END DO
 360                JS = 1
 361                DO J = 0, N2 - 1
 362                   DO IJ = JS, JS + N2 - J - 1
 363                      ARF( IJ ) = AP( IJP )
 364                      IJP = IJP + 1
 365                   END DO
 366                   JS = JS + LDA + 1
 367                END DO
 368 *
 369             ELSE
 370 *
 371 *              N is odd, TRANSR = 'T', and UPLO = 'U'
 372 *
 373                IJP = 0
 374                JS = N2*LDA
 375                DO J = 0, N1 - 1
 376                   DO IJ = JS, JS + J
 377                      ARF( IJ ) = AP( IJP )
 378                      IJP = IJP + 1
 379                   END DO
 380                   JS = JS + LDA
 381                END DO
 382                DO I = 0, N1
 383                   DO IJ = I, I + ( N1+I )*LDA, LDA
 384                      ARF( IJ ) = AP( IJP )
 385                      IJP = IJP + 1
 386                   END DO
 387                END DO
 388 *
 389             END IF
 390 *
 391          END IF
 392 *
 393       ELSE
 394 *
 395 *        N is even
 396 *
 397          IF( NORMALTRANSR ) THEN
 398 *
 399 *           N is even and TRANSR = 'N'
 400 *
 401             IF( LOWER ) THEN
 402 *
 403 *              N is even, TRANSR = 'N', and UPLO = 'L'
 404 *
 405                IJP = 0
 406                JP = 0
 407                DO J = 0, K - 1
 408                   DO I = J, N - 1
 409                      IJ = 1 + I + JP
 410                      ARF( IJ ) = AP( IJP )
 411                      IJP = IJP + 1
 412                   END DO
 413                   JP = JP + LDA
 414                END DO
 415                DO I = 0, K - 1
 416                   DO J = I, K - 1
 417                      IJ = I + J*LDA
 418                      ARF( IJ ) = AP( IJP )
 419                      IJP = IJP + 1
 420                   END DO
 421                END DO
 422 *
 423             ELSE
 424 *
 425 *              N is even, TRANSR = 'N', and UPLO = 'U'
 426 *
 427                IJP = 0
 428                DO J = 0, K - 1
 429                   IJ = K + 1 + J
 430                   DO I = 0, J
 431                      ARF( IJ ) = AP( IJP )
 432                      IJP = IJP + 1
 433                      IJ = IJ + LDA
 434                   END DO
 435                END DO
 436                JS = 0
 437                DO J = K, N - 1
 438                   IJ = JS
 439                   DO IJ = JS, JS + J
 440                      ARF( IJ ) = AP( IJP )
 441                      IJP = IJP + 1
 442                   END DO
 443                   JS = JS + LDA
 444                END DO
 445 *
 446             END IF
 447 *
 448          ELSE
 449 *
 450 *           N is even and TRANSR = 'T'
 451 *
 452             IF( LOWER ) THEN
 453 *
 454 *              N is even, TRANSR = 'T', and UPLO = 'L'
 455 *
 456                IJP = 0
 457                DO I = 0, K - 1
 458                   DO IJ = I + ( I+1 )*LDA, ( N+1 )*LDA - 1, LDA
 459                      ARF( IJ ) = AP( IJP )
 460                      IJP = IJP + 1
 461                   END DO
 462                END DO
 463                JS = 0
 464                DO J = 0, K - 1
 465                   DO IJ = JS, JS + K - J - 1
 466                      ARF( IJ ) = AP( IJP )
 467                      IJP = IJP + 1
 468                   END DO
 469                   JS = JS + LDA + 1
 470                END DO
 471 *
 472             ELSE
 473 *
 474 *              N is even, TRANSR = 'T', and UPLO = 'U'
 475 *
 476                IJP = 0
 477                JS = ( K+1 )*LDA
 478                DO J = 0, K - 1
 479                   DO IJ = JS, JS + J
 480                      ARF( IJ ) = AP( IJP )
 481                      IJP = IJP + 1
 482                   END DO
 483                   JS = JS + LDA
 484                END DO
 485                DO I = 0, K - 1
 486                   DO IJ = I, I + ( K+I )*LDA, LDA
 487                      ARF( IJ ) = AP( IJP )
 488                      IJP = IJP + 1
 489                   END DO
 490                END DO
 491 *
 492             END IF
 493 *
 494          END IF
 495 *
 496       END IF
 497 *
 498       RETURN
 499 *
 500 *     End of STPTTF
 501 *
 502       END