1*DECK SSPMV 2 SUBROUTINE SSPMV (UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY) 3C***BEGIN PROLOGUE SSPMV 4C***PURPOSE Perform the matrix-vector operation. 5C***LIBRARY SLATEC (BLAS) 6C***CATEGORY D1B4 7C***TYPE SINGLE PRECISION (SSPMV-S, DSPMV-D, CSPMV-C) 8C***KEYWORDS LEVEL 2 BLAS, LINEAR ALGEBRA 9C***AUTHOR Dongarra, J. J., (ANL) 10C Du Croz, J., (NAG) 11C Hammarling, S., (NAG) 12C Hanson, R. J., (SNLA) 13C***DESCRIPTION 14C 15C SSPMV performs the matrix-vector operation 16C 17C y := alpha*A*x + beta*y, 18C 19C where alpha and beta are scalars, x and y are n element vectors and 20C A is an n by n symmetric matrix, supplied in packed form. 21C 22C Parameters 23C ========== 24C 25C UPLO - CHARACTER*1. 26C On entry, UPLO specifies whether the upper or lower 27C triangular part of the matrix A is supplied in the packed 28C array AP as follows: 29C 30C UPLO = 'U' or 'u' The upper triangular part of A is 31C supplied in AP. 32C 33C UPLO = 'L' or 'l' The lower triangular part of A is 34C supplied in AP. 35C 36C Unchanged on exit. 37C 38C N - INTEGER. 39C On entry, N specifies the order of the matrix A. 40C N must be at least zero. 41C Unchanged on exit. 42C 43C ALPHA - REAL . 44C On entry, ALPHA specifies the scalar alpha. 45C Unchanged on exit. 46C 47C AP - REAL array of DIMENSION at least 48C ( ( n*( n + 1))/2). 49C Before entry with UPLO = 'U' or 'u', the array AP must 50C contain the upper triangular part of the symmetric matrix 51C packed sequentially, column by column, so that AP( 1 ) 52C contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) 53C and a( 2, 2 ) respectively, and so on. 54C Before entry with UPLO = 'L' or 'l', the array AP must 55C contain the lower triangular part of the symmetric matrix 56C packed sequentially, column by column, so that AP( 1 ) 57C contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) 58C and a( 3, 1 ) respectively, and so on. 59C Unchanged on exit. 60C 61C X - REAL array of dimension at least 62C ( 1 + ( n - 1 )*abs( INCX ) ). 63C Before entry, the incremented array X must contain the n 64C element vector x. 65C Unchanged on exit. 66C 67C INCX - INTEGER. 68C On entry, INCX specifies the increment for the elements of 69C X. INCX must not be zero. 70C Unchanged on exit. 71C 72C BETA - REAL . 73C On entry, BETA specifies the scalar beta. When BETA is 74C supplied as zero then Y need not be set on input. 75C Unchanged on exit. 76C 77C Y - REAL array of dimension at least 78C ( 1 + ( n - 1 )*abs( INCY ) ). 79C Before entry, the incremented array Y must contain the n 80C element vector y. On exit, Y is overwritten by the updated 81C vector y. 82C 83C INCY - INTEGER. 84C On entry, INCY specifies the increment for the elements of 85C Y. INCY must not be zero. 86C Unchanged on exit. 87C 88C***REFERENCES Dongarra, J. J., Du Croz, J., Hammarling, S., and 89C Hanson, R. J. An extended set of Fortran basic linear 90C algebra subprograms. ACM TOMS, Vol. 14, No. 1, 91C pp. 1-17, March 1988. 92C***ROUTINES CALLED LSAME, XERBLA 93C***REVISION HISTORY (YYMMDD) 94C 861022 DATE WRITTEN 95C 910605 Modified to meet SLATEC prologue standards. Only comment 96C lines were modified. (BKS) 97C***END PROLOGUE SSPMV 98C .. Scalar Arguments .. 99 REAL ALPHA, BETA 100 INTEGER INCX, INCY, N 101 CHARACTER*1 UPLO 102C .. Array Arguments .. 103 REAL AP( * ), X( * ), Y( * ) 104C .. Parameters .. 105 REAL ONE , ZERO 106 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 107C .. Local Scalars .. 108 REAL TEMP1, TEMP2 109 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY 110C .. External Functions .. 111 LOGICAL LSAME 112 EXTERNAL LSAME 113C .. External Subroutines .. 114 EXTERNAL XERBLA 115C***FIRST EXECUTABLE STATEMENT SSPMV 116C 117C Test the input parameters. 118C 119 INFO = 0 120 IF ( .NOT.LSAME( UPLO, 'U' ).AND. 121 $ .NOT.LSAME( UPLO, 'L' ) )THEN 122 INFO = 1 123 ELSE IF( N.LT.0 )THEN 124 INFO = 2 125 ELSE IF( INCX.EQ.0 )THEN 126 INFO = 6 127 ELSE IF( INCY.EQ.0 )THEN 128 INFO = 9 129 END IF 130 IF( INFO.NE.0 )THEN 131 CALL XERBLA( 'SSPMV ', INFO ) 132 RETURN 133 END IF 134C 135C Quick return if possible. 136C 137 IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) 138 $ RETURN 139C 140C Set up the start points in X and Y. 141C 142 IF( INCX.GT.0 )THEN 143 KX = 1 144 ELSE 145 KX = 1 - ( N - 1 )*INCX 146 END IF 147 IF( INCY.GT.0 )THEN 148 KY = 1 149 ELSE 150 KY = 1 - ( N - 1 )*INCY 151 END IF 152C 153C Start the operations. In this version the elements of the array AP 154C are accessed sequentially with one pass through AP. 155C 156C First form y := beta*y. 157C 158 IF( BETA.NE.ONE )THEN 159 IF( INCY.EQ.1 )THEN 160 IF( BETA.EQ.ZERO )THEN 161 DO 10, I = 1, N 162 Y( I ) = ZERO 163 10 CONTINUE 164 ELSE 165 DO 20, I = 1, N 166 Y( I ) = BETA*Y( I ) 167 20 CONTINUE 168 END IF 169 ELSE 170 IY = KY 171 IF( BETA.EQ.ZERO )THEN 172 DO 30, I = 1, N 173 Y( IY ) = ZERO 174 IY = IY + INCY 175 30 CONTINUE 176 ELSE 177 DO 40, I = 1, N 178 Y( IY ) = BETA*Y( IY ) 179 IY = IY + INCY 180 40 CONTINUE 181 END IF 182 END IF 183 END IF 184 IF( ALPHA.EQ.ZERO ) 185 $ RETURN 186 KK = 1 187 IF( LSAME( UPLO, 'U' ) )THEN 188C 189C Form y when AP contains the upper triangle. 190C 191 IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN 192 DO 60, J = 1, N 193 TEMP1 = ALPHA*X( J ) 194 TEMP2 = ZERO 195 K = KK 196 DO 50, I = 1, J - 1 197 Y( I ) = Y( I ) + TEMP1*AP( K ) 198 TEMP2 = TEMP2 + AP( K )*X( I ) 199 K = K + 1 200 50 CONTINUE 201 Y( J ) = Y( J ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2 202 KK = KK + J 203 60 CONTINUE 204 ELSE 205 JX = KX 206 JY = KY 207 DO 80, J = 1, N 208 TEMP1 = ALPHA*X( JX ) 209 TEMP2 = ZERO 210 IX = KX 211 IY = KY 212 DO 70, K = KK, KK + J - 2 213 Y( IY ) = Y( IY ) + TEMP1*AP( K ) 214 TEMP2 = TEMP2 + AP( K )*X( IX ) 215 IX = IX + INCX 216 IY = IY + INCY 217 70 CONTINUE 218 Y( JY ) = Y( JY ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2 219 JX = JX + INCX 220 JY = JY + INCY 221 KK = KK + J 222 80 CONTINUE 223 END IF 224 ELSE 225C 226C Form y when AP contains the lower triangle. 227C 228 IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN 229 DO 100, J = 1, N 230 TEMP1 = ALPHA*X( J ) 231 TEMP2 = ZERO 232 Y( J ) = Y( J ) + TEMP1*AP( KK ) 233 K = KK + 1 234 DO 90, I = J + 1, N 235 Y( I ) = Y( I ) + TEMP1*AP( K ) 236 TEMP2 = TEMP2 + AP( K )*X( I ) 237 K = K + 1 238 90 CONTINUE 239 Y( J ) = Y( J ) + ALPHA*TEMP2 240 KK = KK + ( N - J + 1 ) 241 100 CONTINUE 242 ELSE 243 JX = KX 244 JY = KY 245 DO 120, J = 1, N 246 TEMP1 = ALPHA*X( JX ) 247 TEMP2 = ZERO 248 Y( JY ) = Y( JY ) + TEMP1*AP( KK ) 249 IX = JX 250 IY = JY 251 DO 110, K = KK + 1, KK + N - J 252 IX = IX + INCX 253 IY = IY + INCY 254 Y( IY ) = Y( IY ) + TEMP1*AP( K ) 255 TEMP2 = TEMP2 + AP( K )*X( IX ) 256 110 CONTINUE 257 Y( JY ) = Y( JY ) + ALPHA*TEMP2 258 JX = JX + INCX 259 JY = JY + INCY 260 KK = KK + ( N - J + 1 ) 261 120 CONTINUE 262 END IF 263 END IF 264C 265 RETURN 266C 267C End of SSPMV . 268C 269 END 270