set_bc_pic

File: N:\mfix\model\des\pic\set_bc_pic_mi.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: SET_BC_PIC_MI                                           !
4     !  Author: R. Garg                                    Date: 11-Jun-14  !
5     !                                                                      !
6     !  Purpose:                                                            !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE SET_BC_PIC_MI
10     
11     !-----------------------------------------------
12     ! Modules
13     !-----------------------------------------------
14           USE compar
15           USE constant
16           USE bc
17           USE pic_bc
18           USE discretelement
19           USE funits
20           USE geometry
21           USE indices
22           USE param
23           USE param1
24           USE physprop
25           USE run
26     
27           USE error_manager
28           USE toleranc
29     
30           IMPLICIT NONE
31     
32           INTEGER :: BCV
33     
34     !-----------------------------------------------
35     ! Local variables
36     !-----------------------------------------------
37           INTEGER BCV_I      ! BC loop counter
38           INTEGER M           ! Mass phase loop counter
39           INTEGER PHASE_CNT        ! Number of solid phases at bc
40           INTEGER PHASE_LIST(DIM_M) ! List of phases used in current bc
41     
42     ! the number of particles injected in a solids time step
43           DOUBLE PRECISION MAX_DIA ! Max diameter of incoming particles at bc
44     
45           LOGICAL, parameter :: setDBG = .FALSE.
46           LOGICAL :: dFlag
47     
48     !-----------------------------------------------
49     
50           CALL INIT_ERR_MSG("SET_BC_PIC_MI")
51     
52           dFlag = (DMP_LOG .AND. setDBG)
53           if(dFlag) write(*,"(2/,2x,'PIC inlet count: ',I4)") PIC_BCMI
54     
55           PIC_BCMI_INCL_CUTCELL(:) = .false.
56     
57     ! Loop over BCs that are flagged for PIC mass inflow.
58           DO BCV_I = 1, PIC_BCMI
59     
60     ! Get the user defined BC ID.
61              BCV = PIC_BCMI_MAP(BCV_I)
62     
63              PIC_BCMI_OFFSET (BCV_I,:) = 1
64              PIC_BCMI_NORMDIR(BCV_I,:) = 0
65     
66              SELECT CASE(BC_PLANE(BCV))
67              CASE('E'); PIC_BCMI_NORMDIR(BCV_I,1) = 1
68              CASE('W')
69                 PIC_BCMI_NORMDIR(BCV_I,1) = -1
70                 PIC_BCMI_OFFSET (BCV_I,1) = 0
71     
72              CASE('N'); PIC_BCMI_NORMDIR(BCV_I,2) = 1
73              CASE('S')
74                 PIC_BCMI_NORMDIR(BCV_I,2) = -1
75                 PIC_BCMI_OFFSET (BCV_I,2) = 0
76     
77              CASE('T'); PIC_BCMI_NORMDIR(BCV_I,3) = 1
78              CASE('B')
79                 PIC_BCMI_NORMDIR(BCV_I,3) = -1
80                 PIC_BCMI_OFFSET (BCV_I,3) =  0
81              END SELECT
82     
83              if(dFlag) write(*,"(2/,'Setting PIC_MI:',I3)") BCV_I
84     
85     ! The number of mass phases at this inlet.  While a system may be
86     ! polydisperse, the inlet could consist of a single mass phase
87              PHASE_CNT = 0
88     ! The mass phase indices of incoming particles at this inlet
89              PHASE_LIST(:) = -1
90     ! The max diameter of incoming particles at this inlet
91              MAX_DIA = ZERO
92     
93     ! Determine if the inlet is mono or polydisperse
94              DO M=1, DES_MMAX+MMAX
95                 IF(SOLIDS_MODEL(M) /= 'PIC') CYCLE
96                 IF(BC_ROP_s(BCV,M) == UNDEFINED) CYCLE
97                 IF(COMPARE(BC_ROP_s(BCV,M),ZERO)) CYCLE
98                 PHASE_CNT = PHASE_CNT + 1
99                 PHASE_LIST(PHASE_CNT) = M
100                 MAX_DIA = MAX(MAX_DIA,D_P0(M))
101              ENDDO
102     
103           ENDDO
104     
105           CALL SET_PIC_BCMI_IJK
106     
107           CALL FINL_ERR_MSG
108     
109     
110           RETURN
111           END SUBROUTINE SET_BC_PIC_MI
112     
113     
114     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
115     !                                                                      !
116     !  Subroutine: SET_BC_PIC                                              !
117     !  Author: R. Garg                                    Date: 11-Jun-14  !
118     !                                                                      !
119     !  Purpose: Check the data provided for the des mass inflow boundary   !
120     !  condition and flag errors if the data is improper.  This module is  !
121     !  also used to convert the provided information into the format       !
122     !  necessary for the dependent subrountines to function properly.      !
123     !                                                                      !
124     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
125           SUBROUTINE SET_PIC_BCMI_IJK
126     
127     ! Modules
128     !---------------------------------------------------------------------//
129           use bc, only: BC_PLANE
130           use bc, only: BC_I_w, BC_I_e, BC_J_s, BC_J_n, BC_K_b, BC_K_t
131           USE cutcell, only: CUT_CELL_AT
132           USE discretelement, only : DES_MMAX
133           use error_manager
134           use functions
135           use funits, only: DMP_LOG
136           use mpi_utility
137           use param, only: dim_m
138           use pic_bc, only: PIC_BCMI, PIC_BCMI_MAP, PIC_BCMI_IJK
139           use pic_bc, only: PIC_BCMI_IJKSTART, PIC_BCMI_IJKEND
140           use pic_bc, only: pic_bcmi_cnp
141           use pic_bc, only: pic_bcmi_rnp
142           use pic_bc, only: PIC_BCMI_INCL_CUTCELL
143           IMPLICIT NONE
144     
145     ! Local variables
146     !---------------------------------------------------------------------//
147           INTEGER, ALLOCATABLE :: LOC_PIC_BCMI_IJK(:)
148           INTEGER :: BCV, BCV_I
149           INTEGER :: LC
150           INTEGER :: MAX_CELLS
151           INTEGER :: BND1, BND2
152           LOGICAL, parameter :: setDBG = .false.
153           LOGICAL :: dFlag
154           INTEGER :: I,J,K,IJK
155           INTEGER :: I_w, I_e, J_s, J_n, K_b, K_t
156     !......................................................................!
157     
158     
159           CALL INIT_ERR_MSG("SET_PIC_BCMI_IJK")
160     
161           dFlag = (DMP_LOG .AND. setDBG)
162     
163           if(dFlag) write(*,"(2/,2x,'From: SET_PIC_BCMI_IJK')")
164     
165     ! Loop over all inflow BCs to get an approximate count of the number
166     ! of fluid cells that are adjacent to them.
167           MAX_CELLS = 0
168           DO BCV_I = 1, PIC_BCMI
169              BCV = PIC_BCMI_MAP(BCV_I)
170     
171     ! Set the search area a little bigger than the inlet area.
172              if(dFlag) WRITE(*,"(/2x,'Adding cells for BCV: ',I3)") BCV
173              SELECT CASE (BC_PLANE(BCV))
174              CASE('N','S')
175                 BND1 = min(BC_I_e(BCV)+1,IMAX1) - max(BC_I_w(BCV)-1,IMIN1)
176                 BND2 = min(BC_K_t(BCV)+1,KMAX1) - max(BC_K_b(BCV)-1,KMIN1)
177     
178              CASE('E','W')
179                 BND1 = min(BC_J_n(BCV)+1,JMAX1) - max(BC_J_s(BCV)-1,JMIN1)
180                 BND2 = min(BC_K_t(BCV)+1,KMAX1) - max(BC_K_b(BCV)-1,KMIN1)
181     
182              CASE('T','B')
183                 BND1 = min(BC_I_e(BCV)+1,IMAX1) - max(BC_I_w(BCV)-1,IMIN1)
184                 BND2 = min(BC_J_n(BCV)+1,JMAX1) - max(BC_J_s(BCV)-1,JMIN1)
185              END SELECT
186     
187              MAX_CELLS = MAX_CELLS + (BND1 + 1)*(BND2 + 1)
188              if(dFlag) WRITE(*,"(4x,'Plane:   ',A)") BC_PLANE(BCV)
189              if(dFlag) WRITE(*,"(4x,'Cells: ', I8)") (BND1+1)*(BND2+1)
190           ENDDO
191     
192           if(dFlag) write(*,"(2x,'Max Cells: ',I8)") MAX_CELLS
193     
194     ! Allocate an array to hold the IJK values. This array should be
195     ! more than enough to store all the IJKs.
196           allocate( LOC_PIC_BCMI_IJK(MAX_CELLS) )
197     
198     
199     ! Loop over the IJKs for each BC and store only the IJKs that you
200     ! own as well as the start/end array positions for each BC.
201           LC = 1
202           DO BCV_I = 1, PIC_BCMI
203     
204              PIC_BCMI_IJKSTART(BCV_I) = LC
205              BCV = PIC_BCMI_MAP(BCV_I)
206     
207              if(dFlag) write(*,"(/2x,'Searching for fluid cells:',I3)") BCV
208     
209              I_w = max(BC_I_w(BCV),IMIN1); I_e = min(BC_I_e(BCV),IMAX1)
210              J_s = max(BC_J_s(BCV),JMIN1); J_n = min(BC_J_n(BCV),JMAX1)
211              K_b = max(BC_K_b(BCV),KMIN1); K_t = min(BC_K_t(BCV),KMAX1)
212     
213     ! Depending on the flow plane, the 'common' index needs set to reference
214     ! the fluid cell.
215              SELECT CASE (BC_PLANE(BCV))
216              CASE('N'); J_s = BC_J_s(BCV)+1;   J_n = BC_J_n(BCV)+1
217              CASE('S'); J_s = BC_J_s(BCV)-1;   J_n = BC_J_n(BCV)-1
218              CASE('E'); I_w = BC_I_w(BCV)+1;   I_e = BC_I_e(BCV)+1
219              CASE('W'); I_w = BC_I_w(BCV)-1;   I_e = BC_I_e(BCV)-1
220              CASE('T'); K_b = BC_K_b(BCV)+1;   K_t = BC_K_t(BCV)+1
221              CASE('B'); K_b = BC_K_b(BCV)-1;   K_t = BC_K_t(BCV)-1
222              END SELECT
223     
224              if(dFlag) then
225                 write(*,"(4x,'Search bounds: ')")
226                 write(*,"(6x,'I_w/I_e:',2(2x,I6))") I_w, I_e
227                 write(*,"(6x,'J_s/J_n:',2(2x,I6))") J_s, J_n
228                 write(*,"(6x,'K_b/K_t:',2(2x,I6))") K_b, K_t
229              endif
230     
231     ! Store the IJKs.
232              DO K = K_b, K_t
233              DO J = J_s, J_n
234              DO I = I_w, I_e
235     ! Skip cells that this rank does not own or are considered dead.
236     ! Limit only to fluid cells
237                 IF(.NOT.IS_ON_myPE_wobnd(I,J,K)) CYCLE
238                 IJK = FUNIJK(I,J,K)
239     
240                 IF(.NOT.FLUID_AT(IJK)) CYCLE
241     
242                 !do not include this cell if the IO BC has been set to
243                 !not include cutcells
244                 IF(CUT_CELL_AT(IJK).AND.(.NOT.PIC_BCMI_INCL_CUTCELL(BCV_I))) CYCLE
245                 LOC_PIC_BCMI_IJK(LC) = IJK
246                 LC = LC+1
247              ENDDO
248              ENDDO
249              ENDDO
250     
251              PIC_BCMI_IJKEND(BCV_I) = LC-1
252     
253              IF(dFLAG) write(*,1111) BCV, BCV_I,                           &
254                 PIC_BCMI_IJKSTART(BCV_I), PIC_BCMI_IJKEND(BCV_I)
255     
256           ENDDO
257     
258      1111 FORMAT(/2x,'PIC Mass Inflow:',/4x,'BC:',I4,3x,'MAP:',I4,         &
259              /4x,'IJKSTART:',I6,/4x,'IJKEND:  ',I6)
260     
261     
262     ! Allocate the global store arrary array. This changes across MPI ranks.
263           IF(LC > 1) THEN
264              allocate( PIC_BCMI_IJK(LC-1) )
265              allocate(pic_bcmi_cnp(LC-1, DIM_M))
266              allocate(pic_bcmi_rnp(LC-1, DIM_M))
267     
268              PIC_BCMI_IJK(1:LC-1) = LOC_PIC_BCMI_IJK(1:LC-1)
269     
270              pic_bcmi_cnp(1:LC-1,:) = 0.d0
271              pic_bcmi_rnp(1:LC-1,:) = 0.d0
272           ELSE
273              allocate( PIC_BCMI_IJK(1) )
274              allocate(pic_bcmi_cnp(1,1))
275              allocate(pic_bcmi_rnp(1,1))
276     
277              PIC_BCMI_IJK(1) = LOC_PIC_BCMI_IJK(1)
278           ENDIF
279     
280           deallocate(LOC_PIC_BCMI_IJK)
281     
282           CALL FINL_ERR_MSG
283     
284           RETURN
285           END SUBROUTINE SET_PIC_BCMI_IJK
286