Télécharger la plaquette Cast3M


fr en

Télécharger pmat.eso

Retour à la liste

Numérotation des lignes : 

pmat

  1. C PMAT      SOURCE    CB215821  20/11/25    13:35:55     10792          
  2.       subroutine pmat
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. *
  6. * création des matrices de bloquage pour le changement de phase
  7. * ces matrices sont de type 2 et des flx a mettre en face
  8. *
  9. * en entrée : objet modele
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC SMELEME
  14. -INC SMMODEL
  15. -INC SMRIGID
  16. -INC SMCOORD
  17. -INC SMCHPOI
  18. -INC SMCHAML
  19.       segment icpr(nbpts)
  20.       segment icpr1(nbpts)
  21.       segment icpr2(nbpts)
  22.       segment icpr3(nbpts)
  23.       segment  itvr
  24.         real*8  tvr(IB)
  25.       endsegment
  26.       segment ide(ib)
  27.       call LIROBJ('MMODEL  ',mmodel,1,iretou)
  28.       call ACTOBJ('MMODEL  ',mmodel,1)
  29.       if(ierr.ne.0) return
  30.       segact mmodel
  31.       nbsou=kmodel(/1)
  32.       nrigel=nbsou
  33.       nrige=8
  34.       segini mrigid,icpr,icpr1,icpr2,icpr3
  35.       mtymat='BLO_PHAS'
  36.       ib=0
  37.       do 100 i=1,nbsou
  38.       imodel=kmodel(i)
  39.       segact imodel
  40.       meleme=imamod
  41.       segact meleme
  42.       do 101 mel=1,num(/2)
  43.       do 101 npo=1,num(/1)
  44.       ia = num(npo,mel)
  45.       if(icpr(ia).eq.0) then
  46.       ib=ib+1
  47.       icpr(ia)=ib
  48.       endif
  49.   101 continue
  50.       segdes meleme
  51.   100 continue
  52.       nbsous=0
  53.       nbref=0
  54.       nbnn=1
  55.       nbelem=ib
  56. *      write(6,*) 'nbelem nbnn nbref nbsous',nbelem,nbnn,nbref,nbsous
  57.       segini ipt4
  58. * boucle sur les sous zones du model pour creer les matrices de
  59. * blocages
  60.       idd=0
  61.       do 1 i=1,nbsou
  62.       imodel=kmodel(i)
  63.       meleme=imamod
  64.       call impp1(meleme,ipt2)
  65.       segact ipt2
  66. * remplissage d'une matrice et des objets rigidite
  67.       nelrig=ipt2.num(/2)
  68.       segdes ipt2
  69.       irigel(1,i) = ipt2
  70.       irigel(5,i)=nifour
  71.       coerig(i)=1.d0
  72.       irigel(6,i)=2
  73.       nligrp=2
  74.       nligrd=2
  75.       segini descr
  76.       irigel(3,i)=descr
  77.       lisinc(1)='LX'
  78.       lisinc(2)='T'
  79.       lisdua(1)='FLX'
  80.       lisdua(2)='Q'
  81.       noelep(1)=1
  82.       noelep(2)=2
  83.       noeled(1)=1
  84.       noeled(2)=2
  85.       segdes descr
  86.       segini xmatri
  87.           do iou=1,nelrig
  88.        re(1,1,iou)= 0.D0
  89.        re(1,2,iou)=1.D0
  90.        re(2,1,iou)=1.D0
  91.        re(2,2,iou)=0.D0
  92.       enddo
  93.       segdes xmatri
  94. *      segini imatri
  95.       irigel(4,i)=xmatri
  96. *      do 3 j=1,nelrig
  97. *   3  imattt(j)=xmatri
  98.       segdes xmatri,imodel
  99.    1  continue
  100.       segdes mrigid,mmodel
  101.  
  102.       call ECROBJ('RIGIDITE',mrigid)
  103.  
  104.       end
  105.  
  106.  
  107.  
  108.  
  109.  

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