Esope source files

   1 : C J3DESS    SOURCE    CHAT      05/01/13    00:46:18     5004           
   2 :       SUBROUTINE J3DESS(XY,XYC,NPTO,TOL,INUM)
   3 : C----------------------------------------------------
   4 : C     LE POINT XY1 EST IL SUR UN DES SEGMENTS DE XYC1
   5 : C
   6 : C     ESCLAVE DE J3COTO
   7 : C
   8 : C     PP 6/97
   9 : C     Pierre Pegon/JRC Ispra
  10 : C----------------------------------------------------
  11 : C
  12 :       IMPLICIT INTEGER(I-N)
  13 :       IMPLICIT REAL*8(A-H,O-Z)
  14 :       DIMENSION XY(2),XYC(2,NPTO)
  15 :       LOGICAL LOK
  16 : C
  17 :       INUM=0
  18 :       TOL2=TOL*TOL
  19 : C
  20 :       DO 1 IE1=1,NPTO
  21 :         I1=IE1
  22 :         I2=IE1+1-(IE1/NPTO)*IE1
  23 :         D12=(XYC(1,I2)-XYC(1,I1))**2+(XYC(2,I2)-XYC(2,I1))**2
  24 : C
  25 :         DI1=(XY(1)-XYC(1,I1))**2+(XY(2)-XYC(2,I1))**2
  26 :         IF(DI1.GT.D12+TOL2)GOTO 1
  27 : C
  28 :         DI2=(XY(1)-XYC(1,I2))**2+(XY(2)-XYC(2,I2))**2
  29 :         IF(DI2.GT.D12+TOL2)GOTO 1
  30 : C
  31 :         AAA=((XY(1)-XYC(1,I1))*(XYC(1,I2)-XYC(1,I1))
  32 :      >      +(XY(2)-XYC(2,I1))*(XYC(2,I2)-XYC(2,I1)))/D12
  33 :         IF(AAA.LT.0.D0.OR.AAA.GT.1.D0)GOTO 1
  34 : C
  35 :         BBB=((XY(1)-XYC(1,I1))-AAA*(XYC(1,I2)-XYC(1,I1)))**2
  36 :      >     +((XY(2)-XYC(2,I1))-AAA*(XYC(2,I2)-XYC(2,I1)))**2
  37 :         IF(BBB.LT.TOL2)THEN
  38 :           INUM=IE1
  39 :           RETURN
  40 :         ENDIF
  41 : C
  42 :  1    CONTINUE
  43 :       RETURN
  44 :       END
  45 :  
  46 :