LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sla_geamv.f
Go to the documentation of this file.
00001 *> \brief \b SLA_GEAMV
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SLA_GEAMV + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_geamv.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_geamv.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_geamv.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
00022 *                              Y, INCY )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       REAL               ALPHA, BETA
00026 *       INTEGER            INCX, INCY, LDA, M, N, TRANS
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       REAL               A( LDA, * ), X( * ), Y( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> SLA_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 REAL
00091 *>           On entry, ALPHA specifies the scalar alpha.
00092 *>           Unchanged on exit.
00093 *> \endverbatim
00094 *>
00095 *> \param[in] A
00096 *> \verbatim
00097 *>          A is REAL 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 REAL 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 REAL
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 REAL
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 realGEcomputational
00172 *
00173 *  =====================================================================
00174       SUBROUTINE SLA_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       REAL               ALPHA, BETA
00184       INTEGER            INCX, INCY, LDA, M, N, TRANS
00185 *     ..
00186 *     .. Array Arguments ..
00187       REAL               A( LDA, * ), X( * ), Y( * )
00188 *     ..
00189 *
00190 *  =====================================================================
00191 *
00192 *     .. Parameters ..
00193       REAL               ONE, ZERO
00194       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00195 *     ..
00196 *     .. Local Scalars ..
00197       LOGICAL            SYMB_ZERO
00198       REAL               TEMP, SAFE1
00199       INTEGER            I, INFO, IY, J, JX, KX, KY, LENX, LENY
00200 *     ..
00201 *     .. External Subroutines ..
00202       EXTERNAL           XERBLA, SLAMCH
00203       REAL               SLAMCH
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( 'SLA_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 = SLAMCH( '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.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.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.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.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 SLA_GEAMV
00395 *
00396       END
 All Files Functions