Esope source files

   1 : C PART6     SOURCE    FANDEUR   11/04/12    21:16:16     6938           
   2 : 
   3 :       subroutine part6(nzo,mmodel,itab,ireter)
   4 : 
   5 :       implicit integer (i-n)
   6 :       implicit real*8(a-h,o-z)
   7 : 
   8 : -INC CCOPTIO
   9 : -INC SMELEME
  10 : -INC SMMODEL
  11 : -INC SMTABLE
  12 : 
  13 :       segment ipos(nzo)
  14 :       segment mta(nzo)
  15 : 
  16 :       character*1 cha
  17 :       logical bool
  18 : 
  19 :       ireter=0
  20 :       bool = .TRUE.
  21 : 
  22 :       segact mmodel
  23 :       n1=kmodel(/1)
  24 :       segini ipos,mta
  25 : 
  26 :       m=nzo+1
  27 :       segini mtable
  28 :       itab=mtable
  28 :       CALL ECCTAB(mtable,'MOT',0,0.D0,'SOUSTYPE',bool,0
  29 :      #                  ,'MOT',0,0.D0,'ESCLAVE' ,bool,0)
  30 :       do i=1,nzo      
  31 :         segini mmode1
  32 :         mta(i)=mmode1
  32 :         call ecctab(mtable,'ENTIER',i,0.D0,cha,bool, 0
  33 :      $                    ,'MMODEL',0,0.D0,cha,bool,mmode1)
  34 :       enddo
  35 :       
  36 :       nbref=0
  37 :       nbsous=0 
  38 :       idec=0     
  39 :       do isous=1,n1
  40 :         imodel=kmodel(isous)
  41 :         segact imodel
  42 :         meleme=imamod
  43 :         segact meleme
  44 :         nbelmo=num(/2)
  45 :         nf=min(nbelmo,nzo)
  46 :         nbnnzo=num(/1)
  47 :         nbelzo=nbelmo/nzo+1
  48 :         bool = NUMMFR(nefmod).EQ.63
  49 :         do i=1,nf 
  50 :            idac=mod(i+idec-1,nzo) +1
  51 :            nbnn  =nbnnzo
  52 :            nbelem=nbelzo
  53 :            segini ipt1
  54 :            ipt1.itypel=itypel
  55 :            jj=0
  56 :            do j=i,nbelmo,nf
  57 :              jj=jj+1
  58 :              do k=1,nbnn
  59 :                ipt1.num(k,jj)=num(k,j)
  60 :              enddo
  61 :            enddo
  62 :            if (jj.ne.nbelem) then
  63 :              nbelem=jj
  64 :              segadj ipt1
  65 :            endif
  66 :            segdes ipt1
  67 :            segini,imode1=imodel
  68 : *           write(ioimp,*) conmod(/1), imode1.conmod(/1)
  69 : *           write(ioimp,*)' imode1 ' , imode1
  70 : *           write(ioimp,*) ' conmod imode1.conmod ',conmod,imode1.conmod
  71 :            imode1.imamod=ipt1
  72 :            if (imode1.infmod(/1).ge.2) imode1.infmod(2)=0
  73 : C-Cas particulier des elements de type XFEM
  74 : *           if (bool) write(ioimp,*) ' on appellle partxr'
  74 :            IF (bool) CALL PARTXR(imodel,0,imode1)
  75 :            segdes imode1
  76 :            mmode1=mta(idac)
  77 :            ipos(idac)=ipos(idac)+1
  78 : *           write(ioimp,*) ' mmode1 ipos(idac) ' , mmode1, ipos(idac)
  79 :            mmode1.kmodel(ipos(idac))=imode1 
  80 :         enddo
  81 :         segdes meleme
  82 :         segdes imodel
  83 :         idec=mod(idec + nf,nzo) 
  84 :       enddo 
  85 :       segdes mmodel
  86 : * faut-il redimensionner les modeles ?
  87 : * (certains modeles élémentaires ne portaient pas sur nzo elements)
  88 :       m = 0
  89 :       do i=1,nzo
  90 :         mmode1=mta(i)        
  91 :         n1=ipos(i)
  92 :         if (n1.eq.0) then
  93 :           if (m.eq.0) m = i
  94 :         else
  95 :           if (m.ne.0) write(ioimp,*) 'PART6 : cas a signaler ?'
  96 :         endif
  97 :         if (mmode1.kmodel(/1).ne.n1) then
  98 :           segadj mmode1
  99 :         endif
 100 : *        write(ioimp,*) ' modele numero ' , i
 100 : *        call zpmode(mmode1)
 101 :         segdes mmode1
 102 :       enddo
 103 : *  faut-il redimensionner la table aucun des modeles élémentaires 
 104 : * n'avait au moins nzo éléments
 105 :       if (m.ne.0) then
 106 : * on ne garde que les i-1 premieres partitions + le soustype
 107 :         mlotab=m
 108 :         segadj mtable
 109 :       endif
 110 :       segdes mtable
 111 :       segsup ipos,mta
 112 : 
 113 :       return
 114 :       end  
 115 : 
 116 :