PLAG_GetCellIndicesOutflow.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: Search algorithm for cell indices
!          for outflow boundary conditions
!          since no geometry information is available for dummy cells. 
!
! Description: none.
!
! Input: region = current region.
!
! Output: region%levels%plag%aiv
!         region%levels%plag%aivOld
!
! Notes: Test only if particle is no longer in inner cells.
!
!******************************************************************************
!
! $Id: PLAG_GetCellIndicesOutflow.F90,v 1.3 2008/12/06 08:44:33 mtcampbe Exp $
!
! Copyright: (c) 2002 by the University of Illinois
!
!******************************************************************************

SUBROUTINE plag_getcellindicesoutflow( region )

  USE moddatatypes
  USE modpartlag, ONLY    : t_plag, t_plag_input
  USE modbndpatch, ONLY   : t_patch
  USE moddatastruct, ONLY : t_region
  USE modglobal, ONLY     : t_global  
  USE modinterfaces, ONLY : rflo_getpatchindices, rflo_getpatchdirection, &
                            rflo_getnodeoffset,   rflo_getcelloffset,     &
                            rflo_getdimensphys
  USE moderror
  USE modparameters
  USE plag_modparameters
  IMPLICIT NONE

#include "Indexing.h"

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

! ... loop variables
  INTEGER :: ipatch, ipcls

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

  INTEGER :: bctype, ilev, lbound, npatches, npcls
  INTEGER :: icoff, ijcoff, inoff, ijnoff, ijknpatch
  INTEGER :: icplag, ipcbeg, ipcend, ibeg, iend, idir
  INTEGER :: jcplag, jpcbeg, jpcend, jbeg, jend, jdir
  INTEGER :: kcplag, kpcbeg, kpcend, kbeg, kend, kdir

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

  LOGICAL :: lboundskip(6)

  REAL(RFREAL)               :: dpgrid, sgn
  REAL(RFREAL), DIMENSION(3) :: diffpos, facecentroid, posplag, sface
  REAL(RFREAL), POINTER, DIMENSION(:,:)   :: pcv, psi, psj, psk
  REAL(RFREAL), POINTER, DIMENSION(:,:,:) :: pfc

  TYPE(t_patch),  POINTER :: ppatch
  TYPE(t_plag),   POINTER :: pplag
  TYPE(t_global), POINTER :: global
  
!******************************************************************************

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

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

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

  ilev  = region%currLevel
  npcls = region%levels(ilev)%plag%nPcls 
  
  IF (npcls == 0) goto 999 ! exit if no particles

  npatches = region%nPatches

  CALL rflo_getdimensphys( region,ilev,ipcbeg,ipcend, &
                           jpcbeg,jpcend,kpcbeg,kpcend )

  CALL rflo_getcelloffset( region,ilev,icoff,ijcoff )
  CALL rflo_getnodeoffset( region,ilev,inoff,ijnoff )

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

  pplag   => region%levels(ilev)%plag 
  paiv    => pplag%aiv 
  paivold => pplag%aivOld 
  pcv     => pplag%cv

  psi     => region%levels(ilev)%plag%si
  psj     => region%levels(ilev)%plag%sj
  psk     => region%levels(ilev)%plag%sk

  pfc     => region%levels(ilev)%plag%fc 

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

  DO ipcls = 1, npcls

    icplag = paiv(aiv_plag_indexi,ipcls)
    jcplag = paiv(aiv_plag_indexj,ipcls)
    kcplag = paiv(aiv_plag_indexk,ipcls)
    
! - Cycle if particle is not adjacent to a boundary ---------------------------

    IF (ipcbeg < icplag .AND. icplag < ipcend .AND. &
        jpcbeg < jcplag .AND. jcplag < jpcend .AND. &
        kpcbeg < kcplag .AND. kcplag < kpcend ) cycle

    posplag(xcoord:zcoord) = pcv(cv_plag_xpos:cv_plag_zpos,ipcls)
        
! - Set lboundSkip(:) to .TRUE. for values of lbound adjacent to a boundary ---

    lboundskip(1:6) = .true.

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

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

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

! - Loop over patches ---------------------------------------------------------

    DO ipatch=1,npatches

      ppatch => region%levels(ilev)%patches(ipatch)
      lbound =  ppatch%lbound
      IF (lboundskip(lbound)) cycle

      bctype = ppatch%bcType
    
! - Select outflow boundary condition type ------------------------------------

      IF ( bctype>=bc_outflow .AND. bctype<=bc_outflow+bc_range ) THEN 

! ----- Check if particle cell is within (physical cells of) patch ------------

        CALL rflo_getpatchindices( region,ppatch,ilev, &
                                   ibeg,iend,jbeg,jend,kbeg,kend )

        IF ( ibeg <= icplag .AND. icplag <= iend .AND. &
             jbeg <= jcplag .AND. jcplag <= jend .AND. &
             kbeg <= kcplag .AND. kcplag <= kend ) THEN

! ------- Select correct face vector and make it point inwards ----------------

          CALL rflo_getpatchdirection( ppatch,idir,jdir,kdir )

          IF (lbound==1 .OR. lbound==3 .OR. lbound==5) THEN
            sgn   = -1.0_rfreal
            ijknpatch = indijk(icplag,jcplag,kcplag,inoff,ijnoff)
          ELSE
            sgn   = +1.0_rfreal
            ijknpatch = indijk(icplag-idir,jcplag-jdir,kcplag-kdir,inoff,ijnoff)
          ENDIF ! lbound

          SELECT CASE (lbound)

            CASE(1,2)
              sface(1:3)        = sgn*psi(xcoord:zcoord,       ijknpatch)
              facecentroid(1:3) =     pfc(xcoord:zcoord,icoord,ijknpatch)

            CASE(3,4)
              sface(1:3)        = sgn*psj(xcoord:zcoord,       ijknpatch)
              facecentroid(1:3) =     pfc(xcoord:zcoord,jcoord,ijknpatch)

            CASE(5,6)
              sface(1:3)        = sgn*psk(xcoord:zcoord,       ijknpatch)
              facecentroid(1:3) =     pfc(xcoord:zcoord,kcoord,ijknpatch)

          END SELECT ! lbound

          diffpos(1:3) = posplag(1:3)-facecentroid(1:3)
          dpgrid       = dot_product(sface,diffpos)

! ------- Test for particle exiting computational domain ----------------------

          IF ( dpgrid < 0.0_rfreal ) THEN

            paivold(aiv_plag_icells,ipcls) = paiv(aiv_plag_icells,ipcls)
            paivold(aiv_plag_indexi,ipcls) = icplag
            paivold(aiv_plag_indexj,ipcls) = jcplag
            paivold(aiv_plag_indexk,ipcls) = kcplag

            icplag = icplag - idir ! update indices to new (dummy) cell
            jcplag = jcplag - jdir
            kcplag = kcplag - kdir

            paiv(   aiv_plag_icells,ipcls) = indijk(icplag,jcplag,kcplag,icoff,ijcoff)
            paiv(   aiv_plag_indexi,ipcls) = icplag
            paiv(   aiv_plag_indexj,ipcls) = jcplag
            paiv(   aiv_plag_indexk,ipcls) = kcplag

          ENDIF ! dpGrid
        ENDIF   ! iCPlag, jCPlag, kCPlag
      ENDIF     ! bcType
    ENDDO       ! iPatch
  ENDDO         ! iPcls

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

999  CONTINUE
  CALL deregisterfunction( global )

END SUBROUTINE plag_getcellindicesoutflow

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_GetCellIndicesOutflow.F90,v $
! Revision 1.3  2008/12/06 08:44:33  mtcampbe
! Updated license.
!
! Revision 1.2  2008/11/19 22:17:46  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.1  2004/12/01 20:57:34  fnajjar
! Initial revision after changing case
!
! Revision 1.5  2003/11/03 21:21:51  fnajjar
! Changed definition of face vectors pointing to PLAG datastructure
!
! Revision 1.4  2003/05/15 02:57:05  jblazek
! Inlined index function.
!
! Revision 1.3  2003/05/01 22:58:30  jferry
! overhauled structure in order to optimize performance
!
! Revision 1.2  2003/01/16 20:15:11  f-najjar
! Removed iRegionGlobal
!
! Revision 1.1  2002/10/25 14:15:43  f-najjar
! Initial Import of Rocpart
!
!******************************************************************************