Télécharger kreslap2.dgibi

Retour à la liste

Numérotation des lignes :

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

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