cutfunce.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	cutfunce (nc, numel, elbuf_tab, ifunc, iparg, pm, ixs)

Function/Subroutine Documentation

cutfunce()

subroutine cutfunce	(	integer, dimension(5,*)	nc,
		integer	numel,
		type (elbuf_struct_), dimension(ngroup), target	elbuf_tab,
		integer	ifunc,
		integer, dimension(nparg,*)	iparg,
			pm,
		integer, dimension(nixs,*)	ixs )

Definition at line 34 of file cutfunce.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE initbuf_mod
      USE elbufdef_mod         
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      "vect01_c.inc"
#include      "com01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
      my_real
     .   pm(npropm,*)
      INTEGER IPARG(NPARG,*),NC(5,*),IXS(NIXS,*)
      INTEGER NUMEL,IFUNC
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
C-----------------------------------------------
      INTEGER I,J,N,IC,IL,IL_OLD,NG,NEL,MLW,JTURB,MT,G_PLA,II(6)
C     REAL
      my_real
     .   off,  p, vonm2, vonm, s1, s2, s12, s3, VALUE     
      REAL R4
      TYPE(G_BUFEL_) ,POINTER :: GBUF     
      TYPE(L_BUFEL_) ,POINTER :: LBUF     
      TYPE(BUF_MAT_) ,POINTER :: MBUF  
C=======================================================================
      il_old = -1
      VALUE = zero
      DO ic=1,numel
       il = nc(5,ic)
       IF(il/=il_old)THEN
         il_old = il
C
         DO 490 ng=1,ngroup
          CALL initbuf(iparg    ,ng      ,                    
     2          mlw     ,nel     ,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 (ity/=1)      GOTO 490
          IF (nel+nft<il) GOTO 490
C-----------------------------------------------
C         SOLID ELEMENT
C-----------------------------------------------
           gbuf => elbuf_tab(ng)%GBUF
           lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
           mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
           i = il - nft
           llt = nel
           jturb=iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
C
           n = i + nft
           off = gbuf%OFF(i)
!
           DO j=1,6
             ii(j) = nel*(j-1)
           ENDDO
!
c-----------
           IF (ifunc==1 .AND. gbuf%G_PLA > 0) THEN
             VALUE = gbuf%PLA(i)
c-----------
           ELSEIF (ifunc == 2) THEN
             VALUE = gbuf%RHO(i)
c-----------
           ELSEIF (ifunc == 3) THEN
             VALUE = gbuf%EINT(i)
c-----------
           ELSEIF(ifunc==4 .AND. jthe > 0) THEN
             VALUE = gbuf%TEMP(i)
c-----------
           ELSEIF(ifunc==6.OR.ifunc==7)THEN
             p = - (gbuf%SIG(ii(1)+i)
     .            + gbuf%SIG(ii(2)+i)
     .            + gbuf%SIG(ii(3)+i)) / three
             VALUE = p    
             IF (ifunc==7) THEN
               s1 = gbuf%SIG(ii(1)+i) + p
               s2 = gbuf%SIG(ii(2)+i) + p
               s3 = gbuf%SIG(ii(3)+i) + p
               vonm2 = three*(gbuf%SIG(ii(4)+i)**2 +      
     .                        gbuf%SIG(ii(5)+i)**2 +      
     .                        gbuf%SIG(ii(6)+i)**2 +      
     .                   half*(s1*s1+s2*s2+s3*s3))              
              vonm= sqrt(vonm2)
              VALUE = vonm
            ENDIF
c-----------
           ELSEIF (ifunc==8 . and. jturb/=0) THEN
C            ENERGIE TURBULENTE     
             VALUE = gbuf%RK(i) 
           ELSEIF (ifunc==9) THEN
C           VISCOSITE TURBULENTE
            IF((mlw==6 .OR. mlw==17).AND.jturb/=0)THEN
                mt=ixs(1,n)
                VALUE=pm(81,mt)*gbuf%RK(i)**2/
     .                  max(em15,gbuf%RE(i))
               ELSEIF (mlw==46 .OR. mlw==47)THEN
                 VALUE = mbuf%VAR(i)
               ELSE
              VALUE = zero
               ENDIF
C
           ELSEIF(ifunc==10)THEN
C            VORTICITE
             IF(mlw==6 .OR. mlw==17)THEN
               VALUE = lbuf%VK(i)     
             ELSEIF(mlw==46 .OR. mlw==47)THEN
               VALUE = mbuf%VAR(i)      
             ELSE
               VALUE = zero
             ENDIF
C
           ELSEIF(ifunc>=14.AND.ifunc<=19)THEN
             VALUE = gbuf%SIG(ii(ifunc - 13) + i)
           ELSE
             VALUE = zero
           ENDIF
           GOTO 500
C
 490     CONTINUE
 500     CONTINUE
       ENDIF
C-----------------------------------------------
       r4 = VALUE
       CALL write_r_c(r4,1)
      ENDDO
C-----------------------------------------------
      RETURN