PLAG_RFLU_InitSolFromSerial.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: Initialize particle solution in a region by copying data from 
!   serial region.
!
! Description: None.
!
! Input: 
!   pRegion             Pointer to parallel region
!   pRegionSerial       Pointer to serial region
!
! Output: None.
!
! Notes: None.
!
! ******************************************************************************
!
! $Id: PLAG_RFLU_InitSolFromSerial.F90,v 1.7 2008/12/06 08:44:35 mtcampbe Exp $
!
! Copyright: (c) 2005-2007 by the University of Illinois
!
! ******************************************************************************

SUBROUTINE plag_rflu_initsolfromserial(pRegion,pRegionSerial)

  USE moddatatypes
  USE moderror
  USE moddatastruct, ONLY: t_region
  USE modglobal, ONLY: t_global
  USE modgrid, ONLY: t_grid
  USE modpartlag, ONLY: t_plag
  USE modparameters
  USE modsortsearch

  USE rflu_modrenumberings

  USE plag_modparameters    
  
  
  IMPLICIT NONE

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

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

  TYPE(t_region), POINTER :: pregion,pregionserial

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

  LOGICAL :: sortflag
  CHARACTER(CHRLEN) :: rcsidentstring
  INTEGER :: errorflag,icg,icgs,icgsmax,icgsmin,icgsnzpcllow,icgsnzpclmax, &
             icgsnzpclmin,icgsnzpclupp,icl,iloc,ipclpercellcsr, &
             ipclpercellcsrlow,ipclpercellcsrupp,ipclserial,isc2pc,isc2pclow, &
             isc2pcupp,ivar,j
  REAL(RFREAL) :: delfrac,xdel,xmax,xmin,xpcl,xpclmax,xpclmin,ydel,ymax,ymin, &
                  ypcl,ypclmax,ypclmin,zdel,zmax,zmin,zpcl,zpclmax,zpclmin
  TYPE(t_global), POINTER :: global
  TYPE(t_grid), POINTER :: pgrid
  TYPE(t_plag), POINTER :: pplag,pplagserial

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

  rcsidentstring = & 
    '$RCSfile: PLAG_RFLU_InitSolFromSerial.F90,v $ $Revision: 1.7 $'

  global => pregion%global

  CALL registerfunction(global,'PLAG_RFLU_InitSolFromSerial', &
                        'PLAG_RFLU_InitSolFromSerial.F90')
 
  IF ( global%verbLevel > verbose_none ) THEN
    WRITE(stdout,'(A,1X,A)') solver_name,'Initializing particle solution '// &
                             'from serial region...'
    WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
                                     pregion%iRegionGlobal
  END IF ! global%verbLevel

! ******************************************************************************
! Set pointers and values
! ******************************************************************************
  
  pgrid       => pregion%grid
  pplag       => pregion%plag  
  pplagserial => pregionserial%plag

  sortflag = .false.
    
  pplag%nPcls = 0

  delfrac = 0.05_rfreal
 
! ******************************************************************************
! Get (slightly enlarged) grid bounding box
! ******************************************************************************

  xmin = minval(pgrid%xyz(xcoord,1:pgrid%nVert))
  xmax = maxval(pgrid%xyz(xcoord,1:pgrid%nVert))
  ymin = minval(pgrid%xyz(ycoord,1:pgrid%nVert))
  ymax = maxval(pgrid%xyz(ycoord,1:pgrid%nVert))
  zmin = minval(pgrid%xyz(zcoord,1:pgrid%nVert))
  zmax = maxval(pgrid%xyz(zcoord,1:pgrid%nVert))

  xdel = xmax - xmin
  ydel = ymax - ymin
  zdel = zmax - zmin    

  xmin = xmin - delfrac*xdel
  xmax = xmax + delfrac*xdel
  ymin = ymin - delfrac*ydel
  ymax = ymax + delfrac*ydel
  zmin = zmin - delfrac*zdel
  zmax = zmax + delfrac*zdel    
  
! ******************************************************************************  
! Get particle bounding box 
! ******************************************************************************
  
  xpclmin =  huge(1.0_rfreal)
  xpclmax = -huge(1.0_rfreal)
  ypclmin =  huge(1.0_rfreal)
  ypclmax = -huge(1.0_rfreal)
  zpclmin =  huge(1.0_rfreal)
  zpclmax = -huge(1.0_rfreal)    
  
  DO ipclserial = 1,pplagserial%nPcls
    xpclmin = min(xpclmin,pplagserial%cv(cv_plag_xpos,ipclserial)) 
    xpclmax = max(xpclmax,pplagserial%cv(cv_plag_xpos,ipclserial))
    ypclmin = min(ypclmin,pplagserial%cv(cv_plag_ypos,ipclserial)) 
    ypclmax = max(ypclmax,pplagserial%cv(cv_plag_ypos,ipclserial))
    zpclmin = min(zpclmin,pplagserial%cv(cv_plag_zpos,ipclserial)) 
    zpclmax = max(zpclmax,pplagserial%cv(cv_plag_zpos,ipclserial))            
  END DO ! iPclSerial  

! ******************************************************************************  
! If particle bounding box contained at least partially in grid bounding box,
! search for particles
! ******************************************************************************

  IF ( ((xpclmin < xmax) .AND. (ypclmin < ymax) .AND. (zpclmin < zmax)) .AND. & 
       ((xpclmax > xmin) .AND. (ypclmax > ymin) .AND. (zpclmax > zmin)) ) THEN
       
! ==============================================================================
!   Read Pxxx2Sxxx maps so can build sc2pc map which will be used to copy 
!   particle data, find range of serial indices associated with cells in this
!   region, and range of serial cells with non-zero particles
! ==============================================================================
  
    CALL rflu_rnmb_createpbf2sbfmap(pregion)
    CALL rflu_rnmb_createpc2scmap(pregion)
    CALL rflu_rnmb_createpv2svmap(pregion)

    CALL rflu_rnmb_readpxx2sxxmaps(pregion)

    CALL rflu_rnmb_destroypbf2sbfmap(pregion)
    CALL rflu_rnmb_destroypv2svmap(pregion)

    CALL rflu_rnmb_buildsc2pcmap(pregion,sortflag)

    icgsnzpclmin = pplagserial%icgNzPcl(1)
    icgsnzpclmax = pplagserial%icgNzPcl(pplagserial%nCellsNzPcl)

    icgsmin = pgrid%sc2pc(1,1)
    icgsmax = pgrid%sc2pc(1,pgrid%nCells)

! ==============================================================================
!   If cell ranges overlap, then will have particles in this region. Then find
!   the lower and upper indices in the sc2pc and icgNzPcl maps to reduce 
!   looping and searching.
! ==============================================================================
  
    IF ( (icgsnzpclmin < icgsmax) .AND. (icgsnzpclmax > icgsmin) ) THEN 
      CALL binarysearchinteger(pgrid%sc2pc(1,1:pgrid%nCells),pgrid%nCells, &
                               icgsnzpclmin,iloc,j)
      IF ( iloc == element_not_found ) THEN 
        isc2pclow = max(1,min(j,pgrid%nCells))
      ELSE 
        isc2pclow = iloc
      END IF ! iLoc

      CALL binarysearchinteger(pgrid%sc2pc(1,1:pgrid%nCells),pgrid%nCells, &
                               icgsnzpclmax,iloc,j)
      IF ( iloc == element_not_found ) THEN 
        isc2pcupp = max(1,min(j,pgrid%nCells))
      ELSE 
        isc2pcupp = iloc
      END IF ! iLoc

      CALL binarysearchinteger(pplagserial%icgNzPcl(1:pplagserial%nCellsNzPcl), & 
                               pplagserial%nCellsNzPcl,icgsmin,iloc,j)
      IF ( iloc == element_not_found ) THEN 
        icgsnzpcllow = max(1,min(j,pgrid%nCells))
      ELSE 
        icgsnzpcllow = iloc
      END IF ! iLoc

      CALL binarysearchinteger(pplagserial%icgNzPcl(1:pplagserial%nCellsNzPcl), & 
                               pplagserial%nCellsNzPcl,icgsmax,iloc,j)
      IF ( iloc == element_not_found ) THEN 
        icgsnzpclupp = max(1,min(j,pgrid%nCells))
      ELSE 
        icgsnzpclupp = iloc
      END IF ! iLoc

! ------------------------------------------------------------------------------
!     Loop over range of cells in this region which lie in range of cells in 
!     serial region with non-zero particles. If cell actually has non-zero
!     particles, then copy all of them to this region. NOTE check whether 
!     region index of serial particle is not crazy value anymore, which 
!     indicates that serial particle was already assigned to another region, 
!     and hence indicates an erroneous double assignment.
! ------------------------------------------------------------------------------

      DO isc2pc = isc2pclow,isc2pcupp
        icgs = pgrid%sc2pc(1,isc2pc)

        CALL binarysearchinteger(pplagserial%icgNzPcl(icgsnzpcllow:icgsnzpclupp), &
                                 icgsnzpclupp-icgsnzpcllow+1,icgs,iloc)

        IF ( iloc /= element_not_found ) THEN  
          iloc = iloc + icgsnzpcllow - 1 

          IF ( iloc > 1 ) THEN 
            ipclpercellcsrlow = pplagserial%iPclPerCellCSRInfo(iloc-1)+1
          ELSE 
            ipclpercellcsrlow = 1 
          END IF ! iLoc

          ipclpercellcsrupp = pplagserial%iPclPerCellCSRInfo(iloc)

          DO ipclpercellcsr = ipclpercellcsrlow,ipclpercellcsrupp
            ipclserial = pplagserial%iPclPerCellCSR(ipclpercellcsr)

            pplag%nPcls = pplag%nPcls + 1

            DO ivar = 1,pregion%plag%nCv
              pplag%cv(ivar,pplag%nPcls) = pplagserial%cv(ivar,ipclserial)
            END DO ! iVar

            DO ivar = 1,pregion%plag%nArv
              pplag%arv(ivar,pplag%nPcls) = pplagserial%arv(ivar,ipclserial)
            END DO ! iVar

            DO ivar = 1,pregion%plag%nAiv
              pplag%aiv(ivar,pplag%nPcls) = pplagserial%aiv(ivar,ipclserial)
            END DO ! iVar
  
            pplag%aiv(aiv_plag_icells,pplag%nPcls) = pgrid%sc2pc(2,isc2pc)
            pplag%aiv(aiv_plag_regini,pplag%nPcls) = pregion%iRegionGlobal 
  
            IF ( pplagserial%aiv(aiv_plag_regini,ipclserial) /= 0 ) THEN 
              CALL errorstop(global,err_plag_dstr_invalid,__line__)
            ELSE 
              pplagserial%aiv(aiv_plag_regini,ipclserial) = & 
                pregion%iRegionGlobal
            END IF ! pPlagSerial%aiv
          END DO ! iPclSerial
        END IF ! iloc
      END DO ! iSc2Pc 
    END IF ! icgsNzMin

    CALL rflu_rnmb_destroysc2pcmap(pregion)
  END IF ! xPcl

! ******************************************************************************
! Write info
! ******************************************************************************

  IF ( global%verbLevel > verbose_low ) THEN 
    WRITE(stdout,'(A,3X,A,1X,I6)') solver_name,'Number of particles:', &
                                   pplag%nPcls
  END IF ! global%verbLevel

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

  IF ( global%verbLevel > verbose_none ) THEN 
    WRITE(stdout,'(A,1X,A)') solver_name,'Initializing particle solution '// &
                             'from serial region done.'
  END IF ! global%verbLevel

  CALL deregisterfunction(global)

END SUBROUTINE plag_rflu_initsolfromserial

! ******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_RFLU_InitSolFromSerial.F90,v $
! Revision 1.7  2008/12/06 08:44:35  mtcampbe
! Updated license.
!
! Revision 1.6  2008/11/19 22:17:47  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.5  2007/03/27 00:21:33  haselbac
! Adaptation to new initialization
!
! Revision 1.4  2006/05/22 15:33:09  fnajjar
! Fixed bug for uninitialized delFrac
!
! Revision 1.3  2006/05/05 17:36:24  haselbac
! Changed so do not need access to serial grid
!
! Revision 1.2  2006/04/07 15:19:24  haselbac
! Removed tabs
!
! Revision 1.1  2005/05/18 22:27:45  fnajjar
! Initial revision
!
! ******************************************************************************