!     Last change:  DOS  31 Jul 2000    8:40 pm
!                                       *** copyright 2000 ***
! *** filename ranpm.f95                *** John F. Monahan **
!                                       **********************
      PROGRAM PRANPM
!  BASIC CHI-SQUARE TEST OF UNIFORM PSEUDORANDOM GENERATOR
      IMPLICIT NONE
      REAL CHISQ,U,EXP,FKCELL,RANPM
      INTEGER, DIMENSION(64) :: CELL
!                   DO 2**10 = 1024 UNIFORMS IN 64 CELLS
      INTEGER, PARAMETER :: N = 1024
      INTEGER, PARAMETER :: KCELLS = 64
      INTEGER I,J
!
  21  FORMAT(' RESULT OF CHI-SQUARE TEST ON RANPM UNIFORM GENERATOR'/ &
     &    ' WITH',I8,' OBS IN',I4,' CELLS GIVES CHISQ =',F12.4)
!
      OPEN( UNIT=6, FILE='ranpm.out' )
!
!                   INITIALIZE CELL COUNTERS TO ZERO
      CELL = 0
!                   INITIALIZE GENERATOR
      EXP = RANPM(5151917)
!                   EXPECTED NUMBER IN EACH CELL
      FKCELL = REAL(KCELLS)
      EXP = REAL(N)/FKCELL
!                   FILL UP THE CELLS                                                    
      DO I = 1,N
      U = RANPM(I)                                                      
!                   J POINTS TO CELL
      J = 1 + INT( U*FKCELL )
!                   INCREMENT COUNT IN CELL
      CELL(J) = CELL(J) + 1
      END DO  ! LOOP ON I
!                   TEST FOR UNIFORMITY
      CHISQ = 0.
      DO J = 1,KCELLS
      CHISQ = CHISQ + (CELL(J) - EXP)*(CELL(J) - EXP)/EXP
      END DO  ! LOOP ON J
!                   WRITE OUT RESULTS
      WRITE(6,21) N,KCELLS,CHISQ
      STOP                                                              
      END PROGRAM PRANPM
      REAL FUNCTION RANPM(IDUM)
!  PORTABLE IMPLEMENTATION OF UNIFORM PSEUDORANDOM NUMBER GENERATOR
!    S. K. PARK, K. W. MILLER & P.K. STOCKMEYER (1993) RESPONSE,
!     COMMUNICATIONS OF THE ACM, VOLUME 36, NUMBER 7, PP. 108-110.
!     X(N+1) = MOD( 48271*X(N), 2**31-1 )
!
!  SEE ALSO S. K. PARK & K. W. MILLER (1988) RANDOM NUMBER GENERATORS:
!    GOOD ONES ARE HARD TO FIND, COMMUNICATIONS OF THE ACM, VOLUME 31,
!    NUMBER 10, PP. 1192-1201
!
!  ALTERATION OF UPDATED VERSION OF
!  LINUS SCHRAGE (1979)'A MORE PORTABLE FORTRAN RANDOM NUMBER GENERATOR'
!   ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE, VOLUME 5, PP. 132-138.
!
!  ARGUMENT
!   IDUM    INTEGER  FIRST CALL SETS SEED, IGNORED IN SUBSEQUENT CALLS
!
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: IDUM
      REAL, PARAMETER :: RP = 4.656612875E-10     ! 1/P
      INTEGER, PARAMETER :: A = 48271             ! MULTIPLIER
      INTEGER, PARAMETER :: B = 44488             ! MULTIPLIER
      INTEGER, PARAMETER :: C = 3399              ! MULTIPLIER
      INTEGER, PARAMETER :: P = 2147483647        ! MODULUS 2**31 - 1
      INTEGER, SAVE :: IX = 0
      INTEGER K1
!                   BELOW A IS MULTIPLIER 48271
!                   B = 44488 = P/A, C = 3399 = P MOD A
!                   P IS MODULUS = 2**31 - 1
!
!                   IF NOT FIRST CALL, THEN SKIP SETTING SEED
      IF( IX .EQ. 0) IX = IDUM
!                   WRITE NUMBER AS ALPHA*2**16 + BETA
      K1 = IX / B
      IX = A*( IX - K1*B) - K1*C
!                   ABOVE DOES A*IX MOD B -K1*C
      IF( IX .LT. 0 ) IX = IX + P 
!                   RP BELOW IS RECIPROCAL OF P
      RANPM = REAL(IX)*RP
      RETURN
      END FUNCTION RANPM
! *** end of filename ranpm.f95         *********************