Sources Esope | Cast3M

eqpar3
C EQPAR3    SOURCE    CHAT      05/01/12    23:44:00     5004
      SUBROUTINE EQPAR3(X,A,Y,DETNUL)
C
C     resolution d'une equation avec second membre
C     dans un espace a 3 dimensions
C
C
C
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 A(3,3),X(3),Y(3)
      REAL*8 A1(3,3),A2(3,3),A3(3,3)
      LOGICAL DETNUL
C
      CALL DET3(DETA,A)
C
      IF (ABS(DETA).GT.1.D-12) THEN
         DETNUL=.FALSE.
C
         A1(1,1)=Y(1)
         A1(2,1)=Y(2)
         A1(3,1)=Y(3)
         A1(1,2)=A(1,2)
         A1(2,2)=A(2,2)
         A1(3,2)=A(3,2)
         A1(1,3)=A(1,3)
         A1(2,3)=A(2,3)
         A1(3,3)=A(3,3)
C
         A2(1,1)=A(1,1)
         A2(2,1)=A(2,1)
         A2(3,1)=A(3,1)
         A2(1,2)=Y(1)
         A2(2,2)=Y(2)
         A2(3,2)=Y(3)
         A2(1,3)=A(1,3)
         A2(2,3)=A(2,3)
         A2(3,3)=A(3,3)
C
         A3(1,1)=A(1,1)
         A3(2,1)=A(2,1)
         A3(3,1)=A(3,1)
         A3(1,2)=A(1,2)
         A3(2,2)=A(2,2)
         A3(3,2)=A(3,2)
         A3(1,3)=Y(1)
         A3(2,3)=Y(2)
         A3(3,3)=Y(3)
C
         CALL DET3(DETA1,A1)
         CALL DET3(DETA2,A2)
         CALL DET3(DETA3,A3)
         X(1)=DETA1/DETA
         X(2)=DETA2/DETA
         X(3)=DETA3/DETA
      ELSE
         DETNUL=.TRUE.
         X(1)=0.D0
         X(2)=0.D0
         X(3)=0.D0
      ENDIF
C
      RETURN
      END