C DBBLX     SOURCE    CHAT      09/10/09    21:16:55     6519           
*  dedouble les multiplicateurs de Lagrange
*
      subroutine dbblx(mrigid,lagdua)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC CCOPTIO
-INC SMCOORD
-INC SMRIGID
-INC SMELEME
      segact mrigid*mod
      segact mcoord*mod
      nbsous=0
      nbref=0
      nbelem=0
      nbnn=2
      segini ipt8
      lagdua=ipt8
      ipt8.itypel=2
      do 10 ir=1,irigel(/2)
       meleme=irigel(1,ir)
       segact meleme
       if (itypel.ne.22)  goto 10
       nbsous=0
       nbref=0
       nbelem=num(/2)
       nbnn=num(/1)+1
       segini,ipt1=meleme
       segadj ipt1
       segdes meleme
       meleme=ipt1
       irigel(1,ir)=meleme
       do 100 j=1,nbelem
       do 120 i=nbnn,3,-1
        num(i,j)=num(i-1,j)
 120   continue
       nbpts=xcoor(/1)/(idim+1)+1
       segadj mcoord
       num(2,j)=nbpts
       ip=num(1,j)
       xcoor((nbpts-1)*(idim+1)+1)=xcoor((ip-1)*(idim+1)+1)
       xcoor((nbpts-1)*(idim+1)+2)=xcoor((ip-1)*(idim+1)+2)
       xcoor((nbpts-1)*(idim+1)+3)=xcoor((ip-1)*(idim+1)+3)
       if (idim.eq.3)
     >  xcoor((nbpts-1)*(idim+1)+4)=xcoor((ip-1)*(idim+1)+4)
 100   continue
**  on garde la liste des noeuds rajoutés
       nbnn=2
       nbsup=nbelem
       nbelem=ipt8.num(/2)+nbsup
       segadj ipt8
       do 130 j=1,nbsup
        ipt8.num(1,nbelem-nbsup+j)=num(1,j)
        ipt8.num(2,nbelem-nbsup+j)=num(2,j)
 130   continue
       descr=irigel(3,ir)
       segini,des1=descr
       segdes descr
       descr=des1
       irigel(3,ir)=descr
       nligrp=lisinc(/2)+1
       nligrd=lisdua(/2)+1
       segadj descr
       do 200 i=nligrp,3,-1
        lisinc(i)=lisinc(i-1)
        noelep(i)=noelep(i-1)+1
 200   continue
       lisinc(2)='LX'
       noelep(2)=2
       do 210 i=nligrd,3,-1
        lisdua(i)=lisdua(i-1)
        noeled(i)=noeled(i-1)+1
 210   continue
       lisdua(2)='FLX'
       noeled(2)=2
       segdes descr,meleme
       xmatri=irigel(4,ir)
       segini,xmatr1=xmatri
       segdes xmatri
       xmatri=xmatr1
           nelrig=re(/3)
           segadj xmatri
       irigel(4,ir)=xmatri
       do 300 im=1,nelrig
*        xmatri=imattt(im)
*        segini,xmatr1=xmatri
*        segadj xmatr1
*        segdes xmatri
*        xmatri=xmatr1
*        imattt(im)=xmatri
        do 310 i=nligrp,1,-1
        do 310 j=nligrd,2,-1
         re(i,j,im)=re(i,j-1,im)
 310    continue
        do 320 j=nligrd,1,-1
        do 320 i=nligrp,2,-1
         re(i,j,im)=re(i-1,j,im)
 320    continue
        re(1,1,im)=-1.D0
        re(1,2,im)= 1.D0
        re(2,1,im)= 1.D0
        re(2,2,im)=-1.D0
*        segdes xmatri
 300    continue
        segdes xmatri
  10   continue
       segdes mrigid
       if (ipt8.num(/2).eq.0) then
         segsup ipt8
         lagdua=0
       endif
       return
       end