SUBROUTINE CSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
CHARACTER UPLO
INTEGER INFO, LDA, N
INTEGER IPIV( * )
COMPLEX A( LDA, * ), WORK( * )
COMPLEX ONE, ZERO
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ),
$ ZERO = ( 0.0E+0, 0.0E+0 ) )
LOGICAL UPPER
INTEGER K, KP, KSTEP
COMPLEX AK, AKKP1, AKP1, D, T, TEMP
LOGICAL LSAME
COMPLEX CDOTU
EXTERNAL LSAME, CDOTU
EXTERNAL CCOPY, CSWAP, CSYMV, XERBLA
INTRINSIC ABS, MAX
INFO = 0
UPPER = LSAME( UPLO, 'U' )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -4
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CSYTRI', -INFO )
RETURN
END IF
IF( N.EQ.0 )
$ RETURN
IF( UPPER ) THEN
DO 10 INFO = N, 1, -1
IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
$ RETURN
10 CONTINUE
ELSE
DO 20 INFO = 1, N
IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
$ RETURN
20 CONTINUE
END IF
INFO = 0
IF( UPPER ) THEN
K = 1
30 CONTINUE
IF( K.GT.N )
$ GO TO 40
IF( IPIV( K ).GT.0 ) THEN
A( K, K ) = ONE / A( K, K )
IF( K.GT.1 ) THEN
CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 )
CALL CSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
$ A( 1, K ), 1 )
A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, K ),
$ 1 )
END IF
KSTEP = 1
ELSE
T = A( K, K+1 )
AK = A( K, K ) / T
AKP1 = A( K+1, K+1 ) / T
AKKP1 = A( K, K+1 ) / T
D = T*( AK*AKP1-ONE )
A( K, K ) = AKP1 / D
A( K+1, K+1 ) = AK / D
A( K, K+1 ) = -AKKP1 / D
IF( K.GT.1 ) THEN
CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 )
CALL CSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
$ A( 1, K ), 1 )
A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, K ),
$ 1 )
A( K, K+1 ) = A( K, K+1 ) -
$ CDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 )
CALL CCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 )
CALL CSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
$ A( 1, K+1 ), 1 )
A( K+1, K+1 ) = A( K+1, K+1 ) -
$ CDOTU( K-1, WORK, 1, A( 1, K+1 ), 1 )
END IF
KSTEP = 2
END IF
KP = ABS( IPIV( K ) )
IF( KP.NE.K ) THEN
CALL CSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 )
CALL CSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA )
TEMP = A( K, K )
A( K, K ) = A( KP, KP )
A( KP, KP ) = TEMP
IF( KSTEP.EQ.2 ) THEN
TEMP = A( K, K+1 )
A( K, K+1 ) = A( KP, K+1 )
A( KP, K+1 ) = TEMP
END IF
END IF
K = K + KSTEP
GO TO 30
40 CONTINUE
ELSE
K = N
50 CONTINUE
IF( K.LT.1 )
$ GO TO 60
IF( IPIV( K ).GT.0 ) THEN
A( K, K ) = ONE / A( K, K )
IF( K.LT.N ) THEN
CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
$ ZERO, A( K+1, K ), 1 )
A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, K ),
$ 1 )
END IF
KSTEP = 1
ELSE
T = A( K, K-1 )
AK = A( K-1, K-1 ) / T
AKP1 = A( K, K ) / T
AKKP1 = A( K, K-1 ) / T
D = T*( AK*AKP1-ONE )
A( K-1, K-1 ) = AKP1 / D
A( K, K ) = AK / D
A( K, K-1 ) = -AKKP1 / D
IF( K.LT.N ) THEN
CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
$ ZERO, A( K+1, K ), 1 )
A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, K ),
$ 1 )
A( K, K-1 ) = A( K, K-1 ) -
$ CDOTU( N-K, A( K+1, K ), 1, A( K+1, K-1 ),
$ 1 )
CALL CCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 )
CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
$ ZERO, A( K+1, K-1 ), 1 )
A( K-1, K-1 ) = A( K-1, K-1 ) -
$ CDOTU( N-K, WORK, 1, A( K+1, K-1 ), 1 )
END IF
KSTEP = 2
END IF
KP = ABS( IPIV( K ) )
IF( KP.NE.K ) THEN
IF( KP.LT.N )
$ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 )
CALL CSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA )
TEMP = A( K, K )
A( K, K ) = A( KP, KP )
A( KP, KP ) = TEMP
IF( KSTEP.EQ.2 ) THEN
TEMP = A( K, K-1 )
A( K, K-1 ) = A( KP, K-1 )
A( KP, K-1 ) = TEMP
END IF
END IF
K = K - KSTEP
GO TO 50
60 CONTINUE
END IF
RETURN
END