source: palm/trunk/SOURCE/random_function_mod.f90 @ 2000

Last change on this file since 2000 was 2000, checked in by knoop, 5 years ago

Forced header and separation lines into 80 columns

  • Property svn:keywords set to Id
File size: 4.4 KB
RevLine 
[1850]1!> @file random_function_mod.f90
[2000]2!------------------------------------------------------------------------------!
[1036]3! This file is part of PALM.
4!
[2000]5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
[1036]9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
[1818]17! Copyright 1997-2016 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[1]21! -----------------
[2000]22! Forced header and separation lines into 80 columns
[1343]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: random_function_mod.f90 2000 2016-08-20 18:09:15Z knoop $
27!
[1851]28! 1850 2016-04-08 13:29:27Z maronga
29! Module renamed
30!
31!
[1683]32! 1682 2015-10-07 23:56:08Z knoop
33! Code annotations made doxygen readable
34!
[1343]35! 1342 2014-03-26 17:04:47Z kanani
36! REAL constants defined as wp-kind
37!
[1321]38! 1320 2014-03-20 08:40:49Z raasch
[1320]39! ONLY-attribute added to USE-statements,
40! kind-parameters added to all INTEGER and REAL declaration statements,
41! kinds are defined in new module kinds,
42! old module precision_kind is removed,
43! revision history before 2012 removed,
44! comment fields (!:) to be used for variable explanations added to
45! all variable declaration statements
[1]46!
[1093]47! 1092 2013-02-02 11:24:22Z raasch
48! unused variables removed
49!
[1037]50! 1036 2012-10-22 13:43:42Z raasch
51! code put under GPL (PALM 3.9)
52!
[3]53! RCS Log replace by Id keyword, revision history cleaned up
54!
[1]55! Revision 1.1  1998/02/04 16:09:45  raasch
56! Initial revision
57!
58!
59! Description:
60! ------------
[1682]61!> Random number generator, produces numbers equally distributed in interval [0,1]
62!> This routine is taken from the "numerical recipies"
[3]63!------------------------------------------------------------------------------!
[1682]64 MODULE random_function_mod
65 
[1]66
[1320]67    USE kinds
68
[1]69    IMPLICIT NONE
70
71    PRIVATE
72
73    PUBLIC random_function, random_function_ini
74
[1682]75    INTEGER(iwp), PUBLIC, SAVE ::  random_iv(32)  !<
76    INTEGER(iwp), PUBLIC, SAVE ::  random_iy      !<
[1]77
78    INTERFACE random_function_ini
79       MODULE PROCEDURE random_function_ini
80    END INTERFACE random_function_ini
81
82    INTERFACE random_function
83       MODULE PROCEDURE random_function
84    END INTERFACE random_function
85
86 CONTAINS
87
[1682]88!------------------------------------------------------------------------------!
89! Description:
90! ------------
91!> @todo Missing subroutine description.
92!------------------------------------------------------------------------------!
[1]93    SUBROUTINE random_function_ini
94
95       IMPLICIT NONE
96
97       random_iv = 0
98       random_iy = 0
99
100    END SUBROUTINE random_function_ini
101
102    FUNCTION random_function( idum )
103
104
105       IMPLICIT NONE
106
[1682]107       INTEGER(iwp) ::  ia               !<
108       INTEGER(iwp) ::  idum             !<
109       INTEGER(iwp) ::  im               !<
110       INTEGER(iwp) ::  iq               !<
111       INTEGER(iwp) ::  ir               !<
112       INTEGER(iwp) ::  ndiv             !<
113       INTEGER(iwp) ::  ntab             !<
[1]114
[1682]115       INTEGER(iwp) ::  j                !<
116       INTEGER(iwp) ::  k                !<
[1320]117
[1682]118       REAL(wp)     ::  am               !<
119       REAL(wp)     ::  eps              !<
120       REAL(wp)     ::  random_function  !<
121       REAL(wp)     ::  rnmx             !<
[1320]122
[1342]123       PARAMETER ( ia=16807, im=2147483647, am=1.0_wp/im, iq=127773, ir=2836, &
124                   ntab=32, ndiv=1+(im-1)/ntab, eps=1.2e-7_wp, rnmx=1.0_wp-eps )
[1]125
126       IF ( idum .le. 0  .or.  random_iy .eq. 0 )  THEN
127          idum = max (-idum,1)
128          DO  j = ntab+8,1,-1
129             k    = idum / iq
130             idum = ia * ( idum - k * iq ) - ir * k
131             IF ( idum .lt. 0 )  idum = idum + im
132             IF ( j .le. ntab )  random_iv(j) = idum
133          ENDDO
134          random_iy = random_iv(1)
135       ENDIF
136
137       k    = idum / iq
138       idum = ia * ( idum - k * iq ) - ir * k
139       IF ( idum .lt. 0 )  idum = idum + im
140       j            = 1 + random_iy / ndiv
141       random_iy    = random_iv(j)
142       random_iv(j) = idum
143       random_function  = min ( am * random_iy , rnmx )
144
145    END FUNCTION random_function
146
147 END MODULE random_function_mod
Note: See TracBrowser for help on using the repository browser.