multi_evolve_global.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com06_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	multi_evolve_global (timestep, ng, elbuf_tab, iparg, itask, ixs, ixq, ixtg, multi_fvm, gravity, wfext)

Function/Subroutine Documentation

multi_evolve_global()

subroutine multi_evolve_global	(	intent(in)	timestep,
		integer, intent(in)	ng,
		type(elbuf_struct_), dimension(ngroup), target	elbuf_tab,
		integer, dimension(nparg, *), intent(in)	iparg,
		integer, intent(in)	itask,
		integer, dimension(nixs, *), intent(in), target	ixs,
		integer, dimension(nixq, *), intent(in), target	ixq,
		integer, dimension(nixtg, *), intent(in), target	ixtg,
		type(multi_fvm_struct), intent(inout)	multi_fvm,
		dimension(4, *), intent(in)	gravity,
		double precision, intent(inout)	wfext )

Definition at line 33 of file multi_evolve_global.F.

C-----------------------------------------------
C     M o d u l e s
C-----------------------------------------------
      USE initbuf_mod      
      USE elbufdef_mod
      USE multi_fvm_mod
      use element_mod , only : nixs,nixq,nixtg
C-----------------------------------------------
C     I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C     C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com06_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C     D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real, INTENT(IN) :: timestep
      INTEGER, INTENT(IN) :: NG
      TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
      INTEGER, INTENT(IN) :: IPARG(NPARG, *)
      INTEGER, INTENT(IN) :: ITASK ! SMP TASK
      INTEGER, INTENT(IN), TARGET :: IXS(NIXS, *), IXQ(NIXQ, *), IXTG(NIXTG, *)
      TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
      my_real, INTENT(IN) :: gravity(4, *)
      DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
C-----------------------------------------------
C     L o c a l   V a r i a b l e s
C-----------------------------------------------
      TYPE(G_BUFEL_), POINTER :: GBUF
      INTEGER :: II, I, J, ITY, NEL, NFT, ISOLNOD
      INTEGER ::  NODEID, NVERTEX
      my_real ::  vel2, vol, sumflux(5)
      my_real :: vii(5), gravii(3), pres, vx, vy, vz, wext
      INTEGER :: NB_FACE, NB_NODE, NODE_LIST(8)
      INTEGER, DIMENSION(:, :), POINTER :: IX
      DOUBLE PRECISION :: WFEXTT
C-----------------------------------------------
C     B e g i n n i n g   o f   s u b r o u t i n e
C-----------------------------------------------
      gbuf    =>elbuf_tab(ng)%GBUF
      nel     = iparg(2, ng)
      nft     = iparg(3, ng)
      ity     = iparg(5, ng)
      isolnod = iparg(28, ng)
      nb_face = 6
      wfextt  = zero
      ix      =>ixs(1:nixs, 1 + nft : nel + nft)
      IF (isolnod == 8) THEN
         nb_node = 8
         DO j = 1, nb_node
            node_list = j + 1
         ENDDO
      ELSE
         nb_node = 4
         node_list(1) = 2
         node_list(2) = 4
         node_list(3) = 7
         node_list(4) = 6
      ENDIF
 
      IF (multi_fvm%SYM /= 0) THEN
         IF (ity == 2) THEN
C     QUADS
            nb_face = 4
            nb_node = 4
            node_list(1) = 2
            node_list(2) = 3
            node_list(3) = 4
            node_list(4) = 5
 
            ix => ixq(1:nixq, 1 + nft : nel + nft)
         ELSEIF (ity == 7) THEN
C     TRIANGLES
            nb_face = 3
            nb_node = 3
            node_list(1) = 2
            node_list(2) = 3
            node_list(3) = 4
            ix => ixtg(1:nixtg, 1 + nft : nel + nft)
         ENDIF
      ENDIF
 
C     Update global quantities
      DO ii = 1, nel
         i = ii + nft
C     Velocity components
         vx = gbuf%MOM(ii + 0 * nel)
         vy = gbuf%MOM(ii + 1 * nel)
         vz = gbuf%MOM(ii + 2 * nel)
!     Square norm of the velocity
         vel2 = vx * vx + vy * vy + vz * vz
!     Conserved variable
         vii(1) = gbuf%RHO(ii)
         vii(2) = vii(1) * vx
         vii(3) = vii(1) * vy
         vii(4) = vii(1) * vz
         vii(5) = gbuf%EINT(ii) + half * vii(1) * vel2
         
! Volume 
         vol = gbuf%VOL(ii)
! Sum of fluxes
         IF (multi_fvm%SYM == 0 .AND. isolnod /= 4) THEN
            sumflux(1:5) = multi_fvm%FLUXES(1:5, 1, i) + multi_fvm%FLUXES(1:5, 2, i) + 
     .           multi_fvm%FLUXES(1:5, 3, i) + multi_fvm%FLUXES(1:5, 4, i) +
     .           multi_fvm%FLUXES(1:5, 5, i) + multi_fvm%FLUXES(1:5, 6, i)
         ELSEIF (isolnod == 4) THEN
            sumflux(1:5) = multi_fvm%FLUXES(1:5, 5, i) + multi_fvm%FLUXES(1:5, 6, i) + 
     .           multi_fvm%FLUXES(1:5, 2, i) + multi_fvm%FLUXES(1:5, 4, i)
         ELSE
C     TRIANGLES
            sumflux(1:5) = multi_fvm%FLUXES(1:5, 1, i) + multi_fvm%FLUXES(1:5, 2, i) + 
     .           multi_fvm%FLUXES(1:5, 3, i)
            IF (ity == 2) THEN
C     QUADS
               sumflux(1:5) = sumflux(1:5) + multi_fvm%FLUXES(1:5, 4, i)
            ENDIF
         ENDIF
! Time evolution
         vii(1:5) = vol * vii(1:5) - timestep * sumflux(1:5)
! 2D axi
         IF (multi_fvm%SYM == 1) THEN
            pres = multi_fvm%PRES(i)
            vii(3) = vii(3) + timestep * gbuf%AREA(ii) * pres
         ENDIF
! Gravity
         gravii(1:3) = zero
         nvertex = 0
!     TODO(DC) :check the case of tetrahedra
         DO j = 1, nb_node
            nodeid = ix(node_list(j), ii)
            IF(gravity(4, nodeid) == zero) cycle
            nvertex = nvertex + 1
            gravii(1) = gravii(1) + gravity(1, nodeid)
            gravii(2) = gravii(2) + gravity(2, nodeid)
            gravii(3) = gravii(3) + gravity(3, nodeid)
         ENDDO
         IF (nvertex > 0) THEN
            gravii(1:3) = gravii(1:3) / nvertex
         ENDIF
         vii(2:4) = vii(2:4) + timestep * gbuf%RHO(ii) * vol * gravii(1:3)
         wext     = timestep * gbuf%RHO(ii) * vol * (
     .              gravii(1) * multi_fvm%VEL(1, i) + 
     .              gravii(2) * multi_fvm%VEL(2, i) + 
     .              gravii(3) * multi_fvm%VEL(3, i))
         vii(5) = vii(5) + wext
         wfextt = wfextt + wext
! Mass is stored in RHO
         multi_fvm%RHO(i) = vii(1)
! Mass times velocity is stored in VEL
         multi_fvm%VEL(1, i) = vii(2)
         multi_fvm%VEL(2, i) = vii(3)
         multi_fvm%VEL(3, i) = vii(4)
! Total energy is stored in EINT
         multi_fvm%EINT(i) = vii(5)
      ENDDO
 
C-------------------------------------------
!$OMP ATOMIC
       wfext=wfext+wfextt
C-------------------------------------------
 
C-----------------------------------------------
C     E n d  o f   s u b r o u t i n e
C-----------------------------------------------