PLAG_PatchExchangeConf.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: exchange values between buffers of the corresponding 
!          patches of the adjacent regions (both regions
!          are on the same processor).
!
! Description: none.
!
! Input: region    = current (source) region
!        regionDes = destination region
!        patch     = current patch of region
!        patchDes  = destination patch of regionDes
!        iReg      = index of current region
!        iRegDes   = index of destination region.
!
! Output: regions%levels%plagBuff = variables in buffers.
!
! Notes: intended for conforming grid boundaries only.
!        Patch of current (source) region has data residing in dummy cells and 
!        send them to patch of destination region.
!        RFLO srcLbound corresponds to the destination (Des) region for PLAG
!        since the communication pattern is opposite for PLAG.
!
!******************************************************************************
!
! $Id: PLAG_PatchExchangeConf.F90,v 1.3 2008/12/06 08:44:34 mtcampbe Exp $
!
! Copyright: (c) 2002 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_patchexchangeconf( region,regionDes,patch,patchDes,iReg,iRegDes )

  USE moddatatypes
  USE modpartlag, ONLY    : t_buffer_plag
  USE modbndpatch, ONLY   : t_patch
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global
  USE modindexing, ONLY   : getijk, indijkmap
  USE modinterfaces, ONLY : rflo_getpatchindices, rflo_getpatchdirection, &
        rflo_getcelloffset, rflo_getpatchmapping
  USE moderror
  USE modparameters
  USE plag_modparameters
  IMPLICIT NONE

! ... parameters
  TYPE(t_region) :: region, regiondes
  TYPE(t_patch)  :: patch, patchdes

  INTEGER :: ireg, iregdes

! ... loop variables
  INTEGER :: idum, i, j, k, ii, jj, kk

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

  INTEGER :: ibeg, iend, jbeg, jend, kbeg, kend, idir, jdir, kdir, &
             icoff, ijcoff, ijkd, ilev
  INTEGER :: ibegdes, ienddes, jbegdes, jenddes, kbegdes, kenddes, &
             idirdes, jdirdes, kdirdes, icoffdes, ijcoffdes,       &
             ijkcdes, ilevdes
  INTEGER :: lb, lbdes, l1desdir, l2desdir, mapmat(3,4),           &
             ndumcells, ndumcellsdes

  INTEGER :: ibuff, ibuffdes, ibuffsrc, jbuffdes, jbuffsrc, &
             kbuffdes, kbuffsrc, ijkbuffsrc, nbuffsizedes, nbuffsizesrc
             
  LOGICAL :: align

  INTEGER, POINTER, DIMENSION(:,:) :: paiv, paivdes, paivold, paivolddes

  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv, parvdes,              &
                                           parvold, parvolddes,        &
                                           pcv, pcvdes,                &
                                           pcvold, pcvolddes,          &
                                           pdv, pdvdes, prhs, prhsdes, &
                                           prhssum, prhssumdes, ptv, ptvdes

  TYPE(t_global),      POINTER :: global

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

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

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

! check if the source region is active ----------------------------------------

  IF (regiondes%active == off) THEN
    CALL errorstop( global,err_srcregion_off,__line__ )
  ENDIF

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

  ilev      = region%currLevel
  ndumcells = region%nDumCells

  ilevdes = regiondes%currLevel
  ndumcellsdes = regiondes%nDumCells
  
  CALL rflo_getpatchindices( region,patch,ilev,ibeg,iend, &
                             jbeg,jend,kbeg,kend )
  CALL rflo_getpatchindices( regiondes,patchdes,ilevdes,ibegdes,ienddes, &
                             jbegdes,jenddes,kbegdes,kenddes )
  CALL rflo_getpatchdirection( patch   ,idir   ,jdir,   kdir    )
  CALL rflo_getpatchdirection( patchdes,idirdes,jdirdes,kdirdes )
  CALL rflo_getcelloffset( region   ,ilev,icoff   ,ijcoff    )
  CALL rflo_getcelloffset( regiondes,ilevdes,icoffdes,ijcoffdes )

! Set pointers ----------------------------------------------------------------
 
  paiv  => patch%bufferPlag%aiv
  parv  => patch%bufferPlag%arv
  pcv   => patch%bufferPlag%cv
  pdv   => patch%bufferPlag%dv
  ptv   => patch%bufferPlag%tv
  prhs  => patch%bufferPlag%rhs
  prhssum  => patch%bufferPlag%rhsSum

  paivold  => patch%bufferPlag%aivOld
  parvold  => patch%bufferPlag%arvOld
  pcvold   => patch%bufferPlag%cvOld

  paivdes  => patchdes%bufferPlag%aiv
  parvdes  => patchdes%bufferPlag%arv
  pcvdes   => patchdes%bufferPlag%cv
  pdvdes   => patchdes%bufferPlag%dv
  ptvdes   => patchdes%bufferPlag%tv
  prhsdes  => patchdes%bufferPlag%rhs
  prhssumdes  => patchdes%bufferPlag%rhsSum

  paivolddes  => patchdes%bufferPlag%aivOld
  parvolddes  => patchdes%bufferPlag%arvOld
  pcvolddes   => patchdes%bufferPlag%cvOld

  nbuffsizesrc = patch%bufferPlag%nBuffSize

  nbuffsizedes = nbuffsizesrc
  patchdes%bufferPlag%nBuffSizeDes = nbuffsizedes
  
! exit when Buffer Size is Zero 

  IF ( nbuffsizesrc == 0 )  goto 999

! mapping between patches -----------------------------------------------------

                                       l1desdir =  1
  IF (patch%srcL1beg > patch%srcL1end) l1desdir = -1
                                       l2desdir =  1
  IF (patch%srcL2beg > patch%srcL2end) l2desdir = -1

  lb    = patch%lbound
  lbdes = patch%srcLbound
  align = patch%align

  CALL rflo_getpatchmapping( lb,lbdes,l1desdir,l2desdir,align,                &
                             idir,jdir,kdir,idirdes,jdirdes,kdirdes,          &
                             ibeg,iend,jbeg,jend,kbeg,kend,                   &
                             ibegdes,ienddes,jbegdes,jenddes,kbegdes,kenddes, &
                             mapmat )

! Loop over buffer particles of current patch ---------------------------------

  DO ibuff=1, nbuffsizesrc

    ibuffsrc   = paiv(aiv_plag_indexi,ibuff)
    jbuffsrc   = paiv(aiv_plag_indexj,ibuff)
    kbuffsrc   = paiv(aiv_plag_indexk,ibuff)
    ijkbuffsrc = paiv(aiv_plag_icells,ibuff)
    
    ijkcdes = indijkmap(ibuffsrc,jbuffsrc,kbuffsrc,mapmat,icoffdes,ijcoffdes)
    CALL getijk(ijkcdes,icoffdes,ijcoffdes,ndumcellsdes,ibuffdes,jbuffdes,kbuffdes)

! - Update aiv field ----------------------------------------------------------
    
    paivdes(aiv_plag_icells,ibuff) = ijkcdes    
    paivdes(aiv_plag_indexi,ibuff) = ibuffdes
    paivdes(aiv_plag_indexj,ibuff) = jbuffdes
    paivdes(aiv_plag_indexk,ibuff) = kbuffdes

    paivdes(aiv_plag_pidini,ibuff) = paiv(aiv_plag_pidini,ibuff)
    paivdes(aiv_plag_regini,ibuff) = paiv(aiv_plag_regini,ibuff)
    paivdes(aiv_plag_regcrt,ibuff) = iregdes
    paivdes(aiv_plag_burnstat,ibuff) = paiv(aiv_plag_burnstat,ibuff)
    
    paivolddes(:,ibuff) = paivdes(:,ibuff)

! - Update arv, cv, dv, rhs, rhsSum, tv field ---------------------------------

    parvdes(:,ibuff)    = parv(:,ibuff)
    pcvdes(:,ibuff)     = pcv(:,ibuff)
    pdvdes(:,ibuff)     = pdv(:,ibuff)
    prhsdes(:,ibuff)    = prhs(:,ibuff)
    prhssumdes(:,ibuff) = prhssum(:,ibuff)
    ptvdes(:,ibuff)     = ptv(:,ibuff)

    parvolddes(:,ibuff)    = parvold(:,ibuff)
    pcvolddes(:,ibuff)     = pcvold(:,ibuff)

  ENDDO ! iBuff

! reset Buffer size on Source Region to Zero to trap null-particle regions ----

  patch%bufferPlag%nBuffSize = 0

! finalize

999 CONTINUE

  CALL deregisterfunction( global )

END SUBROUTINE plag_patchexchangeconf

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_PatchExchangeConf.F90,v $
! Revision 1.3  2008/12/06 08:44:34  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:17:47  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2004/12/01 20:57:55  fnajjar
! Initial revision after changing case
!
! Revision 1.6  2004/02/13 23:22:07  fnajjar
! Included new cv and aiv definitions for particle burning module
!
! Revision 1.5  2003/09/21 00:19:58  fnajjar
! Reset buffer size on source region to zero
!
! Revision 1.4  2003/05/15 02:57:05  jblazek
! Inlined index function.
!
! Revision 1.3  2003/02/04 22:32:34  f-najjar
! Bug fix in GetIJK call by loading nDumCellsDes
!
! Revision 1.2  2003/01/17 19:45:21  f-najjar
! Compute nBuffSizeDes for buffer size of destination buffers
!
! Revision 1.1  2003/01/13 19:14:50  f-najjar
! Initial Import of Multiblock capability
!
!******************************************************************************