Télécharger mailtopo.procedur

Retour à la liste

Numérotation des lignes :

  1. * MAILTOPO PROCEDUR GOUNAND 26/06/11 21:15:06 12570
  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. *Test 'SI' ('EGA' ialgo 1) ;
  113. *Test lvirt = vrai ;
  114. *Test 'ARGU' mbnc/'MAILLAGE' ;
  115. *Test lmbnc = 'EXIS' mbnc ;
  116. *Test 'FINS' ;
  117. *Test 'SI' ('EGA' ialgo 0) ;
  118. *Test lvirt = faux ;
  119. *Test lmbnc = faux ;
  120. *Test 'FINS' ;
  121. 'ARGU' mbnc/'MAILLAGE' ;
  122. lmbnc = 'EXIS' mbnc ;
  123. *
  124. * Valeur de la métrique
  125. * Attention pour les métriques scalaires, la donnée est homogène à une
  126. * longueur. Pour les métriques anisotropes (tensorielles), c'est
  127. * proportionnel à l'inverse du carré d'une longueur.
  128. *
  129. 'ARGU' metva/'FLOTTANT' ;
  130. 'SI' ('NON' ('EXIS' metva)) ;
  131. 'ARGU' metva/'CHPOINT' ;
  132. 'FINS' ;
  133. * Convention dans cette procédure : s'il n'y a pas de métrique
  134. * On met metva à faux
  135. lmet = 'EXIS' metva ;
  136. 'SI' ('NON' lmet) ;
  137. metva = FAUX ;
  138. 'FINS' ;
  139. tmetva = 'TYPE' metva ;
  140. *
  141. * Mot-clés optionnels :
  142. * IPOL : renvoie la métrique (type CHPOINT) interpolée
  143. * AJNO : on a le droit d'ajouter des noeuds internes (iajno=1
  144. * par défaut)
  145. * NOAJ : on n'ajoute pas de noeuds internes (iajno=0)
  146. *
  147. lmotcle = 'MOTS' 'IPOL' 'AJNO' 'NOAJ' ;
  148. lipol = faux ;
  149. iajno = 1 ;
  150. 'REPE' bmotcle ;
  151. 'ARGU' motcle/'MOT' ;
  152. 'SI' ('NON' ('EXIS' motcle)) ;
  153. 'QUIT' bmotcle ;
  154. 'SINO' ;
  155. * 'MESS' motcle ;
  156. 'SI' ('NON' ('EXIS' lmotcle motcle)) ;
  157. 'ERRE' 1052 'AVEC' motcle lmotcle ;
  158. 'FINS' ;
  159. 'SI' ('EGA' motcle 'IPOL') ;
  160. 'SI' ('EGA' tmetva 'CHPOINT') ;
  161. lipol = vrai ;
  162. 'SINO' ;
  163. 'ERRE' -370 'AVEC' motcle ;
  164. * 39 2
  165. *On ne veut pas d'objet de type %m1:8
  166. 'ERRE' 39 'AVEC' tmetva ;
  167. 'FINS' ;
  168. 'FINS' ;
  169. 'SI' ('EGA' motcle 'NOAJ') ; iajno = 0 ; 'FINS' ;
  170. 'SI' ('EGA' motcle 'AJNO') ; iajno = 1 ; 'FINS' ;
  171. 'FINS' ;
  172. 'FIN' bmotcle ;
  173. *
  174. * Lecture mots-clefs valeur jusqu'à épuisement obligatoire ou non,
  175. * valeurs par défaut...
  176. *
  177. * Obligatoire
  178. *
  179. * DESCRIPTION : IJOB=0
  180. * Minimise le volume d'une topologie de maillage
  181. * en le maintenant supérieur à 0
  182. * IJOB=1
  183. * Minimise le volume, mais on a le droit d'ajouter des
  184. * noeuds internes
  185. * IJOB=2
  186. * La topologie de maillage est supposée être un maillage
  187. * On essaie de l'améliorer en conservant son volume
  188. * mais en augmentant sa qualité grace a l'adjonction
  189. * de noeuds internes
  190. *
  191. * 2017/11/30 : On remplace par ialgo (0 ou 1 : génération ou
  192. * optimisation de maillage) et iajno (autorise-t-on
  193. * l'algorithme à ajouter des noeuds.)
  194. * 2018/01/17 : On essaie de faire aller l'algorithme plus vite en ne
  195. * parcourant que les éléments touchant les différences
  196. * d'un cycle d'optimisation à l'autre
  197. * paramètre
  198. *
  199. * 2018/06/16 : On a ajouté un indice bord_no_chan et corrigé quelques
  200. * bugs dans son implémentation
  201. *
  202. *
  203. *
  204. *
  205. *ijob = tparam . 'job' ;
  206. *
  207. * Optionnel
  208. *
  209. 'ARGU' tparam/'TABLE' ;
  210. xtparam = 'EXIS' tparam ;
  211. 'SI' ('NON' xtparam) ;
  212. tparam = 'TABL' ;
  213. 'FINS' ;
  214. *
  215. * Interpolation de la metrique
  216. *
  217. imomet = MATOUTIL 'GASTIDX' tparam 'ipol_met' 0 ;
  218. 'SI' ('EGA' imomet 0) ;
  219. momet = 'ARIT' ;
  220. 'SINO' ;
  221. 'SI' ('EGA' imomet 1) ;
  222. momet = 'GEOM' ;
  223. 'SINO' ;
  224. 'ERRE' ('CHAI' 'ipol_met=' imomet ' incorrect') ;
  225. 'FINS' ;
  226. 'FINS' ;
  227. *
  228. * Generation d'un nouveau noeud
  229. *
  230. imobary = MATOUTIL 'GASTIDX' tparam 'bary_topo' 0 ;
  231. 'SI' ('NON' ('EXIS' ('LECT' 0 1) imobary)) ;
  232. 'ERRE' ('CHAI' 'bary_topo=' imobary ' incorrect') ;
  233. 'FINS' ;
  234.  
  235. *
  236. * impr : niveau d'impression de la procédure
  237. *
  238. impr = MATOUTIL 'GASTIDX' tparam 'impr' 0 ;
  239. *
  240. 'SI' ('>' impr 0) ;
  241. 'MESS' 'Mailleur topologique v1.2' ' -'
  242. ' Bugs and suggestions to Stephane Gounand CEA France' ;
  243. 'FINS' ;
  244. *
  245. * graph : logique indiquant si la procédure émet des tracés
  246. * (leur nombre dépend de impr)
  247. graph = MATOUTIL 'GASTIDX' tparam 'graph' faux ;
  248. *
  249. * id_cas : une chaine de caractères pour nommer le cas courant
  250. *
  251. idk = 'CHAI' 'topoini=' ('VALE' 'POINTEUR' topoini) ;
  252. idk = MATOUTIL 'GASTIDX' tparam 'id_cas' idk ;
  253. *
  254. * Nombre de boucle d'optimisation max
  255. *
  256. nboptim = MATOUTIL 'GASTIDX' tparam 'max_iter' 100 ;
  257. *
  258. * Sens de parcours des entités topologiques
  259. * isens = 0 (points, arêtes, faces, éléments)
  260. * isens = 1 sens inverse
  261. *
  262. isens = MATOUTIL 'GASTIDX' tparam 'sens' 0 ;
  263. *
  264. * Sort-on la sequence des maillages generes a l'indice 'seqtopo' de la table en sortie ?
  265. *
  266. iseqm = MATOUTIL 'GASTIDX' tparam 'sort_seqm' 0 ;
  267. *
  268. * Verifie-t-on la sequence des maillages generes ?
  269. *
  270. vseqm = MATOUTIL 'GASTIDX' tparam 'veri_seqm' 0 ;
  271. *
  272. * Sort-on les maillages apres chaque pass a l'indice 'seqpass' de la table en sortie ?
  273. *
  274. iseqp = MATOUTIL 'GASTIDX' tparam 'sort_mail_pass' 0 ;
  275. *
  276. * veri_opto : niveau de vérification effectué dans les opérateurs appelés
  277. * (OPTO ou TOPV) (entre 0 et 2 pour l'instant)
  278. *
  279. vopto = MATOUTIL 'GASTIDX' tparam 'veri_opto' 0 ;
  280. *
  281. * impr_opto : niveau d'impression dans les opérateurs appelés
  282. * (OPTO ou TOPV) (entre 0 et 2 pour l'instant)
  283. *
  284. iopto = MATOUTIL 'GASTIDX' tparam 'impr_opto' 0 ;
  285. *
  286. * isegadj : impression des ajustements de dimension des segments
  287. * effectués dans les opérateurs appelés (OPTO ou TOPV) (entre 0 et 1)
  288. *
  289. isegadj = MATOUTIL 'GASTIDX' tparam 'impr_segadj_opto' 0 ;
  290. *
  291. * idetcycl : detecte-t-on le cyclage ? (0 ou 1)
  292. *
  293. idetcycl = MATOUTIL 'GASTIDX' tparam 'detect_cycling' 1 ;
  294. *
  295. *
  296. * igibi = MATOUTIL 'GASTIDX' tparam 'type_implem' 0 ;
  297. *
  298. *
  299. * Table indiquant la stratégie de parcours des types de topologie
  300. * 1=points 2=aretes 3=triangles 4=tétras
  301. * Attention, on applique isens dessus. De plus les éléments de dimension
  302. * égale à celle de l'espace (surfaciques en 2D, volumiques en 3D) ne
  303. * seront parcourus que si on autorise l'ajout de noeuds.
  304. *
  305. vdim = 'VALE' 'DIME' ; vdim1 = vdim '+' 1 ;
  306. tstrat = 'TABL' ;
  307. tstrat . 1 = 'LECT' 1 2 ;
  308. tstrat . 2 = 'LECT' 1 'PAS' 1 vdim1 ;
  309. *
  310. tstrat = MATOUTIL 'GASTIDX' tparam 'strat_parcou_topo' tstrat ;
  311. * Verif
  312. 'SI' ('NON' ('EXIS' tstrat 1)) ;
  313. ch1 = 'CHAI' 'La table de stratégie de parcours na pas dindice 1' ;
  314. 'MESS' ch1 ;
  315. * Données incompatibles
  316. 'ERRE' 21 ;
  317. 'FINS' ;
  318. *
  319. 'SI' ('EGA' isens 1) ;
  320. istrat = 1 ;
  321. 'REPE' binv ;
  322. 'SI' ('EXIS' tstrat istrat) ;
  323. tstrat . istrat = INVELIST (tstrat . istrat) ;
  324. istrat = istrat '+' 1 ;
  325. 'SINO' ;
  326. 'QUIT' binv ;
  327. 'FINS' ;
  328. 'FIN' binv ;
  329. 'FINS' ;
  330. *
  331. * Nb de candidats max autour de chaque topologie parcourue
  332. *
  333. incma = MATOUTIL 'GASTIDX' tparam 'nb_cand_max' 1000 ;
  334. *
  335. * Stratégie à adopter si on dépasse le nombre de candidats max.
  336. * 0 : on saute le cas
  337. * 1 : on teste quelques candidats celui avec un noeud à la moitié
  338. * du max. et avec le noeud milieu si possible
  339. * 2 : on sélectionne un nombre de candidats égal à incma^2 /
  340. * nb points du bord
  341. istma = MATOUTIL 'GASTIDX' tparam 'strat_cand_max' 0 ;
  342. *
  343. * Tentative de stratégie rapide
  344. *
  345. lfast = MATOUTIL 'GASTIDX' tparam 'strat_fast' faux ;
  346. *
  347. * Tests sur la topologie initiale et correction éventuelle
  348. *
  349. lokdeb = vrai ;
  350. * Type de job et type d'éléments du maillage
  351. 'SI' ('NON' ('EXIS' ('LECT' 2 3) vdim)) ;
  352. * 709 2
  353. *Fonction indisponible en dimension %i1.
  354. 'ERRE' 709 'AVEC' vdim ;
  355. 'FINS' ;
  356. *
  357. 'SI' ('EGA' vdim 2) ;
  358. typlici1 = 'MOTS' 'SEG2' 'TRI3' ;
  359. typlici2 = 'MOTS' 'SEG3' 'TRI6' ;
  360. 'FINS' ;
  361. 'SI' ('EGA' vdim 3) ;
  362. typlici1 = 'MOTS' 'TRI3' 'TET4' ;
  363. typlici2 = 'MOTS' 'TRI6' 'TE10' ;
  364. 'FINS' ;
  365. *
  366. ltini = 'ELEM' topoini 'TYPE' ;
  367. dltini = 'DIME' ltini ;
  368. 'SI' ('NEG' dltini 1) ;
  369. 'SI' ('EGA' dltini 0) ;
  370. *1027 2
  371. *Une donnee de type %M1:8 est vide
  372. 'ERRE' 1027 'AVEC' 'MAILLAGE' ;
  373. 'SINO' ;
  374. * 132 2
  375. *On veut un objet %m1:8 elementaire
  376. 'ERRE' 132 'AVEC' 'MAILLAGE' ;
  377. 'FINS' ;
  378. 'FINS' ;
  379. typel = 'EXTR' ltini 1 ;
  380. *'SI' ('EGA' ijob 2) ;
  381. 'SI' ('EGA' ialgo 1) ;
  382. typlici1 = 'EXTR' typlici1 ('LECT' ('DIME' typlici1)) ;
  383. typlici2 = 'EXTR' typlici2 ('LECT' ('DIME' typlici2)) ;
  384. lvol = vrai ;
  385. 'FINS' ;
  386. *
  387. 'SI' ('NON' ('EXIS' (typlici1 'ET' typlici2) typel)) ;
  388. * 926 2
  389. *Le type d'element fini %m1:8 ne convient pas.
  390. 'ERRE' 926 'AVEC' ('CHAI' typel ' ') ;
  391. 'FINS' ;
  392. *
  393. 'SI' ('EGA' ialgo 0) ;
  394. lvol = 'OU' ('EGA' typel ('EXTR' typlici1 ('DIME' typlici1)))
  395. ('EGA' typel ('EXTR' typlici2 ('DIME' typlici2))) ;
  396. 'FINS' ;
  397. *
  398. lquad = 'EXIS' typlici2 typel ;
  399. 'SI' lquad ;
  400. topoinq = topoini ;
  401. topoini = 'CHAN' 'LINE' topoinq ;
  402. 'SI' lmbnc ;
  403. mbncq = mbnc ;
  404. mbnc = 'CHAN' 'LINE' mbncq ;
  405. 'FINS' ;
  406. 'FINS' ;
  407. *
  408. 'SI' ('NON' lvol) ;
  409. borini = topoini ;
  410. noini = 'POIN' borini 'INITIAL' ;
  411. topoini = 'COUT' noini borini ;
  412. 'SINO' ;
  413. borini = MATOUTIL 'BORD' topoini ;
  414. 'FINS' ;
  415. 'SI' ('EGA' iseqm 1) ;
  416. seqtopo = 'ENUM' topoini ;
  417. 'FINS' ;
  418. 'SI' ('EGA' iseqp 1) ;
  419. seqpass = 'ENUM' ;
  420. 'FINS' ;
  421. *
  422. * Orientation
  423. *
  424. txt = 'CHAI' '!!! Topologie initiale :' ;
  425. 'SI' ('EGA' ialgo 1) ;
  426. topoino = 'ORIE' topoini ;
  427. pointr1 pointr2 = 'VALEUR' 'POINTEUR' topoino topoini ;
  428. 'SI' ('NEG' pointr1 pointr2) ;
  429. 'MESS' txt ' Changement orientation elements '
  430. 'pour le cas' ' ' idk ;
  431. lokdeb = lokdeb 'ET' faux ;
  432. 'FINS' ;
  433. 'FINS' ;
  434. *
  435. * Le bord doit être connexe pour la génération de maillage
  436. * Pas nécessairement pour l'optimisation de maillage
  437. *
  438. 'SI' ('EGA' ialgo 0) ;
  439. tcini = 'PART' 'CONN' borini ;
  440. lmc = 'EXIS' tcini 2 ;
  441. 'SI' lmc ;
  442. 'MESS' txt ' bord non connexe' ;
  443. lokdeb = lokdeb 'ET' faux ;
  444. 'FINS' ;
  445. 'FINS' ;
  446. *
  447. * mbnc : partie du bord ne devant pas changer
  448. * mbnc = bord si on est dans le cas TRIA (ialgo = 0)
  449. * S'il n'a pas été donné explicitement dans le cas REMA (ialgo
  450. * =1), on met la valeur par défaut :
  451. * mbnc = vide
  452. * Il faut que DIFF gère ce cas
  453. * et que ETOILE soit correct
  454. *
  455. 'SI' ('NON' lmbnc) ;
  456. 'SI' ('EGA' ialgo 0) ;
  457. mbnc = borini ;
  458. 'SINO' ;
  459. lelem = 'MOTS' 'POI1' 'SEG2' 'TRI3' 'TET4' ;
  460. dimtopo = DEADUTIL 'DIMM' topoini ;
  461. dimbord = dimtopo '-' ialgo ;
  462. telemb = 'EXTR' lelem dimbord ;
  463. mbnc = 'VIDE' 'MAILLAGE'/telemb ;
  464. 'FINS' ;
  465. 'FINS' ;
  466. * 2020/05/02 : si le maillage à ne pas modifier est le bord, on peut
  467. * enlever le noeud virtuel
  468. mbc = 'DIFF' borini mbnc ;
  469. lvirt = 'NEG' ('NBEL' mbc) 0 ;
  470. * Vérification que mbnc est inclus dans le bord
  471. * Est-ce nécessaire ? L'algorithme ne pourrait-il pas marcher
  472. * si mbnc est composé de bords internes. C'est à regarder mais
  473. * CONT et ENVE doivent alors gérer ces cas.
  474.  
  475. lokti = MATOUTIL 'VERITOPO' topoini txt mbnc ;
  476. lokdeb = lokdeb 'ET' lokti ;
  477. *
  478. * Précisions relatives sur les volumes et les qualités des éléments.
  479. * Attention à ces valeurs, elles peuvent changer les maillages obtenus
  480. * assez facilement.
  481. *
  482. precrelv = MATOUTIL 'GASTIDX' tparam 'precrel_volume' 1.d-11 ;
  483. precrelq = MATOUTIL 'GASTIDX' tparam 'precrel_qualite' 1.d-2 ;
  484. 'SI' ('NON' lmet) ;
  485. * le 2eme et 3eme parametre ne servent pas
  486. critqs = MATOUTIL 'GASTIDX' tparam 'critquals' ('ENUM' ('PROG' 2 -3. -3.)) ;
  487. 'SINO' ;
  488. npassev = MATOUTIL 'GASTIDX' tparam 'nbpasses_rema' -3 ;
  489. 'SI' ('EXIS' ('LECT' -3 1 2) npassev) ;
  490. 'SI' ('EXIS' ('LECT' -3 2) npassev) ;
  491. critqs = MATOUTIL 'GASTIDX' tparam 'critquals' ('ENUM' ('PROG' 2 10. 3.) ('PROG' 2 10. 1.)) ;
  492. 'SINO' ;
  493. critqs = MATOUTIL 'GASTIDX' tparam 'critquals' ('ENUM' ('PROG' 2 10. 1.)) ;
  494. 'FINS' ;
  495. 'SINO' ;
  496. 'ERRE' ('CHAI' 'nbpasses_rema=' npassev ' invalide') ;
  497. 'FINS' ;
  498. 'FINS' ;
  499. *
  500. * Ceci doit apparaître après les dernières modifications de tparam
  501. *
  502. 'SI' ('>EG' impr 2) ;
  503. 'MESS' 'Parametres utilises :' ;
  504. 'LIST' tparam ;
  505. 'FINS' ;
  506. * Vérification des indices de la table en entrée
  507. tindok = MATOUTIL 'GENTABIN' 'impr' 'graph' 'id_cas'
  508. 'max_iter' 'sens' 'sort_seqm' 'veri_seqm' 'sort_mail_pass' 'veri_opto' 'impr_opto'
  509. 'impr_segadj_opto' 'detect_cycling'
  510. 'strat_parcou_topo' 'nb_cand_max' 'strat_cand_max' 'strat_fast' ;
  511. tindok = MATOUTIL 'GENTABIN' tindok 'precrel_volume' 'precrel_qualite' 'nbpasses_rema'
  512. 'critquals' 'ipol_met' 'bary_topo' 'parcou_topo' ;
  513. MATOUTIL 'VERTABIN' tparam tindok ;
  514. *
  515. * Algorithme d'amélioration du maillage
  516. *
  517. volucib = MATOUTIL 'MESUINTE' borini ;
  518. volutol = '*' volucib precrelv ;
  519. denstol = volutol '**' (1.D0 '/' vdim) ;
  520. 'SI' ('>EG' impr 1) ;
  521. 'MESSAGE' ('CHAINE' 'Volume cible=' volucib ' tolerance=' volutol) ;
  522. 'SI' graph ;
  523. tit = 'CHAI' idk ' Topologie initiale' ;
  524. 'TRAC' 'CACH' topoini 'TITR' tit ;
  525. 'FINS' ;
  526. 'FINSI' ;
  527.  
  528. *
  529. *'SI' lvirt ;
  530. * 'SI' ('EGA' vdim 2) ; pdep = 0.1 0.05 ; 'FINS' ;
  531. * 'SI' ('EGA' vdim 3) ; pdep = 0.1 0.05 0.066 ; 'FINS' ;
  532. * pzero = 'PLUS' ('BARYCENTRE' borini) pdep ;
  533. * mpzero = 'MANU' 'POI1' pzero ;
  534. *'SINO' ;
  535. * pzero = 0 ;
  536. * mpzero = 'VIDE' 'MAILLAGE'/'POI1' ;
  537. *'FINSI' ;
  538. *
  539. curtopo = topoini ;
  540. * Statistiques
  541. * nnascm : nombre d'appels de la stratégie de limitation
  542. * du nombre de candidats
  543. * nparcou : nombre de topologies parcourues
  544. * nexplor : nombre de topologies explorées
  545. * nchange : nombre de topologies changées
  546. nnascm = 0 ; nparcou = 0 ; nexplor = 0 ; nchange = 0 ;
  547. ioptim = 0 ;
  548. *
  549. * Boucle sur les passes
  550. *
  551. lfirst = vrai ;
  552. npass = 'DIME' critqs ;
  553. tparam . 'critquals_eff' = 'ENUM' ;
  554. *
  555. 'REPE' iipass npass ;
  556. ipass = &iipass ;
  557. critq = 'EXTR' critqs ipass ;
  558. jcq = 'ENTI' 'PROC' ('EXTR' critq 1) ;
  559. 'SI' ('NON' lmet) ;
  560. pcq = 2. ; qcq = -3. ;
  561. 'SINO' ;
  562. pcqdon = 'EXTR' critq 2 ;
  563. qcqdon = 'EXTR' critq 3 ;
  564. * Calcul auto des exposants p pour la p-moyenne des longueurs et
  565. * q pour diminuer l'influence de la qualite ;
  566. * Calcul de lmin/lmax
  567. qlmima = 'INDI' 'TOPO' curtopo metva ('PROG' 103 1 1) ;
  568. miqia = 'MINI' qlmima ; miqia = '-' miqia ('VALE' 'PREC') ;
  569. lmiqia = '/' ('LOG' miqia) ('LOG' 10.) ;
  570. xpre = ('VALE' 'PREC') '**' 0.75d0 ;
  571. lxpre = '/' ('LOG' xpre) ('LOG' 10.) ;
  572. pmax = '/' lxpre lmiqia ;
  573. pcq = 'MINI' ('PROG' pmax pcqdon) ;
  574. 'SI' ('<' ipass npass) ;
  575. 'SI' ('EGA' jcq 3) ;
  576. lmiqav = lmiqia ;
  577. 'SINO' ;
  578. qlmailav = 'INDI' 'TOPO' curtopo metva ('PROG' ('+' jcq 100) 1 1) ;
  579. miqav = 'MINI' qlmailav ;
  580. lmiqav = '/' ('LOG' miqav) ('LOG' 10.) ;
  581. 'FINS' ;
  582. * log1s2 = ((log 0.85) / (log 10.)) ;
  583. log1s2 = ((log 0.8) / (log 10.)) ;
  584. * log1s2 = ((log 0.7) / (log 10.)) ;
  585. qmin = lmiqav '/' log1s2 ;
  586. qcq = 'MAXI' ('PROG' qmin qcqdon) ;
  587. 'SINO' ;
  588. qcq = qcqdon ;
  589. 'FINS' ;
  590. 'FINS' ;
  591. critq_eff = 'PROG' jcq pcq qcq ;
  592. tparam . 'critquals_eff' = tparam . 'critquals_eff' 'ET' critq_eff ;
  593. 'SI' ('>EG' impr 2) ;
  594. titt = 'CHAI' '*** Passe' ' ' ipass ' critqual=' ' ' jcq ' ' pcq ' ' qcq ' ***' ;
  595. 'MESSAGE' titt ;
  596. 'FINS' ;
  597. *
  598. * Test geometrie a la premiere iteration
  599. *
  600. 'SI' lfirst ;
  601. * Qualités
  602. 'SI' ('>' impr 0) ;
  603. dvol nctelem nnul nctno miq maq meq =
  604. MATOUTIL 'AFFQUAL' topoini volucib denstol critq_eff 'REST' 'VMET' metva momet ;
  605. 'SINO' ;
  606. dvol nctelem nnul nctno miq maq meq =
  607. MATOUTIL 'AFFQUAL' topoini volucib denstol critq_eff 'REST' 'VMET' metva momet 'NAFF' ;
  608. 'FINS' ;
  609. *
  610. * Tests sur la topologie initiale (éventuellement corrigée de
  611. * l'orientation et des éléments uniques)
  612. *
  613. 'SI' ('EGA' ialgo 1) ;
  614. 'SI' ('NEG' dvol 0. volutol) ;
  615. 'MESSAGE' txt ' Dvol non nul pour le cas' ' ' idk ;
  616. lokdeb = lokdeb 'ET' faux ;
  617. 'FINS' ;
  618. 'FINS' ;
  619. 'SI' ('<' ('+' dvol volutol) 0.) ;
  620. 'MESSAGE' txt ' Dvol negative pour le cas' ' ' idk ;
  621. lokdeb = lokdeb 'ET' faux ;
  622. 'FINSI' ;
  623. 'SI' ('NON' lokdeb) ;
  624. * 845 2
  625. *Maillage donne incorrect ?!!!
  626. 'ERRE' 845 ;
  627. 'FINS' ;
  628. *
  629. * lnchange : liste des nombres de changement
  630. * lmiq : liste des qualites minimums
  631. * lmeq : liste des qualites medianes
  632. tstat = 'TABL' ;
  633. tstat . 'liar' = 'LECT' ;
  634. tstat . 'lipass' = 'LECT' ;
  635. tstat . 'lnchange' = 'LECT' ;
  636. tstat . 'ldvol' = 'PROG' dvol ;
  637. tstat . 'lnnul' = 'LECT' nnul ;
  638. tstat . 'lmiq' = 'PROG' miq ;
  639. tstat . 'lmeq' = 'PROG' meq ;
  640. tstat . 'lmaq' = 'PROG' maq ;
  641. itstat = 'INDE' tstat ;
  642. dtstat = 'DIME' itstat ;
  643. 'SI' xtparam ; tparam . 'tstat' = tstat ; 'FINS' ;
  644. lfirst = FAUX ;
  645. 'FINS' ;
  646. *
  647. * Boucle d'optimisation
  648. *
  649. istrat = 1 ; lstrat0 = 'LECT' ;
  650. 'SI' lfast ; tfast = 'TABL' ; 'FINS' ;
  651. *
  652. lcvg = faux ;
  653. lcycl = faux ;
  654. 'REPETER' boptim nboptim ;
  655. ioptim = '+' ioptim 1 ;
  656. *tst 'REPETER' boptim 1 ;
  657. lokloc = vrai ;
  658. 'SI' ('EXIS' tstrat istrat) ;
  659. ltyptop = tstrat . istrat ;
  660. 'SINO' ;
  661. lcvg = vrai ;
  662. 'QUIT' boptim ;
  663. 'FINS' ;
  664. *dbg 'MESS' ('CHAI' 'istrat=' istrat ' ltyptop=') ;
  665. *dbg 'LIST' ltyptop ;
  666. ntyptop ='DIME' ltyptop ;
  667. *
  668. tchange = 0 ;
  669. 'REPE' typtop ntyptop ;
  670. iar = 'EXTR' ltyptop &typtop ;
  671. 'SI' ('NON' ('ET' (iar '>EG' 1) (iar '&lt;EG' vdim1))) ;
  672. cherr = 'iar=' iar ' incorrect' ;
  673. 'ERRE' cherr ;
  674. 'FINS' ;
  675. not1 = 'ET' ('EGA' iajno 0) ('EGA' iar ('+' vdim 1)) ;
  676. not2 = 'EXIS' lstrat0 iar ;
  677. *dbg 'MESS' ('CHAI' 'iar=' iar ' iajno=' iajno ' vdim=' vdim
  678. *dbg ' not1=' not1 ' not2=' not2) ;
  679. *dbg 'MESS' 'lstrat0' ; 'LIST' lstrat0 ;
  680. 'SI' ('NON' ('OU' not1 not2)) ;
  681. 'SI' lfast ;
  682. 'SI' ('EXIS' tfast iar) ;
  683. pretopo = tfast . iar ;
  684. elecom = 'INTE' pretopo curtopo ;
  685. eledifc = 'DIFF' curtopo elecom ;
  686. ncurtopo = 'NBEL' curtopo ;
  687. nelecom = 'NBEL' elecom ;
  688. neledifc = 'NBEL' eledifc ;
  689. * naparcav = 'NBEL' aparc ;
  690. * aparc = 'ELEM' aparc 'APPUYE' 'LARGEMENT' eledifc ;
  691. * naparcap = 'NBEL' aparc ;
  692. curtopor = 'ELEM' curtopo 'APPUYE' 'LARGEMENT' eledifc ;
  693. ncurr = 'NBEL' curtopor ;
  694. * ch = 'CHAI' 'Acceleration : maillage (' neledifc ' / '
  695. ch = 'CHAI' 'Acceleration : maillage (' ncurr ' / '
  696. ncurtopo ') ' ;
  697. * iar ' (' naparcap ' / ' naparcav ')' ;
  698. 'MESS' ch ;
  699. * AFFVAR 'ncurtopo' 'nelecom'
  700. * 'neledifc' 'naparcav' 'naparcap' ;
  701. 'SINO' ;
  702. 'MESS' 'Pas dacceleration' ;
  703. curtopor = curtopo ;
  704. 'FINS' ;
  705. tfast . iar = curtopo ;
  706. 'SINO' ;
  707. 'SI' ('EXIS' tparam 'parcou_topo') ;
  708. curtopor = tparam . 'parcou_topo' ;
  709. 'SINO' ;
  710. curtopor = curtopo ;
  711. 'FINS' ;
  712. 'FINS' ;
  713. 'SI' ('EGA' iar 1) ;
  714. aparc = 'CHANGER' curtopor 'POI1' ;
  715. motar = 'points' ;
  716. 'FINS' ;
  717. 'SI' ('EGA' iar 2) ;
  718. aparc = 'CHANGER' curtopor 'LIGN' ;
  719. motar = 'aretes' ;
  720. 'FINSI' ;
  721. 'SI' ('EGA' iar 3) ;
  722. aparc = 'CHAN' curtopor 'SURF' ;
  723. motar = 'triangles' ;
  724. 'FINSI' ;
  725. 'SI' ('EGA' iar 4) ;
  726. aparc = curtopor ;
  727. motar = 'tetras' ;
  728. 'FINSI' ;
  729. titec = 'CHAINE' 'bop=' ioptim ' ' motar ;
  730. * trr = ('EGA' ikas 34) 'ET' ('EGA' &boptim 2) 'ET' ('EGA' iar 2) ;
  731. * trr = ('EGA' ikas 35) 'ET' ('EGA' &boptim 1) 'ET' ('EGA' iar 3) ;
  732. * trr = ('EGA' &boptim 3) 'ET' ('EGA' iar 1) ;
  733. * 'SI' trr ; impr = 4 ; 'SINO' ; impr = 2 ; 'FINS' ;
  734. inascm = 0 ; iparcou = 0 ; iexplor = 0 ; ichange = 0 ;
  735. nparc = 'NBEL' aparc ;
  736. 'SI' ('>EG' impr 2) ;
  737. titt = 'CHAINE' titec ' nel=' nparc ;
  738. 'MESSAGE' titt ;
  739. 'FINS' ;
  740. 'SI' lvirt ;
  741. * curtopof = MATOUTIL 'FERMEPZ' curtopo mbnc pzero ;
  742. curtopof mpzero = MATOUTIL 'FERMEPZ' curtopo mbnc ialgo denstol impr ;
  743. 'SINON' ;
  744. curtopof = curtopo ;
  745. mpzero = 'VIDE' 'MAILLAGE'/'POI1' ;
  746. 'FINSI' ;
  747. ch = 'CHAI' titec ' Topologie de depart' ;
  748. 'SI' ('>EG' impr 3) ;
  749. 'MESSAGE' ('CHAI' ch ' :') ;
  750. 'LISTE' curtopof ;
  751. 'SI' graph ;
  752. 'TRACER' 'CACH' curtopo 'NOEUD' 'TITR' ch ;
  753. 'FINS' ;
  754. 'FINS' ;
  755. newtopo = curtopo ; newtopof = curtopof ;
  756. metvan = metva ;
  757. jnascm = 0 ; jparcou = 0 ; jexplor = 0 ; jchange = 0 ;
  758.  
  759. ltopinf newtopof metvan kexplor kchange kparcou knascm = 'OPTO' newtopof aparc metvan
  760. 'VTOL' volutol 'QTOL' precrelq 'CRIQ' critq_eff
  761. 'ALGO' ialgo 'AJNO' iajno
  762. 'VIRT' mpzero
  763. 'NCMA' incma 'STMA' istma
  764. 'VERI' vopto 'SGAJ' isegadj 'IMPR' iopto
  765. 'MOYE' imomet 'BARY' imobary 'SEQM' iseqm ;
  766. jexplor = jexplor '+' kexplor ;
  767. jchange = jchange '+' kchange ;
  768. jparcou = jparcou '+' kparcou ;
  769. jnascm = jnascm '+' knascm ;
  770. *
  771. inascm = '+' inascm jnascm ; nnascm = '+' nnascm jnascm ;
  772. iparcou = '+' iparcou jparcou ; nparcou = '+' nparcou jparcou ;
  773. iexplor = '+' iexplor jexplor ; nexplor = '+' nexplor jexplor ;
  774. ichange = '+' ichange jchange ; nchange = '+' nchange jchange ;
  775. 'SI' lvirt ;
  776. newtopo = MATOUTIL 'OUVREPZ' newtopof mpzero ;
  777. ltopin = MATOUTIL 'OUVREPZ' ltopinf mpzero ;
  778. 'SINON' ;
  779. newtopo = newtopof ;
  780. ltopin = ltopinf ;
  781. 'FINSI' ;
  782. * Verif ltopinf
  783. 'SI' ('OU' ('EGA' iseqm 1) ('EGA' vseqm 1)) ;
  784. dim3 = 'DIME' ltopin ;
  785. dim = dim3 '/' 3 ;
  786. 'SI' ('NEG' ('*' dim 3) dim3) ;
  787. 'ERRE' 'Dimension liste maillage non divisible par 3' ;
  788. 'FINS' ;
  789. 'SI' ('EGA' iseqm 1) ;
  790. seqtopo = seqtopo 'ET' ltopin ;
  791. 'FINS' ;
  792. 'SI' ('EGA' vseqm 1) ;
  793. newtop2 = curtopo ;
  794. iim3 = 0 ;
  795. lokl = vrai ;
  796. 'REPE' iiim dim ;
  797. iim3 = '+' iim3 1 ;
  798. lmi = 'EXTR' ltopin iim3 ;
  799. iim3 = '+' iim3 1 ;
  800. topoavi = 'EXTR' ltopin iim3 ;
  801. newtop21 = 'DIFF' newtop2 topoavi ;
  802. iim3 = '+' iim3 1 ;
  803. topoapi = 'EXTR' ltopin iim3 ;
  804. newtop22 = newtop21 'ET' topoapi ;
  805. 'SI' ('NON' lokl) ;
  806. 'MESS' 'Changement' ' ' &iiim ' / ' dim ;
  807. 'FINS' ;
  808. txt = 'CHAI' '!!! Topologie' ' ' &iiim ' :' ;
  809. 'SI' ('EGA' ialgo 1) ;
  810. loki = MATOUTIL 'VERITOPO' newtop22 volucib volutol txt mbnc ;
  811. 'SINO' ;
  812. loki = MATOUTIL 'VERITOPO' newtop22 txt mbnc ;
  813. 'FINS' ;
  814. lokl = lokl 'ET' loki ;
  815. 'SI' ('OU' ('NON' loki) ('>EG' impr 3)) ;
  816. ch = 'CHAI' txt ' avant' ;
  817. 'TRAC' (newtop21 'ET' ('COUL' 'VERT' topoavi)) 'TITR' ch ;
  818. ch = 'CHAI' txt ' apres' ;
  819. 'TRAC' (newtop21 'ET' ('COUL' 'ROUG' topoapi)) 'TITR' ch ;
  820. * Nouvel appel avec full impression
  821. 'SI' ('NON' loki) ;
  822. ltopinf2 newtopof2 metva2 kexplor2 kchange2 kparcou2 knascm2 = 'OPTO' newtop2 lmi (metva 'ET' metvan)
  823. 'VTOL' volutol 'QTOL' precrelq 'CRIQ' critq_eff
  824. 'ALGO' ialgo 'AJNO' iajno
  825. 'VIRT' mpzero
  826. 'NCMA' incma 'STMA' istma
  827. 'VERI' 10 'SGAJ' 1 'IMPR' 4
  828. 'MOYE' imomet 'BARY' imobary 'SEQM' iseqm ;
  829. 'ERRE' stop ;
  830. 'FINS' ;
  831. 'FINS' ;
  832. newtop2 = newtop22 ;
  833. 'FIN' iiim ;
  834. dtopo = 'DIFF' newtopo newtop2 ;
  835. 'SI' ('NEG' ('NBEL' dtopo) 0) ;
  836. 'ERRE' 'Newtop2 et newtopo pas identiques' ;
  837. 'FINS' ;
  838. 'FINS' ;
  839. 'FINS' ;
  840. curtopo = newtopo ;
  841. *! 'SI' ('EGA' iseqm 1) ;
  842. *! metva = metva 'ET' metvan ;
  843. *! 'SINO' ;
  844. metva = metvan ;
  845. *! 'FINS' ;
  846. tparam . 'curtopo' = curtopo ;
  847. * Verifs
  848. txt = 'CHAI' '!!! Topologie courante :' ;
  849. 'SI' ('EGA' ialgo 1) ;
  850. lokt = MATOUTIL 'VERITOPO' curtopo volucib volutol txt mbnc ;
  851. 'SINO' ;
  852. lokt = MATOUTIL 'VERITOPO' curtopo txt mbnc ;
  853. 'FINS' ;
  854. lokloc = lokloc 'ET' lokt ;
  855. *
  856. 'SI' ('>EG' impr 2) ;
  857. titt = 'CHAINE' 'bop=' ioptim ' ' motar
  858. ' Topologie: parcourues=' iparcou
  859. ' examinees=' iexplor
  860. ' changees=' ichange ' limit_cand=' inascm ;
  861. 'MESSAGE' titt ;
  862. dvol nctelem nnul nctno miq maq meq =
  863. MATOUTIL 'AFFQUAL' curtopo volucib denstol critq_eff 'REST' 'VMET' metva momet ;
  864. 'SAUTER' 1 'LIGNE' ;
  865. * AFFCAND ne marche que s'il n'y a pas delements en double...
  866. 'SI' (graph 'ET' lokt) ;
  867. tit = 'CHAINE' 'bop=' ioptim ' '
  868. motar ' Topologie obtenue' ;
  869. MATOUTIL 'AFFCAND' curtopo 'QUAL' 'VMET' metva momet
  870. 'TITR' tit ;
  871. 'FINS' ;
  872. 'SINO' ;
  873. dvol nctelem nnul nctno miq maq meq =
  874. MATOUTIL 'AFFQUAL' curtopo volucib denstol critq_eff 'REST' 'VMET' metva momet 'NAFF' ;
  875. 'FINSI' ;
  876. * kchange = '+' kchange ichange ;
  877. 'SINO' ;
  878. ichange = 0 ;
  879. 'FINS' ;
  880. tchange = tchange '+' ichange ;
  881. 'SI' ('EGA' ichange 0) ;
  882. 'SI' ('NON' ('EXIS' lstrat0 iar)) ;
  883. lstrat0 = lstrat0 'ET' iar ;
  884. 'FINS' ;
  885. 'SINO' ;
  886. lstrat0 = 'LECT' ;
  887. 'FINS' ;
  888. * 'SI' trr ; 'QUIT' boptim ; 'FINS' ;
  889. 'SI' ('NON' lokloc) ; 'MESS' 'lokloc faux' ; 'QUIT' typtop ; 'FINS' ;
  890. 'SI' ('NON' ('ET' (iar '>EG' 1) (iar '&lt;EG' vdim1))) ;
  891. cherr = 'iar=' iar ' incorrect' ;
  892. 'ERRE' cherr ;
  893. 'FINS' ;
  894. tstat . 'liar' = tstat . 'liar' 'ET' iar ;
  895. tstat . 'lipass' = tstat . 'lipass' 'ET' ipass ;
  896. tstat . 'lnchange' = tstat . 'lnchange' 'ET' ichange ;
  897. tstat . 'ldvol' = tstat . 'ldvol' 'ET' dvol ;
  898. tstat . 'lnnul' = tstat . 'lnnul' 'ET' nnul ;
  899. tstat . 'lmiq' = tstat . 'lmiq' 'ET' miq ;
  900. tstat . 'lmeq' = tstat . 'lmeq' 'ET' meq ;
  901. tstat . 'lmaq' = tstat . 'lmaq' 'ET' maq ;
  902. 'FIN' typtop ;
  903. * Tentative detection cyclage (freqmax dernieres valeurs egales)
  904. lcycl = faux ;
  905. * 'SI' ('ET' ('EGA' idetcycl 1) ('NEG' tchange 0)) ;
  906. 'SI' ('EGA' idetcycl 1) ;
  907. *
  908. freqmin = 2 ;
  909. freqmax = '*' (vdim '+' 1) 4 ;
  910. lfreqp = 'LECT' ;
  911. 'REPE' iifreq (freqmax '-' freqmin '+' 1) ;
  912. ifreq = &iifreq '+' freqmin '-' 1 ;
  913. lfoundf = vrai ;
  914. 'REPE' il dtstat ;
  915. ind = itstat . &il ;
  916. lval = tstat . ind ;
  917. dlval = 'DIME' lval ;
  918. ilval = dlval '-' ifreq ;
  919. 'SI' ('<' ilval 1) ; lfoundf = faux ; 'QUIT' iifreq ; 'FINS' ;
  920. vcou = 'EXTR' lval ilval ;
  921. vlas = 'EXTR' lval dlval ;
  922. 'SI' ('EGA' ('TYPE' vlas) 'ENTIER') ;
  923. lfoundf = 'ET' lfoundf ('EGA' vlas vcou) ;
  924. 'SINO' ;
  925. 'SI' ('EGA' ind 'ldvol') ;
  926. lfoundf = 'ET' lfoundf ('EGA' vlas vcou volutol) ;
  927. 'SINO' ;
  928. lfoundf = 'ET' lfoundf ('EGA' vlas vcou (vlas '*' precrelq)) ;
  929. 'FINS' ;
  930. 'FINS' ;
  931. 'SI' ('NON' lfoundf) ; 'ITER' iifreq ; 'FINS' ;
  932. 'FIN' il ;
  933. 'SI' lfoundf ; lfreqp = lfreqp 'ET' ifreq ; 'FINS' ;
  934. * 'SI' lfoundf ; freqp = ifreq ; 'QUIT' iifreq ; 'FINS' ;
  935. 'FIN' iifreq ;
  936. dlfreqp = 'DIME' lfreqp ;
  937. 'SI' ('>' dlfreqp 0) ;
  938. * 'SI' lfoundf ;
  939. * 'MESS' 'Detection cyclage : frequences possibles =' ; 'LIST' lfreqp ;
  940. * 'MESS' 'Detection cyclage : frequence possible =' freqp ;
  941. 'REPE' ilfreqp dlfreqp ;
  942. freqp = 'EXTR' lfreqp &ilfreqp ;
  943. * 'MESS' 'freqp=' freqp ;
  944. lfoundc = vrai ;
  945. 'REPE' il dtstat ;
  946. ind = itstat . &il ;
  947. lval = tstat . ind ;
  948. dlval = 'DIME' lval ;
  949. dlval2 = dlval '-' freqp ;
  950. dlval3 = dlval2 '-' freqp ;
  951. 'SI' ('<' dlval3 0) ; lfoundc = faux ; 'QUIT' il ; 'FINS' ;
  952. ival1 = 'LECT' dlval 'PAS' -1 (dlval2 '+' 1) ;
  953. ival2 = 'LECT' dlval2 'PAS' -1 (dlval3 '+' 1) ;
  954. * 'MESS' 'Index=' ind ;
  955. *! 'LIST' ival1 ; 'LIST' ival2 ;
  956. lv1 = 'EXTR' lval ival1 ;
  957. lv2 = 'EXTR' lval ival2 ;
  958. * 'LIST' lv1 ; 'LIST' lv2 ;
  959. tv1 = 'TYPE' lv1 ;
  960. 'SI' ('EGA' tv1 'LISTREEL') ;
  961. 'SI' ('EGA' ind 'ldvol') ;
  962. vtol = volutol ;
  963. 'SINO' ;
  964. vtol = 'MAXI' ('PROG' ('*' ('VALE' 'PREC') 100.)
  965. (('MAXI' (lv1 'ET' lv2) 'ABS') '*' precrelq)) ;
  966. 'FINS' ;
  967. 'FINS' ;
  968. *
  969. 'REPE' iif freqp ;
  970. if = &iif ;
  971. v1 = 'EXTR' lv1 if ;
  972. v2 = 'EXTR' lv2 if ;
  973. 'SI' ('EGA' tv1 'LISTREEL') ;
  974. lfoundc = 'ET' lfoundc ('EGA' v1 v2 vtol) ;
  975. * 'MESS' 'if,v1,v2,vtol,lfoundc=' if ' ' v1 ' ' v2 ' ' vtol ' ' lfoundc ;
  976. 'SINO' ;
  977. lfoundc = 'ET' lfoundc ('EGA' v1 v2) ;
  978. * 'MESS' 'if,v1,v2,lfoundc=' if ' ' v1 ' ' v2 ' ' lfoundc ;
  979. 'FINS' ;
  980. 'SI' ('NON' lfoundc) ; 'QUIT' il ; 'FINS' ;
  981. 'FIN' iif ;
  982. 'FIN' il ;
  983. 'SI' lfoundc ;
  984. lcycl = lfoundc ;
  985. 'QUIT' ilfreqp ;
  986. 'FINS' ;
  987. 'FIN' ilfreqp ;
  988. 'FINS' ;
  989. 'SI' lcycl ;
  990. 'MESS' '! CYCLAGE DETECTE ! bop=' ioptim ' freqp=' freqp ;
  991. lcvg = vrai ;
  992. 'QUIT' boptim ;
  993. 'FINS' ;
  994. 'FINS' ;
  995. * 'SI' ('OU' ('EGA' tchange 0) lcycl) ;
  996. 'SI' ('EGA' tchange 0) ;
  997. istrat = '+' istrat 1 ;
  998. 'SINO' ;
  999. istrat = 1 ;
  1000. 'FINS' ;
  1001. 'SI' ('NON' lokloc) ; 'QUIT' boptim ; 'FINS' ;
  1002. 'FIN' boptim ;
  1003. 'SI' ('>EG' impr 1) ;
  1004. titt = 'CHAINE' 'Passe' ' ' ipass ' :' ' '
  1005. 'Topologie: parcourues=' nparcou
  1006. ' examinees=' nexplor
  1007. ' changees=' nchange ' limit_cand=' nnascm ;
  1008. 'MESSAGE' titt ;
  1009. MATOUTIL 'AFFQUAL' curtopo volucib denstol critq_eff 'VMET' metva momet ;
  1010. 'FINS' ;
  1011. 'SI' ('EGA' iseqp 1) ;
  1012. seqpass = seqpass 'ET' curtopo ;
  1013. 'FINS' ;
  1014. 'FIN' iipass ;
  1015. *
  1016. * Tests et fin de la boucle
  1017. *
  1018. *lokfin = lokloc ;
  1019. lokfin = vrai ;
  1020. * Verifs
  1021. txt = 'CHAI' '!!! Topologie finale :' ;
  1022. 'SI' ('EGA' ialgo 1) ;
  1023. loktf = MATOUTIL 'VERITOPO' curtopo volucib volutol txt mbnc ;
  1024. 'SINO' ;
  1025. loktf = MATOUTIL 'VERITOPO' curtopo txt mbnc ;
  1026. 'FINS' ;
  1027. lokfin = lokfin 'ET' loktf ;
  1028. * Qualités
  1029. dvol nctelem nnul nctno miq maq meq =
  1030. MATOUTIL 'AFFQUAL' curtopo volucib denstol critq_eff 'REST' 'NAFF'
  1031. 'VMET' metva momet ;
  1032. 'SI' ('NEG' nnul 0) ;
  1033. 'MESS' txt ' Elements de volume nul pour le cas' ' ' idk ;
  1034. lokfin = lokfin 'ET' faux ;
  1035. 'FINS' ;
  1036. 'SI' ('NEG' dvol 0. volutol) ;
  1037. 'MESSAGE' txt ' Non cvg sur le volume pour le cas' ' ' idk ;
  1038. 'MESSAGE' ('CHAI' 'dvol=' dvol ' volutol=' volutol) ;
  1039. * 'SI' ('NON' ('ET' ('EGA' ialgo 0) ('EGA' iajno 0))) ;
  1040. lokfin = lokfin 'ET' faux ;
  1041. * 'FINS' ;
  1042. 'FINS' ;
  1043. 'SI' ('NON' lcvg) ;
  1044. 'MESSAGE' txt ' Non cvg sur le cas' ' ' idk ' apres' ' ' ioptim ' iterations' ;
  1045. 'FINS' ;
  1046. *
  1047. 'SI' ('>EG' impr 1) ;
  1048. * titt = 'CHAINE' idk ' Total:' ' '
  1049. * 'Topologie: parcourues=' nparcou
  1050. * ' examinees=' nexplor
  1051. * ' changees=' nchange ' limit_cand=' nnascm ;
  1052. * 'MESSAGE' titt ;
  1053. * MATOUTIL 'AFFQUAL' curtopo volucib denstol critq_eff 'VMET' metva momet ;
  1054. 'SAUTER' 1 'LIGNE' ;
  1055. 'SI' (graph) ;
  1056. tit = 'CHAI' idk ' Topologie finale' ;
  1057. 'SI' ('NON' lokfin) ;
  1058. tit = 'CHAI' '!!!' ' ' tit ' ' 'SOUCI' ;
  1059. 'FINS' ;
  1060. 'TRAC' 'CACH' curtopo 'TITR' tit ;
  1061. 'SI' loktf ;
  1062. MATOUTIL 'AFFCAND' curtopo 'QUAL' 'VMET' metva momet
  1063. 'TITR' tit ;
  1064. 'FINS' ;
  1065. 'FINS' ;
  1066. 'FINS' ;
  1067. 'SAUTER' 1 'LIGNE' ;
  1068.  
  1069.  
  1070. 'SI' lquad ;
  1071. curtopq = 'CHAN' 'QUAD' curtopo topoinq ;
  1072. * 'SI' lmbnc ;
  1073. * curtopq = 'CHAN' 'QUAD' curtopo mbncq ;
  1074. * 'FINS' ;
  1075. curtopo = curtopq ;
  1076. 'FINS' ;
  1077. *
  1078. * Restitution de quelques informations
  1079. *
  1080. tparam . 'nnascm' = nnascm ;
  1081. tparam . 'nparcou' = nparcou ;
  1082. tparam . 'nexplor' = nexplor ;
  1083. tparam . 'nchange' = nchange ;
  1084. *
  1085. tparam . 'dvol' = dvol ;
  1086. tparam . 'nnul' = nnul ;
  1087. tparam . 'miq' = miq ;
  1088. tparam . 'maq' = maq ;
  1089. tparam . 'meq' = meq ;
  1090. *
  1091. tparam . 'cvg' = lcvg ;
  1092. tparam . 'cycling_detected' = lcycl ;
  1093. *
  1094. tparam . 'curtopo' = curtopo ;
  1095. 'SI' ('EGA' iseqm 1) ;
  1096. tparam . 'seqtopo' = seqtopo ;
  1097. tparam . 'metrique' = metva ;
  1098. 'FINS' ;
  1099. 'SI' ('EGA' iseqp 1) ;
  1100. tparam . 'seqpass' = seqpass ;
  1101. 'FINS' ;
  1102. *
  1103. 'RESP' curtopo ;
  1104. 'SI' lipol ;
  1105. 'RESP' metva ;
  1106. 'FINS' ;
  1107. *lourd 'RESPRO'tparam ;
  1108. * 27 2
  1109. *Erreur generation de maillage. Il est neanmoins cree pour contrôle
  1110. 'SI' ('NON' lokfin) ;
  1111. 'SOUC' 27 ;
  1112. * 'ERRE' 27 ;
  1113. 'FINSI' ;
  1114. *
  1115. * End of procedure file MAILTOPO
  1116. *
  1117. 'FINPROC' ;
  1118.  
  1119.  

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