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

Last change on this file since 1570 was 1354, checked in by heinze, 11 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 3.5 KB
RevLine 
[1]1 SUBROUTINE disturb_heatflux
2
[1036]3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later 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!
[1310]17! Copyright 1997-2014 Leibniz Universitaet Hannover
[1320]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[1322]21! ------------------
[1354]22!
23!
[1321]24! Former revisions:
25! -----------------
26! $Id: disturb_heatflux.f90 1354 2014-04-08 15:22:57Z raasch $
27!
[1354]28! 1353 2014-04-08 15:21:23Z heinze
29! REAL constants provided with KIND-attribute
30!
[1323]31! 1322 2014-03-20 16:38:49Z raasch
32! REAL constants defined as wp-kind
33!
[1321]34! 1320 2014-03-20 08:40:49Z raasch
[1320]35! ONLY-attribute added to USE-statements,
36! kind-parameters added to all INTEGER and REAL declaration statements,
37! kinds are defined in new module kinds,
38! revision history before 2012 removed,
39! comment fields (!:) to be used for variable explanations added to
40! all variable declaration statements
[1]41!
[1037]42! 1036 2012-10-22 13:43:42Z raasch
43! code put under GPL (PALM 3.9)
44!
[1]45! Revision 1.1  1998/03/25 20:03:47  raasch
46! Initial revision
47!
48!
49! Description:
50! ------------
51! Generate random, normally distributed heatflux values and store them as the
52! near-surface heatflux.
53! On parallel computers, too, this random generator is called at all grid points
54! of the total array in order to guarantee the same random distribution of the
55! total array regardless of the number of processors used during the model run.
56!------------------------------------------------------------------------------!
57
[1320]58    USE arrays_3d,                                                             &
59        ONLY:  shf
60       
61    USE control_parameters,                                                    &
62        ONLY:  iran, surface_heatflux, wall_heatflux
63       
64    USE cpulog,                                                                &
65        ONLY:  cpu_log, log_point
66       
67    USE kinds
68   
69    USE indices,                                                               &
70        ONLY:  nx, nxl, nxr, ny, nyn, nys, nzb_s_inner
[1]71
72    IMPLICIT NONE
73
[1320]74    INTEGER(iwp) ::  j  !:
75    INTEGER(iwp) ::  i  !:
76   
77    REAL(wp) ::  random_gauss  !:
78    REAL(wp) ::  randomnumber  !:
[1]79
80
81    CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
82
83!
84!-- Generate random disturbances and store them
85    DO  i = 0, nx
86       DO  j = 0, ny
[1322]87          randomnumber = random_gauss( iran, 5.0_wp )
[1320]88          IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j )   &
[1]89          THEN
90             IF ( nzb_s_inner(j,i) == 0 )  THEN
91                shf(j,i) = randomnumber * surface_heatflux
[555]92             ELSE
[1]93!
94!--             Over topography surface_heatflux is replaced by wall_heatflux(0)
95                shf(j,i) = randomnumber * wall_heatflux(0)
96             ENDIF
97          ENDIF
98       ENDDO
99    ENDDO
100
101!
102!-- Exchange lateral boundary conditions for the heatflux array
103    CALL exchange_horiz_2d( shf )
104
105    CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
106
107
108 END SUBROUTINE disturb_heatflux
Note: See TracBrowser for help on using the repository browser.