source: palm/tags/release-3.1b/SOURCE/exchange_horiz_2d.f90 @ 42

Last change on this file since 42 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 5.2 KB
Line 
1 SUBROUTINE exchange_horiz_2d( ar )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: exchange_horiz_2d.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.9  2006/05/12 19:15:52  letzel
14! MPI_REAL replaced by MPI_INTEGER in exchange_horiz_2d_int
15!
16! Revision 1.1  1998/01/23 09:58:21  raasch
17! Initial revision
18!
19!
20! Description:
21! ------------
22! Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
23! boundary conditions, respectively, for 2D-arrays.
24!------------------------------------------------------------------------------!
25
26    USE control_parameters
27    USE cpulog
28    USE indices
29    USE interfaces
30    USE pegrid
31
32    IMPLICIT NONE
33
34    REAL ::  ar(nys-1:nyn+1,nxl-1:nxr+1)
35
36
37    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
38
39#if defined( __parallel )
40
41!
42!-- Exchange of lateral boundary values for parallel computers
43    IF ( pdims(1) == 1 )  THEN
44
45!
46!--    One-dimensional decomposition along y, boundary values can be exchanged
47!--    within the PE memory
48       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
49       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
50
51    ELSE
52!
53!--    Send left boundary, receive right one
54       CALL MPI_SENDRECV( ar(nys,nxl),   ngp_y, MPI_REAL, pleft,  0, &
55                          ar(nys,nxr+1), ngp_y, MPI_REAL, pright, 0, &
56                          comm2d, status, ierr )
57!
58!--    Send right boundary, receive left one
59       CALL MPI_SENDRECV( ar(nys,nxr),   ngp_y, MPI_REAL, pright,  1, &
60                          ar(nys,nxl-1), ngp_y, MPI_REAL, pleft,   1, &
61                          comm2d, status, ierr )
62    ENDIF
63
64    IF ( pdims(2) == 1 )  THEN
65!
66!--    One-dimensional decomposition along x, boundary values can be exchanged
67!--    within the PE memory
68       ar(nys-1,:) = ar(nyn,:)
69       ar(nyn+1,:) = ar(nys,:)
70
71    ELSE
72!
73!--    Send front boundary, receive rear one
74       CALL MPI_SENDRECV( ar(nys,nxl-1),   1, type_x, psouth, 0, &
75                          ar(nyn+1,nxl-1), 1, type_x, pnorth, 0, &
76                          comm2d, status, ierr )
77!
78!--    Send rear boundary, receive front one
79       CALL MPI_SENDRECV( ar(nyn,nxl-1),   1, type_x, pnorth, 1, &
80                          ar(nys-1,nxl-1), 1, type_x, psouth, 1, &
81                          comm2d, status, ierr )
82    ENDIF
83
84#else
85
86!
87!-- Lateral boundary conditions in the non-parallel case
88    IF ( bc_lr == 'cyclic' )  THEN
89       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
90       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
91    ENDIF
92
93    IF ( bc_ns == 'cyclic' )  THEN
94       ar(nys-1,:) = ar(nyn,:)
95       ar(nyn+1,:) = ar(nys,:)
96    ENDIF
97
98#endif
99
100    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
101
102 END SUBROUTINE exchange_horiz_2d
103
104
105
106 SUBROUTINE exchange_horiz_2d_int( ar )
107
108!------------------------------------------------------------------------------!
109! Description:
110! ------------
111! Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
112! boundary conditions, respectively, for 2D integer arrays.
113!------------------------------------------------------------------------------!
114
115    USE control_parameters
116    USE cpulog
117    USE indices
118    USE interfaces
119    USE pegrid
120
121    IMPLICIT NONE
122
123    INTEGER ::  ar(nys-1:nyn+1,nxl-1:nxr+1)
124
125
126    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
127
128#if defined( __parallel )
129
130!
131!-- Exchange of lateral boundary values for parallel computers
132    IF ( pdims(1) == 1 )  THEN
133
134!
135!--    One-dimensional decomposition along y, boundary values can be exchanged
136!--    within the PE memory
137       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
138       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
139
140    ELSE
141!
142!--    Send left boundary, receive right one
143       CALL MPI_SENDRECV( ar(nys,nxl),   ngp_y, MPI_INTEGER, pleft,  0, &
144                          ar(nys,nxr+1), ngp_y, MPI_INTEGER, pright, 0, &
145                          comm2d, status, ierr )
146!
147!--    Send right boundary, receive left one
148       CALL MPI_SENDRECV( ar(nys,nxr),   ngp_y, MPI_INTEGER, pright,  1, &
149                          ar(nys,nxl-1), ngp_y, MPI_INTEGER, pleft,   1, &
150                          comm2d, status, ierr )
151    ENDIF
152
153    IF ( pdims(2) == 1 )  THEN
154!
155!--    One-dimensional decomposition along x, boundary values can be exchanged
156!--    within the PE memory
157       ar(nys-1,:) = ar(nyn,:)
158       ar(nyn+1,:) = ar(nys,:)
159
160    ELSE
161!
162!--    Send front boundary, receive rear one
163       CALL MPI_SENDRECV( ar(nys,nxl-1),   1, type_x_int, psouth, 0, &
164                          ar(nyn+1,nxl-1), 1, type_x_int, pnorth, 0, &
165                          comm2d, status, ierr )
166!
167!--    Send rear boundary, receive front one
168       CALL MPI_SENDRECV( ar(nyn,nxl-1),   1, type_x_int, pnorth, 1, &
169                          ar(nys-1,nxl-1), 1, type_x_int, psouth, 1, &
170                          comm2d, status, ierr )
171    ENDIF
172
173#else
174
175!
176!-- Lateral boundary conditions in the non-parallel case
177    IF ( bc_lr == 'cyclic' )  THEN
178       ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
179       ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
180    ENDIF
181
182    IF ( bc_ns == 'cyclic' )  THEN
183       ar(nys-1,:) = ar(nyn,:)
184       ar(nyn+1,:) = ar(nys,:)
185    ENDIF
186
187#endif
188
189    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
190
191 END SUBROUTINE exchange_horiz_2d_int
Note: See TracBrowser for help on using the repository browser.