Home

Context Navigation

source: palm/trunk/SOURCE/diffusion_u.f90 @ 3798

Last change on this file since 3798 was 3655, checked in by knoop, 6 years ago
Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update
Property svn:keywords set to `Id`
File size: 26.2 KB

Line
1	!> @file diffusion_u.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: diffusion_u.f90 3655 2019-01-07 16:51:22Z hellstea $
27	! OpenACC port for SPEC
28	!
29	! 3547 2018-11-21 13:21:24Z suehring
30	! variables documented
31	!
32	! 3241 2018-09-12 15:02:00Z raasch
33	! unused variables removed
34	!
35	! 2718 2018-01-02 08:49:38Z maronga
36	! Corrected "Former revisions" section
37	!
38	! 2696 2017-12-14 17:12:51Z kanani
39	! Change in file header (GPL part)
40	!
41	! 2638 2017-11-23 12:44:23Z raasch
42	! bugfix for constant top momentumflux
43	!
44	! 2233 2017-05-30 18:08:54Z suehring
45	!
46	! 2232 2017-05-30 17:47:52Z suehring
47	! Adjustments to new topography and surface concept
48	!
49	! 2118 2017-01-17 16:38:49Z raasch
50	! OpenACC version of subroutine removed
51	!
52	! 2037 2016-10-26 11:15:40Z knoop
53	! Anelastic approximation implemented
54	!
55	! 2000 2016-08-20 18:09:15Z knoop
56	! Forced header and separation lines into 80 columns
57	!
58	! 1873 2016-04-18 14:50:06Z maronga
59	! Module renamed (removed _mod)
60	!
61	! 1850 2016-04-08 13:29:27Z maronga
62	! Module renamed
63	!
64	! 1740 2016-01-13 08:19:40Z raasch
65	! unnecessary calculations of kmzm and kmzp in wall bounded parts removed
66	!
67	! 1691 2015-10-26 16:17:44Z maronga
68	! Formatting corrections.
69	!
70	! 1682 2015-10-07 23:56:08Z knoop
71	! Code annotations made doxygen readable
72	!
73	! 1340 2014-03-25 19:45:13Z kanani
74	! REAL constants defined as wp-kind
75	!
76	! 1320 2014-03-20 08:40:49Z raasch
77	! ONLY-attribute added to USE-statements,
78	! kind-parameters added to all INTEGER and REAL declaration statements,
79	! kinds are defined in new module kinds,
80	! revision history before 2012 removed,
81	! comment fields (!:) to be used for variable explanations added to
82	! all variable declaration statements
83	!
84	! 1257 2013-11-08 15:18:40Z raasch
85	! openacc loop and loop vector clauses removed, declare create moved after
86	! the FORTRAN declaration statement
87	!
88	! 1128 2013-04-12 06:19:32Z raasch
89	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
90	! j_north
91	!
92	! 1036 2012-10-22 13:43:42Z raasch
93	! code put under GPL (PALM 3.9)
94	!
95	! 1015 2012-09-27 09:23:24Z raasch
96	! accelerator version (*_acc) added
97	!
98	! 1001 2012-09-13 14:08:46Z raasch
99	! arrays comunicated by module instead of parameter list
100	!
101	! 978 2012-08-09 08:28:32Z fricke
102	! outflow damping layer removed
103	! kmym_x/_y and kmyp_x/_y change to kmym and kmyp
104	!
105	! Revision 1.1 1997/09/12 06:23:51 raasch
106	! Initial revision
107	!
108	!
109	! Description:
110	! ------------
111	!> Diffusion term of the u-component
112	!> @todo additional damping (needed for non-cyclic bc) causes bad vectorization
113	!> and slows down the speed on NEC about 5-10%
114	!------------------------------------------------------------------------------!
115	MODULE diffusion_u_mod
116
117
118	PRIVATE
119	PUBLIC diffusion_u
120
121	INTERFACE diffusion_u
122	MODULE PROCEDURE diffusion_u
123	MODULE PROCEDURE diffusion_u_ij
124	END INTERFACE diffusion_u
125
126	CONTAINS
127
128
129	!------------------------------------------------------------------------------!
130	! Description:
131	! ------------
132	!> Call for all grid points
133	!------------------------------------------------------------------------------!
134	SUBROUTINE diffusion_u
135
136	USE arrays_3d, &
137	ONLY: ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
138
139	USE control_parameters, &
140	ONLY: constant_top_momentumflux, use_surface_fluxes, &
141	use_top_fluxes
142
143	USE grid_variables, &
144	ONLY: ddx, ddx2, ddy
145
146	USE indices, &
147	ONLY: nxlu, nxr, nyn, nys, nzb, nzt, wall_flags_0
148
149	USE kinds
150
151	USE surface_mod, &
152	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
153	surf_usm_v
154
155	IMPLICIT NONE
156
157	INTEGER(iwp) :: i !< running index x direction
158	INTEGER(iwp) :: j !< running index y direction
159	INTEGER(iwp) :: k !< running index z direction
160	INTEGER(iwp) :: l !< running index of surface type, south- or north-facing wall
161	INTEGER(iwp) :: m !< running index surface elements
162	INTEGER(iwp) :: surf_e !< end index of surface elements at (j,i)-gridpoint
163	INTEGER(iwp) :: surf_s !< start index of surface elements at (j,i)-gridpoint
164
165	REAL(wp) :: flag !< flag to mask topography grid points
166	REAL(wp) :: kmym !< diffusion coefficient on southward side of the u-gridbox - interpolated onto xu-yv grid
167	REAL(wp) :: kmyp !< diffusion coefficient on northward side of the u-gridbox - interpolated onto xu-yv grid
168	REAL(wp) :: kmzm !< diffusion coefficient on bottom of the gridbox - interpolated onto xu-zw grid
169	REAL(wp) :: kmzp !< diffusion coefficient on top of the gridbox - interpolated onto xu-zw grid
170	REAL(wp) :: mask_bottom !< flag to mask vertical upward-facing surface
171	REAL(wp) :: mask_north !< flag to mask vertical surface north of the grid point
172	REAL(wp) :: mask_south !< flag to mask vertical surface south of the grid point
173	REAL(wp) :: mask_top !< flag to mask vertical downward-facing surface
174
175
176
177	!$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) &
178	!$ACC PRIVATE(surf_e, surf_s, flag, kmym, kmyp, kmzm, kmzp) &
179	!$ACC PRIVATE(mask_bottom, mask_north, mask_south, mask_top) &
180	!$ACC PRESENT(wall_flags_0, km) &
181	!$ACC PRESENT(u, v, w) &
182	!$ACC PRESENT(ddzu, ddzw, drho_air, rho_air_zw) &
183	!$ACC PRESENT(surf_def_h(0:2), surf_def_v(0:1)) &
184	!$ACC PRESENT(surf_lsm_h, surf_lsm_v(0:1)) &
185	!$ACC PRESENT(surf_usm_h, surf_usm_v(0:1)) &
186	!$ACC PRESENT(tend)
187	DO i = nxlu, nxr
188	DO j = nys, nyn
189	!
190	!-- Compute horizontal diffusion
191	DO k = nzb+1, nzt
192	!
193	!-- Predetermine flag to mask topography and wall-bounded grid points.
194	!-- It is sufficient to masked only north- and south-facing surfaces, which
195	!-- need special treatment for the u-component.
196	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
197	mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
198	mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
199	!
200	!-- Interpolate eddy diffusivities on staggered gridpoints
201	kmyp = 0.25_wp * &
202	( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
203	kmym = 0.25_wp * &
204	( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
205
206	tend(k,j,i) = tend(k,j,i) &
207	+ 2.0_wp * ( &
208	km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
209	- km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
210	) * ddx2 * flag &
211	+ ( mask_north * ( &
212	kmyp * ( u(k,j+1,i) - u(k,j,i) ) * ddy &
213	+ kmyp * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
214	) &
215	- mask_south * ( &
216	kmym * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
217	+ kmym * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
218	) &
219	) * ddy * flag
220	ENDDO
221	!
222	!-- Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
223	!-- surfaces. Note, in the the flat case, loops won't be entered as
224	!-- start_index > end_index. Furtermore, note, no vertical natural surfaces
225	!-- so far.
226	!-- Default-type surfaces
227	DO l = 0, 1
228	surf_s = surf_def_v(l)%start_index(j,i)
229	surf_e = surf_def_v(l)%end_index(j,i)
230	DO m = surf_s, surf_e
231	k = surf_def_v(l)%k(m)
232	tend(k,j,i) = tend(k,j,i) + &
233	surf_def_v(l)%mom_flux_uv(m) * ddy
234	ENDDO
235	ENDDO
236	!
237	!-- Natural-type surfaces
238	DO l = 0, 1
239	surf_s = surf_lsm_v(l)%start_index(j,i)
240	surf_e = surf_lsm_v(l)%end_index(j,i)
241	DO m = surf_s, surf_e
242	k = surf_lsm_v(l)%k(m)
243	tend(k,j,i) = tend(k,j,i) + &
244	surf_lsm_v(l)%mom_flux_uv(m) * ddy
245	ENDDO
246	ENDDO
247	!
248	!-- Urban-type surfaces
249	DO l = 0, 1
250	surf_s = surf_usm_v(l)%start_index(j,i)
251	surf_e = surf_usm_v(l)%end_index(j,i)
252	DO m = surf_s, surf_e
253	k = surf_usm_v(l)%k(m)
254	tend(k,j,i) = tend(k,j,i) + &
255	surf_usm_v(l)%mom_flux_uv(m) * ddy
256	ENDDO
257	ENDDO
258
259	!
260	!-- Compute vertical diffusion. In case of simulating a surface layer,
261	!-- respective grid diffusive fluxes are masked (flag 8) within this
262	!-- loop, and added further below, else, simple gradient approach is
263	!-- applied. Model top is also mask if top-momentum flux is given.
264	DO k = nzb+1, nzt
265	!
266	!-- Determine flags to mask topography below and above. Flag 1 is
267	!-- used to mask topography in general, and flag 8 implies
268	!-- information about use_surface_fluxes. Flag 9 is used to control
269	!-- momentum flux at model top.
270	mask_bottom = MERGE( 1.0_wp, 0.0_wp, &
271	BTEST( wall_flags_0(k-1,j,i), 8 ) )
272	mask_top = MERGE( 1.0_wp, 0.0_wp, &
273	BTEST( wall_flags_0(k+1,j,i), 8 ) ) * &
274	MERGE( 1.0_wp, 0.0_wp, &
275	BTEST( wall_flags_0(k+1,j,i), 9 ) )
276	flag = MERGE( 1.0_wp, 0.0_wp, &
277	BTEST( wall_flags_0(k,j,i), 1 ) )
278	!
279	!-- Interpolate eddy diffusivities on staggered gridpoints
280	kmzp = 0.25_wp * &
281	( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
282	kmzm = 0.25_wp * &
283	( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
284
285	tend(k,j,i) = tend(k,j,i) &
286	+ ( kmzp * ( ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
287	+ ( w(k,j,i) - w(k,j,i-1) ) * ddx &
288	) * rho_air_zw(k) * mask_top &
289	- kmzm * ( ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
290	+ ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
291	) * rho_air_zw(k-1) * mask_bottom &
292	) * ddzw(k) * drho_air(k) * flag
293	ENDDO
294
295	!
296	!-- Vertical diffusion at the first grid point above the surface,
297	!-- if the momentum flux at the bottom is given by the Prandtl law or
298	!-- if it is prescribed by the user.
299	!-- Difference quotient of the momentum flux is not formed over half
300	!-- of the grid spacing (2.0*ddzw(k)) any more, since the comparison
301	!-- with other (LES) models showed that the values of the momentum
302	!-- flux becomes too large in this case.
303	!-- The term containing w(k-1,..) (see above equation) is removed here
304	!-- because the vertical velocity is assumed to be zero at the surface.
305	IF ( use_surface_fluxes ) THEN
306	!
307	!-- Default-type surfaces, upward-facing
308	surf_s = surf_def_h(0)%start_index(j,i)
309	surf_e = surf_def_h(0)%end_index(j,i)
310	DO m = surf_s, surf_e
311
312	k = surf_def_h(0)%k(m)
313
314	tend(k,j,i) = tend(k,j,i) &
315	+ ( - ( - surf_def_h(0)%usws(m) ) &
316	) * ddzw(k) * drho_air(k)
317	ENDDO
318	!
319	!-- Default-type surfaces, dowward-facing
320	surf_s = surf_def_h(1)%start_index(j,i)
321	surf_e = surf_def_h(1)%end_index(j,i)
322	DO m = surf_s, surf_e
323
324	k = surf_def_h(1)%k(m)
325
326	tend(k,j,i) = tend(k,j,i) &
327	+ ( - surf_def_h(1)%usws(m) &
328	) * ddzw(k) * drho_air(k)
329	ENDDO
330	!
331	!-- Natural-type surfaces, upward-facing
332	surf_s = surf_lsm_h%start_index(j,i)
333	surf_e = surf_lsm_h%end_index(j,i)
334	DO m = surf_s, surf_e
335
336	k = surf_lsm_h%k(m)
337
338	tend(k,j,i) = tend(k,j,i) &
339	+ ( - ( - surf_lsm_h%usws(m) ) &
340	) * ddzw(k) * drho_air(k)
341	ENDDO
342	!
343	!-- Urban-type surfaces, upward-facing
344	surf_s = surf_usm_h%start_index(j,i)
345	surf_e = surf_usm_h%end_index(j,i)
346	DO m = surf_s, surf_e
347
348	k = surf_usm_h%k(m)
349
350	tend(k,j,i) = tend(k,j,i) &
351	+ ( - ( - surf_usm_h%usws(m) ) &
352	) * ddzw(k) * drho_air(k)
353	ENDDO
354
355	ENDIF
356	!
357	!-- Add momentum flux at model top
358	IF ( use_top_fluxes .AND. constant_top_momentumflux ) THEN
359	surf_s = surf_def_h(2)%start_index(j,i)
360	surf_e = surf_def_h(2)%end_index(j,i)
361	DO m = surf_s, surf_e
362
363	k = surf_def_h(2)%k(m)
364
365	tend(k,j,i) = tend(k,j,i) &
366	+ ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
367	ENDDO
368	ENDIF
369
370	ENDDO
371	ENDDO
372
373	END SUBROUTINE diffusion_u
374
375
376	!------------------------------------------------------------------------------!
377	! Description:
378	! ------------
379	!> Call for grid point i,j
380	!------------------------------------------------------------------------------!
381	SUBROUTINE diffusion_u_ij( i, j )
382
383	USE arrays_3d, &
384	ONLY: ddzu, ddzw, km, tend, u, v, w, drho_air, rho_air_zw
385
386	USE control_parameters, &
387	ONLY: constant_top_momentumflux, use_surface_fluxes, &
388	use_top_fluxes
389
390	USE grid_variables, &
391	ONLY: ddx, ddx2, ddy
392
393	USE indices, &
394	ONLY: nzb, nzt, wall_flags_0
395
396	USE kinds
397
398	USE surface_mod, &
399	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
400	surf_usm_v
401
402	IMPLICIT NONE
403
404	INTEGER(iwp) :: i !< running index x direction
405	INTEGER(iwp) :: j !< running index y direction
406	INTEGER(iwp) :: k !< running index z direction
407	INTEGER(iwp) :: l !< running index of surface type, south- or north-facing wall
408	INTEGER(iwp) :: m !< running index surface elements
409	INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint
410	INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint
411
412	REAL(wp) :: flag !< flag to mask topography grid points
413	REAL(wp) :: kmym !< diffusion coefficient on southward side of the u-gridbox - interpolated onto xu-yv grid
414	REAL(wp) :: kmyp !<diffusion coefficient on northward side of the u-gridbox - interpolated onto xu-yv grid
415	REAL(wp) :: kmzm !< diffusion coefficient on bottom of the gridbox - interpolated onto xu-zw grid
416	REAL(wp) :: kmzp !< diffusion coefficient on top of the gridbox - interpolated onto xu-zw grid
417	REAL(wp) :: mask_bottom !< flag to mask vertical upward-facing surface
418	REAL(wp) :: mask_north !< flag to mask vertical surface north of the grid point
419	REAL(wp) :: mask_south !< flag to mask vertical surface south of the grid point
420	REAL(wp) :: mask_top !< flag to mask vertical downward-facing surface
421	!
422	!-- Compute horizontal diffusion
423	DO k = nzb+1, nzt
424	!
425	!-- Predetermine flag to mask topography and wall-bounded grid points.
426	!-- It is sufficient to masked only north- and south-facing surfaces, which
427	!-- need special treatment for the u-component.
428	flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
429	mask_south = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j-1,i), 1 ) )
430	mask_north = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j+1,i), 1 ) )
431	!
432	!-- Interpolate eddy diffusivities on staggered gridpoints
433	kmyp = 0.25_wp * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
434	kmym = 0.25_wp * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
435
436	tend(k,j,i) = tend(k,j,i) &
437	+ 2.0_wp * ( &
438	km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
439	- km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
440	) * ddx2 * flag &
441	+ ( &
442	mask_north * kmyp * ( ( u(k,j+1,i) - u(k,j,i) ) * ddy &
443	+ ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
444	) &
445	- mask_south * kmym * ( ( u(k,j,i) - u(k,j-1,i) ) * ddy &
446	+ ( v(k,j,i) - v(k,j,i-1) ) * ddx &
447	) &
448	) * ddy * flag
449	ENDDO
450
451	!
452	!-- Add horizontal momentum flux u'v' at north- (l=0) and south-facing (l=1)
453	!-- surfaces. Note, in the the flat case, loops won't be entered as
454	!-- start_index > end_index. Furtermore, note, no vertical natural surfaces
455	!-- so far.
456	!-- Default-type surfaces
457	DO l = 0, 1
458	surf_s = surf_def_v(l)%start_index(j,i)
459	surf_e = surf_def_v(l)%end_index(j,i)
460	DO m = surf_s, surf_e
461	k = surf_def_v(l)%k(m)
462	tend(k,j,i) = tend(k,j,i) + surf_def_v(l)%mom_flux_uv(m) * ddy
463	ENDDO
464	ENDDO
465	!
466	!-- Natural-type surfaces
467	DO l = 0, 1
468	surf_s = surf_lsm_v(l)%start_index(j,i)
469	surf_e = surf_lsm_v(l)%end_index(j,i)
470	DO m = surf_s, surf_e
471	k = surf_lsm_v(l)%k(m)
472	tend(k,j,i) = tend(k,j,i) + surf_lsm_v(l)%mom_flux_uv(m) * ddy
473	ENDDO
474	ENDDO
475	!
476	!-- Urban-type surfaces
477	DO l = 0, 1
478	surf_s = surf_usm_v(l)%start_index(j,i)
479	surf_e = surf_usm_v(l)%end_index(j,i)
480	DO m = surf_s, surf_e
481	k = surf_usm_v(l)%k(m)
482	tend(k,j,i) = tend(k,j,i) + surf_usm_v(l)%mom_flux_uv(m) * ddy
483	ENDDO
484	ENDDO
485	!
486	!-- Compute vertical diffusion. In case of simulating a surface layer,
487	!-- respective grid diffusive fluxes are masked (flag 8) within this
488	!-- loop, and added further below, else, simple gradient approach is
489	!-- applied. Model top is also mask if top-momentum flux is given.
490	DO k = nzb+1, nzt
491	!
492	!-- Determine flags to mask topography below and above. Flag 1 is
493	!-- used to mask topography in general, and flag 8 implies
494	!-- information about use_surface_fluxes. Flag 9 is used to control
495	!-- momentum flux at model top.
496	mask_bottom = MERGE( 1.0_wp, 0.0_wp, &
497	BTEST( wall_flags_0(k-1,j,i), 8 ) )
498	mask_top = MERGE( 1.0_wp, 0.0_wp, &
499	BTEST( wall_flags_0(k+1,j,i), 8 ) ) * &
500	MERGE( 1.0_wp, 0.0_wp, &
501	BTEST( wall_flags_0(k+1,j,i), 9 ) )
502	flag = MERGE( 1.0_wp, 0.0_wp, &
503	BTEST( wall_flags_0(k,j,i), 1 ) )
504	!
505	!-- Interpolate eddy diffusivities on staggered gridpoints
506	kmzp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
507	kmzm = 0.25_wp * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
508
509	tend(k,j,i) = tend(k,j,i) &
510	+ ( kmzp * ( ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
511	+ ( w(k,j,i) - w(k,j,i-1) ) * ddx &
512	) * rho_air_zw(k) * mask_top &
513	- kmzm * ( ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
514	+ ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
515	) * rho_air_zw(k-1) * mask_bottom &
516	) * ddzw(k) * drho_air(k) * flag
517	ENDDO
518
519	!
520	!-- Vertical diffusion at the first surface grid points, if the
521	!-- momentum flux at the bottom is given by the Prandtl law or if it is
522	!-- prescribed by the user.
523	!-- Difference quotient of the momentum flux is not formed over half of
524	!-- the grid spacing (2.0*ddzw(k)) any more, since the comparison with
525	!-- other (LES) models showed that the values of the momentum flux becomes
526	!-- too large in this case.
527	IF ( use_surface_fluxes ) THEN
528	!
529	!-- Default-type surfaces, upward-facing
530	surf_s = surf_def_h(0)%start_index(j,i)
531	surf_e = surf_def_h(0)%end_index(j,i)
532	DO m = surf_s, surf_e
533
534	k = surf_def_h(0)%k(m)
535
536	tend(k,j,i) = tend(k,j,i) &
537	+ ( - ( - surf_def_h(0)%usws(m) ) &
538	) * ddzw(k) * drho_air(k)
539	ENDDO
540	!
541	!-- Default-type surfaces, dowward-facing (except for model-top fluxes)
542	surf_s = surf_def_h(1)%start_index(j,i)
543	surf_e = surf_def_h(1)%end_index(j,i)
544	DO m = surf_s, surf_e
545
546	k = surf_def_h(1)%k(m)
547
548	tend(k,j,i) = tend(k,j,i) &
549	+ ( - surf_def_h(1)%usws(m) &
550	) * ddzw(k) * drho_air(k)
551	ENDDO
552	!
553	!-- Natural-type surfaces, upward-facing
554	surf_s = surf_lsm_h%start_index(j,i)
555	surf_e = surf_lsm_h%end_index(j,i)
556	DO m = surf_s, surf_e
557
558	k = surf_lsm_h%k(m)
559
560	tend(k,j,i) = tend(k,j,i) &
561	+ ( - ( - surf_lsm_h%usws(m) ) &
562	) * ddzw(k) * drho_air(k)
563	ENDDO
564	!
565	!-- Urban-type surfaces, upward-facing
566	surf_s = surf_usm_h%start_index(j,i)
567	surf_e = surf_usm_h%end_index(j,i)
568	DO m = surf_s, surf_e
569
570	k = surf_usm_h%k(m)
571
572	tend(k,j,i) = tend(k,j,i) &
573	+ ( - ( - surf_usm_h%usws(m) ) &
574	) * ddzw(k) * drho_air(k)
575	ENDDO
576
577	ENDIF
578	!
579	!-- Add momentum flux at model top
580	IF ( use_top_fluxes .AND. constant_top_momentumflux ) THEN
581	surf_s = surf_def_h(2)%start_index(j,i)
582	surf_e = surf_def_h(2)%end_index(j,i)
583	DO m = surf_s, surf_e
584
585	k = surf_def_h(2)%k(m)
586
587	tend(k,j,i) = tend(k,j,i) &
588	+ ( - surf_def_h(2)%usws(m) ) * ddzw(k) * drho_air(k)
589	ENDDO
590	ENDIF
591
592
593	END SUBROUTINE diffusion_u_ij
594
595	END MODULE diffusion_u_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |