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.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. *
  29. real*8 x, FFF
  30. real*8 x1, x2, DENOM, AAA, BBB, CCC, DDD
  31. C Modelling constants for phase disappearance
  32. x1 = 0.01D0
  33. x2 = 0.05D0
  34. C x1 = 0.028D0
  35. C x2 = 0.03D0
  36. DENOM = (x1 - x2)**3
  37. AAA = -2.D0*(x1*x2 - 1.D0)/DENOM
  38. BBB = (x1**3 + x1**2*x2 - 3.D0*x1 + 4.D0*x2**2*x1 - 3.D0*x2)
  39. $ /DENOM
  40. CCC = -2.D0*(x1**2 + x1*x2 - 3.D0 + x2**2)*x1*x2/DENOM
  41. DDD = (x2**2*x1 + x1 + x2**3 - 3.D0*x2)*x1**2/DENOM
  42. if (x .LT. x1) then
  43. FFF = x**2
  44. else if (x .GT. x2) then
  45. FFF = 1.D0
  46. else
  47. FFF = AAA*x**3 + BBB*x**2 + CCC*x + DDD
  48. end if
  49. *
  50. * End of subroutine FFF
  51. *
  52. END
  53.  
  54.  
  55.  

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