LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ csyr2k()

subroutine csyr2k ( character  uplo,
character  trans,
integer  n,
integer  k,
complex  alpha,
complex, dimension(lda,*)  a,
integer  lda,
complex, dimension(ldb,*)  b,
integer  ldb,
complex  beta,
complex, dimension(ldc,*)  c,
integer  ldc 
)

CSYR2K

Purpose:
 CSYR2K  performs one of the symmetric rank 2k operations

    C := alpha*A*B**T + alpha*B*A**T + beta*C,

 or

    C := alpha*A**T*B + alpha*B**T*A + beta*C,

 where  alpha and beta  are scalars,  C is an  n by n symmetric matrix
 and  A and B  are  n by k  matrices  in the  first  case  and  k by n
 matrices in the second case.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On  entry,   UPLO  specifies  whether  the  upper  or  lower
           triangular  part  of the  array  C  is to be  referenced  as
           follows:

              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
                                  is to be referenced.

              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
                                  is to be referenced.
[in]TRANS
          TRANS is CHARACTER*1
           On entry,  TRANS  specifies the operation to be performed as
           follows:

              TRANS = 'N' or 'n'    C := alpha*A*B**T + alpha*B*A**T +
                                         beta*C.

              TRANS = 'T' or 't'    C := alpha*A**T*B + alpha*B**T*A +
                                         beta*C.
[in]N
          N is INTEGER
           On entry,  N specifies the order of the matrix C.  N must be
           at least zero.
[in]K
          K is INTEGER
           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
           of  columns  of the  matrices  A and B,  and on  entry  with
           TRANS = 'T' or 't',  K  specifies  the number of rows of the
           matrices  A and B.  K must be at least zero.
[in]ALPHA
          ALPHA is COMPLEX
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is COMPLEX array, dimension ( LDA, ka ), where ka is
           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
           part of the array  A  must contain the matrix  A,  otherwise
           the leading  k by n  part of the array  A  must contain  the
           matrix A.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
           then  LDA must be at least  max( 1, n ), otherwise  LDA must
           be at least  max( 1, k ).
[in]B
          B is COMPLEX array, dimension ( LDB, kb ), where kb is
           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
           part of the array  B  must contain the matrix  B,  otherwise
           the leading  k by n  part of the array  B  must contain  the
           matrix B.
[in]LDB
          LDB is INTEGER
           On entry, LDB specifies the first dimension of B as declared
           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
           then  LDB must be at least  max( 1, n ), otherwise  LDB must
           be at least  max( 1, k ).
[in]BETA
          BETA is COMPLEX
           On entry, BETA specifies the scalar beta.
[in,out]C
          C is COMPLEX array, dimension ( LDC, N )
           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
           upper triangular part of the array C must contain the upper
           triangular part  of the  symmetric matrix  and the strictly
           lower triangular part of C is not referenced.  On exit, the
           upper triangular part of the array  C is overwritten by the
           upper triangular part of the updated matrix.
           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
           lower triangular part of the array C must contain the lower
           triangular part  of the  symmetric matrix  and the strictly
           upper triangular part of C is not referenced.  On exit, the
           lower triangular part of the array  C is overwritten by the
           lower triangular part of the updated matrix.
[in]LDC
          LDC is INTEGER
           On entry, LDC specifies the first dimension of C as declared
           in  the  calling  (sub)  program.   LDC  must  be  at  least
           max( 1, n ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  Level 3 Blas routine.

  -- Written on 8-February-1989.
     Jack Dongarra, Argonne National Laboratory.
     Iain Duff, AERE Harwell.
     Jeremy Du Croz, Numerical Algorithms Group Ltd.
     Sven Hammarling, Numerical Algorithms Group Ltd.

Definition at line 187 of file csyr2k.f.

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 ALPHA,BETA
195 INTEGER K,LDA,LDB,LDC,N
196 CHARACTER TRANS,UPLO
197* ..
198* .. Array Arguments ..
199 COMPLEX 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 TEMP1,TEMP2
216 INTEGER I,INFO,J,L,NROWA
217 LOGICAL UPPER
218* ..
219* .. Parameters ..
220 COMPLEX ONE
221 parameter(one= (1.0e+0,0.0e+0))
222 COMPLEX ZERO
223 parameter(zero= (0.0e+0,0.0e+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('CSYR2K',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 CSYR2K
392*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: