OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dsyrk.f
Go to the documentation of this file.
1*> \brief \b DSYRK
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 DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
12*
13* .. Scalar Arguments ..
14* DOUBLE PRECISION ALPHA,BETA
15* INTEGER K,LDA,LDC,N
16* CHARACTER TRANS,UPLO
17* ..
18* .. Array Arguments ..
19* DOUBLE PRECISION A(LDA,*),C(LDC,*)
20* ..
21*
22*
23*> \par Purpose:
24* =============
25*>
26*> \verbatim
27*>
28*> DSYRK performs one of the symmetric rank k operations
29*>
30*> C := alpha*A*A**T + beta*C,
31*>
32*> or
33*>
34*> C := alpha*A**T*A + beta*C,
35*>
36*> where alpha and beta are scalars, C is an n by n symmetric matrix
37*> and A is an n by k matrix in the first case and a k by n matrix
38*> 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*A**T + beta*C.
65*>
66*> TRANS = 'T' or 't' C := alpha*A**T*A + beta*C.
67*>
68*> TRANS = 'C' or 'c' C := alpha*A**T*A + beta*C.
69*> \endverbatim
70*>
71*> \param[in] N
72*> \verbatim
73*> N is INTEGER
74*> On entry, N specifies the order of the matrix C. N must be
75*> at least zero.
76*> \endverbatim
77*>
78*> \param[in] K
79*> \verbatim
80*> K is INTEGER
81*> On entry with TRANS = 'N' or 'n', K specifies the number
82*> of columns of the matrix A, and on entry with
83*> TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
84*> of rows of the matrix A. K must be at least zero.
85*> \endverbatim
86*>
87*> \param[in] ALPHA
88*> \verbatim
89*> ALPHA is DOUBLE PRECISION.
90*> On entry, ALPHA specifies the scalar alpha.
91*> \endverbatim
92*>
93*> \param[in] A
94*> \verbatim
95*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is
96*> k when TRANS = 'N' or 'n', and is n otherwise.
97*> Before entry with TRANS = 'N' or 'n', the leading n by k
98*> part of the array A must contain the matrix A, otherwise
99*> the leading k by n part of the array A must contain the
100*> matrix A.
101*> \endverbatim
102*>
103*> \param[in] LDA
104*> \verbatim
105*> LDA is INTEGER
106*> On entry, LDA specifies the first dimension of A as declared
107*> in the calling (sub) program. When TRANS = 'N' or 'n'
108*> then LDA must be at least max( 1, n ), otherwise LDA must
109*> be at least max( 1, k ).
110*> \endverbatim
111*>
112*> \param[in] BETA
113*> \verbatim
114*> BETA is DOUBLE PRECISION.
115*> On entry, BETA specifies the scalar beta.
116*> \endverbatim
117*>
118*> \param[in,out] C
119*> \verbatim
120*> C is DOUBLE PRECISION array, dimension ( LDC, N )
121*> Before entry with UPLO = 'U' or 'u', the leading n by n
122*> upper triangular part of the array C must contain the upper
123*> triangular part of the symmetric matrix and the strictly
124*> lower triangular part of C is not referenced. On exit, the
125*> upper triangular part of the array C is overwritten by the
126*> upper triangular part of the updated matrix.
127*> Before entry with UPLO = 'L' or 'l', the leading n by n
128*> lower triangular part of the array C must contain the lower
129*> triangular part of the symmetric matrix and the strictly
130*> upper triangular part of C is not referenced. On exit, the
131*> lower triangular part of the array C is overwritten by the
132*> lower triangular part of the updated matrix.
133*> \endverbatim
134*>
135*> \param[in] LDC
136*> \verbatim
137*> LDC is INTEGER
138*> On entry, LDC specifies the first dimension of C as declared
139*> in the calling (sub) program. LDC must be at least
140*> max( 1, n ).
141*> \endverbatim
142*
143* Authors:
144* ========
145*
146*> \author Univ. of Tennessee
147*> \author Univ. of California Berkeley
148*> \author Univ. of Colorado Denver
149*> \author NAG Ltd.
150*
151*> \ingroup double_blas_level3
152*
153*> \par Further Details:
154* =====================
155*>
156*> \verbatim
157*>
158*> Level 3 Blas routine.
159*>
160*> -- Written on 8-February-1989.
161*> Jack Dongarra, Argonne National Laboratory.
162*> Iain Duff, AERE Harwell.
163*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
164*> Sven Hammarling, Numerical Algorithms Group Ltd.
165*> \endverbatim
166*>
167* =====================================================================
168 SUBROUTINE dsyrk(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
169*
170* -- Reference BLAS level3 routine --
171* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
172* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
173*
174* .. Scalar Arguments ..
175 DOUBLE PRECISION ALPHA,BETA
176 INTEGER K,LDA,LDC,N
177 CHARACTER TRANS,UPLO
178* ..
179* .. Array Arguments ..
180 DOUBLE PRECISION A(LDA,*),C(LDC,*)
181* ..
182*
183* =====================================================================
184*
185* .. External Functions ..
186 LOGICAL LSAME
187 EXTERNAL lsame
188* ..
189* .. External Subroutines ..
190 EXTERNAL xerbla
191* ..
192* .. Intrinsic Functions ..
193 INTRINSIC max
194* ..
195* .. Local Scalars ..
196 DOUBLE PRECISION TEMP
197 INTEGER I,INFO,J,L,NROWA
198 LOGICAL UPPER
199* ..
200* .. Parameters ..
201 DOUBLE PRECISION ONE,ZERO
202 parameter(one=1.0d+0,zero=0.0d+0)
203* ..
204*
205* Test the input parameters.
206*
207 IF (lsame(trans,'N')) THEN
208 nrowa = n
209 ELSE
210 nrowa = k
211 END IF
212 upper = lsame(uplo,'u')
213*
214 INFO = 0
215.NOT..AND..NOT. IF ((UPPER) (LSAME(UPLO,'l'))) THEN
216 INFO = 1
217.NOT. ELSE IF ((LSAME(TRANS,'n.AND.'))
218.NOT. + (LSAME(TRANS,'t.AND.'))
219.NOT. + (LSAME(TRANS,'c'))) THEN
220 INFO = 2
221.LT. ELSE IF (N0) THEN
222 INFO = 3
223.LT. ELSE IF (K0) THEN
224 INFO = 4
225.LT. ELSE IF (LDAMAX(1,NROWA)) THEN
226 INFO = 7
227.LT. ELSE IF (LDCMAX(1,N)) THEN
228 INFO = 10
229 END IF
230.NE. IF (INFO0) THEN
231 CALL XERBLA('dsyrk ',INFO)
232 RETURN
233 END IF
234*
235* Quick return if possible.
236*
237.EQ..OR..EQ..OR. IF ((N0) (((ALPHAZERO)
238.EQ..AND..EQ. + (K0)) (BETAONE))) RETURN
239*
240* And when alpha.eq.zero.
241*
242.EQ. IF (ALPHAZERO) THEN
243 IF (UPPER) THEN
244.EQ. IF (BETAZERO) THEN
245 DO 20 J = 1,N
246 DO 10 I = 1,J
247 C(I,J) = ZERO
248 10 CONTINUE
249 20 CONTINUE
250 ELSE
251 DO 40 J = 1,N
252 DO 30 I = 1,J
253 C(I,J) = BETA*C(I,J)
254 30 CONTINUE
255 40 CONTINUE
256 END IF
257 ELSE
258.EQ. IF (BETAZERO) THEN
259 DO 60 J = 1,N
260 DO 50 I = J,N
261 C(I,J) = ZERO
262 50 CONTINUE
263 60 CONTINUE
264 ELSE
265 DO 80 J = 1,N
266 DO 70 I = J,N
267 C(I,J) = BETA*C(I,J)
268 70 CONTINUE
269 80 CONTINUE
270 END IF
271 END IF
272 RETURN
273 END IF
274*
275* Start the operations.
276*
277 IF (LSAME(TRANS,'n')) THEN
278*
279* Form C := alpha*A*A**T + beta*C.
280*
281 IF (UPPER) THEN
282 DO 130 J = 1,N
283.EQ. IF (BETAZERO) THEN
284 DO 90 I = 1,J
285 C(I,J) = ZERO
286 90 CONTINUE
287.NE. ELSE IF (BETAONE) THEN
288 DO 100 I = 1,J
289 C(I,J) = BETA*C(I,J)
290 100 CONTINUE
291 END IF
292 DO 120 L = 1,K
293.NE. IF (A(J,L)ZERO) THEN
294 TEMP = ALPHA*A(J,L)
295 DO 110 I = 1,J
296 C(I,J) = C(I,J) + TEMP*A(I,L)
297 110 CONTINUE
298 END IF
299 120 CONTINUE
300 130 CONTINUE
301 ELSE
302 DO 180 J = 1,N
303.EQ. IF (BETAZERO) THEN
304 DO 140 I = J,N
305 C(I,J) = ZERO
306 140 CONTINUE
307.NE. ELSE IF (BETAONE) THEN
308 DO 150 I = J,N
309 C(I,J) = BETA*C(I,J)
310 150 CONTINUE
311 END IF
312 DO 170 L = 1,K
313.NE. IF (A(J,L)ZERO) THEN
314 TEMP = ALPHA*A(J,L)
315 DO 160 I = J,N
316 C(I,J) = C(I,J) + TEMP*A(I,L)
317 160 CONTINUE
318 END IF
319 170 CONTINUE
320 180 CONTINUE
321 END IF
322 ELSE
323*
324* Form C := alpha*A**T*A + beta*C.
325*
326 IF (UPPER) THEN
327 DO 210 J = 1,N
328 DO 200 I = 1,J
329 TEMP = ZERO
330 DO 190 L = 1,K
331 TEMP = TEMP + A(L,I)*A(L,J)
332 190 CONTINUE
333.EQ. IF (BETAZERO) THEN
334 C(I,J) = ALPHA*TEMP
335 ELSE
336 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
337 END IF
338 200 CONTINUE
339 210 CONTINUE
340 ELSE
341 DO 240 J = 1,N
342 DO 230 I = J,N
343 TEMP = ZERO
344 DO 220 L = 1,K
345 TEMP = TEMP + A(L,I)*A(L,J)
346 220 CONTINUE
347.EQ. IF (BETAZERO) THEN
348 C(I,J) = ALPHA*TEMP
349 ELSE
350 C(I,J) = ALPHA*TEMP + BETA*C(I,J)
351 END IF
352 230 CONTINUE
353 240 CONTINUE
354 END IF
355 END IF
356*
357 RETURN
358*
359* End of DSYRK
360*
361 END
xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60
dsyrk
subroutine dsyrk(uplo, trans, n, k, alpha, a, lda, beta, c, ldc)
DSYRK
Definition dsyrk.f:169
max
#define max(a, b)
Definition macros.h:21