LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dtfttr.f
Go to the documentation of this file.
00001 *> \brief \b DTFTTR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DTFTTR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtfttr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtfttr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtfttr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DTFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER          TRANSR, UPLO
00025 *       INTEGER            INFO, N, LDA
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       DOUBLE PRECISION   A( 0: LDA-1, 0: * ), ARF( 0: * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> DTFTTR copies a triangular matrix A from rectangular full packed
00038 *> format (TF) to standard full format (TR).
00039 *> \endverbatim
00040 *
00041 *  Arguments:
00042 *  ==========
00043 *
00044 *> \param[in] TRANSR
00045 *> \verbatim
00046 *>          TRANSR is CHARACTER*1
00047 *>          = 'N':  ARF is in Normal format;
00048 *>          = 'T':  ARF is in Transpose format.
00049 *> \endverbatim
00050 *>
00051 *> \param[in] UPLO
00052 *> \verbatim
00053 *>          UPLO is CHARACTER*1
00054 *>          = 'U':  A is upper triangular;
00055 *>          = 'L':  A is lower triangular.
00056 *> \endverbatim
00057 *>
00058 *> \param[in] N
00059 *> \verbatim
00060 *>          N is INTEGER
00061 *>          The order of the matrices ARF and A. N >= 0.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] ARF
00065 *> \verbatim
00066 *>          ARF is DOUBLE PRECISION array, dimension (N*(N+1)/2).
00067 *>          On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
00068 *>          matrix A in RFP format. See the "Notes" below for more
00069 *>          details.
00070 *> \endverbatim
00071 *>
00072 *> \param[out] A
00073 *> \verbatim
00074 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
00075 *>          On exit, the triangular matrix A.  If UPLO = 'U', the
00076 *>          leading N-by-N upper triangular part of the array A contains
00077 *>          the upper triangular matrix, and the strictly lower
00078 *>          triangular part of A is not referenced.  If UPLO = 'L', the
00079 *>          leading N-by-N lower triangular part of the array A contains
00080 *>          the lower triangular matrix, and the strictly upper
00081 *>          triangular part of A is not referenced.
00082 *> \endverbatim
00083 *>
00084 *> \param[in] LDA
00085 *> \verbatim
00086 *>          LDA is INTEGER
00087 *>          The leading dimension of the array A.  LDA >= max(1,N).
00088 *> \endverbatim
00089 *>
00090 *> \param[out] INFO
00091 *> \verbatim
00092 *>          INFO is INTEGER
00093 *>          = 0:  successful exit
00094 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
00095 *> \endverbatim
00096 *
00097 *  Authors:
00098 *  ========
00099 *
00100 *> \author Univ. of Tennessee 
00101 *> \author Univ. of California Berkeley 
00102 *> \author Univ. of Colorado Denver 
00103 *> \author NAG Ltd. 
00104 *
00105 *> \date November 2011
00106 *
00107 *> \ingroup doubleOTHERcomputational
00108 *
00109 *> \par Further Details:
00110 *  =====================
00111 *>
00112 *> \verbatim
00113 *>
00114 *>  We first consider Rectangular Full Packed (RFP) Format when N is
00115 *>  even. We give an example where N = 6.
00116 *>
00117 *>      AP is Upper             AP is Lower
00118 *>
00119 *>   00 01 02 03 04 05       00
00120 *>      11 12 13 14 15       10 11
00121 *>         22 23 24 25       20 21 22
00122 *>            33 34 35       30 31 32 33
00123 *>               44 45       40 41 42 43 44
00124 *>                  55       50 51 52 53 54 55
00125 *>
00126 *>
00127 *>  Let TRANSR = 'N'. RFP holds AP as follows:
00128 *>  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
00129 *>  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
00130 *>  the transpose of the first three columns of AP upper.
00131 *>  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
00132 *>  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
00133 *>  the transpose of the last three columns of AP lower.
00134 *>  This covers the case N even and TRANSR = 'N'.
00135 *>
00136 *>         RFP A                   RFP A
00137 *>
00138 *>        03 04 05                33 43 53
00139 *>        13 14 15                00 44 54
00140 *>        23 24 25                10 11 55
00141 *>        33 34 35                20 21 22
00142 *>        00 44 45                30 31 32
00143 *>        01 11 55                40 41 42
00144 *>        02 12 22                50 51 52
00145 *>
00146 *>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
00147 *>  transpose of RFP A above. One therefore gets:
00148 *>
00149 *>
00150 *>           RFP A                   RFP A
00151 *>
00152 *>     03 13 23 33 00 01 02    33 00 10 20 30 40 50
00153 *>     04 14 24 34 44 11 12    43 44 11 21 31 41 51
00154 *>     05 15 25 35 45 55 22    53 54 55 22 32 42 52
00155 *>
00156 *>
00157 *>  We then consider Rectangular Full Packed (RFP) Format when N is
00158 *>  odd. We give an example where N = 5.
00159 *>
00160 *>     AP is Upper                 AP is Lower
00161 *>
00162 *>   00 01 02 03 04              00
00163 *>      11 12 13 14              10 11
00164 *>         22 23 24              20 21 22
00165 *>            33 34              30 31 32 33
00166 *>               44              40 41 42 43 44
00167 *>
00168 *>
00169 *>  Let TRANSR = 'N'. RFP holds AP as follows:
00170 *>  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
00171 *>  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
00172 *>  the transpose of the first two columns of AP upper.
00173 *>  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
00174 *>  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
00175 *>  the transpose of the last two columns of AP lower.
00176 *>  This covers the case N odd and TRANSR = 'N'.
00177 *>
00178 *>         RFP A                   RFP A
00179 *>
00180 *>        02 03 04                00 33 43
00181 *>        12 13 14                10 11 44
00182 *>        22 23 24                20 21 22
00183 *>        00 33 34                30 31 32
00184 *>        01 11 44                40 41 42
00185 *>
00186 *>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
00187 *>  transpose of RFP A above. One therefore gets:
00188 *>
00189 *>           RFP A                   RFP A
00190 *>
00191 *>     02 12 22 00 01             00 10 20 30 40 50
00192 *>     03 13 23 33 11             33 11 21 31 41 51
00193 *>     04 14 24 34 44             43 44 22 32 42 52
00194 *> \endverbatim
00195 *
00196 *  =====================================================================
00197       SUBROUTINE DTFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )
00198 *
00199 *  -- LAPACK computational routine (version 3.4.0) --
00200 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00201 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00202 *     November 2011
00203 *
00204 *     .. Scalar Arguments ..
00205       CHARACTER          TRANSR, UPLO
00206       INTEGER            INFO, N, LDA
00207 *     ..
00208 *     .. Array Arguments ..
00209       DOUBLE PRECISION   A( 0: LDA-1, 0: * ), ARF( 0: * )
00210 *     ..
00211 *
00212 *  =====================================================================
00213 *
00214 *     ..
00215 *     .. Local Scalars ..
00216       LOGICAL            LOWER, NISODD, NORMALTRANSR
00217       INTEGER            N1, N2, K, NT, NX2, NP1X2
00218       INTEGER            I, J, L, IJ
00219 *     ..
00220 *     .. External Functions ..
00221       LOGICAL            LSAME
00222       EXTERNAL           LSAME
00223 *     ..
00224 *     .. External Subroutines ..
00225       EXTERNAL           XERBLA
00226 *     ..
00227 *     .. Intrinsic Functions ..
00228       INTRINSIC          MAX, MOD
00229 *     ..
00230 *     .. Executable Statements ..
00231 *
00232 *     Test the input parameters.
00233 *
00234       INFO = 0
00235       NORMALTRANSR = LSAME( TRANSR, 'N' )
00236       LOWER = LSAME( UPLO, 'L' )
00237       IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
00238          INFO = -1
00239       ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
00240          INFO = -2
00241       ELSE IF( N.LT.0 ) THEN
00242          INFO = -3
00243       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00244          INFO = -6
00245       END IF
00246       IF( INFO.NE.0 ) THEN
00247          CALL XERBLA( 'DTFTTR', -INFO )
00248          RETURN
00249       END IF
00250 *
00251 *     Quick return if possible
00252 *
00253       IF( N.LE.1 ) THEN
00254          IF( N.EQ.1 ) THEN
00255             A( 0, 0 ) = ARF( 0 )
00256          END IF
00257          RETURN
00258       END IF
00259 *
00260 *     Size of array ARF(0:nt-1)
00261 *
00262       NT = N*( N+1 ) / 2
00263 *
00264 *     set N1 and N2 depending on LOWER: for N even N1=N2=K
00265 *
00266       IF( LOWER ) THEN
00267          N2 = N / 2
00268          N1 = N - N2
00269       ELSE
00270          N1 = N / 2
00271          N2 = N - N1
00272       END IF
00273 *
00274 *     If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2.
00275 *     If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is
00276 *     N--by--(N+1)/2.
00277 *
00278       IF( MOD( N, 2 ).EQ.0 ) THEN
00279          K = N / 2
00280          NISODD = .FALSE.
00281          IF( .NOT.LOWER )
00282      $      NP1X2 = N + N + 2
00283       ELSE
00284          NISODD = .TRUE.
00285          IF( .NOT.LOWER )
00286      $      NX2 = N + N
00287       END IF
00288 *
00289       IF( NISODD ) THEN
00290 *
00291 *        N is odd
00292 *
00293          IF( NORMALTRANSR ) THEN
00294 *
00295 *           N is odd and TRANSR = 'N'
00296 *
00297             IF( LOWER ) THEN
00298 *
00299 *              N is odd, TRANSR = 'N', and UPLO = 'L'
00300 *
00301                IJ = 0
00302                DO J = 0, N2
00303                   DO I = N1, N2 + J
00304                      A( N2+J, I ) = ARF( IJ )
00305                      IJ = IJ + 1
00306                   END DO
00307                   DO I = J, N - 1
00308                      A( I, J ) = ARF( IJ )
00309                      IJ = IJ + 1
00310                   END DO
00311                END DO
00312 *
00313             ELSE
00314 *
00315 *              N is odd, TRANSR = 'N', and UPLO = 'U'
00316 *
00317                IJ = NT - N
00318                DO J = N - 1, N1, -1
00319                   DO I = 0, J
00320                      A( I, J ) = ARF( IJ )
00321                      IJ = IJ + 1
00322                   END DO
00323                   DO L = J - N1, N1 - 1
00324                      A( J-N1, L ) = ARF( IJ )
00325                      IJ = IJ + 1
00326                   END DO
00327                   IJ = IJ - NX2
00328                END DO
00329 *
00330             END IF
00331 *
00332          ELSE
00333 *
00334 *           N is odd and TRANSR = 'T'
00335 *
00336             IF( LOWER ) THEN
00337 *
00338 *              N is odd, TRANSR = 'T', and UPLO = 'L'
00339 *
00340                IJ = 0
00341                DO J = 0, N2 - 1
00342                   DO I = 0, J
00343                      A( J, I ) = ARF( IJ )
00344                      IJ = IJ + 1
00345                   END DO
00346                   DO I = N1 + J, N - 1
00347                      A( I, N1+J ) = ARF( IJ )
00348                      IJ = IJ + 1
00349                   END DO
00350                END DO
00351                DO J = N2, N - 1
00352                   DO I = 0, N1 - 1
00353                      A( J, I ) = ARF( IJ )
00354                      IJ = IJ + 1
00355                   END DO
00356                END DO
00357 *
00358             ELSE
00359 *
00360 *              N is odd, TRANSR = 'T', and UPLO = 'U'
00361 *
00362                IJ = 0
00363                DO J = 0, N1
00364                   DO I = N1, N - 1
00365                      A( J, I ) = ARF( IJ )
00366                      IJ = IJ + 1
00367                   END DO
00368                END DO
00369                DO J = 0, N1 - 1
00370                   DO I = 0, J
00371                      A( I, J ) = ARF( IJ )
00372                      IJ = IJ + 1
00373                   END DO
00374                   DO L = N2 + J, N - 1
00375                      A( N2+J, L ) = ARF( IJ )
00376                      IJ = IJ + 1
00377                   END DO
00378                END DO
00379 *
00380             END IF
00381 *
00382          END IF
00383 *
00384       ELSE
00385 *
00386 *        N is even
00387 *
00388          IF( NORMALTRANSR ) THEN
00389 *
00390 *           N is even and TRANSR = 'N'
00391 *
00392             IF( LOWER ) THEN
00393 *
00394 *              N is even, TRANSR = 'N', and UPLO = 'L'
00395 *
00396                IJ = 0
00397                DO J = 0, K - 1
00398                   DO I = K, K + J
00399                      A( K+J, I ) = ARF( IJ )
00400                      IJ = IJ + 1
00401                   END DO
00402                   DO I = J, N - 1
00403                      A( I, J ) = ARF( IJ )
00404                      IJ = IJ + 1
00405                   END DO
00406                END DO
00407 *
00408             ELSE
00409 *
00410 *              N is even, TRANSR = 'N', and UPLO = 'U'
00411 *
00412                IJ = NT - N - 1
00413                DO J = N - 1, K, -1
00414                   DO I = 0, J
00415                      A( I, J ) = ARF( IJ )
00416                      IJ = IJ + 1
00417                   END DO
00418                   DO L = J - K, K - 1
00419                      A( J-K, L ) = ARF( IJ )
00420                      IJ = IJ + 1
00421                   END DO
00422                   IJ = IJ - NP1X2
00423                END DO
00424 *
00425             END IF
00426 *
00427          ELSE
00428 *
00429 *           N is even and TRANSR = 'T'
00430 *
00431             IF( LOWER ) THEN
00432 *
00433 *              N is even, TRANSR = 'T', and UPLO = 'L'
00434 *
00435                IJ = 0
00436                J = K
00437                DO I = K, N - 1
00438                   A( I, J ) = ARF( IJ )
00439                   IJ = IJ + 1
00440                END DO
00441                DO J = 0, K - 2
00442                   DO I = 0, J
00443                      A( J, I ) = ARF( IJ )
00444                      IJ = IJ + 1
00445                   END DO
00446                   DO I = K + 1 + J, N - 1
00447                      A( I, K+1+J ) = ARF( IJ )
00448                      IJ = IJ + 1
00449                   END DO
00450                END DO
00451                DO J = K - 1, N - 1
00452                   DO I = 0, K - 1
00453                      A( J, I ) = ARF( IJ )
00454                      IJ = IJ + 1
00455                   END DO
00456                END DO
00457 *
00458             ELSE
00459 *
00460 *              N is even, TRANSR = 'T', and UPLO = 'U'
00461 *
00462                IJ = 0
00463                DO J = 0, K
00464                   DO I = K, N - 1
00465                      A( J, I ) = ARF( IJ )
00466                      IJ = IJ + 1
00467                   END DO
00468                END DO
00469                DO J = 0, K - 2
00470                   DO I = 0, J
00471                      A( I, J ) = ARF( IJ )
00472                      IJ = IJ + 1
00473                   END DO
00474                   DO L = K + 1 + J, N - 1
00475                      A( K+1+J, L ) = ARF( IJ )
00476                      IJ = IJ + 1
00477                   END DO
00478                END DO
00479 *              Note that here, on exit of the loop, J = K-1
00480                DO I = 0, J
00481                   A( I, J ) = ARF( IJ )
00482                   IJ = IJ + 1
00483                END DO
00484 *
00485             END IF
00486 *
00487          END IF
00488 *
00489       END IF
00490 *
00491       RETURN
00492 *
00493 *     End of DTFTTR
00494 *
00495       END
 All Files Functions