MINICERN/mathlib/gen/c/freq.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:01:53  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_DOUBLE)
  11       FUNCTION FREQ(X)
  12
  13       DIMENSION P2(0:4),Q2(0:4)
  14
  15       PARAMETER(Z1 = 1, HF = Z1/2)
  16       PARAMETER(C1 = 0.56418 958, W2 = 1.41421 356, RW2 = 1/W2)
  17
  18       DATA P10,Q10,P11 /+3.67678 77, +3.25845 93, -9.79704 65E-2/
  19
  20       DATA (P2(I),Q2(I),I=0,4)
  21      +/+7.37388 83E+0, +7.37396 09E+0, +6.86501 85E+0, +1.51849 08E+1,
  22      1 +3.03179 93E+0, +1.27955 30E+1, +5.63169 62E-1, +5.35421 68E+0,
  23      2 +4.31877 87E-5, +1/
  24
  25       DATA P30,Q30,P31 /-1.24368 54E-1, +4.40917 06E-1, -9.68210 36E-2/
  26
  27       V=RW2*ABS(X)
  28       IF(V .LT. HF) THEN
  29        Y=V**2
  30        H=V*(P10+P11*Y)/(Q10+Y)
  31        HC=1-H
  32       ELSEIF(V .LT. 4) THEN
  33        AP=P2(4)
  34        AQ=Q2(4)
  35        DO 2 I = 3,0,-1
  36        AP=P2(I)+V*AP
  37     2  AQ=Q2(I)+V*AQ
  38        HC=EXP(-V**2)*AP/AQ
  39        H=1-HC
  40       ELSE
  41        Y=1/V**2
  42        HC=EXP(-V**2)*(C1+Y*(P30+P31*Y)/(Q30+Y))/V
  43        H=1-HC
  44       ENDIF
  45       IF(X .GT. 0) THEN
  46        FREQ=HF+HF*H
  47       ELSE
  48        FREQ=HF*HC
  49       ENDIF
  50       RETURN
  51       END
  52 #endif