LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ zspr()

subroutine zspr ( character  UPLO,
integer  N,
complex*16  ALPHA,
complex*16, dimension( * )  X,
integer  INCX,
complex*16, dimension( * )  AP 
)

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

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

Purpose:
 ZSPR    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*16
           On entry, ALPHA specifies the scalar alpha.
           Unchanged on exit.
[in]X
          X is COMPLEX*16 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*16 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.

Definition at line 131 of file zspr.f.

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*16 ALPHA
141 * ..
142 * .. Array Arguments ..
143  COMPLEX*16 AP( * ), X( * )
144 * ..
145 *
146 * =====================================================================
147 *
148 * .. Parameters ..
149  COMPLEX*16 ZERO
150  parameter( zero = ( 0.0d+0, 0.0d+0 ) )
151 * ..
152 * .. Local Scalars ..
153  INTEGER I, INFO, IX, J, JX, K, KK, KX
154  COMPLEX*16 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( 'ZSPR ', 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 ZSPR
276 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: