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

Last change on this file since 3948 was 3768, checked in by raasch, 6 years ago

variables commented out + statement added to avoid compiler warnings about unused variables

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