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

Last change on this file since 3726 was 3655, checked in by knoop, 6 years ago

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

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