![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLA_SYAMV 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLA_SYAMV + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_syamv.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_syamv.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_syamv.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, 00022 * INCY ) 00023 * 00024 * .. Scalar Arguments .. 00025 * REAL ALPHA, BETA 00026 * INTEGER INCX, INCY, LDA, N 00027 * INTEGER UPLO 00028 * .. 00029 * .. Array Arguments .. 00030 * COMPLEX A( LDA, * ), X( * ) 00031 * REAL Y( * ) 00032 * .. 00033 * 00034 * 00035 *> \par Purpose: 00036 * ============= 00037 *> 00038 *> \verbatim 00039 *> 00040 *> CLA_SYAMV performs the matrix-vector operation 00041 *> 00042 *> y := alpha*abs(A)*abs(x) + beta*abs(y), 00043 *> 00044 *> where alpha and beta are scalars, x and y are vectors and A is an 00045 *> n by n symmetric matrix. 00046 *> 00047 *> This function is primarily used in calculating error bounds. 00048 *> To protect against underflow during evaluation, components in 00049 *> the resulting vector are perturbed away from zero by (N+1) 00050 *> times the underflow threshold. To prevent unnecessarily large 00051 *> errors for block-structure embedded in general matrices, 00052 *> "symbolically" zero components are not perturbed. A zero 00053 *> entry is considered "symbolic" if all multiplications involved 00054 *> in computing that entry have at least one zero multiplicand. 00055 *> \endverbatim 00056 * 00057 * Arguments: 00058 * ========== 00059 * 00060 *> \param[in] UPLO 00061 *> \verbatim 00062 *> UPLO is INTEGER 00063 *> On entry, UPLO specifies whether the upper or lower 00064 *> triangular part of the array A is to be referenced as 00065 *> follows: 00066 *> 00067 *> UPLO = BLAS_UPPER Only the upper triangular part of A 00068 *> is to be referenced. 00069 *> 00070 *> UPLO = BLAS_LOWER Only the lower triangular part of A 00071 *> is to be referenced. 00072 *> 00073 *> Unchanged on exit. 00074 *> \endverbatim 00075 *> 00076 *> \param[in] N 00077 *> \verbatim 00078 *> N is INTEGER 00079 *> On entry, N specifies the number of columns of the matrix A. 00080 *> N must be at least zero. 00081 *> Unchanged on exit. 00082 *> \endverbatim 00083 *> 00084 *> \param[in] ALPHA 00085 *> \verbatim 00086 *> ALPHA is REAL . 00087 *> On entry, ALPHA specifies the scalar alpha. 00088 *> Unchanged on exit. 00089 *> \endverbatim 00090 *> 00091 *> \param[in] A 00092 *> \verbatim 00093 *> A is COMPLEX array of DIMENSION ( LDA, n ). 00094 *> Before entry, the leading m by n part of the array A must 00095 *> contain the matrix of coefficients. 00096 *> Unchanged on exit. 00097 *> \endverbatim 00098 *> 00099 *> \param[in] LDA 00100 *> \verbatim 00101 *> LDA is INTEGER 00102 *> On entry, LDA specifies the first dimension of A as declared 00103 *> in the calling (sub) program. LDA must be at least 00104 *> max( 1, n ). 00105 *> Unchanged on exit. 00106 *> \endverbatim 00107 *> 00108 *> \param[in] X 00109 *> \verbatim 00110 *> X is COMPLEX array, dimension 00111 *> ( 1 + ( n - 1 )*abs( INCX ) ) 00112 *> Before entry, the incremented array X must contain the 00113 *> vector x. 00114 *> Unchanged on exit. 00115 *> \endverbatim 00116 *> 00117 *> \param[in] INCX 00118 *> \verbatim 00119 *> INCX is INTEGER 00120 *> On entry, INCX specifies the increment for the elements of 00121 *> X. INCX must not be zero. 00122 *> Unchanged on exit. 00123 *> \endverbatim 00124 *> 00125 *> \param[in] BETA 00126 *> \verbatim 00127 *> BETA is REAL . 00128 *> On entry, BETA specifies the scalar beta. When BETA is 00129 *> supplied as zero then Y need not be set on input. 00130 *> Unchanged on exit. 00131 *> \endverbatim 00132 *> 00133 *> \param[in,out] Y 00134 *> \verbatim 00135 *> Y is REAL array, dimension 00136 *> ( 1 + ( n - 1 )*abs( INCY ) ) 00137 *> Before entry with BETA non-zero, the incremented array Y 00138 *> must contain the vector y. On exit, Y is overwritten by the 00139 *> updated vector y. 00140 *> \endverbatim 00141 *> 00142 *> \param[in] INCY 00143 *> \verbatim 00144 *> INCY is INTEGER 00145 *> On entry, INCY specifies the increment for the elements of 00146 *> Y. INCY must not be zero. 00147 *> Unchanged on exit. 00148 *> \endverbatim 00149 * 00150 * Authors: 00151 * ======== 00152 * 00153 *> \author Univ. of Tennessee 00154 *> \author Univ. of California Berkeley 00155 *> \author Univ. of Colorado Denver 00156 *> \author NAG Ltd. 00157 * 00158 *> \date November 2011 00159 * 00160 *> \ingroup complexSYcomputational 00161 * 00162 *> \par Further Details: 00163 * ===================== 00164 *> 00165 *> \verbatim 00166 *> 00167 *> Level 2 Blas routine. 00168 *> 00169 *> -- Written on 22-October-1986. 00170 *> Jack Dongarra, Argonne National Lab. 00171 *> Jeremy Du Croz, Nag Central Office. 00172 *> Sven Hammarling, Nag Central Office. 00173 *> Richard Hanson, Sandia National Labs. 00174 *> -- Modified for the absolute-value product, April 2006 00175 *> Jason Riedy, UC Berkeley 00176 *> \endverbatim 00177 *> 00178 * ===================================================================== 00179 SUBROUTINE CLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, 00180 $ INCY ) 00181 * 00182 * -- LAPACK computational routine (version 3.4.0) -- 00183 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00184 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00185 * November 2011 00186 * 00187 * .. Scalar Arguments .. 00188 REAL ALPHA, BETA 00189 INTEGER INCX, INCY, LDA, N 00190 INTEGER UPLO 00191 * .. 00192 * .. Array Arguments .. 00193 COMPLEX A( LDA, * ), X( * ) 00194 REAL Y( * ) 00195 * .. 00196 * 00197 * ===================================================================== 00198 * 00199 * .. Parameters .. 00200 REAL ONE, ZERO 00201 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00202 * .. 00203 * .. Local Scalars .. 00204 LOGICAL SYMB_ZERO 00205 REAL TEMP, SAFE1 00206 INTEGER I, INFO, IY, J, JX, KX, KY 00207 COMPLEX ZDUM 00208 * .. 00209 * .. External Subroutines .. 00210 EXTERNAL XERBLA, SLAMCH 00211 REAL SLAMCH 00212 * .. 00213 * .. External Functions .. 00214 EXTERNAL ILAUPLO 00215 INTEGER ILAUPLO 00216 * .. 00217 * .. Intrinsic Functions .. 00218 INTRINSIC MAX, ABS, SIGN, REAL, AIMAG 00219 * .. 00220 * .. Statement Functions .. 00221 REAL CABS1 00222 * .. 00223 * .. Statement Function Definitions .. 00224 CABS1( ZDUM ) = ABS( REAL ( ZDUM ) ) + ABS( AIMAG ( ZDUM ) ) 00225 * .. 00226 * .. Executable Statements .. 00227 * 00228 * Test the input parameters. 00229 * 00230 INFO = 0 00231 IF ( UPLO.NE.ILAUPLO( 'U' ) .AND. 00232 $ UPLO.NE.ILAUPLO( 'L' ) )THEN 00233 INFO = 1 00234 ELSE IF( N.LT.0 )THEN 00235 INFO = 2 00236 ELSE IF( LDA.LT.MAX( 1, N ) )THEN 00237 INFO = 5 00238 ELSE IF( INCX.EQ.0 )THEN 00239 INFO = 7 00240 ELSE IF( INCY.EQ.0 )THEN 00241 INFO = 10 00242 END IF 00243 IF( INFO.NE.0 )THEN 00244 CALL XERBLA( 'SSYMV ', INFO ) 00245 RETURN 00246 END IF 00247 * 00248 * Quick return if possible. 00249 * 00250 IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) 00251 $ RETURN 00252 * 00253 * Set up the start points in X and Y. 00254 * 00255 IF( INCX.GT.0 )THEN 00256 KX = 1 00257 ELSE 00258 KX = 1 - ( N - 1 )*INCX 00259 END IF 00260 IF( INCY.GT.0 )THEN 00261 KY = 1 00262 ELSE 00263 KY = 1 - ( N - 1 )*INCY 00264 END IF 00265 * 00266 * Set SAFE1 essentially to be the underflow threshold times the 00267 * number of additions in each row. 00268 * 00269 SAFE1 = SLAMCH( 'Safe minimum' ) 00270 SAFE1 = (N+1)*SAFE1 00271 * 00272 * Form y := alpha*abs(A)*abs(x) + beta*abs(y). 00273 * 00274 * The O(N^2) SYMB_ZERO tests could be replaced by O(N) queries to 00275 * the inexact flag. Still doesn't help change the iteration order 00276 * to per-column. 00277 * 00278 IY = KY 00279 IF ( INCX.EQ.1 ) THEN 00280 IF ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN 00281 DO I = 1, N 00282 IF ( BETA .EQ. ZERO ) THEN 00283 SYMB_ZERO = .TRUE. 00284 Y( IY ) = 0.0 00285 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00286 SYMB_ZERO = .TRUE. 00287 ELSE 00288 SYMB_ZERO = .FALSE. 00289 Y( IY ) = BETA * ABS( Y( IY ) ) 00290 END IF 00291 IF ( ALPHA .NE. ZERO ) THEN 00292 DO J = 1, I 00293 TEMP = CABS1( A( J, I ) ) 00294 SYMB_ZERO = SYMB_ZERO .AND. 00295 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00296 00297 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP 00298 END DO 00299 DO J = I+1, N 00300 TEMP = CABS1( A( I, J ) ) 00301 SYMB_ZERO = SYMB_ZERO .AND. 00302 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00303 00304 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP 00305 END DO 00306 END IF 00307 00308 IF ( .NOT.SYMB_ZERO ) 00309 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00310 00311 IY = IY + INCY 00312 END DO 00313 ELSE 00314 DO I = 1, N 00315 IF ( BETA .EQ. ZERO ) THEN 00316 SYMB_ZERO = .TRUE. 00317 Y( IY ) = 0.0 00318 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00319 SYMB_ZERO = .TRUE. 00320 ELSE 00321 SYMB_ZERO = .FALSE. 00322 Y( IY ) = BETA * ABS( Y( IY ) ) 00323 END IF 00324 IF ( ALPHA .NE. ZERO ) THEN 00325 DO J = 1, I 00326 TEMP = CABS1( A( I, J ) ) 00327 SYMB_ZERO = SYMB_ZERO .AND. 00328 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00329 00330 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP 00331 END DO 00332 DO J = I+1, N 00333 TEMP = CABS1( A( J, I ) ) 00334 SYMB_ZERO = SYMB_ZERO .AND. 00335 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00336 00337 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP 00338 END DO 00339 END IF 00340 00341 IF ( .NOT.SYMB_ZERO ) 00342 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00343 00344 IY = IY + INCY 00345 END DO 00346 END IF 00347 ELSE 00348 IF ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN 00349 DO I = 1, N 00350 IF ( BETA .EQ. ZERO ) THEN 00351 SYMB_ZERO = .TRUE. 00352 Y( IY ) = 0.0 00353 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00354 SYMB_ZERO = .TRUE. 00355 ELSE 00356 SYMB_ZERO = .FALSE. 00357 Y( IY ) = BETA * ABS( Y( IY ) ) 00358 END IF 00359 JX = KX 00360 IF ( ALPHA .NE. ZERO ) THEN 00361 DO J = 1, I 00362 TEMP = CABS1( A( J, I ) ) 00363 SYMB_ZERO = SYMB_ZERO .AND. 00364 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00365 00366 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP 00367 JX = JX + INCX 00368 END DO 00369 DO J = I+1, N 00370 TEMP = CABS1( A( I, J ) ) 00371 SYMB_ZERO = SYMB_ZERO .AND. 00372 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00373 00374 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP 00375 JX = JX + INCX 00376 END DO 00377 END IF 00378 00379 IF ( .NOT.SYMB_ZERO ) 00380 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00381 00382 IY = IY + INCY 00383 END DO 00384 ELSE 00385 DO I = 1, N 00386 IF ( BETA .EQ. ZERO ) THEN 00387 SYMB_ZERO = .TRUE. 00388 Y( IY ) = 0.0 00389 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00390 SYMB_ZERO = .TRUE. 00391 ELSE 00392 SYMB_ZERO = .FALSE. 00393 Y( IY ) = BETA * ABS( Y( IY ) ) 00394 END IF 00395 JX = KX 00396 IF ( ALPHA .NE. ZERO ) THEN 00397 DO J = 1, I 00398 TEMP = CABS1( A( I, J ) ) 00399 SYMB_ZERO = SYMB_ZERO .AND. 00400 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00401 00402 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP 00403 JX = JX + INCX 00404 END DO 00405 DO J = I+1, N 00406 TEMP = CABS1( A( J, I ) ) 00407 SYMB_ZERO = SYMB_ZERO .AND. 00408 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00409 00410 Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP 00411 JX = JX + INCX 00412 END DO 00413 END IF 00414 00415 IF ( .NOT.SYMB_ZERO ) 00416 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00417 00418 IY = IY + INCY 00419 END DO 00420 END IF 00421 00422 END IF 00423 * 00424 RETURN 00425 * 00426 * End of CLA_SYAMV 00427 * 00428 END