+++ /dev/null
-C $Date: 1994/10/04 16:19:52 $
-C $Revision: 2.1 $
-C
-C
-C See help for RANDOMV on the PSFSHARE disk to understand these
-C subroutines. This is the VS Fortran version of this code.
-C
-C
- SUBROUTINE VRND(VEC,N)
- INTEGER A(250)
- COMMON /VRANDD/ A, I, I147
- INTEGER LOOP,I,I147,VEC(N)
- DO 23000 LOOP=1,N
- I=I+1
- IF(.NOT.(I.GE.251))GOTO 23002
- I=1
-23002 CONTINUE
- I147=I147+1
- IF(.NOT.(I147.GE.251))GOTO 23004
- I147=1
-23004 CONTINUE
- A(I)=IEOR(A(I147),A(I))
- VEC(LOOP)=A(I)
-23000 CONTINUE
- RETURN
- END
-C
-C
- DOUBLE PRECISION FUNCTION RNDV(IDUM)
- DOUBLE PRECISION RM1,RM2,R(99)
- INTEGER IA1,IC1,M1, IA2,IC2,M2, IA3,IC3,M3, IDUM
- SAVE
- DATA IA1,IC1,M1/1279,351762,1664557/
- DATA IA2,IC2,M2/2011,221592,1048583/
- DATA IA3,IC3,M3/15551,6150,29101/
- IF(.NOT.(IDUM.LT.0))GOTO 23006
- IX1 = MOD(-IDUM,M1)
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX2 = MOD(IX1,M2)
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX3 = MOD(IX1,M3)
- RM1 = 1./DBLE(M1)
- RM2 = 1./DBLE(M2)
- DO 23008 J = 1,99
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX2 = MOD(IA2*IX2+IC2,M2)
- R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1
-23008 CONTINUE
-23006 CONTINUE
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX2 = MOD(IA2*IX2+IC2,M2)
- IX3 = MOD(IA3*IX3+IC3,M3)
- J = 1+(99*IX3)/M3
- RNDV = R(J)
- R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1
- IDUM = IX1
- RETURN
- END
-C
-C
- SUBROUTINE VRNDST(SEED)
- INTEGER A(250),LOOP,IDUM,SEED
- DOUBLE PRECISION RNDV
- COMMON /VRANDD/ A, I, I147
- I=0
- I147=103
- IDUM=SEED
- DO 23010 LOOP=1,250
- A(LOOP)=INT(RNDV(IDUM)*2147483647)
-23010 CONTINUE
- RETURN
- END
-C
-C
- SUBROUTINE VRNDIN(IODEV)
- INTEGER IODEV, A(250)
- COMMON/VRANDD/ A, I, I147
- READ(IODEV) A, I, I147
- RETURN
- END
-C
-C
- SUBROUTINE VRNDOU(IODEV)
-C This corresponds to VRNDOUT in the APFTN64 version
- INTEGER IODEV, A(250)
- COMMON/VRANDD/ A, I, I147
- WRITE(IODEV) A, I, I147
- RETURN
- END
- FUNCTION RNUNF(N)
- INTEGER IRAN1(2000)
- DATA FCTOR /2147483647.0D0/
-C We get only one random number, here! DR 9/1/92
- CALL VRND(IRAN1,1)
- RNUNF= DBLE( IRAN1(1) ) / FCTOR
-C******************************
-C write(6,*) 'rnunf in rnunf = ',rnunf
- RETURN
- END