Télécharger fixmel.eso

Retour à la liste

Numérotation des lignes :

  1. C FIXMEL SOURCE CHAT 05/01/13 00:01:55 5004
  2. SUBROUTINE FIXMEL(MELPRI,MELDUA,
  3. $ MELPR2,MELDU2,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : FIXMEL
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : On corrige les maillages primaux et duaux s'ils n'ont
  11. C pas le même nombre de sous-objets géométriques.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES (UTIL.) : RSETI
  18. C APPELE PAR : PRASEM
  19. C***********************************************************************
  20. C ENTREES : MELPRI, MELDUA
  21. C SORTIES : MELPR2, MELDU2
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 16/11/99, version initiale
  25. C HISTORIQUE : v1, 16/11/99, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. -INC SMELEME
  35. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  36. POINTEUR MELPRI.MELEME
  37. POINTEUR MELDUA.MELEME
  38. POINTEUR MELPR2.MELEME
  39. POINTEUR MELDU2.MELEME
  40. POINTEUR SMLPRI.MELEME
  41. POINTEUR SMLDUA.MELEME
  42. POINTEUR SMLPR2.MELEME
  43. POINTEUR SMLDU2.MELEME
  44. -INC SMLENTI
  45. INTEGER JG
  46. POINTEUR NBLPRI.MLENTI
  47. POINTEUR NBLDUA.MLENTI
  48. POINTEUR NBLMIX.MLENTI
  49. *
  50. INTEGER IDXPRI,IDXDUA
  51. INTEGER NELPRI,NELDUA
  52. INTEGER NUPRI,NUDUA,NUMIX
  53. INTEGER ISOUS,ISOUP,ISOUD,ISOUM
  54. INTEGER NSOUS,NSOUP,NSOUD,NSOUM
  55. *
  56. INTEGER IMPR,IRET
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans fixmel'
  61. *
  62. * Comptage des éléments dans chaque MELEME
  63. *
  64. * primal...
  65. SEGACT MELPRI
  66. NSOUS=MELPRI.LISOUS(/1)
  67. JG=MAX(1,NSOUS)+1
  68. SEGINI NBLPRI
  69. NBLPRI.LECT(1)=1
  70. DO 1 ISOUS=1,MAX(1,NSOUS)
  71. IF (NSOUS.EQ.0) THEN
  72. SMLPRI=MELPRI
  73. ELSE
  74. SMLPRI=MELPRI.LISOUS(ISOUS)
  75. SEGACT SMLPRI
  76. ENDIF
  77. NBLPRI.LECT(ISOUS+1)=NBLPRI.LECT(ISOUS)+SMLPRI.NUM(/2)
  78. IF (NSOUS.NE.0) SEGDES SMLPRI
  79. 1 CONTINUE
  80. SEGDES MELPRI
  81. * ... et dual
  82. SEGACT MELDUA
  83. NSOUS=MELDUA.LISOUS(/1)
  84. JG=MAX(1,NSOUS)+1
  85. SEGINI NBLDUA
  86. NBLDUA.LECT(1)=1
  87. DO 3 ISOUS=1,MAX(1,NSOUS)
  88. IF (NSOUS.EQ.0) THEN
  89. SMLDUA=MELDUA
  90. ELSE
  91. SMLDUA=MELDUA.LISOUS(ISOUS)
  92. SEGACT SMLDUA
  93. ENDIF
  94. NBLDUA.LECT(ISOUS+1)=NBLDUA.LECT(ISOUS)+SMLDUA.NUM(/2)
  95. IF (NSOUS.NE.0) SEGDES SMLDUA
  96. 3 CONTINUE
  97. SEGDES MELDUA
  98. *
  99. * D'où les nombres d'éléments (+1)...
  100. *
  101. NSOUP=NBLPRI.LECT(/1)-1
  102. NELPRI=NBLPRI.LECT(NSOUP+1)
  103. NSOUD=NBLDUA.LECT(/1)-1
  104. NELDUA=NBLDUA.LECT(NSOUD+1)
  105. IF (NELPRI.NE.NELDUA) THEN
  106. WRITE(IOIMP,*) 'Maillage primaux et duaux : nbel différents'
  107. GOTO 9999
  108. ENDIF
  109. IF (NSOUP.EQ.NSOUD) THEN
  110. MELPR2=MELPRI
  111. MELDU2=MELDUA
  112. ELSE
  113. *
  114. * On détermine combien il faudra de sous-maillages
  115. * avec quels nombres d'éléments par sous-maillage
  116. *
  117. NSOUM=NSOUP*NSOUD
  118. JG=NSOUM+1
  119. SEGINI NBLMIX
  120. ISOUP=1
  121. ISOUD=1
  122. ISOUM=0
  123. NUPRI=NBLPRI.LECT(ISOUP+1)
  124. NUDUA=NBLDUA.LECT(ISOUD+1)
  125. NBLMIX.LECT(ISOUM+1)=1
  126. 5 CONTINUE
  127. IF (NUPRI.LT.NUDUA) THEN
  128. ISOUM=ISOUM+1
  129. NBLMIX.LECT(ISOUM+1)=NUPRI
  130. ISOUP=ISOUP+1
  131. NUPRI=NBLPRI.LECT(ISOUP+1)
  132. GOTO 5
  133. ELSEIF (NUPRI.GT.NUDUA) THEN
  134. ISOUM=ISOUM+1
  135. NBLMIX.LECT(ISOUM+1)=NUDUA
  136. ISOUD=ISOUD+1
  137. NUDUA=NBLDUA.LECT(ISOUD+1)
  138. GOTO 5
  139. ELSE
  140. ISOUM=ISOUM+1
  141. NBLMIX.LECT(ISOUM+1)=NUDUA
  142. IF (NUPRI.LT.NELPRI.AND.NUDUA.LT.NELDUA) THEN
  143. ISOUP=ISOUP+1
  144. ISOUD=ISOUD+1
  145. NUPRI=NBLPRI.LECT(ISOUP+1)
  146. NUDUA=NBLDUA.LECT(ISOUD+1)
  147. GOTO 5
  148. ELSEIF (.NOT.(NUPRI.EQ.NELPRI.AND.NUDUA.EQ.NELDUA)) THEN
  149. WRITE(IOIMP,*) 'Erreur de programmation'
  150. GOTO 9999
  151. ENDIF
  152. ENDIF
  153. *
  154. * On remplit MELPR2 et MELDU2 (partitionnés) comme il faut.
  155. *
  156. NBNN=0
  157. NBELEM=0
  158. NBSOUS=ISOUM
  159. NBREF=0
  160. SEGINI MELPR2
  161. SEGINI MELDU2
  162. ISOUP=1
  163. ISOUD=1
  164. ISOUM=0
  165. SEGACT MELPRI
  166. NSOUP=MELPRI.LISOUS(/1)
  167. IF (NSOUP.EQ.0) THEN
  168. SMLPRI=MELPRI
  169. ELSE
  170. SMLPRI=MELPRI.LISOUS(1)
  171. SEGACT SMLPRI
  172. ENDIF
  173. SEGACT MELDUA
  174. NSOUD=MELDUA.LISOUS(/1)
  175. IF (NSOUD.EQ.0) THEN
  176. SMLDUA=MELDUA
  177. ELSE
  178. SMLDUA=MELDUA.LISOUS(1)
  179. SEGACT SMLDUA
  180. ENDIF
  181. NUPRI=NBLPRI.LECT(ISOUP+1)
  182. NUDUA=NBLDUA.LECT(ISOUD+1)
  183. NUMIX=NBLMIX.LECT(ISOUM+1)
  184. 7 CONTINUE
  185. IF (NUPRI.LT.NUDUA) THEN
  186. ISOUM=ISOUM+1
  187. NBNN=SMLPRI.NUM(/1)
  188. NBELEM=NUPRI-NUMIX
  189. NBSOUS=0
  190. NBREF=0
  191. SEGINI SMLPR2
  192. SMLPR2.ITYPEL=SMLPRI.ITYPEL
  193. IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
  194. CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
  195. SEGDES SMLPR2
  196. MELPR2.LISOUS(ISOUM)=SMLPR2
  197. NBNN=SMLDUA.NUM(/1)
  198. SEGINI SMLDU2
  199. SMLDU2.ITYPEL=SMLDUA.ITYPEL
  200. IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
  201. CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
  202. SEGDES SMLDU2
  203. MELDU2.LISOUS(ISOUM)=SMLDU2
  204. SEGDES SMLPRI
  205. ISOUP=ISOUP+1
  206. SMLPRI=MELPRI.LISOUS(ISOUP)
  207. SEGACT SMLPRI
  208. NUPRI=NBLPRI.LECT(ISOUP+1)
  209. NUMIX=NBLMIX.LECT(ISOUM+1)
  210. GOTO 7
  211. ELSEIF (NUPRI.GT.NUDUA) THEN
  212. ISOUM=ISOUM+1
  213. NBNN=SMLPRI.NUM(/1)
  214. NBELEM=NUDUA-NUMIX
  215. NBSOUS=0
  216. NBREF=0
  217. SEGINI SMLPR2
  218. SMLPR2.ITYPEL=SMLPRI.ITYPEL
  219. IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
  220. CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
  221. SEGDES SMLPR2
  222. MELPR2.LISOUS(ISOUM)=SMLPR2
  223. NBNN=SMLDUA.NUM(/1)
  224. SEGINI SMLDU2
  225. SMLDU2.ITYPEL=SMLDUA.ITYPEL
  226. IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
  227. CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
  228. SEGDES SMLDU2
  229. MELDU2.LISOUS(ISOUM)=SMLDU2
  230. SEGDES SMLDUA
  231. ISOUD=ISOUD+1
  232. SMLDUA=MELDUA.LISOUS(ISOUD)
  233. SEGACT SMLDUA
  234. NUDUA=NBLDUA.LECT(ISOUD+1)
  235. NUMIX=NBLMIX.LECT(ISOUM+1)
  236. GOTO 7
  237. ELSE
  238. ISOUM=ISOUM+1
  239. NBNN=SMLPRI.NUM(/1)
  240. NBELEM=NUDUA-NUMIX
  241. NBSOUS=0
  242. NBREF=0
  243. SEGINI SMLPR2
  244. SMLPR2.ITYPEL=SMLPRI.ITYPEL
  245. IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
  246. CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
  247. SEGDES SMLPR2
  248. MELPR2.LISOUS(ISOUM)=SMLPR2
  249. NBNN=SMLDUA.NUM(/1)
  250. SEGINI SMLDU2
  251. SMLDU2.ITYPEL=SMLDUA.ITYPEL
  252. IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
  253. CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
  254. SEGDES SMLDU2
  255. MELDU2.LISOUS(ISOUM)=SMLDU2
  256. IF (NUPRI.LT.NELPRI.AND.NUDUA.LT.NELDUA) THEN
  257. SEGDES SMLPRI
  258. ISOUP=ISOUP+1
  259. SMLPRI=MELPRI.LISOUS(ISOUP)
  260. SEGACT SMLPRI
  261. SEGDES SMLDUA
  262. ISOUD=ISOUD+1
  263. SMLDUA=MELDUA.LISOUS(ISOUD)
  264. SEGACT SMLDUA
  265. NUPRI=NBLPRI.LECT(ISOUP+1)
  266. NUDUA=NBLDUA.LECT(ISOUD+1)
  267. NUMIX=NBLMIX.LECT(ISOUM+1)
  268. GOTO 7
  269. ELSEIF (.NOT.(NUPRI.EQ.NELPRI.AND.NUDUA.EQ.NELDUA)) THEN
  270. WRITE(IOIMP,*) 'Erreur de programmation'
  271. GOTO 9999
  272. ENDIF
  273. ENDIF
  274. IF (NSOUD.NE.0) SEGDES SMLDUA
  275. SEGDES MELDUA
  276. IF (NSOUP.NE.0) SEGDES SMLPRI
  277. SEGDES MELPRI
  278. SEGDES MELDU2
  279. SEGDES MELPR2
  280. SEGSUP NBLMIX
  281. ENDIF
  282. SEGSUP NBLDUA
  283. SEGSUP NBLPRI
  284. *
  285. * Normal termination
  286. *
  287. IRET=0
  288. RETURN
  289. *
  290. * Format handling
  291. *
  292. *
  293. * Error handling
  294. *
  295. 9999 CONTINUE
  296. IRET=1
  297. WRITE(IOIMP,*) 'An error was detected in subroutine fixmel'
  298. RETURN
  299. *
  300. * End of subroutine FIXMEL
  301. *
  302. END
  303.  
  304.  
  305.  
  306.  

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