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

Last change on this file since 3694 was 3655, checked in by knoop, 6 years ago

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

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