PLAG_CECellsGetBufferSize.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: obtains appropriate buffer sizes for corner and edge cells. 
!
! Description: none.
!
! Input: region = current region.
!        iReg   = region number
!
! Output: region%level%cornerCells(:)%bufferExchPlag%nBuffSize = buffer size.
!         region%level%edgeCells(:)%bufferExchPlag%nBuffSize   = buffer size.
!
! Notes: none.
!
!******************************************************************************
!
! $Id: PLAG_CECellsGetBufferSize.F90,v 1.3 2008/12/06 08:44:33 mtcampbe Exp $
!
! Copyright: (c) 2003 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_cecellsgetbuffersize( region, iReg )

  USE moddatatypes
  USE modpartlag, ONLY    : t_plag, t_plag_input, t_buffer_plag
  USE moddatastruct, ONLY : t_region, t_level
  USE modglobal, ONLY     : t_global  
  USE modinterfaces, ONLY : rflo_getcelloffset, rflo_getcornercellsindices, &
                            rflo_getedgecellsindices, rflo_getdimensdummy,  &
                            rflo_getdimensphys

  USE moderror
  USE modparameters
  USE plag_modparameters
  IMPLICIT NONE

#include "Indexing.h"

! ... parameters
  TYPE(t_region)      :: region

  INTEGER, INTENT(IN) :: ireg

! ... loop variables
  INTEGER :: i, j, k, ijk, icorner, iedge, ipcls 

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

  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend
  INTEGER :: idcbeg, idcend, jdcbeg, jdcend, kdcbeg, kdcend
  INTEGER :: ipcbeg, ipcend, jpcbeg, jpcend, kpcbeg, kpcend
  INTEGER :: icplag, jcplag, kcplag
  INTEGER :: icoff, ijcoff, ijkccell, ijkcplag, ijkecell, ilev
  INTEGER :: ibegdummcell, ienddummcell, ibegphyscell, iendphyscell
  INTEGER :: ibegcorncell, iendcorncell, ibegedgecell, iendedgecell
  INTEGER :: lboundskipsum, nbuffsizetot, ndumcells, npatches, npcls
  INTEGER :: ncorners, nedges
   
  INTEGER,          DIMENSION(6)   :: lboundskip
  INTEGER, POINTER, DIMENSION(:,:) :: paiv
  
  LOGICAL :: pclsfound

  TYPE(t_level),       POINTER :: plevel
  TYPE(t_plag),        POINTER :: pplag
  TYPE(t_buffer_plag), POINTER :: pcorncellsxbuff, pedgecellsxbuff
  TYPE(t_global),      POINTER :: global
  
!******************************************************************************

  rcsidentstring = '$RCSfile: PLAG_CECellsGetBufferSize.F90,v $ $Revision: 1.3 $'

  global => region%global
    
  CALL registerfunction( global, 'PLAG_CECellsGetBufferSize',&
  'PLAG_CECellsGetBufferSize.F90' )

! Get dimensions --------------------------------------------------------------

  ilev         = region%currLevel
  ndumcells    = region%nDumCells
  ncorners     = 8
  nedges       = 12
  
  npcls        = region%levels(ilev)%plag%nPcls 
  nbuffsizetot = region%plagInput%nPclsBuffTot

! Set pointers ----------------------------------------------------------------
  
  plevel => region%levels(ilev)
  pplag  => plevel%plag   
  paiv   => pplag%aiv

! Initialize buffer size ----------------------------------------------------

  DO icorner = 1, ncorners
    IF( plevel%cornerCells(icorner)%interact .EQV. .true. .AND.    &
        plevel%cornerCells(icorner)%degenrt   ==   degenerat_none ) THEN 
      DO ijk = 1, ubound(plevel%cornerCells(icorner)%cells,1)
        plevel%cornerCells(icorner)%cells(ijk)%bufferExchPlag%nBuffSize  = 0
      ENDDO ! ijk
    ENDIF   ! interact
  ENDDO     ! iCorner

  DO iedge = 1, nedges
    IF( plevel%edgeCells(iedge)%interact .EQV. .true. .AND.    &
        plevel%edgeCells(iedge)%degenrt   ==    degenerat_none ) THEN
      DO ijk = 1, ubound(plevel%edgeCells(iedge)%cells,1)   
        plevel%edgeCells(iedge)%cells(ijk)%bufferExchPlag%nBuffSize  = 0
      ENDDO ! ijk
    ENDIF   ! interact
  ENDDO     ! iEdge

! Exit for null number of particles -------------------------------------------
!   after initializing buffer size to zero ------------------------------------

  IF ( npcls == 0 ) goto 999

! Get cell dimensions ---------------------------------------------------------
  
  CALL rflo_getcelloffset( region,ilev,icoff,ijcoff )
  
  CALL rflo_getdimensdummy( region,ilev,idcbeg,idcend, &
                            jdcbeg,jdcend,kdcbeg,kdcend )
  CALL rflo_getcelloffset(  region,ilev,icoff,ijcoff )
  ibegdummcell = indijk(idcbeg,jdcbeg,kdcbeg,icoff,ijcoff)
  ienddummcell = indijk(idcend,jdcend,kdcend,icoff,ijcoff)

#ifdef PLAG_CECELLS_DEBUG
  WRITE(*,*) '  Inside PLAG_CECellsGetBufferSize: time,iReg,ijkDummBeg-End = ',&
 global%currentTime+ global%dtMin,ireg,idcbeg,idcend,jdcbeg,jdcend,kdcbeg,kdcend,ibegdummcell,ienddummcell
#endif 
       
! Get physical dimensions  ----------------------------------------------------
      
  CALL rflo_getdimensphys( region,ilev,ipcbeg,ipcend, &
                           jpcbeg,jpcend,kpcbeg,kpcend )
  CALL rflo_getcelloffset( region,ilev,icoff,ijcoff )
  ibegphyscell = indijk(ipcbeg,jpcbeg,kpcbeg,icoff,ijcoff)
  iendphyscell = indijk(ipcend,jpcend,kpcend,icoff,ijcoff)

#ifdef PLAG_CECELLS_DEBUG
  WRITE(*,*) '  Inside PLAG_CECellsGetBufferSize: time,iReg,iPcls,ijkPhysBeg-End = ',&
      global%currentTime+ global%dtMin,ireg,ipcbeg,ipcend,jpcbeg,jpcend,kpcbeg,kpcend,ibegphyscell,iendphyscell
#endif 

! Loop over particles ---------------------------------------------------------

  DO ipcls = 1, npcls
    ijkcplag = paiv(aiv_plag_icells,ipcls)
    icplag   = paiv(aiv_plag_indexi,ipcls)
    jcplag   = paiv(aiv_plag_indexj,ipcls)
    kcplag   = paiv(aiv_plag_indexk,ipcls)    

    pclsfound = .false.

! - Set lboundSkip(:) to 0 for values of lbound adjacent to a boundary -------

    lboundskip(1:6) = 0 

    IF (icplag < ipcbeg) lboundskip(1) = 1       ! to include ipcbeg = ipcend
    IF (icplag > ipcend) lboundskip(2) = 1       ! case, ELSE IF not used here

    IF (jcplag < jpcbeg) lboundskip(3) = 1 
    IF (jcplag > jpcend) lboundskip(4) = 1

    IF (kcplag < kpcbeg) lboundskip(5) = 1
    IF (kcplag > kpcend) lboundskip(6) = 1

    lboundskipsum = sum(lboundskip)

#ifdef PLAG_CECELLS_DEBUG
!   IF ( iPcls == 6 ) THEN
    WRITE(*,*) '  Inside PLAG_CECellsGetBufferSize: time,iReg,iPcls,iCPlag,jCPlag,kCPlag,',&
               ' ijkCPlag,lboundSkip,lboundSkipSum = ',&
        global%currentTime+ global%dtMin,ireg,ipcls,icplag,jcplag,kcplag, &
        ijkcplag,lboundskip,lboundskipsum
!   ENDIF
#endif 
 
    IF ( lboundskipsum == 0  ) goto 1999

#ifdef PLAG_CECELLS_DEBUG
!   IF ( iPcls == 6 ) THEN
    WRITE(*,*) '  Inside PLAG_CECellsGetBufferSize: Particle Fails Skip Test-',&
               'iReg,iPcls,iCPlag,jCPlag,kCPlag,ijkCPlag = ',&
        ireg,ipcls,icplag,jcplag,kcplag,ijkcplag
!   ENDIF
#endif 

! - Corner Cells --------------------------------------------------------------

    DO icorner=1,ncorners

! - Bypass for noninteracting regions -----------------------------------------

      IF( .NOT. plevel%cornerCells(icorner)%interact ) goto 2999

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

      IF( plevel%cornerCells(icorner)%degenrt /= degenerat_none ) goto 2999

#ifdef PLAG_CECELLS_DEBUG
!       IF ( iPcls == 6 ) THEN
       WRITE(*,*) '  Inside PLAG_CECellsGetBufferSize: Entering Corner Test -iReg,iPcls,iCorner = ',&
        ireg,ipcls,icorner
!       ENDIF
#endif 

! - Loop over corner cell indices ---------------------------------------------

      CALL rflo_getcornercellsindices( region,ilev,icorner, &
                                       ibeg,iend,jbeg,jend,kbeg,kend )

      ibegcorncell = indijk(ibeg,jbeg,kbeg,icoff,ijcoff)
      iendcorncell = indijk(iend,jend,kend,icoff,ijcoff)

! - Increment buffer size 

      ijk = 0
      DO k = kbeg, kend
      DO j = jbeg, jend
      DO i = ibeg, iend
        ijk = ijk+1
        pcorncellsxbuff => plevel%cornerCells(icorner)%cells(ijk)%bufferExchPlag
  
        ijkccell = indijk(i,j,k,icoff,ijcoff)
        IF ( ijkcplag == ijkccell ) THEN
          pclsfound = .true.
          pcorncellsxbuff%nBuffSize = pcorncellsxbuff%nBuffSize + 1
        ENDIF ! ijkCPlag
      ENDDO   ! i
      ENDDO   ! j
      ENDDO   ! k

#ifdef PLAG_CECELLS_DEBUG
!      IF ( iPcls == 6 ) THEN
        WRITE(*,*) & 
     '  Inside PLAG_CECellsGetBufferSize: iReg,iPcls,iCorner,ijkbeg-end,ibeg-endCornCell ',&
      ' pCornCellsXBuff%nBuffSize=',&
        ireg,ipcls,iedge,ibeg,iend,jbeg,jend,kbeg,kend,ibegcorncell, iendcorncell, &
        pcorncellsxbuff%nBuffSize
!       ENDIF
#endif 

! -- Trap error ---------------------------------------------------------------

!      IF ( pCornCellsXBuff%nBuffSize > nBuffSizeTot ) & 
!        CALL ErrorStop( global, ERR_PLAG_ARRAYSIZE,__LINE__ )

2999  CONTINUE
        
    ENDDO       ! iCorner    

! If particle is found in corner, bypass edge search --------------------------

    IF (pclsfound) goto 1999
     
! Edge Cells ------------------------------------------------------------------

    DO iedge=1,nedges

! - Bypass for noninteracting regions -----------------------------------------

      IF( .NOT. plevel%edgeCells(iedge)%interact ) goto 3999

! - Bypass for degenerate edge cells ------------------------------------------

      IF( plevel%edgeCells(iedge)%degenrt /= degenerat_none ) goto 3999
      
#ifdef PLAG_CECELLS_DEBUG
!      IF ( iPcls == 6 ) THEN
       WRITE(stdout,'(A,7(3X,I4))') &
       '  Inside PLAG_CECellsGetBufferSize: Entering Edge Test-iReg,iPcls,iEdge,ijkCPlag,i-j-kCPlag',&     
        ireg,ipcls,iedge,ijkcplag,icplag,jcplag,kcplag

!      END IF ! iPcls 
#endif 

! - Loop over edge cell indices -----------------------------------------------

      CALL rflo_getedgecellsindices( region,ilev,iedge, &
                                     ibeg,iend,jbeg,jend,kbeg,kend )
      ibegedgecell = indijk(ibeg,jbeg,kbeg,icoff,ijcoff)
      iendedgecell = indijk(iend,jend,kend,icoff,ijcoff)

#ifdef PLAG_CECELLS_DEBUG
  WRITE(stdout,'(A,12(2X,I4))') &
  '  Inside PLAG_CECellsGetBufferSize: iReg,iEdge,ijkbeg-end,ibeg-endEdgeCell =',&
        ireg,iedge,ibeg,iend,jbeg,jend,kbeg,kend,ibegedgecell,iendedgecell
#endif 

! - Increment buffer size 

      ijk = 0
      DO k = kbeg, kend
      DO j = jbeg, jend
      DO i = ibeg, iend
        ijk = ijk+1    
        pedgecellsxbuff => plevel%edgeCells(iedge)%cells(ijk)%bufferExchPlag     

        ijkecell = indijk(i,j,k,icoff,ijcoff)
        IF ( ijkcplag == ijkecell ) THEN
          pclsfound = .true.
          pedgecellsxbuff%nBuffSize = pedgecellsxbuff%nBuffSize + 1
        ENDIF ! ijkCPlag

#ifdef PLAG_CECELLS_DEBUG
!      IF ( iPcls == 6 ) THEN
!  WRITE(STDOUT,'(A,12(2X,I4))') &
!  '  Inside PLAG_CECellsGetBufferSize: iReg,iPcls,iEdge,ijkbeg-end,ibeg-endEdgeCell,pEdgeCellsXBuff%nBuffSize=',&
!        iReg,iPcls,iEdge,ibeg,iend,jbeg,jend,kbeg,kend,ibegEdgeCell, iendEdgeCell, &
!        pEdgeCellsXBuff%nBuffSize

  WRITE(stdout,'(A,12(2X,I4))') &
  '  Inside PLAG_CECellsGetBufferSize: iReg,iPcls,iEdge,ijk,ijkCPlag,ijkECell,pEdgeCellsXBuff%nBuffSize=',&
        ireg,ipcls,iedge,i,j,k, &
        ijkcplag, ijkecell,&
        pedgecellsxbuff%nBuffSize
!      ENDIF ! iPcls  
#endif

      ENDDO   ! i
      ENDDO   ! j
      ENDDO   ! k


! -- Trap error ---------------------------------------------------------------

!      IF ( pEdgeCellsXBuff%nBuffSize > nBuffSizeTot ) & 
!        CALL ErrorStop( global, ERR_PLAG_ARRAYSIZE,__LINE__ )

3999  CONTINUE
        
   ENDDO      ! iEdge

#ifdef PLAG_CECELLS_DEBUG
!   IF ( iPcls == 6 ) THEN
    WRITE(*,*) '  Inside PLAG_CECellsGetBufferSize: End of Particle Fails Skip Test-iReg,iPcls = ',&
      ireg,ipcls
!   ENDIF ! iPcls  
#endif

1999 CONTINUE
        
  ENDDO          ! iPcls

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

999 CONTINUE

  CALL deregisterfunction( global )

END SUBROUTINE plag_cecellsgetbuffersize

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_CECellsGetBufferSize.F90,v $
! 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:13  fnajjar
! Initial revision after changing case
!
! Revision 1.5  2004/11/29 19:26:06  fnajjar
! Added bypass statement for dengerate cells and debugging IO
!
! Revision 1.4  2004/03/20 23:36:43  fnajjar
! Initialized buffer sizes before checking particle size to alleviate data clobbering for zero nPcls
!
! Revision 1.3  2004/01/26 22:54:01  fnajjar
! Renamed ifdef PLAG_DEBUG to PLAG_CECELLS_DEBUG
!
! Revision 1.2  2003/11/21 22:41:18  fnajjar
! Activated IFDEF PLAG_DEBUG
!
! Revision 1.1  2003/11/12 21:37:59  fnajjar
! Initial import of Corner-Edge cells Infrastructure
!
!******************************************************************************