Download disydr.eso

Back to the list

   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 :  

© Cast3M 2003 - All rights reserved.
Disclaimer