C SEGLIN    SOURCE    CHAT      05/01/13    03:13:13     5004           
      subroutine seglin(p1,p2,x1,x2,dx,ide)
C=============================================================
C                                                            
C    INTERSECTION D UN SEGMENT S1 S2 AVEC UN segment  P1 P2
C                    =
C     P1,P2   2 points  POINTS DANS UN PLAN                   
C     X1,X2   2 points  DANS LE MEME PLAN  
C                                                             
C     OUTPUT:                                                 
C       dx: POINT D'INTERSECTION  
C      ide =-2  pas de solution  (supports // ) 
C      IDE =-1  intersection support x1x2 en dehors du segment  P1 P2
C      ide = 0  intersection support x1x2  dans le segment   p1 p2 
C      IDE = 1  les segments se coupent   
C                                                            
C     G. L. JIANG  / MODIFIE BAZE                             
C                                                             
C=============================================================
      
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      dimension xtrav(2)
      dimension p1(*),p2(*),x1(*),x2(*),dx(*)
C      segment itrav
C      REAL*8 xtrav(2),xpen(2)
C      endsegment       
      DATA EPSI/0.0001/
C
C      segini itrav
      ide= 10
       a11 = x2(2)-x1(2)
       a12 = x1(1)-x2(1)
       a21 = p2(2)-p1(2)
       a22 = p1(1)-p2(1)
       b1 = x1(1)*a11+x1(2)*a12
       b2 = p1(1)*a21+p1(2)*a22       
       det = a11*a22-a21*a12
C================       
       IF(ABS(DET).LT.EPSI) THEN
C        les segments ont ils le meme support
         ps1=0.D0        
        do i=1,2
        xtrav(i) = (x1(i)+x2(i))/2.D0
        ps1 = ps1 + (x2(i)-x1(i))*(p2(i)-p1(i)) 
        enddo 
        xpen=  (x1(2)-x2(2))*(p2(1)-p1(1))  +
     &         (x2(1)-x1(1))*(p2(2)-p1(2))  
        
C------------   
          if ( xpen.lt.epsi)   then
C              il sont sur le meme support                
C   on met  p1p2 dans le sens x1x2  si besoin 
          if(ps1.lt.0.D0) then
          do i=1,2
          xtrav(i) = p2(i)
          p2(i) = p1(i)
          p1(i) = xtrav(i)
          enddo 
          endif
C                          
        ps1= 0.D0 
        ps2= 0.D0
        ps3= 0.D0
        do  i=1,2
        ps1 = ps1 + (x1(i)-p1(i))*(x1(i)-p2(i))
        ps2 = ps2 + (x2(i)-p1(i))*(x2(i)-p2(i)) 
        ps3 = ps3 + (p1(i)-x1(i))*(p1(i)-x2(i))   
        enddo
C                       
        if(ps1.lt.0.D0.and.ps2.lt.0.D0)  then 
C   x1 et x2  entre p1 et p2 
        ide= 1
        do i=1,2
        dx(i)=x2(i)
        enddo
        goto 200
        endif 
C        
        if(ps1.gt.0.D0.and.ps2.gt.0.D0) then
C   p1 et p2  entre x1 et x2 
        ide=0
        if(ps3.gt.0.D0) goto 200
        ide=1
        do i=1,2
        dx(i)=p1(i)
        enddo
        goto 200
        endif
C                                       
        if(ps1.gt.0.D0.and.ps2.lt.0.D0) then 
C   x2 entre p1 et p2   
        do i=1,2
        dx(i)=p1(i)
        enddo
        ide=1
        goto 200        
        endif
C       
        if(ps1.lt.0.D0.and.ps2.gt.0.D0) then 
C   x1 entre p1 et p2   
        do i=1,2
        dx(i)=p2(i)
        enddo
        ide=1
        goto 200        
        endif           
C               
        if(ps2.gt.0.D0) then
C   x2 entre p1 et p2 
        do i=1,2
        dx(i)=p1(i)
        ide=1
        enddo
        goto 200
        endif
C       
        
C               
          else
C--------           
          ide=-2
          endif
C---------                 
       ELSE
C================ les supports se croisent         
         dx(1)=(b1*a22-b2*a12)/det
         dx(2)=-(b1*a21-b2*a11)/det 
         ps=0.D0
         ps2=0.D0
         do 168 i=1,2
         ps = ps + (x1(i)-dx(i))*(x2(i)-dx(i))
         ps2=ps2 + (p1(i)-dx(i))*(p2(i)-dx(i))              
168      continue 
 
        
       if (ps2.le.epsi) then 
C   intersection du support  x1x2   entre p1 et p2           
          if (ps.lt.0.D0.or.abs(ps).lt.0.1D-3) then 
                ide = 1
          else
                ide = 0
          endif         
       else
C intersection des supports en dehors de p1p2           
                ide=-1
       endif
      ENDIF 
200    CONTINUE              
C================    
C       write(6,1000)  ide, (dx(il),il=1,2)
1000   format (I4,2E12.5)        
       return
       end