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

Last change on this file since 3761 was 3761, checked in by raasch, 2 years ago

unused variables removed, OpenACC directives re-formatted, statements added to avoid compiler warnings

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