      SUBROUTINE ASSEMBLE(NODE27,NODE8,IVOIS,NBVOIS,NDOM,NEL,NEL27)
C
      INTEGER NODE27(28,*),NODE8(8,*),IVOIS(26,*),NBVOIS(*),NDOM(*)
      INTEGER IOP(8),IOPF(8,6),IOPA(8,12),IFAC(3,8),IAR(3,8)
      INTEGER IFOP(6),ISUC(4),JFACE(4,6),IFFF(5),ITEMP(2000)
      LOGICAL BAD
C
C IOP(I)    = NUMERO DU NOEUD OPPOSE A I DANS L'ELEMENT A 8 NOEUDS
C IOPF(I,K) = NUMERO DU NOEUD OPPOSE A I SUR LA FACE K
C IOPA(I,K) = NUMERO DU NOEUD OPPOSE A I SUR L'ARETE K 
C IFAC(.,K) = LES FACES ADJACENTES AU NOEUD K (sens "devissant")
C IAR (.,K) = LES ARETES ADJACENTES AU NOEUD K (sens "devissant" 
C             parcourant d'abord la face ifac(1,k) )
C IFOP(I)   = FACE OPPOSEE A LA  FACE I
C ISUC(I)   = SUCCESSEUR DE I
C JFACE(I,K)= NOEUD I DE LA FACE K
C
      DATA IOP  / 7,8,5,6,3,4,1,2 /
C
      DATA IOPF / 8,0,0,5,4,0,0,1,
     2            0,7,6,0,0,3,2,0,
     3            6,5,0,0,2,1,0,0,
     4            0,0,8,7,0,0,4,3,
     5            3,4,1,2,0,0,0,0,
     6            0,0,0,0,7,8,5,6 /
C
      DATA IOPA / 2,1,0,0,0,0,0,0,
     2            0,3,2,0,0,0,0,0,
     3            0,0,4,3,0,0,0,0,
     4            4,0,0,1,0,0,0,0,
     5            0,0,0,0,6,5,0,0,
     6            0,0,0,0,0,7,6,0,
     7            0,0,0,0,0,0,8,7,
     8            0,0,0,0,8,0,0,5,
     9            5,0,0,0,1,0,0,0,
     x            0,6,0,0,0,2,0,0,
     1            0,0,7,0,0,0,3,0,
     2            0,0,0,8,0,0,0,4 /
C
      DATA IFAC / 1,5,3,
     2            2,3,5,
     3            2,5,4,
     4            1,4,5,
     5            1,3,6,
     6            2,6,3,
     7            2,4,6,
     8            1,6,4 /
C
      DATA IAR  / 9,4,1 ,
     2            2,10,1,
     3            11,2,3,
     4            4,12,3,
     5            8,9,5 ,
     6            10,6,5,
     7            6,11,7,
     8            12,8,7 /
C
      DATA IFOP / 2,1,4,3,6,5 /
C
      DATA ISUC / 2,3,4,1 /
C
      DATA JFACE / 5,8,4,1,
     2             2,3,7,6,
     3             5,1,2,6,
     4             4,8,7,3,
     5             1,4,3,2,
     6             8,5,6,7 /
C
      IDIFF_MAX = 0
      NFAIT = 0
      NS0   = 0
C
    1 CONTINUE
      NS    = NS0
      KKKK  = 0
      NBMAX = 0
      NBMIN = 6
      DO 10 I=NS0+1,NEL
        NS = NS+1
        NBMAX = MAX (NBMAX,NBVOIS(I))
        IF (NBVOIS(I).GE.0) NBMIN = MIN (NBMIN,NBVOIS(I))
        IF (NBVOIS(I).EQ.3) GOTO 100
   10 CONTINUE
C
    9 PRINT*,'No element with 3 close neighbours'
      PRINT*,'NBMAX =',NBMAX,'  ;   NBMIN =',NBMIN
      IF (NBMIN.GT.3) THEN
        NBTEMP = 0
        DO 11 I=1,NEL
          IF (NBVOIS(I).EQ.NBMIN) THEN
            NBTEMP = NBTEMP+1
            ITEMP(NBTEMP) = I
          ENDIF
   11   CONTINUE
        WRITE(*,1000) NBTEMP,NBMIN,(ITEMP(K),K=1,NBTEMP)
 1000   FORMAT('The',I6,' elements with',I2,' close neighbours are:'//
     &         40(15I6/) )
ccc        PRINT*,'Entrez le numero du premier element a assembler'
ccc        READ*,NS
        KKKK = KKKK+1
        IF (KKKK.GT.NBTEMP) GOTO 9999
        NS = ITEMP(KKKK)
        PRINT*,'I try no.',KKKK,' :',NS
      ELSE
9999    PRINT*,
     &'***** STOP after',NFAIT,' elements (NEL27 =',NEL27,') *****'
        PRINT*,'Tabular nbvois:'
        DO 15 I=1,NEL
          IF (NBVOIS(I).NE.-99999) PRINT*,I,':',NBVOIS(I)
   15   CONTINUE
        STOP
      ENDIF
 100  CONTINUE
C
      NFAIT = NFAIT+1
      NN1 = 0
      NN2 = 0
      NN3 = 0
      NN4 = 0
      NN5 = 0
      DO 20 I=1,6
        IF (IVOIS(I,NS).GT.0) THEN
          IF (NN1.EQ.0) THEN
            NN1 = IVOIS(I,NS)
            IFFF(1) = I
          ELSEIF(NN2.EQ.0) THEN
            NN2 = IVOIS(I,NS)
            IFFF(2) = I
          ELSEIF(NN3.EQ.0) THEN
            NN3 = IVOIS(I,NS)
            IFFF(3) = I
          ELSEIF(NN4.EQ.0) THEN
            NN4 = IVOIS(I,NS)
            IFFF(4) = I
          ELSE
            NN5 = IVOIS(I,NS)
            IFFF(5) = I
          ENDIF
        ENDIF
   20 CONTINUE
      N1 = NN1
      N2 = NN2
      N3 = NN3
      IPROD = IFFF(1)*IFFF(2)*IFFF(3)
C
   21 IF (IPROD.EQ.48) THEN
        NCOIN = 7
      ELSEIF(IPROD.EQ.40) THEN
        NCOIN = 3
      ELSEIF(IPROD.EQ.36) THEN
        NCOIN = 6
      ELSEIF(IPROD.EQ.30) THEN
        NCOIN = 2
      ELSEIF(IPROD.EQ.24) THEN
        NCOIN = 8
      ELSEIF(IPROD.EQ.20) THEN
        NCOIN = 4
      ELSEIF(IPROD.EQ.18) THEN
        NCOIN = 5
      ELSEIF(IPROD.EQ.15) THEN
        NCOIN = 1
      ELSE
        IF (NN4.EQ.0) THEN
          IF (NFAIT.EQ.1) THEN
            PRINT*,'*** Element',NS,' inappropriate - do it again'
            NFAIT = 0
            GOTO 9
          ELSE
            GOTO 9
          ENDIF
        ELSE
          CALL CHERCHE_OPPOSEE(IFFF,NN1,NN2,NN3,NN4,N1,N2,N3,IPROD)
          IF (IPROD.NE.0) THEN
            GOTO  21
          ELSE
C            IF (NFAIT.EQ.1) THEN
            IF (NN5.NE.0) THEN
            CALL CHERCHE_OPPOSEE(IFFF(2),NN2,NN3,NN4,NN5,N1,N2,N3,IPROD)
              IF (IPROD.NE.0) THEN
                GOTO  21
              ELSE
                PRINT*,'*** Element',NS,' inappropriate - do it again'
                NFAIT = NFAIT-1
                GOTO 9
              ENDIF
            ELSE
              PRINT*,'*** Element',NS,' inappropriate - do it again'
              NFAIT = NFAIT-1
              GOTO 9
            ENDIF
C            ELSE
C              GOTO 9
C            ENDIF
          ENDIF
        ENDIF
      ENDIF
C
      NOP = IVOIS ( 18+NCOIN , NS )
C
C On reordonne les elements adjacents
C
      N1 = IVOIS ( IFAC(1,NCOIN) , NS )
      N2 = IVOIS ( IFAC(2,NCOIN) , NS )
      N3 = IVOIS ( IFAC(3,NCOIN) , NS )
C
      N31 = IVOIS ( 6 + IAR(1,NCOIN) , NS )
      N12 = IVOIS ( 6 + IAR(2,NCOIN) , NS )
      N23 = IVOIS ( 6 + IAR(3,NCOIN) , NS )
      PRINT*,NFAIT,': Assembly of',NS,' with',N1,N2,N3,N12,N23,N31,NOP
cc      PRINT*,NDOM(NS),NDOM(N1),
cc     &ndom(n2),ndom(n3),ndom(n12),ndom(n23),ndom(n31),ndom(nop)
C
      IF (NDOM(N1).NE.NDOM(NS)) 
     &PRINT*,'*** Warning: NDOM(',NS,') =',NDOM(NS),' and NDOM(',N1
     &,') =',NDOM(N1)
      IF (NDOM(N2).NE.NDOM(NS)) 
     &PRINT*,'*** Warning: NDOM(',NS,') =',NDOM(NS),' and NDOM(',N2
     &,') =',NDOM(N2)
      IF (NDOM(N3).NE.NDOM(NS)) 
     &PRINT*,'*** Warning: NDOM(',NS,') =',NDOM(NS),' and NDOM(',N3
     &,') =',NDOM(N3)
      IF (NDOM(N12).NE.NDOM(NS)) 
     &PRINT*,'*** Warning: NDOM(',NS,') =',NDOM(NS),' and NDOM(',N12
     &,') =',NDOM(N12)
      IF (NDOM(N23).NE.NDOM(NS)) 
     &PRINT*,'*** Warning: NDOM(',NS,') =',NDOM(NS),' and NDOM(',N23
     &,') =',NDOM(N23)
      IF (NDOM(N31).NE.NDOM(NS)) 
     &PRINT*,'*** Warning: NDOM(',NS,') =',NDOM(NS),' and NDOM(',N31
     &,') =',NDOM(N31)
      IF (NDOM(NOP).NE.NDOM(NS)) 
     &PRINT*,'*** Warning: NDOM(',NS,') =',NDOM(NS),' and NDOM(',NOP
     &,') =',NDOM(NOP)
C
      NNOP = INDICE ( 8 , NODE8(NCOIN,NS) , NODE8(1,NOP) )
      NN1  = INDICE ( 8 , NODE8(NCOIN,NS) , NODE8(1,N1 ) )
      NN2  = INDICE ( 8 , NODE8(NCOIN,NS) , NODE8(1,N2 ) )
      NN3  = INDICE ( 8 , NODE8(NCOIN,NS) , NODE8(1,N3 ) )
      NN12 = INDICE ( 8 , NODE8(NCOIN,NS) , NODE8(1,N12) )
      NN23 = INDICE ( 8 , NODE8(NCOIN,NS) , NODE8(1,N23) )
      NN31 = INDICE ( 8 , NODE8(NCOIN,NS) , NODE8(1,N31) )
C
C  NODE27(28) = Numero de sous domaine
C
      NODE27 (28,NFAIT) = NDOM( NS )
      NODE27 (27,NFAIT) = NODE8 ( NCOIN , NS )
      NODE27 ( 1,NFAIT) = NODE8 ( IOP(NCOIN) , NS )
      NODE27 ( 4,NFAIT) = NODE8 ( IOP(NN1  ) , N1 )
      NODE27 ( 3,NFAIT) = NODE8 ( IOP(NN31 ) , N31)
      NODE27 ( 2,NFAIT) = NODE8 ( IOP(NN3  ) , N3 )
      NODE27 ( 5,NFAIT) = NODE8 ( IOP(NN2  ) , N2 )
      NODE27 ( 8,NFAIT) = NODE8 ( IOP(NN12 ) , N12)
      NODE27 ( 7,NFAIT) = NODE8 ( IOP(NNOP ) , NOP)
      NODE27 ( 6,NFAIT) = NODE8 ( IOP(NN23 ) , N23)
C
      NODE27 (12,NFAIT) = NODE8 ( IOPF( NCOIN,IFAC(1,NCOIN) ) , NS )
      NODE27 (17,NFAIT) = NODE8 ( IOPF( NCOIN,IFAC(2,NCOIN) ) , NS )
      NODE27 ( 9,NFAIT) = NODE8 ( IOPF( NCOIN,IFAC(3,NCOIN) ) , NS )
      NODE27 (21,NFAIT) = NODE8 ( IOPA( NCOIN, IAR(1,NCOIN) ) , NS )
      NODE27 (24,NFAIT) = NODE8 ( IOPA( NCOIN, IAR(2,NCOIN) ) , NS )
      NODE27 (25,NFAIT) = NODE8 ( IOPA( NCOIN, IAR(3,NCOIN) ) , NS )
      IF ( BAD( 21,NFAIT,NODE27 ) .OR. BAD( 24,NFAIT,NODE27 )
     &                            .OR. BAD( 25,NFAIT,NODE27 ) ) THEN
        PRINT*,'*** Bad element a posteriori - do it again'
        NFAIT = NFAIT-1
        IF (KKKK.EQ.0) THEN
          NS0 = NS
          GOTO 1
        ELSE
          GOTO 9
        ENDIF
      ENDIF
C
      IF1 = INDICE ( 6 , NS , IVOIS(1,N1) )
      IF2 = INDICE ( 6 , NS , IVOIS(1,N2) )
      IF3 = INDICE ( 6 , NS , IVOIS(1,N3) )
      IFOP1 = IFOP(IF1)
      IFOP2 = IFOP(IF2)
      IFOP3 = IFOP(IF3)
C
      II  = INDICE ( 8 , NODE27(4,NFAIT) , NODE8(1,N1) )
      JJ  = INDICE ( 4 , II , JFACE(1,IFOP1) )
      JJ1 = ISUC (JJ )
      JJ2 = ISUC (JJ1)
      JJ3 = ISUC (JJ2)
      NODE27 (20,NFAIT) = NODE8 ( JFACE( JJ1,IFOP1 ) , N1 )
      NODE27 (26,NFAIT) = NODE8 ( JFACE( JJ2,IFOP1 ) , N1 )
      NODE27 (11,NFAIT) = NODE8 ( JFACE( JJ3,IFOP1 ) , N1 )
      IF ( BAD( 26,NFAIT,NODE27 ) ) THEN
        PRINT*,'*** Bad element a posteriori - do it again'
        NFAIT = NFAIT-1
        IF (KKKK.EQ.0) THEN
          NS0 = NS
          GOTO 1
        ELSE
          GOTO 9
        ENDIF
      ENDIF
C
      II  = INDICE ( 8 , NODE27(5,NFAIT) , NODE8(1,N2) )
      JJ  = INDICE ( 4 , II , JFACE(1,IFOP2) )
      JJ1 = ISUC (JJ )
      JJ2 = ISUC (JJ1)
      JJ3 = ISUC (JJ2)
      NODE27 (13,NFAIT) = NODE8 ( JFACE( JJ1,IFOP2 ) , N2 )
      NODE27 (23,NFAIT) = NODE8 ( JFACE( JJ2,IFOP2 ) , N2 )
      NODE27 (16,NFAIT) = NODE8 ( JFACE( JJ3,IFOP2 ) , N2 )
      IF ( BAD( 23,NFAIT,NODE27 ) ) THEN
        PRINT*,'*** Bad element a posteriori - do it again'
        NFAIT = NFAIT-1
        IF (KKKK.EQ.0) THEN
          NS0 = NS
          GOTO 1
        ELSE
          GOTO 9
        ENDIF
      ENDIF
C
      II  = INDICE ( 8 , NODE27(2,NFAIT) , NODE8(1,N3) )
      JJ  = INDICE ( 4 , II , JFACE(1,IFOP3) )
      JJ1 = ISUC (JJ )
      JJ2 = ISUC (JJ1)
      JJ3 = ISUC (JJ2)
      NODE27 (10,NFAIT) = NODE8 ( JFACE( JJ1,IFOP3 ) , N3 )
      NODE27 (22,NFAIT) = NODE8 ( JFACE( JJ2,IFOP3 ) , N3 )
      NODE27 (18,NFAIT) = NODE8 ( JFACE( JJ3,IFOP3 ) , N3 )
      IF ( BAD( 22,NFAIT,NODE27 ) ) THEN
        PRINT*,'*** Bad element a posteriori - do it again'
        NFAIT = NFAIT-1
        IF (KKKK.EQ.0) THEN
          NS0 = NS
          GOTO 1
        ELSE
          GOTO 9
        ENDIF
      ENDIF
C
      II  = INDICE ( 8 , NODE27(23,NFAIT) , NODE8(1,NOP) )
      NODE27 (19,NFAIT) = NODE8 ( IOP(II) , NOP )
      II  = INDICE ( 8 , NODE27(26,NFAIT) , NODE8(1,NOP) )
      NODE27 (14,NFAIT) = NODE8 ( IOP(II) , NOP )
      II  = INDICE ( 8 , NODE27(22,NFAIT) , NODE8(1,NOP) )
      NODE27 (15,NFAIT) = NODE8 ( IOP(II) , NOP )
C
C Fin de definition du gros element
C
C Mise a jour des tableaux
C
      DO 30 I=1,NEL
        IF ( I.NE.NS.AND.I.NE.N1.AND.I.NE.N2.AND.I.NE.N3.AND.
     &       I.NE.N12.AND.I.NE.N23.AND.I.NE.N31.AND.I.NE.NOP ) THEN
        DO 40 K=1,26
          IF ( IVOIS(K,I).EQ.NS ) THEN
            IVOIS(K,I) = -NS
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ELSEIF( IVOIS(K,I).EQ.N1 ) THEN
            IVOIS(K,I) = -N1
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ELSEIF( IVOIS(K,I).EQ.N2 ) THEN
            IVOIS(K,I) = -N2
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ELSEIF( IVOIS(K,I).EQ.N3 ) THEN
            IVOIS(K,I) = -N3
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ELSEIF( IVOIS(K,I).EQ.N12) THEN
            IVOIS(K,I) = -N12
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ELSEIF( IVOIS(K,I).EQ.N23) THEN
            IVOIS(K,I) = -N23
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ELSEIF( IVOIS(K,I).EQ.N31) THEN
            IVOIS(K,I) = -N31
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ELSEIF( IVOIS(K,I).EQ.NOP) THEN
            IVOIS(K,I) = -NOP
            IF (K.LE.6) NBVOIS(I)  = NBVOIS(I) - 1
          ENDIF
   40   CONTINUE
        ELSE
        DO 50 K=1,26
          IVOIS(K,I) = -IABS(IVOIS(K,I))
   50   CONTINUE
        NBVOIS(I) = -99999
        ENDIF
   30 CONTINUE
C
C Calcul de la largeur de bande
C
      DO 60 I=1,26
        DO 61 J=I+1,27
          IDIFF_MAX = MAX ( IDIFF_MAX,
     &                      IABS ( NODE27(I,NFAIT)-NODE27(J,NFAIT) ) )
   61   CONTINUE
   60 CONTINUE
C
      IF (NFAIT.NE.NEL27) THEN
        NS0 = 0
        GOTO 1
      ELSE
cc        PRINT*,'Fin correcte de "assemble"'
        PRINT*,'"assemble" successfully completed'
        PRINT*,'Max difference between nodes in one element:',
     &          IDIFF_MAX+1
      ENDIF
C
      END
