MINICERN/mathlib/gen/v/norranux.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:53  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_UNIX)||defined(CERNLIB_QMALPH)
  11       FUNCTION NORRAN ( RN )
  12 C
  13 C     FORTRAN version for Alliant of CERN library routine NORRAN
  14 C     (entry V101) for the generation of standard normal pseudo-
  15 C     random numbers.                             / Ch.Walck 880407
  16 C
  17 C     Calling sequences:
  18 C     R = UNI ( DUMMY )              Continuous uniform r.n. 0 TO 1
  19 C     R = VNI ( DUMMY )              Continuous uniform r.n. -1 to 1
  20 C     CALL NORRAN ( R )              Standard normal r.n.
  21 C     CALL NORRIN ( ISEED1, ISEED2 ) Initialize seeds
  22 C     CALL NORRUT ( ISEED1, ISEED2 ) Access seeds
  23 C
  24       SAVE MCGN, SRGN, TBL
  25       PARAMETER ( M20=2**20-1, M24=2**24-1, XM24=2.0**(-24)
  26      +          , XM28=2.0**(-28) )
  27       DIMENSION TBL(0:326)
  28       INTEGER R0, R1, R2, SEED1, SEED2, SIGN, SRGN
  29       EQUIVALENCE (MAN,XMAN)
  30       DATA TBL/   0.0000,   0.0625, 2*0.1250, 4*0.1875, 5*0.2500
  31      +        ,   0.5625, 5*0.6250, 3*0.8750,   1.1250,   1.4375
  32      +        , 5*0.0000, 5*0.0625, 4*0.1250, 2*0.1875,   0.2500
  33      +        , 5*0.3125, 5*0.3750, 5*0.4375, 5*0.5000, 4*0.5625
  34      +        , 4*0.6875, 4*0.7500, 4*0.8125,   0.8750, 3*0.9375
  35      +        , 3*1.0000, 3*1.0625, 2*1.1250, 2*1.1875, 2*1.2500
  36      +        , 2*1.3125, 2*1.3750,   1.4375,   1.5000,   1.5625
  37      +        ,   1.6250,   1.6875,   1.7500,   1.8125,10*0.3125
  38      +        , 7*0.3750, 5*0.4375, 2*0.5000, 9*0.6875, 5*0.7500
  39      +        ,   0.8125,10*0.9375, 7*1.0000, 3*1.0625,12*1.1875
  40      +        , 9*1.2500, 5*1.3125, 2*1.3750,13*1.5000,10*1.5625
  41      +        , 7*1.6250, 5*1.6875, 2*1.7500,15*1.8750,13*1.9375
  42      +        ,12*2.0000,10*2.0625, 9*2.1250, 8*2.1875, 7*2.2500
  43      +        , 6*2.3125, 5*2.3750, 4*2.4375, 3*2.5000, 3*2.5625
  44      +        , 2*2.6250, 2*2.6875 /
  45       DATA MCGN/12345/, SRGN/1073/
  46 C
  47       R0   = IEOR ( ISHFT(SRGN,-15), SRGN )
  48       R1   = ISHFT(R0,17)
  49       SRGN = IEOR(R0,R1)
  50       MCGN = 69069 * MCGN
  51       R2   = IEOR(SRGN,MCGN)
  52       R0   = ISHFT(R2,-24)
  53       IF ( R0 .GE. 104 ) GO TO 2
  54       MAN  = IAND(R2,M24)
  55       XMAN = MAN
  56       IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
  57       RN   = XM28 * XMAN + TBL(R0)
  58       RETURN
  59 C
  60     2 IF ( R0 .GE. 208 ) GO TO 3
  61       R0   = R0 - 104
  62       MAN  = IAND(R2,M24)
  63       XMAN = MAN
  64       IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
  65       RN   = - ( XM28 * XMAN + TBL(R0) )
  66       RETURN
  67 C
  68     3 R0   = ISHFT(R2,-20)
  69       IF ( R0 .GE. 3631 ) GO TO 4
  70       R0   = R0 - 3304
  71       MAN  = ISHFT ( IAND(R2,M20), 4 )
  72       XMAN = MAN
  73       IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
  74       RN   = XM28 * XMAN + TBL(R0)
  75       RETURN
  76 C
  77     4 IF ( R0 .GE. 3934 ) GO TO 5
  78       R0   = R0 - 3607
  79       MAN  = ISHFT ( IAND(R2,M20), 4 )
  80       XMAN = MAN
  81       IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
  82       RN   = - ( XM28 * XMAN + TBL(R0) )
  83       RETURN
  84 C
  85     5 RN   = RNORTH ( R2 )
  86       RETURN
  87 C
  88 C     UNI entry for RNORTH
  89 C
  90       ENTRY UNI ( DUMMY )
  91       R0   = IEOR ( ISHFT(SRGN,-15), SRGN )
  92       R1   = ISHFT ( R0 , 17 )
  93       SRGN = IEOR ( R0 ,R1 )
  94       MCGN = 69069 * MCGN
  95       MAN  = ISHFT ( IEOR ( SRGN, MCGN ) , -8 )
  96       XMAN = MAN
  97       IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
  98       UNI = XM24 * XMAN
  99       RETURN
 100 C
 101 C     Uniform number between -1 and 1 for RNORTH
 102 C
 103       ENTRY VNI ( DUMMY )
 104       R0   = IEOR ( ISHFT(SRGN,-15), SRGN )
 105       R1   = ISHFT ( R0 , 17 )
 106       SRGN = IEOR ( R0 ,R1 )
 107       MCGN = 69069 * MCGN
 108       R2   = IEOR ( SRGN, MCGN )
 109       MAN  = IAND ( ISHFT ( R2, -7 ), M24 )
 110       SIGN = ISHFT ( R2, -31 )
 111       SIGN = 1 - 2 * SIGN
 112       XMAN = MAN
 113       IF ( XMAN .EQ. 0.0 ) XMAN = 0.5
 114       VNI = SIGN * XM24 * XMAN
 115       RETURN
 116 C
 117 C     Set seeds
 118 C
 119       ENTRY NORRIN ( SEED1, SEED2 )
 120       MCGN   = SEED1
 121       SRGN   = SEED2
 122       NORRIN = 0
 123       RETURN
 124 C
 125 C     Get seeds
 126 C
 127       ENTRY NORRUT ( SEED1, SEED2 )
 128       SEED1  = MCGN
 129       SEED2  = SRGN
 130       NORRUT = 0
 131       RETURN
 132       END
 133 #endif