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      ../starter/source/interfaces/inter3d1/i7pen3.F
!||--- called by ------------------------------------------------------
!||    i20ini3     ../starter/source/interfaces/inter3d1/i20ini3.F
!||    i21buc1     ../starter/source/interfaces/inter3d1/i21buc3.F
!||    i21tri      ../starter/source/interfaces/inter3d1/i21tri.F
!||    i23buc1     ../starter/source/interfaces/inter3d1/i23buc3.F
!||    i23tri      ../starter/source/interfaces/inter3d1/i23tri.F
!||    i24buc1     ../starter/source/interfaces/inter3d1/i24buc1.F
!||    i24tri      ../starter/source/interfaces/inter3d1/i24tri.F
!||    i7buc1      ../starter/source/interfaces/inter3d1/i7buc1.F
!||    i7tri       ../starter/source/interfaces/inter3d1/i7tri.F
!||    i7trivox1   ../starter/source/interfaces/inter3d1/i7trivox1.F
!||    inint3      ../starter/source/interfaces/inter3d1/inint3.F
!||====================================================================
      SUBROUTINE i7pen3(MARGE,GAPV,N1 ,N2 ,N3 ,
     1                  PENE ,NX1 ,NY1,NZ1,NX2,
     2                  NY2  ,NZ2 ,NX3,NY3,NZ3,
     3                  NX4  ,NY4 ,NZ4,P1 ,P2 ,
     4                  P3   ,P4,LAST)
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) :: LAST !< last candidat
C     REAL
      my_real
     .        MARGE, GAPV(*)
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n1,n2,n3,pene
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx1,ny1,nz1
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx2,ny2,nz2
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx3,ny3,nz3
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx4,ny4,nz4
      my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: p1,p2,p3,p4
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     .     D1,D2,D3,D4,S2
C-----------------------------------------------
       DO i=1,last
        d1 = sqrt(p1(i))
        p1(i) = max(zero, gapv(i) + marge - d1)
C
        d2 = sqrt(p2(i))
        p2(i) = max(zero, gapv(i) + marge - d2)
C
        d3 = sqrt(p3(i))
        p3(i) = max(zero, gapv(i) + marge - d3)
C
        d4 = sqrt(p4(i))
        p4(i) = max(zero, gapv(i) + marge - d4)
       ENDDO
C
       DO i=1,last
        pene(i) = max(p1(i),p2(i),p3(i),p4(i))
        if(p1(i)==pene(i))then
         n1(i) = nx1(i)
         n2(i) = ny1(i) 
         n3(i) = nz1(i) 
        elseif(p2(i)==pene(i))then
         n1(i) = nx2(i)
         n2(i) = ny2(i) 
         n3(i) = nz2(i) 
        elseif(p3(i)==pene(i))then
         n1(i) = nx3(i)
         n2(i) = ny3(i) 
         n3(i) = nz3(i) 
        elseif(p4(i)==pene(i))then
         n1(i) = nx4(i)
         n2(i) = ny4(i) 
         n3(i) = nz4(i) 
        endif
       ENDDO
       DO i=1,last
         s2 = one/max(em30,sqrt(n1(i)**2 + n2(i)**2 + n3(i)**2))
         n1(i) = n1(i)*s2
         n2(i) = n2(i)*s2
         n3(i) = n3(i)*s2
       ENDDO
C
      RETURN
      END