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

◆ dsyr2k()

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

DSYR2K

Purpose:
!>
!> DSYR2K  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.
!>
!>              TRANS = 'C' or 'c'   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' or 'C' or 'c',  K  specifies  the  number
!>           of rows of the matrices  A and B.  K must be at least  zero.
!>
[in]ALPHA
!>          ALPHA is DOUBLE PRECISION.
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]A
!>          A is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION.
!>           On entry, BETA specifies the scalar beta.
!>
[in,out]C
!>          C is DOUBLE PRECISION 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 191 of file dsyr2k.f.

192*
193* -- Reference BLAS level3 routine --
194* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
195* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
196*
197* .. Scalar Arguments ..
198 DOUBLE PRECISION ALPHA,BETA
199 INTEGER K,LDA,LDB,LDC,N
200 CHARACTER TRANS,UPLO
201* ..
202* .. Array Arguments ..
203 DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
204* ..
205*
206* =====================================================================
207*
208* .. External Functions ..
209 LOGICAL LSAME
210 EXTERNAL lsame
211* ..
212* .. External Subroutines ..
213 EXTERNAL xerbla
214* ..
215* .. Intrinsic Functions ..
216 INTRINSIC max
217* ..
218* .. Local Scalars ..
219 DOUBLE PRECISION TEMP1,TEMP2
220 INTEGER I,INFO,J,L,NROWA
221 LOGICAL UPPER
222* ..
223* .. Parameters ..
224 DOUBLE PRECISION ONE,ZERO
225 parameter(one=1.0d+0,zero=0.0d+0)
226* ..
227*
228* Test the input parameters.
229*
230 IF (lsame(trans,'N')) THEN
231 nrowa = n
232 ELSE
233 nrowa = k
234 END IF
235 upper = lsame(uplo,'U')
236*
237 info = 0
238 IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
239 info = 1
240 ELSE IF ((.NOT.lsame(trans,'N')) .AND.
241 + (.NOT.lsame(trans,'T')) .AND.
242 + (.NOT.lsame(trans,'C'))) 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('DSYR2K',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 DSYR2K
395*
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: