Télécharger equa32.eso

Retour à la liste

Numérotation des lignes :

  1. C EQUA32 SOURCE CHAT 05/01/12 23:44:25 5004
  2. SUBROUTINE EQUA32 (AA,B, X,RESOLU)
  3. ************************************************************************
  4. *
  5. * E Q U A 3 2
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * RESOLUTION D'UN SYSTEME DE 3 EQUATIONS A 2 INCONNUES, DE RANG 2.
  12. *
  13. * AA * X = B
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18. IMPLICIT INTEGER(I-N)
  19. -INC CCOPTIO
  20. -INC CCREEL
  21. *
  22. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  23. * -----------
  24. *
  25. * AA (E) MATRICE 3X2 DU SYSTEME.
  26. * B (E) SECOND MEMBRE DU SYSTEME.
  27. * X (S) 2 INCONNUES DU SYSTEME.
  28. * RESOLU (S) = .TRUE. SI LA RESOLUTION A PU SE FAIRE.
  29. *
  30. REAL*8 AA(3,2),B(3),X(2)
  31. LOGICAL RESOLU
  32. *
  33. * CONSTANTES:
  34. * -----------
  35. *
  36. * IND = BIAIS POUR REPRESENTER UN INDICAGE CIRCULAIRE DE 1 A 3.
  37. * PRECIS = CRITERE DE PRECISION.
  38. *
  39. INTEGER IND(5)
  40. REAL*8 PRECIS
  41. PARAMETER (PRECIS = 1.D-5)
  42. *
  43. * VARIABLES:
  44. * ----------
  45. *
  46. * DET = DETERMINANT 2X2 DE LA MATRICE "AA".
  47. * DETMAX = PLUS GRAND DETERMINANT EN VALEUR ABSOLUE.
  48. *
  49. REAL*8 DET,DETMAX,VERIF,B3,A1,A2
  50. *
  51. * AUTEUR, DATE DE CREATION:
  52. * -------------------------
  53. *
  54. * PASCAL MANIGOT 18 NOVEMBRE 1987
  55. *
  56. * LANGAGE:
  57. * --------
  58. *
  59. * FORTRAN77
  60. *
  61. ************************************************************************
  62. *
  63. DATA IND/1,2,3,1,2/
  64. *
  65. I=1
  66. DETMAX = 0.D0
  67. DO 100 IB=1,3
  68. DET = AA(IND(IB),1) * AA(IND(IB+1),2)
  69. & - AA(IND(IB+1),1) * AA(IND(IB),2)
  70. IF (ABS(DET) .GT. ABS(DETMAX) ) THEN
  71. DETMAX = DET
  72. I = IB
  73. END IF
  74. 100 CONTINUE
  75. * END DO
  76. *
  77. * ON RESOUT EN PRENANT LES 2 EQUATIONS CORRESPONDANT AU PLUS GRAND
  78. * DETERMINANT.
  79. *
  80. X(1) = ( B(IND(I)) * AA(IND(I+1),2)
  81. & - B(IND(I+1)) * AA(IND(I),2) ) / DETMAX
  82. X(2) = ( AA(IND(I),1) * B(IND(I+1))
  83. & - AA(IND(I+1),1) * B(IND(I)) ) / DETMAX
  84. *
  85. * ON VERIFIE LA 3EME EQUATION
  86. *
  87. A1 = AA(IND(I+2),1) * X(1)
  88. A2 = AA(IND(I+2),2) * X(2)
  89. VERIF = A1 + A2
  90. B3 = B(IND(I+2))
  91. IF (IIMPI .EQ. 732) THEN
  92. WRITE (IOIMP,*) 'VERIF,B3,A1,A2'
  93. WRITE (IOIMP,*) VERIF,B3,A1,A2
  94. END IF
  95. *
  96. IF (ABS(B3) .LT. XPETIT) THEN
  97. A1 = ABS(A1)
  98. A2 = ABS(A2)
  99. B3 = MAX(A1,A2) * PRECIS
  100. RESOLU = ABS(VERIF) .LE. B3
  101. ELSE
  102. VERIF = (VERIF - B3) / B3
  103. RESOLU = ABS(VERIF) .LE. PRECIS
  104. END IF
  105. IF (IIMPI .EQ. 732) THEN
  106. WRITE (IOIMP,*) 'VERIF'
  107. WRITE (IOIMP,*) VERIF
  108. END IF
  109. *
  110. END
  111.  
  112.  
  113.  
  114.  

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