File: /nfs/home/0/users/jenkins/mfix.git/model/cartesian_grid/get_master.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: GET_U_MASTER_CELLS                                     C
4     !  Purpose: Identify master cells for wall U-Moemntum cells            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 GET_U_MASTER_CELLS
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 bc
27           USE quadric
28           USE cutcell
29           USE functions
30     
31           IMPLICIT NONE
32           INTEGER :: IJK,I,J,K,IJKC,D,DIR(18),DMAX
33           LOGICAL :: U_NODE,V_NODE,W_NODE,VEL_NODE,MASTER_FOUND
34           INTEGER :: NC,L,BCV
35     
36           IF(MyPE == PE_IO) THEN
37              WRITE(*,*)'FINDING MASTER CELLS FOR U-MOMENTUM CELLS...'
38           ENDIF
39     10    FORMAT(1X,A)
40     
41     !======================================================================
42     ! Loop though all BC's and create a default NSW BC in case it is needed
43     ! when the search for a master cell fails
44     !======================================================================
45           DO L = 1, DIMENSION_BC
46              IF (.NOT.BC_DEFINED(L).AND.BC_TYPE(L)(1:2)/='CG') THEN
47                 BC_TYPE(L)='CG_NSW'
48                 NSW_GHOST_BC_ID = L
49                 EXIT
50              ENDIF
51           ENDDO
52     
53     !======================================================================
54     !  For each wall_u_cell: Probe neighboors and identify the master cell
55     !  as the first one having all velocity components available
56     !  A velocity component is available is the cell is not blocked nor a wall cell
57     !======================================================================
58     
59           NC = 0
60     
61           DO IJK = IJKSTART3, IJKEND3
62     
63             IF(WALL_U_AT(IJK)) THEN
64     
65                 MASTER_FOUND = .FALSE.
66                 NC = NC + 1
67     
68                 I = I_OF(IJK)
69                 J = J_OF(IJK)
70                 K = K_OF(IJK)
71     
72                 DIR(1) = EAST_OF(IJK)
73                 DIR(2) = WEST_OF(IJK)
74     
75                 DIR(3) = NORTH_OF(IJK)
76                 DIR(4) = SOUTH_OF(IJK)
77     
78     
79                 DIR(5) = EAST_OF(DIR(3))   ! NORTH-EAST
80                 DIR(6) = EAST_OF(DIR(4))   ! SOUTH-EAST
81     
82                 DIR(7) = WEST_OF(DIR(3))   ! NORTH-WEST
83                 DIR(8) = WEST_OF(DIR(4))   ! SOUTH-WEST
84     
85                 DIR(9) = TOP_OF(IJK)
86                 DIR(10) = BOTTOM_OF(IJK)
87     
88                 DIR(11) = NORTH_OF(DIR(9)) ! NORTH-TOP
89                 DIR(12) = SOUTH_OF(DIR(9)) ! SOUTH-TOP
90     
91                 DIR(13) = NORTH_OF(DIR(10)) ! NORTH-BOTTOM
92                 DIR(14) = SOUTH_OF(DIR(10)) ! SOUTH-BOTTOM
93     
94                 DIR(15) = EAST_OF(DIR(9)) ! EAST-TOP
95                 DIR(16) = WEST_OF(DIR(9)) ! WEST-TOP
96     
97                 DIR(17) = EAST_OF(DIR(10)) ! EAST-BOTTOM
98                 DIR(18) = WEST_OF(DIR(10)) ! WEST-BOTTOM
99     
100                 IF(NO_K)   THEN
101                    DMAX = 4 !8         ! In 2D, probe E,W,N,S,NE,SE,NW,SW
102                 ELSE
103                    DMAX = 18        ! In 3D, probe T,B,NT,ST,NB,SB,ET,WT,EB,WB as well
104                 ENDIF
105     
106                 DO D = 1,DMAX
107     
108                    IJKC = DIR(D)
109     
110                    U_NODE = ((.NOT.BLOCKED_U_CELL_AT(IJKC)).AND.(.NOT.WALL_U_AT(IJKC)))
111                    V_NODE = ((.NOT.BLOCKED_V_CELL_AT(IJKC)).AND.(.NOT.WALL_V_AT(IJKC)))
112     
113                    IF(NO_K)   THEN
114                       VEL_NODE = ((U_NODE).AND.(V_NODE))
115                    ELSE
116                       W_NODE = ((.NOT.BLOCKED_W_CELL_AT(IJKC)).AND.(.NOT.WALL_W_AT(IJKC)))
117                       VEL_NODE = ((U_NODE).AND.(V_NODE).AND.(W_NODE))
118                    ENDIF
119     
120                    IF(U_NODE) THEN
121                       U_MASTER_OF(IJK) = IJKC
122                       MASTER_FOUND = .TRUE.
123                       EXIT
124                    ENDIF
125                 ENDDO
126     
127                 IF(.NOT.MASTER_FOUND) THEN
128                    BCV = BC_U_ID(IJK)
129                    IF(BCV>0) THEN
130                       IF(BC_TYPE(BCV) == 'CG_FSW') THEN
131                          WRITE(*,*) ' WARNING IN SUBROUTINE: GET_U_MASTER_CELLS:'
132                          WRITE(*,*) ' NO MASTER CELL FOUND FOR U_MOMENTUM WALL CELL:', IJK,I,J,K
133                          WRITE(*,*) ' REVERTING TO NO SLIP WALL BOUNDARY CONDITION IN THIS CELL'
134                          BC_U_ID(IJK) = NSW_GHOST_BC_ID
135                          WRITE(*,*) ' BC_U_ID(IJK) = ', BC_U_ID(IJK)
136                       ENDIF
137     !               WRITE(*,*) ' ERROR IN SUBROUTINE: GET_U_MASTER_CELLS:'
138     !               WRITE(*,*) ' NO MASTER CELL FOUND FOR U_MOMENTUM WALL CELL:', IJK,I,J,K
139     !               WRITE(*,*) ' MFIX WILL EXIT NOW.'
140     !               CALL MFIX_EXIT(myPE)
141     
142                    ENDIF
143                 ENDIF
144              ENDIF
145     
146           END DO
147     
148     
149     
150           RETURN
151     
152           END SUBROUTINE GET_U_MASTER_CELLS
153     
154     
155     
156     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
157     !                                                                      C
158     !  Module name: GET_V_MASTER_CELLS                                     C
159     !  Purpose: Identify master cells for wall V-Moemntum cells            C
160     !                                                                      C
161     !  Author: Jeff Dietiker                              Date: 21-Feb-08  C
162     !  Reviewer:                                          Date:            C
163     !                                                                      C
164     !  Revision Number #                                  Date: ##-###-##  C
165     !  Author: #                                                           C
166     !  Purpose: #                                                          C
167     !                                                                      C
168     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
169       SUBROUTINE GET_V_MASTER_CELLS
170     
171           USE param
172           USE param1
173           USE parallel
174           USE constant
175           USE run
176           USE toleranc
177           USE geometry
178           USE indices
179           USE compar
180           USE sendrecv
181           USE bc
182           USE quadric
183           USE cutcell
184           USE functions
185     
186           IMPLICIT NONE
187           INTEGER :: IJK,I,J,K,IJKC,D,DIR(18),DMAX
188           LOGICAL :: U_NODE,V_NODE,W_NODE,VEL_NODE,MASTER_FOUND
189           INTEGER :: NC,BCV
190     
191           IF(MyPE == PE_IO) THEN
192              WRITE(*,10)'FINDING MASTER CELLS FOR V-MOMENTUM CELLS...'
193           ENDIF
194     10    FORMAT(1X,A)
195     
196     !======================================================================
197     !  For each wall_v_cell: Probe neighboors and identify the master cell
198     !  as the first one having all velocity components available
199     !  A velocity component is available is the cell is not blocked nor a wall cell
200     !======================================================================
201     
202           NC = 0
203     
204           DO IJK = IJKSTART3, IJKEND3
205     
206             IF(WALL_V_AT(IJK)) THEN
207     
208                 MASTER_FOUND = .FALSE.
209                 NC = NC + 1
210     
211                 I = I_OF(IJK)
212                 J = J_OF(IJK)
213                 K = K_OF(IJK)
214     
215     
216                 DIR(1) = EAST_OF(IJK)
217                 DIR(2) = WEST_OF(IJK)
218     
219                 DIR(3) = NORTH_OF(IJK)
220                 DIR(4) = SOUTH_OF(IJK)
221     
222     
223                 DIR(5) = EAST_OF(DIR(3))   ! NORTH-EAST
224                 DIR(6) = EAST_OF(DIR(4))   ! SOUTH-EAST
225     
226                 DIR(7) = WEST_OF(DIR(3))   ! NORTH-WEST
227                 DIR(8) = WEST_OF(DIR(4))   ! SOUTH-WEST
228     
229                 DIR(9) = TOP_OF(IJK)
230                 DIR(10) = BOTTOM_OF(IJK)
231     
232                 DIR(11) = NORTH_OF(DIR(9)) ! NORTH-TOP
233                 DIR(12) = SOUTH_OF(DIR(9)) ! SOUTH-TOP
234     
235                 DIR(13) = NORTH_OF(DIR(10)) ! NORTH-BOTTOM
236                 DIR(14) = SOUTH_OF(DIR(10)) ! SOUTH-BOTTOM
237     
238                 DIR(15) = EAST_OF(DIR(9)) ! EAST-TOP
239                 DIR(16) = WEST_OF(DIR(9)) ! WEST-TOP
240     
241                 DIR(17) = EAST_OF(DIR(10)) ! EAST-BOTTOM
242                 DIR(18) = WEST_OF(DIR(10)) ! WEST-BOTTOM
243     
244                 IF(NO_K)   THEN
245                    DMAX = 4 !8         ! In 2D, probe E,W,N,S,NE,SE,NW,SW
246                 ELSE
247                    DMAX = 18        ! In 3D, probe T,B,NT,ST,NB,SB,ET,WT,EB,WB as well
248                 ENDIF
249     
250                 DO D = 1,DMAX
251     
252                    IJKC = DIR(D)
253     
254                    U_NODE = ((.NOT.BLOCKED_U_CELL_AT(IJKC)).AND.(.NOT.WALL_U_AT(IJKC)))
255                    V_NODE = ((.NOT.BLOCKED_V_CELL_AT(IJKC)).AND.(.NOT.WALL_V_AT(IJKC)))
256     
257     
258                    IF(NO_K)   THEN
259                       VEL_NODE = ((U_NODE).AND.(V_NODE))
260                    ELSE
261                       W_NODE = ((.NOT.BLOCKED_W_CELL_AT(IJKC)).AND.(.NOT.WALL_W_AT(IJKC)))
262                       VEL_NODE = ((U_NODE).AND.(V_NODE).AND.(W_NODE))
263                    ENDIF
264     
265                    IF(V_NODE) THEN
266                       V_MASTER_OF(IJK) = IJKC
267                       MASTER_FOUND = .TRUE.
268                       EXIT
269                    ENDIF
270                 ENDDO
271     
272                 IF(.NOT.MASTER_FOUND) THEN
273                    BCV = BC_V_ID(IJK)
274                    IF(BCV>0) THEN
275                       IF(BC_TYPE(BCV) == 'CG_FSW') THEN
276                          WRITE(*,*) ' WARNING IN SUBROUTINE: GET_V_MASTER_CELLS:'
277                          WRITE(*,*) ' NO MASTER CELL FOUND FOR V_MOMENTUM WALL CELL:', IJK,I,J,K
278                          WRITE(*,*) ' REVERTING TO NO SLIP WALL BOUNDARY CONDITION IN THIS CELL'
279                          BC_V_ID(IJK) = NSW_GHOST_BC_ID
280                          WRITE(*,*) ' BC_V_ID(IJK) = ', BC_V_ID(IJK)
281                       ENDIF
282     !               WRITE(*,*) ' ERROR IN SUBROUTINE: GET_V_MASTER_CELLS:'
283     !               WRITE(*,*) ' NO MASTER CELL FOUND FOR V_MOMENTUM WALL CELL:', IJK,I,J,K
284     !               WRITE(*,*) ' MFIX WILL EXIT NOW.'
285     !               CALL MFIX_EXIT(myPE)
286                    ENDIF
287                 ENDIF
288              ENDIF
289     
290           END DO
291     
292     
293     
294           RETURN
295     
296           END SUBROUTINE GET_V_MASTER_CELLS
297     
298     
299     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
300     !                                                                      C
301     !  Module name: GET_W_MASTER_CELLS                                     C
302     !  Purpose: Identify master cells for wall W-Moemntum cells            C
303     !                                                                      C
304     !  Author: Jeff Dietiker                              Date: 21-Feb-08  C
305     !  Reviewer:                                          Date:            C
306     !                                                                      C
307     !  Revision Number #                                  Date: ##-###-##  C
308     !  Author: #                                                           C
309     !  Purpose: #                                                          C
310     !                                                                      C
311     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
312       SUBROUTINE GET_W_MASTER_CELLS
313     
314           USE param
315           USE param1
316           USE parallel
317           USE constant
318           USE run
319           USE toleranc
320           USE geometry
321           USE indices
322           USE compar
323           USE sendrecv
324           USE bc
325           USE quadric
326           USE cutcell
327           USE functions
328     
329           IMPLICIT NONE
330           INTEGER :: IJK,I,J,K,IJKC,D,DIR(18),DMAX
331           LOGICAL :: U_NODE,V_NODE,W_NODE,VEL_NODE,MASTER_FOUND
332           INTEGER :: NC,BCV
333     
334           IF(MyPE == PE_IO) THEN
335              WRITE(*,10)'FINDING MASTER CELLS FOR W-MOMENTUM CELLS...'
336           ENDIF
337     10    FORMAT(1X,A)
338     
339     !======================================================================
340     !  For each wall_w_cell: Probe neighboors and identify the master cell
341     !  as the first one having all velocity components available
342     !  A velocity component is available is the cell is not blocked nor a wall cell
343     !======================================================================
344     
345           NC = 0
346     
347           DO IJK = IJKSTART3, IJKEND3
348     
349              IF(WALL_W_AT(IJK)) THEN
350     
351                 MASTER_FOUND = .FALSE.
352                 NC = NC + 1
353     
354                 I = I_OF(IJK)
355                 J = J_OF(IJK)
356                 K = K_OF(IJK)
357     
358     
359                 DIR(1) = EAST_OF(IJK)
360                 DIR(2) = WEST_OF(IJK)
361     
362                 DIR(3) = NORTH_OF(IJK)
363                 DIR(4) = SOUTH_OF(IJK)
364     
365     
366                 DIR(5) = EAST_OF(DIR(3))   ! NORTH-EAST
367                 DIR(6) = EAST_OF(DIR(4))   ! SOUTH-EAST
368     
369                 DIR(7) = WEST_OF(DIR(3))   ! NORTH-WEST
370                 DIR(8) = WEST_OF(DIR(4))   ! SOUTH-WEST
371     
372                 DIR(9) = TOP_OF(IJK)
373                 DIR(10) = BOTTOM_OF(IJK)
374     
375                 DIR(11) = NORTH_OF(DIR(9)) ! NORTH-TOP
376                 DIR(12) = SOUTH_OF(DIR(9)) ! SOUTH-TOP
377     
378                 DIR(13) = NORTH_OF(DIR(10)) ! NORTH-BOTTOM
379                 DIR(14) = SOUTH_OF(DIR(10)) ! SOUTH-BOTTOM
380     
381                 DIR(15) = EAST_OF(DIR(9)) ! EAST-TOP
382                 DIR(16) = WEST_OF(DIR(9)) ! WEST-TOP
383     
384                 DIR(17) = EAST_OF(DIR(10)) ! EAST-BOTTOM
385                 DIR(18) = WEST_OF(DIR(10)) ! WEST-BOTTOM
386     
387                 IF(NO_K)   THEN
388                    DMAX = 8         ! In 2D, probe E,W,N,S,NE,SE,NW,SW
389                 ELSE
390                    DMAX = 18        ! In 3D, probe T,B,NT,ST,NB,SB,ET,WT,EB,WB as well
391                 ENDIF
392     
393                 DO D = 1,DMAX
394     
395                    IJKC = DIR(D)
396     
397                    U_NODE = ((.NOT.BLOCKED_U_CELL_AT(IJKC)).AND.(.NOT.WALL_U_AT(IJKC)))
398                    V_NODE = ((.NOT.BLOCKED_V_CELL_AT(IJKC)).AND.(.NOT.WALL_V_AT(IJKC)))
399     
400     
401                    IF(NO_K)   THEN
402                       VEL_NODE = ((U_NODE).AND.(V_NODE))
403                    ELSE
404                       W_NODE = ((.NOT.BLOCKED_W_CELL_AT(IJKC)).AND.(.NOT.WALL_W_AT(IJKC)))
405                       VEL_NODE = ((U_NODE).AND.(V_NODE).AND.(W_NODE))
406                    ENDIF
407     
408                    IF(W_NODE) THEN
409                       W_MASTER_OF(IJK) = IJKC
410                       MASTER_FOUND = .TRUE.
411                       EXIT
412                    ENDIF
413                 ENDDO
414     
415                 IF(.NOT.MASTER_FOUND) THEN
416                    BCV = BC_W_ID(IJK)
417                    IF(BCV>0) THEN
418                       IF(BC_TYPE(BCV) == 'CG_FSW') THEN
419                          WRITE(*,*) ' WARNING IN SUBROUTINE: GET_W_MASTER_CELLS:'
420                          WRITE(*,*) ' NO MASTER CELL FOUND FOR W_MOMENTUM WALL CELL:', IJK,I,J,K
421                          WRITE(*,*) ' REVERTING TO NO SLIP WALL BOUNDARY CONDITION IN THIS CELL'
422                          BC_W_ID(IJK) = NSW_GHOST_BC_ID
423                          WRITE(*,*) ' BC_W_ID(IJK) = ', BC_W_ID(IJK)
424                       ENDIF
425     !               WRITE(*,*) ' ERROR IN SUBROUTINE: GET_W_MASTER_CELLS:'
426     !               WRITE(*,*) ' NO MASTER CELL FOUND FOR W_MOMENTUM WALL CELL:', IJK,I,J,K
427     !               WRITE(*,*) ' MFIX WILL EXIT NOW.'
428     !               CALL MFIX_EXIT(myPE)
429                    ENDIF
430     
431                 ENDIF
432              ENDIF
433           END DO
434     
435     
436           RETURN
437     
438           END SUBROUTINE GET_W_MASTER_CELLS
439