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