Télécharger la plaquette Cast3M


fr en

Télécharger disydr.eso

Retour à la liste

Numérotation des lignes : 

disydr

  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