Télécharger la plaquette Cast3M


fr en

Télécharger elmors.eso

Retour à la liste

Numérotation des lignes : 

elmors

  1. C ELMORS    SOURCE    PV        20/09/26    21:16:41     10724          
  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     *************************************************
  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.  
  28.       CALL KMORS(ASSTAB,MATRIK,L)
  29.  
  30. C     *************************************
  31. C     On Rempli les segments MINCP et MINCD
  32. C     pour le MATRIK
  33. C     *************************************
  34.  
  35.       SEGACT MATRIK*MOD
  36.  
  37.       IF (IRIGEL(7,L).NE.6) THEN
  38.          MELEMP=IRIGEL(1,L)
  39.          MELEMD=IRIGEL(2,L)
  40.          IMATRI=IRIGEL(4,L)
  41.  
  42.          SEGACT IMATRI
  43. C     On recupere le nombre de composante de la matrice et
  44. C     le nombre de noeuds primaux NPTP et duaux NPTD
  45.  
  46.          NBSOUS=LIZAFM(/1)
  47.          NBME=LIZAFM(/2)
  48.          SPGP=KSPGP
  49.          SPGD=KSPGD
  50.          IF (NBSOUS.EQ.0) NBSOUS=1
  51.  
  52.          SEGACT SPGP,SPGD
  53.          NPTP=SPGP.NUM(/2)
  54.          NPTD=SPGD.NUM(/2)
  55.          SEGDES SPGP,SPGD
  56.  
  57. C     ***********************************************
  58. C     On rempli a present les segments MINCP et MINCD
  59. C     pour le calcul du profil morse
  60. C     ***********************************************
  61.  
  62.          NBI=NBME
  63.          NPT=NPTP
  64.          SEGINI MINCP
  65.  
  66. C     ******** MINCP **************
  67.          LINC1=0
  68.          DO I=1,NBME
  69.             IFLAG=0
  70.             DO J=1,LINC1
  71.                IF (MINCP.LISINC(J).EQ.LISPRI(I)) IFLAG=1
  72.             END DO
  73.  
  74.             IF (IFLAG.EQ.0) THEN
  75.                LINC1=LINC1+1
  76.                MINCP.LISINC(LINC1)=LISPRI(I)
  77.             END IF
  78.          END DO
  79.          NBI=LINC1
  80.          SEGADJ MINCP
  81.  
  82.          NBI=NBME
  83.          NPT=NPTD
  84.          SEGINI MINCD
  85. C     ******** MINCD **************
  86.          LINC2=0
  87.          DO I=1,NBME
  88.             IFLAG=0
  89.             DO J=1,LINC2
  90.                IF (MINCD.LISINC(J).EQ.LISDUA(I)) IFLAG=1
  91.             END DO
  92.  
  93.             IF (IFLAG.EQ.0) THEN
  94.                LINC2=LINC2+1
  95.                MINCD.LISINC(LINC2)=LISDUA(I)
  96.             END IF
  97.          END DO
  98.          NBI=LINC2
  99.          SEGADJ MINCD
  100.  
  101. C     ******************************
  102. C     On rempli les tableaux MPOS et
  103. C     NPOS des segements MINCP et
  104. C     MINCD
  105. C     ******************************
  106.  
  107.          MINCP.NPOS(1)=1
  108.          DO I=1,NPTP
  109.             DO J=1,LINC1
  110.                MINCP.MPOS(I,J)=J
  111.             END DO
  112.             MINCP.MPOS(I,LINC1+1)=LINC1
  113.             MINCP.NPOS(I+1)=MINCP.NPOS(I)+LINC1
  114.          END DO
  115.  
  116.          MINCD.NPOS(1)=1
  117.          DO I=1,NPTD
  118.             DO J=1,LINC2
  119.                MINCD.MPOS(I,J)=J
  120.             END DO
  121.             MINCD.MPOS(I,LINC2+1)=LINC2
  122.             MINCD.NPOS(I+1)=MINCD.NPOS(I)+LINC2
  123.          END DO
  124.  
  125.          SEGDES MINCP,MINCD
  126.          SEGDES IMATRI
  127.       END IF
  128.  
  129.       KMINCP=MINCP
  130.       KMINCD=MINCD
  131.       SEGDES MATRIK
  132.  
  133.       CALL PFMORS(ASSTAB,MATRIK,L)
  134.       CALL ASSMOR(MATRIK,L)
  135.  
  136.       CALL OPTIM(MATRIK,L)
  137.       SEGACT MATRIK*MOD
  138.       SEGACT IMATRI
  139.       IRIGEL(1,L)=KSPGP
  140.       IRIGEL(2,L)=KSPGD
  141.       IRIGEL(7,L)=6
  142.       SEGDES IMATRI
  143.       SEGDES MATRIK
  144.  
  145.       RETURN
  146.       END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales