1 : C MREM1 SOURCE CHAT 09/10/09 21:21:13 6519 2 : SUBROUTINE MREM1(mchpoi,ri1,ri2,ri3,ri4,ichp6,mchpo1,iret) 3 : * remontee des LX sur les points supports des multiplicateurs 4 : * dans le cas des resolution avexc matrices de dependances 5 : * ri2 rigidite complete avant condensation 6 : * ri1 rigidite de dependance brute 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : -INC SMRIGID 10 : -INC CCOPTIO 11 : -INC SMCHPOI 12 : -INC SMCOORD 13 : -INC SMELEME 14 : segment LXOK(XCOOR(/1)/(idim+1)) 15 : * fabrication du bon ri2 : ri2 + les conditions de ri4 dont les LX 16 : * sont dans ri3 17 : segini lxok 18 : mrigid=ri3 19 : segact mrigid 20 : do 10 irig=1,irigel(/2) 21 : meleme=irigel(1,irig) 22 : segact meleme 22 : if (itypel.ne.22) call erreur(5) 23 : do 20 j=1,num(/2) 24 : lxok(num(1,j))=1 25 : lxok(num(2,j))=1 26 : 20 continue 27 : segdes meleme 28 : 10 continue 29 : segini,ri5=ri4 30 : mrigid=ri5 31 : do 100 irig=1,irigel(/2) 32 : ipt1=irigel(1,irig) 33 : xmatr1=irigel(4,irig) 34 : segini,meleme=ipt1 35 : segini,xmatri=xmatr1 35 : if (itypel.ne.22) call erreur(5) 36 : jj=0 37 : do 110 j=1,num(/2) 38 : if (lxok(num(1,j)).eq.0) num(1,j)=0 39 : if (lxok(num(2,j)).eq.0) num(1,j)=0 40 : if (num(1,j).ne.0) then 41 : jj=jj+1 42 : do 120 in=1,num(/1) 43 : num(in,jj)=num(in,j) 44 : 120 continue 45 : do io=1,re(/2) 46 : do iu=1,re(/1) 47 : re(iu,io,jj)=re(iu,io,j) 48 : enddo 49 : enddo 50 : * imattt(jj)=imattt(j) 51 : endif 52 : 110 continue 53 : nbnn=num(/1) 54 : nbelem=jj 55 : nbsous=0 56 : nbref=0 57 : segadj meleme 58 : irigel(1,irig)=meleme 59 : nelrig=jj 60 : nligrp=re(/2) 61 : nligrd=re(/1) 62 : segadj xmatri 63 : irigel(4,irig)=xmatri 64 : 100 continue 65 : segsup lxok 65 : call fusrig(ri2,mrigid,iret) 66 : ri2=iret 67 : C remontee sur les ddl condenses 67 : call depen3(ri1,ri6) 67 : call mucpri(mchpoi,ri6,ichp3) 68 : * write (6,*) 'mchpoi dans mrem1 ' 68 : * call ecchpo(mchpoi) 69 : * 70 : * on peut tuer ri6 71 : * 72 : segact ri6 73 : do 55 i=1,ri6.irigel(/2) 74 : ipt4=ri6.irigel(1,i) 75 : segsup ipt4 76 : des1=ri6.irigel(3,i) 77 : segsup des1 78 : xmatr6=ri6.irigel(4,i) 79 : * segact imatr6 80 : * do 56 j=1,imatr6.imattt(/1) 81 : * xmatr6=imatr6.imattt(j) 82 : * segsup xmatr6 83 : * 56 continue 84 : segsup xmatr6 85 : 55 continue 85 : call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0) 85 : call adchpo(ichp2,mchpo1,iret,1.D0,1D0) 86 : mchpo1=iret 86 : call mucpri(mchpo1,ri2 ,ichp5) 86 : call adchpo(ichp5,ichp6,IRET,1D0,-1D0) 86 : call remplx(ri1,iret,ichp7) 87 : mchpoi=mchpo1 88 : * les champs de points qui sortent sont de nature diffuse 89 : SEGACT MCHPOI 90 : NAT = MAX(1,JATTRI(/1)) 91 : NSOUPO=IPCHP(/1) 92 : SEGADJ MCHPOI 93 : JATTRI(1)=1 94 : SEGDES MCHPOI 95 : * write (6,*) 'mchpo1 dans mrem1 ' 95 : * call ecchpo(mchpo1) 96 : * write (6,*) 'ichp7 dans mrem1 ' 96 : * call ecchpo(ichp7) 96 : call fuchpo(mchpo1,ichp7,iret) 97 : mchpoi=iret 98 : * les champs de points qui sortent sont de nature diffuse 99 : SEGACT MCHPOI 100 : NAT = MAX(1,JATTRI(/1)) 101 : NSOUPO=IPCHP(/1) 102 : SEGADJ MCHPOI 103 : JATTRI(1)=1 104 : SEGDES MCHPOI 105 : return 106 : end 107 : 108 : 109 :
© Cast3M 2003 - All rights reserved.
Disclaimer