mass_outflow_pic.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: Mass_OUTFLOW_PIC                                        !
!  Author: R. Garg                                   Date: 23-Jun-14   !
!                                                                      !
!  Purpose:  Routine to delete out of domain parcels for PIC           !
!  implementation                                                      !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE mass_outflow_pic

      USE error_manager
      USE mpi_utility
      use bc
      use derived_types, only: pic
      use discretelement
      use functions
      use pic_bc

      implicit none

      INTEGER :: IJK
      INTEGER :: LC, LP, NP
      INTEGER :: BCV, BCV_I

      DOUBLE PRECISION :: DIST


      DO bcv_i = 1, pic_bcmo

         bcv = pic_bcmo_map(bcv_i)

         DO lc=pic_bcmo_ijkstart(bcv_i), pic_bcmo_ijkend(bcv_i)
            ijk = pic_bcmo_ijk(lc)
            DO lp= 1,pinc(ijk)

               np = pic(ijk)%p(lp)
               IF(is_nonexistent(np)) cycle

               SELECT CASE (bc_plane(bcv))
               CASE('S'); dist = yn(bc_j_s(bcv)-1) - des_pos_new(np,2)
               CASE('N'); dist = des_pos_new(np,2) - yn(bc_j_s(bcv))
               CASE('W'); dist = xe(bc_i_w(bcv)-1) - des_pos_new(np,1)
               CASE('E'); dist = des_pos_new(np,1) - xe(bc_i_w(bcv))
               CASE('B'); dist = zt(bc_k_b(bcv)-1) - des_pos_new(np,3)
               CASE('T'); dist = des_pos_new(np,3) - zt(bc_k_b(bcv))
               END SELECT

               IF(dist < des_radius(np)) CALL delete_parcel(np)

            ENDDO
         ENDDO
      ENDDO


      RETURN
      END SUBROUTINE mass_outflow_pic




!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: DELETE_PARCEL                                           !
!  Author: R. Garg                                    Date: 23-Jun-14  !
!                                                                      !
!  Purpose:  Routine to delete parcel                                  !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE delete_parcel(NP)

      USE compar
      USE constant
      USE des_bc
      USE discretelement
      USE funits
      USE geometry
      USE indices
      USE param1
      USE physprop
      USE mfix_pic
      USE functions

      IMPLICIT NONE

      INTEGER, INTENT(IN) :: NP

      CALL set_nonexistent(np)

      des_pos_old(np,:) = zero
      des_pos_new(np,:) = zero
      des_vel_old(np,:) = zero
      des_vel_new(np,:) = zero
      des_radius(np) = zero
      pmass(np) = zero
      pvol(np) = zero
      ro_sol(np) = zero
      omoi(np) = zero

      des_stat_wt(np) = zero

      fc(np,:) = zero

      pip = pip - 1

      RETURN
      END SUBROUTINE delete_parcel