s8ederic3.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/.
!||====================================================================
!||    s8ederic3     ../engine/source/elements/solid/solide8e/s8ederic3.F
!||--- called by ------------------------------------------------------
!||    s8eforc3      ../engine/source/elements/solid/solide8e/s8eforc3.F
!||    s8sforc3      ../engine/source/elements/solid/solide8s/s8sforc3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg        ../engine/source/output/message/message.F
!||    arret         ../engine/source/system/arret.F
!||    schkjabt3     ../engine/source/elements/solid/solide4/schkjabt3.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE s8ederic3(
     1   OFF,     DET,     NGL,     X1,
     2   X2,      X3,      X4,      X5,
     3   X6,      X7,      X8,      Y1,
     4   Y2,      Y3,      Y4,      Y5,
     5   Y6,      Y7,      Y8,      Z1,
     6   Z2,      Z3,      Z4,      Z5,
     7   Z6,      Z7,      Z8,      PX1,
     8   PX2,     PX3,     PX4,     PY1,
     9   PY2,     PY3,     PY4,     PZ1,
     A   PZ2,     PZ3,     PZ4,     PX1H1,
     B   PX1H2,   PX1H3,   PX1H4,   PX2H1,
     C   PX2H2,   PX2H3,   PX2H4,   PX3H1,
     D   PX3H2,   PX3H3,   PX3H4,   PX4H1,
     E   PX4H2,   PX4H3,   PX4H4,   HX,
     F   HY,      HZ,      JR_1,    JS_1,
     G   JT_1,    AJ1,     AJ2,     AJ3,
     H   AJ4,     AJ5,     AJ6,     AJ7,
     I   AJ8,     AJ9,     SMAX,    SAV,
     J   OFFG,    NEL,     ISMSTR,  JLAG)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.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) :: JLAG
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER NEL
      DOUBLE PRECISION X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
     .                 Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),
     .                 Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*),
     .                 SAV(NEL,21)
 
      my_real OFF(*),DET(*),
     .        PX1(*), PX2(*), PX3(*), PX4(*),
     .        PY1(*), PY2(*), PY3(*), PY4(*),
     .        PZ1(*), PZ2(*), PZ3(*), PZ4(*),
     .        PX1H1(*), PX1H2(*), PX1H3(*),PX1H4(*),
     .        PX2H1(*), PX2H2(*), PX2H3(*),PX2H4(*),
     .        PX3H1(*), PX3H2(*), PX3H3(*),PX3H4(*),
     .        PX4H1(*), PX4H2(*), PX4H3(*),PX4H4(*),
     .        HX(MVSIZ,4),  HY(MVSIZ,4), HZ(MVSIZ,4),
     .        JR_1(*),JS_1(*),JT_1(*),
     .        AJ1(*),AJ2(*),AJ3(*),
     .        aj4(*),aj5(*),aj6(*),
     .        aj7(*),aj8(*),aj9(*),smax(*),offg(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NGL(*), I, J ,ICOR,NNEGA,INDEX(MVSIZ)
      my_real DETT(MVSIZ) ,
     .        AJI1(MVSIZ), AJI2(MVSIZ), AJI3(MVSIZ),
     .        aji4(mvsiz), aji5(mvsiz), aji6(mvsiz),
     .        aji7(mvsiz), aji8(mvsiz), aji9(mvsiz),
     .        x17(mvsiz) , x28(mvsiz) , x35(mvsiz) , x46(mvsiz),
     .        y17(mvsiz) , y28(mvsiz) , y35(mvsiz) , y46(mvsiz),
     .        z17(mvsiz) , z28(mvsiz) , z35(mvsiz) , z46(mvsiz),
     .        jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
     .        jac_38_29(mvsiz), jac_19_37(mvsiz), jac_27_18(mvsiz),
     .        jac_26_35(mvsiz), jac_34_16(mvsiz), jac_15_24(mvsiz),
     .        aj12(mvsiz), aj45(mvsiz), aj78(mvsiz),
     .        a17(mvsiz) , a28(mvsiz) ,
     .        b17(mvsiz) , b28(mvsiz) ,
     .        c17(mvsiz) , c28(mvsiz)
C-----------------------------------------------
      DO i=1,nel
        x17(i)=x7(i)-x1(i)
        x28(i)=x8(i)-x2(i)
        x35(i)=x5(i)-x3(i)
        x46(i)=x6(i)-x4(i)
        y17(i)=y7(i)-y1(i)
        y28(i)=y8(i)-y2(i)
        y35(i)=y5(i)-y3(i)
        y46(i)=y6(i)-y4(i)
        z17(i)=z7(i)-z1(i)
        z28(i)=z8(i)-z2(i)
        z35(i)=z5(i)-z3(i)
        z46(i)=z6(i)-z4(i)
      ENDDO
C
      DO i=1,nel
       aj4(i)=x17(i)+x28(i)-x35(i)-x46(i)
       aj5(i)=y17(i)+y28(i)-y35(i)-y46(i)
       aj6(i)=z17(i)+z28(i)-z35(i)-z46(i)
       a17(i)=x17(i)+x46(i)
       a28(i)=x28(i)+x35(i)
       b17(i)=y17(i)+y46(i)
       b28(i)=y28(i)+y35(i)
       c17(i)=z17(i)+z46(i)
       c28(i)=z28(i)+z35(i)
      ENDDO
 
      DO i=1,nel
        aj7(i)=a17(i)+a28(i)
        aj8(i)=b17(i)+b28(i)
        aj9(i)=c17(i)+c28(i)
        aj1(i)=a17(i)-a28(i)
        aj2(i)=b17(i)-b28(i)
        aj3(i)=c17(i)-c28(i)
      ENDDO
C
C     JACOBIAN
C
      DO i=1,nel
        jac_59_68(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)
        jac_67_49(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)
        jac_48_57(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)
      ENDDO
C
      DO i=1,nel
        det(i)=one_over_64*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(i)*jac_48_57(i))
      ENDDO
C
      CALL schkjabt3(
     1   off,     det,     ngl,     offg,
     2   nnega,   index,   nel,     ismstr,
     3   jlag)
      IF (nnega>0) THEN
        IF (ismstr==10.OR.ismstr==12) THEN
#include "vectorize.inc"
         DO j=1,nnega
          i = index(j)
            x1(i)=sav(i,1)
            y1(i)=sav(i,8)
            z1(i)=sav(i,15)
            x2(i)=sav(i,2)
            y2(i)=sav(i,9)
            z2(i)=sav(i,16)
            x3(i)=sav(i,3)
            y3(i)=sav(i,10)
            z3(i)=sav(i,17)
            x4(i)=sav(i,4)
            y4(i)=sav(i,11)
            z4(i)=sav(i,18)
            x5(i)=sav(i,5)
            y5(i)=sav(i,12)
            z5(i)=sav(i,19)
            x6(i)=sav(i,6)
            y6(i)=sav(i,13)
            z6(i)=sav(i,20)
            x7(i)=sav(i,7)
            y7(i)=sav(i,14)
            z7(i)=sav(i,21)
            x8(i)=zero
            y8(i)=zero
            z8(i)=zero
         ENDDO
        ELSE
#include "vectorize.inc"
         DO j=1,nnega
          i = index(j)
            x1(i)=sav(i,1)
            y1(i)=sav(i,2)
            z1(i)=sav(i,3)
            x2(i)=sav(i,4)
            y2(i)=sav(i,5)
            z2(i)=sav(i,6)
            x3(i)=sav(i,7)
            y3(i)=sav(i,8)
            z3(i)=sav(i,9)
            x4(i)=sav(i,10)
            y4(i)=sav(i,11)
            z4(i)=sav(i,12)
            x5(i)=sav(i,13)
            y5(i)=sav(i,14)
            z5(i)=sav(i,15)
            x6(i)=sav(i,16)
            y6(i)=sav(i,17)
            z6(i)=sav(i,18)
            x7(i)=sav(i,19)
            y7(i)=sav(i,20)
            z7(i)=sav(i,21)
            x8(i)=zero
            y8(i)=zero
            z8(i)=zero
         ENDDO
        END IF
#include "vectorize.inc"
         DO j=1,nnega
          i = index(j)
C
            x17(i)=x7(i)-x1(i)
            x28(i)=x8(i)-x2(i)
            x35(i)=x5(i)-x3(i)
            x46(i)=x6(i)-x4(i)
            y17(i)=y7(i)-y1(i)
            y28(i)=y8(i)-y2(i)
            y35(i)=y5(i)-y3(i)
            y46(i)=y6(i)-y4(i)
            z17(i)=z7(i)-z1(i)
            z28(i)=z8(i)-z2(i)
            z35(i)=z5(i)-z3(i)
            z46(i)=z6(i)-z4(i)
C
            aj4(i)=x17(i)+x28(i)-x35(i)-x46(i)
            aj5(i)=y17(i)+y28(i)-y35(i)-y46(i)
            aj6(i)=z17(i)+z28(i)-z35(i)-z46(i)
            a17(i)=x17(i)+x46(i)
            a28(i)=x28(i)+x35(i)
            b17(i)=y17(i)+y46(i)
            b28(i)=y28(i)+y35(i)
            c17(i)=z17(i)+z46(i)
            c28(i)=z28(i)+z35(i)
            aj7(i)=a17(i)+a28(i)
            aj8(i)=b17(i)+b28(i)
            aj9(i)=c17(i)+c28(i)
            aj1(i)=a17(i)-a28(i)
            aj2(i)=b17(i)-b28(i)
            aj3(i)=c17(i)-c28(i)
C      
            jac_59_68(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)
            jac_67_49(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)
            jac_48_57(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)
C
           det(i)=one_over_64*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(i)*jac_48_57(i))
             offg(i) = two
         ENDDO
      END IF
C      
      DO i=1,nel
      jac_38_29(i)=(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
      jac_19_37(i)=( aj1(i)*aj9(i)-aj3(i)*aj7(i))
      jac_27_18(i)=(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
      jac_26_35(i)=( aj2(i)*aj6(i)-aj3(i)*aj5(i))
      jac_34_16(i)=(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
      jac_15_24(i)=( aj1(i)*aj5(i)-aj2(i)*aj4(i))
      END DO
C
      DO i=1,nel
        dett(i)=one_over_64/det(i)
      ENDDO
C
C     INVERSE DE LA MATRICE JACOBIENNE
C
      DO i=1,nel
        aji1(i)=dett(i)*jac_59_68(i)
        aji4(i)=dett(i)*jac_67_49(i)
        aji7(i)=dett(i)*jac_48_57(i)
        aji2(i)=dett(i)*jac_38_29(i)
        aji5(i)=dett(i)*jac_19_37(i)
        aji8(i)=dett(i)*jac_27_18(i)
        aji3(i)=dett(i)*jac_26_35(i)
        aji6(i)=dett(i)*jac_34_16(i)
        aji9(i)=dett(i)*jac_15_24(i)
      ENDDO
C
      DO i=1,nel
        aj12(i)=aji1(i)-aji2(i)
        aj45(i)=aji4(i)-aji5(i)
        aj78(i)=aji7(i)-aji8(i)
      ENDDO
      DO i=1,nel
        px2(i)= aj12(i)-aji3(i)
        py2(i)= aj45(i)-aji6(i)
        pz2(i)= aj78(i)-aji9(i)
        px4(i)=-aj12(i)-aji3(i)
        py4(i)=-aj45(i)-aji6(i)
        pz4(i)=-aj78(i)-aji9(i)
      ENDDO
      DO i=1,nel
        aj12(i)=aji1(i)+aji2(i)
        aj45(i)=aji4(i)+aji5(i)
        aj78(i)=aji7(i)+aji8(i)
      ENDDO
      DO i=1,nel
        px1(i)=-aj12(i)-aji3(i)
        py1(i)=-aj45(i)-aji6(i)
        pz1(i)=-aj78(i)-aji9(i)
        px3(i)=aj12(i)-aji3(i)
        py3(i)=aj45(i)-aji6(i)
        pz3(i)=aj78(i)-aji9(i)
      ENDDO
C
C---- for f_vis  
      jr_1(1:nel)=aji2(1:nel)
      js_1(1:nel)=aji6(1:nel)
      jt_1(1:nel)=aji7(1:nel)
C
C mode 1
C 1 1 -1 -1 -1 -1 1 1
       DO i=1,nel
         hx(i,1)=(x1(i)+x2(i)-x3(i)-x4(i)-x5(i)-x6(i)+x7(i)+x8(i))
         hy(i,1)=(y1(i)+y2(i)-y3(i)-y4(i)-y5(i)-y6(i)+y7(i)+y8(i))
         hz(i,1)=(z1(i)+z2(i)-z3(i)-z4(i)-z5(i)-z6(i)+z7(i)+z8(i))
         px1h1(i)=px1(i)*hx(i,1)+ py1(i)*hy(i,1)+pz1(i)*hz(i,1)
         px2h1(i)=px2(i)*hx(i,1)+ py2(i)*hy(i,1)+pz2(i)*hz(i,1)
         px3h1(i)=px3(i)*hx(i,1)+ py3(i)*hy(i,1)+pz3(i)*hz(i,1)
         px4h1(i)=px4(i)*hx(i,1)+ py4(i)*hy(i,1)+pz4(i)*hz(i,1)
       ENDDO
C mode 2
C 1 -1 -1 1 -1 1 1 -1
       DO i=1,nel
         hx(i,2)=(x1(i)-x2(i)-x3(i)+x4(i)-x5(i)+x6(i)+x7(i)-x8(i))
         hy(i,2)=(y1(i)-y2(i)-y3(i)+y4(i)-y5(i)+y6(i)+y7(i)-y8(i))
         hz(i,2)=(z1(i)-z2(i)-z3(i)+z4(i)-z5(i)+z6(i)+z7(i)-z8(i))
         px1h2(i)=px1(i)*hx(i,2)+ py1(i)*hy(i,2)+pz1(i)*hz(i,2)
         px2h2(i)=px2(i)*hx(i,2)+ py2(i)*hy(i,2)+pz2(i)*hz(i,2)
         px3h2(i)=px3(i)*hx(i,2)+ py3(i)*hy(i,2)+pz3(i)*hz(i,2)
         px4h2(i)=px4(i)*hx(i,2)+ py4(i)*hy(i,2)+pz4(i)*hz(i,2)
       ENDDO
C mode 3
C 1 -1 1 -1 1 -1 1 -1
       DO i=1,nel
         hx(i,3)=(x1(i)-x2(i)+x3(i)-x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
         hy(i,3)=(y1(i)-y2(i)+y3(i)-y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
         hz(i,3)=(z1(i)-z2(i)+z3(i)-z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
         px1h3(i)=px1(i)*hx(i,3)+ py1(i)*hy(i,3)+pz1(i)*hz(i,3)
         px2h3(i)=px2(i)*hx(i,3)+ py2(i)*hy(i,3)+pz2(i)*hz(i,3)
         px3h3(i)=px3(i)*hx(i,3)+ py3(i)*hy(i,3)+pz3(i)*hz(i,3)
         px4h3(i)=px4(i)*hx(i,3)+ py4(i)*hy(i,3)+pz4(i)*hz(i,3)
       ENDDO
C mode 4
C -1 1 -1 1 1 -1 1 -1
       DO i=1,nel
         hx(i,4)=(-x1(i)+x2(i)-x3(i)+x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
         hy(i,4)=(-y1(i)+y2(i)-y3(i)+y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
         hz(i,4)=(-z1(i)+z2(i)-z3(i)+z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
         px1h4(i)=px1(i)*hx(i,4)+ py1(i)*hy(i,4)+pz1(i)*hz(i,4)
         px2h4(i)=px2(i)*hx(i,4)+ py2(i)*hy(i,4)+pz2(i)*hz(i,4)
         px3h4(i)=px3(i)*hx(i,4)+ py3(i)*hy(i,4)+pz3(i)*hz(i,4)
         px4h4(i)=px4(i)*hx(i,4)+ py4(i)*hy(i,4)+pz4(i)*hz(i,4)
       ENDDO
C----surface max mediane-- *16
       DO i=1,nel
         smax(i)= jac_59_68(i)*jac_59_68(i)+jac_67_49(i)*jac_67_49(i)
     .            +jac_48_57(i)*jac_48_57(i)
         smax(i)= max(smax(i),jac_38_29(i)*jac_38_29(i)+jac_19_37(i)*jac_19_37(i)
     .            +jac_27_18(i)*jac_27_18(i))
         smax(i)= max(smax(i),jac_26_35(i)*jac_26_35(i)+jac_34_16(i)*jac_34_16(i)
     .            +jac_15_24(i)*jac_15_24(i))
       ENDDO
       DO i=1,nel
         IF(smax(i)<=zero)THEN
           CALL ancmsg(msgid=173,anmode=aninfo,i1=ngl(i))
           CALL arret(2)
         ENDIF
         smax(i)= one/sqrt(smax(i))
       ENDDO
      RETURN
C
 1000 FORMAT(/' ZERO OR NEGATIVE VOLUME : 3D-ELEMENT NB',i10/)
 2000 FORMAT(/' ZERO OR NEGATIVE VOLUME : DELETE 3D-ELEMENT NB',i10/)
      END