s8zderims3.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/.
!||====================================================================
!||    s8zderims3   ../engine/source/elements/solid/solide8z/s8zderims3.F
!||--- called by ------------------------------------------------------
!||    s8eforc3     ../engine/source/elements/solid/solide8e/s8eforc3.F
!||    s8sforc3     ../engine/source/elements/solid/solide8s/s8sforc3.F
!||    s8zforc3     ../engine/source/elements/solid/solide8z/s8zforc3.F
!||====================================================================
      SUBROUTINE s8zderims3(VOLDP,
     .    KSI,ETA,ZETA,WI,
     .    HX,    HY,    HZ,   
     .    CJ1,CJ2,CJ3,
     .    CJ4,CJ5,CJ6,
     .    CJ7,CJ8,CJ9,
     .    JAC1,JAC2,JAC3,
     .    JAC4,JAC5,JAC6,
     .    JAC7,JAC8,JAC9,
     .    JACI1,JACI2,JACI3,
     .    JACI4,JACI5,JACI6,
     .    JACI7,JACI8,JACI9,NNEGA,INDEX)
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   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NNEGA,INDEX(MVSIZ)
C     REAL
      my_real
     .   KSI,ETA,ZETA,WI,
     .   HX(MVSIZ,4),  HY(MVSIZ,4), HZ(MVSIZ,4),   
     .   CJ1(*),CJ2(*),CJ3(*),
     .   CJ4(*),CJ5(*),CJ6(*),
     .   CJ7(*),CJ8(*),CJ9(*),
     .   JAC1(*),JAC2(*),JAC3(*),
     .   JAC4(*),JAC5(*),JAC6(*),
     .   JAC7(*),JAC8(*),JAC9(*),
     .   jaci1(*),jaci2(*),jaci3(*),
     .   jaci4(*),jaci5(*),jaci6(*),
     .   jaci7(*),jaci8(*),jaci9(*)
      DOUBLE PRECISION 
     .   VOLDP(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J ,ICOR,ep
C     REAL
C                                                                     12
      my_real
     .   DET ,DETT ,  
     .   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
      DOUBLE PRECISION 
     .   DETDP
C-----------------------------------------------
#include "vectorize.inc"
      DO j=1,nnega
       i = index(j)
       jac1(i)=cj1(i)+hx(i,3)*eta+(hx(i,2)+hx(i,4)*eta)*zeta
       jac2(i)=cj2(i)+hy(i,3)*eta+(hy(i,2)+hy(i,4)*eta)*zeta
       jac3(i)=cj3(i)+hz(i,3)*eta+(hz(i,2)+hz(i,4)*eta)*zeta
C
       jac4(i)=cj4(i)+hx(i,1)*zeta+(hx(i,3)+hx(i,4)*zeta)*ksi
       jac5(i)=cj5(i)+hy(i,1)*zeta+(hy(i,3)+hy(i,4)*zeta)*ksi
       jac6(i)=cj6(i)+hz(i,1)*zeta+(hz(i,3)+hz(i,4)*zeta)*ksi
C
       jac7(i)=cj7(i)+hx(i,2)*ksi+(hx(i,1)+hx(i,4)*ksi)*eta
       jac8(i)=cj8(i)+hy(i,2)*ksi+(hy(i,1)+hy(i,4)*ksi)*eta
       jac9(i)=cj9(i)+hz(i,2)*ksi+(hz(i,1)+hz(i,4)*ksi)*eta
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)
       detdp=one_over_512*(jac1(i)*jac_59_68+jac2(i)*jac_67_49+jac3(i)*jac_48_57)
       det = detdp
       voldp(i)= wi*detdp
       dett=one_over_512/det
       jaci1(i)=dett*jac_59_68
       jaci4(i)=dett*jac_67_49
       jaci7(i)=dett*jac_48_57
       jaci2(i)=dett*jac_38_29
       jaci5(i)=dett*jac_19_37
       jaci8(i)=dett*jac_27_18
       jaci3(i)=dett*jac_26_35
       jaci6(i)=dett*jac_34_16
       jaci9(i)=dett*jac_15_24
      ENDDO
C
      RETURN
      END