i8cst3.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/.
!||====================================================================
!||    i8cst3   ../engine/source/interfaces/inter3d/i8cst3.F
!||--- called by ------------------------------------------------------
!||    intvo8   ../engine/source/interfaces/inter3d/intvo8.F
!||====================================================================
      SUBROUTINE i8cst3(
     1   X1,      Y1,      Z1,      X2,
     2   Y2,      Z2,      X3,      Y3,
     3   Z3,      X4,      Y4,      Z4,
     4   XI,      YI,      ZI,      N1,
     5   N2,      N3,      ANS,     SSC,
     6   TTC,     XFACE,   X0,      Y0,
     7   Z0,      XX1,     YY1,     ZZ1,
     8   XX2,     YY2,     ZZ2,     XX3,
     9   YY3,     ZZ3,     XX4,     YY4,
     A   ZZ4,     XI1,     YI1,     ZI1,
     B   XI2,     YI2,     ZI2,     XI3,
     C   YI3,     ZI3,     XI4,     YI4,
     D   ZI4,     XN1,     YN1,     ZN1,
     E   XN2,     YN2,     ZN2,     XN3,
     F   YN3,     ZN3,     XN4,     YN4,
     G   ZN4,     AREA,    LFT,     LLT)
 
 
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(INOUT) :: LFT
      INTEGER, INTENT(INOUT) :: LLT
      my_real
     .   X1(*), X2(*), X3(*), X4(*),
     .     Y1(*), Y2(*), Y3(*), Y4(*),
     .     Z1(*), Z2(*), Z3(*), Z4(*),
     .     XI(*), YI(*), ZI(*), ANS(*),
     .     N1(*), N2(*), N3(*), SSC(*), TTC(*),
     .     X0(*), Y0(*), Z0(*), XFACE(*)
      my_real
     .     XX1(*), XX2(*), XX3(*), XX4(*),
     .     YY1(*), YY2(*), YY3(*), YY4(*),
     .     ZZ1(*), ZZ2(*), ZZ3(*), ZZ4(*),
     .     XI1(*), XI2(*), XI3(*), XI4(*),
     .     YI1(*), YI2(*), YI3(*), YI4(*),
     .     ZI1(*), ZI2(*), ZI3(*), ZI4(*),
     .     xn1(*), xn2(*), xn3(*), xn4(*),
     .     yn1(*), yn2(*), yn3(*), yn4(*),
     .     zn1(*), zn2(*), zn3(*), zn4(*),
     .     area(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real AN     
C=======================================================================
      DO 100 I=lft,llt
      x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
      y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
      z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
C
      xx1(i) = x1(i)-x0(i)
      xx2(i) = x2(i)-x0(i)
      xx3(i) = x3(i)-x0(i)
      xx4(i) = x4(i)-x0(i)
      yy1(i) = y1(i)-y0(i)
      yy2(i) = y2(i)-y0(i)
      yy3(i) = y3(i)-y0(i)
      yy4(i) = y4(i)-y0(i)
      zz1(i) = z1(i)-z0(i)
      zz2(i) = z2(i)-z0(i)
      zz3(i) = z3(i)-z0(i)
      zz4(i) = z4(i)-z0(i)
C
      xi1(i) = x1(i)-xi(i)
      xi2(i) = x2(i)-xi(i)
      xi3(i) = x3(i)-xi(i)
      xi4(i) = x4(i)-xi(i)
      yi1(i) = y1(i)-yi(i)
      yi2(i) = y2(i)-yi(i)
      yi3(i) = y3(i)-yi(i)
      yi4(i) = y4(i)-yi(i)
      zi1(i) = z1(i)-zi(i)
      zi2(i) = z2(i)-zi(i)
      zi3(i) = z3(i)-zi(i)
      zi4(i) = z4(i)-zi(i)
 100  CONTINUE
C
      DO 120 i=lft,llt
      xn1(i) = yy1(i)*zz2(i) - yy2(i)*zz1(i)
      yn1(i) = zz1(i)*xx2(i) - zz2(i)*xx1(i)
      zn1(i) = xx1(i)*yy2(i) - xx2(i)*yy1(i)
      n1(i)=xn1(i)
      n2(i)=yn1(i)
      n3(i)=zn1(i)
 120  CONTINUE
C
      DO 140 i=lft,llt
      xn2(i) = yy2(i)*zz3(i) - yy3(i)*zz2(i)
      yn2(i) = zz2(i)*xx3(i) - zz3(i)*xx2(i)
      zn2(i) = xx2(i)*yy3(i) - xx3(i)*yy2(i)
      n1(i)=n1(i)+xn2(i)
      n2(i)=n2(i)+yn2(i)
      n3(i)=n3(i)+zn2(i)
 140  CONTINUE
C
      DO 160 i=lft,llt
      xn3(i) = yy3(i)*zz4(i) - yy4(i)*zz3(i)
      yn3(i) = zz3(i)*xx4(i) - zz4(i)*xx3(i)
      zn3(i) = xx3(i)*yy4(i) - xx4(i)*yy3(i)
      n1(i)=n1(i)+xn3(i)
      n2(i)=n2(i)+yn3(i)
      n3(i)=n3(i)+zn3(i)
 160  CONTINUE
C
      DO 180 i=lft,llt
      xn4(i) = yy4(i)*zz1(i) - yy1(i)*zz4(i)
      yn4(i) = zz4(i)*xx1(i) - zz1(i)*xx4(i)
      zn4(i) = xx4(i)*yy1(i) - xx1(i)*yy4(i)
      n1(i)=n1(i)+xn4(i)
      n2(i)=n2(i)+yn4(i)
      n3(i)=n3(i)+zn4(i)
 180  CONTINUE
C
      DO 200 i=lft,llt
      an= max(em20,sqrt(n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)))
      n1(i)=n1(i)/an
      n2(i)=n2(i)/an
      n3(i)=n3(i)/an
      area(i)=half*an
 200  CONTINUE
C
      DO 210 i=lft,llt
      x0(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
      y0(i)=(n1(i)*xn2(i)+n2(i)*yn2(i)+n3(i)*zn2(i))
      z0(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
      xx1(i)=(n1(i)*xn4(i)+n2(i)*yn4(i)+n3(i)*zn4(i))
 210  CONTINUE
C
      DO 220 i=lft,llt
      xn1(i) = yi1(i)*zi2(i) - yi2(i)*zi1(i)
      yn1(i) = zi1(i)*xi2(i) - zi2(i)*xi1(i)
      zn1(i) = xi1(i)*yi2(i) - xi2(i)*yi1(i)
      yy1(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
 220  CONTINUE
C
      DO 240 i=lft,llt
      xn2(i) = yi2(i)*zi3(i) - yi3(i)*zi2(i)
      yn2(i) = zi2(i)*xi3(i) - zi3(i)*xi2(i)
      zn2(i) = xi2(i)*yi3(i) - xi3(i)*yi2(i)
      zz1(i)=(n1(i)*xn2(i)+n2(i)*yn2(i)+n3(i)*zn2(i))
 240  CONTINUE
C
      DO 260 i=lft,llt
      xn3(i) = yi3(i)*zi4(i) - yi4(i)*zi3(i)
      yn3(i) = zi3(i)*xi4(i) - zi4(i)*xi3(i)
      zn3(i) = xi3(i)*yi4(i) - xi4(i)*yi3(i)
      xx2(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
 260  CONTINUE
C
      DO 280 i=lft,llt
      xn4(i) = yi4(i)*zi1(i) - yi1(i)*zi4(i)
      yn4(i) = zi4(i)*xi1(i) - zi1(i)*xi4(i)
      zn4(i) = xi4(i)*yi1(i) - xi1(i)*yi4(i)
      yy2(i)=(n1(i)*xn4(i)+n2(i)*yn4(i)+n3(i)*zn4(i))
 280  CONTINUE
C
      DO 300 i=lft,llt
      zz2(i)=y0(i)*yy2(i)
      xx3(i)=zz1(i)*xx1(i)
 300  CONTINUE
C
      DO 320 i=lft,llt
      IF(xface(i)==zero)GOTO 320
      IF(zz2(i)+xx3(i)/=zero)THEN
       ssc(i)=(zz2(i)-xx3(i))/(zz2(i)+xx3(i))
      ELSE
       ssc(i)=zero
      ENDIF
      IF(z0(i)/=zero)THEN
       zz2(i)=yy1(i)*z0(i)
       xx3(i)=xx2(i)*x0(i)
       IF(zz2(i)+xx3(i)/=zero)THEN
        ttc(i)=(zz2(i)-xx3(i))/(zz2(i)+xx3(i))
       ELSE
        ttc(i)=zero
       ENDIF
      ELSE
       ttc(i)=(yy1(i)-x0(i))/x0(i)
      ENDIF
 320  CONTINUE
C
      RETURN
      END