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

Last change on this file since 4457 was 4457, checked in by raasch, 12 months 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.