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