Télécharger la plaquette Cast3M


fr en

Télécharger mocon3.eso

Retour à la liste

Numérotation des lignes : 

mocon3

  1. C MOCON3    SOURCE    PV090527  23/05/09    21:15:05     11666          
  2. C  Mise en forme du maillage des conditions de dirichlet
  3. C conversion du maillage en les elements support des conditions avec creation des  mult lagrange 
  4. C cas de la relation
  5.  
  6.       SUBROUTINE MOCON3(MELEME,ipt7)
  7. *
  8.  
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12.  
  13. -INC PPARAM 
  14. -INC CCOPTIO
  15. -INC SMCOORD
  16. -INC SMELEME
  17.       segment icpr(nbpts)
  18.  
  19. *  decompte des noeuds
  20.       segini icpr
  21.       segact meleme
  22.       ipt1=meleme
  23.       np=0
  24.       do is=1,max(1,lisous(/1))
  25.         if (lisous(/1).ne.0) ipt1=lisous(is)
  26.         segact ipt1
  27.         do iel=1,ipt1.num(/2)
  28.         do ip=1,ipt1.num(/1)
  29.           ipt=ipt1.num(ip,iel)
  30.           if(icpr(ipt).eq.0) then 
  31.            np=np+1
  32.            icpr(ipt)=np
  33.           endif
  34.         enddo
  35.         enddo
  36.       enddo
  37. *  creation maillage support, mults
  38. **    write(6,*) ' mocon2 nombre d elements',np
  39.       nbnn=np+1
  40.       nbelem=1 
  41.       nbsous=0
  42.       nbref=0
  43.       segini ipt7
  44.       ipt7.itypel=22
  45.       nbptso=nbpts
  46.       nbpts=nbptso+1 
  47.       segadj mcoord
  48.         lag1=nbpts
  49.         xcoor((lag1-1)*(idim+1)+1)=xcoor((i-1)*(idim+1)+1)
  50.         xcoor((lag1-1)*(idim+1)+2)=xcoor((i-1)*(idim+1)+2)
  51.         xcoor((lag1-1)*(idim+1)+3)=xcoor((i-1)*(idim+1)+3)
  52.         if (idim.eq.3) 
  53.      >    xcoor((lag1-1)*(idim+1)+4)=xcoor((i-1)*(idim+1)+4)
  54.       ipt7.num(1,1)=lag1
  55.       do ipt=1,icpr(/1)
  56.       if (icpr(ipt).ne.0) then
  57.         xcoor((lag1-1)*(idim+1)+1)=xcoor((i-1)*(idim+1)+1)+
  58.      >    xcoor((lag1-1)*(idim+1)+1)
  59.         xcoor((lag1-1)*(idim+1)+2)=xcoor((i-1)*(idim+1)+2)+
  60.      >    xcoor((lag1-1)*(idim+1)+2)
  61.         xcoor((lag1-1)*(idim+1)+3)=xcoor((i-1)*(idim+1)+3)+
  62.      >    xcoor((lag1-1)*(idim+1)+3)
  63.         if (idim.eq.3) 
  64.      >    xcoor((lag1-1)*(idim+1)+4)=xcoor((i-1)*(idim+1)+4)+
  65.      >    xcoor((lag1-1)*(idim+1)+4)
  66.         ipt7.num(icpr(ipt)+1,1)=ipt
  67. **      write(6,*) 'pt lagrange ',ipt,icpr(ipt),lag1
  68.       endif 
  69.       enddo
  70.         xcoor((lag1-1)*(idim+1)+1)=xcoor((lag1-1)*(idim+1)+1)/(np+1)
  71.         xcoor((lag1-1)*(idim+1)+2)=xcoor((lag1-1)*(idim+1)+2)/(np+1)
  72.         xcoor((lag1-1)*(idim+1)+3)=xcoor((lag1-1)*(idim+1)+3)/(np+1)
  73.         if(idim.eq.4) 
  74.      >    xcoor((lag1-1)*(idim+1)+4)=xcoor((lag1-1)*(idim+1)+4)/(np+1)
  75.  
  76.       end  
  77.  
  78.  

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