File: N:\mfix\model\cartesian_grid\dmp_cartesian.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: SEND_RECEIVE_CUT_CELL_VARIABLES                        C
4     !  Purpose: Send/receive all relevant cut cell related variables       C
5     !                                                                      C
6     !  Author: Jeff Dietiker                              Date: 21-Feb-08  C
7     !  Reviewer:                                          Date:            C
8     !                                                                      C
9     !  Revision Number #                                  Date: ##-###-##  C
10     !  Author: #                                                           C
11     !  Purpose: #                                                          C
12     !                                                                      C
13     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
14       SUBROUTINE SEND_RECEIVE_CUT_CELL_VARIABLES
15     
16           USE param
17           USE param1
18           USE parallel
19           USE constant
20           USE run
21           USE toleranc
22           USE geometry
23           USE indices
24           USE compar
25           USE sendrecv
26           USE quadric
27           USE cutcell
28           USE functions
29     
30           USE mpi_utility      !//d pnicol : for gather
31     
32     
33           IMPLICIT NONE
34     
35           call SEND_RECEIVE_1D_LOGICAL(WALL_U_AT,2)
36           call SEND_RECEIVE_1D_LOGICAL(WALL_V_AT,2)
37           call SEND_RECEIVE_1D_LOGICAL(WALL_W_AT,2)
38     
39           call send_recv(area_cut, 2)
40           call send_recv(Area_U_CUT,2)
41           call send_recv(Area_V_CUT,2)
42           call send_recv(Area_W_CUT,2)
43     
44           call send_recv(DELX_Ue,2)
45           call send_recv(DELX_Uw,2)
46           call send_recv(DELY_Un,2)
47           call send_recv(DELY_Us,2)
48           call send_recv(DELZ_Ut,2)
49           call send_recv(DELZ_Ub,2)
50     
51           call send_recv(DELX_Ve,2)
52           call send_recv(DELX_Vw,2)
53           call send_recv(DELY_Vn,2)
54           call send_recv(DELY_Vs,2)
55           call send_recv(DELZ_Vt,2)
56           call send_recv(DELZ_Vb,2)
57     
58           call send_recv(DELX_We,2)
59           call send_recv(DELX_Ww,2)
60           call send_recv(DELY_Wn,2)
61           call send_recv(DELY_Ws,2)
62           call send_recv(DELZ_Wt,2)
63           call send_recv(DELZ_Wb,2)
64     
65           call send_recv(X_U,2)
66           call send_recv(Y_U,2)
67           call send_recv(Z_U,2)
68     
69           call send_recv(X_U_ec,2)
70           call send_recv(Y_U_ec,2)
71           call send_recv(Z_U_ec,2)
72     
73           call send_recv(X_U_nc,2)
74           call send_recv(Y_U_nc,2)
75           call send_recv(Z_U_nc,2)
76     
77           call send_recv(X_U_tc,2)
78           call send_recv(Y_U_tc,2)
79           call send_recv(Z_U_tc,2)
80     
81           call send_recv(X_V,2)
82           call send_recv(Y_V,2)
83           call send_recv(Z_V,2)
84     
85           call send_recv(X_V_ec,2)
86           call send_recv(Y_V_ec,2)
87           call send_recv(Z_V_ec,2)
88     
89           call send_recv(X_V_nc,2)
90           call send_recv(Y_V_nc,2)
91           call send_recv(Z_V_nc,2)
92     
93           call send_recv(X_V_tc,2)
94           call send_recv(Y_V_tc,2)
95           call send_recv(Z_V_tc,2)
96     
97           call send_recv(X_W,2)
98           call send_recv(Y_W,2)
99           call send_recv(Z_W,2)
100     
101           call send_recv(X_W_ec,2)
102           call send_recv(Y_W_ec,2)
103           call send_recv(Z_W_ec,2)
104     
105           call send_recv(X_W_nc,2)
106           call send_recv(Y_W_nc,2)
107           call send_recv(Z_W_nc,2)
108     
109           call send_recv(X_W_tc,2)
110           call send_recv(Y_W_tc,2)
111           call send_recv(Z_W_tc,2)
112     
113           call send_recv(DELH_Scalar,2)
114           call send_recv(DELH_U,2)
115           call send_recv(DELH_V,2)
116           call send_recv(DELH_W,2)
117     
118           call send_recv(NORMAL_S,2)
119           call send_recv(NORMAL_U,2)
120           call send_recv(NORMAL_V,2)
121           call send_recv(NORMAL_W,2)
122     
123           call send_recv(REFP_S,2)
124           call send_recv(REFP_U,2)
125           call send_recv(REFP_V,2)
126           call send_recv(REFP_W,2)
127     
128           call send_recv(Theta_Ue,2)
129           call send_recv(Theta_Ue_bar,2)
130           call send_recv(Theta_U_ne,2)
131           call send_recv(Theta_U_nw,2)
132           call send_recv(Theta_U_te,2)
133           call send_recv(Theta_U_tw,2)
134           call send_recv(ALPHA_Ue_c,2)
135           call send_recv(NOC_U_E,2)
136           call send_recv(Theta_Un,2)
137           call send_recv(Theta_Un_bar,2)
138           call send_recv(ALPHA_Un_c,2)
139           call send_recv(NOC_U_N,2)
140           call send_recv(Theta_Ut,2)
141           call send_recv(Theta_Ut_bar,2)
142           call send_recv(ALPHA_Ut_c,2)
143           call send_recv(NOC_U_T,2)
144           call send_recv(A_UPG_E,2)
145           call send_recv(A_UPG_W,2)
146     
147           call send_recv(Theta_V_ne,2)
148           call send_recv(Theta_V_se,2)
149           call send_recv(Theta_Vn,2)
150           call send_recv(Theta_Vn_bar,2)
151           call send_recv(Theta_V_nt,2)
152           call send_recv(Theta_V_st,2)
153           call send_recv(Theta_Ve,2)
154           call send_recv(Theta_Ve_bar,2)
155           call send_recv(ALPHA_Ve_c,2)
156           call send_recv(NOC_V_E,2)
157           call send_recv(ALPHA_Vn_c,2)
158           call send_recv(NOC_V_N,2)
159           call send_recv(Theta_Vt,2)
160           call send_recv(Theta_Vt_bar,2)
161           call send_recv(ALPHA_Vt_c,2)
162           call send_recv(NOC_V_T,2)
163           call send_recv(A_VPG_N,2)
164           call send_recv(A_VPG_S,2)
165     
166           call send_recv(Theta_W_te,2)
167           call send_recv(Theta_W_be,2)
168           call send_recv(Theta_W_tn,2)
169           call send_recv(Theta_W_bn,2)
170           call send_recv(Theta_Wt,2)
171           call send_recv(Theta_Wt_bar,2)
172           call send_recv(Theta_We,2)
173           call send_recv(Theta_We_bar,2)
174           call send_recv(ALPHA_We_c,2)
175           call send_recv(NOC_W_E,2)
176           call send_recv(Theta_Wn,2)
177           call send_recv(Theta_Wn_bar,2)
178           call send_recv(ALPHA_Wn_c,2)
179           call send_recv(NOC_W_N,2)
180           call send_recv(ALPHA_Wt_c,2)
181           call send_recv(NOC_W_T,2)
182           call send_recv(A_WPG_T,2)
183           call send_recv(A_WPG_B,2)
184     
185           call send_recv(ONEoDX_E_U,2)
186           call send_recv(ONEoDY_N_U,2)
187           call send_recv(ONEoDZ_T_U,2)
188     
189           call send_recv(ONEoDX_E_V,2)
190           call send_recv(ONEoDY_N_V,2)
191           call send_recv(ONEoDZ_T_V,2)
192     
193           call send_recv(ONEoDX_E_W,2)
194           call send_recv(ONEoDY_N_W,2)
195           call send_recv(ONEoDZ_T_W,2)
196     
197           call SEND_RECEIVE_1D_LOGICAL(CUT_TREATMENT_AT,2)
198           call SEND_RECEIVE_1D_LOGICAL(CUT_U_TREATMENT_AT,2)
199           call SEND_RECEIVE_1D_LOGICAL(CUT_V_TREATMENT_AT,2)
200           call SEND_RECEIVE_1D_LOGICAL(CUT_W_TREATMENT_AT,2)
201     
202           call SEND_RECEIVE_1D_LOGICAL(CUT_CELL_AT,2)
203           call SEND_RECEIVE_1D_LOGICAL(CUT_U_CELL_AT,2)
204           call SEND_RECEIVE_1D_LOGICAL(CUT_V_CELL_AT,2)
205           call SEND_RECEIVE_1D_LOGICAL(CUT_W_CELL_AT,2)
206     
207           call SEND_RECEIVE_1D_LOGICAL(SMALL_CELL_AT,2)
208           call send_recv(SMALL_CELL_FLAG,2)
209     
210     
211           call SEND_RECEIVE_1D_LOGICAL(BLOCKED_CELL_AT,2)
212           call SEND_RECEIVE_1D_LOGICAL(BLOCKED_U_CELL_AT,2)
213           call SEND_RECEIVE_1D_LOGICAL(BLOCKED_V_CELL_AT,2)
214           call SEND_RECEIVE_1D_LOGICAL(BLOCKED_W_CELL_AT,2)
215     
216           call SEND_RECEIVE_1D_LOGICAL(STANDARD_CELL_AT,2)
217           call SEND_RECEIVE_1D_LOGICAL(STANDARD_U_CELL_AT,2)
218           call SEND_RECEIVE_1D_LOGICAL(STANDARD_V_CELL_AT,2)
219           call SEND_RECEIVE_1D_LOGICAL(STANDARD_W_CELL_AT,2)
220     
221           call send_recv(U_MASTER_OF,2)
222           call send_recv(V_MASTER_OF,2)
223           call send_recv(W_MASTER_OF,2)
224     
225           call send_recv(BC_ID,2)
226           call send_recv(BC_U_ID,2)
227           call send_recv(BC_V_ID,2)
228           call send_recv(BC_W_ID,2)
229     
230           call send_recv(FLAG,2)
231           call send_recv(FLAG_E,2)
232           call send_recv(FLAG_N,2)
233           call send_recv(FLAG_T,2)
234     
235           call send_recv(AYZ,2)
236           call send_recv(AXZ,2)
237           call send_recv(AXY,2)
238           call send_recv(VOL,2)
239     
240           call send_recv(AYZ_U,2)
241           call send_recv(AXZ_U,2)
242           call send_recv(AXY_U,2)
243           call send_recv(VOL_U,2)
244     
245           call send_recv(AYZ_V,2)
246           call send_recv(AXZ_V,2)
247           call send_recv(AXY_V,2)
248           call send_recv(VOL_V,2)
249     
250           call send_recv(AYZ_W,2)
251           call send_recv(AXZ_W,2)
252           call send_recv(AXY_W,2)
253           call send_recv(VOL_W,2)
254     
255           RETURN
256     
257     
258           END SUBROUTINE SEND_RECEIVE_CUT_CELL_VARIABLES
259     
260     
261     
262     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
263     !                                                                      C
264     !  Module name: SEND_RECEIVE_2D_LOGICAL                                C
265     !  Purpose: Emulates send/receive for a 2D logical array               C
266     !  using temporary integer                                             C
267     !                                                                      C
268     !  Author: Jeff Dietiker                              Date: 21-Feb-08  C
269     !  Reviewer:                                          Date:            C
270     !                                                                      C
271     !  Revision Number #                                  Date: ##-###-##  C
272     !  Author: #                                                           C
273     !  Purpose: #                                                          C
274     !                                                                      C
275     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
276       SUBROUTINE SEND_RECEIVE_1D_LOGICAL(L1D,NLAYERS)
277     
278           USE param
279           USE param1
280           USE parallel
281           USE constant
282           USE run
283           USE toleranc
284           USE geometry
285           USE indices
286           USE compar
287           USE sendrecv
288           USE quadric
289           USE cutcell
290     
291           USE mpi_utility      !//d pnicol : for gather
292     
293           IMPLICIT NONE
294           INTEGER :: IJK,NLAYERS
295           INTEGER, DIMENSION(DIMENSION_3) :: I1D
296           LOGICAL, DIMENSION(DIMENSION_3) :: L1D
297     
298           IF((NLAYERS/=1).AND.(NLAYERS/=2)) THEN
299              WRITE(*,*)' NLAYERS=',NLAYERS
300              WRITE(*,*)' SEND_RECEIVE_1D_LOGICAL ERROR: NLAYER MUST BE EQUAL TO 1 or 2'
301              CALL MFIX_EXIT(MYPE)
302           ENDIF
303     
304           DO IJK = IJKSTART3, IJKEND3
305              IF(L1D(IJK)) THEN
306                 I1D(IJK) = 1
307              ELSE
308                 I1D(IJK) = 0
309              ENDIF
310           ENDDO
311     
312           call send_recv(I1D,NLAYERS)
313     
314           DO IJK = IJKSTART3, IJKEND3
315              IF(I1D(IJK)==1) THEN
316                 L1D(IJK) = .TRUE.
317              ELSE
318                 L1D(IJK) = .FALSE.
319              ENDIF
320           ENDDO
321     
322     
323           RETURN
324     
325     
326           END SUBROUTINE SEND_RECEIVE_1D_LOGICAL
327     
328     
329     
330     
331     
332     
333     
334     
335     
336     
337     
338