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

Go to the documentation of this file.
00001       INTEGER FUNCTION ignuin(low,high)
00002 C**********************************************************************
00003 C
00004 C     INTEGER FUNCTION IGNUIN( LOW, HIGH )
00005 C
00006 C               GeNerate Uniform INteger
00007 C
00008 C
00009 C                              Function
00010 C
00011 C
00012 C     Generates an integer uniformly distributed between LOW and HIGH.
00013 C
00014 C
00015 C                              Arguments
00016 C
00017 C
00018 C     LOW --> Low bound (inclusive) on integer value to be generated
00019 C                         INTEGER LOW
00020 C
00021 C     HIGH --> High bound (inclusive) on integer value to be generated
00022 C                         INTEGER HIGH
00023 C
00024 C
00025 C                              Note
00026 C
00027 C
00028 C     If (HIGH-LOW) > 2,147,483,561 prints error message on * unit and
00029 C     stops the program.
00030 C
00031 C**********************************************************************
00032 
00033 C     IGNLGI generates integers between 1 and 2147483562
00034 C     MAXNUM is 1 less than maximum generable value
00035 C     .. Parameters ..
00036       INTEGER maxnum
00037       PARAMETER (maxnum=2147483561)
00038       CHARACTER*(*) err1,err2
00039       PARAMETER (err1='LOW > HIGH in IGNUIN',
00040      +          err2=' ( HIGH - LOW ) > 2,147,483,561 in IGNUIN')
00041 C     ..
00042 C     .. Scalar Arguments ..
00043       INTEGER high,low
00044 C     ..
00045 C     .. Local Scalars ..
00046       INTEGER err,ign,maxnow,range,ranp1
00047 C     ..
00048 C     .. External Functions ..
00049       INTEGER ignlgi
00050       EXTERNAL ignlgi
00051 C     ..
00052 C     .. Intrinsic Functions ..
00053       INTRINSIC mod
00054 C     ..
00055 C     .. Executable Statements ..
00056       IF (.NOT. (low.GT.high)) GO TO 10
00057       err = 1
00058 C      ABORT-PROGRAM
00059       GO TO 80
00060 
00061    10 range = high - low
00062       IF (.NOT. (range.GT.maxnum)) GO TO 20
00063       err = 2
00064 C      ABORT-PROGRAM
00065       GO TO 80
00066 
00067    20 IF (.NOT. (low.EQ.high)) GO TO 30
00068       ignuin = low
00069       RETURN
00070 
00071 C     Number to be generated should be in range 0..RANGE
00072 C     Set MAXNOW so that the number of integers in 0..MAXNOW is an
00073 C     integral multiple of the number in 0..RANGE
00074 
00075    30 ranp1 = range + 1
00076       maxnow = (maxnum/ranp1)*ranp1
00077    40 ign = ignlgi() - 1
00078       IF (.NOT. (ign.LE.maxnow)) GO TO 40
00079       ignuin = low + mod(ign,ranp1)
00080       RETURN
00081 
00082    80 IF (.NOT. (err.EQ.1)) GO TO 90
00083       WRITE (*,*) err1
00084       GO TO 100
00085 
00086 C     TO ABORT-PROGRAM
00087    90 WRITE (*,*) err2
00088   100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high
00089       WRITE (*,*) ' Abort on Fatal ERROR'
00090       IF (.NOT. (err.EQ.1)) GO TO 110
00091       CALL XSTOPX ('LOW > HIGH in IGNUIN')
00092 
00093   110 CALL XSTOPX (' ( HIGH - LOW ) > 2,147,483,561 in IGNUIN')
00094 
00095   120 END