2
SUBROUTINE CHIFA (A, LDA, N, KPVT, INFO)
3
C***BEGIN PROLOGUE CHIFA
4
C***PURPOSE Factor a complex Hermitian matrix by elimination
5
C (symmetric pivoting).
6
C***LIBRARY SLATEC (LINPACK)
8
C***TYPE COMPLEX (SSIFA-S, DSIFA-D, CHIFA-C, CSIFA-C)
9
C***KEYWORDS HERMITIAN, LINEAR ALGEBRA, LINPACK, MATRIX FACTORIZATION
10
C***AUTHOR Bunch, J., (UCSD)
13
C CHIFA factors a complex Hermitian matrix by elimination
14
C with symmetric pivoting.
16
C To solve A*X = B , follow CHIFA by CHISL.
17
C To compute INVERSE(A)*C , follow CHIFA by CHISL.
18
C To compute DETERMINANT(A) , follow CHIFA by CHIDI.
19
C To compute INERTIA(A) , follow CHIFA by CHIDI.
20
C To compute INVERSE(A) , follow CHIFA by CHIDI.
25
C the Hermitian matrix to be factored.
26
C Only the diagonal and upper triangle are used.
29
C the leading dimension of the array A .
32
C the order of the matrix A .
36
C A a block diagonal matrix and the multipliers which
37
C were used to obtain it.
38
C The factorization can be written A = U*D*CTRANS(U)
39
C where U is a product of permutation and unit
40
C upper triangular matrices , CTRANS(U) is the
41
C conjugate transpose of U , and D is block diagonal
42
C with 1 by 1 and 2 by 2 blocks.
45
C an integer vector of pivot indices.
49
C = K if the K-th pivot block is singular. This is
50
C not an error condition for this subroutine,
51
C but it does indicate that CHISL or CHIDI may
52
C divide by zero if called.
54
C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
55
C Stewart, LINPACK Users' Guide, SIAM, 1979.
56
C***ROUTINES CALLED CAXPY, CSWAP, ICAMAX
57
C***REVISION HISTORY (YYMMDD)
59
C 890531 Changed all specific intrinsics to generic. (WRB)
60
C 890831 Modified array declarations. (WRB)
61
C 891107 Modified routine equivalence list. (WRB)
62
C 891107 REVISION DATE from Version 3.2
63
C 891214 Prologue converted to Version 4.0 format. (BAB)
64
C 900326 Removed duplicate information from DESCRIPTION section.
66
C 920501 Reformatted the REFERENCES section. (WRB)
67
C***END PROLOGUE CHIFA
68
INTEGER LDA,N,KPVT(*),INFO
71
COMPLEX AK,AKM1,BK,BKM1,DENOM,MULK,MULKM1,T
72
REAL ABSAKK,ALPHA,COLMAX,ROWMAX
73
INTEGER IMAX,IMAXP1,J,JJ,JMAX,K,KM1,KM2,KSTEP,ICAMAX
77
CABS1(ZDUM) = ABS(REAL(ZDUM)) + ABS(AIMAG(ZDUM))
78
C***FIRST EXECUTABLE STATEMENT CHIFA
82
C ALPHA IS USED IN CHOOSING PIVOT BLOCK SIZE.
84
ALPHA = (1.0E0 + SQRT(17.0E0))/8.0E0
88
C MAIN LOOP ON K, WHICH GOES FROM N TO 1.
93
C LEAVE THE LOOP IF K=0 OR K=1.
95
IF (K .EQ. 0) GO TO 200
96
IF (K .GT. 1) GO TO 20
98
IF (CABS1(A(1,1)) .EQ. 0.0E0) INFO = 1
102
C THIS SECTION OF CODE DETERMINES THE KIND OF
103
C ELIMINATION TO BE PERFORMED. WHEN IT IS COMPLETED,
104
C KSTEP WILL BE SET TO THE SIZE OF THE PIVOT BLOCK, AND
105
C SWAP WILL BE SET TO .TRUE. IF AN INTERCHANGE IS
109
ABSAKK = CABS1(A(K,K))
111
C DETERMINE THE LARGEST OFF-DIAGONAL ELEMENT IN
114
IMAX = ICAMAX(K-1,A(1,K),1)
115
COLMAX = CABS1(A(IMAX,K))
116
IF (ABSAKK .LT. ALPHA*COLMAX) GO TO 30
122
C DETERMINE THE LARGEST OFF-DIAGONAL ELEMENT IN
128
ROWMAX = MAX(ROWMAX,CABS1(A(IMAX,J)))
130
IF (IMAX .EQ. 1) GO TO 50
131
JMAX = ICAMAX(IMAX-1,A(1,IMAX),1)
132
ROWMAX = MAX(ROWMAX,CABS1(A(JMAX,IMAX)))
134
IF (CABS1(A(IMAX,IMAX)) .LT. ALPHA*ROWMAX) GO TO 60
139
IF (ABSAKK .LT. ALPHA*COLMAX*(COLMAX/ROWMAX)) GO TO 70
148
IF (MAX(ABSAKK,COLMAX) .NE. 0.0E0) GO TO 100
150
C COLUMN K IS ZERO. SET INFO AND ITERATE THE LOOP.
156
IF (KSTEP .EQ. 2) GO TO 140
160
IF (.NOT.SWAP) GO TO 120
162
C PERFORM AN INTERCHANGE.
164
CALL CSWAP(IMAX,A(1,IMAX),1,A(1,K),1)
168
A(J,K) = CONJG(A(IMAX,J))
173
C PERFORM THE ELIMINATION.
177
MULK = -A(J,K)/A(K,K)
179
CALL CAXPY(J,T,A(1,K),1,A(1,J),1)
180
A(J,J) = CMPLX(REAL(A(J,J)),0.0E0)
184
C SET THE PIVOT ARRAY.
187
IF (SWAP) KPVT(K) = IMAX
193
IF (.NOT.SWAP) GO TO 160
195
C PERFORM AN INTERCHANGE.
197
CALL CSWAP(IMAX,A(1,IMAX),1,A(1,K-1),1)
198
DO 150 JJ = IMAX, KM1
201
A(J,K-1) = CONJG(A(IMAX,J))
209
C PERFORM THE ELIMINATION.
212
IF (KM2 .EQ. 0) GO TO 180
214
AKM1 = A(K-1,K-1)/CONJG(A(K-1,K))
215
DENOM = 1.0E0 - AK*AKM1
219
BKM1 = A(J,K-1)/CONJG(A(K-1,K))
220
MULK = (AKM1*BK - BKM1)/DENOM
221
MULKM1 = (AK*BKM1 - BK)/DENOM
223
CALL CAXPY(J,T,A(1,K),1,A(1,J),1)
225
CALL CAXPY(J,T,A(1,K-1),1,A(1,J),1)
228
A(J,J) = CMPLX(REAL(A(J,J)),0.0E0)
232
C SET THE PIVOT ARRAY.
235
IF (SWAP) KPVT(K) = -IMAX