source: palm/trunk/SOURCE/init_pt_anomaly.f90 @ 861

Last change on this file since 861 was 861, checked in by suehring, 11 years ago

WS5 is available in combination with topography. Version number changed from 3.8 to 3.8a. Modification in init_pt_anomaly.

  • Property svn:keywords set to Id
File size: 1.9 KB
Line 
1 SUBROUTINE init_pt_anomaly
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7! Modification of the amplitude to obtain a visible temperature perturbation.
8!
9! Former revisions:
10! -----------------
11! $Id: init_pt_anomaly.f90 861 2012-03-26 14:18:34Z suehring $
12!
13! 667 2010-12-23 12:06:00Z suehring/gryschka
14! Call of exchange_horiz are modified.
15!
16! 75 2007-03-22 09:54:05Z raasch
17! 2nd+3rd argument removed from exchange horiz
18!
19! 19 2007-02-23 04:53:48Z raasch
20! Calculation extended for gridpoint nzt
21!
22! RCS Log replace by Id keyword, revision history cleaned up
23!
24! Revision 1.7  2005/03/26 20:36:55  raasch
25! Arguments for non-cyclic boundary conditions added to argument list of
26! routine exchange_horiz
27!
28! Revision 1.1  1997/08/29 08:58:56  raasch
29! Initial revision
30!
31!
32! Description:
33! ------------
34! Impose a temperature perturbation for an advection test.
35!------------------------------------------------------------------------------!
36
37    USE arrays_3d
38    USE constants
39    USE grid_variables
40    USE indices
41    USE control_parameters
42
43    IMPLICIT NONE
44
45    INTEGER ::  i, ic, j, jc, k, kc
46    REAL    ::  betrag, radius, rc, x, y, z
47
48!
49!-- Defaults: radius rc, strength z,
50!--           position of centre: ic, jc, kc
51    rc =  10.0 * dx
52    ic =  ( nx+1 ) / 2
53    jc =  ic
54    kc = nzt / 2
55
56!
57!-- Compute the perturbation.
58    DO  i = nxl, nxr
59       DO  j = nys, nyn
60          DO  k = nzb+1, nzt
61             x = ( i - ic ) * dx
62             y = ( j - jc ) * dy
63             z = ABS( zu(k) - zu(kc) )
64             radius = SQRT( x**2 + y**2 + z**2 )
65             IF ( radius <= rc )  THEN
66                betrag = 5.0 * EXP( -( radius * 0.001 / 2.0 )**2 )
67             ELSE
68                betrag = 0.0
69             ENDIF
70
71             pt(k,j,i) = pt(k,j,i) + betrag
72
73          ENDDO
74       ENDDO
75    ENDDO
76
77!
78!-- Exchange of boundary values for temperature
79    CALL exchange_horiz( pt, nbgp )
80
81
82 END SUBROUTINE init_pt_anomaly
Note: See TracBrowser for help on using the repository browser.