3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
11 * SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
13 * .. Scalar Arguments ..
14 * COMPLEX*16 ALPHA,BETA
15 * INTEGER K,LDA,LDB,LDC,M,N
16 * CHARACTER TRANSA,TRANSB
18 * .. Array Arguments ..
19 * COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
28 *> ZGEMM performs one of the matrix-matrix operations
30 *> C := alpha*op( A )*op( B ) + beta*C,
32 *> where op( X ) is one of
34 *> op( X ) = X or op( X ) = X**T or op( X ) = X**H,
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.
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:
49 *> TRANSA = 'N' or 'n', op( A ) = A.
51 *> TRANSA = 'T' or 't', op( A ) = A**T.
53 *> TRANSA = 'C' or 'c', op( A ) = A**H.
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:
62 *> TRANSB = 'N' or 'n', op( B ) = B.
64 *> TRANSB = 'T' or 't', op( B ) = B**T.
66 *> TRANSB = 'C' or 'c', op( B ) = B**H.
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.
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
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
94 *> ALPHA is COMPLEX*16
95 *> On entry, ALPHA specifies the scalar alpha.
100 *> A is COMPLEX*16 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
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 ).
119 *> B is COMPLEX*16 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
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 ).
138 *> BETA is COMPLEX*16
139 *> On entry, BETA specifies the scalar beta. When BETA is
140 *> supplied as zero then C need not be set on input.
145 *> C is COMPLEX*16 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 ).
156 *> On entry, LDC specifies the first dimension of C as declared
157 *> in the calling (sub) program. LDC must be at least
164 *> \author Univ. of Tennessee
165 *> \author Univ. of California Berkeley
166 *> \author Univ. of Colorado Denver
169 *> \date November 2015
171 *> \ingroup complex16_blas_level3
173 *> \par Further Details:
174 * =====================
178 *> Level 3 Blas routine.
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.
187 * =====================================================================
188 SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
190 * -- Reference BLAS level3 routine (version 3.6.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..--
195 * .. Scalar Arguments ..
196 COMPLEX*16 ALPHA,BETA
197 INTEGER K,LDA,LDB,LDC,M,N
198 CHARACTER TRANSA,TRANSB
200 * .. Array Arguments ..
201 COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
204 * =====================================================================
206 * .. External Functions ..
210 * .. External Subroutines ..
213 * .. Intrinsic Functions ..
216 * .. Local Scalars ..
218 INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
219 LOGICAL CONJA,CONJB,NOTA,NOTB
223 PARAMETER (ONE= (1.0D+0,0.0D+0))
225 PARAMETER (ZERO= (0.0D+0,0.0D+0))
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.
234 NOTA = LSAME(TRANSA,'N')
235 NOTB = LSAME(TRANSB,'N')
236 CONJA = LSAME(TRANSA,'C')
237 CONJB = LSAME(TRANSB,'C')
251 * Test the input parameters.
254 IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND.
255 + (.NOT.LSAME(TRANSA,'T'))) THEN
257 ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND.
258 + (.NOT.LSAME(TRANSB,'T'))) THEN
260 ELSE IF (M.LT.0) THEN
262 ELSE IF (N.LT.0) THEN
264 ELSE IF (K.LT.0) THEN
266 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
268 ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
270 ELSE IF (LDC.LT.MAX(1,M)) THEN
274 CALL XERBLA('ZGEMM ',INFO)
278 * Quick return if possible.
280 IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
281 + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
283 * And when alpha.eq.zero.
285 IF (ALPHA.EQ.ZERO) THEN
286 IF (BETA.EQ.ZERO) THEN
302 * Start the operations.
307 * Form C := alpha*A*B + beta*C.
310 IF (BETA.EQ.ZERO) THEN
314 ELSE IF (BETA.NE.ONE) THEN
322 C(I,J) = C(I,J) + TEMP*A(I,L)
328 * Form C := alpha*A**H*B + beta*C.
334 TEMP = TEMP + DCONJG(A(L,I))*B(L,J)
336 IF (BETA.EQ.ZERO) THEN
339 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
345 * Form C := alpha*A**T*B + beta*C
351 TEMP = TEMP + A(L,I)*B(L,J)
353 IF (BETA.EQ.ZERO) THEN
356 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
364 * Form C := alpha*A*B**H + beta*C.
367 IF (BETA.EQ.ZERO) THEN
371 ELSE IF (BETA.NE.ONE) THEN
377 TEMP = ALPHA*DCONJG(B(J,L))
379 C(I,J) = C(I,J) + TEMP*A(I,L)
385 * Form C := alpha*A*B**T + beta*C
388 IF (BETA.EQ.ZERO) THEN
392 ELSE IF (BETA.NE.ONE) THEN
400 C(I,J) = C(I,J) + TEMP*A(I,L)
408 * Form C := alpha*A**H*B**H + beta*C.
414 TEMP = TEMP + DCONJG(A(L,I))*DCONJG(B(J,L))
416 IF (BETA.EQ.ZERO) THEN
419 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
425 * Form C := alpha*A**H*B**T + beta*C
431 TEMP = TEMP + DCONJG(A(L,I))*B(J,L)
433 IF (BETA.EQ.ZERO) THEN
436 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
444 * Form C := alpha*A**T*B**H + beta*C
450 TEMP = TEMP + A(L,I)*DCONJG(B(J,L))
452 IF (BETA.EQ.ZERO) THEN
455 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
461 * Form C := alpha*A**T*B**T + beta*C
467 TEMP = TEMP + A(L,I)*B(J,L)
469 IF (BETA.EQ.ZERO) THEN
472 C(I,J) = ALPHA*TEMP + BETA*C(I,J)