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

Last change on this file since 4416 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
RevLine 
[1682]1!> @file exchange_horiz_2d.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[2000]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.
[1036]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!
[4360]17! Copyright 1997-2020 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[1]21! -----------------
[1683]22!
[3543]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: exchange_horiz_2d.f90 4360 2020-01-07 11:25:50Z monakurppa $
[4182]27! Corrected "Former revisions" section
28!
29! 3768 2019-02-27 14:35:58Z raasch
[3768]30! further variables moved to serial branch to avoid compiler warnings about unused variables
31!
32! 3761 2019-02-25 15:31:42Z raasch
[3761]33! variables moved to serial branch to avoid compiler warnings about unused variables
34!
35! 3655 2019-01-07 16:51:22Z knoop
[3543]36! - New routine for exchange of 8-bit integer arrays
37! - Set Neumann conditions also at radiation boundary
[1321]38!
[4182]39! Revision 1.1  1998/01/23 09:58:21  raasch
40! Initial revision
41!
42!
[1]43! Description:
44! ------------
[1682]45!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
46!> boundary conditions, respectively, for 2D-arrays.
[1]47!------------------------------------------------------------------------------!
[1682]48 SUBROUTINE exchange_horiz_2d( ar )
49 
[1]50
[1320]51    USE control_parameters,                                                    &
[3182]52        ONLY :  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r,                &
[3761]53                bc_dirichlet_s, bc_radiation_l,                                &
[3182]54                bc_radiation_n, bc_radiation_r, bc_radiation_s 
[1320]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   
[1]64    USE pegrid
65
[1933]66    USE pmc_interface,                                                         &
67        ONLY : nesting_mode
68
[3761]69#if ! defined( __parallel )
70    USE control_parameters,                                                    &
71        ONLY:  bc_lr_cyc, bc_ns_cyc
72#endif
[1933]73
[3761]74
[1]75    IMPLICIT NONE
76
[841]77
[1682]78    INTEGER(iwp) :: i  !<
[1320]79   
[1682]80    REAL(wp) ::  ar(nysg:nyng,nxlg:nxrg)  !<
[1320]81   
[1]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
[702]94       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
95       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
[1]96
97    ELSE
98!
99!--    Send left boundary, receive right one
[667]100
[702]101       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                 &
102                          ar(nysg,nxr+1), 1, type_y, pright, 0,               &
[1]103                          comm2d, status, ierr )
104!
105!--    Send right boundary, receive left one
[702]106       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,         &
107                          ar(nysg,nxlg), 1, type_y, pleft,   1,               &
[1]108                          comm2d, status, ierr )
[702]109                         
110     
[1]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
[702]117       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
118       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
[1]119
120    ELSE
121!
122!--    Send front boundary, receive rear one
[667]123
[702]124       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                 &         
125                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0,               &
[1]126                          comm2d, status, ierr )
127!
128!--    Send rear boundary, receive front one
[702]129       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,          &
130                          ar(nysg,nxlg), 1, type_x, psouth, 1,                &
[1]131                          comm2d, status, ierr )
[667]132
[1]133    ENDIF
134
135#else
136
137!
138!-- Lateral boundary conditions in the non-parallel case
[707]139    IF ( bc_lr_cyc )  THEN
[702]140       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
141       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
[1]142    ENDIF
143
[707]144    IF ( bc_ns_cyc )  THEN
[702]145       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
146       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
[1]147    ENDIF
148
[667]149
[1]150#endif
151
[73]152!
[1762]153!-- Neumann-conditions at inflow/outflow/nested boundaries
[1933]154    IF ( nesting_mode /= 'vertical' )  THEN
[3182]155       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
[1933]156          DO  i = nbgp, 1, -1
157             ar(:,nxl-i) = ar(:,nxl)
158          ENDDO
159       ENDIF
[3182]160       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
[1933]161          DO  i = 1, nbgp
162             ar(:,nxr+i) = ar(:,nxr)
163          ENDDO
164       ENDIF
[3182]165       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
[1933]166          DO  i = nbgp, 1, -1
167             ar(nys-i,:) = ar(nys,:)
168          ENDDO
169       ENDIF
[3182]170       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
[1933]171          DO  i = 1, nbgp
172             ar(nyn+i,:) = ar(nyn,:)
173          ENDDO
174       ENDIF
[1762]175    ENDIF
176
[1]177    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
178
179 END SUBROUTINE exchange_horiz_2d
180
181
[3542]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 )
[1]189
[3542]190
191    USE control_parameters,                                                    &
[3768]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
[3542]195       
196    USE cpulog,                                                                &
197        ONLY:  cpu_log, log_point_s
198               
199    USE kinds
200   
201    USE pegrid
202
[3768]203#if ! defined( __parallel )
204    USE control_parameters,                                                    &
205        ONLY:  bc_lr_cyc, bc_ns_cyc
206#endif
207
[3542]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
[1]322!------------------------------------------------------------------------------!
323! Description:
324! ------------
[1682]325!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
[3542]326!> boundary conditions, respectively, for 2D 32-bit integer arrays.
[1]327!------------------------------------------------------------------------------!
[1968]328 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
[1]329
[1682]330
[1320]331    USE control_parameters,                                                    &
[3768]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
[1320]336       
337    USE cpulog,                                                                &
338        ONLY:  cpu_log, log_point_s
[1968]339               
[1320]340    USE kinds
341   
[1]342    USE pegrid
343
[3768]344#if ! defined( __parallel )
345    USE control_parameters,                                                    &
346        ONLY:  bc_lr_cyc, bc_ns_cyc
347#endif
348
[1]349    IMPLICIT NONE
350
[1968]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
[1]357
[1968]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
[1]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
[1968]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)
[1]374
375    ELSE
376!
377!--    Send left boundary, receive right one
[1968]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,                   &
[1]382                          comm2d, status, ierr )
383!
384!--    Send right boundary, receive left one
[1968]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 )                         
[667]390
[1]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
[1968]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,:)
[1]399
[667]400
[1]401    ELSE
402!
403!--    Send front boundary, receive rear one
[1968]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,                  &
[702]408                          comm2d, status, ierr )                         
[667]409
[1]410!
411!--    Send rear boundary, receive front one
[1968]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,                  &
[1]416                          comm2d, status, ierr )
[667]417
[1]418    ENDIF
419
420#else
421
422!
423!-- Lateral boundary conditions in the non-parallel case
[707]424    IF ( bc_lr_cyc )  THEN
[1968]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)
[1]427    ENDIF
428
[707]429    IF ( bc_ns_cyc )  THEN
[1968]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,:)
[1]432    ENDIF
433
434#endif
[1762]435!
436!-- Neumann-conditions at inflow/outflow/nested boundaries
[3542]437    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
[1968]438       DO  i = nbgp_local, 1, -1
439         ar(:,nxl_l-i) = ar(:,nxl_l)
[1762]440       ENDDO
441    ENDIF
[3542]442    IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
[1968]443       DO  i = 1, nbgp_local
444          ar(:,nxr_l+i) = ar(:,nxr_l)
[1762]445       ENDDO
446    ENDIF
[3542]447    IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
[1968]448       DO  i = nbgp_local, 1, -1
449         ar(nys_l-i,:) = ar(nys_l,:)
[1762]450       ENDDO
451    ENDIF
[3542]452    IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
[1968]453       DO  i = 1, nbgp_local
454         ar(nyn_l+i,:) = ar(nyn_l,:)
[1762]455       ENDDO
456    ENDIF
457
[1]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.