FDS Source: Issue #13645. Do not extract particles still in domain

Author: mcgratta

Source/part.f90

@@ -3032,11 +3032,12 @@ END SUBROUTINE MOVE_IN_GAS
 
 SUBROUTINE VENT_PARTICLE_EXTRACTION(HIT_SOLID,EXTRACT,WALL_INDEX,CFACE_INDEX)
 
+USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES
 LOGICAL, INTENT(OUT) :: EXTRACT
 LOGICAL, INTENT(INOUT) :: HIT_SOLID
 LOGICAL :: SET_EXTRACT
 INTEGER, INTENT(IN), OPTIONAL :: WALL_INDEX,CFACE_INDEX
-INTEGER :: SURF_INDEX
+INTEGER :: SURF_INDEX,NOM,IIO,JJO,KKO
 TYPE (BOUNDARY_PROP1_TYPE), POINTER :: B1
 TYPE (BOUNDARY_PROP2_TYPE), POINTER :: B2
 TYPE (BOUNDARY_COORD_TYPE), POINTER :: BCX
@@ -3065,8 +3066,10 @@ SUBROUTINE VENT_PARTICLE_EXTRACTION(HIT_SOLID,EXTRACT,WALL_INDEX,CFACE_INDEX)
    LP%SPLAT = .TRUE.
 ENDIF
 
-IF ( B1%U_NORMAL>SURFACE(SURF_INDEX)%PARTICLE_EXTRACTION_VELOCITY .OR. &
+IF_EXTRACT: IF ( B1%U_NORMAL>SURFACE(SURF_INDEX)%PARTICLE_EXTRACTION_VELOCITY .OR. &
      (POROUS_FLOOR .AND. BC%Z<ZS .AND. LPC%LIQUID_DROPLET) ) THEN
+   CALL SEARCH_OTHER_MESHES(BC%X,BC%Y,BC%Z,NOM,IIO,JJO,KKO)
+   IF (POROUS_FLOOR .AND. BC%Z<ZS .AND. LPC%LIQUID_DROPLET .AND. NOM>0) EXIT IF_EXTRACT  ! Do not remove particle still in domain
    IF (B1%NODE_INDEX > 0) THEN
       IF (DUCTNODE(B1%NODE_INDEX)%TRANSPORT_PARTICLES) THEN
          SELECT CASE (BCX%IOR)
@@ -3147,7 +3150,7 @@ SUBROUTINE VENT_PARTICLE_EXTRACTION(HIT_SOLID,EXTRACT,WALL_INDEX,CFACE_INDEX)
       BC%X=-1.E6_EB
       EXTRACT = .TRUE.
    ENDIF
-ENDIF
+ENDIF IF_EXTRACT
 
 END SUBROUTINE VENT_PARTICLE_EXTRACTION