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

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

bugfix: cpp-directives for serial mode added

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