set_bc_pic

File: /nfs/home/0/users/jenkins/mfix.git/model/des/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(DES_MMAX) ! 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,:) = ZERO
65     
66              SELECT CASE(BC_PLANE(BCV))
67              CASE('E'); PIC_BCMI_NORMDIR(BCV_I,1) =  ONE
68              CASE('W')
69                 PIC_BCMI_NORMDIR(BCV_I,1) = -ONE
70                 PIC_BCMI_OFFSET (BCV_I,1) = 0
71     
72              CASE('N'); PIC_BCMI_NORMDIR(BCV_I,2) =  ONE
73              CASE('S')
74                 PIC_BCMI_NORMDIR(BCV_I,2) = -ONE
75                 PIC_BCMI_OFFSET (BCV_I,2) = 0
76     
77              CASE('T'); PIC_BCMI_NORMDIR(BCV_I,3) =  ONE
78              CASE('B')
79                 PIC_BCMI_NORMDIR(BCV_I,3) = -ONE
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
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,DES_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           use bc, only: BC_PLANE
127           use bc, only: BC_I_w, BC_I_e, BC_J_s, BC_J_n, BC_K_b, BC_K_t
128     
129           use pic_bc, only: PIC_BCMI, PIC_BCMI_MAP, PIC_BCMI_IJK
130           use pic_bc, only: PIC_BCMI_IJKSTART, PIC_BCMI_IJKEND
131           use pic_bc, only: pic_bcmi_cnp
132           use pic_bc, only: pic_bcmi_rnp
133           use pic_bc, only: PIC_BCMI_INCL_CUTCELL
134           USE discretelement, only : DES_MMAX
135           use funits, only: DMP_LOG
136     
137           USE cutcell, only: CUT_CELL_AT
138     
139           use mpi_utility
140           use error_manager
141           use functions
142     
143           IMPLICIT NONE
144     
145           INTEGER, ALLOCATABLE :: LOC_PIC_BCMI_IJK(:)
146     
147           INTEGER :: BCV, BCV_I
148     
149           INTEGER :: LC
150     
151           INTEGER :: MAX_CELLS
152     
153           INTEGER :: BND1, BND2
154     
155           LOGICAL, parameter :: setDBG = .false.
156           LOGICAL :: dFlag
157     
158           INTEGER :: I,J,K,IJK
159           INTEGER :: I_w, I_e, J_s, J_n, K_b, K_t
160     
161           CALL INIT_ERR_MSG("SET_PIC_BCMI_IJK")
162     
163           dFlag = (DMP_LOG .AND. setDBG)
164     
165           if(dFlag) write(*,"(2/,2x,'From: SET_PIC_BCMI_IJK')")
166     
167     
168     
169     ! Loop over all inflow BCs to get an approximate count of the number
170     ! of fluid cells that are adjacent to them.
171           MAX_CELLS = 0
172           DO BCV_I = 1, PIC_BCMI
173              BCV = PIC_BCMI_MAP(BCV_I)
174     
175     ! Set the search area a little bigger than the inlet area.
176              if(dFlag) WRITE(*,"(/2x,'Adding cells for BCV: ',I3)") BCV
177              SELECT CASE (BC_PLANE(BCV))
178              CASE('N','S')
179                 BND1 = min(BC_I_e(BCV)+1,IMAX1) - max(BC_I_w(BCV)-1,IMIN1)
180                 BND2 = min(BC_K_t(BCV)+1,KMAX1) - max(BC_K_b(BCV)-1,KMIN1)
181     
182              CASE('E','W')
183                 BND1 = min(BC_J_n(BCV)+1,JMAX1) - max(BC_J_s(BCV)-1,JMIN1)
184                 BND2 = min(BC_K_t(BCV)+1,KMAX1) - max(BC_K_b(BCV)-1,KMIN1)
185     
186              CASE('T','B')
187                 BND1 = min(BC_I_e(BCV)+1,IMAX1) - max(BC_I_w(BCV)-1,IMIN1)
188                 BND2 = min(BC_J_n(BCV)+1,JMAX1) - max(BC_J_s(BCV)-1,JMIN1)
189              END SELECT
190     
191              MAX_CELLS = MAX_CELLS + (BND1 + 1)*(BND2 + 1)
192              if(dFlag) WRITE(*,"(4x,'Plane:   ',A)") BC_PLANE(BCV)
193              if(dFlag) WRITE(*,"(4x,'Cells: ', I8)") (BND1+1)*(BND2+1)
194           ENDDO
195     
196           if(dFlag) write(*,"(2x,'Max Cells: ',I8)") MAX_CELLS
197     
198     ! Allocate an array to hold the IJK values. This array should be
199     ! more than enough to store all the IJKs.
200           allocate( LOC_PIC_BCMI_IJK(MAX_CELLS) )
201     
202     
203     ! Loop over the IJKs for each BC and store only the IJKs that you
204     ! own as well as the start/end array positions for each BC.
205           LC = 1
206           DO BCV_I = 1, PIC_BCMI
207     
208              PIC_BCMI_IJKSTART(BCV_I) = LC
209              BCV = PIC_BCMI_MAP(BCV_I)
210     
211              if(dFlag) write(*,"(/2x,'Searching for fluid cells:',I3)") BCV
212     
213              I_w = max(BC_I_w(BCV),IMIN1); I_e = min(BC_I_e(BCV),IMAX1)
214              J_s = max(BC_J_s(BCV),JMIN1); J_n = min(BC_J_n(BCV),JMAX1)
215              K_b = max(BC_K_b(BCV),KMIN1); K_t = min(BC_K_t(BCV),KMAX1)
216     
217     ! Depending on the flow plane, the 'common' index needs set to reference
218     ! the fluid cell.
219              SELECT CASE (BC_PLANE(BCV))
220              CASE('N'); J_s = BC_J_s(BCV)+1;   J_n = BC_J_n(BCV)+1
221              CASE('S'); J_s = BC_J_s(BCV)-1;   J_n = BC_J_n(BCV)-1
222              CASE('E'); I_w = BC_I_w(BCV)+1;   I_e = BC_I_e(BCV)+1
223              CASE('W'); I_w = BC_I_w(BCV)-1;   I_e = BC_I_e(BCV)-1
224              CASE('T'); K_b = BC_K_b(BCV)+1;   K_t = BC_K_t(BCV)+1
225              CASE('B'); K_b = BC_K_b(BCV)-1;   K_t = BC_K_t(BCV)-1
226              END SELECT
227     
228              if(dFlag) then
229                 write(*,"(4x,'Search bounds: ')")
230                 write(*,"(6x,'I_w/I_e:',2(2x,I6))") I_w, I_e
231                 write(*,"(6x,'J_s/J_n:',2(2x,I6))") J_s, J_n
232                 write(*,"(6x,'K_b/K_t:',2(2x,I6))") K_b, K_t
233              endif
234     
235     ! Store the IJKs.
236              DO K = K_b, K_t
237              DO J = J_s, J_n
238              DO I = I_w, I_e
239     ! Skip cells that this rank does not own or are considered dead.
240     ! Limit only to fluid cells
241                 IF(.NOT.IS_ON_myPE_wobnd(I,J,K)) CYCLE
242                 IJK = FUNIJK(I,J,K)
243     
244                 IF(.NOT.FLUID_AT(IJK)) CYCLE
245     
246                 !do not include this cell if the IO BC has been set to
247                 !not include cutcells
248                 IF(CUT_CELL_AT(IJK).AND.(.NOT.PIC_BCMI_INCL_CUTCELL(BCV_I))) CYCLE
249                 LOC_PIC_BCMI_IJK(LC) = IJK
250                 LC = LC+1
251              ENDDO
252              ENDDO
253              ENDDO
254     
255              PIC_BCMI_IJKEND(BCV_I) = LC-1
256     
257              IF(dFLAG) write(*,1111) BCV, BCV_I,                           &
258                 PIC_BCMI_IJKSTART(BCV_I), PIC_BCMI_IJKEND(BCV_I)
259     
260           ENDDO
261     
262      1111 FORMAT(/2x,'PIC Mass Inflow:',/4x,'BC:',I4,3x,'MAP:',I4,         &
263              /4x,'IJKSTART:',I6,/4x,'IJKEND:  ',I6)
264     
265     
266     ! Allocate the global store arrary array. This changes across MPI ranks.
267           IF(LC > 1) THEN
268              allocate( PIC_BCMI_IJK(LC-1) )
269              allocate(pic_bcmi_cnp(LC-1, DES_MMAX))
270              allocate(pic_bcmi_rnp(LC-1, DES_MMAX))
271     
272              PIC_BCMI_IJK(1:LC-1) = LOC_PIC_BCMI_IJK(1:LC-1)
273     
274              pic_bcmi_cnp(1:LC-1,:) = 0.d0
275              pic_bcmi_rnp(1:LC-1,:) = 0.d0
276           ELSE
277              allocate( PIC_BCMI_IJK(1) )
278              allocate(pic_bcmi_cnp(1,1))
279              allocate(pic_bcmi_rnp(1,1))
280     
281              PIC_BCMI_IJK(1) = LOC_PIC_BCMI_IJK(1)
282           ENDIF
283     
284           deallocate(LOC_PIC_BCMI_IJK)
285     
286     
287           CALL FINL_ERR_MSG
288     
289     
290           RETURN
291           END SUBROUTINE SET_PIC_BCMI_IJK
292