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