File: N:\mfix\model\set_wall_bc.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Subroutine: SET_WALL_BC                                             C
4     !  Purpose: Set wall boundary conditions                               C
5     !                                                                      C
6     !  Author: M. Syamlal                                 Date: 29-JAN-92  C
7     !  Reviewer: P. Nicoletti, W. Rogers, S. Venkatesan   Date: 29-JAN-92  C
8     !                                                                      C
9     !  Revision Number: 1                                                  C
10     !  Purpose: Add calculations for mass outflow boundary condition       C
11     !  Author: M. Syamlal                                 Date: 23-OCT-92  C
12     !  Reviewer: M. Syamlal                               Date: 11-DEC-92  C
13     !  Revision Number: 2                                                  C
14     !  Purpose: Revised for MFIX 2.0. This subroutine is different from    C
15     !           old set_wall_bc.                                           C
16     !  Author: M. Syamlal                                 Date: 18-JUL-96  C
17     !                                                                      C
18     !  Literature/Document References:                                     C
19     !                                                                      C
20     !  Variables referenced: BC_DEFINED, BC_TYPE, BC_JJ_PS, BC_I_w,        C
21     !                        BC_I_e, BC_J_s, BC_J_n, BC_K_b, BC_K_t,       C
22     !                        ISTART3, IEND3, JSTART3, JEND3, KSTART3,      C
23     !                        KEND3, ISTART2, IEND2, JSTART2, JEND2,        C
24     !                        KSTART2, KEND3, IMAX2, JMAX2, KMAX2, MMAX,    C
25     !                        W_g, W_S in fluid cell adjacent to wall cell  C
26     !  Variables modified: W_g, W_S in wall cell                           C
27     !                                                                      C
28     !                                                                      C
29     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
30     
31           SUBROUTINE SET_WALL_BC()
32     
33     !-----------------------------------------------
34     ! Modules
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           IMPLICIT NONE
47     !-----------------------------------------------
48     ! Dummy arguments
49     !-----------------------------------------------
50     !-----------------------------------------------
51     ! Local variables
52     !-----------------------------------------------
53     ! Local index for boundary condition
54           INTEGER :: L
55     ! indices
56           INTEGER :: IJK, IPJK
57     ! Starting & ending I index
58           INTEGER :: I1, I2
59     ! Starting & ending J index
60           INTEGER :: J1, J2
61     ! Starting and ending K index
62           INTEGER :: K1, K2
63     !-----------------------------------------------
64     
65     
66     ! Set the boundary conditions
67           DO L = 1, DIMENSION_BC
68              IF (BC_DEFINED(L)) THEN
69     
70     ! The range of boundary cells
71                 I1 = BC_I_W(L)
72                 I2 = BC_I_E(L)
73                 J1 = BC_J_S(L)
74                 J2 = BC_J_N(L)
75                 K1 = BC_K_B(L)
76                 K2 = BC_K_T(L)
77     
78                 SELECT CASE (BC_TYPE_ENUM(L))
79                    CASE (FREE_SLIP_WALL)
80                       CALL SET_WALL_BC1 (I1, I2, J1, J2, K1, K2, &
81                                          BC_JJ_PS(L))
82     
83                    CASE (NO_SLIP_WALL)
84                       CALL SET_WALL_BC1 (I1, I2, J1, J2, K1, K2, &
85                                          BC_JJ_PS(L))
86     
87                    CASE (PAR_SLIP_WALL)
88     ! updating the boundary velocity may improve convergence
89                 END SELECT
90              ENDIF
91           ENDDO
92     
93     
94     ! The above section did not address bc_type=undefined (which by default
95     ! is either a ns wall, or if i=1 and cylindrical, a fs wall) or
96     ! bc_type='dummy' conditions. The section below will handle both events
97     ! since default_wall_at will register as true
98           K1 = 1
99           DO J1 = JSTART3, JEND3
100              DO I1 = ISTART3, IEND3
101                 IF(K1.NE.KSTART2) EXIT
102                 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
103                 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE  ! skip dead cells
104                 IJK = FUNIJK(I1,J1,K1)
105                 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1,&
106                     J1, J1, K1, K1, 0)
107              ENDDO
108           ENDDO
109     
110     ! top xy-plane
111           K1 = KMAX2
112           DO J1 = JSTART3, JEND3
113              DO I1 = ISTART3, IEND3
114                 IF(K1.NE.KEND2) EXIT
115                 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
116                 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE  ! skip dead cells
117                 IJK = FUNIJK(I1,J1,K1)
118                 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
119                    J1, J1, K1, K1, 0)
120              ENDDO
121           ENDDO
122     
123     ! south xz-plane
124           J1 = 1
125           DO K1 = KSTART3, KEND3
126              DO I1 = ISTART3, IEND3
127                 IF(J1.NE.JSTART2) EXIT
128                 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
129                 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE  ! skip dead cells
130                 IJK = FUNIJK(I1,J1,K1)
131                 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
132                     J1, J1, K1, K1, 0)
133              ENDDO
134           ENDDO
135     
136     ! north xz-plane
137           J1 = JMAX2
138           DO K1 = KSTART3, KEND3
139              DO I1 = ISTART3, IEND3
140                 IF(J1.NE.JEND2) EXIT
141                 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
142                 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE  ! skip dead cells
143                 IJK = FUNIJK(I1,J1,K1)
144                 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
145                    J1, J1, K1, K1, 0)
146              ENDDO
147           ENDDO
148     
149     ! west zy-plane
150           I1 = 1
151           DO K1 = KSTART3, KEND3
152              DO J1 = JSTART3, JEND3
153                 IF(I1.NE.ISTART2) EXIT
154                 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
155                 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE  ! skip dead cells
156                 IJK = FUNIJK(I1,J1,K1)
157                 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
158                     J1, J1, K1, K1, 0)
159     
160     ! For cylindrical coordinates the azimuthal component should be zero
161     ! at center (this forces no-slip for the azimuthal component at what
162     ! is a free-slip wall)
163                 IF (CYLINDRICAL .AND. XMIN==ZERO) THEN
164                    IPJK = IP_OF(IJK)
165                    W_G(IJK) = -W_G(IPJK)
166                    IF (MMAX > 0) THEN
167                       W_S(IJK,:MMAX) = -W_S(IPJK,:MMAX)
168                    ENDIF
169                 ENDIF
170              ENDDO
171           ENDDO
172     
173     ! east zy-plane
174           I1 = IMAX2
175           DO K1 = KSTART3, KEND3
176              DO J1 = JSTART3, JEND3
177                 IF(I1.NE.IEND2) EXIT
178                 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
179                 IF (DEAD_CELL_AT(I1,J1,K1)) CYCLE  ! skip dead cells
180                 IJK = FUNIJK(I1,J1,K1)
181                 IF (DEFAULT_WALL_AT(IJK)) CALL SET_WALL_BC1 (I1, I1, &
182                     J1, J1, K1, K1, 0)
183              ENDDO
184           ENDDO
185           RETURN
186     
187         CONTAINS
188     
189           INCLUDE 'functions.inc'
190     
191           END SUBROUTINE SET_WALL_BC
192     
193     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
194     !                                                                      C
195     !  Subroutine: SET_WALL_BC1                                            C
196     !                                                                      C
197     !  Purpose: Set U, V, and W components for the specified cells by      C
198     !           copying the same or negative values from near by fluid     C
199     !           cell                                                       C
200     !                                                                      C
201     !  Author: M. Syamlal                                 Date: 21-JAN-92  C
202     !  Reviewer: M. Syamlal, S. Venkatesan, P. Nicoletti  Date: 29-JAN-92  C
203     !            W. Rogers                                                 C
204     !                                                                      C
205     !  Revision Number:                                                    C
206     !  Purpose:                                                            C
207     !  Author:                                            Date: dd-mmm-yy  C
208     !  Reviewer:                                          Date: dd-mmm-yy  C
209     !                                                                      C
210     !  Literature/Document References:                                     C
211     !                                                                      C
212     !  Variables referenced: V_g, W_g, U_g, V_s, W_s, U_s in fluid cell    C
213     !                        adjacent to wall cell                         C
214     !  Variables modified: V_g, W_g, U_g, V_s, W_s, U_s in wall cell       C
215     !                                                                      C
216     !                                                                      C
217     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
218     
219           SUBROUTINE SET_WALL_BC1(II1, II2, JJ1, JJ2, KK1, KK2, &
220                                   BC_JJ_PSL)
221     
222     !-----------------------------------------------
223     ! Modules
224     !-----------------------------------------------
225           USE param
226           USE param1
227           USE bc
228           USE fldvar
229           USE geometry
230           USE indices
231           USE physprop
232           USE run
233           USE funits
234           USE compar
235           IMPLICIT NONE
236     !-----------------------------------------------
237     ! Dummy arguments
238     !-----------------------------------------------
239     ! Starting and ending I index
240           INTEGER, INTENT(IN) :: II1, II2
241     ! Starting and ending J index
242           INTEGER, INTENT(IN) :: JJ1, JJ2
243     ! Starting and ending K index
244           INTEGER, INTENT(IN) :: KK1, KK2
245     ! Johnson-Jackson boundary condition: 0= no, 1=yes
246           INTEGER, INTENT(IN) :: BC_JJ_PSL
247     !-----------------------------------------------
248     ! Local variables
249     !-----------------------------------------------
250     ! Sign with legal values +1 or -1
251           DOUBLE PRECISION :: SIGN0
252     ! Local indices near wall cell
253           INTEGER :: I, J, K
254           INTEGER :: IJK, IMJK, IJMK, IJKM, IPJK, IJPK, IJKP
255           INTEGER :: I1, I2, J1, J2, K1, K2
256     ! Local index for a fluid cell near the wall cell
257           INTEGER :: LFLUID
258     !-----------------------------------------------
259     
260     ! Limit I1, I2 and all to local processor first ghost layer
261           I1 = II1
262           I2 = II2
263           J1 = JJ1
264           J2 = JJ2
265           K1 = KK1
266           K2 = KK2
267     
268           IF(I1.LE.IEND2)   I1 = MAX(I1, ISTART2)
269           IF(J1.LE.JEND2)   J1 = MAX(J1, JSTART2)
270           IF(K1.LE.KEND2)   K1 = MAX(K1, KSTART2)
271           IF(I2.GE.ISTART2) I2 = MIN(I2, IEND2)
272           IF(J2.GE.JSTART2) J2 = MIN(J2, JEND2)
273           IF(K2.GE.KSTART2) K2 = MIN(K2, KEND2)
274     
275           DO K = K1, K2
276              DO J = J1, J2
277                 DO I = I1, I2
278                    IJK = FUNIJK(I,J,K)
279     
280                    IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
281     
282     
283                    IF(NS_WALL_AT(IJK))THEN
284                       SIGN0 = -ONE
285                    ELSE
286     ! note fs_wall occurs for default_wall_at at i==1 if cylindrical and
287     ! xmin=zero
288                       SIGN0 = ONE
289                    ENDIF
290     
291                    IF (WALL_AT(IJK)) THEN
292                       IMJK = IM_OF(IJK)
293                       IJMK = JM_OF(IJK)
294                       IJKM = KM_OF(IJK)
295                       IPJK = IP_OF(IJK)
296                       IJPK = JP_OF(IJK)
297                       IJKP = KP_OF(IJK)
298     
299     ! Fluid cell at West
300                       IF (.NOT.WALL_AT(IMJK)) THEN
301                          LFLUID = IMJK
302     ! Wall cell at North
303                          IF (WALL_AT(IJPK)) THEN
304                             V_G(IJK) = SIGN0*V_G(LFLUID)
305                             IF(BC_JJ_PSL==0) CALL EQUAL(V_S,IJK,SIGN0,V_S,LFLUID)
306                          ENDIF
307     ! Wall cell at Top
308                          IF (WALL_AT(IJKP)) THEN
309                             W_G(IJK) = SIGN0*W_G(LFLUID)
310                             IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
311                          ENDIF
312                       ENDIF
313     
314     ! Fluid cell at East
315                       IF (.NOT.WALL_AT(IPJK)) THEN
316                          LFLUID = IPJK
317     ! Wall cell at North
318                          IF (WALL_AT(IJPK)) THEN
319                             V_G(IJK) = SIGN0*V_G(LFLUID)
320                             IF(BC_JJ_PSL==0) CALL EQUAL(V_S,IJK,SIGN0,V_S,LFLUID)
321                          ENDIF
322     ! Wall cell at Top
323                          IF (WALL_AT(IJKP)) THEN
324                             W_G(IJK) = SIGN0*W_G(LFLUID)
325                             IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
326                          ENDIF
327                       ENDIF
328     
329     
330     ! Fluid cell at South
331                       IF (.NOT.WALL_AT(IJMK)) THEN
332                          LFLUID = IJMK
333     ! Wall cell at East
334                          IF (WALL_AT(IPJK)) THEN
335                             U_G(IJK) = SIGN0*U_G(LFLUID)
336                             IF(BC_JJ_PSL==0) CALL EQUAL(U_S,IJK,SIGN0,U_S,LFLUID)
337                          ENDIF
338     ! Wall cell at Top
339                          IF (WALL_AT(IJKP)) THEN
340                             W_G(IJK) = SIGN0*W_G(LFLUID)
341                             IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
342                          ENDIF
343                       ENDIF
344     
345     ! Fluid cell at North
346                       IF (.NOT.WALL_AT(IJPK)) THEN
347                          LFLUID = IJPK
348     ! Wall cell at East
349                          IF (WALL_AT(IPJK)) THEN
350                             U_G(IJK) = SIGN0*U_G(LFLUID)
351                             IF(BC_JJ_PSL==0) CALL EQUAL(U_S,IJK,SIGN0,U_S,LFLUID)
352                          ENDIF
353     ! Wall cell at Top
354                          IF (WALL_AT(IJKP)) THEN
355                             W_G(IJK) = SIGN0*W_G(LFLUID)
356                             IF(BC_JJ_PSL==0) CALL EQUAL(W_S,IJK,SIGN0,W_S,LFLUID)
357                          ENDIF
358                       ENDIF
359     
360     
361                       IF (DO_K) THEN
362     ! Fluid cell at Bottom
363                          IF (.NOT.WALL_AT(IJKM)) THEN
364                             LFLUID = IJKM
365     ! Wall cell at East
366                             IF (WALL_AT(IPJK)) THEN
367                                U_G(IJK) = SIGN0*U_G(LFLUID)
368                                IF (BC_JJ_PSL == 0) CALL EQUAL(U_S, IJK, &
369                                   SIGN0, U_S, LFLUID)
370                             ENDIF
371     ! Wall cell at North
372                             IF (WALL_AT(IJPK)) THEN
373                                V_G(IJK) = SIGN0*V_G(LFLUID)
374                                IF (BC_JJ_PSL == 0) CALL EQUAL(V_S, IJK, &
375                                   SIGN0, V_S, LFLUID)
376                             ENDIF
377                          ENDIF
378     
379     ! Fluid cell at Top
380                          IF (.NOT.WALL_AT(IJKP)) THEN
381                             LFLUID = IJKP
382     ! Wall cell at East
383                             IF (WALL_AT(IPJK)) THEN
384                                U_G(IJK) = SIGN0*U_G(LFLUID)
385                                IF (BC_JJ_PSL == 0) CALL EQUAL(U_S, IJK, &
386                                   SIGN0, U_S, LFLUID)
387                             ENDIF
388     ! Wall cell at North
389                             IF (WALL_AT(IJPK)) THEN
390                                V_G(IJK) = SIGN0*V_G(LFLUID)
391                                IF (BC_JJ_PSL == 0) CALL EQUAL(V_S, IJK, &
392                                   SIGN0, V_S, LFLUID)
393                             ENDIF
394                          ENDIF
395                       ENDIF   ! end if (do_k)
396     
397                    ENDIF   ! end if (wall_at(ijk))
398                 ENDDO   ! end do loop (i = i1, i2)
399              ENDDO   ! end do loop (j = j1, j2)
400           ENDDO   ! end do loop (k = k1, k2)
401     
402           RETURN
403     
404           CONTAINS
405     
406             INCLUDE 'functions.inc'
407     
408     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
409     !                                                                      C
410     !  Subroutine: EQUAL                                                   C
411     !  Purpose: Loop on the number of solids phases to set a variable      C
412     !           equal to the value or negative value of another variable   C
413     !                                                                      C
414     !  Author: M. Syamlal                                 Date: 29-JAN-92  C
415     !  Reviewer: P. Nicoletti, W. Rogers, S. Venkatesan   Date: 29-JAN-92  C
416     !                                                                      C
417     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
418     
419           SUBROUTINE EQUAL(ARRAY1, IJK1, SIGN0, ARRAY2, IJK2)
420     
421           IMPLICIT NONE
422     !-----------------------------------------------
423     ! Dummy arguments
424     !-----------------------------------------------
425     ! First array
426           DOUBLE PRECISION, INTENT(OUT) :: ARRAY1 (DIMENSION_3, *)
427     ! Second array
428           DOUBLE PRECISION, INTENT(IN) :: ARRAY2 (DIMENSION_3, *)
429     ! IJK index for the first array
430           INTEGER, INTENT(IN) :: IJK1
431     ! IJK index for the second array
432           INTEGER, INTENT(IN) :: IJK2
433     ! Sign to be used when setting ARRAY1.  Legal values
434     ! are + or - 1.0.
435           DOUBLE PRECISION, INTENT(IN) :: SIGN0
436     !-----------------------------------------------
437     ! Local variables
438     !-----------------------------------------------
439     !-----------------------------------------------
440     
441           IF (MMAX > 0) THEN
442              ARRAY1(IJK1,:MMAX) = SIGN0*ARRAY2(IJK2,:MMAX)
443           ENDIF
444     
445           RETURN
446           END SUBROUTINE EQUAL
447     
448           END SUBROUTINE SET_WALL_BC1
449