Télécharger indrpo.eso

Retour à la liste

Numérotation des lignes :

  1. C INDRPO SOURCE CHAT 05/01/13 00:36:02 5004
  2. SUBROUTINE INDRPO(X,Y,NBN,DROITE,PZERO,NBA,IARET,NBS,SOM)
  3. C *****************************************************************
  4. C OBJET : INTERSECTION D'UN POLYGONE SIMPLE AVEC UNE DROITE
  5. C EN ENTREE :
  6. C X,Y : TABLEAU DES COORDONNEES DES POINTS DU POLYGONE
  7. C NBN : NOMBRE DE POINT DU POLYGONE
  8. C DROITE: EQUATION DE LA DROITE
  9. C PZERO : PRECISION DU CALCUL
  10. C EN SORTIE:
  11. C IARET : INDICES DES ARETES DU POLY QU'INTERSECTE DROITE
  12. C NBA : NOMBRE " " " " "
  13. C SOM : INDICES DES SOMMETS DU POLY QU'INTERSECTE DROITE
  14. C NBS : NOMBRE " " " " "
  15. C *****************************************************************
  16. IMPLICIT INTEGER(I-N)
  17. INTEGER NBN,NBA,NBS,IARET(*),SOM(*)
  18. REAL*8 X(*),Y(*),PZERO
  19. REAL*8 DROITE(3)
  20. C
  21. REAL*8 S
  22. INTEGER K,K2,ISD
  23. C
  24. NBS = 0
  25. NBA = 0
  26. S = DROITE(1)*X(1)+DROITE(2)*Y(1)+DROITE(3)
  27. C --- TEST DU PREMIER SOMMET ---
  28. IF((S.LT.PZERO).AND.(S.GT.-PZERO))THEN
  29. NBS = NBS + 1
  30. SOM(NBS) = 1
  31. ISD = 0
  32. ELSE
  33. IF( S.GT.PZERO )THEN
  34. ISD = 1
  35. ELSE
  36. ISD = -1
  37. ENDIF
  38. ENDIF
  39. C --- TEST DES ARETES ---
  40. DO 20 K=1,NBN
  41. K2 = MOD(K,NBN)+1
  42. S = DROITE(1)*X(K2)+DROITE(2)*Y(K2)+DROITE(3)
  43. C --- LE SOMMET K+1 EST SUR LA DROITE ---
  44. IF((S.LT.PZERO).AND.(S.GT.-PZERO))THEN
  45. NBS = NBS + 1
  46. SOM(NBS) = K2
  47. ISD = 0
  48. ELSE
  49. C --- ON ETAIT SUR LA DROITE ---
  50. IF( ISD.EQ.0 )THEN
  51. IF( S.GT.PZERO )THEN
  52. ISD = 1
  53. ELSE
  54. ISD = -1
  55. ENDIF
  56. ELSE
  57. C ---- ON ETAIT PAS SUR LA DROITE
  58. C ---- ET ON CHANGE DE COTE ---
  59. IF((S*ISD).LT.-PZERO)THEN
  60. ISD = -ISD
  61. NBA=NBA+1
  62. IARET(NBA)=K
  63. ENDIF
  64. ENDIF
  65. ENDIF
  66. IF(K.NE.0)S=DROITE(1)*X(K)+DROITE(2)*Y(K)+DROITE(3)
  67. 20 CONTINUE
  68. 999 END
  69.  
  70.  
  71.  

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