1*> \brief \b ZHEMM 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE ZHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) 12* 13* .. Scalar Arguments .. 14* COMPLEX*16 ALPHA,BETA 15* INTEGER LDA,LDB,LDC,M,N 16* CHARACTER SIDE,UPLO 17* .. 18* .. Array Arguments .. 19* COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> ZHEMM performs one of the matrix-matrix operations 29*> 30*> C := alpha*A*B + beta*C, 31*> 32*> or 33*> 34*> C := alpha*B*A + beta*C, 35*> 36*> where alpha and beta are scalars, A is an hermitian matrix and B and 37*> C are m by n matrices. 38*> \endverbatim 39* 40* Arguments: 41* ========== 42* 43*> \param[in] SIDE 44*> \verbatim 45*> SIDE is CHARACTER*1 46*> On entry, SIDE specifies whether the hermitian matrix A 47*> appears on the left or right in the operation as follows: 48*> 49*> SIDE = 'L' or 'l' C := alpha*A*B + beta*C, 50*> 51*> SIDE = 'R' or 'r' C := alpha*B*A + beta*C, 52*> \endverbatim 53*> 54*> \param[in] UPLO 55*> \verbatim 56*> UPLO is CHARACTER*1 57*> On entry, UPLO specifies whether the upper or lower 58*> triangular part of the hermitian matrix A is to be 59*> referenced as follows: 60*> 61*> UPLO = 'U' or 'u' Only the upper triangular part of the 62*> hermitian matrix is to be referenced. 63*> 64*> UPLO = 'L' or 'l' Only the lower triangular part of the 65*> hermitian matrix is to be referenced. 66*> \endverbatim 67*> 68*> \param[in] M 69*> \verbatim 70*> M is INTEGER 71*> On entry, M specifies the number of rows of the matrix C. 72*> M must be at least zero. 73*> \endverbatim 74*> 75*> \param[in] N 76*> \verbatim 77*> N is INTEGER 78*> On entry, N specifies the number of columns of the matrix C. 79*> N must be at least zero. 80*> \endverbatim 81*> 82*> \param[in] ALPHA 83*> \verbatim 84*> ALPHA is COMPLEX*16 85*> On entry, ALPHA specifies the scalar alpha. 86*> \endverbatim 87*> 88*> \param[in] A 89*> \verbatim 90*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is 91*> m when SIDE = 'L' or 'l' and is n otherwise. 92*> Before entry with SIDE = 'L' or 'l', the m by m part of 93*> the array A must contain the hermitian matrix, such that 94*> when UPLO = 'U' or 'u', the leading m by m upper triangular 95*> part of the array A must contain the upper triangular part 96*> of the hermitian matrix and the strictly lower triangular 97*> part of A is not referenced, and when UPLO = 'L' or 'l', 98*> the leading m by m lower triangular part of the array A 99*> must contain the lower triangular part of the hermitian 100*> matrix and the strictly upper triangular part of A is not 101*> referenced. 102*> Before entry with SIDE = 'R' or 'r', the n by n part of 103*> the array A must contain the hermitian matrix, such that 104*> when UPLO = 'U' or 'u', the leading n by n upper triangular 105*> part of the array A must contain the upper triangular part 106*> of the hermitian matrix and the strictly lower triangular 107*> part of A is not referenced, and when UPLO = 'L' or 'l', 108*> the leading n by n lower triangular part of the array A 109*> must contain the lower triangular part of the hermitian 110*> matrix and the strictly upper triangular part of A is not 111*> referenced. 112*> Note that the imaginary parts of the diagonal elements need 113*> not be set, they are assumed to be zero. 114*> \endverbatim 115*> 116*> \param[in] LDA 117*> \verbatim 118*> LDA is INTEGER 119*> On entry, LDA specifies the first dimension of A as declared 120*> in the calling (sub) program. When SIDE = 'L' or 'l' then 121*> LDA must be at least max( 1, m ), otherwise LDA must be at 122*> least max( 1, n ). 123*> \endverbatim 124*> 125*> \param[in] B 126*> \verbatim 127*> B is COMPLEX*16 array, dimension ( LDB, N ) 128*> Before entry, the leading m by n part of the array B must 129*> contain the matrix B. 130*> \endverbatim 131*> 132*> \param[in] LDB 133*> \verbatim 134*> LDB is INTEGER 135*> On entry, LDB specifies the first dimension of B as declared 136*> in the calling (sub) program. LDB must be at least 137*> max( 1, m ). 138*> \endverbatim 139*> 140*> \param[in] BETA 141*> \verbatim 142*> BETA is COMPLEX*16 143*> On entry, BETA specifies the scalar beta. When BETA is 144*> supplied as zero then C need not be set on input. 145*> \endverbatim 146*> 147*> \param[in,out] C 148*> \verbatim 149*> C is COMPLEX*16 array, dimension ( LDC, N ) 150*> Before entry, the leading m by n part of the array C must 151*> contain the matrix C, except when beta is zero, in which 152*> case C need not be set on entry. 153*> On exit, the array C is overwritten by the m by n updated 154*> matrix. 155*> \endverbatim 156*> 157*> \param[in] LDC 158*> \verbatim 159*> LDC is INTEGER 160*> On entry, LDC specifies the first dimension of C as declared 161*> in the calling (sub) program. LDC must be at least 162*> max( 1, m ). 163*> \endverbatim 164* 165* Authors: 166* ======== 167* 168*> \author Univ. of Tennessee 169*> \author Univ. of California Berkeley 170*> \author Univ. of Colorado Denver 171*> \author NAG Ltd. 172* 173*> \ingroup complex16_blas_level3 174* 175*> \par Further Details: 176* ===================== 177*> 178*> \verbatim 179*> 180*> Level 3 Blas routine. 181*> 182*> -- Written on 8-February-1989. 183*> Jack Dongarra, Argonne National Laboratory. 184*> Iain Duff, AERE Harwell. 185*> Jeremy Du Croz, Numerical Algorithms Group Ltd. 186*> Sven Hammarling, Numerical Algorithms Group Ltd. 187*> \endverbatim 188*> 189* ===================================================================== 190 SUBROUTINE ZHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) 191* 192* -- Reference BLAS level3 routine -- 193* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 194* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 195* 196* .. Scalar Arguments .. 197 COMPLEX*16 ALPHA,BETA 198 INTEGER LDA,LDB,LDC,M,N 199 CHARACTER SIDE,UPLO 200* .. 201* .. Array Arguments .. 202 COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*) 203* .. 204* 205* ===================================================================== 206* 207* .. External Functions .. 208 LOGICAL LSAME 209 EXTERNAL LSAME 210* .. 211* .. External Subroutines .. 212 EXTERNAL XERBLA 213* .. 214* .. Intrinsic Functions .. 215 INTRINSIC DBLE,DCONJG,MAX 216* .. 217* .. Local Scalars .. 218 COMPLEX*16 TEMP1,TEMP2 219 INTEGER I,INFO,J,K,NROWA 220 LOGICAL UPPER 221* .. 222* .. Parameters .. 223 COMPLEX*16 ONE 224 PARAMETER (ONE= (1.0D+0,0.0D+0)) 225 COMPLEX*16 ZERO 226 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 227* .. 228* 229* Set NROWA as the number of rows of A. 230* 231 IF (LSAME(SIDE,'L')) THEN 232 NROWA = M 233 ELSE 234 NROWA = N 235 END IF 236 UPPER = LSAME(UPLO,'U') 237* 238* Test the input parameters. 239* 240 INFO = 0 241 IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN 242 INFO = 1 243 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 244 INFO = 2 245 ELSE IF (M.LT.0) THEN 246 INFO = 3 247 ELSE IF (N.LT.0) THEN 248 INFO = 4 249 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 250 INFO = 7 251 ELSE IF (LDB.LT.MAX(1,M)) THEN 252 INFO = 9 253 ELSE IF (LDC.LT.MAX(1,M)) THEN 254 INFO = 12 255 END IF 256 IF (INFO.NE.0) THEN 257 CALL XERBLA('ZHEMM ',INFO) 258 RETURN 259 END IF 260* 261* Quick return if possible. 262* 263 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 264 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 265* 266* And when alpha.eq.zero. 267* 268 IF (ALPHA.EQ.ZERO) THEN 269 IF (BETA.EQ.ZERO) THEN 270 DO 20 J = 1,N 271 DO 10 I = 1,M 272 C(I,J) = ZERO 273 10 CONTINUE 274 20 CONTINUE 275 ELSE 276 DO 40 J = 1,N 277 DO 30 I = 1,M 278 C(I,J) = BETA*C(I,J) 279 30 CONTINUE 280 40 CONTINUE 281 END IF 282 RETURN 283 END IF 284* 285* Start the operations. 286* 287 IF (LSAME(SIDE,'L')) THEN 288* 289* Form C := alpha*A*B + beta*C. 290* 291 IF (UPPER) THEN 292 DO 70 J = 1,N 293 DO 60 I = 1,M 294 TEMP1 = ALPHA*B(I,J) 295 TEMP2 = ZERO 296 DO 50 K = 1,I - 1 297 C(K,J) = C(K,J) + TEMP1*A(K,I) 298 TEMP2 = TEMP2 + B(K,J)*DCONJG(A(K,I)) 299 50 CONTINUE 300 IF (BETA.EQ.ZERO) THEN 301 C(I,J) = TEMP1*DBLE(A(I,I)) + ALPHA*TEMP2 302 ELSE 303 C(I,J) = BETA*C(I,J) + TEMP1*DBLE(A(I,I)) + 304 + ALPHA*TEMP2 305 END IF 306 60 CONTINUE 307 70 CONTINUE 308 ELSE 309 DO 100 J = 1,N 310 DO 90 I = M,1,-1 311 TEMP1 = ALPHA*B(I,J) 312 TEMP2 = ZERO 313 DO 80 K = I + 1,M 314 C(K,J) = C(K,J) + TEMP1*A(K,I) 315 TEMP2 = TEMP2 + B(K,J)*DCONJG(A(K,I)) 316 80 CONTINUE 317 IF (BETA.EQ.ZERO) THEN 318 C(I,J) = TEMP1*DBLE(A(I,I)) + ALPHA*TEMP2 319 ELSE 320 C(I,J) = BETA*C(I,J) + TEMP1*DBLE(A(I,I)) + 321 + ALPHA*TEMP2 322 END IF 323 90 CONTINUE 324 100 CONTINUE 325 END IF 326 ELSE 327* 328* Form C := alpha*B*A + beta*C. 329* 330 DO 170 J = 1,N 331 TEMP1 = ALPHA*DBLE(A(J,J)) 332 IF (BETA.EQ.ZERO) THEN 333 DO 110 I = 1,M 334 C(I,J) = TEMP1*B(I,J) 335 110 CONTINUE 336 ELSE 337 DO 120 I = 1,M 338 C(I,J) = BETA*C(I,J) + TEMP1*B(I,J) 339 120 CONTINUE 340 END IF 341 DO 140 K = 1,J - 1 342 IF (UPPER) THEN 343 TEMP1 = ALPHA*A(K,J) 344 ELSE 345 TEMP1 = ALPHA*DCONJG(A(J,K)) 346 END IF 347 DO 130 I = 1,M 348 C(I,J) = C(I,J) + TEMP1*B(I,K) 349 130 CONTINUE 350 140 CONTINUE 351 DO 160 K = J + 1,N 352 IF (UPPER) THEN 353 TEMP1 = ALPHA*DCONJG(A(J,K)) 354 ELSE 355 TEMP1 = ALPHA*A(K,J) 356 END IF 357 DO 150 I = 1,M 358 C(I,J) = C(I,J) + TEMP1*B(I,K) 359 150 CONTINUE 360 160 CONTINUE 361 170 CONTINUE 362 END IF 363* 364 RETURN 365* 366* End of ZHEMM 367* 368 END 369