![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLA_GBAMV 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLA_GBAMV + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_gbamv.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_gbamv.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_gbamv.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X, 00022 * INCX, BETA, Y, INCY ) 00023 * 00024 * .. Scalar Arguments .. 00025 * REAL ALPHA, BETA 00026 * INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS 00027 * .. 00028 * .. Array Arguments .. 00029 * REAL AB( LDAB, * ), X( * ), Y( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> SLA_GBAMV 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] KL 00089 *> \verbatim 00090 *> KL is INTEGER 00091 *> The number of subdiagonals within the band of A. KL >= 0. 00092 *> \endverbatim 00093 *> 00094 *> \param[in] KU 00095 *> \verbatim 00096 *> KU is INTEGER 00097 *> The number of superdiagonals within the band of A. KU >= 0. 00098 *> \endverbatim 00099 *> 00100 *> \param[in] ALPHA 00101 *> \verbatim 00102 *> ALPHA is REAL 00103 *> On entry, ALPHA specifies the scalar alpha. 00104 *> Unchanged on exit. 00105 *> \endverbatim 00106 *> 00107 *> \param[in] AB 00108 *> \verbatim 00109 *> AB is REAL array of DIMENSION ( LDAB, n ) 00110 *> Before entry, the leading m by n part of the array AB must 00111 *> contain the matrix of coefficients. 00112 *> Unchanged on exit. 00113 *> \endverbatim 00114 *> 00115 *> \param[in] LDAB 00116 *> \verbatim 00117 *> LDAB is INTEGER 00118 *> On entry, LDA specifies the first dimension of AB as declared 00119 *> in the calling (sub) program. LDAB must be at least 00120 *> max( 1, m ). 00121 *> Unchanged on exit. 00122 *> \endverbatim 00123 *> 00124 *> \param[in] X 00125 *> \verbatim 00126 *> X is REAL array, dimension 00127 *> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' 00128 *> and at least 00129 *> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. 00130 *> Before entry, the incremented array X must contain the 00131 *> vector x. 00132 *> Unchanged on exit. 00133 *> \endverbatim 00134 *> 00135 *> \param[in] INCX 00136 *> \verbatim 00137 *> INCX is INTEGER 00138 *> On entry, INCX specifies the increment for the elements of 00139 *> X. INCX must not be zero. 00140 *> Unchanged on exit. 00141 *> \endverbatim 00142 *> 00143 *> \param[in] BETA 00144 *> \verbatim 00145 *> BETA is REAL 00146 *> On entry, BETA specifies the scalar beta. When BETA is 00147 *> supplied as zero then Y need not be set on input. 00148 *> Unchanged on exit. 00149 *> \endverbatim 00150 *> 00151 *> \param[in,out] Y 00152 *> \verbatim 00153 *> Y is REAL array, dimension 00154 *> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' 00155 *> and at least 00156 *> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. 00157 *> Before entry with BETA non-zero, the incremented array Y 00158 *> must contain the vector y. On exit, Y is overwritten by the 00159 *> updated vector y. 00160 *> \endverbatim 00161 *> 00162 *> \param[in] INCY 00163 *> \verbatim 00164 *> INCY is INTEGER 00165 *> On entry, INCY specifies the increment for the elements of 00166 *> Y. INCY must not be zero. 00167 *> Unchanged on exit. 00168 *> 00169 *> Level 2 Blas routine. 00170 *> \endverbatim 00171 * 00172 * Authors: 00173 * ======== 00174 * 00175 *> \author Univ. of Tennessee 00176 *> \author Univ. of California Berkeley 00177 *> \author Univ. of Colorado Denver 00178 *> \author NAG Ltd. 00179 * 00180 *> \date November 2011 00181 * 00182 *> \ingroup realGBcomputational 00183 * 00184 * ===================================================================== 00185 SUBROUTINE SLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X, 00186 $ INCX, BETA, Y, INCY ) 00187 * 00188 * -- LAPACK computational routine (version 3.4.0) -- 00189 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00190 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00191 * November 2011 00192 * 00193 * .. Scalar Arguments .. 00194 REAL ALPHA, BETA 00195 INTEGER INCX, INCY, LDAB, M, N, KL, KU, TRANS 00196 * .. 00197 * .. Array Arguments .. 00198 REAL AB( LDAB, * ), X( * ), Y( * ) 00199 * .. 00200 * 00201 * ===================================================================== 00202 * .. Parameters .. 00203 REAL ONE, ZERO 00204 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00205 * .. 00206 * .. Local Scalars .. 00207 LOGICAL SYMB_ZERO 00208 REAL TEMP, SAFE1 00209 INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE 00210 * .. 00211 * .. External Subroutines .. 00212 EXTERNAL XERBLA, SLAMCH 00213 REAL SLAMCH 00214 * .. 00215 * .. External Functions .. 00216 EXTERNAL ILATRANS 00217 INTEGER ILATRANS 00218 * .. 00219 * .. Intrinsic Functions .. 00220 INTRINSIC MAX, ABS, SIGN 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( KL.LT.0 .OR. KL.GT.M-1 ) THEN 00236 INFO = 4 00237 ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN 00238 INFO = 5 00239 ELSE IF( LDAB.LT.KL+KU+1 )THEN 00240 INFO = 6 00241 ELSE IF( INCX.EQ.0 )THEN 00242 INFO = 8 00243 ELSE IF( INCY.EQ.0 )THEN 00244 INFO = 11 00245 END IF 00246 IF( INFO.NE.0 )THEN 00247 CALL XERBLA( 'SLA_GBAMV ', INFO ) 00248 RETURN 00249 END IF 00250 * 00251 * Quick return if possible. 00252 * 00253 IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR. 00254 $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) 00255 $ RETURN 00256 * 00257 * Set LENX and LENY, the lengths of the vectors x and y, and set 00258 * up the start points in X and Y. 00259 * 00260 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN 00261 LENX = N 00262 LENY = M 00263 ELSE 00264 LENX = M 00265 LENY = N 00266 END IF 00267 IF( INCX.GT.0 )THEN 00268 KX = 1 00269 ELSE 00270 KX = 1 - ( LENX - 1 )*INCX 00271 END IF 00272 IF( INCY.GT.0 )THEN 00273 KY = 1 00274 ELSE 00275 KY = 1 - ( LENY - 1 )*INCY 00276 END IF 00277 * 00278 * Set SAFE1 essentially to be the underflow threshold times the 00279 * number of additions in each row. 00280 * 00281 SAFE1 = SLAMCH( 'Safe minimum' ) 00282 SAFE1 = (N+1)*SAFE1 00283 * 00284 * Form y := alpha*abs(A)*abs(x) + beta*abs(y). 00285 * 00286 * The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to 00287 * the inexact flag. Still doesn't help change the iteration order 00288 * to per-column. 00289 * 00290 KD = KU + 1 00291 KE = KL + 1 00292 IY = KY 00293 IF ( INCX.EQ.1 ) THEN 00294 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN 00295 DO I = 1, LENY 00296 IF ( BETA .EQ. ZERO ) THEN 00297 SYMB_ZERO = .TRUE. 00298 Y( IY ) = 0.0 00299 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00300 SYMB_ZERO = .TRUE. 00301 ELSE 00302 SYMB_ZERO = .FALSE. 00303 Y( IY ) = BETA * ABS( Y( IY ) ) 00304 END IF 00305 IF ( ALPHA .NE. ZERO ) THEN 00306 DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX ) 00307 TEMP = ABS( AB( KD+I-J, J ) ) 00308 SYMB_ZERO = SYMB_ZERO .AND. 00309 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00310 00311 Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP 00312 END DO 00313 END IF 00314 00315 IF ( .NOT.SYMB_ZERO ) 00316 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00317 IY = IY + INCY 00318 END DO 00319 ELSE 00320 DO I = 1, LENY 00321 IF ( BETA .EQ. ZERO ) THEN 00322 SYMB_ZERO = .TRUE. 00323 Y( IY ) = 0.0 00324 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00325 SYMB_ZERO = .TRUE. 00326 ELSE 00327 SYMB_ZERO = .FALSE. 00328 Y( IY ) = BETA * ABS( Y( IY ) ) 00329 END IF 00330 IF ( ALPHA .NE. ZERO ) THEN 00331 DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX ) 00332 TEMP = ABS( AB( KE-I+J, I ) ) 00333 SYMB_ZERO = SYMB_ZERO .AND. 00334 $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00335 00336 Y( IY ) = Y( IY ) + ALPHA*ABS( X( J ) )*TEMP 00337 END DO 00338 END IF 00339 00340 IF ( .NOT.SYMB_ZERO ) 00341 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00342 IY = IY + INCY 00343 END DO 00344 END IF 00345 ELSE 00346 IF( TRANS.EQ.ILATRANS( 'N' ) )THEN 00347 DO I = 1, LENY 00348 IF ( BETA .EQ. ZERO ) THEN 00349 SYMB_ZERO = .TRUE. 00350 Y( IY ) = 0.0 00351 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00352 SYMB_ZERO = .TRUE. 00353 ELSE 00354 SYMB_ZERO = .FALSE. 00355 Y( IY ) = BETA * ABS( Y( IY ) ) 00356 END IF 00357 IF ( ALPHA .NE. ZERO ) THEN 00358 JX = KX 00359 DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX ) 00360 TEMP = ABS( AB( KD+I-J, J ) ) 00361 SYMB_ZERO = SYMB_ZERO .AND. 00362 $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00363 00364 Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP 00365 JX = JX + INCX 00366 END DO 00367 END IF 00368 00369 IF ( .NOT.SYMB_ZERO ) 00370 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00371 00372 IY = IY + INCY 00373 END DO 00374 ELSE 00375 DO I = 1, LENY 00376 IF ( BETA .EQ. ZERO ) THEN 00377 SYMB_ZERO = .TRUE. 00378 Y( IY ) = 0.0 00379 ELSE IF ( Y( IY ) .EQ. ZERO ) THEN 00380 SYMB_ZERO = .TRUE. 00381 ELSE 00382 SYMB_ZERO = .FALSE. 00383 Y( IY ) = BETA * ABS( Y( IY ) ) 00384 END IF 00385 IF ( ALPHA .NE. ZERO ) THEN 00386 JX = KX 00387 DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX ) 00388 TEMP = ABS( AB( KE-I+J, I ) ) 00389 SYMB_ZERO = SYMB_ZERO .AND. 00390 $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO ) 00391 00392 Y( IY ) = Y( IY ) + ALPHA*ABS( X( JX ) )*TEMP 00393 JX = JX + INCX 00394 END DO 00395 END IF 00396 00397 IF ( .NOT.SYMB_ZERO ) 00398 $ Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) ) 00399 00400 IY = IY + INCY 00401 END DO 00402 END IF 00403 00404 END IF 00405 * 00406 RETURN 00407 * 00408 * End of SLA_GBAMV 00409 * 00410 END