File: N:\mfix\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           END SUBROUTINE SET_IC_FLAGS
270     
271     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
272     !                                                                      !
273     !  Subroutine: SET_BC_FLAGS_WALL                                       !
274     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
275     !                                                                      !
276     !  Purpose: Find and validate i, j, k locations for walls BC's         !
277     !                                                                      !
278     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
279           SUBROUTINE SET_BC_FLAGS_WALL
280     
281           USE param
282           USE param1
283           USE geometry
284           USE fldvar
285           USE physprop
286           USE bc
287           USE indices
288           USE funits
289           USE compar
290           USE sendrecv
291           USE functions
292     
293           use error_manager
294     
295           IMPLICIT NONE
296     
297     !-----------------------------------------------
298     ! Local variables
299     !-----------------------------------------------
300     ! loop/variable indices
301           INTEGER :: I , J , K , IJK
302     ! loop index
303           INTEGER :: BCV
304     
305     !-----------------------------------------------
306     
307           CALL INIT_ERR_MSG("SET_BC_FLAGS_WALL")
308     
309     ! Set the wall flags.
310           DO BCV=1, DIMENSION_BC
311              IF(.NOT.BC_DEFINED(BCV)) CYCLE
312     
313              IF(BC_TYPE_ENUM(BCV)==FREE_SLIP_WALL .OR. &
314                 BC_TYPE_ENUM(BCV)==NO_SLIP_WALL   .OR. &
315                 BC_TYPE_ENUM(BCV)==PAR_SLIP_WALL) THEN
316     
317                 DO K = BC_K_B(BCV), BC_K_T(BCV)
318                 DO J = BC_J_S(BCV), BC_J_N(BCV)
319                 DO I = BC_I_W(BCV), BC_I_E(BCV)
320     
321                    IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
322                    IF(DEAD_CELL_AT(I,J,K)) CYCLE
323     
324                    IJK = FUNIJK(I,J,K)
325     
326                    SELECT CASE (BC_TYPE_ENUM(BCV))
327                    CASE(FREE_SLIP_WALL); ICBC_FLAG(IJK)(1:1) = 'S'
328                    CASE(NO_SLIP_WALL);   ICBC_FLAG(IJK)(1:1) = 'W'
329                    CASE(PAR_SLIP_WALL);  ICBC_FLAG(IJK)(1:1) = 's'
330                    END SELECT
331                    WRITE (ICBC_FLAG(IJK)(2:3),"(I2.2)") MOD(BCV,100)
332                 ENDDO
333                 ENDDO
334                 ENDDO
335     
336              ENDIF
337           ENDDO
338     
339           CALL SEND_RECV(ICBC_FLAG,2)
340     
341           CALL FINL_ERR_MSG
342     
343           RETURN
344           END SUBROUTINE SET_BC_FLAGS_WALL
345     
346     
347     
348     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
349     !                                                                      !
350     !  Subroutine: SET_BC_FLAGS_FLOW                                       !
351     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
352     !                                                                      !
353     !  Purpose: Find and validate i, j, k locations for flow BC's. Also    !
354     !           set value of bc_plane for flow BC's.                       !
355     !                                                                      !
356     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
357           SUBROUTINE SET_BC_FLAGS_FLOW
358     
359           USE param
360           USE param1
361           USE geometry
362           USE fldvar
363           USE physprop
364           USE bc
365           USE indices
366           USE funits
367           USE compar
368           USE sendrecv
369     
370           use mpi_utility
371           use sendrecv
372           use functions
373     
374           use error_manager
375     
376           IMPLICIT NONE
377     
378     ! loop/variable indices
379           INTEGER :: BCV, I, J, K, IJK
380     
381           INTEGER :: IER
382     
383     ! error indicator
384           LOGICAL :: ERROR
385     ! surface indictors
386           LOGICAL :: X_CONSTANT, Y_CONSTANT, Z_CONSTANT
387     
388           CALL INIT_ERR_MSG("SET_BC_FLAGS_FLOW")
389     
390     
391     ! FIND THE FLOW SURFACES
392           ERROR = .FALSE.
393     
394           DO BCV = 1, DIMENSION_BC
395     
396              IF(.NOT.BC_DEFINED(BCV)) CYCLE
397     
398              IF(BC_TYPE_ENUM(BCV)==MASS_INFLOW  .OR. &
399                 BC_TYPE_ENUM(BCV)==MASS_OUTFLOW .OR. &
400                 BC_TYPE_ENUM(BCV)==P_INFLOW     .OR. &
401                 BC_TYPE_ENUM(BCV)==P_OUTFLOW    .OR. &
402                 BC_TYPE_ENUM(BCV)==OUTFLOW) THEN
403     
404                 X_CONSTANT = (BC_X_W(BCV) == BC_X_E(BCV))
405                 Y_CONSTANT = (BC_Y_S(BCV) == BC_Y_N(BCV))
406                 Z_CONSTANT = (BC_Z_B(BCV) == BC_Z_T(BCV))
407     
408                 IF(X_CONSTANT .AND. BC_X_W(BCV)/=UNDEFINED)                &
409                    CALL MOD_BC_I(BCV)
410     
411                 IF(Y_CONSTANT .AND. BC_Y_S(BCV)/=UNDEFINED)                &
412                    CALL MOD_BC_J(BCV)
413     
414                 IF(Z_CONSTANT .AND. BC_Z_B(BCV)/=UNDEFINED)                &
415                    CALL MOD_BC_K(BCV)
416     
417     ! Extend the boundaries for cyclic implementation
418                 IF(BC_I_W(BCV) == 2 .AND. BC_I_E(BCV) == (IMAX2 - 1) .AND. &
419                    CYCLIC_X .AND. NODESI > 1) THEN
420                        BC_I_W(BCV) = 1
421                        BC_I_E(BCV) = IMAX2
422                 ENDIF
423                 IF(BC_J_S(BCV) == 2 .AND. BC_J_N(BCV) == (JMAX2 - 1) .AND. &
424                    CYCLIC_Y .AND. NODESJ > 1) THEN
425                    BC_J_S(BCV) = 1
426                    BC_J_N(BCV) = JMAX2
427                 ENDIF
428                 IF(BC_K_B(BCV) == 2 .AND. BC_K_T(BCV) == (KMAX2 - 1) .AND. &
429                    CYCLIC_Z .AND. NODESK > 1) THEN
430                    BC_K_B(BCV) = 1
431                    BC_K_T(BCV) = KMAX2
432                 ENDIF
433     
434     ! Set add the BC to the ICBC_FLAG. If a "non-wall" BC is found, then flag
435     ! this as an error. The next triple-loop will take care of reporting the
436     ! error.
437                 ERROR = .FALSE.
438                 DO K = BC_K_B(BCV), BC_K_T(BCV)
439                 DO J = BC_J_S(BCV), BC_J_N(BCV)
440                 DO I = BC_I_W(BCV), BC_I_E(BCV)
441     
442                    IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
443                    IF(DEAD_CELL_AT(I,J,K)) CYCLE
444     
445                    IJK = FUNIJK(I,J,K)
446     
447     ! Verify that the FLOW BC is overwriting a wall.
448                    IF(WALL_ICBC_FLAG(IJK)) THEN
449     
450                       SELECT CASE (BC_TYPE_ENUM(BCV))
451                       CASE (P_OUTFLOW);    ICBC_FLAG(IJK)(1:1) = 'P'
452                       CASE (MASS_INFLOW);  ICBC_FLAG(IJK)(1:1) = 'I'
453                       CASE (MASS_OUTFLOW); ICBC_FLAG(IJK)(1:1) = 'O'
454                       CASE (OUTFLOW);      ICBC_FLAG(IJK)(1:1) = 'o'
455                       CASE (P_INFLOW);     ICBC_FLAG(IJK)(1:1) = 'p'
456                       END SELECT
457     
458                       WRITE(ICBC_FLAG(IJK)(2:3),"(I2.2)") MOD(BCV,100)
459     
460                    ELSE
461                       ERROR = .TRUE.
462                    ENDIF
463     
464                 ENDDO
465                 ENDDO
466                 ENDDO
467     
468     ! Sync the error flag over all ranks.
469                 CALL GLOBAL_ALL_OR(ERROR)
470     
471     ! Report errors and exit.
472                 IF(ERROR)THEN
473     
474                    CALL OPEN_PE_LOG(IER)
475     
476                    WRITE(ERR_MSG, 1200) BCV
477                    CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
478     
479      1200 FORMAT('Error 1200: Boundary condition ',I3,' overlaps with ',&
480              'another BC.',2/7x,'I',7x,'J',7x,'K',3x,'ICBC')
481     
482                    DO K = BC_K_B(BCV), BC_K_T(BCV)
483                    DO J = BC_J_S(BCV), BC_J_N(BCV)
484                    DO I = BC_I_W(BCV), BC_I_E(BCV)
485     
486                       IF(.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
487                       IF(DEAD_CELL_AT(I,J,K)) CYCLE
488     
489                       IJK = FUNIJK(I,J,K)
490     
491     ! Verify that the FLOW BC is overwriting a wall.
492                       IF(.NOT.WALL_ICBC_FLAG(IJK)) THEN
493                          WRITE(ERR_MSG, 1201) I,J,K, ICBC_FLAG(IJK)
494                          CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
495                       ENDIF
496     
497      1201 FORMAT(1x,3(2x,I6),3x,A3)
498     
499                    ENDDO
500                    ENDDO
501                    ENDDO
502     
503                    WRITE(ERR_MSG,"('Please correct the mfix.dat file.')")
504                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., ABORT=.TRUE.)
505     
506                 ENDIF ! IF(ERROR)
507              ENDIF ! IF(not a wall BC)
508           ENDDO ! BC Loop
509     
510     ! Sync the ICBC flag across ghost layers
511           CALL SEND_RECV(ICBC_FLAG,2)
512     
513           CALL FINL_ERR_MSG
514     
515           RETURN
516           END SUBROUTINE SET_BC_FLAGS_FLOW
517