LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ssyr.f
Go to the documentation of this file.
00001 *> \brief \b SSYR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       REAL ALPHA
00015 *       INTEGER INCX,LDA,N
00016 *       CHARACTER UPLO
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       REAL A(LDA,*),X(*)
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> SSYR   performs the symmetric rank 1 operation
00029 *>
00030 *>    A := alpha*x*x**T + A,
00031 *>
00032 *> where alpha is a real scalar, x is an n element vector and A is an
00033 *> n by n symmetric matrix.
00034 *> \endverbatim
00035 *
00036 *  Arguments:
00037 *  ==========
00038 *
00039 *> \param[in] UPLO
00040 *> \verbatim
00041 *>          UPLO is CHARACTER*1
00042 *>           On entry, UPLO specifies whether the upper or lower
00043 *>           triangular part of the array A is to be referenced as
00044 *>           follows:
00045 *>
00046 *>              UPLO = 'U' or 'u'   Only the upper triangular part of A
00047 *>                                  is to be referenced.
00048 *>
00049 *>              UPLO = 'L' or 'l'   Only the lower triangular part of A
00050 *>                                  is to be referenced.
00051 *> \endverbatim
00052 *>
00053 *> \param[in] N
00054 *> \verbatim
00055 *>          N is INTEGER
00056 *>           On entry, N specifies the order of the matrix A.
00057 *>           N must be at least zero.
00058 *> \endverbatim
00059 *>
00060 *> \param[in] ALPHA
00061 *> \verbatim
00062 *>          ALPHA is REAL
00063 *>           On entry, ALPHA specifies the scalar alpha.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] X
00067 *> \verbatim
00068 *>          X is REAL array of dimension at least
00069 *>           ( 1 + ( n - 1 )*abs( INCX ) ).
00070 *>           Before entry, the incremented array X must contain the n
00071 *>           element vector x.
00072 *> \endverbatim
00073 *>
00074 *> \param[in] INCX
00075 *> \verbatim
00076 *>          INCX is INTEGER
00077 *>           On entry, INCX specifies the increment for the elements of
00078 *>           X. INCX must not be zero.
00079 *> \endverbatim
00080 *>
00081 *> \param[in,out] A
00082 *> \verbatim
00083 *>          A is REAL array of DIMENSION ( LDA, n ).
00084 *>           Before entry with  UPLO = 'U' or 'u', the leading n by n
00085 *>           upper triangular part of the array A must contain the upper
00086 *>           triangular part of the symmetric matrix and the strictly
00087 *>           lower triangular part of A is not referenced. On exit, the
00088 *>           upper triangular part of the array A is overwritten by the
00089 *>           upper triangular part of the updated matrix.
00090 *>           Before entry with UPLO = 'L' or 'l', the leading n by n
00091 *>           lower triangular part of the array A must contain the lower
00092 *>           triangular part of the symmetric matrix and the strictly
00093 *>           upper triangular part of A is not referenced. On exit, the
00094 *>           lower triangular part of the array A is overwritten by the
00095 *>           lower triangular part of the updated matrix.
00096 *> \endverbatim
00097 *>
00098 *> \param[in] LDA
00099 *> \verbatim
00100 *>          LDA is INTEGER
00101 *>           On entry, LDA specifies the first dimension of A as declared
00102 *>           in the calling (sub) program. LDA must be at least
00103 *>           max( 1, n ).
00104 *> \endverbatim
00105 *
00106 *  Authors:
00107 *  ========
00108 *
00109 *> \author Univ. of Tennessee 
00110 *> \author Univ. of California Berkeley 
00111 *> \author Univ. of Colorado Denver 
00112 *> \author NAG Ltd. 
00113 *
00114 *> \date November 2011
00115 *
00116 *> \ingroup single_blas_level2
00117 *
00118 *> \par Further Details:
00119 *  =====================
00120 *>
00121 *> \verbatim
00122 *>
00123 *>  Level 2 Blas routine.
00124 *>
00125 *>  -- Written on 22-October-1986.
00126 *>     Jack Dongarra, Argonne National Lab.
00127 *>     Jeremy Du Croz, Nag Central Office.
00128 *>     Sven Hammarling, Nag Central Office.
00129 *>     Richard Hanson, Sandia National Labs.
00130 *> \endverbatim
00131 *>
00132 *  =====================================================================
00133       SUBROUTINE SSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
00134 *
00135 *  -- Reference BLAS level2 routine (version 3.4.0) --
00136 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00137 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00138 *     November 2011
00139 *
00140 *     .. Scalar Arguments ..
00141       REAL ALPHA
00142       INTEGER INCX,LDA,N
00143       CHARACTER UPLO
00144 *     ..
00145 *     .. Array Arguments ..
00146       REAL A(LDA,*),X(*)
00147 *     ..
00148 *
00149 *  =====================================================================
00150 *
00151 *     .. Parameters ..
00152       REAL ZERO
00153       PARAMETER (ZERO=0.0E+0)
00154 *     ..
00155 *     .. Local Scalars ..
00156       REAL TEMP
00157       INTEGER I,INFO,IX,J,JX,KX
00158 *     ..
00159 *     .. External Functions ..
00160       LOGICAL LSAME
00161       EXTERNAL LSAME
00162 *     ..
00163 *     .. External Subroutines ..
00164       EXTERNAL XERBLA
00165 *     ..
00166 *     .. Intrinsic Functions ..
00167       INTRINSIC MAX
00168 *     ..
00169 *
00170 *     Test the input parameters.
00171 *
00172       INFO = 0
00173       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
00174           INFO = 1
00175       ELSE IF (N.LT.0) THEN
00176           INFO = 2
00177       ELSE IF (INCX.EQ.0) THEN
00178           INFO = 5
00179       ELSE IF (LDA.LT.MAX(1,N)) THEN
00180           INFO = 7
00181       END IF
00182       IF (INFO.NE.0) THEN
00183           CALL XERBLA('SSYR  ',INFO)
00184           RETURN
00185       END IF
00186 *
00187 *     Quick return if possible.
00188 *
00189       IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
00190 *
00191 *     Set the start point in X if the increment is not unity.
00192 *
00193       IF (INCX.LE.0) THEN
00194           KX = 1 - (N-1)*INCX
00195       ELSE IF (INCX.NE.1) THEN
00196           KX = 1
00197       END IF
00198 *
00199 *     Start the operations. In this version the elements of A are
00200 *     accessed sequentially with one pass through the triangular part
00201 *     of A.
00202 *
00203       IF (LSAME(UPLO,'U')) THEN
00204 *
00205 *        Form  A  when A is stored in upper triangle.
00206 *
00207           IF (INCX.EQ.1) THEN
00208               DO 20 J = 1,N
00209                   IF (X(J).NE.ZERO) THEN
00210                       TEMP = ALPHA*X(J)
00211                       DO 10 I = 1,J
00212                           A(I,J) = A(I,J) + X(I)*TEMP
00213    10                 CONTINUE
00214                   END IF
00215    20         CONTINUE
00216           ELSE
00217               JX = KX
00218               DO 40 J = 1,N
00219                   IF (X(JX).NE.ZERO) THEN
00220                       TEMP = ALPHA*X(JX)
00221                       IX = KX
00222                       DO 30 I = 1,J
00223                           A(I,J) = A(I,J) + X(IX)*TEMP
00224                           IX = IX + INCX
00225    30                 CONTINUE
00226                   END IF
00227                   JX = JX + INCX
00228    40         CONTINUE
00229           END IF
00230       ELSE
00231 *
00232 *        Form  A  when A is stored in lower triangle.
00233 *
00234           IF (INCX.EQ.1) THEN
00235               DO 60 J = 1,N
00236                   IF (X(J).NE.ZERO) THEN
00237                       TEMP = ALPHA*X(J)
00238                       DO 50 I = J,N
00239                           A(I,J) = A(I,J) + X(I)*TEMP
00240    50                 CONTINUE
00241                   END IF
00242    60         CONTINUE
00243           ELSE
00244               JX = KX
00245               DO 80 J = 1,N
00246                   IF (X(JX).NE.ZERO) THEN
00247                       TEMP = ALPHA*X(JX)
00248                       IX = JX
00249                       DO 70 I = J,N
00250                           A(I,J) = A(I,J) + X(IX)*TEMP
00251                           IX = IX + INCX
00252    70                 CONTINUE
00253                   END IF
00254                   JX = JX + INCX
00255    80         CONTINUE
00256           END IF
00257       END IF
00258 *
00259       RETURN
00260 *
00261 *     End of SSYR  .
00262 *
00263       END
 All Files Functions