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

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

Initial repository layout and content

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