C KMORS     SOURCE    PV        20/09/26    21:17:34     10724          
      SUBROUTINE KMORS(ASSTAB,MATRIK,LL)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C     ***********************************************
C     * Routine de remplissage du tableau de ASSTAB *
C     * avec le profil de MATRIK.                   *
C     * Entree/sortie : MATRIK                      *
C     * Sortie : ASSTAB                             *
C     ***********************************************

-INC SMMATRIK

-INC SMELEME
      POINTEUR MELEMP.MELEME,MELEMD.MELEME
      POINTEUR SPGD.MELEME
-INC SMLENTI
      POINTEUR IPADP.MLENTI,IPADD.MLENTI

      SEGMENT ASSTAB
      INTEGER ITAB(NBCOMP,NTA)
      ENDSEGMENT

      INTEGER PRI,DUA

C     *********************************
C     On active le segment MATRIK et on
C     pointe sur tous les elements dont
C     on a besoin
C     *********************************

      SEGACT MATRIK
      MELEMP=IRIGEL(1,LL)
      MELEMD=IRIGEL(2,LL)

C     On prend le segment IMATRI
      IMATRI=IRIGEL(4,LL)
      SEGACT IMATRI
      NBSOUS=LIZAFM(/1)
      IF (NBSOUS.EQ.0) NBSOUS=1

C     Le support dual contient le nombre de ligne de la matrice
C     pour une variable scalaire uniquement
      SPGD=KSPGD
      SEGACT SPGD
      NBCOMP=10
      NTA=SPGD.NUM(/2)
      SEGDES SPGD

C     On initialise ASSTAB
      SEGINI ASSTAB
      IPT1=MELEMP
      IPT2=MELEMD

C     On active les connectivites primales et duales pour
C     prendre les NBSOUS1 et NBSOUS2
      SEGACT MELEMP,MELEMD
      NBSOUS1=MELEMP.LISOUS(/1)
      NBSOUS2=MELEMD.LISOUS(/1)
      IF (NBSOUS1.EQ.0) NBSOUS1=1
      IF (NBSOUS2.EQ.0) NBSOUS2=1

      NBEL1=0
      NBEL2=0
      NTTD=0

      DO L=1,NBSOUS
C     Si NBSOUS n est pas egal a 1 c est que l on est en
C     multi-elements cependant, il se peut que les connectivites
C     (aucune, une seule ou les deux) soit un support (par
C     exemple l inconue primale est sur les CENTRE). Dans ce cas
C     le MELEME n'a pas de LISOUS.
         IF (NBSOUS.NE.1) THEN
            IF (NBSOUS1.NE.1) THEN
               IPT1=MELEMP.LISOUS(L)
            END IF
            IF (NBSOUS2.NE.1) THEN
               IPT2=MELEMD.LISOUS(L)
            END IF
         END IF

         CALL KRIPAD(IPT1,IPADP)
         CALL KRIPAD(IPT2,IPADD)

         SEGACT IPT1,IPT2
         SEGACT IPADP,IPADD

         NP=IPT1.NUM(/1)
         MP=IPT2.NUM(/1)

C     Il faut faire attention pour le nombre d elements
         IF (NBSOUS.EQ.1) THEN
            NBEL=IPT1.NUM(/2)
         ELSE
            IF (NBSOUS1.NE.1) THEN
               NBEL=IPT1.NUM(/2)
            ELSEIF (NBSOUS2.NE.1) THEN
               NBEL=IPT2.NUM(/2)
            END IF
         END IF

         DO K=1,NBEL
            DO I=1,NP
               DO J=1,MP
                  IF (NBSOUS.EQ.1) THEN
                     PRI=IPADP.LECT(IPT1.NUM(I,K))
                     DUA=IPADD.LECT(IPT2.NUM(J,K))
                  ELSE
                     IF (NBSOUS1.NE.1) THEN
                        PRI=IPADP.LECT(IPT1.NUM(I,K))
                     ELSE
                        PRI=IPADP.LECT(IPT1.NUM(I,NBEL1+K))
                     END IF
                     IF (NBSOUS2.NE.1) THEN
                        DUA=IPADD.LECT(IPT2.NUM(J,K))
                     ELSE
                        DUA=IPADD.LECT(IPT2.NUM(J,NBEL2+K))
                     END IF
                  END IF
                  NTTD=MAX(NTTD,DUA)

                  NB=ITAB(1,DUA)
 100              CONTINUE
                  IF (NB+2.GT.NBCOMP) THEN
                     NBCOMP=NBCOMP+10
                     SEGADJ ASSTAB
                     GOTO 100
                  END IF

                  IFLAG=0
                  DO II=1,NB
                     IF (ITAB(II+1,DUA).EQ.PRI) THEN
                        IFLAG=1
                     END IF
                  END DO

                  IF (IFLAG.EQ.0) THEN
                     ITAB(1,DUA)=NB+1
                     ITAB(NB+2,DUA)=PRI
                  END IF

               END DO
            END DO
         END DO

         NBEL1=NBEL1+NBEL
         NBEL2=NBEL2+NBEL
         SEGDES IPADP,IPADD
         SEGDES IPT1,IPT2
      END DO

      DO I=1,NTTD
         CALL ORDOTA(ITAB(2,I),ITAB(1,I))
      END DO

      SEGDES ASSTAB
      SEGDES MELEMP,MELEMD
      SEGDES IMATRI
      SEGDES MATRIK
      END