Contents


NAME

     ssyr -  perform  the  symmetric  rank  1  operation    A  :=
     alpha*x*x' + A

SYNOPSIS

     SUBROUTINE SSYR(UPLO, N, ALPHA, X, INCX, A, LDA)

     CHARACTER * 1 UPLO
     INTEGER N, INCX, LDA
     REAL ALPHA
     REAL X(*), A(LDA,*)

     SUBROUTINE SSYR_64(UPLO, N, ALPHA, X, INCX, A, LDA)

     CHARACTER * 1 UPLO
     INTEGER*8 N, INCX, LDA
     REAL ALPHA
     REAL X(*), A(LDA,*)

  F95 INTERFACE
     SUBROUTINE SYR(UPLO, [N], ALPHA, X, [INCX], A, [LDA])

     CHARACTER(LEN=1) :: UPLO
     INTEGER :: N, INCX, LDA
     REAL :: ALPHA
     REAL, DIMENSION(:) :: X
     REAL, DIMENSION(:,:) :: A

     SUBROUTINE SYR_64(UPLO, [N], ALPHA, X, [INCX], A, [LDA])

     CHARACTER(LEN=1) :: UPLO
     INTEGER(8) :: N, INCX, LDA
     REAL :: ALPHA
     REAL, DIMENSION(:) :: X
     REAL, DIMENSION(:,:) :: A

  C INTERFACE
     #include <sunperf.h>

     void ssyr(char uplo, int n, float alpha, float *x, int incx,
               float *a, int lda);

     void ssyr_64(char uplo, long n, float alpha, float *x,  long
               incx, float *a, long lda);

PURPOSE

     ssyr performs the symmetric rank 1 operation A := alpha*x*x'
     +  A, where alpha is a real scalar, x is an n element vector
     and A is an n by n symmetric matrix.

ARGUMENTS

     UPLO (input)
               On entry, UPLO  specifies  whether  the  upper  or
               lower  triangular  part  of  the  array A is to be
               referenced as follows:

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

               UPLO = 'L' or 'l'   Only the lower triangular part
               of A is to be referenced.

               Unchanged on exit.

     N (input)
               On entry, N specifies the order of the  matrix  A.
               N >= 0.  Unchanged on exit.

     ALPHA (input)
               On  entry,  ALPHA  specifies  the  scalar   alpha.
               Unchanged on exit.

     X (input)
               ( 1 + ( n - 1 )*abs( INCX ) ).  Before entry,  the
               incremented  array  X  must  contain the n element
               vector x.  Unchanged on exit.

     INCX (input)
               On entry, INCX specifies  the  increment  for  the
               elements of X. INCX <> 0.  Unchanged on exit.

     A (input/output)
               Before entry with  UPLO = 'U' or 'u', the  leading
               n  by  n upper triangular part of the array A must
               contain the upper triangular part of the symmetric
               matrix and the strictly lower triangular part of A
               is not referenced. On exit, the  upper  triangular
               part  of  the  array A 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 A must  contain
               the  lower triangular part of the symmetric matrix
               and the strictly upper triangular part of A is not
               referenced.  On exit, the lower triangular part of
               the array A is overwritten by the lower triangular
               part of the updated matrix.

     LDA (input)
               On entry, LDA specifies the first dimension  of  A
               as  declared  in the calling (sub) program. LDA >=
               max( 1, n ).  Unchanged on exit.