source: palm/trunk/SOURCE/random_function_mod.f90

Last change on this file was 4828, checked in by Giersch, 10 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
RevLine 
[1850]1!> @file random_function_mod.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_function_mod.f90 4828 2021-01-05 11:21:41Z banzhafs $
[4592]27! File re-formatted to follow the PALM coding standard
28!
29! 4360 2020-01-07 11:25:50Z suehring
[4182]30! Corrected "Former revisions" section
[4592]31!
[4182]32! 4144 2019-08-06 09:11:47Z raasch
[4592]33! Relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
34!
[4144]35! 3802 2019-03-17 13:33:42Z raasch
[4592]36! Type conversion added to avoid compiler warning about constant integer division truncation
37!
[3802]38! 3655 2019-01-07 16:51:22Z knoop
[2716]39! Corrected "Former revisions" section
[1321]40!
[4182]41! Revision 1.1  1998/02/04 16:09:45  raasch
42! Initial revision
43!
44!
[4592]45!--------------------------------------------------------------------------------------------------!
[1]46! Description:
47! ------------
[4592]48!> Random number generator, produces numbers equally distributed in interval [0,1].
49!> This routine is taken from the "numerical recipes".
50!--------------------------------------------------------------------------------------------------!
[1682]51 MODULE random_function_mod
[1]52
[4592]53
[1320]54    USE kinds
55
[1]56    IMPLICIT NONE
57
58    PRIVATE
59
60    PUBLIC random_function, random_function_ini
61
[1682]62    INTEGER(iwp), PUBLIC, SAVE ::  random_iv(32)  !<
63    INTEGER(iwp), PUBLIC, SAVE ::  random_iy      !<
[1]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
[4592]75!--------------------------------------------------------------------------------------------------!
[1682]76! Description:
77! ------------
78!> @todo Missing subroutine description.
[4592]79!--------------------------------------------------------------------------------------------------!
80 SUBROUTINE random_function_ini
[1]81
[4592]82    IMPLICIT NONE
[1]83
[4592]84    random_iv = 0
85    random_iy = 0
[1]86
[4592]87 END SUBROUTINE random_function_ini
[1]88
[4592]89!--------------------------------------------------------------------------------------------------!
90! Description:
91! ------------
92!> @todo Missing function description.
93!--------------------------------------------------------------------------------------------------!
94 FUNCTION random_function( idum )
[1]95
96
[4592]97    IMPLICIT NONE
[1]98
[4592]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             !<
[1]106
[4592]107    INTEGER(iwp) ::  j                !<
108    INTEGER(iwp) ::  k                !<
[1320]109
[4592]110    REAL(wp)     ::  am               !<
111    REAL(wp)     ::  eps              !<
112    REAL(wp)     ::  random_function  !<
113    REAL(wp)     ::  rnmx             !<
[1320]114
[4592]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 )
[1]117
[4592]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
[1]128
[4592]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 )
[1]136
[4592]137 END FUNCTION random_function
[1]138
139 END MODULE random_function_mod
Note: See TracBrowser for help on using the repository browser.