LAPACK  3.11.0
LAPACK: Linear Algebra PACKage
zsyrk.f
1 *> \brief \b ZSYRK
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 ZSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
12 *
13 * .. Scalar Arguments ..
14 * COMPLEX*16 ALPHA,BETA
15 * INTEGER K,LDA,LDC,N
16 * CHARACTER TRANS,UPLO
17 * ..
18 * .. Array Arguments ..
19 * COMPLEX*16 A(LDA,*),C(LDC,*)
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> ZSYRK 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*16
88 *> On entry, ALPHA specifies the scalar alpha.
89 *> \endverbatim
90 *>
91 *> \param[in] A
92 *> \verbatim
93 *> A is COMPLEX*16 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*16
113 *> On entry, BETA specifies the scalar beta.
114 *> \endverbatim
115 *>
116 *> \param[in,out] C
117 *> \verbatim
118 *> C is COMPLEX*16 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 zsyrk(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*16 ALPHA,BETA
174  INTEGER K,LDA,LDC,N
175  CHARACTER TRANS,UPLO
176 * ..
177 * .. Array Arguments ..
178  COMPLEX*16 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*16 TEMP
195  INTEGER I,INFO,J,L,NROWA
196  LOGICAL UPPER
197 * ..
198 * .. Parameters ..
199  COMPLEX*16 ONE
200  parameter(one= (1.0d+0,0.0d+0))
201  COMPLEX*16 ZERO
202  parameter(zero= (0.0d+0,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  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('ZSYRK ',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 ZSYRK
359 *
360  END
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
zsyrk
subroutine zsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZSYRK
Definition: zsyrk.f:167