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

Last change on this file since 4894 was 4828, checked in by Giersch, 4 years ago

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

  • Property svn:keywords set to Id
File size: 2.9 KB
RevLine 
[1682]1!> @file random_gauss.f90
[4592]2!--------------------------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[4592]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.
[1036]8!
[4592]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.
[1036]12!
[4592]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/>.
[1036]15!
[4828]16! Copyright 1997-2021 Leibniz Universitaet Hannover
[4592]17!--------------------------------------------------------------------------------------------------!
[1036]18!
[4592]19!
[484]20! Current revisions:
[1]21! -----------------
[4592]22!
23!
[1321]24! Former revisions:
25! -----------------
26! $Id: random_gauss.f90 4828 2021-01-05 11:21:41Z raasch $
[4592]27! File re-formatted to follow the PALM coding standard
28!
29! 4360 2020-01-07 11:25:50Z suehring
[2716]30! Corrected "Former revisions" section
[4592]31!
[4182]32! 3655 2019-01-07 16:51:22Z knoop
33! Corrected "Former revisions" section
[1321]34!
[4182]35! Revision 1.1  1998/03/25 20:09:47  raasch
36! Initial revision
37!
38!
[4592]39!--------------------------------------------------------------------------------------------------!
[1]40! Description:
41! ------------
[1682]42!> Generates a gaussian distributed random number (mean value 1, sigma = 1)
43!> This routine is taken from the "numerical recipies".
[4592]44!--------------------------------------------------------------------------------------------------!
[1682]45 FUNCTION random_gauss( idum, upper_limit )
[1]46
[4592]47
[1320]48    USE kinds
[1]49
[4592]50    USE random_function_mod,                                                                       &
[1320]51        ONLY:  random_function
52
[1]53    IMPLICIT NONE
54
[1682]55    INTEGER(iwp) ::  idum          !<
56    INTEGER(iwp) ::  iset          !<
[1]57
[1682]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            !<
[1320]65
[1]66    SAVE  iset, gset
67
68    DATA  iset /0/
69
70!
[4592]71!-- Random numbers are created as long as they do not fall below the given upper limit
[1]72    DO
73
74       IF ( iset == 0 )  THEN
[1342]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
[1]79             rsq = v1**2 + v2**2
80          ENDDO
[1342]81          fac          = SQRT( -2.0_wp * LOG( rsq ) / rsq )
[1]82          gset         = v1 * fac
[1342]83          random_gauss = v2 * fac + 1.0_wp
[1]84          iset         = 1
85       ELSE
[1342]86          random_gauss = gset + 1.0_wp
[1]87          iset         = 0
88       ENDIF
89
[1342]90       IF ( ABS( random_gauss - 1.0_wp ) <= upper_limit )  EXIT
[1]91
92    ENDDO
93
94 END FUNCTION random_gauss
Note: See TracBrowser for help on using the repository browser.