Home

Context Navigation

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

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