LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cspr ( character  UPLO,
integer  N,
complex  ALPHA,
complex, dimension( * )  X,
integer  INCX,
complex, dimension( * )  AP 
)

CSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix.

Download CSPR + dependencies [TGZ] [ZIP] [TXT]

Purpose: 
 CSPR    performs the symmetric rank 1 operation

    A := alpha*x*x**H + A,

 where alpha is a complex scalar, x is an n element vector and A is an
 n by n symmetric matrix, supplied in packed form.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the upper or lower
           triangular part of the matrix A is supplied in the packed
           array AP as follows:

              UPLO = 'U' or 'u'   The upper triangular part of A is
                                  supplied in AP.

              UPLO = 'L' or 'l'   The lower triangular part of A is
                                  supplied in AP.

           Unchanged on exit.
[in]N
          N is INTEGER
           On entry, N specifies the order of the matrix A.
           N must be at least zero.
           Unchanged on exit.
[in]ALPHA
          ALPHA is COMPLEX
           On entry, ALPHA specifies the scalar alpha.
           Unchanged on exit.
[in]X
          X is COMPLEX array, dimension at least
           ( 1 + ( N - 1 )*abs( INCX ) ).
           Before entry, the incremented array X must contain the N-
           element vector x.
           Unchanged on exit.
[in]INCX
          INCX is INTEGER
           On entry, INCX specifies the increment for the elements of
           X. INCX must not be zero.
           Unchanged on exit.
[in,out]AP
          AP is COMPLEX array, dimension at least
           ( ( N*( N + 1 ) )/2 ).
           Before entry, with  UPLO = 'U' or 'u', the array AP must
           contain the upper triangular part of the symmetric matrix
           packed sequentially, column by column, so that AP( 1 )
           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
           and a( 2, 2 ) respectively, and so on. On exit, the array
           AP is overwritten by the upper triangular part of the
           updated matrix.
           Before entry, with UPLO = 'L' or 'l', the array AP must
           contain the lower triangular part of the symmetric matrix
           packed sequentially, column by column, so that AP( 1 )
           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
           and a( 3, 1 ) respectively, and so on. On exit, the array
           AP is overwritten by the lower triangular part of the
           updated matrix.
           Note that the imaginary parts of the diagonal elements need
           not be set, they are assumed to be zero, and on exit they
           are set to zero.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 134 of file cspr.f.

134 *
135 * -- LAPACK auxiliary routine (version 3.4.2) --
136 * -- LAPACK is a software package provided by Univ. of Tennessee, --
137 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138 * September 2012
139 *
140 * .. Scalar Arguments ..
141  CHARACTER uplo
142  INTEGER incx, n
143  COMPLEX alpha
144 * ..
145 * .. Array Arguments ..
146  COMPLEX ap( * ), x( * )
147 * ..
148 *
149 * =====================================================================
150 *
151 * .. Parameters ..
152  COMPLEX zero
153  parameter ( zero = ( 0.0e+0, 0.0e+0 ) )
154 * ..
155 * .. Local Scalars ..
156  INTEGER i, info, ix, j, jx, k, kk, kx
157  COMPLEX temp
158 * ..
159 * .. External Functions ..
160  LOGICAL lsame
161  EXTERNAL lsame
162 * ..
163 * .. External Subroutines ..
164  EXTERNAL xerbla
165 * ..
166 * .. Executable Statements ..
167 *
168 * Test the input parameters.
169 *
170  info = 0
171  IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
172  info = 1
173  ELSE IF( n.LT.0 ) THEN
174  info = 2
175  ELSE IF( incx.EQ.0 ) THEN
176  info = 5
177  END IF
178  IF( info.NE.0 ) THEN
179  CALL xerbla( 'CSPR ', info )
180  RETURN
181  END IF
182 *
183 * Quick return if possible.
184 *
185  IF( ( n.EQ.0 ) .OR. ( alpha.EQ.zero ) )
186  $ RETURN
187 *
188 * Set the start point in X if the increment is not unity.
189 *
190  IF( incx.LE.0 ) THEN
191  kx = 1 - ( n-1 )*incx
192  ELSE IF( incx.NE.1 ) THEN
193  kx = 1
194  END IF
195 *
196 * Start the operations. In this version the elements of the array AP
197 * are accessed sequentially with one pass through AP.
198 *
199  kk = 1
200  IF( lsame( uplo, 'U' ) ) THEN
201 *
202 * Form A when upper triangle is stored in AP.
203 *
204  IF( incx.EQ.1 ) THEN
205  DO 20 j = 1, n
206  IF( x( j ).NE.zero ) THEN
207  temp = alpha*x( j )
208  k = kk
209  DO 10 i = 1, j - 1
210  ap( k ) = ap( k ) + x( i )*temp
211  k = k + 1
212  10 CONTINUE
213  ap( kk+j-1 ) = ap( kk+j-1 ) + x( j )*temp
214  ELSE
215  ap( kk+j-1 ) = ap( kk+j-1 )
216  END IF
217  kk = kk + j
218  20 CONTINUE
219  ELSE
220  jx = kx
221  DO 40 j = 1, n
222  IF( x( jx ).NE.zero ) THEN
223  temp = alpha*x( jx )
224  ix = kx
225  DO 30 k = kk, kk + j - 2
226  ap( k ) = ap( k ) + x( ix )*temp
227  ix = ix + incx
228  30 CONTINUE
229  ap( kk+j-1 ) = ap( kk+j-1 ) + x( jx )*temp
230  ELSE
231  ap( kk+j-1 ) = ap( kk+j-1 )
232  END IF
233  jx = jx + incx
234  kk = kk + j
235  40 CONTINUE
236  END IF
237  ELSE
238 *
239 * Form A when lower triangle is stored in AP.
240 *
241  IF( incx.EQ.1 ) THEN
242  DO 60 j = 1, n
243  IF( x( j ).NE.zero ) THEN
244  temp = alpha*x( j )
245  ap( kk ) = ap( kk ) + temp*x( j )
246  k = kk + 1
247  DO 50 i = j + 1, n
248  ap( k ) = ap( k ) + x( i )*temp
249  k = k + 1
250  50 CONTINUE
251  ELSE
252  ap( kk ) = ap( kk )
253  END IF
254  kk = kk + n - j + 1
255  60 CONTINUE
256  ELSE
257  jx = kx
258  DO 80 j = 1, n
259  IF( x( jx ).NE.zero ) THEN
260  temp = alpha*x( jx )
261  ap( kk ) = ap( kk ) + temp*x( jx )
262  ix = jx
263  DO 70 k = kk + 1, kk + n - j
264  ix = ix + incx
265  ap( k ) = ap( k ) + x( ix )*temp
266  70 CONTINUE
267  ELSE
268  ap( kk ) = ap( kk )
269  END IF
270  jx = jx + incx
271  kk = kk + n - j + 1
272  80 CONTINUE
273  END IF
274  END IF
275 *
276  RETURN
277 *
278 * End of CSPR
279 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: