1*> \brief \b CGEMM 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 CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) 12* 13* .. Scalar Arguments .. 14* COMPLEX ALPHA,BETA 15* INTEGER K,LDA,LDB,LDC,M,N 16* CHARACTER TRANSA,TRANSB 17* .. 18* .. Array Arguments .. 19* COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> CGEMM performs one of the matrix-matrix operations 29*> 30*> C := alpha*op( A )*op( B ) + beta*C, 31*> 32*> where op( X ) is one of 33*> 34*> op( X ) = X or op( X ) = X**T or op( X ) = X**H, 35*> 36*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) 37*> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. 38*> \endverbatim 39* 40* Arguments: 41* ========== 42* 43*> \param[in] TRANSA 44*> \verbatim 45*> TRANSA is CHARACTER*1 46*> On entry, TRANSA specifies the form of op( A ) to be used in 47*> the matrix multiplication as follows: 48*> 49*> TRANSA = 'N' or 'n', op( A ) = A. 50*> 51*> TRANSA = 'T' or 't', op( A ) = A**T. 52*> 53*> TRANSA = 'C' or 'c', op( A ) = A**H. 54*> \endverbatim 55*> 56*> \param[in] TRANSB 57*> \verbatim 58*> TRANSB is CHARACTER*1 59*> On entry, TRANSB specifies the form of op( B ) to be used in 60*> the matrix multiplication as follows: 61*> 62*> TRANSB = 'N' or 'n', op( B ) = B. 63*> 64*> TRANSB = 'T' or 't', op( B ) = B**T. 65*> 66*> TRANSB = 'C' or 'c', op( B ) = B**H. 67*> \endverbatim 68*> 69*> \param[in] M 70*> \verbatim 71*> M is INTEGER 72*> On entry, M specifies the number of rows of the matrix 73*> op( A ) and of the matrix C. M must be at least zero. 74*> \endverbatim 75*> 76*> \param[in] N 77*> \verbatim 78*> N is INTEGER 79*> On entry, N specifies the number of columns of the matrix 80*> op( B ) and the number of columns of the matrix C. N must be 81*> at least zero. 82*> \endverbatim 83*> 84*> \param[in] K 85*> \verbatim 86*> K is INTEGER 87*> On entry, K specifies the number of columns of the matrix 88*> op( A ) and the number of rows of the matrix op( B ). K must 89*> be at least zero. 90*> \endverbatim 91*> 92*> \param[in] ALPHA 93*> \verbatim 94*> ALPHA is COMPLEX 95*> On entry, ALPHA specifies the scalar alpha. 96*> \endverbatim 97*> 98*> \param[in] A 99*> \verbatim 100*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is 101*> k when TRANSA = 'N' or 'n', and is m otherwise. 102*> Before entry with TRANSA = 'N' or 'n', the leading m by k 103*> part of the array A must contain the matrix A, otherwise 104*> the leading k by m part of the array A must contain the 105*> matrix A. 106*> \endverbatim 107*> 108*> \param[in] LDA 109*> \verbatim 110*> LDA is INTEGER 111*> On entry, LDA specifies the first dimension of A as declared 112*> in the calling (sub) program. When TRANSA = 'N' or 'n' then 113*> LDA must be at least max( 1, m ), otherwise LDA must be at 114*> least max( 1, k ). 115*> \endverbatim 116*> 117*> \param[in] B 118*> \verbatim 119*> B is COMPLEX array of DIMENSION ( LDB, kb ), where kb is 120*> n when TRANSB = 'N' or 'n', and is k otherwise. 121*> Before entry with TRANSB = 'N' or 'n', the leading k by n 122*> part of the array B must contain the matrix B, otherwise 123*> the leading n by k part of the array B must contain the 124*> matrix B. 125*> \endverbatim 126*> 127*> \param[in] LDB 128*> \verbatim 129*> LDB is INTEGER 130*> On entry, LDB specifies the first dimension of B as declared 131*> in the calling (sub) program. When TRANSB = 'N' or 'n' then 132*> LDB must be at least max( 1, k ), otherwise LDB must be at 133*> least max( 1, n ). 134*> \endverbatim 135*> 136*> \param[in] BETA 137*> \verbatim 138*> BETA is COMPLEX 139*> On entry, BETA specifies the scalar beta. When BETA is 140*> supplied as zero then C need not be set on input. 141*> \endverbatim 142*> 143*> \param[in,out] C 144*> \verbatim 145*> C is COMPLEX array of DIMENSION ( LDC, n ). 146*> Before entry, the leading m by n part of the array C must 147*> contain the matrix C, except when beta is zero, in which 148*> case C need not be set on entry. 149*> On exit, the array C is overwritten by the m by n matrix 150*> ( alpha*op( A )*op( B ) + beta*C ). 151*> \endverbatim 152*> 153*> \param[in] LDC 154*> \verbatim 155*> LDC is INTEGER 156*> On entry, LDC specifies the first dimension of C as declared 157*> in the calling (sub) program. LDC must be at least 158*> max( 1, m ). 159*> \endverbatim 160* 161* Authors: 162* ======== 163* 164*> \author Univ. of Tennessee 165*> \author Univ. of California Berkeley 166*> \author Univ. of Colorado Denver 167*> \author NAG Ltd. 168* 169*> \date November 2011 170* 171*> \ingroup complex_blas_level3 172* 173*> \par Further Details: 174* ===================== 175*> 176*> \verbatim 177*> 178*> Level 3 Blas routine. 179*> 180*> -- Written on 8-February-1989. 181*> Jack Dongarra, Argonne National Laboratory. 182*> Iain Duff, AERE Harwell. 183*> Jeremy Du Croz, Numerical Algorithms Group Ltd. 184*> Sven Hammarling, Numerical Algorithms Group Ltd. 185*> \endverbatim 186*> 187* ===================================================================== 188 SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) 189* 190* -- Reference BLAS level3 routine (version 3.4.0) -- 191* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 192* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 193* November 2011 194* 195* .. Scalar Arguments .. 196 COMPLEX ALPHA,BETA 197 INTEGER K,LDA,LDB,LDC,M,N 198 CHARACTER TRANSA,TRANSB 199* .. 200* .. Array Arguments .. 201 COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) 202* .. 203* 204* ===================================================================== 205* 206* .. External Functions .. 207 LOGICAL LSAME 208 EXTERNAL LSAME 209* .. 210* .. External Subroutines .. 211 EXTERNAL XERBLA 212* .. 213* .. Intrinsic Functions .. 214 INTRINSIC CONJG,MAX 215* .. 216* .. Local Scalars .. 217 COMPLEX TEMP 218 INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB 219 LOGICAL CONJA,CONJB,NOTA,NOTB 220* .. 221* .. Parameters .. 222 COMPLEX ONE 223 PARAMETER (ONE= (1.0E+0,0.0E+0)) 224 COMPLEX ZERO 225 PARAMETER (ZERO= (0.0E+0,0.0E+0)) 226* .. 227* 228* Set NOTA and NOTB as true if A and B respectively are not 229* conjugated or transposed, set CONJA and CONJB as true if A and 230* B respectively are to be transposed but not conjugated and set 231* NROWA, NCOLA and NROWB as the number of rows and columns of A 232* and the number of rows of B respectively. 233* 234 NOTA = LSAME(TRANSA,'N') 235 NOTB = LSAME(TRANSB,'N') 236 CONJA = LSAME(TRANSA,'C') 237 CONJB = LSAME(TRANSB,'C') 238 IF (NOTA) THEN 239 NROWA = M 240 NCOLA = K 241 ELSE 242 NROWA = K 243 NCOLA = M 244 END IF 245 IF (NOTB) THEN 246 NROWB = K 247 ELSE 248 NROWB = N 249 END IF 250* 251* Test the input parameters. 252* 253 INFO = 0 254 IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND. 255 + (.NOT.LSAME(TRANSA,'T'))) THEN 256 INFO = 1 257 ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND. 258 + (.NOT.LSAME(TRANSB,'T'))) THEN 259 INFO = 2 260 ELSE IF (M.LT.0) THEN 261 INFO = 3 262 ELSE IF (N.LT.0) THEN 263 INFO = 4 264 ELSE IF (K.LT.0) THEN 265 INFO = 5 266 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 267 INFO = 8 268 ELSE IF (LDB.LT.MAX(1,NROWB)) THEN 269 INFO = 10 270 ELSE IF (LDC.LT.MAX(1,M)) THEN 271 INFO = 13 272 END IF 273 IF (INFO.NE.0) THEN 274 CALL XERBLA('CGEMM ',INFO) 275 RETURN 276 END IF 277* 278* Quick return if possible. 279* 280 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 281 + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN 282* 283* And when alpha.eq.zero. 284* 285 IF (ALPHA.EQ.ZERO) THEN 286 IF (BETA.EQ.ZERO) THEN 287 DO 20 J = 1,N 288 DO 10 I = 1,M 289 C(I,J) = ZERO 290 10 CONTINUE 291 20 CONTINUE 292 ELSE 293 DO 40 J = 1,N 294 DO 30 I = 1,M 295 C(I,J) = BETA*C(I,J) 296 30 CONTINUE 297 40 CONTINUE 298 END IF 299 RETURN 300 END IF 301* 302* Start the operations. 303* 304 IF (NOTB) THEN 305 IF (NOTA) THEN 306* 307* Form C := alpha*A*B + beta*C. 308* 309 DO 90 J = 1,N 310 IF (BETA.EQ.ZERO) THEN 311 DO 50 I = 1,M 312 C(I,J) = ZERO 313 50 CONTINUE 314 ELSE IF (BETA.NE.ONE) THEN 315 DO 60 I = 1,M 316 C(I,J) = BETA*C(I,J) 317 60 CONTINUE 318 END IF 319 DO 80 L = 1,K 320 IF (B(L,J).NE.ZERO) THEN 321 TEMP = ALPHA*B(L,J) 322 DO 70 I = 1,M 323 C(I,J) = C(I,J) + TEMP*A(I,L) 324 70 CONTINUE 325 END IF 326 80 CONTINUE 327 90 CONTINUE 328 ELSE IF (CONJA) THEN 329* 330* Form C := alpha*A**H*B + beta*C. 331* 332 DO 120 J = 1,N 333 DO 110 I = 1,M 334 TEMP = ZERO 335 DO 100 L = 1,K 336 TEMP = TEMP + CONJG(A(L,I))*B(L,J) 337 100 CONTINUE 338 IF (BETA.EQ.ZERO) THEN 339 C(I,J) = ALPHA*TEMP 340 ELSE 341 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 342 END IF 343 110 CONTINUE 344 120 CONTINUE 345 ELSE 346* 347* Form C := alpha*A**T*B + beta*C 348* 349 DO 150 J = 1,N 350 DO 140 I = 1,M 351 TEMP = ZERO 352 DO 130 L = 1,K 353 TEMP = TEMP + A(L,I)*B(L,J) 354 130 CONTINUE 355 IF (BETA.EQ.ZERO) THEN 356 C(I,J) = ALPHA*TEMP 357 ELSE 358 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 359 END IF 360 140 CONTINUE 361 150 CONTINUE 362 END IF 363 ELSE IF (NOTA) THEN 364 IF (CONJB) THEN 365* 366* Form C := alpha*A*B**H + beta*C. 367* 368 DO 200 J = 1,N 369 IF (BETA.EQ.ZERO) THEN 370 DO 160 I = 1,M 371 C(I,J) = ZERO 372 160 CONTINUE 373 ELSE IF (BETA.NE.ONE) THEN 374 DO 170 I = 1,M 375 C(I,J) = BETA*C(I,J) 376 170 CONTINUE 377 END IF 378 DO 190 L = 1,K 379 IF (B(J,L).NE.ZERO) THEN 380 TEMP = ALPHA*CONJG(B(J,L)) 381 DO 180 I = 1,M 382 C(I,J) = C(I,J) + TEMP*A(I,L) 383 180 CONTINUE 384 END IF 385 190 CONTINUE 386 200 CONTINUE 387 ELSE 388* 389* Form C := alpha*A*B**T + beta*C 390* 391 DO 250 J = 1,N 392 IF (BETA.EQ.ZERO) THEN 393 DO 210 I = 1,M 394 C(I,J) = ZERO 395 210 CONTINUE 396 ELSE IF (BETA.NE.ONE) THEN 397 DO 220 I = 1,M 398 C(I,J) = BETA*C(I,J) 399 220 CONTINUE 400 END IF 401 DO 240 L = 1,K 402 IF (B(J,L).NE.ZERO) THEN 403 TEMP = ALPHA*B(J,L) 404 DO 230 I = 1,M 405 C(I,J) = C(I,J) + TEMP*A(I,L) 406 230 CONTINUE 407 END IF 408 240 CONTINUE 409 250 CONTINUE 410 END IF 411 ELSE IF (CONJA) THEN 412 IF (CONJB) THEN 413* 414* Form C := alpha*A**H*B**H + beta*C. 415* 416 DO 280 J = 1,N 417 DO 270 I = 1,M 418 TEMP = ZERO 419 DO 260 L = 1,K 420 TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L)) 421 260 CONTINUE 422 IF (BETA.EQ.ZERO) THEN 423 C(I,J) = ALPHA*TEMP 424 ELSE 425 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 426 END IF 427 270 CONTINUE 428 280 CONTINUE 429 ELSE 430* 431* Form C := alpha*A**H*B**T + beta*C 432* 433 DO 310 J = 1,N 434 DO 300 I = 1,M 435 TEMP = ZERO 436 DO 290 L = 1,K 437 TEMP = TEMP + CONJG(A(L,I))*B(J,L) 438 290 CONTINUE 439 IF (BETA.EQ.ZERO) THEN 440 C(I,J) = ALPHA*TEMP 441 ELSE 442 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 443 END IF 444 300 CONTINUE 445 310 CONTINUE 446 END IF 447 ELSE 448 IF (CONJB) THEN 449* 450* Form C := alpha*A**T*B**H + beta*C 451* 452 DO 340 J = 1,N 453 DO 330 I = 1,M 454 TEMP = ZERO 455 DO 320 L = 1,K 456 TEMP = TEMP + A(L,I)*CONJG(B(J,L)) 457 320 CONTINUE 458 IF (BETA.EQ.ZERO) THEN 459 C(I,J) = ALPHA*TEMP 460 ELSE 461 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 462 END IF 463 330 CONTINUE 464 340 CONTINUE 465 ELSE 466* 467* Form C := alpha*A**T*B**T + beta*C 468* 469 DO 370 J = 1,N 470 DO 360 I = 1,M 471 TEMP = ZERO 472 DO 350 L = 1,K 473 TEMP = TEMP + A(L,I)*B(J,L) 474 350 CONTINUE 475 IF (BETA.EQ.ZERO) THEN 476 C(I,J) = ALPHA*TEMP 477 ELSE 478 C(I,J) = ALPHA*TEMP + BETA*C(I,J) 479 END IF 480 360 CONTINUE 481 370 CONTINUE 482 END IF 483 END IF 484* 485 RETURN 486* 487* End of CGEMM . 488* 489 END 490