/[MITgcm]/MITgcm_contrib/darwin2/pkg/darwin/darwin_random.F
ViewVC logotype

Contents of /MITgcm_contrib/darwin2/pkg/darwin/darwin_random.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (show annotations) (download)
Wed Apr 13 18:56:24 2011 UTC (14 years, 8 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt62v_20110413, ctrb_darwin2_ckpt62w_20110426, ctrb_darwin2_baseline
darwin2 initial checkin

1 C $Header$
2 C $Name$
3
4 #include "CPP_OPTIONS.h"
5 #include "DARWIN_OPTIONS.h"
6
7 #ifdef PORT_RAND
8 #ifdef OLDSEED
9 These lines are here intentionally to cause a compile-time error:
10 If you really want to use PORT_RAND with OLDSEED, comment them out.
11 #endif
12 #endif
13
14 #ifdef ALLOW_PTRACERS
15 #ifdef ALLOW_DARWIN
16
17 CBOP
18 C !ROUTINE: DARWIN_RANDOM_INIT
19 C !INTERFACE:
20 SUBROUTINE DARWIN_RANDOM_INIT(seed, myThid)
21 C !DESCRIPTION: \bv
22 C *==========================================================*
23 C | SUBROUTINE DARWIN_RANDOM_INIT
24 C | o Initializes the random number generator.
25 C | seed must be positive.
26 C | NOTE: not thread-safe yet!!!
27 C *===========================================================
28 C | Algorithms:
29 C | - With PORT_RAND defined, this uses port_rand.f, which is
30 C | Knuth's portable random number generator [see Numerical
31 C | Recipes, Ch.7.1: ran3].
32 C | We use the floating-point version.
33 C | In order to obtain unique sequences of random numbers,
34 C | the seed should be between 1 and 1618032.
35 C | - With PORT_RAND undefined, it uses the system's RAND
36 C | function. See the system documentation for ranges, etc.
37 C *==========================================================*
38 C \ev
39
40 C !USES:
41 IMPLICIT NONE
42
43 #include "EEPARAMS.h"
44
45 C !INPUT/OUTPUT PARAMETERS:
46 C == Routine arguments ==
47 C myThid :: thread number
48 INTEGER seed
49 INTEGER myThid
50
51 C !FUNCTIONS:
52 C == Functions ==
53 #ifdef PORT_RAND
54 real*8 port_rand
55 external port_rand
56 #endif
57 Coj these are needed for the Intel compiler, define the macro IFORT
58 Coj in your optfile if you want to use it
59 #ifdef IFORT
60 real*4 RAND
61 EXTERNAL RAND
62 #endif
63
64 C !LOCAL VARIABLES:
65 C == Local variables ==
66 C msgBuf - Informational/error meesage buffer
67 CHARACTER*(MAX_LEN_MBUF) msgBuf
68 _RL RandNo
69 INTEGER nrand
70 #ifdef PORT_RAND
71 REAL*8 Dseed
72 #else
73 INTEGER Iseed
74 #endif
75 INTEGER IRand
76 CHARACTER*16 random_name
77 CEOP
78
79 IF (myThid .GT. 1) THEN
80 CALL PRINT_ERROR('DARWIN_RANDOM_INIT: threading no supported',
81 & myThid)
82 STOP 'ABNORMAL END: S/R DARWIN_RANDOM_INIT'
83 END IF
84
85 IF (seed .LE. 0) THEN
86 CALL PRINT_ERROR('DARWIN_RANDOM_INIT: seed must be positive'
87 & , myThid)
88 END IF
89
90 #ifdef PORT_RAND
91 Dseed = float(seed)
92 RandNo = port_rand(Dseed)
93 C need to call again to get a non-zero random number
94 Dseed = -1.D0
95 RandNo = port_rand(Dseed)
96 random_name = 'port_rand'
97 #else
98 #ifdef OLDSEED
99 Iseed = seed
100 do nrand = 1,Iseed
101 Irand = 0
102 RandNo = rand(Irand)
103 end do
104 random_name = 'rand/oldseed'
105 #else
106 Iseed = -seed
107 RandNo = rand(Iseed)
108 random_name = 'rand'
109 #endif
110 #endif
111
112 WRITE(msgbuf,'(A,A,I10,X,F20.16)')
113 & 'QQ random ', random_name, seed, RandNo
114 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
115 & SQUEEZE_RIGHT , myThid)
116
117 RETURN
118 END
119
120 CBOP
121 C !ROUTINE: DARWIN_RANDOM
122 C !INTERFACE:
123 FUNCTION DARWIN_RANDOM(myThid)
124 C !DESCRIPTION: \bv
125 C *==========================================================*
126 C | FUNCTION DARWIN_RANDOM
127 c | o returns a uniform random number between 0 and 1
128 C *==========================================================*
129 C \ev
130
131 C !USES:
132 IMPLICIT NONE
133
134 #include "EEPARAMS.h"
135
136 C !INPUT/OUTPUT PARAMETERS:
137 C == Routine arguments ==
138 C DARWIN_RANDOM :: uniform random number
139 C myThid :: thread number
140 _RL DARWIN_RANDOM
141 INTEGER myThid
142
143 C !FUNCTIONS:
144 C == Functions ==
145 #ifdef PORT_RAND
146 real*8 port_rand
147 external port_rand
148 #endif
149 #ifdef IFORT
150 real*4 RAND
151 EXTERNAL RAND
152 #endif
153
154 C !LOCAL VARIABLES:
155 C == Local variables ==
156 #ifdef PORT_RAND
157 real*8 Dseed
158 #else
159 INTEGER Iseed
160 #endif
161 CEOP
162
163 IF (myThid .GT. 1) THEN
164 CALL PRINT_ERROR('DARWIN_RANDOM: threading no supported',
165 & myThid)
166 STOP 'ABNORMAL END: S/R DARWIN_RANDOM'
167 END IF
168
169 #ifdef PORT_RAND
170 Dseed = -1.d0
171 darwin_random = port_rand(Dseed)
172 #else
173 Iseed = 0
174 darwin_random = rand(Iseed)
175 #endif
176
177 RETURN
178 END
179
180 CBOP
181 C !ROUTINE: DARWIN_RANDOM_NORMAL
182 C !INTERFACE:
183 FUNCTION DARWIN_RANDOM_NORMAL(myThid)
184 C !DESCRIPTION: \bv
185 C *==========================================================*
186 C | FUNCTION DARWIN_RANDOM_NORMAL
187 C | o returns a normally distributed random number with
188 C | mean 0 and stddev 1
189 C *==========================================================*
190 C \ev
191
192 C !USES:
193 IMPLICIT NONE
194
195 #include "EEPARAMS.h"
196
197 C !INPUT/OUTPUT PARAMETERS:
198 C == Routine arguments ==
199 C DARWIN_RANDOM_NORMAL :: normally distributed random number
200 C myThid :: thread number
201 _RL DARWIN_RANDOM_NORMAL
202 INTEGER myThid
203
204 C !FUNCTIONS:
205 C == Functions ==
206 #ifdef PORT_RAND
207 real*8 port_rand_norm
208 external port_rand_norm
209 #endif
210 #ifdef IFORT
211 real*4 RAND
212 EXTERNAL RAND
213 #endif
214
215 C !LOCAL VARIABLES:
216 C == Local variables ==
217 #ifdef PORT_RAND
218 real*8 Dseed
219 #else
220 INTEGER Iseed
221 real*8 uniform
222 real*8 normal
223 #endif
224 CEOP
225
226 IF (myThid .GT. 1) THEN
227 CALL PRINT_ERROR('DARWIN_RANDOM: threading no supported',
228 & myThid)
229 STOP 'ABNORMAL END: S/R DARWIN_RANDOM'
230 END IF
231
232 #ifdef PORT_RAND
233 Dseed = -1.d0
234 darwin_random_normal = port_rand_norm(Dseed)
235 #else
236 Iseed = 0
237 uniform = rand(Iseed)
238 CALL invnormal(normal, uniform, 0.d0, 1.d0)
239 darwin_random_normal = normal
240 #endif
241
242 RETURN
243 END
244 #endif /*DARWIN*/
245 #endif /*ALLOW_PTRACERS*/
246 c ==========================================================
247

  ViewVC Help
Powered by ViewVC 1.1.22