PLAG_CornCellsLoadData.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 corner 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_CornCellsLoadData.F90,v 1.4 2008/12/06 08:44:33 mtcampbe Exp $
!
! Copyright: (c) 2004 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_corncellsloaddata( 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_getcornercellsindices, &
                            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, icorner, icorncellbuff, ipcls

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

  INTEGER :: ilev, ipclsregin, ncorners, npcls, npclsprev
  INTEGER :: icoff, ijcoff
  INTEGER :: ijkcsrc
  INTEGER :: iccdes, jccdes, kccdes, ijkccdes
  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 :: ibegcorncell, iendcorncell
  INTEGER :: errorflag,iccmax 
  INTEGER :: lpclsfoundincorncellsum
  INTEGER :: npclsbeg, npclsend

  INTEGER,          DIMENSION(9)   :: lpclsfoundincorncell
  INTEGER, POINTER, DIMENSION(:,:) :: paiv, paivold
  INTEGER, POINTER, DIMENSION(:,:) :: paivc, paivoldc
  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: corncellcounter
  
  LOGICAL :: pclsfoundincorncell

  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv, parvold, pcv, pcvold, &
                                           pdv, ptv, prhs, prhssum
  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parvc, parvoldc,pcvc, pcvoldc, &
                                           pdvc, ptvc, prhsc, prhssumc
     
  TYPE(t_region),      POINTER :: pregion
  TYPE(t_level),       POINTER :: plevel
  TYPE(t_plag),        POINTER :: pplag 
  TYPE(t_buffer_plag), POINTER :: pcorncellsxbuff
  TYPE(t_global),      POINTER :: global

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

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

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

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

  ilev     = regions(ireg)%currLevel
  npcls    = regions(ireg)%levels(ilev)%plag%nPcls 
  ncorners = 8

! 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
  icorncellbuff = 0

  pclsfoundincorncell = .false.
  lpclsfoundincorncell = 0

! Allocate corner cell buffer counter -----------------------------------------

  iccmax = 0
  DO icorner=1,ncorners
    IF( plevel%cornerCells(icorner)%interact ) &
      iccmax = max(iccmax,ubound(plevel%cornerCells(icorner)%cells,1))
  ENDDO ! iCorner

  ALLOCATE( corncellcounter(ncorners,iccmax),stat=errorflag )
  global%error = errorflag
  IF (global%error /= err_none) &
    CALL errorstop( global,err_allocate,__line__ )

  corncellcounter = 0

#ifdef PLAG_CECELLS_DEBUG
    print*,'PLAG_CornCellsLoadData: iReg,iCCMax = ', ireg, iccmax
#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)
    
    lpclsfoundincorncell = 0

! - Loop over corners ---------------------------------------------------------

    DO icorner=1,ncorners

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

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

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

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

! -- Get corner cell indices --------------------------------------------------

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

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

! -- Check if particle cell is within corner 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 
        lpclsfoundincorncell(icorner) = 1
        pclsfoundincorncell = .true. 
      ENDIF ! iCPlag

#ifdef PLAG_CECELLS_DEBUG
    print*,'PLAG_CornCellsLoadData: iReg,iCorner,iPcls,ibeg,iend,jbeg,jend,kbeg,kend,',&
           'ibegEdgeCell, iendEdgeCell,i-j-kCPlag,ijkCPlag,nPcls,lPclsFoundInEdgeCell',&
            ireg,icorner,ipcls,ibeg,iend,jbeg,jend,kbeg,kend, &
            ibegcorncell, iendcorncell,icplag,jcplag,kcplag,ijkcplag,npcls, &
            lpclsfoundincorncell(icorner) 
#endif

999 CONTINUE
    END DO ! iCorner

! - Loop over corners ---------------------------------------------------------

    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

! -- Get corner cell indices --------------------------------------------------

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

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

      lpclsfoundincorncellsum = sum( lpclsfoundincorncell )   

! -- Check if particle cell is within edge cells extent -----------------------
     
      IF ( icplag >= ibeg .AND. icplag <= iend .AND. &
           jcplag >= jbeg .AND. jcplag <= jend .AND. &
           kcplag >= kbeg .AND. kcplag <= kend       ) & 
        pclsfoundincorncell = .true.

      IF ( lpclsfoundincorncellsum == 0 ) THEN  

! --- Particle is in physical domain ------------------------------------------
! --- Shift particle datastructure only if particle is not in its proper spot -

        ipclsregin = ipclsregin + 1 

#ifdef PLAG_CECELLS_DEBUG
    print*,' PLAG_CornCellsLoadData: iReg, iCorner, iPcls, iPclsRegIn =',&
                                     ireg, icorner, 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

      ENDIF ! lPclsFoundInCornCellSum

! -- Remove particle from active datastructure for specific corner ------------
     
      IF ( lpclsfoundincorncell(icorner) == 1 ) THEN

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

        ijk  = 0 
        DO k=kbeg,kend
        DO j=jbeg,jend
        DO i=ibeg,iend
          ijk     = ijk + 1
          ijkcsrc = indijk(i,j,k,icoff, ijcoff)
 
! --- Set pointers ------------------------------------------------------------
            
          pcorncellsxbuff => plevel%cornerCells(icorner)%cells(ijk)%bufferExchPlag  
           
          paivc    => pcorncellsxbuff%aiv
          parvc    => pcorncellsxbuff%arv    
          pcvc     => pcorncellsxbuff%cv
          pdvc     => pcorncellsxbuff%dv
          ptvc     => pcorncellsxbuff%tv
          prhsc    => pcorncellsxbuff%rhs
          prhssumc => pcorncellsxbuff%rhsSum
    
          paivoldc => pcorncellsxbuff%aivOld    
          parvoldc => pcorncellsxbuff%arvOld
          pcvoldc  => pcorncellsxbuff%cvOld
           
! --- Destination region infrastructure --------------------------------------
            
          iregdes      =  plevel%cornerCells(icorner)%cells(ijk)%srcRegion 

          IF ( iregdes > 0 .AND. ijkcplag == ijkcsrc .AND. &
               pcorncellsxbuff%nBuffSize /= 0              ) THEN
            ijkccdes     = plevel%cornerCells(icorner)%cells(ijk)%srcCell           
            ndumcellsdes = regions(iregdes)%nDumCells

            CALL rflo_getcelloffset( regions(iregdes),ilev,icoffdes,ijcoffdes )
            CALL getijk( ijkccdes,icoffdes,ijcoffdes,ndumcellsdes, &
                         iccdes,jccdes,kccdes )

            corncellcounter(icorner,ijk) = corncellcounter(icorner,ijk)+1
            icorncellbuff = corncellcounter(icorner,ijk)

#ifdef PLAG_CECELLS_DEBUG
  WRITE(stdout,*) '      PLAG_CornCellsLoadData: iReg,iPcls,iCorner,iRegDes,iCornCellBuff ', &
       ireg,ipcls,icorner,iregdes,icorncellbuff
#endif 

! --- Update aiv field --------------------------------------------------------
    
            paivc(aiv_plag_icells,icorncellbuff) = ijkccdes   
            paivc(aiv_plag_indexi,icorncellbuff) = iccdes
            paivc(aiv_plag_indexj,icorncellbuff) = jccdes
            paivc(aiv_plag_indexk,icorncellbuff) = kccdes
            paivc(aiv_plag_pidini,icorncellbuff) = paiv(aiv_plag_pidini,ipcls)
            paivc(aiv_plag_regini,icorncellbuff) = paiv(aiv_plag_regini,ipcls)
            paivc(aiv_plag_regcrt,icorncellbuff) = iregdes
            paivc(aiv_plag_burnstat,icorncellbuff) = paiv(aiv_plag_burnstat,ipcls)
            paivc(aiv_plag_status,icorncellbuff) = paiv(aiv_plag_status,ipcls)
    
            paivoldc(:           ,icorncellbuff) = paivc(:,icorncellbuff) 
                       
! --- Load communication buffer arrays for corner cells -----------------------

            parvc(   :,icorncellbuff) = parv(   :,ipcls)
            pcvc(    :,icorncellbuff) = pcv(    :,ipcls)
            pdvc(    :,icorncellbuff) = pdv(    :,ipcls)
            ptvc(    :,icorncellbuff) = ptv(    :,ipcls)
            prhsc(   :,icorncellbuff) = prhs(   :,ipcls)
            prhssumc(:,icorncellbuff) = prhssum(:,ipcls)

            parvoldc(:,icorncellbuff) = parvold(:,ipcls)
            pcvoldc( :,icorncellbuff) = pcvold( :,ipcls)

#ifdef PLAG_CECELLS_DEBUG
  WRITE(stdout,*) &
  '      PLAG_CornCellsLoadData: iReg, iCorner, iCornCellBuff, nCornBuffSize, pAiv', &
  ireg,icorner, icorncellbuff, pcorncellsxbuff%nBuffSize,&
  paivc(aiv_plag_icells,icorncellbuff),&
  paivc(aiv_plag_indexi,icorncellbuff),&
  paivc(aiv_plag_indexj,icorncellbuff),&
  paivc(aiv_plag_indexk,icorncellbuff),&
  paivc(aiv_plag_pidini,icorncellbuff),&
  paivc(aiv_plag_regini,icorncellbuff),&
  paivc(aiv_plag_regcrt,icorncellbuff),&
  paivc(aiv_plag_burnstat,icorncellbuff)
#endif 

          ENDIF ! iRegDes

        ENDDO   ! i
        ENDDO   ! j
        ENDDO   ! k

      ENDIF   ! pclsFoundInCornCell         

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

      IF ( lpclsfoundincorncellsum == 0 ) goto 1999

#ifdef PLAG_CECELLS_DEBUG
  WRITE(stdout,'(A,2(2X,I3),2(2X,I4))') &
  '      PLAG_CornCellsLoadData: iReg, iCorner, iCornCellBuff', &
      ireg, icorner, icorncellbuff
#endif

2999 CONTINUE

    ENDDO    ! iCorner

1999 CONTINUE
  ENDDO      ! iPcls

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

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

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

! reinitialize reshuffled particle datastructure to account for ---------------
!   region with null size particle --------------------------------------------
!   perform if data reshuffled and particle size null -------------------------
  
  IF ( pclsfoundincorncell .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_CornCellsLoadData: iReg,nPclsBeg,nPclsEnd = ',&
           ireg,npclsbeg,npclsend
#endif
  ENDIF ! pclsFoundInCornCell

! Deallocate corner cell buffer counter ---------------------------------------

  DEALLOCATE( corncellcounter,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_corncellsloaddata

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_CornCellsLoadData.F90,v $
! Revision 1.4  2008/12/06 08:44:33  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:17:46  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:27  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:07:36  fnajjar
! Added AIV_PLAG_STATUS to receive buffer and fixed nPclsBeg
!
! Revision 1.8  2004/03/20 21:53:15  fnajjar
! Included data reinitilization in an IF statement to alleviate data shrinkage
!
! Revision 1.7  2004/03/20 21:34:23  fnajjar
! Exit routine for null nPcls and reinitialized reshuffled data
!
! Revision 1.6  2004/03/19 23:51:08  fnajjar
! Reworked kernel to handle multiple active corners
!
! 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
!
!******************************************************************************