1 : C TRANSA SOURCE PV 07/10/05 21:16:55 5890 2 : C SOUS PROGRAMME DE VERIFICATION QU'UN SEGMENT (LL1 LL2) NE COUPE 3 : C PAS UN SEGMENT DU CONTOUR 4 : C 5 : SUBROUTINE TRANSA(NFI,MAI,ITOUR,X,XMOY,IRECL,LL1,LL2,LL3,LL4) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : DIMENSION NFI(1),MAI(1),X(3,1) 9 : IRECL=0 10 : XCC=XMOY*XMOY*1D-5 11 : DO 1101 ILT=1,ITOUR 12 : ILD=MAI(ILT-1+1)+1 13 : ILF=MAI(ILT+1) 14 : LL4=NFI(ILF) 15 : X41=X(1,LL1)-X(1,LL4) 16 : Y41=X(2,LL1)-X(2,LL4) 17 : X42=X(1,LL2)-X(1,LL4) 18 : Y42=X(2,LL2)-X(2,LL4) 19 : DO 1102 II3=ILD,ILF 20 : LL3=NFI(II3) 21 : X31=X(1,LL1)-X(1,LL3) 22 : Y31=X(2,LL1)-X(2,LL3) 23 : X32=X(1,LL2)-X(1,LL3) 24 : Y32=X(2,LL2)-X(2,LL3) 25 : IF (LL4.EQ.LL1) GOTO 1104 26 : IF (LL4.EQ.LL2) GOTO 1104 27 : IF (LL3.EQ.LL1) GOTO 1104 28 : IF (LL3.EQ.LL2) GOTO 1104 29 : VL3=X31*Y32-Y31*X32 30 : VL4=X41*Y42-Y41*X42 31 : IF (ABS(VL3).LE.XCC) VL3=0.D0 32 : IF (ABS(VL4).LE.XCC) VL4=0.D0 33 : IF (VL3*VL4.GT.0.D0) GOTO 1104 34 : VL1=X31*Y41-Y31*X41 35 : VL2=X32*Y42-Y32*X42 36 : IF (ABS(VL1).LE.XCC) VL1=0.D0 37 : IF (ABS(VL2).LE.XCC) VL2=0.D0 38 : IF (VL1*VL2.LE.0.D0) GOTO 1105 39 : 1104 X41=X31 40 : Y41=Y31 41 : X42=X32 42 : Y42=Y32 43 : LL4=LL3 44 : GOTO 1102 45 : 1105 CONTINUE 46 : IF ((VL1.NE.0.D0.AND.VL2.NE.0.D0).OR. 47 : > (VL3.NE.0.D0.AND.VL4.NE.0.D0)) GOTO 1107 48 : C LES 4 PTS SONT ALIGNES .EST CE QUE LES SEGMENTS SE RECOUVRENT? 49 : SC4=X41*X42+Y41*Y42 50 : IF (SC4.LT.0.D0) GOTO 1107 51 : SC3=X31*X32+Y31*Y32 52 : IF (SC3.LT.0.D0) GOTO 1107 53 : SC2=X32*X42+Y32*Y42 54 : IF (SC2.LT.0.D0) GOTO 1107 55 : SC1=X31*X41+Y31*Y41 56 : IF (SC1.GE.0.D0) GOTO 1104 57 : 1107 IRECL=1 58 : GOTO 1106 59 : 1102 CONTINUE 60 : 1101 CONTINUE 61 : 1106 RETURN 62 : END 63 : 64 : 65 :
© Cast3M 2003 - All rights reserved.
Disclaimer