Numérotation des lignes :

C DBBLX     SOURCE    CB215821  19/08/20    21:16:33     10287          *  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       idimp1 = idim + 1       segact mcoord*mod      nbpts = xcoor(/1) / idimp1      nbini = nbpts       nbsous = 0      nbref  = 0      nbnn   = 2      nbelem = 0      segini,ipt8      ipt8.itypel = 2      nbele8 = nbelem       segact mrigid*mod      nrigel = irigel(/2) C     Boucle d'activation et AJUSTEMENT MCOORD en 1 coup      do 9 ir = 1, nrigel        ipt1 = irigel(1,ir)        segact ipt1        i_z = ipt1.itypel        if (i_z .ne. 22) goto 9        nbpts  = nbpts + ipt1.num(/2) 9    continue      segadj,mcoord       nbpts=nbini      do 10 ir = 1, nrigel        ipt1 = irigel(1,ir)        segact ipt1        i_z = ipt1.itypel        if (i_z .ne. 22) goto 10        segini,meleme=ipt1        nbsous = 0        nbref  = 0        nbnn   = meleme.num(/1)+1        nbelem = meleme.num(/2)        segadj meleme        nbsup  = nbelem         nbpts0 = nbpts        nbpts  = nbpts0 + nbsup         do 100 j = 1, nbsup          do 120 i = nbnn,3,-1            meleme.num(i,j) = meleme.num(i-1,j) 120      continue          meleme.num(2,j) = nbpts0 + j          ip2 = (meleme.num(2,j)-1) * idimp1          ip1 = (meleme.num(1,j)-1) * idimp1          do k = 1, idimp1            xcoor(ip2+k) = xcoor(ip1+k)          enddo 100    continue        irigel(1,ir) = meleme**  on garde la liste des noeuds rajoutés*        nbsous = 0*        nbref  = 0        nbnn   = 2        nbelem = nbele8 + nbsup        segadj ipt8        do 130 j = 1, nbsup          j8 = nbele8 + j          ipt8.num(1,j8) = meleme.num(1,j)          ipt8.num(2,j8) = meleme.num(2,j) 130    continue        nbele8 = nbelem*        des1 = irigel(3,ir)        segini,descr=des1        segdes,des1        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        irigel(3,ir) = descr         xmatr1 = irigel(4,ir)        segini,xmatri=xmatr1        segdes,xmatr1        nelrig = re(/3)        segadj,xmatri        do 300 im = 1, nelrig          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,1,im)          re(1,2,im) = +1.D0          re(2,1,im) = +1.D0          re(2,2,im) = re(1,1,im) 300    continue        segdes,xmatri        irigel(4,ir) = xmatri   10  continue*      segdes mrigid*      if (nbele8.eq.0) then        segsup,ipt8        ipt8 = 0      endif       lagdua = ipt8       end

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