1 |
C $Header: /u/gcmpack/models/MITgcmUV/model/src/port_rand.F,v 1.2 2001/02/02 21:04:48 adcroft Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
C Portable random number generator |
5 |
|
6 |
#undef _USE_INTEGERS |
7 |
|
8 |
! ============================================================================== |
9 |
CBOP |
10 |
C !ROUTINE: port_rand |
11 |
C !INTERFACE: |
12 |
real*8 function port_rand() |
13 |
|
14 |
C !DESCRIPTION: \bv |
15 |
C Portable random number generator |
16 |
C \ev |
17 |
|
18 |
C !LOCAL VARIABLES: |
19 |
implicit none |
20 |
integer nff |
21 |
parameter(nff=55) |
22 |
#ifdef _USE_INTEGERS |
23 |
integer mbig,mseed,mZ |
24 |
#else |
25 |
real*8 mbig,mseed,mz |
26 |
#endif |
27 |
real*8 fac |
28 |
#ifdef _USE_INTEGERS |
29 |
parameter (mbig=1000000000,mseed=161803398,mz=0,fac=1./mbig) |
30 |
#else |
31 |
parameter (mbig=4000000.,mseed=1618033.,mz=0.,fac=1./mbig) |
32 |
#endif |
33 |
integer i,ii,inext,inextp,k,idum |
34 |
parameter(idum=-2) |
35 |
#ifdef _USE_INTEGERS |
36 |
integer mj,mk,ma(nff) |
37 |
#else |
38 |
real*8 mj,mk,ma(nff) |
39 |
#endif |
40 |
logical firstCall |
41 |
save firstCall,inext,inextp,ma |
42 |
data firstCall /.true./ |
43 |
CEOP |
44 |
! ------------------------------------------------------------------------------ |
45 |
if(firstCall)then |
46 |
firstCall=.false. |
47 |
mj=mseed-iabs(idum) |
48 |
mj=mod(mj,mbig) |
49 |
ma(nff)=mj |
50 |
mk=1 |
51 |
do i=1,nff-1 |
52 |
ii=mod(21*i,nff) |
53 |
ma(ii)=mk |
54 |
mk=mj-mk |
55 |
if(mk.lt.mz)mk=mk+mbig |
56 |
mj=ma(ii) |
57 |
enddo |
58 |
do k=1,4 |
59 |
do i=1,nff |
60 |
ma(i)=ma(i)-ma(1+mod(i+30,nff)) |
61 |
if(ma(i).lt.MZ)ma(i)=ma(i)+mbig |
62 |
enddo |
63 |
enddo |
64 |
inext=0 |
65 |
inextp=31 |
66 |
endif |
67 |
inext=mod(inext,nff)+1 |
68 |
inextp=mod(inextp,nff)+1 |
69 |
mj=ma(inext)-ma(inextp) |
70 |
if(mj.lt.MZ)mj=mj+mbig |
71 |
ma(inext)=mj |
72 |
port_rand=mj*fac |
73 |
return |
74 |
! ------------------------------------------------------------------------------ |
75 |
end |
76 |
! ============================================================================== |
77 |
|
78 |
! ============================================================================== |
79 |
subroutine port_ranarr(n,arr) |
80 |
implicit none |
81 |
integer n,i |
82 |
real arr(n) |
83 |
real*8 port_rand |
84 |
! ------------------------------------------------------------------------------ |
85 |
do i=1,n |
86 |
arr(i)=port_rand() |
87 |
enddo |
88 |
|
89 |
return |
90 |
! ------------------------------------------------------------------------------ |
91 |
end |
92 |
! ============================================================================== |