source: palm/trunk/SOURCE/disturb_heatflux.f90 @ 2233

Last change on this file since 2233 was 2233, checked in by suehring, 4 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 5.3 KB
Line 
1!> @file disturb_heatflux.f90
2!------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
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.
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!
17! Copyright 1997-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: disturb_heatflux.f90 2233 2017-05-30 18:08:54Z suehring $
27!
28! 2232 2017-05-30 17:47:52Z suehring
29! Adjustment according new surface data type.
30! Implemented parallel random number generator to obtain always the same
31! random number distribution regardless of the processor distribution.
32!
33! 2037 2016-10-26 11:15:40Z knoop
34! Anelastic approximation implemented
35!
36! 2000 2016-08-20 18:09:15Z knoop
37! Forced header and separation lines into 80 columns
38!
39! 1682 2015-10-07 23:56:08Z knoop
40! Code annotations made doxygen readable
41!
42! 1353 2014-04-08 15:21:23Z heinze
43! REAL constants provided with KIND-attribute
44!
45! 1322 2014-03-20 16:38:49Z raasch
46! REAL constants defined as wp-kind
47!
48! 1320 2014-03-20 08:40:49Z raasch
49! ONLY-attribute added to USE-statements,
50! kind-parameters added to all INTEGER and REAL declaration statements,
51! kinds are defined in new module kinds,
52! revision history before 2012 removed,
53! comment fields (!:) to be used for variable explanations added to
54! all variable declaration statements
55!
56! 1036 2012-10-22 13:43:42Z raasch
57! code put under GPL (PALM 3.9)
58!
59! Revision 1.1  1998/03/25 20:03:47  raasch
60! Initial revision
61!
62!
63! Description:
64! ------------
65!> Generate random, normally distributed heatflux values and store them as the
66!> near-surface heatflux.
67!------------------------------------------------------------------------------!
68 SUBROUTINE disturb_heatflux( surf )
69 
70
71    USE arrays_3d,                                                             &
72        ONLY:  heatflux_input_conversion
73       
74    USE control_parameters,                                                    &
75        ONLY:  iran, surface_heatflux, random_generator, wall_heatflux
76       
77    USE cpulog,                                                                &
78        ONLY:  cpu_log, log_point
79       
80    USE kinds
81   
82    USE indices,                                                               &
83        ONLY:  nzb
84
85    USE random_generator_parallel,                                             &
86        ONLY:  random_number_parallel, random_seed_parallel, random_dummy,     &
87               id_random_array, seq_random_array
88
89    USE surface_mod,                                                           &
90        ONLY:  surf_type
91
92    IMPLICIT NONE
93
94    INTEGER(iwp) ::  i  !< grid index, x direction
95    INTEGER(iwp) ::  j  !< grid index, y direction
96    INTEGER(iwp) ::  k  !< grid index, z direction
97    INTEGER(iwp) ::  m  !< loop variables over surface elements
98   
99    REAL(wp) ::  random_gauss  !<
100    REAL(wp) ::  randomnumber  !<
101
102    TYPE(surf_type) ::  surf   !< surface-type variable
103
104
105    CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
106
107!
108!-- Generate random disturbances and store them. Note, if
109!-- random_generator /= 'random-parallel' it is not guaranteed to obtain 
110!-- the same random distribution if the number of processors is changed.
111    IF ( random_generator /= 'random-parallel' )  THEN
112
113       DO  m = 1, surf%ns
114
115          k = surf%k(m)
116
117          randomnumber = random_gauss( iran, 5.0_wp )     
118!
119!--       k-1 is topography top index. If this is 0, set surface heatflux. Over
120!--       topography surface_heatflux is replaced by wall_heatflux(0).
121          IF ( k-1 == 0 )  THEN
122             surf%shf(m) = randomnumber * surface_heatflux                     &
123                              * heatflux_input_conversion(nzb)
124          ELSE
125             surf%shf(m) = randomnumber * wall_heatflux(0)                     &
126                              * heatflux_input_conversion(k-1)
127          ENDIF
128       ENDDO
129    ELSE
130
131       DO  m = 1, surf%ns
132
133          i = surf%i(m)
134          j = surf%j(m)
135          k = surf%k(m)
136
137          CALL random_seed_parallel( put=seq_random_array(:, j, i) )
138          CALL random_number_parallel( random_dummy )   
139!
140!--       k-1 is topography top index. If this is 0, set surface heatflux. Over
141!--       topography surface_heatflux is replaced by wall_heatflux(0).
142          IF ( k-1 == 0 )  THEN
143             surf%shf(m) = ( random_dummy - 0.5_wp ) * surface_heatflux        &
144                              * heatflux_input_conversion(nzb)
145          ELSE
146             surf%shf(m) = ( random_dummy - 0.5_wp ) * wall_heatflux(0)        &
147                              * heatflux_input_conversion(k-1)
148          ENDIF
149
150          CALL random_seed_parallel( get=seq_random_array(:, j, i) )
151
152       ENDDO
153
154    ENDIF
155
156    CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
157
158
159 END SUBROUTINE disturb_heatflux
Note: See TracBrowser for help on using the repository browser.