5 * Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
9 #include "kernnum/pilot.h"
10 SUBROUTINE CEQINV(N,A,IDIM,R,IFAIL,K,B)
12 COMPLEX A(IDIM,N),B(IDIM,K),ONE,DET,TEMP,S,
13 $ B1,B2,C11,C12,C13,C21,C22,C23,C31,C32,C33
15 DATA NAME/'CEQINV'/,KPRNT/1/
18 C ******************************************************************
20 C REPLACES B BY THE SOLUTION X OF A*X=B, AND REPLACES A BY ITS IN-
23 C N ORDER OF THE SQUARE MATRIX IN ARRAY A.
25 C A (COMPLEX) TWO-DIMENSIONAL ARRAY CONTAINING AN N BY N
28 C IDIM FIRST DIMENSION PARAMETER OF ARRAYS A AND B.
30 C R (REAL) WORKING VECTOR OF LENGTH NOT LESS THAN N.
32 C IFAIL OUTPUT PARAMETER. IFAIL= 0 ... NORMAL EXIT.
33 C IFAIL=-1 ... SINGULAR MATRIX.
35 C K NUMBER OF COLUMNS OF THE MATRIX IN ARRAY B.
37 C B (COMPLEX) TWO-DIMENSIONAL ARRAY CONTAINING AN N BY K
40 C CALLS ... CFACT, CFINV, F010PR, ABEND.
42 C ******************************************************************
44 C TEST FOR PARAMETER ERRORS.
46 IF((N.LT.1).OR.(N.GT.IDIM).OR.(K.LT.1)) GO TO 10
57 C11=A(2,2)*A(3,3)-A(2,3)*A(3,2)
58 C12=A(2,3)*A(3,1)-A(2,1)*A(3,3)
59 C13=A(2,1)*A(3,2)-A(2,2)*A(3,1)
60 C21=A(3,2)*A(1,3)-A(3,3)*A(1,2)
61 C22=A(3,3)*A(1,1)-A(3,1)*A(1,3)
62 C23=A(3,1)*A(1,2)-A(3,2)*A(1,1)
63 C31=A(1,2)*A(2,3)-A(1,3)*A(2,2)
64 C32=A(1,3)*A(2,1)-A(1,1)*A(2,3)
65 C33=A(1,1)*A(2,2)-A(1,2)*A(2,1)
66 T1=ABS(REAL(A(1,1)))+ABS(AIMAG(A(1,1)))
67 T2=ABS(REAL(A(2,1)))+ABS(AIMAG(A(2,1)))
68 T3=ABS(REAL(A(3,1)))+ABS(AIMAG(A(3,1)))
70 C (SET TEMP=PIVOT AND DET=PIVOT*DET.)
77 1 IF(T3.GE.T1) GO TO 2
86 C SET ELEMENTS OF INVERSE IN A.
87 3 IF( REAL(DET).EQ.0. .AND. AIMAG(DET).EQ.0. ) GO TO 11
99 C REPLACE B BY AINV*B.
103 B(1,J)=A(1,1)*B1+A(1,2)*B2+A(1,3)*B(3,J)
104 B(2,J)=A(2,1)*B1+A(2,2)*B2+A(2,3)*B(3,J)
105 B(3,J)=A(3,1)*B1+A(3,2)*B2+A(3,3)*B(3,J)
111 C N=2 CASE BY CRAMERS RULE.
113 DET=A(1,1)*A(2,2)-A(1,2)*A(2,1)
114 IF( REAL(DET).EQ.0. .AND. AIMAG(DET).EQ.0. ) GO TO 11
123 B(1,J)=C11*B1+A(1,2)*B(2,J)
124 B(2,J)=A(2,1)*B1+A(2,2)*B(2,J)
130 7 IF( REAL(A(1,1)).EQ.0. .AND. AIMAG(A(1,1)).EQ.0. ) GO TO 11
137 C N.GT.3 CASES. FACTORIZE MATRIX, INVERT AND SOLVE SYSTEM.
139 9 CALL CFACT(N,A,IDIM,R,IFAIL,DET,JFAIL)
140 IF(IFAIL.NE.0) RETURN
141 CALL CFEQN(N,A,IDIM,R,K,B)
142 CALL CFINV(N,A,IDIM,R)
148 CALL F010PR(NAME,N,IDIM,K,KPRNT)