Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! nr_randnum.f90 is part of AstroBEAR. 00008 ! 00009 ! AstroBEAR is free software: you can redistribute it and/or modify 00010 ! it under the terms of the GNU General Public License as published by 00011 ! the Free Software Foundation, either version 3 of the License, or 00012 ! (at your option) any later version. 00013 ! 00014 ! AstroBEAR is distributed in the hope that it will be useful, 00015 ! but WITHOUT ANY WARRANTY; without even the implied warranty of 00016 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 ! GNU General Public License for more details. 00018 ! 00019 ! You should have received a copy of the GNU General Public License 00020 ! along with AstroBEAR. If not, see <http://www.gnu.org/licenses/>. 00021 ! 00022 !######################################################################### 00023 !=================================================== 00024 ! 00025 ! ROUTINE : nr_randnum. See NumRec. 00026 ! PURPOSE : returns random number between 0 and 1 00027 ! as double precision 00028 !=================================================== 00029 00030 function nr_randnum (idum) 00031 00032 implicit none 00033 00034 integer idum , j , k , idum2 , iy , 00035 im1 , im2 , imm1 , ia1 , 00036 ia2 , iq1 , iq2 , ir1 , ir2 , 00037 ntab 00038 00039 double precision am , temp, ndiv , eps , rnmx , 00040 nr_randnum 00041 00042 parameter (im1 = 2147483563, im2 = 2147483399, & 00043 imm1= im1-1 , ia1 = 40014 , ia2 = 40692 , & 00044 iq1 = 53668 , iq2 = 52774 , ir1 = 12111 , & 00045 ir2 = 3791 , ntab= 32 , ndiv= 1+imm1/ntab , & 00046 eps = 1.2d-12 , rnmx= 1d0-eps) 00047 00048 integer iv(0:ntab-1) 00049 00050 common /randnumcom/ iy, iv, idum2 00051 00052 !------------------------------------------------------ 00053 00054 idum2 = 123456789 00055 am = 1d0/dble(im1) 00056 00057 if (idum .le. 0) then 00058 if (-idum .lt. 1) then 00059 idum = 1 00060 else 00061 idum = -idum 00062 end if 00063 idum2 = idum 00064 do j=ntab+7,0,-1 00065 k = idum / iq1 00066 idum = ia1*(idum-k*iq1)-k*ir1 00067 if (idum .lt. 0) idum = idum + im1 00068 if (j .lt. ntab) iv(j) = idum 00069 end do 00070 iy = iv(0) 00071 end if 00072 k = idum/iq1 00073 idum = ia1*(idum-k*iq1)-k*ir1 00074 if (idum .lt. 0) idum = idum + im1 00075 k = idum2/iq2 00076 idum2 = ia2 * (idum2-k*iq2)-k*ir2 00077 if (idum2 .lt. 0) idum2 = idum2 + im2 00078 j = iy/ndiv 00079 iy = iv(j) - idum2 00080 iv(j) = idum 00081 if (iy .lt. 1) iy = iy + imm1 00082 temp = am * dble(iy) 00083 if (temp .gt. rnmx) then 00084 nr_randnum = rnmx 00085 else 00086 nr_randnum = temp 00087 end if 00088 00089 !=========================================================== 00090 00091 return 00092 end function nr_randnum