001: SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ) 002: * 003: * -- LAPACK auxiliary routine (version 3.2) -- 004: * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 005: * November 2006 006: * 007: * .. Scalar Arguments .. 008: CHARACTER UPLO 009: INTEGER INCX, INCY, LDA, N 010: COMPLEX*16 ALPHA, BETA 011: * .. 012: * .. Array Arguments .. 013: COMPLEX*16 A( LDA, * ), X( * ), Y( * ) 014: * .. 015: * 016: * Purpose 017: * ======= 018: * 019: * ZSYMV performs the matrix-vector operation 020: * 021: * y := alpha*A*x + beta*y, 022: * 023: * where alpha and beta are scalars, x and y are n element vectors and 024: * A is an n by n symmetric matrix. 025: * 026: * Arguments 027: * ========== 028: * 029: * UPLO (input) CHARACTER*1 030: * On entry, UPLO specifies whether the upper or lower 031: * triangular part of the array A is to be referenced as 032: * follows: 033: * 034: * UPLO = 'U' or 'u' Only the upper triangular part of A 035: * is to be referenced. 036: * 037: * UPLO = 'L' or 'l' Only the lower triangular part of A 038: * is to be referenced. 039: * 040: * Unchanged on exit. 041: * 042: * N (input) INTEGER 043: * On entry, N specifies the order of the matrix A. 044: * N must be at least zero. 045: * Unchanged on exit. 046: * 047: * ALPHA (input) COMPLEX*16 048: * On entry, ALPHA specifies the scalar alpha. 049: * Unchanged on exit. 050: * 051: * A (input) COMPLEX*16 array, dimension ( LDA, N ) 052: * Before entry, with UPLO = 'U' or 'u', the leading n by n 053: * upper triangular part of the array A must contain the upper 054: * triangular part of the symmetric matrix and the strictly 055: * lower triangular part of A is not referenced. 056: * Before entry, with UPLO = 'L' or 'l', the leading n by n 057: * lower triangular part of the array A must contain the lower 058: * triangular part of the symmetric matrix and the strictly 059: * upper triangular part of A is not referenced. 060: * Unchanged on exit. 061: * 062: * LDA (input) INTEGER 063: * On entry, LDA specifies the first dimension of A as declared 064: * in the calling (sub) program. LDA must be at least 065: * max( 1, N ). 066: * Unchanged on exit. 067: * 068: * X (input) COMPLEX*16 array, dimension at least 069: * ( 1 + ( N - 1 )*abs( INCX ) ). 070: * Before entry, the incremented array X must contain the N- 071: * element vector x. 072: * Unchanged on exit. 073: * 074: * INCX (input) INTEGER 075: * On entry, INCX specifies the increment for the elements of 076: * X. INCX must not be zero. 077: * Unchanged on exit. 078: * 079: * BETA (input) COMPLEX*16 080: * On entry, BETA specifies the scalar beta. When BETA is 081: * supplied as zero then Y need not be set on input. 082: * Unchanged on exit. 083: * 084: * Y (input/output) COMPLEX*16 array, dimension at least 085: * ( 1 + ( N - 1 )*abs( INCY ) ). 086: * Before entry, the incremented array Y must contain the n 087: * element vector y. On exit, Y is overwritten by the updated 088: * vector y. 089: * 090: * INCY (input) INTEGER 091: * On entry, INCY specifies the increment for the elements of 092: * Y. INCY must not be zero. 093: * Unchanged on exit. 094: * 095: * ===================================================================== 096: * 097: * .. Parameters .. 098: COMPLEX*16 ONE 099: 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: