INRT_CalcScouring.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: compute interaction sources on Lagrangian particles
!          for the scouring process.
!
! Description: none.
!
! Input: region  = current region.
!
! Output: region%levels(iLev)%plag%inrtSources
!
! Notes: none.
!
!******************************************************************************
!
! $Id: INRT_CalcScouring.F90,v 1.4 2008/12/06 08:44:31 mtcampbe Exp $
!
! Copyright: (c) 2003 by the University of Illinois
!
!******************************************************************************

SUBROUTINE inrt_calcscouring( region )

  USE moddatatypes
  USE moddatastruct, ONLY : t_region
  USE modglobal,     ONLY : t_global
#ifdef RFLO
#ifdef PEUL
  USE modparteul,    ONLY : t_peul
#endif
#endif
#ifdef RFLU
  USE modspecies,    ONLY : t_spec
#endif
  USE modpartlag,    ONLY : t_plag
  USE modmixture,    ONLY : t_mixt
  USE modinteract
  USE moderror
  USE modparameters
  USE inrt_modparameters

#ifdef PLAG
  USE plag_modparameters
#endif

  IMPLICIT NONE

! ... parameters
  TYPE(t_region), INTENT(INOUT), TARGET :: region

! ... loop variables
  INTEGER :: iedge, icont, ipcls

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

  INTEGER :: icell, indpeul0, ipeul, ncont, nedges, npcls
#ifdef RFLO
  INTEGER :: ilev
#endif
  INTEGER, POINTER, DIMENSION(:)   :: pcvplagmass
  INTEGER, POINTER, DIMENSION(:,:) :: paivl

  REAL(RFREAL) :: capturearea, coeffscour, diaml, mdotdepo, &
                  onefourth, peulconc, pi, relvelmagl
  REAL(RFREAL),          DIMENSION(3)   :: vell, vels
  REAL(RFREAL), POINTER, DIMENSION(:,:) :: pcvs, pdvl
#ifdef RFLO
  REAL(RFREAL), POINTER, DIMENSION(:,:) :: pdvg
#endif
#ifdef RFLU
  REAL(RFREAL), POINTER, DIMENSION(:,:) :: pcvg
#endif

  TYPE(t_inrt_input),    POINTER :: pinputinrt
  TYPE(t_inrt_interact), POINTER :: pinrtscour
  TYPE(t_plag),          POINTER :: pplag
#ifdef RFLO
#ifdef PEUL
  TYPE(t_peul),          POINTER :: ppeul
#endif
#endif
#ifdef RFLU
  TYPE(t_spec),          POINTER :: ppeul
#endif
  TYPE(t_mixt),          POINTER :: pmixt
  TYPE(t_global),        POINTER :: global

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

  rcsidentstring = '$RCSfile: INRT_CalcScouring.F90,v $ $Revision: 1.4 $'

  global => region%global

  CALL registerfunction( global,'INRT_CalcScouring',&
  'INRT_CalcScouring.F90' )

#ifdef PLAG
! begin =======================================================================

! Check if there are any particles

  npcls = 0

#ifdef RFLO
  ilev  = region%currLevel
  IF (global%plagUsed) npcls = region%levels(ilev)%plag%nPcls
#endif
#ifdef RFLU
  IF (global%plagUsed) npcls = region%plag%nPcls
#endif

  IF (npcls < 1) go to 999

#ifdef RFLU
! Check that have primitive state vector --------------------------------------

  IF ( region%mixt%cvState /= cv_mixt_state_duvwp ) THEN
    CALL errorstop(global,err_cv_state_invalid,__line__)
  END IF ! region%mixt%cvState
#endif

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

#ifdef RFLO
  pplag  => region%levels(ilev)%plag
#ifdef PEUL
  ppeul  => region%levels(ilev)%peul
#endif
  pmixt  => region%levels(ilev)%mixt
#endif
#ifdef RFLU
  pplag  => region%plag
  ppeul  => region%spec
  pmixt  => region%mixt
#endif

  pinputinrt => region%inrtInput

  paivl  => pplag%aiv
#ifdef RFLO
#ifdef PEUL
  pcvs   => ppeul%cv
#endif
#endif
#ifdef RFLU
  pcvs   => ppeul%cv
#endif
  pdvl   => pplag%dv

#ifdef RFLO
  pdvg   => pmixt%dv
#endif
#ifdef RFLU
  pcvg   => pmixt%cv
#endif

  pinrtscour  => pinputinrt%inrts(inrt_type_scouring)

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

  onefourth = 1.0_rfreal/4.0_rfreal
  pi = global%pi

  ncont  = region%plagInput%nCont
  nedges = pinrtscour%nEdges

  indpeul0 = pinputinrt%indPeul0

! Loop over all the particles -------------------------------------------------

  DO ipcls = 1,npcls

    diaml  = pdvl(dv_plag_diam,ipcls)

    vell(1)   = pdvl(dv_plag_uvel,ipcls)
    vell(2)   = pdvl(dv_plag_vvel,ipcls)
    vell(3)   = pdvl(dv_plag_wvel,ipcls)

    icell = paivl(aiv_plag_icells,ipcls)

! - the computation of relVelMagL will have to be moved inside the iEdge
! - loop when a smoke velocity not equal to fluid velocity is implemented.

#ifdef RFLO
    vels(1)   = pdvg(dv_mixt_uvel,icell)
    vels(2)   = pdvg(dv_mixt_vvel,icell)
    vels(3)   = pdvg(dv_mixt_wvel,icell)
#endif
#ifdef RFLU
    vels(1)   = pcvg(cv_mixt_xvel,icell)
    vels(2)   = pcvg(cv_mixt_yvel,icell)
    vels(3)   = pcvg(cv_mixt_zvel,icell)
#endif

    relvelmagl  = sqrt( ( vell(1)-vels(1) )**2  &
                      + ( vell(2)-vels(2) )**2  &
                      + ( vell(3)-vels(3) )**2  )

    DO iedge = 1,nedges

      ipeul = pinrtscour%edges(iedge)%iNode(1) - indpeul0
      peulconc = pcvs(ipeul,icell)

!      Use definitions like these when smoke velocity comes to exist
!      velS(1)   = pDvS(DV_PEUL_UVEL,iCell)
!      velS(2)   = pDvS(DV_PEUL_VVEL,iCell)
!      velS(3)   = pDvS(DV_PEUL_WVEL,iCell)
!
!    relVelMagL  = SQRT( ( velL(1)-velS(1) )**2  &
!                      + ( velL(2)-velS(2) )**2  &
!                      + ( velL(3)-velS(3) )**2  )

      coeffscour = pinrtscour%data(inrt_dat_scouring_coef0 + iedge)

      capturearea = onefourth * pi * diaml**2 * coeffscour

      mdotdepo = peulconc * capturearea * relvelmagl

      pplag%inrtSources(iedge,ipcls) = mdotdepo

    ENDDO ! iEdge
  ENDDO ! iPcls

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

999  CONTINUE
#endif
  CALL deregisterfunction( global )

END SUBROUTINE inrt_calcscouring

!******************************************************************************
!
! RCS Revision history:
!
! $Log: INRT_CalcScouring.F90,v $
! Revision 1.4  2008/12/06 08:44:31  mtcampbe
! Updated license.
!
! Revision 1.3  2008/11/19 22:17:44  mtcampbe
! Added Illinois Open Source License/Copyright
!
! Revision 1.2  2006/02/15 20:18:11  wasistho
! put peul within ifdef
!
! Revision 1.1  2004/12/01 21:56:16  fnajjar
! Initial revision after changing case
!
! Revision 1.7  2004/07/23 22:43:16  jferry
! Integrated rocspecies into rocinteract
!
! Revision 1.6  2004/03/05 22:09:03  jferry
! created global variables for peul, plag, and inrt use
!
! Revision 1.5  2004/02/02 22:52:21  haselbac
! Fixed bug: Wrong parameter subscript
!
! Revision 1.4  2004/01/31 03:59:22  haselbac
! Initial integration for Rocflu and Rocpart
!
! Revision 1.3  2003/04/03 22:52:56  fnajjar
! Included correct pointer for InputInrt
!
! Revision 1.2  2003/04/03 21:10:18  jferry
! implemented additional safety checks for rocinteract
!
! Revision 1.1  2003/04/03 16:19:28  fnajjar
! Initial Import of routines for burning and scouring
!
!******************************************************************************