Sources Esope | Cast3M

transa
C TRANSA    SOURCE    PV        21/07/27    21:15:01     11080          
C   SOUS PROGRAMME DE VERIFICATION QU'UN SEGMENT (LL1 LL2) NE COUPE
C   PAS UN SEGMENT DU CONTOUR
C
      SUBROUTINE TRANSA(NFI,MAI,ITOUR,X,XMOY,IRECL,LL1,LL2,LL3,LL4,xcmp)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION NFI(*),MAI(*),X(3,*)
      IRECL=0
      XCC=XMOY*XMOY*1D-5
      DO 1101 ILT=1,ITOUR
      ILD=MAI(ILT-1+1)+1
      ILF=MAI(ILT+1)
      LL4=NFI(ILF)
      X41=X(1,LL1)-X(1,LL4)
      Y41=X(2,LL1)-X(2,LL4)
      X42=X(1,LL2)-X(1,LL4)
      Y42=X(2,LL2)-X(2,LL4)
      DO 1102 II3=ILD,ILF
      LL3=NFI(II3)
      X31=X(1,LL1)-X(1,LL3)
      Y31=X(2,LL1)-X(2,LL3)
      X32=X(1,LL2)-X(1,LL3)
      Y32=X(2,LL2)-X(2,LL3)
      IF (LL4.EQ.LL1) GOTO 1104
      IF (LL4.EQ.LL2) GOTO 1104
      IF (LL3.EQ.LL1) GOTO 1104
      IF (LL3.EQ.LL2) GOTO 1104
      VL3=X31*Y32-Y31*X32
      VL4=X41*Y42-Y41*X42
      IF (ABS(VL3).LE.XCC) VL3=0.D0
      IF (ABS(VL4).LE.XCC) VL4=0.D0
      IF (VL3*VL4.GT.0.D0) GOTO 1104
      VL1=X31*Y41-Y31*X41
      VL2=X32*Y42-Y32*X42
      IF (ABS(VL1).LE.XCC) VL1=0.D0
      IF (ABS(VL2).LE.XCC) VL2=0.D0
      IF (VL1*VL2.LE.0.D0) GOTO 1105
 1104 X41=X31
      Y41=Y31
      X42=X32
      Y42=Y32
      LL4=LL3
      GOTO 1102
 1105 CONTINUE
      IF ((VL1.NE.0.D0.AND.VL2.NE.0.D0).OR.
     >    (VL3.NE.0.D0.AND.VL4.NE.0.D0)) GOTO 1107
C   LES 4 PTS SONT ALIGNES .EST CE QUE LES SEGMENTS SE RECOUVRENT?
      SC4=X41*X42+Y41*Y42
      IF (SC4.LT.0.D0) GOTO 1107
      SC3=X31*X32+Y31*Y32
      IF (SC3.LT.0.D0) GOTO 1107
      SC2=X32*X42+Y32*Y42
      IF (SC2.LT.0.D0) GOTO 1107
      SC1=X31*X41+Y31*Y41
      IF (SC1.GE.0.D0) GOTO 1104
 1107 IRECL=1
      GOTO 1106
 1102 CONTINUE
 1101 CONTINUE
 1106 RETURN
      END