Esope source files

   1 : C FACTR1    SOURCE    CHAT      05/01/12    23:55:53     5004           
   2 :       SUBROUTINE FACTR1(NDIM,PT1,PT2,PT3,XDEP2,XARI2
   3 :      $     ,XN1,XN2,XN3,XINT,ITEST)
   4 : ************************************************************************
   5 : *** SP 'FACTR1' : A partir d'un plan et d'une droite definies par des 
   6 : *** pts, donne les normales (repere local lie au plan) et le pt
   7 : *** d'intersection droite-plan.
   8 : ***
   9 : *** APPELES 1 = 'PROVEC', 'SCVECT'
  10 : *** APPELES 2 = aucun
  11 : ***
  12 : *** E = 'NDIM' dimension de l'espace
  13 : ***     'PT1', PT2', PT3' pts definissant le plan considere
  14 : ***     'XDEP2', 'XARI2' pts definissant la droite consideree
  15 : ***
  16 : *** S = 'XN1' vecteur unitaire normal au plan
  17 : ***     'XN2' vecteur unitaire normal à droite consideree et à 'XN1'
  18 : ***     'XN3' vecteur unitaire norma à 'XN1' et 'XN2'
  19 : ***     'XINT' coordonnees du pt d'intersection
  20 : ***     'ITEST' vaut 1 si intersection, 0 si parallellisme droite-plan
  21 : ***
  22 : 

Warning:  preg_replace(): Compilation failed: unmatched parentheses at offset 6 in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 158

  23 : ***
  24 : ***      Auteur Cyril Nou
  25 : ************************************************************************
  26 :       IMPLICIT INTEGER(I-N)
  27 :       IMPLICIT REAL*8 (A-H,O-Z)
  28 : -INC CCREEL
  29 :       DIMENSION XDEP2(3),XARI2(3)
  30 :       DIMENSION XINT(3),XN1(3),XN2(3),XN3(3)
  31 :       DIMENSION PT1(3),PT2(3),PT3(3)
  32 :       DIMENSION X1(3),X2(3),X3(3),X4(3)
  33 : ***   construction des vecteurs directeurs droite,plan, etc...
  34 :       DCARAC=0.D0
  35 :       DO 10 I=1,NDIM
  36 :          X1(I)=XARI2(I)-XDEP2(I)
  37 :          X2(I)=XDEP2(I)-PT1(I)
  38 :          X3(I)=PT2(I)-PT1(I)
  39 :          X4(I)=PT3(I)-PT1(I)
  40 : ***      distance caracteristique pour adimensionner
  41 :          DCARAC=DCARAC+X1(I)**2
  42 :  10   CONTINUE
  43 :       DCARAC=SQRT(DCARAC)
  44 : ***   'ITEST'=1 si non parallellisme trajectoire-plan, 0 sinon
  45 :       ITEST=1
  46 : 
  47 : **************
  48 : *** CAS 2D ***
  49 : **************
  50 :       IF (NDIM.EQ.2) THEN
  51 : ***      'XN1' normale au plan
  52 :          IF (ABS(PT1(2)-PT2(2)).GT.(XZPREC*DCARAC)) THEN
  53 :             XN1(1)=1.D0
  54 :             XN1(2)=-(PT2(1)-PT1(1))/(PT2(2)-PT1(2))
  55 :             XNORM=SQRT(XN1(1)**2+XN1(2)**2)
  56 :             XN1(1)=XN1(1)/XNORM
  57 :             XN1(2)=XN1(2)/XNORM
  58 :          ELSE
  59 :             XN1(1)=0.D0
  60 :             XN1(2)=1.D0
  61 :          ENDIF
  62 : ***      'XN2' directeur du plan
  63 :          IF (ABS(PT1(1)-PT2(1)).GT.(XZPREC*DCARAC)) THEN
  64 :             XN2(1)=1.D0
  65 :             XN2(2)=(PT2(2)-PT1(2))/(PT2(1)-PT1(1))
  66 :             XNORM=SQRT(XN2(1)**2+XN2(2)**2)
  67 :             XN2(1)=XN2(1)/XNORM
  68 :             XN2(2)=XN2(2)/XNORM
  69 :          ELSE
  70 :             XN2(1)=0.D0
  71 :             XN2(2)=1.D0
  72 :          ENDIF
  73 : ***      'XINT' intersection trajectoire/plan
  74 :          A=SCVECT(X2,XN2,NDIM)
  75 :          B=SCVECT(X2,XN1,NDIM)
  76 :          C=SCVECT(X1,XN2,NDIM)
  77 :          D=SCVECT(X1,XN1,NDIM)
  78 : ***      verification non parallelisme trajectoire-plan
  79 :          IF (ABS(D).GT.(XZPREC*DCARAC)) THEN
  80 :             COEFF=A-B*C/D
  81 :             XINT(1)=PT1(1)+COEFF*XN2(1)
  82 :             XINT(2)=PT1(2)+COEFF*XN2(2)
  83 :          ELSE 
  84 :             ITEST=0
  85 :          ENDIF
  86 : 
  87 : **************
  88 : *** CAS 3D ***
  89 : **************
  90 :       ELSEIF (NDIM.EQ.3) THEN
  91 : ***      'XN1' normale au plan
  91 :          CALL PROVEC(X3,X4,XN1)
  92 :          XNORM=SQRT(XN1(1)**2+XN1(2)**2+XN1(3)**2)
  93 :          XN1(1)=XN1(1)/XNORM
  94 :          XN1(2)=XN1(2)/XNORM
  95 :          XN1(3)=XN1(3)/XNORM
  96 : ***      'XN2' normale à trajectoire et à 'XN1'
  96 :          CALL PROVEC(XN1,X1,XN2)
  97 :          XNORM=SQRT(XN2(1)**2+XN2(2)**2+XN2(3)**2)
  98 :          IF (ABS(XNORM).GT.(XZPREC*DCARAC)) THEN
  99 :             XN2(1)=XN2(1)/XNORM
 100 :             XN2(2)=XN2(2)/XNORM
 101 :             XN2(3)=XN2(3)/XNORM
 102 :          ELSE
 103 :             XNORM=SQRT(X3(1)**2+X3(2)**2+X3(3)**2)
 104 :             XN2(1)=X3(1)/XNORM
 105 :             XN2(2)=X3(2)/XNORM
 106 :             XN2(3)=X3(3)/XNORM
 107 :          ENDIF
 108 : ***      'XN3' normale restante du repere local 'XN1','XN2',XN3'
 108 :          CALL PROVEC(XN1,XN2,XN3)
 109 : ***      'XINT' intersection trajectoire/plan
 110 :          A=SCVECT(X2,XN2,NDIM)
 111 :          B=SCVECT(X2,XN3,NDIM)
 112 :          C=SCVECT(X2,XN1,NDIM)
 113 :          D=SCVECT(X1,XN3,NDIM)
 114 :          E=SCVECT(X1,XN1,NDIM)
 115 : ***      verification du non parallelisme trajectoire-plan
 116 :          IF (ABS(E).GT.(XZPREC*DCARAC)) THEN
 117 :             COEFF=B-C*D/E
 118 :             XINT(1)=PT1(1)+A*XN2(1)+COEFF*XN3(1)
 119 :             XINT(2)=PT1(2)+A*XN2(2)+COEFF*XN3(2)
 120 :             XINT(3)=PT1(3)+A*XN2(3)+COEFF*XN3(3)
 121 :          ELSE
 122 :             ITEST=0
 123 :          ENDIF
 124 :       ENDIF
 125 :       RETURN
 126 :       END
 127 : 
 128 : 
 129 : 
 130 : 
 131 : 
 132 : 
 133 : 
 134 : 
 135 : 
 136 : 
 137 : 
 138 : 
 139 : 
 140 : 
 141 : 
 142 : 
 143 : 
 144 : 
 145 : 
 146 : 
 147 : 
 148 : 
 149 :  
 150 :