set_bc_pic_mi.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_BC_PIC_MI                                           !
!  Author: R. Garg                                    Date: 11-Jun-14  !
!                                                                      !
!  Purpose:                                                            !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_bc_pic_mi

!-----------------------------------------------
! Modules
!-----------------------------------------------
      USE compar
      USE constant
      USE bc
      USE pic_bc
      USE discretelement
      USE funits
      USE geometry
      USE indices
      USE param
      USE param1
      USE physprop
      USE run

      USE error_manager
      USE toleranc

      IMPLICIT NONE

      INTEGER :: BCV

!-----------------------------------------------
! Local variables
!-----------------------------------------------
      INTEGER BCV_I      ! BC loop counter
      INTEGER M           ! Mass phase loop counter
      INTEGER PHASE_CNT        ! Number of solid phases at bc
      INTEGER PHASE_LIST(dim_m) ! List of phases used in current bc

! the number of particles injected in a solids time step
      DOUBLE PRECISION MAX_DIA ! Max diameter of incoming particles at bc

      LOGICAL, parameter :: setDBG = .false.
      LOGICAL :: dFlag

!-----------------------------------------------

      CALL init_err_msg("SET_BC_PIC_MI")

      dflag = (dmp_log .AND. setdbg)
      if(dflag) write(*,"(2/,2x,'PIC inlet count: ',I4)") pic_bcmi

      pic_bcmi_incl_cutcell(:) = .false.

! Loop over BCs that are flagged for PIC mass inflow.
      DO bcv_i = 1, pic_bcmi

! Get the user defined BC ID.
         bcv = pic_bcmi_map(bcv_i)

         pic_bcmi_offset(bcv_i,:) = 1
         pic_bcmi_normdir(bcv_i,:) = 0

         SELECT CASE(bc_plane(bcv))
         CASE('E'); pic_bcmi_normdir(bcv_i,1) = 1
         CASE('W')
            pic_bcmi_normdir(bcv_i,1) = -1
            pic_bcmi_offset(bcv_i,1) = 0

         CASE('N'); pic_bcmi_normdir(bcv_i,2) = 1
         CASE('S')
            pic_bcmi_normdir(bcv_i,2) = -1
            pic_bcmi_offset(bcv_i,2) = 0

         CASE('T'); pic_bcmi_normdir(bcv_i,3) = 1
         CASE('B')
            pic_bcmi_normdir(bcv_i,3) = -1
            pic_bcmi_offset(bcv_i,3) =  0
         END SELECT

         if(dflag) write(*,"(2/,'Setting PIC_MI:',I3)") bcv_i

! The number of mass phases at this inlet.  While a system may be
! polydisperse, the inlet could consist of a single mass phase
         phase_cnt = 0
! The mass phase indices of incoming particles at this inlet
         phase_list(:) = -1
! The max diameter of incoming particles at this inlet
         max_dia = zero

! Determine if the inlet is mono or polydisperse
         DO m=1, des_mmax+mmax
            IF(solids_model(m) /= 'PIC') cycle
            IF(bc_rop_s(bcv,m) == undefined) cycle
            IF(compare(bc_rop_s(bcv,m),zero)) cycle
            phase_cnt = phase_cnt + 1
            phase_list(phase_cnt) = m
            max_dia = max(max_dia,d_p0(m))
         ENDDO

      ENDDO

      CALL set_pic_bcmi_ijk

      CALL finl_err_msg


      RETURN
      END SUBROUTINE set_bc_pic_mi


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_BC_PIC                                              !
!  Author: R. Garg                                    Date: 11-Jun-14  !
!                                                                      !
!  Purpose: Check the data provided for the des mass inflow boundary   !
!  condition and flag errors if the data is improper.  This module is  !
!  also used to convert the provided information into the format       !
!  necessary for the dependent subrountines to function properly.      !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_pic_bcmi_ijk

! Modules
!---------------------------------------------------------------------//
      use bc, only: bc_plane
      use bc, only: bc_i_w, bc_i_e, bc_j_s, bc_j_n, bc_k_b, bc_k_t
      USE cutcell, only: cut_cell_at
      USE discretelement, only : des_mmax
      use error_manager
      use functions
      use funits, only: dmp_log
      use mpi_utility
      use param, only: dim_m
      use pic_bc, only: pic_bcmi, pic_bcmi_map, pic_bcmi_ijk
      use pic_bc, only: pic_bcmi_ijkstart, pic_bcmi_ijkend
      use pic_bc, only: pic_bcmi_cnp
      use pic_bc, only: pic_bcmi_rnp
      use pic_bc, only: pic_bcmi_incl_cutcell
      IMPLICIT NONE

! Local variables
!---------------------------------------------------------------------//
      INTEGER, ALLOCATABLE :: LOC_PIC_BCMI_IJK(:)
      INTEGER :: BCV, BCV_I
      INTEGER :: LC
      INTEGER :: MAX_CELLS
      INTEGER :: BND1, BND2
      LOGICAL, parameter :: setDBG = .false.
      LOGICAL :: dFlag
      INTEGER :: I,J,K,IJK
      INTEGER :: I_w, I_e, J_s, J_n, K_b, K_t
!......................................................................!


      CALL init_err_msg("SET_PIC_BCMI_IJK")

      dflag = (dmp_log .AND. setdbg)

      if(dflag) write(*,"(2/,2x,'From: SET_PIC_BCMI_IJK')")

! Loop over all inflow BCs to get an approximate count of the number
! of fluid cells that are adjacent to them.
      max_cells = 0
      DO bcv_i = 1, pic_bcmi
         bcv = pic_bcmi_map(bcv_i)

! Set the search area a little bigger than the inlet area.
         if(dflag) WRITE(*,"(/2x,'Adding cells for BCV: ',I3)") bcv
         SELECT CASE (bc_plane(bcv))
         CASE('N','S')
            bnd1 = min(bc_i_e(bcv)+1,imax1) - max(bc_i_w(bcv)-1,imin1)
            bnd2 = min(bc_k_t(bcv)+1,kmax1) - max(bc_k_b(bcv)-1,kmin1)

         CASE('E','W')
            bnd1 = min(bc_j_n(bcv)+1,jmax1) - max(bc_j_s(bcv)-1,jmin1)
            bnd2 = min(bc_k_t(bcv)+1,kmax1) - max(bc_k_b(bcv)-1,kmin1)

         CASE('T','B')
            bnd1 = min(bc_i_e(bcv)+1,imax1) - max(bc_i_w(bcv)-1,imin1)
            bnd2 = min(bc_j_n(bcv)+1,jmax1) - max(bc_j_s(bcv)-1,jmin1)
         END SELECT

         max_cells = max_cells + (bnd1 + 1)*(bnd2 + 1)
         if(dflag) WRITE(*,"(4x,'Plane:   ',A)") bc_plane(bcv)
         if(dflag) WRITE(*,"(4x,'Cells: ', I8)") (bnd1+1)*(bnd2+1)
      ENDDO

      if(dflag) write(*,"(2x,'Max Cells: ',I8)") max_cells

! Allocate an array to hold the IJK values. This array should be
! more than enough to store all the IJKs.
      allocate( loc_pic_bcmi_ijk(max_cells) )


! Loop over the IJKs for each BC and store only the IJKs that you
! own as well as the start/end array positions for each BC.
      lc = 1
      DO bcv_i = 1, pic_bcmi

         pic_bcmi_ijkstart(bcv_i) = lc
         bcv = pic_bcmi_map(bcv_i)

         if(dflag) write(*,"(/2x,'Searching for fluid cells:',I3)") bcv

         i_w = max(bc_i_w(bcv),imin1); i_e = min(bc_i_e(bcv),imax1)
         j_s = max(bc_j_s(bcv),jmin1); j_n = min(bc_j_n(bcv),jmax1)
         k_b = max(bc_k_b(bcv),kmin1); k_t = min(bc_k_t(bcv),kmax1)

! Depending on the flow plane, the 'common' index needs set to reference
! the fluid cell.
         SELECT CASE (bc_plane(bcv))
         CASE('N'); j_s = bc_j_s(bcv)+1;   j_n = bc_j_n(bcv)+1
         CASE('S'); j_s = bc_j_s(bcv)-1;   j_n = bc_j_n(bcv)-1
         CASE('E'); i_w = bc_i_w(bcv)+1;   i_e = bc_i_e(bcv)+1
         CASE('W'); i_w = bc_i_w(bcv)-1;   i_e = bc_i_e(bcv)-1
         CASE('T'); k_b = bc_k_b(bcv)+1;   k_t = bc_k_t(bcv)+1
         CASE('B'); k_b = bc_k_b(bcv)-1;   k_t = bc_k_t(bcv)-1
         END SELECT

         if(dflag) then
            write(*,"(4x,'Search bounds: ')")
            write(*,"(6x,'I_w/I_e:',2(2x,I6))") i_w, i_e
            write(*,"(6x,'J_s/J_n:',2(2x,I6))") j_s, j_n
            write(*,"(6x,'K_b/K_t:',2(2x,I6))") k_b, k_t
         endif

! Store the IJKs.
         DO k = k_b, k_t
         DO j = j_s, j_n
         DO i = i_w, i_e
! Skip cells that this rank does not own or are considered dead.
! Limit only to fluid cells
            IF(.NOT.is_on_mype_wobnd(i,j,k)) cycle
            ijk = funijk(i,j,k)

            IF(.NOT.fluid_at(ijk)) cycle

            !do not include this cell if the IO BC has been set to
            !not include cutcells
            IF(cut_cell_at(ijk).AND.(.NOT.pic_bcmi_incl_cutcell(bcv_i))) cycle
            loc_pic_bcmi_ijk(lc) = ijk
            lc = lc+1
         ENDDO
         ENDDO
         ENDDO

         pic_bcmi_ijkend(bcv_i) = lc-1

         IF(dflag) write(*,1111) bcv, bcv_i,                           &
            pic_bcmi_ijkstart(bcv_i), pic_bcmi_ijkend(bcv_i)

      ENDDO

 1111 FORMAT(/2x,'PIC Mass Inflow:',/4x,'BC:',i4,3x,'MAP:',i4,         &
         /4x,'IJKSTART:',i6,/4x,'IJKEND:  ',i6)


! Allocate the global store arrary array. This changes across MPI ranks.
      IF(lc > 1) THEN
         allocate( pic_bcmi_ijk(lc-1) )
         allocate(pic_bcmi_cnp(lc-1, dim_m))
         allocate(pic_bcmi_rnp(lc-1, dim_m))

         pic_bcmi_ijk(1:lc-1) = loc_pic_bcmi_ijk(1:lc-1)

         pic_bcmi_cnp(1:lc-1,:) = 0.d0
         pic_bcmi_rnp(1:lc-1,:) = 0.d0
      ELSE
         allocate( pic_bcmi_ijk(1) )
         allocate(pic_bcmi_cnp(1,1))
         allocate(pic_bcmi_rnp(1,1))

         pic_bcmi_ijk(1) = loc_pic_bcmi_ijk(1)
      ENDIF

      deallocate(loc_pic_bcmi_ijk)

      CALL finl_err_msg

      RETURN
      END SUBROUTINE set_pic_bcmi_ijk