C RFCO SOURCE PV090527 23/06/16 21:15:02 11677 subroutine rfco implicit real*8(a-h,o-z) implicit integer (i-n) * * calcul des raideurs et des jeux dans le cas de modeles de contact * avec ou sans frottements * le chpoint existe en cas de contacts ( pas pour les frocable) * en sortie : une raideur et un chpoint et une deuxieme raideur. * La premiere raideur est celle des contacts, n'existe pas pour frocable * la deuxieme raisdeur existe si lconv est vrai et si contact frottant( * frocable ou coulomb) * si donne d'un chamelem en entree, en sortie le modele et le chamelem reduit sur les contacts retenus * -INC PPARAM -INC CCOPTIO -INC SMMODEL pointeur mmode3.mmodel,imode3.imodel -INC SMRIGID -INC SMCHPOI -INC SMELEME -INC SMCOORD logical lconv call lirobj ('MMODEL ',mmodel,1,iretou) call actobj ('MMODEL ',mmodel,1) if(ierr.ne.0) return call lirlog(lconv,1,iretou) mchelx=0 call lirobj('MCHAML ', mchelx,0,ircha1) * write(6,*) 'rfco mchel1 ',mchel1 if(ircha1.eq.1) call actobj('MCHAML ', mchelx,1) if(ierr.ne.0) return segact mcoord mrigid=0 mforc=0 irigi2=0 irrr=0 ifff=0 irff=0 nsous= kmodel(/1) do isous=1,nsous imodel=kmodel(isous) ** write(6,*) ' boucfle sur modele isous ', isous,imamod * pour l'instant * imate=1 unilateral; imate=2 maintenu; inatu=0 pas de frottement * inatu=1 coulomb; inatu=2 frocable ( voir nomate) if( imatee.eq.0) then * cas de maintenu avec ou sans coulomb pas encore traité elseif(imatee.eq.1) then * cas de contact unilateral if(inatuu.eq.2) then if( lconv) then *cas de frocable * pour les cables la notion maintenu n'existe pas ifff=0 irff=1 * Petit modele unitaire local (a detruire en fin de traitement) n1=1 segini,mmode2 * Option accro 'GLISS' igliss=1 ** write(6,*) ' ivamod ',ivamod(/1) if(ivamod(/1).ne.3) call erreur(5) ri2 = 0 meleme=ivamod(2) ipt1= ivamod(1) * call ecmail( meleme,1) * call ecmail ( ipt1,1) nfor=0 nobmod=1 mn3=0 nmat=0 segini mmode3 segini imode2 imode2.imamod=imamod imode2.ivamod(1)=mmode3 imode2.tymode(1)='MMODEL' mmode2.kmodel(1)=imode2 segini imode3 imode3.imamod=ipt1 mmode3.kmodel(1)=imode3 call ecrree(1.d-3) call ecrobj('MAILLAGE',meleme) call ecrobj('MMODEL ',mmode2) call accro(igliss) if (ierr.ne.0) goto 9000 call lirobj('RIGIDITE',ri2,1,iretou) if (ierr.ne.0) goto 9000 segsup mmode2 if( irigi2.eq.0) then irigi2=ri2 else call fusrig(irigi2,ri2,Inoup) irigi2= inoup endif iraidx=irigi2 * dessous fin du cas frocable endif else * cas du frottement de coulomb ou de pas de frottement * on commence par le contact unilateral ipoin1=imamod call ecrobj('MAILLAGE',ipoin1) ipt6=0 ** if (inatuu.eq.1) then ipt6 = ivamod(1) ipt8 = ivamod(2) itcont = ivamod(3) segact ipt6*mod ** endif call ecrent(mchelx) call ecrent(isous) ** write(6,*) ' avant impo32 ipt6 ipt8 itcont inatuu', ** > ipt6,ipt8,itcont,inatuu if(idim.eq.3) call impo32(ipt6,ipt8,itcont) if(idim.eq.2) then if (ifomod .ne. -1 .and. ifomod .ne. 0) then call erreur(710) return endif ** write(6,*) ' appel impos2 ' call impos2(ipt6,ipt8,itcont) endif call lirobj('RIGIDITE',ri2,1,iretou) call lirobj('CHPOINT ',mchpo2,1,iretou) call actobj('RIGIDITE',ri2,1) call actobj('CHPOINT ',mchpo2,1) irrr=1 ifff=1 if( mrigid.eq.0) then mrigid=ri2 else call fusrig ( ri2 , mrigid, inoup) mrigid=inoup endif iraidx=mrigid if( mforc.eq.0) then mforc=mchpo2 else call adchpo(mchpo2,mforc,iret,1.d0,1.D0) mforc=iret endif *** if( lconv) then if( .true.) then * on fait aussi le frottement si on avait convergé. if( inatuu.eq.1 ) then if(mchpo2.eq.0) then call erreur (19) return endif ri1=0 call lirobj('MCHAML', mchel1,0,ircha1) if (ircha1 .EQ. 1) call actobj('MCHAML', mchel1,1) meleme = imamod if (idim .eq. 3) then call frig3C(meleme,ri2,mchpo2, ri1) else call frig2C(meleme,ri2,mchpo2, ri1) * write(6,*) ' sortie de frig2c ri2 ' * call prrigi ( ri2,1) * write(6,*) ' sortie de frig2c ri1' * call prrigi( ri1,1) * write(6,*) ' fin ecrituere apres frig2c' endif * write(*,*) 'avant' * call ecchpo(mchpo2,0) ** WRITE(*,*) 'imamod' ,imamod call ftaill(meleme,mchpo2) ** write(*,*) 'apres' ** call ecchpo(mchpo2,0) if (ierr.ne.0 .or. ri2.eq.0) goto 9000 if(irigi2.eq.0) then irigi2=ri1 else call fusrig(irigi2,ri1,inoup) irigi2=inoup endif endif endif endif endif enddo ** write(6,*) 'mrigid en 183',mrigid * * on reordonne mrigid pour mettre en premier toutes * les relations unilatérales ( frocables peut en sortir des pas unil) * * la premiere raideur ne contient que des relations unilaterales pour * l'instant * la deuxieme continet aussi les relations normales d'encasdtrement des * cables glissants iraid1=mrigid mrigid=irigi2 if( mrigid.ne.0) then segini,ri1=mrigid ide=0 segact mrigid ifi=irigel(/2)+1 do i=1,irigel(/2) if( irigel(6,i). eq .0) then ifi=ifi-1 ipla=ifi else ide=ide+1 ipla=ide endif do ib=1,irigel(/1) ri1.irigel(ib,ipla)=irigel(ib,i) enddo ri1.coerig(ipla)= coerig(i) enddo segdes ri1 **** segsup mrigid mrigid=ri1 * une seule raideur en sortie if (ri1.eq.0.or.iraid1.eq.0) then mrigid = ri1+iraid1 else call fusrig(ri1,iraid1,mrigid) endif ** write(6,*) 'ri1 iraid1 mrigid en 217',ri1,iraid1,mrigid else mrigid = iraid1 endif * if(mrigid.eq.0) then call ecrent ( mrigid) else call actobj('RIGIDITE',mrigid,0) call ecrobj('RIGIDITE',mrigid) endif if( mforc.eq.0) then call ecrent (mforc) else ** call ecchpo(mforc,1) call actobj('CHPOINT', mforc,1) call ecrobj('CHPOINT', mforc) ** write(6,*) ' mforc en sortie de rfco ',mforc endif * write(6,*) 'rfco mchelx ',mchelx return 9000 continue call erreur (19) end