1 : C INVMA2 SOURCE CHAT 05/01/13 00:43:15 5004 2 : SUBROUTINE INVMA2(A,NZ,ICRIT) 3 : C 4 : C ==================================================================== 5 : C INVERSION DE MATRICE A PAR LA METHODE DES DETERMINANTS 6 : C matrice limitee a la dimension 4 georgin insa 7 : C A MATRICE (NZ*NZ) A INVERSER EN ENTREE, MATRICE INVERSEE EN SORTIE 8 : C ICRIT=1 SI MATRICE SINGULIERE, 0 SINON 9 : C 10 : C ==================================================================== 11 : C 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : DIMENSION A(4,4),O(4,4) 14 : CALL ZERO(O,4,4) 15 : ICRIT=0 16 : C 17 : C ************************** TRANSPOSITION **************************** 18 : C 19 : A11=A(1,1) 20 : A12=A(1,2) 21 : A13=A(1,3) 22 : A14=A(1,4) 23 : A21=A(2,1) 24 : A22=A(2,2) 25 : A23=A(2,3) 26 : A24=A(2,4) 27 : A31=A(3,1) 28 : A32=A(3,2) 29 : A33=A(3,3) 30 : A34=A(3,4) 31 : A41=A(4,1) 32 : A42=A(4,2) 33 : A43=A(4,3) 34 : A44=A(4,4) 34 : CALL ZERO(A,4,4) 35 : C 36 : C ************************** TEST SUR LA DIMENSION ******************** 37 : C 38 : GOTO (1,200,300,400),NZ 39 : 1 CONTINUE 40 : DELTA=A11 41 : O(1,1)=1.D0 42 : GOTO 500 43 : 200 CONTINUE 44 : DELTA=A11*A22-A21*A12 45 : O(1,1)=A22 46 : O(1,2)=-A21 47 : O(2,1)=-A12 48 : O(2,2)=A11 49 : GOTO 500 50 : 300 CONTINUE 51 : DELTA1=A11*A22*A33+A12*A23*A31+A21*A32*A13 52 : DELTA2=A31*A22*A13+A32*A23*A11+A21*A12*A33 53 : DELTA=DELTA1-DELTA2 54 : O(1,1)=A22*A33-A32*A23 55 : O(1,2)=A31*A23-A21*A33 56 : O(1,3)=A21*A32-A31*A22 57 : O(2,1)=A32*A13-A12*A33 58 : O(2,2)=A11*A33-A31*A13 59 : O(2,3)=A31*A12-A11*A32 60 : O(3,1)=A12*A23-A22*A13 61 : O(3,2)=A21*A13-A11*A23 62 : O(3,3)=A11*A22-A21*A12 63 : GOTO 500 64 : 400 CONTINUE 65 : O(1,1)=(A22*A33*A44+A32*A43*A24+A42*A23*A34) 66 : O(1,1)=O(1,1)-(A42*A33*A24+A32*A23*A44+A43*A34*A22) 67 : O(1,2)=-(A21*A33*A44+A31*A43*A24+A41*A23*A34) 68 : O(1,2)=O(1,2)+(A41*A33*A24+A31*A23*A44+A43*A34*A21) 69 : O(1,3)=(A21*A32*A44+A31*A42*A24+A41*A22*A34) 70 : O(1,3)=O(1,3)-(A41*A32*A24+A42*A34*A21+A31*A22*A44) 71 : O(1,4)=-(A21*A32*A43+A22*A33*A41+A31*A42*A23) 72 : O(1,4)=O(1,4)+(A41*A32*A23+A42*A33*A21+A31*A22*A43) 73 : O(2,1)=-(A12*A33*A44+A32*A43*A14+A42*A13*A24) 74 : O(2,1)=O(2,1)+(A42*A33*A14+A32*A13*A44+A12*A43*A34) 75 : O(2,2)=(A11*A33*A44+A31*A43*A14+A41*A13*A34) 76 : O(2,2)=O(2,2)-(A41*A33*A14+A31*A13*A44+A11*A43*A34) 77 : O(2,3)=-(A11*A32*A44+A31*A42*A14+A41*A12*A34) 78 : O(2,3)=O(2,3)+(A41*A32*A14+A42*A34*A11+A31*A12*A44) 79 : O(2,4)=(A11*A32*A43+A31*A42*A13+A41*A12*A33) 80 : O(2,4)=O(2,4)-(A41*A32*A13+A31*A12*A43+A42*A33*A11) 81 : O(3,1)=(A12*A23*A44+A22*A43*A14+A13*A24*A42) 82 : O(3,1)=O(3,1)-(A42*A23*A14+A22*A13*A44+A43*A24*A12) 83 : O(3,2)=-(A11*A23*A44+A21*A43*A14+A41*A13*A24) 84 : O(3,2)=O(3,2)+(A41*A23*A14+A43*A24*A11+A21*A13*A44) 85 : O(3,3)=(A11*A22*A44+A21*A42*A14+A41*A12*A24) 86 : O(3,3)=O(3,3)-(A41*A22*A14+A21*A12*A44+A11*A42*A24) 87 : O(3,4)=-(A11*A22*A43+A21*A42*A13+A41*A12*A23) 88 : O(3,4)=O(3,4)+(A41*A22*A13+A21*A12*A43+A11*A42*A23) 89 : O(4,1)=-(A12*A23*A34+A22*A33*A14+A13*A24*A32) 90 : O(4,1)=O(4,1)+(A32*A23*A14+A22*A13*A34+A12*A33*A24) 91 : O(4,2)=(A11*A23*A34+A21*A33*A14+A31*A13*A24) 92 : O(4,2)=O(4,2)-(A31*A23*A14+A21*A13*A34+A33*A24*A11) 93 : O(4,3)=-(A11*A22*A34+A12*A24*A31+A21*A32*A14) 94 : O(4,3)=O(4,3)+(A31*A22*A14+A32*A24*A11+A21*A12*A34) 95 : O(4,4)=(A11*A22*A33+A21*A32*A13+A31*A12*A23) 96 : O(4,4)=O(4,4)-(A31*A22*A13+A32*A23*A11+A21*A12*A33) 97 : DELTA=A11*O(1,1)+A12*O(1,2)+A13*O(1,3)+A14*O(1,4) 98 : DELTA2=A21*O(2,1)+A22*O(2,2)+A23*O(2,3)+A14*O(2,4) 99 : GOTO 500 100 : 500 CONTINUE 101 : IF (DABS(DELTA).LT.1.D-50) THEN 102 : ICRIT=1 103 : RETURN 104 : ENDIF 105 : DO 600 I=1,NZ 106 : DO 600 J=1,NZ 107 : A(I,J)=O(I,J)/DELTA 108 : 600 CONTINUE 109 : RETURN 110 : END 111 : 112 : 113 :
© Cast3M 2003 - All rights reserved.
Disclaimer