LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine ssyr2k ( character  UPLO,
character  TRANS,
integer  N,
integer  K,
real  ALPHA,
real, dimension(lda,*)  A,
integer  LDA,
real, dimension(ldb,*)  B,
integer  LDB,
real  BETA,
real, dimension(ldc,*)  C,
integer  LDC 
)

SSYR2K

Purpose: 
 SSYR2K  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 REAL
           On entry, ALPHA specifies the scalar alpha.
[in]A
          A is REAL array of 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 REAL array of 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 REAL
           On entry, BETA specifies the scalar beta.
[in,out]C
          C is REAL array of 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.
Date
November 2011
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 194 of file ssyr2k.f.

194 *
195 * -- Reference BLAS level3 routine (version 3.4.0) --
196 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
197 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
198 * November 2011
199 *
200 * .. Scalar Arguments ..
201  REAL alpha,beta
202  INTEGER k,lda,ldb,ldc,n
203  CHARACTER trans,uplo
204 * ..
205 * .. Array Arguments ..
206  REAL a(lda,*),b(ldb,*),c(ldc,*)
207 * ..
208 *
209 * =====================================================================
210 *
211 * .. External Functions ..
212  LOGICAL lsame
213  EXTERNAL lsame
214 * ..
215 * .. External Subroutines ..
216  EXTERNAL xerbla
217 * ..
218 * .. Intrinsic Functions ..
219  INTRINSIC max
220 * ..
221 * .. Local Scalars ..
222  REAL temp1,temp2
223  INTEGER i,info,j,l,nrowa
224  LOGICAL upper
225 * ..
226 * .. Parameters ..
227  REAL one,zero
228  parameter(one=1.0e+0,zero=0.0e+0)
229 * ..
230 *
231 * Test the input parameters.
232 *
233  IF (lsame(trans,'N')) THEN
234  nrowa = n
235  ELSE
236  nrowa = k
237  END IF
238  upper = lsame(uplo,'U')
239 *
240  info = 0
241  IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,'L'))) THEN
242  info = 1
243  ELSE IF ((.NOT.lsame(trans,'N')) .AND.
244  + (.NOT.lsame(trans,'T')) .AND.
245  + (.NOT.lsame(trans,'C'))) THEN
246  info = 2
247  ELSE IF (n.LT.0) THEN
248  info = 3
249  ELSE IF (k.LT.0) THEN
250  info = 4
251  ELSE IF (lda.LT.max(1,nrowa)) THEN
252  info = 7
253  ELSE IF (ldb.LT.max(1,nrowa)) THEN
254  info = 9
255  ELSE IF (ldc.LT.max(1,n)) THEN
256  info = 12
257  END IF
258  IF (info.NE.0) THEN
259  CALL xerbla('SSYR2K',info)
260  RETURN
261  END IF
262 *
263 * Quick return if possible.
264 *
265  IF ((n.EQ.0) .OR. (((alpha.EQ.zero).OR.
266  + (k.EQ.0)).AND. (beta.EQ.one))) RETURN
267 *
268 * And when alpha.eq.zero.
269 *
270  IF (alpha.EQ.zero) THEN
271  IF (upper) THEN
272  IF (beta.EQ.zero) THEN
273  DO 20 j = 1,n
274  DO 10 i = 1,j
275  c(i,j) = zero
276  10 CONTINUE
277  20 CONTINUE
278  ELSE
279  DO 40 j = 1,n
280  DO 30 i = 1,j
281  c(i,j) = beta*c(i,j)
282  30 CONTINUE
283  40 CONTINUE
284  END IF
285  ELSE
286  IF (beta.EQ.zero) THEN
287  DO 60 j = 1,n
288  DO 50 i = j,n
289  c(i,j) = zero
290  50 CONTINUE
291  60 CONTINUE
292  ELSE
293  DO 80 j = 1,n
294  DO 70 i = j,n
295  c(i,j) = beta*c(i,j)
296  70 CONTINUE
297  80 CONTINUE
298  END IF
299  END IF
300  RETURN
301  END IF
302 *
303 * Start the operations.
304 *
305  IF (lsame(trans,'N')) THEN
306 *
307 * Form C := alpha*A*B**T + alpha*B*A**T + C.
308 *
309  IF (upper) THEN
310  DO 130 j = 1,n
311  IF (beta.EQ.zero) THEN
312  DO 90 i = 1,j
313  c(i,j) = zero
314  90 CONTINUE
315  ELSE IF (beta.NE.one) THEN
316  DO 100 i = 1,j
317  c(i,j) = beta*c(i,j)
318  100 CONTINUE
319  END IF
320  DO 120 l = 1,k
321  IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
322  temp1 = alpha*b(j,l)
323  temp2 = alpha*a(j,l)
324  DO 110 i = 1,j
325  c(i,j) = c(i,j) + a(i,l)*temp1 +
326  + b(i,l)*temp2
327  110 CONTINUE
328  END IF
329  120 CONTINUE
330  130 CONTINUE
331  ELSE
332  DO 180 j = 1,n
333  IF (beta.EQ.zero) THEN
334  DO 140 i = j,n
335  c(i,j) = zero
336  140 CONTINUE
337  ELSE IF (beta.NE.one) THEN
338  DO 150 i = j,n
339  c(i,j) = beta*c(i,j)
340  150 CONTINUE
341  END IF
342  DO 170 l = 1,k
343  IF ((a(j,l).NE.zero) .OR. (b(j,l).NE.zero)) THEN
344  temp1 = alpha*b(j,l)
345  temp2 = alpha*a(j,l)
346  DO 160 i = j,n
347  c(i,j) = c(i,j) + a(i,l)*temp1 +
348  + b(i,l)*temp2
349  160 CONTINUE
350  END IF
351  170 CONTINUE
352  180 CONTINUE
353  END IF
354  ELSE
355 *
356 * Form C := alpha*A**T*B + alpha*B**T*A + C.
357 *
358  IF (upper) THEN
359  DO 210 j = 1,n
360  DO 200 i = 1,j
361  temp1 = zero
362  temp2 = zero
363  DO 190 l = 1,k
364  temp1 = temp1 + a(l,i)*b(l,j)
365  temp2 = temp2 + b(l,i)*a(l,j)
366  190 CONTINUE
367  IF (beta.EQ.zero) THEN
368  c(i,j) = alpha*temp1 + alpha*temp2
369  ELSE
370  c(i,j) = beta*c(i,j) + alpha*temp1 +
371  + alpha*temp2
372  END IF
373  200 CONTINUE
374  210 CONTINUE
375  ELSE
376  DO 240 j = 1,n
377  DO 230 i = j,n
378  temp1 = zero
379  temp2 = zero
380  DO 220 l = 1,k
381  temp1 = temp1 + a(l,i)*b(l,j)
382  temp2 = temp2 + b(l,i)*a(l,j)
383  220 CONTINUE
384  IF (beta.EQ.zero) THEN
385  c(i,j) = alpha*temp1 + alpha*temp2
386  ELSE
387  c(i,j) = beta*c(i,j) + alpha*temp1 +
388  + alpha*temp2
389  END IF
390  230 CONTINUE
391  240 CONTINUE
392  END IF
393  END IF
394 *
395  RETURN
396 *
397 * End of SSYR2K.
398 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: