SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
All Classes Files Functions Variables Typedefs Macros
csyr2.f
Go to the documentation of this file.
1 SUBROUTINE csyr2( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
2*
3* -- PBLAS auxiliary routine (version 2.0) --
4* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5* and University of California, Berkeley.
6* April 1, 1998
7*
8* .. Scalar Arguments ..
9 CHARACTER*1 UPLO
10 INTEGER INCX, INCY, LDA, N
11 COMPLEX ALPHA
12* ..
13* .. Array Arguments ..
14 COMPLEX A( LDA, * ), X( * ), Y( * )
15* ..
16*
17* Purpose
18* =======
19*
20* CSYR2 performs the symmetric rank 2 operation
21*
22* A := alpha*x*y' + alpha*y*x' + A,
23*
24* where alpha is a complex scalar, x and y are n element vectors and A
25* is an n by n SY matrix.
26*
27* Arguments
28* =========
29*
30* UPLO (input) CHARACTER*1
31* On entry, UPLO specifies which part of the matrix A is to be
32* referenced as follows:
33*
34* UPLO = 'L' or 'l' the lower trapezoid of A is referenced,
35*
36* UPLO = 'U' or 'u' the upper trapezoid of A is referenced,
37*
38* otherwise all of the matrix A is referenced.
39*
40* N (input) INTEGER
41* On entry, N specifies the order of the matrix A. N must be at
42* least zero.
43*
44* ALPHA (input) COMPLEX
45* On entry, ALPHA specifies the scalar alpha.
46*
47* X (input) COMPLEX array of dimension at least
48* ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented
49* array X must contain the vector x.
50*
51* INCX (input) INTEGER
52* On entry, INCX specifies the increment for the elements of X.
53* INCX must not be zero.
54*
55* Y (input) COMPLEX array of dimension at least
56* ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the incremented
57* array Y must contain the vector y.
58*
59* INCY (input) INTEGER
60* On entry, INCY specifies the increment for the elements of Y.
61* INCY must not be zero.
62*
63* A (input/output) COMPLEX array
64* On entry, A is an array of dimension (LDA,N). Before entry
65* with UPLO = 'U' or 'u', the leading n by n part of the array
66* A must contain the upper triangular part of the symmetric ma-
67* trix and the strictly lower triangular part of A is not refe-
68* renced. On exit, the upper triangular part of the array A is
69* overwritten by the upper triangular part of the updated ma-
70* trix. When UPLO = 'L' or 'l', the leading n by n part of the
71* the array A must contain the lower triangular part of the
72* symmetric matrix and the strictly upper trapezoidal part of A
73* is not referenced. On exit, the lower triangular part of the
74* array A is overwritten by the lower triangular part of the
75* updated matrix.
76*
77* LDA (input) INTEGER
78* On entry, LDA specifies the leading dimension of the array A.
79* LDA must be at least max( 1, N ).
80*
81* -- Written on April 1, 1998 by
82* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
83*
84* =====================================================================
85*
86* .. Parameters ..
87 COMPLEX ZERO
88 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
89* ..
90* .. Local Scalars ..
91 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
92 COMPLEX TEMP1, TEMP2
93* ..
94* .. External Functions ..
95 LOGICAL LSAME
96 EXTERNAL lsame
97* ..
98* .. External Subroutines ..
99 EXTERNAL xerbla
100* ..
101* .. Intrinsic Functions ..
102 INTRINSIC max
103* ..
104* .. Executable Statements ..
105*
106* Test the input parameters.
107*
108 info = 0
109 IF ( .NOT.lsame( uplo, 'U' ).AND.
110 $ .NOT.lsame( uplo, 'L' ) )THEN
111 info = 1
112 ELSE IF( n.LT.0 )THEN
113 info = 2
114 ELSE IF( incx.EQ.0 )THEN
115 info = 5
116 ELSE IF( incy.EQ.0 )THEN
117 info = 7
118 ELSE IF( lda.LT.max( 1, n ) )THEN
119 info = 9
120 END IF
121 IF( info.NE.0 )THEN
122 CALL xerbla( 'CSYR2', info )
123 RETURN
124 END IF
125*
126* Quick return if possible.
127*
128 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
129 $ RETURN
130*
131* Set up the start points in X and Y if the increments are not both
132* unity.
133*
134 kx = 1
135 ky = 1
136 jx = 1
137 jy = 1
138 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )THEN
139 IF( incx.GT.0 )THEN
140 kx = 1
141 ELSE
142 kx = 1 - ( n - 1 )*incx
143 END IF
144 IF( incy.GT.0 )THEN
145 ky = 1
146 ELSE
147 ky = 1 - ( n - 1 )*incy
148 END IF
149 jx = kx
150 jy = ky
151 END IF
152*
153* Start the operations. In this version the elements of A are
154* accessed sequentially with one pass through the triangular part
155* of A.
156*
157 IF( lsame( uplo, 'U' ) )THEN
158*
159* Form A when A is stored in the upper triangle.
160*
161 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )THEN
162 DO 20, j = 1, n
163 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )THEN
164 temp1 = alpha*y( j )
165 temp2 = alpha*x( j )
166 DO 10, i = 1, j
167 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
168 10 CONTINUE
169 END IF
170 20 CONTINUE
171 ELSE
172 DO 40, j = 1, n
173 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )THEN
174 temp1 = alpha*y( jy )
175 temp2 = alpha*x( jx )
176 ix = kx
177 iy = ky
178 DO 30, i = 1, j
179 a( i, j ) = a( i, j ) + x( ix )*temp1
180 $ + y( iy )*temp2
181 ix = ix + incx
182 iy = iy + incy
183 30 CONTINUE
184 END IF
185 jx = jx + incx
186 jy = jy + incy
187 40 CONTINUE
188 END IF
189 ELSE
190*
191* Form A when A is stored in the lower triangle.
192*
193 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )THEN
194 DO 60, j = 1, n
195 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )THEN
196 temp1 = alpha*y( j )
197 temp2 = alpha*x( j )
198 DO 50, i = j, n
199 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
200 50 CONTINUE
201 END IF
202 60 CONTINUE
203 ELSE
204 DO 80, j = 1, n
205 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )THEN
206 temp1 = alpha*y( jy )
207 temp2 = alpha*x( jx )
208 ix = jx
209 iy = jy
210 DO 70, i = j, n
211 a( i, j ) = a( i, j ) + x( ix )*temp1
212 $ + y( iy )*temp2
213 ix = ix + incx
214 iy = iy + incy
215 70 CONTINUE
216 END IF
217 jx = jx + incx
218 jy = jy + incy
219 80 CONTINUE
220 END IF
221 END IF
222*
223 RETURN
224*
225* End of CSYR2
226*
227 END
subroutine csyr2(uplo, n, alpha, x, incx, y, incy, a, lda)
Definition csyr2.f:2
#define max(A, B)
Definition pcgemr.c:180