Télécharger duali2.eso

Retour à la liste

Numérotation des lignes :

  1. C DUALI2 SOURCE CHAT 05/01/12 22:58:38 5004
  2. C DUALISE LE RESULTAT DE SURF POUR LE MAILLAGE PAR POLYGONE
  3. C
  4. SUBROUTINE DUALI2(FER,XPRO,XPROJ1,IPT2,NUMELG,NDEB,NUMNP)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. LOGICAL PORDO
  8. SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR)
  9. SEGMENT XPRO
  10. REAL*8 XPROJ(3,1)
  11. ENDSEGMENT
  12. POINTEUR XPROJ1.XPRO
  13. SEGMENT ILIST(NBNN)
  14. SEGMENT INB(NUMNP)
  15. -INC SMELEME
  16. POINTEUR POLY.MELEME, POLY1.MELEME
  17. *
  18. DO 84, NUCOT = 1, ITOUR
  19. *
  20. IDEB = MAI(NUCOT)
  21. IFIN = MAI(NUCOT+1)-1
  22. *
  23. DO 84, IP2 = IDEB, IFIN
  24. *
  25. 84 CONTINUE
  26.  
  27. IAUX=XPRO
  28. XPRO=XPROJ1
  29. XPROJ1=IAUX
  30. SEGINI INB
  31. * ON CREE UN NOEUD AU CENTRE DE GRAVITE DE CHAQUE TRIANGLE
  32. DO 15 I=1,NUMELG
  33. *
  34. XPROJ(1,NDEB+I-1)=0.
  35. XPROJ(2,NDEB+I-1)=0.
  36. XPROJ(3,NDEB+I-1)=0.
  37. DO 10 J=1,3
  38. IP=IPT2.NUM(J,I)
  39. INB(IP)=INB(IP)+1
  40. XPROJ(1,NDEB+I-1)=XPROJ(1,NDEB+I-1)+XPROJ1.XPROJ(1,IP)
  41. XPROJ(2,NDEB+I-1)=XPROJ(2,NDEB+I-1)+XPROJ1.XPROJ(2,IP)
  42. XPROJ(3,NDEB+I-1)=XPROJ(3,NDEB+I-1)+XPROJ1.XPROJ(3,IP)
  43. 10 CONTINUE
  44. XPROJ(1,NDEB+I-1)=XPROJ(1,NDEB+I-1)/3
  45. XPROJ(2,NDEB+I-1)=XPROJ(2,NDEB+I-1)/3
  46. XPROJ(3,NDEB+I-1)=XPROJ(3,NDEB+I-1)/3
  47. 15 CONTINUE
  48. * ON CONSTRUIT LES ELEMENTS
  49. NBNN=0
  50. DO 20 IP=1,NUMNP
  51. NBNN=MAX(INB(IP),NBNN)
  52. INB(IP)=0
  53. 20 CONTINUE
  54. *
  55. SEGINI ILIST
  56. NBELEM=NUMNP
  57. NBSOUS=0
  58. NBREF=0
  59. SEGINI MELEME
  60. ITYPEL=32
  61. DO 35 I=1,NUMELG
  62. DO 30 J=1,3
  63. IP=IPT2.NUM(J,I)
  64. INB(IP)=INB(IP)+1
  65. NUM(INB(IP),IP)=I
  66. 30 CONTINUE
  67. 35 CONTINUE
  68. *
  69. NUMNP = NUMELG + NDEB - 1
  70. NUMELG = NBELEM
  71. *
  72. * MAINTENANT IL FAUT REPASSER LES ELEMENTS POUR METTRE LES NOEUDS
  73. * DANS LE BON SENS ET S'OCCUPER DES BORDS
  74. *
  75. DO 100 INT=1,NBELEM
  76. *
  77. * Ordonnancement
  78. *
  79. NUSP = 0
  80. PORDO = .FALSE.
  81. *
  82. * TANT QUE LE POLYGONE N'EST PAS ENTIEREMENT ORDONNEE
  83. *
  84. 50 CONTINUE
  85. *
  86. * Boucle sur tous les triangles voisins
  87. *
  88. DO 70 I=1,INB(INT)
  89. *
  90. ICT = NUM(I,INT)
  91. *
  92. * Boucle sur les sommets du triangle associé
  93. *
  94. DO 60 K=1,3
  95. IF (IPT2.NUM(K,ICT).EQ.INT) THEN
  96. *
  97. * C'est le centre du polygone
  98. *
  99. INT1 = IPT2.NUM(MOD(K,3)+1,ICT)
  100. INT2 = IPT2.NUM(MOD(K+1,3)+1,ICT)
  101. *
  102. IF (NUSP.EQ.0) THEN
  103. *
  104. * Pas encore de sommets mémorisés
  105. *
  106. IF (INT.LT.NDEB) THEN
  107. *
  108. * Le centre du polygone est sur le coté
  109. *
  110. INP3 = NUSOM(INT1, INT, FER, NDEB)
  111. INP4 = NUSOM(INT2, INT, FER, NDEB)
  112. *
  113. IF (INP3.NE.0) THEN
  114. *
  115. * Premier sommet du polygone
  116. *
  117. ILIST(1) = INP3
  118. ILIST(2) = ICT + NDEB - 1
  119. INTF = INT2
  120. NUSP = 2
  121. *
  122. IF (INP4.NE.0) THEN
  123. *
  124. * Le polygone est triangulaire
  125. *
  126. ILIST(3) = INP4
  127. PORDO = .TRUE.
  128. NUSP = 3
  129. *
  130. ENDIF
  131. *
  132. ELSEIF (INP4.NE.0) THEN
  133. *
  134. * Premier sommet du polygone
  135. *
  136. ILIST(1) = INP4
  137. ILIST(2) = ICT + NDEB - 1
  138. INTF = INT1
  139. NUSP = 2
  140. *
  141. ENDIF
  142. ELSE
  143. *
  144. * Le centre du polygone est au milieu de la surface
  145. *
  146. ILIST(1) = ICT + NDEB - 1
  147. INTD = INT1
  148. INTF = INT2
  149. NUSP = 1
  150. *
  151. ENDIF
  152. *
  153. ELSE
  154. *
  155. * Des noeuds sont deja memorisés
  156. *
  157. IF (INT1.EQ.INTF.OR.INT2.EQ.INTF) THEN
  158. *
  159. NUSP = NUSP+1
  160. ILIST (NUSP) = ICT + NDEB - 1
  161. *
  162. IF (INT1.EQ.INTF) THEN
  163. INTF = INT2
  164. ELSE IF (INT2.EQ.INTF) THEN
  165. INTF = INT1
  166. ENDIF
  167. *
  168. IF (INTF.EQ.INTD) THEN
  169. *
  170. * Polygone fermé
  171. *
  172. PORDO = .TRUE.
  173. *
  174. ENDIF
  175. *
  176. INP3 = NUSOM(INTF, INT, FER, NDEB)
  177. *
  178. IF (INP3.NE.0) THEN
  179. *
  180. * Le deux sommets sont voisins sur la frontiere
  181. * => on ferme le polygone
  182. *
  183. NUSP = NUSP+1
  184. ILIST (NUSP) = INP3
  185. PORDO = .TRUE.
  186. *
  187. ENDIF
  188. *
  189. ENDIF
  190. *
  191. ENDIF
  192. *
  193. ENDIF
  194. *
  195. 60 CONTINUE
  196. *
  197. 70 CONTINUE
  198. *
  199. IF (.NOT.PORDO) GOTO 50
  200. *
  201. * Stockage du maillage dans un segment MELEME
  202. *
  203. IF (INT.EQ.1) THEN
  204. *
  205. * Initialisation du pointeur chapeau du maillage
  206. *
  207. NBNN = 0
  208. NBELEM = 0
  209. NBREF = 0
  210. NBSOUS = 1
  211. SEGINI POLY1
  212. *
  213. ELSE
  214. *
  215. * Recherche si un polygone a NUSP cotés existe deja dans MELEME
  216. *
  217. NBELEM = 0
  218. *
  219. DO 80 I=1, POLY1.LISOUS(/1)
  220. *
  221. POLY = POLY1.LISOUS(I)
  222. *
  223. IF (POLY.NUM(/1).EQ.NUSP) THEN
  224. *
  225. NBELEM = POLY.NUM(/2)+1
  226. NBNN = NUSP
  227. NBSOUS = 0
  228. NBREF = 0
  229. *
  230. SEGADJ POLY
  231. GOTO 81
  232. *
  233. ENDIF
  234. *
  235. 80 CONTINUE
  236. 81 CONTINUE
  237. *
  238. IF (NBELEM.EQ.0) THEN
  239. *
  240. NBNN = 0
  241. NBELEM = 0
  242. NBREF = 0
  243. NBSOUS = POLY1.LISOUS(/1)+1
  244. SEGADJ POLY1
  245. *
  246. ENDIF
  247. *
  248. ENDIF
  249. *
  250. IF (NBELEM.EQ.0) THEN
  251. *
  252. * Creation de l'element a NUSP cote
  253. *
  254. NBELEM = 1
  255. NBNN = NUSP
  256. NBSOUS = 0
  257. NBREF = 0
  258. *
  259. SEGINI POLY
  260. *
  261. NBSOUS = POLY1.LISOUS(/1)
  262. POLY1.LISOUS(NBSOUS) = POLY
  263. POLY.ITYPEL = 32
  264. *
  265. ENDIF
  266. *
  267. * Recopie des données dans le MELEME
  268. *
  269. DO 90 I = 1, NUSP
  270. *
  271. POLY.NUM(I, NBELEM) = ILIST(I)
  272. *
  273. 90 CONTINUE
  274. *
  275. 100 CONTINUE
  276. *
  277. * Recopie du nouveau MELEME dans l'ancien
  278. *
  279. IPT3 = IPT2
  280. IPT2 = POLY1
  281. *
  282. SEGSUP IPT3
  283. *
  284. END
  285.  
  286.  
  287.  

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