C DUALIS    SOURCE    CHAT      05/01/12    22:58:42     5004
C   dualise un maillage pour le maillage par polygone
C
      subroutine dualis(fer,fer1,xpro,xproj1)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR)
      SEGMENT XPRO
        REAL*8 XPROJ(3,1)
      ENDSEGMENT
      POINTEUR XPROJ1.XPRO, FER1.FER
      xproj1=xpro
      segini,xpro=xproj1
      segini,fer1=fer
      do 10 it=1,itour
        ideb=mai(it)+1
        ifin=mai(it+1)
        do 20 ip1=ideb,ifin
          ip2=ip1+1
          if (ip2.gt.ifin) ip2=ideb
          xproj(1,nfi(ip1))=(xproj1.XPROJ(1,nfi(ip1))+
     >                       xproj1.XPROJ(1,nfi(ip2)))/2
          xproj(2,nfi(ip1))=(xproj1.XPROJ(2,nfi(ip1))+
     >                       xproj1.XPROJ(2,nfi(ip2)))/2
          xproj(3,nfi(ip1))=(xproj1.XPROJ(3,nfi(ip1))+
     >                       xproj1.XPROJ(3,nfi(ip2)))/2

  20    continue
  10  continue
*
*     Decalage des points duals associes aux sommets
*     interieurs d'un contour concave
*
      do 40 it=1,itour
        ideb=mai(it)+1
        ifin=mai(it+1)
        do 30 ip1=ideb,ifin
          ip2=ip1+1
          if (ip2.gt.ifin) ip2=ideb
          ip3 = ip2 + 1
          if (ip3.gt.ifin) ip3=ideb
*
*         Produit vectoriel des cotes liant un sommet
*
          xvec1 = xproj1.XPROJ(1,nfi(ip2)) - xproj1.XPROJ(1,nfi(ip1))
          yvec1 = xproj1.XPROJ(2,nfi(ip2)) - xproj1.XPROJ(2,nfi(ip1))
          xvec2 = xproj1.XPROJ(1,nfi(ip3)) - xproj1.XPROJ(1,nfi(ip2))
          yvec2 = xproj1.XPROJ(2,nfi(ip3)) - xproj1.XPROJ(2,nfi(ip2))

          prod = xvec1 * yvec2 - xvec2 * yvec1
          IF ( prod .LT. -1.E-10) THEN
*
*           Le sommet est "entrant", decalage des points duals voisins.
*
            xproj(1,nfi(ip1))= xproj(1,nfi(ip1)) + (xvec1 - xvec2)/4
            xproj(2,nfi(ip1))= xproj(2,nfi(ip1)) + (yvec1 - yvec2)/4
            xproj(1,nfi(ip2))= xproj(1,nfi(ip2)) + (xvec1 - xvec2)/4
            xproj(2,nfi(ip2))= xproj(2,nfi(ip2)) + (yvec1 - yvec2)/4

          ENDIF
  30    continue
  40  continue
      end