1: *> \brief \b ZSYR2K
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 ZSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
12: *
13: * .. Scalar Arguments ..
14: * COMPLEX*16 ALPHA,BETA
15: * INTEGER K,LDA,LDB,LDC,N
16: * CHARACTER TRANS,UPLO
17: * ..
18: * .. Array Arguments ..
19: * COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
20: * ..
21: *
22: *
23: *> \par Purpose:
24: * =============
25: *>
26: *> \verbatim
27: *>
28: *> ZSYR2K 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: *> \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 matrices A and B, and on entry with
83: *> TRANS = 'T' or 't', K specifies the number of rows of the
84: *> matrices A and B. K must be at least zero.
85: *> \endverbatim
86: *>
87: *> \param[in] ALPHA
88: *> \verbatim
89: *> ALPHA is COMPLEX*16
90: *> On entry, ALPHA specifies the scalar alpha.
91: *> \endverbatim
92: *>
93: *> \param[in] A
94: *> \verbatim
95: *> A is COMPLEX*16 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] B
113: *> \verbatim
114: *> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is
115: *> k when TRANS = 'N' or 'n', and is n otherwise.
116: *> Before entry with TRANS = 'N' or 'n', the leading n by k
117: *> part of the array B must contain the matrix B, otherwise
118: *> the leading k by n part of the array B must contain the
119: *> matrix B.
120: *> \endverbatim
121: *>
122: *> \param[in] LDB
123: *> \verbatim
124: *> LDB is INTEGER
125: *> On entry, LDB specifies the first dimension of B as declared
126: *> in the calling (sub) program. When TRANS = 'N' or 'n'
127: *> then LDB must be at least max( 1, n ), otherwise LDB must
128: *> be at least max( 1, k ).
129: *> \endverbatim
130: *>
131: *> \param[in] BETA
132: *> \verbatim
133: *> BETA is COMPLEX*16
134: *> On entry, BETA specifies the scalar beta.
135: *> \endverbatim
136: *>
137: *> \param[in,out] C
138: *> \verbatim
139: *> C is COMPLEX*16 array, dimension ( LDC, N )
140: *> Before entry with UPLO = 'U' or 'u', the leading n by n
141: *> upper triangular part of the array C must contain the upper
142: *> triangular part of the symmetric matrix and the strictly
143: *> lower triangular part of C is not referenced. On exit, the
144: *> upper triangular part of the array C is overwritten by the
145: *> upper triangular part of the updated matrix.
146: *> Before entry with UPLO = 'L' or 'l', the leading n by n
147: *> lower triangular part of the array C must contain the lower
148: *> triangular part of the symmetric matrix and the strictly
149: *> upper triangular part of C is not referenced. On exit, the
150: *> lower triangular part of the array C is overwritten by the
151: *> lower triangular part of the updated matrix.
152: *> \endverbatim
153: *>
154: *> \param[in] LDC
155: *> \verbatim
156: *> LDC is INTEGER
157: *> On entry, LDC specifies the first dimension of C as declared
158: *> in the calling (sub) program. LDC must be at least
159: *> max( 1, n ).
160: *> \endverbatim
161: *
162: * Authors:
163: * ========
164: *
165: *> \author Univ. of Tennessee
166: *> \author Univ. of California Berkeley
167: *> \author Univ. of Colorado Denver
168: *> \author NAG Ltd.
169: *
170: *> \ingroup complex16_blas_level3
171: *
172: *> \par Further Details:
173: * =====================
174: *>
175: *> \verbatim
176: *>
177: *> Level 3 Blas routine.
178: *>
179: *> -- Written on 8-February-1989.
180: *> Jack Dongarra, Argonne National Laboratory.
181: *> Iain Duff, AERE Harwell.
182: *> Jeremy Du Croz, Numerical Algorithms Group Ltd.
183: *> Sven Hammarling, Numerical Algorithms Group Ltd.
184: *> \endverbatim
185: *>
186: * =====================================================================
187: SUBROUTINE ZSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
188: *
189: * -- Reference BLAS level3 routine --
190: * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
191: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
192: *
193: * .. Scalar Arguments ..
194: COMPLEX*16 ALPHA,BETA
195: INTEGER K,LDA,LDB,LDC,N
196: CHARACTER TRANS,UPLO
197: * ..
198: * .. Array Arguments ..
199: COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
200: * ..
201: *
202: * =====================================================================
203: *
204: * .. External Functions ..
205: LOGICAL LSAME
206: EXTERNAL LSAME
207: * ..
208: * .. External Subroutines ..
209: EXTERNAL XERBLA
210: * ..
211: * .. Intrinsic Functions ..
212: INTRINSIC MAX
213: * ..
214: * .. Local Scalars ..
215: COMPLEX*16 TEMP1,TEMP2
216: INTEGER I,INFO,J,L,NROWA
217: LOGICAL UPPER
218: * ..
219: * .. Parameters ..
220: COMPLEX*16 ONE
221: PARAMETER (ONE= (1.0D+0,0.0D+0))
222: COMPLEX*16 ZERO
223: PARAMETER (ZERO= (0.0D+0,0.0D+0))
224: * ..
225: *
226: * Test the input parameters.
227: *
228: IF (LSAME(TRANS,'N')) THEN
229: NROWA = N
230: ELSE
231: NROWA = K
232: END IF
233: UPPER = LSAME(UPLO,'U')
234: *
235: INFO = 0
236: IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
237: INFO = 1
238: ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
239: + (.NOT.LSAME(TRANS,'T'))) THEN
240: INFO = 2
241: ELSE IF (N.LT.0) THEN
242: INFO = 3
243: ELSE IF (K.LT.0) THEN
244: INFO = 4
245: ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
246: INFO = 7
247: ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
248: INFO = 9
249: ELSE IF (LDC.LT.MAX(1,N)) THEN
250: INFO = 12
251: END IF
252: IF (INFO.NE.0) THEN
253: CALL XERBLA('ZSYR2K',INFO)
254: RETURN
255: END IF
256: *
257: * Quick return if possible.
258: *
259: IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
260: + (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
261: *
262: * And when alpha.eq.zero.
263: *
264: IF (ALPHA.EQ.ZERO) THEN
265: IF (UPPER) THEN
266: IF (BETA.EQ.ZERO) THEN
267: DO 20 J = 1,N
268: DO 10 I = 1,J
269: C(I,J) = ZERO
270: 10 CONTINUE
271: 20 CONTINUE
272: ELSE
273: DO 40 J = 1,N
274: DO 30 I = 1,J
275: C(I,J) = BETA*C(I,J)
276: 30 CONTINUE
277: 40 CONTINUE
278: END IF
279: ELSE
280: IF (BETA.EQ.ZERO) THEN
281: DO 60 J = 1,N
282: DO 50 I = J,N
283: C(I,J) = ZERO
284: 50 CONTINUE
285: 60 CONTINUE
286: ELSE
287: DO 80 J = 1,N
288: DO 70 I = J,N
289: C(I,J) = BETA*C(I,J)
290: 70 CONTINUE
291: 80 CONTINUE
292: END IF
293: END IF
294: RETURN
295: END IF
296: *
297: * Start the operations.
298: *
299: IF (LSAME(TRANS,'N')) THEN
300: *
301: * Form C := alpha*A*B**T + alpha*B*A**T + C.
302: *
303: IF (UPPER) THEN
304: DO 130 J = 1,N
305: IF (BETA.EQ.ZERO) THEN
306: DO 90 I = 1,J
307: C(I,J) = ZERO
308: 90 CONTINUE
309: ELSE IF (BETA.NE.ONE) THEN
310: DO 100 I = 1,J
311: C(I,J) = BETA*C(I,J)
312: 100 CONTINUE
313: END IF
314: DO 120 L = 1,K
315: IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
316: TEMP1 = ALPHA*B(J,L)
317: TEMP2 = ALPHA*A(J,L)
318: DO 110 I = 1,J
319: C(I,J) = C(I,J) + A(I,L)*TEMP1 +
320: + B(I,L)*TEMP2
321: 110 CONTINUE
322: END IF
323: 120 CONTINUE
324: 130 CONTINUE
325: ELSE
326: DO 180 J = 1,N
327: IF (BETA.EQ.ZERO) THEN
328: DO 140 I = J,N
329: C(I,J) = ZERO
330: 140 CONTINUE
331: ELSE IF (BETA.NE.ONE) THEN
332: DO 150 I = J,N
333: C(I,J) = BETA*C(I,J)
334: 150 CONTINUE
335: END IF
336: DO 170 L = 1,K
337: IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
338: TEMP1 = ALPHA*B(J,L)
339: TEMP2 = ALPHA*A(J,L)
340: DO 160 I = J,N
341: C(I,J) = C(I,J) + A(I,L)*TEMP1 +
342: + B(I,L)*TEMP2
343: 160 CONTINUE
344: END IF
345: 170 CONTINUE
346: 180 CONTINUE
347: END IF
348: ELSE
349: *
350: * Form C := alpha*A**T*B + alpha*B**T*A + C.
351: *
352: IF (UPPER) THEN
353: DO 210 J = 1,N
354: DO 200 I = 1,J
355: TEMP1 = ZERO
356: TEMP2 = ZERO
357: DO 190 L = 1,K
358: TEMP1 = TEMP1 + A(L,I)*B(L,J)
359: TEMP2 = TEMP2 + B(L,I)*A(L,J)
360: 190 CONTINUE
361: IF (BETA.EQ.ZERO) THEN
362: C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
363: ELSE
364: C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
365: + ALPHA*TEMP2
366: END IF
367: 200 CONTINUE
368: 210 CONTINUE
369: ELSE
370: DO 240 J = 1,N
371: DO 230 I = J,N
372: TEMP1 = ZERO
373: TEMP2 = ZERO
374: DO 220 L = 1,K
375: TEMP1 = TEMP1 + A(L,I)*B(L,J)
376: TEMP2 = TEMP2 + B(L,I)*A(L,J)
377: 220 CONTINUE
378: IF (BETA.EQ.ZERO) THEN
379: C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
380: ELSE
381: C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
382: + ALPHA*TEMP2
383: END IF
384: 230 CONTINUE
385: 240 CONTINUE
386: END IF
387: END IF
388: *
389: RETURN
390: *
391: * End of ZSYR2K
392: *
393: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zsyr2k.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / blas