source: palm/trunk/SOURCE/advec_u_ups.f90 @ 415

Last change on this file since 415 was 198, checked in by raasch, 16 years ago

file headers updated for the next release 3.5

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