source: palm/trunk/SOURCE/exchange_horiz_2d.f90 @ 4453

Last change on this file since 4453 was 4453, checked in by raasch, 3 years ago

obsolete IF check about nesting removed

  • Property svn:keywords set to Id
File size: 16.3 KB
Line 
1!> @file exchange_horiz_2d.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_2d.f90 4453 2020-03-11 08:10:13Z raasch $
27! obsolete IF check about nesting removed
28!
29! 4444 2020-03-05 15:59:50Z raasch
30! bugfix: cpp-directives for serial mode added
31!
32! 4360 2020-01-07 11:25:50Z suehring
33! Corrected "Former revisions" section
34!
35! 3768 2019-02-27 14:35:58Z raasch
36! further variables moved to serial branch to avoid compiler warnings about unused variables
37!
38! 3761 2019-02-25 15:31:42Z raasch
39! variables moved to serial branch to avoid compiler warnings about unused variables
40!
41! 3655 2019-01-07 16:51:22Z knoop
42! - New routine for exchange of 8-bit integer arrays
43! - Set Neumann conditions also at radiation boundary
44!
45! Revision 1.1  1998/01/23 09:58:21  raasch
46! Initial revision
47!
48!
49! Description:
50! ------------
51!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
52!> boundary conditions, respectively, for 2D-arrays.
53!------------------------------------------------------------------------------!
54 SUBROUTINE exchange_horiz_2d( ar )
55 
56
57    USE control_parameters,                                                    &
58        ONLY :  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r,                &
59                bc_dirichlet_s, bc_radiation_l,                                &
60                bc_radiation_n, bc_radiation_r, bc_radiation_s 
61               
62    USE cpulog,                                                                &
63        ONLY :  cpu_log, log_point_s
64       
65    USE indices,                                                               &
66        ONLY :  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
67       
68    USE kinds
69   
70    USE pegrid
71
72#if ! defined( __parallel )
73    USE control_parameters,                                                    &
74        ONLY:  bc_lr_cyc, bc_ns_cyc
75#endif
76
77
78    IMPLICIT NONE
79
80
81    INTEGER(iwp) :: i  !<
82   
83    REAL(wp) ::  ar(nysg:nyng,nxlg:nxrg)  !<
84   
85
86    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
87
88#if defined( __parallel )
89
90!
91!-- Exchange of lateral boundary values for parallel computers
92    IF ( pdims(1) == 1 )  THEN
93
94!
95!--    One-dimensional decomposition along y, boundary values can be exchanged
96!--    within the PE memory
97       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
98       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
99
100    ELSE
101!
102!--    Send left boundary, receive right one
103
104       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                 &
105                          ar(nysg,nxr+1), 1, type_y, pright, 0,               &
106                          comm2d, status, ierr )
107!
108!--    Send right boundary, receive left one
109       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,         &
110                          ar(nysg,nxlg), 1, type_y, pleft,   1,               &
111                          comm2d, status, ierr )
112                         
113     
114    ENDIF
115
116    IF ( pdims(2) == 1 )  THEN
117!
118!--    One-dimensional decomposition along x, boundary values can be exchanged
119!--    within the PE memory
120       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
121       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
122
123    ELSE
124!
125!--    Send front boundary, receive rear one
126
127       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                 &         
128                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0,               &
129                          comm2d, status, ierr )
130!
131!--    Send rear boundary, receive front one
132       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,          &
133                          ar(nysg,nxlg), 1, type_x, psouth, 1,                &
134                          comm2d, status, ierr )
135
136    ENDIF
137
138#else
139
140!
141!-- Lateral boundary conditions in the non-parallel case
142    IF ( bc_lr_cyc )  THEN
143       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
144       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
145    ENDIF
146
147    IF ( bc_ns_cyc )  THEN
148       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
149       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
150    ENDIF
151
152#endif
153
154!
155!-- Neumann-conditions at inflow/outflow/nested boundaries
156    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
157       DO  i = nbgp, 1, -1
158          ar(:,nxl-i) = ar(:,nxl)
159       ENDDO
160    ENDIF
161    IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
162       DO  i = 1, nbgp
163          ar(:,nxr+i) = ar(:,nxr)
164       ENDDO
165    ENDIF
166    IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
167       DO  i = nbgp, 1, -1
168          ar(nys-i,:) = ar(nys,:)
169       ENDDO
170    ENDIF
171    IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
172       DO  i = 1, nbgp
173          ar(nyn+i,:) = ar(nyn,:)
174       ENDDO
175    ENDIF
176
177    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
178
179 END SUBROUTINE exchange_horiz_2d
180
181
182!------------------------------------------------------------------------------!
183! Description:
184! ------------
185!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
186!> boundary conditions, respectively, for 2D 8-bit integer arrays.
187!------------------------------------------------------------------------------!
188 SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
189
190
191    USE control_parameters,                                                    &
192        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
193               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
194               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
195       
196    USE cpulog,                                                                &
197        ONLY:  cpu_log, log_point_s
198               
199    USE kinds
200   
201    USE pegrid
202
203#if ! defined( __parallel )
204    USE control_parameters,                                                    &
205        ONLY:  bc_lr_cyc, bc_ns_cyc
206#endif
207
208    IMPLICIT NONE
209
210    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
211    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
212    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
213    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
214    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
215    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
216
217    INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,              &
218                               nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
219
220    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
221
222#if defined( __parallel )
223
224!
225!-- Exchange of lateral boundary values for parallel computers
226    IF ( pdims(1) == 1 )  THEN
227
228!
229!--    One-dimensional decomposition along y, boundary values can be exchanged
230!--    within the PE memory
231       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
232       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
233
234    ELSE
235!
236!--    Send left boundary, receive right one
237       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                     &
238                          type_y_byte, pleft,  0,                              &
239                          ar(nys_l-nbgp_local,nxr_l+1), 1,                     &
240                          type_y_byte, pright, 0,                              &
241                          comm2d, status, ierr )
242!
243!--    Send right boundary, receive left one
244       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,          &
245                          type_y_byte, pright, 1,                              &
246                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,          & 
247                          type_y_byte, pleft,  1,                              &
248                          comm2d, status, ierr )                         
249
250    ENDIF
251
252    IF ( pdims(2) == 1 )  THEN
253!
254!--    One-dimensional decomposition along x, boundary values can be exchanged
255!--    within the PE memory
256       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
257       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
258
259
260    ELSE
261!
262!--    Send front boundary, receive rear one
263       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                    &
264                          type_x_byte, psouth, 0,                             &
265                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                    &
266                          type_x_byte, pnorth, 0,                             &
267                          comm2d, status, ierr )                         
268
269!
270!--    Send rear boundary, receive front one
271       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,         &
272                          type_x_byte, pnorth, 1,                             &
273                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,         &
274                          type_x_byte, psouth, 1,                             &
275                          comm2d, status, ierr )
276
277    ENDIF
278
279#else
280
281!
282!-- Lateral boundary conditions in the non-parallel case
283    IF ( bc_lr_cyc )  THEN
284       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
285       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
286    ENDIF
287
288    IF ( bc_ns_cyc )  THEN
289       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
290       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
291    ENDIF
292
293#endif
294!
295!-- Neumann-conditions at inflow/outflow/nested boundaries
296    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
297       DO  i = nbgp_local, 1, -1
298         ar(:,nxl_l-i) = ar(:,nxl_l)
299       ENDDO
300    ENDIF
301    IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
302       DO  i = 1, nbgp_local
303          ar(:,nxr_l+i) = ar(:,nxr_l)
304       ENDDO
305    ENDIF
306    IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
307       DO  i = nbgp_local, 1, -1
308         ar(nys_l-i,:) = ar(nys_l,:)
309       ENDDO
310    ENDIF
311    IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
312       DO  i = 1, nbgp_local
313         ar(nyn_l+i,:) = ar(nyn_l,:)
314       ENDDO
315    ENDIF
316
317    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
318
319 END SUBROUTINE exchange_horiz_2d_byte
320 
321
322!------------------------------------------------------------------------------!
323! Description:
324! ------------
325!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
326!> boundary conditions, respectively, for 2D 32-bit integer arrays.
327!------------------------------------------------------------------------------!
328 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
329
330
331    USE control_parameters,                                                    &
332        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
333               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
334               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
335
336#if defined( __parallel )
337    USE control_parameters,                                                    &
338        ONLY:  grid_level
339#endif
340
341    USE cpulog,                                                                &
342        ONLY:  cpu_log, log_point_s
343               
344    USE kinds
345   
346    USE pegrid
347
348#if ! defined( __parallel )
349    USE control_parameters,                                                    &
350        ONLY:  bc_lr_cyc, bc_ns_cyc
351#endif
352
353    IMPLICIT NONE
354
355    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
356    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
357    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
358    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
359    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
360    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
361
362    INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                 &
363                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
364
365    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
366
367#if defined( __parallel )
368
369!
370!-- Exchange of lateral boundary values for parallel computers
371    IF ( pdims(1) == 1 )  THEN
372
373!
374!--    One-dimensional decomposition along y, boundary values can be exchanged
375!--    within the PE memory
376       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
377       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
378
379    ELSE
380!
381!--    Send left boundary, receive right one
382       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                     &
383                          type_y_int(grid_level), pleft,  0,                   &
384                          ar(nys_l-nbgp_local,nxr_l+1), 1,                     &
385                          type_y_int(grid_level), pright, 0,                   &
386                          comm2d, status, ierr )
387!
388!--    Send right boundary, receive left one
389       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,          &
390                          type_y_int(grid_level), pright, 1,                   &
391                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,          & 
392                          type_y_int(grid_level), pleft,  1,                   &
393                          comm2d, status, ierr )                         
394
395    ENDIF
396
397    IF ( pdims(2) == 1 )  THEN
398!
399!--    One-dimensional decomposition along x, boundary values can be exchanged
400!--    within the PE memory
401       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
402       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
403
404
405    ELSE
406!
407!--    Send front boundary, receive rear one
408       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                    &
409                          type_x_int(grid_level), psouth, 0,                  &
410                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                    &
411                          type_x_int(grid_level), pnorth, 0,                  &
412                          comm2d, status, ierr )                         
413
414!
415!--    Send rear boundary, receive front one
416       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,         &
417                          type_x_int(grid_level), pnorth, 1,                  &
418                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,         &
419                          type_x_int(grid_level), psouth, 1,                  &
420                          comm2d, status, ierr )
421
422    ENDIF
423
424#else
425
426!
427!-- Lateral boundary conditions in the non-parallel case
428    IF ( bc_lr_cyc )  THEN
429       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
430       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
431    ENDIF
432
433    IF ( bc_ns_cyc )  THEN
434       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
435       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
436    ENDIF
437
438#endif
439!
440!-- Neumann-conditions at inflow/outflow/nested boundaries
441    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
442       DO  i = nbgp_local, 1, -1
443         ar(:,nxl_l-i) = ar(:,nxl_l)
444       ENDDO
445    ENDIF
446    IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
447       DO  i = 1, nbgp_local
448          ar(:,nxr_l+i) = ar(:,nxr_l)
449       ENDDO
450    ENDIF
451    IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
452       DO  i = nbgp_local, 1, -1
453         ar(nys_l-i,:) = ar(nys_l,:)
454       ENDDO
455    ENDIF
456    IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
457       DO  i = 1, nbgp_local
458         ar(nyn_l+i,:) = ar(nyn_l,:)
459       ENDDO
460    ENDIF
461
462    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
463
464 END SUBROUTINE exchange_horiz_2d_int
Note: See TracBrowser for help on using the repository browser.