File:
[local] /
rpl /
lapack /
blas /
zsyr2k.f
Revision
1.11:
download - view:
text,
annotated -
select for diffs -
revision graph
Mon Jan 27 09:28:14 2014 UTC (11 years, 3 months ago) by
bertrand
Branches:
MAIN
CVS tags:
rpl-4_1_24,
rpl-4_1_23,
rpl-4_1_22,
rpl-4_1_21,
rpl-4_1_20,
rpl-4_1_19,
rpl-4_1_18,
rpl-4_1_17,
HEAD
Cohérence.
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 of 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 of 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 of 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: *> \date November 2011
171: *
172: *> \ingroup complex16_blas_level3
173: *
174: *> \par Further Details:
175: * =====================
176: *>
177: *> \verbatim
178: *>
179: *> Level 3 Blas routine.
180: *>
181: *> -- Written on 8-February-1989.
182: *> Jack Dongarra, Argonne National Laboratory.
183: *> Iain Duff, AERE Harwell.
184: *> Jeremy Du Croz, Numerical Algorithms Group Ltd.
185: *> Sven Hammarling, Numerical Algorithms Group Ltd.
186: *> \endverbatim
187: *>
188: * =====================================================================
189: SUBROUTINE ZSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
190: *
191: * -- Reference BLAS level3 routine (version 3.4.0) --
192: * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
193: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
194: * November 2011
195: *
196: * .. Scalar Arguments ..
197: COMPLEX*16 ALPHA,BETA
198: INTEGER K,LDA,LDB,LDC,N
199: CHARACTER TRANS,UPLO
200: * ..
201: * .. Array Arguments ..
202: COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
203: * ..
204: *
205: * =====================================================================
206: *
207: * .. External Functions ..
208: LOGICAL LSAME
209: EXTERNAL LSAME
210: * ..
211: * .. External Subroutines ..
212: EXTERNAL XERBLA
213: * ..
214: * .. Intrinsic Functions ..
215: INTRINSIC MAX
216: * ..
217: * .. Local Scalars ..
218: COMPLEX*16 TEMP1,TEMP2
219: INTEGER I,INFO,J,L,NROWA
220: LOGICAL UPPER
221: * ..
222: * .. Parameters ..
223: COMPLEX*16 ONE
224: PARAMETER (ONE= (1.0D+0,0.0D+0))
225: COMPLEX*16 ZERO
226: PARAMETER (ZERO= (0.0D+0,0.0D+0))
227: * ..
228: *
229: * Test the input parameters.
230: *
231: IF (LSAME(TRANS,'N')) THEN
232: NROWA = N
233: ELSE
234: NROWA = K
235: END IF
236: UPPER = LSAME(UPLO,'U')
237: *
238: INFO = 0
239: IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
240: INFO = 1
241: ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
242: + (.NOT.LSAME(TRANS,'T'))) 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('ZSYR2K',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 ZSYR2K.
395: *
396: 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