Télécharger exmlli.eso

Retour à la liste

Numérotation des lignes :

  1. C EXMLLI SOURCE CHAT 05/01/12 23:51:08 5004
  2. SUBROUTINE EXMLLI(MAIL,LELEM,
  3. $ LSTXML,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : EXMLLI
  9. C DESCRIPTION : Extraction d'éléments d'un maillage que l'on stocke dans
  10. C une liste indexée.
  11. C LELEM est supposée ordonnée.
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES : ACTMEL, DESMEL, INIRPL, RPELEM
  19. C APPELE PAR : ML2LIE
  20. C***********************************************************************
  21. C ENTREES : MAIL, LELEM
  22. C SORTIES : LSTXML
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION : v1, 08/02/2000, version initiale
  26. C HISTORIQUE : v1, 08/02/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. -INC CCOPTIO
  35. -INC SMLENTI
  36. POINTEUR LELEM.MLENTI
  37. POINTEUR RPMAIL.MLENTI
  38. -INC SMELEME
  39. POINTEUR MAIL.MELEME
  40. POINTEUR SOUMAI.MELEME
  41. * Includes persos
  42. * Segment LSTIND (liste séquentielle indexée)
  43. SEGMENT LSTIND
  44. INTEGER IDX(NBM+1)
  45. INTEGER IVAL(NBTVAL)
  46. ENDSEGMENT
  47. INTEGER NBM,NBTVAL
  48. POINTEUR LSTXML.LSTIND
  49. *
  50. INTEGER IMPR,IRET
  51. *
  52. INTEGER NELEM,NNO
  53. INTEGER IELEM,INO,IVXML
  54. INTEGER NOSOMA,NUELEM,NUELMA,NUNO
  55. *
  56. * Executable statements
  57. *
  58. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exmlli.eso'
  59. CALL ACTMEL(MAIL)
  60. CALL INIRPL(MAIL,
  61. $ RPMAIL,
  62. $ IMPR,IRET)
  63. IF (IRET.NE.0) GOTO 9999
  64. * Dimensionnement de LSTXML
  65. SEGACT LELEM
  66. NELEM=LELEM.LECT(/1)
  67. NBM=NELEM
  68. NBTVAL=0
  69. SEGINI LSTXML
  70. SEGACT RPMAIL
  71. DO 1 IELEM=1,NELEM
  72. NUELEM=LELEM.LECT(IELEM)
  73. CALL RPELEM(NUELEM,RPMAIL,
  74. $ NOSOMA,NUELMA,
  75. $ IMPR,IRET)
  76. IF (IRET.NE.0) GOTO 9999
  77. IF (NOSOMA.NE.0) THEN
  78. SOUMAI=MAIL.LISOUS(NOSOMA)
  79. ELSE
  80. SOUMAI=MAIL
  81. ENDIF
  82. NNO=SOUMAI.NUM(/1)
  83. LSTXML.IDX(IELEM+1)=NNO
  84. 1 CONTINUE
  85. * LSTXML.IDX est transformé en la liste d'indexation sur
  86. * LSTXML.IVAL
  87. LSTXML.IDX(1)=1
  88. DO 3 IELEM=1,NELEM
  89. LSTXML.IDX(IELEM+1)=LSTXML.IDX(IELEM+1)+LSTXML.IDX(IELEM)
  90. 3 CONTINUE
  91. NBM=NELEM
  92. NBTVAL=LSTXML.IDX(NELEM+1)-1
  93. SEGADJ,LSTXML
  94. * Remplissage de LSTXML
  95. IVXML=0
  96. DO 5 IELEM=1,NELEM
  97. NUELEM=LELEM.LECT(IELEM)
  98. CALL RPELEM(NUELEM,RPMAIL,
  99. $ NOSOMA,NUELMA,
  100. $ IMPR,IRET)
  101. IF (IRET.NE.0) GOTO 9999
  102. IF (NOSOMA.NE.0) THEN
  103. SOUMAI=MAIL.LISOUS(NOSOMA)
  104. ELSE
  105. SOUMAI=MAIL
  106. ENDIF
  107. NNO=SOUMAI.NUM(/1)
  108. DO 52 INO=1,NNO
  109. IVXML=IVXML+1
  110. NUNO=SOUMAI.NUM(INO,NUELMA)
  111. LSTXML.IVAL(IVXML)=NUNO
  112. 52 CONTINUE
  113. 5 CONTINUE
  114. SEGSUP RPMAIL
  115. SEGDES LSTXML
  116. SEGDES LELEM
  117. CALL DESMEL(MAIL)
  118. *
  119. * Normal termination
  120. *
  121. IRET=0
  122. RETURN
  123. *
  124. * Format handling
  125. *
  126. *
  127. * Error handling
  128. *
  129. 9999 CONTINUE
  130. IRET=1
  131. WRITE(IOIMP,*) 'An error was detected in subroutine exmlli'
  132. RETURN
  133. *
  134. * End of subroutine EXMLLI
  135. *
  136. END
  137.  
  138.  
  139.  
  140.  

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