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

Last change on this file since 4631 was 4626, checked in by raasch, 4 years ago

files re-formatted to follow the PALM coding standard

  • 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-2020 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: exchange_horiz_mod.f90 4626 2020-07-26 09:49:48Z suehring $
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.