Download eqpar3.eso

Back to the list

   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