108 SUBROUTINE csptri( UPLO, N, AP, IPIV, WORK, INFO )
120 COMPLEX AP( * ), WORK( * )
127 parameter( one = ( 1.0e+0, 0.0e+0 ),
128 $ zero = ( 0.0e+0, 0.0e+0 ) )
132 INTEGER J, K, KC, KCNEXT, KP, KPC, KSTEP, KX, NPP
133 COMPLEX AK, AKKP1, AKP1, D, T, TEMP
138 EXTERNAL lsame, cdotu
151 upper = lsame( uplo,
'U' )
152 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
154 ELSE IF( n.LT.0 )
THEN
158 CALL xerbla(
'CSPTRI', -info )
174 DO 10 info = n, 1, -1
175 IF( ipiv( info ).GT.0 .AND. ap( kp ).EQ.zero )
185 IF( ipiv( info ).GT.0 .AND. ap( kp ).EQ.zero )
187 kp = kp + n - info + 1
209 IF( ipiv( k ).GT.0 )
THEN
215 ap( kc+k-1 ) = one / ap( kc+k-1 )
220 CALL ccopy( k-1, ap( kc ), 1, work, 1 )
221 CALL cspmv( uplo, k-1, -one, ap, work, 1, zero, ap( kc ),
223 ap( kc+k-1 ) = ap( kc+k-1 ) -
224 $ cdotu( k-1, work, 1, ap( kc ), 1 )
234 ak = ap( kc+k-1 ) / t
235 akp1 = ap( kcnext+k ) / t
236 akkp1 = ap( kcnext+k-1 ) / t
237 d = t*( ak*akp1-one )
238 ap( kc+k-1 ) = akp1 / d
239 ap( kcnext+k ) = ak / d
240 ap( kcnext+k-1 ) = -akkp1 / d
245 CALL ccopy( k-1, ap( kc ), 1, work, 1 )
246 CALL cspmv( uplo, k-1, -one, ap, work, 1, zero, ap( kc ),
248 ap( kc+k-1 ) = ap( kc+k-1 ) -
249 $ cdotu( k-1, work, 1, ap( kc ), 1 )
250 ap( kcnext+k-1 ) = ap( kcnext+k-1 ) -
251 $ cdotu( k-1, ap( kc ), 1, ap( kcnext ),
253 CALL ccopy( k-1, ap( kcnext ), 1, work, 1 )
254 CALL cspmv( uplo, k-1, -one, ap, work, 1, zero,
256 ap( kcnext+k ) = ap( kcnext+k ) -
257 $ cdotu( k-1, work, 1, ap( kcnext ), 1 )
260 kcnext = kcnext + k + 1
263 kp = abs( ipiv( k ) )
269 kpc = ( kp-1 )*kp / 2 + 1
270 CALL cswap( kp-1, ap( kc ), 1, ap( kpc ), 1 )
272 DO 40 j = kp + 1, k - 1
275 ap( kc+j-1 ) = ap( kx )
279 ap( kc+k-1 ) = ap( kpc+kp-1 )
280 ap( kpc+kp-1 ) = temp
281 IF( kstep.EQ.2 )
THEN
282 temp = ap( kc+k+k-1 )
283 ap( kc+k+k-1 ) = ap( kc+k+kp-1 )
284 ap( kc+k+kp-1 ) = temp
310 kcnext = kc - ( n-k+2 )
311 IF( ipiv( k ).GT.0 )
THEN
317 ap( kc ) = one / ap( kc )
322 CALL ccopy( n-k, ap( kc+1 ), 1, work, 1 )
323 CALL cspmv( uplo, n-k, -one, ap( kc+n-k+1 ), work, 1,
324 $ zero, ap( kc+1 ), 1 )
325 ap( kc ) = ap( kc ) - cdotu( n-k, work, 1, ap( kc+1 ),
336 ak = ap( kcnext ) / t
338 akkp1 = ap( kcnext+1 ) / t
339 d = t*( ak*akp1-one )
340 ap( kcnext ) = akp1 / d
342 ap( kcnext+1 ) = -akkp1 / d
347 CALL ccopy( n-k, ap( kc+1 ), 1, work, 1 )
348 CALL cspmv( uplo, n-k, -one, ap( kc+( n-k+1 ) ), work, 1,
349 $ zero, ap( kc+1 ), 1 )
350 ap( kc ) = ap( kc ) - cdotu( n-k, work, 1, ap( kc+1 ),
352 ap( kcnext+1 ) = ap( kcnext+1 ) -
353 $ cdotu( n-k, ap( kc+1 ), 1,
354 $ ap( kcnext+2 ), 1 )
355 CALL ccopy( n-k, ap( kcnext+2 ), 1, work, 1 )
356 CALL cspmv( uplo, n-k, -one, ap( kc+( n-k+1 ) ), work, 1,
357 $ zero, ap( kcnext+2 ), 1 )
358 ap( kcnext ) = ap( kcnext ) -
359 $ cdotu( n-k, work, 1, ap( kcnext+2 ), 1 )
362 kcnext = kcnext - ( n-k+3 )
365 kp = abs( ipiv( k ) )
371 kpc = npp - ( n-kp+1 )*( n-kp+2 ) / 2 + 1
373 $
CALL cswap( n-kp, ap( kc+kp-k+1 ), 1, ap( kpc+1 ), 1 )
375 DO 70 j = k + 1, kp - 1
378 ap( kc+j-k ) = ap( kx )
384 IF( kstep.EQ.2 )
THEN
385 temp = ap( kc-n+k-1 )
386 ap( kc-n+k-1 ) = ap( kc-n+kp-1 )
387 ap( kc-n+kp-1 ) = temp
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
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 csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI