LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zla_heamv.f
Go to the documentation of this file.
00001 *> \brief \b ZLA_HEAMV
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZLA_HEAMV + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_heamv.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_heamv.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_heamv.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZLA_HEAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
00022 *                             INCY )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       DOUBLE PRECISION   ALPHA, BETA
00026 *       INTEGER            INCX, INCY, LDA, N, UPLO
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       COMPLEX*16         A( LDA, * ), X( * )
00030 *       DOUBLE PRECISION   Y( * )
00031 *       ..
00032 *  
00033 *
00034 *> \par Purpose:
00035 *  =============
00036 *>
00037 *> \verbatim
00038 *>
00039 *> ZLA_SYAMV  performs the matrix-vector operation
00040 *>
00041 *>         y := alpha*abs(A)*abs(x) + beta*abs(y),
00042 *>
00043 *> where alpha and beta are scalars, x and y are vectors and A is an
00044 *> n by n symmetric 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] UPLO
00060 *> \verbatim
00061 *>          UPLO is INTEGER
00062 *>           On entry, UPLO specifies whether the upper or lower
00063 *>           triangular part of the array A is to be referenced as
00064 *>           follows:
00065 *>
00066 *>              UPLO = BLAS_UPPER   Only the upper triangular part of A
00067 *>                                  is to be referenced.
00068 *>
00069 *>              UPLO = BLAS_LOWER   Only the lower triangular part of A
00070 *>                                  is to be referenced.
00071 *>
00072 *>           Unchanged on exit.
00073 *> \endverbatim
00074 *>
00075 *> \param[in] N
00076 *> \verbatim
00077 *>          N is INTEGER
00078 *>           On entry, N specifies the number of columns of the matrix A.
00079 *>           N must be at least zero.
00080 *>           Unchanged on exit.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] ALPHA
00084 *> \verbatim
00085 *>          ALPHA is DOUBLE PRECISION .
00086 *>           On entry, ALPHA specifies the scalar alpha.
00087 *>           Unchanged on exit.
00088 *> \endverbatim
00089 *>
00090 *> \param[in] A
00091 *> \verbatim
00092 *>          A is COMPLEX*16 array, DIMENSION ( LDA, n ).
00093 *>           Before entry, the leading m by n part of the array A must
00094 *>           contain the matrix of coefficients.
00095 *>           Unchanged on exit.
00096 *> \endverbatim
00097 *>
00098 *> \param[in] LDA
00099 *> \verbatim
00100 *>          LDA is INTEGER
00101 *>           On entry, LDA specifies the first dimension of A as declared
00102 *>           in the calling (sub) program. LDA must be at least
00103 *>           max( 1, n ).
00104 *>           Unchanged on exit.
00105 *> \endverbatim
00106 *>
00107 *> \param[in] X
00108 *> \verbatim
00109 *>          X is COMPLEX*16 array, DIMENSION at least
00110 *>           ( 1 + ( n - 1 )*abs( INCX ) )
00111 *>           Before entry, the incremented array X must contain the
00112 *>           vector x.
00113 *>           Unchanged on exit.
00114 *> \endverbatim
00115 *>
00116 *> \param[in] INCX
00117 *> \verbatim
00118 *>          INCX is INTEGER
00119 *>           On entry, INCX specifies the increment for the elements of
00120 *>           X. INCX must not be zero.
00121 *>           Unchanged on exit.
00122 *> \endverbatim
00123 *>
00124 *> \param[in] BETA
00125 *> \verbatim
00126 *>          BETA is DOUBLE PRECISION .
00127 *>           On entry, BETA specifies the scalar beta. When BETA is
00128 *>           supplied as zero then Y need not be set on input.
00129 *>           Unchanged on exit.
00130 *> \endverbatim
00131 *>
00132 *> \param[in,out] Y
00133 *> \verbatim
00134 *>          Y is DOUBLE PRECISION array, dimension
00135 *>           ( 1 + ( n - 1 )*abs( INCY ) )
00136 *>           Before entry with BETA non-zero, the incremented array Y
00137 *>           must contain the vector y. On exit, Y is overwritten by the
00138 *>           updated vector y.
00139 *> \endverbatim
00140 *>
00141 *> \param[in] INCY
00142 *> \verbatim
00143 *>          INCY is INTEGER
00144 *>           On entry, INCY specifies the increment for the elements of
00145 *>           Y. INCY must not be zero.
00146 *>           Unchanged on exit.
00147 *> \endverbatim
00148 *
00149 *  Authors:
00150 *  ========
00151 *
00152 *> \author Univ. of Tennessee 
00153 *> \author Univ. of California Berkeley 
00154 *> \author Univ. of Colorado Denver 
00155 *> \author NAG Ltd. 
00156 *
00157 *> \date November 2011
00158 *
00159 *> \ingroup complex16HEcomputational
00160 *
00161 *> \par Further Details:
00162 *  =====================
00163 *>
00164 *> \verbatim
00165 *>
00166 *>  Level 2 Blas routine.
00167 *>
00168 *>  -- Written on 22-October-1986.
00169 *>     Jack Dongarra, Argonne National Lab.
00170 *>     Jeremy Du Croz, Nag Central Office.
00171 *>     Sven Hammarling, Nag Central Office.
00172 *>     Richard Hanson, Sandia National Labs.
00173 *>  -- Modified for the absolute-value product, April 2006
00174 *>     Jason Riedy, UC Berkeley
00175 *> \endverbatim
00176 *>
00177 *  =====================================================================
00178       SUBROUTINE ZLA_HEAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
00179      $                      INCY )
00180 *
00181 *  -- LAPACK computational routine (version 3.4.0) --
00182 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00183 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00184 *     November 2011
00185 *
00186 *     .. Scalar Arguments ..
00187       DOUBLE PRECISION   ALPHA, BETA
00188       INTEGER            INCX, INCY, LDA, N, UPLO
00189 *     ..
00190 *     .. Array Arguments ..
00191       COMPLEX*16         A( LDA, * ), X( * )
00192       DOUBLE PRECISION   Y( * )
00193 *     ..
00194 *
00195 *  =====================================================================
00196 *
00197 *     .. Parameters ..
00198       DOUBLE PRECISION   ONE, ZERO
00199       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00200 *     ..
00201 *     .. Local Scalars ..
00202       LOGICAL            SYMB_ZERO
00203       DOUBLE PRECISION   TEMP, SAFE1
00204       INTEGER            I, INFO, IY, J, JX, KX, KY
00205       COMPLEX*16         ZDUM
00206 *     ..
00207 *     .. External Subroutines ..
00208       EXTERNAL           XERBLA, DLAMCH
00209       DOUBLE PRECISION   DLAMCH
00210 *     ..
00211 *     .. External Functions ..
00212       EXTERNAL           ILAUPLO
00213       INTEGER            ILAUPLO
00214 *     ..
00215 *     .. Intrinsic Functions ..
00216       INTRINSIC          MAX, ABS, SIGN, REAL, DIMAG
00217 *     ..
00218 *     .. Statement Functions ..
00219       DOUBLE PRECISION   CABS1
00220 *     ..
00221 *     .. Statement Function Definitions ..
00222       CABS1( ZDUM ) = ABS( DBLE ( ZDUM ) ) + ABS( DIMAG ( ZDUM ) )
00223 *     ..
00224 *     .. Executable Statements ..
00225 *
00226 *     Test the input parameters.
00227 *
00228       INFO = 0
00229       IF     ( UPLO.NE.ILAUPLO( 'U' ) .AND.
00230      $         UPLO.NE.ILAUPLO( 'L' ) )THEN
00231          INFO = 1
00232       ELSE IF( N.LT.0 )THEN
00233          INFO = 2
00234       ELSE IF( LDA.LT.MAX( 1, N ) )THEN
00235          INFO = 5
00236       ELSE IF( INCX.EQ.0 )THEN
00237          INFO = 7
00238       ELSE IF( INCY.EQ.0 )THEN
00239          INFO = 10
00240       END IF
00241       IF( INFO.NE.0 )THEN
00242          CALL XERBLA( 'ZHEMV ', INFO )
00243          RETURN
00244       END IF
00245 *
00246 *     Quick return if possible.
00247 *
00248       IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
00249      $   RETURN
00250 *
00251 *     Set up the start points in  X  and  Y.
00252 *
00253       IF( INCX.GT.0 )THEN
00254          KX = 1
00255       ELSE
00256          KX = 1 - ( N - 1 )*INCX
00257       END IF
00258       IF( INCY.GT.0 )THEN
00259          KY = 1
00260       ELSE
00261          KY = 1 - ( N - 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 = DLAMCH( 'Safe minimum' )
00268       SAFE1 = (N+1)*SAFE1
00269 *
00270 *     Form  y := alpha*abs(A)*abs(x) + beta*abs(y).
00271 *
00272 *     The O(N^2) 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 ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN
00279             DO I = 1, N
00280                IF ( BETA .EQ. ZERO ) THEN
00281                   SYMB_ZERO = .TRUE.
00282                   Y( IY ) = 0.0D+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, I
00291                      TEMP = CABS1( A( J, I ) )
00292                      SYMB_ZERO = SYMB_ZERO .AND.
00293      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00294 
00295                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
00296                   END DO
00297                   DO J = I+1, N
00298                      TEMP = CABS1( A( I, J ) )
00299                      SYMB_ZERO = SYMB_ZERO .AND.
00300      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00301 
00302                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
00303                   END DO
00304                END IF
00305 
00306                IF (.NOT.SYMB_ZERO)
00307      $              Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
00308 
00309                IY = IY + INCY
00310             END DO
00311          ELSE
00312             DO I = 1, N
00313                IF ( BETA .EQ. ZERO ) THEN
00314                   SYMB_ZERO = .TRUE.
00315                   Y( IY ) = 0.0D+0
00316                ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
00317                   SYMB_ZERO = .TRUE.
00318                ELSE
00319                   SYMB_ZERO = .FALSE.
00320                   Y( IY ) = BETA * ABS( Y( IY ) )
00321                END IF
00322                IF ( ALPHA .NE. ZERO ) THEN
00323                   DO J = 1, I
00324                      TEMP = CABS1( A( I, J ) )
00325                      SYMB_ZERO = SYMB_ZERO .AND.
00326      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00327 
00328                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
00329                   END DO
00330                   DO J = I+1, N
00331                      TEMP = CABS1( A( J, I ) )
00332                      SYMB_ZERO = SYMB_ZERO .AND.
00333      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00334 
00335                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
00336                   END DO
00337                END IF
00338 
00339                IF (.NOT.SYMB_ZERO)
00340      $              Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
00341 
00342                IY = IY + INCY
00343             END DO
00344          END IF
00345       ELSE
00346          IF ( UPLO .EQ. ILAUPLO( 'U' ) ) THEN
00347             DO I = 1, N
00348                IF ( BETA .EQ. ZERO ) THEN
00349                   SYMB_ZERO = .TRUE.
00350                   Y( IY ) = 0.0D+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                JX = KX
00358                IF ( ALPHA .NE. ZERO ) THEN
00359                   DO J = 1, I
00360                      TEMP = CABS1( A( J, I ) )
00361                      SYMB_ZERO = SYMB_ZERO .AND.
00362      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00363 
00364                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
00365                      JX = JX + INCX
00366                   END DO
00367                   DO J = I+1, N
00368                      TEMP = CABS1( A( I, J ) )
00369                      SYMB_ZERO = SYMB_ZERO .AND.
00370      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00371 
00372                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
00373                      JX = JX + INCX
00374                   END DO
00375                END IF
00376 
00377                IF ( .NOT.SYMB_ZERO )
00378      $              Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
00379 
00380                IY = IY + INCY
00381             END DO
00382          ELSE
00383             DO I = 1, N
00384                IF ( BETA .EQ. ZERO ) THEN
00385                   SYMB_ZERO = .TRUE.
00386                   Y( IY ) = 0.0D+0
00387                ELSE IF ( Y( IY ) .EQ. ZERO ) THEN
00388                   SYMB_ZERO = .TRUE.
00389                ELSE
00390                   SYMB_ZERO = .FALSE.
00391                   Y( IY ) = BETA * ABS( Y( IY ) )
00392                END IF
00393                JX = KX
00394                IF ( ALPHA .NE. ZERO ) THEN
00395                   DO J = 1, I
00396                      TEMP = CABS1( A( I, J ) )
00397                      SYMB_ZERO = SYMB_ZERO .AND.
00398      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00399 
00400                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
00401                      JX = JX + INCX
00402                   END DO
00403                   DO J = I+1, N
00404                      TEMP = CABS1( A( J, I ) )
00405                      SYMB_ZERO = SYMB_ZERO .AND.
00406      $                    ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
00407 
00408                      Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
00409                      JX = JX + INCX
00410                   END DO
00411                END IF
00412 
00413                IF ( .NOT.SYMB_ZERO )
00414      $              Y( IY ) = Y( IY ) + SIGN( SAFE1, Y( IY ) )
00415 
00416                IY = IY + INCY
00417             END DO
00418          END IF
00419 
00420       END IF
00421 *
00422       RETURN
00423 *
00424 *     End of ZLA_HEAMV
00425 *
00426       END
 All Files Functions