Télécharger @inclusi.procedur

Retour à la liste

Numérotation des lignes :

  1. * @INCLUSI PROCEDUR PASCAL 12/11/14 21:15:01 7568
  2. 'DEBP' @INCLUSI THO7U*'TABLE' DPAR1*'FLOTTANT' DREP1*'FLOTTANT' ;
  3. * *
  4. *----------------------------------------------------------------------*
  5. * *
  6. * Pre-traitement Maillage Particules-Matrice *
  7. * *
  8. *----------------------------------------------------------------------*
  9. * *
  10. *------------------------ Lecture des entrees -------------------------*
  11. * *
  12. * Entrees : *
  13. * --------- *
  14. * THO7U : Table maillage cube Voronoi ; *
  15. * DPAR1 : Diametre des particules ; *
  16. * DREP1 : Distance de repulsion ; *
  17. * DENS1 : Densite de reference ; *
  18. * ITRA1 : Indicateur traces ; *
  19. 'ARGU' DENS1/'FLOTTANT' ;
  20. 'SI' ('NON' ('EXIS' DENS1)) ;
  21. DENS1 = 0.25 * (('FLOT' ('NBNO' THO7U . 'MPT')) ** (-1. / 3.)) ;
  22. 'FINS' ;
  23. 'ARGU' ITRA1/'LOGIQUE' ;
  24. 'SI' ('NON' ('EXIS' ITRA1)) ;
  25. ITRA1 = FAUX ;
  26. 'FINS' ;
  27. * *
  28. * Variables locales : *
  29. * ------------------- *
  30. * VOR1 : Maillage aretes cellules de Voronoi ; *
  31. * MPOI1 : Points centre des cellules ; *
  32. * RPAR1 : Rayon des particules ; *
  33. * ELIGM1 : Epaisseur Minimale des ligaments de matrice ; *
  34. * FTET1 : Facteur de forme des tetraedres (rapport Cote/Hauteur *
  35. * tetraedre regulier) ; *
  36. * DENSM1 : Densite minimale du maillage ~ demi-distance entre + petit *
  37. * ligament de matrice possible (au facteur de forme Pres) ; *
  38. * XELIM1 : Facteur d'elimination noeuds des polyedres ; *
  39. * RELIM1 : Rayon d'elimination des noeuds sommets des cellules de *
  40. * Voronoi ; *
  41. * TOL1 : Tolerance ~ precision de la geometrie ; *
  42. *
  43. *
  44. MVOR1 = THO7U . 'MAV' ;
  45. MPOI1 = THO7U . 'MPT' ;
  46. RPAR1 = 0.5 * DPAR1 ;
  47. ELIGM1 = (0.5 * DREP1) - RPAR1 ;
  48. FTET1 = 1.5 ** 0.5 ;
  49. DENSM1 = FTET1 * ELIGM1 ;
  50. XELIM1 = 0.2 ;
  51. RELIM1 = XELIM1 * DENS1 ;
  52. TOL1 = 1.E-3 * ELIGM1 ;
  53. * *
  54. *------ Elimination Sommets "Tres Proches" Cellules de Voronoi --------*
  55. * *
  56. * Elimination des petites aretes de la partition de Voronoi : *
  57. 'ELIM' MVOR1 RELIM1 ;
  58. * *
  59. * Recollement des faces de la partition sur celle du cube unite : *
  60. PM1 = 0. 0. 0. ;
  61. PM2 = 1. 0. 0. ;
  62. PM3 = 1. 1. 0. ;
  63. PM4 = 0. 1. 0. ;
  64. PM5 = 0. 0. 1. ;
  65. PM6 = 1. 0. 1. ;
  66. PM7 = 1. 1. 1. ;
  67. PM8 = 0. 1. 1. ;
  68. 'DEPL' (THO7U . 'FACE1') 'PROJ' 'CYLI' (-1. * PM5) 'PLAN' PM1 PM2 PM3 ;
  69. 'DEPL' (THO7U . 'FACE2') 'PROJ' 'CYLI' (-1. * PM4) 'PLAN' PM1 PM2 PM5 ;
  70. 'DEPL' (THO7U . 'FACE3') 'PROJ' 'CYLI' (-1. * PM2) 'PLAN' PM1 PM4 PM5 ;
  71. 'DEPL' (THO7U . 'FACE4') 'PROJ' 'CYLI' PM2 'PLAN' PM2 PM3 PM6 ;
  72. 'DEPL' (THO7U . 'FACE5') 'PROJ' 'CYLI' PM4 'PLAN' PM3 PM4 PM7 ;
  73. 'DEPL' (THO7U . 'FACE6') 'PROJ' 'CYLI' PM5 'PLAN' PM5 PM6 PM7 ;
  74. * *
  75. VELE1 = 'VALE' 'ELEM' ;
  76. 'OPTI' 'ELEM' 'CUB8' ;
  77. MVCB1 = ((PM1 'DROI' 1 PM2) 'TRAN' 1 PM4) 'VOLU' 'TRAN' 1 PM5 ;
  78. 'OPTI' 'ELEM' VELE1 ;
  79. MSCB1 = 'ENVE' MVCB1 ;
  80. MACB1 = 'ARET' MVCB1 ;
  81. MPCB1 = 'CHAN' 'POI1' MVCB1 ;
  82. * *
  83. *----------------------- Travail Preparatoire -------------------------*
  84. * *
  85. * 1. "Nettoyer" les contours des faces + Reperage Faces Bord Cube ; *
  86. * 2. Reperer les aretes ; *
  87. * *
  88. * 1. Nettoyages des Faces + Reperage Faces Bord Cube : *
  89. NBI1 = 'NBEL' MPOI1 ;
  90. TIP8V = 'TABL' ;
  91. IPREMI1 = VRAI ;
  92. 'REPE' BI1 NBI1 ;
  93. PCI1 = MPOI1 'POIN' &BI1 ;
  94. TIP8V . PCI1 = 'TABL' ;
  95. MPTI1 = THO7U . PCI1 . 'MPT' ;
  96. NBJ1 = NBNO MPTI1 ;
  97. IPREMJ1 = VRAI ;
  98. * *
  99. * Boucle sur les faces des polyedres : *
  100. 'REPE' BJ1 NBJ1 ;
  101. PCJ1 = MPTI1 'POIN' &BJ1 ;
  102. CNTIJ1 = THO7U . PCI1 . PCJ1 . 'MAV' ;
  103. NBPCIJ1 = NBNO CNTIJ1 ;
  104. 'SI' (NBPCIJ1 '<' 3) ;
  105. 'ITER' BJ1 ;
  106. 'FINS' ;
  107. * *
  108. * Si cette Face a deja ete traitee, on recopie puis on itere : *
  109. 'SI' ('EXIS' TIP8V PCJ1) ;
  110. TIP8V . PCI1 . PCJ1 = 'TABL' ;
  111. TIP8V . PCI1 . PCJ1 . 'MAV' = TIP8V . PCJ1 . PCI1 . 'MAV' ;
  112. TIP8V . PCI1 . PCJ1 . 'EXT' = TIP8V . PCJ1 . PCI1 . 'EXT' ;
  113. 'SI' IPREMJ1 ;
  114. IPREMJ1 = FAUX ;
  115. TIP8V . PCI1 . 'MPT' = PCJ1 ;
  116. TIP8V . PCI1 . 'MAV' = TIP8V . PCJ1 . PCI1 . 'MAV' ;
  117. 'SINO' ;
  118. TIP8V . PCI1 . 'MPT' = TIP8V . PCI1 . 'MPT' 'ET' PCJ1 ;
  119. TIP8V . PCI1 . 'MAV' = TIP8V . PCI1 . 'MAV'
  120. 'ET' TIP8V . PCJ1 . PCI1 . 'MAV' ;
  121. 'FINS' ;
  122. 'ITER' BJ1 ;
  123. 'FINS' ;
  124. * *
  125. * Sinon, on teste NBNO-NBEL pour det. presence aretes degenerees : *
  126. * CNTIJ2 sera le contour valide de la Face. *
  127. 'SI' (NBPCIJ1 'EGA' ('NBEL' CNTIJ1)) ;
  128. CNTIJ2 = CNTIJ1 ;
  129. 'SINO' ;
  130. * Si aretes degenerees => reconstruction du contour : *
  131. NBK1 = 'NBEL' CNTIJ1 ;
  132. IPREMK1 = VRAI ;
  133. 'REPE' BK1 NBK1 ;
  134. ELK1 = CNTIJ1 'ELEM' &BK1 ;
  135. PSK1 = ELK1 'POIN' 1 ;
  136. PSK2 = ELK1 'POIN' 2 ;
  137. 'SI' (PSK1 'NEG' PSK2) ;
  138. 'SI' IPREMK1 ;
  139. IPREMK1 = FAUX ;
  140. CNTIJ2 = ELK1 ;
  141. 'SINO' ;
  142. CNTIJ2 = CNTIJ2 'ET' ELK1 ;
  143. 'FINS' ;
  144. 'FINS' ;
  145. 'FIN' BK1 ;
  146. 'FINS' ;
  147. * On ordonne CNTIJ2 ; *
  148. CNTIJ2 = CNTIJ2 'ELEM' 'COMP' (CNTIJ2 'POIN' 1)
  149. (CNTIJ2 'POIN' 1) ;
  150. * *
  151. * Construction d'un point ref. pour la Face Si Face situee sur les *
  152. * Bords du Cube (PCJ2) : *
  153. IEXT1 = 'NON' ('EXIS' THO7U PCJ1) ;
  154. 'SI' IEXT1 ;
  155. NX0 = 0 ; NY0 = 0 ; NZ0 = 0 ;
  156. NX1 = 0 ; NY1 = 0 ; NZ1 = 0 ;
  157. NBK1 = NBNO CNTIJ2 ;
  158. 'REPE' BK1 NBK1 ;
  159. PSK1 = CNTIJ2 'POIN' &BK1 ;
  160. XK1 YK1 ZK1 = PSK1 'COOR' ;
  161. 'SI' (XK1 'EGA' 0.) ; NX0 = NX0 + 1 ; 'FINS' ;
  162. 'SI' (YK1 'EGA' 0.) ; NY0 = NY0 + 1 ; 'FINS' ;
  163. 'SI' (ZK1 'EGA' 0.) ; NZ0 = NZ0 + 1 ; 'FINS' ;
  164. 'SI' (XK1 'EGA' 1.) ; NX1 = NX1 + 1 ; 'FINS' ;
  165. 'SI' (YK1 'EGA' 1.) ; NY1 = NY1 + 1 ; 'FINS' ;
  166. 'SI' (ZK1 'EGA' 1.) ; NZ1 = NZ1 + 1 ; 'FINS' ;
  167. 'FIN' BK1 ;
  168. NMAX1 = 'MAXI' ('LECT' NX0 NY0 NZ0 NX1 NY1 NZ1) ;
  169. 'SI' (NMAX1 'EGA' NX0) ;
  170. PRCIJ1 = PM1 ;
  171. PNCIJ1 = -1. 0. 0. ;
  172. 'FINS' ;
  173. 'SI' (NMAX1 'EGA' NX1) ;
  174. PRCIJ1 = PM2 ;
  175. PNCIJ1 = 1. 0. 0. ;
  176. 'FINS' ;
  177. 'SI' (NMAX1 'EGA' NY0) ;
  178. PRCIJ1 = PM1 ;
  179. PNCIJ1 = 0. -1. 0. ;
  180. 'FINS' ;
  181. 'SI' (NMAX1 'EGA' NY1) ;
  182. PRCIJ1 = PM4 ;
  183. PNCIJ1 = 0. 1. 0. ;
  184. 'FINS' ;
  185. 'SI' (NMAX1 'EGA' NZ0) ;
  186. PRCIJ1 = PM1 ;
  187. PNCIJ1 = 0. 0. -1. ;
  188. 'FINS' ;
  189. 'SI' (NMAX1 'EGA' NZ1) ;
  190. PRCIJ1 = PM5 ;
  191. PNCIJ1 = 0. 0. 1. ;
  192. 'FINS' ;
  193. *List NMAX1 ; List PRCIJ1 ; List PNCIJ1 ;
  194. *Trac ((CNTIJ2 Coul Roug) Et A1) ;
  195. XR1 YR1 ZR1 = PNCIJ1 'COOR' ;
  196. PTCIJ1 = ZR1 XR1 YR1 ;
  197. PTCIJ2 = YR1 ZR1 XR1 ;
  198. PPCIJ1 = PRCIJ1 'PLUS' PTCIJ1 ;
  199. PPCIJ2 = PRCIJ1 'PLUS' PTCIJ2 ;
  200. PCJ2 = PCI1 'SYME' 'PLAN' PRCIJ1 PPCIJ1 PPCIJ2 ;
  201. *Trac Qual ((CNTIJ2 Coul Rose) Et THO7U . PCI1 . Mav Et PCI1 Et PCJ2) ;
  202. 'SINO' ;
  203. PCJ2 = PCJ1 ;
  204. 'FINS' ;
  205. TIP8V . PCI1 . PCJ2 = 'TABL' ;
  206. TIP8V . PCI1 . PCJ2 . 'MAV' = CNTIJ2 ;
  207. TIP8V . PCI1 . PCJ2 . 'EXT' = IEXT1 ;
  208. 'SI' IPREMJ1 ;
  209. IPREMJ1 = FAUX ;
  210. TIP8V . PCI1 . 'MPT' = 'MANU' 'POI1' PCJ2 ;
  211. TIP8V . PCI1 . 'MAV' = CNTIJ2 ;
  212. 'SINO' ;
  213. TIP8V . PCI1 . 'MPT' = TIP8V . PCI1 . 'MPT' 'ET' PCJ2 ;
  214. TIP8V . PCI1 . 'MAV' = TIP8V . PCI1 . 'MAV' 'ET' CNTIJ2 ;
  215. 'FINS' ;
  216. 'FIN' BJ1 ;
  217. 'SI' (('DIME' TIP8V . PCI1) '>' 0) ;
  218. 'SI' IPREMI1 ;
  219. IPREMI1 = FAUX ;
  220. TIP8V . 'MPT' = 'MANU' 'POI1' PCI1 ;
  221. TIP8V . 'MAV' = TIP8V . PCI1 . 'MAV' ;
  222. 'SINO' ;
  223. TIP8V . 'MPT' = TIP8V . 'MPT' 'ET' PCI1 ;
  224. TIP8V . 'MAV' = TIP8V . 'MAV' 'ET' TIP8V . PCI1 . 'MAV' ;
  225. 'FINS' ;
  226. 'FINS' ;
  227. 'FIN' BI1 ;
  228. MPOI1 = TIP8V . 'MPT' ;
  229. * *
  230. * 2. Reperer les aretes par les 3 polyedres qui les definissent : *
  231. * *
  232. NBI1 = NBNO MPOI1 ;
  233. THO7U = 'TABL' ;
  234. IPREMI1 = VRAI ;
  235. 'REPE' BI1 NBI1 ;
  236. PCI1 = MPOI1 'POIN' &BI1 ;
  237. THO7U . PCI1 = 'TABL' ;
  238. MPTI1 = TIP8V . PCI1 . 'MPT' ;
  239. NBJ1 = NBNO MPTI1 ;
  240. IPREMJ1 = VRAI ;
  241. 'REPE' BJ1 NBJ1 ;
  242. PCJ1 = MPTI1 'POIN' &BJ1 ;
  243. THO7U . PCI1 . PCJ1 = 'TABL' ;
  244. CNTIJ1 = TIP8V . PCI1 . PCJ1 . 'MAV' ;
  245. 'SI' ('EXIS' THO7U PCJ1) ;
  246. MPTIJ2 = THO7U . PCJ1 . PCI1 . 'MPT' ;
  247. CNTIJ2 = THO7U . PCJ1 . PCI1 . 'MAV' ;
  248. THO7U . PCI1 . PCJ1 = THO7U . PCJ1 . PCI1 ;
  249. 'SINO' ;
  250. MPTIJ1 = MPTI1 'DIFF' ('MANU' 'POI1' PCJ1) ;
  251. NBK1 = 'NBEL' CNTIJ1 ;
  252. IPREMK1 = VRAI ;
  253. 'REPE' BK1 NBK1 ;
  254. ELK1 = CNTIJ1 'ELEM' &BK1 ;
  255. NBL1 = NBNO MPTIJ1 ;
  256. 'REPE' BL1 NBL1 ;
  257. PCL1 = MPTIJ1 'POIN' &BL1 ;
  258. CNTIL1 = TIP8V . PCI1 . PCL1 . 'MAV' ;
  259. ELL1 = CNTIJ1 'INTE' CNTIL1 'NOVE' ;
  260. NBM1 = 'NBEL' ELL1 ;
  261. 'SI' (NBM1 'NEG' 0) ;
  262. 'REPE' BM1 NBM1 ;
  263. ELM1 = ELL1 'ELEM' &BM1 ;
  264. 'SI' ((NBNO (ELK1 'DIFF' ELM1)) 'EGA' 0) ;
  265. 'SI' ('EXIS' THO7U . PCI1 . PCJ1 PCL1) ;
  266. THO7U . PCI1 . PCJ1 . PCL1 . 'MAV' =
  267. THO7U . PCI1 . PCJ1 . PCL1 . 'MAV' 'ET' ELK1 ;
  268. 'SINO' ;
  269. THO7U . PCI1 . PCJ1 . PCL1 = 'TABL' ;
  270. THO7U . PCI1 . PCJ1 . PCL1 . 'MAV' = ELK1 ;
  271. 'FINS' ;
  272. 'SI' IPREMK1 ;
  273. IPREMK1 = FAUX ;
  274. MPTIJ2 = 'MANU' 'POI1' PCL1 ;
  275. CNTIJ2 = ELM1 ;
  276. 'SINO' ;
  277. 'SI' ('NON' ('DANS' PCL1 MPTIJ2)) ;
  278. MPTIJ2 = MPTIJ2 'ET' PCL1 ;
  279. 'FINS' ;
  280. CNTIJ2 = CNTIJ2 'ET' ELM1 ;
  281. 'FINS' ;
  282. 'ITER' BK1 ;
  283. 'FINS' ;
  284. 'FIN' BM1 ;
  285. 'FINS' ;
  286. 'FIN' BL1 ;
  287. 'FIN' BK1 ;
  288. THO7U . PCI1 . PCJ1 . 'MPT' = MPTIJ2 ;
  289. THO7U . PCI1 . PCJ1 . 'MAV' = CNTIJ2 ;
  290. 'FINS' ;
  291. 'SI' IPREMJ1 ;
  292. IPREMJ1 = FAUX ;
  293. MPTI2 = 'MANU' 'POI1' PCJ1 ;
  294. MAVI2 = CNTIJ2 ;
  295. 'SINO' ;
  296. MPTI2 = MPTI2 'ET' PCJ1 ;
  297. MAVI2 = MAVI2 'ET' CNTIJ2 ;
  298. 'FINS' ;
  299. * Petit Test : *
  300. MTEST1 = CNTIJ2 'DIFF' CNTIJ1 ;
  301. 'SI' (((NBNO MTEST1) + ('NBEL' MTEST1)) 'NEG' 0) ;
  302. 'SAUT' 1 'LIGN' ;
  303. 'TITR' ' ***** Probleme Reperage Aretes ' ;
  304. 'TRAC' (CNTIJ1 'ET' (CNTIJ2 'COUL' 'ORAN')) ;
  305. 'QUIT' BI1 ;
  306. 'FINS' ;
  307. * Re-petit test : on verifie qu'en parcourant les points de MPTIJ2, *
  308. * on parcourt de facon ordonnee le contour : *
  309. * 'REPE' BX1 (NBNO MPTIJ2) ;
  310. * PX1 = MPTIJ2 'POIN' &BX1 ;
  311. * Trac Elem (CNTIJ1 Et (THO7U . PCI1 . PCJ1 . PX1 . Mav Coul Vert)) ;
  312. * 'FIN' BX1 ;
  313. 'FIN' BJ1 ;
  314. * Stockage resultats boucle BI1 : *
  315. THO7U . PCI1 . 'MPT' = MPTI2 ;
  316. THO7U . PCI1 . 'MAV' = MAVI2 ;
  317. 'SI' IPREMI1 ;
  318. IPREMI1 = FAUX ;
  319. MPT2 = 'MANU' 'POI1' PCI1 ;
  320. MAV2 = MAVI2 ;
  321. 'SINO' ;
  322. MPT2 = MPT2 'ET' PCI1 ;
  323. MAV2 = MAV2 'ET' MAVI2 ;
  324. 'FINS' ;
  325. 'FIN' BI1 ;
  326. THO7U . 'MPT' = MPT2 ;
  327. THO7U . 'MAV' = MAV2 ;
  328. * *
  329. *----------------------------------------------------------------------*
  330. * *
  331. * Maillage Particules-Matrice *
  332. * *
  333. *----------------------------------------------------------------------*
  334. * *
  335. * NBI1 : Nombre de particules du tirage : *
  336. NBI1 = NBNO MPOI1 ;
  337. * *
  338. * FDENS1 : Facteur densite locale d'elements = Nbr. moyen d'elements *
  339. * Dans un ligament de matrice (1<FDENS1<2) ; *
  340. * RLIM1 : Distance limite projection enveloppe cellule sur centre *
  341. * particule ou sur son projete sur la(les) Faces : *
  342. FDENS1 = 1.0 ;
  343. FLIM1 = 0.7 ;
  344. RLIM1 = FLIM1 * RPAR1 ;
  345. * *
  346. * Liste de reels pour deplacement aleatoire perturbation position : *
  347. XLPHI1 = 'BRUI' 'BLAN' 'UNIF' 0. 90. (10 * NBI1) ;
  348. XLTHE1 = 'BRUI' 'BLAN' 'UNIF' 180. 180. (10 * NBI1) ;
  349. XLAMP1 = 'BRUI' 'BLAN' 'UNIF' 1.50 1.00 (10 * NBI1) ;
  350. XLAMP1 = ELIGM1 * XLAMP1 ;
  351. NPERTI1 = 0 ;
  352. * *
  353. * La boucle BESSA1 recommence l'operation de maillage par la parti- *
  354. * cule qu'elle n'est pas arrivee a mailler : *
  355. 'REPE' BESSA1 5 ;
  356. * TMPARMAT : table contenant le maillage ; *
  357. TMPARMAT = 'TABL' ;
  358. IPREMI1 = VRAI ;
  359. 'REPE' BI1 NBI1 ;
  360. 'SAUT' 1 'LIGN' ;
  361. 'MESS' ' ***** Particule No : ' &BI1 '/' NBI1 ;
  362. PCI1 = MPOI1 'POIN' &BI1 ;
  363. * PCI1 = MPOI1 'POIN' 53 ;
  364. * IAFAIR1 : le travail est A FAIRe, donc pas encore realise ; *
  365. IAFAIR1 = VRAI ;
  366. * Boucle perturbation position particule : *
  367. * => Si Echec maillage, on recommence en pertubant position PCI1 : *
  368. NBPOSI1 = 11 ;
  369. 'REPE' BPOSI1 NBPOSI1 ;
  370. PPARI1 = PCI1 'PLUS' (RPAR1 * PM2) ;
  371. * *
  372. * Boucle interne sur densite : *
  373. * => Si Echec maillage, on recommence en pertubant densite : *
  374. NBDENS1 = 15 ;
  375. FDENSI1 = FDENS1 ;
  376. FPLUSI1 = 1.1 ;
  377. FMOINI1 = 0.9 ;
  378. 'REPE' BDENS1 NBDENS1 ;
  379. * Parametres Maillage : *
  380. 'SI' (&BDENS1 'MULT' 2) ;
  381. FDENSI1 = (FPLUSI1 ** (&BDENS1 / 2)) * FDENSI1 ;
  382. 'SINO' ;
  383. FDENSI1 = (FMOINI1 ** ((&BDENS1 - 1) / 2)) * FDENSI1 ;
  384. 'FINS' ;
  385. DENSI1 = DENS1 / FDENSI1 ;
  386. DENSMI1 = 0.5 * DENSM1 * (1. / FDENSI1 + 1.) ;
  387. ELIGMI1 = DENSMI1 / FTET1 ;
  388. DPROXI1 = RPAR1 + (0.9 * ELIGMI1) ;
  389. DPROXI1 = 'MINI' ('PROG' DPROXI1 (0.5 * DREP1)) ;
  390. RPARJMI1 = 18. * ('MAXI' ('PROG' DENSM1 DENSMI1)) / PI ;
  391. DFHORI1 = ((RPAR1 ** 2) - (RPARJMI1 ** 2)) ** 0.5 ;
  392. RPARJMI1 = 18. * ('MAXI' ('PROG' DENSM1 DENSMI1)) / PI ;
  393. DAHORI1 = ((RPAR1 ** 2) - (RPARJMI1 ** 2)) ** 0.5 ;
  394. RPARJMI1 = 18. * ('MAXI' ('PROG' DENSM1 DENSMI1)) / PI ;
  395. DSHORI1 = ((RPAR1 ** 2) - (RPARJMI1 ** 2)) ** 0.5 ;
  396. * *
  397. * On indente plus -/- BDENS1... *
  398. * *
  399. * Indice Stockage maillage : *
  400. TMPARMAT . PCI1 = 'TABL' ;
  401. * Indicateurs Cas Intersection : *
  402. * IFACI1 : Partciule PCI1 intersecte une Face ; *
  403. * IAREI1 : Partciule PCI1 intersecte une Arete ; *
  404. * ISOMI1 : Partciule PCI1 intersecte un Sommet ; *
  405. IFACI1 = FAUX ;
  406. IAREI1 = FAUX ;
  407. ISOMI1 = FAUX ;
  408. * Indicateur Position Centre Particule : *
  409. * IDANI1 : PCI1 est Dans le Cube Unite ; *
  410. * IHORI1 : Particule Hors du Cube Unite Et n'intersecte pas Cube ; *
  411. * Attention, un critere d'intersection permet de ne considerer que *
  412. * les intersections "franches" du Cube ; *
  413. XCI1 YCI1 ZCI1 = PCI1 'COOR' ;
  414. LCI1 = 'PROG' XCI1 YCI1 ZCI1 ;
  415. IDANI1 = (('MINI' LCI1) '>EG' 0.) 'ET' (('MAXI' LCI1) '&lt;EG' 1.) ;
  416. IHORI1 = 'NON' IDANI1 ;
  417. 'SI' IHORI1 ;
  418. NBHORI1 = (NBNO MPCB1) + ('NBEL' MACB1) + ('NBEL' MSCB1) ;
  419. 'REPE' BHORI1 NBHORI1 ;
  420. I1 = &BHORI1 ;
  421. 'SI' (I1 '<' 9) ;
  422. PSCBI1 = MPCB1 'POIN' I1 ;
  423. DSCBPCI1 = 'NORM' (PCI1 'MOIN' PSCBI1) ;
  424. 'SI' (DSCBPCI1 '<' DSHORI1) ;
  425. IHORI1 = FAUX ;
  426. 'QUIT' BHORI1 ;
  427. 'FINS' ;
  428. 'SINO' ;
  429. I2 = &BHORI1 - 8 ;
  430. 'SI' (I2 '<' 13) ;
  431. ACBI1 = MACB1 'ELEM' I2 ;
  432. PACBI1 = ACBI1 'POIN' 1 ;
  433. PACBI2 = ACBI1 'POIN' 2 ;
  434. PNACBI1 = PACBI2 'MOIN' PACBI1 ;
  435. PAPCI1 = PCI1 'MOIN' PACBI1 ;
  436. PPCACBI1 = PAPCI1 'MOIN' (('PSCA' PAPCI1 PNACBI1) * PNACBI1) ;
  437. DACBPCI1 = 'NORM' PPCACBI1 ;
  438. PPCACBI1 = PCI1 'MOIN' PPCACBI1 ;
  439. PSCAI1 = 'PSCA' PAPCI1 PNACBI1 ;
  440. 'SI' ((DACBPCI1 '<' DAHORI1) 'ET' (PSCAI1 '>EG' 0.)
  441. 'ET' (PSCAI1 '&lt;EG' 1.));
  442. IHORI1 = FAUX ;
  443. 'QUIT' BHORI1 ;
  444. 'FINS' ;
  445. 'SINO' ;
  446. I3 = &BHORI1 - 20 ;
  447. SCBI1 = MSCB1 'ELEM' I3 ;
  448. MPSCBI1 = 'CHAN' 'POI1' SCBI1 ;
  449. PSCBI1 = MPSCBI1 'POIN' 1 ;
  450. PSCBI2 = MPSCBI1 'POIN' 2 ;
  451. PSCBI3 = MPSCBI1 'POIN' 3 ;
  452. PTSCBI1 = PSCBI2 'MOIN' PSCBI1 ;
  453. PTSCBI2 = PSCBI3 'MOIN' PSCBI1 ;
  454. PNSCBI1 = 'PVEC' PTSCBI1 PTSCBI2 ;
  455. PNSCBI1 = PNSCBI1 / ('NORM' PNSCBI1) ;
  456. PSPCI1 = PCI1 'MOIN' PSCBI1 ;
  457. DSPCI1 = 'PSCA' PNSCBI1 PSPCI1 ;
  458. PPCSCBI1 = PCI1 'MOIN' (DSPCI1 * PNSCBI1) ;
  459. DSPCI1 = 'ABS' DSPCI1 ;
  460. MTDI1 = ('MANU' 'POI1' PPCSCBI1) 'INCL' SCBI1 'LARG'
  461. 'NOID' ;
  462. ITDI1 = (NBNO MTDI1) 'EGA' 1 ;
  463. 'SI' ((DSPCI1 '<' DFHORI1) 'ET' ITDI1) ;
  464. IHORI1 = FAUX ;
  465. 'QUIT' BHORI1 ;
  466. 'FINS' ;
  467. 'FINS' ;
  468. 'FINS' ;
  469. 'FIN' BHORI1 ;
  470. 'FINS' ;
  471. * IPROXI1 : Particule a proximite d'une interface Sans la couper ; *
  472. * => aplanissement particule pour avoir dist. min. avec interface ; *
  473. * IJUSI1 : la particule tangente une interface ; *
  474. IPROXI1 = FAUX ;
  475. IJUSI1 = FAUX ;
  476. * Indicateurs Realisation Maillage : *
  477. * IPARI1 : Maillage de la particule ; *
  478. * Si Faux => pas d'intersection => pas de particule a mailler ; *
  479. * IPROJFI1: Projection conique enveloppe Cellule sur Surface Particule *
  480. * suivant Projection de PCI1 sur une des surfaces intersectees ; *
  481. IPARI1 = VRAI ;
  482. IPROJFI1 = FAUX ;
  483. IPROJAI1 = FAUX ;
  484. * Boucle sur les faces : *
  485. MPTI1 = THO7U . PCI1 . 'MPT' ;
  486. NBJ1 = NBNO MPTI1 ;
  487. IPREMJ1 = VRAI ;
  488. 'REPE' BJ1 NBJ1 ;
  489. IFACJ1 = FAUX ;
  490. IAREJ1 = FAUX ;
  491. IDANJ1 = FAUX ;
  492. IPROXJ1 = FAUX ;
  493. IPROJAJ1 = FAUX ;
  494. PCJ1 = MPTI1 'POIN' &BJ1 ;
  495. TMPARMAT . PCI1 . PCJ1 = 'TABL' ;
  496. * *
  497. * Test intersection Face IJ : *
  498. CNTIJ1 = THO7U . PCI1 . PCJ1 . 'MAV' ;
  499. 'SI' (&BPOSI1 'NEG' 1) ;
  500. PCI0 = PCI1 'MOIN' VDEPI1 ;
  501. PPCFIJX = 0.5 * (PCI0 'PLUS' PCJ1) ;
  502. PNFIJ1 = PPCFIJX 'MOIN' PCI0 ;
  503. DCIFIJX = 'NORM' PNFIJ1 ;
  504. PNFIJ1 = PNFIJ1 / DCIFIJX ;
  505. DVDEPI1 = VDEPI1 'PSCA' PNFIJ1 ;
  506. DCIFIJ1 = DCIFIJX - DVDEPI1 ;
  507. PPCFIJ1 = PPCFIJX 'PLUS' (VDEPI1 'MOIN' (DVDEPI1 * PNFIJ1)) ;
  508. 'SINO' ;
  509. PPCFIJ1 = 0.5 * (PCI1 'PLUS' PCJ1) ;
  510. PNFIJ1 = PPCFIJ1 'MOIN' PCI1 ;
  511. DCIFIJ1 = 'NORM' PNFIJ1 ;
  512. PNFIJ1 = PNFIJ1 / DCIFIJ1 ;
  513. 'FINS' ;
  514. IDANJ1 = (NBNO (('MANU' 'POI1' PPCFIJ1) 'INCL' CNTIJ1 'LARG'
  515. 'NOID')) 'EGA' 1 ;
  516. 'SI' ((DCIFIJ1 '<' RPAR1) 'ET' ('NON' IHORI1)) ;
  517. IFACJ1 = VRAI ;
  518. RPARJ1 = (RPAR1 * RPAR1 - (DCIFIJ1 * DCIFIJ1)) ** 0.5 ;
  519. RLIMJ1 = FLIM1 * RPARJ1 ;
  520. 'SI' ((DCIFIJ1 '>EG' DFHORI1) 'ET' IDANJ1) ;
  521. IJUSI1 = VRAI ;
  522. VDEPI1 = 1.05 * (DCIFIJ1 - DFHORI1) * PNFIJ1 ;
  523. 'TITR' ('CHAI' 'Particule ' &BI1 ' coupe Juste une Face') ;
  524. 'QUIT' BDENS1 ;
  525. 'FINS' ;
  526. 'SINO' ;
  527. 'SI' (DCIFIJ1 '<' DPROXI1) ;
  528. 'SI' ('NON' IPROXI1) ;
  529. IPROXI1 = VRAI 'ET' IDANJ1 ;
  530. 'FINS' ;
  531. 'FINS' ;
  532. 'FINS' ;
  533. * Densite relative a la distance a la Face : *
  534. LCNTIJ1 = 'MESU' CNTIJ1 ;
  535. 'SI' (IFACJ1 'ET' IDANJ1) ;
  536. DENSJ1 = DENSI1 ;
  537. 'SINO' ;
  538. DENSJ1 = FTET1 * (DCIFIJ1 - RPAR1) / FDENSI1 ;
  539. DENSJ1 = 'MAXI' ('PROG' DENSJ1 DENSMI1) ;
  540. DENSJ1 = 'MINI' ('PROG' DENSJ1 DENSI1) ;
  541. 'FINS' ;
  542. * *
  543. * Face deja maillee ? *
  544. 'SI' ('EXIS' TMPARMAT PCJ1) ;
  545. MMATIJ1 = TMPARMAT . PCJ1 . PCI1 . 'MATR' ;
  546. IFACJ1 = 'EXIS' TMPARMAT . PCJ1 . PCI1 'PART' ;
  547. 'SI' IFACJ1 ;
  548. MPARIJ1 = TMPARMAT . PCJ1 . PCI1 . 'PART' ;
  549. Titr ' Face Particule deja Maillee !!!' ;
  550. Trac MPARIJ1 ;
  551. 'FINS' ;
  552. TMPARMAT . PCI1 . PCJ1 = TMPARMAT . PCJ1 . PCI1 ;
  553. 'SINO' ;
  554. * Maillage Face IJ => on parcourt les aretes : *
  555. MPTIJ1 = THO7U . PCI1 . PCJ1 . 'MPT' ;
  556. * *
  557. * Maillage Aretes Matrice : *
  558. * ------------------------- *
  559. * *
  560. * Boucle sur les aretes : *
  561. NBK1 = NBNO MPTIJ1 ;
  562. IPREMK1 = VRAI ;
  563. 'REPE' BK1 NBK1 ;
  564. IAREK1 = FAUX ;
  565. IPROJAK1 = FAUX ;
  566. PCK1 = MPTIJ1 'POIN' &BK1 ;
  567. TMPARMAT . PCI1 . PCJ1 . PCK1 = 'TABL' ;
  568. * *
  569. * Tests pour determiner Si l'arete est deja maillee : *
  570. * IIK1 : Face IK maillee => arete IJK maillee ; *
  571. * IKI1 : Face KI maillee => idem ; *
  572. * IKJ1 : Face KJ maillee => idem ; *
  573. * Note : arete IJK pas forcement associee a IKJ Ou KIJ *
  574. * du fait du Elim & peut etre constituee de + de *
  575. * 1 elt. => tests sur mesure aretes ; *
  576. * Iij11 : test Si mesure arete recuperee test Iij1 egale *
  577. * arete IJK ; *
  578. * Iij10 : test Si mesure arete recuperee test Iij1 >egal *
  579. * arete IJK ; *
  580. ELIJK1 = THO7U . PCI1 . PCJ1 . PCK1 . 'MAV' ;
  581. MESK1 = 'MESU' ELIJK1 ;
  582. TOLK1 = TOL1 * MESK1 ;
  583. * Face IK deja maillee ? *
  584. IIK11 = FAUX ; IIK10 = FAUX ;
  585. IIK1 = 'EXIS' TMPARMAT . PCI1 PCK1 ;
  586. 'SI' IIK1 ;
  587. IIK1 = 'EXIS' TMPARMAT . PCI1 . PCK1 PCJ1 ;
  588. 'SI' IIK1 ;
  589. MMATIJK1 = TMPARMAT . PCI1 . PCK1 . PCJ1 . 'MATR' ;
  590. 'SI' ('EXIS' TMPARMAT . PCI1 . PCK1 . PCJ1 'PART') ;
  591. IAREK1 = VRAI ;
  592. MPARIJK1 = TMPARMAT . PCI1 . PCK1 . PCJ1 . 'PART' ;
  593. MESKX1 = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  594. 'SINO' ;
  595. MESKX1 = 'MESU' MMATIJK1 ;
  596. 'FINS' ;
  597. IIK11 = MESKX1 'EGA' MESK1 TOLK1 ;
  598. IIK10 = MESKX1 '>EG' MESK1 ;
  599. 'SI' ('NON' (IIK11 'OU' IIK10)) ;
  600. ELIJK0 = THO7U . PCI1 . PCK1 . PCJ1 . 'MAV' ;
  601. 'FINS' ;
  602. 'SINO' ;
  603. MPTIK1 = TMPARMAT . PCI1 . PCK1 .'MPT' ;
  604. NBL1 = NBNO MPTIK1 ;
  605. 'REPE' BL1 NBL1 ;
  606. PCL1 = MPTIK1 'POIN' &BL1 ;
  607. ELIKL1 = THO7U . PCI1 . PCK1 . PCL1 . 'MAV' ;
  608. MTEST1 = ELIKL1 'INTE' ELIJK1 'NOVE' ;
  609. IIK1 = ('NBEL' MTEST1) 'NEG' 0 ;
  610. 'SI' IIK1 ;
  611. MMATIJK1 = TMPARMAT . PCI1 . PCK1 . PCL1 . 'MATR' ;
  612. 'SI' ('EXIS' TMPARMAT . PCI1 . PCK1 . PCL1 'PART') ;
  613. IAREK1 = VRAI ;
  614. MPARIJK1 = TMPARMAT . PCI1 . PCK1 . PCL1 . 'PART' ;
  615. MESKX1 = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  616. 'SINO' ;
  617. MESKX1 = 'MESU' MMATIJK1 ;
  618. 'FINS' ;
  619. IIK11 = MESKX1 'EGA' MESK1 TOLK1 ;
  620. IIK10 = MESKX1 '>EG' MESK1 ;
  621. 'SI' ('NON' (IIK11 'OU' IIK10)) ;
  622. ELIJK0 = THO7U . PCI1 . PCK1 . PCL1 . 'MAV' ;
  623. 'FINS' ;
  624. 'QUIT' BL1 ;
  625. 'FINS' ;
  626. 'FIN' BL1 ;
  627. 'FINS' ;
  628. 'FINS' ;
  629. * Face KI deja maillee ? *
  630. IKI11 = FAUX ; IKI10 = FAUX ;
  631. IKI1 = ('EXIS' TMPARMAT PCK1) 'ET' ('NON' IIK11) ;
  632. IKJ1 = IKI1 ;
  633. 'SI' IKI1 ;
  634. IKI1 = 'EXIS' TMPARMAT . PCK1 PCI1 ;
  635. 'FINS' ;
  636. 'SI' IKI1 ;
  637. IKI1 = 'EXIS' TMPARMAT . PCK1 . PCI1 PCJ1 ;
  638. 'SI' IKI1 ;
  639. MMATIJK1 = TMPARMAT . PCK1 . PCI1 . PCJ1 . 'MATR' ;
  640. 'SI' ('EXIS' TMPARMAT . PCK1 . PCI1 . PCJ1 'PART') ;
  641. IAREK1 = VRAI ;
  642. MPARIJK1 = TMPARMAT . PCK1 . PCI1 . PCJ1 . 'PART' ;
  643. MESKX1 = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  644. 'SINO' ;
  645. MESKX1 = 'MESU' MMATIJK1 ;
  646. 'FINS' ;
  647. IKI11 = MESKX1 'EGA' MESK1 TOLK1 ;
  648. IKI10 = MESKX1 '>EG' MESK1 ;
  649. 'SI' ('NON' (IKI11 'OU' IKI10)) ;
  650. ELIJK0 = THO7U . PCK1 . PCI1 . PCJ1 . 'MAV' ;
  651. 'FINS' ;
  652. 'SINO' ;
  653. MPTKI1 = TMPARMAT . PCK1 . PCI1 .'MPT' ;
  654. NBL1 = NBNO MPTKI1 ;
  655. 'REPE' BL1 NBL1 ;
  656. PCL1 = MPTKI1 'POIN' &BL1 ;
  657. ELKIL1 = THO7U . PCK1 . PCI1 . PCL1 . 'MAV' ;
  658. MTEST1 = ELKIL1 'INTE' ELIJK1 'NOVE' ;
  659. IKI1 = ('NBEL' MTEST1) 'NEG' 0 ;
  660. 'SI' IKI1 ;
  661. MMATIJK1 = TMPARMAT . PCK1 . PCI1 . PCL1 . 'MATR' ;
  662. 'SI' ('EXIS' TMPARMAT . PCK1 . PCI1 . PCL1 'PART') ;
  663. IAREK1 = VRAI ;
  664. MPARIJK1 = TMPARMAT . PCK1 . PCI1 . PCL1 . 'PART' ;
  665. MESKX1 = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  666. 'SINO' ;
  667. MESKX1 = 'MESU' MMATIJK1 ;
  668. 'FINS' ;
  669. IKI11 = MESKX1 'EGA' MESK1 TOLK1 ;
  670. IKI10 = MESKX1 '>EG' MESK1 ;
  671. 'SI' ('NON' (IKI11 'OU' IKI10)) ;
  672. ELIJK0 = THO7U . PCK1 . PCI1 . PCL1 . 'MAV' ;
  673. 'FINS' ;
  674. 'QUIT' BL1 ;
  675. 'FINS' ;
  676. 'FIN' BL1 ;
  677. 'FINS' ;
  678. 'FINS' ;
  679. * Face KJ deja maillee ? *
  680. IKJ11 = FAUX ; IKJ10 = FAUX ;
  681. 'SI' IKJ1 ;
  682. IKJ1 = ('EXIS' TMPARMAT . PCK1 PCJ1)
  683. 'ET' ('NON' IKI11) ;
  684. 'FINS' ;
  685. 'SI' IKJ1 ;
  686. IKJ1 = 'EXIS' TMPARMAT . PCK1 . PCJ1 PCI1 ;
  687. 'SI' IKJ1 ;
  688. MMATIJK1 = TMPARMAT . PCK1 . PCJ1 . PCI1 . 'MATR' ;
  689. 'SI' ('EXIS' TMPARMAT . PCK1 . PCJ1 . PCI1 'PART') ;
  690. IAREK1 = VRAI ;
  691. MPARIJK1 = TMPARMAT . PCK1 . PCJ1 . PCI1 . 'PART' ;
  692. MESKX1 = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  693. 'SINO' ;
  694. MESKX1 = 'MESU' MMATIJK1 ;
  695. 'FINS' ;
  696. IKJ11 = MESKX1 'EGA' MESK1 TOLK1 ;
  697. IKJ10 = MESKX1 '>EG' MESK1 ;
  698. 'SI' ('NON' (IKJ11 'OU' IKJ10)) ;
  699. ELIJK0 = THO7U . PCK1 . PCJ1 . PCI1 . 'MAV' ;
  700. 'FINS' ;
  701. 'SINO' ;
  702. MPTKJ1 = TMPARMAT . PCK1 . PCJ1 . 'MPT' ;
  703. NBL1 = NBNO MPTKJ1 ;
  704. 'REPE' BL1 NBL1 ;
  705. PCL1 = MPTKJ1 'POIN' &BL1 ;
  706. ELKJL1 = THO7U . PCK1 . PCJ1 . PCL1 . 'MAV' ;
  707. MTEST1 = ELKJL1 'INTE' ELIJK1 'NOVE' ;
  708. IKJ1 = ('NBEL' MTEST1) 'NEG' 0 ;
  709. 'SI' IKJ1 ;
  710. MMATIJK1 = TMPARMAT . PCK1 . PCJ1 . PCL1 . 'MATR' ;
  711. 'SI' ('EXIS' TMPARMAT . PCK1 . PCJ1 . PCL1 'PART') ;
  712. IAREK1 = VRAI ;
  713. MPARIJK1 = TMPARMAT . PCK1 . PCJ1 . PCL1 . 'PART' ;
  714. MESKX1 = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  715. 'SINO' ;
  716. MESKX1 = 'MESU' MMATIJK1 ;
  717. 'FINS' ;
  718. IKJ11 = MESKX1 'EGA' MESK1 TOLK1 ;
  719. IKJ10 = MESKX1 '>EG' MESK1 ;
  720. 'SI' ('NON' (IKJ11 'OU' IKJ10)) ;
  721. ELIJK0 = THO7U . PCK1 . PCJ1 . PCL1 . 'MAV' ;
  722. 'FINS' ;
  723. 'QUIT' BL1 ;
  724. 'FINS' ;
  725. 'FIN' BL1 ;
  726. 'FINS' ;
  727. 'FINS' ;
  728. * Traitement des cas : *
  729. IXX10 = IIK10 'OU' IKI10 'OU' IKJ10 ;
  730. IIJK1 = VRAI ;
  731. 'SI' IIK11 ;
  732. IXX10 = FAUX ;
  733. IIJK1 = FAUX ;
  734. 'FINS' ;
  735. 'SI' IKI11 ;
  736. IXX10 = FAUX ;
  737. IIJK1 = FAUX ;
  738. 'FINS' ;
  739. 'SI' IKJ11 ;
  740. IXX10 = FAUX ;
  741. IIJK1 = FAUX ;
  742. 'FINS' ;
  743. 'SI' IXX10 ;
  744. PSK1 = (ELIJK1 'ELEM' 1) 'POIN' 1 ;
  745. PSK2 = (ELIJK1 'ELEM' ('NBEL' ELIJK1)) 'POIN' 2 ;
  746. MMATIJK1 = MMATIJK1 'ELEM' 'COMP' PSK1 PSK2 ;
  747. IIJK1 = FAUX ;
  748. 'FINS' ;
  749. * Une partie de l'arete est-elle deja maillee ? *
  750. 'SI' IIJK1 ;
  751. IPREME1 = VRAI ;
  752. 'SI' (IIK1 'OU' IKI1 'OU' IKJ1) ;
  753. * Une partie de l'arete est maillee : *
  754. ELIJK1 = ELIJK1 'DIFF' ELIJK0 ;
  755. IPREME1 = FAUX ;
  756. 'FINS' ;
  757. * *
  758. * Maillage Arete : *
  759. * Iterations sur elts. arete du fait du Elim ; *
  760. NBELK1 = 'NBEL' ELIJK1 ;
  761. 'REPE' BELK1 NBELK1 ;
  762. IAREE1 = FAUX ;
  763. IDANK1 = FAUX ;
  764. AIJK1 = ELIJK1 'ELEM' &BELK1 ;
  765. MESE1 = 'MESU' AIJK1 ;
  766. PSK1 = AIJK1 'POIN' 1 ;
  767. PSK2 = AIJK1 'POIN' 2 ;
  768. * PSK12N : vecteur norme PSK1-SK2 ; *
  769. PSK12N = PSK2 'MOIN' PSK1 ;
  770. PSK12N = PSK12N / ('NORM' PSK12N) ;
  771. * PSK1CI1 : vecteur PSK1-PCI1 ; *
  772. PSK1CI1 = PCI1 'MOIN' PSK1 ;
  773. * PNAKCI1 : normale a l'arete passant par PCI1 ; *
  774. PNAKCI1 = PSK1CI1 'MOIN'
  775. ((PSK1CI1 'PSCA' PSK12N) * PSK12N) ;
  776. * PPCIAK1 : projete de PCI1 sur l'arete ; *
  777. PPCIAK1 = PCI1 'MOIN' PNAKCI1 ;
  778. * DCIAK1 : distance PCI1-arete ; *
  779. DCIAK1 = 'NORM' PNAKCI1 ;
  780. * DCISKi : distance PCI1-PSKi ; *
  781. DCISK1 = 'NORM' PSK1CI1 ;
  782. DCISK2 = 'NORM' (PCI1 'MOIN' PSK2) ;
  783. * DENSK0-DENSK1-DENSK2 : densites centre-extrem. arete ; *
  784. DENSK0 = FTET1 * (DCIAK1 - RPAR1) / FDENSI1 ;
  785. DENSK1 = FTET1 * (DCISK1 - RPAR1) / FDENSI1 ;
  786. DENSK2 = FTET1 * (DCISK2 - RPAR1) / FDENSI1 ;
  787. DENSK0 = 'MAXI' ('PROG' DENSK0 DENSMI1) ;
  788. DENSK1 = 'MAXI' ('PROG' DENSK1 DENSMI1) ;
  789. DENSK2 = 'MAXI' ('PROG' DENSK2 DENSMI1) ;
  790. DENSK0 = 'MINI' ('PROG' DENSK0 DENSI1 (10. * DENSJ1)) ;
  791. DENSK1 = 'MINI' ('PROG' DENSK1 DENSI1 (10. * DENSJ1)) ;
  792. DENSK2 = 'MINI' ('PROG' DENSK2 DENSI1 (10. * DENSJ1)) ;
  793. * PSK1PPK1, PSK2PPK1 : vecteur pour test sur arete ; *
  794. PSK1PPK1 = PPCIAK1 'MOIN' PSK1 ;
  795. PSK2PPK1 = PPCIAK1 'MOIN' PSK2 ;
  796. DSK1PPK1 = 'NORM' PSK1PPK1 ;
  797. DSK2PPK1 = 'NORM' PSK2PPK1 ;
  798. * IDANK1=VRAI, PPCIAK1 appartient au segment [PSK1,PSK2] : *
  799. IDANK1 = (('PSCA' PSK1PPK1 PSK12N) '>EG' 0.)
  800. 'ET' (('PSCA' PSK2PPK1 PSK12N) '&lt;EG' 0.)
  801. 'ET' (DSK1PPK1 '&lt;EG' MESE1)
  802. 'ET' (DSK2PPK1 '&lt;EG' MESE1) ;
  803. * Tests Intersection Sommets : *
  804. IISK1 = DCISK1 '<' RPAR1 ;
  805. IISK2 = DCISK2 '<' RPAR1 ;
  806. ISOMI1 = IISK1 'OU' IISK2 ;
  807. * Test Intersection Arete : *
  808. IAREE1 = (DCIAK1 '<' RPAR1) 'ET' (IDANK1 'OU' ISOMI1) ;
  809. IAREE1 = IAREE1 'ET' ('NON' IHORI1) ;
  810. 'SI' IAREE1 ;
  811. * DPPKPKP0 : Dist. PPCIAK1-Points Intersec. Part-Arete *
  812. DPPKPKP0 = (RPAR1 * RPAR1 - (DCIAK1 ** 2)) ** 0.5 ;
  813. * PSKP1, PSKP2 : Points Intersec. Part-Arete ; *
  814. DPPKPKP1 = DPPKPKP0 / DSK1PPK1 ;
  815. DPPKPKP2 = DPPKPKP0 / DSK2PPK1 ;
  816. PSKP1 = PPCIAK1 'MOIN' (DPPKPKP1 * PSK1PPK1) ;
  817. PSKP2 = PPCIAK1 'MOIN' (DPPKPKP2 * PSK2PPK1) ;
  818. 'SI' (DCIAK1 '>EG' DAHORI1) ;
  819. IJUSI1 = VRAI ;
  820. 'SI' IDANI1 ;
  821. VDEPI1 = -1.05 * (DCIAK1 - DAHORI1)
  822. * PNAKCI1 / DCIAK1 ;
  823. 'SINO' ;
  824. 'SI' IDANJ1 ;
  825. B1 = DCIFIJ1 ;
  826. 'SI' (DCIAK1 '<' B1) ;
  827. B2 = 0. ;
  828. 'SINO' ;
  829. B2 = ((DCIAK1 ** 2) - (B1 ** 2)) ** 0.5 ;
  830. 'FINS' ;
  831. VDEPI1 = PNAKCI1 'PLUS' (DCIFIJ1 * PNFIJ1) ;
  832. VDEPI1 = -1. * VDEPI1 / ('NORM' VDEPI1) ;
  833. 'SINO' ;
  834. B2 = DCIFIJ1 ;
  835. 'SI' (DCIAK1 '<' B2) ;
  836. B1 = 0. ;
  837. 'SINO' ;
  838. B1 = ((DCIAK1 ** 2) - (B2 ** 2)) ** 0.5 ;
  839. 'FINS' ;
  840. VDEPI1 = PNFIJ1 ;
  841. 'FINS' ;
  842. ADEPI1 = ((DAHORI1 ** 2) - (B1 ** 2)) ** 0.5 ;
  843. ADEPI1 = B2 - ADEPI1 ;
  844. VDEPI1 = 1.05 * ADEPI1 * VDEPI1 ;
  845. 'FINS' ;
  846. 'TITR' ('CHAI' 'Particule ' &BI1 ' coupe Juste Arete') ;
  847. 'QUIT' BDENS1 ;
  848. 'FINS' ;
  849. * Elements pour calcul densites : *
  850. DCJAK1 = ((DCIAK1 ** 2) - (DCIFIJ1 ** 2)) ** 0.5 ;
  851. XNECNTK1 = (LCNTIJ1 - MESK1) / (1.0 * DENSI1) ;
  852. THETK1 = 'ATG' (DPPKPKP0 / DCJAK1) ;
  853. THETK1 = THETK1 * PI / 180. ;
  854. * Determination du Cas projection contour : *
  855. IPROJAK1 = (DCJAK1 '<' RLIMJ1) 'OU' ('NON' IDANJ1) ;
  856. 'SI' ISOMI1 ;
  857. * Intersection sommets : *
  858. * Calcul densite caracteristique : *
  859. DENSKP0 = (1. * RPARJ1 * THETK1) / XNECNTK1 ;
  860. DENSKP0 = 'MAXI' ('PROG' DENSKP0 DENSMI1) ;
  861. DENSKP0 = 'MINI' ('PROG' DENSKP0 DENSK1) ;
  862. * Maillage : *
  863. 'SI' (IISK1 'ET' IISK2) ;
  864. 'MESS' ' Intersection 2 sommets : pas encore... !' ;
  865. 'ERRE' 26 ;
  866. 'SINO' ;
  867. 'SI' IISK1 ;
  868. PSKX PSKPX = PSK2 PSKP2 ;
  869. PSK2 PSKP2 = PSK1 PSKP1 ;
  870. PSK1 PSKP1 = PSKX PSKPX ;
  871. DENSKX = DENSK2 ;
  872. DENSK2 = DENSK1 ;
  873. DENSK1 = DENSKX ;
  874. 'FINS' ;
  875. DENSKP1 = 1. / (0.5 / DENSKP0 + (0.5 / DENSK1)) ;
  876. * DENSKP1 = 1. * (0.5 * DENSKP0 + (0.5 * DENSK1)) ;
  877. PSOMI1 = PSK2 ;
  878. * MMATIJK0 = PSK1 'DROI' PSKP1 'DINI' DENSK1
  879. * 'DFIN' DENSKP0 ;
  880. * MMATIJK0 = MMATIJK0 'COUL' 'JAUN' ;
  881. * MPARIJK0 = PSKP1 'DROI' PSK2 'DINI' DENSKP0
  882. * 'DFIN' DENSKP1 ;
  883. DENSKPX = 'NORM' (PSKP1 'MOIN' PSK1) ;
  884. DENSKPX = 'MAXI' ('PROG' DENSKPX DENSMI1) ;
  885. DENSKPX = 'MINI' ('PROG' DENSKPX DENSI1 ) ;
  886. MMATIJK0 = PSK1 'DROI' PSKP1 'DINI' DENSKPX
  887. 'DFIN' DENSKPX ;
  888. MMATIJK0 = MMATIJK0 'COUL' 'JAUN' ;
  889. MPARIJK0 = PSKP1 'DROI' PSK2 'DINI' DENSKPX
  890. 'DFIN' DENSI1 ;
  891. 'FINS' ;
  892. 'SINO' ;
  893. * Intersection uniquement Arete : *
  894. 'SI' IDANJ1 ;
  895. DENSKP0 = (2. * RPARJ1 * (PI - THETK1)) / XNECNTK1 ;
  896. DENSKP0 = 'MAXI' ('PROG' DENSKP0 DENSMI1) ;
  897. DENSKP0 = 'MINI' ('PROG' DENSKP0 DENSI1) ;
  898. DENSKP1 = DENSK1 ;
  899. DENSKP2 = DENSK2 ;
  900. 'SINO' ;
  901. DENSKP0 = (2. * RPARJ1 * THETK1) / XNECNTK1 ;
  902. DENSKP0 = 'MAXI' ('PROG' DENSKP0 DENSMI1) ;
  903. DENSKP0 = 'MINI' ('PROG' DENSKP0 DENSI1) ;
  904. DCJSK1 = (DCISK1 ** 2 - (DCIFIJ1 ** 2)) ** 0.5 ;
  905. DCJSK2 = (DCISK2 ** 2 - (DCIFIJ1 ** 2)) ** 0.5 ;
  906. DENSKP1 = DENSK1 * DCJAK1 * RPARJ1 / (DCJSK1 ** 2) ;
  907. DENSKP2 = DENSK2 * DCJAK1 * RPARJ1 / (DCJSK2 ** 2) ;
  908. DENSKP1 = 'MAXI' ('PROG' DENSKP1 DENSMI1 DENSKP0) ;
  909. DENSKP2 = 'MAXI' ('PROG' DENSKP2 DENSMI1 DENSKP0) ;
  910. DENSKP1 = 'MINI' ('PROG' DENSK1 DENSKP1 DENSKP0) ;
  911. DENSKP2 = 'MINI' ('PROG' DENSK2 DENSKP2 DENSKP0) ;
  912. 'FINS' ;
  913. DENSKP1 = 1. / (0.5 / DENSKP0 + (0.5 / DENSKP1)) ;
  914. DENSKP2 = 1. / (0.5 / DENSKP0 + (0.5 / DENSKP2)) ;
  915. * Maillage Aretes Matrice-Particule : *
  916. DENSKX1 = 'NORM' (PSKP1 'MOIN' PSK1) ;
  917. DENSKX1 = 'MAXI' ('PROG' DENSKX1 DENSMI1) ;
  918. DENSKX1 = 'MINI' ('PROG' DENSKX1 DENSI1) ;
  919. DENSKX2 = 'NORM' (PSKP2 'MOIN' PSK2) ;
  920. DENSKX2 = 'MAXI' ('PROG' DENSKX2 DENSMI1) ;
  921. DENSKX2 = 'MINI' ('PROG' DENSKX2 DENSI1) ;
  922. DENSKPX1 = 'MINI' ('PROG' DENSKX1 DENSKP0) ;
  923. DENSKPX2 = 'MINI' ('PROG' DENSKX2 DENSKP0) ;
  924. DENSKPX0 = 'MINI' ('PROG' DENSI1 (2. * DENSKP0)) ;
  925. MMATIJK0 = PSK1 'DROI' PSKP1 'DINI' DENSKX1
  926. 'DFIN' DENSKPX1 ;
  927. MMATIJK0 = MMATIJK0 'ET'
  928. (PSKP2 'DROI' PSK2 'DINI' DENSKPX2 'DFIN' DENSKX2) ;
  929. 'SI' IPROJAK1 ;
  930. MMATIJK0 = MMATIJK0 'COUL' 'JAUN' ;
  931. 'FINS' ;
  932. MPARIJK0 = PSKP1 'DROI' PPCIAK1 'DINI' DENSKPX1
  933. 'DFIN' DENSKPX0 ;
  934. MPARIJK0 = MPARIJK0 'ET'
  935. (PPCIAK1 'DROI' PSKP2 'DINI' DENSKPX0 'DFIN' DENSKPX2) ;
  936. 'FINS' ;
  937. 'SINO' ;
  938. * Pas Intersection Arete : *
  939. * Si Distance Sommet-PPCIAK1 > Densite calcule
  940. * Et Si PPCIAK1 sur l'arete => on maille en 2 parties : *
  941. * 'SI' IHORI1 ;
  942. * MMATIJK0 = PSK1 'DROI' PSK2 'DINI' DENSK1
  943. * 'DFIN' DENSK2 ;
  944. * 'SINO' ;
  945. 'SI' ((DSK1PPK1 '>EG' DENSK1)
  946. 'ET' (DSK2PPK1 '>EG' DENSK2) 'ET' IDANK1) ;
  947. MMATIJK0 = PSK1 'DROI' PPCIAK1 'DINI' DENSK1
  948. 'DFIN' DENSK0 ;
  949. MMATIJK0 = MMATIJK0 'ET'
  950. (PPCIAK1 'DROI' PSK2 'DINI' DENSK0 'DFIN' DENSK2) ;
  951. 'SINO' ;
  952. MMATIJK0 = PSK1 'DROI' PSK2 'DINI' DENSK1
  953. 'DFIN' DENSK2 ;
  954. 'FINS' ;
  955. 'SI' (DCIAK1 '<' DPROXI1) ;
  956. IPROXI1 = VRAI 'ET' IDANK1 ;
  957. 'FINS' ;
  958. * 'FINS' ;
  959. 'FINS' ;
  960. 'SI' IPREME1 ;
  961. IPREME1 = FAUX ;
  962. MMATIJK1 = MMATIJK0 ;
  963. 'SINO' ;
  964. MMATIJK1 = MMATIJK1 'ET' MMATIJK0 ;
  965. 'FINS' ;
  966. 'SI' IAREE1 ;
  967. PPCIAE0 = PPCIAK1 ;
  968. 'SI' IAREK1 ;
  969. MPARIJK1 = MPARIJK1 'ET' MPARIJK0 ;
  970. 'SINO' ;
  971. IAREK1 = VRAI ;
  972. MPARIJK1 = MPARIJK0 ;
  973. 'FINS' ;
  974. 'FINS' ;
  975. 'FIN' BELK1 ;
  976. 'SINO' ;
  977. 'SI' IAREK1 ;
  978. * 'MESS' ' Arete intersectee Et deja maillee' ;
  979. AIJK1 = ELIJK1 ;
  980. MESE1 = 'MESU' AIJK1 ;
  981. PSK1 = AIJK1 'POIN' 1 ;
  982. PSK2 = AIJK1 'POIN' 2 ;
  983. * PSK12N : vecteur norme PSK1-SK2 ; *
  984. PSK12N = PSK2 'MOIN' PSK1 ;
  985. PSK12N = PSK12N / ('NORM' PSK12N) ;
  986. * PSK1CI1 : vecteur PSK1-PCI1 ; *
  987. PSK1CI1 = PCI1 'MOIN' PSK1 ;
  988. * PNAKCI1 : normale a l'arete passant par PCI1 ; *
  989. PNAKCI1 = PSK1CI1 'MOIN'
  990. ((PSK1CI1 'PSCA' PSK12N) * PSK12N) ;
  991. * PPCIAK1 : projete de PCI1 sur l'arete ; *
  992. PPCIAK1 = PCI1 'MOIN' PNAKCI1 ;
  993. * DCIAK1 : distance PCI1-arete ; *
  994. DCIAK1 = 'NORM' PNAKCI1 ;
  995. DCJAK1 = ((DCIAK1 ** 2) - (DCIFIJ1 ** 2)) ** 0.5 ;
  996. IPROJAK1 = (DCJAK1 '<' RLIMJ1) 'OU' ('NON' IDANJ1) ;
  997. 'SI' IPROJAK1 ;
  998. PPCIAE0 = PPCIAK1 ;
  999. MMATIJK1 = MMATIJK1 'COUL' 'JAUN' ;
  1000. 'FINS' ;
  1001. 'FINS' ;
  1002. 'FINS' ;
  1003. * Stockage Arete Dans la table : *
  1004. TMPARMAT . PCI1 . PCJ1 . PCK1 . 'MATR' = MMATIJK1 ;
  1005. 'SI' IPREMK1 ;
  1006. IPREMK1 = FAUX ;
  1007. CNTMATJ1 = MMATIJK1 ;
  1008. TMPARMAT . PCI1 . PCJ1 . 'MPT' = 'MANU' 'POI1' PCK1 ;
  1009. 'SINO' ;
  1010. CNTMATJ1 = CNTMATJ1 'ET' MMATIJK1 ;
  1011. TMPARMAT . PCI1 . PCJ1 . 'MPT' =
  1012. TMPARMAT . PCI1 . PCJ1 . 'MPT' 'ET' PCK1 ;
  1013. 'FINS' ;
  1014. 'SI' IAREK1 ;
  1015. TMPARMAT . PCI1 . PCJ1 . PCK1 . 'PART' = MPARIJK1 ;
  1016. 'SI' IAREJ1 ;
  1017. CNTPARJ1 = CNTPARJ1 'ET' MPARIJK1 ;
  1018. 'SINO' ;
  1019. IAREJ1 = VRAI ;
  1020. CNTPARJ1 = MPARIJK1 ;
  1021. 'FINS' ;
  1022. 'SI' IPROJAK1 ;
  1023. 'SI' IPROJAJ1 ;
  1024. 'SI' ISOMI1 ;
  1025. PPCIAK0 = PSOMI1 ;
  1026. 'SINO' ;
  1027. 'MESS'
  1028. ' ####" 2x Projection selon point sur aretes pour 1 meme contour ?' ;
  1029. 'ERRE' 26 ;
  1030. 'FINS' ;
  1031. 'SINO' ;
  1032. IPROJAJ1 = VRAI ;
  1033. PPCIAK0 = PPCIAE0 ;
  1034. 'FINS' ;
  1035. 'FINS' ;
  1036. 'FINS' ;
  1037. 'FIN' BK1 ;
  1038. * *
  1039. * Maillage Surfaces Matrice/Particules : *
  1040. * -------------------------------------- *
  1041. * *
  1042. * Maillage surface IJ : *
  1043. IFACJ1 = IFACJ1 'ET' (IDANJ1 'OU' IAREJ1) ;
  1044. 'SI' IFACJ1 ;
  1045. 'SI' IAREJ1 ;
  1046. * Construction Contour(s) Si intersection Arete-Sommet : *
  1047. 'SI' ISOMI1 ;
  1048. CNTMATJ2 = CNTMATJ1 'DIFF' (CNTMATJ1 'ELEM' 'JAUN') ;
  1049. CNTPARJ2 = CNTMATJ2 'PROJ' 'CONI' PSOMI1
  1050. 'SPHE' PCI1 PPARI1 ;
  1051. 'SINO' ;
  1052. 'SI' IPROJAJ1 ;
  1053. CNTMATJ2 = CNTMATJ1 'DIFF' (CNTMATJ1 'ELEM' 'JAUN') ;
  1054. CNTPARJ2 = CNTMATJ2 'PROJ' 'CONI' PPCIAK0
  1055. 'SPHE' PCI1 PPARI1 ;
  1056. 'SINO' ;
  1057. CNTPARJ2 = CNTMATJ1 'PROJ' 'CONI' PPCFIJ1
  1058. 'SPHE' PCI1 PPARI1 ;
  1059. 'FINS' ;
  1060. 'FINS' ;
  1061. CNTPARJ1 = CNTPARJ1 'ET' CNTPARJ2 ;
  1062. 'ELIM' CNTPARJ1 TOL1 ;
  1063. CNTPARJ1 = CNTPARJ1 'ELEM' 'COMP' (CNTPARJ1 'POIN' 1)
  1064. (CNTPARJ1 'POIN' 1) ;
  1065. CNTMATJ1 = CNTMATJ1 'ET' CNTPARJ2 ;
  1066. * Appel a Surf pour intersection Arete(s)-Sommet : *
  1067. 'OPTI' 'ERRE' 'CONT' ;
  1068. TCCONJ1 = 'CCON' CNTMATJ1 ;
  1069. 'REPE' BCCONJ1 ('DIME' TCCONJ1) ;
  1070. CNTMATJ0 = TCCONJ1 . &BCCONJ1 ;
  1071. CNTMATJ0 = CNTMATJ0 'ELEM' 'COMP' (CNTMATJ0 'POIN' 1)
  1072. (CNTMATJ0 'POIN' 1) ;
  1073. 'SI' IPROJAJ1 ;
  1074. MMATIJ0 = 'SURF' CNTMATJ0 'PLAN' 0.9 ;
  1075. 'SINO' ;
  1076. MMATIJ0 = 'SURF' CNTMATJ0 'PLAN' 0.9 ;
  1077. 'FINS' ;
  1078. 'SI' (&BCCONJ1 'EGA' 1) ;
  1079. MMATIJ1 = MMATIJ0 ;
  1080. 'SINO' ;
  1081. MMATIJ1 = MMATIJ1 'ET' MMATIJ0 ;
  1082. 'FINS' ;
  1083. 'FIN' BCCONJ1 ;
  1084. MPARIJ1 = 'SURF' CNTPARJ1 'PLAN' 0.9 ;
  1085. 'OPTI' 'ERRE' 'NORM' ;
  1086. IANNULS1 = ('EGA' ('TYPE' MMATIJ1) 'ANNULE')
  1087. 'OU' ('EGA' ('TYPE' MPARIJ1) 'ANNULE') ;
  1088. 'SI' IANNULS1 ;
  1089. 'MESS' ' ##### Echec maillage surface (ANNULE) ! ' ;
  1090. 'ITER' BDENS1 ;
  1091. 'SINO' ;
  1092. MTOTIJ1 = MMATIJ1 'ET' MPARIJ1 ;
  1093. SCNTIJ1 = 'MESU' 'SURF' (THO7U . PCI1 . PCJ1 . 'MAV') ;
  1094. STOTIJ1 = 'MESU' MTOTIJ1 ;
  1095. 'SI' ((SCNTIJ1 - STOTIJ1) '>' (1.E-5 * SCNTIJ1)) ;
  1096. 'MESS' ' ##### Echec maillage surface ! ';
  1097. 'ITER' BDENS1 ;
  1098. 'FINS' ;
  1099. 'FINS' ;
  1100. 'SINO' ;
  1101. * Construction Contour(s) Si intersection Face : *
  1102. CNTMATJ1 = CNTMATJ1 'ELEM' 'COMP' (CNTMATJ1 'POIN' 1)
  1103. (CNTMATJ1 'POIN' 1) ;
  1104. CNTPARJ1 = CNTMATJ1 'PROJ' 'CONI' PPCFIJ1 'SPHE' PCI1 PPARI1 ;
  1105. CNTMATJ1 = CNTMATJ1 'ET' ('INVE' CNTPARJ1) ;
  1106. * Maillage Surface intersection Face : *
  1107. 'OPTI' 'ERRE' 'CONT' ;
  1108. MMATIJ1 = 'SURF' CNTMATJ1 'PLAN' 0.9 ;
  1109. MPARIJ1 = 'SURF' CNTPARJ1 'PLAN' 0.9 ;
  1110. 'OPTI' 'ERRE' 'NORM' ;
  1111. IANNULS1 = ('EGA' ('TYPE' MMATIJ1) 'ANNULE')
  1112. 'OU' ('EGA' ('TYPE' MPARIJ1) 'ANNULE') ;
  1113. 'SI' IANNULS1 ;
  1114. 'MESS' ' ##### Echec maillage surface (ANNULE) ! ' ;
  1115. 'ITER' BDENS1 ;
  1116. 'SINO' ;
  1117. MTOTIJ1 = MMATIJ1 'ET' MPARIJ1 ;
  1118. SCNTIJ1 = 'MESU' 'SURF' (THO7U . PCI1 . PCJ1 . 'MAV') ;
  1119. STOTIJ1 = 'MESU' MTOTIJ1 ;
  1120. 'SI' ((SCNTIJ1 - STOTIJ1) '>' (1.E-5 * SCNTIJ1)) ;
  1121. 'MESS' ' ##### Echec maillage surface ! ';
  1122. 'ITER' BDENS1 ;
  1123. 'FINS' ;
  1124. 'FINS' ;
  1125. 'FINS' ;
  1126. 'SINO' ;
  1127. * Construction Contour(s) aucune intersection : *
  1128. CNTMATJ1 = CNTMATJ1 'ELEM' 'COMP' (CNTMATJ1 'POIN' 1)
  1129. (CNTMATJ1 'POIN' 1) ;
  1130. * Maillage Surface : *
  1131. 'SI' IHORI1 ;
  1132. CHDIJ1 = 'MANU' 'CHPO' CNTMATJ1 1 'DENS' DENSI1 ;
  1133. 'SINO' ;
  1134. CHDIJ1 = 'MANU' 'CHPO' CNTMATJ1 1 'DENS' DENSJ1 ;
  1135. 'FINS' ;
  1136. 'OPTI' 'ERRE' 'CONT' ;
  1137. MMATIJ1 = 'SURF' CHDIJ1 CNTMATJ1 'PLAN' 0.9 ;
  1138. 'OPTI' 'ERRE' 'NORM' ;
  1139. IANNULS1 = 'EGA' ('TYPE' MMATIJ1) 'ANNULE' ;
  1140. 'SI' IANNULS1 ;
  1141. 'MESS' ' ##### Echec maillage surface (ANNULE) ! ' ;
  1142. 'ITER' BDENS1 ;
  1143. 'SINO' ;
  1144. SCNTIJ1 = 'MESU' 'SURF' CNTMATJ1 ;
  1145. SMATIJ1 = 'MESU' MMATIJ1 ;
  1146. 'SI' ((SCNTIJ1 - SMATIJ1) '>' (1.E-5 * SCNTIJ1)) ;
  1147. 'MESS' ' ##### Echec maillage surface ! ';
  1148. 'ITER' BDENS1 ;
  1149. 'FINS' ;
  1150. 'FINS' ;
  1151. 'FINS' ;
  1152. 'SI' IFACJ1 ;
  1153. MMATIJ1 = MMATIJ1 'COUL' 'OLIV' ;
  1154. 'FINS' ;
  1155. TMPARMAT . PCI1 . PCJ1 . 'MATR' = MMATIJ1 ;
  1156. 'FINS' ;
  1157. * Analyse du cas traite : *
  1158. 'SI' IFACJ1 ;
  1159. MPARIJ1 = MPARIJ1 'COUL' 'ORAN' ;
  1160. TMPARMAT . PCI1 . PCJ1 . 'PART' = MPARIJ1 ;
  1161. 'SI' IFACI1 ;
  1162. ENVPARI1 = ENVPARI1 'ET' MPARIJ1 ;
  1163. 'SINO' ;
  1164. IFACI1 = VRAI ;
  1165. ENVPARI1 = MPARIJ1 ;
  1166. 'FINS' ;
  1167. 'SI' IAREJ1 ;
  1168. 'SI' ('NON' IAREI1) ;
  1169. IAREI1 = VRAI ;
  1170. 'FINS' ;
  1171. 'SI' ((DCIFIJ1 '<' RLIM1) 'OU' ('NON' IDANI1)) ;
  1172. 'SI' IPROJAJ1 ;
  1173. MMATIJ1 = MMATIJ1 'COUL' 'ROSE' ;
  1174. 'SI' IPROJAI1 ;
  1175. * PPCIAJ0 = PPCIAJ0 'PLUS' (PPCIAK0 'MOIN' PCI1) ;
  1176. 'SINO' ;
  1177. IPROJAI1 = VRAI ;
  1178. PPCIAJ0 = PPCIAK0 ;
  1179. 'FINS' ;
  1180. 'SINO' ;
  1181. MMATIJ1 = MMATIJ1 'COUL' 'TURQ' ;
  1182. 'SI' IPROJFI1 ;
  1183. IJUSI1 = VRAI ;
  1184. PPCFIJ0 = PPCFIJ0 'PLUS' (PPCFIJ1 'MOIN' PCI1) ;
  1185. 'SINO' ;
  1186. IPROJFI1 = VRAI ;
  1187. PPCFIJ0 = PPCFIJ1 ;
  1188. 'FINS' ;
  1189. 'FINS' ;
  1190. 'FINS' ;
  1191. 'SINO' ;
  1192. 'SI' ((DCIFIJ1 '<' RLIM1) 'OU' ('NON' IDANI1)) ;
  1193. MMATIJ1 = MMATIJ1 'COUL' 'TURQ' ;
  1194. 'SI' IPROJFI1 ;
  1195. IJUSI1 = VRAI ;
  1196. PPCFIJ0 = PPCFIJ0 'PLUS' (PPCFIJ1 'MOIN' PCI1) ;
  1197. 'SINO' ;
  1198. IPROJFI1 = VRAI ;
  1199. PPCFIJ0 = PPCFIJ1 ;
  1200. 'FINS' ;
  1201. 'FINS' ;
  1202. 'FINS' ;
  1203. 'FINS' ;
  1204. * Stockage Surfaces Dans la table : *
  1205. 'SI' IPREMJ1 ;
  1206. IPREMJ1 = FAUX ;
  1207. ENVMATI1 = MMATIJ1 ;
  1208. TMPARMAT . PCI1 . 'MPT' = 'MANU' 'POI1' PCJ1 ;
  1209. 'SINO' ;
  1210. ENVMATI1 = ENVMATI1 'ET' MMATIJ1 ;
  1211. TMPARMAT . PCI1 . 'MPT' = TMPARMAT . PCI1 . 'MPT' 'ET' PCJ1 ;
  1212. 'FINS' ;
  1213. 'FIN' BJ1 ;
  1214. * *
  1215. * Maillage Volumes Matrice-Particules : *
  1216. * ------------------------------------- *
  1217. * *
  1218. * Enveloppes Connexes Volumes a mailler : *
  1219. 'SI' IFACI1 ;
  1220. 'SI' ISOMI1 ;
  1221. 'MESS' ' - Intersections : Sommet' ;
  1222. ENVMATI2 = ENVMATI1 'ELEM' 'DEFA' ;
  1223. ENVPARI2 = ENVMATI2 'PROJ' 'CONI' PSOMI1 'SPHE' PCI1 PPARI1 ;
  1224. 'SINO' ;
  1225. 'SI' IAREI1 ;
  1226. 'MESS' ' - Intersections : Arete(s)' ;
  1227. 'SINO' ;
  1228. 'MESS' ' - Intersections : Face(s)' ;
  1229. 'FINS' ;
  1230. 'SI' IPROJFI1 ;
  1231. 'SI' IJUSI1 ;
  1232. IJUSI1 = FAUX ;
  1233. VDEPI1 = PPCFIJ0 'MOIN' PCI1 ;
  1234. ADEPI1 = 'NORM' VDEPI1 ;
  1235. VDEPI1 = VDEPI1 / ADEPI1 ;
  1236. VDEPI1 = 1.05 * (ADEPI1 - DAHORI1) * VDEPI1 ;
  1237. 'TITR' ' 2x IPROJFI1 => IJUSI1' ;
  1238. 'QUIT' BDENS1 ;
  1239. 'SINO' ;
  1240. ENVMATI2 = ENVMATI1 'DIFF' (ENVMATI1 'ELEM' 'TURQ') ;
  1241. ENVPARI2 = ENVMATI2 'PROJ' 'CONI' PPCFIJ0 'SPHE' PCI1 PPARI1 ;
  1242. 'FINS' ;
  1243. 'SINO' ;
  1244. 'SI' IPROJAI1 ;
  1245. ENVMATI2 = ENVMATI1 'DIFF' (ENVMATI1 'ELEM' 'ROSE') ;
  1246. ENVPARI2 = ENVMATI2 'PROJ' 'CONI' PPCIAJ0 'SPHE' PCI1 PPARI1 ;
  1247. 'SINO' ;
  1248. ENVPARI2 = ENVMATI1 'PROJ' 'CONI' PCI1 'SPHE' PCI1 PPARI1 ;
  1249. 'FINS' ;
  1250. 'FINS' ;
  1251. 'FINS' ;
  1252. ENVPARI1 = ENVPARI1 'ET' ENVPARI2 ;
  1253. 'ELIM' (ENVPARI1 'ET' ENVMATI1) TOL1 ;
  1254. 'SI' IPROXI1 ;
  1255. 'MESS'
  1256. ' - ATTENTION : PROXIMITE particule-enveloppe cellule detectee' ;
  1257. 'MESS'
  1258. ' => Aplanissement zone surface particule trop proche cellule' ;
  1259. ENVMATI3 = ENVMATI1 'ELEM' 'DEFA' ;
  1260. ENVPARI3 = ENVPARI2 'ELEM' 'DEFA' ;
  1261. MPASSI1 = ENVMATI3 'VOLU' 1 ENVPARI3 ;
  1262. MPASSI1 = ('CHAN' 'LIGN' MPASSI1) 'DIFF'
  1263. ('CHAN' 'LIGN' (ENVPARI3 'ET' ENVMATI3)) ;
  1264. XM1 YM1 ZM1 = ENVMATI3 'COOR' ;
  1265. XM1 = 'KPRO' XM1 MPASSI1 ;
  1266. YM1 = 'KPRO' YM1 MPASSI1 ;
  1267. ZM1 = 'KPRO' ZM1 MPASSI1 ;
  1268. DX1 DY1 DZ1 = (XM1 - XCI1) (YM1 - YCI1) (ZM1 - ZCI1) ;
  1269. DMPI1 = ((DX1 ** 2) + (DY1 ** 2) + (DZ1 ** 2)) ** 0.5 ;
  1270. MASQI1 = DMPI1 'MASQ' 'INFE' DPROXI1 ;
  1271. XP1 YP1 ZP1 = ENVPARI3 'COOR' ;
  1272. XN1 YN1 ZN1 = (XP1 - XM1) (YP1 - YM1) (ZP1 - ZM1) ;
  1273. XNXN1 = ((XN1 ** 2) + (YN1 ** 2) + (ZN1 ** 2)) ** 0.5 ;
  1274. XN1 YN1 ZN1 = (XN1 / XNXN1) (YN1 / XNXN1) (ZN1 / XNXN1) ;
  1275. DUI1 = (DPROXI1 - DMPI1) ;
  1276. CHUXI1 = ((DUI1 * XN1) 'NOMC' 'UX') ;
  1277. CHUYI1 = ((DUI1 * YN1) 'NOMC' 'UY') ;
  1278. CHUZI1 = ((DUI1 * ZN1) 'NOMC' 'UZ') ;
  1279. CHUXI1 = 'CHAN' 'ATTRIBUT' CHUXI1 'NATURE' 'DISCRET' ;
  1280. CHUYI1 = 'CHAN' 'ATTRIBUT' CHUYI1 'NATURE' 'DISCRET' ;
  1281. CHUZI1 = 'CHAN' 'ATTRIBUT' CHUZI1 'NATURE' 'DISCRET' ;
  1282. CHUI1 = (CHUXI1 'ET' CHUYI1 'ET' CHUZI1) * MASQI1 ;
  1283. 'DEPL' ENVPARI1 'PLUS' CHUI1 ;
  1284. 'FINS' ;
  1285. ENVMATI1 = ENVMATI1 'ET' ENVPARI2 ;
  1286. * 'ELIM' ENVMATI1 TOL1 ;
  1287. 'SINO' ;
  1288. 'MESS' ' - Intersections : AUCUNE' ;
  1289. 'SI' IDANI1 ;
  1290. ENVPARI1 = ENVMATI1 'PROJ' 'CONI' PCI1 'SPHE' PCI1 PPARI1 ;
  1291. PSK0 = THO7U . PCI1 . 'MAV' 'POIN' 1 ;
  1292. ELMI1 = (ENVMATI1 'ELEM' 'APPU' 'LARG' PSK0) 'ELEM' 1 ;
  1293. ELPI1 = ELMI1 'PROJ' 'CONI' PCI1 'SPHE' PCI1 PPARI1 ;
  1294. 'ELIM' (ELPI1 'ET' ENVPARI1) TOL1 ;
  1295. * Si Particule proche Face Cellule (d<DPROXI1), on fait un meplat *
  1296. * Sur Particule pour assurer distance min. : *
  1297. 'SI' IPROXI1 ;
  1298. 'MESS'
  1299. ' - ATTENTION : PROXIMITE particule-enveloppe cellule detectee' ;
  1300. 'MESS'
  1301. ' => Aplanissement zone surface particule trop proche cellule' ;
  1302. ENVPARI3 = ENVPARI1 'DIFF' ELPI1 ;
  1303. ENVMATI3 = ENVMATI1 'DIFF' ELMI1 ;
  1304. MPASSI1 = ENVMATI3 'VOLU' 1 ENVPARI3 ;
  1305. MPASSI1 = ('CHAN' 'LIGN' MPASSI1) 'DIFF'
  1306. ('CHAN' 'LIGN' (ENVPARI3 'ET' ENVMATI3)) ;
  1307. XM1 YM1 ZM1 = ENVMATI3 'COOR' ;
  1308. XM1 = 'KPRO' XM1 MPASSI1 ;
  1309. YM1 = 'KPRO' YM1 MPASSI1 ;
  1310. ZM1 = 'KPRO' ZM1 MPASSI1 ;
  1311. DX1 DY1 DZ1 = (XM1 - XCI1) (YM1 - YCI1) (ZM1 - ZCI1) ;
  1312. DMPI1 = ((DX1 ** 2) + (DY1 ** 2) + (DZ1 ** 2)) ** 0.5 ;
  1313. MASQI1 = DMPI1 'MASQ' 'INFE' DPROXI1 ;
  1314. XP1 YP1 ZP1 = ENVPARI3 'COOR' ;
  1315. XN1 YN1 ZN1 = (XP1 - XM1) (YP1 - YM1) (ZP1 - ZM1) ;
  1316. XNXN1 = ((XN1 ** 2) + (YN1 ** 2) + (ZN1 ** 2)) ** 0.5 ;
  1317. XN1 YN1 ZN1 = (XN1 / XNXN1) (YN1 / XNXN1) (ZN1 / XNXN1) ;
  1318. DUI1 = (DPROXI1 - DMPI1) ;
  1319. CHUXI1 = ((DUI1 * XN1) 'NOMC' 'UX') ;
  1320. CHUYI1 = ((DUI1 * YN1) 'NOMC' 'UY') ;
  1321. CHUZI1 = ((DUI1 * ZN1) 'NOMC' 'UZ') ;
  1322. CHUXI1 = 'CHAN' 'ATTRIBUT' CHUXI1 'NATURE' 'DISCRET' ;
  1323. CHUYI1 = 'CHAN' 'ATTRIBUT' CHUYI1 'NATURE' 'DISCRET' ;
  1324. CHUZI1 = 'CHAN' 'ATTRIBUT' CHUZI1 'NATURE' 'DISCRET' ;
  1325. CHUI1 = (CHUXI1 'ET' CHUYI1 'ET' CHUZI1) * MASQI1 ;
  1326. 'DEPL' ENVPARI3 'PLUS' CHUI1 ;
  1327. 'FINS' ;
  1328. DENSX1 = ('MESU' ('CONT' ELMI1)) / 3. ;
  1329. DENSX1 = 'MAXI' ('PROG' DENSX1 DENSMI1) ;
  1330. DENSX1 = 'MINI' ('PROG' DENSX1 DENSI1) ;
  1331. VXI1 = ELMI1 'VOLU' ELPI1 'DINI' DENSX1 'DFIN' DENSX1 ;
  1332. VXI1 = VXI1 'CHAN' 'TET4' ;
  1333. ENVMATI2 = (ENVMATI1 'ET' ENVPARI1) 'DIFF' ('ENVE' VXI1) ;
  1334. ENVMATI1 = ENVMATI1 'ET' ENVPARI1 ;
  1335. 'ELIM' ENVMATI1 TOL1 ;
  1336. 'SINO' ;
  1337. IPARI1 = FAUX ;
  1338. 'FINS' ;
  1339. 'FINS' ;
  1340. * *
  1341. * Maillage Volume Matrice : *
  1342. 'OPTI' 'ERRE' 'CONT' ;
  1343. 'SI' (IFACI1 'OU' ('NON' IPARI1)) ;
  1344. MMATI1 = ('VOLU' ENVMATI1) 'COUL' 'OLIV' ;
  1345. 'SINO' ;
  1346. MMATI1 = (('VOLU' ENVMATI2) 'ET' VXI1) 'COUL' 'OLIV' ;
  1347. 'FINS' ;
  1348. 'OPTI' 'ERRE' 'NORM' ;
  1349. * Test Resultat Volu : *
  1350. IANNULV1 = 'EGA' ('TYPE' MMATI1) 'ANNULE' ;
  1351. 'SI' IANNULV1 ;
  1352. 'MESS' ' ##### ECHEC Maillage Volume Matrice (ANNULE) !' ;
  1353. 'SINO' ;
  1354. * Test sur Enveloppes Resultat : *
  1355. MTESTI1 = ('ENVE' MMATI1) 'DIFF' ENVMATI1 ;
  1356. 'SI' ((NBNO MTESTI1) 'NEG' 0) ;
  1357. 'MESS' ' ##### ECHEC Maillage Volume Matrice !' ;
  1358. 'SINO' ;
  1359. TMPARMAT . PCI1 . 'MATR' = MMATI1 ;
  1360. IAFAIR1 = FAUX ;
  1361. 'FINS' ;
  1362. 'FINS' ;
  1363. * *
  1364. * Maillage Volume Particule : *
  1365. 'SI' IPARI1 ;
  1366. 'OPTI' 'ERRE' 'CONT' ;
  1367. MPARI1 = ('VOLU' ENVPARI1) 'COUL' 'ORAN' ;
  1368. 'OPTI' 'ERRE' 'NORM' ;
  1369. * Test Resultat Volu : *
  1370. IANNULV2 = 'EGA' ('TYPE' MPARI1) 'ANNULE' ;
  1371. 'SI' IANNULV2 ;
  1372. 'MESS' ' ##### ECHEC Maillage Volume particule (ANNULE) ' ;
  1373. 'SINO' ;
  1374. * Test sur Enveloppes Resultat : *
  1375. MTESTI1 = ('ENVE' MPARI1) 'DIFF' ENVPARI1 ;
  1376. 'SI' ((NBNO MTESTI1) 'NEG' 0) ;
  1377. 'MESS' ' ##### ECHEC Maillage Volume particule ' ;
  1378. IAFAIR1 = VRAI ;
  1379. 'SINO' ;
  1380. TMPARMAT . PCI1 . 'PART' = MPARI1 ;
  1381. IAFAIR1 = IAFAIR1 'OU' FAUX ;
  1382. 'FINS' ;
  1383. 'FINS' ;
  1384. IANNULV1 = IANNULV1 'OU' IANNULV2 ;
  1385. 'FINS' ;
  1386. * *
  1387. 'SI' ('NON' IAFAIR1) ;
  1388. MOT1 = 'CHAI'
  1389. ' ***** Particule No ' &BI1 ' / ' NBI1 ' : maillage REUSSI !' ;
  1390. 'MESS' MOT1 ;
  1391. 'QUIT' BDENS1 ;
  1392. 'SINO' ;
  1393. MOT1 = 'CHAI'
  1394. ' ##### Particule No ' &BI1 ' / ' NBI1 ' : maillage ECHOUE !' ;
  1395. 'MESS' MOT1 ;
  1396. 'SAUT' 1 'LIGN' ;
  1397. 'FINS' ;
  1398. * *
  1399. 'FIN' BDENS1 ;
  1400. * *
  1401. 'SI' IAFAIR1 ;
  1402. 'SI' (&BPOSI1 '>' 1) ;
  1403. 'DEPL' PCI1 'MOIN' VDEPI0 ;
  1404. 'FINS' ;
  1405. 'SI' (&BPOSI1 'EGA' NBPOSI1) ;
  1406. 'QUIT' BPOSI1 ;
  1407. 'FINS' ;
  1408. IPERI1 = VRAI ;
  1409. 'SI' IJUSI1 ;
  1410. 'MESS'
  1411. ' - ATTENTION : Intersection PAS ASSEZ FRANCHE detectee' ;
  1412. 'MESS'
  1413. ' => Deplacement position particule' ;
  1414. VDEPI1 = ('FLOT' &BPOSI1) * VDEPI1 ;
  1415. PCI0 = PCI1 'PLUS' VDEPI1 ;
  1416. IOKAY1 = VRAI ;
  1417. 'REPE' BJ1 NBJ1 ;
  1418. PCJ0 = MPTI1 'POIN' &BJ1 ;
  1419. 'SI' (PCJ0 'DANS' MPOI1) ;
  1420. 'SI' (('NORM' (PCJ0 'MOIN' PCI0)) '&lt;EG' DREP1) ;
  1421. IOKAY1 = FAUX ;
  1422. 'QUIT' BJ1 ;
  1423. 'FINS' ;
  1424. 'FINS' ;
  1425. 'FIN' BJ1 ;
  1426. 'SI' IOKAY1 ;
  1427. IPERI1 = FAUX ;
  1428. 'SINO' ;
  1429. 'MESS'
  1430. ' - ATTENTION : Deplacement calcule NON VALIDE ' ;
  1431. 'FINS' ;
  1432. 'SINO' ;
  1433. 'MESS'
  1434. ' - ATTENTION : ECHEC realisation maillage ' ;
  1435. 'FINS' ;
  1436. 'SI' IPERI1 ;
  1437. 'TITR' ' Perturbation position ' ;
  1438. 'MESS'
  1439. ' => Perturbation aleatoire position particule' ;
  1440. NBPERT1 = NBI1 - NPERTI1 ;
  1441. 'SI' (NBPERT1 '&lt;EG' 1) ;
  1442. 'QUIT' BPOSI1 ;
  1443. 'FINS' ;
  1444. 'REPE' BPERT1 NBPERT1 ;
  1445. NPERTI1 = NPERTI1 + 1 ;
  1446. PHII1 = XLPHI1 'EXTR' NPERTI1 ;
  1447. THEI1 = XLTHE1 'EXTR' NPERTI1 ;
  1448. XVDEPI1 = ('COS' PHII1) * ('COS' THEI1) ;
  1449. YVDEPI1 = ('COS' PHII1) * ('SIN' THEI1) ;
  1450. ZVDEPI1 = ('SIN' PHII1) ;
  1451. VDEPI1 = XVDEPI1 YVDEPI1 ZVDEPI1 ;
  1452. AMPI1 = XLAMP1 'EXTR' NPERTI1 ;
  1453. 'SI' (&BPOSI1 '>' 5) ;
  1454. AMPI1 = ('FLOT' &BPOSI1) * AMPI1 ;
  1455. 'FINS' ;
  1456. VDEPI1 = AMPI1 * VDEPI1 ;
  1457. PCI0 = PCI1 'PLUS' VDEPI1 ;
  1458. IOKAY1 = VRAI ;
  1459. 'REPE' BJ1 NBJ1 ;
  1460. PCJ0 = MPTI1 'POIN' &BJ1 ;
  1461. 'SI' (PCJ0 'DANS' MPOI1) ;
  1462. 'SI' (('NORM' (PCJ0 'MOIN' PCI0)) '&lt;EG' DREP1) ;
  1463. IOKAY1 = FAUX ;
  1464. 'QUIT' BJ1 ;
  1465. 'FINS' ;
  1466. 'FINS' ;
  1467. 'FIN' BJ1 ;
  1468. 'SI' IOKAY1 ;
  1469. 'MESS'
  1470. ' i) Perturbation reussie apres ' &BPERT1 ' essai(s)' ;
  1471. 'QUIT' BPERT1 ;
  1472. 'FINS' ;
  1473. 'FIN' BPERT1 ;
  1474. 'FINS' ;
  1475. PCI0 = PCI1 Plus VDEPI1 ;
  1476. 'DEPL' PCI1 'PLUS' VDEPI1 ;
  1477. VDEPI0 = VDEPI1 ;
  1478. 'SINO' ;
  1479. 'QUIT' BPOSI1 ;
  1480. 'FINS' ;
  1481. 'FIN' BPOSI1 ;
  1482. * *
  1483. *--------------------------- Fin Maillage -----------------------------*
  1484. * *
  1485. 'SI' IAFAIR1 ;
  1486. 'SAUT' 1 'LIGN' ;
  1487. 'MESS' ' - ATTENTION : ECHEC perturbations ' ;
  1488. 'SI' ('NON' IANNULV1) ;
  1489. PSK1 = THO7U . PCI1 . 'MAV' 'POIN' 1 ;
  1490. PSK2 = THO7U . PCI1 . 'MAV' 'POIN' 2 ;
  1491. 'TRAC' 'NCLK' 'FACE' (MMATI1 'ET' MPARI1) 'COUP' PCI1 PSK1 PSK2 ;
  1492. 'FINS' ;
  1493. ISTOP1 = FAUX ;
  1494. IESSA1 = VRAI ;
  1495. 'SI' FAUX ;
  1496. * 'SI' ('NEG' ('VALE' 'TRAC') 'PSC') ;
  1497. ISTOP1 IESSA1 = 'CHOI'
  1498. ' Erreur maillage : STOPer ou ESSAyer a nouveau ?' ISTOP1 IESSA1 ;
  1499. 'FINS' ;
  1500. 'SI' ISTOP1 ;
  1501. 'MESS' ' ****** ARET OPERATION MAILLAGE !!!' ;
  1502. 'QUIT' BESSA1 ;
  1503. 'SINO' ;
  1504. 'SI' IESSA1 ;
  1505. 'MESS'
  1506. ' => Re-initialisation du schema ' ;
  1507. MPOI0 = MPOI1 'DIFF' ('MANU' 'POI1' PCI1) ;
  1508. MPOI1 = PCI1 'ET' MPOI0 ;
  1509. 'ITER' BESSA1 ;
  1510. 'SINO' ;
  1511. 'ITER' BI1 ;
  1512. 'FINS' ;
  1513. 'FINS' ;
  1514. 'SINO' ;
  1515. 'SI' IPARI1 ;
  1516. MTOTI1 = MMATI1 'ET' MPARI1 ;
  1517. 'SINO' ;
  1518. MTOTI1 = MMATI1 ;
  1519. 'FINS' ;
  1520. TMPARMAT . PCI1 . 'MAIL' = MTOTI1 ;
  1521. 'SI' IPREMI1 ;
  1522. IPREMI1 = FAUX ;
  1523. TMPARMAT . 'MPCP' = 'MANU' 'POI1' PCI1 ;
  1524. TMPARMAT . 'MATR' = MMATI1 ;
  1525. 'SI' IPARI1 ;
  1526. TMPARMAT . 'PART' = MPARI1 ;
  1527. 'FINS' ;
  1528. TMPARMAT . 'MAIL' = MTOTI1 ;
  1529. 'SINO' ;
  1530. TMPARMAT . 'MPCP' = TMPARMAT . 'MPCP' 'ET' PCI1 ;
  1531. TMPARMAT . 'MATR' = TMPARMAT . 'MATR' 'ET' MMATI1 ;
  1532. 'SI' IPARI1 ;
  1533. 'SI' ('EXIS' TMPARMAT 'PART') ;
  1534. TMPARMAT . 'PART' = TMPARMAT . 'PART' 'ET' MPARI1 ;
  1535. 'SINO' ;
  1536. TMPARMAT . 'PART' = MPARI1 ;
  1537. 'FINS' ;
  1538. 'FINS' ;
  1539. TMPARMAT . 'MAIL' = TMPARMAT . 'MAIL' 'ET' MTOTI1 ;
  1540. 'FINS' ;
  1541. 'SI' (&BI1 'EGA' NBI1) ;
  1542. 'QUIT' BESSA1 ;
  1543. 'FINS' ;
  1544. 'FINS' ;
  1545. * *
  1546. 'FIN' BI1 ;
  1547. 'FIN' BESSA1 ;
  1548. MPAR1 = TMPARMAT . 'PART' ;
  1549. MMAT1 = TMPARMAT . 'MATR' ;
  1550. MTOT1 = TMPARMAT . 'MAIL' ;
  1551. 'ELIM' MTOT1 TOL1 ;
  1552. * *
  1553. * Test Conformite Maillage Total : *
  1554. X1 Y1 Z1 = MTOT1 'COOR' ;
  1555. MPFCB1 = (X1 'POIN' 'INFE' TOL1) 'ET' (X1 'POIN' 'SUPE' (1. - TOL1))
  1556. 'ET' (Y1 'POIN' 'INFE' TOL1) 'ET' (Y1 'POIN' 'SUPE' (1. - TOL1))
  1557. 'ET' (Z1 'POIN' 'INFE' TOL1) 'ET' (Z1 'POIN' 'SUPE' (1. - TOL1)) ;
  1558. ENVTOT1 = 'ENVE' MTOT1 ;
  1559. MSTOT1 = ENVTOT1 'ELEM' 'APPU' 'STRI' MPFCB1 ;
  1560. MTEST1 = ENVTOT1 'DIFF' MSTOT1 ;
  1561. * *
  1562. 'SI' (((NBNO MTEST1) + ('NBEL' MTEST1)) 'EGA' 0) ;
  1563. 'SAUT' 1 'LIGN' ;
  1564. 'MESS'
  1565. '-------------------------- MAILLAGE REUSSI --------------------------'
  1566. ;
  1567. 'SAUT' 1 'LIGN' ;
  1568. 'SI' ITRA1 ;
  1569. FVOL = 100. * ('MESU' MPAR1) / ('MESU' MTOT1) ;
  1570. 'TITR' ('CHAI' ' Maillage (Fvol = ' 'FORMAT' '(F5.1)' FVOL ' %) : '
  1571. (NBNO TMPARMAT . 'MPCP') ' Particules / '
  1572. (NBNO MTOT1) ' Noeuds / '
  1573. ('NBEL' MTOT1) ' Elements') ;
  1574. 'TRAC' 'FACE' (MACB1 'ET' MMAT1) ;
  1575. 'TRAC' 'FACE' (MACB1 'ET' MPAR1) ;
  1576. 'TRAC' 'FACE' (MACB1 'ET' MTOT1) ;
  1577. 'FINS' ;
  1578. 'SINO' ;
  1579. 'SAUT' 1 'LIGN' ;
  1580. 'MESS'
  1581. '########################## MAILLAGE ECHOUE ##########################'
  1582. ;
  1583. 'SAUT' 1 'LIGN' ;
  1584. 'SI' ITRA1 ; 'TRAC' (MSTOT1 'ET' (MTEST1 'COUL' 'ROSE')) ; 'FINS' ;
  1585. 'FINS' ;
  1586. * *
  1587. 'FINP' TMPARMAT ;
  1588. *-------------------- FIN DE LA PROCEDURE INCLUSIO --------------------*
  1589.  
  1590.  

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