s8zdericm3.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/.
!||====================================================================
!||    s8zdericm3    ../engine/source/elements/solid/solide8z/s8zdericm3.F
!||--- called by ------------------------------------------------------
!||    s8zforc3      ../engine/source/elements/solid/solide8z/s8zforc3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg        ../engine/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../engine/share/message_module/message_mod.f
!||====================================================================
      SUBROUTINE s8zdericm3(
     1   DET,     NGL,     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,      PX1,     PX2,
     8   PX3,     PX4,     PY1,     PY2,
     9   PY3,     PY4,     PZ1,     PZ2,
     A   PZ3,     PZ4,     PX1H1,   PX1H2,
     B   PX1H3,   PX1H4,   PX2H1,   PX2H2,
     C   PX2H3,   PX2H4,   PX3H1,   PX3H2,
     D   PX3H3,   PX3H4,   PX4H1,   PX4H2,
     E   PX4H3,   PX4H4,   HX,      HY,
     F   HZ,      JAC1,    JAC2,    JAC3,
     G   JAC4,    JAC5,    JAC6,    JAC7,
     H   JAC8,    JAC9,    SMAX,    SAV,
     I   OFFG,    NNEGA,   INDEX,   NEL,
     J   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) :: ISMSTR
      INTEGER NNEGA,INDEX(MVSIZ),NEL
C     REAL
      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
     .   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(*),offg(*)
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-----------------------------------------------
        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
        DO j=1,nnega
          i = index(j)
#include "lockon.inc"
           IF(ismstr<10) THEN
              CALL ancmsg(msgid=260,anmode=aninfo,
     .                    i1=ngl(i))
             ELSE
              CALL ancmsg(msgid=262,anmode=aninfo,
     .                    i1=ngl(i))
             END IF
#include "lockoff.inc"
        ENDDO
C
#include "vectorize.inc"
        DO j=1,nnega
          i = index(j)
            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      
            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_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
C
          det(i)=one_over_64*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
        ENDDO
#include "vectorize.inc"
         DO j=1,nnega
          i = index(j)
          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))
          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
         END DO
C
C mode 1-4
C 1 1 -1 -1 -1 -1 1 1
#include "vectorize.inc"
       DO j=1,nnega
         i = index(j)
         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)
C   
         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)
C   
         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)
C   
         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)
         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
      RETURN
C
 3000 FORMAT(/' ZERO OR NEGATIVE SUB-VOLUME : 3D-ELEMENT NB:',i10/,
     +        ' ELEMENT IS SWITCHED TO SMALL STRAIN OPTION'/) 
      END