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