File: RELATIVE:/../../../mfix.git/model/set_flags.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Subroutine: SET_FLAGS                                               C
4     !  Purpose: This module assigns a flag to a cell to identify its type. C
5     !                                                                      C
6     !  Author: M. Syamlal                                 Date: 29-JAN-92  C
7     !  Reviewer: P. Nicoletti, W. Rogers, S. Venkatesan   Date: 31-JAN-92  C
8     !                                                                      C
9     !  Revision Number: 1                                                  C
10     !  Purpose: In cylindrical geometry, set the b.c at X=0 to free-slip   C
11     !  Author: M. Syamlal                                 Date: 09-APR-92  C
12     !                                                                      C
13     !  Revision Number: 2                                                  C
14     !  Purpose: Initialize FLAG_E, FLAG_N, FLAG_T for IS specifications.   C
15     !           Change definition of Flags.                                C
16     !  Author: M. Syamlal                                 Date: 21-OCT-92  C
17     !  Reviewer: M. Syamlal                               Date: 11-DEC-92  C
18     !                                                                      C
19     !  Revision Number: 3                                                  C
20     !  Purpose: Define FLAG using info from ICBC_FLAG                      C
21     !  Author: M. Syamlal                                 Date: 21-APR-93  C
22     !                                                                      C
23     !  Literature/Document References:                                     C
24     !                                                                      C
25     !  Variables referenced: IMAX2, JMAX2, KMAX2, BC_DEFINED, BC_TYPE,     C
26     !                        BC_K_b, BC_K_t, BC_J_s, BC_J_n, BC_I_w,       C
27     !                        IS_K_b, IS_K_t, IS_J_s, IS_J_n, IS_I_w,       C
28     !                        BC_I_e, NO_I, NO_J, NO_K                      C
29     !  Variables modified: FLAG, FLAG_E, FLAG_N, FLAG_T                    C
30     !                                                                      C
31     !  Local variables: I, J, K, IJK, L, FLAGX                             C
32     !                                                                      C
33     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
34     
35           SUBROUTINE SET_FLAGS
36     
37     !-----------------------------------------------
38     ! Modules
39     !-----------------------------------------------
40           USE param
41           USE param1
42           USE parallel
43           USE fldvar
44           USE geometry
45           USE bc
46           USE is
47           USE indices
48           USE physprop
49           USE funits
50           USE compar
51           USE sendrecv
52           USE sendrecv3
53           USE boundfunijk
54           use mpi_utility
55           USE function3
56           USE functions
57           IMPLICIT NONE
58     !-----------------------------------------------
59     ! Local variables
60     !-----------------------------------------------
61     ! Indices
62           INTEGER :: I, J, K, IJK, IJK1
63     ! Local DO loop index for b.c. specification
64           INTEGER :: L
65     ! Temporary storage for FLAG value
66           INTEGER :: FLAGX
67           integer, allocatable :: arr1(:)
68     !-----------------------------------------------
69     
70     !  Cell flag definitions
71     !  FLAG  ICBC_FLAG BC_TYPE        Cell type
72     !  ----- --------- -------        ---------
73     !   1       .        -            Cell containing gas or solids or both
74     !  10       p      P_INFLOW       Specified pressure inflow cell
75     !  11       P      P_OUTFLOW      Specified pressure outflow cell
76     !  20       I      MASS_INFLOW    Specified mass flux inflow cell
77     !  21       O      MASS_OUTFLOW   Specified mass flux outflow cell
78     !  31       o      OUTFLOW        outflow cell
79     ! 100       W      NO_SLIP_WALL   Internal/external wall with no-slip b.c.
80     ! 101       S      FREE_SLIP_WALL Internal/external wall with free-slip
81     ! 102       s      PAR_SLIP_WALL  Internal/external wall with partial-slip b.c.
82     ! 106       c      CYCLIC         Cyclic b.c.
83     ! 107       C      CYCLIC_PD      Cyclic b.c. with pressure drop
84     ! Flag values greater than 100 are considered to be wall cells
85     ! (see function.inc).
86     
87     
88     
89     ! make the wall cells adjacent to flow boundaries free-slip wall to
90     ! avoid unphysical strain rates in fluid cells adjacent to the flow
91     ! boundary
92     ! ---------------------------------------------------------------->>>
93     !!$omp  parallel do private( IJK) &
94     !!$omp  schedule(static)
95           DO i = istart4, iend4
96              DO j = jstart4, jend4
97                 DO k = kstart4, kend4
98     
99                   IJK = funijk(i, j, k)
100                   SELECT CASE (TRIM(ICBC_FLAG(IJK)(1:1)))
101                     CASE ('p', 'P', 'I', 'O', 'o')
102     
103                     ijk1 = bound_funijk(i+1, j, k)
104                     IF(TRIM(ICBC_FLAG(IJK1)(1:1)) == 'W')ICBC_FLAG(IJK1)(1:1)='S'
105     
106                     ijk1 = bound_funijk(i-1, j, k)
107                     IF(TRIM(ICBC_FLAG(IJK1)(1:1)) == 'W')ICBC_FLAG(IJK1)(1:1)='S'
108     
109                     ijk1 = bound_funijk(i, j+1, k)
110                     IF(TRIM(ICBC_FLAG(IJK1)(1:1)) == 'W')ICBC_FLAG(IJK1)(1:1)='S'
111     
112                     ijk1 = bound_funijk(i, j-1, k)
113                     IF(TRIM(ICBC_FLAG(IJK1)(1:1)) == 'W')ICBC_FLAG(IJK1)(1:1)='S'
114     
115                     ijk1 = bound_funijk(i, j, k+1)
116                     IF(TRIM(ICBC_FLAG(IJK1)(1:1)) == 'W')ICBC_FLAG(IJK1)(1:1)='S'
117     
118                     ijk1 = bound_funijk(i, j, k-1)
119                     IF(TRIM(ICBC_FLAG(IJK1)(1:1)) == 'W')ICBC_FLAG(IJK1)(1:1)='S'
120                   END SELECT
121                 ENDDO
122               ENDDO
123           ENDDO
124     ! ----------------------------------------------------------------<<<
125     
126     
127     ! Define the numerical value of the variable flag for all cells based
128     ! on the corresponding character value of icbc_flag.  By this point the
129     ! icbc_flag has been defined in all cells (see check_data_06 and
130     ! check_data07 -> get_flow_bc and get_wall_bc)
131     ! ---------------------------------------------------------------->>>
132     !!$omp  parallel do private( IJK) &
133     !!$omp&  schedule(static)
134           DO IJK = ijkstart3, ijkend3
135              SELECT CASE (TRIM(ICBC_FLAG(IJK)(1:1)))
136              CASE ('.')
137                 FLAG(IJK) = 1
138              CASE ('p')
139                 FLAG(IJK) = 10
140              CASE ('P')
141                 FLAG(IJK) = 11
142              CASE ('I')
143                 FLAG(IJK) = 20
144              CASE ('O')
145                 FLAG(IJK) = 21
146              CASE ('o')
147                 FLAG(IJK) = 31
148              CASE ('W')
149                 FLAG(IJK) = 100
150              CASE ('S')
151                 FLAG(IJK) = 101
152              CASE ('s')
153                 FLAG(IJK) = 102
154              CASE ('c')
155                 FLAG(IJK) = 106
156              CASE ('C')
157                 FLAG(IJK) = 107
158              CASE DEFAULT
159     
160     ! Access to only one thread at a time
161     !!$omp       critical
162                 IF(DMP_LOG)WRITE (UNIT_LOG, 1000) IJK, ICBC_FLAG(IJK)
163                 call mfix_exit(myPE)
164     !!$omp       end critical
165              END SELECT
166     ! ----------------------------------------------------------------<<<
167     
168     ! Initialize cell face flags.  UNDEFINED_I should be a large +ve value.
169              FLAG_E(IJK) = UNDEFINED_I
170              FLAG_N(IJK) = UNDEFINED_I
171              FLAG_T(IJK) = UNDEFINED_I
172           ENDDO
173     
174     
175     
176     ! Setting up flags for the higher-order implementation.
177     ! ---------------------------------------------------------------->>>
178           call send_recv(flag)
179     
180           DO i = istart3, iend3
181              DO j = jstart3, jend3
182                 DO k = kstart3, kend3
183                    Flag3(funijk3(i,j,k)) = Flag(funijk(i,j,k))
184                 ENDDO
185              ENDDO
186           ENDDO
187     
188           DO i = istart4, iend4
189              DO j = jstart4, jend4
190                 DO k = kstart4, kend4
191                    If(i.eq.istart4.and.istart4.ne.istart3) then
192                       Flag3(funijk3(i,j,k)) = Flag3(funijk3(i+1,j,k))
193                    endif
194     
195                    If(j.eq.jstart4.and.kstart4.ne.kstart3) then
196                       Flag3(funijk3(i,j,k)) = Flag3(funijk3(i,j+1,k))
197                    endif
198     
199                    If(k.eq.kstart4.and.kstart4.ne.kstart3) then
200                       Flag3(funijk3(i,j,k)) = Flag3(funijk3(i,j,k+1))
201                    endif
202     
203                    If(i.eq.iend4.and.iend4.ne.iend3) then
204                       Flag3(funijk3(i,j,k)) = Flag3(funijk3(i-1,j,k))
205                    endif
206     
207                    If(j.eq.jend4.and.jend4.ne.jend3) then
208                       Flag3(funijk3(i,j,k)) = Flag3(funijk3(i,j-1,k))
209                    endif
210     
211                    If(k.eq.kend4.and.kend4.ne.kend3) then
212                       Flag3(funijk3(i,j,k)) = Flag3(funijk3(i,j,k-1))
213                    endif
214     
215                 ENDDO
216              ENDDO
217           ENDDO
218     
219           call send_recv3(flag3)
220     ! ----------------------------------------------------------------<<<
221     
222     
223     ! Set flag_e, flag_n and flag_b to indicate any internal surfaces. If
224     ! the flag is greater than or equal to 2000, then there is no internal
225     ! surface.
226     ! ---------------------------------------------------------------->>>
227     
228           DO L = 1, DIMENSION_IS
229     ! Make sure an IS has been specified
230              IF (IS_DEFINED(L)) THEN
231                 IF (IS_TYPE(L)=='IMPERMEABLE' .OR. &
232                     IS_TYPE(L)(3:13)=='IMPERMEABLE') THEN
233                    FLAGX = 0
234                 ELSEIF (IS_TYPE(L)=='SEMIPERMEABLE' .OR. &
235                         IS_TYPE(L)(3:15)=='SEMIPERMEABLE') THEN
236                    FLAGX = 1000 + L
237                 ELSE
238                    IF(DMP_LOG)WRITE (UNIT_LOG, 1100) L
239                    call mfix_exit(myPE)
240                 ENDIF
241     
242                 IF (IS_X_W(L)==IS_X_E(L) .AND. DO_I) THEN
243                    IS_PLANE(L) = 'E'
244                    I = IS_I_W(L)
245                    DO K = IS_K_B(L), IS_K_T(L)
246                       DO J = IS_J_S(L), IS_J_N(L)
247                          IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
248                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
249                          IJK = FUNIJK(I,J,K)
250                          FLAG_E(IJK) = FLAGX
251                       ENDDO
252                    ENDDO
253                 ELSEIF (IS_TYPE(L)(1:1) == 'X') THEN
254                    IS_PLANE(L) = 'E'
255                    DO I = IS_I_W(L), IS_I_E(L)
256                       DO K = IS_K_B(L), IS_K_T(L)
257                          DO J = IS_J_S(L), IS_J_N(L)
258                             IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
259                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
260                             IJK = FUNIJK(I,J,K)
261                             FLAG_E(IJK) = FLAGX
262                          ENDDO
263                       ENDDO
264                    ENDDO
265                 ENDIF
266     
267                 IF (IS_Y_S(L)==IS_Y_N(L) .AND. DO_J) THEN
268                    IS_PLANE(L) = 'N'
269                    J = IS_J_S(L)
270                    DO K = IS_K_B(L), IS_K_T(L)
271                       DO I = IS_I_W(L), IS_I_E(L)
272                          IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
273                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
274                          IJK = FUNIJK(I,J,K)
275                          FLAG_N(IJK) = FLAGX
276                       ENDDO
277                    ENDDO
278                 ELSEIF (IS_TYPE(L)(1:1) == 'Y') THEN
279                    IS_PLANE(L) = 'N'
280                    DO J = IS_J_S(L), IS_J_N(L)
281                       DO K = IS_K_B(L), IS_K_T(L)
282                          DO I = IS_I_W(L), IS_I_E(L)
283                             IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
284                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
285                             IJK = FUNIJK(I,J,K)
286                             FLAG_N(IJK) = FLAGX
287                          ENDDO
288                       ENDDO
289                    ENDDO
290                 ENDIF
291     
292                 IF (IS_Z_B(L)==IS_Z_T(L) .AND. DO_K) THEN
293                    IS_PLANE(L) = 'T'
294                    K = IS_K_B(L)
295                    DO J = IS_J_S(L), IS_J_N(L)
296                       DO I = IS_I_W(L), IS_I_E(L)
297                          IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
298                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
299                          IJK = FUNIJK(I,J,K)
300                          FLAG_T(IJK) = FLAGX
301                       ENDDO
302                    ENDDO
303                 ELSEIF (IS_TYPE(L)(1:1) == 'Z') THEN
304                    IS_PLANE(L) = 'T'
305                    DO K = IS_K_B(L), IS_K_T(L)
306                       DO J = IS_J_S(L), IS_J_N(L)
307                          DO I = IS_I_W(L), IS_I_E(L)
308                             IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
309                             IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
310                             IJK = FUNIJK(I,J,K)
311                             FLAG_T(IJK) = FLAGX
312                          ENDDO
313                       ENDDO
314                    ENDDO
315                 ENDIF
316     
317              ENDIF
318           call send_recv(flag,2)
319           call send_recv(flag_t,2)
320           call send_recv(flag_n,2)
321           call send_recv(flag_e,2)
322           ENDDO    ! end do loop (l = 1, dimension_is)
323     ! ----------------------------------------------------------------<<<
324     
325           IF (MYPE.EQ.PE_IO) THEN
326              ALLOCATE (ARR1(IJKMAX3))
327           ELSE
328              ALLOCATE (ARR1(1))
329           ENDIF
330     
331           CALL GATHER(FLAG,ARR1,ROOT)
332           CALL SCATTER(FLAG,ARR1,ROOT)
333     
334           DEALLOCATE (ARR1)
335     
336     
337           RETURN
338      1000 FORMAT(/1X,70('*')//' From: SET_FLAGS',/&
339              ' Message: ICBC_FLAG(',I3,') = ',&
340              A3,' is illegal',/1X,70('*')/)
341      1100 FORMAT(/1X,70('*')//' From: SET_FLAGS',/&
342              ' Message: Unknown IS_TYPE(',I3,&
343              ')',/1X,70('*')/)
344     
345           END SUBROUTINE SET_FLAGS
346     
347     
348     
349     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
350     !                                                                      C
351     !  Module name: SET_FLAGS1                                             C
352     !  Purpose: Assign IP flag to the faces of wall cells                  C
353     !                                                                      C
354     !  Notes: This routine may still leave flag_e, flag_n and flag_t       C
355     !         undefined in some boundary cells                             C
356     !                                                                      C
357     !  Author: M. Syamlal                                 Date: 15-MAY-96  C
358     !  Reviewer:                                          Date:            C
359     !                                                                      C
360     !  Literature/Document References:                                     C
361     !                                                                      C
362     !  Variables referenced:                                               C
363     !  Variables modified: FLAG_E, FLAG_N, FLAG_T                          C
364     !  Local variables:                                                    C
365     !                                                                      C
366     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
367     
368           SUBROUTINE SET_FLAGS1
369     
370     !-----------------------------------------------
371     ! Modules
372     !-----------------------------------------------
373           USE param
374           USE param1
375           USE parallel
376           USE fldvar
377           USE geometry
378           USE bc
379           USE is
380           USE indices
381           USE physprop
382           USE funits
383           USE compar
384           USE sendrecv
385           USE mpi_utility
386           USE functions
387           IMPLICIT NONE
388     !-----------------------------------------------
389     ! Local variables
390     !-----------------------------------------------
391     ! Indices
392           INTEGER :: IJK, IMJK, IJMK, IJKM, IPJK, IJPK, IJKP
393           INTEGER :: I, J, K
394     !
395           INTEGER, DIMENSION(:), allocatable :: FLAG_TEMP
396           INTEGER :: flag_size
397     !-----------------------------------------------
398     
399     
400     ! Allocate storage for temporary flag arrays
401           flag_size = ijkmax3
402           if (myPE.eq.root) then
403               flag_size = ijkmax3
404           endif
405           allocate( flag_temp(flag_size) )
406     
407     
408           DO IJK = ijkstart3,ijkend3
409              IMJK = IM_OF(IJK)
410              IJMK = JM_OF(IJK)
411              IJKM = KM_OF(IJK)
412              IPJK = IP_OF(IJK)
413              IJPK = JP_OF(IJK)
414              IJKP = KP_OF(IJK)
415              I = I_OF(IJK)
416              J = J_OF(IJK)
417              K = K_OF(IJK)
418              IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
419              IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
420     
421     ! If the flag is greater than or equal to 2000, there is no
422     ! internal surface.
423              IF (WALL_AT(IJK)) THEN
424     ! ---------------------------------------------------------------->>>
425     ! the default is equivalent to an impermeable surface and these cells
426     ! will be treated as such in the momentum routines
427                 FLAG_E(IJK) = 0
428                 FLAG_N(IJK) = 0
429                 FLAG_T(IJK) = 0
430                 FLAG_E(IMJK) = 0
431                 FLAG_N(IJMK) = 0
432                 FLAG_T(IJKM) = 0
433     
434                 IF (CYCLIC_AT(IJK)) THEN
435     ! make the upper (E, N, T) boundary permeable
436                    IF (I == IMAX2) THEN
437                       IF ((J/=1.AND.J/=0.) .AND. (J/=JMAX2.AND.J/=JMAX3)) THEN
438                          IF (NO_K) THEN
439                             IF(.NOT.WALL_AT(IMJK)) FLAG_E(IMJK) = 2000
440                          ELSEIF ((K/=1.AND.K/=0) .AND. (K/=KMAX2.AND.K/=KMAX3)) THEN
441                             IF(.NOT.WALL_AT(IMJK)) FLAG_E(IMJK) = 2000
442                          ENDIF
443                       ENDIF
444                    ENDIF
445                    IF (J == JMAX2) THEN
446                       IF ((I/=1.AND.I/=0) .AND. (I/=IMAX2.AND.I/=IMAX3)) THEN
447                          IF (NO_K) THEN
448                             IF(.NOT.WALL_AT(IJMK)) FLAG_N(IJMK) = 2000
449                          ELSE IF ((K/=1.AND.K/=0) .AND. (K/=KMAX2.AND.K/=KMAX3)) THEN
450                             IF(.NOT.WALL_AT(IJMK)) FLAG_N(IJMK) = 2000
451                          ENDIF
452                       ENDIF
453                     ENDIF
454                    IF (K == KMAX2) THEN
455                       IF ((J/=1.AND.J/=0.) .AND. (J/=JMAX2.AND.J/=JMAX3)) THEN
456                          IF ((I/=1.AND.I/=0) .AND. (I/=IMAX2.AND.I/=IMAX3) .AND. &
457                            .NOT.WALL_AT(IJKM)) FLAG_T(IJKM) = 2000
458                       ENDIF
459                    ENDIF
460     
461                 ENDIF   ! end if cyclic_at(ijk)
462     
463     ! ----------------------------------------------------------------<<<
464              ELSEIF (FLUID_AT(IJK)) THEN
465     ! ---------------------------------------------------------------->>>
466     
467                 IF ( .NOT.WALL_AT(IMJK) .AND. FLAG_E(IMJK)==UNDEFINED_I) &
468                    FLAG_E(IMJK) = 2000 + FLAG(IMJK)
469                 IF ( .NOT.WALL_AT(IJMK) .AND. FLAG_N(IJMK)==UNDEFINED_I) &
470                    FLAG_N(IJMK) = 2000 + FLAG(IJMK)
471                 IF ( .NOT.WALL_AT(IJKM) .AND. FLAG_T(IJKM)==UNDEFINED_I) &
472                    FLAG_T(IJKM) = 2000 + FLAG(IJKM)
473                 IF ( .NOT.WALL_AT(IPJK) .AND. FLAG_E(IJK)==UNDEFINED_I) &
474                    FLAG_E(IJK) = 2000 + FLAG(IPJK)
475                 IF ( .NOT.WALL_AT(IJPK) .AND. FLAG_N(IJK)==UNDEFINED_I) &
476                    FLAG_N(IJK) = 2000 + FLAG(IJPK)
477                 IF ( .NOT.WALL_AT(IJKP) .AND. FLAG_T(IJK)==UNDEFINED_I) &
478                    FLAG_T(IJK) = 2000 + FLAG(IJKP)
479     
480              ENDIF   ! end if/else (wall_at(ijk)/fluid_at(ijk))
481     
482           ENDDO    ! end do loop (ijk = ijkstart3,ijkend3)
483     ! ----------------------------------------------------------------<<<
484     
485     ! Fill the ghost layers using gather and scatter
486           call gather( flag_e, flag_temp )
487           call scatter( flag_e, flag_temp )
488           call gather( flag_n, flag_temp )
489           call scatter( flag_n, flag_temp )
490           call gather( flag_t, flag_temp )
491           call scatter( flag_t, flag_temp )
492     
493     ! deallocate storage of temporary flag arrays
494           deallocate( flag_temp )
495           call send_recv(flag_t,2)
496           call send_recv(flag_n,2)
497           call send_recv(flag_e,2)
498     
499           RETURN
500           END SUBROUTINE SET_FLAGS1
501     
502     
503