Télécharger kres_cd2.dgibi

Retour à la liste

Numérotation des lignes :

  1. * fichier : kres_cd2.dgibi
  2. 'OPTION' 'ECHO' 0 ;
  3. *BEGINPROCEDUR glapn
  4. ************************************************************************
  5. * NOM : GLAPN
  6. * DESCRIPTION : Un laplacien scalaire
  7. *
  8. *
  9. *
  10. * LANGAGE : GIBIANE-CAST3M
  11. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  12. * mél : gounand@semt2.smts.cea.fr
  13. **********************************************************************
  14. * VERSION : v1, 08/02/2006, version initiale
  15. * HISTORIQUE : v1, 08/02/2006, création
  16. * HISTORIQUE :
  17. * HISTORIQUE :
  18. ************************************************************************
  19. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  20. * en cas de modification de ce sous-programme afin de faciliter
  21. * la maintenance !
  22. ************************************************************************
  23. *
  24. *
  25. 'DEBPROC' GLAPN ;
  26. 'ARGUMENT' _mt*'MAILLAGE' ;
  27. 'ARGUMENT' gdisc*'MOT ' ;
  28. 'ARGUMENT' nomt*'MOT ' ;
  29. 'ARGUMENT' disct*'MOT ' ;
  30. 'ARGUMENT' nomq*'MOT ' ;
  31. 'ARGUMENT' discq*'MOT ' ;
  32. 'ARGUMENT' coef/'FLOTTANT' ;
  33. 'SI' ('NON' ('EXISTE' coef)) ;
  34. 'ARGUMENT' coef2/'CHPOINT ' ;
  35. 'SI' ('NON' ('EXISTE' coef2)) ;
  36. 'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
  37. 'SINON' ;
  38. coef = coef2 ;
  39. 'ARGUMENT' discc*'MOT ' ;
  40. 'FINSI' ;
  41. 'SINON' ;
  42. discc = 'CSTE' ;
  43. 'FINSI' ;
  44. 'ARGUMENT' methgau/'MOT ' ;
  45. 'SI' ('NON' ('EXISTE' methgau)) ;
  46. methgau = 'GAU7' ;
  47. 'FINSI' ;
  48. *
  49. vdim = 'VALEUR' 'DIME' ;
  50. vmod = 'VALEUR' 'MODE' ;
  51. idim = 0 ;
  52. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  53. idim = 2 ;
  54. iaxi = FAUX ;
  55. 'FINSI' ;
  56. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  57. idim = 2 ;
  58. iaxi = VRAI ;
  59. 'FINSI' ;
  60. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  61. idim = 3 ;
  62. iaxi = FAUX ;
  63. 'FINSI' ;
  64. 'SI' ('EGA' vdim 1) ;
  65. idim = 1 ;
  66. iaxi = FAUX ;
  67. 'FINSI' ;
  68. 'SI' ('EGA' idim 0) ;
  69. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  70. 'FINSI' ;
  71. * Test bête...
  72. 'SI' ('EGA' ('TYPE' coef) 'CHPOINT ') ;
  73. mincoef = 'MINIMUM' coef ;
  74. 'SINON' ;
  75. mincoef = coef ;
  76. 'FINSI' ;
  77. 'SI' ('<' mincoef 0.D0) ;
  78. 'ERREUR' 'Le coef (une viscosité) doit etre positive' ;
  79. 'FINSI' ;
  80. 'SI' iaxi ;
  81. 'ERREUR' ('CHAINE' 'Axi non implémenté') ;
  82. 'FINSI' ;
  83. *
  84. numop = idim ;
  85. numvar = 1 ;
  86. numdat = 1 ;
  87. numcof = 1 ;
  88. numder = idim ;
  89. mmt = 'MOTS' nomt ;
  90. mmq = 'MOTS' nomq ;
  91. ms = 'MOTS' 'SCAL' ;
  92. *
  93. A = ININLIN numop numvar numdat numcof numder ;
  94. A . 'VAR' . 1 . 'NOMDDL' = mmt ;
  95. A . 'VAR' . 1 . 'DISC' = disct ;
  96. A . 'DAT' . 1 . 'NOMDDL' = ms ;
  97. A . 'DAT' . 1 . 'DISC' = discc ;
  98. A . 'DAT' . 1 . 'VALEUR' = coef ;
  99. A . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  100. A . 'COF' . 1 . 'LDAT' = 'LECT' 1 ;
  101. *
  102. 'REPETER' iidim idim ;
  103. A . &iidim . 1 . &iidim = 'LECT' 1 ;
  104. 'FIN' iidim ;
  105. *
  106. numvar = 1 ;
  107. numdat = 0 ;
  108. numcof = 0 ;
  109. *
  110. B = ININLIN numop numvar numdat numcof numder ;
  111. B . 'VAR' . 1 . 'NOMDDL' = mmq ;
  112. B . 'VAR' . 1 . 'DISC' = discq ;
  113. *
  114. 'REPETER' iidim idim ;
  115. B . &iidim . 1 . &iidim = 'LECT' ;
  116. 'FIN' iidim ;
  117. *
  118. mglapn = 'NLIN' gdisc _mt A B methgau ;
  119. * Integration par parties
  120. mglapn = '*' mglapn -1.D0 ;
  121. *
  122. 'RESPRO' mglapn ;
  123. 'FINPROC' ;
  124. *
  125. * End of procedure file GLAPN
  126. *
  127. *ENDPROCEDUR glapn
  128. *BEGINPROCEDUR gugrad
  129. ************************************************************************
  130. * NOM : GUGRAD
  131. * DESCRIPTION : U . grad
  132. *
  133. *
  134. *
  135. * LANGAGE : GIBIANE-CAST3M
  136. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  137. * mél : gounand@semt2.smts.cea.fr
  138. **********************************************************************
  139. * VERSION : v1, 13/05/2004, version initiale
  140. * HISTORIQUE : v1, 13/05/2004, création
  141. * HISTORIQUE :
  142. * HISTORIQUE :
  143. ************************************************************************
  144. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  145. * en cas de modification de ce sous-programme afin de faciliter
  146. * la maintenance !
  147. ************************************************************************
  148. *
  149. *
  150. 'DEBPROC' GUGRAD ;
  151. 'ARGUMENT' _mt*'MAILLAGE' ;
  152. 'ARGUMENT' gdisc*'MOT ' ;
  153. 'ARGUMENT' nomp*'MOT ' ;
  154. 'ARGUMENT' discp*'MOT ' ;
  155. 'ARGUMENT' nomd*'MOT ' ;
  156. 'ARGUMENT' discd*'MOT ' ;
  157. 'ARGUMENT' vtot*'CHPOINT ' ;
  158. 'ARGUMENT' vcomp*'LISTMOTS' ;
  159. 'ARGUMENT' discv*'MOT ' ;
  160. 'ARGUMENT' coef/'FLOTTANT' ;
  161. 'SI' ('NON' ('EXISTE' coef)) ;
  162. 'ARGUMENT' coef2/'CHPOINT ' ;
  163. 'SI' ('NON' ('EXISTE' coef2)) ;
  164. 'ERREUR' 'Il faut donner un coef FLOTTANT ou CHPOINT' ;
  165. 'SINON' ;
  166. coef = coef2 ;
  167. 'ARGUMENT' discc*'MOT ' ;
  168. 'FINSI' ;
  169. 'SINON' ;
  170. discc = 'CSTE' ;
  171. 'FINSI' ;
  172. 'ARGUMENT' methgau/'MOT ' ;
  173. 'SI' ('NON' ('EXISTE' methgau)) ;
  174. methgau = 'GAU7' ;
  175. 'FINSI' ;
  176. 'ARGUMENT' chpop/'CHPOINT' ;
  177. 'ARGUMENT' chpod/'CHPOINT' ;
  178. *
  179. vdim = 'VALEUR' 'DIME' ;
  180. vmod = 'VALEUR' 'MODE' ;
  181. idim = 0 ;
  182. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'PLANDEFO')) ;
  183. idim = 2 ;
  184. iaxi = FAUX ;
  185. * Passé en argument désormais
  186. * vcomp = 'MOTS' 'UX' 'UY' ;
  187. 'FINSI' ;
  188. 'SI' ('ET' ('EGA' vdim 2) ('EGA' vmod 'AXIS')) ;
  189. idim = 2 ;
  190. iaxi = VRAI ;
  191. * vcomp = 'MOTS' 'UR' 'UZ' ;
  192. 'FINSI' ;
  193. 'SI' ('ET' ('EGA' vdim 3) ('EGA' vmod 'TRID')) ;
  194. idim = 3 ;
  195. iaxi = FAUX ;
  196. * vcomp = 'MOTS' 'UX' 'UY' 'UZ' ;
  197. 'FINSI' ;
  198. 'SI' ('EGA' vdim 1) ;
  199. idim = 1 ;
  200. iaxi = FAUX ;
  201. 'FINSI' ;
  202. 'SI' ('EGA' idim 0) ;
  203. 'ERREUR' ('CHAINE' 'vmod=' vmod ' et vdim=' vdim ' non prevu') ;
  204. 'FINSI' ;
  205. 'SI' iaxi ;
  206. 'ERREUR' ('CHAINE' 'Axi non implémenté') ;
  207. 'FINSI' ;
  208. *
  209. numop = 1 ;
  210. numder = idim ;
  211. mmp = 'MOTS' nomp ;
  212. mmd = 'MOTS' nomd ;
  213. numvar = 1 ;
  214. numdat = idim ;
  215. numcof = idim ;
  216. *
  217. A = ININLIN numop numvar numdat numcof numder ;
  218. A . 'VAR' . 1 . 'NOMDDL' = mmp ;
  219. A . 'VAR' . 1 . 'DISC' = discp ;
  220. 'SI' ('EXISTE' chpop) ;
  221. A . 'VAR' . 1 . 'VALEUR' = chpop ;
  222. 'FINSI' ;
  223. 'REPETER' iidim idim ;
  224. nomco = 'EXTRAIRE' vcomp &iidim ;
  225. A . 'DAT' . &iidim . 'NOMDDL' = 'MOTS' nomco ;
  226. A . 'DAT' . &iidim . 'DISC' = discv ;
  227. A . 'DAT' . &iidim . 'VALEUR' = 'EXCO' nomco 'NOID' vtot nomco ;
  228. *
  229. A . 'COF' . &iidim . 'COMPOR' = 'IDEN' ;
  230. A . 'COF' . &iidim . 'LDAT' = 'LECT' &iidim ;
  231. 'FIN' iidim ;
  232. *
  233. 'REPETER' iidim idim ;
  234. A . 1 . 1 . &iidim = 'LECT' &iidim ;
  235. 'FIN' iidim ;
  236. *
  237. numvar = 1 ;
  238. numdat = 1 ;
  239. numcof = 1 ;
  240. *
  241. B = ININLIN numop numvar numdat numcof numder ;
  242. B . 'VAR' . 1 . 'NOMDDL' = mmd ;
  243. B . 'VAR' . 1 . 'DISC' = discd ;
  244. 'SI' ('EXISTE' chpod) ;
  245. B . 'VAR' . 1 . 'VALEUR' = chpod ;
  246. 'FINSI' ;
  247. *
  248. B . 'DAT' . 1 . 'NOMDDL' = 'MOTS' 'SCAL' ;
  249. B . 'DAT' . 1 . 'DISC' = discc ;
  250. B . 'DAT' . 1 . 'VALEUR' = coef ;
  251. B . 'COF' . 1 . 'COMPOR' = 'IDEN' ;
  252. B . 'COF' . 1 . 'LDAT' = 'LECT' 1 ;
  253. *
  254. B . 1 . 1 . 0 = 'LECT' 1 ;
  255. *
  256. mgugrad = 'NLIN' gdisc _mt A B methgau ;
  257. *
  258. 'RESPRO' mgugrad ;
  259. 'FINPROC' ;
  260. *
  261. * End of procedure file GUGRAD
  262. *
  263. *ENDPROCEDUR gugrad
  264. *BEGINPROCEDUR formar
  265. ************************************************************************
  266. * NOM : FORMAR
  267. * DESCRIPTION : formate un réel de facon courte
  268. * pratique pour les noms de
  269. * sauvegarde
  270. * Exemples :
  271. * 'MESSAGE' ('CHAINE' (formar 2.9e5 1)) ;
  272. * 2.9E5
  273. * 'MESSAGE' ('CHAINE' (formar -2.9e5 1)) ;
  274. * -2.9E5
  275. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 1)) ;
  276. * 2.9E-5
  277. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 1)) ;
  278. * -2.9E-5
  279. * 'MESSAGE' ('CHAINE' (formar 2.9 1)) ;
  280. * 2.9
  281. * 'MESSAGE' ('CHAINE' (formar -2.9 1)) ;
  282. * -2.9
  283. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  284. * 0
  285. * 'MESSAGE' ('CHAINE' (formar 0 1)) ;
  286. * 0
  287. * 'MESSAGE' ('CHAINE' (formar 2.9e5 0)) ;
  288. * 3E5
  289. * 'MESSAGE' ('CHAINE' (formar -2.9e5 0)) ;
  290. * -3E5
  291. * 'MESSAGE' ('CHAINE' (formar 2.9e-5 0)) ;
  292. * 3E-5
  293. * 'MESSAGE' ('CHAINE' (formar -2.9e-5 0)) ;
  294. * -3E-5
  295. * 'MESSAGE' ('CHAINE' (formar 2.9 0)) ;
  296. * 3
  297. * 'MESSAGE' ('CHAINE' (formar -2.9 0)) ;
  298. * -3
  299. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  300. * 0
  301. * 'MESSAGE' ('CHAINE' (formar 0 0)) ;
  302. * 0
  303. *
  304. *
  305. *
  306. * LANGAGE : GIBIANE-CAST3M
  307. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  308. * mél : gounand@semt2.smts.cea.fr
  309. **********************************************************************
  310. * VERSION : v1, 18/02/2003, version initiale
  311. * HISTORIQUE : v1, 18/02/2003, création
  312. * HISTORIQUE :
  313. * HISTORIQUE :
  314. ************************************************************************
  315. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  316. * en cas de modification de ce sous-programme afin de faciliter
  317. * la maintenance !
  318. ************************************************************************
  319. *
  320. *
  321. 'DEBPROC' FORMAR ;
  322. 'ARGUMENT' fl*'FLOTTANT' ;
  323. 'ARGUMENT' vir/'ENTIER ' ;
  324. 'SI' ('NON' ('EXISTE' vir)) ;
  325. vir = 1 ;
  326. 'SINON' ;
  327. 'SI' ('<' vir 0) ;
  328. 'ERREUR' 'fournir un entier positif' ;
  329. 'FINSI' ;
  330. 'FINSI' ;
  331. 'SI' ('<' ('ABS' fl) 10.D-100) ;
  332. chfl = 'CHAINE' '0' ;
  333. 'SINON' ;
  334. *! sans le 1.D-10, ca ne fonctionne pas
  335. *! qd on entre pile poil une puissance de 10
  336. lfl = LOG10 ('ABS' fl) ;
  337. * lfl = '+' (LOG10 ('ABS' fl)) 1.D-10 ;
  338. slfl = 'SIGNE' ('ENTIER' lfl) ;
  339. 'SI' ('EGA' slfl 1) ;
  340. elfl = 'ENTIER' lfl ;
  341. 'SINON' ;
  342. elfl = '-' ('ENTIER' lfl) 1 ;
  343. 'FINSI' ;
  344. man = '/' fl ('**' 10.D0 elfl) ;
  345. *
  346. * Une verrue pour des histoires de précision...
  347. *
  348. 'SI' ('EGA' man 10.D0 ('**' 10.D0 ('*' vir -1.D0))) ;
  349. man = '/' man 10.D0 ;
  350. elfl = '+' elfl 1 ;
  351. 'FINSI' ;
  352. *
  353. sman = 'SIGNE' man ;
  354. 'SI' ('EGA' sman 1) ;
  355. fman = 'CHAINE' '(F' ('+' vir 2) '.0' vir ')' ;
  356. 'SINON' ;
  357. fman = 'CHAINE' '(F' ('+' vir 3) '.0' vir ')' ;
  358. 'FINSI' ;
  359. 'SI' ('NEG' vir 0) ;
  360. 'SI' ('NEG' elfl 0) ;
  361. chfl = 'CHAINE' 'FORMAT' fman man 'E' elfl ;
  362. 'SINON' ;
  363. chfl = 'CHAINE' 'FORMAT' fman man ;
  364. 'FINSI' ;
  365. 'SINON' ;
  366. man2 = 'ENTIER' ('+' man ('*' 0.5D0 sman)) ;
  367. 'SI' ('NEG' elfl 0) ;
  368. chfl = 'CHAINE' man2 'E' elfl ;
  369. 'SINON' ;
  370. chfl = 'CHAINE' man2 ;
  371. 'FINSI' ;
  372. 'FINSI' ;
  373. 'FINSI' ;
  374. 'RESPRO' chfl ;
  375. *
  376. * End of procedure file FORMAR
  377. *
  378. 'FINPROC' ;
  379. *ENDPROCEDUR formar
  380. *BEGINPROCEDUR log10
  381. ************************************************************************
  382. * NOM : LOG10
  383. * DESCRIPTION : Log_10
  384. *
  385. *
  386. *
  387. * LANGAGE : GIBIANE-CAST3M
  388. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  389. * mél : gounand@semt2.smts.cea.fr
  390. **********************************************************************
  391. * VERSION : v1, 18/02/2003, version initiale
  392. * HISTORIQUE : v1, 18/02/2003, création
  393. * HISTORIQUE :
  394. * HISTORIQUE :
  395. ************************************************************************
  396. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  397. * en cas de modification de ce sous-programme afin de faciliter
  398. * la maintenance !
  399. ************************************************************************
  400. *
  401. *
  402. 'DEBPROC' LOG10 ;
  403. 'ARGUMENT' fl/'FLOTTANT' ;
  404. 'ARGUMENT' lr/'LISTREEL' ;
  405. 'ARGUMENT' cp/'CHPOINT ' ;
  406. 'ARGUMENT' cm/'MCHAML ' ;
  407. 'SI' ('EXISTE' fl) ;
  408. 'RESPRO' ('/' ('LOG' fl) ('LOG' 10.D0)) ;
  409. 'FINSI' ;
  410. 'SI' ('EXISTE' lr) ;
  411. 'RESPRO' ('/' ('LOG' lr) ('LOG' 10.D0)) ;
  412. 'FINSI' ;
  413. 'SI' ('EXISTE' cp) ;
  414. 'RESPRO' ('/' ('LOG' cp) ('LOG' 10.D0)) ;
  415. 'FINSI' ;
  416. 'SI' ('EXISTE' cm) ;
  417. 'RESPRO' ('/' ('LOG' cm) ('LOG' 10.D0)) ;
  418. 'FINSI' ;
  419. *
  420. * End of procedure file LOG10
  421. *
  422. 'FINPROC' ;
  423. *ENDPROCEDUR log10
  424. *BEGINPROCEDUR exmomod
  425. ************************************************************************
  426. * NOM : EXMOMOD
  427. * DESCRIPTION : Extraction d'un mot d'un listmots
  428. *
  429. *
  430. *
  431. * LANGAGE : GIBIANE-CAST3M
  432. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  433. * mél : gounand@semt2.smts.cea.fr
  434. **********************************************************************
  435. * VERSION : v1, 23/06/2003, version initiale
  436. * HISTORIQUE : v1, 23/06/2003, création
  437. * HISTORIQUE :
  438. * HISTORIQUE :
  439. ************************************************************************
  440. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  441. * en cas de modification de ce sous-programme afin de faciliter
  442. * la maintenance !
  443. ************************************************************************
  444. *
  445. *
  446. 'DEBPROC' EXMOMOD ;
  447. 'ARGUMENT' lm*'LISTMOTS' i*'ENTIER' ;
  448. j = 'DIME' lm ;
  449. k = '+' (MODULO ('-' i 1) j) 1 ;
  450. lemot = 'EXTRAIRE' lm k ;
  451. * Usage de l'opérateur text pour éviter que lemot
  452. * ne soit interprété comme un opérateur
  453. 'RESPRO' 'TEXTE' lemot ;
  454. *
  455. * End of procedure file EXMOMOD
  456. *
  457. 'FINPROC' ;
  458. *ENDPROCEDUR exmomod
  459. *BEGINPROCEDUR modulo
  460. ************************************************************************
  461. * NOM : MODULO
  462. * DESCRIPTION : Calcule un entier modulo un autre...
  463. *
  464. *
  465. *
  466. * LANGAGE : GIBIANE-CAST3M
  467. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  468. * mél : gounand@semt2.smts.cea.fr
  469. **********************************************************************
  470. * VERSION : v1, 15/10/2002, version initiale
  471. * HISTORIQUE : v1, 15/10/2002, création
  472. * HISTORIQUE :
  473. * HISTORIQUE :
  474. ************************************************************************
  475. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  476. * en cas de modification de ce sous-programme afin de faciliter
  477. * la maintenance !
  478. ************************************************************************
  479. *
  480. *
  481. 'DEBPROC' MODULO ;
  482. 'ARGUMENT' i*'ENTIER' j*'ENTIER' ;
  483. 'SI' ('EGA' j 0) ;
  484. 'MESSAGE' 'Impossible de faire modulo 0' ;
  485. 'ERREUR' 5 ;
  486. 'SINON' ;
  487. k=i '/' j ;
  488. mod=i '-' ( k '*'j ) ;
  489. 'RESPRO' mod ;
  490. 'FINSI' ;
  491. *
  492. * End of procedure file MODULO
  493. *
  494. 'FINPROC' ;
  495. *ENDPROCEDUR modulo
  496. *BEGINPROCEDUR dessevol
  497. ************************************************************************
  498. * NOM : DESSEVOL
  499. * DESCRIPTION : Dessine des évolutions : choisit automatiquement
  500. * les options, marqueurs, couleurs...
  501. *
  502. *
  503. * LANGAGE : GIBIANE-CAST3M
  504. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  505. * mél : gounand@semt2.smts.cea.fr
  506. **********************************************************************
  507. * VERSION : v1, 16/11/2004, version initiale
  508. * HISTORIQUE : v1, 16/11/2004, création
  509. * HISTORIQUE :
  510. * HISTORIQUE :
  511. ************************************************************************
  512. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  513. * en cas de modification de ce sous-programme afin de faciliter
  514. * la maintenance !
  515. ************************************************************************
  516. *
  517. *
  518. 'DEBPROC' DESSEVOL ;
  519. 'ARGUMENT' evtot*'EVOLUTION' ;
  520. 'ARGUMENT' tabt*'TABLE' ;
  521. 'ARGUMENT' tit*'MOT' ;
  522. 'ARGUMENT' tix*'MOT' ;
  523. 'ARGUMENT' tiy*'MOT' ;
  524. 'ARGUMENT' lnclk*'LOGIQUE' ;
  525. 'ARGUMENT' nb/'LOGIQUE' ;
  526. *
  527. 'SI' ('NON' ('EXISTE' nb)) ;
  528. nb = FAUX ;
  529. 'FINSI' ;
  530. *
  531. nt = 'DIME' tabt ;
  532. nev = 'DIME' evtot ;
  533. *
  534. * Attention, dans evtot, il y a une évolution avec des noms de points ?
  535. *
  536. *'SI' ('NEG' nev nt) ;
  537. * cherr = 'CHAINE' 'Evolution and title table : not same dim.' ;
  538. * 'ERREUR' cherr ;
  539. *'FINSI' ;
  540. *
  541. tev = 'TABLE' ;
  542. tev . 'TITRE' = tabt ;
  543. *
  544. toto = 'TABLE' ;
  545. *
  546. lcoul = 'MOTS' 'TURQ' 'VERT' 'JAUN' 'ROSE' 'ROUG' 'BLEU' ;
  547. lmarq = 'MOTS' 'TRIB' 'TRIA' 'LOSA' 'CARR' 'ETOI' 'PLUS' 'CROI' ;
  548. ltirr = 'MOTS' 'TIRR' 'TIRC' 'TIRL' 'TIRM' ;
  549. *
  550. 'SI' nb ;
  551. ev2 = evtot ;
  552. 'SINON' ;
  553. icou = 0 ;
  554. 'REPETER' iev nev ;
  555. ii = &iev ;
  556. evi = 'EXTRAIRE' evtot 'COUR' ii ;
  557. 'SI' ('NEG' ('TYPE' ('EXTRAIRE' evi 'ORDO')) 'LISTMOTS') ;
  558. icou = '+' icou 1 ;
  559. 'FINSI' ;
  560. * ii2 = '/' ('+' ii 1) 2 ;
  561. * ci = EXMOMOD lcoul ii2 ;
  562. * ci = EXMOMOD lcoul ii ;
  563. ci = EXMOMOD lcoul icou ;
  564. APPEND toto 'EVOLUTION' ('COULEUR' evi ci) ;
  565. 'FIN' iev ;
  566. ev2 = toto . 'EVOLUTION' ;
  567. 'FINSI' ;
  568. *
  569. 'REPETER' iev nev ;
  570. ii = &iev ;
  571. mi = EXMOMOD lmarq ii ;
  572. ti = EXMOMOD ltirr ii ;
  573. 'SI' nb ;
  574. tev . ii = 'CHAINE' 'MARQ ' mi ' ' ti ;
  575. 'SINON' ;
  576. tev . ii = 'CHAINE' 'MARQ ' mi ;
  577. 'FINSI' ;
  578. 'FIN' iev ;
  579. *
  580. 'SI' lnclk ;
  581. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev
  582. 'NCLK' ;
  583. 'SINON' ;
  584. 'DESSIN' ev2 'TITR' tit 'TITX' tix 'TITY' tiy 'LEGE' 'MIMA' tev ;
  585. 'FINSI' ;
  586. *
  587. * End of procedure file DESSEVOL
  588. *
  589. 'FINPROC' ;
  590. *ENDPROCEDUR dessevol
  591. *BEGINPROCEDUR append
  592. ************************************************************************
  593. * NOM : APPEND
  594. * DESCRIPTION : Rajoute :
  595. * - un entier à un listentier
  596. * - un réel à un listreel
  597. * - un objet (liste, evolution, matrice ou chpoint)
  598. * à un indice de table ('MOT' ou 'ENTIER')
  599. * * si l'indice n'existe pas
  600. * * 'ET' si l'indice existe
  601. *
  602. *
  603. *
  604. * LANGAGE : GIBIANE-CAST3M
  605. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  606. * mél : gounand@semt2.smts.cea.fr
  607. **********************************************************************
  608. * VERSION : v1, 10/09/2004, version initiale
  609. * HISTORIQUE : v1, 10/09/2004, création
  610. * HISTORIQUE :
  611. * HISTORIQUE :
  612. ************************************************************************
  613. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  614. * en cas de modification de ce sous-programme afin de faciliter
  615. * la maintenance !
  616. ************************************************************************
  617. *
  618. *
  619. 'DEBPROC' APPEND ;
  620. 'ARGUMENT' tab/'TABLE' ;
  621. 'SI' ('EXISTE' tab) ;
  622. 'ARGUMENT' itab/'MOT' ;
  623. 'SI' ('NON' ('EXISTE' itab)) ;
  624. 'ARGUMENT' itab*'ENTIER' ;
  625. 'FINSI' ;
  626. lobj = FAUX ;
  627. 'SI' ('NON' lobj) ;
  628. 'ARGUMENT' lr/'LISTREEL' ;
  629. 'SI' ('EXISTE' lr) ;
  630. obj = lr ; lobj = VRAI ;
  631. 'FINSI' ;
  632. 'FINSI' ;
  633. 'SI' ('NON' lobj) ;
  634. 'ARGUMENT' le/'LISTENTI' ;
  635. 'SI' ('EXISTE' le) ;
  636. obj = le ; lobj = VRAI ;
  637. 'FINSI' ;
  638. 'FINSI' ;
  639. 'SI' ('NON' lobj) ;
  640. 'ARGUMENT' lev/'EVOLUTION' ;
  641. 'SI' ('EXISTE' lev) ;
  642. obj = lev ; lobj = VRAI ;
  643. 'FINSI' ;
  644. 'FINSI' ;
  645. 'SI' ('NON' lobj) ;
  646. 'ARGUMENT' lm/'MAILLAGE' ;
  647. 'SI' ('EXISTE' lm) ;
  648. obj = lm ; lobj = VRAI ;
  649. 'FINSI' ;
  650. 'FINSI' ;
  651. 'SI' ('NON' lobj) ;
  652. 'ARGUMENT' chpo/'CHPOINT' ;
  653. 'SI' ('EXISTE' chpo) ;
  654. obj = chpo ; lobj = VRAI ;
  655. 'FINSI' ;
  656. 'FINSI' ;
  657. 'SI' ('NON' lobj) ;
  658. 'ARGUMENT' rig/'RIGIDITE' ;
  659. 'SI' ('EXISTE' rig) ;
  660. obj = rig ; lobj = VRAI ;
  661. 'FINSI' ;
  662. 'FINSI' ;
  663. 'SI' ('NON' lobj) ;
  664. 'ARGUMENT' matk/'MATRIK' ;
  665. 'SI' ('EXISTE' matk) ;
  666. obj = matk ; lobj = VRAI ;
  667. 'FINSI' ;
  668. 'FINSI' ;
  669. 'SI' ('NON' lobj) ;
  670. cherr = 'CHAINE'
  671. 'Il faut fournir un objet liste, evolution, matrice ou chpoint.'
  672. ;
  673. 'ERREUR' cherr ;
  674. 'FINSI' ;
  675. 'SI' ('EXISTE' tab itab) ;
  676. tab . itab = 'ET' (tab . itab) obj ;
  677. 'SINON' ;
  678. tab . itab = obj ;
  679. 'FINSI' ;
  680. 'RESPRO' tab ;
  681. 'FINSI' ;
  682. 'ARGUMENT' lenti/'LISTENTI' ;
  683. 'ARGUMENT' lreel/'LISTREEL' ;
  684. 'SI' ('EXISTE' lenti) ;
  685. 'ARGUMENT' enti*'ENTIER' ;
  686. lenti = 'ET' lenti ('LECT' enti) ;
  687. 'RESPRO' lenti ;
  688. 'FINSI' ;
  689. 'SI' ('EXISTE' lreel) ;
  690. 'ARGUMENT' reel*'FLOTTANT' ;
  691. lreel = 'ET' lreel ('PROG' reel) ;
  692. 'RESPRO' lreel ;
  693. 'FINSI' ;
  694. *
  695. * End of procedure file APPEND
  696. *
  697. 'FINPROC' ;
  698. *ENDPROCEDUR append
  699. 'DEBPROC' discr ;
  700. 'ARGUMENT' Pem*'FLOTTANT' ;
  701. Pe = Pem '*' nm ;
  702. *
  703. * Solution
  704. *
  705. xm ym = 'COORDONNEE' mt ;
  706. num = '-' ('EXP' ('*' xm Pe)) 1.D0 ;
  707. denom = '-' ('EXP' Pe) 1.D0 ;
  708. sol = 'NOMC' 'T' ('/' num denom) ;
  709. csol = 'REDU' sol (d2 'ET' d4) ;
  710. 'SI' graph ;
  711. tit = 'CHAINE' 'Sol exacte Pem=' (formar Pem) ;
  712. 'TRACER' sol mt 'TITRE' tit ;
  713. 'FINSI' ;
  714. *
  715. * Matrice
  716. *
  717. disc = 'QUAI' ;
  718. nomt = 'T' ;
  719. nomq = 'Q' ;
  720. mat1 = '*' (GLAPN _mt 'LINE' nomt disc nomq disc 1.) ('/' -1. Pe) ;
  721. nomu = 'MOTS' 'UX' 'UY' ;
  722. valu = 'MANUEL' 'CHPO' mt nomu ('PROG' 1. 0.) ;
  723. mat2 = GUGRAD _mt 'LINE' nomt disc nomq disc valu nomu disc 1.
  724. ;
  725. matl = mat1 'ET' mat2 ;
  726. matc = 'BLOQUE' 'T' ('ET' d2 d4) ;
  727. fc = 'DEPIMPOSE' matc csol ;
  728. mtot = matl 'ET' matc ;
  729. ftot = fc ;
  730. 'RESPRO' mtot ftot sol ;
  731. 'FINPROC' ;
  732. *
  733. ************************************************************************
  734. * NOM : KRES_CD2
  735. * DESCRIPTION : Test de KRES sur une équation de convection-diffusion
  736. * avec BLOQ
  737. *
  738. *
  739. * LANGAGE : GIBIANE-CAST3M
  740. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  741. * mél : gounand@semt2.smts.cea.fr
  742. **********************************************************************
  743. * VERSION : v1, 08/02/2006, version initiale
  744. * HISTORIQUE : v1, 08/02/2006, création
  745. * HISTORIQUE :
  746. * HISTORIQUE :
  747. ************************************************************************
  748. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  749. * en cas de modification de ce sous-programme afin de faciliter
  750. * la maintenance !
  751. ************************************************************************
  752. *
  753. *
  754. complet = FAUX ;
  755. interact= FAUX ;
  756. graph = FAUX ;
  757. 'OPTION' 'DIME' 2 'ELEM' 'TRI6' ;
  758. 'SI' ('NON' interact) ;
  759. 'OPTION' 'TRAC' 'PS' ;
  760. 'SINON' ;
  761. 'OPTION' 'TRAC' 'X' ;
  762. 'FINSI' ;
  763. *
  764. * Maillage
  765. *
  766. 'SI' complet ;
  767. nm = 100 ;
  768. 'SINON' ;
  769. nm = 20 ;
  770. 'FINSI' ;
  771. p1 = 0. 0. ; p2 = 1. 0. ; p3 = 1. 1. ; p4 = 0. 1. ;
  772. d1 = 'DROIT' nm p1 p2 ; d2 = 'DROIT' nm p2 p3 ;
  773. d3 = 'DROIT' nm p3 p4 ; d4 = 'DROIT' nm p4 p1 ;
  774. cmt = d1 'ET' d2 'ET' d3 'ET' d4 ;
  775. *mt = 'DALLER' d1 d2 d3 d4 ;cmt = 'CONTOUR' mt ;
  776. mt = 'SURFACE' cmt ;
  777. _mt = 'CHANGER' 'QUAF' mt ;
  778.  
  779. tabmit = 'TABLE' ;
  780. tabmit . 1 = 'CHAINE' 'CG' ;
  781. tabmit . 2 = 'CHAINE' 'BiCGStab' ;
  782. tabmit . 3 = 'CHAINE' 'BiCGStab(4)' ;
  783. tabmit . 4 = 'CHAINE' 'GMRES(50)' ;
  784. tabmit . 5 = 'CHAINE' 'CGS' ;
  785. tabprec = 'TABLE' ;
  786. tabprec . 0 = 'CHAINE' 'Rien' ;
  787. tabprec . 1 = 'CHAINE' 'Diag' ;
  788. tabprec . 2 = 'CHAINE' 'DILU' ;
  789. tabprec . 3 = 'CHAINE' 'ILU(0)' ;
  790. tabprec . 4 = 'CHAINE' 'MILU(0)' ;
  791. tabprec . 5 = 'CHAINE' 'ILUT' ;
  792. tabprec . 6 = 'CHAINE' 'ILUT2' ;
  793. tabprec . 7 = 'CHAINE' 'ILUTP' ;
  794. tabprec . 8 = 'CHAINE' 'ILUTP+0' ;
  795. tabpec = 'TABLE' ;
  796. tabpec . 1 = 1.D-4 ;
  797. tabpec . 2 = 1.D-2 ;
  798. tabpec . 3 = 1.D-1 ;
  799. tabpec . 4 = 1.D0 ;
  800. tabpec . 5 = 5.D0 ;
  801. *
  802. * Valeur du Péclet de maille : Pem
  803. *
  804. xini = 'NOMC' 'T' ('BRUIT' 'BLAN' 'UNIF' 0.5 0.5 mt) ;
  805. *
  806. * Tous les péclets BiCGSTAB(4) + ILU(0)
  807. *
  808. tres = 'TABLE' ;
  809. tres . 'EVOS' = 'TABLE' ;
  810. tres . 'OK' = 'TABLE' ;
  811. tres . 'NIT' = 'TABLE' ;
  812. tres . 'TCPU' = 'TABLE' ;
  813. 'REPETER' ipec ('DIME' tabpec) ;
  814. Pem = tabpec . &ipec ;
  815. mtot ftot sol = DISCR Pem ;
  816. 'TEMPS' 'ZERO' ;
  817. rv = 'EQEX' ; rvm = rv . 'METHINV' ;
  818. rvm . 'TYPINV' = 4 ;
  819. rvm . 'PRECOND' = 3 ;
  820. rvm . 'CALRES' = 1 ;
  821. rvm . 'XINIT' = xini ;
  822. res = 'EXCO' 'T' ('KRES' mtot ftot 'TYPI' rvm) 'T' ;
  823. lnmv = 'FLOTTANT' (rvm . 'NMATVEC') ;
  824. lres = rvm . 'CONVINV' ;
  825. tres . 'EVOS' . &ipec = 'EVOL' 'MANU' lnmv (log10 lres) ;
  826. tres . 'OK' . &ipec = 'MAXIMUM' ('-' res sol) 'ABS' ;
  827. tres . 'NIT' . &ipec = 'EXTRAIRE' lnmv ('DIME' lnmv) ;
  828. TABTPS = TEMP 'NOEC';
  829. tres . 'TCPU' . &ipec = TABTPS.'TEMPS_CPU'.'INITIAL';
  830. 'FIN' ipec ;
  831. * Tableau récapitulatif
  832. 'SAUTER' 1 'LIGNE' ;
  833. cc = 'CHAINE' 'Conv-diff BLOQ BiCGSTAB(4) + ILU(0) ' ;
  834. 'MESSAGE' cc ;
  835. cc3 = 'CHAINE' 'Nb pmatvec'/20 'Temps CPU'/40 'Erreur'/60 ;
  836. 'MESSAGE' cc3 ;
  837. 'REPETER' ipec ('DIME' tabpec) ;
  838. nit = tres . 'NIT' . &ipec ;
  839. tcpu = tres . 'TCPU' . &ipec ;
  840. ok = tres . 'OK' . &ipec ;
  841. cc4 = 'CHAINE' 'Pem=' (formar (tabpec . &ipec))
  842. nit*30 (formar tcpu 2)*50
  843. (formar ok 4)*70 ;
  844. 'MESSAGE' cc4 ;
  845. 'FIN' ipec ;
  846. 'SAUTER' 1 'LIGNE' ;
  847. * Graphique
  848. 'SI' graph ;
  849. evtot = @STBL (tres . 'EVOS') ;
  850. tabt = 'TABLE' ;
  851. 'REPETER' ipec ('DIME' tabpec) ;
  852. tabt . &ipec = 'CHAINE' 'Pem=' (formar (tabpec . &ipec)) ;
  853. 'FIN' ipec ;
  854. tit = 'CHAINE' 'Conv-diff BLOQ BiGSTAB(4)+ILU(0) ' ;
  855. titx = 'CHAINE' 'Nb pmatvec' ;
  856. tity = 'CHAINE' 'Log10 critere' ;
  857. DESSEVOL evtot tabt tit titx tity FAUX ;
  858. 'FINSI' ;
  859. *
  860. * Toutes les méthodes avec ILU(0) Pem = 1.D0
  861. *
  862. Pem = 1.0D0 ;
  863. mtot ftot sol = DISCR Pem ;
  864. tres = 'TABLE' ;
  865. tres . 'EVOS' = 'TABLE' ;
  866. tres . 'OK' = 'TABLE' ;
  867. tres . 'NIT' = 'TABLE' ;
  868. tres . 'TCPU' = 'TABLE' ;
  869. 'REPETER' imetit ('DIME' tabmit) ;
  870. 'TEMPS' 'ZERO' ;
  871. rv = 'EQEX' ; rvm = rv . 'METHINV' ;
  872. rvm . 'TYPINV' = &imetit '+' 1 ;
  873. rvm . 'PRECOND' = 3 ;
  874. rvm . 'CALRES' = 1 ;
  875. rvm . 'XINIT' = xini ;
  876. res = 'EXCO' 'T' ('KRES' mtot ftot 'TYPI' rvm) 'T' ;
  877. lnmv = 'FLOTTANT' (rvm . 'NMATVEC') ;
  878. lres = rvm . 'CONVINV' ;
  879. tres . 'EVOS' . &imetit = 'EVOL' 'MANU' lnmv (log10 lres) ;
  880. tres . 'OK' . &imetit = 'MAXIMUM' ('-' res sol) 'ABS' ;
  881. tres . 'NIT' . &imetit = 'EXTRAIRE' lnmv ('DIME' lnmv) ;
  882. TABTPS = TEMP 'NOEC';
  883. tres . 'TCPU' . &imetit = TABTPS.'TEMPS_CPU'.'INITIAL';
  884. 'FIN' imetit ;
  885. * Tableau récapitulatif
  886. 'SAUTER' 1 'LIGNE' ;
  887. cc = 'CHAINE' 'Conv-diff BLOQ ILU(0) Pem=' (formar Pem) ;
  888. 'MESSAGE' cc ;
  889. cc3 = 'CHAINE' 'Nb pmatvec'/20 'Temps CPU'/40 'Erreur'/60 ;
  890. 'MESSAGE' cc3 ;
  891. 'REPETER' imetit ('DIME' tabmit) ;
  892. nit = tres . 'NIT' . &imetit ;
  893. tcpu = tres . 'TCPU' . &imetit ;
  894. ok = tres . 'OK' . &imetit ;
  895. cc4 = 'CHAINE' (tabmit . &imetit)
  896. nit*30 (formar tcpu 2)*50
  897. (formar ok 4)*70 ;
  898. 'MESSAGE' cc4 ;
  899. 'FIN' imetit ;
  900. 'SAUTER' 1 'LIGNE' ;
  901. * Graphique
  902. 'SI' graph ;
  903. evtot = @STBL (tres . 'EVOS') ;
  904. tabt = 'TABLE' ;
  905. 'REPETER' imetit ('DIME' tabmit) ;
  906. tabt . &imetit = tabmit . &imetit ;
  907. 'FIN' imetit ;
  908. tit = 'CHAINE' 'Conv-diff BLOQ ILU(0) Pem=' (formar Pem) ;
  909. titx = 'CHAINE' 'Nb pmatvec' ;
  910. tity = 'CHAINE' 'Log10 critere' ;
  911. DESSEVOL evtot tabt tit titx tity FAUX ;
  912. 'FINSI' ;
  913. *
  914. * Le test vérifie que toutes méthodes (à part CG) ont donné
  915. * une erreur inférieure à 1.D-2
  916. *
  917. test = VRAI ;
  918. 'REPETER' imetit ('-' ('DIME' tabmit) 1) ;
  919. ok = tres . 'OK' . ('+' &imetit 1) ;
  920. test = test 'ET' ('<' ok 1.D-2) ;
  921. 'FIN' imetit ;
  922. *
  923. * Tous les préconditionneurs BiCGSTAB(4) Pem = 1.D0
  924. *
  925. Pem = 1.D0 ;
  926. mtot ftot sol = DISCR Pem ;
  927. tres = 'TABLE' ;
  928. tres . 'EVOS' = 'TABLE' ;
  929. tres . 'OK' = 'TABLE' ;
  930. tres . 'NIT' = 'TABLE' ;
  931. tres . 'TCPU' = 'TABLE' ;
  932. 'REPETER' iprec ('DIME' tabprec) ;
  933. 'TEMPS' 'ZERO' ;
  934. rv = 'EQEX' ; rvm = rv . 'METHINV' ;
  935. rvm . 'TYPINV' = 4 ;
  936. rvm . 'PRECOND' = '-' &iprec 1 ;
  937. rvm . 'CALRES' = 1 ;
  938. rvm . 'XINIT' = xini ;
  939. res = 'EXCO' 'T' ('KRES' mtot ftot 'TYPI' rvm) 'T' ;
  940. lnmv = 'FLOTTANT' (rvm . 'NMATVEC') ;
  941. lres = rvm . 'CONVINV' ;
  942. tres . 'EVOS' . &iprec = 'EVOL' 'MANU' (log10 lnmv) (log10 lres) ;
  943. tres . 'OK' . &iprec = 'MAXIMUM' ('-' res sol) 'ABS' ;
  944. tres . 'NIT' . &iprec = 'EXTRAIRE' lnmv ('DIME' lnmv) ;
  945. TABTPS = TEMP 'NOEC';
  946. tres . 'TCPU' . &iprec = TABTPS.'TEMPS_CPU'.'INITIAL';
  947. 'FIN' iprec ;
  948. * Tableau récapitulatif
  949. 'SAUTER' 1 'LIGN' ;
  950. cc = 'CHAINE' 'Conv-diff BLOQ BiCGSTAB(4) Pem=' (formar Pem) ;
  951. 'MESSAGE' cc ;
  952. cc3 = 'CHAINE' 'Nb pmatvec'/20 'Temps CPU'/40 'Erreur'/60 ;
  953. 'MESSAGE' cc3 ;
  954. 'REPETER' iprec ('DIME' tabprec) ;
  955. nit = tres . 'NIT' . &iprec ;
  956. tcpu = tres . 'TCPU' . &iprec ;
  957. ok = tres . 'OK' . &iprec ;
  958. cc4 = 'CHAINE' (tabprec . ('-' &iprec 1))
  959. nit*30 (formar tcpu 2)*50
  960. (formar ok 4)*70 ;
  961. 'MESSAGE' cc4 ;
  962. 'FIN' iprec ;
  963. 'SAUTER' 1 'LIGNE' ;
  964. * Graphique
  965. 'SI' graph ;
  966. evtot = @STBL (tres . 'EVOS') ;
  967. tabt = 'TABLE' ;
  968. 'REPETER' iprec ('DIME' tabprec) ;
  969. tabt . &iprec = tabprec . ('-' &iprec 1) ;
  970. 'FIN' iprec ;
  971. tit = 'CHAINE' 'Conv-diff BLOQ BiGSTAB(4) Pem= ' (formar Pem) ;
  972. titx = 'CHAINE' 'Log10 Nb pmatvec' ;
  973. tity = 'CHAINE' 'Log10 critere' ;
  974. DESSEVOL evtot tabt tit titx tity FAUX ;
  975. 'FINSI' ;
  976. *
  977. 'SI' ('NON' test) ;
  978. 'ERREUR' 5 ;
  979. 'FINSI' ;
  980. *
  981. 'SI' interact ;
  982. 'OPTION' 'DONN' 5 ;
  983. 'FINSI' ;
  984. *
  985. * End of dgibi file KRES_CD2
  986. *
  987. 'FIN' ;
  988.  
  989.  
  990.  
  991.  
  992.  
  993.  

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