LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
•All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
sgemmtr.f
Go to the documentation of this file.
1*> \brief \b SGEMMTR
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 SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA,
12* C,LDC)
13*
14* .. Scalar Arguments ..
15* REAL ALPHA,BETA
16* INTEGER K,LDA,LDB,LDC,N
17* CHARACTER TRANSA,TRANSB, UPLO
18* ..
19* .. Array Arguments ..
20* REAL A(LDA,*),B(LDB,*),C(LDC,*)
21* ..
22*
23*
24*> \par Purpose:
25* =============
26*>
27*> \verbatim
28*>
29*> SGEMMTR 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 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**T.
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**T.
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 REAL.
103*> On entry, ALPHA specifies the scalar alpha.
104*> \endverbatim
105*>
106*> \param[in] A
107*> \verbatim
108*> A is REAL 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 REAL 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 REAL.
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 REAL 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 sgemmtr(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 REAL ALPHA,BETA
199 INTEGER K,LDA,LDB,LDC,N
200 CHARACTER TRANSA,TRANSB,UPLO
201* ..
202* .. Array Arguments ..
203 REAL 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 max
217* ..
218* .. Local Scalars ..
219 REAL TEMP
220 INTEGER I,INFO,J,L,NROWA,NROWB, ISTART, ISTOP
221 LOGICAL NOTA,NOTB, UPPER
222* ..
223* .. Parameters ..
224 REAL ONE,ZERO
225 parameter(one=1.0d+0,zero=0.0d+0)
226* ..
227*
228* Set NOTA and NOTB as true if A and B respectively are not
229* transposed and set NROWA and NROWB as the number of rows of A
230* and B respectively.
231*
232 nota = lsame(transa,'N')
233 notb = lsame(transb,'N')
234 IF (nota) THEN
235 nrowa = n
236 ELSE
237 nrowa = k
238 END IF
239 IF (notb) THEN
240 nrowb = k
241 ELSE
242 nrowb = n
243 END IF
244 upper = lsame(uplo, 'U')
245*
246* Test the input parameters.
247*
248 info = 0
249 IF ((.NOT. upper) .AND. (.NOT. lsame(uplo, 'L'))) THEN
250 info = 1
251 ELSE IF ((.NOT.nota) .AND. (.NOT.lsame(transa,'C')) .AND.
252 + (.NOT.lsame(transa,'T'))) THEN
253 info = 2
254 ELSE IF ((.NOT.notb) .AND. (.NOT.lsame(transb,'C')) .AND.
255 + (.NOT.lsame(transb,'T'))) THEN
256 info = 3
257 ELSE IF (n.LT.0) THEN
258 info = 4
259 ELSE IF (k.LT.0) THEN
260 info = 5
261 ELSE IF (lda.LT.max(1,nrowa)) THEN
262 info = 8
263 ELSE IF (ldb.LT.max(1,nrowb)) THEN
264 info = 10
265 ELSE IF (ldc.LT.max(1,n)) THEN
266 info = 13
267 END IF
268 IF (info.NE.0) THEN
269 CALL xerbla('SGEMMTR',info)
270 RETURN
271 END IF
272*
273* Quick return if possible.
274*
275 IF (n.EQ.0) RETURN
276*
277* And if alpha.eq.zero.
278*
279 IF (alpha.EQ.zero) THEN
280 IF (beta.EQ.zero) THEN
281 DO 20 j = 1,n
282 IF (upper) THEN
283 istart = 1
284 istop = j
285 ELSE
286 istart = j
287 istop = n
288 END IF
289
290 DO 10 i = istart, istop
291 c(i,j) = zero
292 10 CONTINUE
293 20 CONTINUE
294 ELSE
295 DO 40 j = 1,n
296 IF (upper) THEN
297 istart = 1
298 istop = j
299 ELSE
300 istart = j
301 istop = n
302 END IF
303
304 DO 30 i = istart, istop
305 c(i,j) = beta*c(i,j)
306 30 CONTINUE
307 40 CONTINUE
308 END IF
309 RETURN
310 END IF
311*
312* Start the operations.
313*
314 IF (notb) THEN
315 IF (nota) THEN
316*
317* Form C := alpha*A*B + beta*C.
318*
319 DO 90 j = 1,n
320 IF (upper) THEN
321 istart = 1
322 istop = j
323 ELSE
324 istart = j
325 istop = n
326 END IF
327 IF (beta.EQ.zero) THEN
328 DO 50 i = istart, istop
329 c(i,j) = zero
330 50 CONTINUE
331 ELSE IF (beta.NE.one) THEN
332 DO 60 i = istart, istop
333 c(i,j) = beta*c(i,j)
334 60 CONTINUE
335 END IF
336 DO 80 l = 1,k
337 temp = alpha*b(l,j)
338 DO 70 i = istart, istop
339 c(i,j) = c(i,j) + temp*a(i,l)
340 70 CONTINUE
341 80 CONTINUE
342 90 CONTINUE
343 ELSE
344*
345* Form C := alpha*A**T*B + beta*C
346*
347 DO 120 j = 1,n
348 IF (upper) THEN
349 istart = 1
350 istop = j
351 ELSE
352 istart = j
353 istop = n
354 END IF
355
356 DO 110 i = istart, istop
357 temp = zero
358 DO 100 l = 1,k
359 temp = temp + a(l,i)*b(l,j)
360 100 CONTINUE
361 IF (beta.EQ.zero) THEN
362 c(i,j) = alpha*temp
363 ELSE
364 c(i,j) = alpha*temp + beta*c(i,j)
365 END IF
366 110 CONTINUE
367 120 CONTINUE
368 END IF
369 ELSE
370 IF (nota) THEN
371*
372* Form C := alpha*A*B**T + beta*C
373*
374 DO 170 j = 1,n
375 IF (upper) THEN
376 istart = 1
377 istop = j
378 ELSE
379 istart = j
380 istop = n
381 END IF
382
383 IF (beta.EQ.zero) THEN
384 DO 130 i = istart,istop
385 c(i,j) = zero
386 130 CONTINUE
387 ELSE IF (beta.NE.one) THEN
388 DO 140 i = istart,istop
389 c(i,j) = beta*c(i,j)
390 140 CONTINUE
391 END IF
392 DO 160 l = 1,k
393 temp = alpha*b(j,l)
394 DO 150 i = istart,istop
395 c(i,j) = c(i,j) + temp*a(i,l)
396 150 CONTINUE
397 160 CONTINUE
398 170 CONTINUE
399 ELSE
400*
401* Form C := alpha*A**T*B**T + beta*C
402*
403 DO 200 j = 1,n
404 IF (upper) THEN
405 istart = 1
406 istop = j
407 ELSE
408 istart = j
409 istop = n
410 END IF
411
412 DO 190 i = istart, istop
413 temp = zero
414 DO 180 l = 1,k
415 temp = temp + a(l,i)*b(j,l)
416 180 CONTINUE
417 IF (beta.EQ.zero) THEN
418 c(i,j) = alpha*temp
419 ELSE
420 c(i,j) = alpha*temp + beta*c(i,j)
421 END IF
422 190 CONTINUE
423 200 CONTINUE
424 END IF
425 END IF
426*
427 RETURN
428*
429* End of SGEMMTR
430*
431 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
sgemmtr
subroutine sgemmtr(uplo, transa, transb, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SGEMMTR
Definition sgemmtr.f:191