[1262] | 1 | |
---|
| 2 | ! *****************************COPYRIGHT**************************** |
---|
| 3 | ! (c) British Crown Copyright 2009, the Met Office. |
---|
| 4 | ! All rights reserved. |
---|
[2428] | 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 $ |
---|
[5099] | 7 | |
---|
[1262] | 8 | ! Redistribution and use in source and binary forms, with or without |
---|
| 9 | ! modification, are permitted provided that the |
---|
| 10 | ! following conditions are met: |
---|
[5099] | 11 | |
---|
[1262] | 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. |
---|
[5099] | 23 | |
---|
[1262] | 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. |
---|
[5099] | 35 | |
---|
[1262] | 36 | ! *****************************COPYRIGHT******************************* |
---|
| 37 | ! *****************************COPYRIGHT******************************* |
---|
| 38 | |
---|
[5158] | 39 | DO irand = 1, npoints |
---|
[1262] | 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 |
---|
[5158] | 50 | DO irand = 1, npoints |
---|
[1262] | 51 | ran(irand)=ran(irand)+1 |
---|
| 52 | ran(irand)=(ran(irand))-int(ran(irand)) |
---|
| 53 | enddo |
---|
| 54 | endif |
---|
| 55 | |
---|
| 56 | |
---|