mpi_funs_des_mod.f

Go to the documentation of this file.

!----------------------------------------------------------------------!
! Module: MPI_FUNS_DES                                                 !
! Author: Pradeep Gopalakrishnan                                       !
!                                                                      !
! Purpose: This module contains the subroutines and functions for MPI  !
! communications in DES simulations.                                   !
!----------------------------------------------------------------------!
      module mpi_funs_des

      contains

!----------------------------------------------------------------------!
! Subroutine: DES_PAR_EXCHANGE                                         !
! Author: Pradeep Gopalakrishnan                                       !
!                                                                      !
! Purpose: This subroutine controls entire exchange of particles       !
!    between processors.                                               !
!                                                                      !
! Steps:                                                               !
! 1) Bin the particles to the DES grid.                                !
! 2) Check if the send and recv buffer size is large enough            !
! 3) Pack and send active particles located in ghost cells to the      !
!    processors that own the ghost cells. The exchange occurs in       !
!    the following order to take care of particles crossing at corners !
!    (e.g., crossing directly into the northwest block):               !
!    a.) top-bottom interface                                          !
!    b.) north-south interface                                         !
!    c.) east-west interface                                           !
! 4) Bin the particles (if required)                                   !
! 5) Pack and send particles adjacent to neighboring processes. The    !
!    exchange occurs in the following order:                           !
!    a.) east-west interface                                           !
!    b.) north-south interface                                         !
!    c.) top-bottom interface                                          !
!                                                                      !
! Comments: The DO_NSEARCH flag should be set before calling           !
!   DES_PAR_EXCHANGE; When DO_NSEARCH is true, ghost particles are     !
!   updated and later used  to generate the PAIR lists.                !
!----------------------------------------------------------------------!
      subroutine des_par_exchange()

      use discretelement, only: do_nsearch, des_periodic_walls

      use mfix_pic, only: mppic
      use desmpi, only: iexchflag
      use desmpi, only: dsendbuf, drecvbuf
      use discretelement, only: ighost_updated
      use desmpi, only: ispot

      use geometry, only: no_k

! Module procedures
!---------------------------------------------------------------------//
      use mpi_pack_des, only: desmpi_pack_parcross
      use mpi_unpack_des, only: desmpi_unpack_parcross

      use mpi_pack_des, only: desmpi_pack_ghostpar
      use mpi_unpack_des, only: desmpi_unpack_ghostpar

      use mpi_comm_des, only: desmpi_sendrecv_init
      use mpi_comm_des, only: desmpi_sendrecv_wait

      use desgrid, only: desgrid_pic
      use desmpi_wrapper, only: des_mpi_barrier
      use compar, only: numpes

      implicit none

! Local variables:
!---------------------------------------------------------------------//
! Loop counters.
      integer :: linter, lface, ii
! Number of calls since the buffer was last checked.
      integer, save :: lcheckbuf = 0

!......................................................................!

      IF (.not.((numpes>1) .OR. des_periodic_walls)) RETURN

! Check that the send/recv buffer is sufficient every 100 calls to
! avoid the related global communications.
      if (mod(lcheckbuf,100) == 0) then
         call desmpi_check_sendrecvbuf(check_global=.true.)
         lcheckbuf = 0
      elseif (mod(lcheckbuf,5) == 0) then
         call desmpi_check_sendrecvbuf(check_global=.false.)
      end if
      lcheckbuf = lcheckbuf + 1

! call particle crossing the boundary exchange in T-B,N-S,E-W order
      do ii=1, size(dsendbuf)
         dsendbuf(ii)%facebuf(1) = 0
         drecvbuf(ii)%facebuf(1) = 0
      end do

      ispot = 1
      do linter = merge(2,3,no_k),1,-1
         do lface = linter*2-1,linter*2
            if(.not.iexchflag(lface))cycle
            call desmpi_pack_parcross(lface)
            call desmpi_sendrecv_init(lface)
         end do
         do lface = linter*2-1,linter*2
            if(.not.iexchflag(lface)) cycle
            call desmpi_sendrecv_wait(lface)
            call desmpi_unpack_parcross(lface)
         end do
! update pic this is required for particles crossing corner cells
         do lface = linter*2-1,linter*2
            if(dsendbuf(1+mod(lface,2))%facebuf(1).gt.0 .or. &
               drecvbuf(1+mod(lface,2))%facebuf(1).gt.0) then
               call desgrid_pic(plocate=.false.)
               exit
            end if
         end do
      end do
      call des_mpi_barrier

!      call des_dbgmpi(5)


      IF(.NOT.mppic) THEN
! call ghost particle exchange in E-W, N-S, T-B order

         do ii=1, size(dsendbuf)
            dsendbuf(ii)%facebuf(1) = 0
            drecvbuf(ii)%facebuf(1) = 0
         end do

         ighost_updated(:) = .false.
         ispot = 1
         do linter = 1,merge(2,3,no_k)
            do lface = linter*2-1,linter*2
               if(.not.iexchflag(lface))cycle
               call desmpi_pack_ghostpar(lface)
               call desmpi_sendrecv_init(lface)
            end do
            do lface = linter*2-1,linter*2
               if(.not.iexchflag(lface)) cycle
               call desmpi_sendrecv_wait(lface)
               call desmpi_unpack_ghostpar(lface)
            end do

! Rebin particles to the DES grid as ghost particles may be moved.
            do lface = linter*2-1,linter*2
               if(dsendbuf(1+mod(lface,2))%facebuf(1) .gt.0.or.&
                  drecvbuf(1+mod(lface,2))%facebuf(1).gt.0) then
                  call desgrid_pic(plocate=.false.)
                  exit
               end if
            end do
         end do
         call desmpi_cleanup
         call des_mpi_barrier
      ENDIF   ! end if(.not.mppic)

!      call des_dbgmpi(2)
!      call des_dbgmpi(3)
!      call des_dbgmpi(4)
!      call des_dbgmpi(6)
!      call des_dbgmpi(7)

      END SUBROUTINE des_par_exchange


!----------------------------------------------------------------------!
! Subroutine: DESMPI_CHECK_SENDRECVBUF                                 !
! Author: Pradeep Gopalakrishnan                                       !
!                                                                      !
! Purpose: Checks if the sendrecvbuf size is large enough. If the      !
!    buffers are not sufficent, they are resized.                      !
!----------------------------------------------------------------------!
      SUBROUTINE desmpi_check_sendrecvbuf(check_global)

      use derived_types, only: dg_pic
      use discretelement, only: dimn
      use desmpi, only: imaxbuf
      use desmpi, only: ibufoffset
      use desmpi, only: dsendbuf, drecvbuf
      use desmpi, only: isendindices
      use desmpi, only: ighostpacketsize

      use mpi_utility, only: global_all_max
      use error_manager
      implicit none

      logical, intent(in) :: check_global

! Local variables:
!---------------------------------------------------------------------//
! Loop counters
      INTEGER :: lface, lindx, lijk
! Particle count in send/recv region on current face
      INTEGER :: lparcnt
! Max particle count in send/recv region over all proc faces.
      INTEGER :: lmaxcnt
! Total number of DES grid cells on lface in send/recv
      INTEGER :: ltot_ind
! Previous Buffer
      INTEGER :: pBUF
! Growth factor when resizing send/recv buffers.
      REAL :: lfactor = 0.5
      DOUBLE PRECISION, PARAMETER :: ONEMBo8 = 131072.0
!......................................................................!

      lmaxcnt = 0
      do lface = 1,6
         ltot_ind = isendindices(1,lface)
         lparcnt = 0
         do lindx = 2,ltot_ind+1
            lijk = isendindices(lindx,lface)
            lparcnt = lparcnt + dg_pic(lijk)%isize
         enddo
         if(lparcnt > lmaxcnt) lmaxcnt = lparcnt
      enddo

      if(check_global) call global_all_max(lmaxcnt)

      if (imaxbuf < (1.0+0.5*lfactor)*lmaxcnt*ighostpacketsize) then
         pbuf = imaxbuf
         imaxbuf = (1.0+lfactor)*lmaxcnt*ighostpacketsize
         do lface = 1,2*dimn
            if(allocated(dsendbuf(1+mod(lface,2))%facebuf)) then
               deallocate(dsendbuf(1+mod(lface,2))%&
                  facebuf,drecvbuf(1+mod(lface,2))%facebuf)
            endif
            allocate(dsendbuf(1+mod(lface,2))%facebuf(imaxbuf),&
               drecvbuf(1+mod(lface,2))%facebuf(imaxbuf))
         end do

         WRITE(err_msg, 1000) imaxbuf/onembo8, &
            100.0d0+100.0d0*dble(imaxbuf-pbuf)/dble(pbuf)
         CALL flush_err_msg(header=.false., footer=.false.)

 1000 FORMAT(/'Resizeing DES MPI buffers: ',f7.1,' MB  (+',f5.1'%)')

      endif

      END SUBROUTINE desmpi_check_sendrecvbuf

!----------------------------------------------------------------------!
! Subroutine: DESMPI_CLEANUP                                           !
! Author: Pradeep Gopalakrishnan                                       !
!                                                                      !
! Purpose: Cleans the ghost particle array positions.                  !
!----------------------------------------------------------------------!
      SUBROUTINE desmpi_cleanup

      use discretelement, only: dimn
      use discretelement, only: des_pos_new, des_pos_old
      use discretelement, only: des_vel_new, des_vel_old
      use discretelement, only: omega_new
      use discretelement, only: particle_orientation
      use discretelement, only: orientation,init_orientation
      use discretelement, only: fc
      use discretelement, only: do_old
      use discretelement, only: pip
      use discretelement, only: ighost_cnt
      use discretelement, only: des_usr_var_size, des_usr_var
      use derived_types, only: dg_pic
      use discretelement, only: pijk

      use run, only: energy_eq,any_species_eq
      use des_thermo, only: des_t_s

      use des_rxns, only: des_x_s

      use discretelement, only: ighost_updated
      use functions, only: set_nonexistent
      use desmpi, only: irecvindices
      use desmpi, only: iexchflag

      use param, only: dimension_n_s
      use param1, only: zero

      implicit none

! Local variables:
!---------------------------------------------------------------------//
      integer ltot_ind,lface,lindx,lijk,lcurpar,lpicloc

      do lface = 1,dimn*2
         if(.not.iexchflag(lface))cycle
         ltot_ind = irecvindices(1,lface)
         do lindx = 2,ltot_ind+1
            lijk = irecvindices(lindx,lface)
            do lpicloc =1,dg_pic(lijk)%isize
               lcurpar = dg_pic(lijk)%p(lpicloc)
               if(ighost_updated(lcurpar)) cycle
               pip = pip - 1
               ighost_cnt = ighost_cnt-1
               call set_nonexistent(lcurpar)
               fc(lcurpar,:) = 0.0
               des_pos_new(lcurpar,:)=0
               pijk(lcurpar,:) = -10
               IF (do_old) THEN
                  des_pos_old(lcurpar,:)=0
                  des_vel_old(lcurpar,:)=0
               ENDIF
               des_vel_new(lcurpar,:)=0
               omega_new(lcurpar,:)=0

               IF(particle_orientation) &
                  orientation(1:3,lcurpar) = init_orientation

               if(energy_eq) des_t_s(lcurpar)=0

               if(any_species_eq)then
                  des_x_s(lcurpar,1:dimension_n_s)= 0
               endif

               IF(des_usr_var_size > 0)&
                  des_usr_var(:,lcurpar)= 0

            end do
         end do
      end do
      END SUBROUTINE desmpi_cleanup


!----------------------------------------------------------------------!
! Subroutine: DESMPI_SEND_RECV_FIELD_VARS                              !
! Author: J.Musser                                                     !
!                                                                      !
! Purpose: Collect data from ghost cells for interpolated cases and    !
!   preform halo exchange go sync ghost cell data.                     !
!----------------------------------------------------------------------!
      SUBROUTINE desmpi_send_recv_field_vars

! Flags for solving energy, species and solids density
      use run, only: energy_eq, any_species_eq, solve_ros
! Flag for explicitly coupled simulations
      use discretelement, only: des_explicitly_coupled
! Flag for use interpolation
      use particle_filter, only: des_interp_on
! Gas phae volume fraction and bluk density
      use fldvar, only: ep_g, rop_g
! Solids bulk density and material density
      use fldvar, only: rop_s, ro_s
! Gas phase mass and species mass source terms
      use des_rxns, only: des_r_gp, des_r_gc
      use des_rxns, only: des_sum_r_g, des_r_phase
! Gas phase energy equation source terms
      use des_thermo, only: conv_sc
      use des_rxns, only: des_hor_g
! MPI function for collecting interpolated data from ghost cells.
      use sendrecvnode, only: des_collect_gdata
! MPI wrapper for halo exchange.
      use sendrecv, only: send_recv

      implicit none

! Local variables:
!---------------------------------------------------------------------//

      CALL send_recv(ep_g,2)
      CALL send_recv(rop_g,2)

      CALL send_recv(rop_s,2)
      IF(any(solve_ros)) CALL send_recv(ro_s,2)

! Add in interpolated data from ghost cells and halo exchange
      IF(.NOT.des_explicitly_coupled) THEN

         IF(des_interp_on) THEN
            IF(energy_eq) CALL des_collect_gdata(conv_sc)
            IF(any_species_eq) THEN 
               CALL des_collect_gdata(des_r_gp)
               CALL des_collect_gdata(des_r_gc)
               CALL des_collect_gdata(des_r_phase)
               CALL des_collect_gdata(des_hor_g)
               CALL des_collect_gdata(des_sum_r_g)
            ENDIF
         ENDIF

         IF(energy_eq) CALL send_recv(conv_sc, 2)
         IF(any_species_eq) THEN 
            CALL send_recv(des_r_gp, 2) 
            CALL send_recv(des_r_gc, 2) 
            CALL send_recv(des_r_phase, 2) 
            CALL send_recv(des_hor_g, 2) 
            CALL send_recv(des_sum_r_g, 2) 
         ENDIF
      ENDIF

      RETURN
      END SUBROUTINE desmpi_send_recv_field_vars

      END MODULE mpi_funs_des