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

Last change on this file since 4380 was 4360, checked in by suehring, 5 years ago

Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update

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