aeturb.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	aeturb (iparg, elbuf_tab, flux, val2, xe, ale_connect, ixs, ixq, pm, itask, nercvois, nesdvois, lercvois, lesdvois, lencom, matparam)

Function/Subroutine Documentation

aeturb()

subroutine aeturb	(	integer, dimension(nparg,ngroup)	iparg,
		type (elbuf_struct_), dimension(ngroup), target	elbuf_tab,
			flux,
			val2,
			xe,
		type(t_ale_connectivity), intent(in)	ale_connect,
		integer, dimension(nixs,numels)	ixs,
		integer, dimension(7,numelq)	ixq,
			pm,
		integer	itask,
		integer, dimension(*)	nercvois,
		integer, dimension(*)	nesdvois,
		integer, dimension(*)	lercvois,
		integer, dimension(*)	lesdvois,
		integer	lencom,
		type(matparam_struct_), dimension(nummat), intent(in)	matparam )

Parameters

[in]

matparam

material buffer

Definition at line 40 of file aeturb.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE initbuf_mod
      USE elbufdef_mod            
      USE ale_connectivity_mod
      USE matparam_def_mod, ONLY : matparam_struct_
      use element_mod , only : nixs
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      "com04_c.inc"
#include      "vect01_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,NUMELS), IXQ(7,NUMELQ),
     .        NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*),
     .        LENCOM
      my_real flux(*), val2(*), xe(*), pm(npropm,nummat)
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
      TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
      TYPE(MATPARAM_STRUCT_),DIMENSION(NUMMAT),INTENT(IN) :: MATPARAM !< material buffer
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NG, I, J, MT, ITASK, NEL, MID
      my_real re, r, rhocp
      TYPE(G_BUFEL_)  ,POINTER :: GBUF     
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------  
      DO ng=itask+1,ngroup,nthread
C     ALE ON / OFF
        IF (iparg(76, ng)  ==  1) cycle ! --> OFF
        CALL initbuf(iparg    ,ng      ,                  
     2     mtn     ,llt     ,nft     ,iad     ,ity     ,   
     3     npt     ,jale    ,ismstr  ,jeul    ,jtur    ,   
     4     jthe    ,jlag    ,jmult   ,jhbe    ,jivf    ,   
     5     nvaux   ,jpor    ,jcvt    ,jclose  ,jplasol ,   
     6     irep    ,iint    ,igtyp   ,israt   ,isrot   ,   
     7     icsen   ,isorth  ,isorthg ,ifailure,jsms    )
        IF(jale+jeul==0)   cycle
        IF(iparg(8,ng)==1) cycle
        lft=1
        gbuf => elbuf_tab(ng)%GBUF
c
        IF(jtur==1)THEN
         IF(n2d==0)THEN
          DO i=lft,llt
            j=i+nft
            mt=ixs(1,j)
            re=gbuf%RE(i)
            r =gbuf%RHO(i)
            xe(j)=re/r
            val2(j)=val2(j)*pm(85,mt)/pm(86,mt)
          enddo!next I
         ELSE
          DO i=lft,llt
            j=i+nft
            mt=ixq(1,j)
            re=gbuf%RE(i)
            r =gbuf%RHO(i)
            xe(j)=re/r
            val2(j)=val2(j)*pm(85,mt)/pm(86,mt)
          enddo!next I
         ENDIF
        ELSE
         DO i=lft,llt
           j=i+nft
           xe(j)=zero
         enddo!next I
        ENDIF
        IF(jpor == 2)THEN
C POROSITY, OPTION:IMPOSED TURBULENCY AND NO DIFFUSIVE FLUXES 
          DO i=lft,llt
            j=i+nft
            val2(j)=zero
          enddo!next I
         ENDIF
      ENDDO
C
      CALL my_barrier
C-----------------------------
C       SPMD EXCHANGE : XE, VAL2
C-----------------------------
      IF (nspmd > 1) THEN
!$OMP SINGLE
        CALL spmd_evois(xe,val2,nercvois,nesdvois,lercvois,lesdvois,lencom)
!$OMP END SINGLE
 
      END IF
C-----------------------------
      DO ng=itask+1,ngroup,nthread
C     ALE ON / OFF
        IF (iparg(76, ng)  ==  1) cycle ! --> OFF
        CALL initbuf(iparg    ,ng      ,                  
     2     mtn     ,llt     ,nft     ,iad     ,ity     ,   
     3     npt     ,jale    ,ismstr  ,jeul    ,jtur    ,   
     4     jthe    ,jlag    ,jmult   ,jhbe    ,jivf    ,   
     5     nvaux   ,jpor    ,jcvt    ,jclose  ,jplasol ,   
     6     irep    ,iint    ,igtyp   ,israt   ,isrot   ,   
     7     icsen   ,isorth  ,isorthg ,ifailure,jsms    )
        IF(jale+jeul==0)    cycle
        IF(jtur/=1)         cycle
        IF(mtn==11)         cycle
        IF(mtn==17)         cycle
        IF(iparg(8,ng)==1)  cycle
c
        gbuf => elbuf_tab(ng)%GBUF
        lft=1
        nel=iparg(2,ng)
        mid=iparg(18,ng)
        rhocp = pm(69,mid)
        if(rhocp == zero)then
          rhocp = pm(89,mid)*matparam(mid)%eos%cp
        end if
        IF(n2d==0)THEN
         CALL adiff3(gbuf%RE,xe,flux(6*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
        ELSE
         CALL adiff2(gbuf%RE,xe,flux(4*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
        ENDIF
      ENDDO
C-----------
      CALL my_barrier
C-----------------------------------------------
      RETURN