1 SUBROUTINE SASYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, 2 $ INCY ) 3* 4* -- PBLAS auxiliary routine (version 2.0) -- 5* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 6* and University of California, Berkeley. 7* April 1, 1998 8* 9* .. Scalar Arguments .. 10 CHARACTER*1 UPLO 11 INTEGER INCX, INCY, LDA, N 12 REAL ALPHA, BETA 13* .. 14* .. Array Arguments .. 15 REAL A( LDA, * ), X( * ), Y( * ) 16* .. 17* 18* Purpose 19* ======= 20* 21* SASYMV performs the following matrix-vector operation 22* 23* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y ), 24* 25* where alpha and beta are real scalars, y is a real vector, x is a 26* vector and A is an n by n symmetric matrix. 27* 28* Arguments 29* ========= 30* 31* UPLO (input) CHARACTER*1 32* On entry, UPLO specifies whether the upper or lower triangu- 33* lar part of the array A is to be referenced as follows: 34* 35* UPLO = 'U' or 'u' Only the upper triangular part of A is 36* to be referenced. 37* UPLO = 'L' or 'l' Only the lower triangular part of A is 38* to be referenced. 39* 40* N (input) INTEGER 41* On entry, N specifies the order of the matrix A. N must be at 42* least zero. 43* 44* ALPHA (input) REAL 45* On entry, ALPHA specifies the real scalar alpha. 46* 47* A (input) REAL array 48* On entry, A is an array of dimension (LDA,N). Before entry 49* with UPLO = 'U' or 'u', the leading n by n part of the array 50* A must contain the upper triangular part of the symmetric ma- 51* trix and the strictly lower triangular part of A is not refe- 52* renced. When UPLO = 'L' or 'l', the leading n by n part of 53* the array A must contain the lower triangular part of the 54* symmetric matrix and the strictly upper trapezoidal part of A 55* is not referenced. 56* 57* LDA (input) INTEGER 58* On entry, LDA specifies the leading dimension of the array A. 59* LDA must be at least max( 1, N ). 60* 61* X (input) REAL array of dimension at least 62* ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 63* array X must contain the vector x. 64* 65* INCX (input) INTEGER 66* On entry, INCX specifies the increment for the elements of X. 67* INCX must not be zero. 68* 69* BETA (input) REAL 70* On entry, BETA specifies the real scalar beta. When BETA is 71* supplied as zero then Y need not be set on input. 72* 73* Y (input/output) REAL array of dimension at least 74* ( 1 + ( n - 1 )*abs( INCY ) ). Before entry with BETA non- 75* zero, the incremented array Y must contain the vector y. On 76* exit, the incremented array Y is overwritten by the updated 77* vector y. 78* 79* INCY (input) INTEGER 80* On entry, INCY specifies the increment for the elements of Y. 81* INCY must not be zero. 82* 83* -- Written on April 1, 1998 by 84* Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 85* 86* ===================================================================== 87* 88* .. Parameters .. 89 REAL ONE, ZERO 90 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 91* .. 92* .. Local Scalars .. 93 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY 94 REAL TALPHA, TEMP0, TEMP1, TEMP2 95* .. 96* .. External Functions .. 97 LOGICAL LSAME 98 EXTERNAL LSAME 99* .. 100* .. External Subroutines .. 101 EXTERNAL XERBLA 102* .. 103* .. Intrinsic Functions .. 104 INTRINSIC ABS, MAX 105* .. 106* .. Executable Statements .. 107* 108* Test the input parameters. 109* 110 INFO = 0 111 IF ( .NOT.LSAME( UPLO, 'U' ).AND. 112 $ .NOT.LSAME( UPLO, 'L' ) )THEN 113 INFO = 1 114 ELSE IF( N.LT.0 )THEN 115 INFO = 2 116 ELSE IF( LDA.LT.MAX( 1, N ) )THEN 117 INFO = 5 118 ELSE IF( INCX.EQ.0 )THEN 119 INFO = 7 120 ELSE IF( INCY.EQ.0 )THEN 121 INFO = 10 122 END IF 123 IF( INFO.NE.0 )THEN 124 CALL XERBLA( 'SASYMV', INFO ) 125 RETURN 126 END IF 127* 128* Quick return if possible. 129* 130 IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) 131 $ RETURN 132* 133* Set up the start points in X and Y. 134* 135 IF( INCX.GT.0 ) THEN 136 KX = 1 137 ELSE 138 KX = 1 - ( N - 1 ) * INCX 139 END IF 140 IF( INCY.GT.0 )THEN 141 KY = 1 142 ELSE 143 KY = 1 - ( N - 1 ) * INCY 144 END IF 145* 146* Start the operations. In this version the elements of A are 147* accessed sequentially with one pass through the triangular part 148* of A. 149* 150* First form y := abs( beta * y ). 151* 152 IF( BETA.NE.ONE ) THEN 153 IF( INCY.EQ.1 ) THEN 154 IF( BETA.EQ.ZERO ) THEN 155 DO 10, I = 1, N 156 Y( I ) = ZERO 157 10 CONTINUE 158 ELSE 159 DO 20, I = 1, N 160 Y( I ) = ABS( BETA * Y( I ) ) 161 20 CONTINUE 162 END IF 163 ELSE 164 IY = KY 165 IF( BETA.EQ.ZERO ) THEN 166 DO 30, I = 1, N 167 Y( IY ) = ZERO 168 IY = IY + INCY 169 30 CONTINUE 170 ELSE 171 DO 40, I = 1, N 172 Y( IY ) = ABS( BETA * Y( IY ) ) 173 IY = IY + INCY 174 40 CONTINUE 175 END IF 176 END IF 177 END IF 178* 179 IF( ALPHA.EQ.ZERO ) 180 $ RETURN 181* 182 TALPHA = ABS( ALPHA ) 183* 184 IF( LSAME( UPLO, 'U' ) ) THEN 185* 186* Form y when A is stored in upper triangle. 187* 188 IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) ) THEN 189 DO 60, J = 1, N 190 TEMP1 = TALPHA * ABS( X( J ) ) 191 TEMP2 = ZERO 192 DO 50, I = 1, J - 1 193 TEMP0 = ABS( A( I, J ) ) 194 Y( I ) = Y( I ) + TEMP1 * TEMP0 195 TEMP2 = TEMP2 + TEMP0 * ABS( X( I ) ) 196 50 CONTINUE 197 Y( J ) = Y( J ) + TEMP1 * ABS( A( J, J ) ) + 198 $ ALPHA * TEMP2 199* 200 60 CONTINUE 201* 202 ELSE 203* 204 JX = KX 205 JY = KY 206* 207 DO 80, J = 1, N 208 TEMP1 = TALPHA * ABS( X( JX ) ) 209 TEMP2 = ZERO 210 IX = KX 211 IY = KY 212* 213 DO 70, I = 1, J - 1 214 TEMP0 = ABS( A( I, J ) ) 215 Y( IY ) = Y( IY ) + TEMP1 * TEMP0 216 TEMP2 = TEMP2 + TEMP0 * ABS( X( IX ) ) 217 IX = IX + INCX 218 IY = IY + INCY 219 70 CONTINUE 220 Y( JY ) = Y( JY ) + TEMP1 * ABS( A( J, J ) ) + 221 $ ALPHA * TEMP2 222 JX = JX + INCX 223 JY = JY + INCY 224* 225 80 CONTINUE 226* 227 END IF 228* 229 ELSE 230* 231* Form y when A is stored in lower triangle. 232* 233 IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) ) THEN 234* 235 DO 100, J = 1, N 236* 237 TEMP1 = TALPHA * ABS( X( J ) ) 238 TEMP2 = ZERO 239 Y( J ) = Y( J ) + TEMP1 * ABS( A( J, J ) ) 240* 241 DO 90, I = J + 1, N 242 TEMP0 = ABS( A( I, J ) ) 243 Y( I ) = Y( I ) + TEMP1 * TEMP0 244 TEMP2 = TEMP2 + TEMP0 * ABS( X( I ) ) 245* 246 90 CONTINUE 247* 248 Y( J ) = Y( J ) + ALPHA * TEMP2 249* 250 100 CONTINUE 251* 252 ELSE 253* 254 JX = KX 255 JY = KY 256* 257 DO 120, J = 1, N 258 TEMP1 = TALPHA * ABS( X( JX ) ) 259 TEMP2 = ZERO 260 Y( JY ) = Y( JY ) + TEMP1 * ABS( A( J, J ) ) 261 IX = JX 262 IY = JY 263* 264 DO 110, I = J + 1, N 265* 266 IX = IX + INCX 267 IY = IY + INCY 268 TEMP0 = ABS( A( I, J ) ) 269 Y( IY ) = Y( IY ) + TEMP1 * TEMP0 270 TEMP2 = TEMP2 + TEMP0 * ABS( X( IX ) ) 271* 272 110 CONTINUE 273* 274 Y( JY ) = Y( JY ) + ALPHA * TEMP2 275 JX = JX + INCX 276 JY = JY + INCY 277* 278 120 CONTINUE 279* 280 END IF 281* 282 END IF 283* 284 RETURN 285* 286* End of SASYMV 287* 288 END 289