sdlen3.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/.
!||====================================================================
!||    sdlen3     ../engine/source/elements/solid/solide/sdlen3.F
!||--- called by ------------------------------------------------------
!||    s6cforc3   ../engine/source/elements/thickshell/solide6c/s6cforc3.F
!||    s6zforc3   ../engine/source/elements/solid/solide6z/s6zforc3.F90
!||    scforc3    ../engine/source/elements/thickshell/solidec/scforc3.F
!||    sforc3     ../engine/source/elements/solid/solide/sforc3.F
!||    szforc3    ../engine/source/elements/solid/solidez/szforc3.F
!||--- calls      -----------------------------------------------------
!||    sldege     ../engine/source/elements/solid/solide/sldege.F
!||    slen       ../engine/source/elements/solid/solide/slen.F
!||    slena      ../engine/source/elements/solid/solide/slena.F
!||--- uses       -----------------------------------------------------
!||    ale_mod    ../common_source/modules/ale/ale_mod.F
!||====================================================================
      SUBROUTINE sdlen3(
     1   VOLN,    DELTAX,  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,      N1X,     N2X,
     8   N3X,     N4X,     N5X,     N6X,
     9   N1Y,     N2Y,     N3Y,     N4Y,
     A   N5Y,     N6Y,     N1Z,     N2Z,
     B   N3Z,     N4Z,     N5Z,     N6Z,
     C   NEL,     MTN,     JALE,    JEUL)
C-----------------------------------------------
C   M o d u l e  s
C-----------------------------------------------
      USE ale_mod
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   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: MTN
      INTEGER, INTENT(IN) :: JALE
      INTEGER, INTENT(IN) :: JEUL
      my_real
     .   VOLN(*),DELTAX(*),
     .   X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
     .   Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),  
     .   Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*),
     .   N1X(*), N2X(*), N3X(*), N4X(*), N5X(*), N6X(*),
     .   N1Y(*), N2Y(*), N3Y(*), N4Y(*), N5Y(*), N6Y(*),
     .   N1Z(*), N2Z(*), N3Z(*), N4Z(*), N5Z(*), N6Z(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr17_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, NFAC
      my_real XIOFF(MVSIZ), AREAM(MVSIZ), ATEST(MVSIZ), AREA(MVSIZ,6)
C-----------------------------------------------
      DO I=1,nel
        xioff(i) = one
        aream(i) = em20
      ENDDO
 
      IF((ale%GLOBAL%ICAA==1 .OR. ale%GLOBAL%ISFINT>=2) .AND. jale+jeul/=0)THEN
        CALL slena(
     1   n1x,     n2x,     n3x,     n4x,
     2   n5x,     n6x,     n1y,     n2y,
     3   n3y,     n4y,     n5y,     n6y,
     4   n1z,     n2z,     n3z,     n4z,
     5   n5z,     n6z,     x1,      x2,
     6   x3,      x4,      x5,      x6,
     7   x7,      x8,      y1,      y2,
     8   y3,      y4,      y5,      y6,
     9   y7,      y8,      z1,      z2,
     a   z3,      z4,      z5,      z6,
     b   z7,      z8,      aream,   nel)
        DO i=1,nel
          deltax(i)=two*voln(i)*xioff(i)/sqrt(aream(i))
        ENDDO
      ELSE
        CALL slen(
     1   x1,      x2,      x3,      x4,
     2   y1,      y2,      y3,      y4,
     3   z1,      z2,      z3,      z4,
     4   1,       area,    aream,   nel)
        CALL slen(
     1   x5,      x6,      x7,      x8,
     2   y5,      y6,      y7,      y8,
     3   z5,      z6,      z7,      z8,
     4   2,       area,    aream,   nel)
        CALL slen(
     1   x1,      x2,      x6,      x5,
     2   y1,      y2,      y6,      y5,
     3   z1,      z2,      z6,      z5,
     4   3,       area,    aream,   nel)
        CALL slen(
     1   x2,      x3,      x7,      x6,
     2   y2,      y3,      y7,      y6,
     3   z2,      z3,      z7,      z6,
     4   4,       area,    aream,   nel)
        CALL slen(
     1   x3,      x4,      x8,      x7,
     2   y3,      y4,      y8,      y7,
     3   z3,      z4,      z8,      z7,
     4   5,       area,    aream,   nel)
        CALL slen(
     1   x4,      x1,      x5,      x8,
     2   y4,      y1,      y5,      y8,
     3   z4,      z1,      z5,      z8,
     4   6,       area,    aream,   nel)
        IF (idts6>0) THEN
          CALL sldege(
     1   x1,      x2,      x3,      x4,
     2   x5,      x6,      x7,      x8,
     3   y1,      y2,      y3,      y4,
     4   y5,      y6,      y7,      y8,
     5   z1,      z2,      z3,      z4,
     6   z5,      z6,      z7,      z8,
     7   area,    aream,   voln,    nel)
        ENDIF
        IF(mtn==5.OR.mtn==41)THEN
          DO i=1,nel
            atest(i)=em4*aream(i)
          ENDDO       
          DO i=1,nel                            
            nfac=0                                
            IF(area(i,1)<atest(i)) nfac=nfac+1 
            IF(area(i,2)<atest(i)) nfac=nfac+1 
            IF(area(i,3)<atest(i)) nfac=nfac+1 
            IF(area(i,4)<atest(i)) nfac=nfac+1 
            IF(area(i,5)<atest(i)) nfac=nfac+1 
            IF(area(i,6)<atest(i)) nfac=nfac+1 
            IF(nfac>=3) xioff(i)=ep03           
          ENDDO                                          
       END IF
       DO  i=1,nel
         deltax(i)=four*voln(i)*xioff(i)/sqrt(aream(i))
       ENDDO      
      ENDIF
C-----------------------------------------------      
      RETURN
      END