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