PLAG_CECellsSendSize.F90

Go to the documentation of this file.

! *********************************************************************
! * Rocstar Simulation Suite                                          *
! * Copyright@2015, Illinois Rocstar LLC. All rights reserved.        *
! *                                                                   *
! * Illinois Rocstar LLC                                              *
! * Champaign, IL                                                     *
! * www.illinoisrocstar.com                                           *
! * sales@illinoisrocstar.com                                         *
! *                                                                   *
! * License: See LICENSE file in top level of distribution package or *
! * http://opensource.org/licenses/NCSA                               *
! *********************************************************************
! *********************************************************************
! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
! * NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       *
! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
! * USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
! *********************************************************************
!******************************************************************************
!
! Purpose: send buffer size to edge and corner cells of an adjacent region.
!
! Description: kernel is pertinent when the other region is located
!              on a different processor.
!
! Input: 
!   regions = data of all regions
!   iReg    = current region.
!
! Output: buffer size sent.
!
! Notes: none.
!
!******************************************************************************
!
! $Id: PLAG_CECellsSendSize.F90,v 1.5 2009/03/02 00:19:36 mtcampbe Exp $
!
! Copyright: (c) 2004 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_cecellssendsize( regions,iReg )

  USE moddatatypes
  USE moderror
  USE modmpi
  USE modparameters
  USE modglobal,     ONLY : t_global
  USE moddatastruct, ONLY : t_dcell, t_dcelltransf, t_region, t_level 
  USE modpartlag,    ONLY : t_plag, t_buffer_plag

  IMPLICIT NONE

! ******************************************************************************
! Definitions and declarations
! ******************************************************************************

! ==============================================================================
! Arguments
! ==============================================================================

  TYPE(t_region), POINTER :: regions(:)

  INTEGER, INTENT(IN)     :: ireg

! ==============================================================================
! Locals
! ==============================================================================

  CHARACTER(CHRLEN) :: rcsidentstring

  INTEGER :: dest,i,j,k,icell,icorner,iedge,ijk,ilev,ir,iregdes, iregsrc,    &
             irequestplag,nbuffsizecornsrc,nbuffsizeedgesrc,nbuffsizetotsrc, &
             ncorners,ndimbuffsize,nedges,tag

  TYPE(t_buffer_plag), POINTER :: pcorncellsxbuff, pedgecellsxbuff
  TYPE(t_dcelltransf), POINTER :: psendeccell
  TYPE(t_global),      POINTER :: global
  TYPE(t_level),       POINTER :: plevelsrc
  TYPE(t_plag),        POINTER :: pplag
  TYPE(t_region),      POINTER :: pregionsrc, pregiondes 

! ******************************************************************************
! Start
! ******************************************************************************

  rcsidentstring = '$RCSfile: PLAG_CECellsSendSize.F90,v $ $Revision: 1.5 $'

  global => regions(ireg)%global

  CALL registerfunction( global,'PLAG_CECellsSendSize',&
  'PLAG_CECellsSendSize.F90' )

! ******************************************************************************
! Get dimensions 
! ******************************************************************************

  ilev = regions(ireg)%currLevel
  ncorners  = 8
  nedges    = 12
  
  ndimbuffsize = 1 

  nbuffsizecornsrc = 0
  nbuffsizeedgesrc = 0
  nbuffsizetotsrc  = 0

! ******************************************************************************
! Set pointers 
! ******************************************************************************
  
  pregionsrc => regions(ireg)
  plevelsrc  => pregionsrc%levels(ilev)
  pplag      => plevelsrc%plag

! ******************************************************************************
! Load send buffer size
! ******************************************************************************

  DO ir=1,global%nRegions
    IF (regions(ir)%procid == global%myProcid) goto 1999

    IF ( plevelsrc%sendEcCells(ir)%nCells > 0 ) THEN
      psendeccell => plevelsrc%sendEcCells(ir)

! =============================================================================
!     Reset buffer size in active communicating regions to zero
!      since RFLO has possibility to have multiple active edges/corners
!      on various regions interacting; while for PLAG, edges/corners interact
!      dynamically when buffer size is non-null.
! =============================================================================

      nbuffsizecornsrc = 0
      nbuffsizeedgesrc = 0     
      nbuffsizetotsrc  = 0

! =============================================================================
!     Loop over edges of source region
!      Loading buffer size for edge
! =============================================================================

      DO iedge=1,nedges
        IF( .NOT. plevelsrc%edgeCells(iedge)%interact ) goto 2999
 
! -- Bypass for degenerate edge cells -----------------------------------------

        IF( plevelsrc%edgeCells(iedge)%degenrt /= degenerat_none ) goto 2999
             
        DO ijk=1,ubound(plevelsrc%edgeCells(iedge)%cells,1)
          iregdes = plevelsrc%edgeCells(iedge)%cells(ijk)%srcRegion
          pedgecellsxbuff => plevelsrc%edgeCells(iedge)%cells(ijk)%bufferExchPlag
          IF ( iregdes == ir .AND. regions(iregdes)%procid /= global%myProcid ) THEN               
            nbuffsizeedgesrc = nbuffsizeedgesrc +pedgecellsxbuff%nBuffSize 
          ENDIF   ! iRegDes
        ENDDO     ! ijk

#ifdef PLAG_CECELLS_MPI_DEBUG
  IF ( nbuffsizeedgesrc > 0 ) & 
    print*,' PLAG_CECellsSendSize: procId, iReg, iR, procIdiR, iEdge, nBuffSizeEdgeSrc,iRegDes  = ',&
       global%myProcid, ireg, ir, regions(ir)%procid ,iedge, nbuffsizeedgesrc,iregdes
#endif

2999    CONTINUE
      ENDDO       ! iEdge

! =============================================================================
!     Loop over corners of source region
!      Loading buffer size for corner
! =============================================================================

      DO icorner=1,ncorners
        IF (.NOT. plevelsrc%cornerCells(icorner)%interact) goto 3999

! -- Bypass for degenerate corner cells ---------------------------------------

        IF( plevelsrc%cornerCells(icorner)%degenrt /= degenerat_none ) goto 3999
        
        DO ijk=1,ubound(plevelsrc%cornerCells(icorner)%cells,1)
          iregdes = plevelsrc%cornerCells(icorner)%cells(ijk)%srcRegion
          pcorncellsxbuff => plevelsrc%cornerCells(icorner)%cells(ijk)%bufferExchPlag
          IF ( iregdes == ir .AND. regions(iregdes)%procid /= global%myProcid ) THEN               
            nbuffsizecornsrc = nbuffsizecornsrc +pcorncellsxbuff%nBuffSize 
          ENDIF   ! iRegDes 
        ENDDO     ! ijk

#ifdef PLAG_CECELLS_MPI_DEBUG
  IF ( nbuffsizecornsrc > 0 ) &
    print*,' PLAG_CECellsSendSize : procId, iReg, iR, iCorner, nBuffSizeCornSrc,iRegDes   = ',&
     global%myProcid, ireg, ir, regions(ir)%procid ,icorner, nbuffsizecornsrc,iregdes
#endif

3999    CONTINUE
      ENDDO         ! iCorner

! =============================================================================
!     Send buffers to destination processor 
! =============================================================================

      nbuffsizetotsrc           = nbuffsizecornsrc +nbuffsizeedgesrc
      psendeccell%nBuffSizePlag = nbuffsizetotsrc 
      irequestplag              = psendeccell%iRequestPlag

#ifdef MPI
      dest = regions(ir)%procid
      tag  = regions(ir)%localNumber +plag_tag_shift +mpi_patchoff +1000

      IF(tag .gt. global%mpiTagMax) tag = mod(tag,global%mpiTagMax)
#ifdef PLAG_CECELLS_MPI_DEBUG 
  IF ( nbuffsizetotsrc > 0 ) &             
   print*,'  PLAG_CECellsSendSize: iRegDes, iRegSrc, procDes, procSrc, tagSrc, nBuffSizePlag  = ',&
    ir, ireg, dest, global%myProcid,tag, psendeccell%nBuffSizePlag
#endif

      CALL mpi_isend( psendeccell%nBuffSizePlag,ndimbuffsize,mpi_integer, &
                      dest,tag,global%mpiComm,                            &
                      pplag%requestsCECells(irequestplag),global%mpierr   )
      IF ( global%mpierr /= err_none ) &
        CALL errorstop( global,err_mpi_trouble,__line__ )
#endif

    ENDIF      ! some cells to send

1999 CONTINUE
  ENDDO        ! ir

! ******************************************************************************
! finalize
! ******************************************************************************

  CALL deregisterfunction( global )

END SUBROUTINE plag_cecellssendsize

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_CECellsSendSize.F90,v $
! Revision 1.5  2009/03/02 00:19:36  mtcampbe
! Added some ifdefs around Rocflo to disable particle injection on INFLOW
! boundaries and added some checks around MPI tags utilizing a new global
! data item, global%mpiTagMax.
!
! Revision 1.4  2008/12/06 08:44:33  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:17:45  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2006/04/07 15:19:23  haselbac
! Removed tabs
!
! Revision 1.1  2004/12/01 20:57:20  fnajjar
! Initial revision after changing case
!
! Revision 1.4  2004/11/29 19:26:25  fnajjar
! Added bypass statement for dengerate cells
!
! Revision 1.3  2004/03/20 21:33:20  fnajjar
! Reset buffer sizes in active communicating regions to zero
!
! Revision 1.2  2004/03/10 23:42:31  fnajjar
! Activated IF-statement based on buffer size in ifdef construct
!
! Revision 1.1  2004/03/10 23:16:09  fnajjar
! Initial import of routines to MPI-communicate buffer sizes
!
!******************************************************************************