C....*...1.........2.........3.........4.........5.........6.........7.* REAL*8 FUNCTION DUNSK(IXX) C GENERATES NORMAL(0,1) RV'S USING KNUTH'S (V.2,2ND ED P125-7) VERSION C OF KINDERMAN-MONAHAN RATIO OF UNIFORMS (ACMTOMS,1977,P257-60) METHOD C MODIFIED 5/24/91 BY A R GALLANT TO SET SEED DIFFERENTLY C MODIFIED 12/27/92 BY A R GALLANT TO A REAL*8 FUNCTION implicit real*4 (a-h,o-z) implicit integer*4 (i-n) save DATA A/1.7155277/,B/5.136101667/,C/1.036961/ 1 U=zran(IXX) C A=SQRT(8/E) V=zran(IXX) UNSK=A*(V-0.5)/U ZZ=UNSK*UNSK C B=4*EXP(1/4) dunsk=unsk IF(ZZ.LE.5.-B*U) RETURN C THIS IS KNUTH'S QUICK REJECT TEST, C=4*EXP(-1.35) IF(ZZ.GE.C/U+1.4) GO TO 1 IF(ZZ.LE.-4.*ALOG(U)) RETURN GO TO 1 END REAL FUNCTION zran(IX) C UNIFORM PSEUDORANDOM NUMBER GENERATOR C FORTRAN VERSION OF LEWIS, GOODMAN, MILLER C SCHRAGE, ACM TOMS V.5 (1979) P132 C MODIFIED 1/24/90 BY A R GALLANT TO SET SEED DIFFERENTLY implicit real*4 (a-h,o-z) implicit integer*4 (i-n) save INTEGER*4 A,P,IX,B15,B16,XHI,XALO,LEFTLO,FHI,K DATA A/16807/,B15/32768/,B16/65536/,P/2147483647/ XHI=IX/B16 XALO=(IX-XHI*B16)*A LEFTLO=XALO/B16 FHI=XHI*A+LEFTLO K=FHI/B15 IX=(((XALO-LEFTLO*B16)-P)+(FHI-K*B15)*B16)+K IF(IX.LT.0) IX=IX+P zran=FLOAT(IX)*4.656612875E-10 RETURN END