Esope source files

   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 :