LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
cspr.f
Go to the documentation of this file.
1 *> \brief \b CSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download CSPR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cspr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cspr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cspr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CSPR( UPLO, N, ALPHA, X, INCX, AP )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER UPLO
25 * INTEGER INCX, N
26 * COMPLEX ALPHA
27 * ..
28 * .. Array Arguments ..
29 * COMPLEX AP( * ), X( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> CSPR performs the symmetric rank 1 operation
39 *>
40 *> A := alpha*x*x**H + A,
41 *>
42 *> where alpha is a complex scalar, x is an n element vector and A is an
43 *> n by n symmetric matrix, supplied in packed form.
44 *> \endverbatim
45 *
46 * Arguments:
47 * ==========
48 *
49 *> \param[in] UPLO
50 *> \verbatim
51 *> UPLO is CHARACTER*1
52 *> On entry, UPLO specifies whether the upper or lower
53 *> triangular part of the matrix A is supplied in the packed
54 *> array AP as follows:
55 *>
56 *> UPLO = 'U' or 'u' The upper triangular part of A is
57 *> supplied in AP.
58 *>
59 *> UPLO = 'L' or 'l' The lower triangular part of A is
60 *> supplied in AP.
61 *>
62 *> Unchanged on exit.
63 *> \endverbatim
64 *>
65 *> \param[in] N
66 *> \verbatim
67 *> N is INTEGER
68 *> On entry, N specifies the order of the matrix A.
69 *> N must be at least zero.
70 *> Unchanged on exit.
71 *> \endverbatim
72 *>
73 *> \param[in] ALPHA
74 *> \verbatim
75 *> ALPHA is COMPLEX
76 *> On entry, ALPHA specifies the scalar alpha.
77 *> Unchanged on exit.
78 *> \endverbatim
79 *>
80 *> \param[in] X
81 *> \verbatim
82 *> X is COMPLEX array, dimension at least
83 *> ( 1 + ( N - 1 )*abs( INCX ) ).
84 *> Before entry, the incremented array X must contain the N-
85 *> element vector x.
86 *> Unchanged on exit.
87 *> \endverbatim
88 *>
89 *> \param[in] INCX
90 *> \verbatim
91 *> INCX is INTEGER
92 *> On entry, INCX specifies the increment for the elements of
93 *> X. INCX must not be zero.
94 *> Unchanged on exit.
95 *> \endverbatim
96 *>
97 *> \param[in,out] AP
98 *> \verbatim
99 *> AP is COMPLEX array, dimension at least
100 *> ( ( N*( N + 1 ) )/2 ).
101 *> Before entry, with UPLO = 'U' or 'u', the array AP must
102 *> contain the upper triangular part of the symmetric matrix
103 *> packed sequentially, column by column, so that AP( 1 )
104 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
105 *> and a( 2, 2 ) respectively, and so on. On exit, the array
106 *> AP is overwritten by the upper triangular part of the
107 *> updated matrix.
108 *> Before entry, with UPLO = 'L' or 'l', the array AP must
109 *> contain the lower triangular part of the symmetric matrix
110 *> packed sequentially, column by column, so that AP( 1 )
111 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
112 *> and a( 3, 1 ) respectively, and so on. On exit, the array
113 *> AP is overwritten by the lower triangular part of the
114 *> updated matrix.
115 *> Note that the imaginary parts of the diagonal elements need
116 *> not be set, they are assumed to be zero, and on exit they
117 *> are set to zero.
118 *> \endverbatim
119 *
120 * Authors:
121 * ========
122 *
123 *> \author Univ. of Tennessee
124 *> \author Univ. of California Berkeley
125 *> \author Univ. of Colorado Denver
126 *> \author NAG Ltd.
127 *
128 *> \ingroup complexOTHERauxiliary
129 *
130 * =====================================================================
131  SUBROUTINE cspr( UPLO, N, ALPHA, X, INCX, AP )
132 *
133 * -- LAPACK auxiliary routine --
134 * -- LAPACK is a software package provided by Univ. of Tennessee, --
135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136 *
137 * .. Scalar Arguments ..
138  CHARACTER UPLO
139  INTEGER INCX, N
140  COMPLEX ALPHA
141 * ..
142 * .. Array Arguments ..
143  COMPLEX AP( * ), X( * )
144 * ..
145 *
146 * =====================================================================
147 *
148 * .. Parameters ..
149  COMPLEX ZERO
150  parameter( zero = ( 0.0e+0, 0.0e+0 ) )
151 * ..
152 * .. Local Scalars ..
153  INTEGER I, INFO, IX, J, JX, K, KK, KX
154  COMPLEX TEMP
155 * ..
156 * .. External Functions ..
157  LOGICAL LSAME
158  EXTERNAL lsame
159 * ..
160 * .. External Subroutines ..
161  EXTERNAL xerbla
162 * ..
163 * .. Executable Statements ..
164 *
165 * Test the input parameters.
166 *
167  info = 0
168  IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
169  info = 1
170  ELSE IF( n.LT.0 ) THEN
171  info = 2
172  ELSE IF( incx.EQ.0 ) THEN
173  info = 5
174  END IF
175  IF( info.NE.0 ) THEN
176  CALL xerbla( 'CSPR ', info )
177  RETURN
178  END IF
179 *
180 * Quick return if possible.
181 *
182  IF( ( n.EQ.0 ) .OR. ( alpha.EQ.zero ) )
183  $ RETURN
184 *
185 * Set the start point in X if the increment is not unity.
186 *
187  IF( incx.LE.0 ) THEN
188  kx = 1 - ( n-1 )*incx
189  ELSE IF( incx.NE.1 ) THEN
190  kx = 1
191  END IF
192 *
193 * Start the operations. In this version the elements of the array AP
194 * are accessed sequentially with one pass through AP.
195 *
196  kk = 1
197  IF( lsame( uplo, 'U' ) ) THEN
198 *
199 * Form A when upper triangle is stored in AP.
200 *
201  IF( incx.EQ.1 ) THEN
202  DO 20 j = 1, n
203  IF( x( j ).NE.zero ) THEN
204  temp = alpha*x( j )
205  k = kk
206  DO 10 i = 1, j - 1
207  ap( k ) = ap( k ) + x( i )*temp
208  k = k + 1
209  10 CONTINUE
210  ap( kk+j-1 ) = ap( kk+j-1 ) + x( j )*temp
211  ELSE
212  ap( kk+j-1 ) = ap( kk+j-1 )
213  END IF
214  kk = kk + j
215  20 CONTINUE
216  ELSE
217  jx = kx
218  DO 40 j = 1, n
219  IF( x( jx ).NE.zero ) THEN
220  temp = alpha*x( jx )
221  ix = kx
222  DO 30 k = kk, kk + j - 2
223  ap( k ) = ap( k ) + x( ix )*temp
224  ix = ix + incx
225  30 CONTINUE
226  ap( kk+j-1 ) = ap( kk+j-1 ) + x( jx )*temp
227  ELSE
228  ap( kk+j-1 ) = ap( kk+j-1 )
229  END IF
230  jx = jx + incx
231  kk = kk + j
232  40 CONTINUE
233  END IF
234  ELSE
235 *
236 * Form A when lower triangle is stored in AP.
237 *
238  IF( incx.EQ.1 ) THEN
239  DO 60 j = 1, n
240  IF( x( j ).NE.zero ) THEN
241  temp = alpha*x( j )
242  ap( kk ) = ap( kk ) + temp*x( j )
243  k = kk + 1
244  DO 50 i = j + 1, n
245  ap( k ) = ap( k ) + x( i )*temp
246  k = k + 1
247  50 CONTINUE
248  ELSE
249  ap( kk ) = ap( kk )
250  END IF
251  kk = kk + n - j + 1
252  60 CONTINUE
253  ELSE
254  jx = kx
255  DO 80 j = 1, n
256  IF( x( jx ).NE.zero ) THEN
257  temp = alpha*x( jx )
258  ap( kk ) = ap( kk ) + temp*x( jx )
259  ix = jx
260  DO 70 k = kk + 1, kk + n - j
261  ix = ix + incx
262  ap( k ) = ap( k ) + x( ix )*temp
263  70 CONTINUE
264  ELSE
265  ap( kk ) = ap( kk )
266  END IF
267  jx = jx + incx
268  kk = kk + n - j + 1
269  80 CONTINUE
270  END IF
271  END IF
272 *
273  RETURN
274 *
275 * End of CSPR
276 *
277  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine cspr(UPLO, N, ALPHA, X, INCX, AP)
CSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix.
Definition: cspr.f:132