Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |