C DBBCH     SOURCE    PV        13/04/12    21:15:25     7756           
*  dualise les valeurs d'un champ en fonction d'un meleme de dedoublement de noeuds
*
      subroutine dbbch(mchpoi,ipt8)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC CCOPTIO
-INC SMELEME
-INC SMCHPOI
-INC SMCOORD
      segment trav
      integer lag1(xcoor(/1)/(idim+1))
      integer lag2(xcoor(/1)/(idim+1))
      endsegment
*  ne fonctionne que pour des LX, on suppose qu'il n'y a qu'une include
*  par noeud dédoublé
*  on verifie que le noeud dedouble n'est pas deja dans le champ
      if (ipt8.eq.0) return
      segini trav
      segact mchpoi,ipt8
*     call ecchpo(mchpoi,0)
*     call ecmail(ipt8,0)
      segact mchpoi,ipt8
      do 300 i=1,ipt8.num(/2)
      lag1(ipt8.num(1,i))=ipt8.num(2,i)
 300  continue
      do 310 isoupo=1,ipchp(/1)
      msoupo=ipchp(isoupo)
       segact msoupo
       if (nocomp(/2).ne.1) goto 310
       if (nocomp(1).ne.'FLX') goto 310
       meleme=igeoc
       segact meleme
       do 311 i=1,num(/2)
        lag2(num(1,i))=i
 311   continue
 310  continue
      do 10 isoupo=1,ipchp(/1)
       msoupo=ipchp(isoupo)
       segact msoupo*mod
       if (nocomp(/2).ne.1) goto 10
       if (nocomp(1).ne.'FLX') goto 10
       meleme=igeoc
       mpoval=ipoval
       segact meleme,mpoval*mod
       nbnn=num(/1)
       nbelem=num(/2)
       nbele=nbelem
       nbsous=0
       nbref=0
       segini,ipt1=meleme
       segdes meleme
       meleme=ipt1
       igeoc=meleme
       do 100 j=1,nbele
       if (lag1(num(1,j)).eq.0) goto 110
*      write (6,*) ' num lag1 lag2 ',num(1,j),lag1(num(1,j)),
*    > lag2(lag1(num(1,j)))
       if (lag2(lag1(num(1,j))).ne.0) then
*       write (6,*) ' vpocha ',vpocha(j,1),
*    >        vpocha(lag2(lag1(num(1,j))),1)
        interr(1)=lag1(num(1,j))
        interr(2)=lag2(lag1(num(1,j)))
        call erreur(1001)
        goto 110
        endif
        nbelem=nbelem+1
        segadj meleme
        num(1,nbelem)=lag1(num(1,j))
        n=nbelem
        nc=1
        segadj mpoval
        vpocha(nbelem,1)=vpocha(j,1)
*     write (6,*) ' noeu ',num(1,j),' valeur ',vpocha(j,1),num(1,nbelem)
        goto 100
 110   continue
 100   continue
  10   continue 
       segsup trav
       return
       end