Télécharger duali2.eso

Retour à la liste

Numérotation des lignes :

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

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