1 : C RFCO SOURCE CHAT 12/01/17 21:15:56 7248 2 : subroutine rfco 3 : implicit real*8(a-h,o-z) 4 : implicit integer (i-n) 5 : * 6 : * calcul des raideurs et des jeux dans le cas de modeles de contact 7 : * avec ou sans frottements 8 : * le chpoint existe en cas de contacts ( pas pour les frocable) 9 : * en sortie : une raideur et un chpoint et une deuxieme raideur. 10 : * La premiere raideur est celle des contacts, n'existe pas pour frocable 11 : * la deuxieme raisdeur existe si lconv est vrai et si contact frottant( 12 : * frocable ou coulomb) 13 : * 14 : -INC CCOPTIO 15 : -INC SMMODEL 16 : pointeur mmode3.mmodel,imode3.imodel 17 : -INC SMRIGID 18 : -INC SMCHPOI 19 : logical lconv 19 : call lirobj ('MMODEL',mmodel,1,iretou) 20 : if(ierr.ne.0) return 20 : call lirlog(lconv,1,iretou) 20 : * call lirobj('CHPOINT', mchip1,0,irchp1) 21 : if(ierr.ne.0) return 22 : mrigid=0 23 : mforc=0 24 : irigi2=0 25 : irrr=0 26 : ifff=0 27 : irff=0 28 : segact mmodel 29 : nsous= kmodel(/1) 30 : do isous=1,nsous 31 : imodel=kmodel(isous) 32 : segact imodel 33 : * write(6,*) ' boucfle sur modele isous ', isous,imamod 34 : * pour l'instant 35 : * imate=1 unilateral; imate=2 maintenu; inatu=0 pas de frottement 36 : * inatu=1 coulomb; inatu=2 frocable ( voir nomate) 37 : if( imatee.eq.0) then 38 : * cas de maintenu avec ou sans coulomb pas encore traité 39 : elseif(imatee.eq.1) then 40 : * cas de contact unilateral 41 : if(inatuu.eq.2) then 42 : if( lconv) then 43 : *cas de frocable 44 : * pour les cables la notion maintenu n'existe pas ifff=0 45 : irff=1 46 : * Petit modele unitaire local (a detruire en fin de traitement) 47 : n1=1 48 : segini,mmode2 49 : * Option accro 'GLISS' 50 : igliss=1 51 : segact imodel 51 : if(ivamod(/1).ne.2) call erreur(5) 52 : ri2 = 0 53 : meleme=ivamod(2) 54 : ipt1= ivamod(1) 54 : * call ecmail( meleme,1) 54 : * call ecmail ( ipt1,1) 55 : nfor=0 56 : nobmod=1 57 : mn3=0 58 : nmat=0 59 : segini mmode3 60 : segini imode2 61 : imode2.imamod=imamod 62 : imode2.ivamod(1)=mmode3 63 : imode2.tymode(1)='MMODEL' 64 : segdes imode2 65 : mmode2.kmodel(1)=imode2 66 : segini imode3 67 : imode3.imamod=ipt1 68 : mmode3.kmodel(1)=imode3 69 : segdes mmode3 70 : segdes imodel 70 : call ecrree(1.e-3) 70 : call ecrobj('MAILLAGE',meleme) 70 : call ecrobj('MMODEL ',mmode2) 70 : call accro(igliss) 71 : if (ierr.ne.0) goto 9000 71 : call lirobj('RIGIDITE',ri2,1,iretou) 72 : if (ierr.ne.0) goto 9000 73 : segsup mmode2 74 : if( irigi2.eq.0) then 75 : irigi2=ri2 76 : else 76 : call fusrig(irigi2,ri2,Inoup) 77 : irigi2= inoup 78 : endif 79 : * dessous fin du cas frocable 80 : endif 81 : else 82 : * cas du frottement de coulomb ou de pas de frottement 83 : * on commence par le contact unilateral 83 : call ecrobj('MAILLAGE',imamod) 83 : if(idim.eq.3) call impo32 84 : if(idim.eq.2) then 85 : if (ifomod .ne. -1 .and. ifomod .ne. 0) then 85 : call erreur(710) 86 : return 87 : endif 87 : call impos2 88 : endif 88 : call lirobj('RIGIDITE',ri2,1,iretou) 88 : call lirobj('CHPOINT',mchpo2,1,iretou) 89 : irrr=1 90 : ifff=1 91 : if( mrigid.eq.0) then 92 : mrigid=ri2 93 : else 93 : call fusrig ( ri2 , mrigid, inoup) 94 : mrigid=inoup 95 : endif 96 : if( mforc.eq.0) then 97 : mforc=mchpo2 98 : else 98 : call adchpo(mchpo2,mforc,iret,1.d0,1.D0) 99 : mforc=iret 100 : endif 101 : if( lconv) then 102 : * on fait aussi le frottement si on avait convergé. 103 : if( inatuu.eq.1 ) then 104 : meleme=ivamod(1) 105 : if(mchpo2.eq.0) then 105 : call erreur (19) 106 : return 107 : endif 108 : ri1=0 109 : if (idim .eq. 3) then 109 : call frig3C(meleme,ri2,mchpo2, ri1) 110 : else 110 : call frig2C(meleme,ri2,mchpo2, ri1) 111 : * write(6,*) ' sortie de frig2c ri2 ' 111 : * call prrigi ( ri2,1) 112 : * write(6,*) ' sortie de frig2c ri1' 112 : * call prrigi( ri1,1) 113 : * write(6,*) ' fin ecrituere apres frig2c' 114 : endif 115 : if (ierr.ne.0 .or. ri2.eq.0) goto 9000 116 : if(irigi2.eq.0) then 117 : irigi2=ri1 118 : else 118 : call fusrig(irigi2,ri1,inoup) 119 : irigi2=inoup 120 : endif 121 : endif 122 : endif 123 : endif 124 : endif 125 : segdes imodel 126 : enddo 127 : segdes mmodel 128 : * 129 : * on reordonne mrigid pour mettre en premier toutes 130 : * les relations unilatérales ( frocables peut en sortir des pas unil) 131 : * 132 : * la premiere raideur ne contient que des relations unilaterales pour 133 : * l'instant 134 : * la deuxieme continet aussi les relations normales d'encasdtrement des 135 : * cables glissants 136 : iraid1=mrigid 137 : mrigid=irigi2 138 : if( mrigid.ne.0) then 139 : segini,ri1=mrigid 140 : ide=0 141 : segact mrigid 142 : ifi=irigel(/2)+1 143 : do i=1,irigel(/2) 144 : if( irigel(6,i). eq .0) then 145 : ifi=ifi-1 146 : ipla=ifi 147 : else 148 : ide=ide+1 149 : ipla=ide 150 : endif 151 : do ib=1,irigel(/1) 152 : ri1.irigel(ib,ipla)=irigel(ib,i) 153 : enddo 154 : ri1.coerig(ipla)= coerig(i) 155 : enddo 156 : segdes ri1 157 : segsup mrigid 158 : mrigid=ri1 159 : endif 160 : if(mrigid.eq.0) then 160 : call ecrent ( mrigid) 161 : else 161 : call ecrobj('RIGIDITE',mrigid) 162 : endif 163 : if(iraid1.eq.0) then 163 : call ecrent ( iraid1) 164 : else 164 : call ecrobj('RIGIDITE',iraid1) 165 : endif 166 : if( mforc.eq.0) then 166 : call ecrent (mforc) 167 : else 167 : call ecrobj('CHPOINT', mforc) 168 : endif 169 : return 170 : 9000 continue 170 : call erreur (19) 171 : return 172 : end 173 : 174 : 175 :
© Cast3M 2003 - All rights reserved.
Disclaimer