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