ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
zsyr2.f
Go to the documentation of this file.
1  SUBROUTINE zsyr2( 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*16 ALPHA
12 * ..
13 * .. Array Arguments ..
14  COMPLEX*16 A( LDA, * ), X( * ), Y( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZSYR2 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*16
45 * On entry, ALPHA specifies the scalar alpha.
46 *
47 * X (input) COMPLEX*16 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*16 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*16 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*16 ZERO
88  parameter( zero = ( 0.0d+0, 0.0d+0 ) )
89 * ..
90 * .. Local Scalars ..
91  INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
92  COMPLEX*16 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( 'ZSYR2', 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 ZSYR2
226 *
227  END
max
#define max(A, B)
Definition: pcgemr.c:180
zsyr2
subroutine zsyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
Definition: zsyr2.f:2