source: palm/trunk/SOURCE/init_slope.f90 @ 550

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

typo in file headers removed

  • Property svn:keywords set to Id
File size: 3.3 KB
Line 
1 SUBROUTINE init_slope
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: init_slope.f90 484 2010-02-05 07:36:54Z maronga $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.5  2006/02/23 12:35:34  raasch
14! nanz_2dh renamed ngp_2dh
15!
16! Revision 1.1  2000/04/27 07:06:24  raasch
17! Initial revision
18!
19!
20! Description:
21! ------------
22! Initialization of the temperature field and other variables used in case
23! of a sloping surface.
24! Remember: when a sloping surface is used, only one constant temperature
25!           gradient is allowed!
26!------------------------------------------------------------------------------!
27
28    USE arrays_3d
29    USE constants
30    USE grid_variables
31    USE indices
32    USE pegrid
33    USE control_parameters
34
35    IMPLICIT NONE
36
37    INTEGER ::  i, j, k
38    REAL    ::  alpha, height, pt_value, radius
39    REAL, DIMENSION(:), ALLOCATABLE ::  pt_init_local
40
41!
42!-- Calculate reference temperature field needed for computing buoyancy
43    ALLOCATE( pt_slope_ref(nzb:nzt+1,nxl-1:nxr+1) )
44
45    DO  i = nxl-1, nxr+1
46       DO  k = nzb, nzt+1
47
48!
49!--       Compute height of grid-point relative to lower left corner of
50!--       the total domain.
51!--       First compute the distance between the actual grid point and the
52!--       lower left corner as well as the angle between the line connecting
53!--       these points and the bottom of the model.
54          IF ( k /= nzb )  THEN
55             radius = SQRT( ( i * dx )**2 + zu(k)**2 )
56             height = zu(k)
57          ELSE
58             radius = SQRT( ( i * dx )**2 )
59             height = 0.0
60          ENDIF
61          IF ( radius /= 0.0 )  THEN
62             alpha = ASIN( height / radius )
63          ELSE
64             alpha = 0.0
65          ENDIF
66!
67!--       Compute temperatures in the rotated coordinate system
68          alpha    = alpha + alpha_surface / 180.0 * pi
69          pt_value = pt_surface + radius * SIN( alpha ) * &
70                                  pt_vertical_gradient(1) / 100.0
71          pt_slope_ref(k,i) = pt_value
72       ENDDO               
73    ENDDO
74
75!
76!-- Temperature difference between left and right boundary of the total domain,
77!-- used for the cyclic boundary in x-direction
78    pt_slope_offset = (nx+1) * dx * sin_alpha_surface * &
79                      pt_vertical_gradient(1) / 100.0
80
81
82!
83!-- Following action must only be executed for initial runs
84    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
85!
86!--    Set initial temperature equal to the reference temperature field
87       DO  j = nys-1, nyn+1
88          pt(:,j,:) = pt_slope_ref
89       ENDDO
90
91!
92!--    Recompute the mean initial temperature profile (mean along x-direction of
93!--    the rotated coordinate system)
94       ALLOCATE( pt_init_local(nzb:nzt+1) )
95       pt_init_local = 0.0
96       DO  i = nxl, nxr
97          DO  j =  nys, nyn
98             DO  k = nzb, nzt+1
99                pt_init_local(k) = pt_init_local(k) + pt(k,j,i)
100             ENDDO
101          ENDDO
102      ENDDO
103
104#if defined( __parallel )
105      CALL MPI_ALLREDUCE( pt_init_local, pt_init, nzt+2-nzb, MPI_REAL, &
106                           MPI_SUM, comm2d, ierr )
107#else
108      pt_init = pt_init_local
109#endif
110
111      pt_init = pt_init / ngp_2dh(0)
112      DEALLOCATE( pt_init_local )
113
114   ENDIF
115
116 END SUBROUTINE init_slope
Note: See TracBrowser for help on using the repository browser.