C @(#)ran3.for	17.1.1.1 (ES0-DMD) 01/25/02 17:17:57
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
      REAL FUNCTION RAN3(IDUM)
C+++
C.PURPOSE:      Returns a uniform random  derivative bteen 0.0 and 1.0. 
C               Set IDUM to any negative value to initiaze the sequence.
C.ALGORYTHM:    From Numerical Recipes (Press et al., 1988)
C.VERSION:      910115 RHW IMPLICIT NONE added
C---
      IMPLICIT  NONE
      INTEGER   IDUM                                !
C
      INTEGER   MBIG
      INTEGER   MSEED
      INTEGER   MZ
      REAL      FAC
      PARAMETER (MBIG=1000000000)
      PARAMETER (MSEED=161803398)
      PARAMETER (MZ=0)
      PARAMETER (FAC=1./MBIG)
C
      INTEGER   IFF, II, I
      INTEGER   INEXT, INEXTP
      INTEGER   K
      INTEGER   MJ, MK
      INTEGER   MA(55)
      SAVE
C
      DATA      IFF/0/
C
C ***
      IF (IDUM.LT.0 .OR. IFF.EQ.0) THEN
         IFF    = 1
         MJ     = MSEED - IABS(IDUM)
         MJ     = MOD(MJ,MBIG)
         MA(55) = MJ
         MK     = 1
         DO 11 I=1,54
            II = MOD(21*I,55)
            MA(II) = MK
            MK     = MJ - MK
            IF (MK.LT.MZ) THEN
               MK = MK + MBIG
            ENDIF
            MJ = MA(II)
  11     CONTINUE
C
         DO 13 K = 1,4
            DO 12 I = 1,55
               MA(I) = MA(I)-MA(1+MOD(I+30,55))
               IF (MA(I).LT.MZ) THEN
                  MA(I) = MA(I) + MBIG
               ENDIF
   12       CONTINUE
   13    CONTINUE
         INEXT  = 0
         INEXTP = 31
         IDUM   = 1
      ENDIF
C
      INEXT = INEXT + 1
      IF (INEXT.EQ.56) THEN
         INEXT = 1
      ENDIF
      INEXTP = INEXTP + 1
      IF (INEXTP.EQ.56) THEN
         INEXTP = 1
      ENDIF
      MJ = MA(INEXT) - MA(INEXTP)
      IF (MJ.LT.MZ) THEN
         MJ = MJ + MBIG
      ENDIF
      MA(INEXT) = MJ
      RAN3      = MJ*FAC

      RETURN
      END