File: /nfs/home/0/users/jenkins/mfix.git/model/mod_bc_k.f
1
2
3
4
5
6
7
8
9 SUBROUTINE MOD_BC_K(BCV)
10
11 use bc, only: BC_I_W, BC_I_E
12 use bc, only: BC_J_S, BC_J_N
13 use bc, only: BC_K_B, BC_K_T
14 use bc, only: BC_PLANE
15
16 USE geometry, only: ICBC_FLAG
17
18 USE compar
19 USE mpi_utility
20
21 use error_manager
22 USE functions
23
24 IMPLICIT NONE
25
26
27 INTEGER, INTENT(in) :: BCV
28
29
30 INTEGER :: K_b, K_t
31 INTEGER :: I_w, J_s
32
33 INTEGER :: OWNER
34
35 INTEGER :: I, J
36 INTEGER :: IJK, IJKP
37
38 INTEGER :: IER
39 LOGICAL :: ERROR
40 INTEGER :: K_FLUID, IJK_FLUID
41 INTEGER :: K_WALL, IJK_WALL
42
43
44
45
46 CALL INIT_ERR_MSG("MOD_BC_K")
47
48 K_B = BC_K_B(BCV)
49 K_T = BC_K_T(BCV)
50
51 I_W = BC_I_W(BCV)
52 J_S = BC_J_S(BCV)
53
54
55
56 = merge(myPE, 0, IS_ON_myPE_owns(I_W, J_S, K_B))
57 CALL GLOBAL_ALL_SUM(OWNER)
58
59 IF(myPE == OWNER) THEN
60
61 IJK = FUNIJK(I_W, J_S, K_B)
62 IJKP = FUNIJK(I_W, J_S, K_B+1)
63
64 IF(WALL_ICBC_FLAG(IJK) .AND. ICBC_FLAG(IJKP)(1:1)=='.')THEN
65 K_B = K_B
66 K_T = K_T
67 BC_PLANE(BCV) = 'T'
68 ELSEIF(WALL_ICBC_FLAG(IJKP) .AND. ICBC_FLAG(IJK)(1:1)=='.')THEN
69 K_B = K_B + 1
70 K_T = K_T + 1
71 BC_PLANE(BCV) = 'B'
72 ELSE
73 BC_PLANE(BCV) = '.'
74 ENDIF
75 ENDIF
76
77
78 CALL BCAST(K_B,OWNER)
79 CALL BCAST(K_T,OWNER)
80 CALL BCAST(BC_PLANE(BCV),OWNER)
81
82
83 IF(BC_PLANE(BCV) == '.') THEN
84 CALL BCAST(IJKP,OWNER)
85 CALL BCAST(IJK, OWNER)
86
87 WRITE(ERR_MSG, 1100) BCV, K_B, K_T, I_W, J_S, &
88 IJK, ICBC_FLAG(IJK), IJKP, ICBC_FLAG(IJKP)
89 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
90 ENDIF
91
92 1100 FORMAT('Error 1100: Cannot locate flow plane for boundary ', &
93 'condition ',I3,'.',2/3x,'K Bottom = ',I6,' K Top = ',I6,/&
94 3x,'I West = ',I6,' J South = ',I6,2/' The following ', &
95 'should conttain a wall cell and fluid cell:',/3x,'IJK ',I9, &
96 ' :: ',A3,/3x,'IJKP ',I9,' :: ',A3,2/' Maybe no IC was ', &
97 'specified for the fluid cell.')
98
99
100 (BCV) = K_B
101 BC_K_T(BCV) = K_T
102
103
104 = BC_K_B(BCV)
105 K_FLUID = merge(K_WALL-1, K_WALL+1, BC_PLANE(BCV)=='B')
106
107
108 ERROR = .FALSE.
109 DO J = BC_J_S(BCV), BC_J_N(BCV)
110 DO I = BC_I_W(BCV), BC_I_E(BCV)
111
112
113 IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_FLUID)) CYCLE
114 IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_WALL )) CYCLE
115 IF(DEAD_CELL_AT(I,J,K_FLUID)) CYCLE
116 IF(DEAD_CELL_AT(I,J,K_WALL )) CYCLE
117
118 IJK_WALL = FUNIJK(I,J,K_WALL)
119 IJK_FLUID = FUNIJK(I,J,K_FLUID)
120
121 IF(.NOT.(WALL_ICBC_FLAG(IJK_WALL) .AND. &
122 ICBC_FLAG(IJK_FLUID)(1:1)=='.')) ERROR = .TRUE.
123
124 ENDDO
125 ENDDO
126
127
128 CALL GLOBAL_ALL_OR(ERROR)
129
130
131
132 IF(ERROR) THEN
133
134 CALL OPEN_PE_LOG(IER)
135
136 WRITE(ERR_MSG, 1200) BCV
137 CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
138
139 1200 FORMAT('Error 1200: Illegal geometry for boundary condition:',I3)
140
141 DO J = BC_J_S(BCV), BC_J_N(BCV)
142 DO I = BC_I_W(BCV), BC_I_E(BCV)
143
144
145 IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_FLUID)) CYCLE
146 IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_WALL )) CYCLE
147 IF(DEAD_CELL_AT(I,J,K_FLUID)) CYCLE
148 IF(DEAD_CELL_AT(I,J,K_WALL )) CYCLE
149
150 IJK_WALL = FUNIJK(I,J,K_WALL)
151 IJK_FLUID = FUNIJK(I,J,K_FLUID)
152
153 IF(.NOT.(WALL_ICBC_FLAG(IJK_WALL) .AND. &
154 ICBC_FLAG(IJK_FLUID)(1:1)=='.')) THEN
155
156 WRITE(ERR_MSG, 1201) &
157 I, J, K_WALL, IJK_WALL, ICBC_FLAG(IJK_WALL), &
158 I, J, K_FLUID, IJK_FLUID, ICBC_FLAG(IJK_FLUID)
159 CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
160 ENDIF
161
162 1201 FORMAT(' ',/14X,'I',7X,'J',7X,'K',7X,'IJK',4x,'FLAG',/3x, &
163 'WALL ',3(2x,I6),2x,I9,3x,A,/3x,'FLUID',3(2x,I6),2x,I9,3x,A)
164
165 ENDDO
166 ENDDO
167
168 WRITE(ERR_MSG,"('Please correct the mfix.dat file.')")
169 CALL FLUSH_ERR_MSG(HEADER=.FALSE., ABORT=.TRUE.)
170
171 ENDIF
172
173 CALL FINL_ERR_MSG
174
175 RETURN
176 END SUBROUTINE MOD_BC_K
177