Télécharger lebal2.eso

Retour à la liste

Numérotation des lignes :

  1. C LEBAL2 SOURCE PV 07/11/23 21:17:41 5978
  2. C***********************************************************************
  3. C* *
  4. C* PROJET : Opérateur LIMI *
  5. C* NOM : lEBAl2 *
  6. C* DESCRIPTION : Ce sous programme calcule la valeur du facteur de *
  7. C* forme H à partir de la valeur de H*, en utilisant *
  8. C* la formule de Le Balleur. Le calcul consiste à *
  9. C* rechercher la racine de la relation comprise entre *
  10. C* entre deux bornes par la méthode de dichotomie *
  11. C* LANGAGE : Esope *
  12. C* AUTEUR : Guillaume VENCO - DRN/DMT/SEMT/LTMF *
  13. C* *
  14. C***********************************************************************
  15. C* *
  16. C* APPELES : Aucun *
  17. C* *
  18. C***********************************************************************
  19. C* *
  20. C* ENTREES : HH : -Facteur H* *
  21. C* beta: -Coefficient intervenant dans la formule de *
  22. C* Le Balleur *
  23. C* A0 : -Borne inférieure *
  24. C* B0 : -Borne supérieure *
  25. C* *
  26. C* SORTIES : Q : -Racine comprise entre A0 et B0, Facteur H *
  27. C* *
  28. C***********************************************************************
  29. C* *
  30. C* VERSION : 15/05/2000 *
  31. C* CREATION : 21/04/2000 *
  32. C* *
  33. C***********************************************************************
  34.  
  35. SUBROUTINE LEBAL2(HH,BETA,Q,A0,B0)
  36. IMPLICIT INTEGER(I-N)
  37. IMPLICIT REAL*8 (a-h,o-z)
  38.  
  39. C* *********************************
  40. C* *** Déclaration des variables ***
  41. C* *********************************
  42.  
  43. REAL*8 HH,beta,Q,X
  44. REAL*8 A,A0,B,B0,f1,f2,fx
  45. PARAMETER (eps=1.d-15)
  46.  
  47. C* *********************************
  48. C* ******** Sous-programme *********
  49. C* *********************************
  50.  
  51. A=A0
  52. B=B0
  53.  
  54. C---- Schéma itératif par dichotomie
  55. 50 f1 = beta*(A**2)+(1-HH)*A+HH
  56. f2 = beta*(B**2)+(1-HH)*B+HH
  57.  
  58. X = A+(B-A)/2
  59. fx = beta*(X**2)+(1-HH)*X+HH
  60. IF (fx.EQ.0) GOTO 10
  61. IF ((fx*f1).GT.0) GOTO 20
  62. B = X
  63. GOTO 30
  64.  
  65. 20 A = X
  66. GOTO 30
  67.  
  68. 30 IF(ABS(B-A).LE.eps) GOTO 10
  69. GOTO 50
  70.  
  71. C---- Résultat
  72. 10 Q = X
  73. c Write(6,*) 'La racine est :',Q
  74.  
  75. RETURN
  76.  
  77. END
  78.  
  79. C* *********************************
  80. C* **** Fin Sous-Programme *******
  81. C* *********************************
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  

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