Esope source files

   1 : C PFMORS    SOURCE    MAGN      09/07/30    21:19:46     6458           
   2 :       SUBROUTINE PFMORS(ASSTAB,MATRIK,LL)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C     ******************************************
   6 : C     * Subroutine calculant le profil morse   *
   7 : C     * a partir de ASSTAB                     *
   8 : C     * Entree /Sortie : MATRIK                *
   9 : C     * Sortie : ASSTAB                        *
  10 : C     ******************************************
  11 : 
  12 : -INC SMMATRIK
  13 : 
  14 :       SEGMENT ASSTAB
  15 :       INTEGER ITAB(NBCOMP,NTA)
  16 :       ENDSEGMENT
  17 : 
  18 :       INTEGER DUA,PRI,MAXDUA,MAXPRI
  19 : 
  20 :       SEGACT MATRIK*MOD
  21 :       SEGACT ASSTAB
  22 : 
  23 :       NBCOMP=ITAB(/1)
  24 :       NTA=ITAB(/2)
  25 : 
  26 :       MINCP=KMINCP
  27 :       MINCD=KMINCD
  28 : 
  29 :       SEGACT MINCP,MINCD
  30 :       NPTP=MINCP.MPOS(/1)
  31 :       NPTD=MINCD.MPOS(/1)
  32 :       NBIP=MINCP.MPOS(/2)-1
  33 :       NBID=MINCD.MPOS(/2)-1
  34 : 
  35 :       NTT=NPTD
  36 :       NJA=NPTP
  37 : C     On initialise le segment PMORS
  38 :       SEGINI PMORS
  39 : 
  40 :       M=0
  41 :       MAXPRI=0
  42 :       MAXDUA=0
  43 : 
  44 : 
  45 :       DO I=1,NTA
  46 :          NB=ITAB(1,I)
  47 :          NINCD=MINCD.NPOS(I+1)-MINCD.NPOS(I)
  48 :          
  49 : c         WRITE(6,*) 'NINCD',NINCD
  50 :          LLL=0
  51 :          DO L=1,NINCD
  52 :             LLL=LLL+1
  53 :  300        CONTINUE
  54 :             IF (MINCD.MPOS(I,LLL).EQ.0) THEN
  55 :                LLL=LLL+1
  56 :                GOTO 300
  57 :             END IF
  58 :             DUA=MINCD.NPOS(I)+MINCD.MPOS(I,LLL)-1
  59 :             MAXDUA=MAX(DUA,MAXDUA)
  60 :             
  61 :  100        CONTINUE
  62 :             IF (NTT.LT.DUA) THEN
  63 :                NTT=NTT+100
  64 :                SEGADJ PMORS
  65 :                GOTO 100
  66 :             END IF
  67 : c            WRITE(6,*) 'DUA',DUA,'M',M
  68 :             IA(DUA)=M+1
  69 : c            WRITE(6,*) 'NB', NB
  70 :             
  71 :             DO J=1,NB
  72 : c               WRITE(6,*) 'J',J,'I',I
  73 :                PRI=ITAB(J+1,I)
  74 : c               WRITE(6,*) 'PRI',PRI,'NINCP',MINCP.NPOS(PRI+1)-
  75 : c     &              MINCP.NPOS(PRI)
  76 :                NINCP=MINCP.NPOS(PRI+1)-MINCP.NPOS(PRI)
  77 : 
  78 :                KK=0
  79 :                DO K=1,NINCP
  80 :                   KK=KK+1
  81 :                   PRI=ITAB(J+1,I)    
  82 :                   M=M+1
  83 : c                  WRITE(6,*) 'M',M
  84 :  200              CONTINUE
  85 :                   IF (NJA.LT.M) THEN
  86 :                      NJA=NJA+100
  87 :                      SEGADJ PMORS
  88 :                      GOTO 200
  89 :                   END IF
  90 : c                  WRITE(6,*) 'PRI',PRI,'MINCP.NPOS(PRI)',
  91 : c     &                 MINCP.NPOS(PRI),
  92 : c     &               'MINCP.MPOS(PRI,K)',MINCP.MPOS(PRI,K)  
  93 :  350              CONTINUE
  94 :                   IF (MINCP.MPOS(PRI,KK).EQ.0) THEN
  95 :                      KK=KK+1
  96 :                      GOTO 350
  97 :                   END IF
  98 : 
  99 :                   PRI=MINCP.NPOS(PRI)+MINCP.MPOS(PRI,KK)-1
 100 : c                  WRITE(6,*) 'M',M,'PRI',PRI
 101 :                   MAXPRI=MAX(MAXPRI,PRI)
 102 :                   JA(M)=PRI
 103 :                END DO
 104 :             END DO
 105 :          END DO
 106 :       END DO
 107 : 
 108 : 
 109 :       NTT=MAXDUA
 110 :       NJA=M
 111 : 
 112 :       SEGADJ PMORS
 113 : C     On oublie pas le dernier
 114 :       IA(MAXDUA+1)=M+1
 115 : 
 116 :       SEGDES PMORS
 117 :       SEGDES MINCP,MINCD
 118 :       SEGSUP ASSTAB
 119 : 
 120 :       IRIGEL(5,LL)=PMORS
 121 :       KNTTP=MAXPRI
 122 :       KNTTD=MAXDUA
 123 :       SEGDES MATRIK
 124 :       RETURN
 125 : 
 126 :       END
 127 :  
 128 :  
 129 :