File: RELATIVE:/../../../mfix.git/model/cartesian_grid/CG_set_bc0.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: CG_SET_BC0                                             C
4     !  Purpose: This module does the initial setting of boundary           C
5     !           conditions for cut cells only                              C
6     !                                                                      C
7     !  Author: Jeff Dietiker                              Date: 01-Jul-09  C
8     !                                                                      C
9     !  Literature/Document References:                                     C
10     !                                                                      C
11     !  Variables referenced: BC_DEFINED, BC_TYPE, BC_DT_0, TIME, BC_Jet_g0,C
12     !                        BC_K_b, BC_K_t, BC_J_s, BC_J_n, BC_I_w,       C
13     !                        BC_I_e, BC_PLANE, BC_EP_g, BC_P_g, BC_T_g,    C
14     !                        BC_T_s,  BC_U_g, BC_V_g, BC_W_g,              C
15     !                        MMAX, BC_ROP_s, BC_U_s, BC_V_s, BC_W_s        C
16     !  Variables modified: BC_TIME, BC_V_g, I, J, K, IJK, EP_g, P_g, T_g,  C
17     !                      T_s, U_g, V_g, W_g, ROP_s, U_s, V_s, W_s,       C
18     !                      M                                               C
19     !                                                                      C
20     !  Local variables: L, IJK1, IJK2, IJK3                                C
21     !                                                                      C
22     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
23     !
24           SUBROUTINE CG_SET_BC0
25     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
26     !...Switches: -xf
27     !
28     !-----------------------------------------------
29     !   M o d u l e s
30     !-----------------------------------------------
31           USE bc
32           USE boundfunijk
33           USE compar
34           USE cutcell
35           USE eos, ONLY: EOSG
36           USE fldvar
37           USE functions
38           USE funits
39           USE geometry
40           USE indices
41           USE mpi_utility
42           USE param
43           USE param1
44           USE physprop
45           USE quadric
46           USE run
47           USE scalars
48           USE scales
49           USE sendrecv
50           USE toleranc
51     
52           IMPLICIT NONE
53     !-----------------------------------------------
54     !   G l o b a l   P a r a m e t e r s
55     !-----------------------------------------------
56     !-----------------------------------------------
57     !   L o c a l   P a r a m e t e r s
58     !-----------------------------------------------
59     !-----------------------------------------------
60     !   L o c a l   V a r i a b l e s
61     !-----------------------------------------------
62     
63     !
64     !                      Local index for boundary condition
65           INTEGER          L
66     !
67     !                      indices
68           INTEGER          IJK, M, N ,IJKW,IJKS,IJKB
69     !
70     !----------------------------------------------
71     
72           INTEGER, DIMENSION(8) :: ACCEPTABLE_DEFAULT_WALL=-1
73           LOGICAL :: GLOBAL_CORNER
74     
75     !
76     !  Define global corners as acceptable default walls
77     !  These cells should never be used
78     !
79     
80           IF(.NOT.RE_INDEXING.AND.NumPEs==1) THEN
81     
82           ACCEPTABLE_DEFAULT_WALL(1) = FUNIJK(IMIN3,JMIN3,KMIN3)
83           ACCEPTABLE_DEFAULT_WALL(2) = FUNIJK(IMAX3,JMIN3,KMIN3)
84           ACCEPTABLE_DEFAULT_WALL(3) = FUNIJK(IMIN3,JMAX3,KMIN3)
85           ACCEPTABLE_DEFAULT_WALL(4) = FUNIJK(IMAX3,JMAX3,KMIN3)
86           ACCEPTABLE_DEFAULT_WALL(5) = FUNIJK(IMIN3,JMIN3,KMAX3)
87           ACCEPTABLE_DEFAULT_WALL(6) = FUNIJK(IMAX3,JMIN3,KMAX3)
88           ACCEPTABLE_DEFAULT_WALL(7) = FUNIJK(IMIN3,JMAX3,KMAX3)
89           ACCEPTABLE_DEFAULT_WALL(8) = FUNIJK(IMAX3,JMAX3,KMAX3)
90     
91           ENDIF
92     
93     !      DO N = 1,8
94     !         print*,'acceptable default=',ACCEPTABLE_DEFAULT_WALL(N)
95     !      ENDDO
96     
97     
98           DO IJK = ijkstart3, ijkend3
99     
100              L = BC_ID(IJK)
101     
102              IF(L>0) THEN
103                 IF(BC_TYPE(L)=='CG_PO') THEN
104     
105                    P_STAR(IJK) = ZERO
106                    P_G(IJK) = SCALE_PRESSURE(BC_P_G(L))
107        !
108                    IF (BC_EP_G(L) /= UNDEFINED) EP_G(IJK) = BC_EP_G(L)
109                    IF (BC_T_G(L) /= UNDEFINED) then
110                       T_G(IJK) = BC_T_G(L)
111                    ELSE
112                       T_g(IJK) = TMIN
113                    ENDIF
114     
115                    N = 1
116                    IF (NMAX(0) > 0) THEN
117                       WHERE (BC_X_G(L,:NMAX(0)) /= UNDEFINED) X_G(IJK,:&
118                              NMAX(0)) = BC_X_G(L,:NMAX(0))
119                       N = NMAX(0) + 1
120                    ENDIF
121     
122                    IF (NScalar > 0) THEN
123                       WHERE (BC_Scalar(L,:NScalar) /= UNDEFINED)&
124                       Scalar(IJK,:NScalar) = BC_Scalar(L,:NScalar)
125                    ENDIF
126     
127                    IF (K_Epsilon) THEN
128                       IF (BC_K_Turb_G(L) /= UNDEFINED) K_Turb_G(IJK) = BC_K_Turb_G(L)
129                       IF (BC_E_Turb_G(L) /= UNDEFINED) E_Turb_G(IJK) = BC_E_Turb_G(L)
130                    ENDIF
131     
132                    DO M = 1, MMAX
133                       IF (BC_ROP_S(L,M) /= UNDEFINED) ROP_S(IJK,M) = BC_ROP_S(L,M)
134                       IF(BC_T_S(L,M)/=UNDEFINED)T_S(IJK,M)=BC_T_S(L,M)
135                       IF (BC_THETA_M(L,M) /= UNDEFINED) THETA_M(IJK,M)= BC_THETA_M(L,M)
136                       N = 1
137                       IF (NMAX(M) > 0) THEN
138                          WHERE (BC_X_S(L,M,:NMAX(M)) /= UNDEFINED) X_S(&
139                                 IJK,M,:NMAX(M)) = BC_X_S(L,M,:NMAX(M))
140                          N = NMAX(M) + 1
141                       ENDIF
142                    END DO
143     
144                 ELSEIF(BC_TYPE(L)=='CG_MI') THEN
145     
146                    P_STAR(IJK) = ZERO
147        !
148                    EP_G(IJK) = BC_EP_G(L)
149                    P_G(IJK) = SCALE_PRESSURE(BC_P_G(L))
150                    T_G(IJK) = BC_T_G(L)
151     
152                    IF (NMAX(0) > 0) THEN
153                       X_G(IJK,:NMAX(0)) = BC_X_G(L,:NMAX(0))
154                    ENDIF
155     
156                    IF (NScalar > 0) THEN
157                       Scalar(IJK,:NScalar) = BC_Scalar(L,:NScalar)
158                    ENDIF
159     
160                    IF (K_Epsilon) THEN
161                       K_Turb_G(IJK) = BC_K_Turb_G(L)
162                       E_Turb_G(IJK) = BC_E_Turb_G(L)
163                    ENDIF
164     
165                    DO M = 1, MMAX
166                       ROP_S(IJK,M) = BC_ROP_S(L,M)
167                       T_S(IJK,M) = BC_T_S(L,M)
168                       THETA_M(IJK,M) = BC_THETA_M(L,M)
169     
170                       IF (NMAX(M) > 0) THEN
171                          X_S(IJK,M,:NMAX(M)) = BC_X_S(L,M,:NMAX(M))
172                       ENDIF
173     
174                    END DO
175     
176                    IF(BC_U_g(L)/=UNDEFINED) THEN
177                       U_G(IJK) =  BC_U_g(L)
178                    ELSE
179                       U_G(IJK) =  BC_VELMAG_g(L)*NORMAL_S(IJK,1)
180                    ENDIF
181     
182     
183                    IF(BC_V_g(L)/=UNDEFINED) THEN
184                       V_G(IJK) =  BC_V_g(L)
185                    ELSE
186                       V_G(IJK) =  BC_VELMAG_g(L)*NORMAL_S(IJK,2)
187                    ENDIF
188     
189                    IF(BC_W_g(L)/=UNDEFINED) THEN
190                       W_G(IJK) =  BC_W_g(L)
191                    ELSE
192                       W_G(IJK) =  BC_VELMAG_g(L)*NORMAL_S(IJK,3)
193                    ENDIF
194     
195                    IJKW = WEST_OF(IJK)
196                    IJKS = SOUTH_OF(IJK)
197                    IJKB = BOTTOM_OF(IJK)
198     
199                    IF(FLUID_AT(IJKW)) THEN
200                       IF(BC_U_g(L)/=UNDEFINED) THEN
201                          U_G(IJKW) =  BC_U_g(L)
202                       ELSE
203                          U_G(IJKW) =  BC_VELMAG_g(L)*NORMAL_S(IJK,1)
204                       ENDIF
205                    ENDIF
206     
207                    IF(FLUID_AT(IJKS)) THEN
208                       IF(BC_V_g(L)/=UNDEFINED) THEN
209                          V_G(IJKS) =  BC_V_g(L)
210                       ELSE
211                          V_G(IJKS) =  BC_VELMAG_g(L)*NORMAL_S(IJK,2)
212                       ENDIF
213                    ENDIF
214     
215                    IF(FLUID_AT(IJKB)) THEN
216                       IF(BC_W_g(L)/=UNDEFINED) THEN
217                          W_G(IJKB) =  BC_W_g(L)
218                       ELSE
219                          W_G(IJKB) =  BC_VELMAG_g(L)*NORMAL_S(IJK,3)
220                       ENDIF
221                    ENDIF
222     
223        !
224                    M = 1
225     
226                    DO M=1,MMAX
227     
228                       IF(BC_U_s(L,M)/=UNDEFINED) THEN
229                          U_S(IJK,M) =  BC_U_S(L,M)
230                       ELSE
231                          U_S(IJK,M) =  BC_VELMAG_S(L,M)*NORMAL_S(IJK,1)
232                       ENDIF
233     
234                       IF(BC_V_S(L,M)/=UNDEFINED) THEN
235                          V_S(IJK,M) =  BC_V_S(L,M)
236                       ELSE
237                          V_S(IJK,M) =  BC_VELMAG_S(L,M)*NORMAL_S(IJK,2)
238                       ENDIF
239     
240                       IF(BC_W_S(L,M)/=UNDEFINED) THEN
241                          W_S(IJK,M) =  BC_W_S(L,M)
242                       ELSE
243                          W_S(IJK,M) =  BC_VELMAG_S(L,M)*NORMAL_S(IJK,3)
244                       ENDIF
245     
246                       IJKW = WEST_OF(IJK)
247                       IJKS = SOUTH_OF(IJK)
248                       IJKB = BOTTOM_OF(IJK)
249     
250                       IF(FLUID_AT(IJKW)) THEN
251                          IF(BC_U_S(L,M)/=UNDEFINED) THEN
252                             U_S(IJKW,M) =  BC_U_S(L,M)
253                          ELSE
254                             U_S(IJKW,M) =  BC_VELMAG_S(L,M)*NORMAL_S(IJK,1)
255                          ENDIF
256                       ENDIF
257     
258                       IF(FLUID_AT(IJKS)) THEN
259                          IF(BC_V_S(L,M)/=UNDEFINED) THEN
260                             V_S(IJKS,M) =  BC_V_S(L,M)
261                          ELSE
262                             V_S(IJKS,M) =  BC_VELMAG_S(L,M)*NORMAL_S(IJK,2)
263                          ENDIF
264                       ENDIF
265     
266                       IF(FLUID_AT(IJKB)) THEN
267                          IF(BC_W_S(L,M)/=UNDEFINED) THEN
268                             W_S(IJKB,M) =  BC_W_S(L,M)
269                          ELSE
270                             W_S(IJKB,M) =  BC_VELMAG_S(L,M)*NORMAL_S(IJK,3)
271                          ENDIF
272                       ENDIF
273     
274                    ENDDO
275     
276        !            IF (MMAX > 0) THEN
277        !               U_S(IJK,:MMAX) = BC_U_S(L,:MMAX)
278        !               V_S(IJK,:MMAX) = BC_V_S(L,:MMAX)
279        !               W_S(IJK,:MMAX) = BC_W_S(L,:MMAX)
280        !
281        !               IF(FLUID_AT(IJKW)) THEN
282        !                  U_S(IJKW,:MMAX) = BC_U_S(L,:MMAX)
283        !               ENDIF
284        !
285        !               IF(FLUID_AT(IJKS)) THEN
286        !                  V_S(IJKS,:MMAX) = BC_V_S(L,:MMAX)
287        !               ENDIF
288        !
289        !               IF(FLUID_AT(IJKB)) THEN
290        !                  W_S(IJKB,:MMAX) = BC_W_S(L,:MMAX)
291        !               ENDIF
292        !               M = MMAX + 1
293        !            ENDIF
294     
295     
296                    IF (MW_AVG == UNDEFINED) THEN
297                       MW_MIX_G(IJK) = CALC_MW(X_G,DIMENSION_3,IJK,NMAX(0),MW_G)
298                    ELSE
299                       MW_MIX_G(IJK) = MW_AVG
300                    ENDIF
301                    IF (RO_G0 == UNDEFINED) RO_G(IJK) = EOSG(MW_MIX_G&
302                       (IJK),P_G(IJK),T_G(IJK))
303                    ROP_G(IJK) = EP_G(IJK)*RO_G(IJK)
304     
305                 ENDIF
306              ENDIF
307     
308              IF(DEFAULT_WALL_AT(IJK)) THEN
309     
310     !            print*,'Default_wall_at IJK=',IJK,I_OF(IJK),J_OF(IJK),K_OF(IJK)
311     
312                 GLOBAL_CORNER = .FALSE.
313                 DO N = 1,8
314                    IF(IJK==ACCEPTABLE_DEFAULT_WALL(N)) GLOBAL_CORNER = .TRUE.
315                 ENDDO
316     
317                 IF(.NOT.GLOBAL_CORNER.AND..NOT.BLOCKED_CELL_AT(IJK)) THEN
318     
319                    ICBC_FLAG(IJK)(2:3) = 'CG'
320     
321                    IF((MyPE == PE_IO).AND.PRINT_WARNINGS) THEN
322                       WRITE(*,*) 'WARNING: DEFAULT WALL DETECTED AT I,J,K = ',I_OF(IJK),J_OF(IJK),K_OF(IJK) ,BLOCKED_CELL_AT(IJK)
323                       WRITE(*,*) '         WHEN USING CARTESIAN GRID CUT-CELL FEATURE.'
324                       WRITE(*,*) '         DEFAULT WALLS ARE NOT ALLOWED WITH CUT-CELLS.'
325                       WRITE(*,*) '         THE DEFAULT WALL WAS REMOVED ALONG THIS CELL.'
326                       WRITE(*,*) ''
327                    ENDIF
328     !               CALL MFIX_EXIT(MYPE)
329     
330                 ENDIF
331     
332              ENDIF
333     
334           ENDDO
335     
336           RETURN
337           END SUBROUTINE CG_SET_BC0
338     
339     !// Comments on the modifications for DMP version implementation
340     !// 001 Include header file and common declarations for parallelization
341     !// 020 New local variables for parallelization: FLAG_G , FLUID_AT_G
342     !// 360 Check if i,j,k resides on current processor
343