source: palm/trunk/SOURCE/exchange_horiz.f90 @ 4372

Last change on this file since 4372 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: 13.2 KB
Line 
1!> @file exchange_horiz.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.f90 4360 2020-01-07 11:25:50Z banzhafs $
27! Corrected "Former revisions" section
28!
29! 3761 2019-02-25 15:31:42Z raasch
30! OpenACC directives re-formatted
31!
32! 3657 2019-01-07 20:14:18Z knoop
33! OpenACC port for SPEC
34!
35! Revision 1.1  1997/07/24 11:13:29  raasch
36! Initial revision
37!
38!
39! Description:
40! ------------
41!> Exchange of lateral boundary values (parallel computers) and cyclic
42!> lateral boundary conditions, respectively.
43!------------------------------------------------------------------------------!
44 SUBROUTINE exchange_horiz( ar, nbgp_local)
45 
46
47    USE control_parameters,                                                    &
48        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, mg_switch_to_pe0, synchronous_exchange
49               
50    USE cpulog,                                                                &
51        ONLY:  cpu_log, log_point_s
52       
53    USE indices,                                                               &
54        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
55       
56    USE kinds
57   
58    USE pegrid
59
60    IMPLICIT NONE
61
62
63#if defined( _OPENACC )
64    INTEGER(iwp) ::  i           !<
65#endif
66
67    INTEGER(iwp) ::  nbgp_local  !<
68   
69    REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local,               &
70                        nxl-nbgp_local:nxr+nbgp_local) ::  ar  !<
71                       
72
73    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
74
75#if defined( _OPENACC )
76    !$ACC UPDATE IF_PRESENT ASYNC(1) &
77    !$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) &
78    !$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1))
79
80!
81!-- Wait for first UPDATE to complete before starting the others.
82    !$ACC WAIT(1) ASYNC(2)
83    ! ar(:,:,nxl-nbgp_local:nxl-1) is overwritten by first part below
84    ! ar(:,:,nxl:nxl+nbgp_local-1) has been transferred above
85    DO i = nxl+nbgp_local, nxr-nbgp_local
86       !$ACC UPDATE IF_PRESENT ASYNC(2) &
87       !$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) &
88       !$ACC HOST(ar(:,nys:nys+nbgp_local-1,i))
89    ENDDO
90    ! ar(:,:,nxr-nbgp_local+1:nxr) has been transferred above
91    ! ar(:,:,nxr+1:nxr+nbgp_local) is overwritten by first part below
92
93!
94!-- Wait for first UPDATE to complete before starting MPI.
95    !$ACC WAIT(1)
96#endif
97
98#if defined( __parallel )
99
100!
101!-- Exchange in x-direction of lateral boundaries
102    IF ( pdims(1) == 1  .OR.  mg_switch_to_pe0 )  THEN
103!
104!--    One-dimensional decomposition along y, boundary values can be exchanged
105!--    within the PE memory
106       IF ( bc_lr_cyc )  THEN
107          ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
108          ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
109       ENDIF
110
111    ELSE
112
113       IF ( synchronous_exchange )  THEN
114!
115!--       Send left boundary, receive right one (synchronous)
116          CALL MPI_SENDRECV(                                                   &
117              ar(nzb,nys-nbgp_local,nxl),   1, type_yz(grid_level), pleft,  0, &
118              ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), pright, 0, &
119              comm2d, status, ierr )
120!
121!--       Send right boundary, receive left one (synchronous)
122          CALL MPI_SENDRECV( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1,       &
123                             type_yz(grid_level), pright, 1,                   &
124                             ar(nzb,nys-nbgp_local,nxl-nbgp_local), 1,         &
125                             type_yz(grid_level), pleft,  1,                   &
126                             comm2d, status, ierr )
127
128       ELSE
129
130!
131!--       Asynchroneous exchange
132          IF ( send_receive == 'lr'  .OR.  send_receive == 'al' )  THEN
133
134             req(1:4)  = 0
135             req_count = 0
136!
137!--          Send left boundary, receive right one (asynchronous)
138             CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxl),   1, type_yz(grid_level), &
139                             pleft, req_count, comm2d, req(req_count+1), ierr )
140             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz(grid_level), &
141                             pright, req_count, comm2d, req(req_count+2), ierr )
142!
143!--          Send right boundary, receive left one (asynchronous)
144             CALL MPI_ISEND( ar(nzb,nys-nbgp_local,nxr+1-nbgp_local), 1,       &
145                             type_yz(grid_level), pright, req_count+1, comm2d, &
146                             req(req_count+3), ierr )
147             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
148                             type_yz(grid_level), pleft,  req_count+1, comm2d, &
149                             req(req_count+4), ierr )
150
151             CALL MPI_WAITALL( 4, req, wait_stat, ierr )
152
153          ENDIF
154
155       ENDIF
156
157    ENDIF
158
159    !$ACC UPDATE IF_PRESENT ASYNC(1) &
160    !$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
161    !$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
162
163!
164!-- Wait for UPDATES above to complete before starting MPI.
165    !$ACC WAIT(2)
166
167    IF ( pdims(2) == 1  .OR.  mg_switch_to_pe0 )  THEN
168!
169!--    One-dimensional decomposition along x, boundary values can be exchanged
170!--    within the PE memory
171       IF ( bc_ns_cyc )  THEN
172          ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
173          ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
174       ENDIF
175
176    ELSE
177
178       IF ( synchronous_exchange )  THEN
179!
180!--       Send front boundary, receive rear one (synchronous)
181          CALL MPI_SENDRECV(                                                   &
182              ar(nzb,nys,nxl-nbgp_local),   1, type_xz(grid_level), psouth, 0, &
183              ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), pnorth, 0, &
184              comm2d, status, ierr )
185!
186!--       Send rear boundary, receive front one (synchronous)
187          CALL MPI_SENDRECV( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1,       &
188                             type_xz(grid_level), pnorth, 1,                   &
189                             ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
190                             type_xz(grid_level), psouth, 1,                   &
191                             comm2d, status, ierr )
192
193       ELSE
194
195!
196!--       Asynchroneous exchange
197          IF ( send_receive == 'ns'  .OR.  send_receive == 'al' )  THEN
198
199             req(1:4)  = 0
200             req_count = 0
201
202!
203!--          Send front boundary, receive rear one (asynchronous)
204             CALL MPI_ISEND( ar(nzb,nys,nxl-nbgp_local),   1, type_xz(grid_level), &
205                             psouth, req_count, comm2d, req(req_count+1), ierr )
206             CALL MPI_IRECV( ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz(grid_level), &
207                             pnorth, req_count, comm2d, req(req_count+2), ierr )
208!
209!--          Send rear boundary, receive front one (asynchronous)
210             CALL MPI_ISEND( ar(nzb,nyn-nbgp_local+1,nxl-nbgp_local), 1,       &
211                             type_xz(grid_level), pnorth, req_count+1, comm2d, &
212                             req(req_count+3), ierr )
213             CALL MPI_IRECV( ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,       &
214                             type_xz(grid_level), psouth, req_count+1, comm2d, &
215                             req(req_count+4), ierr )
216
217             CALL MPI_WAITALL( 4, req, wait_stat, ierr )
218
219          ENDIF
220
221       ENDIF
222
223    ENDIF
224
225#else
226
227!
228!-- Lateral boundary conditions in the non-parallel case.
229!-- Case dependent, because in GPU mode still not all arrays are on device. This
230!-- workaround has to be removed later. Also, since PGI compiler 12.5 has problems
231!-- with array syntax, explicit loops are used.
232    IF ( bc_lr_cyc )  THEN
233       ar(:,:,nxl-nbgp_local:nxl-1) = ar(:,:,nxr-nbgp_local+1:nxr)
234       ar(:,:,nxr+1:nxr+nbgp_local) = ar(:,:,nxl:nxl+nbgp_local-1)
235    ENDIF
236
237    !$ACC UPDATE IF_PRESENT ASYNC(1) &
238    !$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) &
239    !$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local))
240
241!
242!-- Wait for UPDATES above to complete before starting MPI.
243    !$ACC WAIT(2)
244
245    IF ( bc_ns_cyc )  THEN
246       ar(:,nys-nbgp_local:nys-1,:) = ar(:,nyn-nbgp_local+1:nyn,:)
247       ar(:,nyn+1:nyn+nbgp_local,:) = ar(:,nys:nys+nbgp_local-1,:)
248    ENDIF
249
250#endif
251
252#if defined( _OPENACC )
253    DO i = nxl-nbgp_local, nxr+nbgp_local
254       !$ACC UPDATE IF_PRESENT ASYNC(2) &
255       !$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) &
256       !$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i))
257    ENDDO
258
259!
260!-- Wait for all UPDATEs to finish.
261    !$ACC WAIT
262#endif
263
264    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
265
266 END SUBROUTINE exchange_horiz
267
268
269!------------------------------------------------------------------------------!
270! Description:
271! ------------
272!> @todo Missing subroutine description.
273!------------------------------------------------------------------------------!
274 SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local)
275
276    USE control_parameters,                                                    &
277        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level
278                       
279    USE indices,                                                               &
280        ONLY:  nzb
281       
282    USE kinds
283   
284    USE pegrid
285
286    IMPLICIT NONE
287
288    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
289    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
290    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
291    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
292    INTEGER(iwp) ::  nzt_l       !< local index bound at current grid level, top
293    INTEGER(iwp) ::  nbgp_local  !< number of ghost points
294   
295    INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local,     &
296                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
297
298
299#if defined( __parallel )
300    IF ( pdims(1) == 1 )  THEN
301!
302!--    One-dimensional decomposition along y, boundary values can be exchanged
303!--    within the PE memory
304       IF ( bc_lr_cyc )  THEN
305          ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
306          ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
307       ENDIF
308    ELSE
309!
310!--    Send left boundary, receive right one (synchronous)
311       CALL MPI_SENDRECV(                                                          &
312           ar(nzb,nys_l-nbgp_local,nxl_l),   1, type_yz_int(grid_level), pleft,  0,&
313           ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0,&
314           comm2d, status, ierr )
315!
316!--    Send right boundary, receive left one (synchronous)
317       CALL MPI_SENDRECV(                                                          &
318           ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level),&
319           pright, 1,                                                              &
320           ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1, type_yz_int(grid_level),&
321           pleft,  1,                                                              &
322           comm2d, status, ierr )
323    ENDIF
324
325
326    IF ( pdims(2) == 1 )  THEN
327!
328!--    One-dimensional decomposition along x, boundary values can be exchanged
329!--    within the PE memory
330       IF ( bc_ns_cyc )  THEN
331          ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
332          ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
333       ENDIF
334
335    ELSE
336
337!
338!--    Send front boundary, receive rear one (synchronous)
339       CALL MPI_SENDRECV(                                                          &
340           ar(nzb,nys_l,nxl_l-nbgp_local),   1, type_xz_int(grid_level), psouth, 0,&
341           ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0,&
342           comm2d, status, ierr )
343!
344!--    Send rear boundary, receive front one (synchronous)
345       CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1,          &
346                          type_xz_int(grid_level), pnorth, 1,                      &
347                          ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1,          &
348                          type_xz_int(grid_level), psouth, 1,                      &
349                          comm2d, status, ierr )
350
351    ENDIF
352
353#else
354
355    IF ( bc_lr_cyc )  THEN
356       ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
357       ar(:,:,nxr_l+1:nxr_l+nbgp_local) = ar(:,:,nxl_l:nxl_l+nbgp_local-1)
358    ENDIF
359
360    IF ( bc_ns_cyc )  THEN
361       ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
362       ar(:,nyn_l+1:nyn_l+nbgp_local,:) = ar(:,nys_l:nys_l+nbgp_local-1,:)
363    ENDIF
364
365#endif
366
367
368 END SUBROUTINE exchange_horiz_int
Note: See TracBrowser for help on using the repository browser.