Esope source files

   1 : C PART5     SOURCE    CHAT      06/03/10    21:15:13     5327           
   2 : *  partitionne meleme dans itab en fonction de nbzon
   3 : *
   4 :       SUBROUTINE PART5(MELEME,ITAB,NBZON)
   5 : *
   6 :       IMPLICIT INTEGER(I-N)
   7 : -INC SMELEME
   8 : -INC CCOPTIO
   8 :       CALL CRTABL(ITAB)
   8 :       CALL ECCTAB(ITAB,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,
   9 :      #                  0,'MOT',0,0.D0,'ESCLAVE',.TRUE.,0)
  10 : *
  11 : * cas particulier moins d'élément que de zone 
  12 : *
  13 :       segact meleme
  14 :       inn=0
  15 :       if(lisous(/1).eq.0) then
  16 :        inn = num(/2)
  17 :       else 
  18 :         do ia=1,lisous(/1)
  19 :          ipt2=lisous(ia)
  20 :          segact ipt2
  21 :          inn=inn + ipt2.num(/2)
  22 :         enddo
  23 :       endif
  24 :       if(inn.lt.nbzon) then
  25 :       segini,ipt1=meleme
  25 :             CALL ECCTAB(ITAB,'ENTIER',1,0.D0,' ',.TRUE.,
  26 :      #                   0,'MAILLAGE',0,0.D0,' ',.TRUE.,ipt1)
  27 :       write(6,*) ' une seule zone crée !!!!!!!!!!!!!!!!!!!!!!'
  28 :       segdes ipt1,meleme
  29 :       return
  30 :       endif
  31 : *  boucle sur les zones de maillages à creer
  32 :       ja=0
  33 :       do 10 iz=1,max(1,nbzon)
  34 : *      write(6,*) ' iz ja ' , iz,ja
  35 :       ja=0
  36 :       segact meleme
  37 :       nbnn=0
  38 :       nbelem=0
  39 :       nbref=0
  40 :       nbsous=max(1,lisous(/1))
  41 :       segini,ipt4
  42 :       jsous=0
  43 :       ipt1=meleme
  44 :       do 20 isous=1,max(1,lisous(/1))
  45 :       if (lisous(/1).ne.0) ipt1=lisous(isous)
  46 :       segact ipt1
  47 :       segini,ipt5=ipt1
  48 :       do 30 j=1,ipt5.num(/2)
  49 :       if (mod(j-iz+ja,nbzon).ne.0) then
  50 : * on annule l'element
  51 :         ipt5.num(1,j)=0
  52 :       endif
  53 :   30  continue
  54 :       ja = ja + ipt5.num(/2)
  55 : *  compaction de ipt5
  56 :       jf=0
  57 :       do 50 j=1,ipt5.num(/2)
  58 :       if (ipt5.num(1,j).eq.0) goto 50
  59 :       jf=jf+1
  60 :       ipt5.icolor(jf)=ipt5.icolor(j)
  61 :       do i=1,ipt5.num(/1)
  62 :         ipt5.num(i,jf)=ipt5.num(i,j)
  63 :       enddo
  64 :   50  continue
  65 :       nbnn=ipt5.num(/1)
  66 :       nbelem=jf
  67 :       nbsous=0
  68 :       nbref=0
  69 :       segadj ipt5
  70 :       segdes ipt5
  71 :       if (jf.ne.0) then
  72 :         jsous=jsous+1
  73 :         ipt4.lisous(jsous)=ipt5
  74 :       else
  75 :         segsup ipt5
  76 :       endif
  77 :       segdes ipt1
  78 :   20  continue
  79 :       nbsous=jsous
  80 :       nbref=0
  81 :       nbnn=0
  82 :       nbelem=0
  83 :       segadj ipt4
  84 :       if (jsous.eq.1) then
  85 :          ipt5=ipt4.lisous(1)
  86 :          segsup ipt4
  87 :          ipt4=ipt5
  88 :       endif
  89 :       segdes meleme,ipt4
  89 :       CALL ECCTAB(ITAB,'ENTIER',iz,0.D0,' ',.TRUE.,
  90 :      #                   0,'MAILLAGE',0,0.D0,' ',.TRUE.,ipt4)
  91 :   10  continue
  92 :       end
  93 : 
  94 : 
  95 : 
  96 : 
  97 :  
  98 :  
  99 :  
 100 :  
 101 :  
 102 :