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

Last change on this file since 1989 was 1969, checked in by suehring, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 11.0 KB
Line 
1!> @file exchange_horiz_2d.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2016 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: exchange_horiz_2d.f90 1969 2016-07-18 12:03:12Z gronemeier $
26!
27! 1968 2016-07-18 12:01:49Z suehring
28! 2D-INTEGER exchange adopted for different multigrid level
29!
30! 1818 2016-04-06 15:53:27Z maronga
31! Initial version of purely vertical nesting introduced.
32!
33! 1804 2016-04-05 16:30:18Z maronga
34! Removed code for parameter file check (__check)
35!
36! 1762 2016-02-25 12:31:13Z hellstea
37! Introduction of nested domain feature
38!
39! 1682 2015-10-07 23:56:08Z knoop
40! Code annotations made doxygen readable
41!
42! 1348 2014-03-27 18:01:03Z raasch
43! bugfix: bc_lr_cyc and bc_ns_cyc added to ONLY-list
44!
45! 1320 2014-03-20 08:40:49Z raasch
46! ONLY-attribute added to USE-statements,
47! kind-parameters added to all INTEGER and REAL declaration statements,
48! kinds are defined in new module kinds,
49! revision history before 2012 removed,
50! comment fields (!:) to be used for variable explanations added to
51! all variable declaration statements
52!
53! 1092 2013-02-02 11:24:22Z raasch
54! unused variables removed
55!
56! 1036 2012-10-22 13:43:42Z raasch
57! code put under GPL (PALM 3.9)
58!
59! 841 2012-02-28 12:29:49Z maronga
60! Excluded routine from compilation of namelist_file_check
61!
62! Revision 1.1  1998/01/23 09:58:21  raasch
63! Initial revision
64!
65!
66! Description:
67! ------------
68!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
69!> boundary conditions, respectively, for 2D-arrays.
70!------------------------------------------------------------------------------!
71 SUBROUTINE exchange_horiz_2d( ar )
72 
73
74    USE control_parameters,                                                    &
75        ONLY :  bc_lr_cyc, bc_ns_cyc, inflow_l, inflow_n, inflow_r, inflow_s,  &
76                nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,        &
77                outflow_l, outflow_n, outflow_r, outflow_s
78               
79    USE cpulog,                                                                &
80        ONLY :  cpu_log, log_point_s
81       
82    USE indices,                                                               &
83        ONLY :  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
84       
85    USE kinds
86   
87    USE pegrid
88
89    USE pmc_interface,                                                         &
90        ONLY : nesting_mode
91
92
93    IMPLICIT NONE
94
95
96    INTEGER(iwp) :: i  !<
97   
98    REAL(wp) ::  ar(nysg:nyng,nxlg:nxrg)  !<
99   
100
101    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
102
103#if defined( __parallel )
104
105!
106!-- Exchange of lateral boundary values for parallel computers
107    IF ( pdims(1) == 1 )  THEN
108
109!
110!--    One-dimensional decomposition along y, boundary values can be exchanged
111!--    within the PE memory
112       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
113       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
114
115    ELSE
116!
117!--    Send left boundary, receive right one
118
119       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                 &
120                          ar(nysg,nxr+1), 1, type_y, pright, 0,               &
121                          comm2d, status, ierr )
122!
123!--    Send right boundary, receive left one
124       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,         &
125                          ar(nysg,nxlg), 1, type_y, pleft,   1,               &
126                          comm2d, status, ierr )
127                         
128     
129    ENDIF
130
131    IF ( pdims(2) == 1 )  THEN
132!
133!--    One-dimensional decomposition along x, boundary values can be exchanged
134!--    within the PE memory
135       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
136       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
137
138    ELSE
139!
140!--    Send front boundary, receive rear one
141
142       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                 &         
143                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0,               &
144                          comm2d, status, ierr )
145!
146!--    Send rear boundary, receive front one
147       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,          &
148                          ar(nysg,nxlg), 1, type_x, psouth, 1,                &
149                          comm2d, status, ierr )
150
151    ENDIF
152
153#else
154
155!
156!-- Lateral boundary conditions in the non-parallel case
157    IF ( bc_lr_cyc )  THEN
158       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
159       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
160    ENDIF
161
162    IF ( bc_ns_cyc )  THEN
163       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
164       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
165    ENDIF
166
167
168#endif
169
170!
171!-- Neumann-conditions at inflow/outflow/nested boundaries
172    IF ( nesting_mode /= 'vertical' )  THEN
173       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
174          DO  i = nbgp, 1, -1
175             ar(:,nxl-i) = ar(:,nxl)
176          ENDDO
177       ENDIF
178       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
179          DO  i = 1, nbgp
180             ar(:,nxr+i) = ar(:,nxr)
181          ENDDO
182       ENDIF
183       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
184          DO  i = nbgp, 1, -1
185             ar(nys-i,:) = ar(nys,:)
186          ENDDO
187       ENDIF
188       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
189          DO  i = 1, nbgp
190             ar(nyn+i,:) = ar(nyn,:)
191          ENDDO
192       ENDIF
193    ENDIF
194
195    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
196
197 END SUBROUTINE exchange_horiz_2d
198
199
200
201!------------------------------------------------------------------------------!
202! Description:
203! ------------
204!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
205!> boundary conditions, respectively, for 2D integer arrays.
206!------------------------------------------------------------------------------!
207 
208 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
209
210
211    USE control_parameters,                                                    &
212        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, nest_bound_l, nest_bound_n,   &
213               nest_bound_r, nest_bound_s
214       
215    USE cpulog,                                                                &
216        ONLY:  cpu_log, log_point_s
217               
218    USE kinds
219   
220    USE pegrid
221
222    IMPLICIT NONE
223
224    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
225    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
226    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
227    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
228    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
229    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
230
231    INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                 &
232                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
233
234    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
235
236#if defined( __parallel )
237
238!
239!-- Exchange of lateral boundary values for parallel computers
240    IF ( pdims(1) == 1 )  THEN
241
242!
243!--    One-dimensional decomposition along y, boundary values can be exchanged
244!--    within the PE memory
245       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
246       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
247
248    ELSE
249!
250!--    Send left boundary, receive right one
251       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                     &
252                          type_y_int(grid_level), pleft,  0,                   &
253                          ar(nys_l-nbgp_local,nxr_l+1), 1,                     &
254                          type_y_int(grid_level), pright, 0,                   &
255                          comm2d, status, ierr )
256!
257!--    Send right boundary, receive left one
258       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,          &
259                          type_y_int(grid_level), pright, 1,                   &
260                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,          & 
261                          type_y_int(grid_level), pleft,  1,                   &
262                          comm2d, status, ierr )                         
263
264    ENDIF
265
266    IF ( pdims(2) == 1 )  THEN
267!
268!--    One-dimensional decomposition along x, boundary values can be exchanged
269!--    within the PE memory
270       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
271       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
272
273
274    ELSE
275!
276!--    Send front boundary, receive rear one
277       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                    &
278                          type_x_int(grid_level), psouth, 0,                  &
279                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                    &
280                          type_x_int(grid_level), pnorth, 0,                  &
281                          comm2d, status, ierr )                         
282
283!
284!--    Send rear boundary, receive front one
285       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,         &
286                          type_x_int(grid_level), pnorth, 1,                  &
287                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,         &
288                          type_x_int(grid_level), psouth, 1,                  &
289                          comm2d, status, ierr )
290
291    ENDIF
292
293#else
294
295!
296!-- Lateral boundary conditions in the non-parallel case
297    IF ( bc_lr_cyc )  THEN
298       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
299       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
300    ENDIF
301
302    IF ( bc_ns_cyc )  THEN
303       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
304       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
305    ENDIF
306
307#endif
308!
309!-- Neumann-conditions at inflow/outflow/nested boundaries
310    IF ( nest_bound_l )  THEN
311       DO  i = nbgp_local, 1, -1
312         ar(:,nxl_l-i) = ar(:,nxl_l)
313       ENDDO
314    ENDIF
315    IF ( nest_bound_r )  THEN
316       DO  i = 1, nbgp_local
317          ar(:,nxr_l+i) = ar(:,nxr_l)
318       ENDDO
319    ENDIF
320    IF ( nest_bound_s )  THEN
321       DO  i = nbgp_local, 1, -1
322         ar(nys_l-i,:) = ar(nys_l,:)
323       ENDDO
324    ENDIF
325    IF ( nest_bound_n )  THEN
326       DO  i = 1, nbgp_local
327         ar(nyn_l+i,:) = ar(nyn_l,:)
328       ENDDO
329    ENDIF
330
331    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
332
333 END SUBROUTINE exchange_horiz_2d_int
Note: See TracBrowser for help on using the repository browser.