LAPACK: SRC/csymv.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          UPLO
00010       INTEGER            INCX, INCY, LDA, N
00011       COMPLEX            ALPHA, BETA
00012 *     ..
00013 *     .. Array Arguments ..
00014       COMPLEX            A( LDA, * ), X( * ), Y( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  CSYMV  performs the matrix-vector  operation
00021 *
00022 *     y := alpha*A*x + beta*y,
00023 *
00024 *  where alpha and beta are scalars, x and y are n element vectors and
00025 *  A is an n by n symmetric matrix.
00026 *
00027 *  Arguments
00028 *  ==========
00029 *
00030 *  UPLO     (input) CHARACTER*1
00031 *           On entry, UPLO specifies whether the upper or lower
00032 *           triangular part of the array A is to be referenced as
00033 *           follows:
00034 *
00035 *              UPLO = 'U' or 'u'   Only the upper triangular part of A
00036 *                                  is to be referenced.
00037 *
00038 *              UPLO = 'L' or 'l'   Only the lower triangular part of A
00039 *                                  is to be referenced.
00040 *
00041 *           Unchanged on exit.
00042 *
00043 *  N        (input) INTEGER
00044 *           On entry, N specifies the order of the matrix A.
00045 *           N must be at least zero.
00046 *           Unchanged on exit.
00047 *
00048 *  ALPHA    (input) COMPLEX
00049 *           On entry, ALPHA specifies the scalar alpha.
00050 *           Unchanged on exit.
00051 *
00052 *  A        (input) COMPLEX array, dimension ( LDA, N )
00053 *           Before entry, with  UPLO = 'U' or 'u', the leading n by n
00054 *           upper triangular part of the array A must contain the upper
00055 *           triangular part of the symmetric matrix and the strictly
00056 *           lower triangular part of A is not referenced.
00057 *           Before entry, with UPLO = 'L' or 'l', the leading n by n
00058 *           lower triangular part of the array A must contain the lower
00059 *           triangular part of the symmetric matrix and the strictly
00060 *           upper triangular part of A is not referenced.
00061 *           Unchanged on exit.
00062 *
00063 *  LDA      (input) INTEGER
00064 *           On entry, LDA specifies the first dimension of A as declared
00065 *           in the calling (sub) program. LDA must be at least
00066 *           max( 1, N ).
00067 *           Unchanged on exit.
00068 *
00069 *  X        (input) COMPLEX array, dimension at least
00070 *           ( 1 + ( N - 1 )*abs( INCX ) ).
00071 *           Before entry, the incremented array X must contain the N-
00072 *           element vector x.
00073 *           Unchanged on exit.
00074 *
00075 *  INCX     (input) INTEGER
00076 *           On entry, INCX specifies the increment for the elements of
00077 *           X. INCX must not be zero.
00078 *           Unchanged on exit.
00079 *
00080 *  BETA     (input) COMPLEX
00081 *           On entry, BETA specifies the scalar beta. When BETA is
00082 *           supplied as zero then Y need not be set on input.
00083 *           Unchanged on exit.
00084 *
00085 *  Y        (input/output) COMPLEX array, dimension at least
00086 *           ( 1 + ( N - 1 )*abs( INCY ) ).
00087 *           Before entry, the incremented array Y must contain the n
00088 *           element vector y. On exit, Y is overwritten by the updated
00089 *           vector y.
00090 *
00091 *  INCY     (input) INTEGER
00092 *           On entry, INCY specifies the increment for the elements of
00093 *           Y. INCY must not be zero.
00094 *           Unchanged on exit.
00095 *
00096 * =====================================================================
00097 *
00098 *     .. Parameters ..
00099       COMPLEX            ONE
00100       PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
00101       COMPLEX            ZERO
00102       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
00103 *     ..
00104 *     .. Local Scalars ..
00105       INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
00106       COMPLEX            TEMP1, TEMP2
00107 *     ..
00108 *     .. External Functions ..
00109       LOGICAL            LSAME
00110       EXTERNAL           LSAME
00111 *     ..
00112 *     .. External Subroutines ..
00113       EXTERNAL           XERBLA
00114 *     ..
00115 *     .. Intrinsic Functions ..
00116       INTRINSIC          MAX
00117 *     ..
00118 *     .. Executable Statements ..
00119 *
00120 *     Test the input parameters.
00121 *
00122       INFO = 0
00123       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00124          INFO = 1
00125       ELSE IF( N.LT.0 ) THEN
00126          INFO = 2
00127       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00128          INFO = 5
00129       ELSE IF( INCX.EQ.0 ) THEN
00130          INFO = 7
00131       ELSE IF( INCY.EQ.0 ) THEN
00132          INFO = 10
00133       END IF
00134       IF( INFO.NE.0 ) THEN
00135          CALL XERBLA( 'CSYMV ', INFO )
00136          RETURN
00137       END IF
00138 *
00139 *     Quick return if possible.
00140 *
00141       IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
00142      $   RETURN
00143 *
00144 *     Set up the start points in  X  and  Y.
00145 *
00146       IF( INCX.GT.0 ) THEN
00147          KX = 1
00148       ELSE
00149          KX = 1 - ( N-1 )*INCX
00150       END IF
00151       IF( INCY.GT.0 ) THEN
00152          KY = 1
00153       ELSE
00154          KY = 1 - ( N-1 )*INCY
00155       END IF
00156 *
00157 *     Start the operations. In this version the elements of A are
00158 *     accessed sequentially with one pass through the triangular part
00159 *     of A.
00160 *
00161 *     First form  y := beta*y.
00162 *
00163       IF( BETA.NE.ONE ) THEN
00164          IF( INCY.EQ.1 ) THEN
00165             IF( BETA.EQ.ZERO ) THEN
00166                DO 10 I = 1, N
00167                   Y( I ) = ZERO
00168    10          CONTINUE
00169             ELSE
00170                DO 20 I = 1, N
00171                   Y( I ) = BETA*Y( I )
00172    20          CONTINUE
00173             END IF
00174          ELSE
00175             IY = KY
00176             IF( BETA.EQ.ZERO ) THEN
00177                DO 30 I = 1, N
00178                   Y( IY ) = ZERO
00179                   IY = IY + INCY
00180    30          CONTINUE
00181             ELSE
00182                DO 40 I = 1, N
00183                   Y( IY ) = BETA*Y( IY )
00184                   IY = IY + INCY
00185    40          CONTINUE
00186             END IF
00187          END IF
00188       END IF
00189       IF( ALPHA.EQ.ZERO )
00190      $   RETURN
00191       IF( LSAME( UPLO, 'U' ) ) THEN
00192 *
00193 *        Form  y  when A is stored in upper triangle.
00194 *
00195          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
00196             DO 60 J = 1, N
00197                TEMP1 = ALPHA*X( J )
00198                TEMP2 = ZERO
00199                DO 50 I = 1, J - 1
00200                   Y( I ) = Y( I ) + TEMP1*A( I, J )
00201                   TEMP2 = TEMP2 + A( I, J )*X( I )
00202    50          CONTINUE
00203                Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2
00204    60       CONTINUE
00205          ELSE
00206             JX = KX
00207             JY = KY
00208             DO 80 J = 1, N
00209                TEMP1 = ALPHA*X( JX )
00210                TEMP2 = ZERO
00211                IX = KX
00212                IY = KY
00213                DO 70 I = 1, J - 1
00214                   Y( IY ) = Y( IY ) + TEMP1*A( I, J )
00215                   TEMP2 = TEMP2 + A( I, J )*X( IX )
00216                   IX = IX + INCX
00217                   IY = IY + INCY
00218    70          CONTINUE
00219                Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2
00220                JX = JX + INCX
00221                JY = JY + INCY
00222    80       CONTINUE
00223          END IF
00224       ELSE
00225 *
00226 *        Form  y  when A is stored in lower triangle.
00227 *
00228          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
00229             DO 100 J = 1, N
00230                TEMP1 = ALPHA*X( J )
00231                TEMP2 = ZERO
00232                Y( J ) = Y( J ) + TEMP1*A( J, J )
00233                DO 90 I = J + 1, N
00234                   Y( I ) = Y( I ) + TEMP1*A( I, J )
00235                   TEMP2 = TEMP2 + A( I, J )*X( I )
00236    90          CONTINUE
00237                Y( J ) = Y( J ) + ALPHA*TEMP2
00238   100       CONTINUE
00239          ELSE
00240             JX = KX
00241             JY = KY
00242             DO 120 J = 1, N
00243                TEMP1 = ALPHA*X( JX )
00244                TEMP2 = ZERO
00245                Y( JY ) = Y( JY ) + TEMP1*A( J, J )
00246                IX = JX
00247                IY = JY
00248                DO 110 I = J + 1, N
00249                   IX = IX + INCX
00250                   IY = IY + INCY
00251                   Y( IY ) = Y( IY ) + TEMP1*A( I, J )
00252                   TEMP2 = TEMP2 + A( I, J )*X( IX )
00253   110          CONTINUE
00254                Y( JY ) = Y( JY ) + ALPHA*TEMP2
00255                JX = JX + INCX
00256                JY = JY + INCY
00257   120       CONTINUE
00258          END IF
00259       END IF
00260 *
00261       RETURN
00262 *
00263 *     End of CSYMV
00264 *
00265       END