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

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

typo in file headers removed

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