File: N:\mfix\model\des\mass_outflow_dem.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: MASS_OUTFLOW_DEM                                        !
4     !  Author: J.Musser                                   Date: 13-Jul-09  !
5     !                                                                      !
6     !  Purpose:  This routine fills in the necessary information for new   !
7     !  particles entereing the system.                                     !
8     !                                                                      !
9     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
10           SUBROUTINE MASS_OUTFLOW_DEM(FORCE_NSEARCH)
11     
12           use derived_types, only: dg_pic
13           use discretelement
14           use des_bc
15           use bc
16           use functions
17           use param1, only: zero
18     
19           use mpi_utility, only: GLOBAL_ALL_OR
20     
21           implicit none
22     
23           LOGICAL, INTENT(INOUT) :: FORCE_NSEARCH
24     
25           INTEGER :: IJK
26           INTEGER :: LC, LP, NP, M
27           INTEGER :: BCV, BCV_I, IDX
28     
29           DOUBLE PRECISION :: SGN
30           DOUBLE PRECISION :: DIST
31     
32           LOGICAL :: FREEZE_VEL
33           DOUBLE PRECISION :: FREEZE(3)
34     
35           DO BCV_I = 1, DEM_BCMO
36     
37              BCV = DEM_BCMO_MAP(BCV_I)
38     
39              FREEZE_VEL = (BC_TYPE_ENUM(BCV) /= MASS_OUTFLOW)
40     
41              SELECT CASE (BC_PLANE(BCV))
42              CASE('N'); FREEZE = (/0.0d0, 1.0d0, 0.0d0/); IDX=2; SGN=-1.0d0
43              CASE('S'); FREEZE = (/0.0d0, 1.0d0, 0.0d0/); IDX=2; SGN= 1.0d0
44              CASE('E'); FREEZE = (/1.0d0, 0.0d0, 0.0d0/); IDX=1; SGN=-1.0d0
45              CASE('W'); FREEZE = (/1.0d0, 0.0d0, 0.0d0/); IDX=1; SGN= 1.0d0
46              CASE('T'); FREEZE = (/0.0d0, 0.0d0, 1.0d0/); IDX=3; SGN=-1.0d0
47              CASE('B'); FREEZE = (/0.0d0, 0.0d0, 1.0d0/); IDX=3; SGN= 1.0d0
48              END SELECT
49     
50              DO LC=DEM_BCMO_IJKSTART(BCV_I), DEM_BCMO_IJKEND(BCV_I)
51                 IJK = DEM_BCMO_IJK(LC)
52                 DO LP= 1,DG_PIC(IJK)%ISIZE
53     
54                    NP = DG_PIC(IJK)%P(LP)
55     
56                    IF(IS_NONEXISTENT(NP)) CYCLE
57                    IF(IS_ANY_GHOST(NP)) CYCLE
58                    IF(IS_ENTERING(NP)) CYCLE
59     
60                    SELECT CASE (BC_PLANE(BCV))
61                    CASE('S'); DIST = YN(BC_J_s(BCV)-1) - DES_POS_NEW(NP,2)
62                    CASE('N'); DIST = DES_POS_NEW(NP,2) - YN(BC_J_s(BCV))
63                    CASE('W'); DIST = XE(BC_I_w(BCV)-1) - DES_POS_NEW(NP,1)
64                    CASE('E'); DIST = DES_POS_NEW(NP,1) - XE(BC_I_w(BCV))
65                    CASE('B'); DIST = ZT(BC_K_b(BCV)-1) - DES_POS_NEW(NP,3)
66                    CASE('T'); DIST = DES_POS_NEW(NP,3) - ZT(BC_K_b(BCV))
67                    END SELECT
68     
69     ! The particle is still inside the domain
70                    IF(DIST > DES_RADIUS(NP)) THEN
71                       CALL SET_NORMAL(NP)
72     
73     ! Check if the particle is crossing over the outlet plane.
74                    ELSEIF(DIST > ZERO) THEN
75     
76     ! The velocity is 'frozen' normal to the outflow plane. This approach
77     ! is strict because complex BCs (via STLs) can let particles pop through
78     ! the wall along the outlet.
79                       IF(FREEZE_VEL) THEN
80     ! Only 'freeze' a particle's velocy if it has it moving out of the
81     ! domain. Otherwise, particles flagged as exiting but moving away from
82     ! the BC appear to moon-walk through the domain until it crashes.
83                          IF(DES_VEL_NEW(NP,IDX)*SGN > 0.0d0) THEN
84                             DES_VEL_NEW(NP,:) = DES_VEL_NEW(NP,:)*FREEZE(:)
85     ! Set the flags for an exiting particle.
86                             IF (IS_GHOST(NP)) THEN
87                                CALL SET_EXITING_GHOST(NP)
88                             ELSE
89                                CALL SET_EXITING(NP)
90                             ENDIF
91                          ENDIF
92     
93     ! The user specified velocity is applied to the exiting particle. This
94     ! only applies to mass outflows where the speed at which particles
95     ! exit needs to be controled.
96                       ELSE
97                          M = PIJK(NP,5)
98                          DES_VEL_NEW(NP,1) = BC_U_s(BCV,M)
99                          DES_VEL_NEW(NP,2) = BC_V_s(BCV,M)
100                          DES_VEL_NEW(NP,3) = BC_W_s(BCV,M)
101     ! Set the flags for an exiting particle.
102                          IF (IS_GHOST(NP)) THEN
103                             CALL SET_EXITING_GHOST(NP)
104                          ELSE
105                             CALL SET_EXITING(NP)
106                          ENDIF
107                       ENDIF
108     
109     ! Ladies and gentlemen, the particle has left the building.
110                    ELSE
111                       CALL DELETE_PARTICLE(NP)
112                       FORCE_NSEARCH = .TRUE.
113                    ENDIF
114     
115                 ENDDO
116              ENDDO
117           ENDDO
118     
119     ! Sync the search flag across all processes.
120     !      CALL GLOBAL_ALL_OR(FORCE_NSEARCH)
121     
122           RETURN
123           END SUBROUTINE MASS_OUTFLOW_DEM
124     
125     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
126     !                                                                      !
127     !  Subroutine: DELETE_PARTICLE                                         !
128     !  Author: J.Musser                                   Date: 13-Jul-09  !
129     !                                                                      !
130     !  Purpose:  This routine is used to check if a new particle has fully !
131     !  entered the domain.  If so, the flag classifying the particle as new!
132     !  is removed, allowing the particle to respond to contact forces from !
133     !  walls and other particles.                                          !
134     !                                                                      !
135     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
136           SUBROUTINE DELETE_PARTICLE(NP)
137     
138           USE compar
139           USE constant
140           USE des_bc
141           USE discretelement
142           USE funits
143           USE geometry
144           USE indices
145           USE param1
146           USE physprop
147           USE functions
148     
149           IMPLICIT NONE
150     
151           INTEGER, INTENT(IN) :: NP
152     
153     !-----------------------------------------------
154     ! Local variables
155     !-----------------------------------------------
156     
157           iGLOBAL_ID(NP) = -1
158           CALL SET_NONEXISTENT(NP)
159     
160           DES_POS_NEW(NP,:) = ZERO
161           DES_VEL_NEW(NP,:) = ZERO
162           OMEGA_NEW(NP,:) = ZERO
163     
164           IF(PARTICLE_ORIENTATION) ORIENTATION(1:3,NP) = INIT_ORIENTATION
165     
166           IF (DO_OLD) THEN
167              DES_POS_OLD(NP,:) = ZERO
168              DES_VEL_OLD(NP,:) = ZERO
169              OMEGA_OLD(NP,:) = ZERO
170           ENDIF
171     
172           DES_RADIUS(NP) = ZERO
173           PMASS(NP) = HUGE(0.0)
174           PVOL(NP) = HUGE(0.0)
175           RO_Sol(NP) = ZERO
176           OMOI(NP) = ZERO
177     
178           FC(NP,:) = ZERO
179           TOW(NP,:) = ZERO
180     
181           PPOS(NP,:) = ZERO
182     
183           WALL_COLLISION_FACET_ID(:,NP) = -1
184     
185           PIP = PIP - 1
186     
187           RETURN
188           END SUBROUTINE DELETE_PARTICLE
189