Télécharger le2mel.eso

Retour à la liste

Numérotation des lignes :

  1. C LE2MEL SOURCE CHAT 05/01/13 01:14:20 5004
  2. SUBROUTINE LE2MEL(MLELEM,MELEME,IMPR,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : LE2MEL
  7. C DESCRIPTION : Construit un MELEME d'éléments POLY à
  8. C partir d'une liste séquentielle indexée d'éléments
  9. C voir le segment MLELEM
  10. C En gros, on regroupe les éléments qui ont le meme
  11. C nombre de points.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : -
  18. C APPELES (E/S) : ECROBJ, PRLIST (opérateur 'LIST')
  19. C APPELES (BLAS) : -
  20. C APPELES (CALCUL) : -
  21. C APPELE PAR : POIELE, ELPOEL
  22. C***********************************************************************
  23. C SYNTAXE GIBIANE : -
  24. C ENTREES : MLELEM (type MLELEM) : liste séquentielle
  25. C indexée d'éléments
  26. C ENTREES/SORTIES : -
  27. C SORTIES : MELEME ( " MELEME) : maillage de POLY
  28. C associé aux entrées.
  29. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30. C***********************************************************************
  31. C VERSION : v1, 08/10/98, version initiale
  32. C HISTORIQUE : v1, 08/10/98, création
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37. C en cas de modification de ce sous-programme afin de faciliter
  38. C la maintenance !
  39. C***********************************************************************
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC SMELEME
  44. -INC SMLENTI
  45. POINTEUR PONBEL.MLENTI
  46. POINTEUR MTYPL.MLENTI
  47. *
  48. * Segment MLELEM
  49. *
  50. SEGMENT MLELEM
  51. INTEGER INDEX(NBL+1)
  52. INTEGER LESPOI(NBTPOI)
  53. ENDSEGMENT
  54. *
  55. * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  56. *
  57. * NBL : NOMBRE D'ELEMENTS
  58. * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES
  59. * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  60. * DANS LE TABLEAU LESPOI
  61. * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  62. * DU IEME ELEMENT
  63. *
  64. INTEGER IMPR,IRET
  65. INTEGER MAXPOI,NTYPL
  66. *
  67. * Executable statements
  68. *
  69. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans le2mel.eso'
  70. SEGACT MLELEM
  71. NBL=INDEX(/1)-1
  72. *
  73. * On construit le tableau temporaire PONBEL tel que :
  74. * PONBEL(I) : NOMBRE DE POINTS DU IEME ELEMENT DE MLELEM
  75. *
  76. * On calcule aussi le maximum du nombre de points des éléments de
  77. * MLELEM.
  78. *
  79. JG=NBL
  80. SEGINI PONBEL
  81. MAXPOI=0
  82. DO 1 INBL=1,NBL
  83. PONBEL.LECT(INBL)=INDEX(INBL+1)-INDEX(INBL)
  84. MAXPOI=MAX(MAXPOI,PONBEL.LECT(INBL))
  85. 1 CONTINUE
  86. *
  87. * Maintenant on détermine le nombre de sous-objets (LISOUS)
  88. * que devra comporter MELEME, cad le nombre de type d'éléments
  89. * différents (distingués par le nombre de noeuds)
  90. * MTYPL(NONOEU) contient le nombre d'éléments de MLELEM ayant
  91. * NONOEU noeuds (éventuellement nul).
  92. * NTYPL contient le nombre de type d'éléments différents
  93. * à créer.
  94. *
  95. JG=MAXPOI
  96. SEGINI MTYPL
  97. DO 2 INBL=1,NBL
  98. NONOEU=PONBEL.LECT(INBL)
  99. MTYPL.LECT(NONOEU)=MTYPL.LECT(NONOEU)+1
  100. 2 CONTINUE
  101. NTYPL=0
  102. DO 3 IMAXPO=1,MAXPOI
  103. IF (MTYPL.LECT(IMAXPO).NE.0) NTYPL=NTYPL+1
  104. 3 CONTINUE
  105. *
  106. * On construit le MELEME en distinguant le cas NTYPL=1...
  107. *
  108. IF (NTYPL.EQ.1) THEN
  109. NBSOUS=0
  110. NBNN=MAXPOI
  111. NBELEM=NBL
  112. NBREF=0
  113. SEGINI MELEME
  114. * Type d'élément : POLY (cf. bdata.eso)
  115. ITYPEL=32
  116. DO 5 INBEL=1,NBL
  117. IDELEM=INDEX(INBEL)-1
  118. DO 52 INBNN=1,MAXPOI
  119. NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN)
  120. 52 CONTINUE
  121. 5 CONTINUE
  122. SEGDES MELEME
  123. ELSE
  124. NBSOUS=NTYPL
  125. NBNN=0
  126. NBELEM=0
  127. NBREF=0
  128. SEGINI MELEME
  129. NBNOEU=0
  130. DO 7 INBSO=1,NTYPL
  131. * On cherche le nombre de noeuds du type d'éléments suivant
  132. NBNOEU=NBNOEU+1
  133. 72 CONTINUE
  134. IF (MTYPL.LECT(NBNOEU).EQ.0) THEN
  135. NBNOEU=NBNOEU+1
  136. GOTO 72
  137. ENDIF
  138. NBSOUS=0
  139. * On stockera le sommet en premier
  140. NBNN=NBNOEU
  141. NBELEM=MTYPL.LECT(NBNOEU)
  142. NBREF=0
  143. SEGINI IPT1
  144. IPT1.ITYPEL=32
  145. IELEM=0
  146. DO 74 INBEL=1,NBELEM
  147. IELEM=IELEM+1
  148. 742 CONTINUE
  149. IF (PONBEL.LECT(IELEM).NE.NBNOEU) THEN
  150. IELEM=IELEM+1
  151. GOTO 742
  152. ENDIF
  153. IDELEM=INDEX(IELEM)-1
  154. DO 744 INBNN=1,NBNN
  155. IPT1.NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN)
  156. 744 CONTINUE
  157. 74 CONTINUE
  158. SEGDES IPT1
  159. MELEME.LISOUS(INBSO)=IPT1
  160. 7 CONTINUE
  161. SEGDES MELEME
  162. ENDIF
  163. SEGSUP MTYPL
  164. SEGDES MLELEM
  165. SEGDES PONBEL
  166. IF (IMPR.GT.2) THEN
  167. WRITE(IOIMP,*) 'On a créé MELEME=',MELEME
  168. IF (IMPR.GT.3) THEN
  169. CALL ECROBJ('MAILLAGE',MELEME)
  170. CALL PRLIST
  171. ENDIF
  172. ENDIF
  173. *
  174. * Normal termination
  175. *
  176. IRET=0
  177. RETURN
  178. *
  179. * Format handling
  180. *
  181. 4000 FORMAT (A,'(1..',I8,')')
  182. 5000 FORMAT (8(1X,I8))
  183. *
  184. * Error handling
  185. *
  186. 9999 CONTINUE
  187. IRET=1
  188. WRITE(IOIMP,*) 'An error was detected in subroutine le2mel'
  189. RETURN
  190. *
  191. * End of subroutine LE2MEL
  192. *
  193. END
  194.  
  195.  
  196.  
  197.  
  198.  

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