C PFMORS    SOURCE    PV        20/09/26    21:19:06     10724          
      SUBROUTINE PFMORS(ASSTAB,MATRIK,LL)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C     ******************************************
C     * Subroutine calculant le profil morse   *
C     * a partir de ASSTAB                     *
C     * Entree /Sortie : MATRIK                *
C     * Sortie : ASSTAB                        *
C     ******************************************

-INC SMMATRIK

      SEGMENT ASSTAB
      INTEGER ITAB(NBCOMP,NTA)
      ENDSEGMENT

      INTEGER DUA,PRI,MAXDUA,MAXPRI

      SEGACT MATRIK*MOD
      SEGACT ASSTAB

      NBCOMP=ITAB(/1)
      NTA=ITAB(/2)

      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

      NTT=NPTD
      NJA=NPTP
C     On initialise le segment PMORS
      SEGINI PMORS

      M=0
      MAXPRI=0
      MAXDUA=0


      DO I=1,NTA
         NB=ITAB(1,I)
         NINCD=MINCD.NPOS(I+1)-MINCD.NPOS(I)

c         WRITE(6,*) 'NINCD',NINCD
         LLL=0
         DO L=1,NINCD
            LLL=LLL+1
 300        CONTINUE
            IF (MINCD.MPOS(I,LLL).EQ.0) THEN
               LLL=LLL+1
               GOTO 300
            END IF
            DUA=MINCD.NPOS(I)+MINCD.MPOS(I,LLL)-1
            MAXDUA=MAX(DUA,MAXDUA)

 100        CONTINUE
            IF (NTT.LT.DUA) THEN
               NTT=NTT+100
               SEGADJ PMORS
               GOTO 100
            END IF
c            WRITE(6,*) 'DUA',DUA,'M',M
            IA(DUA)=M+1
c            WRITE(6,*) 'NB', NB

            DO J=1,NB
c               WRITE(6,*) 'J',J,'I',I
               PRI=ITAB(J+1,I)
c               WRITE(6,*) 'PRI',PRI,'NINCP',MINCP.NPOS(PRI+1)-
c     &              MINCP.NPOS(PRI)
               NINCP=MINCP.NPOS(PRI+1)-MINCP.NPOS(PRI)

               KK=0
               DO K=1,NINCP
                  KK=KK+1
                  PRI=ITAB(J+1,I)
                  M=M+1
c                  WRITE(6,*) 'M',M
 200              CONTINUE
                  IF (NJA.LT.M) THEN
                     NJA=NJA+100
                     SEGADJ PMORS
                     GOTO 200
                  END IF
c                  WRITE(6,*) 'PRI',PRI,'MINCP.NPOS(PRI)',
c     &                 MINCP.NPOS(PRI),
c     &               'MINCP.MPOS(PRI,K)',MINCP.MPOS(PRI,K)
 350              CONTINUE
                  IF (MINCP.MPOS(PRI,KK).EQ.0) THEN
                     KK=KK+1
                     GOTO 350
                  END IF

                  PRI=MINCP.NPOS(PRI)+MINCP.MPOS(PRI,KK)-1
c                  WRITE(6,*) 'M',M,'PRI',PRI
                  MAXPRI=MAX(MAXPRI,PRI)
                  JA(M)=PRI
               END DO
            END DO
         END DO
      END DO


      NTT=MAXDUA
      NJA=M

      SEGADJ PMORS
C     On oublie pas le dernier
      IA(MAXDUA+1)=M+1

      SEGDES PMORS
      SEGDES MINCP,MINCD
      SEGSUP ASSTAB

      IRIGEL(5,LL)=PMORS
      KNTTP=MAXPRI
      KNTTD=MAXDUA
      SEGDES MATRIK
      RETURN

      END