![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZTRTTF 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZTRTTF + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztrttf.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztrttf.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztrttf.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZTRTTF( TRANSR, UPLO, N, A, LDA, ARF, 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 *> ZTRTTF copies a triangular matrix A from standard full format (TR) 00038 *> to rectangular full packed format (TF) . 00039 *> \endverbatim 00040 * 00041 * Arguments: 00042 * ========== 00043 * 00044 *> \param[in] TRANSR 00045 *> \verbatim 00046 *> TRANSR is CHARACTER*1 00047 *> = 'N': ARF in Normal mode is wanted; 00048 *> = 'C': ARF in Conjugate Transpose mode is wanted; 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] A 00065 *> \verbatim 00066 *> A is COMPLEX*16 array, dimension ( LDA, N ) 00067 *> On entry, the triangular matrix A. If UPLO = 'U', the 00068 *> leading N-by-N upper triangular part of the array A contains 00069 *> the upper triangular matrix, and the strictly lower 00070 *> triangular part of A is not referenced. If UPLO = 'L', the 00071 *> leading N-by-N lower triangular part of the array A contains 00072 *> the lower triangular matrix, and the strictly upper 00073 *> triangular part of A is not referenced. 00074 *> \endverbatim 00075 *> 00076 *> \param[in] LDA 00077 *> \verbatim 00078 *> LDA is INTEGER 00079 *> The leading dimension of the matrix A. LDA >= max(1,N). 00080 *> \endverbatim 00081 *> 00082 *> \param[out] ARF 00083 *> \verbatim 00084 *> ARF is COMPLEX*16 array, dimension ( N*(N+1)/2 ), 00085 *> On exit, the upper or lower triangular matrix A stored in 00086 *> RFP format. For a further discussion see Notes below. 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 ZTRTTF( TRANSR, UPLO, N, A, LDA, ARF, 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 I, IJ, J, K, L, N1, N2, NT, NX2, NP1X2 00239 * .. 00240 * .. External Functions .. 00241 LOGICAL LSAME 00242 EXTERNAL LSAME 00243 * .. 00244 * .. External Subroutines .. 00245 EXTERNAL XERBLA 00246 * .. 00247 * .. Intrinsic Functions .. 00248 INTRINSIC DCONJG, MAX, MOD 00249 * .. 00250 * .. Executable Statements .. 00251 * 00252 * Test the input parameters. 00253 * 00254 INFO = 0 00255 NORMALTRANSR = LSAME( TRANSR, 'N' ) 00256 LOWER = LSAME( UPLO, 'L' ) 00257 IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN 00258 INFO = -1 00259 ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN 00260 INFO = -2 00261 ELSE IF( N.LT.0 ) THEN 00262 INFO = -3 00263 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00264 INFO = -5 00265 END IF 00266 IF( INFO.NE.0 ) THEN 00267 CALL XERBLA( 'ZTRTTF', -INFO ) 00268 RETURN 00269 END IF 00270 * 00271 * Quick return if possible 00272 * 00273 IF( N.LE.1 ) THEN 00274 IF( N.EQ.1 ) THEN 00275 IF( NORMALTRANSR ) THEN 00276 ARF( 0 ) = A( 0, 0 ) 00277 ELSE 00278 ARF( 0 ) = DCONJG( A( 0, 0 ) ) 00279 END IF 00280 END IF 00281 RETURN 00282 END IF 00283 * 00284 * Size of array ARF(1:2,0:nt-1) 00285 * 00286 NT = N*( N+1 ) / 2 00287 * 00288 * set N1 and N2 depending on LOWER: for N even N1=N2=K 00289 * 00290 IF( LOWER ) THEN 00291 N2 = N / 2 00292 N1 = N - N2 00293 ELSE 00294 N1 = N / 2 00295 N2 = N - N1 00296 END IF 00297 * 00298 * If N is odd, set NISODD = .TRUE., LDA=N+1 and A is (N+1)--by--K2. 00299 * If N is even, set K = N/2 and NISODD = .FALSE., LDA=N and A is 00300 * N--by--(N+1)/2. 00301 * 00302 IF( MOD( N, 2 ).EQ.0 ) THEN 00303 K = N / 2 00304 NISODD = .FALSE. 00305 IF( .NOT.LOWER ) 00306 $ NP1X2 = N + N + 2 00307 ELSE 00308 NISODD = .TRUE. 00309 IF( .NOT.LOWER ) 00310 $ NX2 = N + N 00311 END IF 00312 * 00313 IF( NISODD ) THEN 00314 * 00315 * N is odd 00316 * 00317 IF( NORMALTRANSR ) THEN 00318 * 00319 * N is odd and TRANSR = 'N' 00320 * 00321 IF( LOWER ) THEN 00322 * 00323 * SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) ) 00324 * T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0) 00325 * T1 -> a(0), T2 -> a(n), S -> a(n1); lda=n 00326 * 00327 IJ = 0 00328 DO J = 0, N2 00329 DO I = N1, N2 + J 00330 ARF( IJ ) = DCONJG( A( N2+J, I ) ) 00331 IJ = IJ + 1 00332 END DO 00333 DO I = J, N - 1 00334 ARF( IJ ) = A( I, J ) 00335 IJ = IJ + 1 00336 END DO 00337 END DO 00338 * 00339 ELSE 00340 * 00341 * SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1) 00342 * T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0) 00343 * T1 -> a(n2), T2 -> a(n1), S -> a(0); lda=n 00344 * 00345 IJ = NT - N 00346 DO J = N - 1, N1, -1 00347 DO I = 0, J 00348 ARF( IJ ) = A( I, J ) 00349 IJ = IJ + 1 00350 END DO 00351 DO L = J - N1, N1 - 1 00352 ARF( IJ ) = DCONJG( A( J-N1, L ) ) 00353 IJ = IJ + 1 00354 END DO 00355 IJ = IJ - NX2 00356 END DO 00357 * 00358 END IF 00359 * 00360 ELSE 00361 * 00362 * N is odd and TRANSR = 'C' 00363 * 00364 IF( LOWER ) THEN 00365 * 00366 * SRPA for LOWER, TRANSPOSE and N is odd 00367 * T1 -> A(0,0) , T2 -> A(1,0) , S -> A(0,n1) 00368 * T1 -> A(0+0) , T2 -> A(1+0) , S -> A(0+n1*n1); lda=n1 00369 * 00370 IJ = 0 00371 DO J = 0, N2 - 1 00372 DO I = 0, J 00373 ARF( IJ ) = DCONJG( A( J, I ) ) 00374 IJ = IJ + 1 00375 END DO 00376 DO I = N1 + J, N - 1 00377 ARF( IJ ) = A( I, N1+J ) 00378 IJ = IJ + 1 00379 END DO 00380 END DO 00381 DO J = N2, N - 1 00382 DO I = 0, N1 - 1 00383 ARF( IJ ) = DCONJG( A( J, I ) ) 00384 IJ = IJ + 1 00385 END DO 00386 END DO 00387 * 00388 ELSE 00389 * 00390 * SRPA for UPPER, TRANSPOSE and N is odd 00391 * T1 -> A(0,n1+1), T2 -> A(0,n1), S -> A(0,0) 00392 * T1 -> A(n2*n2), T2 -> A(n1*n2), S -> A(0); lda=n2 00393 * 00394 IJ = 0 00395 DO J = 0, N1 00396 DO I = N1, N - 1 00397 ARF( IJ ) = DCONJG( A( J, I ) ) 00398 IJ = IJ + 1 00399 END DO 00400 END DO 00401 DO J = 0, N1 - 1 00402 DO I = 0, J 00403 ARF( IJ ) = A( I, J ) 00404 IJ = IJ + 1 00405 END DO 00406 DO L = N2 + J, N - 1 00407 ARF( IJ ) = DCONJG( A( N2+J, L ) ) 00408 IJ = IJ + 1 00409 END DO 00410 END DO 00411 * 00412 END IF 00413 * 00414 END IF 00415 * 00416 ELSE 00417 * 00418 * N is even 00419 * 00420 IF( NORMALTRANSR ) THEN 00421 * 00422 * N is even and TRANSR = 'N' 00423 * 00424 IF( LOWER ) THEN 00425 * 00426 * SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) ) 00427 * T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0) 00428 * T1 -> a(1), T2 -> a(0), S -> a(k+1); lda=n+1 00429 * 00430 IJ = 0 00431 DO J = 0, K - 1 00432 DO I = K, K + J 00433 ARF( IJ ) = DCONJG( A( K+J, I ) ) 00434 IJ = IJ + 1 00435 END DO 00436 DO I = J, N - 1 00437 ARF( IJ ) = A( I, J ) 00438 IJ = IJ + 1 00439 END DO 00440 END DO 00441 * 00442 ELSE 00443 * 00444 * SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) ) 00445 * T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0) 00446 * T1 -> a(k+1), T2 -> a(k), S -> a(0); lda=n+1 00447 * 00448 IJ = NT - N - 1 00449 DO J = N - 1, K, -1 00450 DO I = 0, J 00451 ARF( IJ ) = A( I, J ) 00452 IJ = IJ + 1 00453 END DO 00454 DO L = J - K, K - 1 00455 ARF( IJ ) = DCONJG( A( J-K, L ) ) 00456 IJ = IJ + 1 00457 END DO 00458 IJ = IJ - NP1X2 00459 END DO 00460 * 00461 END IF 00462 * 00463 ELSE 00464 * 00465 * N is even and TRANSR = 'C' 00466 * 00467 IF( LOWER ) THEN 00468 * 00469 * SRPA for LOWER, TRANSPOSE and N is even (see paper, A=B) 00470 * T1 -> A(0,1) , T2 -> A(0,0) , S -> A(0,k+1) : 00471 * T1 -> A(0+k) , T2 -> A(0+0) , S -> A(0+k*(k+1)); lda=k 00472 * 00473 IJ = 0 00474 J = K 00475 DO I = K, N - 1 00476 ARF( IJ ) = A( I, J ) 00477 IJ = IJ + 1 00478 END DO 00479 DO J = 0, K - 2 00480 DO I = 0, J 00481 ARF( IJ ) = DCONJG( A( J, I ) ) 00482 IJ = IJ + 1 00483 END DO 00484 DO I = K + 1 + J, N - 1 00485 ARF( IJ ) = A( I, K+1+J ) 00486 IJ = IJ + 1 00487 END DO 00488 END DO 00489 DO J = K - 1, N - 1 00490 DO I = 0, K - 1 00491 ARF( IJ ) = DCONJG( A( J, I ) ) 00492 IJ = IJ + 1 00493 END DO 00494 END DO 00495 * 00496 ELSE 00497 * 00498 * SRPA for UPPER, TRANSPOSE and N is even (see paper, A=B) 00499 * T1 -> A(0,k+1) , T2 -> A(0,k) , S -> A(0,0) 00500 * T1 -> A(0+k*(k+1)) , T2 -> A(0+k*k) , S -> A(0+0)); lda=k 00501 * 00502 IJ = 0 00503 DO J = 0, K 00504 DO I = K, N - 1 00505 ARF( IJ ) = DCONJG( A( J, I ) ) 00506 IJ = IJ + 1 00507 END DO 00508 END DO 00509 DO J = 0, K - 2 00510 DO I = 0, J 00511 ARF( IJ ) = A( I, J ) 00512 IJ = IJ + 1 00513 END DO 00514 DO L = K + 1 + J, N - 1 00515 ARF( IJ ) = DCONJG( A( K+1+J, L ) ) 00516 IJ = IJ + 1 00517 END DO 00518 END DO 00519 * 00520 * Note that here J = K-1 00521 * 00522 DO I = 0, J 00523 ARF( IJ ) = A( I, J ) 00524 IJ = IJ + 1 00525 END DO 00526 * 00527 END IF 00528 * 00529 END IF 00530 * 00531 END IF 00532 * 00533 RETURN 00534 * 00535 * End of ZTRTTF 00536 * 00537 END