s8zdericto3.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/.
!||====================================================================
!||    s8zdericto3   ../engine/source/elements/solid/solide8z/s8zdericto3.F
!||--- called by ------------------------------------------------------
!||    s8zforc3      ../engine/source/elements/solid/solide8z/s8zforc3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg        ../engine/source/output/message/message.F
!||    arret         ../engine/source/system/arret.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE s8zdericto3(
     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   JAC_I,   NEL,     ISMSTR)
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
      INTEGER, INTENT(IN) :: ISMSTR
      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(*),jac_i(10,mvsiz)
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(mvsiz) ,   
     .   jaci1, jaci2, jaci3,
     .   jaci4, jaci5, jaci6,
     .   jaci7, jaci8, jaci9,
     .   x17 , x28 , x35 , x46,
     .   y17 , y28 , y35 , y46,
     .   z17 , z28 , z35 , z46,
     .   jac_59_68, jac_67_49, jac_48_57,
     .   jac_38_29, jac_19_37, jac_27_18,
     .   jac_26_35, jac_34_16, jac_15_24,
     .   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
        jaci1=jac_i(1,i)
        jaci4=jac_i(4,i)
        jaci7=jac_i(7,i)
        jaci2=jac_i(2,i)
        jaci5=jac_i(5,i)
        jaci8=jac_i(8,i)
        jaci3=jac_i(3,i)
        jaci6=jac_i(6,i)
        jaci9=jac_i(9,i)
        det(i) =jac_i(10,i)
C
        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
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       
       IF (ismstr/=11) RETURN
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       
        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
C
C     JACOBIAN
C
        jac_59_68=jac5(i)*jac9(i)-jac6(i)*jac8(i)
        jac_67_49=jac6(i)*jac7(i)-jac4(i)*jac9(i)
        jac_38_29=(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
        jac_19_37=( jac1(i)*jac9(i)-jac3(i)*jac7(i))
        jac_27_18=(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
        jac_26_35=( jac2(i)*jac6(i)-jac3(i)*jac5(i))
        jac_34_16=(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
        jac_15_24=( jac1(i)*jac5(i)-jac2(i)*jac4(i))
        jac_48_57=jac4(i)*jac8(i)-jac5(i)*jac7(i)
C----surface max mediane-- *16
        smax(i)= jac_59_68*jac_59_68+jac_67_49*jac_67_49
     .            +jac_48_57*jac_48_57
        smax(i)= max(smax(i),jac_38_29*jac_38_29+jac_19_37*jac_19_37
     .            +jac_27_18*jac_27_18)
        smax(i)= max(smax(i),jac_26_35*jac_26_35+jac_34_16*jac_34_16
     .            +jac_15_24*jac_15_24)
       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
      END