set_bc_pic_mo.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: SET_BC_PIC_MO                                           !
!                                                                      !
!                                                                      !
!  Author: R.Garg                                     Date: 23-June-14 !
!                                                                      !
!  Comments:                                                           !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_bc_pic_mo

      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 pic_bc, only: pic_bcmo, pic_bcmo_map, pic_bcmo_ijk
      use pic_bc, only: pic_bcmo_ijkstart, pic_bcmo_ijkend

      use funits, only: dmp_log

      use mpi_utility
      use error_manager
      use functions

      IMPLICIT NONE

!-----------------------------------------------
! Local variables
!-----------------------------------------------
      INTEGER :: BCV, BCV_I      ! BC loop counter

      INTEGER :: LC

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

      INTEGER :: MAX_CELLS, BND1, BND2

      INTEGER, ALLOCATABLE :: LOC_PIC_BCMO_IJK(:)

      INTEGER :: I,J,K,IJK
      INTEGER :: I_w, I_e, J_s, J_n, K_b, K_t

      CALL init_err_msg("SET_BC_PIC_MO")

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

! Loop over the outflow BCs to get an approximate count of the number
! of fluid cells that are adjacent to the outlet.
      max_cells = 0
      DO bcv_i = 1, pic_bcmo
         bcv = pic_bcmo_map(bcv_i)

! Set the search area to the dimensions of the inlet.
         if(dflag) WRITE(*,"(/2x,'Adding cells for BCV: ',I3)") bcv
         SELECT CASE (bc_plane(bcv))
         CASE('N','S')
            bnd1 = bc_i_e(bcv) - bc_i_w(bcv)
            bnd2 = bc_k_t(bcv) - bc_k_b(bcv)

         CASE('E','W')
            bnd1 = bc_j_n(bcv) - bc_j_s(bcv)
            bnd2 = bc_k_t(bcv) - bc_k_b(bcv)

         CASE('T','B')
            bnd1 = bc_i_e(bcv) - bc_i_w(bcv)
            bnd2 = bc_j_n(bcv) - bc_j_s(bcv)
         END SELECT

         max_cells = max_cells +                                      &
            2*(bnd1+1)*(bnd2+1) + 2*(bnd1+2) + 2*(bnd2+2)

         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_bcmo_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_bcmo

         pic_bcmo_ijkstart(bcv_i) = lc
         bcv = pic_bcmo_map(bcv_i)

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

         i_w = bc_i_w(bcv); i_e = bc_i_e(bcv)
         j_s = bc_j_s(bcv); j_n = bc_j_n(bcv)
         k_b = bc_k_b(bcv); k_t = bc_k_t(bcv)

! Depending on the flow plane, the 'common' index needs shifted to
! reference the fluid cell.
         SELECT CASE (bc_plane(bcv))
         CASE('N'); j_s = j_s+1;  j_n = j_s
         CASE('S'); j_s = j_s-1;  j_n = j_s
         CASE('E'); i_w = i_w+1;  i_e = i_w
         CASE('W'); i_w = i_w-1;  i_e = i_w
         CASE('T'); k_b = k_b+1;  k_t = k_b
         CASE('B'); k_b = k_b-1;  k_t = k_b
        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

            loc_pic_bcmo_ijk(lc) = ijk
            lc = lc+1
         ENDDO
         ENDDO
         ENDDO

         pic_bcmo_ijkend(bcv_i) = lc-1

         if(dflag) write(*,1111) bcv, bcv_i,                           &
            pic_bcmo_ijkstart(bcv_i),pic_bcmo_ijkend(bcv_i)

      ENDDO

 1111 FORMAT(/2x,'PIC Mass Outflow:',/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_bcmo_ijk(lc-1) )
         pic_bcmo_ijk(1:lc-1) = loc_pic_bcmo_ijk(1:lc-1)
      ELSE
         allocate( pic_bcmo_ijk(1) )
         pic_bcmo_ijk(1) = loc_pic_bcmo_ijk(1)
      ENDIF

      deallocate(loc_pic_bcmo_ijk)

      CALL finl_err_msg

      RETURN
      END SUBROUTINE set_bc_pic_mo