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/05/13    21:15:19     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.               do ino=2,nbnoe
  232.                 ipoin=ipt4.num(ino,iel)
  233.                 if (icpr(ipoin).ne.1) goto 14
  234.               enddo
  235.               igard=igard+1
  236.               irela(iel)=igard
  237.  14         continue
  238.             if (igard.eq.0) goto 15
  239.             irj=irj+1
  240. C
  241.             xmatr4=ri4.irigel(4,iri)
  242.             if (igard.eq.nbelt) then
  243.               ipt5=ipt4
  244.               xmatr5=xmatr4
  245.               goto 16
  246.             endif
  247. C
  248.             nbelem=igard
  249.             nbnn=nbnoe
  250.             nbref=0
  251.             nbsous=0
  252.             segini,ipt5
  253.             segact,xmatr4
  254.             nligrd=xmatr4.re(/1)
  255.             nligrp=xmatr4.re(/2)
  256.             nelrig=igard
  257.             rigrel=0
  258.             segini,xmatr5
  259.             do 17 iel=1,nbelt
  260.               iel2=irela(iel)
  261.               if (iel2.eq.0) goto 17
  262.               do ino=1,nbnoe
  263.                 ipt5.num(ino,iel2)=ipt4.num(ino,iel)
  264.               enddo
  265.               do ilc=1,nligrp
  266.                 do ili=1,nligrd
  267.                   xmatr5.re(ili,ilc,iel2)=xmatr4.re(ili,ilc,iel)
  268.                 enddo
  269.               enddo
  270.  17         continue
  271.  16         continue
  272.             ri5.coerig(irj)=ri4.coerig(iri)
  273.             ri5.irigel(1,irj)=ipt5
  274.             ri5.irigel(2,irj)=ri4.irigel(2,iri)
  275.             ri5.irigel(3,irj)=ri4.irigel(3,iri)
  276.             ri5.irigel(4,irj)=xmatr5
  277.             ri5.irigel(5,irj)=ri4.irigel(5,iri)
  278.             ri5.irigel(6,irj)=ri4.irigel(6,iri)
  279.             ri5.irigel(7,irj)=ri4.irigel(7,iri)
  280.             ri5.irigel(8,irj)=ri4.irigel(8,iri)
  281.  15         continue
  282.             segsup,irela
  283.           enddo
  284. C
  285.           if (irj.eq.0) then
  286.             segsup,ri5
  287.           else
  288.             if (irj.ne.nri) segadj,ri5
  289.             ri4=ivamod(4)
  290.             call fusrig(ri5,irigi1,iret)
  291.             irigi1=iret
  292.           endif
  293.           segsup,icpr
  294.         endif
  295.       endif
  296. C
  297.       mrigid=irigi1
  298.       if(irigi2.ne.0) then
  299.         mrigid=irigi2
  300.         segini,ri1=mrigid
  301.         ide=0
  302.         segact mrigid
  303.         ifi=irigel(/2)+1
  304.         do i=1,irigel(/2)
  305.           if( irigel(6,i). eq .0) then
  306.             ifi=ifi-1
  307.             ipla=ifi
  308.           else
  309.            ide=ide+1
  310.             ipla=ide
  311.           endif
  312.           do ib=1,irigel(/1)
  313.             ri1.irigel(ib,ipla)=irigel(ib,i)
  314.           enddo
  315.           ri1.coerig(ipla)= coerig(i)
  316.         enddo
  317.         segdes ri1
  318. ****    segsup mrigid
  319.         mrigid=ri1
  320. *  une seule raideur en sortie
  321.         if (ri1.eq.0.or.irigi1.eq.0) then
  322.           mrigid = ri1+irigi1
  323.         else
  324.           call fusrig(ri1,irigi1,mrigid)
  325.         endif
  326.       endif
  327. C
  328. C--------------------------------------------------------------------
  329. C     Conditions de frottement : pour tests dans unpas
  330. CCC   if(irigi0.eq.0) then
  331. CCC     call ecrent(irigi0)
  332. CCC   else
  333. CCC     call actobj('RIGIDITE',irigi0,0)
  334. CCC     call ecrobj('RIGIDITE',irigi0)
  335. CCC   endif
  336. C--------------------------------------------------------------------
  337. C
  338.       if(mforc.eq.0) then
  339.          call ecrent(mforc)
  340.       else
  341.          call actobj('CHPOINT',mforc,1)
  342.          call ecrobj('CHPOINT',mforc)
  343.       endif
  344. C
  345.       if(mrigid.eq.0) then
  346.         call ecrent(mrigid)
  347.       else
  348.         call actobj('RIGIDITE',mrigid,0)
  349.         call ecrobj('RIGIDITE',mrigid)
  350.       endif
  351. C
  352.  9000 CONTINUE
  353.       END
  354.  
  355.  

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