Télécharger racfga.eso

Retour à la liste

Numérotation des lignes :

  1. C RACFGA SOURCE CHAT 05/01/13 02:44:15 5004
  2. C***********************************************************************
  3. C* *
  4. C* PROJET : Opérateur LIMI *
  5. C* NOM : RACFGA *
  6. C* DESCRIPTION : Ce sous programme calcule la valeur du paramètre *
  7. C* gamma intervenant dans une des relations de fermeture *
  8. C* de Cousteix. Le calcul consiste à rechercher la *
  9. C* racine de la relation comprise entre deux bornes *
  10. C* 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 : FONCTIONS FGAMMA *
  17. C* *
  18. C***********************************************************************
  19. C* *
  20. C* ENTREES : UE : -Champ de vitesse extérieure *
  21. C* D1 : -Epaisseur de déplacement *
  22. C* HN : -Facteur de forme *
  23. C* A0 : -Borne inférieure *
  24. C* B0 : -Borne supérieure *
  25. C* *
  26. C* SORTIES : Q : -Racine comprise entre A0 et B0, cad gamma *
  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 RACFGA(UE,D1,HN,Q,A0,B0)
  36. IMPLICIT INTEGER(I-N)
  37. IMPLICIT REAL*8 (A-H,O-Z)
  38. C* *********************************
  39. C* *** Déclaration des variables ***
  40. C* *********************************
  41.  
  42. REAL*8 UE,D1,HN,Q,X
  43. REAL*8 A,A0,B,B0,f1,f2,fx,a1,a2,a3,fg
  44. PARAMETER (eps=1.d-15)
  45.  
  46. C* *********************************
  47. C* ******** Sous-programme *********
  48. C* *********************************
  49.  
  50. A=A0
  51. B=B0
  52.  
  53. C---- Schéma itératif par dichotomie
  54. 50 f1 = fgammb(UE,D1,HN,A)
  55. f2 = fgammb(UE,D1,HN,B)
  56.  
  57. C---- Par dichotomie
  58. X = A+(B-A)/2
  59. fx = fgammb(UE,D1,HN,X)
  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ésultats
  72. 10 Q = X
  73. c Write(6,*) 'La racine est :',Q
  74.  
  75. RETURN
  76. END
  77.  
  78. C* *********************************
  79. C* **** Fin Sous-Programme *******
  80. C* *********************************
  81.  
  82.  
  83.  
  84.  

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