Télécharger exmlli.eso

Retour à la liste

Numérotation des lignes :

exmlli
  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.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMLENTI
  38. POINTEUR LELEM.MLENTI
  39. POINTEUR RPMAIL.MLENTI
  40. -INC SMELEME
  41. POINTEUR MAIL.MELEME
  42. POINTEUR SOUMAI.MELEME
  43. * Includes persos
  44. * Segment LSTIND (liste séquentielle indexée)
  45. SEGMENT LSTIND
  46. INTEGER IDX(NBM+1)
  47. INTEGER IVAL(NBTVAL)
  48. ENDSEGMENT
  49. INTEGER NBM,NBTVAL
  50. POINTEUR LSTXML.LSTIND
  51. *
  52. INTEGER IMPR,IRET
  53. *
  54. INTEGER NELEM,NNO
  55. INTEGER IELEM,INO,IVXML
  56. INTEGER NOSOMA,NUELEM,NUELMA,NUNO
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exmlli.eso'
  61. CALL ACTMEL(MAIL)
  62. CALL INIRPL(MAIL,
  63. $ RPMAIL,
  64. $ IMPR,IRET)
  65. IF (IRET.NE.0) GOTO 9999
  66. * Dimensionnement de LSTXML
  67. SEGACT LELEM
  68. NELEM=LELEM.LECT(/1)
  69. NBM=NELEM
  70. NBTVAL=0
  71. SEGINI LSTXML
  72. SEGACT RPMAIL
  73. DO 1 IELEM=1,NELEM
  74. NUELEM=LELEM.LECT(IELEM)
  75. CALL RPELEM(NUELEM,RPMAIL,
  76. $ NOSOMA,NUELMA,
  77. $ IMPR,IRET)
  78. IF (IRET.NE.0) GOTO 9999
  79. IF (NOSOMA.NE.0) THEN
  80. SOUMAI=MAIL.LISOUS(NOSOMA)
  81. ELSE
  82. SOUMAI=MAIL
  83. ENDIF
  84. NNO=SOUMAI.NUM(/1)
  85. LSTXML.IDX(IELEM+1)=NNO
  86. 1 CONTINUE
  87. * LSTXML.IDX est transformé en la liste d'indexation sur
  88. * LSTXML.IVAL
  89. LSTXML.IDX(1)=1
  90. DO 3 IELEM=1,NELEM
  91. LSTXML.IDX(IELEM+1)=LSTXML.IDX(IELEM+1)+LSTXML.IDX(IELEM)
  92. 3 CONTINUE
  93. NBM=NELEM
  94. NBTVAL=LSTXML.IDX(NELEM+1)-1
  95. SEGADJ,LSTXML
  96. * Remplissage de LSTXML
  97. IVXML=0
  98. DO 5 IELEM=1,NELEM
  99. NUELEM=LELEM.LECT(IELEM)
  100. CALL RPELEM(NUELEM,RPMAIL,
  101. $ NOSOMA,NUELMA,
  102. $ IMPR,IRET)
  103. IF (IRET.NE.0) GOTO 9999
  104. IF (NOSOMA.NE.0) THEN
  105. SOUMAI=MAIL.LISOUS(NOSOMA)
  106. ELSE
  107. SOUMAI=MAIL
  108. ENDIF
  109. NNO=SOUMAI.NUM(/1)
  110. DO 52 INO=1,NNO
  111. IVXML=IVXML+1
  112. NUNO=SOUMAI.NUM(INO,NUELMA)
  113. LSTXML.IVAL(IVXML)=NUNO
  114. 52 CONTINUE
  115. 5 CONTINUE
  116. SEGSUP RPMAIL
  117. SEGDES LSTXML
  118. SEGDES LELEM
  119. CALL DESMEL(MAIL)
  120. *
  121. * Normal termination
  122. *
  123. IRET=0
  124. RETURN
  125. *
  126. * Format handling
  127. *
  128. *
  129. * Error handling
  130. *
  131. 9999 CONTINUE
  132. IRET=1
  133. WRITE(IOIMP,*) 'An error was detected in subroutine exmlli'
  134. RETURN
  135. *
  136. * End of subroutine EXMLLI
  137. *
  138. END
  139.  
  140.  
  141.  
  142.  

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