1 | |
---|
2 | ! *****************************COPYRIGHT**************************** |
---|
3 | ! (c) British Crown Copyright 2009, the Met Office. |
---|
4 | ! All rights reserved. |
---|
5 | ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ |
---|
6 | ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/icarus-scops-4.1-bsd/congvec.f $ |
---|
7 | |
---|
8 | ! Redistribution and use in source and binary forms, with or without |
---|
9 | ! modification, are permitted provided that the |
---|
10 | ! following conditions are met: |
---|
11 | |
---|
12 | ! * Redistributions of source code must retain the above |
---|
13 | ! copyright notice, this list of conditions and the following |
---|
14 | ! disclaimer. |
---|
15 | ! * Redistributions in binary form must reproduce the above |
---|
16 | ! copyright notice, this list of conditions and the following |
---|
17 | ! disclaimer in the documentation and/or other materials |
---|
18 | ! provided with the distribution. |
---|
19 | ! * Neither the name of the Met Office nor the names of its |
---|
20 | ! contributors may be used to endorse or promote products |
---|
21 | ! derived from this software without specific prior written |
---|
22 | ! permission. |
---|
23 | |
---|
24 | ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
---|
25 | ! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
---|
26 | ! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR |
---|
27 | ! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
---|
28 | ! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
---|
29 | ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
---|
30 | ! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
---|
31 | ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
---|
32 | ! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
---|
33 | ! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
---|
34 | ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
---|
35 | |
---|
36 | ! *****************************COPYRIGHT******************************* |
---|
37 | ! *****************************COPYRIGHT******************************* |
---|
38 | |
---|
39 | DO irand = 1, npoints |
---|
40 | ! Marsaglia CONG algorithm |
---|
41 | seed(irand)=69069*seed(irand)+1234567 |
---|
42 | ! mod 32 bit overflow |
---|
43 | seed(irand)=mod(seed(irand),2**30) |
---|
44 | ran(irand)=seed(irand)*0.931322574615479E-09 |
---|
45 | enddo |
---|
46 | |
---|
47 | ! convert to range 0-1 (32 bit only) |
---|
48 | overflow_32=i2_16*i2_16 |
---|
49 | if ( overflow_32 .le. huge32 ) then |
---|
50 | DO irand = 1, npoints |
---|
51 | ran(irand)=ran(irand)+1 |
---|
52 | ran(irand)=(ran(irand))-int(ran(irand)) |
---|
53 | enddo |
---|
54 | endif |
---|
55 | |
---|
56 | |
---|