Esope source files

   1 : C ELMORS    SOURCE    MAGN      09/07/30    21:16:50     6458           
   2 :       SUBROUTINE ELMORS(MATRIK,L)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C     *************************************************
   6 : C     MATRIK contient la matrice a transformer en morse
   7 : C     L est le numero de la matrice dans MATRIK a
   8 : C     transformer.
   9 : C     *************************************************
  10 : -INC SMMATRIK
  11 : -INC SMELEME
  12 :       POINTEUR SPGP.MELEME,SPGD.MELEME
  13 :       POINTEUR MELEMP.MELEME, MELEMD.MELEME
  14 :       
  15 : -INC SMLENTI
  16 :       POINTEUR IPADP.MLENTI,IPADD.MLENTI
  17 : 
  18 :       SEGMENT ASSTAB
  19 :       INTEGER ITAB(NBCOMP,NTA)
  20 :       ENDSEGMENT
  21 : 
  22 : C     **********************************
  23 : C     On rempli le tableau ASSTAB qui
  24 : C     contient le preassemblage en morse
  25 : C     de la matrice
  26 : C     **********************************
  27 : 
  27 :       CALL KMORS(ASSTAB,MATRIK,L)
  28 : 
  29 : C     *************************************
  30 : C     On Rempli les segments MINCP et MINCD
  31 : C     pour le MATRIK
  32 : C     *************************************
  33 : 
  34 :       SEGACT MATRIK*MOD
  35 : 
  36 :       IF (IRIGEL(7,L).NE.6) THEN
  37 :          MELEMP=IRIGEL(1,L)
  38 :          MELEMD=IRIGEL(2,L)
  39 :          IMATRI=IRIGEL(4,L)
  40 : 
  41 :          SEGACT IMATRI
  42 : C     On recupere le nombre de composante de la matrice et
  43 : C     le nombre de noeuds primaux NPTP et duaux NPTD
  44 : 
  45 :          NBSOUS=LIZAFM(/1)
  46 :          NBME=LIZAFM(/2)
  47 :          SPGP=KSPGP
  48 :          SPGD=KSPGD
  49 :          IF (NBSOUS.EQ.0) NBSOUS=1
  50 : 
  51 :          SEGACT SPGP,SPGD
  52 :          NPTP=SPGP.NUM(/2)
  53 :          NPTD=SPGD.NUM(/2)
  54 :          SEGDES SPGP,SPGD
  55 : 
  56 : C     ***********************************************
  57 : C     On rempli a present les segments MINCP et MINCD
  58 : C     pour le calcul du profil morse
  59 : C     ***********************************************
  60 : 
  61 :          NBI=NBME
  62 :          NPT=NPTP
  63 :          SEGINI MINCP
  64 : 
  65 : C     ******** MINCP **************
  66 :          LINC1=0
  67 :          DO I=1,NBME
  68 :             IFLAG=0
  69 :             DO J=1,LINC1
  70 :                IF (MINCP.LISINC(J).EQ.LISPRI(I)) IFLAG=1
  71 :             END DO
  72 : 
  73 :             IF (IFLAG.EQ.0) THEN
  74 :                LINC1=LINC1+1
  75 :                MINCP.LISINC(LINC1)=LISPRI(I)
  76 :             END IF
  77 :          END DO
  78 :          NBI=LINC1
  79 :          SEGADJ MINCP
  80 : 
  81 :          NBI=NBME
  82 :          NPT=NPTD
  83 :          SEGINI MINCD
  84 : C     ******** MINCD **************
  85 :          LINC2=0
  86 :          DO I=1,NBME
  87 :             IFLAG=0
  88 :             DO J=1,LINC2
  89 :                IF (MINCD.LISINC(J).EQ.LISDUA(I)) IFLAG=1
  90 :             END DO
  91 : 
  92 :             IF (IFLAG.EQ.0) THEN
  93 :                LINC2=LINC2+1
  94 :                MINCD.LISINC(LINC2)=LISDUA(I)
  95 :             END IF
  96 :          END DO
  97 :          NBI=LINC2
  98 :          SEGADJ MINCD
  99 : 
 100 : C     ******************************
 101 : C     On rempli les tableaux MPOS et
 102 : C     NPOS des segements MINCP et 
 103 : C     MINCD
 104 : C     ******************************
 105 : 
 106 :          MINCP.NPOS(1)=1
 107 :          DO I=1,NPTP
 108 :             DO J=1,LINC1
 109 :                MINCP.MPOS(I,J)=J
 110 :             END DO
 111 :             MINCP.MPOS(I,LINC1+1)=LINC1
 112 :             MINCP.NPOS(I+1)=MINCP.NPOS(I)+LINC1
 113 :          END DO
 114 : 
 115 :          MINCD.NPOS(1)=1
 116 :          DO I=1,NPTD
 117 :             DO J=1,LINC2
 118 :                MINCD.MPOS(I,J)=J
 119 :             END DO
 120 :             MINCD.MPOS(I,LINC2+1)=LINC2
 121 :             MINCD.NPOS(I+1)=MINCD.NPOS(I)+LINC2
 122 :          END DO
 123 : 
 124 :          SEGDES MINCP,MINCD
 125 :          SEGDES IMATRI
 126 :       END IF
 127 : 
 128 :       KMINCP=MINCP
 129 :       KMINCD=MINCD
 130 :       SEGDES MATRIK
 131 : 
 131 :       CALL PFMORS(ASSTAB,MATRIK,L)
 131 :       CALL ASSMOR(MATRIK,L)
 132 :       
 132 :       CALL OPTIM(MATRIK,L)
 133 :       SEGACT MATRIK*MOD
 134 :       SEGACT IMATRI
 135 :       IRIGEL(1,L)=KSPGP
 136 :       IRIGEL(2,L)=KSPGD
 137 :       IRIGEL(7,L)=6
 138 :       SEGDES IMATRI
 139 :       SEGDES MATRIK
 140 : 
 141 :       RETURN
 142 :       END
 143 :  
 144 :  
 145 :