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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: Mass_OUTFLOW_PIC                                        !
4     !  Author: R. Garg                                   Date: 23-Jun-14   !
5     !                                                                      !
6     !  Purpose:  Routine to delete out of domain parcels for PIC           !
7     !  implementation                                                      !
8     !                                                                      !
9     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
10           SUBROUTINE MASS_OUTFLOW_PIC
11     
12           USE error_manager
13           USE mpi_utility
14           use bc
15           use derived_types, only: pic
16           use discretelement
17           use functions
18           use pic_bc
19     
20           implicit none
21     
22           INTEGER :: IJK
23           INTEGER :: LC, LP, NP
24           INTEGER :: BCV, BCV_I
25     
26           DOUBLE PRECISION :: DIST
27     
28     
29           DO BCV_I = 1, PIC_BCMO
30     
31              BCV = PIC_BCMO_MAP(BCV_I)
32     
33              DO LC=PIC_BCMO_IJKSTART(BCV_I), PIC_BCMO_IJKEND(BCV_I)
34                 IJK = PIC_BCMO_IJK(LC)
35                 DO LP= 1,PINC(IJK)
36     
37                    NP = PIC(IJK)%p(LP)
38                    IF(IS_NONEXISTENT(NP)) CYCLE
39     
40                    SELECT CASE (BC_PLANE(BCV))
41                    CASE('S'); DIST = YN(BC_J_s(BCV)-1) - DES_POS_NEW(NP,2)
42                    CASE('N'); DIST = DES_POS_NEW(NP,2) - YN(BC_J_s(BCV))
43                    CASE('W'); DIST = XE(BC_I_w(BCV)-1) - DES_POS_NEW(NP,1)
44                    CASE('E'); DIST = DES_POS_NEW(NP,1) - XE(BC_I_w(BCV))
45                    CASE('B'); DIST = ZT(BC_K_b(BCV)-1) - DES_POS_NEW(NP,3)
46                    CASE('T'); DIST = DES_POS_NEW(NP,3) - ZT(BC_K_b(BCV))
47                    END SELECT
48     
49                    IF(DIST < DES_RADIUS(NP)) CALL DELETE_PARCEL(NP)
50     
51                 ENDDO
52              ENDDO
53           ENDDO
54     
55     
56           RETURN
57           END SUBROUTINE MASS_OUTFLOW_PIC
58     
59     
60     
61     
62     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
63     !                                                                      !
64     !  Subroutine: DELETE_PARCEL                                           !
65     !  Author: R. Garg                                    Date: 23-Jun-14  !
66     !                                                                      !
67     !  Purpose:  Routine to delete parcel                                  !
68     !                                                                      !
69     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
70           SUBROUTINE DELETE_PARCEL(NP)
71     
72           USE compar
73           USE constant
74           USE des_bc
75           USE discretelement
76           USE funits
77           USE geometry
78           USE indices
79           USE param1
80           USE physprop
81           USE mfix_pic
82           USE functions
83     
84           IMPLICIT NONE
85     
86           INTEGER, INTENT(IN) :: NP
87     
88           CALL SET_NONEXISTENT(NP)
89     
90           DES_POS_OLD(NP,:) = ZERO
91           DES_POS_NEW(NP,:) = ZERO
92           DES_VEL_OLD(NP,:) = ZERO
93           DES_VEL_NEW(NP,:) = ZERO
94           DES_RADIUS(NP) = ZERO
95           PMASS(NP) = ZERO
96           PVOL(NP) = ZERO
97           RO_Sol(NP) = ZERO
98           OMOI(NP) = ZERO
99     
100           DES_STAT_WT(NP) = ZERO
101     
102           FC(NP,:) = ZERO
103     
104           PIP = PIP - 1
105     
106           RETURN
107           END SUBROUTINE DELETE_PARCEL
108