Télécharger deadutil.procedur

Retour à la liste

Numérotation des lignes :

  1. * DEADUTIL PROCEDUR GOUNAND 07/07/05 21:15:22 5784
  2. ************************************************************************
  3. * NOM : DEADUTIL
  4. * DESCRIPTION :
  5. *
  6. *
  7. *
  8. * LANGAGE : GIBIANE-CAST3M
  9. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  10. * mél : gounand@semt2.smts.cea.fr
  11. **********************************************************************
  12. * VERSION : v1, 05/04/2006, version initiale
  13. * HISTORIQUE : v1, 05/04/2006, création
  14. * HISTORIQUE :
  15. * HISTORIQUE :
  16. ************************************************************************
  17. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  18. * en cas de modification de ce sous-programme afin de faciliter
  19. * la maintenance !
  20. ************************************************************************
  21. *
  22. *
  23. 'DEBPROC' DEADUTIL ;
  24. 'ARGUMENT' motcle*'MOT' ;
  25. *
  26. lmotcle = 'MOTS' 'DIMM' 'TYPM' 'AXI?' 'SPH?' 'QISO' 'QEQU' ;
  27. 'SI' ('NON' ('EXISTE' lmotcle motcle)) ;
  28. cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ;
  29. 'ERREUR' cherr ;
  30. 'FINSI' ;
  31. *
  32. 'SI' ('EGA' motcle 'AXI?') ;
  33. vmod = 'VALEUR' 'MODE' ;
  34. laxi = ('EGA' vmod 'AXIS') 'OU' ('EGA' vmod 'UNIDAXIS')
  35. 'OU' ('EGA' vmod 'UNIDAXISAXDZ') 'OU' ('EGA' vmod 'UNIDAXISAXCZ')
  36. 'OU' ('EGA' vmod 'UNIDAXISAXGZ') ;
  37. 'RESPRO' laxi ;
  38. 'FINSI' ;
  39. *
  40. 'SI' ('EGA' motcle 'SPH?') ;
  41. vmod = 'VALEUR' 'MODE' ;
  42. lsph = 'EGA' vmod 'UNIDSPHE' ;
  43. 'RESPRO' lsph ;
  44. 'FINSI' ;
  45. *
  46. 'SI' ('EGA' motcle 'DIMM') ;
  47. 'ARGUMENT' mt*'MAILLAGE' ;
  48. tabdim = 'TABLE' ;
  49. tabdim . 0 = 'MOTS' 'POI1' ;
  50. tabdim . 1 = 'MOTS' 'SEG2' 'SEG3' ;
  51. tabdim . 2 = 'MOTS' 'TRI3' 'TRI6' 'TRI7' 'QUA4' 'QUA8' 'QUA9' ;
  52. tabdim . 3 = 'MOTS' 'CUB8' 'CU20' 'PRI6' 'PR15' 'TET4' 'TE10'
  53. 'PYR5' 'PY13' 'CU27' 'PR21' 'TE15' 'PY19' ;
  54. fidim = FAUX ;
  55. dim = -1 ;
  56. lelem = 'ELEM' mt 'TYPE' ;
  57. nelem = 'DIME' lelem ;
  58. 'SI' ('EGA' nelem 0) ;
  59. cherr = 'CHAINE' 'Maillage vide ?' ;
  60. 'ERREUR' cherr ;
  61. 'FINSI' ;
  62. *
  63. 'REPETER' ielem nelem ;
  64. melem = 'EXTRAIRE' lelem &ielem ;
  65. 'REPETER' itdim 4 ;
  66. idim = ('-' &itdim 1) ;
  67. lli = tabdim . idim ;
  68. * id = ISINLIS melem lli ;
  69. * 'SI' ('NEG' id 0) ;
  70. id = 'EXISTE' lli melem ;
  71. 'SI' id ;
  72. 'SI' fidim ;
  73. 'SI' ('NEG' dim idim) ;
  74. cherr = 'CHAINE' 'Composite mesh not allowed' ;
  75. 'ERREUR' cherr ;
  76. 'FINSI' ;
  77. 'SINON' ;
  78. dim = idim ;
  79. fidim = VRAI ;
  80. 'FINSI' ;
  81. 'FINSI' ;
  82. 'FIN' itdim ;
  83. 'FIN' ielem ;
  84. *
  85. 'SI' ('NON' fidim) ;
  86. cherr = 'CHAINE' 'No known elements in this mesh' ;
  87. 'ERREUR' cherr ;
  88. 'FINSI' ;
  89. *
  90. 'RESPRO' dim ;
  91. 'FINSI' ;
  92. *
  93. *
  94. *
  95. 'SI' ('EGA' motcle 'TYPM') ;
  96. 'ARGUMENT' mt*'MAILLAGE' ;
  97. tabtyp = 'TABLE' ;
  98. tabtyp . 1 = 'MOTS' 'SEG2' 'TRI3' 'QUA4' 'CUB8' 'PRI6' 'TET4' 'PYR5' ;
  99. tabtyp . 2 = 'MOTS' 'TRI6' 'QUA8' 'CU20' 'PR15' 'TE10' 'PY13' ;
  100. tabtyp . 3 = 'MOTS' 'SEG3' 'TRI7' 'QUA9' 'CU27' 'PR21' 'TE15' 'PY19' ;
  101. listyp = 'MOTS' 'LINE' 'QUAI' 'QUAF' ;
  102. *
  103. fityp = FAUX ;
  104. typ = -1 ;
  105. lelem = 'ELEM' mt 'TYPE' ;
  106. nelem = 'DIME' lelem ;
  107. 'SI' ('EGA' nelem 0) ;
  108. cherr = 'CHAINE' 'Void mesh ?' ;
  109. 'MESSAGE' cherr ;
  110. 'QUITTER' TYPM ;
  111. 'FINSI' ;
  112. *
  113. 'REPETER' ielem nelem ;
  114. melem = 'EXTRAIRE' lelem &ielem ;
  115. 'REPETER' ittyp 3 ;
  116. ityp = &ittyp ;
  117. lli = tabtyp . ityp ;
  118. * id = ISINLIS melem lli ;
  119. * 'SI' ('NEG' id 0) ;
  120. id = 'EXISTE' lli melem ;
  121. 'SI' id ;
  122. 'SI' fityp ;
  123. 'SI' ('NEG' typ ityp) ;
  124. cherr = 'CHAINE' 'Composite mesh not allowed' ;
  125. 'ERREUR' cherr ;
  126. 'FINSI' ;
  127. 'SINON' ;
  128. typ = ityp ;
  129. fityp = VRAI ;
  130. 'FINSI' ;
  131. 'FINSI' ;
  132. 'FIN' ittyp ;
  133. 'FIN' ielem ;
  134. *
  135. 'SI' ('NON' fityp) ;
  136. cherr = 'CHAINE' 'No known elements in this mesh' ;
  137. 'ERREUR' cherr ;
  138. 'FINSI' ;
  139. *
  140. mtyp = 'EXTRAIRE' listyp typ ;
  141. 'RESPRO' mtyp ;
  142. 'FINSI' ;
  143. *
  144. * QISO PROCEDUR GOUNAND 06/04/06 17:53:15 5371
  145. ************************************************************************
  146. * NOM : QISO
  147. * DESCRIPTION : Critère de qualité d'un maillage : alignement
  148. * (= isotropie)
  149. *
  150. *
  151. *
  152. * LANGAGE : GIBIANE-CAST3M
  153. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  154. * mél : gounand@semt2.smts.cea.fr
  155. **********************************************************************
  156. * VERSION : v1, 11/05/2007, version initiale
  157. * HISTORIQUE : v1, 11/05/2007, création
  158. * HISTORIQUE :
  159. * HISTORIQUE :
  160. ************************************************************************
  161. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  162. * en cas de modification de ce sous-programme afin de faciliter
  163. * la maintenance !
  164. ************************************************************************
  165. *
  166. *
  167. *
  168. 'SI' ('EGA' motcle 'QISO') ;
  169. *
  170. 'ARGUMENT' _mt*'MAILLAGE' ;
  171. 'ARGUMENT' gdisc*'MOT' ;
  172. 'ARGUMENT' methgau*'MOT' ;
  173. *
  174. idim = 'VALEUR' 'DIME' ;
  175. vdim = DEADUTIL 'DIMM' _mt ;
  176. *
  177. 'ARGUMENT' met/'CHPOINT' ;
  178. lmet = 'EXISTE' met ;
  179. 'SI' lmet ;
  180. 'ARGUMENT' metdisc*'MOT' ;
  181. 'SINON' ;
  182. metdisc = 'CSTE' ;
  183. 'FINSI' ;
  184. *
  185. ncmet = '/' ('*' idim ('+' idim 1)) 2 ;
  186. loi = 'CHAINE' 'QALI' ;
  187. *
  188. * Calcul de la fonctionnelle
  189. *
  190. numop = 1 ;
  191. numvar = 1 ;
  192. numder = vdim ;
  193. numdat = 0 ;
  194. numcof = 0 ;
  195. *
  196. A = ININLIN numop numvar numdat numcof numder ;
  197. A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  198. A . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  199. A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
  200. *
  201. numvar = 1 ;
  202. numdat = ncmet ;
  203. numcof = 1 ;
  204. B = ININLIN numop numvar numdat numcof numder ;
  205. B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  206. B . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  207. B . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
  208. *
  209. idat = 0 ;
  210. 'REPETER' idi idim ;
  211. nomdat = 'CHAINE' 'G' &idi &idi ;
  212. * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
  213. idat = '+' idat 1 ;
  214. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
  215. B . 'DAT' . idat . 'DISC' = metdisc ;
  216. 'SI' lmet ;
  217. B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ;
  218. 'SINON' ;
  219. B . 'DAT' . idat . 'VALEUR' = 1.D0 ;
  220. 'FINSI' ;
  221. 'FIN' idi ;
  222. 'REPETER' idi idim ;
  223. nj = '-' idim &idi ;
  224. * 'MESSAGE' ('CHAINE' 'nj=' nj) ;
  225. 'SI' ('>EG' nj 1) ;
  226. 'REPETER' jdi nj ;
  227. nomdat = 'CHAINE' 'G' &idi ('+' &idi &jdi) ;
  228. * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
  229. idat = '+' idat 1 ;
  230. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
  231. B . 'DAT' . idat . 'DISC' = metdisc ;
  232. 'SI' lmet ;
  233. B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ;
  234. 'SINON' ;
  235. B . 'DAT' . idat . 'VALEUR' = 0.D0 ;
  236. 'FINSI' ;
  237. 'FIN' jdi ;
  238. 'FINSI' ;
  239. 'FIN' idi ;
  240. lisdat = 'LECT' 1 'PAS' 1 'NPAS' ('-' numdat 1) ;
  241. *
  242. B . 'COF' . 1 . 'COMPOR' = loi ;
  243. B . 'COF' . 1 . 'LDAT' = lisdat ;
  244. *
  245. A . 1 . 1 . 0 = 'LECT' ;
  246. B . 1 . 1 . 0 = 'LECT' 1 ;
  247. *
  248. vfonc = 'NLIN' gdisc _mt A B 'ERF1' methgau ;
  249. *
  250. 'RESPRO' vfonc ;
  251. 'FINSI' ;
  252. *
  253. * QEQU PROCEDUR GOUNAND 06/04/06 17:53:15 5371
  254. ************************************************************************
  255. * NOM : QEQU
  256. * DESCRIPTION : Critère de qualité d'un maillage : equidistribution
  257. *
  258. *
  259. *
  260. * LANGAGE : GIBIANE-CAST3M
  261. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  262. * mél : gounand@semt2.smts.cea.fr
  263. **********************************************************************
  264. * VERSION : v1, 11/05/2007, version initiale
  265. * HISTORIQUE : v1, 11/05/2007, création
  266. * HISTORIQUE :
  267. * HISTORIQUE :
  268. ************************************************************************
  269. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  270. * en cas de modification de ce sous-programme afin de faciliter
  271. * la maintenance !
  272. ************************************************************************
  273. *
  274. *
  275. 'SI' ('EGA' motcle 'QEQU') ;
  276. *
  277. 'ARGUMENT' _mt*'MAILLAGE' ;
  278. 'ARGUMENT' gdisc*'MOT' ;
  279. 'ARGUMENT' methgau*'MOT' ;
  280. *
  281. idim = 'VALEUR' 'DIME' ;
  282. vdim = DEADUTIL 'DIMM' _mt ;
  283. *
  284. 'ARGUMENT' met/'CHPOINT' ;
  285. lmet = 'EXISTE' met ;
  286. 'SI' lmet ;
  287. 'ARGUMENT' metdisc*'MOT' ;
  288. 'SINON' ;
  289. metdisc = 'CSTE' ;
  290. 'FINSI' ;
  291. ncmet = '/' ('*' idim ('+' idim 1)) 2 ;
  292. loi = 'CHAINE' 'QEQU' ;
  293. *
  294. * Calcul de la fonctionnelle
  295. *
  296. numop = 1 ;
  297. numvar = 1 ;
  298. numder = vdim ;
  299. numdat = 0 ;
  300. numcof = 0 ;
  301. *
  302. A = ININLIN numop numvar numdat numcof numder ;
  303. A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  304. A . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  305. A . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
  306. *
  307. numvar = 1 ;
  308. numdat = ncmet ;
  309. numcof = 1 ;
  310. B = ININLIN numop numvar numdat numcof numder ;
  311. B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ;
  312. B . 'VAR' . 1 . 'DISC' = 'CSTE' ;
  313. B . 'VAR' . 1 . 'VALEUR' = 1.D0 ;
  314. *
  315. idat = 0 ;
  316. 'REPETER' idi idim ;
  317. nomdat = 'CHAINE' 'G' &idi &idi ;
  318. * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
  319. idat = '+' idat 1 ;
  320. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
  321. B . 'DAT' . idat . 'DISC' = metdisc ;
  322. 'SI' lmet ;
  323. B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ;
  324. 'SINON' ;
  325. B . 'DAT' . idat . 'VALEUR' = 1.D0 ;
  326. 'FINSI' ;
  327. 'FIN' idi ;
  328. 'REPETER' idi idim ;
  329. nj = '-' idim &idi ;
  330. * 'MESSAGE' ('CHAINE' 'nj=' nj) ;
  331. 'SI' ('>EG' nj 1) ;
  332. 'REPETER' jdi nj ;
  333. nomdat = 'CHAINE' 'G' &idi ('+' &idi &jdi) ;
  334. * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ;
  335. idat = '+' idat 1 ;
  336. B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ;
  337. B . 'DAT' . idat . 'DISC' = metdisc ;
  338. 'SI' lmet ;
  339. B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ;
  340. 'SINON' ;
  341. B . 'DAT' . idat . 'VALEUR' = 0.D0 ;
  342. 'FINSI' ;
  343. 'FIN' jdi ;
  344. 'FINSI' ;
  345. 'FIN' idi ;
  346. lisdat = 'LECT' 1 'PAS' 1 'NPAS' ('-' numdat 1) ;
  347. *
  348. B . 'COF' . 1 . 'COMPOR' = loi ;
  349. B . 'COF' . 1 . 'LDAT' = lisdat ;
  350. *
  351. A . 1 . 1 . 0 = 'LECT' ;
  352. B . 1 . 1 . 0 = 'LECT' 1 ;
  353. *
  354. vfonci = 'NLIN' gdisc _mt A B 'ERF1' methgau ;
  355. *
  356. rvfonci = 'MAXIMUM' ('RESULT' vfonci) ;
  357. rvelemr = 'FLOTTANT' ('NBEL' _mt) ;
  358. fac = '/' rvelemr rvfonci ;
  359. *
  360. vfonc = '*' vfonci fac ;
  361. *
  362. 'SI' faux ;
  363. rvfonc = 'MAXIMUM' ('RESULT' vfonc) ;
  364. tol = '/' rvelemr 10. ;
  365. test = ('EGA' rvfonc rvelemr tol) ;
  366. 'SI' ('NON' test) ;
  367. 'ERREUR' 5 ;
  368. 'FINSI' ;
  369. 'FINSI' ;
  370. *
  371. 'RESPRO' vfonc ;
  372. *
  373. 'FINSI' ;
  374. *
  375. * End of procedure file DEADUTIL
  376. *
  377. 'FINPROC' ;
  378.  
  379.  
  380.  
  381.  

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