Esope source files

   1 : C PART      SOURCE    FANDEUR   11/04/12    21:16:18     6938           
   2 : *  partitionne le maillage ou le modele
   3 : *
   4 :        SUBROUTINE PART
   5 : 
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 : 
   9 : -INC CCOPTIO
  10 : -INC CCASSIS
  11 : 
  12 :        SEGMENT IPOS(0)
  13 :        SEGMENT ICPR(0)
  14 :        SEGMENT IADJ(0)
  15 :        SEGMENT JADJC(0)
  16 : 
  17 :        character*4 mcle(1)
  18 :        data mcle/'NOOP'/
  19 : 
  19 :        call lirmot(mcle,1,iretmo,0)
  20 :        if (ierr.ne.0) return
  20 :        call lirobj('MAILLAGE',meleme,0,iretou)
  21 :        if (ierr.ne.0) return
  22 :        if( iretou.eq.0) go to 100
  23 : 
  24 : C partition d'un MAILLAGE
  25 :        nbzone=max(1,nbesc)
  26 :        nb=(LOG(float(nbzone))/LOG(2.))+1.e-6
  27 :        nbzone=2**nb
  27 :        call lirent(nbzone,0,iretou)
  28 :        if (ierr.ne.0) return
  29 :        if (iretmo.ne.0) then
  29 :          call part5(meleme,itab,nbzone)
  30 :          goto 1000
  31 :        endif
  32 :        nbzon=max(1,nbzone)
  33 :        nb=(LOG(float(nbzon))/LOG(2.))+1.e-6
  34 :        if (2**nb.ne.nbzone)  THEN
  35 :          interr(1)=nbzone
  35 :          call erreur(36)
  36 :          return
  37 :        endif
  38 : *  on reprend ce qui est fait dans la renumerotation en N-D
  38 :        call part2(meleme,IPOS,nb,ICPR,iadj,jadjc)
  39 : *       write(ioimp,*) ' apres part2 ierr ',ierr
  40 :        nodes=ipos(/1)/3
  40 :        call part4(meleme,IPOS,icpr,nb,itab,iadj,jadjc)
  41 : *       write(ioimp,*) ' apres part4 ierr ',ierr
  42 :        GO TO 1000
  43 : 
  44 :   100  CONTINUE
  45 : C partition d'un MODELE
  45 :        call lirobj('MMODEL',ipmodl,0,iretou)
  46 :        if (ierr.ne.0) return
  47 :        if(iretou.eq.0) then
  47 :           call erreur (21)
  48 :           return
  49 :        endif
  49 :        call lirent(nzo,1,iretou)
  50 :        if (ierr.ne.0) return
  51 :        if (nzo.lt.1) then
  52 :          interr(1) = nzo
  52 :          call erreur(36)
  53 :          return
  54 :        endif
  55 : c*       nbzone=max(1,nbesc)
  56 : c*       nzo = min(nzo,nbzone)
  56 :        call part6(nzo,ipmodl,itab,ireter)
  57 :        if(ireter.ne.0) return
  58 : 
  59 :  1000  continue
  60 : *       write(ioimp,*) ' avant ecrobj itab ierr ',itab,ierr
  60 :        call ecrobj('TABLE',itab)
  61 : 
  62 :        RETURN
  63 :        END
  64 : 
  65 :