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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     ! Subroutine: SET_ICBC_FLAG                                            !
4     ! Author: J.Musser                                    Date: 01-Mar-14  !
5     !                                                                      !
6     ! Purpose: Provided a detailed error message when the sum of volume    !
7     !                                                                      !
8     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
9           SUBROUTINE SET_ICBC_FLAG
10     
11     
12           CALL INIT_ICBC_FLAG
13     
14           CALL SET_IC_FLAGS
15     
16           CALL SET_BC_FLAGS_WALL
17     
18           CALL SET_BC_FLAGS_FLOW
19     
20     ! Verify that ICBC flags are set for all fluid cells.
21           CALL CHECK_ICBC_FLAG
22     
23           END SUBROUTINE SET_ICBC_FLAG
24     
25     
26     
27     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
28     !                                                                      !
29     ! Subroutine: INIT_ICBC_FLAG                                           !
30     ! Author: J.Musser                                    Date: 01-Mar-14  !
31     !                                                                      !
32     ! Purpose: Provided a detailed error message when the sum of volume    !
33     !                                                                      !
34     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
35           SUBROUTINE INIT_ICBC_FLAG
36     
37           use param1, only: zero
38           use run, only: RUN_TYPE
39     
40           use mpi_utility
41           use functions
42     
43           implicit none
44           INTEGER :: I, J, K, IJK
45     
46     ! Initialize the icbc_flag array.
47           DO K = kStart3, kEnd3
48           DO J = jStart3, jEnd3
49           DO I = iStart3, iEnd3
50     
51              IJK = FUNIJK(I,J,K)
52     
53     ! Initialize the ICBC Flag
54              ICBC_FLAG(IJK) = merge('   ', '.--', RUN_TYPE == 'NEW')
55     
56     ! If at domain boundaries then set default values (wall or, if
57     ! specified, cyclic)
58              IF (DO_K) THEN
59                 IF(K==KMIN3 .OR. K==KMIN2 .OR. K==KMAX2 .OR. K==KMAX3)THEN
60                    IF (CYCLIC_Z_PD) THEN
61                       ICBC_FLAG(IJK) = 'C--'
62                    ELSEIF (CYCLIC_Z) THEN
63                       ICBC_FLAG(IJK) = 'c--'
64                    ELSE
65                       ICBC_FLAG(IJK) = 'W--'
66                    ENDIF
67                 ENDIF
68              ENDIF
69     
70              IF(DO_J)THEN
71                 IF(J==JMIN3 .OR. J==JMIN2 .OR. J==JMAX2 .OR. J==JMAX3)THEN
72                    IF (CYCLIC_Y_PD) THEN
73                       ICBC_FLAG(IJK) = 'C--'
74                    ELSEIF (CYCLIC_Y) THEN
75                       ICBC_FLAG(IJK) = 'c--'
76                    ELSE
77                      ICBC_FLAG(IJK) = 'W--'
78                    ENDIF
79                 ENDIF
80              ENDIF
81     
82              IF(DO_I)THEN
83                 IF(I==IMIN3 .OR. I==IMIN2 .OR. I==IMAX2 .OR. I==IMAX3)THEN
84                    IF (CYCLIC_X_PD) THEN
85                       ICBC_FLAG(IJK) = 'C--'
86                    ELSEIF (CYCLIC_X) THEN
87                       ICBC_FLAG(IJK) = 'c--'
88                    ELSE
89                       ICBC_FLAG(IJK) = 'W--'
90                    ENDIF
91                 ENDIF
92                 IF (I==1 .AND. CYLINDRICAL .AND. XMIN==ZERO) &
93                    ICBC_FLAG(IJK) = 'S--'
94              ENDIF
95     ! corner cells are wall cells
96              IF ((I==IMIN3 .OR. I==IMIN2 .OR. I==IMAX2 .OR. I==IMAX3) .AND. &
97                  (J==JMIN3 .OR. J==JMIN2 .OR. J==JMAX2 .OR. J==JMIN3) .AND. &
98                  (K==KMIN3 .OR. K==KMIN2 .OR. K==KMAX2 .OR. K==KMAX3)) THEN
99                 IF (ICBC_FLAG(IJK) /= 'S--') ICBC_FLAG(IJK) = 'W--'
100              ENDIF
101     
102           ENDDO ! end do loop (i=istart3, iend3)
103           ENDDO ! end do loop (j=jstart3, jend3)
104           ENDDO ! end do loop (k=kstart3, kend3)
105     
106           RETURN
107     
108           END SUBROUTINE INIT_ICBC_FLAG
109     
110     
111     
112     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
113     !                                                                      !
114     !  Subroutine: CHECK_ICBC_FLAG                                         !
115     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
116     !                                                                      !
117     !  Purpose: Verify that data was not given for undefined BC regions.   !
118     !  Note that the error message may be incomplete
119     !                                                                      !
120     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
121           SUBROUTINE CHECK_ICBC_FLAG
122     
123     
124           use run, only: RUN_TYPE
125     
126           use mpi_utility
127           use sendrecv
128     
129           use error_manager
130           use functions
131     
132           IMPLICIT NONE
133     
134           LOGICAL :: ERROR = .FALSE.
135     
136           INTEGER :: I, J ,K, IER
137     
138           IF(RUN_TYPE(1:3) /= 'NEW') RETURN
139     
140     
141     
142           CALL INIT_ERR_MSG("CHECK_ICBC_FLAG")
143     
144     ! First check for any errors.
145           DO K = kStart2, kEnd2
146           DO J = jStart2, jEnd2
147           DO I = iStart2, iEnd2
148              IF(ICBC_FLAG(FUNIJK(I,J,K)) == '   ') ERROR = .TRUE.
149           ENDDO
150           ENDDO
151           ENDDO
152     
153     ! Sync up the error flag across all processes.
154           CALL GLOBAL_ALL_OR(ERROR)
155     
156     ! If an error is detected, have each rank open a log file and write
157     ! it's own message. Otherwise, we need to send all the data back to
158     ! PE_IO and that's too much work!
159           IF(ERROR) THEN
160     
161              CALL OPEN_PE_LOG(IER)
162     
163              WRITE(ERR_MSG, 1100) trim(iVal(myPE))
164              CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
165     
166              DO K = kStart2, kEnd2
167              DO J = jStart2, jEnd2
168              DO I = iStart2, iEnd2
169                 IF(ICBC_FLAG(FUNIJK(I,J,K)) == '   ') THEN
170                    WRITE(ERR_MSG,1101) I, J, K
171                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
172                 ENDIF
173     
174              ENDDO
175              ENDDO
176              ENDDO
177     
178              WRITE(ERR_MSG, 1102)
179              CALL FLUSH_ERR_MSG(HEADER=.FALSE., ABORT=.TRUE.)
180     
181           ELSE
182     ! If no erros, sync up the ghost cell layers.
183              CALL SEND_RECV(ICBC_FLAG,2)
184           ENDIF
185     
186     ! Clean up and return.
187           CALL FINL_ERR_MSG
188     
189           RETURN
190     
191      1100 FORMAT('Error 1100 (PE ',A,') : No initial or boundary ',        &
192              'condtions specified in','the following cells:',/             &
193              '    I       J       K')
194     
195      1101 FORMAT(I5,3X,I5,3X,I5)
196     
197      1102 FORMAT('Please correct the mfix.dat file.')
198     
199           END SUBROUTINE CHECK_ICBC_FLAG
200     
201     
202     
203     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
204     !                                                                      !
205     !  Subroutine: SET_IC_FLAGS                                            !
206     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
207     !                                                                      !
208     !  Purpose: Set the IC portions of the ICBC_Flag array.                !
209     !                                                                      !
210     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
211           SUBROUTINE SET_IC_FLAGS
212     
213           use ic, only: IC_DEFINED
214           use ic, only: IC_TYPE
215     
216           use ic, only: IC_I_W, IC_I_E
217           use ic, only: IC_J_S, IC_J_N
218           use ic, only: IC_K_B, IC_K_T
219     
220           use param, only: dimension_ic
221     
222           use sendrecv
223           use mpi_utility
224           use error_manager
225           use functions
226     
227           IMPLICIT NONE
228     
229     !-----------------------------------------------
230     ! Local variables
231     !-----------------------------------------------
232           INTEGER :: ICV
233           INTEGER :: I, J, K, IJK
234     
235           CALL INIT_ERR_MSG("SET_IC_FLAGS")
236     
237     
238           IC_LP: DO ICV=1, DIMENSION_IC
239     
240              IF(.NOT.IC_DEFINED(ICV)) CYCLE IC_LP
241     
242     ! Skip checks for PATCH restarts.
243              IF (IC_TYPE(ICV) == 'PATCH') CYCLE IC_LP
244     
245     !  Set ICBC flag
246              DO K = IC_K_B(ICV), IC_K_T(ICV)
247              DO J = IC_J_S(ICV), IC_J_N(ICV)
248              DO I = IC_I_W(ICV), IC_I_E(ICV)
249                 IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
250                 IF(DEAD_CELL_AT(I,J,K)) CYCLE
251                 IJK = FUNIJK(I,J,K)
252                 WRITE(ICBC_FLAG(IJK)(1:3),"('.',I2.2)") MOD(ICV,100)
253              ENDDO
254              ENDDO
255              ENDDO
256     
257     
258           ENDDO IC_LP
259     
260     ! Update the ICBC flag on ghost cells.
261           CALL SEND_RECV(ICBC_FLAG, 2)
262     
263     
264     ! Clean up and return.
265           CALL FINL_ERR_MSG
266     
267           RETURN
268     
269      1100 FORMAT('Error 1100 (PE ',A,') : No initial or boundary ',        &
270              'condtions specified in','the following cells:',/             &
271              '    I       J       K')
272     
273      1101 FORMAT(I5,3X,I5,3X,I5)
274     
275      1102 FORMAT('Please correct the mfix.dat file.')
276     
277           END SUBROUTINE SET_IC_FLAGS
278     
279     
280     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
281     !                                                                      !
282     !  Subroutine: SET_BC_FLAGS_WALL                                       !
283     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
284     !                                                                      !
285     !  Purpose: Find and validate i, j, k locations for walls BC's         !
286     !                                                                      !
287     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
288           SUBROUTINE SET_BC_FLAGS_WALL
289     
290           USE param
291           USE param1
292           USE geometry
293           USE fldvar
294           USE physprop
295           USE bc
296           USE indices
297           USE funits
298           USE compar
299           USE sendrecv
300           USE functions
301     
302           use error_manager
303     
304           IMPLICIT NONE
305     
306     !-----------------------------------------------
307     ! Local variables
308     !-----------------------------------------------
309     ! loop/variable indices
310           INTEGER :: I , J , K , IJK
311     ! loop index
312           INTEGER :: BCV
313     
314     ! Total number of valid BC types
315           INTEGER, PARAMETER :: DIM_BCTYPE = 21
316     
317     !-----------------------------------------------
318     
319           CALL INIT_ERR_MSG("SET_BC_FLAGS_WALL")
320     
321     ! Set the wall flags.
322           DO BCV=1, DIMENSION_BC
323              IF(.NOT.BC_DEFINED(BCV)) CYCLE
324     
325              IF(BC_TYPE(BCV)=='FREE_SLIP_WALL' .OR. &
326                 BC_TYPE(BCV)=='NO_SLIP_WALL'   .OR. &
327                 BC_TYPE(BCV)=='PAR_SLIP_WALL') THEN
328     
329                 DO K = BC_K_B(BCV), BC_K_T(BCV)
330                 DO J = BC_J_S(BCV), BC_J_N(BCV)
331                 DO I = BC_I_W(BCV), BC_I_E(BCV)
332     
333                    IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
334                    IF(DEAD_CELL_AT(I,J,K)) CYCLE
335     
336                    IJK = FUNIJK(I,J,K)
337     
338                    SELECT CASE (TRIM(BC_TYPE(BCV)))
339                    CASE('FREE_SLIP_WALL'); ICBC_FLAG(IJK)(1:1) = 'S'
340                    CASE('NO_SLIP_WALL');   ICBC_FLAG(IJK)(1:1) = 'W'
341                    CASE('PAR_SLIP_WALL');  ICBC_FLAG(IJK)(1:1) = 's'
342                    END SELECT
343                    WRITE (ICBC_FLAG(IJK)(2:3),"(I2.2)") MOD(BCV,100)
344                 ENDDO
345                 ENDDO
346                 ENDDO
347     
348              ENDIF
349           ENDDO
350     
351           CALL SEND_RECV(ICBC_FLAG,2)
352     
353           CALL FINL_ERR_MSG
354     
355           RETURN
356           END SUBROUTINE SET_BC_FLAGS_WALL
357     
358     
359     
360     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
361     !                                                                      !
362     !  Subroutine: SET_BC_FLAGS_FLOW                                       !
363     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
364     !                                                                      !
365     !  Purpose: Find and validate i, j, k locations for flow BC's. Also    !
366     !           set value of bc_plane for flow BC's.                       !
367     !                                                                      !
368     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
369           SUBROUTINE SET_BC_FLAGS_FLOW
370     
371           USE param
372           USE param1
373           USE geometry
374           USE fldvar
375           USE physprop
376           USE bc
377           USE indices
378           USE funits
379           USE compar
380           USE sendrecv
381     
382           use mpi_utility
383           use sendrecv
384           use functions
385     
386           use error_manager
387     
388           IMPLICIT NONE
389     
390     ! loop/variable indices
391           INTEGER :: BCV, I, J, K, IJK
392     
393           INTEGER :: IER
394     
395     ! error indicator
396           LOGICAL :: ERROR
397     ! surface indictors
398           LOGICAL :: X_CONSTANT, Y_CONSTANT, Z_CONSTANT
399     
400           CALL INIT_ERR_MSG("SET_BC_FLAGS_FLOW")
401     
402     
403     ! FIND THE FLOW SURFACES
404           ERROR = .FALSE.
405     
406           DO BCV = 1, DIMENSION_BC
407     
408              IF(.NOT.BC_DEFINED(BCV)) CYCLE
409     
410              IF(BC_TYPE(BCV)=='MASS_INFLOW'  .OR. &
411                 BC_TYPE(BCV)=='MASS_OUTFLOW' .OR. &
412                 BC_TYPE(BCV)=='P_INFLOW'     .OR. &
413                 BC_TYPE(BCV)=='P_OUTFLOW'    .OR. &
414                 BC_TYPE(BCV)=='OUTFLOW') THEN
415     
416                 X_CONSTANT = (BC_X_W(BCV) == BC_X_E(BCV))
417                 Y_CONSTANT = (BC_Y_S(BCV) == BC_Y_N(BCV))
418                 Z_CONSTANT = (BC_Z_B(BCV) == BC_Z_T(BCV))
419     
420                 IF(X_CONSTANT .AND. BC_X_W(BCV)/=UNDEFINED)                &
421                    CALL MOD_BC_I(BCV)
422     
423                 IF(Y_CONSTANT .AND. BC_Y_S(BCV)/=UNDEFINED)                &
424                    CALL MOD_BC_J(BCV)
425     
426                 IF(Z_CONSTANT .AND. BC_Z_B(BCV)/=UNDEFINED)                &
427                    CALL MOD_BC_K(BCV)
428     
429     ! Extend the boundaries for cyclic implementation
430                 IF(BC_I_W(BCV) == 2 .AND. BC_I_E(BCV) == (IMAX2 - 1) .AND. &
431                    CYCLIC_X .AND. NODESI > 1) THEN
432                        BC_I_W(BCV) = 1
433                        BC_I_E(BCV) = IMAX2
434                 ENDIF
435                 IF(BC_J_S(BCV) == 2 .AND. BC_J_N(BCV) == (JMAX2 - 1) .AND. &
436                    CYCLIC_Y .AND. NODESJ > 1) THEN
437                    BC_J_S(BCV) = 1
438                    BC_J_N(BCV) = JMAX2
439                 ENDIF
440                 IF(BC_K_B(BCV) == 2 .AND. BC_K_T(BCV) == (KMAX2 - 1) .AND. &
441                    CYCLIC_Z .AND. NODESK > 1) THEN
442                    BC_K_B(BCV) = 1
443                    BC_K_T(BCV) = KMAX2
444                 ENDIF
445     
446     ! Set add the BC to the ICBC_FLAG. If a "non-wall" BC is found, then flag
447     ! this as an error. The next triple-loop will take care of reporting the
448     ! error.
449                 ERROR = .FALSE.
450                 DO K = BC_K_B(BCV), BC_K_T(BCV)
451                 DO J = BC_J_S(BCV), BC_J_N(BCV)
452                 DO I = BC_I_W(BCV), BC_I_E(BCV)
453     
454                    IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
455                    IF(DEAD_CELL_AT(I,J,K)) CYCLE
456     
457                    IJK = FUNIJK(I,J,K)
458     
459     ! Verify that the FLOW BC is overwriting a wall.
460                    IF(WALL_ICBC_FLAG(IJK)) THEN
461     
462                       SELECT CASE (TRIM(BC_TYPE(BCV)))
463                       CASE ('P_OUTFLOW');    ICBC_FLAG(IJK)(1:1) = 'P'
464                       CASE ('MASS_INFLOW');  ICBC_FLAG(IJK)(1:1) = 'I'
465                       CASE ('MASS_OUTFLOW'); ICBC_FLAG(IJK)(1:1) = 'O'
466                       CASE ('OUTFLOW');      ICBC_FLAG(IJK)(1:1) = 'o'
467                       CASE ('P_INFLOW');     ICBC_FLAG(IJK)(1:1) = 'p'
468                       END SELECT
469     
470                       WRITE(ICBC_FLAG(IJK)(2:3),"(I2.2)") MOD(BCV,100)
471     
472                    ELSE
473                       ERROR = .TRUE.
474                    ENDIF
475     
476                 ENDDO
477                 ENDDO
478                 ENDDO
479     
480     ! Sync the error flag over all ranks.
481                 CALL GLOBAL_ALL_OR(ERROR)
482     
483     ! Report errors and exit.
484                 IF(ERROR)THEN
485     
486                    CALL OPEN_PE_LOG(IER)
487     
488                    WRITE(ERR_MSG, 1200) BCV
489                    CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
490     
491      1200 FORMAT('Error 1200: Boundary condition ',I3,' overlaps with ',&
492              'another BC.',2/7x,'I',7x,'J',7x,'K',3x,'ICBC')
493     
494                    DO K = BC_K_B(BCV), BC_K_T(BCV)
495                    DO J = BC_J_S(BCV), BC_J_N(BCV)
496                    DO I = BC_I_W(BCV), BC_I_E(BCV)
497     
498                       IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
499                       IF(DEAD_CELL_AT(I,J,K)) CYCLE
500     
501                       IJK = FUNIJK(I,J,K)
502     
503     ! Verify that the FLOW BC is overwriting a wall.
504                       IF(.NOT.WALL_ICBC_FLAG(IJK)) THEN
505                          WRITE(ERR_MSG, 1201) I,J,K, ICBC_FLAG(IJK)
506                          CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
507                       ENDIF
508     
509      1201 FORMAT(1x,3(2x,I6),3x,A3)
510     
511                    ENDDO
512                    ENDDO
513                    ENDDO
514     
515                    WRITE(ERR_MSG,"('Please correct the mfix.dat file.')")
516                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., ABORT=.TRUE.)
517     
518                 ENDIF ! IF(ERROR)
519              ENDIF ! IF(not a wall BC)
520           ENDDO ! BC Loop
521     
522     ! Sync the ICBC flag across ghost layers
523           CALL SEND_RECV(ICBC_FLAG,2)
524     
525           CALL FINL_ERR_MSG
526     
527           RETURN
528           END SUBROUTINE SET_BC_FLAGS_FLOW
529