sjacidp.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/.
!||====================================================================
!||    sjacidp       ../starter/source/elements/solid/solide/sjacidp.F
!||--- called by ------------------------------------------------------
!||    sinit3        ../starter/source/elements/solid/solide/sinit3.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE sjacidp(
     .              XD1  ,XD2  ,XD3  ,XD4  ,XD5  ,XD6  ,XD7  ,XD8   ,
     .              YD1  ,YD2  ,YD3  ,YD4  ,YD5  ,YD6  ,YD7  ,YD8   ,
     .              ZD1  ,ZD2  ,ZD3  ,ZD4  ,ZD5  ,ZD6  ,ZD7  ,ZD8   ,
     .              JAC_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"
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 , INTENT(IN) :: NEL
      my_real , DIMENSION(10,NEL),INTENT(OUT) :: JAC_I     
      DOUBLE PRECISION , DIMENSION(MVSIZ), INTENT(IN) ::
     .   XD1, XD2, XD3, XD4, XD5, XD6, XD7, XD8,
     .   yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8,
     .   zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I
C
      my_real
     .   JAC1(MVSIZ), JAC2(MVSIZ), JAC3(MVSIZ), 
     .   jac4(mvsiz), jac5(mvsiz), jac6(mvsiz),
     .   jac7(mvsiz), jac8(mvsiz), jac9(mvsiz),
     .   jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz)
C
      my_real
     .   det(mvsiz), dett(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)
C=======================================================================
      DO i=1,nel
        x17(i)=xd7(i)-xd1(i)
        x28(i)=xd8(i)-xd2(i)
        x35(i)=xd5(i)-xd3(i)
        x46(i)=xd6(i)-xd4(i)
C
        y17(i)=yd7(i)-yd1(i)
        y28(i)=yd8(i)-yd2(i)
        y35(i)=yd5(i)-yd3(i)
        y46(i)=yd6(i)-yd4(i)
C
        z17(i)=zd7(i)-zd1(i)
        z28(i)=zd8(i)-zd2(i)
        z35(i)=zd5(i)-zd3(i)
        z46(i)=zd6(i)-zd4(i)
      ENDDO
C
C Jacobian Matrix
      DO i=1,nel               
        jac1(i)=x17(i)+x28(i)-x35(i)-x46(i)
        jac2(i)=y17(i)+y28(i)-y35(i)-y46(i)
        jac3(i)=z17(i)+z28(i)-z35(i)-z46(i)
C
        jac4(i)=x17(i)+x46(i)+x28(i)+x35(i)
        jac5(i)=y17(i)+y46(i)+y28(i)+y35(i)
        jac6(i)=z17(i)+z46(i)+z28(i)+z35(i)
C
        jac7(i)=x17(i)+x46(i)-x28(i)-x35(i)
        jac8(i)=y17(i)+y46(i)-y28(i)-y35(i)
        jac9(i)=z17(i)+z46(i)-z28(i)-z35(i)
      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_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
      ENDDO
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))
       dett(i)=one_over_64/max(det(i),em20)
      ENDDO     
C
C Jacobian matrix inverse
      DO i=1,nel
        jac_i(1,i)=dett(i)*jac_59_68(i)
        jac_i(4,i)=dett(i)*jac_67_49(i)
        jac_i(7,i)=dett(i)*jac_48_57(i)
        jac_i(2,i)=dett(i)*(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
        jac_i(5,i)=dett(i)*( jac1(i)*jac9(i)-jac3(i)*jac7(i))
        jac_i(8,i)=dett(i)*(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
        jac_i(3,i)=dett(i)*( jac2(i)*jac6(i)-jac3(i)*jac5(i))
        jac_i(6,i)=dett(i)*(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
        jac_i(9,i)=dett(i)*( jac1(i)*jac5(i)-jac2(i)*jac4(i))
      ENDDO
C
      DO i=1,nel
        jac_i(10,i) = det(i)
      ENDDO
C
      RETURN
      END SUBROUTINE sjacidp