Télécharger la plaquette Cast3M


fr en

Télécharger rfco.eso

Retour à la liste

Numérotation des lignes : 

rfco

  1. C RFCO      SOURCE    OF166741  24/10/21    21:15:22     12042          
  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. *  si donne d'un chamelem en entree, en sortie le modele et le chamelem reduit sur les contacts retenus
  14. *
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMMODEL
  18.       pointeur mmode3.mmodel,imode3.imodel
  19. -INC SMRIGID
  20. -INC SMCHPOI
  21. -INC SMELEME
  22. -INC SMCOORD
  23.       logical lconv
  24.       call lirobj ('MMODEL  ',mmodel,1,iretou)
  25.       call actobj ('MMODEL  ',mmodel,1)
  26.       if(ierr.ne.0) return
  27.       call lirlog(lconv,1,iretou)
  28.        mchelx=0
  29.        call lirobj('MCHAML  ', mchelx,0,ircha1)
  30. *     write(6,*) 'rfco mchel1 ',mchel1
  31.        if(ircha1.eq.1) call actobj('MCHAML  ', mchelx,1)
  32.       if(ierr.ne.0) return
  33.       segact mcoord
  34.       mrigid=0
  35.       mforc=0
  36.       irigi2=0
  37.       irrr=0
  38.       ifff=0
  39.       irff=0
  40.       nsous= kmodel(/1)
  41.       do isous=1,nsous
  42.         imodel=kmodel(isous)
  43. **      write(6,*) ' boucfle sur modele isous ', isous,imamod
  44. * pour l'instant
  45. * imate=1 unilateral; imate=2 maintenu; inatu=0 pas de frottement
  46. * inatu=1 coulomb; inatu=2 frocable ( voir nomate)
  47.         if( imatee.eq.0) then
  48. * cas de maintenu avec ou sans coulomb  pas encore traité
  49.         elseif(imatee.eq.1) then
  50. * cas de contact unilateral
  51.           if(inatuu.eq.2) then
  52.             if( lconv) then
  53. *cas de frocable
  54. * pour les cables la notion maintenu n'existe pas               ifff=0
  55.               irff=1
  56. **            write(6,*) ' ivamod ',ivamod(/1)
  57.               if(ivamod(/1).ne.3) call erreur(5)
  58.               ri2 = 0
  59.               meleme = ivamod(2)
  60.               ipt1   = ivamod(1)
  61. *              call ecmail( meleme,1)
  62. *              call ecmail ( ipt1,1)
  63. *     Petit modele unitaire local (a detruire en fin de traitement)
  64.               n1=1
  65.               segini,mmode2,mmode3
  66.               nfor=0
  67.               nmat=0
  68.               mn3=1
  69.               nobmod=1
  70.               segini imode2
  71.               imode2.imamod=imamod
  72.               imode2.conmod=conmod
  73.               imode2.ivamod(1)=mmode3
  74.               imode2.tymode(1)='MMODEL'
  75.               mmode2.kmodel(1)=imode2
  76.               nobmod=0
  77.               segini imode3
  78.               imode3.imamod=ipt1
  79.               imode3.conmod=conmod
  80.               mmode3.kmodel(1)=imode3
  81. *     Option accro 'GLISS'
  82.               igliss=1
  83.               call ecrree(1.d-3)
  84.               call ecrobj('MAILLAGE',meleme)
  85.               call ecrobj('MMODEL  ',mmode2)
  86.               call accro(igliss)
  87.               if (ierr.ne.0) goto 9000
  88.               call lirobj('RIGIDITE',ri2,1,iretou)
  89.               if (ierr.ne.0) goto 9000
  90.               segsup mmode2,mmode3
  91.               if( irigi2.eq.0) then
  92.                 irigi2=ri2
  93.               else
  94.                 call fusrig(irigi2,ri2,Inoup)
  95.                 irigi2= inoup
  96.               endif
  97.               iraidx=irigi2
  98. * dessous fin du cas frocable
  99.             endif
  100.           else
  101. * cas du frottement de coulomb ou de pas de frottement
  102. *           on commence par le contact unilateral
  103.             ipoin1=imamod
  104.             call ecrobj('MAILLAGE',ipoin1)
  105.             ipt6=0
  106. **          if (inatuu.eq.1) then
  107.               ipt6 = ivamod(1)
  108.               ipt8 = ivamod(2)
  109.               itcont = ivamod(3)
  110.               segact ipt6*mod
  111. **          endif
  112.              call ecrent(mchelx)
  113.              call ecrent(isous)
  114. **          write(6,*) ' avant impo32 ipt6 ipt8 itcont inatuu',
  115. **   >        ipt6,ipt8,itcont,inatuu
  116.             if(idim.eq.3) call impo32(ipt6,ipt8,itcont)
  117.             if(idim.eq.2) then
  118.               if (ifomod .ne. -1 .and. ifomod .ne. 0) then
  119.                  call erreur(710)
  120.                  return
  121.               endif
  122. **            write(6,*) ' appel impos2 '
  123.               call impos2(ipt6,ipt8,itcont)
  124.             endif
  125.             call lirobj('RIGIDITE',ri2,1,iretou)
  126.             call lirobj('CHPOINT ',mchpo2,1,iretou)
  127.             call actobj('RIGIDITE',ri2,1)
  128.             call actobj('CHPOINT ',mchpo2,1)
  129.             irrr=1
  130.             ifff=1
  131.             if( mrigid.eq.0) then
  132.                mrigid=ri2
  133.             else
  134.                call fusrig ( ri2 , mrigid, inoup)
  135.                mrigid=inoup
  136.             endif
  137.             iraidx=mrigid
  138.             if( mforc.eq.0) then
  139.                mforc=mchpo2
  140.             else
  141.                call adchpo(mchpo2,mforc,iret,1.d0,1.D0)
  142.                mforc=iret
  143.             endif
  144. ***            if( lconv) then
  145.             if( .true.) then
  146. *    on fait aussi le frottement si on avait convergé.
  147.               if( inatuu.eq.1 ) then
  148.                  if(mchpo2.eq.0) then
  149.                    call erreur (19)
  150.                    return
  151.                  endif
  152.                  ri1=0
  153.                  call lirobj('MCHAML', mchel1,0,ircha1)
  154.                  if (ircha1 .EQ. 1) call actobj('MCHAML', mchel1,1)
  155.                  meleme = imamod
  156.                  if (idim .eq. 3) then
  157.                    call frig3C(meleme,ri2,mchpo2, ri1)
  158.                  else
  159.                    call frig2C(meleme,ri2,mchpo2, ri1)
  160. *                   write(6,*) ' sortie de frig2c ri2 '
  161. *                   call prrigi ( ri2,1)
  162. *                   write(6,*) ' sortie de frig2c ri1'
  163. *                   call prrigi( ri1,1)
  164. *                   write(6,*) ' fin ecrituere apres frig2c'
  165.                  endif
  166. *                write(*,*) 'avant'
  167. *                call ecchpo(mchpo2,0)
  168. **               WRITE(*,*) 'imamod' ,imamod
  169.                  call ftaill(meleme,mchpo2)
  170. **               write(*,*) 'apres'
  171. **               call ecchpo(mchpo2,0)
  172.                  if (ierr.ne.0 .or. ri2.eq.0) goto 9000
  173.                  if(irigi2.eq.0) then
  174.                     irigi2=ri1
  175.                  else
  176.                    call fusrig(irigi2,ri1,inoup)
  177.                    irigi2=inoup
  178.                  endif
  179.               endif
  180.             endif
  181.           endif
  182.         endif
  183.       enddo
  184. **    write(6,*) 'mrigid en 183',mrigid
  185. *
  186. *  on reordonne mrigid pour mettre en premier toutes
  187. *  les relations unilatérales ( frocables peut en sortir des pas unil)
  188. *
  189. *  la premiere raideur ne contient que des relations unilaterales pour
  190. * l'instant
  191. * la deuxieme contient aussi les relations normales d'encastrement des
  192. * cables glissants
  193.       iraid1=mrigid
  194.       mrigid=irigi2
  195.       if( mrigid.ne.0) then
  196.         segini,ri1=mrigid
  197.         ide=0
  198.         segact mrigid
  199.         ifi=irigel(/2)+1
  200.         do i=1,irigel(/2)
  201.           if( irigel(6,i). eq .0) then
  202.             ifi=ifi-1
  203.             ipla=ifi
  204.           else
  205.            ide=ide+1
  206.             ipla=ide
  207.           endif
  208.           do ib=1,irigel(/1)
  209.             ri1.irigel(ib,ipla)=irigel(ib,i)
  210.           enddo
  211.           ri1.coerig(ipla)= coerig(i)
  212.         enddo
  213.         segdes ri1
  214. ****    segsup mrigid
  215.         mrigid=ri1
  216. *  une seule raideur en sortie
  217.         if (ri1.eq.0.or.iraid1.eq.0) then
  218.           mrigid = ri1+iraid1
  219.         else
  220.           call fusrig(ri1,iraid1,mrigid)
  221.         endif
  222. **    write(6,*) 'ri1 iraid1 mrigid en 217',ri1,iraid1,mrigid
  223.       else
  224.         mrigid = iraid1
  225.       endif
  226. *
  227.       if(mrigid.eq.0) then
  228.         call ecrent ( mrigid)
  229.       else
  230.         call actobj('RIGIDITE',mrigid,0)
  231.         call ecrobj('RIGIDITE',mrigid)
  232.       endif
  233.       if( mforc.eq.0) then
  234.          call ecrent (mforc)
  235.       else
  236. **       call ecchpo(mforc,1)
  237.          call actobj('CHPOINT', mforc,1)
  238.          call ecrobj('CHPOINT', mforc)
  239. **       write(6,*) ' mforc en sortie de rfco ',mforc
  240.       endif
  241. *     write(6,*) 'rfco mchelx ',mchelx
  242.       return
  243.  
  244.  9000 continue
  245.       call erreur (19)
  246.       end
  247.  
  248.  
  249.  

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