Télécharger j3dess.eso

Retour à la liste

Numérotation des lignes :

j3dess
  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.  
  47.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales