Télécharger eqpar3.eso

Retour à la liste

Numérotation des lignes :

  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
  16. CALL DET3(DETA,A)
  17. C
  18. IF (ABS(DETA).GT.1.D-12) THEN
  19. DETNUL=.FALSE.
  20. C
  21. A1(1,1)=Y(1)
  22. A1(2,1)=Y(2)
  23. A1(3,1)=Y(3)
  24. A1(1,2)=A(1,2)
  25. A1(2,2)=A(2,2)
  26. A1(3,2)=A(3,2)
  27. A1(1,3)=A(1,3)
  28. A1(2,3)=A(2,3)
  29. A1(3,3)=A(3,3)
  30. C
  31. A2(1,1)=A(1,1)
  32. A2(2,1)=A(2,1)
  33. A2(3,1)=A(3,1)
  34. A2(1,2)=Y(1)
  35. A2(2,2)=Y(2)
  36. A2(3,2)=Y(3)
  37. A2(1,3)=A(1,3)
  38. A2(2,3)=A(2,3)
  39. A2(3,3)=A(3,3)
  40. C
  41. A3(1,1)=A(1,1)
  42. A3(2,1)=A(2,1)
  43. A3(3,1)=A(3,1)
  44. A3(1,2)=A(1,2)
  45. A3(2,2)=A(2,2)
  46. A3(3,2)=A(3,2)
  47. A3(1,3)=Y(1)
  48. A3(2,3)=Y(2)
  49. A3(3,3)=Y(3)
  50. C
  51. CALL DET3(DETA1,A1)
  52. CALL DET3(DETA2,A2)
  53. CALL DET3(DETA3,A3)
  54. X(1)=DETA1/DETA
  55. X(2)=DETA2/DETA
  56. X(3)=DETA3/DETA
  57. ELSE
  58. DETNUL=.TRUE.
  59. X(1)=0.D0
  60. X(2)=0.D0
  61. X(3)=0.D0
  62. ENDIF
  63. C
  64. RETURN
  65. END
  66.  
  67.  
  68.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales