i7pen3.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/.
!||====================================================================
!||    i7pen3   ../engine/source/interfaces/intsort/i7pen3.F
!||--- called by ------------------------------------------------------
!||    i10sto   ../engine/source/interfaces/intsort/i10sto.F
!||    i20sto   ../engine/source/interfaces/intsort/i20sto.F
!||    i21sto   ../engine/source/interfaces/int21/i21sto.F
!||    i23sto   ../engine/source/interfaces/int23/i23sto.F
!||    i7sto    ../engine/source/interfaces/intsort/i7sto.F
!||====================================================================
      SUBROUTINE i7pen3(JLT   ,MARGE ,X1    ,X2     ,X3   ,
     .                  X4    ,Y1    ,Y2    ,Y3     ,Y4   ,
     .                  Z1    ,Z2    ,Z3    ,Z4     ,XI   ,
     .                  YI    ,ZI    ,PENE  ,IX1    ,IX2  ,
     .                  IX3   ,IX4   ,IGAP  ,GAP    ,GAPV )
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 JLT, IGAP
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
      my_real
     .        GAPV(MVSIZ), MARGE, GAP
      my_real
     .     x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
     .     y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
     .     z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .     xi(mvsiz), yi(mvsiz), zi(mvsiz), pene(mvsiz)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IG,I3N
      my_real
     .     X0(MVSIZ), Y0(MVSIZ), Z0(MVSIZ), GAP2(MVSIZ),
     .     NX1(MVSIZ), NX2(MVSIZ), NX3(MVSIZ), NX4(MVSIZ),
     .     ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
     .     nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
     .     lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
     .     lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
     .     al1(mvsiz), al2(mvsiz), al3(mvsiz), al4(mvsiz),
     .     p1(mvsiz),  p2(mvsiz),  p3(mvsiz),  p4(mvsiz),
     .     x01(mvsiz),  x02(mvsiz),  x03(mvsiz), x04(mvsiz),
     .     y01(mvsiz),  y02(mvsiz),  y03(mvsiz), y04(mvsiz),
     .     z01(mvsiz),  z02(mvsiz),  z03(mvsiz), z04(mvsiz),
     .     xi1(mvsiz),  xi2(mvsiz),  xi3(mvsiz), xi4(mvsiz),
     .     yi1(mvsiz),  yi2(mvsiz),  yi3(mvsiz), yi4(mvsiz),
     .     zi1(mvsiz),  zi2(mvsiz),  zi3(mvsiz), zi4(mvsiz),
     .     hlb1(mvsiz), hlc1(mvsiz), hlb2(mvsiz),hlc2(mvsiz),
     .     hlb3(mvsiz), hlc3(mvsiz), hlb4(mvsiz),hlc4(mvsiz)
      my_real
     .     dti, s2,a1,a2,a3,a4,d1,d2,d3,d4,
     .     x12,x23,x34,x41,xi0,sx1,sx2,sx3,sx4,sx0,
     .     y12,y23,y34,y41,yi0,sy1,sy2,sy3,sy4,sy0,
     .     z12,z23,z34,z41,zi0,sz1,sz2,sz3,sz4,sz0,
     .     la, hla, aaa, zoneinf, zoneinf2
C-----------------------------------------------
c GAPV(I)=GAP+CURV_MAX(CAND_E(I))
      DO i = 1, jlt
          zoneinf = gapv(i)+marge
          gap2(i)= zoneinf*zoneinf
      END DO
C
C  0 QUAD, 1 TRI ,2 MIXTE
      i3n=0
      DO i=1,jlt
       IF(ix3(i)==ix4(i))i3n=i3n+1
      ENDDO
      IF(i3n==jlt)THEN
        i3n=1
      ELSEIF(i3n/=0)THEN
        i3n=2
      ENDIF
C--------------------------------------------------------
C  UNIQUEMENT POUR PAQUET DE QUADRANGLE
C--------------------------------------------------------
      IF(i3n==0) THEN
       DO i=1,jlt
         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)) 
       ENDDO
C--------------------------------------------------------
C  CAS DES PAQUETS MIXTES
C--------------------------------------------------------
      ELSEIF(i3n==2) THEN
       DO i=1,jlt
        IF(ix3(i)/=ix4(i))THEN
         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)) 
        ELSE
         x0(i) = x3(i)
         y0(i) = y3(i)
         z0(i) = z3(i)
        ENDIF
       ENDDO
      ENDIF
C--------------------------------------------------------
C  UNIQUEMENT POUR PAQUET DE TRIANGLE
C--------------------------------------------------------
      IF(i3n==1) THEN
       DO i=1,jlt
C
       x01(i) = x1(i) - x3(i)
       y01(i) = y1(i) - y3(i)
       z01(i) = z1(i) - z3(i)
C
       x02(i) = x2(i) - x3(i)
       y02(i) = y2(i) - y3(i)
       z02(i) = z2(i) - z3(i)
C
       xi0 = x3(i) - xi(i)
       yi0 = y3(i) - yi(i)
       zi0 = z3(i) - zi(i)
C
       xi1(i) = x1(i) - xi(i)
       yi1(i) = y1(i) - yi(i)
       zi1(i) = z1(i) - zi(i)
C
       xi2(i) = x2(i) - xi(i)
       yi2(i) = y2(i) - yi(i)
       zi2(i) = z2(i) - zi(i)
C
       sx1 = yi0*zi1(i) - zi0*yi1(i)
       sy1 = zi0*xi1(i) - xi0*zi1(i)
       sz1 = xi0*yi1(i) - yi0*xi1(i)
C
       sx2 = yi0*zi2(i) - zi0*yi2(i)
       sy2 = zi0*xi2(i) - xi0*zi2(i)
       sz2 = xi0*yi2(i) - yi0*xi2(i)
C
       sx0 = y01(i)*z02(i) - z01(i)*y02(i)
       sy0 = z01(i)*x02(i) - x01(i)*z02(i)
       sz0 = x01(i)*y02(i) - y01(i)*x02(i)
       s2 = 1./max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
C
       lb1(i) = -(sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
       lc1(i) =  (sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
C
        aaa    = one/max(em30,x01(i)*x01(i)+y01(i)*y01(i)+z01(i)*z01(i))
        hlc1(i)= lc1(i)*abs(lc1(i))*aaa
        al1(i) = -(xi0*x01(i)+yi0*y01(i)+zi0*z01(i))*aaa
        al1(i) = max(zero,min(one,al1(i)))
        aaa    = one/max(em30,x02(i)*x02(i)+y02(i)*y02(i)+z02(i)*z02(i))
        hlb1(i)= lb1(i)*abs(lb1(i))*aaa
        al2(i) = -(xi0*x02(i)+yi0*y02(i)+zi0*z02(i))*aaa
        al2(i) = max(zero,min(one,al2(i)))
C
      ENDDO
C
      DO i=1,jlt
        x12 = x2(i) - x1(i)
        y12 = y2(i) - y1(i)
        z12 = z2(i) - z1(i)
        la = one - lb1(i) - lc1(i)
        aaa = one / max(em20,x12*x12+y12*y12+z12*z12)
        hla= la*abs(la) * aaa
        IF(la<zero.AND.
     +     hla<=hlb1(i).AND.hla<=hlc1(i))THEN
         lb1(i) = (xi2(i)*x12+yi2(i)*y12+zi2(i)*z12)*aaa
         lb1(i) = max(zero,min(one,lb1(i)))
         lc1(i) = one - lb1(i)
        ELSEIF(lb1(i)<zero.AND.
     +        hlb1(i)<=hlc1(i).AND.hlb1(i)<=hla)THEN
         lb1(i) = zero
         lc1(i) = al2(i)
        ELSEIF(lc1(i)<zero.AND.
     +        hlc1(i)<=hla.AND.hlc1(i)<=hlb1(i))THEN
         lc1(i) = zero
         lb1(i) = al1(i)
        ENDIF
      ENDDO
C
      DO i=1,jlt
C
       nx1(i) = xi(i)-(x3(i) + lb1(i)*x01(i) + lc1(i)*x02(i))
       ny1(i) = yi(i)-(y3(i) + lb1(i)*y01(i) + lc1(i)*y02(i))
       nz1(i) = zi(i)-(z3(i) + lb1(i)*z01(i) + lc1(i)*z02(i))
       p1(i) = nx1(i)*nx1(i) + ny1(i)*ny1(i) +nz1(i)*nz1(i)
C !!!!!!!!!!!!!!!!!!!!!!!
C  PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
C!!!!!!!!!!!!!!!!!!!!!!!!
       pene(i) = max(zero, gap2(i) - p1(i))
C
      ENDDO
C--------------------------------------------------------
C  CAS DES PAQUETS MIXTES OU QUADRANGLE
C--------------------------------------------------------
      ELSE
C
       DO i=1,jlt
C
        x01(i) = x1(i) - x0(i)
        y01(i) = y1(i) - y0(i)
        z01(i) = z1(i) - z0(i)
C
        x02(i) = x2(i) - x0(i)
        y02(i) = y2(i) - y0(i)
        z02(i) = z2(i) - z0(i)
C
        x03(i) = x3(i) - x0(i)
        y03(i) = y3(i) - y0(i)
        z03(i) = z3(i) - z0(i)
C
        x04(i) = x4(i) - x0(i)
        y04(i) = y4(i) - y0(i)
        z04(i) = z4(i) - z0(i)
C
        xi0 = x0(i) - xi(i)
        yi0 = y0(i) - yi(i)
        zi0 = z0(i) - zi(i)
C
        xi1(i) = x1(i) - xi(i)
        yi1(i) = y1(i) - yi(i)
        zi1(i) = z1(i) - zi(i)
C
        xi2(i) = x2(i) - xi(i)
        yi2(i) = y2(i) - yi(i)
        zi2(i) = z2(i) - zi(i)
C
        xi3(i) = x3(i) - xi(i)
        yi3(i) = y3(i) - yi(i)
        zi3(i) = z3(i) - zi(i)
C
        xi4(i) = x4(i) - xi(i)
        yi4(i) = y4(i) - yi(i)
        zi4(i) = z4(i) - zi(i)
C
        sx1 = yi0*zi1(i) - zi0*yi1(i)
        sy1 = zi0*xi1(i) - xi0*zi1(i)
        sz1 = xi0*yi1(i) - yi0*xi1(i)
C
        sx2 = yi0*zi2(i) - zi0*yi2(i)
        sy2 = zi0*xi2(i) - xi0*zi2(i)
        sz2 = xi0*yi2(i) - yi0*xi2(i)
C
        sx0 = y01(i)*z02(i) - z01(i)*y02(i)
        sy0 = z01(i)*x02(i) - x01(i)*z02(i)
        sz0 = x01(i)*y02(i) - y01(i)*x02(i)
        s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
C
        lb1(i) = -(sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
        lc1(i) =  (sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
C
        sx3 = yi0*zi3(i) - zi0*yi3(i)
        sy3 = zi0*xi3(i) - xi0*zi3(i)
        sz3 = xi0*yi3(i) - yi0*xi3(i)
C
        sx0 = y02(i)*z03(i) - z02(i)*y03(i)
        sy0 = z02(i)*x03(i) - x02(i)*z03(i)
        sz0 = x02(i)*y03(i) - y02(i)*x03(i)
        s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
C
        lb2(i) = -(sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
        lc2(i) =  (sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
C
        sx4 = yi0*zi4(i) - zi0*yi4(i)
        sy4 = zi0*xi4(i) - xi0*zi4(i)
        sz4 = xi0*yi4(i) - yi0*xi4(i)
C
        sx0 = y03(i)*z04(i) - z03(i)*y04(i)
        sy0 = z03(i)*x04(i) - x03(i)*z04(i)
        sz0 = x03(i)*y04(i) - y03(i)*x04(i)
        s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
C
        lb3(i) = -(sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
        lc3(i) =  (sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
C
        sx0 = y04(i)*z01(i) - z04(i)*y01(i)
        sy0 = z04(i)*x01(i) - x04(i)*z01(i)
        sz0 = x04(i)*y01(i) - y04(i)*x01(i)
        s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
C
        lb4(i) = -(sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
        lc4(i) =  (sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
C
        aaa    = one/max(em30,x01(i)*x01(i)+y01(i)*y01(i)+z01(i)*z01(i))
        hlc1(i)= lc1(i)*abs(lc1(i))*aaa
        hlb4(i)= lb4(i)*abs(lb4(i))*aaa
        al1(i) = -(xi0*x01(i)+yi0*y01(i)+zi0*z01(i))*aaa
        al1(i) = max(zero,min(one,al1(i)))
        aaa    = one/max(em30,x02(i)*x02(i)+y02(i)*y02(i)+z02(i)*z02(i))
        hlc2(i)= lc2(i)*abs(lc2(i))*aaa
        hlb1(i)= lb1(i)*abs(lb1(i))*aaa
        al2(i) = -(xi0*x02(i)+yi0*y02(i)+zi0*z02(i))*aaa
        al2(i) = max(zero,min(one,al2(i)))
        aaa    = one/max(em30,x03(i)*x03(i)+y03(i)*y03(i)+z03(i)*z03(i))
        hlc3(i)= lc3(i)*abs(lc3(i))*aaa
        hlb2(i)= lb2(i)*abs(lb2(i))*aaa
        al3(i) = -(xi0*x03(i)+yi0*y03(i)+zi0*z03(i))*aaa
        al3(i) = max(zero,min(one,al3(i)))
        aaa    = one/max(em30,x04(i)*x04(i)+y04(i)*y04(i)+z04(i)*z04(i))
        hlc4(i)= lc4(i)*abs(lc4(i))*aaa
        hlb3(i)= lb3(i)*abs(lb3(i))*aaa
        al4(i) = -(xi0*x04(i)+yi0*y04(i)+zi0*z04(i))*aaa
        al4(i) = max(zero,min(one,al4(i)))
C
       ENDDO
C
       DO i=1,jlt
        x12 = x2(i) - x1(i)
        y12 = y2(i) - y1(i)
        z12 = z2(i) - z1(i)
        la = one - lb1(i) - lc1(i)
        aaa = one / max(em20,x12*x12+y12*y12+z12*z12)
        hla= la*abs(la) * aaa
        IF(la<zero.AND.
     +     hla<=hlb1(i).AND.hla<=hlc1(i))THEN
         lb1(i) = (xi2(i)*x12+yi2(i)*y12+zi2(i)*z12) * aaa
         lb1(i) = max(zero,min(one,lb1(i)))
         lc1(i) = one - lb1(i)
        ELSEIF(lb1(i)<zero.AND.
     +         hlb1(i)<=hlc1(i).AND.hlb1(i)<=hla)THEN
         lb1(i) = zero
         lc1(i) = al2(i)
        ELSEIF(lc1(i)<zero.AND.
     +         hlc1(i)<=hla.AND.hlc1(i)<=hlb1(i))THEN
         lc1(i) = zero
         lb1(i) = al1(i)
        ENDIF
       ENDDO
C
       DO i=1,jlt
          x23 = x3(i) - x2(i)
          y23 = y3(i) - y2(i)
          z23 = z3(i) - z2(i)
        la = one - lb2(i) - lc2(i)
        aaa = one / max(em20,x23*x23+y23*y23+z23*z23)
        hla= la*abs(la) * aaa
        IF(la<zero.AND.
     +     hla<=hlb2(i).AND.hla<=hlc2(i))THEN
         lb2(i) = (xi3(i)*x23+yi3(i)*y23+zi3(i)*z23)*aaa
         lb2(i) = max(zero,min(one,lb2(i)))
         lc2(i) = one - lb2(i)
        ELSEIF(lb2(i)<zero.AND.
     +         hlb2(i)<=hlc2(i).AND.hlb2(i)<=hla)THEN
         lb2(i) = zero
         lc2(i) = al3(i)
        ELSEIF(lc2(i)<zero.AND.
     +         hlc2(i)<=hla.AND.hlc2(i)<=hlb2(i))THEN
         lc2(i) = zero
         lb2(i) = al2(i)
        ENDIF
       ENDDO
C
       DO i=1,jlt
          x34 = x4(i) - x3(i)
          y34 = y4(i) - y3(i)
          z34 = z4(i) - z3(i)
        la = one - lb3(i) - lc3(i)
        aaa = one / max(em20,x34*x34+y34*y34+z34*z34)
        hla= la*abs(la) * aaa
        IF(la<zero.AND.
     +     hla<=hlb3(i).AND.hla<=hlc3(i))THEN
         lb3(i) = (xi4(i)*x34+yi4(i)*y34+zi4(i)*z34)*aaa
         lb3(i) = max(zero,min(one,lb3(i)))
         lc3(i) = one - lb3(i)
        ELSEIF(lb3(i)<zero.AND.
     +         hlb3(i)<=hlc3(i).AND.hlb3(i)<=hla)THEN
         lb3(i) = zero
         lc3(i) = al4(i)
        ELSEIF(lc3(i)<zero.AND.
     +         hlc3(i)<=hla.AND.hlc3(i)<=hlb3(i))THEN
         lc3(i) = zero
         lb3(i) = al3(i)
        ENDIF
       ENDDO
C
       DO i=1,jlt
          x41 = x1(i) - x4(i)
          y41 = y1(i) - y4(i)
          z41 = z1(i) - z4(i)
        la = one - lb4(i) - lc4(i)
        aaa = one / max(em20,x41*x41+y41*y41+z41*z41)
        hla= la*abs(la) * aaa
        IF(la<zero.AND.
     +     hla<=hlb4(i).AND.hla<=hlc4(i))THEN
         lb4(i) = (xi1(i)*x41+yi1(i)*y41+zi1(i)*z41)*aaa
         lb4(i) = max(zero,min(one,lb4(i)))
         lc4(i) = one - lb4(i)
        ELSEIF(lb4(i)<zero.AND.
     +         hlb4(i)<=hlc4(i).AND.hlb4(i)<=hla)THEN
         lb4(i) = zero
         lc4(i) = al1(i)
        ELSEIF(lc4(i)<zero.AND.
     +         hlc4(i)<=hla.AND.hlc4(i)<=hlb4(i))THEN
         lc4(i) = zero
         lb4(i) = al4(i)
        ENDIF
       ENDDO
 
C
C
C
C
       DO i=1,jlt
C
        nx1(i) = xi(i)-(x0(i) + lb1(i)*x01(i) + lc1(i)*x02(i))
        ny1(i) = yi(i)-(y0(i) + lb1(i)*y01(i) + lc1(i)*y02(i))
        nz1(i) = zi(i)-(z0(i) + lb1(i)*z01(i) + lc1(i)*z02(i))
        p1(i) = nx1(i)*nx1(i) + ny1(i)*ny1(i) +nz1(i)*nz1(i)
        d1 = max(zero, gap2(i) - p1(i))
C
        nx2(i) = xi(i)-(x0(i) + lb2(i)*x02(i) + lc2(i)*x03(i))
        ny2(i) = yi(i)-(y0(i) + lb2(i)*y02(i) + lc2(i)*y03(i))
        nz2(i) = zi(i)-(z0(i) + lb2(i)*z02(i) + lc2(i)*z03(i))
        p2(i) = nx2(i)*nx2(i) + ny2(i)*ny2(i) +nz2(i)*nz2(i)
        d2 = max(zero, gap2(i) - p2(i))
C
        nx3(i) = xi(i)-(x0(i) + lb3(i)*x03(i) + lc3(i)*x04(i))
        ny3(i) = yi(i)-(y0(i) + lb3(i)*y03(i) + lc3(i)*y04(i))
        nz3(i) = zi(i)-(z0(i) + lb3(i)*z03(i) + lc3(i)*z04(i))
        p3(i) = nx3(i)*nx3(i) + ny3(i)*ny3(i) +nz3(i)*nz3(i)
        d3 = max(zero, gap2(i) - p3(i))
C
        nx4(i) = xi(i)-(x0(i) + lb4(i)*x04(i) + lc4(i)*x01(i))
        ny4(i) = yi(i)-(y0(i) + lb4(i)*y04(i) + lc4(i)*y01(i))
        nz4(i) = zi(i)-(z0(i) + lb4(i)*z04(i) + lc4(i)*z01(i))
        p4(i) = nx4(i)*nx4(i) + ny4(i)*ny4(i) +nz4(i)*nz4(i)
        d4 = max(zero, gap2(i) - p4(i))
C !!!!!!!!!!!!!!!!!!!!!!!
C  PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
C!!!!!!!!!!!!!!!!!!!!!!!!
        pene(i) = max(d1,d2,d3,d4)
C
       ENDDO
      ENDIF
C
      RETURN
      END
C===============================================================================