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.  
  65. -INC PPARAM
  66. -INC CCOPTIO
  67. -INC SMELEME
  68. POINTEUR MCLAS.MELEME
  69. POINTEUR MCLPO1.MELEME
  70. POINTEUR MCENT.MELEME
  71. -INC SMLENTI
  72. POINTEUR PONBEL.MLENTI
  73. POINTEUR KRIPO1.MLENTI
  74. *
  75. * Segment MLELEM
  76. *
  77. SEGMENT MLELEM
  78. INTEGER INDEX(NBL+1)
  79. INTEGER LESPOI(NBTPOI)
  80. ENDSEGMENT
  81. *
  82. * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  83. *
  84. * NBL : NOMBRE D'ELEMENTS
  85. * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES
  86. * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  87. * DANS LE TABLEAU LESPOI
  88. * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  89. * DU IEME ELEMENT
  90. *
  91. POINTEUR LEPOEL.MLELEM
  92. POINTEUR ICOUR.MLELEM
  93. INTEGER IMPR,IRET
  94. INTEGER NBL,NBTPOI
  95. *
  96. * Executable statements
  97. *
  98. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans poelem.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. NBPOI1=MCLPO1.NUM(/2)
  107. SEGACT PONBEL
  108. NPONB=PONBEL.LECT(/1)
  109. IF (NPONB.NE.NBPOI1) THEN
  110. WRITE(IOIMP,*) 'Dimension of MCLPO1 and PONBEL are not equal'
  111. GOTO 9999
  112. ENDIF
  113. C On initialise le segment LEPOEL (type MLELEM)
  114. C et le segment ICOUR (type MLELEM)
  115. C dans ICOUR, seul le tableau INDEX nous intéresse
  116. NBL=NBPOI1
  117. NBTPOI=0
  118. SEGINI LEPOEL
  119. IDEPA=1
  120. DO 2 INBL=1,NBL
  121. LEPOEL.INDEX(INBL)=IDEPA
  122. IDEPA=IDEPA+1+PONBEL.LECT(INBL)
  123. 2 CONTINUE
  124. LEPOEL.INDEX(NBL+1)=IDEPA
  125. SEGDES PONBEL
  126. SEGINI,ICOUR=LEPOEL
  127. NBTPOI=IDEPA-1
  128. SEGADJ LEPOEL
  129. C
  130. C On remplit LESPOI(INDEX(I)) avec le numéro du Ieme point
  131. C de MCLPO1.
  132. C
  133. DO 3 INBL=1,NBL
  134. LEPOEL.LESPOI(ICOUR.INDEX(INBL))=MCLPO1.NUM(1,INBL)
  135. ICOUR.INDEX(INBL)=ICOUR.INDEX(INBL)+1
  136. 3 CONTINUE
  137. C In KRIPAD : SEGINI KRIPO1
  138. CALL KRIPAD(MCLPO1,KRIPO1)
  139. SEGDES MCLPO1
  140. C
  141. C On remplit LESPOI(INDEX(I)+1 -> INDEX(I+1)-1)
  142. C avec les points centres des éléments contenant le
  143. C Ieme point de MCLPO1.
  144. C
  145. C On procède en bouclant sur les éléments de MCLAS pour
  146. C remplir le tableau LESPOI.
  147. C
  148. SEGACT MCENT
  149. SEGACT MCLAS
  150. NBSOUS=MCLAS.LISOUS(/1)
  151. IF (NBSOUS.EQ.0) NBSOUS=1
  152. ICENT=0
  153. DO 4 INBSOU=1,NBSOUS
  154. IF (NBSOUS.GT.1) THEN
  155. IPT1=MCLAS.LISOUS(INBSOU)
  156. SEGACT IPT1
  157. ELSE
  158. IPT1=MCLAS
  159. ENDIF
  160. NBPOEL=IPT1.NUM(/1)
  161. NBELEM=IPT1.NUM(/2)
  162. DO 42 INBEL=1,NBELEM
  163. ICENT=ICENT+1
  164. NOCEN=MCENT.NUM(1,ICENT)
  165. DO 422 INBPO=1,NBPOEL
  166. NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL))
  167. IF (NOPOI1.NE.0) THEN
  168. LEPOEL.LESPOI(ICOUR.INDEX(NOPOI1))=NOCEN
  169. ICOUR.INDEX(NOPOI1)=ICOUR.INDEX(NOPOI1)+1
  170. ELSE
  171. WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas'
  172. WRITE(IOIMP,*) 'le maillage de points correspondant'
  173. WRITE(IOIMP,*) 'à MCLAS.'
  174. GOTO 9999
  175. ENDIF
  176. 422 CONTINUE
  177. 42 CONTINUE
  178. IF (NBSOUS.GT.1) SEGDES IPT1
  179. 4 CONTINUE
  180. SEGDES MCLAS
  181. SEGDES MCENT
  182. IF (IMPR.GT.2) THEN
  183. WRITE(IOIMP,*) 'On a créé LEPOEL (type MLELEM)=',LEPOEL
  184. IF (IMPR.GT.3) THEN
  185. WRITE(IOIMP,4000) 'LEPOEL.INDEX',NBL+1
  186. WRITE(IOIMP,5000) (LEPOEL.INDEX(I),I=1,NBL+1)
  187. WRITE(IOIMP,4000) 'LEPOEL.LESPOI',NBTPOI
  188. WRITE(IOIMP,5000) (LEPOEL.LESPOI(I),I=1,NBTPOI)
  189. ENDIF
  190. ENDIF
  191. SEGDES LEPOEL
  192. SEGSUP ICOUR
  193. SEGSUP KRIPO1
  194. *
  195. * Normal termination
  196. *
  197. IRET=0
  198. RETURN
  199. *
  200. * Format handling
  201. *
  202. 4000 FORMAT (A,'(1..',I8,')')
  203. 5000 FORMAT (8(1X,I8))
  204. *
  205. * Error handling
  206. *
  207. 9999 CONTINUE
  208. IRET=1
  209. WRITE(IOIMP,*) 'An error was detected in subroutine poelem'
  210. RETURN
  211. *
  212. * End of subroutine POELEM
  213. *
  214. END
  215.  
  216.  
  217.  
  218.  

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