This commit was generated by cvs2svn to compensate for changes in r2,

[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / g / gausin64.F

diff --git a/MINICERN/mathlib/gen/g/gausin64.F b/MINICERN/mathlib/gen/g/gausin64.F
new file mode 100644 (file)
index 0000000..006ec1c
--- /dev/null
+++ b/MINICERN/mathlib/gen/g/gausin64.F
@@ -0,0 +1,64 @@
+*
+* $Id$
+*
+* $Log$
+* Revision 1.1.1.1  1996/04/01 15:02:43  mclareni
+* Mathlib gen
+*
+*
+#include "gen/pilot.h"
+#if !defined(CERNLIB_DOUBLE)
+      FUNCTION  GAUSIN(P)
+#endif
+#if defined(CERNLIB_DOUBLE)
+      FUNCTION DGAUSN(P)
+#include "gen/imp64.inc"
+#endif
+C     Computes a "Normal Deviate"
+C     Based on G.W. Hill & A.W. Davis, Algorithm 442 Normal Deviate
+C     Collected Algorithms from CACM
+
+      CHARACTER NAME*(*)
+      CHARACTER*80 ERRTXT
+#if !defined(CERNLIB_DOUBLE)
+      PARAMETER (NAME = 'GAUSIN')
+#endif
+#if defined(CERNLIB_DOUBLE)
+      PARAMETER (NAME = 'DGAUSN')
+#endif
+
+      PARAMETER (C = 2.50662 82746 31000 50D0)
+      PARAMETER (Z1 = 1, HF = Z1/2, C1 = 3*Z1/4, C2 = 7*Z1/8, C3 = Z1/3)
+
+      IF(P .LE. 0 .OR. P .GE. 1) THEN
+       H=0
+       WRITE(ERRTXT,101) P
+       CALL MTLPRT(NAME,'G105.1',ERRTXT)
+      ELSEIF(P .EQ. HF) THEN
+       H=0
+      ELSE
+       X=P
+       IF(P .GT. HF) X=1-P
+       X=SQRT(-2*LOG(X))
+       X=X-((7.47395*X+494.877)*X+1637.720)/
+     1     (((X+117.9407)*X+908.401)*X+659.935)
+       IF(P .LT. HF) X=-X
+       S=X**2
+#if !defined(CERNLIB_DOUBLE)
+       Z=C*(P-FREQ(X))*EXP(HF*S)
+#endif
+#if defined(CERNLIB_DOUBLE)
+       Z=C*(P-DFREQ(X))*EXP(HF*S)
+#endif
+       H=(((((C1*S+C2)*Z+X)*X+HF)*C3*Z+HF*X)*Z+1)*Z+X
+      ENDIF
+#if !defined(CERNLIB_DOUBLE)
+       GAUSIN=H
+#endif
+#if defined(CERNLIB_DOUBLE)
+      DGAUSN=H
+#endif
+      RETURN
+  101 FORMAT('ARGUMENT P =',1P,D15.8,' NOT IN RANGE')
+      END
+