home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / RAN3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.6 KB  |  59 lines
  1. FUNCTION ran3(VAR idum: integer): real;
  2. (* Programs using RAN3 must declare the following variables
  3. VAR
  4.    glinext,glinextp: integer;
  5.    glma: ARRAY [1..55] OF real;
  6. in the main routine. Machines with 4-byte integers can use the integer
  7. implementation of this routine, substituting glma of type integer, the
  8. commented CONST and VAR declarations, and the MOD function in the third
  9. line after the BEGIN. *)
  10. (* CONST
  11.    mbig=1000000000;
  12.    mseed=161803398;
  13.    mz=0;
  14.    fac=1.0e-9;
  15. VAR
  16.    i,ii,k,mj,mk: integer; *)
  17. CONST
  18.    mbig=4.0e6;
  19.    mseed=1618033.0;
  20.    mz=0.0;
  21.    fac=2.5e-7; (* 1/mbig *)
  22. VAR
  23.    i,ii,k: integer;
  24.    mj,mk: real;
  25. BEGIN
  26.    IF (idum < 0) THEN BEGIN
  27.       mj := mseed+idum;
  28.       (* The following IF block is mj := mj MOD mbig; for real variables. *)
  29.       IF mj>=0.0 THEN mj := mj-mbig*trunc(mj/mbig)
  30.          ELSE mj := mbig-abs(mj)+mbig*trunc(abs(mj)/mbig);
  31.       glma[55] := mj;
  32.       mk := 1;
  33.       FOR i := 1 TO 54 DO BEGIN
  34.          ii := 21*i MOD 55;
  35.          glma[ii] := mk;
  36.          mk := mj-mk;
  37.          IF (mk < mz) THEN mk := mk+mbig;
  38.          mj := glma[ii]
  39.       END;
  40.       FOR k := 1 TO 4 DO BEGIN
  41.          FOR i := 1 TO 55 DO BEGIN
  42.             glma[i] := glma[i]-glma[1+((i+30) MOD 55)];
  43.             IF (glma[i] < mz) THEN glma[i] := glma[i]+mbig
  44.          END
  45.       END;
  46.       glinext := 0;
  47.       glinextp := 31;
  48.       idum := 1
  49.    END;
  50.    glinext := glinext+1;
  51.    IF (glinext = 56) THEN glinext := 1;
  52.    glinextp := glinextp+1;
  53.    IF (glinextp = 56) THEN glinextp := 1;
  54.    mj := glma[glinext]-glma[glinextp];
  55.    IF (mj < mz) THEN mj := mj+mbig;
  56.    glma[glinext] := mj;
  57.    ran3 := mj*fac
  58. END;
  59.