C ADDMAT    SOURCE    PV        20/09/26    21:15:03     10724          
      SUBROUTINE ADDMAT(M1,M2,M3,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC SMMATRIK
      POINTEUR M1.MATRIK,M2.MATRIK,M3.MATRIK
      POINTEUR PMS3.PMORS, IZA3.IZA
      POINTEUR IMAT1.IMATRI,IMAT2.IMATRI,IMAT3.IMATRI

      SEGMENT ASSTAB
      INTEGER ITAB(NBCOMP,NTA)
      ENDSEGMENT

      INTEGER NBCOMP,NTA,PRI,DUA,NTTP,NTTD,IRET

C     =========================================
      IRET=0

      SEGACT M1

C     Si les matrices ne sont pas morse, on les crees
C     en morse
      IF (M1.IRIGEL(7,1).NE.6) THEN
        CALL ELMORS(M1,1)
      END IF

      SEGACT M2

      IF (M2.IRIGEL(7,1).NE.6) THEN
        CALL ELMORS(M2,1)
      END IF

      SEGACT M1,M2

      PMS1=M1.IRIGEL(5,1)
      PMS2=M2.IRIGEL(5,1)

      IZA1=M1.IRIGEL(6,1)
      IZA2=M2.IRIGEL(6,1)

      IMAT1=M1.IRIGEL(4,1)
      IMAT2=M2.IRIGEL(4,1)

      SEGACT IMAT1,IMAT2

      NBSOUS=IMAT1.LIZAFM(/1)
      NBME1=IMAT1.LIZAFM(/2)
      NBME2=IMAT2.LIZAFM(/2)

      IF (NBME1.NE.NBME2) THEN
        WRITE(6,*) 'ADDMAT: Les 2 MATRIK n ont pas'
        WRITE(6,*) 'le meme support, impossible de les'
        WRITE(6,*) 'additionner.'
        IRET=1
        RETURN
      ELSE
        IFLAG=0
        NBME=NBME1
        DO I=1,NBME
           IF ((IMAT1.LISPRI(I).NE.IMAT2.LISPRI(I)).OR.
     &        (IMAT1.LISDUA(I).NE.IMAT2.LISDUA(I))) THEN
              IFLAG=1
           END IF
        END DO
        IF (IFLAG.NE.0) THEN
        WRITE(6,*) 'ADDMAT: Les 2 MATRIK n ont pas'
        WRITE(6,*) 'le meme support, impossible de les'
        WRITE(6,*) 'additionner.'
        IRET=1
        RETURN
        END IF
      END IF

      SEGINI IMAT3

C     On recopie le segact IMATRI de la matrice 1 dans le IMATRI
C     pour la matrice 3

      DO I=1,NBME
         IMAT3.LISPRI(I)=IMAT1.LISPRI(I)
         IMAT3.LISDUA(I)=IMAT1.LISDUA(I)
      END DO
      IMAT3.KSPGP=IMAT1.KSPGP
      IMAT3.KSPGD=IMAT1.KSPGD

C     On initialise M3
      NMATRI=1
      NRIGE=7
      NKID=9
      NKMT=7
      SEGINI M3

      M3.KMINCP=M1.KMINCP
      M3.KMINCD=M1.KMINCD
c      WRITE(6,*) 'ADDMAT',M1.KMINCP,M1.KMINCD

      CALL RSETI(M3.IRIGEL(1,1),M1.IRIGEL(1,1),7)

      SEGACT PMS1,PMS2
      SEGACT IZA1,IZA2

      NTT=PMS1.IA(/1)-1

      NBCOMP=10
      NTA=NTT
      SEGINI ASSTAB

      DO I=1,NTT
         LI1=PMS1.IA(I)
         NB1=PMS1.IA(I+1)-PMS1.IA(I)

         LI2=PMS2.IA(I)
         NB2=PMS2.IA(I+1)-PMS2.IA(I)

         DO J=1,NB1
            NB=ITAB(1,I)
            PRI=PMS1.JA(LI1+J-1)

 10         IF (NB+1.GE.NBCOMP) THEN
               NBCOMP=NBCOMP+10
               SEGADJ ASSTAB
               GO TO 10
            END IF

C     On regarde sur la ligne DUA si la colonne PRI est
C     deja inserer dans le profil ITAB
            DO II=1,NB
               IF (ITAB(II+1,I).EQ.PRI) GO TO 30
            END DO
            ITAB(1,I)=NB+1
            ITAB(NB+2,I)=PRI

 30         CONTINUE
         END DO

         DO J=1,NB2
            NB=ITAB(1,I)
            PRI=PMS2.JA(LI2+J-1)

 35         IF (NB+1.GE.NBCOMP) THEN
               NBCOMP=NBCOMP+10
               SEGADJ ASSTAB
               GO TO 35
            END IF

C     On regarde sur la ligne DUA si la colonne PRI est
C     deja inserer dans le profil ITAB
            DO II=1,NB
               IF (ITAB(II+1,I).EQ.PRI) GO TO 40
            END DO
            ITAB(1,I)=NB+1
            ITAB(NB+2,I)=PRI

 40         CONTINUE
         END DO
      END DO

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

c      write(6,*)' KTAB ************** NPTD=',NTT
c      DO II=1,NTT
c         nb=ITAB(1,II)
c         write(6,*)' II=',ii,'  NB=',nb
c         write(6,*)(ITAB(ji+1,ii),ji=1,nb)
c      END DO

c      SEGDES ASSTAB
      M3.KNTTD=NTT
c      CALL PFMORS(ASSTAB,M3,1)

      NJA=PMS1.JA(/1)
      SEGINI PMS3

      M=0
      DO I=1,NTT
         NB=ITAB(1,I)

         PMS3.IA(I)=M+1
         DO J=1,NB
            M=M+1
 110        CONTINUE
            IF (M.GT.NJA) THEN
               NJA=NJA+100
               SEGADJ PMS3
               GOTO 110
            END IF

            PMS3.JA(M)=ITAB(J+1,I)
         END DO
      END DO

      PMS3.IA(NTT+1)=M+1
      NJA=M
      SEGADJ PMS3

c      SEGACT M3*MOD
c      PMS3=M3.IRIGEL(5,1)
c      SEGACT PMS3
      NBVA=PMS3.JA(/1)
      SEGINI IZA3

      N=PMS3.IA(/1)
c      WRITE(6,*) 'N=',N
c      DO I=1,N
c         WRITE(6,*) I,'IA',PMS3.IA(I)
c      END DO
c      WRITE(6,*) 'NBVA=',NBVA
c      DO I=1,NBVA
c         WRITE(6,*) I,'JA',PMS3.JA(I)
c      END DO

      NTT=PMS3.IA(/1)-1
      DO I=1,NTT

         LI1=PMS1.IA(I)
         NB1=PMS1.IA(I+1)-PMS1.IA(I)

         LI2=PMS2.IA(I)
         NB2=PMS2.IA(I+1)-PMS2.IA(I)

         DO J=1,NB1
            PRI=PMS1.JA(LI1+J-1)

            MA=IMORSE(PMS1.IA,PMS1.JA,I,PRI)
            MM=IMORSE(PMS3.IA,PMS3.JA,I,PRI)

            IZA3.A(MM)=IZA3.A(MM)+IZA1.A(MA)
         END DO

         DO J=1,NB2
            PRI=PMS2.JA(LI2+J-1)

            MA=IMORSE(PMS2.IA,PMS2.JA,I,PRI)
            MM=IMORSE(PMS3.IA,PMS3.JA,I,PRI)

            IZA3.A(MM)=IZA3.A(MM)+IZA2.A(MA)
         END DO
      END DO

      SEGDES PMS1,PMS2,PMS3
      SEGDES IZA1,IZA2,PMS3
C      SEGSUP ASSTAB

C     On remplit les pointeurs de M3

      M3.IRIGEL(4,1)=IMAT3
      M3.IRIGEL(5,1)=PMS3
      M3.IRIGEL(6,1)=IZA3
      M3.IRIGEL(7,1)=6

      M3.KSYM=2
      M3.KNTTP=M2.KNTTP
      M3.KNTTD=M1.KNTTD

      SEGDES IMAT1,IMAT2,IMAT3
      SEGDES M1,M2,M3

      CALL OPTIM(M3,1)
      RETURN
      END