![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE ZSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) 2: * 3: * -- LAPACK auxiliary routine (version 3.2) -- 4: * -- LAPACK is a software package provided by Univ. of Tennessee, -- 5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 6: * November 2006 7: * 8: * .. Scalar Arguments .. 9: CHARACTER UPLO 10: INTEGER INCX, LDA, N 11: COMPLEX*16 ALPHA 12: * .. 13: * .. Array Arguments .. 14: COMPLEX*16 A( LDA, * ), X( * ) 15: * .. 16: * 17: * Purpose 18: * ======= 19: * 20: * ZSYR performs the symmetric rank 1 operation 21: * 22: * A := alpha*x*( x' ) + A, 23: * 24: * where alpha is a complex scalar, x is an n element vector and A is an 25: * n by n symmetric matrix. 26: * 27: * Arguments 28: * ========== 29: * 30: * UPLO (input) CHARACTER*1 31: * On entry, UPLO specifies whether the upper or lower 32: * triangular part of the array A is to be referenced as 33: * follows: 34: * 35: * UPLO = 'U' or 'u' Only the upper triangular part of A 36: * is to be referenced. 37: * 38: * UPLO = 'L' or 'l' Only the lower triangular part of A 39: * is to be referenced. 40: * 41: * Unchanged on exit. 42: * 43: * N (input) INTEGER 44: * On entry, N specifies the order of the matrix A. 45: * N must be at least zero. 46: * Unchanged on exit. 47: * 48: * ALPHA (input) COMPLEX*16 49: * On entry, ALPHA specifies the scalar alpha. 50: * Unchanged on exit. 51: * 52: * X (input) COMPLEX*16 array, dimension at least 53: * ( 1 + ( N - 1 )*abs( INCX ) ). 54: * Before entry, the incremented array X must contain the N- 55: * element vector x. 56: * Unchanged on exit. 57: * 58: * INCX (input) INTEGER 59: * On entry, INCX specifies the increment for the elements of 60: * X. INCX must not be zero. 61: * Unchanged on exit. 62: * 63: * A (input/output) COMPLEX*16 array, dimension ( LDA, N ) 64: * Before entry, with UPLO = 'U' or 'u', the leading n by n 65: * upper triangular part of the array A must contain the upper 66: * triangular part of the symmetric matrix and the strictly 67: * lower triangular part of A is not referenced. On exit, the 68: * upper triangular part of the array A is overwritten by the 69: * upper triangular part of the updated matrix. 70: * Before entry, with UPLO = 'L' or 'l', the leading n by n 71: * lower triangular part of the array A must contain the lower 72: * triangular part of the symmetric matrix and the strictly 73: * upper triangular part of A is not referenced. On exit, the 74: * lower triangular part of the array A is overwritten by the 75: * lower triangular part of the updated matrix. 76: * 77: * LDA (input) INTEGER 78: * On entry, LDA specifies the first dimension of A as declared 79: * in the calling (sub) program. LDA must be at least 80: * max( 1, N ). 81: * Unchanged on exit. 82: * 83: * ===================================================================== 84: * 85: * .. Parameters .. 86: COMPLEX*16 ZERO 87: PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) 88: * .. 89: * .. Local Scalars .. 90: INTEGER I, INFO, IX, J, JX, KX 91: COMPLEX*16 TEMP 92: * .. 93: * .. External Functions .. 94: LOGICAL LSAME 95: EXTERNAL LSAME 96: * .. 97: * .. External Subroutines .. 98: EXTERNAL XERBLA 99: * .. 100: * .. Intrinsic Functions .. 101: INTRINSIC MAX 102: * .. 103: * .. Executable Statements .. 104: * 105: * Test the input parameters. 106: * 107: INFO = 0 108: IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 109: INFO = 1 110: ELSE IF( N.LT.0 ) THEN 111: INFO = 2 112: ELSE IF( INCX.EQ.0 ) THEN 113: INFO = 5 114: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 115: INFO = 7 116: END IF 117: IF( INFO.NE.0 ) THEN 118: CALL XERBLA( 'ZSYR ', INFO ) 119: RETURN 120: END IF 121: * 122: * Quick return if possible. 123: * 124: IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) ) 125: $ RETURN 126: * 127: * Set the start point in X if the increment is not unity. 128: * 129: IF( INCX.LE.0 ) THEN 130: KX = 1 - ( N-1 )*INCX 131: ELSE IF( INCX.NE.1 ) THEN 132: KX = 1 133: END IF 134: * 135: * Start the operations. In this version the elements of A are 136: * accessed sequentially with one pass through the triangular part 137: * of A. 138: * 139: IF( LSAME( UPLO, 'U' ) ) THEN 140: * 141: * Form A when A is stored in upper triangle. 142: * 143: IF( INCX.EQ.1 ) THEN 144: DO 20 J = 1, N 145: IF( X( J ).NE.ZERO ) THEN 146: TEMP = ALPHA*X( J ) 147: DO 10 I = 1, J 148: A( I, J ) = A( I, J ) + X( I )*TEMP 149: 10 CONTINUE 150: END IF 151: 20 CONTINUE 152: ELSE 153: JX = KX 154: DO 40 J = 1, N 155: IF( X( JX ).NE.ZERO ) THEN 156: TEMP = ALPHA*X( JX ) 157: IX = KX 158: DO 30 I = 1, J 159: A( I, J ) = A( I, J ) + X( IX )*TEMP 160: IX = IX + INCX 161: 30 CONTINUE 162: END IF 163: JX = JX + INCX 164: 40 CONTINUE 165: END IF 166: ELSE 167: * 168: * Form A when A is stored in lower triangle. 169: * 170: IF( INCX.EQ.1 ) THEN 171: DO 60 J = 1, N 172: IF( X( J ).NE.ZERO ) THEN 173: TEMP = ALPHA*X( J ) 174: DO 50 I = J, N 175: A( I, J ) = A( I, J ) + X( I )*TEMP 176: 50 CONTINUE 177: END IF 178: 60 CONTINUE 179: ELSE 180: JX = KX 181: DO 80 J = 1, N 182: IF( X( JX ).NE.ZERO ) THEN 183: TEMP = ALPHA*X( JX ) 184: IX = JX 185: DO 70 I = J, N 186: A( I, J ) = A( I, J ) + X( IX )*TEMP 187: IX = IX + INCX 188: 70 CONTINUE 189: END IF 190: JX = JX + INCX 191: 80 CONTINUE 192: END IF 193: END IF 194: * 195: RETURN 196: * 197: * End of ZSYR 198: * 199: END