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