![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DSYR 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 DSYR(UPLO,N,ALPHA,X,INCX,A,LDA) 00012 * 00013 * .. Scalar Arguments .. 00014 * DOUBLE PRECISION ALPHA 00015 * INTEGER INCX,LDA,N 00016 * CHARACTER UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * DOUBLE PRECISION A(LDA,*),X(*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> DSYR 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 DOUBLE PRECISION. 00063 *> On entry, ALPHA specifies the scalar alpha. 00064 *> \endverbatim 00065 *> 00066 *> \param[in] X 00067 *> \verbatim 00068 *> X is DOUBLE PRECISION 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 DOUBLE PRECISION 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 double_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 DSYR(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 DOUBLE PRECISION ALPHA 00142 INTEGER INCX,LDA,N 00143 CHARACTER UPLO 00144 * .. 00145 * .. Array Arguments .. 00146 DOUBLE PRECISION A(LDA,*),X(*) 00147 * .. 00148 * 00149 * ===================================================================== 00150 * 00151 * .. Parameters .. 00152 DOUBLE PRECISION ZERO 00153 PARAMETER (ZERO=0.0D+0) 00154 * .. 00155 * .. Local Scalars .. 00156 DOUBLE PRECISION 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('DSYR ',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 DSYR . 00262 * 00263 END