Télécharger la plaquette Cast3M


fr en

Télécharger mailtopo.procedur

Retour à la liste

Numérotation des lignes : 

  1. * MAILTOPO  PROCEDUR  GOUNAND   25/07/24    21:15:03     12334          
  2. ************************************************************************
  3. * NOM         : MAILTOPO
  4. * DESCRIPTION : Algorithme topologique de génération ou d'optimisation
  5. *               d'un maillage.
  6. *
  7. *               Bibliographie :
  8. *
  9. *@article{doi:10.1080/12506559.2000.10511454,
  10. *     author = {Coupez, Thierry},
  11. *     title = {Génération de maillage et adaptation de maillage par
  12. *     optimisation locale},
  13. *     journal = {Revue Européenne des Éléments Finis},
  14. *     volume = {9},
  15. *     number = {4},
  16. *     pages = {403-423},
  17. *     year = {2000},
  18. *     doi = {10.1080/12506559.2000.10511454},
  19. *     URL = {http://www.tandfonline.com/doi/abs/10.1080/12506559.2000.10511454}}
  20. *
  21. *
  22. *@PhdThesis{,
  23. *  author =       {Cyril Gruau},
  24. *   title =        {Génération de métriques pour adaptation anisotrope
  25. *     de maillage, application à la mise en forme des matériaux},
  26. *  school =       {ENSMP},
  27. *  year =         {2004},
  28. *  month =     {10 dec}}
  29. *
  30. *@article{Gruau20054951,
  31. *     title = "3D tetrahedral, unstructured and anisotropic mesh
  32. *     generation with adaptation to natural and multidomain metric",
  33. *     journal = "Computer Methods in Applied Mechanics and Engineering",
  34. *     volume = "194",
  35. *     number = "48 - 49",
  36. *     pages = "4951 - 4976",
  37. *      year = "2005",
  38. *     issn = "0045-7825",
  39. *     doi = "10.1016/j.cma.2004.11.020",
  40. *     url = "http://www.sciencedirect.com/science/article/pii/S0045782505000745",
  41. *     author = "Cyril Gruau and Thierry Coupez",
  42. *     keywords = "Topology and shape optimization",
  43. *     keywords = "Elliptic interpolation",
  44. *     keywords = "Thickness detection and curvature treatment",
  45. *     keywords = "Interface refinement"}
  46. *
  47. * @article{Coupez20112391,
  48. *     title = "Metric construction by length distribution tensor and
  49. *     edge based error for anisotropic adaptive meshing",
  50. *     journal = "Journal of Computational Physics",
  51. *     volume = "230",
  52. *     number = "7",
  53. *     pages = "2391 - 2405",
  54. *     year = "2011",
  55. *     issn = "0021-9991",
  56. *     doi = "10.1016/j.jcp.2010.11.041",
  57. *     url = "http://www.sciencedirect.com/science/article/pii/S002199911000656X",
  58. *     author = "T. Coupez",
  59. *     keywords = "Metric",
  60. *     keywords = "Length distribution tensor",
  61. *     keywords = "Anisotropic meshing",
  62. *     keywords = "Interpolation error",
  63. *     keywords = "Edge error estimate"}
  64. *
  65. *
  66. * LANGAGE     : GIBIANE-CAST3M
  67. * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  68. *               mél : stephane.gounand@cea.fr
  69. **********************************************************************
  70. * VERSION    : v1, 28/11/2017, version initiale
  71. * HISTORIQUE : v1, 28/11/2017, création
  72. * DESCRIPTION : IJOB=0
  73. *               Minimise le volume d'une topologie de maillage
  74. *               en le maintenant supérieur à 0
  75. *               IJOB=1
  76. *               Minimise le volume, mais on a le droit d'ajouter des
  77. *               noeuds internes
  78. *               IJOB=2
  79. *               La topologie de maillage est supposée être un maillage
  80. *               On essaie de l'améliorer en conservant son volume
  81. *               mais en augmentant sa qualité grace a l'adjonction
  82. *               de noeuds internes
  83. *
  84. * 2017/11/30 : On remplace par ialgo (0 ou 1 : génération ou
  85. *              optimisation de maillage) et iajno (autorise-t-on
  86. *              l'algorithme à ajouter des noeuds.)
  87. * HISTORIQUE :
  88. * HISTORIQUE :
  89. ************************************************************************
  90. *
  91. 'DEBPROC' MAILTOPO ;
  92. * Mot-clé obligatoire :
  93. *            TRIA : génération de maillage (ialgo=0)
  94. *            REMA : remaillage             (ialgo=1)
  95. 'ARGU' moalgo*'MOT' ;
  96. lmoalgo = 'MOTS' 'TRIA' 'REMA' ;
  97. ialgo   = 'POSI' moalgo 'DANS' lmoalgo ;
  98. 'SI' ('EGA' ialgo 0) ;
  99.    'ERRE' 1052 'AVEC' moalgo lmoalgo ;
  100. 'FINS' ;
  101. ialgo = ialgo '-' 1 ;
  102. *
  103. 'ARGUMENT' topoini*'MAILLAGE' ;
  104. *dbg 'MESS' 'coucou mailtopo' ;
  105. *
  106. * Dans le cas REMA, le mailleur peut modifier le bord par défaut
  107. * seulement si on donne une métrique
  108. * à l'aide du noeud virtuel lvirt=vrai et on peut dire s'il y a une
  109. * partie du bord que l'on ne veut pas modifier
  110. * Dans le cas TRIA, le mailleur ne peut pas modifier le bord par défaut
  111. *
  112. 'SI' ('EGA' ialgo 1) ;
  113.    lvirt = vrai ;
  114.    'ARGU' mbnc/'MAILLAGE' ;
  115.    lmbnc = 'EXIS' mbnc ;
  116. 'FINS' ;
  117. 'SI' ('EGA' ialgo 0) ;
  118.    lvirt = faux ;
  119.    lmbnc = faux ;
  120. 'FINS' ;
  121. *
  122. * Valeur de la métrique
  123. * Attention pour les métriques scalaires, la donnée est homogène à une
  124. * longueur. Pour les métriques anisotropes (tensorielles), c'est
  125. * proportionnel à l'inverse du carré d'une longueur.
  126. *
  127. 'ARGU' metva/'FLOTTANT' ;
  128. 'SI' ('NON' ('EXIS' metva)) ;
  129.    'ARGU' metva/'CHPOINT' ;
  130. 'FINS' ;
  131. * Convention dans cette procédure : s'il n'y a pas de métrique
  132. * On met metva à faux
  133. lmet = 'EXIS' metva ;
  134. 'SI' ('NON' lmet) ;
  135.    metva = FAUX ;
  136. 'FINS' ;
  137. tmetva = 'TYPE' metva ;
  138. *
  139. * Mot-clés optionnels :
  140. *            IPOL : renvoie la métrique (type CHPOINT) interpolée
  141. *            AJNO : on a le droit d'ajouter des noeuds internes (iajno=1
  142. *                   par défaut)
  143. *            NOAJ : on n'ajoute pas de noeuds internes (iajno=0)
  144. *            ARIT : moyenne arithmétique pour l'interpolation de
  145. *                   métrique (imomet=0) par défaut
  146. *            GEOM : moyenne géométrique pour l'interpolation de métrique
  147. *                   (en fait, log-euclidienne) (imomet=1)
  148. *
  149. lmotcle = 'MOTS' 'IPOL' 'AJNO' 'NOAJ' 'ARIT' 'GEOM' ;
  150. lipol = faux ;
  151. iajno = 1 ;
  152. imomet = 0 ; momet = 'ARIT' ;
  153. 'REPE' bmotcle ;
  154.    'ARGU' motcle/'MOT' ;
  155.    'SI' ('NON' ('EXIS' motcle)) ;
  156.       'QUIT' bmotcle ;
  157.    'SINO' ;
  158. *      'MESS' motcle ;
  159.       'SI' ('NON' ('EXIS' lmotcle motcle)) ;
  160.          'ERRE' 1052 'AVEC' motcle lmotcle ;
  161.       'FINS' ;
  162.       'SI' ('EGA' motcle 'IPOL') ;
  163.          'SI' ('EGA' tmetva 'CHPOINT') ;
  164.             lipol = vrai ;
  165.          'SINO' ;
  166.             'ERRE' -370 'AVEC' motcle ;
  167. *  39 2
  168. *On ne veut pas d'objet de type %m1:8
  169.             'ERRE' 39 'AVEC' tmetva ;
  170.          'FINS' ;
  171.       'FINS' ;
  172.       'SI' ('EGA' motcle 'NOAJ') ; iajno = 0 ; 'FINS' ;
  173.       'SI' ('EGA' motcle 'AJNO') ; iajno = 1 ; 'FINS' ;
  174.       'SI' ('EGA' motcle 'ARIT') ; imomet = 0 ; momet = motcle ; 'FINS' ;
  175.       'SI' ('EGA' motcle 'GEOM') ; imomet = 1 ; momet = motcle ; 'FINS' ;
  176.    'FINS' ;
  177. 'FIN' bmotcle ;
  178. *
  179. * Lecture mots-clefs valeur jusqu'à épuisement obligatoire ou non,
  180. * valeurs par défaut...
  181. *
  182. *     Obligatoire
  183. *
  184. * DESCRIPTION : IJOB=0
  185. *               Minimise le volume d'une topologie de maillage
  186. *               en le maintenant supérieur à 0
  187. *               IJOB=1
  188. *               Minimise le volume, mais on a le droit d'ajouter des
  189. *               noeuds internes
  190. *               IJOB=2
  191. *               La topologie de maillage est supposée être un maillage
  192. *               On essaie de l'améliorer en conservant son volume
  193. *               mais en augmentant sa qualité grace a l'adjonction
  194. *               de noeuds internes
  195. *
  196. * 2017/11/30 : On remplace par ialgo (0 ou 1 : génération ou
  197. *              optimisation de maillage) et iajno (autorise-t-on
  198. *              l'algorithme à ajouter des noeuds.)
  199. * 2018/01/17 : On essaie de faire aller l'algorithme plus vite en ne
  200. *              parcourant que les éléments touchant les différences
  201. *              d'un cycle d'optimisation à l'autre
  202. *              paramètre
  203. *
  204. * 2018/06/16 : On a ajouté un indice bord_no_chan et corrigé quelques
  205. *              bugs dans son implémentation
  206. *
  207. *
  208. *
  209. *
  210. *ijob  = tparam . 'job' ;
  211. *
  212. *     Optionnel
  213. *
  214. 'ARGU' tparam/'TABLE' ;
  215. xtparam = 'EXIS' tparam ;
  216. 'SI' ('NON' xtparam) ;
  217.    tparam = 'TABL' ;
  218. 'FINS' ;
  219. *
  220. * debug : niveau d'impression de la procédure
  221. *
  222. debug = MATOUTIL 'GASTIDX' tparam 'debug' 0 ;
  223. *
  224. 'SI' ('>' debug 0) ;
  225.    'MESS' 'Mailleur topologique v1.0beta' ' -'
  226.       ' Bugs and suggestions to Stephane Gounand CEA France' ;
  227. 'FINS' ;
  228. *
  229. * graph : logique indiquant si la procédure émet des tracés
  230. *         (leur nombre dépend de debug)
  231. graph = MATOUTIL 'GASTIDX' tparam 'graph' faux ;
  232. *
  233. * id_cas : une chaine de caractères pour nommer le cas courant
  234. *
  235. idk = 'CHAI' 'topoini=' ('VALE' 'POINTEUR' topoini) ;
  236. idk = MATOUTIL 'GASTIDX' tparam 'id_cas' idk ;
  237. *
  238. * Nombre de boucle d'optimisation max
  239. *
  240. nboptim = MATOUTIL 'GASTIDX' tparam 'max_iter' 100 ;
  241. *
  242. * Sens de parcours des entités topologiques
  243. * isens = 0 (points, arêtes, faces, éléments)
  244. * isens = 1 sens inverse
  245. *
  246. isens = MATOUTIL 'GASTIDX' tparam 'sens' 0 ;
  247. **
  248. ** impr : niveau d'impression des opérateurs appelés (OPTO ou TOPV)
  249. ** (entre 0 et 3 pour l'instant)
  250. **
  251. *impr = 0 ;
  252. *'SI' ('EXIS' tparam 'impr') ; impr = tparam . 'impr' ; 'FINS' ;
  253. *
  254. * verif : niveau de vérification effectué dans les opérateurs appelés
  255. * (OPTO ou TOPV) (entre 0 et 2 pour l'instant)
  256. *
  257. iveri = MATOUTIL 'GASTIDX' tparam 'verif' 0 ;
  258. *
  259. * isegadj : impression des ajustements de dimension des segments
  260. * effectués dans les opérateurs appelés (OPTO ou TOPV) (entre 0 et 1)
  261. *
  262. isegadj = MATOUTIL 'GASTIDX' tparam 'impr_segadj' 0 ;
  263. *
  264. *
  265. * igibi = MATOUTIL 'GASTIDX' tparam 'type_implem' 0 ;
  266. *
  267. *
  268. * Table indiquant la stratégie de parcours des types de topologie
  269. * 1=points 2=aretes 3=triangles 4=tétras
  270. * Attention, on applique isens dessus. De plus les éléments de dimension
  271. * égale à celle de l'espace (surfaciques en 2D, volumiques en 3D) ne
  272. * seront parcourus que si on autorise l'ajout de noeuds.
  273. *
  274. vdim = 'VALE' 'DIME' ;
  275. tstrat = 'TABL' ;
  276. tstrat . 1 = 'LECT' 1 2 ;
  277. tstrat . 2 = 'LECT' 1 'PAS' 1 ('+' vdim 1) ;
  278. *
  279. tstrat = MATOUTIL 'GASTIDX' tparam 'strat_parcou_topo' tstrat ;
  280. * Verif
  281. 'SI' ('NON' ('EXIS' tstrat 1)) ;
  282.    ch1 = 'CHAI' 'La table de stratégie de parcours na pas dindice 1' ;
  283.    'MESS' ch1 ;
  284. * Données incompatibles
  285.    'ERRE' 21 ;
  286. 'FINS' ;
  287. *
  288. 'SI' ('EGA' isens 1) ;
  289.    istrat = 1 ;
  290.    'REPE' binv ;
  291.       'SI' ('EXIS' tstrat istrat) ;
  292.          tstrat . istrat = INVELIST (tstrat . istrat) ;
  293.          istrat = istrat '+' 1 ;
  294.       'SINO' ;
  295.          'QUIT' binv ;
  296.       'FINS' ;
  297.    'FIN' binv ;
  298. 'FINS' ;
  299. *
  300. * Nb de candidats max autour de chaque topologie parcourue
  301. *
  302. incma = MATOUTIL 'GASTIDX' tparam 'nb_cand_max' 1000 ;
  303. *
  304. * Stratégie à adopter si on dépasse le nombre de candidats max.
  305. *   0 : on saute le cas
  306. *   1 : on teste quelques candidats celui avec un noeud à la moitié
  307. *       du max. et avec le noeud milieu si possible
  308. *   2 : on sélectionne un nombre de candidats égal à incma^2 /
  309. *               nb points du bord
  310. istma = MATOUTIL 'GASTIDX' tparam 'strat_cand_max' 0 ;
  311. *
  312. * Tentative de stratégie rapide
  313. *
  314. lfast = MATOUTIL 'GASTIDX' tparam 'strat_fast' faux ;
  315. *
  316. * Tests sur la topologie initiale et correction éventuelle
  317. *
  318. lok = vrai ;
  319. * Type de job et type d'éléments du maillage
  320. 'SI' ('NON' ('EXIS' ('LECT' 2 3) vdim)) ;
  321. * 709 2
  322. *Fonction indisponible en dimension %i1.
  323.    'ERRE' 709 'AVEC' vdim ;
  324. 'FINS' ;
  325. *
  326. 'SI' ('EGA' vdim 2) ;
  327.    typlici1 = 'MOTS' 'SEG2' 'TRI3' ;
  328.    typlici2 = 'MOTS' 'SEG3' 'TRI6' ;
  329. 'FINS' ;
  330. 'SI' ('EGA' vdim 3) ;
  331.    typlici1 = 'MOTS' 'TRI3' 'TET4' ;
  332.    typlici2 = 'MOTS' 'TRI6' 'TE10' ;
  333. 'FINS' ;
  334. *
  335. ltini = 'ELEM' topoini 'TYPE' ;
  336. dltini = 'DIME' ltini ;
  337. 'SI' ('NEG' dltini 1) ;
  338.    'SI' ('EGA' dltini 0) ;
  339. *1027 2
  340. *Une donnee de type %M1:8 est vide
  341.       'ERRE' 1027 'AVEC' 'MAILLAGE' ;
  342.    'SINO' ;
  343. *    132 2
  344. *On veut un objet %m1:8 elementaire
  345.       'ERRE' 132 'AVEC' 'MAILLAGE' ;
  346.    'FINS' ;
  347. 'FINS' ;
  348. typel = 'EXTR' ltini 1 ;
  349. *'SI' ('EGA' ijob 2) ;
  350. 'SI' ('EGA' ialgo 1) ;
  351.    typlici1 = 'EXTR' typlici1 ('LECT' ('DIME' typlici1)) ;
  352.    typlici2 = 'EXTR' typlici2 ('LECT' ('DIME' typlici2)) ;
  353.    lvol = vrai ;
  354. 'FINS' ;
  355. *
  356. 'SI' ('NON' ('EXIS' (typlici1 'ET' typlici2) typel)) ;
  357. * 926 2
  358. *Le type d'element fini %m1:8 ne convient pas.
  359.    'ERRE' 926 'AVEC' ('CHAI' typel '    ') ;
  360. 'FINS' ;
  361. *
  362. 'SI' ('EGA' ialgo 0) ;
  363.    lvol = 'OU' ('EGA' typel ('EXTR' typlici1 ('DIME' typlici1)))
  364.                ('EGA' typel ('EXTR' typlici2 ('DIME' typlici2))) ;
  365. 'FINS' ;
  366. *
  367. lquad = 'EXIS' typlici2 typel ;
  368. 'SI' lquad ;
  369.    topoinq = topoini ;
  370.    topoini = 'CHAN' 'LINE' topoinq ;
  371.    'SI' lmbnc ;
  372.       mbncq = mbnc ;
  373.       mbnc = 'CHAN' 'LINE' mbncq ;
  374.    'FINS' ;
  375. 'FINS' ;
  376. *
  377. 'SI' ('NON' lvol) ;
  378.    borini = topoini ;
  379.    noini = 'POIN' borini 'INITIAL' ;
  380.    topoini = 'COUT' noini borini ;
  381. 'SINO' ;
  382.    borini  = MATOUTIL 'BORD' topoini ;
  383. 'FINS' ;
  384. *
  385. * mbnc : partie du bord ne devant pas changer
  386. *        mbnc = bord  si on est dans le cas TRIA (ialgo = 0)
  387. *        S'il n'a pas été donné explicitement dans le cas REMA (ialgo
  388. *        =1), on met la valeur par défaut :
  389. *        mbnc = vide
  390. *        Il faut que DIFF gère ce cas
  391. *        et que ETOILE soit correct
  392. *
  393.    'SI' ('NON' lmbnc) ;
  394.       'SI' ('NON' lvirt) ;
  395.          mbnc = borini ;
  396.       'SINO' ;
  397.          lelem   = 'MOTS' 'POI1' 'SEG2' 'TRI3' 'TET4' ;
  398.          dimtopo = DEADUTIL 'DIMM' topoini ;
  399.          dimbord = dimtopo '-' ialgo ;
  400.          telemb = 'EXTR' lelem dimbord ;
  401.          mbnc = 'VIDE' 'MAILLAGE'/telemb ;
  402.       'FINS' ;
  403.    'SINO' ;
  404. * 2020/05/02 : si le maillage à ne pas modifier est le bord, on peut
  405. *              enlever le noeud virtuel
  406.       'SI' ('EGA' ('NBEL' ('DIFF' borini mbnc)) 0) ;
  407.          lvirt = faux ;
  408.       'FINS' ;
  409.    'FINS' ;
  410. * Vérification que mbnc est inclus dans le bord
  411. * Est-ce nécessaire ? L'algorithme ne pourrait-il pas marcher
  412. * si mbnc est composé de bords internes. C'est à regarder mais
  413. * CONT et ENVE doivent alors gérer ces cas.
  414.    mi = 'INTE' mbnc borini 'NOVERIF' ;
  415. *   'SI' ('NON' (EGAMAIL mi mbnc)) ;
  416.    'SI' ('NEG' ('NBEL' ('DIFF'  mi mbnc)) 0) ;
  417.       cherr = 'CHAI' 'bord_no_chan non inclus dans le bord' ;
  418.       'ERRE' cherr ;
  419.    'FINS' ;
  420. *'FINS' ;
  421. *
  422. * Précisions relatives sur les volumes et les qualités des éléments.
  423. * Attention à ces valeurs, elles peuvent changer les maillages obtenus
  424. * assez facilement.
  425. *
  426. precrelv = MATOUTIL 'GASTIDX' tparam 'precrel_volume' 1.d-11 ;
  427. precrelq = MATOUTIL 'GASTIDX' tparam 'precrel_qualite' 1.d-2 ;
  428. *
  429. * Ceci doit apparaître après les dernières modifications de tparam
  430. *
  431. 'SI' ('>EG' debug 2) ;
  432.    'MESS' 'Parametres utilises :' ;
  433.    'LIST' tparam ;
  434. 'FINS' ;
  435. * Vérification des indices de la table en entrée
  436. tindok = MATOUTIL 'GENTABIN' 'debug' 'graph' 'id_cas'
  437.   'max_iter' 'sens' 'verif' 'impr_segadj'
  438.   'strat_parcou_topo' 'nb_cand_max' 'strat_cand_max' 'strat_fast' ;
  439. tindok = MATOUTIL 'GENTABIN' tindok 'precrel_volume'
  440.                          'precrel_qualite' ;
  441. MATOUTIL 'VERTABIN' tparam tindok ;
  442. *
  443. *   Orientation
  444. *
  445. *'SI' ('EGA' ijob 2) ;
  446. 'SI' ('EGA' ialgo 1) ;
  447.    topoino = 'ORIE' topoini ;
  448.    pointr1 pointr2 = 'VALEUR' 'POINTEUR' topoino topoini ;
  449.    'SI' ('NEG' pointr1 pointr2) ;
  450.       'MESS' '!!! Topologie initiale : changement orientation elements '
  451.          'pour le cas' ' ' idk ;
  452.       lok = lok 'ET' faux ;
  453.    'FINS' ;
  454. 'FINS' ;
  455. topoinu = 'UNIQ' topoini ;
  456. dnode = '-' ('NBEL' topoini) ('NBEL' topoinu) ;
  457. 'SI' ('NEG' dnode 0) ;
  458.    'MESSAGE' '!!! Topologie initiale :' ' ' dnode
  459.      ' elements en double pour le cas' ' ' idk ;
  460.      'SI' ('EGA' ialgo 1) ;
  461.         lok = lok 'ET' faux ;
  462.      'FINS' ;
  463. *   'SI' ('NEG' ijob 2) ;
  464. *   'FINS' ;
  465. 'FINS' ;
  466. *
  467. * Le bord doit être connexe pour la génération de maillage
  468. * Pas nécessairement pour l'optimisation de maillage
  469. *
  470. tcini = 'PART' 'CONN' borini ;
  471. lmc = 'EXIS' tcini 2 ;
  472. *'SI' ('ET' ('<' ijob 2) lmc) ;
  473. 'SI' ('ET' ('EGA' ialgo 0) lmc) ;
  474.    'MESS' '!!! Topologie initiale :'
  475.       ' Bord non connexe' ;
  476.    lok = lok 'ET' faux ;
  477. 'FINS' ;
  478. *
  479. * Algorithme d'amélioration du maillage
  480. *
  481. volucib = MATOUTIL 'MESUINTE' borini ;
  482. volutol = '*' volucib precrelv ;
  483. 'SI' ('>EG' debug 1) ;
  484. *'MESSAGE' ('CHAINE' 'Volume initial=' volini) ;
  485.    'MESSAGE' ('CHAINE' 'Volume cible=' volucib ' tolerance=' volutol) ;
  486.    'SI' graph ;
  487.       tit = 'CHAI' idk ' Topologie initiale' ;
  488.       'TRAC' 'CACH' topoini 'TITR' tit ;
  489. *      tit = 'CHAINE' idk ' Contour Initial ; vol=' volucib ;
  490. *      pbor = 'CHANGER' 'POI1' borini ;
  491. *      'TRACER' ('ET' borini pbor) 'TITR' tit ;
  492.    'FINS' ;
  493. 'FINSI' ;
  494.  
  495. * Qualités
  496. 'SI' ('>' debug 0) ;
  497.    dvol nctelem nnul nctno miq maq moq =
  498.       MATOUTIL 'AFFQUAL' topoini volucib volutol 'REST' 'VMET' metva momet ;
  499. 'SINO' ;
  500.    dvol nctelem nnul nctno miq maq moq =
  501.       MATOUTIL 'AFFQUAL' topoini volucib volutol 'REST' 'VMET' metva momet 'NAFF' ;
  502. 'FINS' ;
  503. *
  504. * Tests sur la topologie initiale (éventuellement corrigée de
  505. *      l'orientation et des éléments uniques)
  506. *
  507. 'SI' ('EGA' ialgo 1) ;
  508.    'SI' ('NEG' dvol 0. volutol) ;
  509.       'MESSAGE' '!!! Topologie initiale :'
  510.          ' Dvol non nul pour le cas' ' ' idk ;
  511.       lok = lok 'ET' faux ;
  512.    'FINS' ;
  513. 'FINS' ;
  514. 'SI' ('<' ('+' dvol volutol) 0.) ;
  515.    'MESSAGE' '!!! Dvol negative pour le cas' ' ' idk ;
  516.    lok = lok 'ET' faux ;
  517. 'FINSI' ;
  518. 'SI' ('NON' lok) ;
  519. * 845 2
  520. *Maillage donne incorrect ?!!!
  521.    'ERRE' 845 ;
  522. 'FINS' ;
  523. *
  524. 'SI' lvirt ;
  525.    'SI' ('EGA' vdim 2) ; pdep = 0.1 0.05 ; 'FINS' ;
  526.    'SI' ('EGA' vdim 3) ; pdep = 0.1 0.05 0.066 ; 'FINS' ;
  527.    pzero = 'PLUS' ('BARYCENTRE' borini) pdep ;
  528. 'SINO' ;
  529.    pzero = 0 ;
  530. 'FINSI' ;
  531. *
  532. curtopo = topoini ;
  533. * Statistiques
  534. * nnascm  : nombre d'appels de la stratégie de limitation
  535. *           du nombre de candidats
  536. * nparcou : nombre de topologies parcourues
  537. * nexplor : nombre de topologies explorées
  538. * nchange : nombre de topologies changées
  539. nnascm = 0 ; nparcou = 0 ; nexplor = 0 ; nchange = 0 ;
  540. oldtopo = curtopo ;
  541. *
  542. * Boucle d'optimisation
  543. *
  544. istrat = 1 ; lstrat0 = 'LECT' ;
  545. 'SI' lfast ; tfast = 'TABL' ; 'FINS' ;
  546. *
  547. 'REPETER' boptim nboptim ;
  548. *tst 'REPETER' boptim 1 ;
  549.    'SI' ('EXIS' tstrat istrat) ;
  550.       ltyptop = tstrat . istrat ;
  551.    'SINO' ;
  552.       'QUIT' boptim ;
  553.    'FINS' ;
  554. *dbg   'MESS' ('CHAI' 'istrat=' istrat ' ltyptop=') ;
  555. *dbg   'LIST' ltyptop ;
  556.    ntyptop ='DIME' ltyptop ;
  557. *
  558.    tchange = 0 ;
  559.    'REPE' typtop ntyptop ;
  560.       iar = 'EXTR' ltyptop &typtop ;
  561.       not1 = 'ET' ('EGA' iajno 0) ('EGA' iar ('+' vdim 1)) ;
  562.       not2 = 'EXIS' lstrat0 iar ;
  563. *dbg      'MESS' ('CHAI' 'iar=' iar ' iajno=' iajno ' vdim=' vdim
  564. *dbg         ' not1=' not1 ' not2=' not2) ;
  565. *dbg      'MESS' 'lstrat0' ; 'LIST' lstrat0 ;
  566.       'SI' ('NON' ('OU' not1 not2)) ;
  567.          'SI' lfast ;
  568.             'SI' ('EXIS' tfast iar) ;
  569.                pretopo = tfast . iar ;
  570.                elecom  = 'INTE' pretopo curtopo ;
  571.                eledifc = 'DIFF' curtopo elecom ;
  572.                ncurtopo = 'NBEL' curtopo ;
  573.                nelecom  = 'NBEL' elecom ;
  574.                neledifc = 'NBEL' eledifc ;
  575. *               naparcav = 'NBEL' aparc ;
  576. *               aparc   = 'ELEM' aparc 'APPUYE' 'LARGEMENT' eledifc ;
  577. *               naparcap = 'NBEL' aparc ;
  578.                curtopor = 'ELEM' curtopo 'APPUYE' 'LARGEMENT' eledifc ;
  579.                ncurr = 'NBEL' curtopor ;
  580. *               ch = 'CHAI' 'Acceleration : maillage (' neledifc ' / '
  581.                ch = 'CHAI' 'Acceleration : maillage (' ncurr ' / '
  582.                ncurtopo ')  ' ;
  583. *               iar ' (' naparcap ' / ' naparcav ')' ;
  584.                'MESS' ch ;
  585. *               AFFVAR 'ncurtopo' 'nelecom'
  586. *                  'neledifc' 'naparcav' 'naparcap' ;
  587.             'SINO' ;
  588.                'MESS' 'Pas dacceleration' ;
  589.                curtopor = curtopo ;
  590.             'FINS' ;
  591.             tfast . iar = curtopo ;
  592.          'SINO' ;
  593.             curtopor = curtopo ;
  594.          'FINS' ;
  595.          'SI' ('EGA' iar 1) ;
  596.             aparc = 'CHANGER' curtopor 'POI1' ;
  597.             motar = 'points' ;
  598.          'FINS' ;
  599.          'SI' ('EGA' iar 2) ;
  600.             aparc = 'CHANGER' curtopor 'LIGN' ;
  601.             motar = 'aretes' ;
  602.          'FINSI' ;
  603.          'SI' ('EGA' iar 3) ;
  604.             aparc =  'CHAN' curtopor 'SURF' ;
  605.             motar = 'triangles' ;
  606.          'FINSI' ;
  607.          'SI' ('EGA' iar 4) ;
  608.             aparc =  curtopor ;
  609.             motar = 'tetras' ;
  610.          'FINSI' ;
  611.          titec = 'CHAINE' 'bop=' &boptim ' ' motar ;
  612. *      trr = ('EGA' ikas 34) 'ET' ('EGA' &boptim 2) 'ET' ('EGA' iar 2) ;
  613. *      trr = ('EGA' ikas 35) 'ET' ('EGA' &boptim 1) 'ET' ('EGA' iar 3) ;
  614. *      trr = ('EGA' &boptim 3) 'ET' ('EGA' iar 1) ;
  615. *      'SI' trr ; debug = 4 ; 'SINO' ; debug = 2 ; 'FINS' ;
  616.          inascm = 0 ; iparcou = 0 ; iexplor = 0 ; ichange = 0 ;
  617.          nparc = 'NBEL' aparc ;
  618.          'SI' ('>EG' debug 2) ;
  619.             titt = 'CHAINE' titec ' nel=' nparc ;
  620.             'MESSAGE' titt ;
  621.          'FINS' ;
  622.          'SI' lvirt ;
  623.             curtopof = MATOUTIL 'FERMEPZ' curtopo mbnc pzero ;
  624.          'SINON' ;
  625.             curtopof = curtopo ;
  626.          'FINSI' ;
  627.          ch = 'CHAI' titec ' Topologie de depart' ;
  628.          'SI' ('>EG' debug 3) ;
  629.             'MESSAGE' ('CHAI' ch ' :') ;
  630.             'LISTE' curtopof ;
  631.             'SI' graph ;
  632.                'TRACER' 'CACH' curtopo 'NOEUD' 'TITR' ch ;
  633.             'FINS' ;
  634.          'FINS' ;
  635.          newtopo  = curtopo  ; newtopof = curtopof ;
  636.          jnascm = 0 ; jparcou = 0 ; jexplor = 0 ; jchange = 0 ;
  637. * igibi=0
  638.          newtopof metva kexplor kchange kparcou knascm = 'OPTO' newtopof aparc metva
  639.                   'VTOL' volutol 'QTOL' precrelq
  640.                   'ALGO' ialgo   'AJNO' iajno
  641.                   'VIRT' pzero
  642.                   'NCMA' incma 'STMA' istma 'MOYE' imomet
  643.                   'VERI' iveri 'SGAJ' isegadj 'IMPR' debug ;
  644.          jexplor = jexplor '+' kexplor ;
  645.          jchange = jchange '+' kchange ;
  646.          jparcou = jparcou '+' kparcou ;
  647.          jnascm  = jnascm  '+' knascm ;
  648. *
  649.          inascm  = '+' inascm  jnascm  ; nnascm  = '+' nnascm  jnascm  ;
  650.          iparcou = '+' iparcou jparcou ; nparcou = '+' nparcou jparcou ;
  651.          iexplor = '+' iexplor jexplor ; nexplor = '+' nexplor jexplor ;
  652.          ichange = '+' ichange jchange ; nchange = '+' nchange jchange ;
  653.          'SI' lvirt ;
  654.             newtopo = MATOUTIL 'OUVREPZ' newtopof pzero ;
  655.          'SINON' ;
  656.             newtopo = newtopof ;
  657.          'FINSI' ;
  658.          curtopo = newtopo ;
  659.          tparam . 'curtopo' = curtopo ;
  660. *
  661.          'SI' ('>EG' debug 2) ;
  662.             titt = 'CHAINE' 'bop=' &boptim ' ' motar
  663.                             ' Topologie: parcourues=' iparcou
  664.                             ' examinees=' iexplor
  665.                             ' changees=' ichange ' limit_cand=' inascm ;
  666.             'MESSAGE' titt ;
  667.             MATOUTIL 'AFFQUAL' curtopo volucib volutol 'VMET' metva momet ;
  668.             'SAUTER' 1 'LIGNE' ;
  669.             'SI' graph ;
  670. *?      AFFCAND curtopo 'QUAL' tit ;
  671.                curtopu = 'UNIQ' curtopo ;
  672.                dnode = '-' ('NBEL' curtopo) ('NBEL' curtopu) ;
  673.                'SI' ('NEG' dnode 0) ;
  674.                   'MESSAGE' '!!! ' dnode
  675.                      ' elements en double pour le cas ' idk ;
  676.                'FINS' ;
  677.                tit =  'CHAINE' 'bop=' &boptim ' '
  678.                    motar ' Topologie obtenue' ;
  679.                MATOUTIL 'AFFCAND' curtopu 'QUAL' 'VMET' metva momet
  680.                   'TITR' tit ;
  681.             'FINS' ;
  682.          'FINSI' ;
  683. *      kchange = '+' kchange ichange ;
  684.          oldtopo = curtopo ;
  685.       'SINO' ;
  686.          ichange = 0 ;
  687.       'FINS' ;
  688.       tchange = tchange '+' ichange ;
  689.       'SI' ('EGA' ichange 0) ;
  690.          'SI' ('NON' ('EXIS' lstrat0 iar)) ;
  691.             lstrat0 = lstrat0 'ET' iar ;
  692.          'FINS' ;
  693.       'SINO' ;
  694.          lstrat0 = 'LECT' ;
  695.       'FINS' ;
  696. *      'SI' trr ; 'QUIT' boptim ; 'FINS' ;
  697.    'FIN' typtop ;
  698.    'SI' ('EGA' tchange 0) ;
  699.       istrat = '+' istrat 1 ;
  700.    'SINO' ;
  701.       istrat = 1 ;
  702.    'FINS' ;
  703. 'FIN' boptim ;
  704. *
  705. 'SI' ('>EG' debug 1) ;
  706.    titt = 'CHAINE' idk ' Total:' ' '
  707.                    'Topologie: parcourues=' nparcou
  708.                    ' examinees=' nexplor
  709.                    ' changees=' nchange ' limit_cand=' nnascm ;
  710.    'MESSAGE' titt ;
  711.    MATOUTIL 'AFFQUAL' curtopo volucib volutol 'VMET' metva momet ;
  712.    'SI' graph ;
  713.       tit = 'CHAI' idk ' Topologie finale obtenue' ;
  714.       'TRAC' 'CACH' curtopo 'TITR' tit ;
  715.    'FINS' ;
  716. 'FINS' ;
  717. 'SAUTER' 1 'LIGNE' ;
  718. *
  719. * Tests et fin de la boucle
  720. *
  721. lok = vrai ;
  722. curtopu = 'UNIQ' curtopo ;
  723. dnode = '-' ('NBEL' curtopo) ('NBEL' curtopu) ;
  724. 'SI' ('NEG' dnode 0) ;
  725.    'MESSAGE' '!!!' ' ' dnode
  726.      ' elements en double pour le cas' ' ' idk ;
  727.    lok = lok 'ET' faux ;
  728. 'FINS' ;
  729. *'SI' ('NON' lvirt) ;
  730. * Si pas de noeud virtuel, on est censé conserver le bord
  731. * 2018/06/11 même en cas de modification du bord, il y a peut-être
  732. * une partie qui doit être conservée
  733.    bornew = MATOUTIL 'BORD' curtopo ;
  734.    mi = 'INTE' mbnc bornew 'NOVERIF' ;
  735. *   'SI' ('NON' (EGAMAIL mi mbnc)) ;
  736.    'SI' ('NEG' ('NBEL' ('DIFF' mi mbnc)) 0) ;
  737.       'MESSAGE' '!!! Bord modifie pour le cas' ' ' idk ;
  738.       lok = lok 'ET' faux ;
  739.       'TRAC' (mi 'ET' ('COUL' bornew 'ROUG')) ;
  740.    'FINS' ;
  741. *'FINS' ;
  742. * Qualités
  743. dvol nctelem nnul nctno miq maq moq =
  744.    MATOUTIL 'AFFQUAL' curtopo volucib volutol 'REST' 'NAFF'
  745.       'VMET' metva momet ;
  746. *dvol = '-' ('MESURE' curtopo) volucib ;
  747. 'SI' ('NEG' nnul 0) ;
  748.    'MESS' '!!! Elements de volume nul pour le cas' ' ' idk ;
  749.    lok = lok 'ET' faux ;
  750. 'FINS' ;
  751.    'SI' ('NEG' dvol 0. volutol) ;
  752.       'MESSAGE' '!!! Non cvg sur le volume pour le cas' ' ' idk ;
  753.       'MESSAGE' ('CHAI' 'dvol=' dvol ' volutol=' volutol) ;
  754. *      'MESSAGE' '!!! Dvol non nul pour le cas ' idk ;
  755.       'SI' ('NON' ('ET' ('EGA' ialgo 0) ('EGA' iajno 0))) ;
  756.          lok = lok 'ET' faux ;
  757.       'FINS' ;
  758.    'FINS' ;
  759. 'SI' ('<' ('+' dvol volutol) 0.) ;
  760.    'MESSAGE' '!!! Dvol negative pour le cas' ' ' idk ;
  761.    lok = lok 'ET' faux ;
  762. 'FINSI' ;
  763. *'SI' ('NEG' dvol 0. volutol) ;
  764. *   'MESSAGE' '!!! Non cvg sur le volume pour le cas ' idk ;
  765. *   'ERRE' 27 ;
  766. *'FINSI' ;
  767. 'SI' lquad ;
  768.    curtopq = 'CHAN' 'QUAD' curtopo topoinq ;
  769. *      'SI' lmbnc ;
  770. *         curtopq = 'CHAN' 'QUAD' curtopo mbncq ;
  771. *      'FINS' ;
  772.    curtopo = curtopq ;
  773. 'FINS' ;
  774. *
  775. * Restitution de quelques informations
  776. *
  777. tparam . 'nnascm'  = nnascm ;
  778. tparam . 'nparcou' = nparcou ;
  779. tparam . 'nexplor' = nexplor ;
  780. tparam . 'nchange' = nchange ;
  781. *
  782. tparam . 'dvol'   = dvol ;
  783. tparam . 'nnul'   = nnul ;
  784. tparam . 'miq'    = miq ;
  785. tparam . 'maq'    = maq ;
  786. tparam . 'moq'    = moq ;
  787. *
  788. tparam . 'curtopo' = curtopo ;
  789. *
  790. 'RESP' curtopo ;
  791. 'SI' lipol ;
  792.    'RESP' metva ;
  793. 'FINS' ;
  794. *lourd   'RESPRO'tparam ;
  795. *  27 2
  796. *Erreur generation de maillage. Il est neanmoins cree pour contrôle
  797. 'SI' ('NON' lok) ;
  798.    'ERRE' 27 ;
  799. 'FINSI' ;
  800. *
  801. * End of procedure file MAILTOPO
  802. *
  803. 'FINPROC' ;
  804.  
  805.  

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