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

Last change on this file since 2769 was 2718, checked in by maronga, 7 years ago

deleting of deprecated files; headers updated where needed

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