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

Last change on this file since 757 was 556, checked in by raasch, 14 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 2.0 KB
RevLine 
[1]1 SUBROUTINE disturb_heatflux
2
3!------------------------------------------------------------------------------!
[484]4! Current revisions:
[1]5! -----------------
[556]6!
[1]7!
8! Former revisions:
9! -----------------
[3]10! $Id: disturb_heatflux.f90 556 2010-09-07 08:01:34Z helmke $
[556]11!
12! 555 2010-09-07 07:32:53Z raasch
13! Bugfix in if statement
14!
[3]15! RCS Log replace by Id keyword, revision history cleaned up
16!
[1]17! Revision 1.7  2006/08/04 14:35:07  raasch
18! Additional parameter in function random_gauss which limits the range of the
19! created random numbers, izuf renamed iran
20!
21! Revision 1.1  1998/03/25 20:03:47  raasch
22! Initial revision
23!
24!
25! Description:
26! ------------
27! Generate random, normally distributed heatflux values and store them as the
28! near-surface heatflux.
29! On parallel computers, too, this random generator is called at all grid points
30! of the total array in order to guarantee the same random distribution of the
31! total array regardless of the number of processors used during the model run.
32!------------------------------------------------------------------------------!
33
34    USE arrays_3d
35    USE control_parameters
36    USE cpulog
37    USE grid_variables
38    USE indices
39    USE interfaces
40
41    IMPLICIT NONE
42
43    INTEGER ::  i, j
44    REAL    ::  random_gauss, randomnumber
45
46
47    CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
48
49!
50!-- Generate random disturbances and store them
51    DO  i = 0, nx
52       DO  j = 0, ny
53          randomnumber = random_gauss( iran, 5.0 )
54          IF ( nxl <= i  .AND.  nxr >= i  .AND.  nys <= j  .AND.  nyn >= j ) &
55          THEN
56             IF ( nzb_s_inner(j,i) == 0 )  THEN
57                shf(j,i) = randomnumber * surface_heatflux
[555]58             ELSE
[1]59!
60!--             Over topography surface_heatflux is replaced by wall_heatflux(0)
61                shf(j,i) = randomnumber * wall_heatflux(0)
62             ENDIF
63          ENDIF
64       ENDDO
65    ENDDO
66
67!
68!-- Exchange lateral boundary conditions for the heatflux array
69    CALL exchange_horiz_2d( shf )
70
71    CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
72
73
74 END SUBROUTINE disturb_heatflux
Note: See TracBrowser for help on using the repository browser.