LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zgemmtr.f
Go to the documentation of this file.
1*> \brief \b ZGEMMTR
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 ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA,
12* C,LDC)
13*
14* .. Scalar Arguments ..
15* COMPLEX*16 ALPHA,BETA
16* INTEGER K,LDA,LDB,LDC,N
17* CHARACTER TRANSA,TRANSB, UPLO
18* ..
19* .. Array Arguments ..
20* COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
21* ..
22*
23*
24*> \par Purpose:
25* =============
26*>
27*> \verbatim
28*>
29*> ZGEMMTR performs one of the matrix-matrix operations
30*>
31*> C := alpha*op( A )*op( B ) + beta*C,
32*>
33*> where op( X ) is one of
34*>
35*> op( X ) = X or op( X ) = X**T,
36*>
37*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
38*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix.
39*> Thereby, the routine only accesses and updates the upper or lower
40*> triangular part of the result matrix C. This behaviour can be used if
41*> the resulting matrix C is known to be Hermitian or symmetric.
42*> \endverbatim
43*
44* Arguments:
45* ==========
46*
47*> \param[in] UPLO
48*> \verbatim
49*> UPLO is CHARACTER*1
50*> On entry, UPLO specifies whether the lower or the upper
51*> triangular part of C is access and updated.
52*>
53*> UPLO = 'L' or 'l', the lower triangular part of C is used.
54*>
55*> UPLO = 'U' or 'u', the upper triangular part of C is used.
56*> \endverbatim
57*
58*> \param[in] TRANSA
59*> \verbatim
60*> TRANSA is CHARACTER*1
61*> On entry, TRANSA specifies the form of op( A ) to be used in
62*> the matrix multiplication as follows:
63*>
64*> TRANSA = 'N' or 'n', op( A ) = A.
65*>
66*> TRANSA = 'T' or 't', op( A ) = A**T.
67*>
68*> TRANSA = 'C' or 'c', op( A ) = A**H.
69*> \endverbatim
70*>
71*> \param[in] TRANSB
72*> \verbatim
73*> TRANSB is CHARACTER*1
74*> On entry, TRANSB specifies the form of op( B ) to be used in
75*> the matrix multiplication as follows:
76*>
77*> TRANSB = 'N' or 'n', op( B ) = B.
78*>
79*> TRANSB = 'T' or 't', op( B ) = B**T.
80*>
81*> TRANSB = 'C' or 'c', op( B ) = B**H.
82*> \endverbatim
83*>
84*> \param[in] N
85*> \verbatim
86*> N is INTEGER
87*> On entry, N specifies the number of rows and columns of
88*> the matrix C, the number of columns of op(B) and the number
89*> of rows of op(A). N must be at least zero.
90*> \endverbatim
91*>
92*> \param[in] K
93*> \verbatim
94*> K is INTEGER
95*> On entry, K specifies the number of columns of the matrix
96*> op( A ) and the number of rows of the matrix op( B ). K must
97*> be at least zero.
98*> \endverbatim
99*>
100*> \param[in] ALPHA
101*> \verbatim
102*> ALPHA is COMPLEX*16.
103*> On entry, ALPHA specifies the scalar alpha.
104*> \endverbatim
105*>
106*> \param[in] A
107*> \verbatim
108*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
109*> k when TRANSA = 'N' or 'n', and is n otherwise.
110*> Before entry with TRANSA = 'N' or 'n', the leading n by k
111*> part of the array A must contain the matrix A, otherwise
112*> the leading k by m part of the array A must contain the
113*> matrix A.
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 TRANSA = 'N' or 'n' then
121*> LDA must be at least max( 1, n ), otherwise LDA must be at
122*> least max( 1, k ).
123*> \endverbatim
124*>
125*> \param[in] B
126*> \verbatim
127*> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is
128*> n when TRANSB = 'N' or 'n', and is k otherwise.
129*> Before entry with TRANSB = 'N' or 'n', the leading k by n
130*> part of the array B must contain the matrix B, otherwise
131*> the leading n by k part of the array B must contain the
132*> matrix B.
133*> \endverbatim
134*>
135*> \param[in] LDB
136*> \verbatim
137*> LDB is INTEGER
138*> On entry, LDB specifies the first dimension of B as declared
139*> in the calling (sub) program. When TRANSB = 'N' or 'n' then
140*> LDB must be at least max( 1, k ), otherwise LDB must be at
141*> least max( 1, n ).
142*> \endverbatim
143*>
144*> \param[in] BETA
145*> \verbatim
146*> BETA is COMPLEX*16.
147*> On entry, BETA specifies the scalar beta. When BETA is
148*> supplied as zero then C need not be set on input.
149*> \endverbatim
150*>
151*> \param[in,out] C
152*> \verbatim
153*> C is COMPLEX*16 array, dimension ( LDC, N )
154*> Before entry, the leading n by n part of the array C must
155*> contain the matrix C, except when beta is zero, in which
156*> case C need not be set on entry.
157*> On exit, the upper or lower triangular part of the matrix
158*> C is overwritten by the n by n matrix
159*> ( alpha*op( A )*op( B ) + beta*C ).
160*> \endverbatim
161*>
162*> \param[in] LDC
163*> \verbatim
164*> LDC is INTEGER
165*> On entry, LDC specifies the first dimension of C as declared
166*> in the calling (sub) program. LDC must be at least
167*> max( 1, n ).
168*> \endverbatim
169*
170* Authors:
171* ========
172*
173*> \author Martin Koehler
174*
175*> \ingroup gemmtr
176*
177*> \par Further Details:
178* =====================
179*>
180*> \verbatim
181*>
182*> Level 3 Blas routine.
183*>
184*> -- Written on 19-July-2023.
185*> Martin Koehler, MPI Magdeburg
186*> \endverbatim
187*>
188* =====================================================================
189 SUBROUTINE zgemmtr(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
190 + BETA,C,LDC)
191 IMPLICIT NONE
192*
193* -- Reference BLAS level3 routine --
194* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
195* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
196*
197* .. Scalar Arguments ..
198 COMPLEX*16 ALPHA,BETA
199 INTEGER K,LDA,LDB,LDC,N
200 CHARACTER TRANSA,TRANSB,UPLO
201* ..
202* .. Array Arguments ..
203 COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
204* ..
205*
206* =====================================================================
207*
208* .. External Functions ..
209 LOGICAL LSAME
210 EXTERNAL lsame
211* ..
212* .. External Subroutines ..
213 EXTERNAL xerbla
214* ..
215* .. Intrinsic Functions ..
216 INTRINSIC conjg,max
217* ..
218* .. Local Scalars ..
219 COMPLEX*16 TEMP
220 INTEGER I,INFO,J,L,NROWA,NROWB,ISTART, ISTOP
221 LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER
222* ..
223* .. Parameters ..
224 COMPLEX*16 ONE
225 parameter(one= (1.0d+0,0.0d+0))
226 COMPLEX*16 ZERO
227 parameter(zero= (0.0d+0,0.0d+0))
228* ..
229*
230* Set NOTA and NOTB as true if A and B respectively are not
231* conjugated or transposed, set CONJA and CONJB as true if A and
232* B respectively are to be transposed but not conjugated and set
233* NROWA and NROWB as the number of rows of A and B respectively.
234*
235 nota = lsame(transa,'N')
236 notb = lsame(transb,'N')
237 conja = lsame(transa,'C')
238 conjb = lsame(transb,'C')
239 IF (nota) THEN
240 nrowa = n
241 ELSE
242 nrowa = k
243 END IF
244 IF (notb) THEN
245 nrowb = k
246 ELSE
247 nrowb = n
248 END IF
249 upper = lsame(uplo, 'U')
250
251*
252* Test the input parameters.
253*
254 info = 0
255 IF ((.NOT. upper) .AND. (.NOT. lsame(uplo, 'L'))) THEN
256 info = 1
257 ELSE IF ((.NOT.nota) .AND. (.NOT.conja) .AND.
258 + (.NOT.lsame(transa,'T'))) THEN
259 info = 2
260 ELSE IF ((.NOT.notb) .AND. (.NOT.conjb) .AND.
261 + (.NOT.lsame(transb,'T'))) THEN
262 info = 3
263 ELSE IF (n.LT.0) THEN
264 info = 4
265 ELSE IF (k.LT.0) THEN
266 info = 5
267 ELSE IF (lda.LT.max(1,nrowa)) THEN
268 info = 8
269 ELSE IF (ldb.LT.max(1,nrowb)) THEN
270 info = 10
271 ELSE IF (ldc.LT.max(1,n)) THEN
272 info = 13
273 END IF
274 IF (info.NE.0) THEN
275 CALL xerbla('ZGEMMTR',info)
276 RETURN
277 END IF
278*
279* Quick return if possible.
280*
281 IF (n.EQ.0) 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 IF (upper) THEN
289 istart = 1
290 istop = j
291 ELSE
292 istart = j
293 istop = n
294 END IF
295
296 DO 10 i = istart, istop
297 c(i,j) = zero
298 10 CONTINUE
299 20 CONTINUE
300 ELSE
301 DO 40 j = 1,n
302 IF (upper) THEN
303 istart = 1
304 istop = j
305 ELSE
306 istart = j
307 istop = n
308 END IF
309 DO 30 i = istart, istop
310 c(i,j) = beta*c(i,j)
311 30 CONTINUE
312 40 CONTINUE
313 END IF
314 RETURN
315 END IF
316*
317* Start the operations.
318*
319 IF (notb) THEN
320 IF (nota) THEN
321*
322* Form C := alpha*A*B + beta*C.
323*
324 DO 90 j = 1,n
325 IF (upper) THEN
326 istart = 1
327 istop = j
328 ELSE
329 istart = j
330 istop = n
331 END IF
332 IF (beta.EQ.zero) THEN
333 DO 50 i = istart, istop
334 c(i,j) = zero
335 50 CONTINUE
336 ELSE IF (beta.NE.one) THEN
337 DO 60 i = istart, istop
338 c(i,j) = beta*c(i,j)
339 60 CONTINUE
340 END IF
341 DO 80 l = 1,k
342 temp = alpha*b(l,j)
343 DO 70 i = istart, istop
344 c(i,j) = c(i,j) + temp*a(i,l)
345 70 CONTINUE
346 80 CONTINUE
347 90 CONTINUE
348 ELSE IF (conja) THEN
349*
350* Form C := alpha*A**H*B + beta*C.
351*
352 DO 120 j = 1,n
353 IF (upper) THEN
354 istart = 1
355 istop = j
356 ELSE
357 istart = j
358 istop = n
359 END IF
360
361 DO 110 i = istart, istop
362 temp = zero
363 DO 100 l = 1,k
364 temp = temp + conjg(a(l,i))*b(l,j)
365 100 CONTINUE
366 IF (beta.EQ.zero) THEN
367 c(i,j) = alpha*temp
368 ELSE
369 c(i,j) = alpha*temp + beta*c(i,j)
370 END IF
371 110 CONTINUE
372 120 CONTINUE
373 ELSE
374*
375* Form C := alpha*A**T*B + beta*C
376*
377 DO 150 j = 1,n
378 IF (upper) THEN
379 istart = 1
380 istop = j
381 ELSE
382 istart = j
383 istop = n
384 END IF
385
386 DO 140 i = istart, istop
387 temp = zero
388 DO 130 l = 1,k
389 temp = temp + a(l,i)*b(l,j)
390 130 CONTINUE
391 IF (beta.EQ.zero) THEN
392 c(i,j) = alpha*temp
393 ELSE
394 c(i,j) = alpha*temp + beta*c(i,j)
395 END IF
396 140 CONTINUE
397 150 CONTINUE
398 END IF
399 ELSE IF (nota) THEN
400 IF (conjb) THEN
401*
402* Form C := alpha*A*B**H + beta*C.
403*
404 DO 200 j = 1,n
405 IF (upper) THEN
406 istart = 1
407 istop = j
408 ELSE
409 istart = j
410 istop = n
411 END IF
412
413 IF (beta.EQ.zero) THEN
414 DO 160 i = istart,istop
415 c(i,j) = zero
416 160 CONTINUE
417 ELSE IF (beta.NE.one) THEN
418 DO 170 i = istart, istop
419 c(i,j) = beta*c(i,j)
420 170 CONTINUE
421 END IF
422 DO 190 l = 1,k
423 temp = alpha*conjg(b(j,l))
424 DO 180 i = istart, istop
425 c(i,j) = c(i,j) + temp*a(i,l)
426 180 CONTINUE
427 190 CONTINUE
428 200 CONTINUE
429 ELSE
430*
431* Form C := alpha*A*B**T + beta*C
432*
433 DO 250 j = 1,n
434 IF (upper) THEN
435 istart = 1
436 istop = j
437 ELSE
438 istart = j
439 istop = n
440 END IF
441
442 IF (beta.EQ.zero) THEN
443 DO 210 i = istart, istop
444 c(i,j) = zero
445 210 CONTINUE
446 ELSE IF (beta.NE.one) THEN
447 DO 220 i = istart, istop
448 c(i,j) = beta*c(i,j)
449 220 CONTINUE
450 END IF
451 DO 240 l = 1,k
452 temp = alpha*b(j,l)
453 DO 230 i = istart, istop
454 c(i,j) = c(i,j) + temp*a(i,l)
455 230 CONTINUE
456 240 CONTINUE
457 250 CONTINUE
458 END IF
459 ELSE IF (conja) THEN
460 IF (conjb) THEN
461*
462* Form C := alpha*A**H*B**H + beta*C.
463*
464 DO 280 j = 1,n
465 IF (upper) THEN
466 istart = 1
467 istop = j
468 ELSE
469 istart = j
470 istop = n
471 END IF
472
473 DO 270 i = istart, istop
474 temp = zero
475 DO 260 l = 1,k
476 temp = temp + conjg(a(l,i))*conjg(b(j,l))
477 260 CONTINUE
478 IF (beta.EQ.zero) THEN
479 c(i,j) = alpha*temp
480 ELSE
481 c(i,j) = alpha*temp + beta*c(i,j)
482 END IF
483 270 CONTINUE
484 280 CONTINUE
485 ELSE
486*
487* Form C := alpha*A**H*B**T + beta*C
488*
489 DO 310 j = 1,n
490 IF (upper) THEN
491 istart = 1
492 istop = j
493 ELSE
494 istart = j
495 istop = n
496 END IF
497
498 DO 300 i = istart, istop
499 temp = zero
500 DO 290 l = 1,k
501 temp = temp + conjg(a(l,i))*b(j,l)
502 290 CONTINUE
503 IF (beta.EQ.zero) THEN
504 c(i,j) = alpha*temp
505 ELSE
506 c(i,j) = alpha*temp + beta*c(i,j)
507 END IF
508 300 CONTINUE
509 310 CONTINUE
510 END IF
511 ELSE
512 IF (conjb) THEN
513*
514* Form C := alpha*A**T*B**H + beta*C
515*
516 DO 340 j = 1,n
517 IF (upper) THEN
518 istart = 1
519 istop = j
520 ELSE
521 istart = j
522 istop = n
523 END IF
524
525 DO 330 i = istart, istop
526 temp = zero
527 DO 320 l = 1,k
528 temp = temp + a(l,i)*conjg(b(j,l))
529 320 CONTINUE
530 IF (beta.EQ.zero) THEN
531 c(i,j) = alpha*temp
532 ELSE
533 c(i,j) = alpha*temp + beta*c(i,j)
534 END IF
535 330 CONTINUE
536 340 CONTINUE
537 ELSE
538*
539* Form C := alpha*A**T*B**T + beta*C
540*
541 DO 370 j = 1,n
542 IF (upper) THEN
543 istart = 1
544 istop = j
545 ELSE
546 istart = j
547 istop = n
548 END IF
549
550 DO 360 i = istart, istop
551 temp = zero
552 DO 350 l = 1,k
553 temp = temp + a(l,i)*b(j,l)
554 350 CONTINUE
555 IF (beta.EQ.zero) THEN
556 c(i,j) = alpha*temp
557 ELSE
558 c(i,j) = alpha*temp + beta*c(i,j)
559 END IF
560 360 CONTINUE
561 370 CONTINUE
562 END IF
563 END IF
564*
565 RETURN
566*
567* End of ZGEMMTR
568*
569 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
zgemmtr
subroutine zgemmtr(uplo, transa, transb, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
ZGEMMTR
Definition zgemmtr.f:191