File: /nfs/home/0/users/jenkins/mfix.git/model/check_data/check_bc_pic.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     ! minimum amount of geometry data.                                     !
3     !                                                                      !
4     ! Subroutine: CHECK_BC_PIC                                             !
5     ! Author: R. Garg                                     Date: 11-Jun-14  !
6     !                                                                      !
7     ! Purpose: Determine if BCs are "DEFINED" and that they contain the    !
8     ! minimum amount of geometry data.                                     !
9     !                                                                      !
10     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
11           SUBROUTINE CHECK_BC_PIC(M_TOT)
12     
13     ! Global Variables:
14     !---------------------------------------------------------------------//
15     
16     ! Simulation dimension (2D/3D)
17           USE discretelement, only: DIMN
18     ! User specified BC
19           use bc, only: BC_TYPE
20     ! User specifed: BC geometry
21           use bc, only: BC_EP_s
22     ! Use specified flag for ignoring PO BC for discrete solids
23           USE bc, only: BC_PO_APPLY_TO_DES
24     ! PIC model specific BC region specification.
25           USE bc, only: BC_PIC_MI_CONST_NPC, BC_PIC_MI_CONST_STATWT
26           USE bc, only: BC_X_w, BC_X_e, BC_Y_s, BC_Y_n, BC_Z_b, BC_Z_t
27     
28     ! Solids phase identifier
29           use run, only: SOLIDS_MODEL
30     ! Number of PIC inlet/outlet BCs detected.
31           use pic_bc, only: PIC_BCMI, PIC_BCMO
32     !
33           use pic_bc, only: PIC_BCMI_MAP
34           use pic_bc, only: PIC_BCMO_MAP
35     ! Global Parameters:
36     !---------------------------------------------------------------------//
37     ! The max number of BCs.
38           use param, only: DIMENSION_BC
39     ! Parameter constants
40           use param1, only: ZERO, UNDEFINED
41     
42     
43     ! Use the error manager for posting error messages.
44     !---------------------------------------------------------------------//
45           use error_manager
46     
47     
48           IMPLICIT NONE
49     
50     
51     ! Passed Arguments:
52     !---------------------------------------------------------------------//
53     ! Total number of solids phases.
54           INTEGER, INTENT(in) :: M_TOT
55     
56     ! Local Variables:
57     !---------------------------------------------------------------------//
58     ! loop/variable indices
59           INTEGER :: BCV, M, BCV_I, IDIM
60           INTEGER :: BCV2, BCV2_I
61     
62     ! Temp logical variables for checking constant npc and statwt specification
63           LOGICAL :: CONST_NPC, CONST_STATWT
64     
65           DOUBLE PRECISION :: BC_ORIG(3), BC_END(3), BC2_ORIG(3) , BC2_END(3)
66           DOUBLE PRECISION :: BC_MIN, BC_MAX, BC2_MIN, BC2_MAX
67     
68           LOGICAL :: SEP_AXIS
69     
70     !......................................................................!
71     
72     
73     ! Initialize the error manager.
74           CALL INIT_ERR_MSG("CHECK_BC_PIC")
75     
76     ! Initialize
77           PIC_BCMI = 0
78           PIC_BCMO = 0
79     
80     ! Loop over all BCs looking for PIC solids inlets/outlets
81           DO BCV = 1, DIMENSION_BC
82     
83              SELECT CASE (TRIM(BC_TYPE(BCV)))
84     
85     ! Determine the number of mass inlets that contain PIC solids.
86              CASE ('MASS_INFLOW')
87                 M_LP: DO M=1,M_TOT
88                    IF(SOLIDS_MODEL(M)=='PIC' .AND.                         &
89                       BC_EP_s(BCV,M) > ZERO) THEN
90                       PIC_BCMI = PIC_BCMI + 1
91                       PIC_BCMI_MAP(PIC_BCMI) = BCV
92                       EXIT M_LP
93                    ENDIF
94                 ENDDO M_LP
95     
96     ! Count the number of pressure outflows.
97              CASE ('P_OUTFLOW')
98                 IF(BC_PO_APPLY_TO_DES(BCV)) then
99                    PIC_BCMO = PIC_BCMO + 1
100                    PIC_BCMO_MAP(PIC_BCMO) = BCV
101                 ENDIF
102     
103     ! Flag CG_MI as an error if PIC solids are present.
104              CASE ('CG_MI')
105                 DO M=1,M_TOT
106                    IF(SOLIDS_MODEL(M)=='PIC') THEN
107                       IF(BC_EP_s(BCV,M) /= UNDEFINED .AND.                 &
108                          BC_EP_s(BCV,M) > ZERO) THEN
109                          WRITE(ERR_MSG,1000) trim(iVar('BC_TYPE',BCV)),    &
110                             'GC_MI'
111                          CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
112                       ENDIF
113                    ENDIF
114                 ENDDO
115     
116              CASE ('CG_PO')
117                 WRITE(ERR_MSG,1000) trim(iVar('BC_TYPE',BCV)), 'GC_PO'
118                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
119     
120              CASE ('MASS_OUTFLOW', 'OUTFLOW', 'P_INFLOW')
121                 WRITE(ERR_MSG,1000) trim(iVar('BC_TYPE',BCV)),             &
122                    trim(BC_TYPE(BCV))
123                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
124     
125              END SELECT
126     
127           ENDDO
128     
129     
130           CALL FINL_ERR_MSG
131     
132     
133     1000  FORMAT('Error 1000: Unsupported boundary condition specified ',  &
134                'with',/'PIC simulation: ',A,' = ',A,/'Please correct the ',&
135                'mfix.dat file.')
136     
137     
138     ! Loop over all MI BC's for data consistency checks
139           DO BCV_I = 1, PIC_BCMI
140     
141     ! Get the user defined BC ID.
142              BCV = PIC_BCMI_MAP(BCV_I)
143     
144              DO M=1,M_TOT
145                 IF(SOLIDS_MODEL(M)=='PIC' .AND.                         &
146                      BC_EP_s(BCV,M) > ZERO) THEN
147                    CONST_NPC    = (BC_PIC_MI_CONST_NPC   (BCV, M) .ne. 0)
148                    CONST_STATWT = (BC_PIC_MI_CONST_STATWT(BCV, M) .ne. ZERO  )
149                    IF(CONST_NPC.and.CONST_STATWT) then
150                       WRITE(ERR_MSG, 1100) BCV, M
151                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
152                    ENDIF
153     
154                    IF(.not.CONST_NPC.and.(.not.CONST_STATWT)) then
155                       WRITE(ERR_MSG, 1101) BCV, M
156                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
157                    ENDIF
158     
159     
160                 ENDIF
161              ENDDO
162     
163     1100     FORMAT('Error 1100: In PIC model for BC # ',i5, &
164                   ' and solid phase # ', i5, /, &
165                   'Non zero Values specified for both ', &
166                   'BC_PIC_MI_CONST_NPC and BC_PIC_MI_CONST_STATWT.', /, &
167                   'Choose between constant number of parcels per cell or ', &
168                   'constant statistical weight', /, &
169                   'See MFIX readme',/'Please correct the data file.')
170     
171     
172     1101     FORMAT('Error 1101: In PIC model for BC # ',i5, &
173                   ' and solid phase # ', i5, /, &
174                   'A non-zero value not specified for ', &
175                   'BC_PIC_MI_CONST_NPC or BC_PIC_MI_CONST_STATWT. ', /, &
176                   'Choose between constant number of parcels per cell or ', &
177                   'constant statistical weight', /, &
178                   'See MFIX readme',/'Please correct the data file.')
179     
180     
181              BC_ORIG(1) = BC_X_W(BCV)
182              BC_ORIG(2) = BC_Y_S(BCV)
183              BC_ORIG(3) = BC_Z_B(BCV)
184              BC_END(1)  = BC_X_E(BCV)
185              BC_END(2)  = BC_Y_N(BCV)
186              BC_END(3)  = BC_Z_T(BCV)
187              BCVTWOLOOP: DO BCV2_I = BCV_I+1, PIC_BCMI
188     
189                 ! Get the user defined BC ID.
190                 BCV2 = PIC_BCMI_MAP(BCV2_I)
191     
192     
193                 BC2_ORIG(1) = BC_X_W(BCV2)
194                 BC2_ORIG(2) = BC_Y_S(BCV2)
195                 BC2_ORIG(3) = BC_Z_B(BCV2)
196                 BC2_END(1)  = BC_X_E(BCV2)
197                 BC2_END(2)  = BC_Y_N(BCV2)
198                 BC2_END(3)  = BC_Z_T(BCV2)
199     
200                 sep_axis  = .false.
201                 DO idim = 1, dimn
202     
203                    bc_min = BC_ORIG(idim)
204                    bc_max = BC_END(idim)
205                    bc2_min = BC2_ORIG(idim)
206                    bc2_max = bc2_END(idim)
207     
208     
209                    if(bc_min.eq.bc_max.and.bc_min.eq.bc2_min.and.bc_min.eq.bc2_max) cycle
210                    !if above is true, then the sep_axis will be true (see below) and
211                    !overlapping bc regions will also be deemed as non-overlapping
212     
213                    !Check for separating axis. If the separating axis exists, then
214                    !the BC regions can't overlap.
215                    !generally equality implies lack of sep_axis, and thus, overlapping
216                    !However, doing so will flag all BC's as overlapping since
217                    !BC's have to share common edges. So here the equality is considered
218                    !as existence of a separating axis, and hence, no overlap
219                    !equality is also considered as separating axis whbch is
220                    if ((bc_min .ge. bc2_max)  .or. (bc_max .le. bc2_min) ) then
221                       sep_axis = .true.
222                       exit
223                    endif
224     
225                 end DO
226     
227                 if(.not.sep_axis) then
228                    !implies the BC regions could not find a separating axis and are thereofre
229                    !overlapping
230     
231                    write(err_msg, 1004) BCV, BCV2
232                    CALL FLUSH_ERR_MSG(footer = .false.)
233     
234                    DO IDIM = 1, DIMN
235     
236                       write(err_msg, 1005) 'BC1', IDIM, BC_ORIG(IDIM), BC_END(IDIM)
237                       CALL FLUSH_ERR_MSG(header = .false., footer = .false.)
238     
239                       write(err_msg, 1005) 'BC2', IDIM, BC2_ORIG(IDIM), BC2_END(IDIM)
240                       CALL FLUSH_ERR_MSG(header = .false., footer = .false.)
241     
242                    ENDDO
243                    write(err_msg, 1006)
244     
245                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., ABORT=.TRUE.)
246     
247                 endif
248              end DO BCVTWOLOOP
249     
250     
251           ENDDO
252     
253     1004  FORMAT('Error # 1004 for PIC Solids MI BC:',/5x, &
254                'Overlapping MI BC regions with non zero', /, &
255                'solids volume fraction  not allowed.', /, &
256                'Overlapping BCs are', 2(2x, i4))
257     
258     1005  FORMAT('Spans of ', A, ' in dir ', I2, /5x, 2(2x, g17.8))
259     
260     
261     1006  Format('Please correct the data file. Exiting.')
262     
263     
264           END SUBROUTINE CHECK_BC_PIC
265