GNU Octave: libcruft/ranlib/ignlgi.f Source File

Go to the documentation of this file.
00001       INTEGER FUNCTION ignlgi()
00002 C**********************************************************************
00003 C
00004 C     INTEGER FUNCTION IGNLGI()
00005 C               GeNerate LarGe Integer
00006 C
00007 C     Returns a random integer following a uniform distribution over
00008 C     (1, 2147483562) using the current generator.
00009 C
00010 C     This is a transcription from Pascal to Fortran of routine
00011 C     Random from the paper
00012 C
00013 C     L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
00014 C     with Splitting Facilities." ACM Transactions on Mathematical
00015 C     Software, 17:98-111 (1991)
00016 C
00017 C**********************************************************************
00018 C     .. Parameters ..
00019       INTEGER numg
00020       PARAMETER (numg=32)
00021 C     ..
00022 C     .. Scalars in Common ..
00023       INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
00024 C     ..
00025 C     .. Arrays in Common ..
00026       INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
00027      +        lg2(numg)
00028       LOGICAL qanti(numg)
00029 C     ..
00030 C     .. Local Scalars ..
00031       INTEGER curntg,k,s1,s2,z
00032       LOGICAL qqssd
00033 C     ..
00034 C     .. External Functions ..
00035       LOGICAL qrgnin
00036       EXTERNAL qrgnin
00037 C     ..
00038 C     .. External Subroutines ..
00039       EXTERNAL getcgn,inrgcm,rgnqsd,setall
00040 C     ..
00041 C     .. Common blocks ..
00042       COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
00043      +       cg2,qanti
00044 C     ..
00045 C     .. Save statement ..
00046       SAVE /globe/
00047 C     ..
00048 C     .. Executable Statements ..
00049 C
00050 C     IF THE RANDOM NUMBER PACKAGE HAS NOT BEEN INITIALIZED YET, DO SO.
00051 C     IT CAN BE INITIALIZED IN ONE OF TWO WAYS : 1) THE FIRST CALL TO
00052 C     THIS ROUTINE  2) A CALL TO SETALL.
00053 C
00054       IF (.NOT. (qrgnin())) CALL inrgcm()
00055       CALL rgnqsd(qqssd)
00056       IF (.NOT. (qqssd)) CALL setall(1234567890,123456789)
00057 C
00058 C     Get Current Generator
00059 C
00060       CALL getcgn(curntg)
00061       s1 = cg1(curntg)
00062       s2 = cg2(curntg)
00063       k = s1/53668
00064       s1 = a1* (s1-k*53668) - k*12211
00065       IF (s1.LT.0) s1 = s1 + m1
00066       k = s2/52774
00067       s2 = a2* (s2-k*52774) - k*3791
00068       IF (s2.LT.0) s2 = s2 + m2
00069       cg1(curntg) = s1
00070       cg2(curntg) = s2
00071       z = s1 - s2
00072       IF (z.LT.1) z = z + m1 - 1
00073       IF (qanti(curntg)) z = m1 - z
00074       ignlgi = z
00075       RETURN
00076 
00077       END