Télécharger elmors.eso

Retour à la liste

Numérotation des lignes :

  1. C ELMORS SOURCE PV 16/11/17 21:59:17 9180
  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 SMELEME
  11. POINTEUR SPGP.MELEME,SPGD.MELEME
  12. POINTEUR MELEMP.MELEME, MELEMD.MELEME
  13.  
  14. -INC SMLENTI
  15. POINTEUR IPADP.MLENTI,IPADD.MLENTI
  16.  
  17. SEGMENT ASSTAB
  18. INTEGER ITAB(NBCOMP,NTA)
  19. ENDSEGMENT
  20.  
  21. C **********************************
  22. C On rempli le tableau ASSTAB qui
  23. C contient le preassemblage en morse
  24. C de la matrice
  25. C **********************************
  26.  
  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.  
  132. CALL PFMORS(ASSTAB,MATRIK,L)
  133. CALL ASSMOR(MATRIK,L)
  134.  
  135. CALL OPTIM(MATRIK,L)
  136. SEGACT MATRIK*MOD
  137. SEGACT IMATRI
  138. IRIGEL(1,L)=KSPGP
  139. IRIGEL(2,L)=KSPGD
  140. IRIGEL(7,L)=6
  141. SEGDES IMATRI
  142. SEGDES MATRIK
  143.  
  144. RETURN
  145. END
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  

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