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