File: /nfs/home/0/users/jenkins/mfix.git/model/mod_bc_j.f
1
2
3
4
5
6
7
8
9 SUBROUTINE MOD_BC_J(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 :: J_s, J_n
31 INTEGER :: I_w, K_b
32
33 INTEGER :: OWNER
34 INTEGER :: I, K
35 INTEGER :: IJK , IJPK
36
37 INTEGER :: IER
38 LOGICAL :: ERROR
39 INTEGER :: J_FLUID, IJK_FLUID
40 INTEGER :: J_WALL, IJK_WALL
41
42
43
44
45 CALL INIT_ERR_MSG("MOD_BC_J")
46
47 J_S = BC_J_S(BCV)
48 J_N = BC_J_N(BCV)
49
50 I_W = BC_I_W(BCV)
51 K_B = BC_K_B(BCV)
52
53
54 = merge(myPE, 0, IS_ON_myPE_owns(I_W,J_S,K_B))
55 CALL GLOBAL_ALL_SUM(OWNER)
56
57 IF(myPE == OWNER)THEN
58
59 IJK = FUNIJK(I_W, J_S, K_B)
60 IJPK = FUNIJK(I_W, J_S+1, K_B)
61
62 IF (WALL_ICBC_FLAG(IJK) .AND. ICBC_FLAG(IJPK)(1:1)=='.') THEN
63 J_S = J_S
64 J_N = J_N
65 BC_PLANE(BCV) = 'N'
66
67 ELSE IF (WALL_ICBC_FLAG(IJPK) .AND. ICBC_FLAG(IJK)(1:1)=='.') THEN
68 J_S = J_S + 1
69 J_N = J_N + 1
70 BC_PLANE(BCV) = 'S'
71
72 ELSE
73 BC_PLANE(BCV) = '.'
74 ENDIF
75 ENDIF
76
77 CALL BCAST(J_S,OWNER)
78 CALL BCAST(J_N,OWNER)
79 CALL BCAST(BC_PLANE(BCV),OWNER)
80
81
82 IF(BC_PLANE(BCV) == '.') THEN
83 CALL BCAST(IJPK,OWNER)
84 CALL BCAST(IJK, OWNER)
85
86 WRITE(ERR_MSG, 1100) BCV, J_S, J_N, I_W, K_B, &
87 IJK, ICBC_FLAG(IJK), IJPK, ICBC_FLAG(IJPK)
88 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
89 ENDIF
90
91 1100 FORMAT('Error 1100: Cannot locate flow plane for boundary ', &
92 'condition ',I3,'.',2/3x,'J South = ',I6,' J North = ',I6,/&
93 3x,'I West = ',I6,' K Bottom = ',I6,2/' The following ', &
94 'should conttain a wall cell and fluid cell:',/3x,'IJK ',I9, &
95 ' :: ',A3,/3x,'IJPK ',I9,' :: ',A3,2/' Maybe no IC was ', &
96 'specified for the fluid cell.')
97
98
99 (BCV) = J_S
100 BC_J_N(BCV) = J_N
101
102
103 J_WALL = BC_J_S(BCV)
104 J_FLUID = merge(J_WALL-1, J_WALL+1, BC_PLANE(BCV)=='S')
105
106
107
108
109 = .FALSE.
110 DO K = BC_K_B(BCV), BC_K_T(BCV)
111 DO I = BC_I_W(BCV), BC_I_E(BCV)
112 IF(.NOT.IS_ON_myPE_plus2layers(I,J_FLUID,K)) CYCLE
113 IF(.NOT.IS_ON_myPE_plus2layers(I,J_WALL, K)) CYCLE
114 IF(DEAD_CELL_AT(I,J_FLUID,K)) CYCLE
115 IF(DEAD_CELL_AT(I,J_WALL, K)) CYCLE
116
117 IJK_WALL = FUNIJK(I,J_WALL, K)
118 IJK_FLUID = FUNIJK(I,J_FLUID,K)
119
120 IF(.NOT.(WALL_ICBC_FLAG(IJK_WALL) .AND. &
121 ICBC_FLAG(IJK_FLUID)(1:1)=='.')) ERROR = .TRUE.
122
123 ENDDO
124 ENDDO
125
126
127
128 CALL GLOBAL_ALL_OR(ERROR)
129
130
131
132
133 IF(ERROR) THEN
134
135 CALL OPEN_PE_LOG(IER)
136
137 WRITE(ERR_MSG, 1200) BCV
138 CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
139
140 1200 FORMAT('Error 1200: Illegal geometry for boundary condition:',I3)
141
142 DO K = BC_K_B(BCV), BC_K_T(BCV)
143 DO I = BC_I_W(BCV), BC_I_E(BCV)
144
145 IF(.NOT.IS_ON_myPE_plus2layers(I,J_FLUID,K)) CYCLE
146 IF(.NOT.IS_ON_myPE_plus2layers(I,J_WALL, K)) CYCLE
147 IF(DEAD_CELL_AT(I, J_FLUID,K)) CYCLE
148 IF(DEAD_CELL_AT(I, J_WALL, K)) CYCLE
149
150 IJK_WALL = FUNIJK(I,J_WALL ,K)
151 IJK_FLUID = FUNIJK(I,J_FLUID,K)
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_WALL, K, IJK_WALL, ICBC_FLAG(IJK_WALL), &
158 I, J_FLUID, K, 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_J
177