SUBROUTINE INVRSE(N,M,A) C C PURPOSE : INVERT AN N BY N COMPLEX*16 MATRIX C see routines below for interfacing C C INPUT : A - THE MATRIX TO BE INVERTED C N - THE NUMBER OF COLUMNS ( NUMBER OF ROWS) USED C M - DIMENSION OF A C C OUTPUT : A - THE INVERSE OF THE ORIGIONAL MATRIX C C METHOD : GAUSS / JORDAN ELIMINATION USING MAXIMUM C PIVOTAL ELEMENT. USE OF DIVIDE IS MINIMIZED. C UNSCRAMBLING IS EFFICIENT AT THE EXPENSE OF C EXTRA STORAGE. DETERMINANT MAY HAVE WRONG SIGN. C C COMPLEX*16 A(M,M) COMPLEX*16 D,LARGE INTEGER ROW(100),COL(100),MTEMP COMPLEX*16 TEMP(100) C C D=(1.0D0,0.0D0) DO 6 K=1,N ROW(K)=K COL(K)=K 6 CONTINUE C C BEGIN MAIN REDUCTION LOOP ON K C DO 10 K=1,N C C FIND LARGEST C LARGE=A(ROW(K),COL(K)) IL=K JL=K DO 7 I=K,N DO 7 J=K,N IF(ABS(A(ROW(I),COL(J))).GT.ABS(LARGE)) THEN IL=I JL=J LARGE=A(ROW(I),COL(J)) END IF 7 CONTINUE MTEMP=ROW(K) ROW(K)=ROW(IL) ROW(IL)=MTEMP MTEMP=COL(K) COL(K)=COL(JL) COL(JL)=MTEMP C END MAX INTERCHANGE C LARGE IS NOW THE A(K,K) PIVOT D=D*LARGE A(ROW(K),COL(K))=(1.0D0,0.0D0)/LARGE DO 11 J=1,N IF(J.NE.K) THEN A(ROW(K),COL(J))=A(ROW(K),COL(J))*A(ROW(K),COL(K)) END IF 11 CONTINUE DO 12 I=1,N IF( I.EQ.K ) GO TO 12 DO 13 J=1,N IF( J.NE.K ) THEN A(ROW(I),COL(J))=A(ROW(I),COL(J))- 1 A(ROW(I),COL(K)) * A(ROW(K),COL(J)) END IF 13 CONTINUE A(ROW(I),COL(K))=-A(ROW(I),COL(K))*A(ROW(K),COL(K)) 12 CONTINUE 10 CONTINUE C C END OF MAIN REDUCTION LOOP ON K C PRINT *,' DETERMINANT = ',D C UNSCRAMBLE ROWS DO 200 J=1,N DO 180 I=1,N TEMP(COL(I))=A(ROW(I),J) 180 CONTINUE DO 190 I=1,N A(I,J)=TEMP(I) 190 CONTINUE 200 CONTINUE C UNSCRAMBLE COLUMNS DO 300 I=1,N DO 280 J=1,N TEMP(ROW(J))=A(I,COL(J)) 280 CONTINUE DO 290 J=1,N A(I,J)=TEMP(J) 290 CONTINUE 300 CONTINUE RETURN END SUBROUTINE DBLTOCX(N,HR,IHR,HI,IHI,CX,ICX) C CONVERT HR,HI TO A COMPLEX MATRIX CX INTEGER N,IHR,IHI,ICX COMPLEX*16 CX(ICX,ICX) REAL*8 HR(IHR,IHR) REAL*8 HI(IHI,IHI) DO 10 I=1,N DO 10 J=1,N CALL A02DC(HR(I,J),HI(I,J),CX(I,J)) 10 CONTINUE RETURN END SUBROUTINE CXTODBL(N,CX,ICX,HR,IHR,HI,IHI) C CONVERT COMPLEX MATRIX CX TO REAL AND IMAGINARY HR,HI INTEGER N,IHR,IHI,ICX COMPLEX*16 CX(ICX,ICX) REAL*8 HR(IHR,IHR) REAL*8 HI(IHI,IHI) DO 10 I=1,N DO 10 J=1,N CALL A02CD(CX(I,J),HR(I,J),HI(I,J)) 10 CONTINUE RETURN END SUBROUTINE CXCOPY(N,M,A,B) C COPY COMPLEX*16 MATRIX A INTO MATRIX B INTEGER N,M COMPLEX*16 A(M,M),B(M,M) DO 10 I = 1,N DO 10 J = 1,N B(I,J) = A(I,J) 10 CONTINUE RETURN END SUBROUTINE DBLCXVEC(N, VR,M1, VI,M2, C,M3) C COPY REAL*8 VECTOR TO COMPLEX*16 C-VECTOR INTEGER N,M1,M2,M3 REAL*8 VR(M1) REAL*8 VI(M2) COMPLEX*16 C(M3) DO 10 I = 1,N CALL A02DC(VR(I),VI(I),C(I)) C C(I) = CMPLX( VR(I) , VI(I) ) 10 CONTINUE END