Télécharger la plaquette Cast3M


fr en

Télécharger intpseg2.eso

Retour à la liste

Numérotation des lignes : 

intpseg2

  1. C INTPSEG2  SOURCE    SH236661  13/11/25    21:15:08     7869
  2. C
  3.       SUBROUTINE INTPSEG2(NRA,NRB,NRC,X1,Y1,X2,Y2,
  4.      &                    IINT,XI1,YI1,XI2,YI2)
  5. C----------------------------------------------------------------------C
  6. C         Determination de l'intersection entre un segment et          C
  7. C  un demi plan definit par une droite et un point dans le demi plan   C
  8. C                                                                      C
  9. C     NRA, NRB = entiers, numeros des noeuds de la droite (AB)         C
  10. C     NRC = entier, numero du noeud dans le demi plan                  C
  11. C     X1,Y1                                                            C
  12. C     X2,Y2 = coordonnees des points P1 et P2 du segment [P1,P2]       C
  13. C                l'ordre P1,P2 est important (voir ci dessous)         C
  14. C                                                                      C
  15. C     IINT     = indicateur sur l'intersection :                       C
  16. C                - IINT = 0 P1P2 est hors du demi plan                 C
  17. C                         --> les coordonnees de I1 et I2 sont nulles  C
  18. C                - IINT = 1 P1P2 intersecte le demi plan               C
  19. C                         --> I1 et I2 sont les points d'intersection  C
  20. C     XI1,YI1                                                          C
  21. C     XI2,YI2 = coordonnees des points du segment d'intersection       C
  22. C               oriente comme le segment [P1,P2]                       C
  23. C----------------------------------------------------------------------C
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC SMCOORD
  30.       PARAMETER (ZERO=1D-14)
  31. C
  32.       SEGACT,MCOORD
  33.       IDIMP1=IDIM+1
  34. C     Extraction des coordonnees des points A, B
  35.       XA=XCOOR((NRA-1)*IDIMP1+1)
  36.       YA=XCOOR((NRA-1)*IDIMP1+2)
  37.       XB=XCOOR((NRB-1)*IDIMP1+1)
  38.       YB=XCOOR((NRB-1)*IDIMP1+2)
  39. C     Vecteur normal a la droite AB
  40.       XN=(YB-YA)
  41.       YN=(XA-XB)
  42. C     Signe du produit scalaire n.AC
  43.       XC=XCOOR((NRC-1)*IDIMP1+1)
  44.       YC=XCOOR((NRC-1)*IDIMP1+2)
  45.       PSC=(XN*(XC-XA))+(YN*(YC-YA))
  46.       IF (ABS(PSC).LT.ZERO) THEN
  47. C        Demi plan mal definit
  48.          CALL ERREUR(363)
  49.       ENDIF
  50.       SIGC=SIGN(1D0,PSC)
  51. C     Signe du produit scalaire n.AP1
  52.       PS1=(XN*(X1-XA))+(YN*(Y1-YA))
  53.       SIG1=SIGN(1D0,PS1)
  54.       IF (ABS(PS1).LT.ZERO) SIG1=SIGC
  55. C     Signe du produit scalaire n.AP2
  56.       PS2=(XN*(X2-XA))+(YN*(Y2-YA))
  57.       SIG2=SIGN(1D0,PS2)
  58.       IF (ABS(PS2).LT.ZERO) SIG2=SIGC
  59. C     Il y a 4 cas possibles
  60.       IINT=0
  61.       XI1=0D0
  62.       YI1=0D0
  63.       XI2=0D0
  64.       YI2=0D0
  65. C     1) [P1,P2] est hors du demi plan
  66.       IF ((SIG1.NE.SIGC).AND.(SIG2.NE.SIGC)) THEN
  67.          GOTO 999
  68.       ENDIF
  69. C     2) P1 est dans le demi plan et P2 dehors
  70.       IF ((SIG1.EQ.SIGC).AND.(SIG2.NE.SIGC)) THEN
  71.          IINT=1
  72.          XI1=X1
  73.          YI1=Y1
  74.          GOTO 100
  75.       ENDIF
  76. C     3) P2 est dans le demi plan et P1 dehors
  77.       IF ((SIG1.NE.SIGC).AND.(SIG2.EQ.SIGC)) THEN
  78.          IINT=2
  79.          XI2=X2
  80.          YI2=Y2
  81.          GOTO 100
  82.       ENDIF
  83. C     4) [P1,P2] est entierment dans le demi plan
  84.       IF ((SIG1.EQ.SIGC).AND.(SIG2.EQ.SIGC)) THEN
  85.          IINT=1
  86.          XI1=X1
  87.          YI1=Y1
  88.          XI2=X2
  89.          YI2=Y2
  90.          GOTO 999
  91.       ENDIF
  92. C
  93. 100   CONTINUE
  94. C     Calcul de l'intersection du segment (P1,P2) avec la droite (AB)
  95.       DET=((X1-X2)*(YB-YA))-((Y1-Y2)*(XB-XA))
  96. C     Si DET>0, il y a intersection entre les droites (AB) et (CD)
  97.       IF (ABS(DET).GT.ZERO) THEN
  98. C        Coordonnees barycentriques du point d'intersection
  99.          ZETA=(((XB-X2)*(YB-YA))-((YB-Y2)*(XB-XA)))/DET
  100. C        Coordonnees du point d'intersection
  101.          XI=(ZETA*X1)+((1.-ZETA)*X2)
  102.          YI=(ZETA*Y1)+((1.-ZETA)*Y2)
  103.       ELSE
  104. C        Si le determinant est negatif, il n'y a pas d'intersection
  105. C        ==> erreur
  106.          IINT=0
  107.          XI1=0D0
  108.          YI1=0D0
  109.          XI2=0D0
  110.          YI2=0D0
  111.          GOTO 999
  112.       ENDIF
  113. C     Ce point correspond a I1 ou I2 selon la valeur de IINT
  114.       IF (IINT.EQ.1) THEN
  115.          XI2=XI
  116.          YI2=YI
  117.       ELSEIF (IINT.EQ.2) THEN
  118.          IINT=1
  119.          XI1=XI
  120.          YI1=YI
  121.       ENDIF
  122. C     Fin du programme
  123. 999   RETURN
  124.       END
  125.  
  126.  
  127.  

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