Télécharger rlenso.eso

Retour à la liste

Numérotation des lignes :

  1. C RLENSO SOURCE CHAT 05/01/13 03:01:40 5004
  2. SUBROUTINE RLENSO(MELFL,MELFP,MELSOM,MLEPOI)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : RLENSO
  8. C
  9. C DESCRIPTION : Appelle par GRADI2
  10. C
  11. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12. C
  13. C AUTEUR : A. BECCANTINI
  14. C
  15. C************************************************************************
  16. C
  17. C
  18. C Inputs:
  19. C MELFL : facel of domaine table
  20. C MELFP : facep of domaine table
  21. C MELSOM : sommet of the domaine table
  22. C
  23. C Outputs:
  24. C MLEPOI : list of integers.
  25. C MLEPOI.LECT(I) is the pointer of the list of integers
  26. C MLENTI which contains the neighbors of the i-th sommet
  27. C point.
  28. C
  29. C
  30. C
  31. C**** Variables de COOPTIO
  32. C
  33. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  34. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  35. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  36. C & ,IECHO, IIMPI, IOSPI
  37. C & ,IDIM
  38. C & ,MCOORD
  39. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  40. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  41. C & ,NORINC,NORVAL,NORIND,NORVAD
  42. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  43. CC
  44. IMPLICIT INTEGER(I-N)
  45. INTEGER NSOMM, NBSOUS, NBELEM, NBNO
  46. & , IELEM, NGF, NGF1, INOEU, NGS1, NLS1, ISOUS
  47. & , IELEMF, NGC1, NGC2, NELT, NELTT, I1
  48. C
  49. -INC SMELEME
  50. INTEGER JG
  51. -INC SMLENTI
  52. -INC CCOPTIO
  53. C
  54. POINTEUR MELSOM.MELEME, MELFL.MELEME, MELFP.MELEME, MELFP1.MELEME
  55. & ,MLESOM.MLENTI, MLEFP.MLENTI, MTOUC.MLENTI, MTOUC2.MLENTI
  56. & ,MLEPOI.MLENTI
  57. C
  58. C**** Le MELEME SOMMET
  59. C
  60. CALL KRIPAD(MELSOM,MLESOM)
  61. C
  62. C MLESOM: numerotation globale -> locale
  63. C
  64. C**** En KRIPAD
  65. C SEGACT MELSOM
  66. C SEGINI MLESOM
  67. C
  68. NSOMM = MELSOM.NUM(/2)
  69. JG=NSOMM
  70. SEGINI MTOUC
  71. SEGINI MTOUC2
  72. C MTOUC.LECT(NLS1) = estimation of the number of neighbors for NLS1
  73. C MTOUC2.LECT(NLS1) = how many times NLS1 is touched
  74. C
  75. SEGACT MELFP
  76. C
  77. C**** En 2D MELFP est un maillage elementaire
  78. C En 3D pas à priori
  79. C -> MLEFP contains the list of LISOUS
  80. C
  81. NBSOUS=MELFP.LISOUS(/1)
  82. C NBSOUS=0 fais un peux chier!
  83. JG=MAX(NBSOUS,1)
  84. SEGINI MLEFP
  85. IF(NBSOUS .EQ. 0)THEN
  86. MLEFP.LECT(1)=MELFP
  87. ELSE
  88. DO ISOUS=1,NBSOUS,1
  89. MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS)
  90. ENDDO
  91. ENDIF
  92. SEGDES MELFP
  93. C
  94. SEGACT MELFL
  95. NBSOUS=MELFL.LISOUS(/1)
  96. IF(NBSOUS .NE. 0)THEN
  97. WRITE(IOIMP,*) 'FACEL = ???'
  98. WRITE(IOIMP,*) 'Subroutine rlenso.eso'
  99. CALL ERREUR(5)
  100. GOTO 9999
  101. ENDIF
  102. C
  103. IELEMF=0
  104. NBSOUS=MLEFP.LECT(/1)
  105. DO ISOUS = 1, NBSOUS, 1
  106. MELFP1=MLEFP.LECT(ISOUS)
  107. SEGACT MELFP1
  108. NBELEM=MELFP1.NUM(/2)
  109. NBNO=MELFP1.NUM(/1) - 1
  110. C
  111. C The first ISOUS of 'FACEP' has NBELEM elements which contain
  112. C NBNO sommets and one point face. Each time a 'sommet' point is
  113. C touched, there are at most two neighbors of him.
  114. C
  115. DO IELEM = 1, NBELEM,1
  116. IELEMF=IELEMF+1
  117. NGF=MELFP1.NUM(NBNO+1,IELEM)
  118. NGF1=MELFL.NUM(2,IELEMF)
  119. IF(NGF .NE. NGF1)THEN
  120. WRITE(IOIMP,*) 'FACEL = ???'
  121. WRITE(IOIMP,*) 'Subroutine rlenso.eso'
  122. CALL ERREUR(5)
  123. GOTO 9999
  124. ENDIF
  125. C
  126. C Loop involving the sommet noeuds of the element of
  127. C FACEP
  128. C
  129. DO INOEU = 1, NBNO, 1
  130. NGS1 = MELFP1.NUM(INOEU,IELEM)
  131. NLS1 = MLESOM.LECT(NGS1)
  132. MTOUC2.LECT(NLS1)=MTOUC2.LECT(NLS1)+1
  133. ENDDO
  134. ENDDO
  135. ENDDO
  136. C
  137. C**** MTOUC2.LECT(NLS1) says us how many times NLS1 is touched
  138. C Apart from the first interface, normally each
  139. C interface adds just one new neighbor and not two.
  140. C I create NSOMM MLENTI which contain the list of neighbors.
  141. C MLEPOI contains the number of their pointers
  142. C
  143. JG=NSOMM
  144. SEGINI MLEPOI
  145. DO INOEU=1,NSOMM,1
  146. JG=MTOUC2.LECT(INOEU)+1
  147. SEGINI MLENTI
  148. C MTOUC.LECT(INOEU) says how many places are in each MLENTI
  149. MTOUC.LECT(INOEU)=JG
  150. MLEPOI.LECT(INOEU)=MLENTI
  151. MTOUC2.LECT(INOEU)=0
  152. ENDDO
  153. C
  154. IELEMF=0
  155. NBSOUS=MLEFP.LECT(/1)
  156. DO ISOUS = 1, NBSOUS, 1
  157. MELFP1=MLEFP.LECT(ISOUS)
  158. NBELEM=MELFP1.NUM(/2)
  159. NBNO=MELFP1.NUM(/1) - 1
  160. C
  161. C The first ISOUS of 'FACEP' has NBELEM elements which contain
  162. C NBNO sommets and one point face. Each time a 'sommet' point is
  163. C touched, there are at most two neighbors of him. As already
  164. C mentioned, normally each interface adds just one new neighbor
  165. C and not two.
  166. C
  167. DO IELEM = 1, NBELEM,1
  168. IELEMF=IELEMF+1
  169. NGF=MELFP1.NUM(NBNO+1,IELEM)
  170. NGF1=MELFL.NUM(2,IELEMF)
  171. NGC1=MELFL.NUM(1,IELEMF)
  172. NGC2=MELFL.NUM(3,IELEMF)
  173. IF(NGC1 .NE. NGC2)THEN
  174. C
  175. C************* Internal face
  176. C
  177. C Loop involving the sommet noeuds of the element of
  178. C FACEP
  179. C
  180. DO INOEU = 1, NBNO, 1
  181. NGS1 = MELFP1.NUM(INOEU,IELEM)
  182. NLS1 = MLESOM.LECT(NGS1)
  183. C
  184. C**************** POINT NGC1: does it already belong to the list?
  185. C
  186. C NELT says how many neighbors are already in
  187. C MLEPOI.LECT(NLS1)
  188. C NELTT is the dimension of MLEPOI.LECT(NLS1)
  189. C
  190. NELT=MTOUC2.LECT(NLS1)
  191. NELTT=MTOUC.LECT(NLS1)
  192. MLENTI = MLEPOI.LECT(NLS1)
  193. DO I1 = 1, NELT, 1
  194. IF(MLENTI.LECT(I1).EQ.NGC1) GOTO 1
  195. ENDDO
  196. C
  197. C**************** It does not
  198. C
  199. IF(NELT .LT. NELTT)THEN
  200. MTOUC2.LECT(NLS1)=NELT+1
  201. MLENTI.LECT(NELT+1)=NGC1
  202. NELT=NELT+1
  203. ELSE
  204. C******************* Dimension of MLENTI too little
  205. NELT=NELT+1
  206. NELTT= NELTT+1
  207. JG=NELTT
  208. SEGADJ MLENTI
  209. MTOUC2.LECT(NLS1)=JG
  210. MTOUC.LECT(NLS1)=JG
  211. MLENTI.LECT(JG)=NGC1
  212. ENDIF
  213. C
  214. C**************** It does not
  215. C
  216. 1 CONTINUE
  217. C
  218. C**************** The same for NGC2
  219. C
  220. DO I1 = 1, NELT, 1
  221. IF(MLENTI.LECT(I1).EQ.NGC2) GOTO 2
  222. ENDDO
  223. C
  224. C**************** The point does not already belong to this element
  225. C
  226. IF(NELT .LT. NELTT)THEN
  227. MTOUC2.LECT(NLS1)=NELT+1
  228. MLENTI.LECT(NELT+1)=NGC2
  229. ELSE
  230. C
  231. C******************* Dimension of MLENTI too little
  232. C
  233. JG=NELTT+1
  234. SEGADJ MLENTI
  235. MTOUC2.LECT(NLS1)=JG
  236. MTOUC.LECT(NLS1)=JG
  237. MLENTI.LECT(JG)=NGC2
  238. ENDIF
  239. C
  240. C**************** The point already belongs to this element
  241. C Nothing to do
  242. C
  243. 2 CONTINUE
  244. ENDDO
  245. ELSE
  246. C
  247. C************* Boundary face
  248. C
  249. C Loop involving the sommet noeuds of the element of
  250. C FACEP
  251. C
  252. DO INOEU = 1, NBNO, 1
  253. NGS1 = MELFP1.NUM(INOEU,IELEM)
  254. NLS1 = MLESOM.LECT(NGS1)
  255. NELT=MTOUC2.LECT(NLS1)
  256. NELTT=MTOUC.LECT(NLS1)
  257. MLENTI = MLEPOI.LECT(NLS1)
  258. C
  259. C**************** POINT NGF cannot belongs to the list
  260. C
  261. IF(NELT .LT. NELTT)THEN
  262. MTOUC2.LECT(NLS1)=NELT+1
  263. MLENTI.LECT(NELT+1)=NGF
  264. NELT=NELT+1
  265. ELSE
  266. C******************* Dimension of MLENTI too little
  267. NELT=NELT+1
  268. NELTT= NELTT+1
  269. JG=NELTT
  270. SEGADJ MLENTI
  271. MTOUC2.LECT(NLS1)=JG
  272. MTOUC.LECT(NLS1)=JG
  273. MLENTI.LECT(JG)=NGF
  274. ENDIF
  275. C
  276. C**************** What about NGC1?
  277. C
  278. DO I1 = 1, NELT, 1
  279. IF(MLENTI.LECT(I1).EQ.NGC1) GOTO 3
  280. ENDDO
  281. C
  282. C**************** The point does not already belong to this element
  283. C
  284. IF(NELT .LT. NELTT)THEN
  285. MTOUC2.LECT(NLS1)=NELT+1
  286. MLENTI.LECT(NELT+1)=NGC1
  287. ELSE
  288. C
  289. C******************* Dimension of MLENTI too little
  290. C
  291. JG=NELTT+1
  292. SEGADJ MLENTI
  293. MTOUC2.LECT(NLS1)=JG
  294. MTOUC.LECT(NLS1)=JG
  295. MLENTI.LECT(JG)=NGC1
  296. ENDIF
  297. C
  298. C**************** The point already belongs to this element
  299. C Nothing to do
  300. C
  301. 3 CONTINUE
  302. ENDDO
  303. ENDIF
  304. ENDDO
  305. SEGDES MELFP1
  306. ENDDO
  307. C
  308. C**** We eliminate the 0 into the MLENTI of
  309. C MLEPOI.LECT(NL sommet)
  310. C
  311. DO INOEU=1,NSOMM,1
  312. MLENTI=MLEPOI.LECT(INOEU)
  313. NELT=MTOUC2.LECT(INOEU)
  314. NELTT=MTOUC.LECT(INOEU)
  315. DO I1=(NELT+1),NELTT,1
  316. IF(MLENTI.LECT(I1) .NE. 0)THEN
  317. C
  318. C************* There is an error somewhere
  319. C
  320. WRITE(IOIMP,*) 'Subroutine rlenso.eso'
  321. CALL ERREUR(5)
  322. GOTO 9999
  323. ENDIF
  324. ENDDO
  325. JG=NELT
  326. SEGADJ MLENTI
  327. SEGDES MLENTI
  328. ENDDO
  329. C
  330. C**** Test
  331. C
  332. C DO INOEU=1,NSOMM,1
  333. C MLENTI=MLEPOI.LECT(INOEU)
  334. C NELT=MLENTI.LECT(/1)
  335. C write (*,*) 'ngs =', MELSOM.NUM(1,INOEU)
  336. C write (*,*) (mlenti.lect(i2),i2=1,nelt)
  337. C ENDDO
  338. C
  339. SEGSUP MTOUC
  340. SEGSUP MTOUC2
  341. C
  342. SEGSUP MLESOM
  343. SEGDES MELSOM
  344. C
  345. SEGSUP MLEFP
  346. C
  347. SEGDES MELFL
  348. SEGDES MLEPOI
  349. C
  350. 9999 RETURN
  351. END
  352.  
  353.  
  354.  
  355.  
  356.  

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