LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sspmv.f
Go to the documentation of this file.
00001 *> \brief \b SSPMV
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       REAL ALPHA,BETA
00015 *       INTEGER INCX,INCY,N
00016 *       CHARACTER UPLO
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       REAL AP(*),X(*),Y(*)
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> SSPMV  performs the matrix-vector operation
00029 *>
00030 *>    y := alpha*A*x + beta*y,
00031 *>
00032 *> where alpha and beta are scalars, x and y are n element vectors and
00033 *> A is an n by n symmetric matrix, supplied in packed form.
00034 *> \endverbatim
00035 *
00036 *  Arguments:
00037 *  ==========
00038 *
00039 *> \param[in] UPLO
00040 *> \verbatim
00041 *>          UPLO is CHARACTER*1
00042 *>           On entry, UPLO specifies whether the upper or lower
00043 *>           triangular part of the matrix A is supplied in the packed
00044 *>           array AP as follows:
00045 *>
00046 *>              UPLO = 'U' or 'u'   The upper triangular part of A is
00047 *>                                  supplied in AP.
00048 *>
00049 *>              UPLO = 'L' or 'l'   The lower triangular part of A is
00050 *>                                  supplied in AP.
00051 *> \endverbatim
00052 *>
00053 *> \param[in] N
00054 *> \verbatim
00055 *>          N is INTEGER
00056 *>           On entry, N specifies the order of the matrix A.
00057 *>           N must be at least zero.
00058 *> \endverbatim
00059 *>
00060 *> \param[in] ALPHA
00061 *> \verbatim
00062 *>          ALPHA is REAL
00063 *>           On entry, ALPHA specifies the scalar alpha.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] AP
00067 *> \verbatim
00068 *>          AP is REAL array of DIMENSION at least
00069 *>           ( ( n*( n + 1 ) )/2 ).
00070 *>           Before entry with UPLO = 'U' or 'u', the array AP must
00071 *>           contain the upper triangular part of the symmetric matrix
00072 *>           packed sequentially, column by column, so that AP( 1 )
00073 *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
00074 *>           and a( 2, 2 ) respectively, and so on.
00075 *>           Before entry with UPLO = 'L' or 'l', the array AP must
00076 *>           contain the lower triangular part of the symmetric matrix
00077 *>           packed sequentially, column by column, so that AP( 1 )
00078 *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
00079 *>           and a( 3, 1 ) respectively, and so on.
00080 *> \endverbatim
00081 *>
00082 *> \param[in] X
00083 *> \verbatim
00084 *>          X is REAL array of dimension at least
00085 *>           ( 1 + ( n - 1 )*abs( INCX ) ).
00086 *>           Before entry, the incremented array X must contain the n
00087 *>           element vector x.
00088 *> \endverbatim
00089 *>
00090 *> \param[in] INCX
00091 *> \verbatim
00092 *>          INCX is INTEGER
00093 *>           On entry, INCX specifies the increment for the elements of
00094 *>           X. INCX must not be zero.
00095 *> \endverbatim
00096 *>
00097 *> \param[in] BETA
00098 *> \verbatim
00099 *>          BETA is REAL
00100 *>           On entry, BETA specifies the scalar beta. When BETA is
00101 *>           supplied as zero then Y need not be set on input.
00102 *> \endverbatim
00103 *>
00104 *> \param[in,out] Y
00105 *> \verbatim
00106 *>          Y is REAL array of dimension at least
00107 *>           ( 1 + ( n - 1 )*abs( INCY ) ).
00108 *>           Before entry, the incremented array Y must contain the n
00109 *>           element vector y. On exit, Y is overwritten by the updated
00110 *>           vector y.
00111 *> \endverbatim
00112 *>
00113 *> \param[in] INCY
00114 *> \verbatim
00115 *>          INCY is INTEGER
00116 *>           On entry, INCY specifies the increment for the elements of
00117 *>           Y. INCY must not be zero.
00118 *> \endverbatim
00119 *
00120 *  Authors:
00121 *  ========
00122 *
00123 *> \author Univ. of Tennessee 
00124 *> \author Univ. of California Berkeley 
00125 *> \author Univ. of Colorado Denver 
00126 *> \author NAG Ltd. 
00127 *
00128 *> \date November 2011
00129 *
00130 *> \ingroup single_blas_level2
00131 *
00132 *> \par Further Details:
00133 *  =====================
00134 *>
00135 *> \verbatim
00136 *>
00137 *>  Level 2 Blas routine.
00138 *>  The vector and matrix arguments are not referenced when N = 0, or M = 0
00139 *>
00140 *>  -- Written on 22-October-1986.
00141 *>     Jack Dongarra, Argonne National Lab.
00142 *>     Jeremy Du Croz, Nag Central Office.
00143 *>     Sven Hammarling, Nag Central Office.
00144 *>     Richard Hanson, Sandia National Labs.
00145 *> \endverbatim
00146 *>
00147 *  =====================================================================
00148       SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
00149 *
00150 *  -- Reference BLAS level2 routine (version 3.4.0) --
00151 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00152 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00153 *     November 2011
00154 *
00155 *     .. Scalar Arguments ..
00156       REAL ALPHA,BETA
00157       INTEGER INCX,INCY,N
00158       CHARACTER UPLO
00159 *     ..
00160 *     .. Array Arguments ..
00161       REAL AP(*),X(*),Y(*)
00162 *     ..
00163 *
00164 *  =====================================================================
00165 *
00166 *     .. Parameters ..
00167       REAL ONE,ZERO
00168       PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
00169 *     ..
00170 *     .. Local Scalars ..
00171       REAL TEMP1,TEMP2
00172       INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
00173 *     ..
00174 *     .. External Functions ..
00175       LOGICAL LSAME
00176       EXTERNAL LSAME
00177 *     ..
00178 *     .. External Subroutines ..
00179       EXTERNAL XERBLA
00180 *     ..
00181 *
00182 *     Test the input parameters.
00183 *
00184       INFO = 0
00185       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
00186           INFO = 1
00187       ELSE IF (N.LT.0) THEN
00188           INFO = 2
00189       ELSE IF (INCX.EQ.0) THEN
00190           INFO = 6
00191       ELSE IF (INCY.EQ.0) THEN
00192           INFO = 9
00193       END IF
00194       IF (INFO.NE.0) THEN
00195           CALL XERBLA('SSPMV ',INFO)
00196           RETURN
00197       END IF
00198 *
00199 *     Quick return if possible.
00200 *
00201       IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
00202 *
00203 *     Set up the start points in  X  and  Y.
00204 *
00205       IF (INCX.GT.0) THEN
00206           KX = 1
00207       ELSE
00208           KX = 1 - (N-1)*INCX
00209       END IF
00210       IF (INCY.GT.0) THEN
00211           KY = 1
00212       ELSE
00213           KY = 1 - (N-1)*INCY
00214       END IF
00215 *
00216 *     Start the operations. In this version the elements of the array AP
00217 *     are accessed sequentially with one pass through AP.
00218 *
00219 *     First form  y := beta*y.
00220 *
00221       IF (BETA.NE.ONE) THEN
00222           IF (INCY.EQ.1) THEN
00223               IF (BETA.EQ.ZERO) THEN
00224                   DO 10 I = 1,N
00225                       Y(I) = ZERO
00226    10             CONTINUE
00227               ELSE
00228                   DO 20 I = 1,N
00229                       Y(I) = BETA*Y(I)
00230    20             CONTINUE
00231               END IF
00232           ELSE
00233               IY = KY
00234               IF (BETA.EQ.ZERO) THEN
00235                   DO 30 I = 1,N
00236                       Y(IY) = ZERO
00237                       IY = IY + INCY
00238    30             CONTINUE
00239               ELSE
00240                   DO 40 I = 1,N
00241                       Y(IY) = BETA*Y(IY)
00242                       IY = IY + INCY
00243    40             CONTINUE
00244               END IF
00245           END IF
00246       END IF
00247       IF (ALPHA.EQ.ZERO) RETURN
00248       KK = 1
00249       IF (LSAME(UPLO,'U')) THEN
00250 *
00251 *        Form  y  when AP contains the upper triangle.
00252 *
00253           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
00254               DO 60 J = 1,N
00255                   TEMP1 = ALPHA*X(J)
00256                   TEMP2 = ZERO
00257                   K = KK
00258                   DO 50 I = 1,J - 1
00259                       Y(I) = Y(I) + TEMP1*AP(K)
00260                       TEMP2 = TEMP2 + AP(K)*X(I)
00261                       K = K + 1
00262    50             CONTINUE
00263                   Y(J) = Y(J) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
00264                   KK = KK + J
00265    60         CONTINUE
00266           ELSE
00267               JX = KX
00268               JY = KY
00269               DO 80 J = 1,N
00270                   TEMP1 = ALPHA*X(JX)
00271                   TEMP2 = ZERO
00272                   IX = KX
00273                   IY = KY
00274                   DO 70 K = KK,KK + J - 2
00275                       Y(IY) = Y(IY) + TEMP1*AP(K)
00276                       TEMP2 = TEMP2 + AP(K)*X(IX)
00277                       IX = IX + INCX
00278                       IY = IY + INCY
00279    70             CONTINUE
00280                   Y(JY) = Y(JY) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
00281                   JX = JX + INCX
00282                   JY = JY + INCY
00283                   KK = KK + J
00284    80         CONTINUE
00285           END IF
00286       ELSE
00287 *
00288 *        Form  y  when AP contains the lower triangle.
00289 *
00290           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
00291               DO 100 J = 1,N
00292                   TEMP1 = ALPHA*X(J)
00293                   TEMP2 = ZERO
00294                   Y(J) = Y(J) + TEMP1*AP(KK)
00295                   K = KK + 1
00296                   DO 90 I = J + 1,N
00297                       Y(I) = Y(I) + TEMP1*AP(K)
00298                       TEMP2 = TEMP2 + AP(K)*X(I)
00299                       K = K + 1
00300    90             CONTINUE
00301                   Y(J) = Y(J) + ALPHA*TEMP2
00302                   KK = KK + (N-J+1)
00303   100         CONTINUE
00304           ELSE
00305               JX = KX
00306               JY = KY
00307               DO 120 J = 1,N
00308                   TEMP1 = ALPHA*X(JX)
00309                   TEMP2 = ZERO
00310                   Y(JY) = Y(JY) + TEMP1*AP(KK)
00311                   IX = JX
00312                   IY = JY
00313                   DO 110 K = KK + 1,KK + N - J
00314                       IX = IX + INCX
00315                       IY = IY + INCY
00316                       Y(IY) = Y(IY) + TEMP1*AP(K)
00317                       TEMP2 = TEMP2 + AP(K)*X(IX)
00318   110             CONTINUE
00319                   Y(JY) = Y(JY) + ALPHA*TEMP2
00320                   JX = JX + INCX
00321                   JY = JY + INCY
00322                   KK = KK + (N-J+1)
00323   120         CONTINUE
00324           END IF
00325       END IF
00326 *
00327       RETURN
00328 *
00329 *     End of SSPMV .
00330 *
00331       END
 All Files Functions