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