From K193301%CZHRZU1A.BitNet@wigate.nic.wisc.edu Wed Nov 17 17:36:19 1993
Received: from cs.wisc.edu by tilsit.cs.wisc.edu; Wed, 17 Nov 93 17:36:18 -0600
Received: from vms3.macc.wisc.edu by cs.wisc.edu; Wed, 17 Nov 93 17:36:16 -0600
Received: from CEARN by WISCMACC.BitNet; Wed, 17 Nov 93 17:37 CDT
Received: from CZHRZU1A.BITNET (NJE origin K193301@CZHRZU1A)
          by CEARN.CERN.CH (LMail V1.1d/1.7f) with RFC822 id 9035;
          Thu, 18 Nov 1993 00:34:21 +0100
Message-Id: <23111717370667@WISCMACC.BitNet>
Date: Thu, 18 Nov 93 00:34:40 GMT
From: "P. Kall" <K193301%CZHRZU1A.BitNet@wigate.nic.wisc.edu>
Subject: random.for
To: Spyros Kontogiorgis <kontogio>
*Destination: CS.WISC.EDU
Status: R


C=====================================================================
C                          R A N D O M
C=====================================================================
C     All procedures which call the random number generator RND() are
C     in this file. Calls to RND() are located in the following rows:
C     10, 29, 30, 35, 49, 61
C=====================================================================
      LOGICAL FUNCTION COIN(DUMMY)
      REAL*8 WW,DUMMY
C
C------------- Lahey F77L-EM/32 intrinsic function ----------------
C
      WW=RND()
      IF (WW .LT. 0.5) THEN
         COIN=.TRUE.
                       ELSE
         COIN=.FALSE.
      ENDIF
      END
C=======================================================================
      SUBROUTINE INDICS(MM,IND1,IND2)
      INTEGER MM,IND1,IND2
      REAL*8 WW
      IND1=1
      IND2=1
      IF (MM .EQ. 1) RETURN
      IF (MM .EQ. 2) THEN
         IND1=1
         IND2=2
         RETURN
      ENDIF
C
C------------- Lahey F77L-EM/32 intrinsic function ----------------
C
      CALL INDEX(MM,IND1)
cc    WW=RND()
cc    WW=RND()*(MM+1.0D0)
cc    IND1=WW
cc    IF (IND1 .EQ. MM+1) IND1=MM
cc    IF (IND1 .EQ. 0) IND1=1
   10 CONTINUE
C
C------------- Lahey F77L-EM/32 intrinsic function ----------------
C
cc    WW=RND()*(MM+1.0D0)
cc    IND2=WW
cc    IF (IND2 .EQ. MM+1) IND2=MM
cc    IF (IND2 .EQ. 0) IND2=1
      CALL INDEX(MM,IND2)
      IF (IND1 .EQ. IND2) GOTO 10
      END
C=======================================================================
      SUBROUTINE INDEX(MM,INDE)
      INTEGER MM,INDE
      REAL*8 WW
      IF (MM .EQ. 1) THEN
         INDE=1
         RETURN
      ENDIF
C
C------------- Lahey F77L-EM/32 intrinsic function ----------------
C
      WW=RND()*(MM+1.0D0)
      INDE=WW
      IF (INDE .EQ. MM+1) INDE=MM
      IF (INDE .EQ. 0) INDE=1
   10 CONTINUE
      END
C=======================================================================
      DOUBLE PRECISION FUNCTION XENTRY(MAXVAL,INTVAL,SIGDIG,ZERO)
      DOUBLE PRECISION   MAXVAL,ZERO,XX,CUTENT
      INTEGER            INTVAL,IDUMMY,SIGDIG
      LOGICAL            COIN
   10 CONTINUE
C
C------------- Lahey F77L-EM/32 intrinsic function ----------------
C
      XX=RND()*DBLE(MAXVAL)
      IF (DABS(XX) .LT. ZERO) GOTO 10
      IF (INTVAL .EQ. 3 .OR.
     *   (INTVAL .EQ. 1 .AND. COIN(IDUMMY))) XX=-1.0D0*XX
      XX=CUTENT(XX,SIGDIG)
cc    XX=DINT(XX*10**SIGDIG)/10**(SIGDIG)
      XENTRY=XX
      END
C=======================================================================
      DOUBLE PRECISION FUNCTION CUTENT(WHAT,SIGDIG)
      DOUBLE PRECISION  WHAT
      INTEGER           SIGDIG
      CUTENT=DINT(WHAT*10**SIGDIG)/10**(SIGDIG)
      END
C=======================================================================

