Contents


NAME

     ssyrk - perform one of the symmetric rank k  operations    C
     := alpha*A*A' + beta*C or C := alpha*A'*A + beta*C

SYNOPSIS

     SUBROUTINE SSYRK(UPLO, TRANSA, N, K, ALPHA, A, LDA, BETA, C, LDC)

     CHARACTER * 1 UPLO, TRANSA
     INTEGER N, K, LDA, LDC
     REAL ALPHA, BETA
     REAL A(LDA,*), C(LDC,*)

     SUBROUTINE SSYRK_64(UPLO, TRANSA, N, K, ALPHA, A, LDA, BETA, C, LDC)

     CHARACTER * 1 UPLO, TRANSA
     INTEGER*8 N, K, LDA, LDC
     REAL ALPHA, BETA
     REAL A(LDA,*), C(LDC,*)

  F95 INTERFACE
     SUBROUTINE SYRK(UPLO, [TRANSA], [N], [K], ALPHA, A, [LDA], BETA, C,
            [LDC])

     CHARACTER(LEN=1) :: UPLO, TRANSA
     INTEGER :: N, K, LDA, LDC
     REAL :: ALPHA, BETA
     REAL, DIMENSION(:,:) :: A, C

     SUBROUTINE SYRK_64(UPLO, [TRANSA], [N], [K], ALPHA, A, [LDA], BETA,
            C, [LDC])

     CHARACTER(LEN=1) :: UPLO, TRANSA
     INTEGER(8) :: N, K, LDA, LDC
     REAL :: ALPHA, BETA
     REAL, DIMENSION(:,:) :: A, C

  C INTERFACE
     #include <sunperf.h>

     void ssyrk(char uplo, char  transa,  int  n,  int  k,  float
               alpha,  float  *a,  int lda, float beta, float *c,
               int ldc);

     void ssyrk_64(char uplo, char transa, long n, long k,  float
               alpha,  float  *a, long lda, float beta, float *c,
               long ldc);

PURPOSE

     ssyrk performs one of the symmetric rank k operations  C  :=
     alpha*A*A' + beta*C or C := alpha*A'*A + beta*C where  alpha
     and beta  are scalars, C is an  n by n  symmetric matrix and
     A   is  an   n  by k  matrix in the first case and a  k by n
     matrix in the second case.

ARGUMENTS

     UPLO (input)
               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.

               Unchanged on exit.

     TRANSA (input)
               On entry,  TRANSA  specifies the operation  to  be
               performed as follows:

               TRANSA = 'N' or 'n'   C := alpha*A*A' + beta*C.

               TRANSA = 'T' or 't'   C := alpha*A'*A + beta*C.

               TRANSA = 'C' or 'c'   C := alpha*A'*A + beta*C.

               Unchanged on exit.

               TRANSA is defaulted to 'N' for F95 INTERFACE.

     N (input)
               On entry,  N specifies the order of the matrix  C.
               N must be at least zero.  Unchanged on exit.

     K (input)
               On entry with  TRANSA = 'N' or 'n',  K   specifies
               the  number  of   columns    of  the   matrix   A,
               and  on   entry   with TRANSA = 'T' or 't' or  'C'
               or  'c',  K  specifies  the  number of rows of the
               matrix  A.  K must be at least zero.  Unchanged on
               exit.
     ALPHA (input)
               On  entry,  ALPHA  specifies  the  scalar   alpha.
               Unchanged on exit.

     A (input)
               REAL             array of DIMENSION ( LDA,  ka  ),
               where  ka is k  when  TRANSA = 'N' or 'n',  and is
               n  otherwise.  Before entry with  TRANSA = '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.  Unchanged on exit.

     LDA (input)
               On entry, LDA specifies the first dimension  of  A
               as  declared  in   the   calling   (sub)  program.
               When  TRANSA = 'N' or 'n' then   LDA  must  be  at
               least   max(  1,  n  ),  otherwise  LDA must be at
               least  max( 1, k ).  Unchanged on exit.

     BETA (input)
               On  entry,  BETA  specifies   the   scalar   beta.
               Unchanged on exit.

     C (input/output)
               REAL             array of DIMENSION ( LDC, n ).

               Before entry  with  UPLO = 'U' or 'u',  the  lead-
               ing   n  by n upper triangular part of the array C
               must contain the upper  triangular  part   of  the
               symmetric  matrix  and the strictly lower triangu-
               lar part of C is not  referenced.   On  exit,  the
               upper triangular part of the array  C is overwrit-
               ten by the upper triangular part  of  the  updated
               matrix.

               Before entry  with  UPLO = 'L' or 'l',  the  lead-
               ing   n  by n lower triangular part of the array C
               must contain the lower  triangular  part   of  the
               symmetric  matrix  and the strictly upper triangu-
               lar part of C is not  referenced.   On  exit,  the
               lower triangular part of the array  C is overwrit-
               ten by the lower triangular part  of  the  updated
               matrix.

     LDC (input)
               On entry, LDC specifies the first dimension  of  C
               as  declared  in   the   calling   (sub)  program.
               LDC  must  be  at  least max( 1, n  ).   Unchanged
               on exit.