110 SUBROUTINE csptri( UPLO, N, AP, IPIV, WORK, INFO )
123 COMPLEX AP( * ), WORK( * )
130 parameter ( one = ( 1.0e+0, 0.0e+0 ),
131 $ zero = ( 0.0e+0, 0.0e+0 ) )
135 INTEGER J, K, KC, KCNEXT, KP, KPC, KSTEP, KX, NPP
136 COMPLEX AK, AKKP1, AKP1, D, T, TEMP
141 EXTERNAL lsame, cdotu
154 upper = lsame( uplo,
'U' )
155 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
157 ELSE IF( n.LT.0 )
THEN
161 CALL xerbla(
'CSPTRI', -info )
177 DO 10 info = n, 1, -1
178 IF( ipiv( info ).GT.0 .AND. ap( kp ).EQ.zero )
188 IF( ipiv( info ).GT.0 .AND. ap( kp ).EQ.zero )
190 kp = kp + n - info + 1
212 IF( ipiv( k ).GT.0 )
THEN
218 ap( kc+k-1 ) = one / ap( kc+k-1 )
223 CALL ccopy( k-1, ap( kc ), 1, work, 1 )
224 CALL cspmv( uplo, k-1, -one, ap, work, 1, zero, ap( kc ),
226 ap( kc+k-1 ) = ap( kc+k-1 ) -
227 $ cdotu( k-1, work, 1, ap( kc ), 1 )
237 ak = ap( kc+k-1 ) / t
238 akp1 = ap( kcnext+k ) / t
239 akkp1 = ap( kcnext+k-1 ) / t
240 d = t*( ak*akp1-one )
241 ap( kc+k-1 ) = akp1 / d
242 ap( kcnext+k ) = ak / d
243 ap( kcnext+k-1 ) = -akkp1 / d
248 CALL ccopy( k-1, ap( kc ), 1, work, 1 )
249 CALL cspmv( uplo, k-1, -one, ap, work, 1, zero, ap( kc ),
251 ap( kc+k-1 ) = ap( kc+k-1 ) -
252 $ cdotu( k-1, work, 1, ap( kc ), 1 )
253 ap( kcnext+k-1 ) = ap( kcnext+k-1 ) -
254 $ cdotu( k-1, ap( kc ), 1, ap( kcnext ),
256 CALL ccopy( k-1, ap( kcnext ), 1, work, 1 )
257 CALL cspmv( uplo, k-1, -one, ap, work, 1, zero,
259 ap( kcnext+k ) = ap( kcnext+k ) -
260 $ cdotu( k-1, work, 1, ap( kcnext ), 1 )
263 kcnext = kcnext + k + 1
266 kp = abs( ipiv( k ) )
272 kpc = ( kp-1 )*kp / 2 + 1
273 CALL cswap( kp-1, ap( kc ), 1, ap( kpc ), 1 )
275 DO 40 j = kp + 1, k - 1
278 ap( kc+j-1 ) = ap( kx )
282 ap( kc+k-1 ) = ap( kpc+kp-1 )
283 ap( kpc+kp-1 ) = temp
284 IF( kstep.EQ.2 )
THEN
285 temp = ap( kc+k+k-1 )
286 ap( kc+k+k-1 ) = ap( kc+k+kp-1 )
287 ap( kc+k+kp-1 ) = temp
313 kcnext = kc - ( n-k+2 )
314 IF( ipiv( k ).GT.0 )
THEN
320 ap( kc ) = one / ap( kc )
325 CALL ccopy( n-k, ap( kc+1 ), 1, work, 1 )
326 CALL cspmv( uplo, n-k, -one, ap( kc+n-k+1 ), work, 1,
327 $ zero, ap( kc+1 ), 1 )
328 ap( kc ) = ap( kc ) - cdotu( n-k, work, 1, ap( kc+1 ),
339 ak = ap( kcnext ) / t
341 akkp1 = ap( kcnext+1 ) / t
342 d = t*( ak*akp1-one )
343 ap( kcnext ) = akp1 / d
345 ap( kcnext+1 ) = -akkp1 / d
350 CALL ccopy( n-k, ap( kc+1 ), 1, work, 1 )
351 CALL cspmv( uplo, n-k, -one, ap( kc+( n-k+1 ) ), work, 1,
352 $ zero, ap( kc+1 ), 1 )
353 ap( kc ) = ap( kc ) - cdotu( n-k, work, 1, ap( kc+1 ),
355 ap( kcnext+1 ) = ap( kcnext+1 ) -
356 $ cdotu( n-k, ap( kc+1 ), 1,
357 $ ap( kcnext+2 ), 1 )
358 CALL ccopy( n-k, ap( kcnext+2 ), 1, work, 1 )
359 CALL cspmv( uplo, n-k, -one, ap( kc+( n-k+1 ) ), work, 1,
360 $ zero, ap( kcnext+2 ), 1 )
361 ap( kcnext ) = ap( kcnext ) -
362 $ cdotu( n-k, work, 1, ap( kcnext+2 ), 1 )
365 kcnext = kcnext - ( n-k+3 )
368 kp = abs( ipiv( k ) )
374 kpc = npp - ( n-kp+1 )*( n-kp+2 ) / 2 + 1
376 $
CALL cswap( n-kp, ap( kc+kp-k+1 ), 1, ap( kpc+1 ), 1 )
378 DO 70 j = k + 1, kp - 1
381 ap( kc+j-k ) = ap( kx )
387 IF( kstep.EQ.2 )
THEN
388 temp = ap( kc-n+k-1 )
389 ap( kc-n+k-1 ) = ap( kc-n+kp-1 )
390 ap( kc-n+kp-1 ) = temp
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
CSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix ...
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP