Télécharger elelem.eso

Retour à la liste

Numérotation des lignes :

  1. C ELELEM SOURCE CHAT 05/01/12 23:30:45 5004
  2. SUBROUTINE ELELEM(MCLAS,MCLPO1,MCENT,LEPOEL,ELNBEL,
  3. $ LEELEL,IMPR,IRET)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C***********************************************************************
  7. C NOM : ELELEM
  8. C DESCRIPTION : On construit la liste séquentielle indexée d'éléments
  9. C LEELEL (type MLELEM).
  10. * NOCENT : indice du centre de l'élément considéré dans
  11. * MCENT
  12. * LEELEL.LESPOI(LEELEL.INDEX(NOCENT)) :
  13. * contient le numéro du centre de l'élément considéré
  14. * LEELEL.LESPOI(LEPOEL.INDEX(NOCENT)+1
  15. * -> LEPOEL.INDEX(NOCENT+1)-1) :
  16. * contient les numéro des points centre des éléments
  17. * qui ont un point de MCLPO1 en commun avec l'élément
  18. * considéré (!)
  19. *
  20. * ELNBEL est tel que ELNBEL(NOCENT) = nb d'éléments ayant au
  21. * moins un point de MCLPO1
  22. * en commun avec l'élément
  23. * dont l'indice du centre
  24. * dans MCENT est NOCENT.
  25. * ELNBEL est calculé dans la subroutine elenbl.eso
  26. * Il sert à dimensionner le tableau LESPOI et remplir
  27. * le tableau INDEX du segment LEELEL.
  28. C
  29. C LANGAGE : ESOPE
  30. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  31. C mél : gounand@semt2.smts.cea.fr
  32. C***********************************************************************
  33. C APPELES : KRIPAD : MELEME -> (num. globale->locale)
  34. C APPELES (E/S) : -
  35. C APPELES (BLAS) : -
  36. C APPELES (CALCUL) : -
  37. C APPELE PAR : ELPOEL
  38. C***********************************************************************
  39. C SYNTAXE GIBIANE : -
  40. C ENTREES : MCLAS (type MELEME) : maillage de classe de
  41. C points (sommet, face) par
  42. C élément (MMAIL,ELTFA)
  43. C MCLPO1 (type MELEME) : maillage de points
  44. C correspondant à MCLAS
  45. C MCENT (type MELEME) : un maillage de
  46. C points (dits 'centres') ayant le meme
  47. C nombre d'éléments que MCLAS et
  48. C servant à repérer les éléments de MCLAS.
  49. C ELNBEL (type MLENTI) : voir DESCRIPTION
  50. C
  51. C ENTREES/SORTIES : -
  52. C SORTIES : LEELEL (type MLELEM) : liste séquentielle indexée
  53. C d'éléments (cf. plus haut)
  54. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  55. C***********************************************************************
  56. C VERSION : v1, 02/11/98, version initiale
  57. C HISTORIQUE : v1, 02/11/98, création
  58. C HISTORIQUE :
  59. C HISTORIQUE :
  60. C***********************************************************************
  61. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  62. C en cas de modification de ce sous-programme afin de faciliter
  63. C la maintenance !
  64. C***********************************************************************
  65. -INC CCOPTIO
  66. -INC SMELEME
  67. POINTEUR MCLAS.MELEME
  68. POINTEUR MCLPO1.MELEME
  69. POINTEUR MCENT.MELEME
  70. -INC SMLENTI
  71. POINTEUR ELNBEL.MLENTI
  72. POINTEUR KRIPO1.MLENTI
  73. *
  74. * Segment MLELEM
  75. *
  76. SEGMENT MLELEM
  77. INTEGER INDEX(NBL+1)
  78. INTEGER LESPOI(NBTPOI)
  79. ENDSEGMENT
  80. *
  81. * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  82. *
  83. * NBL : NOMBRE D'ELEMENTS
  84. * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES
  85. * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  86. * DANS LE TABLEAU LESPOI
  87. * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  88. * DU IEME ELEMENT
  89. *
  90. POINTEUR LEPOEL.MLELEM
  91. POINTEUR LEELEL.MLELEM
  92. INTEGER IMPR,IRET
  93. INTEGER NBL,NBTPOI
  94. LOGICAL LFOUND
  95. *
  96. * Executable statements
  97. *
  98. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans elelem.eso'
  99. SEGACT MCLPO1
  100. NBSOUS=MCLPO1.LISOUS(/1)
  101. NOTYP =MCLPO1.ITYPEL
  102. IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  103. WRITE(IOIMP,*) 'MCLPO1 must contain only POI1 elements'
  104. GOTO 9999
  105. ENDIF
  106. C In KRIPAD : SEGINI KRIPO1
  107. CALL KRIPAD(MCLPO1,KRIPO1)
  108. SEGDES MCLPO1
  109. SEGACT MCENT
  110. NBSOUS=MCENT.LISOUS(/1)
  111. NOTYP =MCENT.ITYPEL
  112. IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  113. WRITE(IOIMP,*) 'MCENT must contain only POI1 elements'
  114. GOTO 9999
  115. ENDIF
  116. NBCENT=MCENT.NUM(/2)
  117. SEGACT ELNBEL
  118. NELNB=ELNBEL.LECT(/1)
  119. IF (NELNB.NE.NBCENT) THEN
  120. WRITE(IOIMP,*) 'Dimension of MCENT and ELNBEL are not equal'
  121. GOTO 9999
  122. ENDIF
  123. C
  124. C On initialise le segment LEELEL (type MLELEM)
  125. C
  126. NBL=NBCENT
  127. NBTPOI=0
  128. SEGINI LEELEL
  129. IDEPA=1
  130. DO 1 INBL=1,NBL
  131. LEELEL.INDEX(INBL)=IDEPA
  132. IDEPA=IDEPA+1+ELNBEL.LECT(INBL)
  133. 1 CONTINUE
  134. LEELEL.INDEX(NBL+1)=IDEPA
  135. SEGDES ELNBEL
  136. NBTPOI=IDEPA-1
  137. SEGADJ LEELEL
  138. SEGACT LEPOEL
  139. * Parcourons le maillage
  140. SEGACT MCLAS
  141. NBSOUS=MCLAS.LISOUS(/1)
  142. IF (NBSOUS.EQ.0) NBSOUS=1
  143. ICENT=0
  144. DO 3 INBSOU=1,NBSOUS
  145. IF (NBSOUS.GT.1) THEN
  146. IPT1=MCLAS.LISOUS(INBSOU)
  147. SEGACT IPT1
  148. ELSE
  149. IPT1=MCLAS
  150. ENDIF
  151. NBPOEL=IPT1.NUM(/1)
  152. NBELEM=IPT1.NUM(/2)
  153. DO 32 INBEL=1,NBELEM
  154. ICENT=ICENT+1
  155. LEELEL.LESPOI(LEELEL.INDEX(ICENT))=MCENT.NUM(1,ICENT)
  156. ICOUR=LEELEL.INDEX(ICENT)+1
  157. DO 322 INBPO=1,NBPOEL
  158. NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL))
  159. IF (NOPOI1.NE.0) THEN
  160. DO 3222 IPOEL=LEPOEL.INDEX(NOPOI1)+1,
  161. $ LEPOEL.INDEX(NOPOI1+1)-1
  162. NUMCEN=LEPOEL.LESPOI(IPOEL)
  163. IBCOUR=LEELEL.INDEX(ICENT)
  164. 32222 CONTINUE
  165. LFOUND=(NUMCEN.EQ.LEELEL.LESPOI(IBCOUR))
  166. IF (.NOT.LFOUND.AND.(IBCOUR.LT.ICOUR)) THEN
  167. IBCOUR=IBCOUR+1
  168. GOTO 32222
  169. ENDIF
  170. IF (.NOT.LFOUND) THEN
  171. LEELEL.LESPOI(ICOUR)=NUMCEN
  172. ICOUR=ICOUR+1
  173. ENDIF
  174. 3222 CONTINUE
  175. ELSE
  176. WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas'
  177. WRITE(IOIMP,*) 'le maillage de points correspondant'
  178. WRITE(IOIMP,*) 'à MCLAS.'
  179. GOTO 9999
  180. ENDIF
  181. 322 CONTINUE
  182. 32 CONTINUE
  183. IF (NBSOUS.GT.1) SEGDES IPT1
  184. 3 CONTINUE
  185. SEGDES MCLAS
  186. SEGDES LEPOEL
  187. IF (IMPR.GT.2) THEN
  188. WRITE(IOIMP,*) 'On a créé LEELEL (type MLELEM)=',LEELEL
  189. IF (IMPR.GT.3) THEN
  190. WRITE(IOIMP,4000) 'LEELEL.INDEX',NBL+1
  191. WRITE(IOIMP,5000) (LEELEL.INDEX(I),I=1,NBL+1)
  192. WRITE(IOIMP,4000) 'LEELEL.LESPOI',NBTPOI
  193. WRITE(IOIMP,5000) (LEELEL.LESPOI(I),I=1,NBTPOI)
  194. ENDIF
  195. ENDIF
  196. SEGDES LEELEL
  197. SEGDES MCENT
  198. SEGSUP KRIPO1
  199. *
  200. * Normal termination
  201. *
  202. IRET=0
  203. RETURN
  204. *
  205. * Format handling
  206. *
  207. 4000 FORMAT (A,'(1..',I8,')')
  208. 5000 FORMAT (8(1X,I8))
  209. *
  210. * Error handling
  211. *
  212. 9999 CONTINUE
  213. IRET=1
  214. WRITE(IOIMP,*) 'An error was detected in subroutine elelem'
  215. RETURN
  216. *
  217. * End of subroutine ELELEM
  218. *
  219. END
  220.  
  221.  
  222.  
  223.  

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