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

Last change on this file since 3 was 3, checked in by raasch, 17 years ago

RCS Log replace by Id keyword, revision history cleaned up

File size: 1.6 KB
Line 
1 SUBROUTINE init_pt_anomaly
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id$
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.7  2005/03/26 20:36:55  raasch
14! Arguments for non-cyclic boundary conditions added to argument list of
15! routine exchange_horiz
16!
17! Revision 1.1  1997/08/29 08:58:56  raasch
18! Initial revision
19!
20!
21! Description:
22! ------------
23! Impose a temperature perturbation for an advection test.
24!------------------------------------------------------------------------------!
25
26    USE arrays_3d
27    USE constants
28    USE grid_variables
29    USE indices
30    USE control_parameters
31
32    IMPLICIT NONE
33
34    INTEGER ::  i, ic, j, jc, k, kc
35    REAL    ::  betrag, radius, rc, x, y, z
36
37!
38!-- Defaults: radius rc, strength z,
39!--           position of centre: ic, jc, kc
40    rc =  10.0 * dx
41    ic =  ( nx+1 ) / 2
42    jc =  ic
43    kc = nzt / 2
44
45!
46!-- Compute the perturbation.
47    DO  i = nxl, nxr
48       DO  j = nys, nyn
49          DO  k = nzb+1, nzt-1
50             x = ( i - ic ) * dx
51             y = ( j - jc ) * dy
52             z = ABS( zu(k) - zu(kc) )
53             radius = SQRT( x**2 + y**2 + z**2 )
54             IF ( radius <= rc )  THEN
55                betrag = 5.0 * EXP( -( radius / 2.0 )**2 )
56             ELSE
57                betrag = 0.0
58             ENDIF
59
60             pt(k,j,i) = pt(k,j,i) + betrag
61
62          ENDDO
63       ENDDO
64    ENDDO
65
66!
67!-- Exchange of boundary values for temperature
68    CALL exchange_horiz( pt, 0, 0 )
69
70
71 END SUBROUTINE init_pt_anomaly
Note: See TracBrowser for help on using the repository browser.