Télécharger equa32.eso

Retour à la liste

Numérotation des lignes :

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

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