DOUBLE PRECISION FUNCTION dinvnr(p,q) C********************************************************************** C C DOUBLE PRECISION FUNCTION DINVNR(P,Q) C Double precision NoRmal distribution INVerse C C C Function C C C Returns X such that CUMNOR(X) = P, i.e., the integral from - C infinity to X of (1/SQRT(2*PI)) EXP(-U*U/2) dU is P C C C Arguments C C C P --> The probability whose normal deviate is sought. C P is DOUBLE PRECISION C C Q --> 1-P C P is DOUBLE PRECISION C C C Method C C C The rational function on page 95 of Kennedy and Gentle, C Statistical Computing, Marcel Dekker, NY , 1980 is used as a start C value for the Newton method of finding roots. C C C Note C C C If P or Q .lt. machine EPS returns +/- DINVNR(EPS) C C********************************************************************** C .. Parameters .. INTEGER maxit PARAMETER (maxit=100) DOUBLE PRECISION eps PARAMETER (eps=1.0D-13) DOUBLE PRECISION r2pi PARAMETER (r2pi=0.3989422804014326D0) DOUBLE PRECISION nhalf PARAMETER (nhalf=-0.5D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION p,q C .. C .. Local Scalars .. DOUBLE PRECISION strtx,xcur,cum,ccum,pp,dx INTEGER i LOGICAL qporq C .. C .. External Functions .. DOUBLE PRECISION stvaln EXTERNAL stvaln C .. C .. External Subroutines .. EXTERNAL cumnor C .. C .. Statement Functions .. DOUBLE PRECISION dennor,x dennor(x) = r2pi*exp(nhalf*x*x) C .. C .. Executable Statements .. C C FIND MINIMUM OF P AND Q C qporq = p .LE. q IF (.NOT. (qporq)) GO TO 10 pp = p GO TO 20 10 pp = q C C INITIALIZATION STEP C 20 strtx = stvaln(pp) xcur = strtx C C NEWTON ITERATIONS C DO 30,i = 1,maxit CALL cumnor(xcur,cum,ccum) dx = (cum-pp)/dennor(xcur) xcur = xcur - dx IF (abs(dx/xcur).LT.eps) GO TO 40 30 CONTINUE dinvnr = strtx C C IF WE GET HERE, NEWTON HAS FAILED C IF (.NOT.qporq) dinvnr = -dinvnr RETURN C C IF WE GET HERE, NEWTON HAS SUCCEEDED C 40 dinvnr = xcur IF (.NOT.qporq) dinvnr = -dinvnr RETURN END