Télécharger rlexvb.eso

Retour à la liste

Numérotation des lignes :

  1. C RLEXVB SOURCE CHAT 05/01/13 03:03:11 5004
  2. SUBROUTINE RLEXVB(MELFL,MELFP,MELSOM,MLELEM)
  3. C
  4. C**** Variables de COOPTIO
  5. C
  6. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  7. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  8. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  9. C & ,IECHO, IIMPI, IOSPI
  10. C & ,IDIM
  11. CC & ,MCOORD
  12. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  13. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  14. C & ,NORINC,NORVAL,NORIND,NORVAD
  15. C & ,NUCROU, IPSAUV
  16. C
  17. IMPLICIT INTEGER(I-N)
  18. INTEGER NSOMM, LAST, NTOTN, NTOTE, NBSOUS, NBELEM, NBNO
  19. & , IELEM, NGF, NGF1, INOEU, NGS1, NLS1, ISOUS
  20. & , IPOS1, IPOSV1, NVOIS1, INOEU2, NGS2, NLS2
  21. & , IVOIS, IPOS, IELEMF, I1
  22. LOGICAL LOGCON
  23. C
  24. -INC SMCOORD
  25. -INC SMELEME
  26. INTEGER JG
  27. -INC SMLENTI
  28. -INC CCOPTIO
  29. C
  30. INTEGER NBL, NBTPOI
  31. SEGMENT MLELEM
  32. INTEGER INDEX(NBL+1)
  33. INTEGER LESPOI(NBTPOI)
  34. ENDSEGMENT
  35. C
  36. POINTEUR MELSOM.MELEME, MELFL.MELEME, MELFP.MELEME
  37. & ,MLESOM.MLENTI, MLEFP.MLENTI, MPOS.MLENTI, MTOUC.MLENTI
  38. & ,MLELE1.MLELEM, MELFP1.MELEME
  39. C
  40. C**** Le MELEME SOMMET
  41. C
  42. CALL KRIPAD(MELSOM,MLESOM)
  43. C
  44. C MLESOM: numerotation globale -> locale
  45. C
  46. C**** En KRIPAD
  47. C SEGACT MELSOM
  48. C SEGINI MLESOM
  49. C
  50. NSOMM = MELSOM.NUM(/2)
  51. JG=NSOMM
  52. SEGINI MTOUC
  53. C MTOUC.LECT(NLS1) = surestimation de nombre de voisins de NLS1
  54. SEGINI MPOS
  55. C MPOS.LECT + LAST : liste chaînée des sommets sur le bord
  56. LAST=-1
  57. C
  58. SEGACT MELFP
  59. C
  60. C**** En 2D MELFP est un maillage elementaire
  61. C En 3D pas à priori
  62. C
  63. C NTOTE : nombre total d'elts dans la même structure
  64. C
  65. NTOTN = 0
  66. NTOTE = 0
  67. NBSOUS=MELFP.LISOUS(/1)
  68. C NBSOUS=0 fais un peux chier!
  69. JG=MAX(NBSOUS,1)
  70. SEGINI MLEFP
  71. IF(NBSOUS .EQ. 0)THEN
  72. MLEFP.LECT(1)=MELFP
  73. ELSE
  74. DO ISOUS=1,NBSOUS,1
  75. MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS)
  76. ENDDO
  77. ENDIF
  78. SEGDES MELFP
  79. C
  80. SEGACT MELFL
  81. NBSOUS=MELFL.LISOUS(/1)
  82. IF(NBSOUS .NE. 0)THEN
  83. WRITE(IOIMP,*) 'FACEL = ???'
  84. WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  85. CALL ERREUR(5)
  86. GOTO 9999
  87. ENDIF
  88. C
  89. NBSOUS=JG
  90. IELEMF=0
  91. DO ISOUS = 1, NBSOUS, 1
  92. MELFP1=MLEFP.LECT(ISOUS)
  93. SEGACT MELFP1
  94. NBELEM=MELFP1.NUM(/2)
  95. NBNO=MELFP1.NUM(/1) - 1
  96. DO IELEM = 1, NBELEM,1
  97. IELEMF=IELEMF+1
  98. NGF=MELFP1.NUM(NBNO+1,IELEM)
  99. NGF1=MELFL.NUM(2,IELEMF)
  100. IF(NGF .NE. NGF1)THEN
  101. WRITE(IOIMP,*) 'FACEL = ???'
  102. WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  103. CALL ERREUR(5)
  104. GOTO 9999
  105. ENDIF
  106. IF(MELFL.NUM(1,IELEMF) .EQ. MELFL.NUM(3,IELEMF))THEN
  107. C
  108. C************* La face est sur le bord
  109. C
  110. DO INOEU = 1, NBNO, 1
  111. NGS1 = MELFP1.NUM(INOEU,IELEM)
  112. NLS1 = MLESOM.LECT(NGS1)
  113. IF(MPOS.LECT(NLS1).EQ.0)THEN
  114. NTOTE=NTOTE+1
  115. MPOS.LECT(NLS1)=LAST
  116. LAST=NLS1
  117. ENDIF
  118. ENDDO
  119. ENDIF
  120. ENDDO
  121. ENDDO
  122. C
  123. C NTOTN : nombre total de noeuds dans la structure sommets de bords
  124. C + sommets voisins
  125. C N.B. Les sommets voisins peuvent ne pas etre sur le bord
  126. C
  127. NTOTN = 0
  128. DO ISOUS = 1, NBSOUS, 1
  129. MELFP1=MLEFP.LECT(ISOUS)
  130. NBELEM=MELFP1.NUM(/2)
  131. NBNO=MELFP1.NUM(/1) - 1
  132. DO IELEM = 1, NBELEM,1
  133. DO INOEU = 1, NBNO, 1
  134. NGS1 = MELFP1.NUM(INOEU,IELEM)
  135. NLS1 = MLESOM.LECT(NGS1)
  136. IF(MPOS.LECT(NLS1).NE.0)THEN
  137. C
  138. C******************** Le sommet est sur le bord
  139. C
  140. MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+NBNO -1
  141. NTOTN=NTOTN+(NBNO - 1)
  142. ENDIF
  143. ENDDO
  144. ENDDO
  145. ENDDO
  146. C
  147. C**** On stoke l'informaton dans une LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  148. C
  149. C NBL : NOMBRE D'ELEMENTS
  150. C NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES
  151. C INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  152. C DANS LE TABLEAU LESPOI
  153. C LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  154. C DU IEME ELEMENT
  155. C
  156. C En plus, après le REPEAT UNTIL,
  157. C MPOS.LECT(NLS1) = position du sommet NLS1 i.e.
  158. C J=MPOS.LECT(NLS1) -> NLS1=LESPOI(INDEX(J))
  159. C se voisins sont dedans LESPOI(INDEX(J)+1 -> INDEX(I+1)-1)
  160. NBL=NTOTE
  161. NBTPOI=NBL+NTOTN
  162. SEGINI MLELEM
  163. IPOS1=0
  164. MLELEM.INDEX(1)=1
  165. C
  166. C**** REPEAT UNTIL
  167. C
  168. 1 CONTINUE
  169. NLS1 = LAST
  170. IF(NLS1 .NE. -1)THEN
  171. IPOS1=IPOS1+1
  172. MLELEM.LESPOI(MLELEM.INDEX(IPOS1))=NLS1
  173. LAST = MPOS.LECT(NLS1)
  174. MPOS.LECT(NLS1)=IPOS1
  175. MLELEM.INDEX(IPOS1+1)=MLELEM.INDEX(IPOS1)+MTOUC.LECT(NLS1)+1
  176. MTOUC.LECT(NLS1)=0
  177. GOTO 1
  178. ENDIF
  179. C
  180. C**** N.B. MTOUC.LECT(I) = 0 \forall I
  181. C
  182. C Fin REPEAT UNTIL
  183. C On remplie LESPOI
  184. C
  185. DO ISOUS = 1, NBSOUS, 1
  186. MELFP1 = MLEFP.LECT(ISOUS)
  187. NBELEM=MELFP1.NUM(/2)
  188. NBNO=MELFP1.NUM(/1) - 1
  189. DO IELEM = 1, NBELEM, 1
  190. DO INOEU = 1, NBNO, 1
  191. NGS1 = MELFP1.NUM(INOEU,IELEM)
  192. NLS1 = MLESOM.LECT(NGS1)
  193. C IPOS1 = 0 -> NGS1 n'est pas sur le bords
  194. C IPOS1 = C > 0
  195. C C= position de NGS1 (NLS1) dedans MLELEM.INDEX
  196. IPOS1 = MPOS.LECT(NLS1)
  197. IF(IPOS1 .GT. 0)THEN
  198. C
  199. C IPOSV1 = position du premier voisin de NLS1 dedans
  200. C MLEMEM.LESPOI
  201. IPOSV1 = MLELEM.INDEX(IPOS1)+1
  202. C NVOIS1 = surestimation du nombre de voisins de NLS1
  203. NVOIS1 = MLELEM.INDEX(IPOS1+1)-IPOSV1
  204. DO INOEU2 = 1, NBNO, 1
  205. NGS2=MELFP1.NUM(INOEU2,IELEM)
  206. IF(NGS1 .NE. NGS2)THEN
  207. NLS2 = MLESOM.LECT(NGS2)
  208. IVOIS=0
  209. C
  210. C**************** REPEAT UNTIL
  211. C
  212. 10 CONTINUE
  213. IF(MLELEM.LESPOI(IPOSV1+IVOIS) .EQ. 0)THEN
  214. MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
  215. MLELEM.LESPOI(IPOSV1+IVOIS) = NLS2
  216. ELSE
  217. LOGCON = (NLS2 .NE. MLELEM.LESPOI(IPOSV1
  218. $ +IVOIS))
  219. IVOIS=IVOIS+1
  220. IF(LOGCON)THEN
  221. IF(IVOIS .GT. NVOIS1)THEN
  222. C
  223. C************************* Il y a un erreur de programmation (NVOIS1 n'a
  224. C pas bien été évalué)
  225. C
  226. WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  227. CALL ERREUR(5)
  228. GOTO 9999
  229. ELSE
  230. GOTO 10
  231. ENDIF
  232. ENDIF
  233. ENDIF
  234. ENDIF
  235. ENDDO
  236. ENDIF
  237. ENDDO
  238. ENDDO
  239. SEGDES MELFP1
  240. ENDDO
  241. SEGSUP MLEFP
  242. C
  243. C**** LESPOI SURDIMENSIONÉ
  244. C
  245. NBTPOI=0
  246. DO IELEM = 1 , NTOTE, 1
  247. NLS1 = MLELEM.LESPOI(MLELEM.INDEX(IELEM))
  248. NBTPOI=NBTPOI+1+MTOUC.LECT(NLS1)
  249. ENDDO
  250. NBL=NTOTE
  251. SEGINI MLELE1
  252. C
  253. MLELE1.INDEX(1)=1
  254. DO IELEM = 1, NBL , 1
  255. IPOS=MLELEM.INDEX(IELEM)
  256. IPOS1=MLELE1.INDEX(IELEM)
  257. NLS1 = MLELEM.LESPOI(IPOS)
  258. NGS1 = MELSOM.NUM(1,NLS1)
  259. NVOIS1 = MTOUC.LECT(NLS1)
  260. MLELE1.LESPOI(IPOS1)=NGS1
  261. MLELE1.INDEX(IELEM+1)=MLELE1.INDEX(IELEM)+NVOIS1+1
  262. DO INOEU = 1, NVOIS1, 1
  263. NLS2 = MLELEM.LESPOI(IPOS+INOEU)
  264. IF(NLS2 .EQ.0)THEN
  265. WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  266. CALL ERREUR(5)
  267. GOTO 9999
  268. ELSE
  269. NGS2=MELSOM.NUM(1,NLS2)
  270. MLELE1.LESPOI(IPOS1+INOEU)=NGS2
  271. ENDIF
  272. ENDDO
  273. ENDDO
  274. C
  275. SEGSUP MLELEM
  276. MLELEM=MLELE1
  277. C
  278. SEGSUP MLESOM
  279. SEGSUP MPOS
  280. SEGSUP MTOUC
  281. SEGDES MLELEM
  282. SEGDES MELSOM
  283. SEGDES MELFL
  284. C
  285. C**** Problème détecté dans un cas test: mal-conditionnent
  286. C de la matrice associé à la méthode de moindres carres
  287. C aux bords.
  288. C Quand possible, on elimine de MLELEM tous les voisins
  289. C sommets qui sont sur le bord -> MLELE1
  290. C
  291. SEGACT MLELEM
  292. NBL=MLELEM.INDEX(/1)-1
  293. NBTPOI=MLELEM.LESPOI(/1)
  294. SEGINI MLELE1
  295. C
  296. C**** MLESOM.MLENTI contient les sommets aux bords
  297. C
  298. JG=MCOORD.XCOOR(/1)/(IDIM+1)
  299. SEGINI MLESOM
  300. DO IELEM=1,NBL,1
  301. IPOS=MLELEM.INDEX(IELEM)
  302. NGS1=MLELEM.LESPOI(IPOS)
  303. MLESOM.LECT(NGS1)=IELEM
  304. ENDDO
  305. C
  306. C
  307. C**** On rempli MLELE1
  308. C
  309. NBTPOI=0
  310. NVOIS1=0
  311. C
  312. C**** Pour chaque SOMMET NGS1, NVOIS1 = nombre des voisins qui ne
  313. C sont pas sur le bords
  314. C
  315. IPOS1=MLELEM.INDEX(1)
  316. DO IELEM=1,NBL,1
  317. IPOS=IPOS1
  318. IPOS1=MLELEM.INDEX(1+IELEM)
  319. NBTPOI=NBTPOI+1
  320. MLELE1.INDEX(IELEM)=NBTPOI
  321. NGS1=MLELEM.LESPOI(IPOS)
  322. MLELE1.LESPOI(NBTPOI)=NGS1
  323. DO I1=IPOS+1,IPOS1-1,1
  324. NGS2=MLELEM.LESPOI(I1)
  325. NLS2=MLESOM.LECT(NGS2)
  326. IF(NLS2.EQ.0)THEN
  327. C
  328. C************* NGS2 n'est pas sur le bord
  329. C
  330. NVOIS1=NVOIS1+1
  331. MLELE1.LESPOI(NBTPOI+NVOIS1)=NGS2
  332. ENDIF
  333. ENDDO
  334. IF(NVOIS1.EQ.0)THEN
  335. C
  336. C********** Tous les voisins de NGS1 sont sur le bords
  337. C
  338. DO I1=IPOS+1,IPOS1-1,1
  339. NGS2=MLELEM.LESPOI(I1)
  340. NVOIS1=NVOIS1+1
  341. MLELE1.LESPOI(NBTPOI+NVOIS1)=NGS2
  342. ENDDO
  343. ENDIF
  344. NBTPOI=NBTPOI+NVOIS1
  345. NVOIS1=0
  346. ENDDO
  347. MLELE1.INDEX(NBL+1)=NBTPOI+1
  348. C
  349. SEGSUP MLELEM
  350. SEGADJ MLELE1
  351. MLELEM=MLELE1
  352. SEGDES MLELEM
  353. SEGSUP MLESOM
  354. C
  355. 9999 RETURN
  356. END
  357.  
  358.  
  359.  

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