Home

Context Navigation

exchange_horiz_mod.f90 @ 4869

Last change on this file since 4869 was 4828, checked in by Giersch, 4 years ago
Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code
Property svn:keywords set to `Id`
File size: 33.2 KB

Line
1	!> @file exchange_horiz.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 terms of the GNU General
6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
7	! (at your option) any later version.
8	!
9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11	! Public License for more details.
12	!
13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
14	! <http://www.gnu.org/licenses/>.
15	!
16	! Copyright 1997-2021 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! -----------------
21	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: exchange_horiz_mod.f90 4828 2021-01-05 11:21:41Z schwenkel $
26	! file re-formatted to follow the PALM coding standard
27	!
28	! 4474 2020-03-26 09:32:18Z raasch
29	! bugfix for correct usage of alternative communicators in case of 1d-decompositions and in
30	! non-parallel mode
31	!
32	! 4461 2020-03-12 16:51:59Z raasch
33	! optional communicator added to exchange_horiz
34	!
35	! 4457 2020-03-11 14:20:43Z raasch
36	! routine has been modularized, file exchange_horiz_2d has been merged
37	!
38	! 4429 2020-02-27 15:24:30Z raasch
39	! bugfix: cpp-directives added for serial mode
40	!
41	! 4360 2020-01-07 11:25:50Z suehring
42	! Corrected "Former revisions" section
43	!
44	! 3761 2019-02-25 15:31:42Z raasch
45	! OpenACC directives re-formatted
46	!
47	! 3657 2019-01-07 20:14:18Z knoop
48	! OpenACC port for SPEC
49	!
50	! Revision 1.1 1997/07/24 11:13:29 raasch
51	! Initial revision
52	!
53	!
54	! Description:
55	! ------------
56	!> Exchange of ghost point layers for subdomains (in parallel mode) and setting of cyclic lateral
57	!> boundary conditions for the total domain .
58	!--------------------------------------------------------------------------------------------------!
59	MODULE exchange_horiz_mod
60
61	USE kinds
62
63	USE pegrid
64
65	IMPLICIT NONE
66
67	PRIVATE
68	PUBLIC exchange_horiz, exchange_horiz_int, exchange_horiz_2d, exchange_horiz_2d_byte, &
69	exchange_horiz_2d_int
70
71	INTERFACE exchange_horiz
72	MODULE PROCEDURE exchange_horiz
73	END INTERFACE exchange_horiz
74
75	INTERFACE exchange_horiz_int
76	MODULE PROCEDURE exchange_horiz_int
77	END INTERFACE exchange_horiz_int
78
79	INTERFACE exchange_horiz_2d
80	MODULE PROCEDURE exchange_horiz_2d
81	END INTERFACE exchange_horiz_2d
82
83	INTERFACE exchange_horiz_2d_byte
84	MODULE PROCEDURE exchange_horiz_2d_byte
85	END INTERFACE exchange_horiz_2d_byte
86
87	INTERFACE exchange_horiz_2d_int
88	MODULE PROCEDURE exchange_horiz_2d_int
89	END INTERFACE exchange_horiz_2d_int
90
91
92	CONTAINS
93
94
95	!--------------------------------------------------------------------------------------------------!
96	! Description:
97	! ------------
98	!> Exchange of ghost point layers for subdomains (in parallel mode) and setting of cyclic lateral
99	!> boundary conditions for the total domain.
100	!> This routine is for REAL 3d-arrays.
101	!--------------------------------------------------------------------------------------------------!
102	SUBROUTINE exchange_horiz( ar, nbgp_local, alternative_communicator)
103
104	USE control_parameters, &
105	ONLY: bc_lr_cyc, bc_ns_cyc
106
107	#if defined( __parallel )
108	USE control_parameters, &
109	ONLY: grid_level, mg_switch_to_pe0, synchronous_exchange
110	#endif
111
112	USE cpulog, &
113	ONLY: cpu_log, log_point_s
114
115	USE indices, &
116	ONLY: nxl, nxr, nyn, nys, nzb, nzt
117
118
119	#if defined( _OPENACC )
120	INTEGER(iwp) :: i !<
121	#endif
122
123	INTEGER(iwp), OPTIONAL :: alternative_communicator !< alternative MPI communicator to be used
124
125	INTEGER(iwp) :: communicator !< communicator that is used as argument in MPI calls
126	INTEGER(iwp) :: left_pe !< id of left pe that is used as argument in MPI calls
127	INTEGER(iwp) :: nbgp_local !< number of ghost point layers
128	INTEGER(iwp) :: north_pe !< id of north pe that is used as argument in MPI calls
129	INTEGER(iwp) :: right_pe !< id of right pe that is used as argument in MPI calls
130	INTEGER(iwp) :: south_pe !< id of south pe that is used as argument in MPI calls
131
132	REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local, &
133	nxl-nbgp_local:nxr+nbgp_local) :: ar !< 3d-array for which exchange is done
134
135
136	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
137
138	#if defined( _OPENACC )
139	!$ACC UPDATE IF_PRESENT ASYNC(1) &
140	!$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
141	!$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
142
143	!
144	!-- Wait for first UPDATE to complete before starting the others.
145	!$ACC WAIT(1) ASYNC(2)
146	! ar(:,:,nxl-nbgp_local:nxl-1) is overwritten by first part below
147	! ar(:,:,nxl:nxl+nbgp_local-1) has been transferred above
148	DO i = nxl+nbgp_local, nxr-nbgp_local
149	!$ACC UPDATE IF_PRESENT ASYNC(2) &
150	!$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
151	!$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
152	ENDDO
153	! ar(:,:,nxr-nbgp_local+1:nxr) has been transferred above
154	! ar(:,:,nxr+1:nxr+nbgp_local) is overwritten by first part below
155
156	!
157	!-- Wait for first UPDATE to complete before starting MPI.
158	!$ACC WAIT(1)
159	#endif
160
161	!
162	!-- Set the communicator to be used
163	IF ( PRESENT( alternative_communicator ) ) THEN
164	!
165	!-- Alternative communicator is to be used
166	communicator = communicator_configurations(alternative_communicator)%mpi_communicator
167	left_pe = communicator_configurations(alternative_communicator)%pleft
168	right_pe = communicator_configurations(alternative_communicator)%pright
169	south_pe = communicator_configurations(alternative_communicator)%psouth
170	north_pe = communicator_configurations(alternative_communicator)%pnorth
171
172	ELSE
173	!
174	!-- Main communicator is to be used
175	communicator = comm2d
176	left_pe = pleft
177	right_pe = pright
178	south_pe = psouth
179	north_pe = pnorth
180
181	ENDIF
182
183	#if defined( __parallel )
184
185	!
186	!-- Exchange in x-direction of lateral boundaries
187	IF ( pdims(1) == 1 .OR. mg_switch_to_pe0 ) THEN
188	!
189	!-- One-dimensional decomposition along y, boundary values can be exchanged within the PE memory.
190	IF ( PRESENT( alternative_communicator ) ) THEN
191	IF ( alternative_communicator <= 2 ) THEN
192	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
193	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
194	ENDIF
195	ELSE
196	IF ( bc_lr_cyc ) THEN
197	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
198	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
199	ENDIF
200	ENDIF
201
202	ELSE
203
204	IF ( synchronous_exchange ) THEN
205	!
206	!-- Send left boundary, receive right one (synchronous)
207	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), left_pe, 0, &
208	ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), right_pe, 0, &
209	communicator, status, ierr )
210	!
211	!-- Send right boundary, receive left one (synchronous)
212	CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, &
213	type_yz(grid_level), right_pe, 1, &
214	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
215	type_yz(grid_level), left_pe, 1, &
216	communicator, status, ierr )
217
218	ELSE
219
220	!
221	!-- Asynchroneous exchange
222	IF ( send_receive == 'lr' .OR. send_receive == 'al' ) THEN
223
224	req(1:4) = 0
225	req_count = 0
226	!
227	!-- Send left boundary, receive right one (asynchronous)
228	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl), 1, type_yz(grid_level), left_pe, &
229	req_count, communicator, req(req_count+1), ierr )
230	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), right_pe, &
231	req_count, communicator, req(req_count+2), ierr )
232	!
233	!-- Send right boundary, receive left one (asynchronous)
234	CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1, type_yz(grid_level), &
235	right_pe, req_count+1, communicator, req(req_count+3), ierr )
236	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, type_yz(grid_level), &
237	left_pe, req_count+1, communicator, req(req_count+4), ierr )
238
239	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
240
241	ENDIF
242
243	ENDIF
244
245	ENDIF
246
247	!$ACC UPDATE IF_PRESENT ASYNC(1) &
248	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
249	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
250
251	!
252	!-- Wait for UPDATES above to complete before starting MPI.
253	!$ACC WAIT(2)
254
255	IF ( pdims(2) == 1 .OR. mg_switch_to_pe0 ) THEN
256	!
257	!-- One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
258	IF ( PRESENT( alternative_communicator ) ) THEN
259	IF ( alternative_communicator == 1 .OR. alternative_communicator == 3 ) THEN
260	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
261	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
262	ENDIF
263	ELSE
264	IF ( bc_ns_cyc ) THEN
265	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
266	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
267	ENDIF
268	ENDIF
269
270	ELSE
271
272	IF ( synchronous_exchange ) THEN
273	!
274	!-- Send front boundary, receive rear one (synchronous)
275	CALL MPI_SENDRECV( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), south_pe, 0, &
276	ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), north_pe, 0, &
277	communicator, status, ierr )
278	!
279	!-- Send rear boundary, receive front one (synchronous)
280	CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, &
281	type_xz(grid_level), north_pe, 1, &
282	ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, &
283	type_xz(grid_level), south_pe, 1, &
284	communicator, status, ierr )
285
286	ELSE
287
288	!
289	!-- Asynchroneous exchange
290	IF ( send_receive == 'ns' .OR. send_receive == 'al' ) THEN
291
292	req(1:4) = 0
293	req_count = 0
294
295	!
296	!-- Send front boundary, receive rear one (asynchronous)
297	CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local), 1, type_xz(grid_level), south_pe, &
298	req_count, communicator, req(req_count+1), ierr )
299	CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), north_pe, &
300	req_count, communicator, req(req_count+2), ierr )
301	!
302	!-- Send rear boundary, receive front one (asynchronous)
303	CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1, type_xz(grid_level), &
304	north_pe, req_count+1, communicator, req(req_count+3), ierr )
305	CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1, type_xz(grid_level), &
306	south_pe, req_count+1, communicator, req(req_count+4), ierr )
307
308	CALL MPI_WAITALL( 4, req, wait_stat, ierr )
309
310	ENDIF
311
312	ENDIF
313
314	ENDIF
315
316	#else
317
318	!
319	!-- Lateral boundary conditions in the non-parallel case.
320	!-- Case dependent, because in GPU mode still not all arrays are on device. This workaround has to
321	!-- be removed later. Also, since PGI compiler 12.5 has problems with array syntax, explicit loops
322	!-- are used.
323	IF ( PRESENT( alternative_communicator ) ) THEN
324	IF ( alternative_communicator <= 2 ) THEN
325	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
326	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
327	ENDIF
328	ELSE
329	IF ( bc_lr_cyc ) THEN
330	ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
331	ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
332	ENDIF
333	ENDIF
334
335	!$ACC UPDATE IF_PRESENT ASYNC(1) &
336	!$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
337	!$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
338
339	!
340	!-- Wait for UPDATES above to complete before starting MPI.
341	!$ACC WAIT(2)
342
343	IF ( PRESENT( alternative_communicator ) ) THEN
344	IF ( alternative_communicator == 1 .OR. alternative_communicator == 3 ) THEN
345	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
346	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
347	ENDIF
348	ELSE
349	IF ( bc_ns_cyc ) THEN
350	ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
351	ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
352	ENDIF
353	ENDIF
354
355	#endif
356
357	#if defined( _OPENACC )
358	DO i = nxl-nbgp_local, nxr+nbgp_local
359	!$ACC UPDATE IF_PRESENT ASYNC(2) &
360	!$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
361	!$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
362	ENDDO
363
364	!
365	!-- Wait for all UPDATEs to finish.
366	!$ACC WAIT
367	#endif
368
369	CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
370
371	END SUBROUTINE exchange_horiz
372
373
374	!--------------------------------------------------------------------------------------------------!
375	! Description:
376	! ------------
377	!> @todo Missing subroutine description.
378	!--------------------------------------------------------------------------------------------------!
379	SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local )
380
381
382	USE control_parameters, &
383	ONLY: bc_lr_cyc, bc_ns_cyc
384
385	#if defined( __parallel )
386	USE control_parameters, &
387	ONLY: grid_level
388	#endif
389
390	USE indices, &
391	ONLY: nzb
392
393	INTEGER(iwp) :: nbgp_local !< number of ghost points
394	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
395	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
396	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
397	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
398	INTEGER(iwp) :: nzt_l !< local index bound at current grid level, top
399
400	INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local, &
401	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
402
403
404	#if defined( __parallel )
405	IF ( pdims(1) == 1 ) THEN
406	!
407	!-- One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
408	IF ( bc_lr_cyc ) THEN
409	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
410	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
411	ENDIF
412	ELSE
413	!
414	!-- Send left boundary, receive right one (synchronous)
415	CALL MPI_SENDRECV( ar(nzb,nys_l-nbgp_local,nxl_l), 1, type_yz_int(grid_level), pleft, 0, &
416	ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0, &
417	comm2d, status, ierr )
418	!
419	!-- Send right boundary, receive left one (synchronous)
420	CALL MPI_SENDRECV( ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level), &
421	pright, 1, &
422	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, type_yz_int(grid_level), &
423	pleft, 1, &
424	comm2d, status, ierr )
425	ENDIF
426
427
428	IF ( pdims(2) == 1 ) THEN
429	!
430	!-- One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
431	IF ( bc_ns_cyc ) THEN
432	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
433	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
434	ENDIF
435
436	ELSE
437
438	!
439	!-- Send front boundary, receive rear one (synchronous)
440	CALL MPI_SENDRECV( ar(nzb,nys_l,nxl_l-nbgp_local), 1, type_xz_int(grid_level), psouth, 0, &
441	ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0, &
442	comm2d, status, ierr )
443	!
444	!-- Send rear boundary, receive front one (synchronous)
445	CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1, &
446	type_xz_int(grid_level), pnorth, 1, &
447	ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
448	type_xz_int(grid_level), psouth, 1, &
449	comm2d, status, ierr )
450
451	ENDIF
452
453	#else
454
455	IF ( bc_lr_cyc ) THEN
456	ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
457	ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
458	ENDIF
459
460	IF ( bc_ns_cyc ) THEN
461	ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
462	ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
463	ENDIF
464
465	#endif
466
467	END SUBROUTINE exchange_horiz_int
468
469	! Description:
470	! ------------
471	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
472	!> respectively, for 2D-arrays.
473	!--------------------------------------------------------------------------------------------------!
474	SUBROUTINE exchange_horiz_2d( ar )
475
476	USE control_parameters, &
477	ONLY : bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
478	bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
479
480	USE cpulog, &
481	ONLY : cpu_log, log_point_s
482
483	USE indices, &
484	ONLY : nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
485
486	#if ! defined( __parallel )
487	USE control_parameters, &
488	ONLY: bc_lr_cyc, bc_ns_cyc
489	#endif
490
491
492	INTEGER(iwp) :: i !<
493
494	REAL(wp) :: ar(nysg:nyng,nxlg:nxrg) !<
495
496
497	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
498
499	#if defined( __parallel )
500
501	!
502	!-- Exchange of lateral boundary values for parallel computers
503	IF ( pdims(1) == 1 ) THEN
504
505	!
506	!-- One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
507	ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
508	ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
509
510	ELSE
511	!
512	!-- Send left boundary, receive right one
513
514	CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft, 0, &
515	ar(nysg,nxr+1), 1, type_y, pright, 0, &
516	comm2d, status, ierr )
517	!
518	!-- Send right boundary, receive left one
519	CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright, 1, &
520	ar(nysg,nxlg), 1, type_y, pleft, 1, &
521	comm2d, status, ierr )
522
523
524	ENDIF
525
526	IF ( pdims(2) == 1 ) THEN
527	!
528	!-- One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
529	ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
530	ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
531
532	ELSE
533	!
534	!-- Send front boundary, receive rear one
535
536	CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0, &
537	ar(nyn+1,nxlg), 1, type_x, pnorth, 0, &
538	comm2d, status, ierr )
539	!
540	!-- Send rear boundary, receive front one
541	CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1, &
542	ar(nysg,nxlg), 1, type_x, psouth, 1, &
543	comm2d, status, ierr )
544
545	ENDIF
546
547	#else
548
549	!
550	!-- Lateral boundary conditions in the non-parallel case
551	IF ( bc_lr_cyc ) THEN
552	ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
553	ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
554	ENDIF
555
556	IF ( bc_ns_cyc ) THEN
557	ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
558	ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
559	ENDIF
560
561	#endif
562
563	!
564	!-- Neumann-conditions at inflow/outflow/nested boundaries
565	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
566	DO i = nbgp, 1, -1
567	ar(:,nxl-i) = ar(:,nxl)
568	ENDDO
569	ENDIF
570	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
571	DO i = 1, nbgp
572	ar(:,nxr+i) = ar(:,nxr)
573	ENDDO
574	ENDIF
575	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
576	DO i = nbgp, 1, -1
577	ar(nys-i,:) = ar(nys,:)
578	ENDDO
579	ENDIF
580	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
581	DO i = 1, nbgp
582	ar(nyn+i,:) = ar(nyn,:)
583	ENDDO
584	ENDIF
585
586	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
587
588	END SUBROUTINE exchange_horiz_2d
589
590
591	!--------------------------------------------------------------------------------------------------!
592	! Description:
593	! ------------
594	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
595	!> respectively, for 2D 8-bit integer arrays.
596	!--------------------------------------------------------------------------------------------------!
597	SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
598
599
600	USE control_parameters, &
601	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
602	bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
603
604	USE cpulog, &
605	ONLY: cpu_log, log_point_s
606
607	#if ! defined( __parallel )
608	USE control_parameters, &
609	ONLY: bc_lr_cyc, bc_ns_cyc
610	#endif
611
612	INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged
613	INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries
614	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
615	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
616	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
617	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
618
619	INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, &
620	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
621
622	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
623
624	#if defined( __parallel )
625
626	!
627	!-- Exchange of lateral boundary values for parallel computers
628	IF ( pdims(1) == 1 ) THEN
629
630	!
631	!-- One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
632	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
633	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
634
635	ELSE
636	!
637	!-- Send left boundary, receive right one
638	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, &
639	type_y_byte, pleft, 0, &
640	ar(nys_l-nbgp_local,nxr_l+1), 1, &
641	type_y_byte, pright, 0, &
642	comm2d, status, ierr )
643	!
644	!-- Send right boundary, receive left one
645	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, &
646	type_y_byte, pright, 1, &
647	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
648	type_y_byte, pleft, 1, &
649	comm2d, status, ierr )
650
651	ENDIF
652
653	IF ( pdims(2) == 1 ) THEN
654	!
655	!-- One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
656	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
657	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
658
659
660	ELSE
661	!
662	!-- Send front boundary, receive rear one
663	CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, &
664	type_x_byte, psouth, 0, &
665	ar(nyn_l+1,nxl_l-nbgp_local), 1, &
666	type_x_byte, pnorth, 0, &
667	comm2d, status, ierr )
668
669	!
670	!-- Send rear boundary, receive front one
671	CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, &
672	type_x_byte, pnorth, 1, &
673	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
674	type_x_byte, psouth, 1, &
675	comm2d, status, ierr )
676
677	ENDIF
678
679	#else
680
681	!
682	!-- Lateral boundary conditions in the non-parallel case
683	IF ( bc_lr_cyc ) THEN
684	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
685	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
686	ENDIF
687
688	IF ( bc_ns_cyc ) THEN
689	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
690	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
691	ENDIF
692
693	#endif
694	!
695	!-- Neumann-conditions at inflow/outflow/nested boundaries
696	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
697	DO i = nbgp_local, 1, -1
698	ar(:,nxl_l-i) = ar(:,nxl_l)
699	ENDDO
700	ENDIF
701	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
702	DO i = 1, nbgp_local
703	ar(:,nxr_l+i) = ar(:,nxr_l)
704	ENDDO
705	ENDIF
706	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
707	DO i = nbgp_local, 1, -1
708	ar(nys_l-i,:) = ar(nys_l,:)
709	ENDDO
710	ENDIF
711	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
712	DO i = 1, nbgp_local
713	ar(nyn_l+i,:) = ar(nyn_l,:)
714	ENDDO
715	ENDIF
716
717	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
718
719	END SUBROUTINE exchange_horiz_2d_byte
720
721
722	!--------------------------------------------------------------------------------------------------!
723	! Description:
724	! ------------
725	!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
726	!> respectively, for 2D 32-bit integer arrays.
727	!--------------------------------------------------------------------------------------------------!
728	SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
729
730
731	USE control_parameters, &
732	ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
733	bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
734
735	#if defined( __parallel )
736	USE control_parameters, &
737	ONLY: grid_level
738	#endif
739
740	USE cpulog, &
741	ONLY: cpu_log, log_point_s
742
743	#if ! defined( __parallel )
744	USE control_parameters, &
745	ONLY: bc_lr_cyc, bc_ns_cyc
746	#endif
747
748	INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged
749	INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries
750	INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side
751	INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side
752	INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side
753	INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side
754
755	INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, &
756	nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array
757
758	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
759
760	#if defined( __parallel )
761
762	!
763	!-- Exchange of lateral boundary values for parallel computers
764	IF ( pdims(1) == 1 ) THEN
765
766	!
767	!-- One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
768	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
769	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
770
771	ELSE
772	!
773	!-- Send left boundary, receive right one
774	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, &
775	type_y_int(grid_level), pleft, 0, &
776	ar(nys_l-nbgp_local,nxr_l+1), 1, &
777	type_y_int(grid_level), pright, 0, &
778	comm2d, status, ierr )
779	!
780	!-- Send right boundary, receive left one
781	CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, &
782	type_y_int(grid_level), pright, 1, &
783	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
784	type_y_int(grid_level), pleft, 1, &
785	comm2d, status, ierr )
786
787	ENDIF
788
789	IF ( pdims(2) == 1 ) THEN
790	!
791	!-- One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
792	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
793	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
794
795
796	ELSE
797	!
798	!-- Send front boundary, receive rear one
799	CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, &
800	type_x_int(grid_level), psouth, 0, &
801	ar(nyn_l+1,nxl_l-nbgp_local), 1, &
802	type_x_int(grid_level), pnorth, 0, &
803	comm2d, status, ierr )
804
805	!
806	!-- Send rear boundary, receive front one
807	CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, &
808	type_x_int(grid_level), pnorth, 1, &
809	ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, &
810	type_x_int(grid_level), psouth, 1, &
811	comm2d, status, ierr )
812
813	ENDIF
814
815	#else
816
817	!
818	!-- Lateral boundary conditions in the non-parallel case
819	IF ( bc_lr_cyc ) THEN
820	ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
821	ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
822	ENDIF
823
824	IF ( bc_ns_cyc ) THEN
825	ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
826	ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
827	ENDIF
828
829	#endif
830	!
831	!-- Neumann-conditions at inflow/outflow/nested boundaries
832	IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN
833	DO i = nbgp_local, 1, -1
834	ar(:,nxl_l-i) = ar(:,nxl_l)
835	ENDDO
836	ENDIF
837	IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN
838	DO i = 1, nbgp_local
839	ar(:,nxr_l+i) = ar(:,nxr_l)
840	ENDDO
841	ENDIF
842	IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN
843	DO i = nbgp_local, 1, -1
844	ar(nys_l-i,:) = ar(nys_l,:)
845	ENDDO
846	ENDIF
847	IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN
848	DO i = 1, nbgp_local
849	ar(nyn_l+i,:) = ar(nyn_l,:)
850	ENDDO
851	ENDIF
852
853	CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
854
855	END SUBROUTINE exchange_horiz_2d_int
856
857
858	END MODULE exchange_horiz_mod

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

Context Navigation

source: palm/trunk/SOURCE/exchange_horiz_mod.f90 @ 4869

Download in other formats: