1 : C EQPAR3 SOURCE CHAT 05/01/12 23:44:00 5004 2 : SUBROUTINE EQPAR3(X,A,Y,DETNUL) 3 : C 4 : C resolution d'une equation avec second membre 5 : C dans un espace a 3 dimensions 6 : C 7 : C 8 : C 9 : C 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8 (A-H,O-Z) 12 : REAL*8 A(3,3),X(3),Y(3) 13 : REAL*8 A1(3,3),A2(3,3),A3(3,3) 14 : LOGICAL DETNUL 15 : C 15 : CALL DET3(DETA,A) 16 : C 17 : IF (ABS(DETA).GT.1.D-12) THEN 18 : DETNUL=.FALSE. 19 : C 20 : A1(1,1)=Y(1) 21 : A1(2,1)=Y(2) 22 : A1(3,1)=Y(3) 23 : A1(1,2)=A(1,2) 24 : A1(2,2)=A(2,2) 25 : A1(3,2)=A(3,2) 26 : A1(1,3)=A(1,3) 27 : A1(2,3)=A(2,3) 28 : A1(3,3)=A(3,3) 29 : C 30 : A2(1,1)=A(1,1) 31 : A2(2,1)=A(2,1) 32 : A2(3,1)=A(3,1) 33 : A2(1,2)=Y(1) 34 : A2(2,2)=Y(2) 35 : A2(3,2)=Y(3) 36 : A2(1,3)=A(1,3) 37 : A2(2,3)=A(2,3) 38 : A2(3,3)=A(3,3) 39 : C 40 : A3(1,1)=A(1,1) 41 : A3(2,1)=A(2,1) 42 : A3(3,1)=A(3,1) 43 : A3(1,2)=A(1,2) 44 : A3(2,2)=A(2,2) 45 : A3(3,2)=A(3,2) 46 : A3(1,3)=Y(1) 47 : A3(2,3)=Y(2) 48 : A3(3,3)=Y(3) 49 : C 49 : CALL DET3(DETA1,A1) 49 : CALL DET3(DETA2,A2) 49 : CALL DET3(DETA3,A3) 50 : X(1)=DETA1/DETA 51 : X(2)=DETA2/DETA 52 : X(3)=DETA3/DETA 53 : ELSE 54 : DETNUL=.TRUE. 55 : X(1)=0.D0 56 : X(2)=0.D0 57 : X(3)=0.D0 58 : ENDIF 59 : C 60 : RETURN 61 : END 62 : 63 :
© Cast3M 2003 - All rights reserved.
Disclaimer