Home

Context Navigation

source: palm/trunk/SOURCE/exchange_horiz_2d.f90 @ 3542

Last change on this file since 3542 was 3542, checked in by suehring, 6 years ago
Revise ghost point exchange in netcdf-data input; new routine for ghost point exchange of 1-Byte Integer; Remove tabs in chemistry model which prevent compilation with gfortran and debug options
Property svn:keywords set to `Id`
File size: 17.1 KB

Line
1	!> @file exchange_horiz_2d.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	! - New routine for exchange of 8-bit integer arrays
23	! - Set Neumann conditions also at radiation boundary
24	!
25	! Former revisions:
26	! -----------------
27	! $Id: exchange_horiz_2d.f90 3542 2018-11-20 17:04:13Z suehring $
28	! Rename variables in offline nesting mode and flags indicating lateral
29	! boundary conditions
30	!
31	! 3182 2018-07-27 13:36:03Z suehring
32	! Corrected "Former revisions" section
33	!
34	! 2696 2017-12-14 17:12:51Z kanani
35	! Change in file header (GPL part)
36	! Forcing implemented (MS)
37	!
38	! 2101 2017-01-05 16:42:31Z suehring
39	!
40	! 2000 2016-08-20 18:09:15Z knoop
41	! Forced header and separation lines into 80 columns
42	!
43	! 1968 2016-07-18 12:01:49Z suehring
44	! 2D-INTEGER exchange adopted for different multigrid level
45	!
46	! 1818 2016-04-06 15:53:27Z maronga
47	! Initial version of purely vertical nesting introduced.
48	!
49	! 1804 2016-04-05 16:30:18Z maronga
50	! Removed code for parameter file check (__check)
51	!
52	! 1762 2016-02-25 12:31:13Z hellstea
53	! Introduction of nested domain feature
54	!
55	! 1682 2015-10-07 23:56:08Z knoop
56	! Code annotations made doxygen readable
57	!
58	! 1348 2014-03-27 18:01:03Z raasch
59	! bugfix: bc_lr_cyc and bc_ns_cyc added to ONLY-list
60	!
61	! 1320 2014-03-20 08:40:49Z raasch
62	! ONLY-attribute added to USE-statements,
63	! kind-parameters added to all INTEGER and REAL declaration statements,
64	! kinds are defined in new module kinds,
65	! revision history before 2012 removed,
66	! comment fields (!:) to be used for variable explanations added to
67	! all variable declaration statements
68	!
69	! 1092 2013-02-02 11:24:22Z raasch
70	! unused variables removed
71	!
72	! 1036 2012-10-22 13:43:42Z raasch
73	! code put under GPL (PALM 3.9)
74	!
75	! 841 2012-02-28 12:29:49Z maronga
76	! Excluded routine from compilation of namelist_file_check
77	!
78	! Revision 1.1 1998/01/23 09:58:21 raasch
79	! Initial revision
80	!
81	!
82	! Description:
83	! ------------
84	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
85	!> boundary conditions, respectively, for 2D-arrays.
86	!------------------------------------------------------------------------------!
87	SUBROUTINE exchange_horiz_2d( ar )
88
89
90	USE control_parameters, &
91	ONLY : bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, &
92	bc_dirichlet_s, bc_lr_cyc, bc_ns_cyc, bc_radiation_l, &
93	bc_radiation_n, bc_radiation_r, bc_radiation_s
94
95	USE cpulog, &
96	ONLY : cpu_log, log_point_s
97
98	USE indices, &
99	ONLY : nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
100
101	USE kinds
102
103	USE pegrid
104
105	USE pmc_interface, &
106	ONLY : nesting_mode
107
108
109	IMPLICIT NONE
110
111
112	INTEGER(iwp) :: i !<
113
114	REAL(wp) :: ar(nysg:nyng,nxlg:nxrg) !<
115
116
117	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
118
119	#if defined( __parallel )
120
121	!
122	!-- Exchange of lateral boundary values for parallel computers
123	IF ( pdims(1) == 1 ) THEN
124
125	!
126	!-- One-dimensional decomposition along y, boundary values can be exchanged
127	!-- within the PE memory
128	ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
129	ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
130
131	ELSE
132	!
133	!-- Send left boundary, receive right one
134
135	CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft, 0, &
136	ar(nysg,nxr+1), 1, type_y, pright, 0, &
137	comm2d, status, ierr )
138	!
139	!-- Send right boundary, receive left one
140	CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright, 1, &
141	ar(nysg,nxlg), 1, type_y, pleft, 1, &
142	comm2d, status, ierr )
143
144
145	ENDIF
146
147	IF ( pdims(2) == 1 ) THEN
148	!
149	!-- One-dimensional decomposition along x, boundary values can be exchanged
150	!-- within the PE memory
151	ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
152	ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
153
154	ELSE
155	!
156	!-- Send front boundary, receive rear one
157
158	CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0, &
159	ar(nyn+1,nxlg), 1, type_x, pnorth, 0, &
160	comm2d, status, ierr )
161	!
162	!-- Send rear boundary, receive front one
163	CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1, &
164	ar(nysg,nxlg), 1, type_x, psouth, 1, &
165	comm2d, status, ierr )
166
167	ENDIF
168
169	#else
170
171	!
172	!-- Lateral boundary conditions in the non-parallel case
173	IF ( bc_lr_cyc ) THEN
174	ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
175	ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
176	ENDIF
177
178	IF ( bc_ns_cyc ) THEN
179	ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
180	ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
181	ENDIF
182
183
184	#endif
185
186	!
187	!-- Neumann-conditions at inflow/outflow/nested boundaries
188	IF ( nesting_mode /= 'vertical' ) THEN
189	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
190	DO i = nbgp, 1, -1
191	ar(:,nxl-i) = ar(:,nxl)
192	ENDDO
193	ENDIF
194	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
195	DO i = 1, nbgp
196	ar(:,nxr+i) = ar(:,nxr)
197	ENDDO
198	ENDIF
199	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
200	DO i = nbgp, 1, -1
201	ar(nys-i,:) = ar(nys,:)
202	ENDDO
203	ENDIF
204	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
205	DO i = 1, nbgp
206	ar(nyn+i,:) = ar(nyn,:)
207	ENDDO
208	ENDIF
209	ENDIF
210
211	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
212
213	END SUBROUTINE exchange_horiz_2d
214
215
216	!------------------------------------------------------------------------------!
217	! Description:
218	! ------------
219	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
220	!> boundary conditions, respectively, for 2D 8-bit integer arrays.
221	!------------------------------------------------------------------------------!
222	SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
223
224
225	USE control_parameters, &
226	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, &
227	bc_dirichlet_s, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
228	bc_radiation_s, bc_lr_cyc, bc_ns_cyc, bc_radiation_l, &
229	bc_radiation_n, bc_radiation_r, bc_radiation_s, grid_level
230
231	USE cpulog, &
232	ONLY: cpu_log, log_point_s
233
234	USE kinds
235
236	USE pegrid
237
238	IMPLICIT NONE
239
240	INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries
241	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
242	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
243	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
244	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
245	INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged
246
247	INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, &
248	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
249
250	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
251
252	#if defined( __parallel )
253
254	!
255	!-- Exchange of lateral boundary values for parallel computers
256	IF ( pdims(1) == 1 ) THEN
257
258	!
259	!-- One-dimensional decomposition along y, boundary values can be exchanged
260	!-- within the PE memory
261	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
262	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
263
264	ELSE
265	!
266	!-- Send left boundary, receive right one
267	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, &
268	type_y_byte, pleft, 0, &
269	ar(nys_l-nbgp_local,nxr_l+1), 1, &
270	type_y_byte, pright, 0, &
271	comm2d, status, ierr )
272	!
273	!-- Send right boundary, receive left one
274	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, &
275	type_y_byte, pright, 1, &
276	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
277	type_y_byte, pleft, 1, &
278	comm2d, status, ierr )
279
280	ENDIF
281
282	IF ( pdims(2) == 1 ) THEN
283	!
284	!-- One-dimensional decomposition along x, boundary values can be exchanged
285	!-- within the PE memory
286	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
287	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
288
289
290	ELSE
291	!
292	!-- Send front boundary, receive rear one
293	CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, &
294	type_x_byte, psouth, 0, &
295	ar(nyn_l+1,nxl_l-nbgp_local), 1, &
296	type_x_byte, pnorth, 0, &
297	comm2d, status, ierr )
298
299	!
300	!-- Send rear boundary, receive front one
301	CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, &
302	type_x_byte, pnorth, 1, &
303	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
304	type_x_byte, psouth, 1, &
305	comm2d, status, ierr )
306
307	ENDIF
308
309	#else
310
311	!
312	!-- Lateral boundary conditions in the non-parallel case
313	IF ( bc_lr_cyc ) THEN
314	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
315	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
316	ENDIF
317
318	IF ( bc_ns_cyc ) THEN
319	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
320	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
321	ENDIF
322
323	#endif
324	!
325	!-- Neumann-conditions at inflow/outflow/nested boundaries
326	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
327	DO i = nbgp_local, 1, -1
328	ar(:,nxl_l-i) = ar(:,nxl_l)
329	ENDDO
330	ENDIF
331	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
332	DO i = 1, nbgp_local
333	ar(:,nxr_l+i) = ar(:,nxr_l)
334	ENDDO
335	ENDIF
336	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
337	DO i = nbgp_local, 1, -1
338	ar(nys_l-i,:) = ar(nys_l,:)
339	ENDDO
340	ENDIF
341	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
342	DO i = 1, nbgp_local
343	ar(nyn_l+i,:) = ar(nyn_l,:)
344	ENDDO
345	ENDIF
346
347	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
348
349	END SUBROUTINE exchange_horiz_2d_byte
350
351
352	!------------------------------------------------------------------------------!
353	! Description:
354	! ------------
355	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
356	!> boundary conditions, respectively, for 2D 32-bit integer arrays.
357	!------------------------------------------------------------------------------!
358	SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
359
360
361	USE control_parameters, &
362	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, &
363	bc_dirichlet_s, bc_radiation_l, bc_radiation_n, bc_radiation_r, &
364	bc_radiation_s, bc_lr_cyc, bc_ns_cyc, bc_radiation_l, &
365	bc_radiation_n, bc_radiation_r, bc_radiation_s, grid_level
366
367	USE cpulog, &
368	ONLY: cpu_log, log_point_s
369
370	USE kinds
371
372	USE pegrid
373
374	IMPLICIT NONE
375
376	INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries
377	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
378	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
379	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
380	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
381	INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged
382
383	INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, &
384	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
385
386	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
387
388	#if defined( __parallel )
389
390	!
391	!-- Exchange of lateral boundary values for parallel computers
392	IF ( pdims(1) == 1 ) THEN
393
394	!
395	!-- One-dimensional decomposition along y, boundary values can be exchanged
396	!-- within the PE memory
397	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
398	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
399
400	ELSE
401	!
402	!-- Send left boundary, receive right one
403	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, &
404	type_y_int(grid_level), pleft, 0, &
405	ar(nys_l-nbgp_local,nxr_l+1), 1, &
406	type_y_int(grid_level), pright, 0, &
407	comm2d, status, ierr )
408	!
409	!-- Send right boundary, receive left one
410	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, &
411	type_y_int(grid_level), pright, 1, &
412	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
413	type_y_int(grid_level), pleft, 1, &
414	comm2d, status, ierr )
415
416	ENDIF
417
418	IF ( pdims(2) == 1 ) THEN
419	!
420	!-- One-dimensional decomposition along x, boundary values can be exchanged
421	!-- within the PE memory
422	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
423	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
424
425
426	ELSE
427	!
428	!-- Send front boundary, receive rear one
429	CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, &
430	type_x_int(grid_level), psouth, 0, &
431	ar(nyn_l+1,nxl_l-nbgp_local), 1, &
432	type_x_int(grid_level), pnorth, 0, &
433	comm2d, status, ierr )
434
435	!
436	!-- Send rear boundary, receive front one
437	CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, &
438	type_x_int(grid_level), pnorth, 1, &
439	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
440	type_x_int(grid_level), psouth, 1, &
441	comm2d, status, ierr )
442
443	ENDIF
444
445	#else
446
447	!
448	!-- Lateral boundary conditions in the non-parallel case
449	IF ( bc_lr_cyc ) THEN
450	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
451	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
452	ENDIF
453
454	IF ( bc_ns_cyc ) THEN
455	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
456	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
457	ENDIF
458
459	#endif
460	!
461	!-- Neumann-conditions at inflow/outflow/nested boundaries
462	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
463	DO i = nbgp_local, 1, -1
464	ar(:,nxl_l-i) = ar(:,nxl_l)
465	ENDDO
466	ENDIF
467	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
468	DO i = 1, nbgp_local
469	ar(:,nxr_l+i) = ar(:,nxr_l)
470	ENDDO
471	ENDIF
472	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
473	DO i = nbgp_local, 1, -1
474	ar(nys_l-i,:) = ar(nys_l,:)
475	ENDDO
476	ENDIF
477	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
478	DO i = 1, nbgp_local
479	ar(nyn_l+i,:) = ar(nyn_l,:)
480	ENDDO
481	ENDIF
482
483	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
484
485	END SUBROUTINE exchange_horiz_2d_int

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |