s8ederig3.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/.
!||====================================================================
!||    s8ederig3   ../engine/source/elements/solid/solide8e/s8ederig3.F
!||--- called by ------------------------------------------------------
!||    s8eforc3    ../engine/source/elements/solid/solide8e/s8eforc3.F
!||    s8sforc3    ../engine/source/elements/solid/solide8s/s8sforc3.F
!||====================================================================
      SUBROUTINE s8ederig3(
     1   PX1,     PX2,     PX3,     PX4,
     2   PX5,     PX6,     PX7,     PX8,
     3   PY1,     PY2,     PY3,     PY4,
     4   PY5,     PY6,     PY7,     PY8,
     5   PZ1,     PZ2,     PZ3,     PZ4,
     6   PZ5,     PZ6,     PZ7,     PZ8,
     7   AJI1,    AJI2,    AJI3,    AJI4,
     8   AJI5,    AJI6,    AJI7,    AJI8,
     9   AJI9,    PR,      PS,      PT,
     A   NEL)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.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
      my_real
     .   PX1(*), PX2(*), PX3(*), PX4(*),
     .   PX5(*), PX6(*), PX7(*), PX8(*),
     .   PY1(*), PY2(*), PY3(*), PY4(*),
     .   PY5(*), PY6(*), PY7(*), PY8(*),
     .   PZ1(*), PZ2(*), PZ3(*), PZ4(*), 
     .   PZ5(*), PZ6(*), PZ7(*), PZ8(*),
     .   AJI1(*), AJI2(*), AJI3(*),
     .   AJI4(*), AJI5(*), AJI6(*),
     .   aji7(*), aji8(*), aji9(*),
     .   pr(8),ps(8),pt(8)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J 
C     REAL
C                                                                     12
      my_real
     .   A1PR1,A1PR3,A1PR5,A1PR7,
     .   A4PR1,A4PR3,A4PR5,A4PR7,
     .   A7PR1,A7PR3,A7PR5,A7PR7,
     .   A2PS1,A2PS2,A2PS5,A2PS6,
     .   A5PS1,A5PS2,A5PS5,A5PS6,
     .   A8PS1,A8PS2,A8PS5,A8PS6,
     .   a3pt1,a3pt2,a3pt3,a3pt4,
     .   a6pt1,a6pt2,a6pt3,a6pt4,
     .   a9pt1,a9pt2,a9pt3,a9pt4
C-----------------------------------------------
cc-----pxI
      DO i=1,nel
        a1pr1=aji1(i)*pr(1)
        a1pr3=aji1(i)*pr(3)
        a1pr5=aji1(i)*pr(5)
        a1pr7=aji1(i)*pr(7)
        a2ps1=aji2(i)*ps(1)
        a2ps2=aji2(i)*ps(2)
        a2ps5=aji2(i)*ps(5)
        a2ps6=aji2(i)*ps(6)
        a3pt1=aji3(i)*pt(1)
        a3pt2=aji3(i)*pt(2)
        a3pt3=aji3(i)*pt(3)
        a3pt4=aji3(i)*pt(4)
       px1(i)= a1pr1+a2ps1+a3pt1
       px2(i)=-a1pr1+a2ps2+a3pt2
       px3(i)= a1pr3-a2ps2+a3pt3
       px4(i)=-a1pr3-a2ps1+a3pt4
       px5(i)= a1pr5+a2ps5-a3pt1
       px6(i)=-a1pr5+a2ps6-a3pt2
       px7(i)= a1pr7-a2ps6-a3pt3
       px8(i)=-a1pr7-a2ps5-a3pt4
      ENDDO
C
      DO i=1,nel
C
        a4pr1=aji4(i)*pr(1)
        a4pr3=aji4(i)*pr(3)
        a4pr5=aji4(i)*pr(5)
        a4pr7=aji4(i)*pr(7)
        a5ps1=aji5(i)*ps(1)
        a5ps2=aji5(i)*ps(2)
        a5ps5=aji5(i)*ps(5)
        a5ps6=aji5(i)*ps(6)
        a6pt1=aji6(i)*pt(1)
        a6pt2=aji6(i)*pt(2)
        a6pt3=aji6(i)*pt(3)
        a6pt4=aji6(i)*pt(4)
       py1(i)= a4pr1+a5ps1+a6pt1
       py2(i)=-a4pr1+a5ps2+a6pt2
       py3(i)= a4pr3-a5ps2+a6pt3
       py4(i)=-a4pr3-a5ps1+a6pt4
       py5(i)= a4pr5+a5ps5-a6pt1
       py6(i)=-a4pr5+a5ps6-a6pt2
       py7(i)= a4pr7-a5ps6-a6pt3
       py8(i)=-a4pr7-a5ps5-a6pt4
      ENDDO
C
      DO i=1,nel
C
        a7pr1=aji7(i)*pr(1)
        a7pr3=aji7(i)*pr(3)
        a7pr5=aji7(i)*pr(5)
        a7pr7=aji7(i)*pr(7)
        a8ps1=aji8(i)*ps(1)
        a8ps2=aji8(i)*ps(2)
        a8ps5=aji8(i)*ps(5)
        a8ps6=aji8(i)*ps(6)
        a9pt1=aji9(i)*pt(1)
        a9pt2=aji9(i)*pt(2)
        a9pt3=aji9(i)*pt(3)
        a9pt4=aji9(i)*pt(4)
       pz1(i)= a7pr1+a8ps1+a9pt1
       pz2(i)=-a7pr1+a8ps2+a9pt2
       pz3(i)= a7pr3-a8ps2+a9pt3
       pz4(i)=-a7pr3-a8ps1+a9pt4
       pz5(i)= a7pr5+a8ps5-a9pt1
       pz6(i)=-a7pr5+a8ps6-a9pt2
       pz7(i)= a7pr7-a8ps6-a9pt3
       pz8(i)=-a7pr7-a8ps5-a9pt4
      ENDDO
C
      RETURN
       END