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**H + 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
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**H + 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