PLAG_EdgeCellsLoadData.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: loads data buffer size for edge cells
!          and shrinks particle datastructure. 
!
! Description: none.
!
! Input: regions = data of all regions,
!        iReg    = current region number.
!
! Output: region%level%edgeCells%buffExchPlag%aiv,arv,cv,dv,tv   = buffer data.
!         region%level%cornerCells%buffExchPlag%aiv,arv,cv,dv,tv = buffer data.
!         region%level%plag%aiv,arv,cv,dv,tv = Plag data.
!
! Notes: None.
!
!******************************************************************************
!
! $Id: PLAG_EdgeCellsLoadData.F90,v 1.5 2008/12/06 08:44:33 mtcampbe Exp $
!
! Copyright: (c) 2004 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_edgecellsloaddata( regions, iReg )

  USE moddatatypes
  USE modpartlag, ONLY    : t_plag, t_plag_input, t_buffer_plag
  USE moddatastruct, ONLY : t_region, t_level, t_dcell
  USE modglobal, ONLY     : t_global  
  USE modindexing, ONLY   : getijk
  USE modinterfaces, ONLY : rflo_getcelloffset,         &
                            rflo_getedgecellsindices,   &
                            rflo_getdimensphys
  USE moderror
  USE modparameters
  USE plag_modparameters
  IMPLICIT NONE

#include "Indexing.h"

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

  INTEGER, INTENT(IN)     :: ireg

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

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

  INTEGER :: ilev, ipclsregin, nedges, npcls, npclsprev
  INTEGER :: icoff, ijcoff
  INTEGER :: ijkcsrc, ijkesrc
  INTEGER :: iecdes, jecdes, kecdes, ijkecdes
  INTEGER :: icplag, ipcbeg, ipcend, ibeg, iend, ijkcplag
  INTEGER :: jcplag, jpcbeg, jpcend, jbeg, jend
  INTEGER :: kcplag, kpcbeg, kpcend, kbeg, kend
  INTEGER :: icoffdes, ijcoffdes, ndumcellsdes, iregdes
  INTEGER :: ibegedgecell,iendedgecell 
  INTEGER :: errorflag,iecmax
  INTEGER :: lpclsfoundinedgecellsum
  INTEGER :: npclsbeg, npclsend

  INTEGER,          DIMENSION(12)  :: lpclsfoundinedgecell
  INTEGER, POINTER, DIMENSION(:,:) :: paiv, paivold
  INTEGER, POINTER, DIMENSION(:,:) :: paivc, paivoldc
  INTEGER, POINTER, DIMENSION(:,:) :: paive, paivolde
  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: edgecellcounter

  LOGICAL :: pclsfoundinedgecell
  
  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv, parvold, pcv, pcvold, &
                                           pdv, ptv, prhs, prhssum
  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parve, parvolde,pcve, pcvolde, &
                                           pdve, ptve, prhse, prhssume
     
  TYPE(t_region),      POINTER :: pregion
  TYPE(t_level),       POINTER :: plevel
  TYPE(t_plag),        POINTER :: pplag 
  TYPE(t_buffer_plag), POINTER :: pedgecellsxbuff
  TYPE(t_global),      POINTER :: global

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

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

  global => regions(ireg)%global
    
  CALL registerfunction( global, 'PLAG_EdgeCellsLoadData',&
  'PLAG_EdgeCellsLoadData.F90' )

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

  ilev   = regions(ireg)%currLevel
  npcls  = regions(ireg)%levels(ilev)%plag%nPcls 
  nedges = 12

! Set pointers ----------------------------------------------------------------
  
  pregion => regions(ireg)
  plevel  => regions(ireg)%levels(ilev) 
  pplag   => plevel%plag   
  paiv    => pplag%aiv
  parv    => pplag%arv
  pcv     => pplag%cv
  pdv     => pplag%dv
  ptv     => pplag%tv
  prhs    => pplag%rhs
  prhssum => pplag%rhsSum

  paivold => pplag%aivOld
  parvold => pplag%arvOld
  pcvold  => pplag%cvOld

! Exit for null number of particles -------------------------------------------

  IF ( pplag%nPcls == 0 ) goto 3999  
  
! Get grid dimensions ---------------------------------------------------------
  
  CALL rflo_getdimensphys( pregion,ilev,ipcbeg,ipcend, &
                           jpcbeg,jpcend,kpcbeg,kpcend )

! Get cell offset -------------------------------------------------------------

  CALL rflo_getcelloffset( pregion,ilev,icoff,ijcoff )
  
! Initialize counters for particles in inside and buffer regions --------------
  
  ipclsregin    = 0
  iedgecellbuff = 0

  pclsfoundinedgecell = .false.
  lpclsfoundinedgecell = 0

! Allocate edge cell buffer counter -------------------------------------------

  iecmax = 0
  DO iedge=1,nedges
    IF( plevel%edgeCells(iedge)%interact ) &
      iecmax = max(iecmax,ubound(plevel%edgeCells(iedge)%cells,1))
  ENDDO ! iEdge

  ALLOCATE( edgecellcounter(nedges,iecmax),stat=errorflag )
  global%error = errorflag
  IF (global%error /= err_none) &
    CALL errorstop( global,err_allocate,__line__ )

  edgecellcounter = 0

#ifdef PLAG_CECELLS_DEBUG
    print*,'PLAG_EdgeCellsLoadData: iReg,iECMax = ', ireg, iecmax
#endif

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

  DO ipcls=1,npcls

    icplag   = paiv(aiv_plag_indexi,ipcls)
    jcplag   = paiv(aiv_plag_indexj,ipcls)
    kcplag   = paiv(aiv_plag_indexk,ipcls)
    ijkcplag = paiv(aiv_plag_icells,ipcls)
    
    lpclsfoundinedgecell = 0

! - Loop over edges -----------------------------------------------------------
   
    DO iedge=1,nedges 

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

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

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

      IF( plevel%edgeCells(iedge)%degenrt /= degenerat_none ) goto 999

! -- Get edge cell indices ----------------------------------------------------

      CALL rflo_getedgecellsindices( pregion,ilev,iedge, &
                                     ibeg,iend,jbeg,jend,kbeg,kend )

      ibegedgecell = indijk(ibeg,jbeg,kbeg,icoff,ijcoff)
      iendedgecell = indijk(iend,jend,kend,icoff,ijcoff)

! -- Check if particle cell is within edge cells extent -----------------------
! --  set flag to take care of multiple active edges --------------------------    

      IF ( icplag >= ibeg .AND. icplag <= iend .AND. &
           jcplag >= jbeg .AND. jcplag <= jend .AND. &
           kcplag >= kbeg .AND. kcplag <= kend       ) THEN 
        lpclsfoundinedgecell(iedge) = 1
        pclsfoundinedgecell = .true. 
      ENDIF ! iCPlag

#ifdef PLAG_CECELLS_DEBUG
    print*,'PLAG_EdgeCellsLoadData: iReg,iEdge,iPcls,ibeg,iend,jbeg,jend,kbeg,kend,',&
           'ibegEdgeCell, iendEdgeCell,i-j-kCPlag,ijkCPlag,nPcls,lPclsFoundInEdgeCell',&
            ireg,iedge,ipcls,ibeg,iend,jbeg,jend,kbeg,kend, &
            ibegedgecell, iendedgecell,icplag,jcplag,kcplag,ijkcplag,npcls, &
            lpclsfoundinedgecell(iedge) 
#endif

999 CONTINUE
    END DO ! iEdge
    
! - Loop over edges -----------------------------------------------------------

    DO iedge=1,nedges 

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

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

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

      IF( plevel%edgeCells(iedge)%degenrt /= degenerat_none ) goto 2999

! -- Get edge cell indices ----------------------------------------------------

      CALL rflo_getedgecellsindices( pregion,ilev,iedge, &
                                     ibeg,iend,jbeg,jend,kbeg,kend )

! -- Determine sum of lPclsFoundInEdgeCell ------------------------------------
!      Such particle is in the physical domain --------------------------------

      lpclsfoundinedgecellsum = sum( lpclsfoundinedgecell )     

! -- Particle is in physical domain -------------------------------------------
! -- Shift particle datastructure only if particle is not in its proper spot --
       
      IF ( lpclsfoundinedgecellsum == 0 ) THEN  

        ipclsregin = ipclsregin + 1 

#ifdef PLAG_CECELLS_DEBUG
    print*,' PLAG_EdgeCellsLoadData: iReg, iEdge, iPcls,iPclsRegIn =',&
                                     ireg, iedge, ipcls,ipclsregin
#endif

        IF ( ipclsregin /= ipcls ) THEN
          paiv(   :,ipclsregin) = paiv(   :,ipcls)
          parv(   :,ipclsregin) = parv(   :,ipcls)
          pcv(    :,ipclsregin) = pcv(    :,ipcls)
          pdv(    :,ipclsregin) = pdv(    :,ipcls)
          ptv(    :,ipclsregin) = ptv(    :,ipcls)
          prhs(   :,ipclsregin) = prhs(   :,ipcls)
          prhssum(:,ipclsregin) = prhssum(:,ipcls)

          paivold(:,ipclsregin) = paivold(:,ipcls)
          parvold(:,ipclsregin) = parvold(:,ipcls)
          pcvold( :,ipclsregin) = pcvold( :,ipcls)
        ENDIF ! iPclsRegIn

! -- Remove particle from active datastructure for specific edge --------------
                
      ENDIF ! lPclsFoundInEdgeCellSum
      
      IF ( lpclsfoundinedgecell(iedge) == 1 ) THEN  

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

        ijk = 0
        DO k=kbeg,kend
        DO j=jbeg,jend
        DO i=ibeg,iend
          ijk     = ijk + 1
          ijkesrc = indijk(i,j,k,icoff, ijcoff)

! --- Set pointers ------------------------------------------------------------

          pedgecellsxbuff => plevel%edgeCells(iedge)%cells(ijk)%bufferExchPlag     
           
          paive    => pedgecellsxbuff%aiv
          parve    => pedgecellsxbuff%arv    
          pcve     => pedgecellsxbuff%cv
          pdve     => pedgecellsxbuff%dv
          ptve     => pedgecellsxbuff%tv
          prhse    => pedgecellsxbuff%rhs
          prhssume => pedgecellsxbuff%rhsSum
    
          paivolde => pedgecellsxbuff%aivOld    
          parvolde => pedgecellsxbuff%arvOld
          pcvolde  => pedgecellsxbuff%cvOld
            
! --- Destination region infrastructure ---------------------------------------
            
          iregdes      =  plevel%edgeCells(iedge)%cells(ijk)%srcRegion 

          IF ( iregdes > 0 .AND. ijkcplag == ijkesrc .AND. &
               pedgecellsxbuff%nBuffSize /= 0              ) THEN
            ijkecdes     = plevel%edgeCells(iedge)%cells(ijk)%srcCell           
            ndumcellsdes = regions(iregdes)%nDumCells

            CALL rflo_getcelloffset( regions(iregdes),ilev,icoffdes,ijcoffdes )
            CALL getijk( ijkecdes,icoffdes,ijcoffdes,ndumcellsdes, &
                         iecdes,jecdes,kecdes )

            edgecellcounter(iedge,ijk) = edgecellcounter(iedge,ijk)+1
            iedgecellbuff = edgecellcounter(iedge,ijk)

#ifdef PLAG_CECELLS_DEBUG
  WRITE(stdout,*) '      PLAG_EdgeCellsLoadData: iReg,iPcls,iEdge,iRegDes,iEdgeCellBuff ', &
       ireg, ipcls, iedge, iregdes, iedgecellbuff
#endif 
                    
! --- Update aiv field --------------------------------------------------------
    
            paive(aiv_plag_icells,iedgecellbuff) = ijkecdes   
            paive(aiv_plag_indexi,iedgecellbuff) = iecdes
            paive(aiv_plag_indexj,iedgecellbuff) = jecdes
            paive(aiv_plag_indexk,iedgecellbuff) = kecdes
            paive(aiv_plag_pidini,iedgecellbuff) = paiv(aiv_plag_pidini,ipcls)
            paive(aiv_plag_regini,iedgecellbuff) = paiv(aiv_plag_regini,ipcls)
            paive(aiv_plag_regcrt,iedgecellbuff) = iregdes
            paive(aiv_plag_burnstat,iedgecellbuff) = paiv(aiv_plag_burnstat,ipcls)
            paive(aiv_plag_status,iedgecellbuff) = paiv(aiv_plag_status,ipcls)
    
            paivolde(:           ,iedgecellbuff) = paive(:,iedgecellbuff) 
                       
! --- Load communication buffer arrays for corner cells -----------------------

            parve(   :,iedgecellbuff) = parv(   :,ipcls)
            pcve(    :,iedgecellbuff) = pcv(    :,ipcls)
            pdve(    :,iedgecellbuff) = pdv(    :,ipcls)
            ptve(    :,iedgecellbuff) = ptv(    :,ipcls)
            prhse(   :,iedgecellbuff) = prhs(   :,ipcls)
            prhssume(:,iedgecellbuff) = prhssum(:,ipcls)

            parvolde(:,iedgecellbuff) = parvold(:,ipcls)
            pcvolde( :,iedgecellbuff) = pcvold( :,ipcls)

#ifdef PLAG_CECELLS_DEBUG
  WRITE(stdout,*) &
  '      PLAG_EdgeCellsLoadData: iReg, iEdge, iEdgeCellBuff, nEdgeBuffSize, pAiv', &
  ireg, iedge, iedgecellbuff, pedgecellsxbuff%nBuffSize,&
  paive(aiv_plag_icells,iedgecellbuff),&
  paive(aiv_plag_indexi,iedgecellbuff),&
  paive(aiv_plag_indexj,iedgecellbuff),&
  paive(aiv_plag_indexk,iedgecellbuff),&
  paive(aiv_plag_pidini,iedgecellbuff),&
  paive(aiv_plag_regini,iedgecellbuff),&
  paive(aiv_plag_regcrt,iedgecellbuff),&
  paive(aiv_plag_burnstat,iedgecellbuff)
#endif  

          ENDIF ! iRegDes

        ENDDO   ! i
        ENDDO   ! j
        ENDDO   ! k

      ENDIF   ! lPclsFoundInEdgeCell       

! ---- Exit edge search if particle is in physical domain ------------------

      IF ( lpclsfoundinedgecellsum == 0 ) goto 1999

#ifdef PLAG_CECELLS_DEBUG
  WRITE(stdout,'(A,2(2X,I3),2(2X,I4))') &
  '      PLAG_EdgeCellsLoadData: iReg, iEdge, iEdgeCellBuff', &
      ireg, iedge, iedgecellbuff
#endif

2999 CONTINUE

    ENDDO    ! iEdge

1999 CONTINUE
  ENDDO      ! iPcls

! Get new particle datasize --------------------------------------------------

  npclsprev = pplag%nPcls 
  IF ( pclsfoundinedgecell ) pplag%nPcls = ipclsregin

#ifdef PLAG_CECELLS_DEBUG    
  WRITE(stdout,'(A,I4,2I8,2X,L1)') &
  '      PLAG_EdgeCellsLoadData: iReg,nPclsPrev,nPclsCurr,pclsFoundInEdgeCell = ',&
         ireg,npclsprev,pplag%nPcls,pclsfoundinedgecell
#endif  

! reinitialize reshuffled particle datastructure to account for ---------------
!   region with null size particle --------------------------------------------
!   perform if data reshuffled and particle size null -------------------------

  IF ( pclsfoundinedgecell .AND. pplag%nPcls == 0) THEN 
    npclsbeg = max(1,pplag%nPcls+1)
    npclsend = npclsprev
  
    pplag%aiv(:   ,npclsbeg:npclsend) = 0
    pplag%aivOld(:,npclsbeg:npclsend) = 0
    pplag%arv(:   ,npclsbeg:npclsend) = 0.0_rfreal
    pplag%arvOld(:,npclsbeg:npclsend) = 0.0_rfreal
    pplag%cv(:    ,npclsbeg:npclsend) = 0.0_rfreal
    pplag%cvOld(: ,npclsbeg:npclsend) = 0.0_rfreal
    pplag%rhs(:   ,npclsbeg:npclsend) = 0.0_rfreal
    pplag%rhsSum(:,npclsbeg:npclsend) = 0.0_rfreal

#ifdef PLAG_CECELLS_DEBUG    
    WRITE(stdout,'(A,I4,2I8,2X,L1)') &
    '      PLAG_EdgeCellsLoadData: iReg,nPclsBeg,nPclsEnd = ',&
           ireg,npclsbeg,npclsend
#endif
  ENDIF ! pclsFoundInEdgeCell

! Deallocate edge cell buffer counter -----------------------------------------

  DEALLOCATE( edgecellcounter,stat=errorflag )
  global%error = errorflag
  IF (global%error /= err_none) &
    CALL errorstop( global,err_deallocate,__line__ )

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

3999 CONTINUE

  CALL deregisterfunction( global )

END SUBROUTINE plag_edgecellsloaddata

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_EdgeCellsLoadData.F90,v $
! Revision 1.5  2008/12/06 08:44:33  mtcampbe
! Updated license.
!
! Revision 1.4  2008/11/19 22:17:46  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.3  2006/04/07 15:19:23  haselbac
! Removed tabs
!
! Revision 1.2  2004/12/01 21:09:35  fnajjar
! Initial revision after changing case
!
! Revision 1.10  2004/11/29 19:27:08  fnajjar
! Added bypass statement for dengerate cells
!
! Revision 1.9  2004/04/09 23:09:16  fnajjar
! Added AIV_PLAG_STATUS to receive buffer and fixed nPclsBeg
!
! Revision 1.8  2004/03/20 21:53:16  fnajjar
! Included data reinitilization in an IF statement to alleviate data shrinkage
!
! Revision 1.7  2004/03/20 21:34:51  fnajjar
! Exit routine for null nPcls and reinitialized reshuffled data
!
! Revision 1.6  2004/03/19 23:51:30  fnajjar
! Reworked kernel to handle multiple active edges
!
! Revision 1.5  2004/03/18 21:41:52  fnajjar
! Various bug fixed for proper buffer loading
!
! Revision 1.4  2004/02/13 23:22:07  fnajjar
! Included new cv and aiv definitions for particle burning module
!
! Revision 1.3  2004/01/29 16:52:48  fnajjar
! Included search bypass for particles in physical domain
!
! Revision 1.2  2004/01/28 16:10:28  fnajjar
! Moved statements inside IF iReg for correct syntax
!
! Revision 1.1  2004/01/26 22:56:28  fnajjar
! Initial import for corner-edge cells to load buffer data
!
!******************************************************************************