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