s8zderict3.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/.
!||====================================================================
!||    s8zderict3    ../engine/source/elements/solid/solide8z/s8zderict3.f
!||--- called by ------------------------------------------------------
!||    s8cke3        ../engine/source/elements/thickshell/solide8c/s8cke3.F
!||    s8zforc3      ../engine/source/elements/solid/solide8z/s8zforc3.F
!||    s8zke3        ../engine/source/elements/solid/solide8z/s8zke3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg        ../engine/source/output/message/message.F
!||    arret         ../engine/source/system/arret.F
!||    schkjab3      ../engine/source/elements/solid/solide/schkjab3.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE s8zderict3(
     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,      JAC1,    JAC2,
     G   JAC3,    JAC4,    JAC5,    JAC6,
     H   JAC7,    JAC8,    JAC9,    SMAX,
     I   NEL)
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) :: 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(*)
C     REAL
      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),   
     .   jac1(*),jac2(*),jac3(*),
     .   jac4(*),jac5(*),jac6(*),
     .   jac7(*),jac8(*),jac9(*),smax(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NGL(*), I, J ,ICOR
C     REAL
C                                                                     12
      my_real
     .   dett ,   
     .   jaci1, jaci2, jaci3,
     .   jaci4, jaci5, jaci6,
     .   jaci7, jaci8, jaci9,
     .   x17 , x28 , x35 , x46,
     .   y17 , y28 , y35 , y46,
     .   z17 , z28 , z35 , z46,
     .   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),
     .   jaci12, jaci45, jaci78,
     .   x_17_46 , x_28_35 ,
     .   y_17_46 , y_28_35 ,
     .   z_17_46 , z_28_35
C-----------------------------------------------
C
      DO i=1,nel
        x17=x7(i)-x1(i)
        x28=x8(i)-x2(i)
        x35=x5(i)-x3(i)
        x46=x6(i)-x4(i)
        y17=y7(i)-y1(i)
        y28=y8(i)-y2(i)
        y35=y5(i)-y3(i)
        y46=y6(i)-y4(i)
        z17=z7(i)-z1(i)
        z28=z8(i)-z2(i)
        z35=z5(i)-z3(i)
        z46=z6(i)-z4(i)
C
C Jacobian matrix
        jac4(i)=x17+x28-x35-x46
        jac5(i)=y17+y28-y35-y46
        jac6(i)=z17+z28-z35-z46
        x_17_46=x17+x46
        x_28_35=x28+x35
        y_17_46=y17+y46
        y_28_35=y28+y35
        z_17_46=z17+z46
        z_28_35=z28+z35
 
        jac7(i)=x_17_46+x_28_35
        jac8(i)=y_17_46+y_28_35
        jac9(i)=z_17_46+z_28_35
        jac1(i)=x_17_46-x_28_35
        jac2(i)=y_17_46-y_28_35
        jac3(i)=z_17_46-z_28_35
      ENDDO
C
      DO i=1,nel
      jac_59_68(i)=jac5(i)*jac9(i)-jac6(i)*jac8(i)
      jac_67_49(i)=jac6(i)*jac7(i)-jac4(i)*jac9(i)
      jac_38_29(i)=(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
      jac_19_37(i)=( jac1(i)*jac9(i)-jac3(i)*jac7(i))
      jac_27_18(i)=(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
      jac_26_35(i)=( jac2(i)*jac6(i)-jac3(i)*jac5(i))
      jac_34_16(i)=(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
      jac_15_24(i)=( jac1(i)*jac5(i)-jac2(i)*jac4(i))
      jac_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
      END DO
C
      DO i=1,nel
      det(i)=one_over_64*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
      ENDDO
C
      CALL schkjab3(
     1   off,     det,     ngl,     nel)
C
C Jacobian matrix inverse
C
      DO i=1,nel
        dett=one_over_64/det(i)
        jaci1=dett*jac_59_68(i)
        jaci4=dett*jac_67_49(i)
        jaci7=dett*jac_48_57(i)
        jaci2=dett*jac_38_29(i)
        jaci5=dett*jac_19_37(i)
        jaci8=dett*jac_27_18(i)
        jaci3=dett*jac_26_35(i)
        jaci6=dett*jac_34_16(i)
        jaci9=dett*jac_15_24(i)
!
        jaci12=jaci1-jaci2
        jaci45=jaci4-jaci5
        jaci78=jaci7-jaci8
!
        px2(i)= jaci12-jaci3
        py2(i)= jaci45-jaci6
        pz2(i)= jaci78-jaci9
        px4(i)=-jaci12-jaci3
        py4(i)=-jaci45-jaci6
        pz4(i)=-jaci78-jaci9
!
        jaci12=jaci1+jaci2
        jaci45=jaci4+jaci5
        jaci78=jaci7+jaci8
!
        px1(i)=-jaci12-jaci3
        py1(i)=-jaci45-jaci6
        pz1(i)=-jaci78-jaci9
        px3(i)=jaci12-jaci3
        py3(i)=jaci45-jaci6
        pz3(i)=jaci78-jaci9
      ENDDO
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