File: /nfs/home/0/users/jenkins/mfix.git/model/set_icbc_flags.f
1
2
3
4
5
6
7
8
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
21 CALL CHECK_ICBC_FLAG
22
23 END SUBROUTINE SET_ICBC_FLAG
24
25
26
27
28
29
30
31
32
33
34
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
46 DO K = kStart3, kEnd3
47 DO J = jStart3, jEnd3
48 DO I = iStart3, iEnd3
49
50 IJK = FUNIJK(I,J,K)
51
52
53 (IJK) = merge(' ', '.--', RUN_TYPE == 'NEW')
54
55
56
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
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
102 ENDDO
103 ENDDO
104
105 RETURN
106
107 END SUBROUTINE INIT_ICBC_FLAG
108
109
110
111
112
113
114
115
116
117
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
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
153 CALL GLOBAL_ALL_OR(ERROR)
154
155
156
157
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
182 CALL SEND_RECV(ICBC_FLAG,2)
183 ENDIF
184
185
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
203
204
205
206
207
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
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
240 IF (IC_TYPE(ICV) == 'PATCH') CYCLE IC_LP
241
242
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
258 CALL SEND_RECV(ICBC_FLAG, 2)
259
260
261
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
278
279
280
281
282
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
305
306
307 INTEGER :: I , J , K , IJK
308
309 INTEGER :: BCV
310
311
312 INTEGER, PARAMETER :: DIM_BCTYPE = 21
313
314
315
316 CALL INIT_ERR_MSG("SET_BC_FLAGS_WALL")
317
318
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
358
359
360
361
362
363
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
388 INTEGER :: BCV, I, J, K, IJK
389
390 INTEGER :: IER
391
392
393 LOGICAL :: ERROR
394
395 LOGICAL :: X_CONSTANT, Y_CONSTANT, Z_CONSTANT
396
397 CALL INIT_ERR_MSG("SET_BC_FLAGS_FLOW")
398
399
400
401 = .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
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
444
445
446 = .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
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
478 CALL GLOBAL_ALL_OR(ERROR)
479
480
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
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
516 ENDIF
517 ENDDO
518
519
520 CALL SEND_RECV(ICBC_FLAG,2)
521
522 CALL FINL_ERR_MSG
523
524 RETURN
525 END SUBROUTINE SET_BC_FLAGS_FLOW
526