Download splipl.eso

Back to the list

   1 : C SPLIPL    SOURCE    CHAT      06/03/29    21:34:46     5360           
   2 :       SUBROUTINE SPLIPL(IPOLY,NBPP,NN,IPOLY1,NBPP1,IPOLY2,NBPP2,iarr)
   3 : C     *****************************************************************
   4 : C     OBJET : DECOUPE (SPLIT) UN POLYGONE PAR UNE ARETE 
   5 : C
   6 : C     EN ENTREE:
   7 : C      IPOLY,NBPP: POLYGONE A DECOUPER
   8 : C      NN : NOEUDS DE L'ARETE DE COUPE (NN(1),NN(2))
   9 : C
  10 : C     EN SORTIE:
  11 : C       IPOLY1 : CONTIENT L'ARETE NN(1) VERS NN(2) 
  12 : C               EN IPOLY1(NBPP1)IPOLY(1)
  13 : C       IPOLY2 : CONTIENT L'ARETE NN(2) VERS NN(1)
  14 : C               EN IPOLY2(NBPP2)IPOLY(1)
  15 : C       iarr  : 0 SI OK, -1 SI NN(1) OU NN(2) NE SONT PAS CORRECTS
  16 : C               C.A.D. SI NN(1) = NN(2) OU SI NN(1) OU NN(2) 
  17 : C               NE SONT PAS DANS IPOLY
  18 : C
  19 : C     *****************************************************************
  20 :       IMPLICIT INTEGER(I-N)
  21 :       INTEGER IPOLY(*),NBPP,NN(*),IPOLY1(*),NBPP1,IPOLY2(*),NBPP2,iarr
  22 : C      
  23 :       INTEGER INM1,INM2,I,I1,I2
  24 : C
  25 :       iarr = -1
  26 :       IF(NN(1).EQ.NN(2))THEN
  26 :         CALL DSERRE(1,iarr,'SPLIPL',' ARETE: ORIGINE=EXTREMITE')       
  27 :         GO TO 999
  28 :       ENDIF
  29 : C     --- RECHERCHE NN(2) ---
  30 :       INM1 = 0
  31 :       INM2 = 0
  32 :       DO 10 I=1,NBPP
  33 :         IF( IPOLY(I).EQ. NN(1) )INM1 = I
  34 :         IF( IPOLY(I).EQ. NN(2) )INM2 = I
  35 :    10 CONTINUE  
  36 :       IF(INM1.EQ.0)THEN
  36 :         CALL DSERRE(1,iarr,'SPLIPL',' ORIGINE HORS POLYGONE')       
  37 :         GO TO 999
  38 :       ENDIF
  39 :       IF(INM2.EQ.0)THEN
  39 :         CALL DSERRE(1,iarr,'SPLIPL',' EXTREMITE HORS POLYGONE')       
  40 :         GO TO 999
  41 :       ENDIF
  42 : C     --- POLY1 DE : INM2 -> INM1 ---
  43 :       IF( INM1.LT.INM2 )THEN
  44 :         NBPP2 = INM2 - INM1 + 1
  45 :         NBPP1 = NBPP - NBPP2 + 2
  46 :       ELSE
  47 :         NBPP1 = INM1 - INM2 + 1
  48 :         NBPP2 = NBPP - NBPP1 + 2
  49 :       ENDIF
  50 :       I1 = INM2
  51 :       DO 20 I=1,NBPP1 
  52 :         IPOLY1(I) = IPOLY(I1)
  53 :         I1 = MOD(I1,NBPP)+1
  54 :    20 CONTINUE
  55 :       I2 = INM1
  56 :       DO 30 I=1,NBPP2 
  57 :         IPOLY2(I) = IPOLY(I2)
  58 :         I2 = MOD(I2,NBPP)+1
  59 :    30 CONTINUE
  60 :       iarr = 0      
  61 :   999 END
  62 :  
  63 :  
  64 :  

© Cast3M 2003 - All rights reserved.
Disclaimer