| 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 |