PLAG_CECellsSendData.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 data from edge and corner cells to 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 data sent.
!
! Notes: none.
!
!******************************************************************************
!
! $Id: PLAG_CECellsSendData.F90,v 1.4 2009/03/02 00:19:36 mtcampbe Exp $
!
! Copyright: (c) 2004 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_cecellssenddata( 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

  USE plag_modparameters
  
  USE plag_modinterfaces, ONLY : plag_edgecellsloadsendbuff, &
                                 plag_corncellsloadsendbuff

  IMPLICIT NONE

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

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

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

  INTEGER, INTENT(IN)     :: ireg

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

  CHARACTER(CHRLEN) :: rcsidentstring

  INTEGER :: dest,ilev,ir,iregdes,iregsrc,irequestplag,tagi,tagr
  INTEGER :: nbuffsizecornsrc,nbuffsizeedgesrc,nbuffsizetotsrc 
  INTEGER :: narv,naiv,ncont,ncv,ndimi,ndimr,nsendbuffi,nsendbuffr
  INTEGER,      POINTER, DIMENSION(:)   :: psendbuffi
  
  REAL(RFREAL), POINTER, DIMENSION(:)   :: psendbuffr

  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

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

  rcsidentstring = '$RCSfile: PLAG_CECellsSendData.F90,v $ $Revision: 1.4 $'

  global => regions(ireg)%global

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

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

  ilev = regions(ireg)%currLevel

  nbuffsizeedgesrc = 0
  nbuffsizecornsrc = 0
  nbuffsizetotsrc  = 0

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

! ******************************************************************************
! Set send buffer dimensions
! ******************************************************************************

  naiv  = pplag%nAiv
  narv  = pplag%nArv
  ncv   = pplag%nCv

  ndimi = naiv
  ndimr = 2*narv +4*ncv     

! ******************************************************************************
! Load send buffer data
! ******************************************************************************

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

    IF ( plevelsrc%sendEcCells(ir)%nCells > 0 ) THEN
      psendeccell => plevelsrc%sendEcCells(ir)
      psendbuffi  => psendeccell%buffplagI
      psendbuffr  => psendeccell%buffplagR 

! =============================================================================
!     Bypass MPI communication for null buffer size 
! =============================================================================       

      IF ( psendeccell%nBuffSizePlag == 0 ) goto 1999

! =============================================================================
!     Load buffer data for edges
! =============================================================================

      CALL plag_edgecellsloadsendbuff( regions,ireg,ir,nbuffsizeedgesrc )

! =============================================================================
!     Load buffer data for corners
! =============================================================================

      CALL plag_corncellsloadsendbuff( regions,ireg,ir,nbuffsizeedgesrc, &
                                       nbuffsizecornsrc )

! =============================================================================
!     Trap error for inconsistent buffer sizes
! =============================================================================

      nbuffsizetotsrc=  nbuffsizecornsrc+nbuffsizeedgesrc
      IF ( nbuffsizetotsrc /= psendeccell%nBuffSizePlag ) THEN
        WRITE(stdout,*) 'PLAG_CECellsSendData: Error inconsistent buffer sizes'
        WRITE(stdout,*) '                      nBuffSizeEdgeSrc = ', nbuffsizeedgesrc
        WRITE(stdout,*) '                      nBuffSizeCornSrc = ', nbuffsizecornsrc
        WRITE(stdout,*) '                      nBuffSizeTotSrc = ', nbuffsizetotsrc
        WRITE(stdout,*) '            pSendEcCell%nBuffSizePlag = ', psendeccell%nBuffSizePlag

! TEMPORARY
!        CALL ErrorStop(global,ERR_PLAG_BUFFSIZE,__LINE__,errorString)
#ifdef MPI
         CALL mpi_finalize(global%mpierr)
#endif
         stop
! END TEMPORARY
      ENDIF ! nBuffSizeTotSrc

! =============================================================================
!     Send buffer data to destination processor 
! =============================================================================

      nsendbuffi = ndimi * psendeccell%nBuffSizePlag
      nsendbuffr = ndimr * psendeccell%nBuffSizePlag

      irequestplag = psendeccell%iRequestPlag

#ifdef MPI
      dest = regions(ir)%procid

!------------------------------------------------------------------------------
!     Integer buffer data
!------------------------------------------------------------------------------

      tagi  = regions(ir)%localNumber +plag_tag_shift +mpi_patchoff +2000

      IF(tagi .gt. global%mpiTagMax) tagi = mod(tagi,global%mpiTagMax)

#ifdef PLAG_CECELLS_MPI_DEBUG 
  WRITE(stdout,'(A,A,7(2X,I5))') &
  '  PLAG_CECellsSendData-INT: iRegDes, iRegSrc, procDes, procSrc,',&
  'tagSrc, nBuffSizePlag,nSendBuffI  = ',&
    ir, ireg, dest, global%myProcid,tagi, psendeccell%nBuffSizePlag,nsendbuffi
#endif

      CALL mpi_isend( psendbuffi,nsendbuffi,mpi_integer, &
                      dest,tagi,global%mpiComm,                            &
                      pplag%requestsCECellsI(irequestplag),global%mpierr   )
      IF ( global%mpierr /= err_none ) &
        CALL errorstop( global,err_mpi_trouble,__line__ )

!------------------------------------------------------------------------------
!     Real buffer data
!------------------------------------------------------------------------------

      tagr  = regions(ir)%localNumber +plag_tag_shift +mpi_patchoff +3000
      IF(tagr .gt. global%mpiTagMax) tagr = mod(tagr,global%mpiTagMax)

#ifdef PLAG_CECELLS_MPI_DEBUG 
  WRITE(stdout,'(A,A,7(2X,I5))') &
  '  PLAG_CECellsSendData-REAL: iRegDes, iRegSrc, procDes, procSrc,',&
  'tagSrc, nBuffSizePlag,nSendBuffR  = ',&
    ir, ireg, dest, global%myProcid,tagr, psendeccell%nBuffSizePlag,nsendbuffr
#endif

      CALL mpi_isend( psendbuffr,nsendbuffr,mpi_rfreal, &
                      dest,tagr,global%mpiComm,                            &
                      pplag%requestsCECellsR(irequestplag),global%mpierr   )
      IF ( global%mpierr /= err_none ) &
        CALL errorstop( global,err_mpi_trouble,__line__ )

#endif
1999 CONTINUE
    ENDIF      ! some cells to send

999 CONTINUE
  ENDDO        ! ir

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

  CALL deregisterfunction( global )

END SUBROUTINE plag_cecellssenddata

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_CECellsSendData.F90,v $
! Revision 1.4  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.3  2008/12/06 08:44:33  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:17:45  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2004/12/01 20:57:17  fnajjar
! Initial revision after changing case
!
! Revision 1.2  2004/03/20 21:32:34  fnajjar
! Added more writing statement for error trapping
!
! Revision 1.1  2004/03/18 21:43:27  fnajjar
! Initial import for MPI-based data buffer communication
!
!******************************************************************************