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