MINICERN/mathlib/gen/g/gausin.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:42  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_DOUBLE)
  11       FUNCTION GAUSIN(P)
  12
  13 C     Computes a "Normal Deviate"
  14 C     Based on G.W. Hill & A.W. Davis, Algorithm 442 Normal Deviate
  15 C     Collected Algorithms from CACM
  16
  17       CHARACTER NAME*(*)
  18       CHARACTER*80 ERRTXT
  19       PARAMETER (NAME = 'GAUSIN')
  20       PARAMETER (C = 2.50662 827)
  21
  22       IF(P .LE. 0 .OR. P .GE. 1) THEN
  23        H=0
  24        WRITE(ERRTXT,101) P
  25        CALL MTLPRT(NAME,'G105.1',ERRTXT)
  26       ELSEIF(P .EQ. 0.5) THEN
  27        H=0
  28       ELSE
  29        X=P
  30        IF(P .GT. 0.5) X=1-P
  31        X=SQRT(-2*LOG(X))
  32        X=X-((7.45551*X+450.636)*X+1271.059)/
  33      1     (((X+110.4212)*X+750.365)*X+500.756)
  34        IF(P .LT. 0.5) X=-X
  35        H=C*(P-FREQ(X))*EXP(0.5*X**2)+X
  36       ENDIF
  37       GAUSIN=H
  38       RETURN
  39   101 FORMAT('ARGUMENT P =',1P,E15.5,' NOT IN RANGE')
  40       END
  41 #endif