source: palm/trunk/SOURCE/random_function_mod.f90

Last change on this file was 4828, checked in by Giersch, 9 months ago

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

  • Property svn:keywords set to Id
File size: 4.4 KB
Line 
1!> @file random_function_mod.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2021 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: random_function_mod.f90 4828 2021-01-05 11:21:41Z banzhafs $
27! File re-formatted to follow the PALM coding standard
28!
29! 4360 2020-01-07 11:25:50Z suehring
30! Corrected "Former revisions" section
31!
32! 4144 2019-08-06 09:11:47Z raasch
33! Relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
34!
35! 3802 2019-03-17 13:33:42Z raasch
36! Type conversion added to avoid compiler warning about constant integer division truncation
37!
38! 3655 2019-01-07 16:51:22Z knoop
39! Corrected "Former revisions" section
40!
41! Revision 1.1  1998/02/04 16:09:45  raasch
42! Initial revision
43!
44!
45!--------------------------------------------------------------------------------------------------!
46! Description:
47! ------------
48!> Random number generator, produces numbers equally distributed in interval [0,1].
49!> This routine is taken from the "numerical recipes".
50!--------------------------------------------------------------------------------------------------!
51 MODULE random_function_mod
52
53
54    USE kinds
55
56    IMPLICIT NONE
57
58    PRIVATE
59
60    PUBLIC random_function, random_function_ini
61
62    INTEGER(iwp), PUBLIC, SAVE ::  random_iv(32)  !<
63    INTEGER(iwp), PUBLIC, SAVE ::  random_iy      !<
64
65    INTERFACE random_function_ini
66       MODULE PROCEDURE random_function_ini
67    END INTERFACE random_function_ini
68
69    INTERFACE random_function
70       MODULE PROCEDURE random_function
71    END INTERFACE random_function
72
73 CONTAINS
74
75!--------------------------------------------------------------------------------------------------!
76! Description:
77! ------------
78!> @todo Missing subroutine description.
79!--------------------------------------------------------------------------------------------------!
80 SUBROUTINE random_function_ini
81
82    IMPLICIT NONE
83
84    random_iv = 0
85    random_iy = 0
86
87 END SUBROUTINE random_function_ini
88
89!--------------------------------------------------------------------------------------------------!
90! Description:
91! ------------
92!> @todo Missing function description.
93!--------------------------------------------------------------------------------------------------!
94 FUNCTION random_function( idum )
95
96
97    IMPLICIT NONE
98
99    INTEGER(iwp) ::  ia               !<
100    INTEGER(iwp) ::  idum             !<
101    INTEGER(iwp) ::  im               !<
102    INTEGER(iwp) ::  iq               !<
103    INTEGER(iwp) ::  ir               !<
104    INTEGER(iwp) ::  ndiv             !<
105    INTEGER(iwp) ::  ntab             !<
106
107    INTEGER(iwp) ::  j                !<
108    INTEGER(iwp) ::  k                !<
109
110    REAL(wp)     ::  am               !<
111    REAL(wp)     ::  eps              !<
112    REAL(wp)     ::  random_function  !<
113    REAL(wp)     ::  rnmx             !<
114
115    PARAMETER ( ia = 16807, im = 2147483647, am = 1.0_wp / im, iq = 127773, ir = 2836, ntab = 32,  &
116                ndiv = 1 + INT( REAL( im - 1 ) / ntab ), eps = 1.2e-7_wp, rnmx = 1.0_wp - eps )
117
118    IF ( idum <= 0  .OR.  random_iy == 0 )  THEN
119       idum = MAX( -idum, 1 )
120       DO  j = ntab + 8, 1, -1
121          k    = idum / iq
122          idum = ia * ( idum - k * iq ) - ir * k
123          IF ( idum < 0 )  idum = idum + im
124          IF ( j <= ntab )  random_iv(j) = idum
125       ENDDO
126       random_iy = random_iv(1)
127    ENDIF
128
129    k    = idum / iq
130    idum = ia * ( idum - k * iq ) - ir * k
131    IF ( idum < 0 )  idum = idum + im
132    j            = 1 + random_iy / ndiv
133    random_iy    = random_iv(j)
134    random_iv(j) = idum
135    random_function  = MIN( am * random_iy , rnmx )
136
137 END FUNCTION random_function
138
139 END MODULE random_function_mod
Note: See TracBrowser for help on using the repository browser.