Home

Context Navigation

source: palm/trunk/SOURCE/boundary_conds.f90 @ 2875

Last change on this file since 2875 was 2766, checked in by kanani, 7 years ago
Removal of chem directive, plus minor changes
Property svn:keywords set to `Id`
File size: 40.6 KB

Line
1	!> @file boundary_conds.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: boundary_conds.f90 2766 2018-01-22 17:17:47Z knoop $
27	! Removed preprocessor directive __chem
28	!
29	! 2718 2018-01-02 08:49:38Z maronga
30	! Corrected "Former revisions" section
31	!
32	! 2696 2017-12-14 17:12:51Z kanani
33	! Change in file header (GPL part)
34	! Adjust boundary conditions for e and diss in case of TKE-e closure (TG)
35	! Implementation of chemistry module (FK)
36	!
37	! 2569 2017-10-20 11:54:42Z kanani
38	! Removed redundant code for ibc_s_b=1 and ibc_q_b=1
39	!
40	! 2365 2017-08-21 14:59:59Z kanani
41	! Vertical grid nesting implemented: exclude setting vertical velocity to zero
42	! on fine grid (SadiqHuq)
43	!
44	! 2320 2017-07-21 12:47:43Z suehring
45	! Remove unused control parameter large_scale_forcing from only-list
46	!
47	! 2292 2017-06-20 09:51:42Z schwenkel
48	! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
49	! includes two more prognostic equations for cloud drop concentration (nc)
50	! and cloud water content (qc).
51	!
52	! 2233 2017-05-30 18:08:54Z suehring
53	!
54	! 2232 2017-05-30 17:47:52Z suehring
55	! Set boundary conditions on topography top using flag method.
56	!
57	! 2118 2017-01-17 16:38:49Z raasch
58	! OpenACC directives removed
59	!
60	! 2000 2016-08-20 18:09:15Z knoop
61	! Forced header and separation lines into 80 columns
62	!
63	! 1992 2016-08-12 15:14:59Z suehring
64	! Adjustments for top boundary condition for passive scalar
65	!
66	! 1960 2016-07-12 16:34:24Z suehring
67	! Treat humidity and passive scalar separately
68	!
69	! 1823 2016-04-07 08:57:52Z hoffmann
70	! Initial version of purely vertical nesting introduced.
71	!
72	! 1822 2016-04-07 07:49:42Z hoffmann
73	! icloud_scheme removed. microphyisics_seifert added.
74	!
75	! 1764 2016-02-28 12:45:19Z raasch
76	! index bug for u_p at left outflow removed
77	!
78	! 1762 2016-02-25 12:31:13Z hellstea
79	! Introduction of nested domain feature
80	!
81	! 1742 2016-01-13 09:50:06Z raasch
82	! bugfix for outflow Neumann boundary conditions at bottom and top
83	!
84	! 1717 2015-11-11 15:09:47Z raasch
85	! Bugfix: index error in outflow conditions for left boundary
86	!
87	! 1682 2015-10-07 23:56:08Z knoop
88	! Code annotations made doxygen readable
89	!
90	! 1410 2014-05-23 12:16:18Z suehring
91	! Bugfix: set dirichlet boundary condition for passive_scalar at model domain
92	! top
93	!
94	! 1399 2014-05-07 11:16:25Z heinze
95	! Bugfix: set inflow boundary conditions also if no humidity or passive_scalar
96	! is used.
97	!
98	! 1398 2014-05-07 11:15:00Z heinze
99	! Dirichlet-condition at the top for u and v changed to u_init and v_init also
100	! for large_scale_forcing
101	!
102	! 1380 2014-04-28 12:40:45Z heinze
103	! Adjust Dirichlet-condition at the top for pt in case of nudging
104	!
105	! 1361 2014-04-16 15:17:48Z hoffmann
106	! Bottom and top boundary conditions of rain water content (qr) and
107	! rain drop concentration (nr) changed to Dirichlet
108	!
109	! 1353 2014-04-08 15:21:23Z heinze
110	! REAL constants provided with KIND-attribute
111	!
112	! 1320 2014-03-20 08:40:49Z raasch
113	! ONLY-attribute added to USE-statements,
114	! kind-parameters added to all INTEGER and REAL declaration statements,
115	! kinds are defined in new module kinds,
116	! revision history before 2012 removed,
117	! comment fields (!:) to be used for variable explanations added to
118	! all variable declaration statements
119	!
120	! 1257 2013-11-08 15:18:40Z raasch
121	! loop independent clauses added
122	!
123	! 1241 2013-10-30 11:36:58Z heinze
124	! Adjust ug and vg at each timestep in case of large_scale_forcing
125	!
126	! 1159 2013-05-21 11:58:22Z fricke
127	! Bugfix: Neumann boundary conditions for the velocity components at the
128	! outflow are in fact radiation boundary conditions using the maximum phase
129	! velocity that ensures numerical stability (CFL-condition).
130	! Hence, logical operator use_cmax is now used instead of bc_lr_dirneu/_neudir.
131	! Bugfix: In case of use_cmax at the outflow, u, v, w are replaced by
132	! u_p, v_p, w_p
133	!
134	! 1115 2013-03-26 18:16:16Z hoffmann
135	! boundary conditions of two-moment cloud scheme are restricted to Neumann-
136	! boundary-conditions
137	!
138	! 1113 2013-03-10 02:48:14Z raasch
139	! GPU-porting
140	! dummy argument "range" removed
141	! Bugfix: wrong index in loops of radiation boundary condition
142	!
143	! 1053 2012-11-13 17:11:03Z hoffmann
144	! boundary conditions for the two new prognostic equations (nr, qr) of the
145	! two-moment cloud scheme
146	!
147	! 1036 2012-10-22 13:43:42Z raasch
148	! code put under GPL (PALM 3.9)
149	!
150	! 996 2012-09-07 10:41:47Z raasch
151	! little reformatting
152	!
153	! 978 2012-08-09 08:28:32Z fricke
154	! Neumann boudnary conditions are added at the inflow boundary for the SGS-TKE.
155	! Outflow boundary conditions for the velocity components can be set to Neumann
156	! conditions or to radiation conditions with a horizontal averaged phase
157	! velocity.
158	!
159	! 875 2012-04-02 15:35:15Z gryschka
160	! Bugfix in case of dirichlet inflow bc at the right or north boundary
161	!
162	! Revision 1.1 1997/09/12 06:21:34 raasch
163	! Initial revision
164	!
165	!
166	! Description:
167	! ------------
168	!> Boundary conditions for the prognostic quantities.
169	!> One additional bottom boundary condition is applied for the TKE (=(u)*2)
170	!> in prandtl_fluxes. The cyclic lateral boundary conditions are implicitly
171	!> handled in routine exchange_horiz. Pressure boundary conditions are
172	!> explicitly set in routines pres, poisfft, poismg and sor.
173	!------------------------------------------------------------------------------!
174	SUBROUTINE boundary_conds
175
176
177	USE arrays_3d, &
178	ONLY: c_u, c_u_m, c_u_m_l, c_v, c_v_m, c_v_m_l, c_w, c_w_m, c_w_m_l, &
179	diss_p, dzu, e_p, nc_p, nr_p, pt, pt_p, q, q_p, qc_p, qr_p, s, &
180	s_p, sa, sa_p, u, ug, u_init, u_m_l, u_m_n, u_m_r, u_m_s, u_p, &
181	v, vg, v_init, v_m_l, v_m_n, v_m_r, v_m_s, v_p, &
182	w, w_p, w_m_l, w_m_n, w_m_r, w_m_s, pt_init
183
184	USE chemistry_model_mod, &
185	ONLY: chem_boundary_conds
186
187	USE control_parameters, &
188	ONLY: air_chemistry, bc_pt_t_val, bc_q_t_val, bc_s_t_val, &
189	constant_diffusion, cloud_physics, coupling_mode, dt_3d, &
190	force_bound_l, force_bound_s, forcing, humidity, &
191	ibc_pt_b, ibc_pt_t, ibc_q_b, ibc_q_t, ibc_s_b, ibc_s_t, &
192	ibc_sa_t, ibc_uv_b, ibc_uv_t, inflow_l, inflow_n, inflow_r, &
193	inflow_s, intermediate_timestep_count, &
194	microphysics_morrison, microphysics_seifert, nest_domain, &
195	nest_bound_l, nest_bound_s, nudging, ocean, outflow_l, &
196	outflow_n, outflow_r, outflow_s, passive_scalar, rans_tke_e, &
197	tsc, use_cmax
198
199	USE grid_variables, &
200	ONLY: ddx, ddy, dx, dy
201
202	USE indices, &
203	ONLY: nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
204	nzb, nzt, wall_flags_0
205
206	USE kinds
207
208	USE pegrid
209
210	USE pmc_interface, &
211	ONLY : nesting_mode
212
213	USE surface_mod, &
214	ONLY : bc_h
215
216	IMPLICIT NONE
217
218	INTEGER(iwp) :: i !< grid index x direction
219	INTEGER(iwp) :: j !< grid index y direction
220	INTEGER(iwp) :: k !< grid index z direction
221	INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on facing.
222	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls
223	INTEGER(iwp) :: m !< running index surface elements
224
225	REAL(wp) :: c_max !<
226	REAL(wp) :: denom !<
227
228
229	!
230	!-- Bottom boundary
231	IF ( ibc_uv_b == 1 ) THEN
232	u_p(nzb,:,:) = u_p(nzb+1,:,:)
233	v_p(nzb,:,:) = v_p(nzb+1,:,:)
234	ENDIF
235	!
236	!-- Set zero vertical velocity at topography top (l=0), or bottom (l=1) in case
237	!-- of downward-facing surfaces.
238	DO l = 0, 1
239	!
240	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
241	!-- for downward-facing surfaces at topography bottom (k+1).
242	kb = MERGE( -1, 1, l == 0 )
243	!$OMP PARALLEL DO PRIVATE( i, j, k )
244	DO m = 1, bc_h(l)%ns
245	i = bc_h(l)%i(m)
246	j = bc_h(l)%j(m)
247	k = bc_h(l)%k(m)
248	w_p(k+kb,j,i) = 0.0_wp
249	ENDDO
250	ENDDO
251
252	!
253	!-- Top boundary. A nested domain ( ibc_uv_t = 3 ) does not require settings.
254	IF ( ibc_uv_t == 0 ) THEN
255	u_p(nzt+1,:,:) = u_init(nzt+1)
256	v_p(nzt+1,:,:) = v_init(nzt+1)
257	ELSEIF ( ibc_uv_t == 1 ) THEN
258	u_p(nzt+1,:,:) = u_p(nzt,:,:)
259	v_p(nzt+1,:,:) = v_p(nzt,:,:)
260	ENDIF
261
262	!
263	!-- Vertical nesting: Vertical velocity not zero at the top of the fine grid
264	IF ( .NOT. nest_domain .AND. &
265	TRIM(coupling_mode) /= 'vnested_fine' ) THEN
266	w_p(nzt:nzt+1,:,:) = 0.0_wp !< nzt is not a prognostic level (but cf. pres)
267	ENDIF
268
269	!
270	!-- Temperature at bottom and top boundary.
271	!-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by
272	!-- the sea surface temperature of the coupled ocean model.
273	!-- Dirichlet
274	IF ( ibc_pt_b == 0 ) THEN
275	DO l = 0, 1
276	!
277	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
278	!-- for downward-facing surfaces at topography bottom (k+1).
279	kb = MERGE( -1, 1, l == 0 )
280	!$OMP PARALLEL DO PRIVATE( i, j, k )
281	DO m = 1, bc_h(l)%ns
282	i = bc_h(l)%i(m)
283	j = bc_h(l)%j(m)
284	k = bc_h(l)%k(m)
285	pt_p(k+kb,j,i) = pt(k+kb,j,i)
286	ENDDO
287	ENDDO
288	!
289	!-- Neumann, zero-gradient
290	ELSEIF ( ibc_pt_b == 1 ) THEN
291	DO l = 0, 1
292	!
293	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
294	!-- for downward-facing surfaces at topography bottom (k+1).
295	kb = MERGE( -1, 1, l == 0 )
296	!$OMP PARALLEL DO PRIVATE( i, j, k )
297	DO m = 1, bc_h(l)%ns
298	i = bc_h(l)%i(m)
299	j = bc_h(l)%j(m)
300	k = bc_h(l)%k(m)
301	pt_p(k+kb,j,i) = pt_p(k,j,i)
302	ENDDO
303	ENDDO
304	ENDIF
305
306	!
307	!-- Temperature at top boundary
308	IF ( ibc_pt_t == 0 ) THEN
309	pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
310	!
311	!-- In case of nudging adjust top boundary to pt which is
312	!-- read in from NUDGING-DATA
313	IF ( nudging ) THEN
314	pt_p(nzt+1,:,:) = pt_init(nzt+1)
315	ENDIF
316	ELSEIF ( ibc_pt_t == 1 ) THEN
317	pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
318	ELSEIF ( ibc_pt_t == 2 ) THEN
319	pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
320	ENDIF
321
322	!
323	!-- Boundary conditions for TKE
324	!-- Generally Neumann conditions with de/dz=0 are assumed
325	IF ( .NOT. constant_diffusion ) THEN
326
327	IF ( .NOT. rans_tke_e ) THEN
328	DO l = 0, 1
329	!
330	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
331	!-- for downward-facing surfaces at topography bottom (k+1).
332	kb = MERGE( -1, 1, l == 0 )
333	!$OMP PARALLEL DO PRIVATE( i, j, k )
334	DO m = 1, bc_h(l)%ns
335	i = bc_h(l)%i(m)
336	j = bc_h(l)%j(m)
337	k = bc_h(l)%k(m)
338	e_p(k+kb,j,i) = e_p(k,j,i)
339	ENDDO
340	ENDDO
341	ENDIF
342
343	IF ( .NOT. nest_domain ) THEN
344	e_p(nzt+1,:,:) = e_p(nzt,:,:)
345	ENDIF
346	ENDIF
347
348	!
349	!-- Boundary conditions for TKE dissipation rate
350	IF ( rans_tke_e .AND. .NOT. nest_domain ) THEN
351	diss_p(nzt+1,:,:) = diss_p(nzt,:,:)
352	ENDIF
353
354	!
355	!-- Boundary conditions for salinity
356	IF ( ocean ) THEN
357	!
358	!-- Bottom boundary: Neumann condition because salinity flux is always
359	!-- given.
360	DO l = 0, 1
361	!
362	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
363	!-- for downward-facing surfaces at topography bottom (k+1).
364	kb = MERGE( -1, 1, l == 0 )
365	!$OMP PARALLEL DO PRIVATE( i, j, k )
366	DO m = 1, bc_h(l)%ns
367	i = bc_h(l)%i(m)
368	j = bc_h(l)%j(m)
369	k = bc_h(l)%k(m)
370	sa_p(k+kb,j,i) = sa_p(k,j,i)
371	ENDDO
372	ENDDO
373	!
374	!-- Top boundary: Dirichlet or Neumann
375	IF ( ibc_sa_t == 0 ) THEN
376	sa_p(nzt+1,:,:) = sa(nzt+1,:,:)
377	ELSEIF ( ibc_sa_t == 1 ) THEN
378	sa_p(nzt+1,:,:) = sa_p(nzt,:,:)
379	ENDIF
380
381	ENDIF
382
383	!
384	!-- Boundary conditions for total water content,
385	!-- bottom and top boundary (see also temperature)
386	IF ( humidity ) THEN
387	!
388	!-- Surface conditions for constant_humidity_flux
389	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
390	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
391	!-- q_p at k-1
392	IF ( ibc_q_b == 0 ) THEN
393
394	DO l = 0, 1
395	!
396	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
397	!-- for downward-facing surfaces at topography bottom (k+1).
398	kb = MERGE( -1, 1, l == 0 )
399	!$OMP PARALLEL DO PRIVATE( i, j, k )
400	DO m = 1, bc_h(l)%ns
401	i = bc_h(l)%i(m)
402	j = bc_h(l)%j(m)
403	k = bc_h(l)%k(m)
404	q_p(k+kb,j,i) = q(k+kb,j,i)
405	ENDDO
406	ENDDO
407
408	ELSE
409
410	DO l = 0, 1
411	!
412	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
413	!-- for downward-facing surfaces at topography bottom (k+1).
414	kb = MERGE( -1, 1, l == 0 )
415	!$OMP PARALLEL DO PRIVATE( i, j, k )
416	DO m = 1, bc_h(l)%ns
417	i = bc_h(l)%i(m)
418	j = bc_h(l)%j(m)
419	k = bc_h(l)%k(m)
420	q_p(k+kb,j,i) = q_p(k,j,i)
421	ENDDO
422	ENDDO
423	ENDIF
424	!
425	!-- Top boundary
426	IF ( ibc_q_t == 0 ) THEN
427	q_p(nzt+1,:,:) = q(nzt+1,:,:)
428	ELSEIF ( ibc_q_t == 1 ) THEN
429	q_p(nzt+1,:,:) = q_p(nzt,:,:) + bc_q_t_val * dzu(nzt+1)
430	ENDIF
431
432	IF ( cloud_physics .AND. microphysics_morrison ) THEN
433	!
434	!-- Surface conditions cloud water (Dirichlet)
435	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
436	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
437	!-- qr_p and nr_p at k-1
438	!$OMP PARALLEL DO PRIVATE( i, j, k )
439	DO m = 1, bc_h(0)%ns
440	i = bc_h(0)%i(m)
441	j = bc_h(0)%j(m)
442	k = bc_h(0)%k(m)
443	qc_p(k-1,j,i) = 0.0_wp
444	nc_p(k-1,j,i) = 0.0_wp
445	ENDDO
446	!
447	!-- Top boundary condition for cloud water (Dirichlet)
448	qc_p(nzt+1,:,:) = 0.0_wp
449	nc_p(nzt+1,:,:) = 0.0_wp
450
451	ENDIF
452
453	IF ( cloud_physics .AND. microphysics_seifert ) THEN
454	!
455	!-- Surface conditions rain water (Dirichlet)
456	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
457	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
458	!-- qr_p and nr_p at k-1
459	!$OMP PARALLEL DO PRIVATE( i, j, k )
460	DO m = 1, bc_h(0)%ns
461	i = bc_h(0)%i(m)
462	j = bc_h(0)%j(m)
463	k = bc_h(0)%k(m)
464	qr_p(k-1,j,i) = 0.0_wp
465	nr_p(k-1,j,i) = 0.0_wp
466	ENDDO
467	!
468	!-- Top boundary condition for rain water (Dirichlet)
469	qr_p(nzt+1,:,:) = 0.0_wp
470	nr_p(nzt+1,:,:) = 0.0_wp
471
472	ENDIF
473	ENDIF
474	!
475	!-- Boundary conditions for scalar,
476	!-- bottom and top boundary (see also temperature)
477	IF ( passive_scalar ) THEN
478	!
479	!-- Surface conditions for constant_humidity_flux
480	!-- Run loop over all non-natural and natural walls. Note, in wall-datatype
481	!-- the k coordinate belongs to the atmospheric grid point, therefore, set
482	!-- s_p at k-1
483	IF ( ibc_s_b == 0 ) THEN
484
485	DO l = 0, 1
486	!
487	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
488	!-- for downward-facing surfaces at topography bottom (k+1).
489	kb = MERGE( -1, 1, l == 0 )
490	!$OMP PARALLEL DO PRIVATE( i, j, k )
491	DO m = 1, bc_h(l)%ns
492	i = bc_h(l)%i(m)
493	j = bc_h(l)%j(m)
494	k = bc_h(l)%k(m)
495	s_p(k+kb,j,i) = s(k+kb,j,i)
496	ENDDO
497	ENDDO
498
499	ELSE
500
501	DO l = 0, 1
502	!
503	!-- Set kb, for upward-facing surfaces value at topography top (k-1) is set,
504	!-- for downward-facing surfaces at topography bottom (k+1).
505	kb = MERGE( -1, 1, l == 0 )
506	!$OMP PARALLEL DO PRIVATE( i, j, k )
507	DO m = 1, bc_h(l)%ns
508	i = bc_h(l)%i(m)
509	j = bc_h(l)%j(m)
510	k = bc_h(l)%k(m)
511	s_p(k+kb,j,i) = s_p(k,j,i)
512	ENDDO
513	ENDDO
514	ENDIF
515	!
516	!-- Top boundary condition
517	IF ( ibc_s_t == 0 ) THEN
518	s_p(nzt+1,:,:) = s(nzt+1,:,:)
519	ELSEIF ( ibc_s_t == 1 ) THEN
520	s_p(nzt+1,:,:) = s_p(nzt,:,:)
521	ELSEIF ( ibc_s_t == 2 ) THEN
522	s_p(nzt+1,:,:) = s_p(nzt,:,:) + bc_s_t_val * dzu(nzt+1)
523	ENDIF
524
525	ENDIF
526	!
527	!-- Top/bottom boundary conditions for chemical species
528	IF ( air_chemistry ) CALL chem_boundary_conds( 'set_bc_bottomtop' )
529	!
530	!-- In case of inflow or nest boundary at the south boundary the boundary for v
531	!-- is at nys and in case of inflow or nest boundary at the left boundary the
532	!-- boundary for u is at nxl. Since in prognostic_equations (cache optimized
533	!-- version) these levels are handled as a prognostic level, boundary values
534	!-- have to be restored here.
535	!-- For the SGS-TKE, Neumann boundary conditions are used at the inflow.
536	IF ( inflow_s ) THEN
537	v_p(:,nys,:) = v_p(:,nys-1,:)
538	IF ( .NOT. constant_diffusion ) e_p(:,nys-1,:) = e_p(:,nys,:)
539	ELSEIF ( inflow_n ) THEN
540	IF ( .NOT. constant_diffusion ) e_p(:,nyn+1,:) = e_p(:,nyn,:)
541	ELSEIF ( inflow_l ) THEN
542	u_p(:,:,nxl) = u_p(:,:,nxl-1)
543	IF ( .NOT. constant_diffusion ) e_p(:,:,nxl-1) = e_p(:,:,nxl)
544	ELSEIF ( inflow_r ) THEN
545	IF ( .NOT. constant_diffusion ) e_p(:,:,nxr+1) = e_p(:,:,nxr)
546	ENDIF
547
548	!
549	!-- The same restoration for u at i=nxl and v at j=nys as above must be made
550	!-- in case of nest boundaries. This must not be done in case of vertical nesting
551	!-- mode as in that case the lateral boundaries are actually cyclic.
552	IF ( nesting_mode /= 'vertical' .OR. forcing ) THEN
553	IF ( nest_bound_s .OR. force_bound_s ) THEN
554	v_p(:,nys,:) = v_p(:,nys-1,:)
555	ENDIF
556	IF ( nest_bound_l .OR. force_bound_l ) THEN
557	u_p(:,:,nxl) = u_p(:,:,nxl-1)
558	ENDIF
559	ENDIF
560
561	!
562	!-- Lateral boundary conditions for scalar quantities at the outflow
563	IF ( outflow_s ) THEN
564	pt_p(:,nys-1,:) = pt_p(:,nys,:)
565	IF ( .NOT. constant_diffusion ) e_p(:,nys-1,:) = e_p(:,nys,:)
566	IF ( rans_tke_e ) diss_p(:,nys-1,:) = diss_p(:,nys,:)
567	IF ( humidity ) THEN
568	q_p(:,nys-1,:) = q_p(:,nys,:)
569	IF ( cloud_physics .AND. microphysics_morrison ) THEN
570	qc_p(:,nys-1,:) = qc_p(:,nys,:)
571	nc_p(:,nys-1,:) = nc_p(:,nys,:)
572	ENDIF
573	IF ( cloud_physics .AND. microphysics_seifert ) THEN
574	qr_p(:,nys-1,:) = qr_p(:,nys,:)
575	nr_p(:,nys-1,:) = nr_p(:,nys,:)
576	ENDIF
577	ENDIF
578	IF ( passive_scalar ) s_p(:,nys-1,:) = s_p(:,nys,:)
579	ELSEIF ( outflow_n ) THEN
580	pt_p(:,nyn+1,:) = pt_p(:,nyn,:)
581	IF ( .NOT. constant_diffusion ) e_p(:,nyn+1,:) = e_p(:,nyn,:)
582	IF ( rans_tke_e ) diss_p(:,nyn+1,:) = diss_p(:,nyn,:)
583	IF ( humidity ) THEN
584	q_p(:,nyn+1,:) = q_p(:,nyn,:)
585	IF ( cloud_physics .AND. microphysics_morrison ) THEN
586	qc_p(:,nyn+1,:) = qc_p(:,nyn,:)
587	nc_p(:,nyn+1,:) = nc_p(:,nyn,:)
588	ENDIF
589	IF ( cloud_physics .AND. microphysics_seifert ) THEN
590	qr_p(:,nyn+1,:) = qr_p(:,nyn,:)
591	nr_p(:,nyn+1,:) = nr_p(:,nyn,:)
592	ENDIF
593	ENDIF
594	IF ( passive_scalar ) s_p(:,nyn+1,:) = s_p(:,nyn,:)
595	ELSEIF ( outflow_l ) THEN
596	pt_p(:,:,nxl-1) = pt_p(:,:,nxl)
597	IF ( .NOT. constant_diffusion ) e_p(:,:,nxl-1) = e_p(:,:,nxl)
598	IF ( rans_tke_e ) diss_p(:,:,nxl-1) = diss_p(:,:,nxl)
599	IF ( humidity ) THEN
600	q_p(:,:,nxl-1) = q_p(:,:,nxl)
601	IF ( cloud_physics .AND. microphysics_morrison ) THEN
602	qc_p(:,:,nxl-1) = qc_p(:,:,nxl)
603	nc_p(:,:,nxl-1) = nc_p(:,:,nxl)
604	ENDIF
605	IF ( cloud_physics .AND. microphysics_seifert ) THEN
606	qr_p(:,:,nxl-1) = qr_p(:,:,nxl)
607	nr_p(:,:,nxl-1) = nr_p(:,:,nxl)
608	ENDIF
609	ENDIF
610	IF ( passive_scalar ) s_p(:,:,nxl-1) = s_p(:,:,nxl)
611	ELSEIF ( outflow_r ) THEN
612	pt_p(:,:,nxr+1) = pt_p(:,:,nxr)
613	IF ( .NOT. constant_diffusion ) e_p(:,:,nxr+1) = e_p(:,:,nxr)
614	IF ( rans_tke_e ) diss_p(:,:,nxr+1) = diss_p(:,:,nxr)
615	IF ( humidity ) THEN
616	q_p(:,:,nxr+1) = q_p(:,:,nxr)
617	IF ( cloud_physics .AND. microphysics_morrison ) THEN
618	qc_p(:,:,nxr+1) = qc_p(:,:,nxr)
619	nc_p(:,:,nxr+1) = nc_p(:,:,nxr)
620	ENDIF
621	IF ( cloud_physics .AND. microphysics_seifert ) THEN
622	qr_p(:,:,nxr+1) = qr_p(:,:,nxr)
623	nr_p(:,:,nxr+1) = nr_p(:,:,nxr)
624	ENDIF
625	ENDIF
626	IF ( passive_scalar ) s_p(:,:,nxr+1) = s_p(:,:,nxr)
627	ENDIF
628
629	!
630	!-- Lateral boundary conditions for chemical species
631	IF ( air_chemistry ) CALL chem_boundary_conds( 'set_bc_lateral' )
632
633	!
634	!-- Radiation boundary conditions for the velocities at the respective outflow.
635	!-- The phase velocity is either assumed to the maximum phase velocity that
636	!-- ensures numerical stability (CFL-condition) or calculated after
637	!-- Orlanski(1976) and averaged along the outflow boundary.
638	IF ( outflow_s ) THEN
639
640	IF ( use_cmax ) THEN
641	u_p(:,-1,:) = u(:,0,:)
642	v_p(:,0,:) = v(:,1,:)
643	w_p(:,-1,:) = w(:,0,:)
644	ELSEIF ( .NOT. use_cmax ) THEN
645
646	c_max = dy / dt_3d
647
648	c_u_m_l = 0.0_wp
649	c_v_m_l = 0.0_wp
650	c_w_m_l = 0.0_wp
651
652	c_u_m = 0.0_wp
653	c_v_m = 0.0_wp
654	c_w_m = 0.0_wp
655
656	!
657	!-- Calculate the phase speeds for u, v, and w, first local and then
658	!-- average along the outflow boundary.
659	DO k = nzb+1, nzt+1
660	DO i = nxl, nxr
661
662	denom = u_m_s(k,0,i) - u_m_s(k,1,i)
663
664	IF ( denom /= 0.0_wp ) THEN
665	c_u(k,i) = -c_max * ( u(k,0,i) - u_m_s(k,0,i) ) / ( denom * tsc(2) )
666	IF ( c_u(k,i) < 0.0_wp ) THEN
667	c_u(k,i) = 0.0_wp
668	ELSEIF ( c_u(k,i) > c_max ) THEN
669	c_u(k,i) = c_max
670	ENDIF
671	ELSE
672	c_u(k,i) = c_max
673	ENDIF
674
675	denom = v_m_s(k,1,i) - v_m_s(k,2,i)
676
677	IF ( denom /= 0.0_wp ) THEN
678	c_v(k,i) = -c_max * ( v(k,1,i) - v_m_s(k,1,i) ) / ( denom * tsc(2) )
679	IF ( c_v(k,i) < 0.0_wp ) THEN
680	c_v(k,i) = 0.0_wp
681	ELSEIF ( c_v(k,i) > c_max ) THEN
682	c_v(k,i) = c_max
683	ENDIF
684	ELSE
685	c_v(k,i) = c_max
686	ENDIF
687
688	denom = w_m_s(k,0,i) - w_m_s(k,1,i)
689
690	IF ( denom /= 0.0_wp ) THEN
691	c_w(k,i) = -c_max * ( w(k,0,i) - w_m_s(k,0,i) ) / ( denom * tsc(2) )
692	IF ( c_w(k,i) < 0.0_wp ) THEN
693	c_w(k,i) = 0.0_wp
694	ELSEIF ( c_w(k,i) > c_max ) THEN
695	c_w(k,i) = c_max
696	ENDIF
697	ELSE
698	c_w(k,i) = c_max
699	ENDIF
700
701	c_u_m_l(k) = c_u_m_l(k) + c_u(k,i)
702	c_v_m_l(k) = c_v_m_l(k) + c_v(k,i)
703	c_w_m_l(k) = c_w_m_l(k) + c_w(k,i)
704
705	ENDDO
706	ENDDO
707
708	#if defined( __parallel )
709	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
710	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
711	MPI_SUM, comm1dx, ierr )
712	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
713	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
714	MPI_SUM, comm1dx, ierr )
715	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
716	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
717	MPI_SUM, comm1dx, ierr )
718	#else
719	c_u_m = c_u_m_l
720	c_v_m = c_v_m_l
721	c_w_m = c_w_m_l
722	#endif
723
724	c_u_m = c_u_m / (nx+1)
725	c_v_m = c_v_m / (nx+1)
726	c_w_m = c_w_m / (nx+1)
727
728	!
729	!-- Save old timelevels for the next timestep
730	IF ( intermediate_timestep_count == 1 ) THEN
731	u_m_s(:,:,:) = u(:,0:1,:)
732	v_m_s(:,:,:) = v(:,1:2,:)
733	w_m_s(:,:,:) = w(:,0:1,:)
734	ENDIF
735
736	!
737	!-- Calculate the new velocities
738	DO k = nzb+1, nzt+1
739	DO i = nxlg, nxrg
740	u_p(k,-1,i) = u(k,-1,i) - dt_3d * tsc(2) * c_u_m(k) * &
741	( u(k,-1,i) - u(k,0,i) ) * ddy
742
743	v_p(k,0,i) = v(k,0,i) - dt_3d * tsc(2) * c_v_m(k) * &
744	( v(k,0,i) - v(k,1,i) ) * ddy
745
746	w_p(k,-1,i) = w(k,-1,i) - dt_3d * tsc(2) * c_w_m(k) * &
747	( w(k,-1,i) - w(k,0,i) ) * ddy
748	ENDDO
749	ENDDO
750
751	!
752	!-- Bottom boundary at the outflow
753	IF ( ibc_uv_b == 0 ) THEN
754	u_p(nzb,-1,:) = 0.0_wp
755	v_p(nzb,0,:) = 0.0_wp
756	ELSE
757	u_p(nzb,-1,:) = u_p(nzb+1,-1,:)
758	v_p(nzb,0,:) = v_p(nzb+1,0,:)
759	ENDIF
760	w_p(nzb,-1,:) = 0.0_wp
761
762	!
763	!-- Top boundary at the outflow
764	IF ( ibc_uv_t == 0 ) THEN
765	u_p(nzt+1,-1,:) = u_init(nzt+1)
766	v_p(nzt+1,0,:) = v_init(nzt+1)
767	ELSE
768	u_p(nzt+1,-1,:) = u_p(nzt,-1,:)
769	v_p(nzt+1,0,:) = v_p(nzt,0,:)
770	ENDIF
771	w_p(nzt:nzt+1,-1,:) = 0.0_wp
772
773	ENDIF
774
775	ENDIF
776
777	IF ( outflow_n ) THEN
778
779	IF ( use_cmax ) THEN
780	u_p(:,ny+1,:) = u(:,ny,:)
781	v_p(:,ny+1,:) = v(:,ny,:)
782	w_p(:,ny+1,:) = w(:,ny,:)
783	ELSEIF ( .NOT. use_cmax ) THEN
784
785	c_max = dy / dt_3d
786
787	c_u_m_l = 0.0_wp
788	c_v_m_l = 0.0_wp
789	c_w_m_l = 0.0_wp
790
791	c_u_m = 0.0_wp
792	c_v_m = 0.0_wp
793	c_w_m = 0.0_wp
794
795	!
796	!-- Calculate the phase speeds for u, v, and w, first local and then
797	!-- average along the outflow boundary.
798	DO k = nzb+1, nzt+1
799	DO i = nxl, nxr
800
801	denom = u_m_n(k,ny,i) - u_m_n(k,ny-1,i)
802
803	IF ( denom /= 0.0_wp ) THEN
804	c_u(k,i) = -c_max * ( u(k,ny,i) - u_m_n(k,ny,i) ) / ( denom * tsc(2) )
805	IF ( c_u(k,i) < 0.0_wp ) THEN
806	c_u(k,i) = 0.0_wp
807	ELSEIF ( c_u(k,i) > c_max ) THEN
808	c_u(k,i) = c_max
809	ENDIF
810	ELSE
811	c_u(k,i) = c_max
812	ENDIF
813
814	denom = v_m_n(k,ny,i) - v_m_n(k,ny-1,i)
815
816	IF ( denom /= 0.0_wp ) THEN
817	c_v(k,i) = -c_max * ( v(k,ny,i) - v_m_n(k,ny,i) ) / ( denom * tsc(2) )
818	IF ( c_v(k,i) < 0.0_wp ) THEN
819	c_v(k,i) = 0.0_wp
820	ELSEIF ( c_v(k,i) > c_max ) THEN
821	c_v(k,i) = c_max
822	ENDIF
823	ELSE
824	c_v(k,i) = c_max
825	ENDIF
826
827	denom = w_m_n(k,ny,i) - w_m_n(k,ny-1,i)
828
829	IF ( denom /= 0.0_wp ) THEN
830	c_w(k,i) = -c_max * ( w(k,ny,i) - w_m_n(k,ny,i) ) / ( denom * tsc(2) )
831	IF ( c_w(k,i) < 0.0_wp ) THEN
832	c_w(k,i) = 0.0_wp
833	ELSEIF ( c_w(k,i) > c_max ) THEN
834	c_w(k,i) = c_max
835	ENDIF
836	ELSE
837	c_w(k,i) = c_max
838	ENDIF
839
840	c_u_m_l(k) = c_u_m_l(k) + c_u(k,i)
841	c_v_m_l(k) = c_v_m_l(k) + c_v(k,i)
842	c_w_m_l(k) = c_w_m_l(k) + c_w(k,i)
843
844	ENDDO
845	ENDDO
846
847	#if defined( __parallel )
848	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
849	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
850	MPI_SUM, comm1dx, ierr )
851	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
852	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
853	MPI_SUM, comm1dx, ierr )
854	IF ( collective_wait ) CALL MPI_BARRIER( comm1dx, ierr )
855	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
856	MPI_SUM, comm1dx, ierr )
857	#else
858	c_u_m = c_u_m_l
859	c_v_m = c_v_m_l
860	c_w_m = c_w_m_l
861	#endif
862
863	c_u_m = c_u_m / (nx+1)
864	c_v_m = c_v_m / (nx+1)
865	c_w_m = c_w_m / (nx+1)
866
867	!
868	!-- Save old timelevels for the next timestep
869	IF ( intermediate_timestep_count == 1 ) THEN
870	u_m_n(:,:,:) = u(:,ny-1:ny,:)
871	v_m_n(:,:,:) = v(:,ny-1:ny,:)
872	w_m_n(:,:,:) = w(:,ny-1:ny,:)
873	ENDIF
874
875	!
876	!-- Calculate the new velocities
877	DO k = nzb+1, nzt+1
878	DO i = nxlg, nxrg
879	u_p(k,ny+1,i) = u(k,ny+1,i) - dt_3d * tsc(2) * c_u_m(k) * &
880	( u(k,ny+1,i) - u(k,ny,i) ) * ddy
881
882	v_p(k,ny+1,i) = v(k,ny+1,i) - dt_3d * tsc(2) * c_v_m(k) * &
883	( v(k,ny+1,i) - v(k,ny,i) ) * ddy
884
885	w_p(k,ny+1,i) = w(k,ny+1,i) - dt_3d * tsc(2) * c_w_m(k) * &
886	( w(k,ny+1,i) - w(k,ny,i) ) * ddy
887	ENDDO
888	ENDDO
889
890	!
891	!-- Bottom boundary at the outflow
892	IF ( ibc_uv_b == 0 ) THEN
893	u_p(nzb,ny+1,:) = 0.0_wp
894	v_p(nzb,ny+1,:) = 0.0_wp
895	ELSE
896	u_p(nzb,ny+1,:) = u_p(nzb+1,ny+1,:)
897	v_p(nzb,ny+1,:) = v_p(nzb+1,ny+1,:)
898	ENDIF
899	w_p(nzb,ny+1,:) = 0.0_wp
900
901	!
902	!-- Top boundary at the outflow
903	IF ( ibc_uv_t == 0 ) THEN
904	u_p(nzt+1,ny+1,:) = u_init(nzt+1)
905	v_p(nzt+1,ny+1,:) = v_init(nzt+1)
906	ELSE
907	u_p(nzt+1,ny+1,:) = u_p(nzt,nyn+1,:)
908	v_p(nzt+1,ny+1,:) = v_p(nzt,nyn+1,:)
909	ENDIF
910	w_p(nzt:nzt+1,ny+1,:) = 0.0_wp
911
912	ENDIF
913
914	ENDIF
915
916	IF ( outflow_l ) THEN
917
918	IF ( use_cmax ) THEN
919	u_p(:,:,0) = u(:,:,1)
920	v_p(:,:,-1) = v(:,:,0)
921	w_p(:,:,-1) = w(:,:,0)
922	ELSEIF ( .NOT. use_cmax ) THEN
923
924	c_max = dx / dt_3d
925
926	c_u_m_l = 0.0_wp
927	c_v_m_l = 0.0_wp
928	c_w_m_l = 0.0_wp
929
930	c_u_m = 0.0_wp
931	c_v_m = 0.0_wp
932	c_w_m = 0.0_wp
933
934	!
935	!-- Calculate the phase speeds for u, v, and w, first local and then
936	!-- average along the outflow boundary.
937	DO k = nzb+1, nzt+1
938	DO j = nys, nyn
939
940	denom = u_m_l(k,j,1) - u_m_l(k,j,2)
941
942	IF ( denom /= 0.0_wp ) THEN
943	c_u(k,j) = -c_max * ( u(k,j,1) - u_m_l(k,j,1) ) / ( denom * tsc(2) )
944	IF ( c_u(k,j) < 0.0_wp ) THEN
945	c_u(k,j) = 0.0_wp
946	ELSEIF ( c_u(k,j) > c_max ) THEN
947	c_u(k,j) = c_max
948	ENDIF
949	ELSE
950	c_u(k,j) = c_max
951	ENDIF
952
953	denom = v_m_l(k,j,0) - v_m_l(k,j,1)
954
955	IF ( denom /= 0.0_wp ) THEN
956	c_v(k,j) = -c_max * ( v(k,j,0) - v_m_l(k,j,0) ) / ( denom * tsc(2) )
957	IF ( c_v(k,j) < 0.0_wp ) THEN
958	c_v(k,j) = 0.0_wp
959	ELSEIF ( c_v(k,j) > c_max ) THEN
960	c_v(k,j) = c_max
961	ENDIF
962	ELSE
963	c_v(k,j) = c_max
964	ENDIF
965
966	denom = w_m_l(k,j,0) - w_m_l(k,j,1)
967
968	IF ( denom /= 0.0_wp ) THEN
969	c_w(k,j) = -c_max * ( w(k,j,0) - w_m_l(k,j,0) ) / ( denom * tsc(2) )
970	IF ( c_w(k,j) < 0.0_wp ) THEN
971	c_w(k,j) = 0.0_wp
972	ELSEIF ( c_w(k,j) > c_max ) THEN
973	c_w(k,j) = c_max
974	ENDIF
975	ELSE
976	c_w(k,j) = c_max
977	ENDIF
978
979	c_u_m_l(k) = c_u_m_l(k) + c_u(k,j)
980	c_v_m_l(k) = c_v_m_l(k) + c_v(k,j)
981	c_w_m_l(k) = c_w_m_l(k) + c_w(k,j)
982
983	ENDDO
984	ENDDO
985
986	#if defined( __parallel )
987	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
988	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
989	MPI_SUM, comm1dy, ierr )
990	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
991	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
992	MPI_SUM, comm1dy, ierr )
993	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
994	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
995	MPI_SUM, comm1dy, ierr )
996	#else
997	c_u_m = c_u_m_l
998	c_v_m = c_v_m_l
999	c_w_m = c_w_m_l
1000	#endif
1001
1002	c_u_m = c_u_m / (ny+1)
1003	c_v_m = c_v_m / (ny+1)
1004	c_w_m = c_w_m / (ny+1)
1005
1006	!
1007	!-- Save old timelevels for the next timestep
1008	IF ( intermediate_timestep_count == 1 ) THEN
1009	u_m_l(:,:,:) = u(:,:,1:2)
1010	v_m_l(:,:,:) = v(:,:,0:1)
1011	w_m_l(:,:,:) = w(:,:,0:1)
1012	ENDIF
1013
1014	!
1015	!-- Calculate the new velocities
1016	DO k = nzb+1, nzt+1
1017	DO j = nysg, nyng
1018	u_p(k,j,0) = u(k,j,0) - dt_3d * tsc(2) * c_u_m(k) * &
1019	( u(k,j,0) - u(k,j,1) ) * ddx
1020
1021	v_p(k,j,-1) = v(k,j,-1) - dt_3d * tsc(2) * c_v_m(k) * &
1022	( v(k,j,-1) - v(k,j,0) ) * ddx
1023
1024	w_p(k,j,-1) = w(k,j,-1) - dt_3d * tsc(2) * c_w_m(k) * &
1025	( w(k,j,-1) - w(k,j,0) ) * ddx
1026	ENDDO
1027	ENDDO
1028
1029	!
1030	!-- Bottom boundary at the outflow
1031	IF ( ibc_uv_b == 0 ) THEN
1032	u_p(nzb,:,0) = 0.0_wp
1033	v_p(nzb,:,-1) = 0.0_wp
1034	ELSE
1035	u_p(nzb,:,0) = u_p(nzb+1,:,0)
1036	v_p(nzb,:,-1) = v_p(nzb+1,:,-1)
1037	ENDIF
1038	w_p(nzb,:,-1) = 0.0_wp
1039
1040	!
1041	!-- Top boundary at the outflow
1042	IF ( ibc_uv_t == 0 ) THEN
1043	u_p(nzt+1,:,0) = u_init(nzt+1)
1044	v_p(nzt+1,:,-1) = v_init(nzt+1)
1045	ELSE
1046	u_p(nzt+1,:,0) = u_p(nzt,:,0)
1047	v_p(nzt+1,:,-1) = v_p(nzt,:,-1)
1048	ENDIF
1049	w_p(nzt:nzt+1,:,-1) = 0.0_wp
1050
1051	ENDIF
1052
1053	ENDIF
1054
1055	IF ( outflow_r ) THEN
1056
1057	IF ( use_cmax ) THEN
1058	u_p(:,:,nx+1) = u(:,:,nx)
1059	v_p(:,:,nx+1) = v(:,:,nx)
1060	w_p(:,:,nx+1) = w(:,:,nx)
1061	ELSEIF ( .NOT. use_cmax ) THEN
1062
1063	c_max = dx / dt_3d
1064
1065	c_u_m_l = 0.0_wp
1066	c_v_m_l = 0.0_wp
1067	c_w_m_l = 0.0_wp
1068
1069	c_u_m = 0.0_wp
1070	c_v_m = 0.0_wp
1071	c_w_m = 0.0_wp
1072
1073	!
1074	!-- Calculate the phase speeds for u, v, and w, first local and then
1075	!-- average along the outflow boundary.
1076	DO k = nzb+1, nzt+1
1077	DO j = nys, nyn
1078
1079	denom = u_m_r(k,j,nx) - u_m_r(k,j,nx-1)
1080
1081	IF ( denom /= 0.0_wp ) THEN
1082	c_u(k,j) = -c_max * ( u(k,j,nx) - u_m_r(k,j,nx) ) / ( denom * tsc(2) )
1083	IF ( c_u(k,j) < 0.0_wp ) THEN
1084	c_u(k,j) = 0.0_wp
1085	ELSEIF ( c_u(k,j) > c_max ) THEN
1086	c_u(k,j) = c_max
1087	ENDIF
1088	ELSE
1089	c_u(k,j) = c_max
1090	ENDIF
1091
1092	denom = v_m_r(k,j,nx) - v_m_r(k,j,nx-1)
1093
1094	IF ( denom /= 0.0_wp ) THEN
1095	c_v(k,j) = -c_max * ( v(k,j,nx) - v_m_r(k,j,nx) ) / ( denom * tsc(2) )
1096	IF ( c_v(k,j) < 0.0_wp ) THEN
1097	c_v(k,j) = 0.0_wp
1098	ELSEIF ( c_v(k,j) > c_max ) THEN
1099	c_v(k,j) = c_max
1100	ENDIF
1101	ELSE
1102	c_v(k,j) = c_max
1103	ENDIF
1104
1105	denom = w_m_r(k,j,nx) - w_m_r(k,j,nx-1)
1106
1107	IF ( denom /= 0.0_wp ) THEN
1108	c_w(k,j) = -c_max * ( w(k,j,nx) - w_m_r(k,j,nx) ) / ( denom * tsc(2) )
1109	IF ( c_w(k,j) < 0.0_wp ) THEN
1110	c_w(k,j) = 0.0_wp
1111	ELSEIF ( c_w(k,j) > c_max ) THEN
1112	c_w(k,j) = c_max
1113	ENDIF
1114	ELSE
1115	c_w(k,j) = c_max
1116	ENDIF
1117
1118	c_u_m_l(k) = c_u_m_l(k) + c_u(k,j)
1119	c_v_m_l(k) = c_v_m_l(k) + c_v(k,j)
1120	c_w_m_l(k) = c_w_m_l(k) + c_w(k,j)
1121
1122	ENDDO
1123	ENDDO
1124
1125	#if defined( __parallel )
1126	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1127	CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
1128	MPI_SUM, comm1dy, ierr )
1129	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1130	CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
1131	MPI_SUM, comm1dy, ierr )
1132	IF ( collective_wait ) CALL MPI_BARRIER( comm1dy, ierr )
1133	CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
1134	MPI_SUM, comm1dy, ierr )
1135	#else
1136	c_u_m = c_u_m_l
1137	c_v_m = c_v_m_l
1138	c_w_m = c_w_m_l
1139	#endif
1140
1141	c_u_m = c_u_m / (ny+1)
1142	c_v_m = c_v_m / (ny+1)
1143	c_w_m = c_w_m / (ny+1)
1144
1145	!
1146	!-- Save old timelevels for the next timestep
1147	IF ( intermediate_timestep_count == 1 ) THEN
1148	u_m_r(:,:,:) = u(:,:,nx-1:nx)
1149	v_m_r(:,:,:) = v(:,:,nx-1:nx)
1150	w_m_r(:,:,:) = w(:,:,nx-1:nx)
1151	ENDIF
1152
1153	!
1154	!-- Calculate the new velocities
1155	DO k = nzb+1, nzt+1
1156	DO j = nysg, nyng
1157	u_p(k,j,nx+1) = u(k,j,nx+1) - dt_3d * tsc(2) * c_u_m(k) * &
1158	( u(k,j,nx+1) - u(k,j,nx) ) * ddx
1159
1160	v_p(k,j,nx+1) = v(k,j,nx+1) - dt_3d * tsc(2) * c_v_m(k) * &
1161	( v(k,j,nx+1) - v(k,j,nx) ) * ddx
1162
1163	w_p(k,j,nx+1) = w(k,j,nx+1) - dt_3d * tsc(2) * c_w_m(k) * &
1164	( w(k,j,nx+1) - w(k,j,nx) ) * ddx
1165	ENDDO
1166	ENDDO
1167
1168	!
1169	!-- Bottom boundary at the outflow
1170	IF ( ibc_uv_b == 0 ) THEN
1171	u_p(nzb,:,nx+1) = 0.0_wp
1172	v_p(nzb,:,nx+1) = 0.0_wp
1173	ELSE
1174	u_p(nzb,:,nx+1) = u_p(nzb+1,:,nx+1)
1175	v_p(nzb,:,nx+1) = v_p(nzb+1,:,nx+1)
1176	ENDIF
1177	w_p(nzb,:,nx+1) = 0.0_wp
1178
1179	!
1180	!-- Top boundary at the outflow
1181	IF ( ibc_uv_t == 0 ) THEN
1182	u_p(nzt+1,:,nx+1) = u_init(nzt+1)
1183	v_p(nzt+1,:,nx+1) = v_init(nzt+1)
1184	ELSE
1185	u_p(nzt+1,:,nx+1) = u_p(nzt,:,nx+1)
1186	v_p(nzt+1,:,nx+1) = v_p(nzt,:,nx+1)
1187	ENDIF
1188	w_p(nzt:nzt+1,:,nx+1) = 0.0_wp
1189
1190	ENDIF
1191
1192	ENDIF
1193
1194	END SUBROUTINE boundary_conds

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |