LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cla_geamv.f
Go to the documentation of this file.
00001 *> \brief \b CLA_GEAMV
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CLA_GEAMV + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_geamv.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_geamv.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_geamv.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CLA_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
00027 *       INTEGER            TRANS
00028 *       ..
00029 *       .. Array Arguments ..
00030 *       COMPLEX            A( LDA, * ), X( * )
00031 *       REAL               Y( * )
00032 *       ..
00033 *  
00034 *
00035 *> \par Purpose:
00036 *  =============
00037 *>
00038 *> \verbatim
00039 *>
00040 *> CLA_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 REAL
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 array, 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 array, dimension
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 REAL
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 REAL 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 complexGEcomputational
00173 *
00174 *  =====================================================================
00175       SUBROUTINE CLA_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       REAL               ALPHA, BETA
00185       INTEGER            INCX, INCY, LDA, M, N
00186       INTEGER            TRANS
00187 *     ..
00188 *     .. Array Arguments ..
00189       COMPLEX            A( LDA, * ), X( * )
00190       REAL               Y( * )
00191 *     ..
00192 *
00193 *  =====================================================================
00194 *
00195 *     .. Parameters ..
00196       COMPLEX            ONE, ZERO
00197       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00198 *     ..
00199 *     .. Local Scalars ..
00200       LOGICAL            SYMB_ZERO
00201       REAL               TEMP, SAFE1
00202       INTEGER            I, INFO, IY, J, JX, KX, KY, LENX, LENY
00203       COMPLEX            CDUM
00204 *     ..
00205 *     .. External Subroutines ..
00206       EXTERNAL           XERBLA, SLAMCH
00207       REAL               SLAMCH
00208 *     ..
00209 *     .. External Functions ..
00210       EXTERNAL           ILATRANS
00211       INTEGER            ILATRANS
00212 *     ..
00213 *     .. Intrinsic Functions ..
00214       INTRINSIC          MAX, ABS, REAL, AIMAG, SIGN
00215 *     ..
00216 *     .. Statement Functions ..
00217       REAL               CABS1
00218 *     ..
00219 *     .. Statement Function Definitions ..
00220       CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( 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( 'CLA_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 = SLAMCH( '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.0 ) THEN
00291                   SYMB_ZERO = .TRUE.
00292                   Y( IY ) = 0.0
00293                ELSE IF ( Y( IY ) .EQ. 0.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.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.0 ) THEN
00317                   SYMB_ZERO = .TRUE.
00318                   Y( IY ) = 0.0
00319                ELSE IF ( Y( IY ) .EQ. 0.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.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.0 ) THEN
00345                   SYMB_ZERO = .TRUE.
00346                   Y( IY ) = 0.0
00347                ELSE IF ( Y( IY ) .EQ. 0.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.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.0 ) THEN
00373                   SYMB_ZERO = .TRUE.
00374                   Y( IY ) = 0.0
00375                ELSE IF ( Y( IY ) .EQ. 0.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.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 CLA_GEAMV
00405 *
00406       END
 All Files Functions