akturb.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	akturb (iparg, elbuf_tab, flux, val2, xk, ale_connect, ixs, ixq, pm, itask, nercvois, nesdvois, lercvois, lesdvois, lencom, matparam)

Function/Subroutine Documentation

akturb()

subroutine akturb	(	integer, dimension(nparg,ngroup)	iparg,
		type (elbuf_struct_), dimension(ngroup), target	elbuf_tab,
			flux,
			val2,
			xk,
		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 akturb.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(*), xk(*), 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 rk, re, r, xmt, 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
        !ALE ON / OFF
        IF (iparg(76, ng)  ==  1) cycle ! --> OFF
        gbuf => elbuf_tab(ng)%GBUF
c
        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
        IF(jtur == 1)THEN
         IF(n2d == 0)THEN
          DO i=lft,llt
           j=i+nft
           mt=ixs(1,j)
           rk=gbuf%RK(i)
           re=gbuf%RE(i)
           r =gbuf%RHO(i)
           xk(j)=rk/r
           xmt=pm(81,mt)*rk*rk / max(em15,re)
           val2(j)=xmt/pm(85,mt)
          enddo!next I
         ELSE
          DO i=lft,llt
           j=i+nft
           mt=ixq(1,j)
           rk=gbuf%RK(i)
           re=gbuf%RE(i)
           r =gbuf%RHO(i)
           xk(j)=rk/r
           xmt=pm(81,mt)*rk*rk / max(em15,re)
           val2(j)=xmt/pm(85,mt)
          enddo!next I
         ENDIF
        ELSE
         DO i=lft,llt
          j=i+nft
          xk(j)=zero
         enddo!next I
        ENDIF
        IF(jpor == 2)THEN
         ! POROSITY, IMPOSED TURBULENCY & NO DIFFUSIVE FLUX 
         DO i=lft,llt
           j=i+nft
           val2(j)=zero
         enddo!next I
        ENDIF
      ENDDO
C
      CALL my_barrier
C
C-----------------------------
C       SPMD EXCHANGE : XK, VAL2 WITHIN ADJACENT ELEMENTS
C-----------------------------
      IF (nspmd > 1) THEN
!$OMP SINGLE
        CALL spmd_evois(xk,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
        gbuf => elbuf_tab(ng)%GBUF
c
        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
        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%RK,xk,flux(6*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
        ELSE
         CALL adiff2(gbuf%RK,xk,flux(4*nft+1),val2,ale_connect,gbuf%VOL,gbuf%TEMP,rhocp,nel)
        ENDIF
      ENDDO
C
      CALL my_barrier
C-----------
      RETURN