Télécharger la plaquette Cast3M


fr en

Télécharger indrpo.eso

Retour à la liste

Numérotation des lignes : 

indrpo

  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