C ASSMOR    SOURCE    PV        20/09/26    21:15:20     10724          
      SUBROUTINE ASSMOR(MATRIK,LL)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

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

      INTEGER PRI,DUA,LI,CO

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

      SEGACT MATRIK*MOD
      MELEMP=IRIGEL(1,LL)
      MELEMD=IRIGEL(2,LL)
      PMORS=IRIGEL(5,LL)
      SEGACT PMORS
      NBVA=JA(/1)
      SEGINI IZA

C     On recupere les segment MINCP et MINCD
      MINCP=KMINCP
      MINCD=KMINCD

      SEGACT MINCP,MINCD
      NPTP=MINCP.MPOS(/1)
      NPTD=MINCD.MPOS(/1)
      NBIP=MINCP.MPOS(/2)-1
      NBID=MINCD.MPOS(/2)-1

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

      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

      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

c         WRITE(6,*) 'IRIGEL',IRIGEL(7,LL),NP,MP,NBEL
c         IF (IRIGEL(7,LL.EQ.5) THEN
c            DO NL=1,NBME
c               IZAFM=LIZAFM(L,NL)
c               SEGACT IZAFM
c               DO K=1,NBEL
c                  IF (NBSOUS.EQ.1) THEN
c                     PRI=IPADP.LECT(IPT1.NUM(1,K))
c                     DUA=IPADD.LECT(IPT2.NUM(1,K))
c                  ELSE
c                     IF (NBSOUS1.NE.1) THEN
c                        PRI=IPADP.LECT(IPT1.NUM(1,K))
c                     ELSE
c                        PRI=IPADP.LECT(IPT1.NUM(1,NBEL1+K))
c                     END IF
c                     IF (NBSOUS2.NE.1) THEN
c                        DUA=IPADD.LECT(IPT2.NUM(1,K))
c                     ELSE
c                        DUA=IPADD.LECT(IPT2.NUM(1,NBEL2+K))
c                     END IF
c                  END IF
c
c                  WRITE(6,*) 'PRI',PRI,'DUA',DUA
c
c               END DO
c               SEGDES IZAFM
c            END DO
c         ELSE
         DO NL=1,NBME
            IZAFM=LIZAFM(L,NL)
            SEGACT IZAFM
            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

C     NINCP et NINCD sont les numero des inconnues primales et
C     duale traite.
                     IFLAG=0
                     DO JJ=1,NBIP
                        IF ((LISPRI(NL).EQ.MINCP.LISINC(JJ)).AND.
     &                       (IFLAG.EQ.0)) THEN
                           IFLAG=1
                           NINCP=JJ
                        END IF
                     END DO

                     IFLAG=0
                     DO JJ=1,NBID
                        IF ((LISDUA(NL).EQ.MINCD.LISINC(JJ)).AND.
     &                       (IFLAG.EQ.0)) THEN
                           IFLAG=1
                           NINCD=JJ
                        END IF
                     END DO

                     LI=MINCD.NPOS(DUA)+MINCD.MPOS(DUA,NINCD)-1
                     CO=MINCP.NPOS(PRI)+MINCP.MPOS(PRI,NINCP)-1
                     NB=IA(LI+1)-IA(LI)

                     M=IA(LI)
c                     WRITE(6,*) 'LI',LI,'CO',CO,'M',M,'NB',NB

                     IFLAG=0
                     DO KK=1,NB
c                        WRITE(6,*) 'JA(',M+KK-1,')=',JA(M+KK-1)
                        IF ((JA(M+KK-1).EQ.CO).AND.(IFLAG.EQ.0)) THEN
                           IFLAG=1
                           A(M+KK-1)=A(M+KK-1)+AM(K,I,J)
                           M=M+KK-1
                        END IF
                     END DO
c                     WRITE(6,*) 'AFFECT: M ',M

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

      SEGDES MELEMP,MELEMD
      SEGDES IMATRI
      SEGDES MINCP,MINCD
      SEGDES IZA
      SEGDES PMORS
      IRIGEL(6,LL)=IZA
      SEGDES MATRIK
      RETURN

      END