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

Last change on this file since 4180 was 4180, checked in by scharf, 22 months ago

removed comments in 'Former revisions' section that are older than 01.01.2019

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