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

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

preliminary update for changes concerning non-cyclic boundary conditions

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