![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SSPR 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 SSPR(UPLO,N,ALPHA,X,INCX,AP) 00012 * 00013 * .. Scalar Arguments .. 00014 * REAL ALPHA 00015 * INTEGER INCX,N 00016 * CHARACTER UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * REAL AP(*),X(*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> SSPR 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, supplied in packed form. 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 matrix A is supplied in the packed 00044 *> array AP as follows: 00045 *> 00046 *> UPLO = 'U' or 'u' The upper triangular part of A is 00047 *> supplied in AP. 00048 *> 00049 *> UPLO = 'L' or 'l' The lower triangular part of A is 00050 *> supplied in AP. 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] AP 00082 *> \verbatim 00083 *> AP is REAL array of DIMENSION at least 00084 *> ( ( n*( n + 1 ) )/2 ). 00085 *> Before entry with UPLO = 'U' or 'u', the array AP must 00086 *> contain the upper triangular part of the symmetric matrix 00087 *> packed sequentially, column by column, so that AP( 1 ) 00088 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) 00089 *> and a( 2, 2 ) respectively, and so on. On exit, the array 00090 *> AP is overwritten by the upper triangular part of the 00091 *> updated matrix. 00092 *> Before entry with UPLO = 'L' or 'l', the array AP must 00093 *> contain the lower triangular part of the symmetric matrix 00094 *> packed sequentially, column by column, so that AP( 1 ) 00095 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) 00096 *> and a( 3, 1 ) respectively, and so on. On exit, the array 00097 *> AP is overwritten by the lower triangular part of the 00098 *> updated matrix. 00099 *> \endverbatim 00100 * 00101 * Authors: 00102 * ======== 00103 * 00104 *> \author Univ. of Tennessee 00105 *> \author Univ. of California Berkeley 00106 *> \author Univ. of Colorado Denver 00107 *> \author NAG Ltd. 00108 * 00109 *> \date November 2011 00110 * 00111 *> \ingroup single_blas_level2 00112 * 00113 *> \par Further Details: 00114 * ===================== 00115 *> 00116 *> \verbatim 00117 *> 00118 *> Level 2 Blas routine. 00119 *> 00120 *> -- Written on 22-October-1986. 00121 *> Jack Dongarra, Argonne National Lab. 00122 *> Jeremy Du Croz, Nag Central Office. 00123 *> Sven Hammarling, Nag Central Office. 00124 *> Richard Hanson, Sandia National Labs. 00125 *> \endverbatim 00126 *> 00127 * ===================================================================== 00128 SUBROUTINE SSPR(UPLO,N,ALPHA,X,INCX,AP) 00129 * 00130 * -- Reference BLAS level2 routine (version 3.4.0) -- 00131 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00132 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00133 * November 2011 00134 * 00135 * .. Scalar Arguments .. 00136 REAL ALPHA 00137 INTEGER INCX,N 00138 CHARACTER UPLO 00139 * .. 00140 * .. Array Arguments .. 00141 REAL AP(*),X(*) 00142 * .. 00143 * 00144 * ===================================================================== 00145 * 00146 * .. Parameters .. 00147 REAL ZERO 00148 PARAMETER (ZERO=0.0E+0) 00149 * .. 00150 * .. Local Scalars .. 00151 REAL TEMP 00152 INTEGER I,INFO,IX,J,JX,K,KK,KX 00153 * .. 00154 * .. External Functions .. 00155 LOGICAL LSAME 00156 EXTERNAL LSAME 00157 * .. 00158 * .. External Subroutines .. 00159 EXTERNAL XERBLA 00160 * .. 00161 * 00162 * Test the input parameters. 00163 * 00164 INFO = 0 00165 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN 00166 INFO = 1 00167 ELSE IF (N.LT.0) THEN 00168 INFO = 2 00169 ELSE IF (INCX.EQ.0) THEN 00170 INFO = 5 00171 END IF 00172 IF (INFO.NE.0) THEN 00173 CALL XERBLA('SSPR ',INFO) 00174 RETURN 00175 END IF 00176 * 00177 * Quick return if possible. 00178 * 00179 IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN 00180 * 00181 * Set the start point in X if the increment is not unity. 00182 * 00183 IF (INCX.LE.0) THEN 00184 KX = 1 - (N-1)*INCX 00185 ELSE IF (INCX.NE.1) THEN 00186 KX = 1 00187 END IF 00188 * 00189 * Start the operations. In this version the elements of the array AP 00190 * are accessed sequentially with one pass through AP. 00191 * 00192 KK = 1 00193 IF (LSAME(UPLO,'U')) THEN 00194 * 00195 * Form A when upper triangle is stored in AP. 00196 * 00197 IF (INCX.EQ.1) THEN 00198 DO 20 J = 1,N 00199 IF (X(J).NE.ZERO) THEN 00200 TEMP = ALPHA*X(J) 00201 K = KK 00202 DO 10 I = 1,J 00203 AP(K) = AP(K) + X(I)*TEMP 00204 K = K + 1 00205 10 CONTINUE 00206 END IF 00207 KK = KK + J 00208 20 CONTINUE 00209 ELSE 00210 JX = KX 00211 DO 40 J = 1,N 00212 IF (X(JX).NE.ZERO) THEN 00213 TEMP = ALPHA*X(JX) 00214 IX = KX 00215 DO 30 K = KK,KK + J - 1 00216 AP(K) = AP(K) + X(IX)*TEMP 00217 IX = IX + INCX 00218 30 CONTINUE 00219 END IF 00220 JX = JX + INCX 00221 KK = KK + J 00222 40 CONTINUE 00223 END IF 00224 ELSE 00225 * 00226 * Form A when lower triangle is stored in AP. 00227 * 00228 IF (INCX.EQ.1) THEN 00229 DO 60 J = 1,N 00230 IF (X(J).NE.ZERO) THEN 00231 TEMP = ALPHA*X(J) 00232 K = KK 00233 DO 50 I = J,N 00234 AP(K) = AP(K) + X(I)*TEMP 00235 K = K + 1 00236 50 CONTINUE 00237 END IF 00238 KK = KK + N - J + 1 00239 60 CONTINUE 00240 ELSE 00241 JX = KX 00242 DO 80 J = 1,N 00243 IF (X(JX).NE.ZERO) THEN 00244 TEMP = ALPHA*X(JX) 00245 IX = JX 00246 DO 70 K = KK,KK + N - J 00247 AP(K) = AP(K) + X(IX)*TEMP 00248 IX = IX + INCX 00249 70 CONTINUE 00250 END IF 00251 JX = JX + INCX 00252 KK = KK + N - J + 1 00253 80 CONTINUE 00254 END IF 00255 END IF 00256 * 00257 RETURN 00258 * 00259 * End of SSPR . 00260 * 00261 END