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
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
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
COMPLEX function cdotu(N, CX, INCX, CY, INCY)
CDOTU
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 ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY