PLAG_ModRkInit.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: Suite of routines to initialize Runge-Kutta schemes.
!
! Description: None.
!
! Notes: None.
!
!*******************************************************************************
!
! $Id: PLAG_ModRkInit.F90,v 1.8 2009/03/02 00:19:36 mtcampbe Exp $
!
! Copyright: (c) 2005 by the University of Illinois
!
!*******************************************************************************

MODULE plag_modrkinit
  
  USE modglobal, ONLY: t_global
  USE modparameters
  USE moddatatypes
  USE modglobal,     ONLY: t_global
  USE modgrid,       ONLY: t_grid
  USE modpartlag,    ONLY: t_plag, t_plag_input, t_tile_plag
  USE modbndpatch,   ONLY: t_patch
  USE moddatastruct, ONLY: t_region
  USE moderror

  USE plag_modparameters
  USE inrt_modparameters

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: plag_injctilerkinit, &
            plag_rkinitprimary
        
! ******************************************************************************
! Declarations and definitions
! ******************************************************************************  
   
  CHARACTER(CHRLEN) :: RCSIdentString = & 
    '$RCSfile: PLAG_ModRkInit.F90,v $ $Revision: 1.8 $'        
       
! ******************************************************************************
! Routines
! ******************************************************************************

  CONTAINS




!******************************************************************************
!
! Purpose: Initialize Runge-Kutta scheme for Integer variables.
!
! Description: None.
!
! Input: 
!   region      Region data
!   iStage      Runge-Kutta stage
!   icBeg       Beginning index for cell update
!   icEnd       Ending index for cell update
!   ivBeg       Beginning index for variable update
!   ivEnd       Ending index for variable update
!   aiv         Integer variables
!   aivOld      Old integer variables
!
! Output: 
!   ivOld       Old integer variables
!
! Notes: None.
!
!******************************************************************************

SUBROUTINE plag_rkinitgenericint(region,iStage,icBeg,icEnd,ivBeg,ivEnd,&
                                 aiv,aivold)

! *****************************************************************************
! Definitions and declarations
! *****************************************************************************

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

  INTEGER, INTENT(IN) :: icbeg,icend,istage,ivbeg,ivend
  INTEGER, DIMENSION(:,:), POINTER :: aiv,aivold
  TYPE(t_region) :: region

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

  CHARACTER(CHRLEN) :: rcsidentstring
  INTEGER :: ic,iv
  TYPE(t_global), POINTER :: global

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

  rcsidentstring = '$RCSfile: PLAG_ModRkInit.F90,v $ $Revision: 1.8 $'

  global => region%global

  CALL registerfunction(global,'PLAG_RkInitGenericInt',&
  'PLAG_ModRkInit.F90')

! *****************************************************************************
! Initialize Runge-Kutta scheme
! *****************************************************************************

  SELECT CASE ( global%rkScheme ) 
    CASE ( rk_scheme_4_classical ) 
      IF ( istage == 1 ) THEN
        DO ic = icbeg,icend
          DO iv = ivbeg,ivend
            aivold(iv,ic) = aiv(iv,ic)
          END DO ! iv
        END DO ! ic
      END IF ! iStage
    CASE ( rk_scheme_3_wray ) 
      DO ic = icbeg,icend
        DO iv = ivbeg,ivend
          aivold(iv,ic) = aiv(iv,ic)
        END DO ! iv
      END DO ! ic   
    CASE default
      CALL errorstop(global,err_reached_default,__line__)
  END SELECT ! global%rkScheme

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

  CALL deregisterfunction(global)

END SUBROUTINE plag_rkinitgenericint





!******************************************************************************
!
! Purpose: Initialize Runge-Kutta scheme for Real variables.
!
! Description: None.
!
! Input: 
!   region      Region data
!   iStage      Runge-Kutta stage
!   icBeg       Beginning index for cell update
!   icEnd       Ending index for cell update
!   ivBeg       Beginning index for variable update
!   ivEnd       Ending index for variable update
!   rv          Real variables
!   rvOld       Old real variables
!
! Output: 
!   rvOld       Old real variables
!
! Notes: None.
!
!******************************************************************************

SUBROUTINE plag_rkinitgenericreal(region,iStage,icBeg,icEnd,ivBeg,ivEnd,&
                                  rv,rvold)

! *****************************************************************************
! Definitions and declarations
! *****************************************************************************

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

  INTEGER, INTENT(IN) :: icbeg,icend,istage,ivbeg,ivend
  REAL(RFREAL), DIMENSION(:,:), POINTER :: rv,rvold
  TYPE(t_region) :: region

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

  CHARACTER(CHRLEN) :: rcsidentstring
  INTEGER :: ic,iv
  TYPE(t_global), POINTER :: global

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

  rcsidentstring = '$RCSfile: PLAG_ModRkInit.F90,v $ $Revision: 1.8 $'

  global => region%global

  CALL registerfunction(global,'PLAG_RkInitGenericReal',&
  'PLAG_ModRkInit.F90')

! *****************************************************************************
! Initialize Runge-Kutta scheme
! *****************************************************************************

  SELECT CASE ( global%rkScheme ) 
    CASE ( rk_scheme_4_classical ) 
      IF ( istage == 1 ) THEN
        DO ic = icbeg,icend
          DO iv = ivbeg,ivend
            rvold(iv,ic) = rv(iv,ic)
          END DO ! iv
        END DO ! ic
      END IF ! iStage
    CASE ( rk_scheme_3_wray ) 
      DO ic = icbeg,icend
        DO iv = ivbeg,ivend
          rvold(iv,ic) = rv(iv,ic)
        END DO ! iv
      END DO ! ic   
    CASE default
      CALL errorstop(global,err_reached_default,__line__)
  END SELECT ! global%rkScheme

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

  CALL deregisterfunction(global)

END SUBROUTINE plag_rkinitgenericreal





!******************************************************************************
!
! Purpose: Driver that initializes primary variables.
!
! Description: none.
!
! Input: istage = RK stage
!        region = data of current region.
!
! Output: region%levels%plag%cvOld 
!         region%levels%plag%aivOld
!         region%levels%plag%arvOld
!
! Notes: none.
!
!******************************************************************************

SUBROUTINE plag_rkinitprimary( region, iStage )

! *****************************************************************************
! Definitions and declarations
! *****************************************************************************

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

  INTEGER, INTENT(IN) :: istage
  TYPE(t_region), INTENT(INOUT), TARGET :: region

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

  CHARACTER(CHRLEN) :: rcsidentstring

#ifdef RFLO
  INTEGER :: ilev
#endif
  INTEGER :: naiv,narv,ncv,npcls
  INTEGER, POINTER, DIMENSION(:,:) :: paiv, paivold

  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv, parvold, pcv, pcvold
  
  TYPE(t_plag),   POINTER :: pplag  
  TYPE(t_global), POINTER :: global

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

  rcsidentstring = '$RCSfile: PLAG_ModRkInit.F90,v $ $Revision: 1.8 $'

  global => region%global

  CALL registerfunction(global,'PLAG_RkInitPrimary',&
  'PLAG_ModRkInit.F90')

!******************************************************************************
! Set pointers
!******************************************************************************

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

  paiv    => pplag%aiv
  parv    => pplag%arv   
  pcv     => pplag%cv
  
  paivold => pplag%aivOld
  parvold => pplag%arvOld
  pcvold  => pplag%cvOld
  
!******************************************************************************
! Get dimensions
!******************************************************************************

#ifdef RFLO
  npcls = region%levels(ilev)%plag%nPcls 
#endif
#ifdef RFLU
  npcls = region%plag%nPcls
#endif
  
  naiv = pplag%nAiv
  narv = pplag%nArv           
  ncv  = pplag%nCv

!******************************************************************************
! Initialize previous solution
!******************************************************************************
  
  CALL plag_rkinitgenericint(  region,istage,1,npcls,1,naiv,paiv,paivold )
  CALL plag_rkinitgenericreal( region,istage,1,npcls,1,narv,parv,parvold )
  CALL plag_rkinitgenericreal( region,istage,1,npcls,1,ncv ,pcv ,pcvold  )

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

  CALL deregisterfunction(global)

END SUBROUTINE plag_rkinitprimary







!******************************************************************************
!
! Purpose: Driver that initializes variables for tiles.
!
! Description: none.
!
! Input: region = current region.
!        iStage = current RK stage.
!
! Output: region%levels%tilePlag%cvOld 
!
! Notes: none.
!
!******************************************************************************

SUBROUTINE plag_injctilerkinit( region, iStage )


! *****************************************************************************
! Definitions and declarations
! *****************************************************************************

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

  INTEGER, INTENT(IN) :: istage
  TYPE(t_region), INTENT(INOUT), TARGET :: region

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

  CHARACTER(CHRLEN) :: rcsidentstring
  INTEGER :: bctype,ipatch,ncv,npatches,ntiles
#ifdef RFLO
  INTEGER :: ilev,n1,n2
#endif
  
  REAL(RFREAL), POINTER, DIMENSION(:,:) :: pcv, pcvold

  TYPE(t_patch),     POINTER :: ppatch
  TYPE(t_tile_plag), POINTER :: ptileplag  
  TYPE(t_global), POINTER :: global

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

  rcsidentstring = '$RCSfile: PLAG_ModRkInit.F90,v $ $Revision: 1.8 $'

  global => region%global

  CALL registerfunction(global,'PLAG_InjcTileRkInit',&
  'PLAG_ModRkInit.F90')
  
!****************************************************************************** 
! Get dimensions
!****************************************************************************** 

#ifdef RFLO
  ilev     = region%currLevel
  npatches = region%nPatches
#endif
#ifdef RFLU
  npatches = region%grid%nPatches
#endif

!******************************************************************************     
! Loop over patches
!****************************************************************************** 

  DO ipatch=1,npatches

#ifdef RFLO
    ppatch => region%levels(ilev)%patches(ipatch)
#endif
#ifdef RFLU
    ppatch => region%patches(ipatch)
#endif

    bctype = ppatch%bcType

! =============================================================================
!   Select injection boundary condition
! =============================================================================

#ifdef RFLU
    IF ( (bctype >= bc_injection .AND. bctype <= bc_injection + bc_range) .OR. &
         (bctype >= bc_inflow    .AND. bctype <= bc_inflow    + bc_range)      ) THEN 
#else
    IF ( (bctype >= bc_injection .AND. bctype <= bc_injection + bc_range)) THEN
#endif

!  ----------------------------------------------------------------------------   
!     Get tile dimensions and set pointers
!  ----------------------------------------------------------------------------   

#ifdef RFLO
      n1      = abs(ppatch%l1end   -ppatch%l1beg   ) + 1    
      n2      = abs(ppatch%l2end   -ppatch%l2beg   ) + 1
      ntiles  = n1*n2
#endif
#ifdef RFLU
      ntiles  = ppatch%nBFaces
#endif
      
      ptileplag => ppatch%tilePlag
      
      ncv  = ptileplag%nCv

      pcv     => ptileplag%cv
      pcvold  => ptileplag%cvOld

!  ----------------------------------------------------------------------------  
!     Initialize previous solution
!  ---------------------------------------------------------------------------- 
      
      CALL plag_rkinitgenericreal( region,istage,1,ntiles,1,ncv,pcv,pcvold  )

    END IF !bcType
          
  END DO ! iPatch

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

  CALL deregisterfunction(global)

END SUBROUTINE plag_injctilerkinit

! ******************************************************************************
! End
! ******************************************************************************
  
END MODULE plag_modrkinit

!******************************************************************************
!
! RCS Revision history:
!
! $Log: PLAG_ModRkInit.F90,v $
! Revision 1.8  2009/03/02 00:19:36  mtcampbe
! Added some ifdefs around Rocflo to disable particle injection on INFLOW
! boundaries and added some checks around MPI tags utilizing a new global
! data item, global%mpiTagMax.
!
! Revision 1.7  2008/12/06 08:44:34  mtcampbe
! Updated license.
!
! Revision 1.6  2008/11/19 22:17:46  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.5  2006/09/18 20:30:18  fnajjar
! Activated tile datastructure for inflow bc
!
! Revision 1.4  2006/04/07 15:19:23  haselbac
! Removed tabs
!
! Revision 1.3  2005/05/26 23:02:05  fnajjar
! Bug fix in setting iLev before defining pPlag pointer
!
! Revision 1.2  2005/05/23 18:42:15  fnajjar
! Bug fix to define pointers before setting dimensions
!
! Revision 1.1  2005/05/19 16:02:43  fnajjar
! Initial import
!
!******************************************************************************