Télécharger distan.eso

Retour à la liste

Numérotation des lignes :

  1. C DISTAN SOURCE CHAT 05/01/12 22:51:23 5004
  2. SUBROUTINE DISTAN(XP,XA,XB,YP,YA,YB,ZP,ZA,ZB,D,MARQ)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C
  7. C
  8.  
  9. C
  10. C
  11. MARQ=1
  12. c write(6,*)xa,ya,za
  13. IF (XA.NE.XB) THEN
  14. XM=((XB-XA)**2*XP+(YB-YA)*(XB-XA)*YP-(ZB-ZA)*(XB*ZA-XA*ZB)+(ZB-Z
  15. $A)*(XB-XA)*ZP-(YB-YA)*(YA*XB-YB*XA))/((XB-XA)**2+(YB-YA)**2+(ZB-Z
  16. $A)**2)
  17.  
  18. YM=((YB-YA)/(XB-XA))*XM+((YA*XB-YB*XA)/(XB-XA))
  19. ZM=((ZB-ZA)/(XB-XA))*XM+((ZA*XB-ZB*XA)/(XB-XA))
  20. ELSE
  21. IF (ZA.NE.ZB) THEN
  22. XM=XA
  23. ZM=((YB-YA)*YP+(ZB-ZA)*ZP-YA*ZB+YB*ZA)/((ZB-ZA)+((YB-YA)
  24. $**2)/(ZB-ZA)+(YA*ZB-YB*ZA)*(YB-YA)/(ZB-ZA))
  25. YM=(YB-YA)/(ZB-ZA)*ZM+(YA*ZB-YB*ZA)/(ZB-ZA)
  26. ELSE
  27. IF (YA.NE.YB) THEN
  28. XM=XA
  29. ZM=ZA
  30. YM=YP
  31. ELSE
  32. CALL ERREUR(945)
  33. END IF
  34. END IF
  35. END IF
  36.  
  37. D=((XP-XM)**2+(YP-YM)**2+(ZP-ZM)**2)**0.5
  38.  
  39. c XMI=MIN(XA,XB)
  40. c XMA=MAX(XA,XB)
  41. c YMI=MIN(YA,YB)
  42. c YMA=MAX(YA,YB)
  43. c ZMI=MIN(ZA,ZB)
  44. c ZMA=MAX(ZA,ZB)
  45. c IF (XM.GE.XMI.AND.XM.LE.XMA) THEN
  46. c IF (YM.GE.YMI.AND.YM.LE.YMA) THEN
  47. c IF (ZM.GE.ZMI.AND.ZM.LE.ZMA) THEN
  48. c MARQ=0
  49. c ENDIF
  50. c ENDIF
  51. c ENDIF
  52.  
  53. c si AM.BM négatif M est dans le segment
  54. XYM=(XM-XA)*(XM-XB)+(YM-YA)*(YM-YB)+(ZM-ZA)*(ZM-ZB)
  55. IF (XYM.LE.0) THEN
  56. MARQ=0
  57. ENDIF
  58. c if (marq.eq.0) then
  59. c write(6,*)xm,ym,zm
  60. c write(6,*)'marq',marq,'dist',d
  61. c end if
  62.  
  63. RETURN
  64. END
  65.  
  66.  
  67.  
  68.  

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