Télécharger disydr.eso

Retour à la liste

Numérotation des lignes :

  1. C DISYDR SOURCE CHAT 05/01/12 22:51:52 5004
  2. SUBROUTINE DISYDR(XE,N, PT1,PT2, XXL2M)
  3. C-----------------------------------------------------------------
  4. C Calcul de la distance minimum d'un ensemble de point
  5. C a un point (DISYPT), une droite (DISYDR) ou un plan (DISYPL)
  6. C de symetrie
  7. C
  8. C Entree XE(3,N) Tableau de point
  9. C
  10. C PT1(3) point (DISYPT), point de la droite (DISYDR)
  11. C normale NORMEE au plan (DISYPL)
  12. C PT2(3) vecteur directeur NORME de la droite (DISYDR)
  13. C D distance a l'origine (DISYPL)
  14. C
  15. C Sortie XXL2M Carre de la distance minimale
  16. C
  17. C Appele par: CONNE1
  18. C
  19. C PP 22/10/92
  20. C PP 11/01/92 il faut bien sortir le carre pour la symetrie P
  21. C-----------------------------------------------------------------
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24. DIMENSION XE(3,N),PT1(3),PT2(3)
  25. C
  26. DO 3 I=1,N
  27. A=0.D0
  28. DO 1 J=1,3
  29. A=A+PT2(J)*(XE(J,I)-PT1(J))
  30. 1 CONTINUE
  31. B=0.D0
  32. DO 2 J=1,3
  33. B=B+(PT1(J)-XE(J,I)+A*PT2(J))**2
  34. 2 CONTINUE
  35. IF(I.EQ.1)THEN
  36. XXL2M=B
  37. ELSE
  38. XXL2M=MIN(XXL2M,B)
  39. ENDIF
  40. 3 CONTINUE
  41. RETURN
  42. C-----------------------------------------------------------------
  43. E N T R Y DISYPT(XE,N, PT1, XXL2M)
  44. C
  45. DO 5 I=1,N
  46. B=0.D0
  47. DO 4 J=1,3
  48. B=B+(XE(J,I)-PT1(J))**2
  49. 4 CONTINUE
  50. IF(I.EQ.1)THEN
  51. XXL2M=B
  52. ELSE
  53. XXL2M=MIN(XXL2M,B)
  54. ENDIF
  55. 5 CONTINUE
  56. RETURN
  57. C-----------------------------------------------------------------
  58. E N T R Y DISYPL(XE,N, PT1,D, XXL2M)
  59. C
  60. DO 7 I=1,N
  61. B=D
  62. DO 6 J=1,3
  63. B=B+XE(J,I)*PT1(J)
  64. 6 CONTINUE
  65. B=B*B
  66. IF(I.EQ.1)THEN
  67. XXL2M=B
  68. ELSE
  69. XXL2M=MIN(XXL2M,B)
  70. ENDIF
  71. 7 CONTINUE
  72. RETURN
  73. C-----------------------------------------------------------------
  74. END
  75.  
  76.  

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