Télécharger poelem.eso

Retour à la liste

Numérotation des lignes :

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

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