![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CTRMM 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 00012 * 00013 * .. Scalar Arguments .. 00014 * COMPLEX ALPHA 00015 * INTEGER LDA,LDB,M,N 00016 * CHARACTER DIAG,SIDE,TRANSA,UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * COMPLEX A(LDA,*),B(LDB,*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> CTRMM performs one of the matrix-matrix operations 00029 *> 00030 *> B := alpha*op( A )*B, or B := alpha*B*op( A ) 00031 *> 00032 *> where alpha is a scalar, B is an m by n matrix, A is a unit, or 00033 *> non-unit, upper or lower triangular matrix and op( A ) is one of 00034 *> 00035 *> op( A ) = A or op( A ) = A**T or op( A ) = A**H. 00036 *> \endverbatim 00037 * 00038 * Arguments: 00039 * ========== 00040 * 00041 *> \param[in] SIDE 00042 *> \verbatim 00043 *> SIDE is CHARACTER*1 00044 *> On entry, SIDE specifies whether op( A ) multiplies B from 00045 *> the left or right as follows: 00046 *> 00047 *> SIDE = 'L' or 'l' B := alpha*op( A )*B. 00048 *> 00049 *> SIDE = 'R' or 'r' B := alpha*B*op( A ). 00050 *> \endverbatim 00051 *> 00052 *> \param[in] UPLO 00053 *> \verbatim 00054 *> UPLO is CHARACTER*1 00055 *> On entry, UPLO specifies whether the matrix A is an upper or 00056 *> lower triangular matrix as follows: 00057 *> 00058 *> UPLO = 'U' or 'u' A is an upper triangular matrix. 00059 *> 00060 *> UPLO = 'L' or 'l' A is a lower triangular matrix. 00061 *> \endverbatim 00062 *> 00063 *> \param[in] TRANSA 00064 *> \verbatim 00065 *> TRANSA is CHARACTER*1 00066 *> On entry, TRANSA specifies the form of op( A ) to be used in 00067 *> the matrix multiplication as follows: 00068 *> 00069 *> TRANSA = 'N' or 'n' op( A ) = A. 00070 *> 00071 *> TRANSA = 'T' or 't' op( A ) = A**T. 00072 *> 00073 *> TRANSA = 'C' or 'c' op( A ) = A**H. 00074 *> \endverbatim 00075 *> 00076 *> \param[in] DIAG 00077 *> \verbatim 00078 *> DIAG is CHARACTER*1 00079 *> On entry, DIAG specifies whether or not A is unit triangular 00080 *> as follows: 00081 *> 00082 *> DIAG = 'U' or 'u' A is assumed to be unit triangular. 00083 *> 00084 *> DIAG = 'N' or 'n' A is not assumed to be unit 00085 *> triangular. 00086 *> \endverbatim 00087 *> 00088 *> \param[in] M 00089 *> \verbatim 00090 *> M is INTEGER 00091 *> On entry, M specifies the number of rows of B. M must be at 00092 *> least zero. 00093 *> \endverbatim 00094 *> 00095 *> \param[in] N 00096 *> \verbatim 00097 *> N is INTEGER 00098 *> On entry, N specifies the number of columns of B. N must be 00099 *> at least zero. 00100 *> \endverbatim 00101 *> 00102 *> \param[in] ALPHA 00103 *> \verbatim 00104 *> ALPHA is COMPLEX 00105 *> On entry, ALPHA specifies the scalar alpha. When alpha is 00106 *> zero then A is not referenced and B need not be set before 00107 *> entry. 00108 *> \endverbatim 00109 *> 00110 *> \param[in] A 00111 *> \verbatim 00112 *> A is COMPLEX array of DIMENSION ( LDA, k ), where k is m 00113 *> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. 00114 *> Before entry with UPLO = 'U' or 'u', the leading k by k 00115 *> upper triangular part of the array A must contain the upper 00116 *> triangular matrix and the strictly lower triangular part of 00117 *> A is not referenced. 00118 *> Before entry with UPLO = 'L' or 'l', the leading k by k 00119 *> lower triangular part of the array A must contain the lower 00120 *> triangular matrix and the strictly upper triangular part of 00121 *> A is not referenced. 00122 *> Note that when DIAG = 'U' or 'u', the diagonal elements of 00123 *> A are not referenced either, but are assumed to be unity. 00124 *> \endverbatim 00125 *> 00126 *> \param[in] LDA 00127 *> \verbatim 00128 *> LDA is INTEGER 00129 *> On entry, LDA specifies the first dimension of A as declared 00130 *> in the calling (sub) program. When SIDE = 'L' or 'l' then 00131 *> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' 00132 *> then LDA must be at least max( 1, n ). 00133 *> \endverbatim 00134 *> 00135 *> \param[in,out] B 00136 *> \verbatim 00137 *> B is COMPLEX array of DIMENSION ( LDB, n ). 00138 *> Before entry, the leading m by n part of the array B must 00139 *> contain the matrix B, and on exit is overwritten by the 00140 *> transformed matrix. 00141 *> \endverbatim 00142 *> 00143 *> \param[in] LDB 00144 *> \verbatim 00145 *> LDB is INTEGER 00146 *> On entry, LDB specifies the first dimension of B as declared 00147 *> in the calling (sub) program. LDB must be at least 00148 *> max( 1, m ). 00149 *> \endverbatim 00150 * 00151 * Authors: 00152 * ======== 00153 * 00154 *> \author Univ. of Tennessee 00155 *> \author Univ. of California Berkeley 00156 *> \author Univ. of Colorado Denver 00157 *> \author NAG Ltd. 00158 * 00159 *> \date November 2011 00160 * 00161 *> \ingroup complex_blas_level3 00162 * 00163 *> \par Further Details: 00164 * ===================== 00165 *> 00166 *> \verbatim 00167 *> 00168 *> Level 3 Blas routine. 00169 *> 00170 *> -- Written on 8-February-1989. 00171 *> Jack Dongarra, Argonne National Laboratory. 00172 *> Iain Duff, AERE Harwell. 00173 *> Jeremy Du Croz, Numerical Algorithms Group Ltd. 00174 *> Sven Hammarling, Numerical Algorithms Group Ltd. 00175 *> \endverbatim 00176 *> 00177 * ===================================================================== 00178 SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 00179 * 00180 * -- Reference BLAS level3 routine (version 3.4.0) -- 00181 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00182 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00183 * November 2011 00184 * 00185 * .. Scalar Arguments .. 00186 COMPLEX ALPHA 00187 INTEGER LDA,LDB,M,N 00188 CHARACTER DIAG,SIDE,TRANSA,UPLO 00189 * .. 00190 * .. Array Arguments .. 00191 COMPLEX A(LDA,*),B(LDB,*) 00192 * .. 00193 * 00194 * ===================================================================== 00195 * 00196 * .. External Functions .. 00197 LOGICAL LSAME 00198 EXTERNAL LSAME 00199 * .. 00200 * .. External Subroutines .. 00201 EXTERNAL XERBLA 00202 * .. 00203 * .. Intrinsic Functions .. 00204 INTRINSIC CONJG,MAX 00205 * .. 00206 * .. Local Scalars .. 00207 COMPLEX TEMP 00208 INTEGER I,INFO,J,K,NROWA 00209 LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER 00210 * .. 00211 * .. Parameters .. 00212 COMPLEX ONE 00213 PARAMETER (ONE= (1.0E+0,0.0E+0)) 00214 COMPLEX ZERO 00215 PARAMETER (ZERO= (0.0E+0,0.0E+0)) 00216 * .. 00217 * 00218 * Test the input parameters. 00219 * 00220 LSIDE = LSAME(SIDE,'L') 00221 IF (LSIDE) THEN 00222 NROWA = M 00223 ELSE 00224 NROWA = N 00225 END IF 00226 NOCONJ = LSAME(TRANSA,'T') 00227 NOUNIT = LSAME(DIAG,'N') 00228 UPPER = LSAME(UPLO,'U') 00229 * 00230 INFO = 0 00231 IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN 00232 INFO = 1 00233 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 00234 INFO = 2 00235 ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND. 00236 + (.NOT.LSAME(TRANSA,'T')) .AND. 00237 + (.NOT.LSAME(TRANSA,'C'))) THEN 00238 INFO = 3 00239 ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN 00240 INFO = 4 00241 ELSE IF (M.LT.0) THEN 00242 INFO = 5 00243 ELSE IF (N.LT.0) THEN 00244 INFO = 6 00245 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 00246 INFO = 9 00247 ELSE IF (LDB.LT.MAX(1,M)) THEN 00248 INFO = 11 00249 END IF 00250 IF (INFO.NE.0) THEN 00251 CALL XERBLA('CTRMM ',INFO) 00252 RETURN 00253 END IF 00254 * 00255 * Quick return if possible. 00256 * 00257 IF (M.EQ.0 .OR. N.EQ.0) RETURN 00258 * 00259 * And when alpha.eq.zero. 00260 * 00261 IF (ALPHA.EQ.ZERO) THEN 00262 DO 20 J = 1,N 00263 DO 10 I = 1,M 00264 B(I,J) = ZERO 00265 10 CONTINUE 00266 20 CONTINUE 00267 RETURN 00268 END IF 00269 * 00270 * Start the operations. 00271 * 00272 IF (LSIDE) THEN 00273 IF (LSAME(TRANSA,'N')) THEN 00274 * 00275 * Form B := alpha*A*B. 00276 * 00277 IF (UPPER) THEN 00278 DO 50 J = 1,N 00279 DO 40 K = 1,M 00280 IF (B(K,J).NE.ZERO) THEN 00281 TEMP = ALPHA*B(K,J) 00282 DO 30 I = 1,K - 1 00283 B(I,J) = B(I,J) + TEMP*A(I,K) 00284 30 CONTINUE 00285 IF (NOUNIT) TEMP = TEMP*A(K,K) 00286 B(K,J) = TEMP 00287 END IF 00288 40 CONTINUE 00289 50 CONTINUE 00290 ELSE 00291 DO 80 J = 1,N 00292 DO 70 K = M,1,-1 00293 IF (B(K,J).NE.ZERO) THEN 00294 TEMP = ALPHA*B(K,J) 00295 B(K,J) = TEMP 00296 IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) 00297 DO 60 I = K + 1,M 00298 B(I,J) = B(I,J) + TEMP*A(I,K) 00299 60 CONTINUE 00300 END IF 00301 70 CONTINUE 00302 80 CONTINUE 00303 END IF 00304 ELSE 00305 * 00306 * Form B := alpha*A**T*B or B := alpha*A**H*B. 00307 * 00308 IF (UPPER) THEN 00309 DO 120 J = 1,N 00310 DO 110 I = M,1,-1 00311 TEMP = B(I,J) 00312 IF (NOCONJ) THEN 00313 IF (NOUNIT) TEMP = TEMP*A(I,I) 00314 DO 90 K = 1,I - 1 00315 TEMP = TEMP + A(K,I)*B(K,J) 00316 90 CONTINUE 00317 ELSE 00318 IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I)) 00319 DO 100 K = 1,I - 1 00320 TEMP = TEMP + CONJG(A(K,I))*B(K,J) 00321 100 CONTINUE 00322 END IF 00323 B(I,J) = ALPHA*TEMP 00324 110 CONTINUE 00325 120 CONTINUE 00326 ELSE 00327 DO 160 J = 1,N 00328 DO 150 I = 1,M 00329 TEMP = B(I,J) 00330 IF (NOCONJ) THEN 00331 IF (NOUNIT) TEMP = TEMP*A(I,I) 00332 DO 130 K = I + 1,M 00333 TEMP = TEMP + A(K,I)*B(K,J) 00334 130 CONTINUE 00335 ELSE 00336 IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I)) 00337 DO 140 K = I + 1,M 00338 TEMP = TEMP + CONJG(A(K,I))*B(K,J) 00339 140 CONTINUE 00340 END IF 00341 B(I,J) = ALPHA*TEMP 00342 150 CONTINUE 00343 160 CONTINUE 00344 END IF 00345 END IF 00346 ELSE 00347 IF (LSAME(TRANSA,'N')) THEN 00348 * 00349 * Form B := alpha*B*A. 00350 * 00351 IF (UPPER) THEN 00352 DO 200 J = N,1,-1 00353 TEMP = ALPHA 00354 IF (NOUNIT) TEMP = TEMP*A(J,J) 00355 DO 170 I = 1,M 00356 B(I,J) = TEMP*B(I,J) 00357 170 CONTINUE 00358 DO 190 K = 1,J - 1 00359 IF (A(K,J).NE.ZERO) THEN 00360 TEMP = ALPHA*A(K,J) 00361 DO 180 I = 1,M 00362 B(I,J) = B(I,J) + TEMP*B(I,K) 00363 180 CONTINUE 00364 END IF 00365 190 CONTINUE 00366 200 CONTINUE 00367 ELSE 00368 DO 240 J = 1,N 00369 TEMP = ALPHA 00370 IF (NOUNIT) TEMP = TEMP*A(J,J) 00371 DO 210 I = 1,M 00372 B(I,J) = TEMP*B(I,J) 00373 210 CONTINUE 00374 DO 230 K = J + 1,N 00375 IF (A(K,J).NE.ZERO) THEN 00376 TEMP = ALPHA*A(K,J) 00377 DO 220 I = 1,M 00378 B(I,J) = B(I,J) + TEMP*B(I,K) 00379 220 CONTINUE 00380 END IF 00381 230 CONTINUE 00382 240 CONTINUE 00383 END IF 00384 ELSE 00385 * 00386 * Form B := alpha*B*A**T or B := alpha*B*A**H. 00387 * 00388 IF (UPPER) THEN 00389 DO 280 K = 1,N 00390 DO 260 J = 1,K - 1 00391 IF (A(J,K).NE.ZERO) THEN 00392 IF (NOCONJ) THEN 00393 TEMP = ALPHA*A(J,K) 00394 ELSE 00395 TEMP = ALPHA*CONJG(A(J,K)) 00396 END IF 00397 DO 250 I = 1,M 00398 B(I,J) = B(I,J) + TEMP*B(I,K) 00399 250 CONTINUE 00400 END IF 00401 260 CONTINUE 00402 TEMP = ALPHA 00403 IF (NOUNIT) THEN 00404 IF (NOCONJ) THEN 00405 TEMP = TEMP*A(K,K) 00406 ELSE 00407 TEMP = TEMP*CONJG(A(K,K)) 00408 END IF 00409 END IF 00410 IF (TEMP.NE.ONE) THEN 00411 DO 270 I = 1,M 00412 B(I,K) = TEMP*B(I,K) 00413 270 CONTINUE 00414 END IF 00415 280 CONTINUE 00416 ELSE 00417 DO 320 K = N,1,-1 00418 DO 300 J = K + 1,N 00419 IF (A(J,K).NE.ZERO) THEN 00420 IF (NOCONJ) THEN 00421 TEMP = ALPHA*A(J,K) 00422 ELSE 00423 TEMP = ALPHA*CONJG(A(J,K)) 00424 END IF 00425 DO 290 I = 1,M 00426 B(I,J) = B(I,J) + TEMP*B(I,K) 00427 290 CONTINUE 00428 END IF 00429 300 CONTINUE 00430 TEMP = ALPHA 00431 IF (NOUNIT) THEN 00432 IF (NOCONJ) THEN 00433 TEMP = TEMP*A(K,K) 00434 ELSE 00435 TEMP = TEMP*CONJG(A(K,K)) 00436 END IF 00437 END IF 00438 IF (TEMP.NE.ONE) THEN 00439 DO 310 I = 1,M 00440 B(I,K) = TEMP*B(I,K) 00441 310 CONTINUE 00442 END IF 00443 320 CONTINUE 00444 END IF 00445 END IF 00446 END IF 00447 * 00448 RETURN 00449 * 00450 * End of CTRMM . 00451 * 00452 END