--- /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