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

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

last commit documented

  • Property svn:keywords set to Id
File size: 11.5 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!
[2718]17! Copyright 1997-2018 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[1]21! -----------------
[1683]22!
[3183]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: exchange_horiz_2d.f90 3183 2018-07-27 14:25:55Z suehring $
[3183]27! Rename variables in offline nesting mode and flags indicating lateral
28! boundary conditions
29!
30! 3182 2018-07-27 13:36:03Z suehring
[2716]31! Corrected "Former revisions" section
32!
33! 2696 2017-12-14 17:12:51Z kanani
34! Change in file header (GPL part)
[2696]35! Forcing implemented (MS)
36!
37! 2101 2017-01-05 16:42:31Z suehring
[1321]38!
[2001]39! 2000 2016-08-20 18:09:15Z knoop
40! Forced header and separation lines into 80 columns
41!
[1969]42! 1968 2016-07-18 12:01:49Z suehring
43! 2D-INTEGER exchange adopted for different multigrid level
44!
[1933]45! 1818 2016-04-06 15:53:27Z maronga
46! Initial version of purely vertical nesting introduced.
47!
[1805]48! 1804 2016-04-05 16:30:18Z maronga
49! Removed code for parameter file check (__check)
50!
[1763]51! 1762 2016-02-25 12:31:13Z hellstea
52! Introduction of nested domain feature
53!
[1683]54! 1682 2015-10-07 23:56:08Z knoop
55! Code annotations made doxygen readable
56!
[1349]57! 1348 2014-03-27 18:01:03Z raasch
58! bugfix: bc_lr_cyc and bc_ns_cyc added to ONLY-list
59!
[1321]60! 1320 2014-03-20 08:40:49Z raasch
[1320]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
[1]67!
[1093]68! 1092 2013-02-02 11:24:22Z raasch
69! unused variables removed
70!
[1037]71! 1036 2012-10-22 13:43:42Z raasch
72! code put under GPL (PALM 3.9)
73!
[842]74! 841 2012-02-28 12:29:49Z maronga
75! Excluded routine from compilation of namelist_file_check
76!
[1]77! Revision 1.1  1998/01/23 09:58:21  raasch
78! Initial revision
79!
80!
81! Description:
82! ------------
[1682]83!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
84!> boundary conditions, respectively, for 2D-arrays.
[1]85!------------------------------------------------------------------------------!
[1682]86 SUBROUTINE exchange_horiz_2d( ar )
87 
[1]88
[1320]89    USE control_parameters,                                                    &
[3182]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 
[1320]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   
[1]102    USE pegrid
103
[1933]104    USE pmc_interface,                                                         &
105        ONLY : nesting_mode
106
107
[1]108    IMPLICIT NONE
109
[841]110
[1682]111    INTEGER(iwp) :: i  !<
[1320]112   
[1682]113    REAL(wp) ::  ar(nysg:nyng,nxlg:nxrg)  !<
[1320]114   
[1]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
[702]127       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
128       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
[1]129
130    ELSE
131!
132!--    Send left boundary, receive right one
[667]133
[702]134       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                 &
135                          ar(nysg,nxr+1), 1, type_y, pright, 0,               &
[1]136                          comm2d, status, ierr )
137!
138!--    Send right boundary, receive left one
[702]139       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,         &
140                          ar(nysg,nxlg), 1, type_y, pleft,   1,               &
[1]141                          comm2d, status, ierr )
[702]142                         
143     
[1]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
[702]150       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
151       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
[1]152
153    ELSE
154!
155!--    Send front boundary, receive rear one
[667]156
[702]157       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                 &         
158                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0,               &
[1]159                          comm2d, status, ierr )
160!
161!--    Send rear boundary, receive front one
[702]162       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,          &
163                          ar(nysg,nxlg), 1, type_x, psouth, 1,                &
[1]164                          comm2d, status, ierr )
[667]165
[1]166    ENDIF
167
168#else
169
170!
171!-- Lateral boundary conditions in the non-parallel case
[707]172    IF ( bc_lr_cyc )  THEN
[702]173       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
174       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
[1]175    ENDIF
176
[707]177    IF ( bc_ns_cyc )  THEN
[702]178       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
179       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
[1]180    ENDIF
181
[667]182
[1]183#endif
184
[73]185!
[1762]186!-- Neumann-conditions at inflow/outflow/nested boundaries
[1933]187    IF ( nesting_mode /= 'vertical' )  THEN
[3182]188       IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
[1933]189          DO  i = nbgp, 1, -1
190             ar(:,nxl-i) = ar(:,nxl)
191          ENDDO
192       ENDIF
[3182]193       IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
[1933]194          DO  i = 1, nbgp
195             ar(:,nxr+i) = ar(:,nxr)
196          ENDDO
197       ENDIF
[3182]198       IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
[1933]199          DO  i = nbgp, 1, -1
200             ar(nys-i,:) = ar(nys,:)
201          ENDDO
202       ENDIF
[3182]203       IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
[1933]204          DO  i = 1, nbgp
205             ar(nyn+i,:) = ar(nyn,:)
206          ENDDO
207       ENDIF
[1762]208    ENDIF
209
[1]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! ------------
[1682]219!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
220!> boundary conditions, respectively, for 2D integer arrays.
[1]221!------------------------------------------------------------------------------!
[1682]222 
[1968]223 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
[1]224
[1682]225
[1320]226    USE control_parameters,                                                    &
[3182]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
[1320]230       
231    USE cpulog,                                                                &
232        ONLY:  cpu_log, log_point_s
[1968]233               
[1320]234    USE kinds
235   
[1]236    USE pegrid
237
238    IMPLICIT NONE
239
[1968]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
[1]246
[1968]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
[1]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
[1968]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)
[1]263
264    ELSE
265!
266!--    Send left boundary, receive right one
[1968]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,                   &
[1]271                          comm2d, status, ierr )
272!
273!--    Send right boundary, receive left one
[1968]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 )                         
[667]279
[1]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
[1968]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,:)
[1]288
[667]289
[1]290    ELSE
291!
292!--    Send front boundary, receive rear one
[1968]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,                  &
[702]297                          comm2d, status, ierr )                         
[667]298
[1]299!
300!--    Send rear boundary, receive front one
[1968]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,                  &
[1]305                          comm2d, status, ierr )
[667]306
[1]307    ENDIF
308
309#else
310
311!
312!-- Lateral boundary conditions in the non-parallel case
[707]313    IF ( bc_lr_cyc )  THEN
[1968]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)
[1]316    ENDIF
317
[707]318    IF ( bc_ns_cyc )  THEN
[1968]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,:)
[1]321    ENDIF
322
323#endif
[1762]324!
325!-- Neumann-conditions at inflow/outflow/nested boundaries
[3182]326    IF ( bc_dirichlet_l )  THEN
[1968]327       DO  i = nbgp_local, 1, -1
328         ar(:,nxl_l-i) = ar(:,nxl_l)
[1762]329       ENDDO
330    ENDIF
[3182]331    IF ( bc_dirichlet_r )  THEN
[1968]332       DO  i = 1, nbgp_local
333          ar(:,nxr_l+i) = ar(:,nxr_l)
[1762]334       ENDDO
335    ENDIF
[3182]336    IF ( bc_dirichlet_s )  THEN
[1968]337       DO  i = nbgp_local, 1, -1
338         ar(nys_l-i,:) = ar(nys_l,:)
[1762]339       ENDDO
340    ENDIF
[3182]341    IF ( bc_dirichlet_n )  THEN
[1968]342       DO  i = 1, nbgp_local
343         ar(nyn_l+i,:) = ar(nyn_l,:)
[1762]344       ENDDO
345    ENDIF
346
[1]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.