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