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    MB234859  26/07/06    21:15:13     12548          
  2.       SUBROUTINE RFCO
  3. *----------------------------------------------------------------------
  4. *  Calcul des raideurs et des jeux dans le cas de modeles de contact
  5. *  avec ou sans frottements
  6. *
  7. *  Entree : MMODEL de contact
  8. *
  9. *  Sortie : CHPOINT (valeurs des jeux) (pas pour les frocable)
  10. *           RIGIDITE conditions de contact et de frottements
  11. *
  12. *  Remarque : faut-il egalement sortir les conditions de frottements 
  13. *             pour les utiliser comme indicateur de recalcul des 
  14. *             conditions en cas de grands glissements. 
  15. *             Les lignes commentees demarrant par CCC permettent de   
  16. *             faire cela mais a tester davantage avant
  17. *----------------------------------------------------------------------
  18. C
  19.       IMPLICIT REAL*8(A-H,O-Z)
  20.       IMPLICIT INTEGER (I-N)
  21. C
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC SMMODEL
  25.       pointeur mmode3.mmodel,imode3.imodel
  26. -INC SMRIGID
  27. -INC SMCHPOI
  28. -INC SMELEME
  29. -INC SMCOORD
  30. C
  31.       logical lconv
  32.       SEGMENT ICPR(NBPTS)
  33.       SEGMENT IRELA(NBELT)
  34. C
  35.       CALL LIROBJ('MMODEL  ',MMODEL,1,IRETOU)
  36.       CALL ACTOBJ('MMODEL  ',MMODEL,1)
  37.       IF(IERR.NE.0) RETURN
  38. C
  39.       CALL LIRLOG(lconv,1,iretou)
  40.       IF(IERR.NE.0) RETURN
  41. C
  42.       MCHELX=0
  43.       CALL LIROBJ('MCHAML  ', MCHELX,0,IRCHA1)
  44.       IF(IRCHA1.EQ.1) CALL ACTOBJ('MCHAML  ', MCHELX,1)
  45.       IF(IERR.NE.0) RETURN
  46. C
  47.       segact mcoord
  48.       irigi0=0
  49.       irigi1=0
  50.       irigi2=0
  51.       mforc=0
  52. C
  53.       DO 10 ISOUS=1,KMODEL(/1)
  54.         imodel=kmodel(isous)
  55.         if (formod(1).NE.'CONTACT') GOTO 10
  56. C
  57. C       D'apres NOMATE :
  58. C       imate=1 unilateral; imate=2 maintenu; 
  59. C       inatu=0 sans frottement;inatu=1 coulomb; inatu=2 frocable
  60. C
  61. C       CONTACT UNILATERAL
  62.         if(imatee.eq.1) then
  63. C
  64. C         FROCABLE
  65.           if(inatuu.eq.2) then
  66.             if (lconv) then
  67. **            write(6,*) ' ivamod ',ivamod(/1)
  68.               if(ivamod(/1).ne.3) call erreur(5)
  69.               ri3 = 0
  70.               meleme = ivamod(2)
  71.               ipt1   = ivamod(1)
  72. *             call ecmail( meleme,1)
  73. *             call ecmail ( ipt1,1)
  74. *             Petit modele unitaire local (a detruire en fin de traitement)
  75.               n1=1
  76.               segini,mmode2,mmode3
  77.               nfor=0
  78.               nmat=0
  79.               mn3=1
  80.               nobmod=1
  81.               segini imode2
  82.               imode2.imamod=imamod
  83.               imode2.conmod=conmod
  84.               imode2.ivamod(1)=mmode3
  85.               imode2.tymode(1)='MMODEL'
  86.               mmode2.kmodel(1)=imode2
  87.               nobmod=0
  88.               segini imode3
  89.               imode3.imamod=ipt1
  90.               imode3.conmod=conmod
  91.               mmode3.kmodel(1)=imode3
  92. *             Option accro 'GLISS'
  93.               igliss=1
  94.               call ecrree(1.d-3)
  95.               call ecrobj('MAILLAGE',meleme)
  96.               call ecrobj('MMODEL  ',mmode2)
  97.               call accro(igliss)
  98.               IF (IERR.NE.0) THEN
  99.                 CALL ERREUR(19)
  100.                 GOTO 9000
  101.               ENDIF
  102.               call lirobj('RIGIDITE',ri2,1,iretou)
  103.               IF (IERR.NE.0) THEN
  104.                 CALL ERREUR(19)
  105.                 GOTO 9000
  106.               ENDIF
  107.               segsup mmode2,mmode3
  108.               if(irigi2.eq.0) then
  109.                 irigi2=ri2
  110.               else
  111.                 call fusrig(irigi2,ri2,Inoup)
  112.                 irigi2= inoup
  113.               endif
  114.             endif
  115. C
  116.           else
  117. C           Cas sans frottement ou avec frottement de Coulomb
  118.             ipt1   = imamod
  119.             ipt6   = ivamod(1)
  120.             ipt8   = ivamod(2)
  121.             itcont = ivamod(3)
  122. C
  123.             if (idim.eq.3) then
  124. **            write(6,*) ' avant impo32 ipt6 ipt8 itcont inatuu',
  125. **   >        ipt6,ipt8,itcont,inatuu
  126.               call impo32(ipt1,ipt6,ipt8,itcont,mchelx,ri1,mchpo2)
  127.               if (ierr.ne.0) GOTO 9000
  128. C--------------------------------------------------------------------
  129. CCC           if (mchpo2.ne.0) call frig3C(ipt1,ri1,mchpo2,ri2)
  130. C--------------------------------------------------------------------
  131.               if (inatuu.eq.1.and.mchpo2.ne.0) then 
  132.                 call frig3C(ipt1,ri1,mchpo2,ri2)
  133.                 if (ierr.ne.0) GOTO 9000
  134.               endif
  135. C
  136.             elseif (idim.eq.2) then
  137.               if (ifomod.ne.-1 .and. ifomod.ne.0) then
  138.                 call erreur(710)
  139.                 GOTO 9000
  140.               endif
  141.               call impos2(ipt1,ipt6,ipt8,itcont,mchelx,ri1,mchpo2)
  142.               if (ierr.ne.0) GOTO 9000
  143. C--------------------------------------------------------------------
  144. CCC           if (mchpo2.ne.0) call frig2C(ipt1,ri1,mchpo2,ri2)
  145. C--------------------------------------------------------------------
  146.               if (inatuu.eq.1.and.mchpo2.ne.0) then 
  147.                 call frig2C(ipt1,ri1,mchpo2,ri2)
  148.                 if (ierr.ne.0) GOTO 9000
  149.               endif
  150.             endif
  151. C
  152.             call ftaill(ipt1,mchpo2)
  153.             if (ierr.ne.0) goto 9000
  154. C
  155. C           Fusionner les objets pour le modele elementaire courant
  156.             ri3=ri1
  157.             if (inatuu.eq.1.and.mchpo2.ne.0) call fusrig(ri1,ri2,ri3)
  158. C
  159. C--------------------------------------------------------------------
  160. C           Fusionner les objets avec les autres modeles elementaires
  161. CCC         if(irigi0.eq.0.or.ri2.eq.0) then
  162. CCC           irigi0=irigi0+ri2
  163. CCC         else
  164. CCC           call fusrig(irigi0,ri2,inoup)
  165. CCC           irigi0=inoup
  166. CCC         endif
  167. C--------------------------------------------------------------------
  168. C
  169. C           Fusionner les objets avec les autres modeles elementaires
  170.             if(irigi1.eq.0) then
  171.               irigi1=ri3
  172.             else
  173.               call fusrig(irigi1,ri3,inoup)
  174.               irigi1=inoup
  175.             endif
  176. C
  177.             if(mforc.eq.0.or.mchpo2.eq.0) then
  178.               mforc=mforc+mchpo2
  179.             else
  180.               call adchpo(mchpo2,mforc,iret,1.D0,1.D0)
  181.               mforc=iret
  182.             endif
  183. C
  184.           endif
  185. C
  186.         endif
  187.   10  CONTINUE
  188. C
  189. C     IRIGI2 : Pointeur sur les rigidites des modeles FROCABLES
  190. C     IRIGI1 : Pointeur sur les rigidites des autres modeles
  191. *  on reordonne mrigid pour mettre en premier toutes
  192. *  les relations unilatérales ( frocables peut en sortir des pas unil)
  193. C
  194. C     Elements quadratiques : ajout de conditions sur noeuds milieu
  195. C     -> ne le faire que pour les elements ayant une condition de
  196. C     contact
  197.       if(irigi1.ne.0) then
  198.         if (ivamod(/1).eq.4) then
  199. C
  200. C         Identifier les noeuds avec une condition de contact
  201.           segini,icpr
  202.           ri4=irigi1
  203.           segact,ri4
  204.           do 13 iri=1,ri4.irigel(/2)
  205.             if (ri4.irigel(6,iri).ne.1) goto 13
  206.             ipt4=ri4.irigel(1,iri)
  207.             do iel=1,ipt4.num(/2)
  208.               do ino=2,ipt4.num(/1)
  209.                 ipoin=ipt4.num(ino,iel)
  210.                 if (icpr(ipoin).eq.0) icpr(ipoin)=1
  211.               enddo
  212.             enddo
  213.  13       continue
  214. C
  215.           ri4=ivamod(4)
  216.           segact,ri4
  217.           nri=ri4.irigel(/2)
  218.           nrigel=nri
  219.           segini,ri5
  220.           ri5.mtymat=ri4.mtymat
  221.           ri5.iforig=ri4.iforig
  222.           irj=0
  223.           do iri=1,nri
  224.             igard=0
  225.             ipt4=ri4.irigel(1,iri)
  226.             segact,ipt4
  227.             nbnoe=ipt4.num(/1)
  228.             nbelt=ipt4.num(/2)
  229.             segini,irela
  230.             do 14 iel=1,nbelt
  231. *             RELA MILI : 1er noeud LX, 2eme noeud le noeud milieu
  232.               do ino=3,nbnoe
  233.                 ipoin=ipt4.num(ino,iel)
  234.                 if (icpr(ipoin).ne.1) goto 14
  235.               enddo
  236.               igard=igard+1
  237.               irela(iel)=igard
  238.  14         continue
  239.             if (igard.eq.0) goto 15
  240.             irj=irj+1
  241. C
  242.             xmatr4=ri4.irigel(4,iri)
  243.             if (igard.eq.nbelt) then
  244.               ipt5=ipt4
  245.               xmatr5=xmatr4
  246.               goto 16
  247.             endif
  248. C
  249.             nbelem=igard
  250.             nbnn=nbnoe
  251.             nbref=0
  252.             nbsous=0
  253.             segini,ipt5
  254.             ipt5.itypel=ipt4.itypel
  255.             segact,xmatr4
  256.             nligrd=xmatr4.re(/1)
  257.             nligrp=xmatr4.re(/2)
  258.             nelrig=igard
  259.             rigrel=0
  260.             segini,xmatr5
  261.             do 17 iel=1,nbelt
  262.               iel2=irela(iel)
  263.               if (iel2.eq.0) goto 17
  264.               do ino=1,nbnoe
  265.                 ipt5.num(ino,iel2)=ipt4.num(ino,iel)
  266.               enddo
  267.               do ilc=1,nligrp
  268.                 do ili=1,nligrd
  269.                   xmatr5.re(ili,ilc,iel2)=xmatr4.re(ili,ilc,iel)
  270.                 enddo
  271.               enddo
  272.  17         continue
  273.  16         continue
  274.             ri5.coerig(irj)=ri4.coerig(iri)
  275.             ri5.irigel(1,irj)=ipt5
  276.             ri5.irigel(2,irj)=ri4.irigel(2,iri)
  277.             ri5.irigel(3,irj)=ri4.irigel(3,iri)
  278.             ri5.irigel(4,irj)=xmatr5
  279.             ri5.irigel(5,irj)=ri4.irigel(5,iri)
  280.             ri5.irigel(6,irj)=ri4.irigel(6,iri)
  281.             ri5.irigel(7,irj)=ri4.irigel(7,iri)
  282.             ri5.irigel(8,irj)=ri4.irigel(8,iri)
  283.  15         continue
  284.             segsup,irela
  285.           enddo
  286. C
  287.           if (irj.eq.0) then
  288.             segsup,ri5
  289.           else
  290.             IF (IRJ.NE.NRI) THEN
  291.               nrigel=irj
  292.               segadj,ri5
  293.             ENDIF
  294.             call fusrig(ri5,irigi1,iret)
  295.             irigi1=iret
  296.           endif
  297.           segsup,icpr
  298.         endif
  299.       endif
  300. C
  301.       mrigid=irigi1
  302.       if(irigi2.ne.0) then
  303.         mrigid=irigi2
  304.         segini,ri1=mrigid
  305.         ide=0
  306.         segact mrigid
  307.         ifi=irigel(/2)+1
  308.         do i=1,irigel(/2)
  309.           if( irigel(6,i). eq .0) then
  310.             ifi=ifi-1
  311.             ipla=ifi
  312.           else
  313.            ide=ide+1
  314.             ipla=ide
  315.           endif
  316.           do ib=1,irigel(/1)
  317.             ri1.irigel(ib,ipla)=irigel(ib,i)
  318.           enddo
  319.           ri1.coerig(ipla)= coerig(i)
  320.         enddo
  321.         segdes ri1
  322. ****    segsup mrigid
  323.         mrigid=ri1
  324. *  une seule raideur en sortie
  325.         if (ri1.eq.0.or.irigi1.eq.0) then
  326.           mrigid = ri1+irigi1
  327.         else
  328.           call fusrig(ri1,irigi1,mrigid)
  329.         endif
  330.       endif
  331. C
  332. C--------------------------------------------------------------------
  333. C     Conditions de frottement : pour tests dans unpas
  334. CCC   if(irigi0.eq.0) then
  335. CCC     call ecrent(irigi0)
  336. CCC   else
  337. CCC     call actobj('RIGIDITE',irigi0,0)
  338. CCC     call ecrobj('RIGIDITE',irigi0)
  339. CCC   endif
  340. C--------------------------------------------------------------------
  341. C
  342.       if(mforc.eq.0) then
  343.          call ecrent(mforc)
  344.       else
  345.          call actobj('CHPOINT',mforc,1)
  346.          call ecrobj('CHPOINT',mforc)
  347.       endif
  348. C
  349.       if(mrigid.eq.0) then
  350.         call ecrent(mrigid)
  351.       else
  352.         call actobj('RIGIDITE',mrigid,0)
  353.         call ecrobj('RIGIDITE',mrigid)
  354.       endif
  355. C
  356.  9000 CONTINUE
  357.       END
  358.  
  359.  
  360.  

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