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