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

Last change on this file since 3163 was 2718, checked in by maronga, 7 years ago

deleting of deprecated files; headers updated where needed

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