![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CHEMM 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 CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) 00012 * 00013 * .. Scalar Arguments .. 00014 * COMPLEX ALPHA,BETA 00015 * INTEGER LDA,LDB,LDC,M,N 00016 * CHARACTER SIDE,UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> CHEMM performs one of the matrix-matrix operations 00029 *> 00030 *> C := alpha*A*B + beta*C, 00031 *> 00032 *> or 00033 *> 00034 *> C := alpha*B*A + beta*C, 00035 *> 00036 *> where alpha and beta are scalars, A is an hermitian matrix and B and 00037 *> C are m by n matrices. 00038 *> \endverbatim 00039 * 00040 * Arguments: 00041 * ========== 00042 * 00043 *> \param[in] SIDE 00044 *> \verbatim 00045 *> SIDE is CHARACTER*1 00046 *> On entry, SIDE specifies whether the hermitian matrix A 00047 *> appears on the left or right in the operation as follows: 00048 *> 00049 *> SIDE = 'L' or 'l' C := alpha*A*B + beta*C, 00050 *> 00051 *> SIDE = 'R' or 'r' C := alpha*B*A + beta*C, 00052 *> \endverbatim 00053 *> 00054 *> \param[in] UPLO 00055 *> \verbatim 00056 *> UPLO is CHARACTER*1 00057 *> On entry, UPLO specifies whether the upper or lower 00058 *> triangular part of the hermitian matrix A is to be 00059 *> referenced as follows: 00060 *> 00061 *> UPLO = 'U' or 'u' Only the upper triangular part of the 00062 *> hermitian matrix is to be referenced. 00063 *> 00064 *> UPLO = 'L' or 'l' Only the lower triangular part of the 00065 *> hermitian matrix is to be referenced. 00066 *> \endverbatim 00067 *> 00068 *> \param[in] M 00069 *> \verbatim 00070 *> M is INTEGER 00071 *> On entry, M specifies the number of rows of the matrix C. 00072 *> M must be at least zero. 00073 *> \endverbatim 00074 *> 00075 *> \param[in] N 00076 *> \verbatim 00077 *> N is INTEGER 00078 *> On entry, N specifies the number of columns of the matrix C. 00079 *> N must be at least zero. 00080 *> \endverbatim 00081 *> 00082 *> \param[in] ALPHA 00083 *> \verbatim 00084 *> ALPHA is COMPLEX 00085 *> On entry, ALPHA specifies the scalar alpha. 00086 *> \endverbatim 00087 *> 00088 *> \param[in] A 00089 *> \verbatim 00090 *> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is 00091 *> m when SIDE = 'L' or 'l' and is n otherwise. 00092 *> Before entry with SIDE = 'L' or 'l', the m by m part of 00093 *> the array A must contain the hermitian matrix, such that 00094 *> when UPLO = 'U' or 'u', the leading m by m upper triangular 00095 *> part of the array A must contain the upper triangular part 00096 *> of the hermitian matrix and the strictly lower triangular 00097 *> part of A is not referenced, and when UPLO = 'L' or 'l', 00098 *> the leading m by m lower triangular part of the array A 00099 *> must contain the lower triangular part of the hermitian 00100 *> matrix and the strictly upper triangular part of A is not 00101 *> referenced. 00102 *> Before entry with SIDE = 'R' or 'r', the n by n part of 00103 *> the array A must contain the hermitian matrix, such that 00104 *> when UPLO = 'U' or 'u', the leading n by n upper triangular 00105 *> part of the array A must contain the upper triangular part 00106 *> of the hermitian matrix and the strictly lower triangular 00107 *> part of A is not referenced, and when UPLO = 'L' or 'l', 00108 *> the leading n by n lower triangular part of the array A 00109 *> must contain the lower triangular part of the hermitian 00110 *> matrix and the strictly upper triangular part of A is not 00111 *> referenced. 00112 *> Note that the imaginary parts of the diagonal elements need 00113 *> not be set, they are assumed to be zero. 00114 *> \endverbatim 00115 *> 00116 *> \param[in] LDA 00117 *> \verbatim 00118 *> LDA is INTEGER 00119 *> On entry, LDA specifies the first dimension of A as declared 00120 *> in the calling (sub) program. When SIDE = 'L' or 'l' then 00121 *> LDA must be at least max( 1, m ), otherwise LDA must be at 00122 *> least max( 1, n ). 00123 *> \endverbatim 00124 *> 00125 *> \param[in] B 00126 *> \verbatim 00127 *> B is COMPLEX array of DIMENSION ( LDB, n ). 00128 *> Before entry, the leading m by n part of the array B must 00129 *> contain the matrix B. 00130 *> \endverbatim 00131 *> 00132 *> \param[in] LDB 00133 *> \verbatim 00134 *> LDB is INTEGER 00135 *> On entry, LDB specifies the first dimension of B as declared 00136 *> in the calling (sub) program. LDB must be at least 00137 *> max( 1, m ). 00138 *> \endverbatim 00139 *> 00140 *> \param[in] BETA 00141 *> \verbatim 00142 *> BETA is COMPLEX 00143 *> On entry, BETA specifies the scalar beta. When BETA is 00144 *> supplied as zero then C need not be set on input. 00145 *> \endverbatim 00146 *> 00147 *> \param[in,out] C 00148 *> \verbatim 00149 *> C is COMPLEX array of DIMENSION ( LDC, n ). 00150 *> Before entry, the leading m by n part of the array C must 00151 *> contain the matrix C, except when beta is zero, in which 00152 *> case C need not be set on entry. 00153 *> On exit, the array C is overwritten by the m by n updated 00154 *> matrix. 00155 *> \endverbatim 00156 *> 00157 *> \param[in] LDC 00158 *> \verbatim 00159 *> LDC is INTEGER 00160 *> On entry, LDC specifies the first dimension of C as declared 00161 *> in the calling (sub) program. LDC must be at least 00162 *> max( 1, m ). 00163 *> \endverbatim 00164 * 00165 * Authors: 00166 * ======== 00167 * 00168 *> \author Univ. of Tennessee 00169 *> \author Univ. of California Berkeley 00170 *> \author Univ. of Colorado Denver 00171 *> \author NAG Ltd. 00172 * 00173 *> \date November 2011 00174 * 00175 *> \ingroup complex_blas_level3 00176 * 00177 *> \par Further Details: 00178 * ===================== 00179 *> 00180 *> \verbatim 00181 *> 00182 *> Level 3 Blas routine. 00183 *> 00184 *> -- Written on 8-February-1989. 00185 *> Jack Dongarra, Argonne National Laboratory. 00186 *> Iain Duff, AERE Harwell. 00187 *> Jeremy Du Croz, Numerical Algorithms Group Ltd. 00188 *> Sven Hammarling, Numerical Algorithms Group Ltd. 00189 *> \endverbatim 00190 *> 00191 * ===================================================================== 00192 SUBROUTINE CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) 00193 * 00194 * -- Reference BLAS level3 routine (version 3.4.0) -- 00195 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00196 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00197 * November 2011 00198 * 00199 * .. Scalar Arguments .. 00200 COMPLEX ALPHA,BETA 00201 INTEGER LDA,LDB,LDC,M,N 00202 CHARACTER SIDE,UPLO 00203 * .. 00204 * .. Array Arguments .. 00205 COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) 00206 * .. 00207 * 00208 * ===================================================================== 00209 * 00210 * .. External Functions .. 00211 LOGICAL LSAME 00212 EXTERNAL LSAME 00213 * .. 00214 * .. External Subroutines .. 00215 EXTERNAL XERBLA 00216 * .. 00217 * .. Intrinsic Functions .. 00218 INTRINSIC CONJG,MAX,REAL 00219 * .. 00220 * .. Local Scalars .. 00221 COMPLEX TEMP1,TEMP2 00222 INTEGER I,INFO,J,K,NROWA 00223 LOGICAL UPPER 00224 * .. 00225 * .. Parameters .. 00226 COMPLEX ONE 00227 PARAMETER (ONE= (1.0E+0,0.0E+0)) 00228 COMPLEX ZERO 00229 PARAMETER (ZERO= (0.0E+0,0.0E+0)) 00230 * .. 00231 * 00232 * Set NROWA as the number of rows of A. 00233 * 00234 IF (LSAME(SIDE,'L')) THEN 00235 NROWA = M 00236 ELSE 00237 NROWA = N 00238 END IF 00239 UPPER = LSAME(UPLO,'U') 00240 * 00241 * Test the input parameters. 00242 * 00243 INFO = 0 00244 IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN 00245 INFO = 1 00246 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 00247 INFO = 2 00248 ELSE IF (M.LT.0) THEN 00249 INFO = 3 00250 ELSE IF (N.LT.0) THEN 00251 INFO = 4 00252 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 00253 INFO = 7 00254 ELSE IF (LDB.LT.MAX(1,M)) THEN 00255 INFO = 9 00256 ELSE IF (LDC.LT.MAX(1,M)) THEN 00257 INFO = 12 00258 END IF 00259 IF (INFO.NE.0) THEN 00260 CALL XERBLA('CHEMM ',INFO) 00261 RETURN 00262 END IF 00263 * 00264 * Quick return if possible. 00265 * 00266 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 00267 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 00268 * 00269 * And when alpha.eq.zero. 00270 * 00271 IF (ALPHA.EQ.ZERO) THEN 00272 IF (BETA.EQ.ZERO) THEN 00273 DO 20 J = 1,N 00274 DO 10 I = 1,M 00275 C(I,J) = ZERO 00276 10 CONTINUE 00277 20 CONTINUE 00278 ELSE 00279 DO 40 J = 1,N 00280 DO 30 I = 1,M 00281 C(I,J) = BETA*C(I,J) 00282 30 CONTINUE 00283 40 CONTINUE 00284 END IF 00285 RETURN 00286 END IF 00287 * 00288 * Start the operations. 00289 * 00290 IF (LSAME(SIDE,'L')) THEN 00291 * 00292 * Form C := alpha*A*B + beta*C. 00293 * 00294 IF (UPPER) THEN 00295 DO 70 J = 1,N 00296 DO 60 I = 1,M 00297 TEMP1 = ALPHA*B(I,J) 00298 TEMP2 = ZERO 00299 DO 50 K = 1,I - 1 00300 C(K,J) = C(K,J) + TEMP1*A(K,I) 00301 TEMP2 = TEMP2 + B(K,J)*CONJG(A(K,I)) 00302 50 CONTINUE 00303 IF (BETA.EQ.ZERO) THEN 00304 C(I,J) = TEMP1*REAL(A(I,I)) + ALPHA*TEMP2 00305 ELSE 00306 C(I,J) = BETA*C(I,J) + TEMP1*REAL(A(I,I)) + 00307 + ALPHA*TEMP2 00308 END IF 00309 60 CONTINUE 00310 70 CONTINUE 00311 ELSE 00312 DO 100 J = 1,N 00313 DO 90 I = M,1,-1 00314 TEMP1 = ALPHA*B(I,J) 00315 TEMP2 = ZERO 00316 DO 80 K = I + 1,M 00317 C(K,J) = C(K,J) + TEMP1*A(K,I) 00318 TEMP2 = TEMP2 + B(K,J)*CONJG(A(K,I)) 00319 80 CONTINUE 00320 IF (BETA.EQ.ZERO) THEN 00321 C(I,J) = TEMP1*REAL(A(I,I)) + ALPHA*TEMP2 00322 ELSE 00323 C(I,J) = BETA*C(I,J) + TEMP1*REAL(A(I,I)) + 00324 + ALPHA*TEMP2 00325 END IF 00326 90 CONTINUE 00327 100 CONTINUE 00328 END IF 00329 ELSE 00330 * 00331 * Form C := alpha*B*A + beta*C. 00332 * 00333 DO 170 J = 1,N 00334 TEMP1 = ALPHA*REAL(A(J,J)) 00335 IF (BETA.EQ.ZERO) THEN 00336 DO 110 I = 1,M 00337 C(I,J) = TEMP1*B(I,J) 00338 110 CONTINUE 00339 ELSE 00340 DO 120 I = 1,M 00341 C(I,J) = BETA*C(I,J) + TEMP1*B(I,J) 00342 120 CONTINUE 00343 END IF 00344 DO 140 K = 1,J - 1 00345 IF (UPPER) THEN 00346 TEMP1 = ALPHA*A(K,J) 00347 ELSE 00348 TEMP1 = ALPHA*CONJG(A(J,K)) 00349 END IF 00350 DO 130 I = 1,M 00351 C(I,J) = C(I,J) + TEMP1*B(I,K) 00352 130 CONTINUE 00353 140 CONTINUE 00354 DO 160 K = J + 1,N 00355 IF (UPPER) THEN 00356 TEMP1 = ALPHA*CONJG(A(J,K)) 00357 ELSE 00358 TEMP1 = ALPHA*A(K,J) 00359 END IF 00360 DO 150 I = 1,M 00361 C(I,J) = C(I,J) + TEMP1*B(I,K) 00362 150 CONTINUE 00363 160 CONTINUE 00364 170 CONTINUE 00365 END IF 00366 * 00367 RETURN 00368 * 00369 * End of CHEMM . 00370 * 00371 END