Home

Context Navigation

source: palm/trunk/SOURCE/diffusion_w.f90 @ 993

Last change on this file since 993 was 979, checked in by fricke, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 12.3 KB

Line
1	MODULE diffusion_w_mod
2
3	!------------------------------------------------------------------------------!
4	! Current revisions:
5	! -----------------
6	!
7	!
8	! Former revisions:
9	! -----------------
10	! $Id: diffusion_w.f90 979 2012-08-09 08:50:11Z hoffmann $
11	!
12	! 978 2012-08-09 08:28:32Z fricke
13	! outflow damping layer removed
14	! kmxm_x/_z and kmxp_x/_z change to kmxm and kmxp
15	! kmym_y/_z and kmyp_y/_z change to kmym and kmyp
16	!
17	! 667 2010-12-23 12:06:00Z suehring/gryschka
18	! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
19	!
20	! 366 2009-08-25 08:06:27Z raasch
21	! bc_lr/bc_ns replaced by bc_lr_cyc/bc_ns_cyc
22	!
23	! 75 2007-03-22 09:54:05Z raasch
24	! Wall functions now include diabatic conditions, call of routine wall_fluxes,
25	! z0 removed from argument list
26	!
27	! 20 2007-02-26 00:12:32Z raasch
28	! Bugfix: ddzw dimensioned 1:nzt"+1"
29	!
30	! RCS Log replace by Id keyword, revision history cleaned up
31	!
32	! Revision 1.12 2006/02/23 10:38:03 raasch
33	! nzb_2d replaced by nzb_w_outer, wall functions added for all vertical walls,
34	! +z0 in argument list
35	! WARNING: loops containing the MAX function are still not properly vectorized!
36	!
37	! Revision 1.1 1997/09/12 06:24:11 raasch
38	! Initial revision
39	!
40	!
41	! Description:
42	! ------------
43	! Diffusion term of the w-component
44	!------------------------------------------------------------------------------!
45
46	USE wall_fluxes_mod
47
48	PRIVATE
49	PUBLIC diffusion_w
50
51	INTERFACE diffusion_w
52	MODULE PROCEDURE diffusion_w
53	MODULE PROCEDURE diffusion_w_ij
54	END INTERFACE diffusion_w
55
56	CONTAINS
57
58
59	!------------------------------------------------------------------------------!
60	! Call for all grid points
61	!------------------------------------------------------------------------------!
62	SUBROUTINE diffusion_w( ddzu, ddzw, km, tend, u, v, w )
63
64	USE control_parameters
65	USE grid_variables
66	USE indices
67
68	IMPLICIT NONE
69
70	INTEGER :: i, j, k
71	REAL :: kmxm, kmxp, kmym, kmyp
72	REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
73	REAL :: tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
74	REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
75	REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus, wsvs
76
77
78	!
79	!-- First calculate horizontal momentum flux w'u' and/or w'v' at vertical
80	!-- walls, if neccessary
81	IF ( topography /= 'flat' ) THEN
82	CALL wall_fluxes( wsus, 0.0, 0.0, 0.0, 1.0, nzb_w_inner, &
83	nzb_w_outer, wall_w_x )
84	CALL wall_fluxes( wsvs, 0.0, 0.0, 1.0, 0.0, nzb_w_inner, &
85	nzb_w_outer, wall_w_y )
86	ENDIF
87
88	DO i = nxl, nxr
89	DO j = nys, nyn
90	DO k = nzb_w_outer(j,i)+1, nzt-1
91	!
92	!-- Interpolate eddy diffusivities on staggered gridpoints
93	kmxp = 0.25 * &
94	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
95	kmxm = 0.25 * &
96	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
97	kmyp = 0.25 * &
98	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
99	kmym = 0.25 * &
100	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
101
102	tend(k,j,i) = tend(k,j,i) &
103	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
104	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
105	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
106	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
107	& ) * ddx &
108	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
109	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
110	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
111	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
112	& ) * ddy &
113	& + 2.0 * ( &
114	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
115	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
116	& ) * ddzu(k+1)
117	ENDDO
118
119	!
120	!-- Wall functions at all vertical walls, where necessary
121	IF ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) THEN
122
123	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
124	!
125	!-- Interpolate eddy diffusivities on staggered gridpoints
126	kmxp = 0.25 * &
127	( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
128	kmxm = 0.25 * &
129	( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
130	kmyp = 0.25 * &
131	( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
132	kmym = 0.25 * &
133	( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
134
135	tend(k,j,i) = tend(k,j,i) &
136	+ ( fwxp(j,i) * ( &
137	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
138	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
139	) &
140	- fwxm(j,i) * ( &
141	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
142	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
143	) &
144	+ wall_w_x(j,i) * wsus(k,j,i) &
145	) * ddx &
146	+ ( fwyp(j,i) * ( &
147	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
148	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
149	) &
150	- fwym(j,i) * ( &
151	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
152	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
153	) &
154	+ wall_w_y(j,i) * wsvs(k,j,i) &
155	) * ddy &
156	+ 2.0 * ( &
157	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
158	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
159	) * ddzu(k+1)
160	ENDDO
161	ENDIF
162
163	ENDDO
164	ENDDO
165
166	END SUBROUTINE diffusion_w
167
168
169	!------------------------------------------------------------------------------!
170	! Call for grid point i,j
171	!------------------------------------------------------------------------------!
172	SUBROUTINE diffusion_w_ij( i, j, ddzu, ddzw, km, tend, u, v, w )
173
174	USE control_parameters
175	USE grid_variables
176	USE indices
177
178	IMPLICIT NONE
179
180	INTEGER :: i, j, k
181	REAL :: kmxm, kmxp, kmym, kmyp
182	REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
183	REAL :: tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)
184	REAL, DIMENSION(nzb:nzt+1) :: wsus, wsvs
185	REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
186
187
188	DO k = nzb_w_outer(j,i)+1, nzt-1
189	!
190	!-- Interpolate eddy diffusivities on staggered gridpoints
191	kmxp = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
192	kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
193	kmyp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
194	kmym = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
195
196	tend(k,j,i) = tend(k,j,i) &
197	& + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
198	& + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
199	& - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
200	& - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
201	& ) * ddx &
202	& + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
203	& + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
204	& - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
205	& - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
206	& ) * ddy &
207	& + 2.0 * ( &
208	& km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
209	& - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
210	& ) * ddzu(k+1)
211	ENDDO
212
213	!
214	!-- Wall functions at all vertical walls, where necessary
215	IF ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) THEN
216
217	!
218	!-- Calculate the horizontal momentum fluxes w'u' and/or w'v'
219	IF ( wall_w_x(j,i) /= 0.0 ) THEN
220	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
221	wsus, 0.0, 0.0, 0.0, 1.0 )
222	ELSE
223	wsus = 0.0
224	ENDIF
225
226	IF ( wall_w_y(j,i) /= 0.0 ) THEN
227	CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
228	wsvs, 0.0, 0.0, 1.0, 0.0 )
229	ELSE
230	wsvs = 0.0
231	ENDIF
232
233	DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
234	!
235	!-- Interpolate eddy diffusivities on staggered gridpoints
236	kmxp = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
237	kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
238	kmyp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
239	kmym = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
240
241	tend(k,j,i) = tend(k,j,i) &
242	+ ( fwxp(j,i) * ( &
243	kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
244	+ kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
245	) &
246	- fwxm(j,i) * ( &
247	kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
248	+ kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
249	) &
250	+ wall_w_x(j,i) * wsus(k) &
251	) * ddx &
252	+ ( fwyp(j,i) * ( &
253	kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
254	+ kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
255	) &
256	- fwym(j,i) * ( &
257	kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
258	+ kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
259	) &
260	+ wall_w_y(j,i) * wsvs(k) &
261	) * ddy &
262	+ 2.0 * ( &
263	km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
264	- km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
265	) * ddzu(k+1)
266	ENDDO
267	ENDIF
268
269	END SUBROUTINE diffusion_w_ij
270
271	END MODULE diffusion_w_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |