Sources Esope | Cast3M

splipl
C SPLIPL    SOURCE    CHAT      06/03/29    21:34:46     5360
      SUBROUTINE SPLIPL(IPOLY,NBPP,NN,IPOLY1,NBPP1,IPOLY2,NBPP2,iarr)
C     *****************************************************************
C     OBJET : DECOUPE (SPLIT) UN POLYGONE PAR UNE ARETE
C
C     EN ENTREE:
C      IPOLY,NBPP: POLYGONE A DECOUPER
C      NN : NOEUDS DE L'ARETE DE COUPE (NN(1),NN(2))
C
C     EN SORTIE:
C       IPOLY1 : CONTIENT L'ARETE NN(1) VERS NN(2)
C               EN IPOLY1(NBPP1)IPOLY(1)
C       IPOLY2 : CONTIENT L'ARETE NN(2) VERS NN(1)
C               EN IPOLY2(NBPP2)IPOLY(1)
C       iarr  : 0 SI OK, -1 SI NN(1) OU NN(2) NE SONT PAS CORRECTS
C               C.A.D. SI NN(1) = NN(2) OU SI NN(1) OU NN(2)
C               NE SONT PAS DANS IPOLY
C
C     *****************************************************************
      IMPLICIT INTEGER(I-N)
      INTEGER IPOLY(*),NBPP,NN(*),IPOLY1(*),NBPP1,IPOLY2(*),NBPP2,iarr
C
      INTEGER INM1,INM2,I,I1,I2
C
      iarr = -1
      IF(NN(1).EQ.NN(2))THEN
        CALL DSERRE(1,iarr,'SPLIPL',' ARETE: ORIGINE=EXTREMITE')
        GO TO 999
      ENDIF
C     --- RECHERCHE NN(2) ---
      INM1 = 0
      INM2 = 0
      DO 10 I=1,NBPP
        IF( IPOLY(I).EQ. NN(1) )INM1 = I
        IF( IPOLY(I).EQ. NN(2) )INM2 = I
   10 CONTINUE
      IF(INM1.EQ.0)THEN
        CALL DSERRE(1,iarr,'SPLIPL',' ORIGINE HORS POLYGONE')
        GO TO 999
      ENDIF
      IF(INM2.EQ.0)THEN
        CALL DSERRE(1,iarr,'SPLIPL',' EXTREMITE HORS POLYGONE')
        GO TO 999
      ENDIF
C     --- POLY1 DE : INM2 -> INM1 ---
      IF( INM1.LT.INM2 )THEN
        NBPP2 = INM2 - INM1 + 1
        NBPP1 = NBPP - NBPP2 + 2
      ELSE
        NBPP1 = INM1 - INM2 + 1
        NBPP2 = NBPP - NBPP1 + 2
      ENDIF
      I1 = INM2
      DO 20 I=1,NBPP1
        IPOLY1(I) = IPOLY(I1)
        I1 = MOD(I1,NBPP)+1
   20 CONTINUE
      I2 = INM1
      DO 30 I=1,NBPP2
        IPOLY2(I) = IPOLY(I2)
        I2 = MOD(I2,NBPP)+1
   30 CONTINUE
      iarr = 0
  999 END