![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZTFSM 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZTFSM + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztfsm.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztfsm.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztfsm.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, 00022 * B, LDB ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER TRANSR, DIAG, SIDE, TRANS, UPLO 00026 * INTEGER LDB, M, N 00027 * COMPLEX*16 ALPHA 00028 * .. 00029 * .. Array Arguments .. 00030 * COMPLEX*16 A( 0: * ), B( 0: LDB-1, 0: * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> Level 3 BLAS like routine for A in RFP Format. 00040 *> 00041 *> ZTFSM solves the matrix equation 00042 *> 00043 *> op( A )*X = alpha*B or X*op( A ) = alpha*B 00044 *> 00045 *> where alpha is a scalar, X and B are m by n matrices, A is a unit, or 00046 *> non-unit, upper or lower triangular matrix and op( A ) is one of 00047 *> 00048 *> op( A ) = A or op( A ) = A**H. 00049 *> 00050 *> A is in Rectangular Full Packed (RFP) Format. 00051 *> 00052 *> The matrix X is overwritten on B. 00053 *> \endverbatim 00054 * 00055 * Arguments: 00056 * ========== 00057 * 00058 *> \param[in] TRANSR 00059 *> \verbatim 00060 *> TRANSR is CHARACTER*1 00061 *> = 'N': The Normal Form of RFP A is stored; 00062 *> = 'C': The Conjugate-transpose Form of RFP A is stored. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] SIDE 00066 *> \verbatim 00067 *> SIDE is CHARACTER*1 00068 *> On entry, SIDE specifies whether op( A ) appears on the left 00069 *> or right of X as follows: 00070 *> 00071 *> SIDE = 'L' or 'l' op( A )*X = alpha*B. 00072 *> 00073 *> SIDE = 'R' or 'r' X*op( A ) = alpha*B. 00074 *> 00075 *> Unchanged on exit. 00076 *> \endverbatim 00077 *> 00078 *> \param[in] UPLO 00079 *> \verbatim 00080 *> UPLO is CHARACTER*1 00081 *> On entry, UPLO specifies whether the RFP matrix A came from 00082 *> an upper or lower triangular matrix as follows: 00083 *> UPLO = 'U' or 'u' RFP A came from an upper triangular matrix 00084 *> UPLO = 'L' or 'l' RFP A came from a lower triangular matrix 00085 *> 00086 *> Unchanged on exit. 00087 *> \endverbatim 00088 *> 00089 *> \param[in] TRANS 00090 *> \verbatim 00091 *> TRANS is CHARACTER*1 00092 *> On entry, TRANS specifies the form of op( A ) to be used 00093 *> in the matrix multiplication as follows: 00094 *> 00095 *> TRANS = 'N' or 'n' op( A ) = A. 00096 *> 00097 *> TRANS = 'C' or 'c' op( A ) = conjg( A' ). 00098 *> 00099 *> Unchanged on exit. 00100 *> \endverbatim 00101 *> 00102 *> \param[in] DIAG 00103 *> \verbatim 00104 *> DIAG is CHARACTER*1 00105 *> On entry, DIAG specifies whether or not RFP A is unit 00106 *> triangular as follows: 00107 *> 00108 *> DIAG = 'U' or 'u' A is assumed to be unit triangular. 00109 *> 00110 *> DIAG = 'N' or 'n' A is not assumed to be unit 00111 *> triangular. 00112 *> 00113 *> Unchanged on exit. 00114 *> \endverbatim 00115 *> 00116 *> \param[in] M 00117 *> \verbatim 00118 *> M is INTEGER 00119 *> On entry, M specifies the number of rows of B. M must be at 00120 *> least zero. 00121 *> Unchanged on exit. 00122 *> \endverbatim 00123 *> 00124 *> \param[in] N 00125 *> \verbatim 00126 *> N is INTEGER 00127 *> On entry, N specifies the number of columns of B. N must be 00128 *> at least zero. 00129 *> Unchanged on exit. 00130 *> \endverbatim 00131 *> 00132 *> \param[in] ALPHA 00133 *> \verbatim 00134 *> ALPHA is COMPLEX*16 00135 *> On entry, ALPHA specifies the scalar alpha. When alpha is 00136 *> zero then A is not referenced and B need not be set before 00137 *> entry. 00138 *> Unchanged on exit. 00139 *> \endverbatim 00140 *> 00141 *> \param[in] A 00142 *> \verbatim 00143 *> A is COMPLEX*16 array, dimension (N*(N+1)/2) 00144 *> NT = N*(N+1)/2. On entry, the matrix A in RFP Format. 00145 *> RFP Format is described by TRANSR, UPLO and N as follows: 00146 *> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even; 00147 *> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If 00148 *> TRANSR = 'C' then RFP is the Conjugate-transpose of RFP A as 00149 *> defined when TRANSR = 'N'. The contents of RFP A are defined 00150 *> by UPLO as follows: If UPLO = 'U' the RFP A contains the NT 00151 *> elements of upper packed A either in normal or 00152 *> conjugate-transpose Format. If UPLO = 'L' the RFP A contains 00153 *> the NT elements of lower packed A either in normal or 00154 *> conjugate-transpose Format. The LDA of RFP A is (N+1)/2 when 00155 *> TRANSR = 'C'. When TRANSR is 'N' the LDA is N+1 when N is 00156 *> even and is N when is odd. 00157 *> See the Note below for more details. Unchanged on exit. 00158 *> \endverbatim 00159 *> 00160 *> \param[in,out] B 00161 *> \verbatim 00162 *> B is COMPLEX*16 array, dimension (LDB,N) 00163 *> Before entry, the leading m by n part of the array B must 00164 *> contain the right-hand side matrix B, and on exit is 00165 *> overwritten by the solution matrix X. 00166 *> \endverbatim 00167 *> 00168 *> \param[in] LDB 00169 *> \verbatim 00170 *> LDB is INTEGER 00171 *> On entry, LDB specifies the first dimension of B as declared 00172 *> in the calling (sub) program. LDB must be at least 00173 *> max( 1, m ). 00174 *> Unchanged on exit. 00175 *> \endverbatim 00176 * 00177 * Authors: 00178 * ======== 00179 * 00180 *> \author Univ. of Tennessee 00181 *> \author Univ. of California Berkeley 00182 *> \author Univ. of Colorado Denver 00183 *> \author NAG Ltd. 00184 * 00185 *> \date November 2011 00186 * 00187 *> \ingroup complex16OTHERcomputational 00188 * 00189 *> \par Further Details: 00190 * ===================== 00191 *> 00192 *> \verbatim 00193 *> 00194 *> We first consider Standard Packed Format when N is even. 00195 *> We give an example where N = 6. 00196 *> 00197 *> AP is Upper AP is Lower 00198 *> 00199 *> 00 01 02 03 04 05 00 00200 *> 11 12 13 14 15 10 11 00201 *> 22 23 24 25 20 21 22 00202 *> 33 34 35 30 31 32 33 00203 *> 44 45 40 41 42 43 44 00204 *> 55 50 51 52 53 54 55 00205 *> 00206 *> 00207 *> Let TRANSR = 'N'. RFP holds AP as follows: 00208 *> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last 00209 *> three columns of AP upper. The lower triangle A(4:6,0:2) consists of 00210 *> conjugate-transpose of the first three columns of AP upper. 00211 *> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first 00212 *> three columns of AP lower. The upper triangle A(0:2,0:2) consists of 00213 *> conjugate-transpose of the last three columns of AP lower. 00214 *> To denote conjugate we place -- above the element. This covers the 00215 *> case N even and TRANSR = 'N'. 00216 *> 00217 *> RFP A RFP A 00218 *> 00219 *> -- -- -- 00220 *> 03 04 05 33 43 53 00221 *> -- -- 00222 *> 13 14 15 00 44 54 00223 *> -- 00224 *> 23 24 25 10 11 55 00225 *> 00226 *> 33 34 35 20 21 22 00227 *> -- 00228 *> 00 44 45 30 31 32 00229 *> -- -- 00230 *> 01 11 55 40 41 42 00231 *> -- -- -- 00232 *> 02 12 22 50 51 52 00233 *> 00234 *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate- 00235 *> transpose of RFP A above. One therefore gets: 00236 *> 00237 *> 00238 *> RFP A RFP A 00239 *> 00240 *> -- -- -- -- -- -- -- -- -- -- 00241 *> 03 13 23 33 00 01 02 33 00 10 20 30 40 50 00242 *> -- -- -- -- -- -- -- -- -- -- 00243 *> 04 14 24 34 44 11 12 43 44 11 21 31 41 51 00244 *> -- -- -- -- -- -- -- -- -- -- 00245 *> 05 15 25 35 45 55 22 53 54 55 22 32 42 52 00246 *> 00247 *> 00248 *> We next consider Standard Packed Format when N is odd. 00249 *> We give an example where N = 5. 00250 *> 00251 *> AP is Upper AP is Lower 00252 *> 00253 *> 00 01 02 03 04 00 00254 *> 11 12 13 14 10 11 00255 *> 22 23 24 20 21 22 00256 *> 33 34 30 31 32 33 00257 *> 44 40 41 42 43 44 00258 *> 00259 *> 00260 *> Let TRANSR = 'N'. RFP holds AP as follows: 00261 *> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last 00262 *> three columns of AP upper. The lower triangle A(3:4,0:1) consists of 00263 *> conjugate-transpose of the first two columns of AP upper. 00264 *> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first 00265 *> three columns of AP lower. The upper triangle A(0:1,1:2) consists of 00266 *> conjugate-transpose of the last two columns of AP lower. 00267 *> To denote conjugate we place -- above the element. This covers the 00268 *> case N odd and TRANSR = 'N'. 00269 *> 00270 *> RFP A RFP A 00271 *> 00272 *> -- -- 00273 *> 02 03 04 00 33 43 00274 *> -- 00275 *> 12 13 14 10 11 44 00276 *> 00277 *> 22 23 24 20 21 22 00278 *> -- 00279 *> 00 33 34 30 31 32 00280 *> -- -- 00281 *> 01 11 44 40 41 42 00282 *> 00283 *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate- 00284 *> transpose of RFP A above. One therefore gets: 00285 *> 00286 *> 00287 *> RFP A RFP A 00288 *> 00289 *> -- -- -- -- -- -- -- -- -- 00290 *> 02 12 22 00 01 00 10 20 30 40 50 00291 *> -- -- -- -- -- -- -- -- -- 00292 *> 03 13 23 33 11 33 11 21 31 41 51 00293 *> -- -- -- -- -- -- -- -- -- 00294 *> 04 14 24 34 44 43 44 22 32 42 52 00295 *> \endverbatim 00296 *> 00297 * ===================================================================== 00298 SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, 00299 $ B, LDB ) 00300 * 00301 * -- LAPACK computational routine (version 3.4.0) -- 00302 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00303 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00304 * November 2011 00305 * 00306 * .. Scalar Arguments .. 00307 CHARACTER TRANSR, DIAG, SIDE, TRANS, UPLO 00308 INTEGER LDB, M, N 00309 COMPLEX*16 ALPHA 00310 * .. 00311 * .. Array Arguments .. 00312 COMPLEX*16 A( 0: * ), B( 0: LDB-1, 0: * ) 00313 * .. 00314 * 00315 * ===================================================================== 00316 * .. 00317 * .. Parameters .. 00318 COMPLEX*16 CONE, CZERO 00319 PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ), 00320 $ CZERO = ( 0.0D+0, 0.0D+0 ) ) 00321 * .. 00322 * .. Local Scalars .. 00323 LOGICAL LOWER, LSIDE, MISODD, NISODD, NORMALTRANSR, 00324 $ NOTRANS 00325 INTEGER M1, M2, N1, N2, K, INFO, I, J 00326 * .. 00327 * .. External Functions .. 00328 LOGICAL LSAME 00329 EXTERNAL LSAME 00330 * .. 00331 * .. External Subroutines .. 00332 EXTERNAL XERBLA, ZGEMM, ZTRSM 00333 * .. 00334 * .. Intrinsic Functions .. 00335 INTRINSIC MAX, MOD 00336 * .. 00337 * .. Executable Statements .. 00338 * 00339 * Test the input parameters. 00340 * 00341 INFO = 0 00342 NORMALTRANSR = LSAME( TRANSR, 'N' ) 00343 LSIDE = LSAME( SIDE, 'L' ) 00344 LOWER = LSAME( UPLO, 'L' ) 00345 NOTRANS = LSAME( TRANS, 'N' ) 00346 IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN 00347 INFO = -1 00348 ELSE IF( .NOT.LSIDE .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN 00349 INFO = -2 00350 ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN 00351 INFO = -3 00352 ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 00353 INFO = -4 00354 ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) 00355 $ THEN 00356 INFO = -5 00357 ELSE IF( M.LT.0 ) THEN 00358 INFO = -6 00359 ELSE IF( N.LT.0 ) THEN 00360 INFO = -7 00361 ELSE IF( LDB.LT.MAX( 1, M ) ) THEN 00362 INFO = -11 00363 END IF 00364 IF( INFO.NE.0 ) THEN 00365 CALL XERBLA( 'ZTFSM ', -INFO ) 00366 RETURN 00367 END IF 00368 * 00369 * Quick return when ( (N.EQ.0).OR.(M.EQ.0) ) 00370 * 00371 IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) 00372 $ RETURN 00373 * 00374 * Quick return when ALPHA.EQ.(0D+0,0D+0) 00375 * 00376 IF( ALPHA.EQ.CZERO ) THEN 00377 DO 20 J = 0, N - 1 00378 DO 10 I = 0, M - 1 00379 B( I, J ) = CZERO 00380 10 CONTINUE 00381 20 CONTINUE 00382 RETURN 00383 END IF 00384 * 00385 IF( LSIDE ) THEN 00386 * 00387 * SIDE = 'L' 00388 * 00389 * A is M-by-M. 00390 * If M is odd, set NISODD = .TRUE., and M1 and M2. 00391 * If M is even, NISODD = .FALSE., and M. 00392 * 00393 IF( MOD( M, 2 ).EQ.0 ) THEN 00394 MISODD = .FALSE. 00395 K = M / 2 00396 ELSE 00397 MISODD = .TRUE. 00398 IF( LOWER ) THEN 00399 M2 = M / 2 00400 M1 = M - M2 00401 ELSE 00402 M1 = M / 2 00403 M2 = M - M1 00404 END IF 00405 END IF 00406 * 00407 IF( MISODD ) THEN 00408 * 00409 * SIDE = 'L' and N is odd 00410 * 00411 IF( NORMALTRANSR ) THEN 00412 * 00413 * SIDE = 'L', N is odd, and TRANSR = 'N' 00414 * 00415 IF( LOWER ) THEN 00416 * 00417 * SIDE ='L', N is odd, TRANSR = 'N', and UPLO = 'L' 00418 * 00419 IF( NOTRANS ) THEN 00420 * 00421 * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and 00422 * TRANS = 'N' 00423 * 00424 IF( M.EQ.1 ) THEN 00425 CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, 00426 $ A, M, B, LDB ) 00427 ELSE 00428 CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, 00429 $ A( 0 ), M, B, LDB ) 00430 CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), 00431 $ M, B, LDB, ALPHA, B( M1, 0 ), LDB ) 00432 CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, 00433 $ A( M ), M, B( M1, 0 ), LDB ) 00434 END IF 00435 * 00436 ELSE 00437 * 00438 * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and 00439 * TRANS = 'C' 00440 * 00441 IF( M.EQ.1 ) THEN 00442 CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, ALPHA, 00443 $ A( 0 ), M, B, LDB ) 00444 ELSE 00445 CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, 00446 $ A( M ), M, B( M1, 0 ), LDB ) 00447 CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), 00448 $ M, B( M1, 0 ), LDB, ALPHA, B, LDB ) 00449 CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, 00450 $ A( 0 ), M, B, LDB ) 00451 END IF 00452 * 00453 END IF 00454 * 00455 ELSE 00456 * 00457 * SIDE ='L', N is odd, TRANSR = 'N', and UPLO = 'U' 00458 * 00459 IF( .NOT.NOTRANS ) THEN 00460 * 00461 * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'U', and 00462 * TRANS = 'N' 00463 * 00464 CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, 00465 $ A( M2 ), M, B, LDB ) 00466 CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, A( 0 ), M, 00467 $ B, LDB, ALPHA, B( M1, 0 ), LDB ) 00468 CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, 00469 $ A( M1 ), M, B( M1, 0 ), LDB ) 00470 * 00471 ELSE 00472 * 00473 * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'U', and 00474 * TRANS = 'C' 00475 * 00476 CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, 00477 $ A( M1 ), M, B( M1, 0 ), LDB ) 00478 CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, A( 0 ), M, 00479 $ B( M1, 0 ), LDB, ALPHA, B, LDB ) 00480 CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, 00481 $ A( M2 ), M, B, LDB ) 00482 * 00483 END IF 00484 * 00485 END IF 00486 * 00487 ELSE 00488 * 00489 * SIDE = 'L', N is odd, and TRANSR = 'C' 00490 * 00491 IF( LOWER ) THEN 00492 * 00493 * SIDE ='L', N is odd, TRANSR = 'C', and UPLO = 'L' 00494 * 00495 IF( NOTRANS ) THEN 00496 * 00497 * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'L', and 00498 * TRANS = 'N' 00499 * 00500 IF( M.EQ.1 ) THEN 00501 CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, 00502 $ A( 0 ), M1, B, LDB ) 00503 ELSE 00504 CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, 00505 $ A( 0 ), M1, B, LDB ) 00506 CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, 00507 $ A( M1*M1 ), M1, B, LDB, ALPHA, 00508 $ B( M1, 0 ), LDB ) 00509 CALL ZTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, 00510 $ A( 1 ), M1, B( M1, 0 ), LDB ) 00511 END IF 00512 * 00513 ELSE 00514 * 00515 * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'L', and 00516 * TRANS = 'C' 00517 * 00518 IF( M.EQ.1 ) THEN 00519 CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, 00520 $ A( 0 ), M1, B, LDB ) 00521 ELSE 00522 CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, 00523 $ A( 1 ), M1, B( M1, 0 ), LDB ) 00524 CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, 00525 $ A( M1*M1 ), M1, B( M1, 0 ), LDB, 00526 $ ALPHA, B, LDB ) 00527 CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, 00528 $ A( 0 ), M1, B, LDB ) 00529 END IF 00530 * 00531 END IF 00532 * 00533 ELSE 00534 * 00535 * SIDE ='L', N is odd, TRANSR = 'C', and UPLO = 'U' 00536 * 00537 IF( .NOT.NOTRANS ) THEN 00538 * 00539 * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'U', and 00540 * TRANS = 'N' 00541 * 00542 CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, 00543 $ A( M2*M2 ), M2, B, LDB ) 00544 CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( 0 ), M2, 00545 $ B, LDB, ALPHA, B( M1, 0 ), LDB ) 00546 CALL ZTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, 00547 $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) 00548 * 00549 ELSE 00550 * 00551 * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'U', and 00552 * TRANS = 'C' 00553 * 00554 CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, 00555 $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) 00556 CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( 0 ), M2, 00557 $ B( M1, 0 ), LDB, ALPHA, B, LDB ) 00558 CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, 00559 $ A( M2*M2 ), M2, B, LDB ) 00560 * 00561 END IF 00562 * 00563 END IF 00564 * 00565 END IF 00566 * 00567 ELSE 00568 * 00569 * SIDE = 'L' and N is even 00570 * 00571 IF( NORMALTRANSR ) THEN 00572 * 00573 * SIDE = 'L', N is even, and TRANSR = 'N' 00574 * 00575 IF( LOWER ) THEN 00576 * 00577 * SIDE ='L', N is even, TRANSR = 'N', and UPLO = 'L' 00578 * 00579 IF( NOTRANS ) THEN 00580 * 00581 * SIDE ='L', N is even, TRANSR = 'N', UPLO = 'L', 00582 * and TRANS = 'N' 00583 * 00584 CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA, 00585 $ A( 1 ), M+1, B, LDB ) 00586 CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( K+1 ), 00587 $ M+1, B, LDB, ALPHA, B( K, 0 ), LDB ) 00588 CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, CONE, 00589 $ A( 0 ), M+1, B( K, 0 ), LDB ) 00590 * 00591 ELSE 00592 * 00593 * SIDE ='L', N is even, TRANSR = 'N', UPLO = 'L', 00594 * and TRANS = 'C' 00595 * 00596 CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA, 00597 $ A( 0 ), M+1, B( K, 0 ), LDB ) 00598 CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( K+1 ), 00599 $ M+1, B( K, 0 ), LDB, ALPHA, B, LDB ) 00600 CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, CONE, 00601 $ A( 1 ), M+1, B, LDB ) 00602 * 00603 END IF 00604 * 00605 ELSE 00606 * 00607 * SIDE ='L', N is even, TRANSR = 'N', and UPLO = 'U' 00608 * 00609 IF( .NOT.NOTRANS ) THEN 00610 * 00611 * SIDE ='L', N is even, TRANSR = 'N', UPLO = 'U', 00612 * and TRANS = 'N' 00613 * 00614 CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA, 00615 $ A( K+1 ), M+1, B, LDB ) 00616 CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), M+1, 00617 $ B, LDB, ALPHA, B( K, 0 ), LDB ) 00618 CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, CONE, 00619 $ A( K ), M+1, B( K, 0 ), LDB ) 00620 * 00621 ELSE 00622 * 00623 * SIDE ='L', N is even, TRANSR = 'N', UPLO = 'U', 00624 * and TRANS = 'C' 00625 CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA, 00626 $ A( K ), M+1, B( K, 0 ), LDB ) 00627 CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), M+1, 00628 $ B( K, 0 ), LDB, ALPHA, B, LDB ) 00629 CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, CONE, 00630 $ A( K+1 ), M+1, B, LDB ) 00631 * 00632 END IF 00633 * 00634 END IF 00635 * 00636 ELSE 00637 * 00638 * SIDE = 'L', N is even, and TRANSR = 'C' 00639 * 00640 IF( LOWER ) THEN 00641 * 00642 * SIDE ='L', N is even, TRANSR = 'C', and UPLO = 'L' 00643 * 00644 IF( NOTRANS ) THEN 00645 * 00646 * SIDE ='L', N is even, TRANSR = 'C', UPLO = 'L', 00647 * and TRANS = 'N' 00648 * 00649 CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA, 00650 $ A( K ), K, B, LDB ) 00651 CALL ZGEMM( 'C', 'N', K, N, K, -CONE, 00652 $ A( K*( K+1 ) ), K, B, LDB, ALPHA, 00653 $ B( K, 0 ), LDB ) 00654 CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, CONE, 00655 $ A( 0 ), K, B( K, 0 ), LDB ) 00656 * 00657 ELSE 00658 * 00659 * SIDE ='L', N is even, TRANSR = 'C', UPLO = 'L', 00660 * and TRANS = 'C' 00661 * 00662 CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, ALPHA, 00663 $ A( 0 ), K, B( K, 0 ), LDB ) 00664 CALL ZGEMM( 'N', 'N', K, N, K, -CONE, 00665 $ A( K*( K+1 ) ), K, B( K, 0 ), LDB, 00666 $ ALPHA, B, LDB ) 00667 CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, CONE, 00668 $ A( K ), K, B, LDB ) 00669 * 00670 END IF 00671 * 00672 ELSE 00673 * 00674 * SIDE ='L', N is even, TRANSR = 'C', and UPLO = 'U' 00675 * 00676 IF( .NOT.NOTRANS ) THEN 00677 * 00678 * SIDE ='L', N is even, TRANSR = 'C', UPLO = 'U', 00679 * and TRANS = 'N' 00680 * 00681 CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA, 00682 $ A( K*( K+1 ) ), K, B, LDB ) 00683 CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), K, B, 00684 $ LDB, ALPHA, B( K, 0 ), LDB ) 00685 CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, CONE, 00686 $ A( K*K ), K, B( K, 0 ), LDB ) 00687 * 00688 ELSE 00689 * 00690 * SIDE ='L', N is even, TRANSR = 'C', UPLO = 'U', 00691 * and TRANS = 'C' 00692 * 00693 CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, ALPHA, 00694 $ A( K*K ), K, B( K, 0 ), LDB ) 00695 CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), K, 00696 $ B( K, 0 ), LDB, ALPHA, B, LDB ) 00697 CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, CONE, 00698 $ A( K*( K+1 ) ), K, B, LDB ) 00699 * 00700 END IF 00701 * 00702 END IF 00703 * 00704 END IF 00705 * 00706 END IF 00707 * 00708 ELSE 00709 * 00710 * SIDE = 'R' 00711 * 00712 * A is N-by-N. 00713 * If N is odd, set NISODD = .TRUE., and N1 and N2. 00714 * If N is even, NISODD = .FALSE., and K. 00715 * 00716 IF( MOD( N, 2 ).EQ.0 ) THEN 00717 NISODD = .FALSE. 00718 K = N / 2 00719 ELSE 00720 NISODD = .TRUE. 00721 IF( LOWER ) THEN 00722 N2 = N / 2 00723 N1 = N - N2 00724 ELSE 00725 N1 = N / 2 00726 N2 = N - N1 00727 END IF 00728 END IF 00729 * 00730 IF( NISODD ) THEN 00731 * 00732 * SIDE = 'R' and N is odd 00733 * 00734 IF( NORMALTRANSR ) THEN 00735 * 00736 * SIDE = 'R', N is odd, and TRANSR = 'N' 00737 * 00738 IF( LOWER ) THEN 00739 * 00740 * SIDE ='R', N is odd, TRANSR = 'N', and UPLO = 'L' 00741 * 00742 IF( NOTRANS ) THEN 00743 * 00744 * SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'L', and 00745 * TRANS = 'N' 00746 * 00747 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA, 00748 $ A( N ), N, B( 0, N1 ), LDB ) 00749 CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ), 00750 $ LDB, A( N1 ), N, ALPHA, B( 0, 0 ), 00751 $ LDB ) 00752 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE, 00753 $ A( 0 ), N, B( 0, 0 ), LDB ) 00754 * 00755 ELSE 00756 * 00757 * SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'L', and 00758 * TRANS = 'C' 00759 * 00760 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA, 00761 $ A( 0 ), N, B( 0, 0 ), LDB ) 00762 CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ), 00763 $ LDB, A( N1 ), N, ALPHA, B( 0, N1 ), 00764 $ LDB ) 00765 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE, 00766 $ A( N ), N, B( 0, N1 ), LDB ) 00767 * 00768 END IF 00769 * 00770 ELSE 00771 * 00772 * SIDE ='R', N is odd, TRANSR = 'N', and UPLO = 'U' 00773 * 00774 IF( NOTRANS ) THEN 00775 * 00776 * SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'U', and 00777 * TRANS = 'N' 00778 * 00779 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA, 00780 $ A( N2 ), N, B( 0, 0 ), LDB ) 00781 CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ), 00782 $ LDB, A( 0 ), N, ALPHA, B( 0, N1 ), 00783 $ LDB ) 00784 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE, 00785 $ A( N1 ), N, B( 0, N1 ), LDB ) 00786 * 00787 ELSE 00788 * 00789 * SIDE ='R', N is odd, TRANSR = 'N', UPLO = 'U', and 00790 * TRANS = 'C' 00791 * 00792 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA, 00793 $ A( N1 ), N, B( 0, N1 ), LDB ) 00794 CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ), 00795 $ LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB ) 00796 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE, 00797 $ A( N2 ), N, B( 0, 0 ), LDB ) 00798 * 00799 END IF 00800 * 00801 END IF 00802 * 00803 ELSE 00804 * 00805 * SIDE = 'R', N is odd, and TRANSR = 'C' 00806 * 00807 IF( LOWER ) THEN 00808 * 00809 * SIDE ='R', N is odd, TRANSR = 'C', and UPLO = 'L' 00810 * 00811 IF( NOTRANS ) THEN 00812 * 00813 * SIDE ='R', N is odd, TRANSR = 'C', UPLO = 'L', and 00814 * TRANS = 'N' 00815 * 00816 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, 00817 $ A( 1 ), N1, B( 0, N1 ), LDB ) 00818 CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ), 00819 $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ), 00820 $ LDB ) 00821 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE, 00822 $ A( 0 ), N1, B( 0, 0 ), LDB ) 00823 * 00824 ELSE 00825 * 00826 * SIDE ='R', N is odd, TRANSR = 'C', UPLO = 'L', and 00827 * TRANS = 'C' 00828 * 00829 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, 00830 $ A( 0 ), N1, B( 0, 0 ), LDB ) 00831 CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ), 00832 $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ), 00833 $ LDB ) 00834 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE, 00835 $ A( 1 ), N1, B( 0, N1 ), LDB ) 00836 * 00837 END IF 00838 * 00839 ELSE 00840 * 00841 * SIDE ='R', N is odd, TRANSR = 'C', and UPLO = 'U' 00842 * 00843 IF( NOTRANS ) THEN 00844 * 00845 * SIDE ='R', N is odd, TRANSR = 'C', UPLO = 'U', and 00846 * TRANS = 'N' 00847 * 00848 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, 00849 $ A( N2*N2 ), N2, B( 0, 0 ), LDB ) 00850 CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ), 00851 $ LDB, A( 0 ), N2, ALPHA, B( 0, N1 ), 00852 $ LDB ) 00853 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE, 00854 $ A( N1*N2 ), N2, B( 0, N1 ), LDB ) 00855 * 00856 ELSE 00857 * 00858 * SIDE ='R', N is odd, TRANSR = 'C', UPLO = 'U', and 00859 * TRANS = 'C' 00860 * 00861 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, 00862 $ A( N1*N2 ), N2, B( 0, N1 ), LDB ) 00863 CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ), 00864 $ LDB, A( 0 ), N2, ALPHA, B( 0, 0 ), 00865 $ LDB ) 00866 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE, 00867 $ A( N2*N2 ), N2, B( 0, 0 ), LDB ) 00868 * 00869 END IF 00870 * 00871 END IF 00872 * 00873 END IF 00874 * 00875 ELSE 00876 * 00877 * SIDE = 'R' and N is even 00878 * 00879 IF( NORMALTRANSR ) THEN 00880 * 00881 * SIDE = 'R', N is even, and TRANSR = 'N' 00882 * 00883 IF( LOWER ) THEN 00884 * 00885 * SIDE ='R', N is even, TRANSR = 'N', and UPLO = 'L' 00886 * 00887 IF( NOTRANS ) THEN 00888 * 00889 * SIDE ='R', N is even, TRANSR = 'N', UPLO = 'L', 00890 * and TRANS = 'N' 00891 * 00892 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, ALPHA, 00893 $ A( 0 ), N+1, B( 0, K ), LDB ) 00894 CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, K ), 00895 $ LDB, A( K+1 ), N+1, ALPHA, B( 0, 0 ), 00896 $ LDB ) 00897 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, CONE, 00898 $ A( 1 ), N+1, B( 0, 0 ), LDB ) 00899 * 00900 ELSE 00901 * 00902 * SIDE ='R', N is even, TRANSR = 'N', UPLO = 'L', 00903 * and TRANS = 'C' 00904 * 00905 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, ALPHA, 00906 $ A( 1 ), N+1, B( 0, 0 ), LDB ) 00907 CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, 0 ), 00908 $ LDB, A( K+1 ), N+1, ALPHA, B( 0, K ), 00909 $ LDB ) 00910 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, CONE, 00911 $ A( 0 ), N+1, B( 0, K ), LDB ) 00912 * 00913 END IF 00914 * 00915 ELSE 00916 * 00917 * SIDE ='R', N is even, TRANSR = 'N', and UPLO = 'U' 00918 * 00919 IF( NOTRANS ) THEN 00920 * 00921 * SIDE ='R', N is even, TRANSR = 'N', UPLO = 'U', 00922 * and TRANS = 'N' 00923 * 00924 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, ALPHA, 00925 $ A( K+1 ), N+1, B( 0, 0 ), LDB ) 00926 CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, 0 ), 00927 $ LDB, A( 0 ), N+1, ALPHA, B( 0, K ), 00928 $ LDB ) 00929 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, CONE, 00930 $ A( K ), N+1, B( 0, K ), LDB ) 00931 * 00932 ELSE 00933 * 00934 * SIDE ='R', N is even, TRANSR = 'N', UPLO = 'U', 00935 * and TRANS = 'C' 00936 * 00937 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, ALPHA, 00938 $ A( K ), N+1, B( 0, K ), LDB ) 00939 CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, K ), 00940 $ LDB, A( 0 ), N+1, ALPHA, B( 0, 0 ), 00941 $ LDB ) 00942 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, CONE, 00943 $ A( K+1 ), N+1, B( 0, 0 ), LDB ) 00944 * 00945 END IF 00946 * 00947 END IF 00948 * 00949 ELSE 00950 * 00951 * SIDE = 'R', N is even, and TRANSR = 'C' 00952 * 00953 IF( LOWER ) THEN 00954 * 00955 * SIDE ='R', N is even, TRANSR = 'C', and UPLO = 'L' 00956 * 00957 IF( NOTRANS ) THEN 00958 * 00959 * SIDE ='R', N is even, TRANSR = 'C', UPLO = 'L', 00960 * and TRANS = 'N' 00961 * 00962 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA, 00963 $ A( 0 ), K, B( 0, K ), LDB ) 00964 CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, K ), 00965 $ LDB, A( ( K+1 )*K ), K, ALPHA, 00966 $ B( 0, 0 ), LDB ) 00967 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, CONE, 00968 $ A( K ), K, B( 0, 0 ), LDB ) 00969 * 00970 ELSE 00971 * 00972 * SIDE ='R', N is even, TRANSR = 'C', UPLO = 'L', 00973 * and TRANS = 'C' 00974 * 00975 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA, 00976 $ A( K ), K, B( 0, 0 ), LDB ) 00977 CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, 0 ), 00978 $ LDB, A( ( K+1 )*K ), K, ALPHA, 00979 $ B( 0, K ), LDB ) 00980 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, CONE, 00981 $ A( 0 ), K, B( 0, K ), LDB ) 00982 * 00983 END IF 00984 * 00985 ELSE 00986 * 00987 * SIDE ='R', N is even, TRANSR = 'C', and UPLO = 'U' 00988 * 00989 IF( NOTRANS ) THEN 00990 * 00991 * SIDE ='R', N is even, TRANSR = 'C', UPLO = 'U', 00992 * and TRANS = 'N' 00993 * 00994 CALL ZTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA, 00995 $ A( ( K+1 )*K ), K, B( 0, 0 ), LDB ) 00996 CALL ZGEMM( 'N', 'C', M, K, K, -CONE, B( 0, 0 ), 00997 $ LDB, A( 0 ), K, ALPHA, B( 0, K ), LDB ) 00998 CALL ZTRSM( 'R', 'L', 'C', DIAG, M, K, CONE, 00999 $ A( K*K ), K, B( 0, K ), LDB ) 01000 * 01001 ELSE 01002 * 01003 * SIDE ='R', N is even, TRANSR = 'C', UPLO = 'U', 01004 * and TRANS = 'C' 01005 * 01006 CALL ZTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA, 01007 $ A( K*K ), K, B( 0, K ), LDB ) 01008 CALL ZGEMM( 'N', 'N', M, K, K, -CONE, B( 0, K ), 01009 $ LDB, A( 0 ), K, ALPHA, B( 0, 0 ), LDB ) 01010 CALL ZTRSM( 'R', 'U', 'C', DIAG, M, K, CONE, 01011 $ A( ( K+1 )*K ), K, B( 0, 0 ), LDB ) 01012 * 01013 END IF 01014 * 01015 END IF 01016 * 01017 END IF 01018 * 01019 END IF 01020 END IF 01021 * 01022 RETURN 01023 * 01024 * End of ZTFSM 01025 * 01026 END