Télécharger la plaquette Cast3M


fr en

Télécharger factr1.eso

Retour à la liste

Numérotation des lignes : 

factr1

  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. *** Rq : 'XZPREC' (-INC CCREEL), erreur precision calcul machine
  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
  92.          CALL PROVEC(X3,X4,XN1)
  93.          XNORM=SQRT(XN1(1)**2+XN1(2)**2+XN1(3)**2)
  94.          XN1(1)=XN1(1)/XNORM
  95.          XN1(2)=XN1(2)/XNORM
  96.          XN1(3)=XN1(3)/XNORM
  97. ***      'XN2' normale à trajectoire et à 'XN1'
  98.          CALL PROVEC(XN1,X1,XN2)
  99.          XNORM=SQRT(XN2(1)**2+XN2(2)**2+XN2(3)**2)
  100.          IF (ABS(XNORM).GT.(XZPREC*DCARAC)) THEN
  101.             XN2(1)=XN2(1)/XNORM
  102.             XN2(2)=XN2(2)/XNORM
  103.             XN2(3)=XN2(3)/XNORM
  104.          ELSE
  105.             XNORM=SQRT(X3(1)**2+X3(2)**2+X3(3)**2)
  106.             XN2(1)=X3(1)/XNORM
  107.             XN2(2)=X3(2)/XNORM
  108.             XN2(3)=X3(3)/XNORM
  109.          ENDIF
  110. ***      'XN3' normale restante du repere local 'XN1','XN2',XN3'
  111.          CALL PROVEC(XN1,XN2,XN3)
  112. ***      'XINT' intersection trajectoire/plan
  113.          A=SCVECT(X2,XN2,NDIM)
  114.          B=SCVECT(X2,XN3,NDIM)
  115.          C=SCVECT(X2,XN1,NDIM)
  116.          D=SCVECT(X1,XN3,NDIM)
  117.          E=SCVECT(X1,XN1,NDIM)
  118. ***      verification du non parallelisme trajectoire-plan
  119.          IF (ABS(E).GT.(XZPREC*DCARAC)) THEN
  120.             COEFF=B-C*D/E
  121.             XINT(1)=PT1(1)+A*XN2(1)+COEFF*XN3(1)
  122.             XINT(2)=PT1(2)+A*XN2(2)+COEFF*XN3(2)
  123.             XINT(3)=PT1(3)+A*XN2(3)+COEFF*XN3(3)
  124.          ELSE
  125.             ITEST=0
  126.          ENDIF
  127.       ENDIF
  128.       RETURN
  129.       END
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  

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