ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
zsyr.f
Go to the documentation of this file.
1  SUBROUTINE zsyr( UPLO, N, ALPHA, X, INCX, 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, 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 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 * A (input/output) COMPLEX*16 array
56 * On entry, A is an array of dimension (LDA,N). Before entry
57 * with UPLO = 'U' or 'u', the leading n by n part of the array
58 * A must contain the upper triangular part of the symmetric ma-
59 * trix and the strictly lower triangular part of A is not refe-
60 * renced. On exit, the upper triangular part of the array A is
61 * overwritten by the upper triangular part of the updated ma-
62 * trix. When UPLO = 'L' or 'l', the leading n by n part of the
63 * the array A must contain the lower triangular part of the
64 * symmetric matrix and the strictly upper trapezoidal part of A
65 * is not referenced. On exit, the lower triangular part of the
66 * array A is overwritten by the lower triangular part of the
67 * updated matrix.
68 *
69 * LDA (input) INTEGER
70 * On entry, LDA specifies the leading dimension of the array A.
71 * LDA must be at least max( 1, N ).
72 *
73 * =====================================================================
74 *
75 * .. Parameters ..
76  COMPLEX*16 ZERO
77  parameter( zero = ( 0.0d+0, 0.0d+0 ) )
78 * ..
79 * .. Local Scalars ..
80  INTEGER I, INFO, IX, J, JX, KX
81  COMPLEX*16 TEMP
82 * ..
83 * .. External Functions ..
84  LOGICAL LSAME
85  EXTERNAL lsame
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL xerbla
89 * ..
90 * .. Intrinsic Functions ..
91  INTRINSIC max
92 * ..
93 * .. Executable Statements ..
94 *
95 * Test the input parameters.
96 *
97  info = 0
98  IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
99  info = 1
100  ELSE IF( n.LT.0 ) THEN
101  info = 2
102  ELSE IF( incx.EQ.0 ) THEN
103  info = 5
104  ELSE IF( lda.LT.max( 1, n ) ) THEN
105  info = 7
106  END IF
107  IF( info.NE.0 ) THEN
108  CALL xerbla( 'ZSYR', info )
109  RETURN
110  END IF
111 *
112 * Quick return if possible.
113 *
114  IF( ( n.EQ.0 ) .OR. ( alpha.EQ.zero ) )
115  $ RETURN
116 *
117 * Set the start point in X if the increment is not unity.
118 *
119  kx = 1
120  IF( incx.LE.0 ) THEN
121  kx = 1 - ( n-1 )*incx
122  ELSE IF( incx.NE.1 ) THEN
123  kx = 1
124  END IF
125 *
126 * Start the operations. In this version the elements of A are
127 * accessed sequentially with one pass through the triangular part
128 * of A.
129 *
130  IF( lsame( uplo, 'U' ) ) THEN
131 *
132 * Form A when A is stored in upper triangle.
133 *
134  IF( incx.EQ.1 ) THEN
135  DO 20 j = 1, n
136  IF( x( j ).NE.zero ) THEN
137  temp = alpha*x( j )
138  DO 10 i = 1, j
139  a( i, j ) = a( i, j ) + x( i )*temp
140  10 CONTINUE
141  END IF
142  20 CONTINUE
143  ELSE
144  jx = kx
145  DO 40 j = 1, n
146  IF( x( jx ).NE.zero ) THEN
147  temp = alpha*x( jx )
148  ix = kx
149  DO 30 i = 1, j
150  a( i, j ) = a( i, j ) + x( ix )*temp
151  ix = ix + incx
152  30 CONTINUE
153  END IF
154  jx = jx + incx
155  40 CONTINUE
156  END IF
157  ELSE
158 *
159 * Form A when A is stored in lower triangle.
160 *
161  IF( incx.EQ.1 ) THEN
162  DO 60 j = 1, n
163  IF( x( j ).NE.zero ) THEN
164  temp = alpha*x( j )
165  DO 50 i = j, n
166  a( i, j ) = a( i, j ) + x( i )*temp
167  50 CONTINUE
168  END IF
169  60 CONTINUE
170  ELSE
171  jx = kx
172  DO 80 j = 1, n
173  IF( x( jx ).NE.zero ) THEN
174  temp = alpha*x( jx )
175  ix = jx
176  DO 70 i = j, n
177  a( i, j ) = a( i, j ) + x( ix )*temp
178  ix = ix + incx
179  70 CONTINUE
180  END IF
181  jx = jx + incx
182  80 CONTINUE
183  END IF
184  END IF
185 *
186  RETURN
187 *
188 * End of ZSYR
189 *
190  END
zsyr
subroutine zsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
Definition: zsyr.f:2
max
#define max(A, B)
Definition: pcgemr.c:180