PLAG_BufferSizeSend.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 adjacent region on different processor.
!
! Description: none.
!
! Input: regions = data of all regions
!        iReg    = index of current region.
!
! Output: buffer size to other processors.
!
! Notes: None.
!
!******************************************************************************
!
! $Id: PLAG_BufferSizeSend.F90,v 1.4 2009/03/02 00:19:36 mtcampbe Exp $
!
! Copyright: (c) 2003 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_buffersizesend( regions, iReg )

  USE moddatatypes
  USE modpartlag, ONLY    : t_buffer_plag
  USE modbndpatch, ONLY   : t_patch
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE modpartlag, ONLY    : t_plag
  USE moderror
  USE modmpi
  USE modparameters
  USE plag_modparameters
  IMPLICIT NONE

! ... parameters
  TYPE(t_region), POINTER :: regions(:)
  
  INTEGER :: ireg

! ... loop variables
  INTEGER :: ipatch

! ... local variables
  CHARACTER(CHRLEN) :: rcsidentstring

#ifdef MPI
  INTEGER :: statusplag(mpi_status_size)
#endif

  INTEGER :: bctype, ilev, ipatchdes,iregdes, irequestplag,           &
             narv, naiv, nbuffi, nbuffr, nbuffsizesrc, ncont,         &
             ncv, ndimbuffsize, ndv, npatches,nsendbuffi,             &
             nsendbuffr, ntv, procdes, tagdes 
                                        
  TYPE(t_patch),  POINTER :: patchsrc, patchdes
  TYPE(t_plag),   POINTER :: pplag
  TYPE(t_global), POINTER :: global

!******************************************************************************

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

  global => regions(ireg)%global

  CALL registerfunction( global,'PLAG_BufferSizeSend',&
  'PLAG_BufferSizeSend.F90' )
    
! get dimensions and set pointer ----------------------------------------------
  
  ncont = regions(ireg)%plagInput%nCont
  ncv   = cv_plag_last + ncont
  ndv   = dv_plag_last
  ntv   = tv_plag_last
  naiv  = aiv_plag_last
  narv  = arv_plag_last
       
  nbuffi     = 2*naiv
  nbuffr     = 2*narv +4*ncv +ndv +ntv  
  ndimbuffsize = 1 
        
  ilev     = regions(ireg)%currLevel
  npatches = regions(ireg)%nPatches

  pplag => regions(ireg)%levels(ilev)%plag
          
! loop over patches -----------------------------------------------------------

  DO ipatch = 1, npatches

! - pointer is at Src region sending data to Des region -----------------------

    patchsrc => regions(ireg)%levels(ilev)%patches(ipatch)

    bctype    = patchsrc%bcType
    iregdes   = patchsrc%srcRegion
    ipatchdes = patchsrc%srcPatch

! - region interface for various boundary conditions --------------------------

    IF ( (bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
         (bctype>=bc_regionint  .AND. bctype<=bc_regionint +bc_range) .OR. &
         (bctype>=bc_regnonconf .AND. bctype<=bc_regnonconf+bc_range) .OR. &
         (bctype>=bc_tra_peri   .AND. bctype<=bc_tra_peri  +bc_range) .OR. &
         (bctype>=bc_rot_peri   .AND. bctype<=bc_rot_peri  +bc_range) ) THEN

      IF ( regions(iregdes)%procid /= global%myProcid ) THEN
        patchdes => regions(iregdes)%levels(ilev)%patches(ipatchdes)
        
        nbuffsizesrc = patchsrc%bufferPlag%nBuffSize
        
        nsendbuffi = nbuffi *nbuffsizesrc
        nsendbuffr = nbuffr *nbuffsizesrc
  
        patchsrc%bufferPlag%nSendBuffI = nsendbuffi
        patchsrc%bufferPlag%nSendBuffR = nsendbuffr 

        irequestplag = patchsrc%bufferPlag%iRequest

#ifdef PLAG_MPI_DEBUG              
  IF( nbuffsizesrc /= 0 ) &
  WRITE(stdout,*) '  PLAG_BufferSizeSend: iReg, nBuffSizeSrc, nDimBuffSize, iRequestPlag  = ',&
                     ireg, nbuffsizesrc, ndimbuffsize, irequestplag    
#endif

#ifdef MPI
        procdes = regions(iregdes)%procid
        tagdes  = regions(iregdes)%localNumber &
                + plag_tag_shift +mpi_patchoff*ipatchdes*iregdes + procdes 

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

#ifdef PLAG_MPI_DEBUG          
  IF( nbuffsizesrc /= 0 ) &
  WRITE(stdout,*) '  PLAG_BufferSizeSend: iReg, iRegDes, procDes, tagDes = ',&
                     ireg, iregdes, procdes,tagdes
#endif
                                  
        CALL mpi_isend( patchsrc%bufferPlag%nBuffSize,             &
                        ndimbuffsize,mpi_integer,                  &
                        procdes,tagdes,global%mpiComm,             &
                        pplag%requests(irequestplag),global%mpierr )
                        
        IF (global%mpierr /= err_none) &
          CALL errorstop( global,err_mpi_trouble,__line__ )
#endif
 
      ENDIF ! regions
    ENDIF ! bcType

  ENDDO ! iPatch

! finalize --------------------------------------------------------------------

  CALL deregisterfunction( global )

END SUBROUTINE plag_buffersizesend

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_BufferSizeSend.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:32  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:56:59  fnajjar
! Initial revision after changing case
!
! Revision 1.10  2004/04/09 23:05:54  fnajjar
! Added IF statement to activate only for non-null buffer size
!
! Revision 1.9  2004/03/21 00:43:32  fnajjar
! Fixed tags to be smaller number since Frost run-time system complains about size
!
! Revision 1.8  2004/03/06 21:25:05  fnajjar
! Added PLAG_TAG_SHIFT to MPI-based communication tags
!
! Revision 1.7  2003/05/27 19:14:16  fnajjar
! Removed distPartBurning and all pertinent LOGICAL datastructure
!
! Revision 1.6  2003/05/07 00:15:05  fnajjar
! Included I/O within ifdef PLAG_MPI_DEBUG construct
!
! Revision 1.5  2003/01/24 23:10:15  f-najjar
! Added to tagSrc and tagDes procId for Des region to avoid tag collision
!
! Revision 1.4  2003/01/24 22:37:55  f-najjar
! Made tagDes less prone to tag collision by multiplying by iRegDes
!
! Revision 1.3  2003/01/24 22:33:35  f-najjar
! Used generic ERR_NONE for MPI error trapping
!
! Revision 1.2  2003/01/23 17:51:34  f-najjar
! Add ModMPI for MPI communication
!
! Revision 1.1  2003/01/23 17:31:22  f-najjar
! Initial import for MPI
!
!******************************************************************************