This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / freq64.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 DFREQ(X)
12 C
13 #include "gen/imp64.inc"
14 C
15       CHARACTER*(*) NAME
16       PARAMETER(NAME='DFREQ')
17 #endif
18 #if !defined(CERNLIB_DOUBLE)
19       FUNCTION FREQ(X)
20 C
21       CHARACTER*(*) NAME
22       PARAMETER(NAME='FREQ')
23 #endif
24 C
25       DIMENSION P1(0:3),Q1(0:3),P2(0:7),Q2(0:7),P3(0:4),Q3(0:4)
26
27       PARAMETER(Z1 = 1, HF = Z1/2)
28       PARAMETER(C1 = 0.56418 95835 47756 29D0)
29       PARAMETER(W2 = 1.41421 35623 73095 05D0, RW2 = 1/W2)
30
31       DATA (P1(I),Q1(I),I=0,3)
32      +/+2.42667 95523 05317 5D+2, +2.15058 87586 98612 0D+2,
33      1 +2.19792 61618 29415 2D+1, +9.11649 05404 51490 1D+1,
34      2 +6.99638 34886 19135 5D+0, +1.50827 97630 40778 7D+1,
35      3 -3.56098 43701 81538 5D-2, +1/
36
37       DATA (P2(I),Q2(I),I=0,7)
38      +/+3.00459 26102 01616 01D+2, +3.00459 26095 69832 93D+2,
39      1 +4.51918 95371 18729 42D+2, +7.90950 92532 78980 27D+2,
40      2 +3.39320 81673 43436 87D+2, +9.31354 09485 06096 21D+2,
41      3 +1.52989 28504 69404 04D+2, +6.38980 26446 56311 67D+2,
42      4 +4.31622 27222 05673 53D+1, +2.77585 44474 39876 43D+2,
43      5 +7.21175 82508 83093 66D+0, +7.70001 52935 22947 30D+1,
44      6 +5.64195 51747 89739 71D-1, +1.27827 27319 62942 35D+1,
45      7 -1.36864 85738 27167 07D-7, +1/
46
47       DATA (P3(I),Q3(I),I=0,4)
48      +/-2.99610 70770 35421 74D-3, +1.06209 23052 84679 18D-2,
49      1 -4.94730 91062 32507 34D-2, +1.91308 92610 78298 41D-1,
50      2 -2.26956 59353 96869 30D-1, +1.05167 51070 67932 07D+0,
51      3 -2.78661 30860 96477 88D-1, +1.98733 20181 71352 56D+0,
52      4 -2.23192 45973 41846 86D-2, +1/
53
54       V=RW2*ABS(X)
55       IF(V .LT. HF) THEN
56        Y=V**2
57        AP=P1(3)
58        AQ=Q1(3)
59        DO 1 I = 2,0,-1
60        AP=P1(I)+Y*AP
61     1  AQ=Q1(I)+Y*AQ
62        H=V*AP/AQ
63        HC=1-H
64       ELSEIF(V .LT. 4) THEN
65        AP=P2(7)
66        AQ=Q2(7)
67        DO 2 I = 6,0,-1
68        AP=P2(I)+V*AP
69     2  AQ=Q2(I)+V*AQ
70        HC=EXP(-V**2)*AP/AQ
71        H=1-HC
72       ELSE
73        Y=1/V**2
74        AP=P3(4)
75        AQ=Q3(4)
76        DO 3 I = 3,0,-1
77        AP=P3(I)+Y*AP
78     3  AQ=Q3(I)+Y*AQ
79        HC=EXP(-V**2)*(C1+Y*AP/AQ)/V
80        H=1-HC
81       ENDIF
82       IF(X .GT. 0) THEN
83 #if defined(CERNLIB_DOUBLE)
84        DFREQ=HF+HF*H
85       ELSE
86        DFREQ=HF*HC
87 #endif
88 #if !defined(CERNLIB_DOUBLE)
89        FREQ=HF+HF*H
90       ELSE
91        FREQ=HF*HC
92 #endif
93       ENDIF
94       RETURN
95       END