LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ssyr2k.f
Go to the documentation of this file.
1*> \brief \b SSYR2K
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 SSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
12*
13* .. Scalar Arguments ..
14* REAL ALPHA,BETA
15* INTEGER K,LDA,LDB,LDC,N
16* CHARACTER TRANS,UPLO
17* ..
18* .. Array Arguments ..
19* REAL A(LDA,*),B(LDB,*),C(LDC,*)
20* ..
21*
22*
23*> \par Purpose:
24* =============
25*>
26*> \verbatim
27*>
28*> SSYR2K performs one of the symmetric rank 2k operations
29*>
30*> C := alpha*A*B**T + alpha*B*A**T + beta*C,
31*>
32*> or
33*>
34*> C := alpha*A**T*B + alpha*B**T*A + beta*C,
35*>
36*> where alpha and beta are scalars, C is an n by n symmetric matrix
37*> and A and B are n by k matrices in the first case and k by n
38*> matrices in the second case.
39*> \endverbatim
40*
41* Arguments:
42* ==========
43*
44*> \param[in] UPLO
45*> \verbatim
46*> UPLO is CHARACTER*1
47*> On entry, UPLO specifies whether the upper or lower
48*> triangular part of the array C is to be referenced as
49*> follows:
50*>
51*> UPLO = 'U' or 'u' Only the upper triangular part of C
52*> is to be referenced.
53*>
54*> UPLO = 'L' or 'l' Only the lower triangular part of C
55*> is to be referenced.
56*> \endverbatim
57*>
58*> \param[in] TRANS
59*> \verbatim
60*> TRANS is CHARACTER*1
61*> On entry, TRANS specifies the operation to be performed as
62*> follows:
63*>
64*> TRANS = 'N' or 'n' C := alpha*A*B**T + alpha*B*A**T +
65*> beta*C.
66*>
67*> TRANS = 'T' or 't' C := alpha*A**T*B + alpha*B**T*A +
68*> beta*C.
69*>
70*> TRANS = 'C' or 'c' C := alpha*A**T*B + alpha*B**T*A +
71*> beta*C.
72*> \endverbatim
73*>
74*> \param[in] N
75*> \verbatim
76*> N is INTEGER
77*> On entry, N specifies the order of the matrix C. N must be
78*> at least zero.
79*> \endverbatim
80*>
81*> \param[in] K
82*> \verbatim
83*> K is INTEGER
84*> On entry with TRANS = 'N' or 'n', K specifies the number
85*> of columns of the matrices A and B, and on entry with
86*> TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
87*> of rows of the matrices A and B. K must be at least zero.
88*> \endverbatim
89*>
90*> \param[in] ALPHA
91*> \verbatim
92*> ALPHA is REAL
93*> On entry, ALPHA specifies the scalar alpha.
94*> \endverbatim
95*>
96*> \param[in] A
97*> \verbatim
98*> A is REAL array, dimension ( LDA, ka ), where ka is
99*> k when TRANS = 'N' or 'n', and is n otherwise.
100*> Before entry with TRANS = 'N' or 'n', the leading n by k
101*> part of the array A must contain the matrix A, otherwise
102*> the leading k by n part of the array A must contain the
103*> matrix A.
104*> \endverbatim
105*>
106*> \param[in] LDA
107*> \verbatim
108*> LDA is INTEGER
109*> On entry, LDA specifies the first dimension of A as declared
110*> in the calling (sub) program. When TRANS = 'N' or 'n'
111*> then LDA must be at least max( 1, n ), otherwise LDA must
112*> be at least max( 1, k ).
113*> \endverbatim
114*>
115*> \param[in] B
116*> \verbatim
117*> B is REAL array, dimension ( LDB, kb ), where kb is
118*> k when TRANS = 'N' or 'n', and is n otherwise.
119*> Before entry with TRANS = 'N' or 'n', the leading n by k
120*> part of the array B must contain the matrix B, otherwise
121*> the leading k by n part of the array B must contain the
122*> matrix B.
123*> \endverbatim
124*>
125*> \param[in] LDB
126*> \verbatim
127*> LDB is INTEGER
128*> On entry, LDB specifies the first dimension of B as declared
129*> in the calling (sub) program. When TRANS = 'N' or 'n'
130*> then LDB must be at least max( 1, n ), otherwise LDB must
131*> be at least max( 1, k ).
132*> \endverbatim
133*>
134*> \param[in] BETA
135*> \verbatim
136*> BETA is REAL
137*> On entry, BETA specifies the scalar beta.
138*> \endverbatim
139*>
140*> \param[in,out] C
141*> \verbatim
142*> C is REAL array, dimension ( LDC, N )
143*> Before entry with UPLO = 'U' or 'u', the leading n by n
144*> upper triangular part of the array C must contain the upper
145*> triangular part of the symmetric matrix and the strictly
146*> lower triangular part of C is not referenced. On exit, the
147*> upper triangular part of the array C is overwritten by the
148*> upper triangular part of the updated matrix.
149*> Before entry with UPLO = 'L' or 'l', the leading n by n
150*> lower triangular part of the array C must contain the lower
151*> triangular part of the symmetric matrix and the strictly
152*> upper triangular part of C is not referenced. On exit, the
153*> lower triangular part of the array C is overwritten by the
154*> lower triangular part of the updated matrix.
155*> \endverbatim
156*>
157*> \param[in] LDC
158*> \verbatim
159*> LDC is INTEGER
160*> On entry, LDC specifies the first dimension of C as declared
161*> in the calling (sub) program. LDC must be at least
162*> max( 1, n ).
163*> \endverbatim
164*
165* Authors:
166* ========
167*
168*> \author Univ. of Tennessee
169*> \author Univ. of California Berkeley
170*> \author Univ. of Colorado Denver
171*> \author NAG Ltd.
172*
173*> \ingroup her2k
174*
175*> \par Further Details:
176* =====================
177*>
178*> \verbatim
179*>
180*> Level 3 Blas routine.
181*>
182*>
183*> -- Written on 8-February-1989.
184*> Jack Dongarra, Argonne National Laboratory.
185*> Iain Duff, AERE Harwell.
186*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
187*> Sven Hammarling, Numerical Algorithms Group Ltd.
188*> \endverbatim
189*>
190* =====================================================================
191 SUBROUTINE ssyr2k(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
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 TRANS,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 TEMP1,TEMP2
220 INTEGER I,INFO,J,L,NROWA
221 LOGICAL UPPER
222* ..
223* .. Parameters ..
224 REAL ONE,ZERO
225 parameter(one=1.0e+0,zero=0.0e+0)
226* ..
227*
228* Test the input parameters.
229*
230 IF (lsame(trans,'N')) THEN
231 nrowa = n
232 ELSE
233 nrowa = k
234 END IF
235 upper = lsame(uplo,'U')
236*
237 info = 0
238 IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
239 info = 1
240 ELSE IF ((.NOT.lsame(trans,'N')) .AND.
241 + (.NOT.lsame(trans,'T')) .AND.
242 + (.NOT.lsame(trans,'C'))) THEN
243 info = 2
244 ELSE IF (n.LT.0) THEN
245 info = 3
246 ELSE IF (k.LT.0) THEN
247 info = 4
248 ELSE IF (lda.LT.max(1,nrowa)) THEN
249 info = 7
250 ELSE IF (ldb.LT.max(1,nrowa)) THEN
251 info = 9
252 ELSE IF (ldc.LT.max(1,n)) THEN
253 info = 12
254 END IF
255 IF (info.NE.0) THEN
256 CALL xerbla('SSYR2K',info)
257 RETURN
258 END IF
259*
260* Quick return if possible.
261*
262 IF ((n.EQ.0) .OR. (((alpha.EQ.zero).OR.
263 + (k.EQ.0)).AND. (beta.EQ.one))) RETURN
264*
265* And when alpha.eq.zero.
266*
267 IF (alpha.EQ.zero) THEN
268 IF (upper) THEN
269 IF (beta.EQ.zero) THEN
270 DO 20 j = 1,n
271 DO 10 i = 1,j
272 c(i,j) = zero
273 10 CONTINUE
274 20 CONTINUE
275 ELSE
276 DO 40 j = 1,n
277 DO 30 i = 1,j
278 c(i,j) = beta*c(i,j)
279 30 CONTINUE
280 40 CONTINUE
281 END IF
282 ELSE
283 IF (beta.EQ.zero) THEN
284 DO 60 j = 1,n
285 DO 50 i = j,n
286 c(i,j) = zero
287 50 CONTINUE
288 60 CONTINUE
289 ELSE
290 DO 80 j = 1,n
291 DO 70 i = j,n
292 c(i,j) = beta*c(i,j)
293 70 CONTINUE
294 80 CONTINUE
295 END IF
296 END IF
297 RETURN
298 END IF
299*
300* Start the operations.
301*
302 IF (lsame(trans,'N')) THEN
303*
304* Form C := alpha*A*B**T + alpha*B*A**T + C.
305*
306 IF (upper) THEN
307 DO 130 j = 1,n
308 IF (beta.EQ.zero) THEN
309 DO 90 i = 1,j
310 c(i,j) = zero
311 90 CONTINUE
312 ELSE IF (beta.NE.one) THEN
313 DO 100 i = 1,j
314 c(i,j) = beta*c(i,j)
315 100 CONTINUE
316 END IF
317 DO 120 l = 1,k
318 IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
319 temp1 = alpha*b(j,l)
320 temp2 = alpha*a(j,l)
321 DO 110 i = 1,j
322 c(i,j) = c(i,j) + a(i,l)*temp1 +
323 + b(i,l)*temp2
324 110 CONTINUE
325 END IF
326 120 CONTINUE
327 130 CONTINUE
328 ELSE
329 DO 180 j = 1,n
330 IF (beta.EQ.zero) THEN
331 DO 140 i = j,n
332 c(i,j) = zero
333 140 CONTINUE
334 ELSE IF (beta.NE.one) THEN
335 DO 150 i = j,n
336 c(i,j) = beta*c(i,j)
337 150 CONTINUE
338 END IF
339 DO 170 l = 1,k
340 IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
341 temp1 = alpha*b(j,l)
342 temp2 = alpha*a(j,l)
343 DO 160 i = j,n
344 c(i,j) = c(i,j) + a(i,l)*temp1 +
345 + b(i,l)*temp2
346 160 CONTINUE
347 END IF
348 170 CONTINUE
349 180 CONTINUE
350 END IF
351 ELSE
352*
353* Form C := alpha*A**T*B + alpha*B**T*A + C.
354*
355 IF (upper) THEN
356 DO 210 j = 1,n
357 DO 200 i = 1,j
358 temp1 = zero
359 temp2 = zero
360 DO 190 l = 1,k
361 temp1 = temp1 + a(l,i)*b(l,j)
362 temp2 = temp2 + b(l,i)*a(l,j)
363 190 CONTINUE
364 IF (beta.EQ.zero) THEN
365 c(i,j) = alpha*temp1 + alpha*temp2
366 ELSE
367 c(i,j) = beta*c(i,j) + alpha*temp1 +
368 + alpha*temp2
369 END IF
370 200 CONTINUE
371 210 CONTINUE
372 ELSE
373 DO 240 j = 1,n
374 DO 230 i = j,n
375 temp1 = zero
376 temp2 = zero
377 DO 220 l = 1,k
378 temp1 = temp1 + a(l,i)*b(l,j)
379 temp2 = temp2 + b(l,i)*a(l,j)
380 220 CONTINUE
381 IF (beta.EQ.zero) THEN
382 c(i,j) = alpha*temp1 + alpha*temp2
383 ELSE
384 c(i,j) = beta*c(i,j) + alpha*temp1 +
385 + alpha*temp2
386 END IF
387 230 CONTINUE
388 240 CONTINUE
389 END IF
390 END IF
391*
392 RETURN
393*
394* End of SSYR2K
395*
396 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ssyr2k
subroutine ssyr2k(uplo, trans, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SSYR2K
Definition ssyr2k.f:192