Sources Esope | Cast3M

j3dess
C J3DESS    SOURCE    CHAT      05/01/13    00:46:18     5004
      SUBROUTINE J3DESS(XY,XYC,NPTO,TOL,INUM)
C----------------------------------------------------
C     LE POINT XY1 EST IL SUR UN DES SEGMENTS DE XYC1
C
C     ESCLAVE DE J3COTO
C
C     PP 6/97
C     Pierre Pegon/JRC Ispra
C----------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XY(2),XYC(2,NPTO)
      LOGICAL LOK
C
      INUM=0
      TOL2=TOL*TOL
C
      DO 1 IE1=1,NPTO
        I1=IE1
        I2=IE1+1-(IE1/NPTO)*IE1
        D12=(XYC(1,I2)-XYC(1,I1))**2+(XYC(2,I2)-XYC(2,I1))**2
C
        DI1=(XY(1)-XYC(1,I1))**2+(XY(2)-XYC(2,I1))**2
        IF(DI1.GT.D12+TOL2)GOTO 1
C
        DI2=(XY(1)-XYC(1,I2))**2+(XY(2)-XYC(2,I2))**2
        IF(DI2.GT.D12+TOL2)GOTO 1
C
        AAA=((XY(1)-XYC(1,I1))*(XYC(1,I2)-XYC(1,I1))
     >      +(XY(2)-XYC(2,I1))*(XYC(2,I2)-XYC(2,I1)))/D12
        IF(AAA.LT.0.D0.OR.AAA.GT.1.D0)GOTO 1
C
        BBB=((XY(1)-XYC(1,I1))-AAA*(XYC(1,I2)-XYC(1,I1)))**2
     >     +((XY(2)-XYC(2,I1))-AAA*(XYC(2,I2)-XYC(2,I1)))**2
        IF(BBB.LT.TOL2)THEN
          INUM=IE1
          RETURN
        ENDIF
C
 1    CONTINUE
      RETURN
      END