LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zla_gbamv.f
Go to the documentation of this file.
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
 All Files Functions