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

Last change on this file since 561 was 484, checked in by raasch, 15 years ago

typo in file headers removed

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