Télécharger la plaquette Cast3M


fr en

Télécharger mailtopo.procedur

Retour à la liste

Numérotation des lignes : 

  1. * MAILTOPO  PROCEDUR  GOUNAND   21/04/09    21:15:04     10944          
  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 noeurds internes (iajno=0)
  144. *
  145. lmotcle = 'MOTS' 'IPOL' 'AJNO' 'NOAJ' ;
  146. lipol = faux ;
  147. iajno = 1 ;
  148. 'REPE' bmotcle ;
  149.    'ARGU' motcle/'MOT' ;
  150.    'SI' ('NON' ('EXIS' motcle)) ;
  151.       'QUIT' bmotcle ;
  152.    'SINO' ;
  153. *      'MESS' motcle ;
  154.       'SI' ('NON' ('EXIS' lmotcle motcle)) ;
  155.          'ERRE' 1052 'AVEC' motcle lmotcle ;
  156.       'FINS' ;
  157.       'SI' ('EGA' motcle 'IPOL') ;
  158.          'SI' ('EGA' ('TYPE' metva) 'CHPOINT') ;
  159.             lipol = vrai ;
  160.          'SINO' ;         
  161.             'ERRE' -370 'AVEC' motcle ;
  162. *  39 2
  163. *On ne veut pas d'objet de type %m1:8
  164.             'ERRE' 39 'AVEC' tmetva ;
  165.          'FINS' ;
  166.       'FINS' ;
  167.       'SI' ('EGA' motcle 'NOAJ') ; iajno = 0 ; 'FINS' ;
  168.       'SI' ('EGA' motcle 'AJNO') ; iajno = 1 ; 'FINS' ;
  169.    'FINS' ;
  170. 'FIN' bmotcle ;
  171. *
  172. * Lecture mots-clefs valeur jusqu'à épuisement obligatoire ou non,
  173. * valeurs par défaut...
  174. *
  175. *     Obligatoire
  176. *
  177. * DESCRIPTION : IJOB=0
  178. *               Minimise le volume d'une topologie de maillage
  179. *               en le maintenant supérieur à 0
  180. *               IJOB=1
  181. *               Minimise le volume, mais on a le droit d'ajouter des
  182. *               noeuds internes
  183. *               IJOB=2
  184. *               La topologie de maillage est supposée être un maillage
  185. *               On essaie de l'améliorer en conservant son volume
  186. *               mais en augmentant sa qualité grace a l'adjonction
  187. *               de noeuds internes
  188. *
  189. * 2017/11/30 : On remplace par ialgo (0 ou 1 : génération ou
  190. *              optimisation de maillage) et iajno (autorise-t-on
  191. *              l'algorithme à ajouter des noeuds.)
  192. * 2018/01/17 : On essaie de faire aller l'algorithme plus vite en ne
  193. *              parcourant que les éléments touchant les différences
  194. *              d'un cycle d'optimisation à l'autre
  195. *              paramètre 
  196. *
  197. * 2018/06/16 : On a ajouté un indice bord_no_chan et corrigé quelques
  198. *              bugs dans son implémentation
  199. *
  200. *
  201. *
  202. *
  203. *ijob  = tparam . 'job' ;
  204. *
  205. *     Optionnel
  206. *
  207. 'ARGU' tparam/'TABLE' ;
  208. xtparam = 'EXIS' tparam ;
  209. 'SI' ('NON' xtparam) ;
  210.    tparam = 'TABL' ;
  211. 'FINS' ;
  212. *
  213. * debug : niveau d'impression de la procédure
  214. *
  215. debug = MATOUTIL 'GASTIDX' tparam 'debug' 0 ;
  216. *
  217. 'SI' ('>EG' debug 0) ;
  218.    'MESS' 'Mailleur topologique v1.0beta' ' -'
  219.       ' Bugs and suggestions to Stephane Gounand CEA France' ;
  220. 'FINS' ;   
  221. *
  222. * graph : logique indiquant si la procédure émet des tracés
  223. *         (leur nombre dépend de debug)
  224. graph = MATOUTIL 'GASTIDX' tparam 'graph' faux ;
  225. *
  226. * id_cas : une chaine de caractères pour nommer le cas courant
  227. *
  228. idk = 'CHAI' 'topoini=' ('VALE' 'POINTEUR' topoini) ;
  229. idk = MATOUTIL 'GASTIDX' tparam 'id_cas' idk ;
  230. *
  231. * Nombre de boucle d'optimisation max
  232. *
  233. nboptim = MATOUTIL 'GASTIDX' tparam 'max_iter' 100 ;
  234. *
  235. * Sens de parcours des entités topologiques
  236. * isens = 0 (points, arêtes, faces, éléments)
  237. * isens = 1 sens inverse
  238. *
  239. isens = MATOUTIL 'GASTIDX' tparam 'sens' 0 ;
  240. **
  241. ** impr : niveau d'impression des opérateurs appelés (OPTO ou TOPV)
  242. ** (entre 0 et 3 pour l'instant)
  243. **
  244. *impr = 0 ;
  245. *'SI' ('EXIS' tparam 'impr') ; impr = tparam . 'impr' ; 'FINS' ;
  246. *
  247. * verif : niveau de vérification effectué dans les opérateurs appelés
  248. * (OPTO ou TOPV) (entre 0 et 2 pour l'instant)
  249. *
  250. iveri = MATOUTIL 'GASTIDX' tparam 'verif' 0 ;
  251. *
  252. * isegadj : impression des ajustements de dimension des segments
  253. * effectués dans les opérateurs appelés (OPTO ou TOPV) (entre 0 et 1)
  254. *
  255. isegadj = MATOUTIL 'GASTIDX' tparam 'impr_segadj' 0 ;
  256. *
  257. *
  258. * igibi = MATOUTIL 'GASTIDX' tparam 'type_implem' 0 ;
  259. *
  260. *
  261. * Table indiquant la stratégie de parcours des types de topologie
  262. * 1=points 2=aretes 3=triangles 4=tétras
  263. * Attention, on applique isens dessus. De plus les éléments de dimension
  264. * égale à celle de l'espace (surfaciques en 2D, volumiques en 3D) ne
  265. * seront parcourus que si on autorise l'ajout de noeuds.
  266. *
  267. vdim = 'VALE' 'DIME' ;
  268. tstrat = 'TABL' ;
  269. tstrat . 1 = 'LECT' 1 2 ;
  270. tstrat . 2 = 'LECT' 1 'PAS' 1 ('+' vdim 1) ;
  271. *
  272. tstrat = MATOUTIL 'GASTIDX' tparam 'strat_parcou_topo' tstrat ;
  273. * Verif
  274. 'SI' ('NON' ('EXIS' tstrat 1)) ;
  275.    ch1 = 'CHAI' 'La table de stratégie de parcours na pas dindice 1' ;
  276.    'MESS' ch1 ;
  277. * Données incompatibles   
  278.    'ERRE' 21 ;
  279. 'FINS' ;   
  280. *
  281. 'SI' ('EGA' isens 1) ;
  282.    istrat = 1 ;
  283.    'REPE' binv ;
  284.       'SI' ('EXIS' tstrat istrat) ;
  285.          tstrat . istrat = INVELIST (tstrat . istrat) ;
  286.          istrat = istrat '+' 1 ;
  287.       'SINO' ;
  288.          'QUIT' binv ;
  289.       'FINS' ;
  290.    'FIN' binv ;
  291. 'FINS' ;
  292. *
  293. * Nb de candidats max autour de chaque topologie parcourue
  294. *
  295. incma = MATOUTIL 'GASTIDX' tparam 'nb_cand_max' 1000 ;
  296. *
  297. * Stratégie à adopter si on dépasse le nombre de candidats max.
  298. *   0 : on saute le cas
  299. *   1 : on teste quelques candidats celui avec un noeud à la moitié
  300. *       du max. et avec le noeud milieu si possible
  301. *   2 : on sélectionne un nombre de candidats égal à incma^2 /
  302. *               nb points du bord
  303. istma = MATOUTIL 'GASTIDX' tparam 'strat_cand_max' 0 ;
  304. *
  305. * Tentative de stratégie rapide
  306. *
  307. lfast = MATOUTIL 'GASTIDX' tparam 'strat_fast' faux ;
  308. *
  309. * Tests sur la topologie initiale et correction éventuelle
  310. *
  311. lok = vrai ;
  312. * Type de job et type d'éléments du maillage
  313. 'SI' ('NON' ('EXIS' ('LECT' 2 3) vdim)) ;
  314. * 709 2
  315. *Fonction indisponible en dimension %i1.
  316.    'ERRE' 709 'AVEC' vdim ;
  317. 'FINS' ;   
  318. *
  319. 'SI' ('EGA' vdim 2) ;
  320.    typlicit = 'MOTS' 'SEG2' 'TRI3' ;
  321. 'FINS' ;   
  322. 'SI' ('EGA' vdim 3) ;
  323.    typlicit = 'MOTS' 'TRI3' 'TET4' ;
  324. 'FINS' ;   
  325. *
  326. ltini = 'ELEM' topoini 'TYPE' ;
  327. dltini = 'DIME' ltini ;
  328. 'SI' ('NEG' dltini 1) ;
  329.    'SI' ('EGA' dltini 0) ;
  330. *1027 2
  331. *Une donnee de type %M1:8 est vide
  332.       'ERRE' 1027 'AVEC' 'MAILLAGE' ;
  333.    'SINO' ;
  334. *    132 2
  335. *On veut un objet %m1:8 elementaire
  336.       'ERRE' 132 'AVEC' 'MAILLAGE' ;
  337.    'FINS' ;
  338. 'FINS' ;
  339. typel = 'EXTR' ltini 1 ;
  340. *'SI' ('EGA' ijob 2) ;
  341. 'SI' ('EGA' ialgo 1) ;
  342.    typlicit = 'EXTR' typlicit ('LECT' ('DIME' typlicit)) ;
  343.    lvol = vrai ;
  344. 'FINS' ;   
  345. *
  346. 'SI' ('NON' ('EXIS' typlicit typel)) ;
  347. * 926 2
  348. *Le type d'element fini %m1:8 ne convient pas.
  349.    'ERRE' 926 'AVEC' ('CHAI' typel '    ') ;
  350. 'FINS' ;
  351. *
  352. 'SI' ('EGA' ialgo 0) ;
  353.    lvol = 'EGA' typel ('EXTR' typlicit ('DIME' typlicit)) ;
  354. 'FINS' ;   
  355. *
  356. 'SI' ('NON' lvol) ;
  357.    borini = topoini ;
  358.    noini = 'POIN' borini 'INITIAL' ;
  359.    topoini = 'COUT' noini borini ;
  360. 'SINO' ;
  361.    borini  = MATOUTIL 'BORD' topoini ;
  362. 'FINS' ;   
  363. *
  364. * mbnc : partie du bord ne devant pas changer
  365. *        mbnc = bord  si on est dans le cas TRIA (ialgo = 0)
  366. *        S'il n'a pas été donné explicitement dans le cas REMA (ialgo
  367. *        =1), on met la valeur par défaut :
  368. *        mbnc = vide
  369. *        Il faut que DIFF gère ce cas
  370. *        et que ETOILE soit correct
  371. *
  372.    'SI' ('NON' lmbnc) ;
  373.       'SI' ('NON' lvirt) ;
  374.          mbnc = borini ;
  375.       'SINO' ; 
  376.          lelem   = 'MOTS' 'POI1' 'SEG2' 'TRI3' 'TET4' ;
  377.          dimtopo = DEADUTIL 'DIMM' topoini ;
  378.          dimbord = dimtopo '-' ialgo ;
  379.          telemb = 'EXTR' lelem dimbord ;
  380.          mbnc = 'VIDE' 'MAILLAGE'/telemb ;
  381.       'FINS' ;
  382.    'SINO' ;
  383. * 2020/05/02 : si le maillage à ne pas modifier est le bord, on peut
  384. *              enlever le noeud virtuel   
  385.       'SI' ('EGA' ('NBEL' ('DIFF' borini mbnc)) 0) ;
  386.          lvirt = faux ;
  387.       'FINS' ;
  388.    'FINS' ;   
  389. * Vérification que mbnc est inclus dans le bord
  390. * Est-ce nécessaire ? L'algorithme ne pourrait-il pas marcher
  391. * si mbnc est composé de bords internes. C'est à regarder mais
  392. * CONT et ENVE doivent alors gérer ces cas.
  393.    mi = 'INTE' mbnc borini 'NOVERIF' ;
  394. *   'SI' ('NON' (EGAMAIL mi mbnc)) ;
  395.    'SI' ('NEG' ('NBEL' ('DIFF'  mi mbnc)) 0) ;
  396.       cherr = 'CHAI' 'bord_no_chan non inclus dans le bord' ;
  397.       'ERRE' cherr ;
  398.    'FINS' ;
  399. *'FINS' ;
  400. *
  401. * Précisions relatives sur les volumes et les qualités des éléments.
  402. * Attention à ces valeurs, elles peuvent changer les maillages obtenus
  403. * assez facilement.
  404. *
  405. precrelv = MATOUTIL 'GASTIDX' tparam 'precrel_volume' 1.d-11 ;
  406. precrelq = MATOUTIL 'GASTIDX' tparam 'precrel_qualite' 1.d-2 ;
  407. *
  408. * Ceci doit apparaître après les dernières modifications de tparam
  409. *
  410. 'SI' ('>EG' debug 2) ;
  411.    'MESS' 'Parametres utilises :' ;
  412.    'LIST' tparam ;
  413. 'FINS' ;
  414. * Vérification des indices de la table en entrée
  415. tindok = MATOUTIL 'GENTABIN' 'debug' 'graph' 'id_cas'
  416.   'max_iter' 'sens' 'verif' 'impr_segadj'
  417.   'strat_parcou_topo' 'nb_cand_max' 'strat_cand_max' 'strat_fast' ;
  418. tindok = MATOUTIL 'GENTABIN' tindok 'precrel_volume'
  419.                          'precrel_qualite' ;  
  420. MATOUTIL 'VERTABIN' tparam tindok ;
  421. *
  422. *   Orientation
  423. *
  424. *'SI' ('EGA' ijob 2) ;
  425. 'SI' ('EGA' ialgo 1) ;
  426.    topoino = 'ORIE' topoini ;
  427.    pointr1 pointr2 = 'VALEUR' 'POINTEUR' topoino topoini ;
  428.    'SI' ('NEG' pointr1 pointr2) ;
  429.       'MESS' '!!! Topologie initiale : changement orientation elements '
  430.          'pour le cas' ' ' idk ;
  431.       lok = lok 'ET' faux ;
  432.    'FINS' ;
  433. 'FINS' ;
  434. topoinu = 'UNIQ' topoini ;
  435. dnode = '-' ('NBEL' topoini) ('NBEL' topoinu) ;
  436. 'SI' ('NEG' dnode 0) ;
  437.    'MESSAGE' '!!! Topologie initiale :' ' ' dnode
  438.      ' elements en double pour le cas' ' ' idk ;
  439.      'SI' ('EGA' ialgo 1) ;
  440.         lok = lok 'ET' faux ;
  441.      'FINS' ;   
  442. *   'SI' ('NEG' ijob 2) ;
  443. *   'FINS' ;
  444. 'FINS' ;
  445. *
  446. * Le bord doit être connexe pour la génération de maillage
  447. * Pas nécessairement pour l'optimisation de maillage
  448. *
  449. tcini = 'PART' 'CONN' borini ;
  450. lmc = 'EXIS' tcini 2 ;
  451. *'SI' ('ET' ('<' ijob 2) lmc) ;
  452. 'SI' ('ET' ('EGA' ialgo 0) lmc) ;
  453.    'MESS' '!!! Topologie initiale :'
  454.       ' Bord non connexe' ;
  455.    lok = lok 'ET' faux ;
  456. 'FINS' ;
  457. *
  458. * Algorithme d'amélioration du maillage
  459. *
  460. volucib = MATOUTIL 'MESUINTE' borini ;
  461. volutol = '*' volucib precrelv ;
  462. 'SI' ('>EG' debug 1) ;
  463. *'MESSAGE' ('CHAINE' 'Volume initial=' volini) ;
  464.    'MESSAGE' ('CHAINE' 'Volume cible=' volucib ' tolerance=' volutol) ;
  465.    'SI' graph ;
  466.       tit = 'CHAI' idk ' Topologie initiale' ;
  467.       'TRAC' 'CACH' topoini 'TITR' tit ;
  468. *      tit = 'CHAINE' idk ' Contour Initial ; vol=' volucib ;
  469. *      pbor = 'CHANGER' 'POI1' borini ;
  470. *      'TRACER' ('ET' borini pbor) 'TITR' tit ;
  471.    'FINS' ;      
  472. 'FINSI' ;
  473.  
  474. * Qualités
  475. 'SI' ('>' debug 0) ; 
  476.    dvol nctelem nnul nctno miq maq moq =
  477.       MATOUTIL 'AFFQUAL' topoini volucib volutol 'REST' 'VMET' metva ;
  478. 'SINO' ;
  479.    dvol nctelem nnul nctno miq maq moq =
  480.       MATOUTIL 'AFFQUAL' topoini volucib volutol 'REST' 'VMET' metva 'NAFF' ;
  481. 'FINS' ;
  482. *
  483. * Tests sur la topologie initiale (éventuellement corrigée de
  484. *      l'orientation et des éléments uniques)
  485. *
  486. 'SI' ('EGA' ialgo 1) ;
  487.    'SI' ('NEG' dvol 0. volutol) ;
  488.       'MESSAGE' '!!! Topologie initiale :'
  489.          ' Dvol non nul pour le cas' ' ' idk ;
  490.       lok = lok 'ET' faux ;
  491.    'FINS' ;
  492. 'FINS' ;               
  493. 'SI' ('<' ('+' dvol volutol) 0.) ;
  494.    'MESSAGE' '!!! Dvol negative pour le cas' ' ' idk ;
  495.    lok = lok 'ET' faux ;
  496. 'FINSI' ;
  497. 'SI' ('NON' lok) ;
  498. * 845 2
  499. *Maillage donne incorrect ?!!!
  500.    'ERRE' 845 ;
  501. 'FINS' ;
  502. *
  503. 'SI' lvirt ;
  504.    'SI' ('EGA' vdim 2) ; pdep = 0.1 0.05 ; 'FINS' ;
  505.    'SI' ('EGA' vdim 3) ; pdep = 0.1 0.05 0.066 ; 'FINS' ;
  506.    pzero = 'PLUS' ('BARYCENTRE' borini) pdep ;
  507. 'SINO' ;
  508.    pzero = 0 ;
  509. 'FINSI' ;
  510. *
  511. curtopo = topoini ;
  512. * Statistiques
  513. * nnascm  : nombre d'appels de la stratégie de limitation
  514. *           du nombre de candidats
  515. * nparcou : nombre de topologies parcourues
  516. * nexplor : nombre de topologies explorées
  517. * nchange : nombre de topologies changées
  518. nnascm = 0 ; nparcou = 0 ; nexplor = 0 ; nchange = 0 ;
  519. oldtopo = curtopo ;
  520. *
  521. * Boucle d'optimisation
  522. *
  523. istrat = 1 ; lstrat0 = 'LECT' ;
  524. 'SI' lfast ; tfast = 'TABL' ; 'FINS' ;
  525. *
  526. 'REPETER' boptim nboptim ;
  527. *tst 'REPETER' boptim 1 ;
  528.    'SI' ('EXIS' tstrat istrat) ;
  529.       ltyptop = tstrat . istrat ;
  530.    'SINO' ;
  531.       'QUIT' boptim ;
  532.    'FINS' ;
  533. *dbg   'MESS' ('CHAI' 'istrat=' istrat ' ltyptop=') ;
  534. *dbg   'LIST' ltyptop ;
  535.    ntyptop ='DIME' ltyptop ;
  536. *
  537.    tchange = 0 ;
  538.    'REPE' typtop ntyptop ;
  539.       iar = 'EXTR' ltyptop &typtop ;
  540.       not1 = 'ET' ('EGA' iajno 0) ('EGA' iar ('+' vdim 1)) ;
  541.       not2 = 'EXIS' lstrat0 iar ;
  542. *dbg      'MESS' ('CHAI' 'iar=' iar ' iajno=' iajno ' vdim=' vdim
  543. *dbg         ' not1=' not1 ' not2=' not2) ;
  544. *dbg      'MESS' 'lstrat0' ; 'LIST' lstrat0 ;
  545.       'SI' ('NON' ('OU' not1 not2)) ;
  546.          'SI' lfast ;
  547.             'SI' ('EXIS' tfast iar) ;
  548.                pretopo = tfast . iar ;
  549.                elecom  = 'INTE' pretopo curtopo ;
  550.                eledifc = 'DIFF' curtopo elecom ;
  551.                ncurtopo = 'NBEL' curtopo ;
  552.                nelecom  = 'NBEL' elecom ;
  553.                neledifc = 'NBEL' eledifc ;
  554. *               naparcav = 'NBEL' aparc ;   
  555. *               aparc   = 'ELEM' aparc 'APPUYE' 'LARGEMENT' eledifc ;
  556. *               naparcap = 'NBEL' aparc ;
  557.                curtopor = 'ELEM' curtopo 'APPUYE' 'LARGEMENT' eledifc ;
  558.                ncurr = 'NBEL' curtopor ;
  559. *               ch = 'CHAI' 'Acceleration : maillage (' neledifc ' / '
  560.                ch = 'CHAI' 'Acceleration : maillage (' ncurr ' / '
  561.                ncurtopo ')  ' ;
  562. *               iar ' (' naparcap ' / ' naparcav ')' ;
  563.                'MESS' ch ;
  564. *               AFFVAR 'ncurtopo' 'nelecom'
  565. *                  'neledifc' 'naparcav' 'naparcap' ;
  566.             'SINO' ;
  567.                'MESS' 'Pas dacceleration' ;
  568.                curtopor = curtopo ;
  569.             'FINS' ;
  570.             tfast . iar = curtopo ;
  571.          'SINO' ;
  572.             curtopor = curtopo ;
  573.          'FINS' ;
  574.          'SI' ('EGA' iar 1) ;
  575.             aparc = 'CHANGER' curtopor 'POI1' ;
  576.             motar = 'points' ;
  577.          'FINS' ;      
  578.          'SI' ('EGA' iar 2) ;
  579.             aparc = 'CHANGER' curtopor 'LIGN' ;
  580.             motar = 'aretes' ;
  581.          'FINSI' ;
  582.          'SI' ('EGA' iar 3) ;
  583.             aparc =  'CHAN' curtopor 'SURF' ;
  584.             motar = 'triangles' ;
  585.          'FINSI' ;
  586.          'SI' ('EGA' iar 4) ;
  587.             aparc =  curtopor ;
  588.             motar = 'tetras' ;
  589.          'FINSI' ;
  590.          titec = 'CHAINE' 'bop=' &boptim ' ' motar ;
  591. *      trr = ('EGA' ikas 34) 'ET' ('EGA' &boptim 2) 'ET' ('EGA' iar 2) ;
  592. *      trr = ('EGA' ikas 35) 'ET' ('EGA' &boptim 1) 'ET' ('EGA' iar 3) ;
  593. *      trr = ('EGA' &boptim 3) 'ET' ('EGA' iar 1) ;
  594. *      'SI' trr ; debug = 4 ; 'SINO' ; debug = 2 ; 'FINS' ;
  595.          inascm = 0 ; iparcou = 0 ; iexplor = 0 ; ichange = 0 ;
  596.          nparc = 'NBEL' aparc ;
  597.          'SI' ('>EG' debug 2) ;
  598.             titt = 'CHAINE' titec ' nel=' nparc ;
  599.             'MESSAGE' titt ;
  600.          'FINS' ;         
  601.          'SI' lvirt ;
  602.             curtopof = MATOUTIL 'FERMEPZ' curtopo mbnc pzero ;
  603.          'SINON' ;
  604.             curtopof = curtopo ;
  605.          'FINSI' ;
  606.          ch = 'CHAI' titec ' Topologie de depart' ;
  607.          'SI' ('>EG' debug 3) ;
  608.             'MESSAGE' ('CHAI' ch ' :') ;
  609.             'LISTE' curtopof ;
  610.             'SI' graph ;
  611.                'TRACER' 'CACH' curtopo 'NOEUD' 'TITR' ch ;
  612.             'FINS' ;
  613.          'FINS' ;
  614.          newtopo  = curtopo  ; newtopof = curtopof ;
  615.          jnascm = 0 ; jparcou = 0 ; jexplor = 0 ; jchange = 0 ;
  616. * igibi=0
  617.          newtopof metva kexplor kchange kparcou knascm = 'OPTO' newtopof aparc metva
  618.                   'VTOL' volutol 'QTOL' precrelq
  619.                   'ALGO' ialgo   'AJNO' iajno
  620.                   'VIRT' pzero
  621.                   'NCMA' incma 'STMA' istma
  622.                   'VERI' iveri 'SGAJ' isegadj 'IMPR' debug ;
  623.          jexplor = jexplor '+' kexplor ;
  624.          jchange = jchange '+' kchange ;
  625.          jparcou = jparcou '+' kparcou ;
  626.          jnascm  = jnascm  '+' knascm ;
  627. *
  628.          inascm  = '+' inascm  jnascm  ; nnascm  = '+' nnascm  jnascm  ;
  629.          iparcou = '+' iparcou jparcou ; nparcou = '+' nparcou jparcou ;
  630.          iexplor = '+' iexplor jexplor ; nexplor = '+' nexplor jexplor ;
  631.          ichange = '+' ichange jchange ; nchange = '+' nchange jchange ;
  632.          'SI' lvirt ;
  633.             newtopo = MATOUTIL 'OUVREPZ' newtopof pzero ;
  634.          'SINON' ;
  635.             newtopo = newtopof ;
  636.          'FINSI' ;
  637.          curtopo = newtopo ;
  638.          tparam . 'curtopo' = curtopo ;
  639. *
  640.          'SI' ('>EG' debug 2) ;
  641.             titt = 'CHAINE' 'bop=' &boptim ' ' motar
  642.                             ' Topologie: parcourues=' iparcou
  643.                             ' examinees=' iexplor
  644.                             ' changees=' ichange ' limit_cand=' inascm ;
  645.             'MESSAGE' titt ;
  646.             MATOUTIL 'AFFQUAL' curtopo volucib volutol 'VMET' metva ;
  647.             'SAUTER' 1 'LIGNE' ;
  648.             'SI' graph ;
  649. *?      AFFCAND curtopo 'QUAL' tit ;
  650.                curtopu = 'UNIQ' curtopo ;
  651.                dnode = '-' ('NBEL' curtopo) ('NBEL' curtopu) ;
  652.                'SI' ('NEG' dnode 0) ;
  653.                   'MESSAGE' '!!! ' dnode
  654.                      ' elements en double pour le cas ' idk ;
  655.                'FINS' ;
  656.                tit =  'CHAINE' 'bop=' &boptim ' '
  657.                    motar ' Topologie obtenue' ;
  658.                MATOUTIL 'AFFCAND' curtopu 'QUAL' 'VMET' metva
  659.                   'TITR' tit ;
  660.             'FINS' ;            
  661.          'FINSI' ;
  662. *      kchange = '+' kchange ichange ;
  663.          oldtopo = curtopo ;
  664.       'SINO' ;
  665.          ichange = 0 ;
  666.       'FINS' ;
  667.       tchange = tchange '+' ichange ;
  668.       'SI' ('EGA' ichange 0) ;
  669.          'SI' ('NON' ('EXIS' lstrat0 iar)) ;
  670.             lstrat0 = lstrat0 'ET' iar ;
  671.          'FINS' ;
  672.       'SINO' ;
  673.          lstrat0 = 'LECT' ;
  674.       'FINS' ;
  675. *      'SI' trr ; 'QUIT' boptim ; 'FINS' ;
  676.    'FIN' typtop ;
  677.    'SI' ('EGA' tchange 0) ;
  678.       istrat = '+' istrat 1 ;
  679.    'SINO' ;
  680.       istrat = 1 ;
  681.    'FINS' ;         
  682. 'FIN' boptim ;
  683. *
  684. 'SI' ('>EG' debug 1) ;
  685.    titt = 'CHAINE' idk ' Total:' ' ' 
  686.                    'Topologie: parcourues=' nparcou
  687.                    ' examinees=' nexplor
  688.                    ' changees=' nchange ' limit_cand=' nnascm ;
  689.    'MESSAGE' titt ;
  690.    MATOUTIL 'AFFQUAL' curtopo volucib volutol 'VMET' metva ;
  691.    'SI' graph ;
  692.       tit = 'CHAI' idk ' Topologie finale obtenue' ;
  693.       'TRAC' 'CACH' curtopo 'TITR' tit ;
  694.    'FINS' ;      
  695. 'FINS' ;   
  696. 'SAUTER' 1 'LIGNE' ;
  697. *
  698. * Tests et fin de la boucle
  699. *
  700. lok = vrai ;
  701. curtopu = 'UNIQ' curtopo ;
  702. dnode = '-' ('NBEL' curtopo) ('NBEL' curtopu) ;
  703. 'SI' ('NEG' dnode 0) ;
  704.    'MESSAGE' '!!!' ' ' dnode
  705.      ' elements en double pour le cas' ' ' idk ;
  706.    lok = lok 'ET' faux ;
  707. 'FINS' ;
  708. *'SI' ('NON' lvirt) ;
  709. * Si pas de noeud virtuel, on est censé conserver le bord
  710. * 2018/06/11 même en cas de modification du bord, il y a peut-être
  711. * une partie qui doit être conservée
  712.    bornew = MATOUTIL 'BORD' curtopo ;
  713.    mi = 'INTE' mbnc bornew 'NOVERIF' ;
  714. *   'SI' ('NON' (EGAMAIL mi mbnc)) ;
  715.    'SI' ('NEG' ('NBEL' ('DIFF' mi mbnc)) 0) ;
  716.       'MESSAGE' '!!! Bord modifie pour le cas' ' ' idk ;
  717.       lok = lok 'ET' faux ;
  718.    'FINS' ;
  719. *'FINS' ;
  720. * Qualités
  721. dvol nctelem nnul nctno miq maq moq =
  722.    MATOUTIL 'AFFQUAL' curtopo volucib volutol 'REST' 'NAFF'
  723.       'VMET' metva ;
  724. *dvol = '-' ('MESURE' curtopo) volucib ;
  725. 'SI' ('NEG' nnul 0) ;
  726.    'MESS' '!!! Elements de volume nul pour le cas' ' ' idk ;
  727.    lok = lok 'ET' faux ;
  728. 'FINS' ;
  729.    'SI' ('NEG' dvol 0. volutol) ;
  730.       'MESSAGE' '!!! Non cvg sur le volume pour le cas' ' ' idk ;
  731.       'MESSAGE' ('CHAI' 'dvol=' dvol) ;
  732. *      'MESSAGE' '!!! Dvol non nul pour le cas ' idk ;
  733.       'SI' ('NON' ('ET' ('EGA' ialgo 0) ('EGA' iajno 0))) ;
  734.          lok = lok 'ET' faux ;
  735.       'FINS' ;         
  736.    'FINS' ;
  737. 'SI' ('<' ('+' dvol volutol) 0.) ;
  738.    'MESSAGE' '!!! Dvol negative pour le cas' ' ' idk ;
  739.    lok = lok 'ET' faux ;
  740. 'FINSI' ;
  741. *'SI' ('NEG' dvol 0. volutol) ;
  742. *   'MESSAGE' '!!! Non cvg sur le volume pour le cas ' idk ;
  743. *   'ERRE' 27 ;
  744. *'FINSI' ;
  745. *
  746. * Restitution de quelques informations
  747. *
  748. tparam . 'nnascm'  = nnascm ;
  749. tparam . 'nparcou' = nparcou ;
  750. tparam . 'nexplor' = nexplor ;
  751. tparam . 'nchange' = nchange ;
  752. *
  753. tparam . 'dvol'   = dvol ;
  754. tparam . 'nnul'   = nnul ;
  755. tparam . 'miq'    = miq ;
  756. tparam . 'maq'    = maq ;
  757. tparam . 'moq'    = moq ;
  758. *
  759. tparam . 'curtopo' = curtopo ;
  760. *
  761. 'RESP' curtopo ;
  762. 'SI' lipol ;
  763.    'RESP' metva ;
  764. 'FINS' ;
  765. *lourd   'RESPRO'tparam ;
  766. *  27 2
  767. *Erreur generation de maillage. Il est neanmoins cree pour contrôle
  768. 'SI' ('NON' lok) ;
  769.    'ERRE' 27 ;
  770. 'FINSI' ;
  771. *
  772. * End of procedure file MAILTOPO
  773. *
  774. 'FINPROC' ;
  775.  
  776.  
  777.  

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