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

Last change on this file since 492 was 484, checked in by raasch, 14 years ago

typo in file headers removed

  • Property svn:keywords set to Id
File size: 3.9 KB
Line 
1 SUBROUTINE exchange_horiz( ar )
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: exchange_horiz.f90 484 2010-02-05 07:36:54Z maronga $
11!
12! 75 2007-03-22 09:54:05Z raasch
13! Special cases for additional gridpoints along x or y in case of non-cyclic
14! boundary conditions are not regarded any more
15!
16! RCS Log replace by Id keyword, revision history cleaned up
17!
18! Revision 1.16  2006/02/23 12:19:08  raasch
19! anz_yz renamed ngp_yz
20!
21! Revision 1.1  1997/07/24 11:13:29  raasch
22! Initial revision
23!
24!
25! Description:
26! ------------
27! Exchange of lateral boundary values (parallel computers) and cyclic
28! lateral boundary conditions, respectively.
29!------------------------------------------------------------------------------!
30
31    USE control_parameters
32    USE cpulog
33    USE indices
34    USE interfaces
35    USE pegrid
36
37    IMPLICIT NONE
38
39#if defined( __parallel )
40    INTEGER, DIMENSION(4)                 ::  req
41    INTEGER, DIMENSION(MPI_STATUS_SIZE,4) ::  wait_stat
42#endif
43
44    REAL ::  ar(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
45
46
47    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
48
49#if defined( __parallel )
50
51!
52!-- Exchange of lateral boundary values for parallel computers
53    IF ( pdims(1) == 1  .OR.  mg_switch_to_pe0 )  THEN
54!
55!--    One-dimensional decomposition along y, boundary values can be exchanged
56!--    within the PE memory
57       IF ( bc_lr == 'cyclic' )  THEN
58          ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
59          ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
60       ENDIF
61
62    ELSE
63
64       req = 0
65!
66!--    Send left boundary, receive right one
67       CALL MPI_ISEND(                                                     &
68               ar(nzb,nys-1,nxl), ngp_yz(grid_level), MPI_REAL, pleft,  0, &
69                          comm2d, req(1), ierr )
70       CALL MPI_IRECV(                                                       &
71               ar(nzb,nys-1,nxr+1), ngp_yz(grid_level), MPI_REAL, pright, 0, &
72                          comm2d, req(2), ierr )
73!
74!--    Send right boundary, receive left one
75       CALL MPI_ISEND(                                                     &
76               ar(nzb,nys-1,nxr), ngp_yz(grid_level), MPI_REAL, pright, 1, &
77                          comm2d, req(3), ierr )
78       CALL MPI_IRECV(                                                       &
79               ar(nzb,nys-1,nxl-1), ngp_yz(grid_level), MPI_REAL, pleft,  1, &
80                          comm2d, req(4), ierr )
81       CALL MPI_WAITALL( 4, req, wait_stat, ierr )
82
83    ENDIF
84
85
86    IF ( pdims(2) == 1  .OR.  mg_switch_to_pe0 )  THEN
87!
88!--    One-dimensional decomposition along x, boundary values can be exchanged
89!--    within the PE memory
90       IF ( bc_ns == 'cyclic' )  THEN
91          ar(:,nys-1,:) = ar(:,nyn,:)
92          ar(:,nyn+1,:) = ar(:,nys,:)
93       ENDIF
94
95    ELSE
96
97       req = 0
98!
99!--    Send front boundary, receive rear one
100       CALL MPI_ISEND( ar(nzb,nys,nxl-1),   1, type_xz(grid_level), psouth, 0, &
101                       comm2d, req(1), ierr )
102       CALL MPI_IRECV( ar(nzb,nyn+1,nxl-1), 1, type_xz(grid_level), pnorth, 0, &
103                       comm2d, req(2), ierr )
104!
105!--    Send rear boundary, receive front one
106       CALL MPI_ISEND( ar(nzb,nyn,nxl-1),   1, type_xz(grid_level), pnorth, 1, &
107                       comm2d, req(3), ierr )
108       CALL MPI_IRECV( ar(nzb,nys-1,nxl-1), 1, type_xz(grid_level), psouth, 1, &
109                       comm2d, req(4), ierr )
110       call MPI_WAITALL( 4, req, wait_stat, ierr )
111
112    ENDIF
113
114
115#else
116
117!
118!-- Lateral boundary conditions in the non-parallel case
119    IF ( bc_lr == 'cyclic' )  THEN
120       ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
121       ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
122    ENDIF
123
124    IF ( bc_ns == 'cyclic' )  THEN
125       ar(:,nys-1,:) = ar(:,nyn,:)
126       ar(:,nyn+1,:) = ar(:,nys,:)
127    ENDIF
128
129#endif
130
131    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
132
133 END SUBROUTINE exchange_horiz
Note: See TracBrowser for help on using the repository browser.