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. -INC CCOPTIO
  41. -INC SMELEME
  42. -INC SMLENTI
  43. POINTEUR PONBEL.MLENTI
  44. POINTEUR MTYPL.MLENTI
  45. *
  46. * Segment MLELEM
  47. *
  48. SEGMENT MLELEM
  49. INTEGER INDEX(NBL+1)
  50. INTEGER LESPOI(NBTPOI)
  51. ENDSEGMENT
  52. *
  53. * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  54. *
  55. * NBL : NOMBRE D'ELEMENTS
  56. * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES
  57. * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  58. * DANS LE TABLEAU LESPOI
  59. * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  60. * DU IEME ELEMENT
  61. *
  62. INTEGER IMPR,IRET
  63. INTEGER MAXPOI,NTYPL
  64. *
  65. * Executable statements
  66. *
  67. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans le2mel.eso'
  68. SEGACT MLELEM
  69. NBL=INDEX(/1)-1
  70. *
  71. * On construit le tableau temporaire PONBEL tel que :
  72. * PONBEL(I) : NOMBRE DE POINTS DU IEME ELEMENT DE MLELEM
  73. *
  74. * On calcule aussi le maximum du nombre de points des éléments de
  75. * MLELEM.
  76. *
  77. JG=NBL
  78. SEGINI PONBEL
  79. MAXPOI=0
  80. DO 1 INBL=1,NBL
  81. PONBEL.LECT(INBL)=INDEX(INBL+1)-INDEX(INBL)
  82. MAXPOI=MAX(MAXPOI,PONBEL.LECT(INBL))
  83. 1 CONTINUE
  84. *
  85. * Maintenant on détermine le nombre de sous-objets (LISOUS)
  86. * que devra comporter MELEME, cad le nombre de type d'éléments
  87. * différents (distingués par le nombre de noeuds)
  88. * MTYPL(NONOEU) contient le nombre d'éléments de MLELEM ayant
  89. * NONOEU noeuds (éventuellement nul).
  90. * NTYPL contient le nombre de type d'éléments différents
  91. * à créer.
  92. *
  93. JG=MAXPOI
  94. SEGINI MTYPL
  95. DO 2 INBL=1,NBL
  96. NONOEU=PONBEL.LECT(INBL)
  97. MTYPL.LECT(NONOEU)=MTYPL.LECT(NONOEU)+1
  98. 2 CONTINUE
  99. NTYPL=0
  100. DO 3 IMAXPO=1,MAXPOI
  101. IF (MTYPL.LECT(IMAXPO).NE.0) NTYPL=NTYPL+1
  102. 3 CONTINUE
  103. *
  104. * On construit le MELEME en distinguant le cas NTYPL=1...
  105. *
  106. IF (NTYPL.EQ.1) THEN
  107. NBSOUS=0
  108. NBNN=MAXPOI
  109. NBELEM=NBL
  110. NBREF=0
  111. SEGINI MELEME
  112. * Type d'élément : POLY (cf. bdata.eso)
  113. ITYPEL=32
  114. DO 5 INBEL=1,NBL
  115. IDELEM=INDEX(INBEL)-1
  116. DO 52 INBNN=1,MAXPOI
  117. NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN)
  118. 52 CONTINUE
  119. 5 CONTINUE
  120. SEGDES MELEME
  121. ELSE
  122. NBSOUS=NTYPL
  123. NBNN=0
  124. NBELEM=0
  125. NBREF=0
  126. SEGINI MELEME
  127. NBNOEU=0
  128. DO 7 INBSO=1,NTYPL
  129. * On cherche le nombre de noeuds du type d'éléments suivant
  130. NBNOEU=NBNOEU+1
  131. 72 CONTINUE
  132. IF (MTYPL.LECT(NBNOEU).EQ.0) THEN
  133. NBNOEU=NBNOEU+1
  134. GOTO 72
  135. ENDIF
  136. NBSOUS=0
  137. * On stockera le sommet en premier
  138. NBNN=NBNOEU
  139. NBELEM=MTYPL.LECT(NBNOEU)
  140. NBREF=0
  141. SEGINI IPT1
  142. IPT1.ITYPEL=32
  143. IELEM=0
  144. DO 74 INBEL=1,NBELEM
  145. IELEM=IELEM+1
  146. 742 CONTINUE
  147. IF (PONBEL.LECT(IELEM).NE.NBNOEU) THEN
  148. IELEM=IELEM+1
  149. GOTO 742
  150. ENDIF
  151. IDELEM=INDEX(IELEM)-1
  152. DO 744 INBNN=1,NBNN
  153. IPT1.NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN)
  154. 744 CONTINUE
  155. 74 CONTINUE
  156. SEGDES IPT1
  157. MELEME.LISOUS(INBSO)=IPT1
  158. 7 CONTINUE
  159. SEGDES MELEME
  160. ENDIF
  161. SEGSUP MTYPL
  162. SEGDES MLELEM
  163. SEGDES PONBEL
  164. IF (IMPR.GT.2) THEN
  165. WRITE(IOIMP,*) 'On a créé MELEME=',MELEME
  166. IF (IMPR.GT.3) THEN
  167. CALL ECROBJ('MAILLAGE',MELEME)
  168. CALL PRLIST
  169. ENDIF
  170. ENDIF
  171. *
  172. * Normal termination
  173. *
  174. IRET=0
  175. RETURN
  176. *
  177. * Format handling
  178. *
  179. 4000 FORMAT (A,'(1..',I8,')')
  180. 5000 FORMAT (8(1X,I8))
  181. *
  182. * Error handling
  183. *
  184. 9999 CONTINUE
  185. IRET=1
  186. WRITE(IOIMP,*) 'An error was detected in subroutine le2mel'
  187. RETURN
  188. *
  189. * End of subroutine LE2MEL
  190. *
  191. END
  192.  
  193.  
  194.  
  195.  
  196.  

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