Télécharger deduadap.procedur

Retour à la liste

Numérotation des lignes :

  1. * DEDUADAP PROCEDUR JC220346 16/07/08 21:15:02 9008
  2. ************************************************************************
  3. * NOM : DEDUADAP
  4. *
  5. * Opérateur DEDU option ADAP
  6. * --------------------------
  7. * CHPO2 = 'DEDU' 'ADAP' MAIL (CHAM1) (RIG1 (CHPO1)) ;
  8. *
  9. * Objet :
  10. * _______
  11. *
  12. * Génère un champ de déplacement permettant de régulariser un
  13. * maillage ou de l'adapter suivant une métrique sans changer
  14. * sa topologie.
  15. *
  16. * Commentaire :
  17. * _____________
  18. *
  19. * MAIL : maillage à régulariser ou adapter
  20. *
  21. * CHAM1 : champ par élément aux noeuds donnant une métrique :
  22. * tenseur symétrique de composantes G11,G22,G12,...
  23. * (par défaut, le tenseur unité)
  24. *
  25. * RIG1 : Conditions sur les déplacements
  26. * CHPO1 (par défaut, on bloque les noeuds frontières de MAIL)
  27. *
  28. * CHPO2 : champ de déplacement.
  29. *
  30. * Notes :
  31. * _______
  32. *
  33. * L'option 'ADAP' est censée fonctionner sans conditions sur le
  34. * maillage.
  35. *
  36. * Référence principale :
  37. * ______________________
  38. *
  39. *@Article{huang4,
  40. * author = {Weizhang Huang},
  41. * title = {Variational Mesh Adaptation:
  42. * Isotropy and Equidistribution},
  43. * journal = {JCP},
  44. * year = {2001},
  45. * volume = {174},
  46. * pages = {903-924},
  47. * endroit = {Classeur Mesh Movement (VIIIb)}
  48. *}
  49. *
  50. * Je dois faire également un rapport technique...
  51. *
  52. *
  53. *
  54. * LANGAGE : GIBIANE-CAST3M
  55. * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  56. * mél : gounand@semt2.smts.cea.fr
  57. **********************************************************************
  58. * VERSION : v1, 05/04/2006, version initiale
  59. * HISTORIQUE : v1, 05/04/2006, création
  60. * HISTORIQUE :
  61. * HISTORIQUE :
  62. ************************************************************************
  63. * Prière de PRENDRE LE TEMPS de compléter les commentaires
  64. * en cas de modification de ce sous-programme afin de faciliter
  65. * la maintenance !
  66. ************************************************************************
  67. *
  68. *
  69. 'DEBPROC' DEDUADAP ;
  70. *
  71. * Lecture des arguments
  72. *
  73. 'ARGUMENT' mail*'MAILLAGE' ;
  74. *
  75. 'ARGUMENT' rblo/'RIGIDITE' ;
  76. lrb = 'EXISTE' rblo ;
  77. 'SI' lrb ;
  78. 'ARGUMENT' cblo/'CHPOINT' ;
  79. lcb = 'EXISTE' cblo ;
  80. 'SINON' ;
  81. lcb = FAUX ;
  82. 'FINSI' ;
  83. *
  84. lmotcle = 'MOTS' 'METR' 'DISG' 'THET' 'GAMM' 'NITM' 'ACVG' 'METG'
  85. 'IDIR' 'TINV' ;
  86. lchad = FAUX ; lchp = FAUX ;
  87. ldisg = FAUX ;
  88. theta = 0.2D0 ;
  89. gamma = 2.D0 ;
  90. *theta = 0.2D0 ;
  91. *gamma = 2.D0 ;
  92. itmax = 40 ;
  93. acccvg = VRAI ;
  94. lmg = FAUX ;
  95. lidir = FAUX ;
  96. ltinv = FAUX ;
  97. *
  98. 'REPETER' imotcle ;
  99. 'ARGUMENT' motcle/'MOT' ;
  100. 'SI' ('NON' ('EXISTE' motcle)) ;
  101. 'QUITTER' imotcle ;
  102. 'FINSI' ;
  103. lmc = 'EXISTE' lmotcle motcle ;
  104. 'SI' ('NON' lmc) ;
  105. cherr = 'CHAINE' 'Motcle ' motcle ' unknown' ;
  106. 'ERREUR' cherr ;
  107. 'FINSI' ;
  108. *
  109. 'SI' ('EGA' motcle 'METR') ;
  110. 'ARGUMENT' chad/'MCHAML' ;
  111. lchad = 'EXISTE' chad ;
  112. 'SI' ('NON' lchad) ;
  113. 'ARGUMENT' chp/'CHPOINT' ;
  114. lchp = 'EXISTE' chp ;
  115. 'ARGUMENT' metdisc*'MOT' ;
  116. 'SINON' ;
  117. lchp = FAUX ;
  118. 'FINSI' ;
  119. 'FINSI' ;
  120. *
  121. 'SI' ('EGA' motcle 'DISG') ;
  122. 'ARGUMENT' gdisc*'MOT' ;
  123. ldisg = VRAI ;
  124. 'FINSI' ;
  125. *
  126. 'SI' ('EGA' motcle 'THET') ;
  127. 'ARGUMENT' theta*'FLOTTANT' ;
  128. lok = 'ET' ('>' theta -1.D-8) ('<' theta ('+' 1. 1.D-8)) ;
  129. 'SI' ('NON' lok) ;
  130. cherr = 'CHAINE' 'FLOT1 must be in the range [0..1]' ;
  131. 'ERREUR' cherr ;
  132. 'FINSI' ;
  133. 'FINSI' ;
  134. *
  135. 'SI' ('EGA' motcle 'GAMM') ;
  136. 'ARGUMENT' gamma*'FLOTTANT' ;
  137. lok = ('>' gamma ('-' 1.D0 1.D-8)) ;
  138. 'SI' ('NON' lok) ;
  139. cherr = 'CHAINE' 'FLOT2 must be larger than 1' ;
  140. 'ERREUR' cherr ;
  141. 'FINSI' ;
  142. 'FINSI' ;
  143. *
  144. 'SI' ('EGA' motcle 'NITM') ;
  145. 'ARGUMENT' itmax*'ENTIER' ;
  146. lok = ('>' itmax 0) ;
  147. 'SI' ('NON' lok) ;
  148. cherr = 'CHAINE' 'ENTI1 must be larger than 0' ;
  149. 'ERREUR' cherr ;
  150. 'FINSI' ;
  151. 'FINSI' ;
  152. *
  153. 'SI' ('EGA' motcle 'ACVG') ;
  154. 'ARGUMENT' acccvg*'LOGIQUE' ;
  155. 'FINSI' ;
  156. *
  157. 'SI' ('EGA' motcle 'METG') ;
  158. 'ARGUMENT' methgau*'MOT' ;
  159. lmg = VRAI ;
  160. 'FINSI' ;
  161. *
  162. 'SI' ('EGA' motcle 'IDIR') ;
  163. 'ARGUMENT' idir*'ENTIER' ;
  164. lidir = VRAI ;
  165. 'FINSI' ;
  166. *
  167. 'SI' ('EGA' motcle 'TINV') ;
  168. 'ARGUMENT' tinv*'TABLE' ;
  169. ltinv = VRAI ;
  170. 'FINSI' ;
  171. *
  172. 'FIN' imotcle ;
  173. ladap = 'OU' lchad lchp ;
  174. *
  175. 'ARGUMENT' debug/'LOGIQUE' ;
  176. 'SI' ('NON' ('EXISTE' debug)) ;
  177. debug = FAUX ;
  178. 'FINSI' ;
  179. *
  180. * Initialisations
  181. *
  182. idim = 'VALEUR' 'DIME' ;
  183. imod = 'VALEUR' 'MODE' ;
  184. vdim = DEADUTIL 'DIMM' mail ;
  185. vtyp = DEADUTIL 'TYPM' mail ;
  186. laxi = DEADUTIL 'AXI?' ;
  187. lsph = DEADUTIL 'SPH?' ;
  188. *
  189. 'SI' ('OU' ('<' idim 1) ('>' idim 3)) ;
  190. 'ERREUR' ('CHAINE' 'idim = ' idim ' not implemented') ;
  191. 'FINSI' ;
  192. 'SI' ('OU' ('EGA' imod 'AXIS') ('EGA' imod 'UNIDAXIS')) ;
  193. 'ERREUR' ('CHAINE' 'Axisymetric modes not yet implemented') ;
  194. 'FINSI' ;
  195. 'SI' ('EGA' imod 'FOUR') ;
  196. 'ERREUR' ('CHAINE' 'Fourier mode not implemented') ;
  197. 'FINSI' ;
  198. 'SI' ('EGA' imod 'SPHE') ;
  199. 'ERREUR' ('CHAINE' 'Spherical mode not yet implemented') ;
  200. 'FINSI' ;
  201. *
  202. vquaf = ('EGA' vtyp 'QUAF') ;
  203. 'SI' ('ET' ldisg ('NON' vquaf)) ;
  204. cherr = 'CHAINE' 'Loption DISG necessite un maillage de QUAF' ;
  205. 'ERREUR' cherr ;
  206. 'FINSI' ;
  207. 'SI' ('ET' lchp ('NON' vquaf)) ;
  208. cherr = 'CHAINE' 'Loption METR+CHPO necessite un maillage de QUAF' ;
  209. 'ERREUR' cherr ;
  210. 'FINSI' ;
  211. *
  212. * Paramètres du solveur non-linéaire
  213. *
  214. * Evaluation de la matrice tangente
  215. * iktan = 1 : Matrice tangente exact (chère)
  216. * iktan = 2 : " approchée 1 (on néglige les termes extradiagonaux
  217. * (UX,FY)...)
  218. * (par défaut)
  219. * iktan = 3 : " approchée 2 (on néglige en plus les dérivées
  220. * extradiagonales (ddxi, ddeta))
  221. * (ne fonctionne pas)
  222. *
  223. * Accélération de convergence
  224. * acccvg = VRAI : accélération à la PV
  225. *
  226. * Période de recalcul de la matrice tangente
  227. * rktan = i (toutes les i itérations non-linéaires)
  228. *
  229. * itmax : Nombre maxi d'itérations
  230. * rfonc : critère d'arrêt sur la variation de la fonctionnelle
  231. * fback : facteur divisif pour la relaxation lors d'un backtracking
  232. * nback : nombre maxi de backtracking
  233. * fvdet : critère pour le backtracking, variation maxi de la valeur
  234. * du jacobien
  235.  
  236. iktan = 2 ;
  237. *!!!iktan = 1 ;
  238. rktan = 1 ;
  239. 'SI' debug ;
  240. rfonc = 5.D-8 ;
  241. 'SINON' ;
  242. rfonc = 5.D-2 ;
  243. 'FINSI' ;
  244. fback = 2.D0 ; fvdet = 4.D0 ;
  245. nback = 10 ; damp = 1.0D0 ;
  246. *
  247. * Maillage
  248. *
  249. 'SI' vquaf ;
  250. _mt = mail ;
  251. 'SINON' ;
  252. _mt = 'CHANGER' mail 'QUAF' ;
  253. 'FINSI' ;
  254. *
  255. * Inconnus et discrétisation
  256. *
  257. 'SI' ('NON' lmg) ;
  258. 'SI' ('EGA' vtyp 'LINE') ;
  259. methgau = 'GAR1' ;
  260. 'SINON' ;
  261. methgau = 'GAR2' ;
  262. 'FINSI' ;
  263. 'FINSI' ;
  264. 'SI' ('NON' ldisg) ;
  265. gdisc = vtyp ;
  266. 'FINSI' ;
  267. *
  268. 'SI' ('OU' laxi lsph) ;
  269. lu = 'MOTS' 'UR' 'UZ' ;
  270. lf = 'MOTS' 'FR' 'FZ' ;
  271. 'SINON' ;
  272. lu = 'MOTS' 'UX' 'UY' 'UZ' ;
  273. lf = 'MOTS' 'FX' 'FY' 'FZ' ;
  274. 'FINSI' ;
  275. *
  276. lextr = 'LECT' 1 'PAS' 1 idim ;
  277. *
  278. lpr = 'EXTRAIRE' lu lextr ; ldu = 'EXTRAIRE' lf lextr ;
  279. *
  280. * Métrique
  281. *
  282. 'SI' ladap;
  283. 'SI' lchad ;
  284. * $mt = 'MODE' _mt 'NAVIER_STOKES' 'QUAF' ;
  285. * chpmet = 'KCHA' $mt chad 'CHPO' 'QUAF' ;
  286. * metdisc = 'CSTE' ;
  287. $mt = 'MODELISER' mail 'THERMIQUE' ;
  288. chpmet = 'CHANGER' 'CHPO' $mt chad ;
  289. metdisc = gdisc ;
  290. 'FINSI' ;
  291. 'SI' lchp ;
  292. chpmet = chp ;
  293. 'FINSI' ;
  294. 'FINSI' ;
  295. *
  296. * Conditions aux limites sur les déplacements
  297. *
  298. 'SI' ('NON' lrb) ;
  299. 'SI' ('EGA' idim 1) ;
  300. * Faute de mieux : contour ne fonctionne pas en 1D
  301. bord = 'ET' ('POIN' mail 'INITIAL')
  302. ('POIN' mail 'FINAL') ;
  303. 'FINSI' ;
  304. 'SI' ('EGA' idim 2) ;
  305. bord = 'CONTOUR' mail ;
  306. * rblo = 'BLOQUE' 'UX' 'UY' bord ;
  307. 'FINSI' ;
  308. 'SI' ('EGA' idim 3) ;
  309. bord = 'ENVELOPPE' mail ;
  310. * rblo = 'BLOQUE' 'UX' 'UY' 'UZ' bord ;
  311. 'FINSI' ;
  312. rblo = 'BLOQUE' 'DEPL' bord ;
  313. 'FINSI' ;
  314. *
  315. * Initilisations diverses
  316. *
  317. iniform = 'FORME' ;
  318. tres = 'TABLE' ;
  319. dx = 'MANUEL' 'CHPO' mail lpr ('PROG') ;
  320. det0 = DEADJACO _mt gdisc methgau ;
  321. tyde = 'TYPE' det0 ;
  322. 'SI' ('EGA' tyde 'ENTIER') ;
  323. chinfo = 'CHAINE' 'DEDUADAP : the mesh is already skew !' ;
  324. 'MESSAGE' chinfo ;
  325. cherr = 'CHAINE' 'Check the input mesh' ;
  326. 'ERREUR' cherr ;
  327. 'FINSI' ;
  328. 'SI' ladap ;
  329. fonc0 = DEADFONC _mt gdisc methgau theta gamma
  330. chpmet metdisc 'ELEM' ;
  331. 'SI' lidir ;
  332. res = DEADRESI _mt gdisc methgau theta gamma ldu
  333. chpmet metdisc idir ;
  334. 'SINON' ;
  335. res = DEADRESI _mt gdisc methgau theta gamma ldu
  336. chpmet metdisc ;
  337. 'FINSI' ;
  338. 'SINON' ;
  339. fonc0 = DEADFONC _mt gdisc methgau theta gamma 'ELEM' ;
  340. 'SI' lidir ;
  341. res = DEADRESI _mt gdisc methgau theta gamma ldu idir ;
  342. 'SINON' ;
  343. res = DEADRESI _mt gdisc methgau theta gamma ldu ;
  344. 'FINSI' ;
  345. 'FINSI' ;
  346. dampi = damp ;
  347. fonci = fonc0 ;
  348. deti = det0 ;
  349. 'SI' acccvg ;
  350. znacce = 3 ; itdep = 3 ;
  351. acfp1 = 'COPIER' ('*' res 0.) ; acfp2 = acfp1 ;
  352. acfp3 = acfp1 ; acfep1 = acfp1;
  353. acfep2 = acfp1 ; correc=0.; freap = 0. ;
  354. 'FINSI' ;
  355. *
  356. * Algorithme non linéaire
  357. *
  358. cvgok = FAUX ;
  359. 'REPETER' it itmax ;
  360. dampi = 'MINIMUM' ('PROG' damp ('*' dampi fback)) ;
  361. 'SI' debug ;
  362. ch = 'CHAINE' ' Itération : ' &it ;
  363. 'MESSAGE' ch ;
  364. ch = 'CHAINE' ' dampi=' dampi ;
  365. 'MESSAGE' ch ;
  366. 'FINSI' ;
  367. *
  368. * Calcul du résidu
  369. *
  370. * partie liée à la fonctionnelle
  371. 'SI' ladap ;
  372. 'SI' lidir ;
  373. resf = DEADRESI _mt gdisc methgau theta gamma ldu
  374. chpmet metdisc idir ;
  375. 'SINON' ;
  376. resf = DEADRESI _mt gdisc methgau theta gamma ldu
  377. chpmet metdisc ;
  378. 'FINSI' ;
  379. 'SINON' ;
  380. 'SI' lidir ;
  381. resf = DEADRESI _mt gdisc methgau theta gamma ldu idir ;
  382. 'SINON' ;
  383. resf = DEADRESI _mt gdisc methgau theta gamma ldu ;
  384. 'FINSI' ;
  385. 'FINSI' ;
  386. * partie liée aux blocages
  387. resb = '*' rblo dx ;
  388. 'SI' lcb ;
  389. resb = resb '-' cblo ;
  390. 'FINSI' ;
  391. res = resf '+' resb ;
  392. * acceleration de convergence
  393. 'SI' acccvg ;
  394. correcp = correc; correc = 0;
  395. acfp0 = 'ENLEVER' (res - freap) 'FLX' ;
  396. acfep0 = acfp0;
  397. acfep0 = acfep0 - correcp ;
  398. 'SI' ('MULT' &it znacce) ;
  399. 'SI' ('>' &it itdep) ;
  400. 'SI' ('>' dampi ('*' damp 0.9)) ;
  401. 'SI' debug ;
  402. 'MESSAGE' 'Convergence acceleration' ;
  403. 'FINSI' ;
  404. correc = act3 acfep2 acfep1 acfep0
  405. acfp3 acfp2 acfp1 acfp0 ;
  406. res = '-' res correc;
  407. 'FINSI' ;
  408. 'FINSI' ;
  409. 'FINSI' ;
  410. 'SI' ('>' &it 3) ;
  411. 'DETRUIT' acfp3 ;
  412. 'DETRUIT' acfep2 ;
  413. 'FINSI' ;
  414. acfp3 = acfp2 ; acfp2 = acfp1 ; acfp1 = acfp0 ;
  415. acfep2 = acfep1 ; acfep1 = acfep0 ;
  416. 'MENAGE' ;
  417. 'FINSI' ;
  418. *
  419. * Calcul de la matrice tangente
  420. *
  421. 'SI' ('MULT' ('-' &it 1) rktan) ;
  422. 'SI' ladap ;
  423. 'SI' lidir ;
  424. jac = DEADKTAN _mt gdisc methgau theta gamma
  425. lpr ldu chpmet metdisc iktan idir ;
  426. 'SINON' ;
  427. jac = DEADKTAN _mt gdisc methgau theta gamma
  428. lpr ldu iktan chpmet metdisc ;
  429. 'FINSI' ;
  430. 'SINON' ;
  431. 'SI' lidir ;
  432. jac = DEADKTAN _mt gdisc methgau theta gamma
  433. lpr ldu iktan idir ;
  434. 'SINON' ;
  435. jac = DEADKTAN _mt gdisc methgau theta gamma
  436. lpr ldu iktan ;
  437. 'FINSI' ;
  438. 'FINSI' ;
  439. jact = 'ET' jac rblo ;
  440. 'FINSI' ;
  441. *
  442. * Résolution du problème linéarisé
  443. *
  444. 'SI' ltinv ;
  445. mat smb = jact ('*' -1.D0 res) ;
  446. 'SI' ('EGA' (tinv . 'TYPINV') 0) ;
  447. 'OPTI' impi 0 ;
  448. sol = 'RESOUD' mat smb 'NOID' ;
  449. 'OPTI' impi 0 ;
  450. 'SINON' ;
  451. 'SI' ('EXISTE' tinv 'LTIME') ;
  452. ltime = tinv . 'LTIME' ;
  453. 'SINON' ;
  454. ltime = FAUX ;
  455. 'FINSI' ;
  456. *
  457. 'SI' ('EGA' ltime vrai) ;
  458. sol tt = 'KRES' mat smb 'TYPI' tinv ;
  459. 'LISTE' tt ;
  460. 'SINON' ;
  461. sol = 'KRES' mat smb 'TYPI' tinv ;
  462. 'FINSI' ;
  463. 'FINSI' ;
  464. ddx = sol ;
  465. 'SINON' ;
  466. ddx = 'RESO' jact ('*' -1.D0 res) ;
  467. 'FINSI' ;
  468. * 'LISTE' ddx ;
  469. *
  470. *
  471. *
  472. 'SI' acccvg ;
  473. freap = reac rblo ddx ;
  474. * resx = 'ENLEVER' ('-' res (reac rblo ddx)) 'FLX' ;
  475. * resx2 = 'ENLEVER' (res) 'FLX' ;
  476. 'FINSI' ;
  477. *
  478. * Backtracking
  479. *
  480. backok = FAUX ;
  481. 'REPETER' iback nback ;
  482. 'SI' ('>' &iback 1) ;
  483. dampi = '/' dampi fback ;
  484. 'SI' debug ;
  485. ch = 'CHAINE' ' dampi=' dampi ;
  486. 'MESSAGE' ch ;
  487. 'FINSI' ;
  488. 'FINSI' ;
  489. ddxi = '*' ddx dampi ;
  490. depx = 'EXCO' lpr ddxi lpr 'NOID' ;
  491. * Test si le déplacement calculé inverse un jacobien
  492. * ou le change trop
  493. oldconf = 'FORME' ;
  494. 'FORME' depx ;
  495. detip = DEADJACO _mt gdisc methgau ;
  496. 'FORME' oldconf ;
  497. tyde = 'TYPE' detip ;
  498. 'SI' ('EGA' tyde 'ENTIER') ;
  499. 'SI' debug ;
  500. ch = 'CHAINE' ' Warning : inv. loc. jacobien !' ;
  501. 'MESSAGE' ch ;
  502. 'FINSI' ;
  503. 'SINON' ;
  504. vardet = ('/' detip deti) ;
  505. mivd = 'MINIMUM' vardet ;
  506. mavd = 'MAXIMUM' vardet ;
  507. 'SI' debug ;
  508. 'MESSAGE' ('CHAINE' 'Mini var jaco = ' mivd ) ;
  509. 'MESSAGE' ('CHAINE' 'Maxi var jaco = ' mavd ) ;
  510. 'FINSI' ;
  511. bigvar = 'OU' ('>' mavd fvdet) ('<' mivd ('/' 1.D0 fvdet)) ;
  512. 'SI' bigvar ;
  513. 'SI' debug ;
  514. ch = 'CHAINE'
  515. ' Warn : trop grande variation du jaco !' ;
  516. 'MESSAGE' ch ;
  517. 'FINSI' ;
  518. 'SINON' ;
  519. backok = VRAI ;
  520. 'QUITTER' iback ;
  521. 'FINSI' ;
  522. 'FINSI' ;
  523. 'FIN' iback ;
  524. 'SI' ('NON' backok) ;
  525. chinfo1 = 'CHAINE'
  526. 'DEDUADAP : Backtracking failed to converge !' ;
  527. 'MESSAGE' chinfo1 ;
  528. chinfo2 = 'CHAINE' 'Please check the output displacement'
  529. 'MESSAGE' chinfo2 ;
  530. dep = 'EXCO' lpr dx lpr ;
  531. 'RESPRO' dep ;
  532. 'QUITTER' DEDUADAP ;
  533. 'FINSI' ;
  534. dx = '+' dx ddxi ;
  535. 'FORME' depx ;
  536. 'SI' ladap ;
  537. foncip = DEADFONC _mt gdisc methgau theta gamma
  538. chpmet metdisc 'ELEM' ;
  539. 'SINON' ;
  540. foncip = DEADFONC _mt gdisc methgau theta gamma 'ELEM' ;
  541. 'FINSI' ;
  542. *
  543. * Critère de convergence
  544. *
  545. vrrfon = '/' ('-' foncip fonci) fonci ;
  546. critconv = 'MAXIMUM' vrrfon 'ABS' ;
  547. tres . &it = critconv ;
  548. cvgok = ('<' critconv rfonc) ;
  549. 'SI' debug ;
  550. chmess = 'CHAINE' ' critere = ' critconv ;
  551. 'MESSAGE' chmess ;
  552. 'FINSI' ;
  553. deti = detip ;
  554. fonci = foncip ;
  555. 'SI' debug ;
  556. tit = 'CHAINE' 'Maillage ; it=' &it ' crit=' critconv ;
  557. TRAC 'CACH' mail 'TITR' tit 'NCLK' ;
  558. 'FINSI' ;
  559. 'SI' cvgok ;
  560. 'QUITTER' it ;
  561. 'FINSI' ;
  562. 'FIN' it ;
  563. 'FORME' iniform ;
  564. dep = 'EXCO' lpr dx lpr ;
  565. *
  566. itfin = ('-' &it 1) ;
  567. 'SI' debug ;
  568. ch = 'CHAINE' ' Itération finale : ' itfin ;
  569. 'MESSAGE' ch ;
  570. lit = 'PROG' 1. 'PAS' 1. 'NPAS' ('-' itfin 1) ;
  571. lres = 'PROG' ;
  572. 'REPETER' it itfin ;
  573. lres = 'ET' lres ('PROG'
  574. ('/' ('LOG' ('+' (tres . &it ) 1.D-16))
  575. ('LOG' 10.D0) )) ;
  576. 'FIN' it ;
  577. titev = 'CHAINE' 'LOG10 Critere (iterations)' ;
  578. evres = 'EVOL' 'MANU' lit lres 'TITR' titev ;
  579. 'DESSIN' evres ;
  580. 'FINSI' ;
  581. *
  582. 'RESPRO' dep ;
  583. *
  584. * End of procedure file DEDUADAP
  585. *
  586. 'FINPROC' ;
  587.  
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  

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