1 : C DBBLX SOURCE CHAT 09/10/09 21:16:55 6519 2 : * dedouble les multiplicateurs de Lagrange 3 : * 4 : subroutine dbblx(mrigid,lagdua) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : -INC CCOPTIO 8 : -INC SMCOORD 9 : -INC SMRIGID 10 : -INC SMELEME 11 : segact mrigid*mod 12 : segact mcoord*mod 13 : nbsous=0 14 : nbref=0 15 : nbelem=0 16 : nbnn=2 17 : segini ipt8 18 : lagdua=ipt8 19 : ipt8.itypel=2 20 : do 10 ir=1,irigel(/2) 21 : meleme=irigel(1,ir) 22 : segact meleme 23 : if (itypel.ne.22) goto 10 24 : nbsous=0 25 : nbref=0 26 : nbelem=num(/2) 27 : nbnn=num(/1)+1 28 : segini,ipt1=meleme 29 : segadj ipt1 30 : segdes meleme 31 : meleme=ipt1 32 : irigel(1,ir)=meleme 33 : do 100 j=1,nbelem 34 : do 120 i=nbnn,3,-1 35 : num(i,j)=num(i-1,j) 36 : 120 continue 37 : nbpts=xcoor(/1)/(idim+1)+1 38 : segadj mcoord 39 : num(2,j)=nbpts 40 : ip=num(1,j) 41 : xcoor((nbpts-1)*(idim+1)+1)=xcoor((ip-1)*(idim+1)+1) 42 : xcoor((nbpts-1)*(idim+1)+2)=xcoor((ip-1)*(idim+1)+2) 43 : xcoor((nbpts-1)*(idim+1)+3)=xcoor((ip-1)*(idim+1)+3) 44 : if (idim.eq.3) 45 : > xcoor((nbpts-1)*(idim+1)+4)=xcoor((ip-1)*(idim+1)+4) 46 : 100 continue 47 : ** on garde la liste des noeuds rajoutés 48 : nbnn=2 49 : nbsup=nbelem 50 : nbelem=ipt8.num(/2)+nbsup 51 : segadj ipt8 52 : do 130 j=1,nbsup 53 : ipt8.num(1,nbelem-nbsup+j)=num(1,j) 54 : ipt8.num(2,nbelem-nbsup+j)=num(2,j) 55 : 130 continue 56 : descr=irigel(3,ir) 57 : segini,des1=descr 58 : segdes descr 59 : descr=des1 60 : irigel(3,ir)=descr 61 : nligrp=lisinc(/2)+1 62 : nligrd=lisdua(/2)+1 63 : segadj descr 64 : do 200 i=nligrp,3,-1 65 : lisinc(i)=lisinc(i-1) 66 : noelep(i)=noelep(i-1)+1 67 : 200 continue 68 : lisinc(2)='LX' 69 : noelep(2)=2 70 : do 210 i=nligrd,3,-1 71 : lisdua(i)=lisdua(i-1) 72 : noeled(i)=noeled(i-1)+1 73 : 210 continue 74 : lisdua(2)='FLX' 75 : noeled(2)=2 76 : segdes descr,meleme 77 : xmatri=irigel(4,ir) 78 : segini,xmatr1=xmatri 79 : segdes xmatri 80 : xmatri=xmatr1 81 : nelrig=re(/3) 82 : segadj xmatri 83 : irigel(4,ir)=xmatri 84 : do 300 im=1,nelrig 85 : * xmatri=imattt(im) 86 : * segini,xmatr1=xmatri 87 : * segadj xmatr1 88 : * segdes xmatri 89 : * xmatri=xmatr1 90 : * imattt(im)=xmatri 91 : do 310 i=nligrp,1,-1 92 : do 310 j=nligrd,2,-1 93 : re(i,j,im)=re(i,j-1,im) 94 : 310 continue 95 : do 320 j=nligrd,1,-1 96 : do 320 i=nligrp,2,-1 97 : re(i,j,im)=re(i-1,j,im) 98 : 320 continue 99 : re(1,1,im)=-1.D0 100 : re(1,2,im)= 1.D0 101 : re(2,1,im)= 1.D0 102 : re(2,2,im)=-1.D0 103 : * segdes xmatri 104 : 300 continue 105 : segdes xmatri 106 : 10 continue 107 : segdes mrigid 108 : if (ipt8.num(/2).eq.0) then 109 : segsup ipt8 110 : lagdua=0 111 : endif 112 : return 113 : end 114 : 115 : 116 : 117 : 118 :
© Cast3M 2003 - All rights reserved.
Disclaimer