Télécharger waam.procedur

Retour à la liste

Numérotation des lignes :

  1. * WAAM PROCEDUR SP204843 25/05/07 21:15:02 12262
  2. DEBP WAAM TAB1*'TABLE' ;
  3.  
  4. *-------------------------- Initialisations ---------------------------*
  5.  
  6. * Lecture des options :
  7. argu MOT1*'MOT' ;
  8.  
  9. * icas1 = 1 / 2 / 3 pour MAIL / VISU / MACRO
  10. * Si 0 in fine : erreur.
  11. icas1 = 0 ;
  12.  
  13. *----------------------------------------------------------------------*
  14. * Option MAIL
  15. *----------------------------------------------------------------------*
  16.  
  17. si (ega mot1 'MAIL') ;
  18. icas1 = 1 ;
  19.  
  20. *----------------- Lecture des arguments de l'option ------------------*
  21.  
  22. imot1 = faux ;
  23. imot2 = faux ;
  24. imot3 = faux ;
  25. imot4 = faux ;
  26. imot5 = faux ;
  27. repe b1 5 ;
  28. argu moti1/'MOT' ;
  29. si (non (exis moti1)) ; quit b1 ; fins ;
  30.  
  31. * Arguments option MAIL :
  32. si (ega moti1 'PAS') ;
  33. imot1 = vrai ;
  34. argu lpas1/'LISTREEL' ;
  35. si (exis lpas1) ;
  36. npas1 = dime lpas1 ;
  37. si (npas1 ega 0) ;
  38. erre '***** ERREUR : le LISTREEL fourni est de dimension nulle.' ;
  39. quit waam ;
  40. fins ;
  41. pas1 = extr lpas1 1 ;
  42. sino ;
  43. argu pas1*'FLOTTANT' ;
  44. lpas1 = prog pas1 ;
  45. npas1 = 1 ;
  46. fins ;
  47. fins ;
  48. si (ega moti1 'LARG') ;
  49. imot2 = vrai ;
  50. argu larg1*'FLOTTANT' ;
  51. fins ;
  52. si (ega moti1 'DENS') ;
  53. imot3 = vrai ;
  54. argu dens1*'FLOTTANT' ;
  55. fins ;
  56.  
  57. * Arguments option TEMP :
  58. si (ega moti1 'TEMP') ;
  59. imot4 = vrai ;
  60. argu flot4/'FLOTTANT' ;
  61. si (non (exis flot4)) ;
  62. flot4 = 3. * Pi ;
  63. fins ;
  64. fins ;
  65. si (ega moti1 'MAXI') ;
  66. imot5 = vrai ;
  67. argu flot5*'FLOTTANT' ;
  68. fins ;
  69. fin b1 ;
  70. si (non imot1) ;
  71. erre '***** ERREUR : il manque la donnee du PAS de discretisation du depot' ;
  72. quit waam ;
  73. fins ;
  74. si (non imot2) ;
  75. si (exis tab1 'LARGEUR_DE_PASSE') ;
  76. larg1 = tab1.largeur_de_passe ;
  77. sino ;
  78. erre '***** ERREUR : il manque la donnee de la LARGeur du depot' ;
  79. quit waam ;
  80. fins ;
  81. fins ;
  82. si (non imot3) ;
  83. argu N1/'ENTIER' ;
  84. si (exis N1) ;
  85. N1 = maxi (lect N1 1) ;
  86. sino ;
  87. N1 = 1 ;
  88. fins ;
  89. dens1 = pas1 / (flot N1) ;
  90. fins ;
  91.  
  92. *------------------- MAILLAGE des passes de soudage -------------------*
  93.  
  94. si (non (exis tab1 passes)) ;
  95. erre '***** ERREUR : la table de SOUDAGE en entree n"a pas d"indice PASSES' ;
  96. quit waam ;
  97. fins ;
  98.  
  99. * Definition d'une tolerance geometrique :
  100. tol1 = 1.e-4 * dens1 ;
  101.  
  102. * Maillage d'une section de cordon :
  103. lsi1 = (0 0 0) droi (0 larg1 0) dini dens1 dfin dens1 ;
  104.  
  105. * Initialisattion sorties (MAIL) :
  106. tab2 = table ;
  107. ttps1 = table ;
  108. tmai1 = table ;
  109. indi1 = 0 ;
  110.  
  111. * On parcourt la trajectoire :
  112. mtraj1 = tab1.trajectoire ;
  113. mail2 = vide maillage ;
  114. idebui1 = vrai ;
  115. ibouci1 = faux ;
  116.  
  117. * Boucle sur elements de la trajectoire :
  118. nb1 = nbel mtraj1 ;
  119. repe b1 nb1 ;
  120.  
  121. * Lecture ieme element de la trajectoire :
  122. eli1 = mtraj1 elem &b1 ;
  123. Pi1 = eli1 poin 1 ;
  124. Pi2 = eli1 poin 2 ;
  125. vai1 = Pi2 moin Pi1 ;
  126. vni1 = vai1 / (norm vai1) ;
  127. mcouli1 = (eli1 elem coul) extr 1 ;
  128. imaili1 = ega mcouli1 'ROUG' ;
  129. idepli1 = ega mcouli1 'VERT' ;
  130. *
  131. * Segment VERT : deplacement
  132. si idepli1 ;
  133. idebui1 = vrai ;
  134. ibouci1 = faux ;
  135. iter b1 ;
  136. fins ;
  137. *
  138. * Segment ROUGE : maillage
  139. si imaili1 ;
  140.  
  141. * Si debut nouvelle passe :
  142. si idebui1 ;
  143.  
  144. * Identification de la passe :
  145. npassi1 = 0 ;
  146. nbp1 = dime tab1.passes ;
  147. repe bp1 nbp1 ;
  148. mailpss1 = (tab1.passes.&bp1).maillage ;
  149. pps1 pps2 = (mailpss1 poin 1) (mailpss1 poin 2) ;
  150. si ((Pi1 ega pps1) et (Pi2 ega pps2)) ;
  151. tpassi1 = tab1.passes.&bp1 ;
  152. npassi1 = &bp1 ;
  153. mess '***** WAAM : maillage de la passe :' npassi1 ;
  154. quit bp1 ;
  155. fins ;
  156. fin bp1 ;
  157. si (npassi1 ega 0) ;
  158. erre '***** WAAM : passe non identifiee' ;
  159. quit waam ;
  160. fins ;
  161.  
  162. * Hauteur de cordon :
  163. debi1 = tpassi1 . debit ;
  164. vite1 = tpassi1 . vitesse ;
  165. haut1 = debi1 / vite1 / larg1 ;
  166. mess (chai '***** WAAM : hauteur de la passe :' npassi1 ' =' haut1) ;
  167.  
  168. * Maillage :
  169. * si1 : maillage section courante :
  170. * vnsi1 : normale a la section
  171. si1 = lsi1 tran (0 0 haut1) dini dens1 dfin dens1 ;
  172. vnsi1 = 1 0 0 ;
  173.  
  174. * Positionnement extremite initiale (Pi1 au centre de l'arete superieure) :
  175. Pmsup1 = 0 (0.5*larg1) haut1 ;
  176. si1 = si1 plus (Pi1 moin Pmsup1) ;
  177.  
  178. * Initialisation section extremite finale :
  179. si2 = si1 plus vai1 ;
  180. vnsi2 = vnsi1 ;
  181. angl2 = 0. ;
  182. *
  183. * Orientation sections de maillage :
  184. * Par defaut, selon vni1 :
  185. vnsmai1 = vni1 ;
  186. vnsmai2 = vnsmai1 ;
  187.  
  188. * Detection suite segments rouges et boucle :
  189. tpsi2 = tpassi1.instants extr 1 ;
  190. tpsi22 = tpassi1.instants extr 2 ;
  191. si (&b1 neg nb1) ;
  192. elip1 = mtraj1 elem (&b1 + 1) ;
  193. mcoulip1 = (elip1 elem coul) extr 1 ;
  194. isuiti1 = ega mcoulip1 'ROUG' ;
  195. isuiti2 = non (vide (elip1 inte mailpss1)) ;
  196. si (npassi1 neg nbp1) ;
  197. isuiti2 = isuiti2 ou (ega tpsi22 (tab1.passes.(npassi1+1).instants extr 1)) ;
  198. fins ;
  199. isuiti1 = isuiti1 et isuiti2 ;
  200. si isuiti1 ;
  201. vai2 = (elip1 poin 2) moin (elip1 poin 1) ;
  202. vni2 = vai2 / (norm vai2) ;
  203. vasmai2 = vni1 plus vni2 ;
  204. vnsmai2 = vasmai2 / (norm vasmai2) ;
  205. elfini1 = elip1 ;
  206. pfini1 = elip1 poin 2 ;
  207. nb2 = nb1 - (&b1 + 1) ;
  208. i2 = &b1 + 2 ;
  209. * Rq : si nb2 = 0, le bloc n'est pas execute
  210. repe b2 nb2 ;
  211. eli2 = mtraj1 elem i2 ;
  212. mcoul2 = (eli2 elem coul) extr 1 ;
  213. si (neg mcoul2 'ROUG') ; quit b2 ; fins ;
  214. pfini1 = eli2 poin 2 ;
  215. elfini1 = eli2 ;
  216. vafini1 = pfini1 moin (eli2 poin 1) ;
  217. vnfini1 = vafini1 / (norm vafini1) ;
  218. i2 = i2 + 1 ;
  219. fin b2 ;
  220. ibouci1 = (norm (pfini1 moin pi1)) < tol1 ;
  221. si ibouci1 ;
  222. mess '***** WAAM : boucle fermee detectee' ;
  223. * On definit la normale a la section de maillage (SMA) :
  224. vasmai1 = vni1 plus vnfini1 ;
  225. vnsmai1 = vasmai1 / (norm vasmai1) ;
  226. fins ;
  227. fins ;
  228. fins ;
  229.  
  230. * Orientation de si1 selon vnsmai1 :
  231. *list vnsmai1 ; list vnsi1 ;
  232. *trac (0 -0 3) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2) ;
  233. vnnz1 = pvec vnsi1 vnsmai1 ;
  234. lvnnz1 = norm vnnz1 ;
  235. * Si sinus non nul a tol1 pres, on oriente la section :
  236. si (lvnnz1 neg 0. (tol1 / dens1)) ;
  237. si (lvnnz1 ega 1. (vale prec)) ; lvnnz1 = 1. ; fins ;
  238. angl1 = asin lvnnz1 ;
  239. *list vnsi1 ; list vnsmai1 ; list angl1 ;
  240. si ((psca vnsmai1 vnsi1) < 0.) ;
  241. angl1 = 180. - angl1 ;
  242. *mess ' on prend (180.-angl1)' ;
  243. fins ;
  244. si1 = si1 tour angl1 pi1 (pi1 plus vnnz1) ;
  245. vnsi1 = vnsmai1 ;
  246. si2 = si1 plus vai1 ;
  247. vnsi2 = vnsi1 ;
  248. angl2 = 0. ;
  249. sino ;
  250. si ((psca vnsmai1 vnsi1) < 0.) ;
  251. vnsi1 = vnsmai1 ;
  252. si2 = si1 plus vai1 ;
  253. vnsi2 = vnsi1 ;
  254. angl2 = 0. ;
  255. fins ;
  256. fins ;
  257. *list vnsi1 ; list angl1 ;
  258. titr 'Debut de passe, apres orientation de si1' ;
  259. *trac (0 0 100) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2) ;
  260.  
  261. * Si boucle, on garde la section de maillage du debut :
  262. si ibouci1 ;
  263. sfini1 = si1 ;
  264. vnfini1 = vnsmai1 ;
  265. fins ;
  266.  
  267. sino ;
  268.  
  269. * On a deja si1 correctement orientee.
  270. * On doit orienter si2.
  271. * Par defaut, orientation de si1 :
  272. si2 = si1 plus vai1 ;
  273. vnsi2 = vnsi1 ;
  274. angl2 = 0. ;
  275. vnsmai2 = vnsi2 ;
  276.  
  277. * Si fin d'une boucle, orientation si2 connue :
  278. si (ibouci1 et (pi2 ega pfini1)) ;
  279. vnsmai2 = vnfini1 ;
  280. sino ;
  281. si (&b1 neg nb1) ;
  282. elip1 = mtraj1 elem (&b1 + 1) ;
  283. mcoulip1 = (elip1 elem coul) extr 1 ;
  284. isuiti1 = ega mcoulip1 'ROUG' ;
  285. si isuiti1 ;
  286. vai2 = (elip1 poin 2) moin (elip1 poin 1) ;
  287. vni2 = vai2 / (norm vai2) ;
  288. vasmai2 = vni1 plus vni2 ;
  289. vnsmai2 = vasmai2 / (norm vasmai2) ;
  290. fins ;
  291. fins ;
  292. fins ;
  293.  
  294. * Fin "Si idebui1 / sinon" :
  295. fins ;
  296. *
  297. * Orientation de si2 selon vnsmai2 :
  298. *list vnsmai2 ; list vnsi2 ;
  299. *trac (0 0 100) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2 et (pi1 droi 1 (pi1 plus (0.01*vnsi1))) et (pi2 droi 1 (pi2 plus (0.01*vnsi2)))) titr 'Avant orientation si2' ;
  300. vnnz1 = pvec vnsi2 vnsmai2 ;
  301. lvnnz1 = norm vnnz1 ;
  302. * Si sinus non nul a tol1 pres, on oriente la section :
  303. si (lvnnz1 neg 0. (tol1 / dens1)) ;
  304. si (lvnnz1 ega 1. (vale prec)) ; lvnnz1 = 1. ; fins ;
  305. angl2 = asin lvnnz1 ;
  306. si ((psca vnsi2 vnsmai2) < 0.) ;
  307. *mess ' on prend (180.-angl2)' ; saut 1 lign ;
  308. angl2 = 180. - angl2 ;
  309. fins ;
  310. si2 = si2 tour angl2 pi2 (pi2 plus vnnz1) ;
  311. vnsi2 = vnsi2 tour angl2 (0 0 0) vnnz1 ;
  312. sino ;
  313. * Pas sur que ça serve a quelque chose...
  314. si ((psca vnsi2 vnsmai2) < 0.) ;
  315. vnsi2 = vnsmai2 ;
  316. angl2 = 180. ;
  317. fins ;
  318. fins ;
  319. titr 'En cours de passe, apres orientation de si2' ;
  320. *trac (0 0 100) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2 et (pi1 droi 1 (pi1 plus (0.01*vnsi1))) et (pi2 droi 1 (pi2 plus (0.01*vnsi2)))) ;
  321. *si (ibouci1 et (pi2 ega pfini1)) ;
  322. *trac (5 -2 3) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et (si22 coul oran) et pi1 et pi2) ;
  323. *fins ;
  324.  
  325. *---- Maillage du segment :
  326.  
  327. llpas1 = somm (lpas1 enle npas1) ;
  328. leli1 = mesu eli1 ;
  329. si (leli1 &lt;EG llpas1) ;
  330. erre '***** ERREUR : somme pas de discretisation > long. ' &b1 'e passe' ;
  331. quit waam ;
  332. fins ;
  333.  
  334. * Boucle sur les pas de discretisation :
  335.  
  336. * pasi1 : pas de discretisation courant
  337. * nei1 : nb maillages pour ce pas de discretisation du segment
  338. * pami1 : pas de maillage courant
  339. * nei2 : nbel crees par pas de maillage
  340.  
  341. idebui1 = non isuiti1 ;
  342. repe bp1 npas1 ;
  343. pasi1 = extr lpas1 &bp1 ;
  344. si (&bp1 neg npas1) ;
  345. nei1 = 1 ;
  346. pami1 = pasi1 ;
  347. sino ;
  348. llmi1 = leli1 - llpas1 ;
  349. nei1 = llmi1 / pasi1 + 0.5 ;
  350. nei1 = maxi (lect (enti nei1) 1) ;
  351. *mess 'nei1=' nei1 ;
  352. pami1 = llmi1 / (flot nei1) ;
  353. fins ;
  354.  
  355. vtrani1 = pami1 * vni1 ;
  356. ltrani1 = norm vtrani1 ;
  357. nei2 = enti (ltrani1 / dens1 + 0.5) ;
  358. nei2 = maxi (lect (enti nei2) 1) ;
  359. *mess 'nei2=' nei2 ;
  360. itouri1 = (abs angl2) > 0. ;
  361. *list itouri1 ;
  362. *list angl2 ;
  363. angli2 = angl2 / (flot nei1) ;
  364. vnsi22 = vnsi1 ;
  365. si22 = si1 ;
  366. dti2 = ltrani1 / vite1 ;
  367. repe b2 nei1 ;
  368. pi22 = pi1 plus vtrani1 ;
  369. si itouri1 ;
  370. vnsi22 = vnsi22 tour angli2 (0 0 0) vnnz1 ;
  371. pi33 = pi22 plus vnnz1 ;
  372. pi44 = pi22 plus (pvec vnsi22 vnnz1) ;
  373. si22 = si22 proj dire vtrani1 plan pi22 pi33 pi44 ;
  374. sino ;
  375. si22 = si1 plus vtrani1 ;
  376. fins ;
  377. maili2 = si1 volu si22 nei2 ;
  378. si1 = si22 ;
  379. pi1 = pi22 ;
  380. maili2 = maili2 coul (indi1+1) ;
  381. mail2 = mail2 et maili2 ;
  382. tmai1 . indi1 = mail2 ;
  383. ttps1 . indi1 = tpsi2 ;
  384. tpsi2 = tpsi2 + dti2 ;
  385. indi1 = indi1 + 1 ;
  386. fin b2 ;
  387.  
  388. fin bp1 ;
  389.  
  390. *trac (5 -2 3) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et (si22 coul oran) et pi1 et pi2) ;
  391.  
  392. vnsi1 = vnsi2 ;
  393. vnsmai1 = vnsmai2 ;
  394.  
  395. * Fin si imail1 (segment rouge) ;
  396. sino ;
  397. erre '***** ERREUR : pb definition trajectoire, couleur segment inconnue' ;
  398. quit waam ;
  399. fins ;
  400.  
  401. * Fin boucle segments trajectoire
  402. fin b1 ;
  403. * elim mail2 tol1 ;
  404.  
  405. * Verification list des temps de tttps1 bien ordonnee :
  406. ltps1 = prog table ttps1 ;
  407. ltps2 = ordo ltps1 ;
  408. si (((ltps2 - ltps1) maxi abs) > (1.e-3*dti2)) ;
  409. erre '***** la liste des TEMPS de l''evolution du maillage est mal ordonnee' ;
  410. fins ;
  411. * Enregistrement des sorties :
  412. tab2.maillage = mail2 ;
  413. tab2.evolution_maillage = table ;
  414. tab2.evolution_maillage.temps = ttps1 ;
  415. tab2.evolution_maillage.maillage = tmai1 ;
  416.  
  417. *-------------------------- Sous-option TEMP --------------------------*
  418.  
  419. si imot4 ;
  420.  
  421. * Valeurs de dtca1 :
  422. nbp1 = dime tab1 . passes ;
  423. tpi1 = 0. ;
  424. ltp1 = prog ;
  425. ldtca1 = prog ;
  426. repe bp1 nbp1 ;
  427. vsi1 = tab1 . passes . &bp1 . vitesse ;
  428. dtcai1 = pas1 / vsi1 / flot4 ;
  429. si (&bp1 ega nbp1) ;
  430. tpi2 = (tab1 . passes . &bp1 . instants) extr 2 ;
  431. sino ;
  432. ip1 = &bp1 + 1 ;
  433. tpip1 = (tab1 . passes . ip1 . instants) extr 1 ;
  434. tpi2 = tpip1 - tab1 . temps_de_coupure ;
  435. fins ;
  436. ltp1 = ltp1 et tpi1 et tpi2 ;
  437. ldtca1 = ldtca1 et dtcai1 et dtcai1 ;
  438. tpi1 = tpip1 ;
  439. fin bp1 ;
  440. evdtca1 = evol manu ltp1 ldtca1 ;
  441. *list evdtca1 ;
  442.  
  443. * Redecoupage de la liste des temps de l'evolution de la puissance thermique :
  444. evqt1 = tab1.evolution_puissance ;
  445. ltqt1 = extr evqt1 absc ;
  446. lqqt1 = extr evqt1 ordo ;
  447. tol2 = 1.e-6 * (maxi lqqt1) ;
  448. tol3 = 0.001 * tab1.temps_de_coupure ;
  449.  
  450. * Gestion des evenements :
  451. ieve1 = exis tab1 evenements ;
  452. Si ieve1 ;
  453. lteve1 = prog ;
  454. lieve1 = lect ;
  455. repe beve1 (dime tab1.evenements) ;
  456. ie1 = &beve1 ;
  457. lteve1 = lteve1 et tab1.evenements.ie1.temps ;
  458. lieve1 = lieve1 et (lect (dime (tab1.evenements.ie1.temps)) * ie1) ;
  459. fin beve1 ;
  460. lpeve1 = posi ltqt1 dans lteve1 tol3 ;
  461. *list lteve1 ;
  462. *list lieve1 ;
  463. *list lpeve1 ;
  464. sino ;
  465. lpeve1 = lect (dime ltqt1) * 0 ;
  466. fins ;
  467.  
  468. * Sous-decoupage de l'historique de puissance :
  469. nb1 = dime ltqt1 ;
  470. t0 = extr ltqt1 1 ;
  471. q0 = extr lqqt1 1 ;
  472.  
  473. * Gestion evenements :
  474. peve0 = extr lpeve1 1 ;
  475. si (peve0 neg 0) ;
  476. neve0 = extr lieve1 peve0 ;
  477. si ((peve0 + 1) &lt;EG (dime lieve1)) ;
  478. neve1 = extr lieve1 (peve0 + 1) ;
  479. sino ;
  480. neve1 = -1 ;
  481. fins ;
  482. idtev1 = neve0 ega neve1 ;
  483. si idtev1 ;
  484. tev1 = lteve1 extr (peve0 + 1) ;
  485. dtev1 = tev1 - t0 ;
  486. *mess (chai 'Even. = ' neve0 ', dtev1 =' dtev1) ;
  487. fins ;
  488. sino ;
  489. idtev1 = faux ;
  490. fins ;
  491.  
  492. * Boucle sur les piquets de temps :
  493. ltca1 = prog t0 ;
  494. repe b1 (nb1 - 1) ;
  495. ip1 = &b1 + 1 ;
  496. t1 = extr ltqt1 ip1 ;
  497. q1 = extr lqqt1 ip1 ;
  498. peve1 = extr lpeve1 ip1 ;
  499. dt1 = t1 - t0 ;
  500. dtca1 = ipol evdtca1 t0 ;
  501. si (&b1 ega 1) ; dt0 = dt1 ; fins ;
  502. * Avec evements :
  503. si idtev1 ;
  504. si (dt1 &lt;EG dtca1) ;
  505. si (dtev1 &lt;EG dtca1) ;
  506. si (dt1 ega dtev1 tol3) ;
  507. ltca1 = ltca1 et (prog t1) ;
  508. sino ;
  509. si (dt1 < dtev1) ;
  510. ltca1 = ltca1 et (prog t1) et (prog tev1) ;
  511. t1 = tev1 ;
  512. sino ;
  513. ltca1 = ltca1 et (prog tev1) et (prog t1) ;
  514. fins ;
  515. fins ;
  516. sino ;
  517. ltca1 = ltca1 et (prog t1) ;
  518. si ((q0 > tol2) ou (q1 > tol2)) ;
  519. ltca1 = ltca1 et ((prog t1 pas dtca1 tev1) enle 1) ;
  520. sino ;
  521. ltca1 = ltca1 et ((prog t1 pas dt1 geom 2. tev1) enle 1) ;
  522. fins ;
  523. t1 = tev1 ;
  524. fins ;
  525. sino ;
  526. si (dt1 ega dtev1 tol3) ;
  527. si ((q0 > tol2) ou (q1 > tol2)) ;
  528. ltca1 = ltca1 et ((prog t0 pas dtca1 t1) enle 1) ;
  529. sino ;
  530. ltca1 = ltca1 et ((prog t0 pas dtev1 geom 2. t1) enle 1) ;
  531. fins ;
  532. sino ;
  533. si (dtev1 < dt1) ;
  534. si (dtev1 < dtca1) ;
  535. ltca1 = ltca1 et (prog tev1) ;
  536. sino ;
  537. si ((q0 > tol2) ou (q1 > tol2)) ;
  538. *mess '############ Ici 1' ;
  539. ltca1 = ltca1 et ((prog t0 pas dtca1 tev1) enle 1) ;
  540. ltca1 = ltca1 et ((prog tev1 pas dtca1 t1) enle 1) ;
  541. sino ;
  542. ltca1 = ltca1 et (prog tev1 pas dtev1 geom 2. t1) ;
  543. fins ;
  544. fins ;
  545. sino ;
  546. si ((q0 > tol2) ou (q1 > tol2)) ;
  547. *mess '############ Ici 2' ;
  548. ltca1 = ltca1 et ((prog t0 pas dtca1 tev1) enle 1) ;
  549. sino ;
  550. ltca1 = ltca1 et ((prog t0 pas dt0 geom 2. tev1) enle 1) ;
  551. fins ;
  552. t1 = tev1 ;
  553. fins ;
  554. fins ;
  555. fins ;
  556. * Pas d'evenement :
  557. sino ;
  558. si (dt1 &lt;EG dtca1) ;
  559. ltca1 = ltca1 et (prog t1) ;
  560. sino ;
  561. si ((q0 > tol2) ou (q1 > tol2)) ;
  562. ltca1 = ltca1 et ((prog t0 pas dtca1 t1) enle 1) ;
  563. sino ;
  564. ltca1 = ltca1 et ((prog t0 pas dt0 geom 2. t1) enle 1) ;
  565. fins ;
  566. fins ;
  567. fins ;
  568. t0 = t1 ;
  569. q0 = q1 ;
  570. ntca1 = dime ltca1 ;
  571. dt0 = (ltca1 extr ntca1) - (ltca1 extr (ntca1-1)) ;
  572. * Gestion evenement suivant :
  573. peve0 = peve1 ;
  574. si (peve0 neg 0) ;
  575. neve0 = extr lieve1 peve0 ;
  576. si ((peve0 + 1) &lt;EG (dime lieve1)) ;
  577. neve1 = extr lieve1 (peve0 + 1) ;
  578. sino ;
  579. neve1 = -1 ;
  580. fins ;
  581. idtev1 = neve0 ega neve1 ;
  582. si idtev1 ;
  583. tev1 = lteve1 extr (peve0 + 1) ;
  584. dtev1 = tev1 - t0 ;
  585. *mess (chai 'Even. = ' neve0 ', dtev1 =' dtev1) ;
  586. fins ;
  587. sino ;
  588. idtev1 = faux ;
  589. fins ;
  590. fin b1 ;
  591.  
  592. * Raffinement si pas > flot5 (option TEMP MAXI) :
  593. si imot5 ;
  594. ltca1 = ltca1 raff flot5 ;
  595. fins ;
  596.  
  597. * Verification si liste temps calcules bien ordonnee :
  598. ltca2 = ordo ltca1 ;
  599. si (((ltca2 - ltca1) maxi abs) > (1.e-3*dtca1)) ;
  600. erre '***** La liste des TEMPS_CALCULES est mal ordonnee' ;
  601. quit waam ;
  602. fins ;
  603.  
  604. tab2.temps_calcules = ltca1 ;
  605.  
  606. * Sorties si evenements :
  607. si ieve1 ;
  608. tab2.temps_evenements = lteve1 ;
  609. tab2.index_evenements = lieve1 ;
  610. fins ;
  611.  
  612. * Fin sous-option TEMP :
  613. fins ;
  614.  
  615. resp tab2 ;
  616. quit waam ;
  617. * Fin option MAILLAGE :
  618. fins ;
  619.  
  620. *----------------------------------------------------------------------*
  621. * Option VISU *
  622. *----------------------------------------------------------------------*
  623.  
  624. si (ega mot1 'VISU') ;
  625. icas1 = 2 ;
  626. *
  627. * Lecture MOT CACH / FACE :
  628. argu mot1/'MOT' ;
  629. si (exis mot1) ;
  630. cle1 = text mot1 ;
  631. sino ;
  632. cle1 = text ' ' ;
  633. fins ;
  634.  
  635. * Lecture maillage complementaire a afficher :
  636. argu mail2/maillage ;
  637. si (non (exis mail2)) ;
  638. mail2 = vide maillage ;
  639. fins ;
  640.  
  641. mail1 = tab1.maillage ;
  642. tmai1 = tab1.evolution_maillage.maillage ;
  643. dep0 = manu chpo (mail1 et mail2) 3 ux 0 uy 0 uz 0 ;
  644. def0 = vide deforme ;
  645. i1 = 0 ;
  646. repe b2 (dime tmai1) ;
  647. maili1 = tmai1.i1 ;
  648. maili1 = maili1 et mail2 ;
  649. defi1 = defo maili1 dep0 0. ;
  650. def0 = def0 et defi1 ;
  651. i1 = i1 + 1 ;
  652. fin b2 ;
  653. trac cle1 anim def0 ;
  654.  
  655. quit waam ;
  656. * Fin option VISU :
  657. fins ;
  658.  
  659. *----------------------------------------------------------------------*
  660. * Option MACRO
  661. *----------------------------------------------------------------------*
  662.  
  663. si (ega mot1 'MACRO') ;
  664. icas1 = 3 ;
  665.  
  666. *----------------- Lecture des arguments de l'option ------------------*
  667.  
  668. imot1 = faux ; comm mot-cle LONG ;
  669. imot2 = faux ; comm mot-cle LARG ;
  670. imot3 = faux ; comm mot-cle HAUT ;
  671. imot4 = faux ; comm mot-cle DENS ;
  672. imot5 = faux ; comm mot-cle TEMP ;
  673. imot6 = faux ; comm mot-cle MAXI ;
  674. repe b1 10 ; comm volontairement superieur au nombre de mot-cle ;
  675. argu moti1/'MOT' ;
  676. si (non (exis moti1)) ; quit b1 ; fins ;
  677.  
  678. * Arguments option MACRO :
  679. si (ega moti1 'LONG' 4) ;
  680. imot1 = vrai ;
  681. argu long1*'FLOTTANT' ;
  682. long1 = prog long1 ;
  683. npas1 = 1 ;
  684. fins ;
  685. si (ega moti1 'LARG' 4) ;
  686. imot2 = vrai ;
  687. argu larg1*'FLOTTANT' ;
  688. fins ;
  689. si (ega moti1 'HAUT' 4) ;
  690. imot3 = vrai ;
  691. argu enti1*'ENTIER' ;
  692. fins ;
  693. si (ega moti1 'DENS' 4) ;
  694. imot4 = vrai ;
  695. argu dens1*'FLOTTANT' ;
  696. fins ;
  697.  
  698. * Arguments sous-option TEMP :
  699. si (ega moti1 'TEMP' 4) ;
  700. imot5 = vrai ;
  701. * argu flot4/'FLOTTANT' ;
  702. * si (non (exis flot4)) ;
  703. * flot4 = 0.1 ;
  704. * fins ;
  705. * fins ;
  706. * si (ega moti1 'MAXI' 4) ;
  707. argu mot6*'MOT' ;
  708. si (neg mot6 'MAXI') ;
  709. erre ' ***** On attend le mot-cle MAXI' ;
  710. fins ;
  711. imot6 = vrai ;
  712. argu flot5*'FLOTTANT' ;
  713. fins ;
  714. fin b1 ;
  715.  
  716. * Analyse arguments lus :
  717. * iltot1 : indicateur maillage de toute la longeur de la passe :
  718. si (non imot2) ;
  719. si (non (exis tab1 'PASSES')) ;
  720. erre '***** ERREUR : il manque la donnee de la LARGeur du depot' ;
  721. fins ;
  722. fins ;
  723. si (non imot3) ;
  724. enti1 = 1 ;
  725. fins ;
  726. si (non imot4) ;
  727. dens1 = tab1 . passes . 1 . largeur ; comm pour calcul tolerance geom. ;
  728. fins ;
  729. si (non imot5) ;
  730. * flot4 = 0.1 ;
  731. imot5 = vrai ;
  732. fins ;
  733.  
  734. *list long1 ; list larg1 ; list dens1 ; list enti1 ; list flot5 ;
  735.  
  736. *--------------------- MAILLAGE des macro-depots ----------------------*
  737.  
  738. si (non (exis tab1 passes)) ;
  739. erre '***** ERREUR : la table de SOUDAGE en entree n"a pas d''indice PASSES' ;
  740. quit waam ;
  741. fins ;
  742.  
  743. * Definition d'une tolerance geometrique :
  744. tol1 = 1.e-4 * dens1 ;
  745.  
  746. * Appareillement des passes superposees (couches) :
  747. * mtraj1 = tab1.trajectoire ; comm pour affichage et debugage ;
  748. * tgroup1 : table contenant des groupes de passes superposees
  749. tgroup1 = table ;
  750. lsaut1 = lect ; comm liste des passes identifiees dans un groupe ;
  751. nbp1 = dime tab1 . passes ;
  752. repe bp1 nbp1 ;
  753. ip1 = &bp1 ;
  754. si (dans (lect ip1) lsaut1) ; iter bp1 ; fins ;
  755.  
  756. * Initialisation nouveau groupe de passes superposees :
  757. elpi1 = tab1 . passes . ip1 . maillage ;
  758. tgroup1 . ip1 = lect ip1 ;
  759. lsaut1 = lsaut1 et ip1 ;
  760. * lgroup1 = elpi1 ; comm pour affichage et debugage ;
  761.  
  762. si (enti1 ega 1) ; iter bp1 ; fins ;
  763. si (ip1 ega nbp1) ; quit bp1 ; fins ;
  764.  
  765. * Recherche couche suivante :
  766. ip2 = ip1 ;
  767. nc1 = tab1 . passes . ip1 . couche ;
  768. nbc1 = mini (lect (enti1 - 1) (nbp1 - ip1)) ;
  769. repe bc1 nbc1 ;
  770. nc1 = nc1 + 1 ;
  771. pi1 = elpi1 poin 1 ;
  772. pi2 = elpi1 poin (nbno elpi1) ;
  773. nbp2 = nbp1 - ip2 ;
  774. si (nbp2 ega 0) ; quit bc1 ; fins ;
  775. repe bp2 nbp2 ;
  776. ip2 = ip2 + 1 ;
  777. nc2 = tab1 . passes . ip2 . couche ;
  778. si (nc2 ega nc1) ;
  779. elpi2 = tab1 . passes . ip2 . maillage ;
  780. pi3 = elpi2 poin proc pi1 ;
  781. pi4 = elpi2 poin proc pi2 ;
  782. vitei2 = tab1 . passes . ip2 . vitesse ;
  783. debii2 = tab1 . passes . ip2 . debit ;
  784. largi2 = tab1 . passes . ip2 . largeur ;
  785. epc2 = debii2 / vitei2 / largi2 ;
  786. dmaxi2 = maxi (prog (norm (pi3 moin pi1)) (norm (pi4 moin pi2))) ;
  787. *mess 'epc2 =' epc2 ; list dmaxi2 ; trac (lgroup1 et (elpi2 coul or) et (mtraj1 coul blan)) ;
  788. si ((abs (dmaxi2 - epc2)) &lt;EG (0.01 * epc2)) ;
  789. tgroup1 . ip1 = tgroup1 . ip1 et ip2 ;
  790. lsaut1 = lsaut1 et ip2 ;
  791. * lgroup1 = lgroup1 et elpi2 ;
  792. quit bp2 ;
  793. fins ;
  794. fins ;
  795. fin bp2 ;
  796. elpi1 = elpi2 ;
  797. fin bc1 ;
  798. *trac (lgroup1 et (mtraj1 chan poi1)) ;
  799.  
  800. fin bp1 ;
  801.  
  802. * Initialisattion sorties (MACRO) :
  803. tab2 = table ;
  804. ttps1 = table ;
  805. tmai1 = table ;
  806. indi1 = 0 ;
  807.  
  808. * Boucle sur elements de la trajectoire :
  809. mtraj1 = tab1.trajectoire ;
  810. mail2 = vide maillage ;
  811. idebui1 = vrai ;
  812. ibouci1 = faux ;
  813. lsaut1 = lect ; comm liste des passes deja maillees ;
  814. nb1 = nbel mtraj1 ;
  815. repe b1 nb1 ;
  816.  
  817. * Lecture ieme element de la trajectoire :
  818. eli1 = mtraj1 elem &b1 ;
  819. Pi1 = eli1 poin 1 ;
  820. Pi2 = eli1 poin 2 ;
  821. vai1 = Pi2 moin Pi1 ;
  822. vni1 = vai1 / (norm vai1) ;
  823. mcouli1 = (eli1 elem coul) extr 1 ;
  824. imaili1 = ega mcouli1 'ROUG' ;
  825. idepli1 = ega mcouli1 'VERT' ;
  826.  
  827. si (non imot1) ;
  828. long1 = prog (mesu eli1) ;
  829. npas1 = 1 ;
  830. fins ;
  831. *
  832. * Segment VERT : deplacement
  833. si idepli1 ;
  834. idebui1 = vrai ;
  835. ibouci1 = faux ;
  836. iter b1 ;
  837. fins ;
  838. *
  839. * Segment ROUGE : maillage
  840. si imaili1 ;
  841.  
  842. * Si debut nouvelle passe :
  843. si idebui1 ;
  844.  
  845. * Identification de la passe :
  846. npassi1 = 0 ;
  847. nbp1 = dime tab1.passes ;
  848. repe bp1 nbp1 ;
  849. mailpss1 = (tab1.passes.&bp1).maillage ;
  850. si ((dans pi1 mailpss1) et (dans pi2 mailpss1)) ;
  851. tpassi1 = tab1.passes.&bp1 ;
  852. npassi1 = &bp1 ;
  853. quit bp1 ;
  854. fins ;
  855. fin bp1 ;
  856. si (dans (lect npassi1) lsaut1) ;
  857. iter b1 ;
  858. fins ;
  859.  
  860. * Affichage :
  861. si (npassi1 ega 0) ;
  862. erre '***** WAAM : passe non identifiee' ;
  863. sino ;
  864. mess '***** WAAM : maillage de la passe :' npassi1 ;
  865. lsaut1 = lsaut1 et tgroup1 . npassi1 ;
  866. fins ;
  867.  
  868. * Hauteur de cordon :
  869. haut1 = 0. ;
  870. hautp1 = 0. ;
  871. lpassi1 = tgroup1 . npassi1 ;
  872. nbgrp1 = mini (lect enti1 (dime lpassi1)) ;
  873. repe bgrp1 nbgrp1 ;
  874. ipassi1 = extr lpassi1 &bgrp1 ;
  875. debii1 = tab1 . passes . ipassi1 . debit ;
  876. vitei1 = tab1 . passes . ipassi1 . vitesse ;
  877. largi1 = tab1 . passes . ipassi1 . largeur ;
  878. haut1 = debii1 / vitei1 / largi1 + haut1 ;
  879. si (&bgrp1 ega 1) ; hautp1 = haut1 ; fins ;
  880. fin bgrp1 ;
  881. mess (chai '***** WAAM : hauteur du macro-depot :' npassi1 ' =' haut1) ;
  882.  
  883. * Maillage :
  884. * si1 : maillage section courante :
  885. * vnsi1 : normale a la section
  886. largi1 = tab1 . passes . npassi1 . largeur ;
  887. si (non imot4) ;
  888. dens1 = largi1 ;
  889. fins ;
  890. lsi1 = (0 0 0) droi (0 largi1 0) dini dens1 dfin dens1 ;
  891. si1 = lsi1 tran (0 0 haut1) dini dens1 dfin dens1 ;
  892. vnsi1 = 1 0 0 ;
  893.  
  894. * Positionnement extremite initiale (Pi1 au centre de l'arete superieure) :
  895. Pmsup1 = 0 (0.5*largi1) haut1 ;
  896. Prefi1 = Pi1 moin (0 0 hautp1) plus (0 0 haut1) ;
  897. si1 = si1 plus (Prefi1 moin Pmsup1) ;
  898.  
  899. *si (&b1 neg 1) ; trac qual (si1 et mail2 et mtraj1) ; fins ;
  900.  
  901. * Initialisation section extremite finale :
  902. si2 = si1 plus vai1 ;
  903. vnsi2 = vnsi1 ;
  904. angl2 = 0. ;
  905. *
  906. * Orientation sections de maillage :
  907. * Par defaut, selon vni1 :
  908. vnsmai1 = vni1 ;
  909. vnsmai2 = vnsmai1 ;
  910.  
  911. * Detection suite segments rouges et boucle :
  912. tpsi2 = tpassi1.instants extr 1 ;
  913. dtc1 = tab1 . temps_de_coupure ;
  914. si (indi1 neg 0) ;
  915. dtpassi1 = tpsi2 - (tab1.passes.(npassi1-1).instants extr 2) - (1. * dtc1) ;
  916. tpsi2 = (ttps1 . (indi1 - 1)) + dtpassi1 ;
  917. *mess 'tpsi2 =' tpsi2 ;
  918. fins ;
  919. tpsi22 = tpassi1.instants extr 2 ;
  920. si (&b1 neg nb1) ;
  921. elip1 = mtraj1 elem (&b1 + 1) ;
  922. mcoulip1 = (elip1 elem coul) extr 1 ;
  923. isuiti1 = ega mcoulip1 'ROUG' ;
  924. isuiti2 = non (vide (elip1 inte mailpss1)) ;
  925. si (npassi1 neg nbp1) ;
  926. isuiti2 = isuiti2 ou (ega tpsi22 (tab1.passes.(npassi1+1).instants extr 1)) ;
  927. fins ;
  928. isuiti1 = isuiti1 et isuiti2 ;
  929. si isuiti1 ;
  930. vai2 = (elip1 poin 2) moin (elip1 poin 1) ;
  931. vni2 = vai2 / (norm vai2) ;
  932. vasmai2 = vni1 plus vni2 ;
  933. vnsmai2 = vasmai2 / (norm vasmai2) ;
  934. elfini1 = elip1 ;
  935. pfini1 = elip1 poin 2 ;
  936. nb2 = nb1 - (&b1 + 1) ;
  937. i2 = &b1 + 2 ;
  938. * Rq : si nb2 = 0, le bloc n'est pas execute
  939. repe b2 nb2 ;
  940. eli2 = mtraj1 elem i2 ;
  941. mcoul2 = (eli2 elem coul) extr 1 ;
  942. si (neg mcoul2 'ROUG') ; quit b2 ; fins ;
  943. pfini1 = eli2 poin 2 ;
  944. elfini1 = eli2 ;
  945. vafini1 = pfini1 moin (eli2 poin 1) ;
  946. vnfini1 = vafini1 / (norm vafini1) ;
  947. i2 = i2 + 1 ;
  948. fin b2 ;
  949. ibouci1 = (norm (pfini1 moin pi1)) < tol1 ;
  950. si ibouci1 ;
  951. mess '***** WAAM : boucle fermee detectee' ;
  952. * On definit la normale a la section de maillage (SMA) :
  953. vasmai1 = vni1 plus vnfini1 ;
  954. vnsmai1 = vasmai1 / (norm vasmai1) ;
  955. fins ;
  956. fins ;
  957. fins ;
  958.  
  959. * Orientation de si1 selon vnsmai1 :
  960. *list vnsmai1 ; list vnsi1 ;
  961. *trac (0 -0 3) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2) ;
  962. vnnz1 = pvec vnsi1 vnsmai1 ;
  963. lvnnz1 = norm vnnz1 ;
  964. * Si sinus non nul a tol1 pres, on oriente la section :
  965. si (lvnnz1 neg 0. (tol1 / dens1)) ;
  966. si (lvnnz1 ega 1. (vale prec)) ; lvnnz1 = 1. ; fins ;
  967. angl1 = asin lvnnz1 ;
  968. *list vnsi1 ; list vnsmai1 ; list angl1 ;
  969. si ((psca vnsmai1 vnsi1) < 0.) ;
  970. angl1 = 180. - angl1 ;
  971. *mess ' on prend (180.-angl1)' ;
  972. fins ;
  973. si1 = si1 tour angl1 pi1 (pi1 plus vnnz1) ;
  974. vnsi1 = vnsmai1 ;
  975. si2 = si1 plus vai1 ;
  976. vnsi2 = vnsi1 ;
  977. angl2 = 0. ;
  978. sino ;
  979. si ((psca vnsmai1 vnsi1) < 0.) ;
  980. vnsi1 = vnsmai1 ;
  981. si2 = si1 plus vai1 ;
  982. vnsi2 = vnsi1 ;
  983. angl2 = 0. ;
  984. fins ;
  985. fins ;
  986. *list vnsi1 ; list angl1 ;
  987. titr 'Debut de passe, apres orientation de si1' ;
  988. *trac (0 0 100) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2) ;
  989.  
  990. * Si boucle, on garde la section de maillage du debut :
  991. si ibouci1 ;
  992. sfini1 = si1 ;
  993. vnfini1 = vnsmai1 ;
  994. fins ;
  995.  
  996. sino ;
  997.  
  998. * On a deja si1 correctement orientee.
  999. * On doit orienter si2.
  1000. * Par defaut, orientation de si1 :
  1001. si2 = si1 plus vai1 ;
  1002. vnsi2 = vnsi1 ;
  1003. angl2 = 0. ;
  1004. vnsmai2 = vnsi2 ;
  1005.  
  1006. * Identification et enregitrement de la passe :
  1007. npassi1 = 0 ;
  1008. nbp1 = dime tab1.passes ;
  1009. repe bp1 nbp1 ;
  1010. mailpss1 = (tab1.passes.&bp1).maillage ;
  1011. si ((dans pi1 mailpss1) et (dans pi2 mailpss1)) ;
  1012. npassi1 = &bp1 ;
  1013. quit bp1 ;
  1014. fins ;
  1015. fin bp1 ;
  1016. lsaut1 = lsaut1 et tgroup1 . npassi1 ;
  1017.  
  1018. * Si fin d'une boucle, orientation si2 connue :
  1019. si (ibouci1 et (pi2 ega pfini1)) ;
  1020. vnsmai2 = vnfini1 ;
  1021. sino ;
  1022. si (&b1 neg nb1) ;
  1023. elip1 = mtraj1 elem (&b1 + 1) ;
  1024. mcoulip1 = (elip1 elem coul) extr 1 ;
  1025. isuiti1 = ega mcoulip1 'ROUG' ;
  1026. si isuiti1 ;
  1027. vai2 = (elip1 poin 2) moin (elip1 poin 1) ;
  1028. vni2 = vai2 / (norm vai2) ;
  1029. vasmai2 = vni1 plus vni2 ;
  1030. vnsmai2 = vasmai2 / (norm vasmai2) ;
  1031. fins ;
  1032. fins ;
  1033. fins ;
  1034.  
  1035. * Fin "Si idebui1 / sinon" :
  1036. fins ;
  1037. *
  1038. * Orientation de si2 selon vnsmai2 :
  1039. *list vnsmai2 ; list vnsi2 ;
  1040. *trac (0 0 100) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2 et (pi1 droi 1 (pi1 plus (0.01*vnsi1))) et (pi2 droi 1 (pi2 plus (0.01*vnsi2)))) titr 'Avant orientation si2' ;
  1041. vnnz1 = pvec vnsi2 vnsmai2 ;
  1042. lvnnz1 = norm vnnz1 ;
  1043. * Si sinus non nul a tol1 pres, on oriente la section :
  1044. si (lvnnz1 neg 0. (tol1 / dens1)) ;
  1045. si (lvnnz1 ega 1. (vale prec)) ; lvnnz1 = 1. ; fins ;
  1046. angl2 = asin lvnnz1 ;
  1047. si ((psca vnsi2 vnsmai2) < 0.) ;
  1048. *mess ' on prend (180.-angl2)' ; saut 1 lign ;
  1049. angl2 = 180. - angl2 ;
  1050. fins ;
  1051. si2 = si2 tour angl2 pi2 (pi2 plus vnnz1) ;
  1052. vnsi2 = vnsi2 tour angl2 (0 0 0) vnnz1 ;
  1053. sino ;
  1054. * Pas sur que ça serve a quelque chose...
  1055. si ((psca vnsi2 vnsmai2) < 0.) ;
  1056. vnsi2 = vnsmai2 ;
  1057. angl2 = 180. ;
  1058. fins ;
  1059. fins ;
  1060. *titr 'En cours de passe, apres orientation de si2' ;
  1061. *trac (0 0 100) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et pi1 et pi2 et (pi1 droi 1 (pi1 plus (0.01*vnsi1))) et (pi2 droi 1 (pi2 plus (0.01*vnsi2)))) ;
  1062. *si (ibouci1 et (pi2 ega pfini1)) ;
  1063. *trac (5 -2 3) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et (si22 coul oran) et pi1 et pi2) ;
  1064. *fins ;
  1065.  
  1066. *---- Maillage du segment :
  1067.  
  1068. llong1 = somm (long1 enle npas1) ;
  1069. leli1 = mesu eli1 ;
  1070. si (leli1 &lt;EG llong1) ;
  1071. erre '***** ERREUR : somme pas de discretisation > long. ' &b1 'e passe' ;
  1072. quit waam ;
  1073. fins ;
  1074.  
  1075. * Boucle sur les pas de discretisation :
  1076.  
  1077. * pasi1 : pas de discretisation courant
  1078. * nei1 : nb maillages pour ce pas de discretisation du segment
  1079. * pami1 : pas de maillage courant
  1080. * nei2 : nbel crees par pas de maillage
  1081.  
  1082. idebui1 = non isuiti1 ;
  1083. pi11 = pi1 ;
  1084. repe bp1 npas1 ;
  1085. pasi1 = extr long1 &bp1 ;
  1086. si (&bp1 neg npas1) ;
  1087. nei1 = 1 ;
  1088. pami1 = pasi1 ;
  1089. sino ;
  1090. llmi1 = leli1 - llong1 ;
  1091. nei1 = llmi1 / pasi1 + 0.5 ;
  1092. nei1 = maxi (lect (enti nei1) 1) ;
  1093. *mess 'nei1=' nei1 ;
  1094. pami1 = llmi1 / (flot nei1) ;
  1095. fins ;
  1096.  
  1097. vtrani1 = pami1 * vni1 ;
  1098. ltrani1 = norm vtrani1 ;
  1099. nei2 = enti (ltrani1 / dens1 + 0.5) ;
  1100. nei2 = maxi (lect (enti nei2) 1) ;
  1101. *mess 'nei2=' nei2 ;
  1102. itouri1 = (abs angl2) > 0. ;
  1103. *list itouri1 ;
  1104. *list angl2 ;
  1105. angli2 = angl2 / (flot nei1) ;
  1106. vnsi22 = vnsi1 ;
  1107. si22 = si1 ;
  1108. dti2 = ltrani1 / vitei1 ;
  1109. repe b2 nei1 ;
  1110. pi22 = pi11 plus vtrani1 ;
  1111. si itouri1 ;
  1112. vnsi22 = vnsi22 tour angli2 (0 0 0) vnnz1 ;
  1113. pi33 = pi22 plus vnnz1 ;
  1114. pi44 = pi22 plus (pvec vnsi22 vnnz1) ;
  1115. si22 = si22 proj dire vtrani1 plan pi22 pi33 pi44 ;
  1116. sino ;
  1117. si22 = si1 plus vtrani1 ;
  1118. fins ;
  1119. maili2 = si1 volu si22 nei2 ;
  1120. si1 = si22 ;
  1121. pi11 = pi22 ;
  1122. maili2 = maili2 coul (indi1+1) ;
  1123. mail2 = mail2 et maili2 ;
  1124. tmai1 . indi1 = mail2 ;
  1125. ttps1 . indi1 = tpsi2 ;
  1126. tpsi2 = tpsi2 + dti2 + dtc1 ;
  1127. indi1 = indi1 + 1 ;
  1128. fin b2 ;
  1129.  
  1130. fin bp1 ;
  1131.  
  1132. *trac (5 -2 3) (mtraj1 et mail2 et (si1 coul rose) et (si2 coul turq) et (si22 coul oran) et pi1 et pi2) ;
  1133.  
  1134. vnsi1 = vnsi2 ;
  1135. vnsmai1 = vnsmai2 ;
  1136.  
  1137. * Fin si imail1 (segment rouge) ;
  1138. sino ;
  1139. erre '***** ERREUR : pb definition trajectoire, couleur segment inconnue' ;
  1140. quit waam ;
  1141. fins ;
  1142.  
  1143. * Fin boucle segments trajectoire
  1144. fin b1 ;
  1145. elim mail2 tol1 ;
  1146.  
  1147. * Verification list des temps de tttps1 bien ordonnee :
  1148. ltps1 = prog table ttps1 ;
  1149. ltps2 = ordo ltps1 ;
  1150. si (((ltps2 - ltps1) maxi abs) > (1.e-3 * dti2)) ;
  1151. erre '***** la liste des TEMPS de l''evolution du maillage est mal ordonnee' ;
  1152. fins ;
  1153. * Enregistrement des sorties :
  1154. tab2.maillage = mail2 ;
  1155. tab2.evolution_maillage = table ;
  1156. tab2.evolution_maillage.temps = ttps1 ;
  1157. tab2.evolution_maillage.maillage = tmai1 ;
  1158.  
  1159. *--------------------------- TEMPS_CALCULES ---------------------------*
  1160.  
  1161. nbt1 = dime ttps1 ;
  1162. ltca1 = prog ;
  1163. repe bt1 nbt1 ;
  1164. tps0 = ttps1 . (&bt1 - 1) ;
  1165. si (&bt1 neg nbt1) ;
  1166. tps1 = (ttps1 . &bt1) - dtc1 ;
  1167. sino ;
  1168. tps1 = (tab1 . evolution_puissance extr absc) maxi ;
  1169. fins ;
  1170. si (tps1 < tps0) ;
  1171. * mess 'tps0 =' tps0 ;
  1172. * mess 'tps1 =' tps1 ;
  1173. erre ' ***** Erreur dans le calcul de la liste des TEMPS_CALCULES' ;
  1174. fins ;
  1175. ltcai1 = prog tps0 pas dtc1 geom 2 tps1 ;
  1176. ltca1 = ltca1 et ltcai1 ;
  1177. fin bt1 ;
  1178.  
  1179. * Raffinement si pas > flot5 (option TEMP MAXI) :
  1180. si imot6 ;
  1181. ltca1 = ltca1 raff flot5 ;
  1182. fins ;
  1183.  
  1184. * Verification si liste temps calcules bien ordonnee :
  1185. ltca2 = ordo ltca1 ;
  1186. si (((ltca2 - ltca1) maxi abs) > (1.e-3 * dtc1)) ;
  1187. erre '***** La liste des TEMPS_CALCULES est mal ordonnee' ;
  1188. quit waam ;
  1189. fins ;
  1190. tab2.temps_calcules = ltca1 ;
  1191.  
  1192. resp tab2 ;
  1193. quit waam ;
  1194. * Fin option MACRO-DEPOT :
  1195. fins ;
  1196.  
  1197. *----------------------------------------------------------------------*
  1198. * FIN *
  1199. *----------------------------------------------------------------------*
  1200. *
  1201. * MOT1 n'est pas un des mots-cles des options de la procedure :
  1202. si (icas1 ega 0) ;
  1203. erre '***** ERREUR WAAM : MOT-cle option WAAM non reconnu.' ;
  1204. quit waam ;
  1205. fins ;
  1206.  
  1207. FINP ;
  1208.  
  1209.  
  1210.  
  1211.  
  1212.  
  1213.  

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