source: palm/tags/release-3.4a/SOURCE/advec_u_ups.f90 @ 141

Last change on this file since 141 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

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