![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZSYR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZSYR + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyr.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyr.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyr.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER UPLO 00025 * INTEGER INCX, LDA, N 00026 * COMPLEX*16 ALPHA 00027 * .. 00028 * .. Array Arguments .. 00029 * COMPLEX*16 A( LDA, * ), X( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> ZSYR 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. 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 array A is to be referenced as 00054 *> follows: 00055 *> 00056 *> UPLO = 'U' or 'u' Only the upper triangular part of A 00057 *> is to be referenced. 00058 *> 00059 *> UPLO = 'L' or 'l' Only the lower triangular part of A 00060 *> is to be referenced. 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] A 00098 *> \verbatim 00099 *> A is COMPLEX*16 array, dimension ( LDA, N ) 00100 *> Before entry, with UPLO = 'U' or 'u', the leading n by n 00101 *> upper triangular part of the array A must contain the upper 00102 *> triangular part of the symmetric matrix and the strictly 00103 *> lower triangular part of A is not referenced. On exit, the 00104 *> upper triangular part of the array A is overwritten by the 00105 *> upper triangular part of the updated matrix. 00106 *> Before entry, with UPLO = 'L' or 'l', the leading n by n 00107 *> lower triangular part of the array A must contain the lower 00108 *> triangular part of the symmetric matrix and the strictly 00109 *> upper triangular part of A is not referenced. On exit, the 00110 *> lower triangular part of the array A is overwritten by the 00111 *> lower triangular part of the updated matrix. 00112 *> \endverbatim 00113 *> 00114 *> \param[in] LDA 00115 *> \verbatim 00116 *> LDA is INTEGER 00117 *> On entry, LDA specifies the first dimension of A as declared 00118 *> in the calling (sub) program. LDA must be at least 00119 *> max( 1, N ). 00120 *> Unchanged on exit. 00121 *> \endverbatim 00122 * 00123 * Authors: 00124 * ======== 00125 * 00126 *> \author Univ. of Tennessee 00127 *> \author Univ. of California Berkeley 00128 *> \author Univ. of Colorado Denver 00129 *> \author NAG Ltd. 00130 * 00131 *> \date November 2011 00132 * 00133 *> \ingroup complex16SYauxiliary 00134 * 00135 * ===================================================================== 00136 SUBROUTINE ZSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) 00137 * 00138 * -- LAPACK auxiliary routine (version 3.4.0) -- 00139 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00140 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00141 * November 2011 00142 * 00143 * .. Scalar Arguments .. 00144 CHARACTER UPLO 00145 INTEGER INCX, LDA, N 00146 COMPLEX*16 ALPHA 00147 * .. 00148 * .. Array Arguments .. 00149 COMPLEX*16 A( LDA, * ), X( * ) 00150 * .. 00151 * 00152 * ===================================================================== 00153 * 00154 * .. Parameters .. 00155 COMPLEX*16 ZERO 00156 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) 00157 * .. 00158 * .. Local Scalars .. 00159 INTEGER I, INFO, IX, J, JX, KX 00160 COMPLEX*16 TEMP 00161 * .. 00162 * .. External Functions .. 00163 LOGICAL LSAME 00164 EXTERNAL LSAME 00165 * .. 00166 * .. External Subroutines .. 00167 EXTERNAL XERBLA 00168 * .. 00169 * .. Intrinsic Functions .. 00170 INTRINSIC MAX 00171 * .. 00172 * .. Executable Statements .. 00173 * 00174 * Test the input parameters. 00175 * 00176 INFO = 0 00177 IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00178 INFO = 1 00179 ELSE IF( N.LT.0 ) THEN 00180 INFO = 2 00181 ELSE IF( INCX.EQ.0 ) THEN 00182 INFO = 5 00183 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00184 INFO = 7 00185 END IF 00186 IF( INFO.NE.0 ) THEN 00187 CALL XERBLA( 'ZSYR ', INFO ) 00188 RETURN 00189 END IF 00190 * 00191 * Quick return if possible. 00192 * 00193 IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) ) 00194 $ RETURN 00195 * 00196 * Set the start point in X if the increment is not unity. 00197 * 00198 IF( INCX.LE.0 ) THEN 00199 KX = 1 - ( N-1 )*INCX 00200 ELSE IF( INCX.NE.1 ) THEN 00201 KX = 1 00202 END IF 00203 * 00204 * Start the operations. In this version the elements of A are 00205 * accessed sequentially with one pass through the triangular part 00206 * of A. 00207 * 00208 IF( LSAME( UPLO, 'U' ) ) THEN 00209 * 00210 * Form A when A is stored in upper triangle. 00211 * 00212 IF( INCX.EQ.1 ) THEN 00213 DO 20 J = 1, N 00214 IF( X( J ).NE.ZERO ) THEN 00215 TEMP = ALPHA*X( J ) 00216 DO 10 I = 1, J 00217 A( I, J ) = A( I, J ) + X( I )*TEMP 00218 10 CONTINUE 00219 END IF 00220 20 CONTINUE 00221 ELSE 00222 JX = KX 00223 DO 40 J = 1, N 00224 IF( X( JX ).NE.ZERO ) THEN 00225 TEMP = ALPHA*X( JX ) 00226 IX = KX 00227 DO 30 I = 1, J 00228 A( I, J ) = A( I, J ) + X( IX )*TEMP 00229 IX = IX + INCX 00230 30 CONTINUE 00231 END IF 00232 JX = JX + INCX 00233 40 CONTINUE 00234 END IF 00235 ELSE 00236 * 00237 * Form A when A is stored in lower triangle. 00238 * 00239 IF( INCX.EQ.1 ) THEN 00240 DO 60 J = 1, N 00241 IF( X( J ).NE.ZERO ) THEN 00242 TEMP = ALPHA*X( J ) 00243 DO 50 I = J, N 00244 A( I, J ) = A( I, J ) + X( I )*TEMP 00245 50 CONTINUE 00246 END IF 00247 60 CONTINUE 00248 ELSE 00249 JX = KX 00250 DO 80 J = 1, N 00251 IF( X( JX ).NE.ZERO ) THEN 00252 TEMP = ALPHA*X( JX ) 00253 IX = JX 00254 DO 70 I = J, N 00255 A( I, J ) = A( I, J ) + X( IX )*TEMP 00256 IX = IX + INCX 00257 70 CONTINUE 00258 END IF 00259 JX = JX + INCX 00260 80 CONTINUE 00261 END IF 00262 END IF 00263 * 00264 RETURN 00265 * 00266 * End of ZSYR 00267 * 00268 END