![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZSPR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZSPR + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zspr.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zspr.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zspr.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZSPR( UPLO, N, ALPHA, X, INCX, AP ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER UPLO 00025 * INTEGER INCX, N 00026 * COMPLEX*16 ALPHA 00027 * .. 00028 * .. Array Arguments .. 00029 * COMPLEX*16 AP( * ), X( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> ZSPR performs the symmetric rank 1 operation 00039 *> 00040 *> A := alpha*x*x**H + A, 00041 *> 00042 *> where alpha is a complex scalar, x is an n element vector and A is an 00043 *> n by n symmetric matrix, supplied in packed form. 00044 *> \endverbatim 00045 * 00046 * Arguments: 00047 * ========== 00048 * 00049 *> \param[in] UPLO 00050 *> \verbatim 00051 *> UPLO is CHARACTER*1 00052 *> On entry, UPLO specifies whether the upper or lower 00053 *> triangular part of the matrix A is supplied in the packed 00054 *> array AP as follows: 00055 *> 00056 *> UPLO = 'U' or 'u' The upper triangular part of A is 00057 *> supplied in AP. 00058 *> 00059 *> UPLO = 'L' or 'l' The lower triangular part of A is 00060 *> supplied in AP. 00061 *> 00062 *> Unchanged on exit. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] N 00066 *> \verbatim 00067 *> N is INTEGER 00068 *> On entry, N specifies the order of the matrix A. 00069 *> N must be at least zero. 00070 *> Unchanged on exit. 00071 *> \endverbatim 00072 *> 00073 *> \param[in] ALPHA 00074 *> \verbatim 00075 *> ALPHA is COMPLEX*16 00076 *> On entry, ALPHA specifies the scalar alpha. 00077 *> Unchanged on exit. 00078 *> \endverbatim 00079 *> 00080 *> \param[in] X 00081 *> \verbatim 00082 *> X is COMPLEX*16 array, dimension at least 00083 *> ( 1 + ( N - 1 )*abs( INCX ) ). 00084 *> Before entry, the incremented array X must contain the N- 00085 *> element vector x. 00086 *> Unchanged on exit. 00087 *> \endverbatim 00088 *> 00089 *> \param[in] INCX 00090 *> \verbatim 00091 *> INCX is INTEGER 00092 *> On entry, INCX specifies the increment for the elements of 00093 *> X. INCX must not be zero. 00094 *> Unchanged on exit. 00095 *> \endverbatim 00096 *> 00097 *> \param[in,out] AP 00098 *> \verbatim 00099 *> AP is COMPLEX*16 array, dimension at least 00100 *> ( ( N*( N + 1 ) )/2 ). 00101 *> Before entry, with UPLO = 'U' or 'u', the array AP must 00102 *> contain the upper triangular part of the symmetric matrix 00103 *> packed sequentially, column by column, so that AP( 1 ) 00104 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) 00105 *> and a( 2, 2 ) respectively, and so on. On exit, the array 00106 *> AP is overwritten by the upper triangular part of the 00107 *> updated matrix. 00108 *> Before entry, with UPLO = 'L' or 'l', the array AP must 00109 *> contain the lower triangular part of the symmetric matrix 00110 *> packed sequentially, column by column, so that AP( 1 ) 00111 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) 00112 *> and a( 3, 1 ) respectively, and so on. On exit, the array 00113 *> AP is overwritten by the lower triangular part of the 00114 *> updated matrix. 00115 *> Note that the imaginary parts of the diagonal elements need 00116 *> not be set, they are assumed to be zero, and on exit they 00117 *> are set to zero. 00118 *> \endverbatim 00119 * 00120 * Authors: 00121 * ======== 00122 * 00123 *> \author Univ. of Tennessee 00124 *> \author Univ. of California Berkeley 00125 *> \author Univ. of Colorado Denver 00126 *> \author NAG Ltd. 00127 * 00128 *> \date November 2011 00129 * 00130 *> \ingroup complex16OTHERauxiliary 00131 * 00132 * ===================================================================== 00133 SUBROUTINE ZSPR( UPLO, N, ALPHA, X, INCX, AP ) 00134 * 00135 * -- LAPACK auxiliary routine (version 3.4.0) -- 00136 * -- LAPACK 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 CHARACTER UPLO 00142 INTEGER INCX, N 00143 COMPLEX*16 ALPHA 00144 * .. 00145 * .. Array Arguments .. 00146 COMPLEX*16 AP( * ), X( * ) 00147 * .. 00148 * 00149 * ===================================================================== 00150 * 00151 * .. Parameters .. 00152 COMPLEX*16 ZERO 00153 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) 00154 * .. 00155 * .. Local Scalars .. 00156 INTEGER I, INFO, IX, J, JX, K, KK, KX 00157 COMPLEX*16 TEMP 00158 * .. 00159 * .. External Functions .. 00160 LOGICAL LSAME 00161 EXTERNAL LSAME 00162 * .. 00163 * .. External Subroutines .. 00164 EXTERNAL XERBLA 00165 * .. 00166 * .. Executable Statements .. 00167 * 00168 * Test the input parameters. 00169 * 00170 INFO = 0 00171 IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00172 INFO = 1 00173 ELSE IF( N.LT.0 ) THEN 00174 INFO = 2 00175 ELSE IF( INCX.EQ.0 ) THEN 00176 INFO = 5 00177 END IF 00178 IF( INFO.NE.0 ) THEN 00179 CALL XERBLA( 'ZSPR ', INFO ) 00180 RETURN 00181 END IF 00182 * 00183 * Quick return if possible. 00184 * 00185 IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) ) 00186 $ RETURN 00187 * 00188 * Set the start point in X if the increment is not unity. 00189 * 00190 IF( INCX.LE.0 ) THEN 00191 KX = 1 - ( N-1 )*INCX 00192 ELSE IF( INCX.NE.1 ) THEN 00193 KX = 1 00194 END IF 00195 * 00196 * Start the operations. In this version the elements of the array AP 00197 * are accessed sequentially with one pass through AP. 00198 * 00199 KK = 1 00200 IF( LSAME( UPLO, 'U' ) ) THEN 00201 * 00202 * Form A when upper triangle is stored in AP. 00203 * 00204 IF( INCX.EQ.1 ) THEN 00205 DO 20 J = 1, N 00206 IF( X( J ).NE.ZERO ) THEN 00207 TEMP = ALPHA*X( J ) 00208 K = KK 00209 DO 10 I = 1, J - 1 00210 AP( K ) = AP( K ) + X( I )*TEMP 00211 K = K + 1 00212 10 CONTINUE 00213 AP( KK+J-1 ) = AP( KK+J-1 ) + X( J )*TEMP 00214 ELSE 00215 AP( KK+J-1 ) = AP( KK+J-1 ) 00216 END IF 00217 KK = KK + J 00218 20 CONTINUE 00219 ELSE 00220 JX = KX 00221 DO 40 J = 1, N 00222 IF( X( JX ).NE.ZERO ) THEN 00223 TEMP = ALPHA*X( JX ) 00224 IX = KX 00225 DO 30 K = KK, KK + J - 2 00226 AP( K ) = AP( K ) + X( IX )*TEMP 00227 IX = IX + INCX 00228 30 CONTINUE 00229 AP( KK+J-1 ) = AP( KK+J-1 ) + X( JX )*TEMP 00230 ELSE 00231 AP( KK+J-1 ) = AP( KK+J-1 ) 00232 END IF 00233 JX = JX + INCX 00234 KK = KK + J 00235 40 CONTINUE 00236 END IF 00237 ELSE 00238 * 00239 * Form A when lower triangle is stored in AP. 00240 * 00241 IF( INCX.EQ.1 ) THEN 00242 DO 60 J = 1, N 00243 IF( X( J ).NE.ZERO ) THEN 00244 TEMP = ALPHA*X( J ) 00245 AP( KK ) = AP( KK ) + TEMP*X( J ) 00246 K = KK + 1 00247 DO 50 I = J + 1, N 00248 AP( K ) = AP( K ) + X( I )*TEMP 00249 K = K + 1 00250 50 CONTINUE 00251 ELSE 00252 AP( KK ) = AP( KK ) 00253 END IF 00254 KK = KK + N - J + 1 00255 60 CONTINUE 00256 ELSE 00257 JX = KX 00258 DO 80 J = 1, N 00259 IF( X( JX ).NE.ZERO ) THEN 00260 TEMP = ALPHA*X( JX ) 00261 AP( KK ) = AP( KK ) + TEMP*X( JX ) 00262 IX = JX 00263 DO 70 K = KK + 1, KK + N - J 00264 IX = IX + INCX 00265 AP( K ) = AP( K ) + X( IX )*TEMP 00266 70 CONTINUE 00267 ELSE 00268 AP( KK ) = AP( KK ) 00269 END IF 00270 JX = JX + INCX 00271 KK = KK + N - J + 1 00272 80 CONTINUE 00273 END IF 00274 END IF 00275 * 00276 RETURN 00277 * 00278 * End of ZSPR 00279 * 00280 END