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