Télécharger la plaquette Cast3M


fr en

Télécharger mocon1.eso

Retour à la liste

Numérotation des lignes : 

mocon1

  1. C MOCON1    SOURCE    MB234859  26/05/13    21:15:05     12548          
  2. C----------------------------------------------------------------------
  3. C        Creation du maillage support des conditions de contact
  4. C
  5. C  Ce maillage permet d'associer un noeud de la surface de contact aux
  6. C  conditions de contact-frottement qui le concernent :
  7. C  1     condition    de contact    par noeuds
  8. C  1 a 2 condition(s) de frottement par noeuds, selon la dimension.
  9. C  Le maillage cree est constitue d'elements formes de NBNN noeuds.
  10. C  En 2D :
  11. C   noeud 1             : noeud support du LX de la cond. de contact
  12. C   noeud 2 a NBNN-1    : noeud(s) associe(s) aux conditions
  13. C   noeud NBNN          : noeud support du LX de la cond. de frottement
  14. C  En 3D :
  15. C   noeud 1             : noeud support du LX de la cond. de contact
  16. C   noeud 2 a NBNN-1    : noeud(s) associe(s) aux conditions
  17. C   noeud NBNN-1 a NBNN : noeuds support du LX des cond. de frottement
  18. C  Le nombre de noeuds NN associe a une condition depend de la formulation 
  19. C  Pour les cas MESC et SYME, NN=1 et pour le cas FAIB NN=IDIM
  20. C
  21. C  Remarque : les conditions s'appuie sur des elements SEG2 en 2D et
  22. C  TRI3 en 3D. Si les maillages des surfaces de contact ne sont pas 
  23. C  constitues de ces elements, ces derniers sont changes lorsque cela 
  24. C  est possible ou un message d'erreur est affiche.
  25. C
  26. C  Entrees :
  27. C  --------
  28. C    IPT2  : Pointeur sur le maillage d'une des surfaces en contact
  29. C    IPT3  : Pointeur sur le maillage d'une des surfaces en contact
  30. C    IMFRO : Entier valant 3 en presence de frottement
  31. C    ITYPC : Formulation des conditions (voir modeli.eso)
  32. C              0 -> FROCABLE
  33. C              1 -> MESC
  34. C              2 -> FAIB
  35. C              3 -> SYME
  36. C
  37. C  Sorties :
  38. C  --------
  39. C    IPT1  : Pointeur sur le maillage support du modele de contact.
  40. C    IPT6  : Pointeur sur le second maillage support du modele de contact 
  41. C            (uniquement pour la formulation SYME)
  42. C    IPT4  : Pointeur sur le maillage constitue d'elements adaptes 
  43. C            pour l'ecriture de conditions de contact
  44. C            (IPT3 ou cree par MOCON4)
  45. C    IPT5  : Pointeur sur le maillage constitue d'elements adaptes 
  46. C            pour l'ecriture de conditions de contact 
  47. C            (IPT3 ou cree par MOCON4)
  48. C    IPRIG : Si necessaire, pointeur sur un objet MRIGID imposant des 
  49. C            conditions sur les noeuds milieu. Sinon vaut 0
  50. C
  51. C  Remarque :
  52. C  ----------
  53. C  IPT2 et IPT3 peuvent etre des constitues de plusieurs type d'elements 
  54. C  (objet geometrie complexe), d'ou l'utilisation de ACTOBJ pour activer 
  55. C  tous les sous-maillages.
  56. C  IPT1, IPT4 et IPT5 sont des maillages constitue d'un seul type d'elmt
  57. C  (objet geometrie simple), d'ou l'utilisation directe de SEGDES.
  58. C
  59. C  Appelee par : MODELI
  60. C----------------------------------------------------------------------
  61.       SUBROUTINE MOCON1(IPT2,IPT3,IMFRO,ITYPC,IPT1,IPT6,IPT4,IPT5,IPRIG)
  62. C
  63.       IMPLICIT INTEGER(I-N)
  64.       IMPLICIT REAL*8 (A-H,O-Z)
  65. C
  66. -INC PPARAM
  67. -INC CCOPTIO
  68. -INC SMCOORD
  69. -INC SMELEME
  70. -INC CCGEOME
  71. C
  72.       SEGMENT ICPR(NBPTS)                 
  73.       DIMENSION XX(4)
  74. C
  75.       IPRIG=0
  76.       IFOIS=1
  77.       IPT4=0
  78.       IPT5=0
  79. C
  80.       IF (IPT2.NE.0) CALL ACTOBJ('MAILLAGE',IPT2,1)
  81.       IF (IPT3.NE.0) CALL ACTOBJ('MAILLAGE',IPT3,1)
  82. C
  83. C     Nombre de LX
  84.       NBL=1
  85.       IF (IMFRO.EQ.3) NBL=IDIM
  86. C
  87.       IF (ITYPC.EQ.0) THEN
  88.         MELEME=IPT2
  89.         IF (LISOUS(/1).NE.0) CALL ERREUR(25)
  90.         IF (IERR.NE.0) RETURN
  91.       ELSE
  92.         CALL MOCON4(IPT2,IPT4,IPRI2)
  93.         CALL MOCON4(IPT3,IPT5,IPRI3)
  94.         MELEME=IPT5
  95. C
  96.         IF (IPRI2*IPRI3.NE.0) THEN
  97.           CALL FUSRIG(IPRI2,IPRI3,IPRIG)
  98.         ELSEIF (IPRI2.NE.0) THEN
  99.           IPRIG=IPRI2
  100.         ELSEIF (IPRI3.NE.0) THEN
  101.           IPRIG=IPRI3
  102.         ENDIF
  103. C
  104.         IF (ITYPC.EQ.2) GOTO 1000
  105. C
  106.       ENDIF
  107. C
  108. C     FORMULATIONS AUTRES QUE FAIBLE
  109. C                  ------
  110. C
  111.  500  CONTINUE
  112. C
  113.       NBELT=NUM(/2)
  114.       NBNOE=NUM(/1)
  115. C
  116. C     Remplissage icpr pour avoir le nombre de noeuds
  117.       segini icpr
  118.       icp=0
  119.       do j=1,NBELT
  120.         do i=1,NBNOE
  121.           ip=num(i,j)
  122.           if(icpr(ip).eq.0) then
  123.             icp=icp+1
  124.             icpr(ip)=icp
  125.           endif
  126.         enddo
  127.       enddo
  128. C
  129.       nbnn=nbl+1
  130.       nbelem=icp
  131.       IF (ITYPC.EQ.0) nbelem=nbelem*idim
  132.       nbsous=0
  133.       nbref=0
  134.       segini,ipt1
  135.       ipt1.itypel=22
  136. C
  137.       do i=1,nbpts
  138.         if(icpr(i).ne.0) then
  139.           ip=icpr(i)
  140.           ipt1.num(2,ip)=i
  141.           nbpts=nbpts+1
  142.           ipt1.num(1,ip)=nbpts
  143.           if(nbl.ge.2) then
  144.             nbpts=nbpts+1
  145.             ipt1.num(3,ip)=nbpts
  146.           endif
  147.           if(nbl.ge.3) then
  148.             nbpts=nbpts+1
  149.             ipt1.num(4,ip)=nbpts
  150.           endif
  151.         endif
  152.       enddo
  153. C
  154. C     Modele FROCABLE
  155.       if (ITYPC.eq.0) then
  156.         do j=nbelem/idim,1,-1
  157.           ipt1.num(1,(j-1)*idim+1)=ipt1.num(1,j)
  158.           ipt1.num(2,(j-1)*idim+1)=ipt1.num(2,j)
  159.           if(nbl.ge.2) ipt1.num(3,(j-1)*idim+1)=ipt1.num(3,j)
  160.           if(nbl.ge.3) ipt1.num(4,(j-1)*idim+1)=ipt1.num(4,j)
  161.           nbpts=nbpts+1
  162.           ipt1.num(1,(j-1)*idim+2)=nbpts
  163.           ipt1.num(2,(j-1)*idim+2)=ipt1.num(2,j)
  164.           if(nbl.ge.2) then
  165.            nbpts=nbpts+1
  166.            ipt1.num(3,(j-1)*idim+2)=nbpts
  167.           endif
  168.           if(nbl.ge.3) then
  169.            nbpts=nbpts+1
  170.            ipt1.num(4,(j-1)*idim+2)=nbpts
  171.           endif
  172.  
  173.           if(idim.eq.3) then
  174.           nbpts=nbpts+1
  175.           ipt1.num(1,(j-1)*idim+3)=nbpts
  176.           ipt1.num(2,(j-1)*idim+3)=ipt1.num(2,j)
  177.           if(nbl.ge.2) then
  178.            nbpts=nbpts+1
  179.            ipt1.num(3,(j-1)*idim+3)=nbpts
  180.           endif
  181.           if(nbl.ge.3) then
  182.            nbpts=nbpts+1
  183.            ipt1.num(4,(j-1)*idim+3)=nbpts
  184.           endif
  185.           endif
  186.         enddo
  187.       endif
  188. C
  189. C     Ajouter les noeuds support des LX
  190.       SEGADJ,MCOORD
  191.       il1=0
  192.       il2=0
  193.       do j=1,ipt1.num(/2)
  194.         ip=ipt1.num(2,j)
  195.         il=ipt1.num(1,j)
  196.         if(nbl.ge.2) il1=ipt1.num(3,j)
  197.         if(nbl.ge.3) il2=ipt1.num(4,j)
  198.         do id=1,idim+1
  199.           xc=xcoor((ip-1)*(idim+1)+id)
  200.           xcoor((il-1)*(idim+1)+id)=xc
  201.           if(il1.ne.0) xcoor((il1-1)*(idim+1)+id)=xc
  202.           if(il2.ne.0) xcoor((il2-1)*(idim+1)+id)=xc
  203.         enddo
  204.       enddo
  205. C
  206.       SEGSUP,ICPR
  207. C
  208.       IF (ITYPC.EQ.3) THEN
  209.         IF (IFOIS.EQ.1) THEN
  210.           IFOIS=2
  211.           MELEME=IPT4
  212.           ITEMP=IPT1
  213.           GOTO 500
  214.         ELSE
  215.           IPT6=IPT1
  216.           IPT1=ITEMP
  217.           SEGDES,IPT6
  218.         ENDIF
  219.       ENDIF
  220.       GOTO 2000
  221. C=============
  222.  1000 CONTINUE
  223. C=============
  224. C
  225. C     Formulation faible
  226.       NBEL4=IPT4.NUM(/2)
  227.       NBEL5=IPT5.NUM(/2)
  228.       NBNOE=IPT4.NUM(/1)
  229.       NBELEM=NBEL4+NBEL5
  230.       NBNN=NBNOE+NBL
  231.       NBSOUS=0
  232.       NBREF=0
  233.       SEGINI,IPT1
  234.       IPT1.ITYPEL=22
  235. C
  236.       NBPTSO=NBPTS
  237.       NBPTS =NBPTS+NBELEM*NBL
  238.       SEGADJ,MCOORD
  239. C
  240.       MELEME=IPT5
  241.       NBELEM=NBEL5
  242.       L=0
  243. C
  244.  1500 CONTINUE
  245. C
  246.       DO J=1,NBELEM
  247. C
  248.         L=L+1
  249.         DO K=1,IDIM+1
  250.           XX(K)=0.D0
  251.         ENDDO
  252.         DO I=1,NBNOE
  253.           IP=NUM(I,J)
  254.           IPT1.NUM(I+1,L)=IP
  255.           DO K=1,IDIM+1
  256.             XC=XCOOR((IDIM+1)*(IP-1)+K)
  257.             XX(K)=XX(K)+XC
  258.           ENDDO
  259.         ENDDO
  260.         DO K=1,IDIM+1
  261.           XX(K)=XX(K)/NBNOE
  262.         ENDDO
  263. C
  264.         IPT1.NUM(1,L)=NBPTSO+1
  265.         IF(NBL.GE.2) IPT1.NUM(NBNOE+2,L)=NBPTSO+2
  266.         IF(NBL.GE.3) IPT1.NUM(NBNOE+3,L)=NBPTSO+3
  267. C
  268.         DO K=1,IDIM+1
  269.           XC=XX(K)
  270.           XCOOR((IDIM+1)*((NBPTSO+1)-1)+K)=XC
  271.           IF(NBL.GE.2) XCOOR((IDIM+1)*((NBPTSO+2)-1)+K)=XC
  272.           IF(NBL.GE.3) XCOOR((IDIM+1)*((NBPTSO+3)-1)+K)=XC
  273.         ENDDO
  274.         NBPTSO=NBPTSO+NBL
  275. C
  276.       ENDDO
  277. C
  278.       IF (IFOIS.EQ.1) THEN
  279.         IFOIS=2
  280.         MELEME=IPT4
  281.         NBELEM=NBEL4
  282.         GOTO 1500
  283.       ENDIF
  284. C=============
  285.  2000 CONTINUE
  286. C=============
  287. C
  288.       IF (IPT2.NE.0) CALL ACTOBJ('MAILLAGE',IPT2,0)
  289.       IF (IPT3.NE.0) CALL ACTOBJ('MAILLAGE',IPT3,0)
  290.       IF (IPT4.NE.0) SEGDES,IPT4
  291.       IF (IPT5.NE.0) SEGDES,IPT5
  292.       SEGDES,IPT1
  293. C
  294.       END
  295.  
  296.  

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