Esope source files

   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 :