invoi2.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	invoi2 (x, irect, lmsr, msr, nsv, iloc, irtl, nseg, nsn)

Function/Subroutine Documentation

invoi2()

subroutine invoi2	(		x,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	lmsr,
		integer, dimension(*)	msr,
		integer, dimension(*)	nsv,
		integer, dimension(*)	iloc,
		integer, dimension(*)	irtl,
		integer, dimension(*)	nseg,
		integer	nsn )

Definition at line 29 of file invoi2.F.

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