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

Last change on this file since 3454 was 3183, checked in by suehring, 6 years ago

last commit documented

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