Télécharger rlexvc.eso

Retour à la liste

Numérotation des lignes :

  1. C RLEXVC SOURCE CHAT 05/01/13 03:03:19 5004
  2. SUBROUTINE RLEXVC(MELEMM,MELCEN,MELSOM,MLELEM)
  3. C
  4. C**** Variables de COOPTIO
  5. C
  6. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  7. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  8. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  9. C & ,IECHO, IIMPI, IOSPI
  10. C & ,IDIM
  11. C & ,MCOORD
  12. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  13. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  14. C & ,NORINC,NORVAL,NORIND,NORVAD
  15. C & ,NUCROU, IPSAUV
  16. C
  17. IMPLICIT INTEGER(I-N)
  18. INTEGER NSOMM, ICEN, NBSOUS, ISOUS, NBELEM, NBNO, IELEM, INOEU
  19. & , NLS1, NGS1, NGC, IPOS, NGC2
  20. C
  21. -INC SMELEME
  22. INTEGER JG
  23. -INC SMLENTI
  24. -INC CCOPTIO
  25. C
  26. INTEGER NBL, NBTPOI
  27. SEGMENT MLELEM
  28. INTEGER INDEX(NBL+1)
  29. INTEGER LESPOI(NBTPOI)
  30. ENDSEGMENT
  31. C
  32. POINTEUR MELSOM.MELEME, MELEMM.MELEME, MELCEN.MELEME
  33. & ,MLESOM.MLENTI, MTOUC.MLENTI, MLEMAI.MLENTI
  34. C
  35. C**** Le MELEME SOMMET
  36. C
  37. CALL KRIPAD(MELSOM,MLESOM)
  38. C
  39. C MLESOM: numerotation globale -> locale
  40. C
  41. C**** En KRIPAD
  42. C SEGACT MELSOM
  43. C SEGINI MLESOM
  44. C
  45. NSOMM = MELSOM.NUM(/2)
  46. JG=NSOMM
  47. SEGINI MTOUC
  48. C MTOUC.LECT(NLS1) = estimation de nombre des centres voisins de
  49. C NLS1
  50. SEGACT MELEMM
  51. NBSOUS=MELEMM.LISOUS(/1)
  52. C NBSOUS=0 fait un peux chier!
  53. JG=MAX(NBSOUS,1)
  54. SEGINI MLEMAI
  55. IF(NBSOUS .EQ. 0)THEN
  56. MLEMAI.LECT(1)=MELEMM
  57. ELSE
  58. DO ISOUS=1,NBSOUS,1
  59. MLEMAI.LECT(ISOUS)=MELEMM.LISOUS(ISOUS)
  60. ENDDO
  61. ENDIF
  62. SEGDES MELEMM
  63. C
  64. C**** Combien de fois chaque sommet est touché par un centre?
  65. C
  66. NBSOUS=JG
  67. NBTPOI=0
  68. DO ISOUS = 1, NBSOUS, 1
  69. MELEMM=MLEMAI.LECT(ISOUS)
  70. SEGACT MELEMM
  71. NBELEM=MELEMM.NUM(/2)
  72. NBNO=MELEMM.NUM(/1)
  73. DO IELEM = 1, NBELEM,1
  74. DO INOEU = 1, NBNO, 1
  75. NGS1 = MELEMM.NUM(INOEU,IELEM)
  76. NLS1 = MLESOM.LECT(NGS1)
  77. MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
  78. NBTPOI=NBTPOI+1
  79. ENDDO
  80. ENDDO
  81. ENDDO
  82. C
  83. NBL=NSOMM
  84. NBTPOI=NBTPOI+NSOMM
  85. SEGINI MLELEM
  86. C
  87. C**** Les sommets dedans MLELEM dans le meme ordre que dedans MLESOM
  88. C
  89. MLELEM.INDEX(1)=1
  90. DO IELEM=1, NBL, 1
  91. MLELEM.LESPOI(MLELEM.INDEX(IELEM))=MELSOM.NUM(1,IELEM)
  92. MLELEM.INDEX(IELEM+1)=MLELEM.INDEX(IELEM)+1+MTOUC.LECT(IELEM)
  93. MTOUC.LECT(IELEM)=0
  94. ENDDO
  95. C
  96. C**** MTOUC.LECT(IELEM)=0 \forall IELEM
  97. C
  98. ICEN = 0
  99. SEGACT MELCEN
  100. DO ISOUS = 1, NBSOUS, 1
  101. MELEMM=MLEMAI.LECT(ISOUS)
  102. NBELEM=MELEMM.NUM(/2)
  103. NBNO=MELEMM.NUM(/1)
  104. DO IELEM = 1, NBELEM,1
  105. ICEN=ICEN+1
  106. NGC=MELCEN.NUM(1,ICEN)
  107. DO INOEU = 1, NBNO, 1
  108. NGS1 = MELEMM.NUM(INOEU,IELEM)
  109. NLS1 = MLESOM.LECT(NGS1)
  110. MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
  111. IPOS = MLELEM.INDEX(NLS1)+MTOUC.LECT(NLS1)
  112. NGC2 = MLELEM.LESPOI(IPOS)
  113. IF(NGC2 .NE. 0)THEN
  114. WRITE(IOIMP,*) 'Subroutine rlexvc.eso'
  115. CALL ERREUR(5)
  116. GOTO 9999
  117. ELSE
  118. MLELEM.LESPOI(IPOS)=NGC
  119. ENDIF
  120. ENDDO
  121. ENDDO
  122. SEGDES MELEMM
  123. ENDDO
  124. C
  125. SEGDES MLELEM
  126. SEGDES MELCEN
  127. SEGDES MELSOM
  128. SEGSUP MTOUC
  129. SEGSUP MLESOM
  130. SEGSUP MLEMAI
  131. C
  132. 9999 RETURN
  133. END
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  

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