invoi2.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/.
!||====================================================================
!||    invoi2    ../engine/source/interfaces/inter2d/invoi2.F
!||--- called by ------------------------------------------------------
!||    i9main2   ../engine/source/interfaces/int09/i9main2.F
!||    intvo2    ../engine/source/interfaces/inter2d/intvo2.F
!||====================================================================
      SUBROUTINE invoi2(X,IRECT,LMSR,MSR,NSV,ILOC,IRTL,NSEG,NSN)
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 NSN
      INTEGER IRECT(4,*), LMSR(*), MSR(*), NSV(*), ILOC(*), IRTL(*),
     .   NSEG(*)
C     REAL
      my_real
     .   x(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER II, I, J, K, NUM, NPT, JJ, LL, L, LG, M, MG
C     REAL
      my_real
     .   cms, dms, result, c2, c3, s2, s3, cs, d2, cc
C-----------------------------------------------
      DO 200 ii=1,nsn
      i=nsv(ii)
      j=iloc(ii)
      k=msr(j)
      cms=(x(2,i)-x(2,k))**2+(x(3,i)-x(3,k))**2
      num=nseg(j+1)-nseg(j)
      npt=nseg(j)-1
C---------------------------------------------
C     RECHERCHE DU NOEUD main LE PLUS PROCHE
C---------------------------------------------
      DO 100 jj=1,num
      ll=lmsr(npt+jj)
      l=irect(1,ll)
      IF(l==j)l=irect(2,ll)
      lg=msr(l)
      dms=(x(2,i)-x(2,lg))**2+(x(3,i)-x(3,lg))**2
      IF(dms<cms)THEN
       cms=dms
       j=l
       k=lg
      ENDIF
  100 CONTINUE
C------------------------------------------------
C     RECHERCHE DU SEGMENT main LE PLUS PROCHE
C------------------------------------------------
      iloc(ii)=j
      result=ep30
      num=nseg(j+1)-nseg(j)
      npt=nseg(j)-1
C
      DO 150 jj=1,num
      ll=lmsr(jj+npt)
      m=irect(1,ll)
      IF(m==j)m=irect(2,ll)
      mg=msr(m)
C
      c2=x(2,mg)-x(2,k)
      c3=x(3,mg)-x(3,k)
      s2=x(2,i)-x(2,k)
      s3=x(3,i)-x(3,k)
      cs=c2*s2+c3*s3
      d2=s2*s2+s3*s3
      IF(cs>zero)THEN
       cc=c2*c2+c3*c3
       d2=d2-cs*cs/cc
      ENDIF
      IF(d2>result)GOTO 150
       result=d2
       irtl(ii)=ll
  150 CONTINUE
  200 CONTINUE
      RETURN
      END