PLAG_UpdateDataStruct.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: Update the particle datastructure by removing particles flagged for
!   deletion.
!
! Description: None.
!
! Input: 
!  pRegion     Pointer to region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: PLAG_UpdateDataStruct.F90,v 1.12 2008/12/06 08:44:36 mtcampbe Exp $
!
! Copyright: (c) 2004 by the University of Illinois
!
! ******************************************************************************

#ifdef RFLO
SUBROUTINE plag_updatedatastruct(pRegion,iReg)
#endif

#ifdef RFLU
SUBROUTINE plag_updatedatastruct(pRegion)
#endif

  USE moddatatypes
  USE modparameters
  USE moderror
  USE modglobal, ONLY: t_global
  USE moddatastruct, ONLY: t_region
  USE modpartlag, ONLY: t_plag
  USE modmpi
 
  USE plag_modparameters    
   
  IMPLICIT NONE

! ******************************************************************************
! Declarations and definitions
! ******************************************************************************

! ==============================================================================  
! Arguments 
! ==============================================================================  

#ifdef RFLO
  TYPE(t_region) :: pregion
  INTEGER, INTENT(IN) :: ireg
#endif

#ifdef RFLU
  TYPE(t_region), POINTER :: pregion
#endif

! ==============================================================================  
! Locals
! =============================================================================  

  CHARACTER(CHRLEN) :: rcsidentstring

#ifdef RFLO
  INTEGER :: ilev
#endif
#ifdef RFLU
  INTEGER :: ireg
#endif

  INTEGER :: iaiv,iarv,icv,idv,igap,ipcl,itv,naiv,narv,ncv,ndv,&
             npclsbeg,npclsend,npclsprev,ntv
  INTEGER, DIMENSION(:,:), POINTER :: paiv,paivold
  REAL(RFREAL), DIMENSION(:,:), POINTER :: parv,parvold,pcv,pcvold,pdv,&
                                           prhs,prhssum,ptv
  TYPE(t_global), POINTER :: global
  TYPE(t_plag),   POINTER :: pplag

! ******************************************************************************
! Start
! ******************************************************************************

  rcsidentstring = '$RCSfile: PLAG_UpdateDataStruct.F90,v $ $Revision: 1.12 $'

  global => pregion%global

  CALL registerfunction(global,'PLAG_UpdateDataStruct',&
  'PLAG_UpdateDataStruct.F90')
  
! ******************************************************************************
! Set variables and pointers
! ******************************************************************************

#ifdef RFLO
  ilev  =  pregion%currLevel
  pplag => pregion%levels(ilev)%plag
#endif

#ifdef RFLU
  pplag => pregion%plag
#endif

  paiv  => pplag%aiv
  parv  => pplag%arv
  pcv   => pplag%cv
  pdv   => pplag%dv
  prhs  => pplag%rhs
  prhssum => pplag%rhsSum
  ptv   => pplag%tv

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

! ******************************************************************************
! Get dimensions
! ******************************************************************************

  naiv = pplag%nAiv
  narv = pplag%nArv
  ncv  = pplag%nCv
  ndv  = pplag%nDv
  ntv  = pplag%nTv

#ifdef RFLU
  ireg  = pregion%iRegionGlobal
#endif

! ******************************************************************************
! Loop over particles
! ******************************************************************************

  igap = 1
  ipcl = pplag%nPcls 

  searchloop: DO

! ==============================================================================  
!   Copy data if DELETE status in iGap and KEEP status in iPcl
! ==============================================================================  

    IF ( ( paiv(aiv_plag_status,igap) /= plag_status_keep   .AND. &
           paiv(aiv_plag_status,igap) /= plag_status_comm ) .AND. &
         ( paiv(aiv_plag_status,ipcl) == plag_status_keep   .OR.  &
           paiv(aiv_plag_status,ipcl) == plag_status_comm )       ) THEN

! ------------------------------------------------------------------------------
!      Copy data and set status to keep
! ------------------------------------------------------------------------------       
   
       DO iaiv = 1, naiv
         paiv(iaiv,igap)    = paiv(iaiv,ipcl)
         paivold(iaiv,igap) = paivold(iaiv,ipcl)
       END DO ! iAiv
    
       DO iarv = 1, narv
         parv(iarv,igap)    = parv(iarv,ipcl)
         parvold(iarv,igap) = parvold(iarv,ipcl)
       END DO ! iArv
  
       DO icv = 1, ncv
         pcv(icv,igap)     = pcv(icv,ipcl)
         pcvold( icv,igap) = pcvold(icv,ipcl)
         prhs(icv,igap)    = prhs(icv,ipcl)
         prhssum(icv,igap) = prhssum(icv,ipcl)   
       END DO ! iCv

       DO idv = 1, ndv
         pdv(idv,igap)     = pdv(idv,ipcl)
       END DO ! iDv
  
       DO itv = 1, ntv
         ptv(itv,igap)     = ptv(itv,ipcl)
       END DO ! iDv
  
       paiv(aiv_plag_status,igap) = paiv(aiv_plag_status,ipcl)
   
! ------------------------------------------------------------------------------
!      Increment/decrement counters
! ------------------------------------------------------------------------------    
    
       igap = igap + 1
       ipcl = ipcl - 1
       
! ==============================================================================
!   Update counters if KEEP or COMM status in iGap and DELETE status in iPcl
! ==============================================================================       
       
    ELSE
      IF ( paiv(aiv_plag_status,igap) == plag_status_keep .OR. &
           paiv(aiv_plag_status,igap) == plag_status_comm      ) THEN        
        igap = igap + 1 
      END IF ! pAiv
      
      IF ( paiv(aiv_plag_status,ipcl) == plag_status_delete ) THEN 
        ipcl = ipcl - 1
      END IF ! pAiv 
    END IF ! pAiv(AIV_PLAG_STATUS,iGap)

! ==============================================================================  
!   Exit update
! ==============================================================================  

    IF ( igap > ipcl ) THEN
      EXIT searchloop
    END IF ! iGap
  END DO searchloop

! ******************************************************************************
! Update number of particles
! ******************************************************************************
 
  npclsprev   = pplag%nPcls  
  pplag%nPcls = ipcl

  npclsbeg = max(1,pplag%nPcls+1)
  npclsend = npclsprev

! ******************************************************************************
! Initialize datastructure to crazy for particles between nPclsBeg and nPclsEnd
! ******************************************************************************

  DO ipcl = npclsbeg, npclsend
    DO iaiv = 1, naiv
      paiv(iaiv,ipcl)    = crazy_value_int 
      paivold(iaiv,ipcl) = crazy_value_int 
    END DO ! iAiv

    DO iarv = 1, narv
      parv(iarv,ipcl)    = REAL(crazy_value_int,kind=rfreal)
      parvold(iarv,ipcl) = REAL(crazy_value_int,kind=rfreal)
    END DO ! iArv

    DO icv = 1, ncv
      pcv(icv,ipcl)     = REAL(crazy_value_int,kind=rfreal)
      pcvold(icv,ipcl)  = REAL(crazy_value_int,kind=rfreal)
      prhs(icv,ipcl)    = REAL(crazy_value_int,kind=rfreal)
      prhssum(icv,ipcl) = REAL(crazy_value_int,kind=rfreal)
    END DO ! iCv

    DO idv = 1, ndv
      pdv(idv,ipcl)     = REAL(crazy_value_int,kind=rfreal)
    END DO ! iDv

    DO itv = 1, ntv
      ptv(itv,ipcl)     = REAL(crazy_value_int,kind=rfreal)
    END DO ! iTv
  END DO ! iPcl 

! ******************************************************************************
! End
! ******************************************************************************

  CALL deregisterfunction(global)

END SUBROUTINE plag_updatedatastruct

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_UpdateDataStruct.F90,v $
! Revision 1.12  2008/12/06 08:44:36  mtcampbe
! Updated license.
!
! Revision 1.11  2008/11/19 22:17:48  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.10  2006/04/07 15:19:24  haselbac
! Removed tabs
!
! Revision 1.9  2005/12/30 16:29:59  fnajjar
! Added dv and tv in data reshuffle for consistency in GatherSurfStats
!
! Revision 1.8  2005/05/18 22:22:33  fnajjar
! Adapted to parallelization within RFLU
!
! Revision 1.7  2004/07/01 23:05:11  fnajjar
! Added aivOld to data shuffle kernel to inline with particle trajectory motion
!
! Revision 1.6  2004/05/22 00:15:16  fnajjar
! Bug fixes for proper definition of nPclsBeg and nPclsEnd
!
! Revision 1.5  2004/05/05 21:47:44  fnajjar
! Bug Fix: updating cvOld and arvOld in datastructure
!
! Revision 1.4  2004/05/05 21:20:38  fnajjar
! Clean up and simplification
!
! Revision 1.3  2004/04/09 22:58:59  fnajjar
! Made routine RFLO-aware with ifdef and included bug fix for datastructure reinitialization
!
! Revision 1.2  2004/04/07 20:26:07  fnajjar
! Redesigned kernel to account for degeneracy case of last particle to be removed
!
! Revision 1.1  2004/03/26 21:33:48  fnajjar
! Initial import for plag datastructure update
!
! ******************************************************************************