Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |