cutfunce.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    cutfunce       ../engine/source/tools/sect/cutfunce.F
!||--- called by ------------------------------------------------------
!||    genani         ../engine/source/output/anim/generate/genani.F
!||--- calls      -----------------------------------------------------
!||    initbuf        ../engine/share/resol/initbuf.F
!||    write_r_c      ../common_source/tools/input_output/write_routines.c
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    element_mod    ../common_source/modules/elements/element_mod.F90
!||    initbuf_mod    ../engine/share/resol/initbuf.F
!||====================================================================
      SUBROUTINE cutfunce(NC   ,NUMEL,ELBUF_TAB,IFUNC  ,
     .                    IPARG,PM   ,IXS    )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE initbuf_mod
      USE elbufdef_mod
      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      "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,II(6)
C     REAL
      my_real
     .   off,  p, vonm2, vonm, s1, s2, 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            TURBULENT ENERGY     
             VALUE = gbuf%RK(i) 
           ELSEIF (ifunc==9) THEN
C           TURBULENT VISCOSITY
            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            VORTICITY
             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
      END