Home

Context Navigation

source: palm/trunk/SOURCE/diffusion_v.f90 @ 3648

Last change on this file since 3648 was 3634, checked in by knoop, 6 years ago
OpenACC port for SPEC
Property svn:keywords set to `Id`
File size: 25.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |