LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cgemmtr()

subroutine cgemmtr ( character uplo,
character transa,
character transb,
integer n,
integer k,
complex alpha,
complex, dimension(lda,*) a,
integer lda,
complex, dimension(ldb,*) b,
integer ldb,
complex beta,
complex, dimension(ldc,*) c,
integer ldc )

CGEMMTR

Purpose:
!>
!> CGEMMTR  performs one of the matrix-matrix operations
!>
!>    C := alpha*op( A )*op( B ) + beta*C,
!>
!> where  op( X ) is one of
!>
!>    op( X ) = X   or   op( X ) = X**T,
!>
!> alpha and beta are scalars, and A, B and C are matrices, with op( A )
!> an n by k matrix,  op( B )  a  k by n matrix and  C an n by n matrix.
!> Thereby, the routine only accesses and updates the upper or lower
!> triangular part of the result matrix C. This behaviour can be used if
!> the resulting matrix C is known to be Hermitian or symmetric.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the lower or the upper
!>           triangular part of C is access and updated.
!>
!>              UPLO = 'L' or 'l', the lower triangular part of C is used.
!>
!>              UPLO = 'U' or 'u', the upper triangular part of C is used.
!>
[in]TRANSA
!>          TRANSA is CHARACTER*1
!>           On entry, TRANSA specifies the form of op( A ) to be used in
!>           the matrix multiplication as follows:
!>
!>              TRANSA = 'N' or 'n',  op( A ) = A.
!>
!>              TRANSA = 'T' or 't',  op( A ) = A**T.
!>
!>              TRANSA = 'C' or 'c',  op( A ) = A**H.
!>
[in]TRANSB
!>          TRANSB is CHARACTER*1
!>           On entry, TRANSB specifies the form of op( B ) to be used in
!>           the matrix multiplication as follows:
!>
!>              TRANSB = 'N' or 'n',  op( B ) = B.
!>
!>              TRANSB = 'T' or 't',  op( B ) = B**T.
!>
!>              TRANSB = 'C' or 'c',  op( B ) = B**H.
!>
[in]N
!>          N is INTEGER
!>           On entry,  N specifies the number of rows and columns of
!>           the matrix C, the number of columns of op(B) and the number
!>           of rows of op(A).  N must be at least zero.
!>
[in]K
!>          K is INTEGER
!>           On entry,  K  specifies  the number of columns of the matrix
!>           op( A ) and the number of rows of the matrix op( B ). K must
!>           be at least  zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX.
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]A
!>          A is COMPLEX array, dimension ( LDA, ka ), where ka is
!>           k  when  TRANSA = 'N' or 'n',  and is  n  otherwise.
!>           Before entry with  TRANSA = 'N' or 'n',  the leading  n by k
!>           part of the array  A  must contain the matrix  A,  otherwise
!>           the leading  k by m  part of the array  A  must contain  the
!>           matrix A.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
!>           LDA must be at least  max( 1, n ), otherwise  LDA must be at
!>           least  max( 1, k ).
!>
[in]B
!>          B is COMPLEX array, dimension ( LDB, kb ), where kb is
!>           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
!>           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
!>           part of the array  B  must contain the matrix  B,  otherwise
!>           the leading  n by k  part of the array  B  must contain  the
!>           matrix B.
!>
[in]LDB
!>          LDB is INTEGER
!>           On entry, LDB specifies the first dimension of B as declared
!>           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
!>           LDB must be at least  max( 1, k ), otherwise  LDB must be at
!>           least  max( 1, n ).
!>
[in]BETA
!>          BETA is COMPLEX.
!>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
!>           supplied as zero then C need not be set on input.
!>
[in,out]C
!>          C is COMPLEX array, dimension ( LDC, N )
!>           Before entry, the leading  n by n  part of the array  C must
!>           contain the matrix  C,  except when  beta  is zero, in which
!>           case C need not be set on entry.
!>           On exit, the upper or lower triangular part of the matrix
!>           C  is overwritten by the n by n matrix
!>           ( alpha*op( A )*op( B ) + beta*C ).
!>
[in]LDC
!>          LDC is INTEGER
!>           On entry, LDC specifies the first dimension of C as declared
!>           in  the  calling  (sub)  program.   LDC  must  be  at  least
!>           max( 1, n ).
!>
Author
Martin Koehler
Further Details:
!>
!>  Level 3 Blas routine.
!>
!>  -- Written on 19-July-2023.
!>     Martin Koehler, MPI Magdeburg
!>

Definition at line 189 of file cgemmtr.f.

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 ALPHA,BETA
199 INTEGER K,LDA,LDB,LDC,N
200 CHARACTER TRANSA,TRANSB,UPLO
201* ..
202* .. Array Arguments ..
203 COMPLEX 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 TEMP
220 INTEGER I,INFO,J,L,NROWA,NROWB,ISTART, ISTOP
221 LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER
222* ..
223* .. Parameters ..
224 COMPLEX ONE
225 parameter(one= (1.0e+0,0.0e+0))
226 COMPLEX ZERO
227 parameter(zero= (0.0e+0,0.0e+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('CGEMMTR',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 CGEMMTR
568*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: