C PART5     SOURCE    PV        18/11/19    21:15:20     9995           
C  partitionne un MELEME dans ITAB en fonction de NBZON
C
      SUBROUTINE PART5(MELEME,ITAB,NBZON,KESCL)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)


-INC SMELEME
-INC PPARAM
-INC CCOPTIO
-INC SMTABLE
-INC CCASSIS


        SEGMENT SSREF
C         ISREF   : Tableau indiquant si la sous-zone contient ou non des elements
C         IMELE   : Tableau avec les references des MELEME COMPLEXES de chaque ZONE
C         NBELE   : Tableau avec le nombre d'elements du type en cours par ZONE
C         JSOUS   : Tableau avec le nombre de Sous Ref par ZONE
          INTEGER ISREF(NBZON,NBSM)
          INTEGER IMELE(NBZON)
          INTEGER NBELE(NBZON)
          INTEGER JSOUS(NBZON)
        ENDSEGMENT


C     Declaration du COMMON pour le travail en parallele
      COMMON/part5c/NBTHR,SSREF,JA,IPT2,NBNN,NBELEM,ISOUS,NBZONE

      EXTERNAL part5i
      LOGICAL  BTHRD

C     Decompte du nombre d'elements dans le MELEME
      SEGACT MELEME

      inn=0
      NBS = lisous(/1)
      NBSM=MAX(1,NBS)
      if(NBS.eq.0) then
C       MELEME SIMPLE
        inn = num(/2)

      else
C       MELEME COMPLEXE
        do ia=1,NBS
          IPT2=lisous(ia)
          SEGACT,IPT2
          inn=inn + IPT2.num(/2)
        enddo
      endif


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C SI moins d'elements que de ZONES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      if(inn .LT. nbzon) NBZON=INN

      NBZONE=NBZON
      M=NBZON
      IF (KESCL.GT.0) M=M+2
      SEGINI,MTABLE
      ITAB=MTABLE
      IF (KESCL.GT.0) THEN
         CALL ECCTAB(ITAB,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0
     &                   ,'MOT',0,0.D0,'ESCLAVE' ,.TRUE.,0)
         CALL ECCTAB(ITAB,'MOT',0,0.D0,'CREATEUR',.TRUE.,0,
     &                    'MOT',0,0.D0,'PART'    ,.TRUE.,0)

      ENDIF

      SEGINI,SSREF
C Initialisations et Dimensionnement des MELEME
      DO 10 IZ=1,MAX(1,NBZON)
C       Creation des MELEME COMPLEXE
        nbnn=0
        nbelem=0
        nbref=0
        nbsous=NBSM
        SEGINI,IPT4

        IPT2=MELEME
        JA=0
        JSOUS(IZ) = 0
        DO 20 isous=1,NBSM
          if (NBS .NE. 0) THEN
            IPT2=lisous(isous)
          endif

C         Dimentionnement des MELEME SIMPLES a 1 element pres
          nbelem =(IPT2.num(/2) / nbzon) + 1
          nbnn   = IPT2.num(/1)
          nbsous =0
          nbref  =0
          SEGINI,IPT5
          IPT5.ITYPEL = IPT2.ITYPEL

C          jf=0
          JA = JA + IPT2.num(/2)

C         Sauvegarde des Tableaux pour la suite
          JSOUS(IZ) = JSOUS(IZ) + 1
          IPT4.LISOUS(ISOUS)=IPT5
          IMELE(IZ) = IPT4
          ISREF(IZ,isous) = 1
 20     CONTINUE
 10   CONTINUE

C Le MELEME en entree est parcouru et ses elements sont repartis dans les
C bonnes ZONES
      IPT2=MELEME
      JA=0
      DO 30 isous=1,NBSM
        if (NBS .NE. 0) THEN
          IPT2=lisous(isous)
        endif

C       Remise a zero du nombre d'elements pour cette Sous Ref
        DO IZ=1,MAX(1,NBZON)
          NBELE(IZ) = 0
        ENDDO

C       On remplit ici le COMMON pour le travail en parallele
        NBNN   = IPT2.num(/1)
        NBELEM = IPT2.num(/2)
        NBTHR = MIN(NBELEM,NBTHRS)

        ITH = 0
        IF (NBESC .NE. 0) ith=oothrd

        IF ((NBTHR .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
          ITH   = 1
          BTHRD = .FALSE.
        ELSE
          BTHRD = .TRUE.
          CALL THREADII
        ENDIF

        IF (BTHRD) THEN
          DO ith=2,NBTHR
            CALL THREADID(ith,part5i)
          ENDDO
          CALL part5i(1)

C         Attente de la fin de tous les threads en cours de travail
          DO ith=2,NBTHR
            CALL THREADIF(ith)
          ENDDO

C         On libère les Threads
          CALL THREADIS

        ELSE
          CALL part5i(1)
        ENDIF

        JA = JA + IPT2.num(/2)

C       Ajustement des MELEME SIMPLE pour toutes les ZONES si besoin
        DO IZ=1,MAX(1,NBZON)
          IPT4 = IMELE(IZ)
          IPT5 = IPT4.LISOUS(ISOUS)

          IF(NBELE(IZ) .EQ. 0) THEN
            ISREF(IZ,ISOUS) = 0
            JSOUS(IZ)       = JSOUS(IZ) - 1
            SEGSUP,IPT5

          ELSEIF(NBELE(IZ) .EQ. (IPT5.NUM(/2) - 1) )THEN
            nbnn   = IPT5.NUM(/1)
            nbelem = NBELE(IZ)
            nbref  = 0
            nbsous = 0
            SEGADJ,IPT5
            SEGDES,IPT5

          ELSE
            SEGDES,IPT5

          ENDIF

        ENDDO

 30   CONTINUE


C     Boucle Finale pour remplir la TABLE resultat
      DO 70 IZ=1,MAX(1,NBZON)
C       Recuperation du MELEME COMPLEXE
        IPT4 = IMELE(IZ)

C       Retassement du MELEME COMPLEXE IPT4 et Ajustement si necessaire
        ISACT = 0
        nbsous = JSOUS(IZ)
        IF (nbsous .NE. NBSM) THEN
          DO ISOUS=1,NBSM
            IF( ISREF(IZ,ISOUS) .EQ. 1 )THEN
              ISACT = ISACT + 1
              IPT4.LISOUS(ISACT)=IPT4.LISOUS(ISOUS)
            ENDIF
          ENDDO

          nbref  = 0
          nbnn   = 0
          nbelem = 0
          SEGADJ,IPT4
        ENDIF

C       Reclassement en MELEME SIMPLE si une seule Sous-Zone
        if (nbsous .eq. 1) then
          IPT5=IPT4.LISOUS(1)
          SEGSUP,IPT4
          IPT4=IPT5

        else
          SEGDES,IPT4

        endif
        
        CALL ECCTAB(ITAB,'ENTIER',IZ        ,0.D0  ,' ',.TRUE.,
     &                    0      ,'MAILLAGE',0,0.D0,' ',.TRUE.,IPT4)

 70   CONTINUE

      IF(NBS .GT. 0) THEN
C       MELEME COMPLEXE
        DO ia = 1,NBS
          IPT2=lisous(ia)
          SEGDES,IPT2
        ENDDO
      ENDIF

      SEGDES,MELEME,MTABLE
      SEGSUP,SSREF
      RETURN

      END