Télécharger funcf.eso

Retour à la liste

Numérotation des lignes :

  1. C FUNCF SOURCE BECC 05/12/02 21:15:24 5258
  2. SUBROUTINE FUNCF(x, FFF)
  3. C***********************************************************************
  4. C NOM : FFF
  5. C DESCRIPTION :
  6. C
  7. C
  8. C
  9. C LANGAGE : ESOPE
  10. C AUTEUR : Jose R. Garcia-Cascales,
  11. C Universidad Politecnica de Cartagena,
  12. C jr.garcia@upct.es
  13. C
  14. C***********************************************************************
  15. C APPELE PAR : pr12f.eso
  16. C***********************************************************************
  17. C SYNTAXE GIBIANE :
  18. C ENTREES :
  19. C ENTREES/SORTIES :
  20. C SORTIES :
  21. C***********************************************************************
  22. C VERSION : v1, 08/03/01, version initiale
  23. C vf, 20/11/05
  24. C***********************************************************************
  25. -INC CCOPTIO
  26. *
  27. real*8 x, FFF
  28. real*8 x1, x2, DENOM, AAA, BBB, CCC, DDD
  29. C Modelling constants for phase disappearance
  30. x1 = 0.01D0
  31. x2 = 0.05D0
  32. C x1 = 0.028D0
  33. C x2 = 0.03D0
  34. DENOM = (x1 - x2)**3
  35. AAA = -2.D0*(x1*x2 - 1.D0)/DENOM
  36. BBB = (x1**3 + x1**2*x2 - 3.D0*x1 + 4.D0*x2**2*x1 - 3.D0*x2)
  37. $ /DENOM
  38. CCC = -2.D0*(x1**2 + x1*x2 - 3.D0 + x2**2)*x1*x2/DENOM
  39. DDD = (x2**2*x1 + x1 + x2**3 - 3.D0*x2)*x1**2/DENOM
  40. if (x .LT. x1) then
  41. FFF = x**2
  42. else if (x .GT. x2) then
  43. FFF = 1.D0
  44. else
  45. FFF = AAA*x**3 + BBB*x**2 + CCC*x + DDD
  46. end if
  47. *
  48. * End of subroutine FFF
  49. *
  50. END
  51.  
  52.  
  53.  

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