sdlen_dege.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/.
!||====================================================================
!||    sdlen_dege    ../engine/source/elements/solid/solide/sdlen_dege.F
!||--- called by ------------------------------------------------------
!||    s8cforc3      ../engine/source/elements/thickshell/solide8c/s8cforc3.F
!||    s8eforc3      ../engine/source/elements/solid/solide8e/s8eforc3.F
!||    s8sforc3      ../engine/source/elements/solid/solide8s/s8sforc3.f
!||    s8zforc3      ../engine/source/elements/solid/solide8z/s8zforc3.F
!||    sdlen8        ../engine/source/elements/solid/solidez/sdlen8.F
!||--- calls      -----------------------------------------------------
!||    degenes8      ../engine/source/elements/solid/solide/degenes8.F
!||    deges4v       ../engine/source/elements/solid/solide/deges4v.F
!||    idege8        ../engine/source/elements/solid/solide/idege8.F
!||--- uses       -----------------------------------------------------
!||    element_mod   ../common_source/modules/elements/element_mod.F90
!||====================================================================
      SUBROUTINE sdlen_dege(
     1   VOLG,    LAT,     X1,      X2,
     2   X3,      X4,      X5,      X6,
     3   X7,      X8,      Y1,      Y2,
     4   Y3,      Y4,      Y5,      Y6,
     5   Y7,      Y8,      Z1,      Z2,
     6   Z3,      Z4,      Z5,      Z6,
     7   Z7,      Z8,      IXS,     IDEGE,
     8   NEL)
      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   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER IXS(NIXS,*), IDEGE(*)
      my_real
     .   VOLG(*),LAT(*),
     .   X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
     .   Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),  
     .   Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
C----------DELTAX crrection for degenerated element
      INTEGER I,IT
      my_real
     .   AREAM(MVSIZ),FAC,V_G
C-----------------------------------------------
      CALL DEGENES8(
     1   IXS,     IDEGE,   NEL)
C
      DO I=1,nel
C-------due to the fact that AREA_Max*L is far from V for Dege---
       IF(idege(i) > 0) THEN
        aream(i) =em20
C----tetra 4  ,pyrami     
        IF (idege(i)>2) THEN
         fac=one_over_9
        ELSEIF (idege(i)>1) THEN
         fac=fourth
        ELSE
         fac=one
        END IF
          it = 0
        CALL idege8(x1(i),x2(i),x3(i),x4(i),y1(i),y2(i),y3(i),y4(i),
     .             z1(i),z2(i),z3(i),z4(i),aream(i),fac,it)
        CALL idege8(x5(i),x6(i),x7(i),x8(i),y5(i),y6(i),y7(i),y8(i),
     .             z5(i),z6(i),z7(i),z8(i),aream(i),fac,it)
        CALL idege8(x1(i),x2(i),x6(i),x5(i),y1(i),y2(i),y6(i),y5(i),
     .             z1(i),z2(i),z6(i),z5(i),aream(i),fac,it)
        CALL idege8(x2(i),x3(i),x7(i),x6(i),y2(i),y3(i),y7(i),y6(i),
     .             z2(i),z3(i),z7(i),z6(i),aream(i),fac,it)
        CALL idege8(x3(i),x4(i),x8(i),x7(i),y3(i),y4(i),y8(i),y7(i),
     .             z3(i),z4(i),z8(i),z7(i),aream(i),fac,it)
        CALL idege8(x4(i),x1(i),x5(i),x8(i),y4(i),y1(i),y5(i),y8(i),
     .             z4(i),z1(i),z5(i),z8(i),aream(i),fac,it)
C----tetra 4       
        IF (it ==0  ) aream(i)=fac*aream(i)
        IF (idege(i)>3 ) THEN
           aream(i)=aream(i)*fac
         CALL deges4v(v_g,
     .   x1(i), x2(i), x3(i), x4(i), x5(i), x6(i), x7(i), x8(i),
     .   y1(i), y2(i), y3(i), y4(i), y5(i), y6(i), y7(i), y8(i),
     .   z1(i), z2(i), z3(i), z4(i), z5(i), z6(i), z7(i), z8(i))
          ELSE
           v_g=volg(i)
          END IF
        lat(i) = four*v_g/sqrt(aream(i))
 
       ENDIF
      ENDDO
C      
      RETURN
      END