File: /nfs/home/0/users/jenkins/mfix.git/model/set_wall_bc.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 SUBROUTINE SET_WALL_BC()
32
33
34
35
36 USE param
37 USE param1
38 USE bc
39 USE fldvar
40 USE geometry
41 USE indices
42 USE physprop
43 USE run
44 USE funits
45 USE compar
46 USE functions
47 IMPLICIT NONE
48
49
50
51
52
53
54
55 INTEGER :: L
56
57 INTEGER :: IJK, IPJK
58
59 INTEGER :: I1, I2
60
61 INTEGER :: J1, J2
62
63 INTEGER :: K1, K2
64
65
66
67
68 DO L = 1, DIMENSION_BC
69 IF (BC_DEFINED(L)) THEN
70
71
72 = BC_I_W(L)
73 I2 = BC_I_E(L)
74 J1 = BC_J_S(L)
75 J2 = BC_J_N(L)
76 K1 = BC_K_B(L)
77 K2 = BC_K_T(L)
78
79 SELECT CASE (TRIM(BC_TYPE(L)))
80 CASE ('FREE_SLIP_WALL')
81 CALL SET_WALL_BC1 (I1, I2, J1, J2, K1, K2, &
82 BC_JJ_PS(L))
83
84 CASE ('NO_SLIP_WALL')
85 CALL SET_WALL_BC1 (I1, I2, J1, J2, K1, K2, &
86 BC_JJ_PS(L))
87
88 CASE ('PAR_SLIP_WALL')
89
90 END SELECT
91 ENDIF
92 ENDDO
93
94
95
96
97
98
99 = 1
100 DO J1 = JSTART3, JEND3
101 DO I1 = ISTART3, IEND3
102 IF(K1.NE.KSTART2) EXIT
103 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
104 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE
105 = FUNIJK(I1,J1,K1)
106 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1,&
107 J1, J1, K1, K1, 0)
108 ENDDO
109 ENDDO
110
111
112 = KMAX2
113 DO J1 = JSTART3, JEND3
114 DO I1 = ISTART3, IEND3
115 IF(K1.NE.KEND2) EXIT
116 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
117 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE
118 = FUNIJK(I1,J1,K1)
119 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
120 J1, J1, K1, K1, 0)
121 ENDDO
122 ENDDO
123
124
125 = 1
126 DO K1 = KSTART3, KEND3
127 DO I1 = ISTART3, IEND3
128 IF(J1.NE.JSTART2) EXIT
129 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
130 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE
131 = FUNIJK(I1,J1,K1)
132 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
133 J1, J1, K1, K1, 0)
134 ENDDO
135 ENDDO
136
137
138 = JMAX2
139 DO K1 = KSTART3, KEND3
140 DO I1 = ISTART3, IEND3
141 IF(J1.NE.JEND2) EXIT
142 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
143 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE
144 = FUNIJK(I1,J1,K1)
145 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
146 J1, J1, K1, K1, 0)
147 ENDDO
148 ENDDO
149
150
151 = 1
152 DO K1 = KSTART3, KEND3
153 DO J1 = JSTART3, JEND3
154 IF(I1.NE.ISTART2) EXIT
155 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
156 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE
157 = FUNIJK(I1,J1,K1)
158 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
159 J1, J1, K1, K1, 0)
160
161
162
163
164 IF (CYLINDRICAL .AND. XMIN==ZERO) THEN
165 IPJK = IP_OF(IJK)
166 W_G(IJK) = -W_G(IPJK)
167 IF (MMAX > 0) THEN
168 W_S(IJK,:MMAX) = -W_S(IPJK,:MMAX)
169 ENDIF
170 ENDIF
171 ENDDO
172 ENDDO
173
174
175 = IMAX2
176 DO K1 = KSTART3, KEND3
177 DO J1 = JSTART3, JEND3
178 IF(I1.NE.IEND2) EXIT
179 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
180 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE
181 = FUNIJK(I1,J1,K1)
182 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
183 J1, J1, K1, K1, 0)
184 ENDDO
185 ENDDO
186 RETURN
187 END SUBROUTINE SET_WALL_BC
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216 SUBROUTINE SET_WALL_BC1(II1, II2, JJ1, JJ2, KK1, KK2, &
217 BC_JJ_PSL)
218
219
220
221
222 USE param
223 USE param1
224 USE bc
225 USE fldvar
226 USE geometry
227 USE indices
228 USE physprop
229 USE run
230 USE funits
231 USE compar
232 USE functions
233 IMPLICIT NONE
234
235
236
237
238 INTEGER, INTENT(IN) :: II1, II2
239
240 INTEGER, INTENT(IN) :: JJ1, JJ2
241
242 INTEGER, INTENT(IN) :: KK1, KK2
243
244 INTEGER, INTENT(IN) :: BC_JJ_PSL
245
246
247
248
249 DOUBLE PRECISION :: SIGN0
250
251 INTEGER :: I, J, K
252 INTEGER :: IJK, IMJK, IJMK, IJKM, IPJK, IJPK, IJKP
253 INTEGER :: I1, I2, J1, J2, K1, K2
254
255 INTEGER :: LFLUID
256
257
258
259 = II1
260 I2 = II2
261 J1 = JJ1
262 J2 = JJ2
263 K1 = KK1
264 K2 = KK2
265
266 IF(I1.LE.IEND2) I1 = MAX(I1, ISTART2)
267 IF(J1.LE.JEND2) J1 = MAX(J1, JSTART2)
268 IF(K1.LE.KEND2) K1 = MAX(K1, KSTART2)
269 IF(I2.GE.ISTART2) I2 = MIN(I2, IEND2)
270 IF(J2.GE.JSTART2) J2 = MIN(J2, JEND2)
271 IF(K2.GE.KSTART2) K2 = MIN(K2, KEND2)
272
273 DO K = K1, K2
274 DO J = J1, J2
275 DO I = I1, I2
276 IJK = FUNIJK(I,J,K)
277
278 IF (DEAD_CELL_AT(I,J,K)) CYCLE
279
280
281 IF(NS_WALL_AT(IJK))THEN
282 SIGN0 = -ONE
283 ELSE
284
285
286 = ONE
287 ENDIF
288
289 IF (WALL_AT(IJK)) THEN
290 IMJK = IM_OF(IJK)
291 IJMK = JM_OF(IJK)
292 IJKM = KM_OF(IJK)
293 IPJK = IP_OF(IJK)
294 IJPK = JP_OF(IJK)
295 IJKP = KP_OF(IJK)
296
297
298 IF (.NOT.WALL_AT(IMJK)) THEN
299 LFLUID = IMJK
300
301 IF (WALL_AT(IJPK)) THEN
302 V_G(IJK) = SIGN0*V_G(LFLUID)
303 IF(BC_JJ_PSL==0) CALL EQUAL(V_S,IJK,SIGN0,V_S,LFLUID)
304 ENDIF
305
306 IF (WALL_AT(IJKP)) THEN
307 W_G(IJK) = SIGN0*W_G(LFLUID)
308 IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
309 ENDIF
310 ENDIF
311
312
313 IF (.NOT.WALL_AT(IPJK)) THEN
314 LFLUID = IPJK
315
316 IF (WALL_AT(IJPK)) THEN
317 V_G(IJK) = SIGN0*V_G(LFLUID)
318 IF(BC_JJ_PSL==0) CALL EQUAL(V_S,IJK,SIGN0,V_S,LFLUID)
319 ENDIF
320
321 IF (WALL_AT(IJKP)) THEN
322 W_G(IJK) = SIGN0*W_G(LFLUID)
323 IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
324 ENDIF
325 ENDIF
326
327
328
329 IF (.NOT.WALL_AT(IJMK)) THEN
330 LFLUID = IJMK
331
332 IF (WALL_AT(IPJK)) THEN
333 U_G(IJK) = SIGN0*U_G(LFLUID)
334 IF(BC_JJ_PSL==0) CALL EQUAL(U_S,IJK,SIGN0,U_S,LFLUID)
335 ENDIF
336
337 IF (WALL_AT(IJKP)) THEN
338 W_G(IJK) = SIGN0*W_G(LFLUID)
339 IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
340 ENDIF
341 ENDIF
342
343
344 IF (.NOT.WALL_AT(IJPK)) THEN
345 LFLUID = IJPK
346
347 IF (WALL_AT(IPJK)) THEN
348 U_G(IJK) = SIGN0*U_G(LFLUID)
349 IF(BC_JJ_PSL==0) CALL EQUAL(U_S,IJK,SIGN0,U_S,LFLUID)
350 ENDIF
351
352 IF (WALL_AT(IJKP)) THEN
353 W_G(IJK) = SIGN0*W_G(LFLUID)
354 IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
355 ENDIF
356 ENDIF
357
358
359 IF (DO_K) THEN
360
361 IF (.NOT.WALL_AT(IJKM)) THEN
362 LFLUID = IJKM
363
364 IF (WALL_AT(IPJK)) THEN
365 U_G(IJK) = SIGN0*U_G(LFLUID)
366 IF (BC_JJ_PSL == 0) CALL EQUAL(U_S, IJK, &
367 SIGN0, U_S, LFLUID)
368 ENDIF
369
370 IF (WALL_AT(IJPK)) THEN
371 V_G(IJK) = SIGN0*V_G(LFLUID)
372 IF (BC_JJ_PSL == 0) CALL EQUAL(V_S, IJK, &
373 SIGN0, V_S, LFLUID)
374 ENDIF
375 ENDIF
376
377
378 IF (.NOT.WALL_AT(IJKP)) THEN
379 LFLUID = IJKP
380
381 IF (WALL_AT(IPJK)) THEN
382 U_G(IJK) = SIGN0*U_G(LFLUID)
383 IF (BC_JJ_PSL == 0) CALL EQUAL(U_S, IJK, &
384 SIGN0, U_S, LFLUID)
385 ENDIF
386
387 IF (WALL_AT(IJPK)) THEN
388 V_G(IJK) = SIGN0*V_G(LFLUID)
389 IF (BC_JJ_PSL == 0) CALL EQUAL(V_S, IJK, &
390 SIGN0, V_S, LFLUID)
391 ENDIF
392 ENDIF
393 ENDIF
394
395 ENDIF
396 ENDDO
397 ENDDO
398 ENDDO
399
400 RETURN
401 END SUBROUTINE SET_WALL_BC1
402