Sources Esope | Cast3M

repart
C REPART    SOURCE    PV        17/06/26    21:15:12     9466           
      subroutine repart(mrigid)
*
*   repartitionne une raideur pour la limiter a un enregistrement gemat
*   par sous-zone. Ca optimise gemat.
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC SMELEME
-INC SMRIGID
      INTEGER OOOLEN
      INTEGER OOOVAL
*
      LTRK=OOOVAL(1,4)
      if (LTRK.eq.0) LTRK=oooval(1,1)
 
      iafair=0
      nbs=0
      segact mrigid
      do 100 irig=1,irigel(/2)
        xmatri=irigel(4,irig)
        LSEG=ooolen(xmatri)
*        write (6,*) ' repart lseg ',lseg
        nblprt=(LSEG-1)/LTRK + 1
        meleme=irigel(1,irig)
        segact meleme
        nbelem=num(/2)
        nblmax=(nbelem-1)/nblprt+1
        nblprt=(nbelem-1)/nblmax+1
        if (nbelem.gt.nblmax) iafair=1
*        if (nblprt.gt.1) iafair=1
        nbs=nbs+nblprt
*        write (6,*) ' re nblmax ',nbelem,nblmax
*        write (6,*) ' nblprt vaut ',nblprt
        segdes meleme
 100  continue
*      write(6,*) 'nrigel nbs',irigel(/1),nbs
      if (iafair.eq.0) then
        segdes,mrigid
        return
      endif
*
*  il y a du travail à faire
      nrigel=nbs
      segini ri1
      ri1.iforig=iforig
      ri1.mtymat=mtymat
      nbs=0
      nbsous=0
      nbref=0
      do 200 irig=1,irigel(/2)
        xmatri=irigel(4,irig)
        LSEG=ooolen(xmatri)
        nblprt=(LSEG+1)/LTRK + 1
        meleme=irigel(1,irig)
        segact meleme
        nbnn=num(/1)
        nbelee=num(/2)
        nblmax=(nbelee-1)/nblprt+1
        nblprt=(nbelee-1)/nblmax+1
        if (nbelee.le.nblmax) then
*        if (nblprt.eq.1) then
          nbs=nbs+1
          ri1.coerig(nbs)=coerig(irig)
          do im=1,irigel(/1)
            ri1.irigel(im,nbs)=irigel(im,irig)
          enddo
        else
          segact xmatri
          nligrd=re(/1)
          nligrp=re(/2)
          do 250 ipar=1,nblprt
            nbs=nbs+1
            jpar=nblmax*(ipar-1)
            nbelem=min(nblmax,nbelee-jpar)
            segini ipt2
            ipt2.itypel=itypel
            do 260 iel=1,nbelem
              jel=iel+jpar
              do 270 in=1,nbnn
                ipt2.num(in,iel)=num(in,jel)
 270          continue
              ipt2.icolor(iel)=icolor(jel)
 260        continue
            segdes ipt2
            nelrig=nbelem
            segini xmatr1
            do 280 iel=1,nelrig
              jel=iel+jpar
              do 280 ip=1,nligrp
                do 280 id=1,nligrd
                  xmatr1.re(id,ip,iel)=re(id,ip,jel)
 280        continue
            segdes xmatr1
            ri1.coerig(nbs)=coerig(irig)
            ri1.irigel(1,nbs)=ipt2
            ri1.irigel(2,nbs)=irigel(2,irig)
            ri1.irigel(3,nbs)=irigel(3,irig)
            ri1.irigel(4,nbs)=xmatr1
            do im=5,irigel(/1)
              ri1.irigel(im,nbs)=irigel(im,irig)
            enddo
 250      continue
          segsup xmatri
        endif
        segdes meleme
 200  continue
      segdes ri1
      segsup mrigid
      mrigid=ri1
      return
      end