source: palm/trunk/SOURCE/random_gauss.f90 @ 4598

Last change on this file since 4598 was 4592, checked in by raasch, 10 months ago

files re-formatted to follow the PALM coding standard

  • Property svn:keywords set to Id
File size: 2.9 KB
Line 
1!> @file random_gauss.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-2020 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: random_gauss.f90 4592 2020-07-08 09:56:29Z suehring $
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! 3655 2019-01-07 16:51:22Z knoop
33! Corrected "Former revisions" section
34!
35! Revision 1.1  1998/03/25 20:09:47  raasch
36! Initial revision
37!
38!
39!--------------------------------------------------------------------------------------------------!
40! Description:
41! ------------
42!> Generates a gaussian distributed random number (mean value 1, sigma = 1)
43!> This routine is taken from the "numerical recipies".
44!--------------------------------------------------------------------------------------------------!
45 FUNCTION random_gauss( idum, upper_limit )
46
47
48    USE kinds
49
50    USE random_function_mod,                                                                       &
51        ONLY:  random_function
52
53    IMPLICIT NONE
54
55    INTEGER(iwp) ::  idum          !<
56    INTEGER(iwp) ::  iset          !<
57
58    REAL(wp)     ::  fac           !<
59    REAL(wp)     ::  gset          !<
60    REAL(wp)     ::  random_gauss  !<
61    REAL(wp)     ::  rsq           !<
62    REAL(wp)     ::  upper_limit   !<
63    REAL(wp)     ::  v1            !<
64    REAL(wp)     ::  v2            !<
65
66    SAVE  iset, gset
67
68    DATA  iset /0/
69
70!
71!-- Random numbers are created as long as they do not fall below the given upper limit
72    DO
73
74       IF ( iset == 0 )  THEN
75          rsq = 0.0_wp
76          DO  WHILE ( rsq >= 1.0_wp  .OR.  rsq == 0.0_wp )
77             v1  = 2.0_wp * random_function( idum ) - 1.0_wp
78             v2  = 2.0_wp * random_function( idum ) - 1.0_wp
79             rsq = v1**2 + v2**2
80          ENDDO
81          fac          = SQRT( -2.0_wp * LOG( rsq ) / rsq )
82          gset         = v1 * fac
83          random_gauss = v2 * fac + 1.0_wp
84          iset         = 1
85       ELSE
86          random_gauss = gset + 1.0_wp
87          iset         = 0
88       ENDIF
89
90       IF ( ABS( random_gauss - 1.0_wp ) <= upper_limit )  EXIT
91
92    ENDDO
93
94 END FUNCTION random_gauss
Note: See TracBrowser for help on using the repository browser.