LAPACK 3.3.0

dsyr.f

Go to the documentation of this file.
00001       SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
00002 *     .. Scalar Arguments ..
00003       DOUBLE PRECISION ALPHA
00004       INTEGER INCX,LDA,N
00005       CHARACTER UPLO
00006 *     ..
00007 *     .. Array Arguments ..
00008       DOUBLE PRECISION A(LDA,*),X(*)
00009 *     ..
00010 *
00011 *  Purpose
00012 *  =======
00013 *
00014 *  DSYR   performs the symmetric rank 1 operation
00015 *
00016 *     A := alpha*x*x' + A,
00017 *
00018 *  where alpha is a real scalar, x is an n element vector and A is an
00019 *  n by n symmetric matrix.
00020 *
00021 *  Arguments
00022 *  ==========
00023 *
00024 *  UPLO   - CHARACTER*1.
00025 *           On entry, UPLO specifies whether the upper or lower
00026 *           triangular part of the array A is to be referenced as
00027 *           follows:
00028 *
00029 *              UPLO = 'U' or 'u'   Only the upper triangular part of A
00030 *                                  is to be referenced.
00031 *
00032 *              UPLO = 'L' or 'l'   Only the lower triangular part of A
00033 *                                  is to be referenced.
00034 *
00035 *           Unchanged on exit.
00036 *
00037 *  N      - INTEGER.
00038 *           On entry, N specifies the order of the matrix A.
00039 *           N must be at least zero.
00040 *           Unchanged on exit.
00041 *
00042 *  ALPHA  - DOUBLE PRECISION.
00043 *           On entry, ALPHA specifies the scalar alpha.
00044 *           Unchanged on exit.
00045 *
00046 *  X      - DOUBLE PRECISION array of dimension at least
00047 *           ( 1 + ( n - 1 )*abs( INCX ) ).
00048 *           Before entry, the incremented array X must contain the n
00049 *           element vector x.
00050 *           Unchanged on exit.
00051 *
00052 *  INCX   - INTEGER.
00053 *           On entry, INCX specifies the increment for the elements of
00054 *           X. INCX must not be zero.
00055 *           Unchanged on exit.
00056 *
00057 *  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
00058 *           Before entry with  UPLO = 'U' or 'u', the leading n by n
00059 *           upper triangular part of the array A must contain the upper
00060 *           triangular part of the symmetric matrix and the strictly
00061 *           lower triangular part of A is not referenced. On exit, the
00062 *           upper triangular part of the array A is overwritten by the
00063 *           upper triangular part of the updated matrix.
00064 *           Before entry with UPLO = 'L' or 'l', the leading n by n
00065 *           lower triangular part of the array A must contain the lower
00066 *           triangular part of the symmetric matrix and the strictly
00067 *           upper triangular part of A is not referenced. On exit, the
00068 *           lower triangular part of the array A is overwritten by the
00069 *           lower triangular part of the updated matrix.
00070 *
00071 *  LDA    - INTEGER.
00072 *           On entry, LDA specifies the first dimension of A as declared
00073 *           in the calling (sub) program. LDA must be at least
00074 *           max( 1, n ).
00075 *           Unchanged on exit.
00076 *
00077 *  Further Details
00078 *  ===============
00079 *
00080 *  Level 2 Blas routine.
00081 *
00082 *  -- Written on 22-October-1986.
00083 *     Jack Dongarra, Argonne National Lab.
00084 *     Jeremy Du Croz, Nag Central Office.
00085 *     Sven Hammarling, Nag Central Office.
00086 *     Richard Hanson, Sandia National Labs.
00087 *
00088 *  =====================================================================
00089 *
00090 *     .. Parameters ..
00091       DOUBLE PRECISION ZERO
00092       PARAMETER (ZERO=0.0D+0)
00093 *     ..
00094 *     .. Local Scalars ..
00095       DOUBLE PRECISION TEMP
00096       INTEGER I,INFO,IX,J,JX,KX
00097 *     ..
00098 *     .. External Functions ..
00099       LOGICAL LSAME
00100       EXTERNAL LSAME
00101 *     ..
00102 *     .. External Subroutines ..
00103       EXTERNAL XERBLA
00104 *     ..
00105 *     .. Intrinsic Functions ..
00106       INTRINSIC MAX
00107 *     ..
00108 *
00109 *     Test the input parameters.
00110 *
00111       INFO = 0
00112       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
00113           INFO = 1
00114       ELSE IF (N.LT.0) THEN
00115           INFO = 2
00116       ELSE IF (INCX.EQ.0) THEN
00117           INFO = 5
00118       ELSE IF (LDA.LT.MAX(1,N)) THEN
00119           INFO = 7
00120       END IF
00121       IF (INFO.NE.0) THEN
00122           CALL XERBLA('DSYR  ',INFO)
00123           RETURN
00124       END IF
00125 *
00126 *     Quick return if possible.
00127 *
00128       IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
00129 *
00130 *     Set the start point in X if the increment is not unity.
00131 *
00132       IF (INCX.LE.0) THEN
00133           KX = 1 - (N-1)*INCX
00134       ELSE IF (INCX.NE.1) THEN
00135           KX = 1
00136       END IF
00137 *
00138 *     Start the operations. In this version the elements of A are
00139 *     accessed sequentially with one pass through the triangular part
00140 *     of A.
00141 *
00142       IF (LSAME(UPLO,'U')) THEN
00143 *
00144 *        Form  A  when A is stored in upper triangle.
00145 *
00146           IF (INCX.EQ.1) THEN
00147               DO 20 J = 1,N
00148                   IF (X(J).NE.ZERO) THEN
00149                       TEMP = ALPHA*X(J)
00150                       DO 10 I = 1,J
00151                           A(I,J) = A(I,J) + X(I)*TEMP
00152    10                 CONTINUE
00153                   END IF
00154    20         CONTINUE
00155           ELSE
00156               JX = KX
00157               DO 40 J = 1,N
00158                   IF (X(JX).NE.ZERO) THEN
00159                       TEMP = ALPHA*X(JX)
00160                       IX = KX
00161                       DO 30 I = 1,J
00162                           A(I,J) = A(I,J) + X(IX)*TEMP
00163                           IX = IX + INCX
00164    30                 CONTINUE
00165                   END IF
00166                   JX = JX + INCX
00167    40         CONTINUE
00168           END IF
00169       ELSE
00170 *
00171 *        Form  A  when A is stored in lower triangle.
00172 *
00173           IF (INCX.EQ.1) THEN
00174               DO 60 J = 1,N
00175                   IF (X(J).NE.ZERO) THEN
00176                       TEMP = ALPHA*X(J)
00177                       DO 50 I = J,N
00178                           A(I,J) = A(I,J) + X(I)*TEMP
00179    50                 CONTINUE
00180                   END IF
00181    60         CONTINUE
00182           ELSE
00183               JX = KX
00184               DO 80 J = 1,N
00185                   IF (X(JX).NE.ZERO) THEN
00186                       TEMP = ALPHA*X(JX)
00187                       IX = JX
00188                       DO 70 I = J,N
00189                           A(I,J) = A(I,J) + X(IX)*TEMP
00190                           IX = IX + INCX
00191    70                 CONTINUE
00192                   END IF
00193                   JX = JX + INCX
00194    80         CONTINUE
00195           END IF
00196       END IF
00197 *
00198       RETURN
00199 *
00200 *     End of DSYR  .
00201 *
00202       END
 All Files Functions