source: palm/trunk/SOURCE/advec_s_ups.f90 @ 86

Last change on this file since 86 was 4, checked in by raasch, 18 years ago

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 5.1 KB
RevLine 
[1]1 SUBROUTINE advec_s_ups( s, var_char )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
[3]10! $Id: advec_s_ups.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
[1]13! Revision 1.6  2004/04/30 08:02:43  raasch
14! Enlarged transposition arrays introduced
15!
16! Revision 1.1  1999/02/05 08:44:47  raasch
17! Initial revision
18!
19!
20! Description:
21! ------------
22! Upstream-Spline advection of scalar quantities (potential temperature,
23! turbulent kinetic energy). The advection process is divided into three
24! subsequent steps, one for each of the dimensions. The result is stored as a
25! tendency in array tend. The computation of the cubic splines and the possible
26! execution of the Long-filter require that all grid points of the relevant
27! dimension are available. For model runs on more than one PE therefore both the
28! advected and the advecting quantities are transposed accordingly.
29!
30! Actual arguments:
31! s        = scalar quantity to be advected (remains unchanged in this UP)
32! var_char = character string specifying the quantity to be advected
33!
34! Internally used arrays:
35! v_ad     = scalar quantity to be advected, initialized = s at the beginning,
36!            also being used as temporary storage after each time step
37! d        = advecting component (u, v, or w)
38!------------------------------------------------------------------------------!
39
40    USE advection
41    USE arrays_3d
42    USE cpulog
43    USE grid_variables
44    USE indices
45    USE interfaces
46    USE control_parameters
47
48    IMPLICIT NONE
49
50    CHARACTER (LEN=*) ::  var_char
51
52    INTEGER ::  i, j, k
53    REAL    ::  s(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
54    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  v_ad
55
56    CALL cpu_log( log_point_s(16), 'advec_s_ups', 'start' )
57
58#if defined( __parallel )
59
60!
61!-- Advection of the scalar in x-direction:
62!-- Store the scalar in temporary array v_ad (component to be advected,
63!-- boundaries are not used because they disturb the transposition)
64    ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
65    v_ad = 0.0
66    v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = s(nzb+1:nzt,nys:nyn,nxl:nxr)
67
68!
69!-- Enlarge the size of tend, used as a working array for the transpositions
70    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
71       DEALLOCATE( tend )
72       ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
73    ENDIF
74
75!
76!-- Transpose the component to be advected: z --> x
77    CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
78
79#else
80
81!
82!-- Advection of the scalar in x-direction:
83!-- Store the scalar in temporary array v_ad (component to be advected)
84    ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
85    v_ad(:,:,:) = s(:,:,:)
86
87#endif
88
89!
90!-- Advecting component (u) must be averaged out on the scalar's grid
91    DO  i = nxl, nxr
92       DO  j = nys, nyn
93          DO  k = nzb+1, nzt
94              d(k,j,i) = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
95          ENDDO
96       ENDDO
97    ENDDO
98
99#if defined( __parallel )
100
101!
102!-- Transpose the advecting componnet: z --> x
103    CALL transpose_zx( d, tend, d, tend, d )
104
105#endif
106
107!
108!-- Upstream-Spline advection of the scalar in x-direction
109    CALL spline_x( v_ad, d, var_char )
110
111!
112!-- Advection of the scalar in y-direction:
113!-- advecting component (v) must be averaged out on the scalar's grid
114    DO  i = nxl, nxr
115       DO  j = nys, nyn
116          DO  k = nzb+1, nzt
117              d(k,j,i) = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
118          ENDDO
119       ENDDO
120    ENDDO
121
122#if defined( __parallel )
123   
124!
125!-- Transpose the advecting component: z --> y
126    CALL transpose_zx( d, tend, d, tend, d )
127    CALL transpose_xy( d, tend, d, tend, d )
128
129!
130!-- Transpose the component to be advected: x --> y
131    CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
132
133#endif
134
135!
136!-- Upstream-Spline advection of the scalar in y-direction
137    CALL spline_y( v_ad, d, var_char )
138
139!
140!-- Advection of the scalar in z-direction:
141!-- the advecting component (w) must be averaged out on the scalar's grid
142!-- (weighted for non-equidistant grid)
143    d = 0.0
144    DO  i = nxl, nxr
145       DO  j = nys, nyn
146          DO  k = nzb+1, nzt
147             d(k,j,i) =  ( w(k,j,i) * ( zu(k) - zw(k-1) ) + &
148                           w(k-1,j,i) * ( zw(k) - zu(k) ) ) * ddzw(k)
149          ENDDO
150       ENDDO
151    ENDDO
152
153#if defined( __parallel )
154
155!
156!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
157    CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
158    CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
159
160!
161!-- Resize tend to its normal size
162    IF ( nxra > nxr  .OR.  nyna > nyn  .OR.  nza > nz )  THEN
163       DEALLOCATE( tend )
164       ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
165    ENDIF
166
167#endif
168
169!
170!-- Upstream-Spline advection of the scalar in z-direction
171    CALL spline_z( v_ad, d, dzu, spl_tri_zu, var_char )
172
173!
174!-- Compute the tendency term
175    DO  i = nxl, nxr
176       DO  j = nys, nyn
177          DO  k = nzb+1, nzt
178             tend(k,j,i) = ( v_ad(k,j,i) - s(k,j,i) ) / dt_3d 
179          ENDDO
180       ENDDO
181    ENDDO
182
183    DEALLOCATE( v_ad )
184
185    CALL cpu_log( log_point_s(16), 'advec_s_ups', 'stop' )
186
187 END SUBROUTINE advec_s_ups
Note: See TracBrowser for help on using the repository browser.