1 |
C $Header$ |
2 |
C $Name$ |
3 |
|
4 |
c Inverse normal distribution |
5 |
c returns inverse normal cumulative distribution |
6 |
c from p:[0,1] -> y:[-inf,+inf] centered on mu with stdev of sigma |
7 |
c p is RandNo passed in, y is return variable for deviate |
8 |
c |
9 |
c Scott Grant, Spring 2006 |
10 |
|
11 |
SUBROUTINE invnormal(y,p,mean,sigma) |
12 |
implicit none |
13 |
|
14 |
c local variables |
15 |
real*8 mean |
16 |
real*8 sigma |
17 |
real*8 q |
18 |
real*8 r |
19 |
real*8 x |
20 |
real*8 p |
21 |
real*8 plow |
22 |
real*8 phigh |
23 |
real*8 y |
24 |
real*8 a(6) |
25 |
real*8 b(5) |
26 |
real*8 c(6) |
27 |
real*8 d(4) |
28 |
|
29 |
|
30 |
c Create random variable from -inf to +inf |
31 |
c Coefficients in rational approximations. |
32 |
a(1) = -3.969683028665376d+01 |
33 |
a(2) = 2.209460984245205d+02 |
34 |
a(3) = -2.759285104469687d+02 |
35 |
a(4) = 1.383577518672690d+02 |
36 |
a(5) = -3.066479806614716d+01 |
37 |
a(6) = 2.506628277459239d+00 |
38 |
|
39 |
b(1) = -5.447609879822406d+01 |
40 |
b(2) = 1.615858368580409d+02 |
41 |
b(3) = -1.556989798598866d+02 |
42 |
b(4) = 6.680131188771972d+01 |
43 |
b(5) = -1.328068155288572d+01 |
44 |
|
45 |
c(1) = -7.784894002430293d-03 |
46 |
c(2) = -3.223964580411365d-01 |
47 |
c(3) = -2.400758277161838d+00 |
48 |
c(4) = -2.549732539343734d+00 |
49 |
c(5) = 4.374664141464968d+00 |
50 |
c(6) = 2.938163982698783d+00 |
51 |
|
52 |
d(1) = 7.784695709041462d-03 |
53 |
d(2) = 3.224671290700398d-01 |
54 |
d(3) = 2.445134137142996d+00 |
55 |
d(4) = 3.754408661907416d+00 |
56 |
|
57 |
c Define break-points. |
58 |
|
59 |
plow = 0.02425d0 |
60 |
phigh = 1.d0 - plow |
61 |
|
62 |
c Rational approximation for lower region. |
63 |
|
64 |
if ((0.d0 .lt. p) .and. (p .lt. plow))then |
65 |
q = sqrt(-2.0d0*log(p)) |
66 |
x = (((((c(1)*q+c(2))*q+c(3))*q+c(4))*q+c(5))*q+c(6)) / |
67 |
& ((((d(1)*q+d(2))*q+d(3))*q+d(4))*q+1.d0) |
68 |
endif |
69 |
|
70 |
c Rational approximation for central region. |
71 |
|
72 |
if ((plow .le. p).and.(p .le. phigh))then |
73 |
q = p - 0.5d0 |
74 |
r = q*q |
75 |
x = (((((a(1)*r+a(2))*r+a(3))*r+a(4))*r+a(5))*r+a(6))*q / |
76 |
& (((((b(1)*r+b(2))*r+b(3))*r+b(4))*r+b(5))*r+1.d0) |
77 |
endif |
78 |
|
79 |
c Rational approximation for upper region. |
80 |
|
81 |
if ((phigh .lt. p).and.(p .lt. 1.d0))then |
82 |
q = sqrt(-2.0d0*log(1.d0-p)) |
83 |
x = -(((((c(1)*q+c(2))*q+c(3))*q+c(4))*q+c(5))*q+c(6)) / |
84 |
& ((((d(1)*q+d(2))*q+d(3))*q+d(4))*q+1.d0) |
85 |
endif |
86 |
|
87 |
c Normal Deviate about mean |
88 |
c write(6,*)'DEVIATE',x |
89 |
y = sigma*sqrt(2.0d0)*x + mean |
90 |
c write(6,*)'Normal PDF Value INSIDE:',y |
91 |
c write(6,*)'MEAN:',mean |
92 |
c write(6,*)'SIGMA:',sigma |
93 |
|
94 |
|
95 |
return |
96 |
end |