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

Last change on this file since 4001 was 3761, checked in by raasch, 6 years ago

unused variables removed, OpenACC directives re-formatted, statements added to avoid compiler warnings

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