Télécharger elenbl.eso

Retour à la liste

Numérotation des lignes :

  1. C ELENBL SOURCE CHAT 05/01/12 23:31:01 5004
  2. SUBROUTINE ELENBL(MCLAS,MCLPO1,MCENT,LEPOEL,
  3. $ ELNBEL,IMPR,IRET)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM : ELENBL
  8. C DESCRIPTION : Construit une liste d'entiers : ELNBEL (type MLENTI)
  9. * NOCENT : indice du centre de l'élément considéré dans MCENT
  10. * ELNBEL(NOCENT) : nombre d'éléments partageant (au moins)
  11. * un point de MCLPO1 avec l'élément considéré.
  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 : KRIPAD : MELEME -> (num. globale->locale)
  18. C APPELES (E/S) : -
  19. C APPELES (BLAS) : -
  20. C APPELES (CALCUL) : -
  21. C APPELE PAR : ELPOEL
  22. C***********************************************************************
  23. C SYNTAXE GIBIANE : -
  24. C ENTREES : MCLAS (type MELEME) : maillage de classe de
  25. C points (sommet, face) par
  26. C élément (MMAIL,ELTFA)
  27. C MCLPO1 (type MELEME) : maillage de points
  28. C correspondant à MCLAS
  29. C MCENT (type MELEME) : maillage des centres de
  30. C MCLAS
  31. C LEPOEL (type MLELEM) :
  32. * NOPOI1 : indice du point considéré dans MCLPO1
  33. * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)) :
  34. * contient le numéro du point considéré
  35. * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)+1
  36. * -> LEPOEL.INDEX(NOPOI1+1)-1) :
  37. * contient les numéro des points centre
  38. * des éléments contenant le point considéré
  39. C
  40. C ENTREES/SORTIES : -
  41. C SORTIES : ELNBEL (type MLENTI)
  42. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  43. C***********************************************************************
  44. C VERSION : v1, 02/11/98, version initiale
  45. C HISTORIQUE : v1, 02/11/98, création
  46. C HISTORIQUE :
  47. C HISTORIQUE :
  48. C***********************************************************************
  49. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  50. C en cas de modification de ce sous-programme afin de faciliter
  51. C la maintenance !
  52. C***********************************************************************
  53. -INC CCOPTIO
  54. -INC SMELEME
  55. POINTEUR MCLAS.MELEME
  56. POINTEUR MCLPO1.MELEME
  57. POINTEUR MCENT.MELEME
  58. -INC SMLENTI
  59. POINTEUR ELNBEL.MLENTI
  60. POINTEUR KRIPO1.MLENTI
  61. POINTEUR TMPCEN.MLENTI
  62. *
  63. * Segment MLELEM
  64. *
  65. SEGMENT MLELEM
  66. INTEGER INDEX(NBL+1)
  67. INTEGER LESPOI(NBTPOI)
  68. ENDSEGMENT
  69. *
  70. * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  71. *
  72. * NBL : NOMBRE D'ELEMENTS
  73. * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES
  74. * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  75. * DANS LE TABLEAU LESPOI
  76. * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  77. * DU IEME ELEMENT
  78. *
  79. POINTEUR LEPOEL.MLELEM
  80. INTEGER IMPR,IRET
  81. LOGICAL LFOUND
  82. *
  83. * Executable statements
  84. *
  85. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans elenbl.eso'
  86. SEGACT MCLPO1
  87. NBSOUS=MCLPO1.LISOUS(/1)
  88. NOTYP =MCLPO1.ITYPEL
  89. IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  90. WRITE(IOIMP,*) 'MCLPO1 must contain only POI1 elements'
  91. GOTO 9999
  92. ENDIF
  93. C In KRIPAD : SEGINI KRIPO1
  94. CALL KRIPAD(MCLPO1,KRIPO1)
  95. NBPOI1=MCLPO1.NUM(/2)
  96. SEGDES MCLPO1
  97. SEGACT MCENT
  98. NBSOUS=MCENT.LISOUS(/1)
  99. NOTYP =MCENT.ITYPEL
  100. IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  101. WRITE(IOIMP,*) 'MCENT must contain only POI1 elements'
  102. GOTO 9999
  103. ENDIF
  104. NBCENT=MCENT.NUM(/2)
  105. JG=NBCENT
  106. SEGINI ELNBEL
  107. * On a besoin du max. du nombre de centres adjacents à un point
  108. * de MCLPO1 pour avoir une estimation
  109. * du nombre max de centres adjacents à l'élément en cours
  110. SEGACT LEPOEL
  111. NBLEPO=LEPOEL.INDEX(/1)-1
  112. IF (NBLEPO.NE.NBPOI1) THEN
  113. WRITE(IOIMP,*)
  114. $ 'Dimension of MCLPO1 and LEPOEL are not compatible'
  115. GOTO 9999
  116. ENDIF
  117. MAPOCE=0
  118. DO 1 INBL=1,NBLEPO
  119. MAPOCE=MAX(MAPOCE,(LEPOEL.INDEX(INBL+1)-LEPOEL.INDEX(INBL)))
  120. 1 CONTINUE
  121. * Dans LEPOEL, on a a la fois le point et les centre adjacents
  122. MAPOCE=MAPOCE-1
  123. * Parcourons le maillage géométrique
  124. SEGACT MCLAS
  125. NBSOUS=MCLAS.LISOUS(/1)
  126. IF (NBSOUS.EQ.0) NBSOUS=1
  127. ICENT=0
  128. DO 2 INBSOU=1,NBSOUS
  129. IF (NBSOUS.GT.1) THEN
  130. IPT1=MCLAS.LISOUS(INBSOU)
  131. SEGACT IPT1
  132. ELSE
  133. IPT1=MCLAS
  134. ENDIF
  135. NBPOEL=IPT1.NUM(/1)
  136. NBELEM=IPT1.NUM(/2)
  137. JG=NBPOEL*MAPOCE
  138. * TMPCEN sert à stocker les centres adajacents à l'élément
  139. * en cours. Il faut faire attention à ne pas stocker deux
  140. * fois le meme numéro de centre.
  141. SEGINI TMPCEN
  142. DO 22 INBEL=1,NBELEM
  143. ICENT=ICENT+1
  144. ITMPC=1
  145. * On stocke le centre de l'élément considéré en premier
  146. TMPCEN.LECT(ITMPC)=MCENT.NUM(1,ICENT)
  147. DO 222 INBPO=1,NBPOEL
  148. NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL))
  149. IF (NOPOI1.NE.0) THEN
  150. DO 2222 IPOCE=LEPOEL.INDEX(NOPOI1)+1,
  151. $ LEPOEL.INDEX(NOPOI1+1)-1
  152. NUMCEN=LEPOEL.LESPOI(IPOCE)
  153. IBTMPC=1
  154. * On cherche si le centre de numéro NUMCEN n'est pas deja
  155. * dans la liste TMPCEN
  156. 22222 CONTINUE
  157. LFOUND=(NUMCEN.EQ.TMPCEN.LECT(IBTMPC))
  158. IF (.NOT.LFOUND.AND.(IBTMPC.LT.ITMPC)) THEN
  159. IBTMPC=IBTMPC+1
  160. GOTO 22222
  161. ENDIF
  162. * Il n'est pas dans la liste, on le rajoute
  163. IF (.NOT.LFOUND) THEN
  164. ITMPC=ITMPC+1
  165. TMPCEN.LECT(ITMPC)=NUMCEN
  166. ENDIF
  167. 2222 CONTINUE
  168. ELSE
  169. WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas'
  170. WRITE(IOIMP,*) 'le maillage de points correspondant'
  171. WRITE(IOIMP,*) 'à MCLAS.'
  172. ENDIF
  173. 222 CONTINUE
  174. * ITMPC-1 car TMPCEN contient aussi le centre de l'élément
  175. * courant
  176. ELNBEL.LECT(ICENT)=ITMPC-1
  177. 22 CONTINUE
  178. IF (NBSOUS.GT.1) SEGDES IPT1
  179. SEGSUP TMPCEN
  180. 2 CONTINUE
  181. SEGDES MCLAS
  182. SEGDES LEPOEL
  183. SEGDES MCENT
  184. SEGSUP KRIPO1
  185. IF (IMPR.GT.2) THEN
  186. WRITE(IOIMP,*) 'On a créé ELNBEL (type MLENTI)=',ELNBEL
  187. IF (IMPR.GT.3) THEN
  188. WRITE(IOIMP,4000) 'ELNBEL',NBCENT
  189. WRITE(IOIMP,5000) (ELNBEL.LECT(I),I=1,NBCENT)
  190. ENDIF
  191. ENDIF
  192. SEGDES ELNBEL
  193. *
  194. * Normal termination
  195. *
  196. IRET=0
  197. RETURN
  198. *
  199. * Format handling
  200. *
  201. 4000 FORMAT (A,'(1..',I8,')')
  202. 5000 FORMAT (8(1X,I8))
  203. *
  204. * Error handling
  205. *
  206. 9999 CONTINUE
  207. IRET=1
  208. WRITE(IOIMP,*) 'An error was detected in subroutine elenbl'
  209. RETURN
  210. *
  211. * End of subroutine ELENBL
  212. *
  213. END
  214.  
  215.  
  216.  
  217.  

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