Télécharger la plaquette Cast3M


fr en

Télécharger int2d.eso

Retour à la liste

Numérotation des lignes : 

int2d

  1. C INT2D     SOURCE    GOUNAND   24/10/09    21:15:05     12031          
  2.       SUBROUTINE INT2D (IP1,IP2,IP3,IP4,INTERS,RESULT)
  3. ************************************************************************
  4. *
  5. *                              I N T 2 D
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *     INTERSECTION DE 2 DROITES DEFINIES CHACUNES PAR DEUX POINTS
  11. *     .
  12. *
  13. * MODULES UTILISES:
  14. * -----------------
  15. *
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8 (A-H,O-Z)
  18. *
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC CCREEL
  22. *
  23. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  24. * -----------
  25. *
  26. *     IP1...  (E)  POINT 1 DE LA DROITE 1
  27. *     IP2...  (E)  POINT 2 DE LA DROITE 1
  28. *     IP3...  (E)  POINT 1 DE LA DROITE 2
  29. *     IP4...  (E)  POINT 2 DE LA DROITE 2
  30. *     INTERS  (S)  POINT D'INTERSECTION DES DEUX DROITES
  31. *     RESULT  (S)  = 'OK' SI LA RESOLUTION A PU SE FAIRE
  32. *                  = 'PARALLELE' SI LA RESOLUTION N'A PAS PU SE FAIRE
  33. *                  = 'NON COPLANAIRE'
  34. *
  35.       CHARACTER*(*) RESULT
  36. *
  37. * VARIABLES:
  38. * ----------
  39. *
  40. *     X.,Y.,Z. = COORDONNEES DES POINTS DES DROITES
  41. *     D.       = DENSITES DES POINTS
  42. *     PVEC     = PRODUIT VECTORIEL P1P2.P3P4
  43. *
  44. *     AA      ( )  MATRICE 3X2 DU SYSTEME
  45. *     B       ( )  SECOND MEMBRE DU SYSTEME
  46. *     T       ( )  MATRICE RESULTAT
  47. *
  48.       REAL*8 AA(3,2),B(3),T(2),
  49.      &       X1,X2,X3,X4,Y1,Y2,Y3,Y4,Z1,Z2,Z3,Z4,
  50.      &       XI,YI,ZI,D1,D2,D3,D4,T1,T2,
  51.      &       PV1,PV2,PV3,PVEC
  52.       LOGICAL RESOLU
  53. *
  54. * REMARQUES:
  55. * ----------
  56. *      LES POINTS DONNEES SONT SUPPOSES NON CONFONDUS
  57. *
  58. * AUTEUR, DATE DE CREATION:
  59. * -------------------------
  60. *
  61. *     LIONEL VIVAN       19 NOVEMBRE 1987
  62. *
  63. * LANGAGE:
  64. * --------
  65. *
  66. *     FORTRAN77
  67. *
  68. ************************************************************************
  69. *
  70.       XTPARA=SQRT(XZPREC)*100.D0
  71.  
  72. *
  73. *    CALCUL DES COORDONNEES DES POINTS
  74. *
  75.       CALL EXCOO1(IP1,X1,Y1,Z1,D1)
  76.       CALL EXCOO1(IP2,X2,Y2,Z2,D2)
  77.       CALL EXCOO1(IP3,X3,Y3,Z3,D3)
  78.       CALL EXCOO1(IP4,X4,Y4,Z4,D4)
  79. *
  80.       AA(1,1)=X2-X1
  81.       AA(1,2)=X3-X4
  82.       AA(2,1)=Y2-Y1
  83.       AA(2,2)=Y3-Y4
  84.       AA(3,1)=Z2-Z1
  85.       AA(3,2)=Z3-Z4
  86. *
  87.       B(1)=X3-X1
  88.       B(2)=Y3-Y1
  89.       B(3)=Z3-Z1
  90. *
  91.       XNAAB=0.D0
  92.       DO J=1,2
  93.          DO I=1,3
  94.             XNAAB=MAX(XNAAB,ABS(AA(I,J)))
  95.          ENDDO
  96.       ENDDO
  97.       DO I=1,3
  98.          XNAAB=MAX(XNAAB,ABS(B(I)))
  99.       ENDDO
  100. *
  101. *   TEST : DROITES PARALLELES ?
  102. *
  103.       PV1=((Y2-Y1)*(Z4-Z3))-((Z2-Z1)*(Y4-Y3))
  104.       PV2=((Z2-Z1)*(X4-X3))-((X2-X1)*(Z4-Z3))
  105.       PV3=((X2-X1)*(Y4-Y3))-((Y2-Y1)*(X4-X3))
  106.       PVEC=SQRT(PV1**2+PV2**2+PV3**2)
  107.       IF (PVEC.LT.(XNAAB*XTPARA)) THEN
  108.          RESULT='PARALLELE'
  109.          RETURN
  110.       END IF
  111. *
  112. *   CALCUL DU POINT D'INTERSECTION
  113. *
  114.       CALL EQUA32(AA,B,T,RESOLU)
  115.       IF (IERR.NE.0) RETURN
  116.       IF (.NOT.RESOLU) THEN
  117.          RESULT='NON COPLANAIRE'
  118.          RETURN
  119.       END IF
  120.       T1=T(1)
  121.       T2=T(2)
  122.       XI=X1+T1*(X2-X1)
  123.       YI=Y1+T1*(Y2-Y1)
  124.       ZI=Z1+T1*(Z2-Z1)
  125.       CALL CREPO1(XI,YI,ZI,INTERS)
  126.       RESULT='OK'
  127. *
  128.       END
  129.  
  130.  

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