Numérotation des lignes :

C DUALIS    SOURCE    CHAT      05/01/12    22:58:42     5004C   dualise un maillage pour le maillage par polygoneC      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

© Cast3M 2003 - Tous droits réservés.
Mentions légales