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