Esope source files

   1 : C PMAT      SOURCE    CHAT      11/03/16    21:29:11     6902           
   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 : -INC CCOPTIO
  11 : -INC SMELEME
  12 : -INC SMMODEL
  13 : -INC SMRIGID
  14 : -INC SMCOORD
  15 : -INC SMCHPOI
  16 : -INC SMCHAML
  17 :       segment icpr(XCOOR(/1)/(idim+1))
  18 :       segment icpr1(XCOOR(/1)/(idim+1))
  19 :       segment icpr2(XCOOR(/1)/(idim+1))
  20 :       segment icpr3(XCOOR(/1)/(idim+1))
  21 :       segment  itvr
  22 :         real*8  tvr(IB)
  23 :       endsegment
  24 :       segment ide(ib)
  24 :       call lirobj('MMODEL',mmodel,1,iretou)
  25 :       if(ierr.ne.0) return
  26 :       segact mmodel
  27 :       nbsou=kmodel(/1)
  28 :       nrigel=nbsou
  29 :       nrige=8
  30 :       segini mrigid,icpr,icpr1,icpr2,icpr3
  31 :       mtymat='BLO_PHAS'
  32 :       ib=0
  33 :       do 100 i=1,nbsou
  34 :       imodel=kmodel(i)
  35 :       segact imodel
  36 :       meleme=imamod
  37 :       segact meleme
  38 :       do 101 mel=1,num(/2)
  39 :       do 101 npo=1,num(/1)
  40 :       ia = num(npo,mel)
  41 :       if(icpr(ia).eq.0) then
  42 :       ib=ib+1
  43 :       icpr(ia)=ib
  44 :       endif
  45 :   101 continue
  46 :       segdes meleme
  47 :   100 continue
  48 :       nbsous=0
  49 :       nbref=0
  50 :       nbnn=1
  51 :       nbelem=ib
  52 : *      write(6,*) 'nbelem nbnn nbref nbsous',nbelem,nbnn,nbref,nbsous
  53 :       segini ipt4
  54 : * boucle sur les sous zones du model pour creer les matrices de
  55 : * blocages 
  56 :       idd=0         
  57 :       do 1 i=1,nbsou
  58 :       imodel=kmodel(i)
  59 :       meleme=imamod
  59 :       call impp1(meleme,ipt2)
  60 :       segact ipt2
  61 : * remplissage d'une matrice et des objets rigidite    
  62 :       nelrig=ipt2.num(/2)
  63 :       segdes ipt2
  64 :       irigel(1,i) = ipt2
  65 :       irigel(5,i)=nifour
  66 :       coerig(i)=1.d0
  67 :       irigel(6,i)=2
  68 :       nligrp=2
  69 :       nligrd=2
  70 :       segini descr
  71 :       irigel(3,i)=descr
  72 :       lisinc(1)='LX'
  73 :       lisinc(2)='T'
  74 :       lisdua(1)='FLX'
  75 :       lisdua(2)='Q'
  76 :       noelep(1)=1     
  77 :       noelep(2)=2     
  78 :       noeled(1)=1     
  79 :       noeled(2)=2     
  80 :       segdes descr
  81 :       segini xmatri
  82 :           do iou=1,nelrig
  83 :        re(1,1,iou)= 0.D0                                                        
  84 :        re(1,2,iou)=1.D0   
  85 :        re(2,1,iou)=1.D0                                                         
  86 :        re(2,2,iou)=0.D0  
  87 :       enddo        
  88 :       segdes xmatri          
  89 : *      segini imatri
  90 :       irigel(4,i)=xmatri
  91 : *      do 3 j=1,nelrig
  92 : *   3  imattt(j)=xmatri
  93 :       segdes xmatri,imodel
  94 :    1  continue
  95 :       segdes mrigid,mmodel
  95 :       call ecrobj ('RIGIDITE',mrigid)
  96 :       return
  97 :       end
  98 :  
  99 :  
 100 :