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

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

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

Revision 1.2 - (hide annotations) (download)
Thu May 12 16:13:11 2011 UTC (14 years, 6 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64k_20130723, ctrb_darwin2_ckpt65w_20160512, ctrb_darwin2_ckpt65j_20150225, ctrb_darwin2_ckpt63l_20120405, ctrb_darwin2_ckpt66g_20170424, ctrb_darwin2_ckpt64h_20130528, ctrb_darwin2_ckpt66k_20171025, ctrb_darwin2_ckpt66n_20180118, ctrb_darwin2_ckpt65v_20160409, ctrb_darwin2_ckpt65s_20160114, ctrb_darwin2_ckpt65_20140718, ctrb_darwin2_ckpt64m_20130820, ctrb_darwin2_ckpt66d_20170214, ctrb_darwin2_ckpt64r_20131210, ctrb_darwin2_ckpt65m_20150615, ctrb_darwin2_ckpt65q_20151118, ctrb_darwin2_ckpt65o_20150914, ctrb_darwin2_ckpt64f_20130405, ctrb_darwin2_ckpt63f_20111201, ctrb_darwin2_ckpt64a_20121116, ctrb_darwin2_ckpt65p_20151023, ctrb_darwin2_ckpt64n_20130826, ctrb_darwin2_ckpt65e_20140929, ctrb_darwin2_ckpt64o_20131024, ctrb_darwin2_ckpt64v_20140411, ctrb_darwin2_ckpt64z_20140711, ctrb_darwin2_ckpt65l_20150504, ctrb_darwin2_ckpt65z_20160929, ctrb_darwin2_ckpt65n_20150729, ctrb_darwin2_ckpt62y_20110526, ctrb_darwin2_ckpt64y_20140622, ctrb_darwin2_ckpt65d_20140915, ctrb_darwin2_ckpt64t_20140202, ctrb_darwin2_ckpt66h_20170602, ctrb_darwin2_ckpt64i_20130622, ctrb_darwin2_ckpt62x_20110513, ctrb_darwin2_ckpt64s_20140105, ctrb_darwin2_ckpt64x_20140524, ctrb_darwin2_ckpt63o_20120629, ctrb_darwin2_ckpt64e_20130305, ctrb_darwin2_ckpt65x_20160612, ctrb_darwin2_ckpt66f_20170407, ctrb_darwin2_ckpt63c_20111011, ctrb_darwin2_ckpt63i_20120124, ctrb_darwin2_ckpt65g_20141120, ctrb_darwin2_ckpt63m_20120506, ctrb_darwin2_ckpt63s_20120908, ctrb_darwin2_ckpt65k_20150402, ctrb_darwin2_ckpt63e_20111107, ctrb_darwin2_ckpt64w_20140502, ctrb_darwin2_ckpt63b_20110830, ctrb_darwin2_ckpt63j_20120217, ctrb_darwin2_ckpt66a_20161020, ctrb_darwin2_ckpt63r_20120817, ctrb_darwin2_ckpt64g_20130503, ctrb_darwin2_ckpt64l_20130806, ctrb_darwin2_ckpt63g_20111220, ctrb_darwin2_ckpt65f_20141014, ctrb_darwin2_ckpt64c_20130120, ctrb_darwin2_ckpt63a_20110804, ctrb_darwin2_ckpt66b_20161219, ctrb_darwin2_ckpt64u_20140308, ctrb_darwin2_ckpt64j_20130704, ctrb_darwin2_ckpt65i_20150123, ctrb_darwin2_ckpt66j_20170815, ctrb_darwin2_ckpt65y_20160801, ctrb_darwin2_ckpt63h_20111230, ctrb_darwin2_ckpt63p_20120707, ctrb_darwin2_ckpt66c_20170121, ctrb_darwin2_ckpt65a_20140728, ctrb_darwin2_ckpt65b_20140812, ctrb_darwin2_ckpt65t_20160221, ctrb_darwin2_ckpt64p_20131118, ctrb_darwin2_ckpt63d_20111107, ctrb_darwin2_ckpt63q_20120731, ctrb_darwin2_ckpt63_20110728, ctrb_darwin2_ckpt64b_20121224, ctrb_darwin2_ckpt64d_20130219, ctrb_darwin2_ckpt66o_20180209, ctrb_darwin2_ckpt66e_20170314, ctrb_darwin2_ckpt64_20121012, ctrb_darwin2_ckpt64q_20131118, ctrb_darwin2_ckpt64p_20131024, ctrb_darwin2_ckpt65u_20160315, ctrb_darwin2_ckpt65r_20151221, ctrb_darwin2_ckpt66i_20170718, ctrb_darwin2_ckpt63n_20120604, ctrb_darwin2_ckpt63k_20120317, ctrb_darwin2_ckpt65c_20140830, ctrb_darwin2_ckpt62z_20110622, ctrb_darwin2_ckpt66l_20171025, ctrb_darwin2_ckpt65h_20141217, ctrb_darwin2_ckpt66m_20171213, HEAD
Changes since 1.1: +4 -7 lines 
fix subroutine arguments
1 jahn 1.2 C $Header: /u/gcmpack/MITgcm_contrib/darwin2/pkg/darwin/darwin_random.F,v 1.1 2011/04/13 18:56:24 jahn Exp $
2     C $Name: $
3 jahn 1.1
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 jahn 1.2 #ifndef PORT_RAND
218 jahn 1.1 INTEGER Iseed
219     real*8 uniform
220     real*8 normal
221     #endif
222     CEOP
223    
224     IF (myThid .GT. 1) THEN
225     CALL PRINT_ERROR('DARWIN_RANDOM: threading no supported',
226     & myThid)
227     STOP 'ABNORMAL END: S/R DARWIN_RANDOM'
228     END IF
229    
230     #ifdef PORT_RAND
231 jahn 1.2 darwin_random_normal = port_rand_norm()
232 jahn 1.1 #else
233     Iseed = 0
234     uniform = rand(Iseed)
235     CALL invnormal(normal, uniform, 0.d0, 1.d0)
236     darwin_random_normal = normal
237     #endif
238    
239     RETURN
240     END
241     #endif /*DARWIN*/
242     #endif /*ALLOW_PTRACERS*/
243     c ==========================================================
244    
  ViewVC Help
Powered by ViewVC 1.1.22