![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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