Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |