Télécharger soudage.procedur

Retour à la liste

Numérotation des lignes :

  1. * SOUDAGE PROCEDUR PASCAL 21/04/13 21:15:13 10957
  2. DEBP SOUDAGE TAB1*'TABLE' ;
  3.  
  4. *--------------- Lecture des arguments d'entree globaux ---------------*
  5. *
  6. si (non (exis tab1 'VITESSE_DE_SOUDAGE')) ;
  7. erre '***** ERREUR : VITESSE_DE_SOUDAGE non definie.' ;
  8. quit soudage ;
  9. fins ;
  10. si (non (exis tab1 'PUISSANCE_DE_SOUDAGE')) ;
  11. erre '***** ERREUR : PUISSANCE_DE_SOUDAGE non definie.' ;
  12. quit soudage ;
  13. fins ;
  14.  
  15. * Diametre, vitesse et debit de fil :
  16. si (exis tab1 'DIAMETRE_DE_FIL') ;
  17. dfil1 = tab1.diametre_de_fil ;
  18. vfil1 = tab1.vitesse_de_fil ;
  19. debi1 = pi * dfil1 * dfil1 * 0.25 * vfil1 ;
  20. tab1.debit_de_fil = debi1 ;
  21. fins ;
  22. si (non (exis tab1 'DEBIT_DE_FIL')) ;
  23. erre '***** ERREUR : DEBIT_DE_FIL non defini.' ;
  24. quit soudage ;
  25. fins ;
  26.  
  27. * Vitesse de deplacement :
  28. si (non (exis tab1 'VITESSE_DE_DEPLACEMENT')) ;
  29. tab1.vitesse_de_deplacement = tab1.vitesse_de_soudage ;
  30. fins ;
  31.  
  32. * Point de depart :
  33. Si (non (exis tab1 'POINT_DE_DEPART')) ;
  34. P1 = 0 0 0 ;
  35. tab1.point_de_depart = P1 ;
  36. fins ;
  37.  
  38. * Temps de coupure :
  39. si (non (exis tab1 'TEMPS_DE_COUPURE')) ;
  40. tab1.temps_de_coupure = 0.1 ;
  41. fins ;
  42.  
  43. *-------------------------- Initialisations ---------------------------*
  44.  
  45. * Test dimension 3 :
  46. si ((vale dime) neg 3) ;
  47. erreur '***** SOUDAGE : fonctionne uniquement en dimension 3' ;
  48. quit soudage ;
  49. fins ;
  50.  
  51. * Indicateur 1er appel a soudage :
  52. si (exis tab1 'TRAJECTOIRE') ;
  53. idebut1 = faux ;
  54. sino ;
  55. idebut1 = vrai ;
  56. fins ;
  57.  
  58. * Indicateur changement de couche :
  59. si (non (exis tab1 'DEPLA_COUCHE')) ;
  60. tab1.depla_couche = faux ;
  61. fins ;
  62.  
  63. * icas1 = 1 / 2 / 3 pour POINT / PASSE / DEPLA
  64. * Si 0 in fine : erreur.
  65. icas1 = 0 ;
  66.  
  67. *------------------------- Lecture des options ------------------------*
  68.  
  69. argu MOT1*'MOT' ;
  70.  
  71. *----------------------------------------------------------------------*
  72. * Option POINT *
  73. *----------------------------------------------------------------------*
  74.  
  75. si (ega mot1 'POINT') ;
  76. icas1 = 1 ;
  77.  
  78. * Initialisation enregistrement donnees POINT :
  79. si (exis tab1 points) ;
  80. npt1 = dime tab1.points ;
  81. sino ;
  82. npt1 = 0 ;
  83. tab1.points = table ;
  84. fins ;
  85. npt1 = npt1 + 1 ;
  86. tab1.points.npt1 = table ;
  87. *
  88. * Lecture des arguments de l'option :
  89. argu FLOT1*'FLOTTANT' ;
  90.  
  91. * Trajectoire POINT :
  92. si idebut1 ;
  93. P1 = tab1.point_de_depart ;
  94. tab1.trajectoire = manu poi1 P1 ;
  95. fins ;
  96.  
  97. * Lecture Arguments PUIS, DEBI option POINT :
  98. imot2 = faux ; imot3 = faux ;
  99. repe b1 2 ;
  100. argu MOT2/'MOT' ;
  101. si (non (exis mot2)) ; quit B1 ; fins ;
  102. si (ega mot2 'PUIS') ;
  103. imot2 = vrai ;
  104. argu qtot1*'FLOTTANT' ;
  105. fins ;
  106. si (ega mot2 'DEBI') ;
  107. imot3 = vrai ;
  108. argu debi1*'FLOTTANT' ;
  109. fins ;
  110. fin b1 ;
  111. si (non imot2) ;
  112. qtot1 = tab1.puissance_de_soudage ;
  113. fins ;
  114. si (non imot3) ;
  115. debi1 = tab1.debit_de_fil ;
  116. fins ;
  117. *list qtot1 ;
  118. *list debi1 ;
  119. *list idebut1 ;
  120. *
  121. * Ajout ou pas du temps de coupure option POINT :
  122. idtcp1 = faux ;
  123. si ((non idebut1)) ;
  124. evqtot0 = tab1.evolution_puissance ;
  125. lqtot0 = extr evqtot0 ordo ;
  126. qtot0 = extr lqtot0 (dime lqtot0) ;
  127. idtcp1 = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ;
  128.  
  129. evdebi0 = tab1.evolution_debit ;
  130. ldebi0 = extr evdebi0 ordo ;
  131. debi0 = extr ldebi0 (dime ldebi0) ;
  132. idtcp1 = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ;
  133. fins ;
  134. si idtcp1 ;
  135. dtcp1 = tab1.temps_de_coupure ;
  136. flot1 = flot1 + dtcp1 ;
  137. fins ;
  138.  
  139. * Evolution puissance option POINT :
  140. si idebut1 ;
  141. ltps1 = prog 0. flot1 ;
  142. lqtot1 = prog qtot1 qtot1 ;
  143. lti1 = ltps1 ;
  144. sino ;
  145. evqtot0 = tab1.evolution_puissance ;
  146. ltps0 = extr evqtot0 absc ;
  147. lqtot0 = extr evqtot0 ordo ;
  148. tps0 = extr ltps0 (dime ltps0) ;
  149. qtot0 = extr lqtot0 (dime lqtot0) ;
  150. * Si la puissance indiquee est differente de celle existante :
  151. si ((abs(qtot0-qtot1)) > (abs(1.e-4*qtot1))) ;
  152. * Ajout temps de coupure au temps de realisation du POINT :
  153. ltps1 = prog (tps0 + dtcp1) (tps0 + flot1) ;
  154. lqtot1 = prog qtot1 qtot1 ;
  155. sino ;
  156. ltps1 = prog (tps0 + flot1) ;
  157. lqtot1 = prog qtot1 ;
  158. fins ;
  159. lti1 = prog tps0 (tps0 + flot1) ;
  160. ltps1 = ltps0 et ltps1 ;
  161. lqtot1 = lqtot0 et lqtot1 ;
  162. fins ;
  163. evqtot1 = evol roug manu temp ltps1 qtot lqtot1 ;
  164. tab1.evolution_puissance = evqtot1 ;
  165.  
  166. * Evolution debit POINT :
  167. si idebut1 ;
  168. ltps1 = prog 0. flot1 ;
  169. ldebi1 = prog debi1 debi1 ;
  170. sino ;
  171. evdebi0 = tab1.evolution_debit ;
  172. ltps0 = extr evdebi0 absc ;
  173. ldebi0 = extr evdebi0 ordo ;
  174. tps0 = extr ltps0 (dime ltps0) ;
  175. debi0 = extr ldebi0 (dime ldebi0) ;
  176. * Si la puissance indiquee est differente de celle existante :
  177. si ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ;
  178. * Ajout temps de coupure au temps de realisation du POINT :
  179. ltps1 = prog (tps0 + dtcp1) (tps0 + flot1) ;
  180. ldebi1 = prog debi1 debi1 ;
  181. lqi1 = prog 1. 1. ;
  182. sino ;
  183. ltps1 = prog (tps0 + flot1) ;
  184. ldebi1 = prog debi1 ;
  185. lqi1 = prog 1. ;
  186. fins ;
  187. ltps1 = ltps0 et ltps1 ;
  188. ldebi1 = ldebi0 et ldebi1 ;
  189. fins ;
  190. evdebi1 = evol roug manu temp ltps1 debi ldebi1 ;
  191. tab1.evolution_debit = evdebi1 ;
  192.  
  193. * Evolution deplacement POINT :
  194. si idebut1 ;
  195. ltps1 = prog 0. flot1 ;
  196. ldep1 = prog 0. 0. ;
  197. sino ;
  198. evdep0 = tab1.evolution_deplacement ;
  199. ltps0 = extr evdep0 absc ;
  200. ldep0 = extr evdep0 ordo ;
  201. tps0 = extr ltps0 (dime ltps0) ;
  202. dep0 = extr ldep0 (dime ldep0) ;
  203. ltps1 = prog (tps0 + flot1) ;
  204. ldep1 = prog dep0 ;
  205. ltps1 = ltps0 et ltps1 ;
  206. ldep1 = ldep0 et ldep1 ;
  207. fins ;
  208. evdep1 = evol vert manu temp ltps1 ldep1 ;
  209. tab1.evolution_deplacement = evdep1 ;
  210.  
  211. * Enregistrement donnees POINT
  212. tab1.points.npt1.point = P1 ;
  213. tab1.points.npt1.instants = lti1 ;
  214. tab1.points.npt1.puissance = qtot1 ;
  215. tab1.points.npt1.debit = debi1 ;
  216.  
  217. quit soudage ;
  218. * Fin option POINT :
  219. fins ;
  220.  
  221. *----------------------------------------------------------------------*
  222. * Option PASSE *
  223. *----------------------------------------------------------------------*
  224. si (ega mot1 'PASSE') ;
  225. icas1 = 2 ;
  226.  
  227. * Lecture des arguments de l'option :
  228. argu MOT2*'MOT' ;
  229.  
  230. * Triatement particulier option CERC ordre arguments :
  231. si (ega mot2 'CERC') ;
  232. argu N1/ENTIER ;
  233. fins ;
  234.  
  235. * Lecture arguments RELA/ABSO, VITE, PUIS, DEBI
  236. imot3 = faux ; imot4 = faux ; imot5 = faux ; imot6 = faux ;
  237. irela1 = vrai ;
  238. repe b1 4 ;
  239. argu mot3/'MOT' ;
  240. si (non (exis mot3)) ; quit b1; fins ;
  241. si (ega mot3 'ABSO') ;
  242. imot3 = vrai ;
  243. irela1 = faux ;
  244. fins ;
  245. si (ega mot3 'VITE') ;
  246. imot4 = vrai ;
  247. argu vdep1*'FLOTTANT' ;
  248. fins ;
  249. si (ega mot3 'PUIS') ;
  250. imot5 = vrai ;
  251. argu qtot1*'FLOTTANT' ;
  252. fins ;
  253. si (ega mot3 'DEBI') ;
  254. imot6 = vrai ;
  255. argu debi1*'FLOTTANT' ;
  256. fins ;
  257. fin b1 ;
  258.  
  259. * Si changement de COUCHE demande :
  260. si (tab1.depla_couche) ;
  261. tab1.depla_couche = faux ;
  262. * Epaisseur de la couche :
  263. si imot4 ;
  264. Vpf1 = vdep1 ;
  265. sino ;
  266. Vpf1 = tab1.vitesse_de_soudage ;
  267. fins ;
  268. si imot6 ;
  269. Dpf1 = debi1 ;
  270. sino ;
  271. Dpf1 = tab1.debit_de_fil ;
  272. fins ;
  273. Lpf1 = tab1.largeur_de_passe ;
  274. epf1 = Dpf1 / Vpf1 / Lpf1 ;
  275. * Pause :
  276. si (exis tab1 'DEPLA_PAUSE') ;
  277. tpf1 = tab1.depla_pause ;
  278. vdep2 = epf1 / tpf1 ;
  279. oubl tab1 depla_pause ;
  280. sino ;
  281. vdep2 = tab1.vitesse_de_deplacement ;
  282. fins ;
  283. soudage tab1 depla droi (0 0 epf1) vite vdep2 ;
  284. fins ;
  285.  
  286. * Vitesse & Increment de temps PASSE :
  287. si (non imot4) ;
  288. vdep1 = tab1.vitesse_de_soudage ;
  289. fins ;
  290.  
  291. * Puissance PASSE :
  292. si (non imot5) ;
  293. qtot1 = tab1.puissance_de_soudage ;
  294. fins ;
  295.  
  296. * Debit PASSE :
  297. si (non imot6) ;
  298. debi1 = tab1.debit_de_fil ;
  299. fins ;
  300. *list vdep1 ;
  301. *list qtot1 ;
  302. *list debi1 ;
  303.  
  304. * Ajout ou pas du temps de coupure option PASSE :
  305. idtcp1 = faux ;
  306. si ((non idebut1)) ;
  307. evqtot0 = tab1.evolution_puissance ;
  308. lqtot0 = extr evqtot0 ordo ;
  309. evdebi0 = tab1.evolution_debit ;
  310. ldebi0 = extr evdebi0 ordo ;
  311. qtot0 = extr lqtot0 (dime lqtot0) ;
  312. idtcp1 = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ;
  313. debi0 = extr ldebi0 (dime ldebi0) ;
  314. idtcp1 = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ;
  315. fins ;
  316. *list idtcp1 ;
  317. si idtcp1 ;
  318. dtcp1 = tab1.temps_de_coupure ;
  319. fins ;
  320.  
  321. * Initialisation enregistrement donnees PASSE :
  322. si (exis tab1 passes) ;
  323. nps1 = dime tab1.passes ;
  324. sino ;
  325. nps1 = 0 ;
  326. tab1.passes = table ;
  327. fins ;
  328. nps1 = nps1 + 1 ;
  329. tab1.passes.nps1 = table ;
  330.  
  331. * icas2 = indicateur sous-option realisee :
  332. icas2 = 0 ;
  333.  
  334. *----------------------------- PASSE DROI -----------------------------*
  335. * Sous-option DROI :
  336. si (ega mot2 'DROI') ;
  337. icas2 = 1 ;
  338.  
  339. * Lecture du point :
  340. argu P1*'POINT' ;
  341.  
  342. * Trajectoire PASSE DROI :
  343. si idebut1 ;
  344. P0 = tab1.point_de_depart ;
  345. * Deplacements relatifs :
  346. si irela1 ;
  347. P1 = P0 plus P1 ;
  348. fins ;
  349. mail1 = P0 droi 1 P1 ;
  350. mail1 = mail1 coul roug ;
  351. ll1 = mesu mail1 ;
  352. maili1 = mail1 ;
  353. sino ;
  354. mail0 = tab1.trajectoire ;
  355. nbpts0 = nbno mail0 ;
  356. P0 = mail0 poin nbpts0 ;
  357. * Deplacements relatifs :
  358. si irela1 ;
  359. P1 = P0 plus P1 ;
  360. fins ;
  361. mail1 = P0 droi 1 P1 ;
  362. mail1 = mail1 coul roug ;
  363. ll1 = mesu mail1 ;
  364. maili1 = mail1 ;
  365. si (nbpts0 > 1) ;
  366. mail1 = mail0 et mail1 ;
  367. fins ;
  368. fins ;
  369. tab1.trajectoire = mail1 ;
  370.  
  371. * Increment de temps :
  372. dt1 = ll1 / vdep1 ;
  373. si idtcp1 ;
  374. dt1 = dt1 + dtcp1 ;
  375. fins ;
  376.  
  377. * Evolution puissance PASSE DROI :
  378. si idebut1 ;
  379. ltps1 = prog 0. dt1 ;
  380. lqtot1 = prog qtot1 qtot1 ;
  381. lti1 = ltps1 ;
  382. sino ;
  383. ltps0 = extr evqtot0 absc ;
  384. tps0 = extr ltps0 (dime ltps0) ;
  385. * Si la puissance indiquee est differente de celle existante :
  386. si idtcp1 ;
  387. lti1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  388. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  389. lqtot1 = prog qtot1 qtot1 ;
  390. sino ;
  391. lti1 = prog tps0 (tps0 + dt1) ;
  392. ltps1 = prog (tps0 + dt1) ;
  393. lqtot1 = prog qtot1 ;
  394. fins ;
  395. ltps1 = ltps0 et ltps1 ;
  396. lqtot1 = lqtot0 et lqtot1 ;
  397. fins ;
  398. evqtot1 = evol roug manu temp ltps1 qtot lqtot1 ;
  399. tab1.evolution_puissance = evqtot1 ;
  400.  
  401. * Evolution debit PASSE DROI :
  402. si idebut1 ;
  403. ltps1 = prog 0. dt1 ;
  404. ldebi1 = prog debi1 debi1 ;
  405. sino ;
  406. ltps0 = extr evdebi0 absc ;
  407. tps0 = extr ltps0 (dime ltps0) ;
  408. * Si la puissance indiquee est differente de celle existante :
  409. si idtcp1 ;
  410. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  411. ldebi1 = prog debi1 debi1 ;
  412. sino ;
  413. ltps1 = prog (tps0 + dt1) ;
  414. ldebi1 = prog debi1 ;
  415. fins ;
  416. ltps1 = ltps0 et ltps1 ;
  417. ldebi1 = ldebi0 et ldebi1 ;
  418. fins ;
  419. evdebi1 = evol roug manu temp ltps1 debi ldebi1 ;
  420. tab1.evolution_debit = evdebi1 ;
  421.  
  422. * Evolution deplacement PASSE DROI :
  423. si idebut1 ;
  424. ltps1 = prog 0. dt1 ;
  425. ldep1 = prog 0. ll1 ;
  426. sino ;
  427. evdep0 = tab1.evolution_deplacement ;
  428. ltps0 = extr evdep0 absc ;
  429. ldep0 = extr evdep0 ordo ;
  430. tps0 = extr ltps0 (dime ltps0) ;
  431. dep0 = extr ldep0 (dime ldep0) ;
  432. si idtcp1 ;
  433. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  434. ldep1 = prog dep0 (dep0 + ll1) ;
  435. sino ;
  436. ltps1 = prog (tps0 + dt1) ;
  437. ldep1 = prog (dep0 + ll1) ;
  438. fins ;
  439. ltps1 = ltps0 et ltps1 ;
  440. ldep1 = ldep0 et ldep1 ;
  441. fins ;
  442. evdep1 = evol vert manu temp ltps1 ldep1 ;
  443. tab1.evolution_deplacement = evdep1 ;
  444.  
  445. * Enregistrement donnees PASSE DROI
  446. tab1.passes.nps1.maillage = maili1 ;
  447. tab1.passes.nps1.geometrie = mot 'DROI' ;
  448. tab1.passes.nps1.instants = lti1 ;
  449. tab1.passes.nps1.vitesse = vdep1 ;
  450. tab1.passes.nps1.puissance = qtot1 ;
  451. tab1.passes.nps1.debit = debi1 ;
  452.  
  453. si (exis tab1 'LARGEUR_DE_PASSE') ;
  454. tab1.passes.nps1.largeur = tab1.largeur_de_passe ;
  455. fins ;
  456.  
  457. quit soudage ;
  458. * Fin option PASSE DROI :
  459. fins ;
  460.  
  461. *----------------------------- PASSE CERC -----------------------------*
  462. * Sous-option CERC :
  463. si (ega mot2 'CERC') ;
  464. icas2 = 2 ;
  465.  
  466. * P1 est le centre du cercle, P2, l'extremite de la trajectoire
  467. argu P2*'POINT' P1*'POINT' ;
  468.  
  469. * Trajectoire PASSE CERC :
  470. si idebut1 ;
  471. P0 = tab1.point_de_depart ;
  472. * Deplacements relatifs :
  473. si irela1 ;
  474. P1 = P0 plus P1 ;
  475. P2 = P0 plus P2 ;
  476. fins ;
  477. si (non (exis N1)) ;
  478. V1 = P0 moin P1 ;
  479. V2 = P2 moin P1 ;
  480. V1 = V1 / (norm V1) ;
  481. V2 = V2 / (norm V2) ;
  482. N1 = (acos (psca V1 V2)) / 5. ;
  483. N1 = maxi (lect (enti N1) 1) ;
  484. fins ;
  485. mail1 = CERC N1 P0 P1 P2 ;
  486. mail1 = mail1 coul roug ;
  487. maili1 = mail1 ;
  488. ll1 = mesu mail1 ;
  489. sino ;
  490. mail0 = tab1.trajectoire ;
  491. nbpts0 = nbno mail0 ;
  492. P0 = mail0 poin nbpts0 ;
  493. * Deplacements relatifs :
  494. si irela1 ;
  495. P1 = P0 plus P1 ;
  496. P2 = P0 plus P2 ;
  497. fins ;
  498. si (non (exis N1)) ;
  499. V1 = P0 moin P1 ;
  500. V2 = P2 moin P1 ;
  501. V1 = V1 / (norm V1) ;
  502. V2 = V2 / (norm V2) ;
  503. N1 = (acos (psca V1 V2)) / 5. ;
  504. N1 = maxi (lect (enti N1) 1) ;
  505. fins ;
  506. mail1 = CERC N1 P0 P1 P2 ;
  507. mail1 = mail1 coul roug ;
  508. maili1 = mail1 ;
  509. ll1 = mesu mail1 ;
  510. si (nbpts0 > 1) ;
  511. mail1 = mail0 et mail1 ;
  512. fins ;
  513. fins ;
  514. tab1.trajectoire = mail1 ;
  515.  
  516. * Increment de temps :
  517. dt1 = ll1 / vdep1 ;
  518. si idtcp1 ;
  519. dt1 = dt1 + dtcp1 ;
  520. fins ;
  521.  
  522. * Evolution puissance PASSE CERC :
  523. si idebut1 ;
  524. ltps1 = prog 0. dt1 ;
  525. lqtot1 = prog qtot1 qtot1 ;
  526. lti1 = ltps1 ;
  527. sino ;
  528. ltps0 = extr evqtot0 absc ;
  529. tps0 = extr ltps0 (dime ltps0) ;
  530. * Si la puissance indiquee est differente de celle existante :
  531. si idtcp1 ;
  532. lti1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  533. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  534. lqtot1 = prog qtot1 qtot1 ;
  535. sino ;
  536. lti1 = prog tps0 (tps0 + dt1) ;
  537. ltps1 = prog (tps0 + dt1) ;
  538. lqtot1 = prog qtot1 ;
  539. fins ;
  540. ltps1 = ltps0 et ltps1 ;
  541. lqtot1 = lqtot0 et lqtot1 ;
  542. fins ;
  543. evqtot1 = evol roug manu temp ltps1 qtot lqtot1 ;
  544. tab1.evolution_puissance = evqtot1 ;
  545.  
  546. * Evolution debit PASSE CERC :
  547. si idebut1 ;
  548. ltps1 = prog 0. dt1 ;
  549. ldebi1 = prog debi1 debi1 ;
  550. sino ;
  551. ltps0 = extr evdebi0 absc ;
  552. tps0 = extr ltps0 (dime ltps0) ;
  553. * Si la puissance indiquee est differente de celle existante :
  554. si idtcp1 ;
  555. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  556. ldebi1 = prog debi1 debi1 ;
  557. sino ;
  558. ltps1 = prog (tps0 + dt1) ;
  559. ldebi1 = prog debi1 ;
  560. fins ;
  561. ltps1 = ltps0 et ltps1 ;
  562. ldebi1 = ldebi0 et ldebi1 ;
  563. fins ;
  564. evdebi1 = evol roug manu temp ltps1 debi ldebi1 ;
  565. tab1.evolution_debit = evdebi1 ;
  566.  
  567. * Evolution deplacement PASSE CERC :
  568. si idebut1 ;
  569. ltps1 = prog 0. dt1 ;
  570. ldep1 = prog 0. ll1 ;
  571. sino ;
  572. evdep0 = tab1.evolution_deplacement ;
  573. ltps0 = extr evdep0 absc ;
  574. ldep0 = extr evdep0 ordo ;
  575. tps0 = extr ltps0 (dime ltps0) ;
  576. dep0 = extr ldep0 (dime ldep0) ;
  577. si idtcp1 ;
  578. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  579. ldep1 = prog dep0 (dep0 + ll1) ;
  580. sino ;
  581. ltps1 = prog (tps0 + dt1) ;
  582. ldep1 = prog (dep0 + ll1) ;
  583. fins ;
  584. ltps1 = ltps0 et ltps1 ;
  585. ldep1 = ldep0 et ldep1 ;
  586. fins ;
  587. evdep1 = evol vert manu temp ltps1 ldep1 ;
  588. tab1.evolution_deplacement = evdep1 ;
  589.  
  590. * Enregistrement donnees PASSE CERC
  591. tab1.passes.nps1.maillage = maili1 ;
  592. tab1.passes.nps1.geometrie = mot 'CERC' ;
  593. tab1.passes.nps1.centre = P1 ;
  594. tab1.passes.nps1.instants = lti1 ;
  595. tab1.passes.nps1.vitesse = vdep1 ;
  596. tab1.passes.nps1.puissance = qtot1 ;
  597. tab1.passes.nps1.debit = debi1 ;
  598.  
  599. si (exis tab1 'LARGEUR_DE_PASSE') ;
  600. tab1.passes.nps1.largeur = tab1.largeur_de_passe ;
  601. fins ;
  602.  
  603. quit soudage ;
  604. * Fin option PASSE CERC :
  605. fins ;
  606.  
  607. *----------------------------- PASSE MAIL -----------------------------*
  608. * Sous-option MAIL :
  609. si (ega mot2 'MAIL') ;
  610. icas2 = 3 ;
  611.  
  612. argu mail1*'MAILLAGE' ;
  613. eltyp1 = mail1 elem type ;
  614. imax1 = 0 ;
  615. si (exis eltyp1 'SEG2') ; imax1 = imax1 + 1 ; fins ;
  616. si (exis eltyp1 'SEG3') ; imax1 = imax1 + 1 ; fins ;
  617. si ((dime eltyp1) > imax1) ;
  618. erre '***** ERREUR : le maillage doit etre compose de SEG2 ou de SEG3.' ;
  619. fins ;
  620. ll1 = mesu mail1 ;
  621. maili1 = mail1 ;
  622.  
  623. * Trajectoire PASSE MAIL :
  624. si idebut1 ;
  625. P1 = mail1 poin 1 ;
  626. tab1.point_de_depart = P1 ;
  627. sino ;
  628. mail0 = tab1.trajectoire ;
  629. nbpts0 = nbno mail0 ;
  630. P0 = mail0 poin nbpts0 ;
  631. P1 = mail1 poin 1 ;
  632. si (P1 neg P0) ;
  633. erre '***** ERREUR : MAILLAGE incompatible.' ;
  634. quit soudage ;
  635. fins ;
  636. si (nbpts0 > 1) ;
  637. mail1 = mail1 coul roug ;
  638. mail1 = mail0 et mail1 ;
  639. fins ;
  640. fins ;
  641. tab1.trajectoire = mail1 ;
  642.  
  643. * Increment de temps :
  644. dt1 = ll1 / vdep1 ;
  645. si idtcp1 ;
  646. dt1 = dt1 + dtcp1 ;
  647. fins ;
  648.  
  649. * Evolution puissance PASSE MAIL :
  650. si idebut1 ;
  651. ltps1 = prog 0. dt1 ;
  652. lqtot1 = prog qtot1 qtot1 ;
  653. lti1 = ltps1 ;
  654. sino ;
  655. ltps0 = extr evqtot0 absc ;
  656. tps0 = extr ltps0 (dime ltps0) ;
  657. * Si la puissance indiquee est differente de celle existante :
  658. si idtcp1 ;
  659. lti1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  660. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  661. lqtot1 = prog qtot1 qtot1 ;
  662. sino ;
  663. lti1 = prog tps0 (tps0 + dt1) ;
  664. ltps1 = prog (tps0 + dt1) ;
  665. lqtot1 = prog qtot1 ;
  666. fins ;
  667. ltps1 = ltps0 et ltps1 ;
  668. lqtot1 = lqtot0 et lqtot1 ;
  669. fins ;
  670. evqtot1 = evol roug manu temp ltps1 qtot lqtot1 ;
  671. tab1.evolution_puissance = evqtot1 ;
  672.  
  673. * Evolution debit PASSE MAIL :
  674. si idebut1 ;
  675. ltps1 = prog 0. dt1 ;
  676. ldebi1 = prog debi1 debi1 ;
  677. sino ;
  678. ltps0 = extr evdebi0 absc ;
  679. tps0 = extr ltps0 (dime ltps0) ;
  680. * Si la puissance indiquee est differente de celle existante :
  681. si idtcp1 ;
  682. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  683. ldebi1 = prog debi1 debi1 ;
  684. sino ;
  685. ltps1 = prog (tps0 + dt1) ;
  686. ldebi1 = prog debi1 ;
  687. fins ;
  688. ltps1 = ltps0 et ltps1 ;
  689. ldebi1 = ldebi0 et ldebi1 ;
  690. fins ;
  691. evdebi1 = evol roug manu temp ltps1 debi ldebi1 ;
  692. tab1.evolution_debit = evdebi1 ;
  693.  
  694. * Evolution deplacement PASSE MAIL :
  695. si idebut1 ;
  696. ltps1 = prog 0. dt1 ;
  697. ldep1 = prog 0. ll1 ;
  698. sino ;
  699. evdep0 = tab1.evolution_deplacement ;
  700. ltps0 = extr evdep0 absc ;
  701. ldep0 = extr evdep0 ordo ;
  702. tps0 = extr ltps0 (dime ltps0) ;
  703. dep0 = extr ldep0 (dime ldep0) ;
  704. si idtcp1 ;
  705. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  706. ldep1 = prog dep0 (dep0 + ll1) ;
  707. sino ;
  708. ltps1 = prog (tps0 + dt1) ;
  709. ldep1 = prog (dep0 + ll1) ;
  710. fins ;
  711. ltps1 = ltps0 et ltps1 ;
  712. ldep1 = ldep0 et ldep1 ;
  713. fins ;
  714. evdep1 = evol vert manu temp ltps1 ldep1 ;
  715. tab1.evolution_deplacement = evdep1 ;
  716.  
  717. * Enregistrement donnees PASSE MAIL
  718. tab1.passes.nps1.maillage = maili1 ;
  719. tab1.passes.nps1.geometrie = mot 'MAIL' ;
  720. tab1.passes.nps1.instants = lti1 ;
  721. tab1.passes.nps1.vitesse = vdep1 ;
  722. tab1.passes.nps1.puissance = qtot1 ;
  723. tab1.passes.nps1.debit = debi1 ;
  724.  
  725. si (exis tab1 'LARGEUR_DE_PASSE') ;
  726. tab1.passes.nps1.largeur = tab1.largeur_de_passe ;
  727. fins ;
  728.  
  729. quit soudage ;
  730. * Fin option PASSE MAIL :
  731. fins ;
  732.  
  733. * Si mot2 ne correspond a aucune option connue, icas2 = 0 : erreur
  734. si (icas2 ega 0) ;
  735. erre '***** ERREUR : MOT option non reconnu.' ;
  736. quit soudage ;
  737. fins ;
  738.  
  739. * Fin option PASSE :
  740. fins ;
  741.  
  742. *----------------------------------------------------------------------*
  743. * Option DEPLA *
  744. *----------------------------------------------------------------------*
  745.  
  746. si (ega mot1 'DEPLA') ;
  747. icas1 = 3 ;
  748. *
  749. * Lecture des arguments de l'option :
  750. argu MOT2*'MOT' ;
  751.  
  752. * icas2 = indicateur sous-option realisee :
  753. icas2 = 0 ;
  754.  
  755. *----------------------------- DEPLA DROI -----------------------------*
  756. si (ega mot2 'DROI') ;
  757. icas2 = 1 ;
  758.  
  759. argu P1*'POINT' ;
  760.  
  761. * Deplacement relatif / absolu :
  762. imot3 = faux ; imot4 = faux ;
  763. irela1 = vrai ;
  764. repe b1 2 ;
  765. argu mot3/'MOT' ;
  766. si (non (exis mot3)) ; quit b1 ; fins ;
  767. si (ega mot3 'ABSO') ;
  768. imot3 = vrai ;
  769. irela1 = faux ;
  770. fins ;
  771. si (ega mot3 'VITE') ;
  772. imot4 = vrai ;
  773. argu vdep1*'FLOTTANT' ;
  774. fins ;
  775. fin b1 ;
  776.  
  777. * Trajectoire DEPLA DROI :
  778. si idebut1 ;
  779. P0 = tab1.point_de_depart ;
  780. * Deplacements relatifs :
  781. si irela1 ;
  782. P1 = P0 plus P1 ;
  783. fins ;
  784. mail1 = P0 droi 1 P1 ;
  785. mail1 = mail1 coul vert ;
  786. ll1 = mesu mail1 ;
  787. sino ;
  788. mail0 = tab1.trajectoire ;
  789. nbpts0 = nbno mail0 ;
  790. P0 = mail0 poin nbpts0 ;
  791. * Deplacements relatifs :
  792. si irela1 ;
  793. P1 = P0 plus P1 ;
  794. fins ;
  795. mail1 = P0 droi 1 P1 ;
  796. mail1 = mail1 coul vert ;
  797. ll1 = mesu mail1 ;
  798. si (nbpts0 > 1) ;
  799. mail1 = mail0 et mail1 ;
  800. fins ;
  801. fins ;
  802. tab1.trajectoire = mail1 ;
  803.  
  804. * Increment de temps DEPLA DROI :
  805. si (non imot4) ;
  806. vdep1 = tab1.vitesse_de_deplacement ;
  807. fins ;
  808. dt1 = ll1 / vdep1 ;
  809.  
  810. * Evolution puissance DEPLA DROI :
  811. qtot1 = 0. ;
  812. icoup1 = faux ;
  813. si idebut1 ;
  814. ltps1 = prog 0. dt1 ;
  815. lqtot1 = prog qtot1 qtot1 ;
  816. lqi1 = prog 1. 1. ;
  817. sino ;
  818. evqtot0 = tab1.evolution_puissance ;
  819. ltps0 = extr evqtot0 absc ;
  820. lqtot0 = extr evqtot0 ordo ;
  821. tps0 = extr ltps0 (dime ltps0) ;
  822. qtot0 = extr lqtot0 (dime lqtot0) ;
  823. * Si la puissance indiquee est differente de celle existante :
  824. si ((abs(qtot0-qtot1)) > (abs(1.e-4*qtot1))) ;
  825. icoup1 = vrai ;
  826. dtcp1 = tab1.temps_de_coupure ;
  827. * La duree de realisation du point de soudure doit etre sup. au temps de coupure :
  828. * si (dtcp1 >EG dt1) ;
  829. * erre '***** ERREUR : le temps de soudage est inferieur au temps de coupure.' ;
  830. * quit soudage ;
  831. * fins ;
  832. dt1 = dt1 + dtcp1 ;
  833. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  834. lqtot1 = prog qtot1 qtot1 ;
  835. lqi1 = prog 1. 1. ;
  836. sino ;
  837. ltps1 = prog (tps0 + dt1) ;
  838. lqtot1 = prog qtot1 ;
  839. lqi1 = prog 1. ;
  840. fins ;
  841. ltps1 = ltps0 et ltps1 ;
  842. lqtot1 = lqtot0 et lqtot1 ;
  843. fins ;
  844. evqtot1 = evol roug manu temp ltps1 qtot lqtot1 ;
  845. tab1.evolution_puissance = evqtot1 ;
  846.  
  847. * Evolution debit DEPLA DROI :
  848. debi1 = 0. ;
  849. ldebi1 = debi1 * lqi1 ;
  850. si (non idebut1) ;
  851. ldebi1 = (extr tab1.evolution_debit ordo) et ldebi1 ;
  852. fins ;
  853. evdebi1 = evol roug manu temp ltps1 debi ldebi1 ;
  854. tab1.evolution_debit = evdebi1 ;
  855.  
  856. * Evolution deplacement DEPLA DROI :
  857. si idebut1 ;
  858. ltps1 = prog 0. dt1 ;
  859. ldep1 = prog 0. ll1 ;
  860. sino ;
  861. evdep0 = tab1.evolution_deplacement ;
  862. ltps0 = extr evdep0 absc ;
  863. ldep0 = extr evdep0 ordo ;
  864. tps0 = extr ltps0 (dime ltps0) ;
  865. dep0 = extr ldep0 (dime ldep0) ;
  866. si icoup1 ;
  867. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  868. ldep1 = prog dep0 (dep0 + ll1) ;
  869. sino ;
  870. ltps1 = prog (tps0 + dt1) ;
  871. ldep1 = prog (dep0 + ll1) ;
  872. fins ;
  873. ltps1 = ltps0 et ltps1 ;
  874. ldep1 = ldep0 et ldep1 ;
  875. fins ;
  876. evdep1 = evol vert manu temp ltps1 ldep1 ;
  877. tab1.evolution_deplacement = evdep1 ;
  878.  
  879. quit soudage ;
  880. * Fin option DEPLA DROI :
  881. fins ;
  882.  
  883. *----------------------------- DEPLA CERC -----------------------------*
  884. si (ega mot2 'CERC') ;
  885. icas2 = 2 ;
  886.  
  887. * P1 est le centre du cercle, P2, l'extremite de la trajectoire
  888. argu P2*'POINT' P1*'POINT' N1/'ENTIER';
  889.  
  890. * Deplacement relatif / absolu :
  891. imot3 = faux ; imot4 = faux ;
  892. irela1 = vrai ;
  893. repe b1 2 ;
  894. argu mot3/'MOT' ;
  895. si (non (exis mot3)) ; quit b1 ; fins ;
  896. si (ega mot3 'ABSO') ;
  897. imot3 = vrai ;
  898. irela1 = faux ;
  899. fins ;
  900. si (ega mot3 'VITE') ;
  901. imot4 = vrai ;
  902. argu vdep1*'FLOTTANT' ;
  903. fins ;
  904. fin b1 ;
  905.  
  906. * Trajectoire DEPLA CERC :
  907. si idebut1 ;
  908. P0 = tab1.point_de_depart ;
  909. * Deplacements relatifs :
  910. si irela1 ;
  911. P1 = P0 plus P1 ;
  912. P2 = P0 plus P2 ;
  913. fins ;
  914. * Par defaut, N1 calcule pour avoir angle de 5 deg.
  915. si (non (exis N1)) ;
  916. V1 = P0 moin P1 ;
  917. V2 = P2 moin P1 ;
  918. V1 = V1 / (norm V1) ;
  919. V2 = V2 / (norm V2) ;
  920. N1 = (acos (psca V1 V2)) / 5. ;
  921. N1 = maxi (lect (enti N1) 1) ;
  922. fins ;
  923. mail1 = CERC N1 P0 P1 P2 ;
  924. mail1 = mail1 coul vert ;
  925. ll1 = mesu mail1 ;
  926. sino ;
  927. mail0 = tab1.trajectoire ;
  928. nbpts0 = nbno mail0 ;
  929. P0 = mail0 poin nbpts0 ;
  930. * Deplacements relatifs :
  931. si irela1 ;
  932. P1 = P0 plus P1 ;
  933. P2 = P0 plus P2 ;
  934. fins ;
  935. si (non (exis N1)) ;
  936. V1 = P0 moin P1 ;
  937. V2 = P2 moin P1 ;
  938. V1 = V1 / (norm V1) ;
  939. V2 = V2 / (norm V2) ;
  940. N1 = (acos (psca V1 V2)) / 5. ;
  941. N1 = maxi (lect (enti N1) 1) ;
  942. fins ;
  943. mail1 = CERC N1 P0 P1 P2 ;
  944. mail1 = mail1 coul vert ;
  945. ll1 = mesu mail1 ;
  946. si (nbpts0 > 1) ;
  947. mail1 = mail0 et mail1 ;
  948. fins ;
  949. fins ;
  950. tab1.trajectoire = mail1 ;
  951.  
  952. * Increment de temps DEPLA CERC :
  953. si (non imot4) ;
  954. vdep1 = tab1.vitesse_de_deplacement ;
  955. fins ;
  956. dt1 = ll1 / vdep1 ;
  957.  
  958. * Evolution puissance DEPLA CERC :
  959. qtot1 = 0. ;
  960. icoup1 = faux ;
  961. si idebut1 ;
  962. ltps1 = prog 0. dt1 ;
  963. lqtot1 = prog qtot1 qtot1 ;
  964. lqi1 = prog 1. 1. ;
  965. sino ;
  966. evqtot0 = tab1.evolution_puissance ;
  967. ltps0 = extr evqtot0 absc ;
  968. lqtot0 = extr evqtot0 ordo ;
  969. tps0 = extr ltps0 (dime ltps0) ;
  970. qtot0 = extr lqtot0 (dime lqtot0) ;
  971. * Si la puissance indiquee est differente de celle existante :
  972. si ((abs(qtot0-qtot1)) > (abs(1.e-4*qtot1))) ;
  973. icoup1 = vrai ;
  974. dtcp1 = tab1.temps_de_coupure ;
  975. * La duree de realisation du point de soudure doit etre sup. au temps de coupure :
  976. * si (dtcp1 >EG dt1) ;
  977. * erre '***** ERREUR : le temps de soudage est inferieur au temps de coupure.' ;
  978. * quit soudage ;
  979. * fins ;
  980. dt1 = dt1 + dtcp1 ;
  981. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  982. lqtot1 = prog qtot1 qtot1 ;
  983. lqi1 = prog 1. 1. ;
  984. sino ;
  985. ltps1 = prog (tps0 + dt1) ;
  986. lqtot1 = prog qtot1 ;
  987. lqi1 = prog 1. ;
  988. fins ;
  989. ltps1 = ltps0 et ltps1 ;
  990. lqtot1 = lqtot0 et lqtot1 ;
  991. fins ;
  992. evqtot1 = evol roug manu temp ltps1 qtot lqtot1 ;
  993. tab1.evolution_puissance = evqtot1 ;
  994.  
  995. * Evolution debit DEPLA CERC :
  996. debi1 = 0. ;
  997. ldebi1 = debi1 * lqi1 ;
  998. si (non idebut1) ;
  999. ldebi1 = (extr tab1.evolution_debit ordo) et ldebi1 ;
  1000. fins ;
  1001. evdebi1 = evol roug manu temp ltps1 debi ldebi1 ;
  1002. tab1.evolution_debit = evdebi1 ;
  1003.  
  1004. * Evolution deplacement DEPLA CERC :
  1005. si idebut1 ;
  1006. ltps1 = prog 0. dt1 ;
  1007. ldep1 = prog 0. ll1 ;
  1008. sino ;
  1009. evdep0 = tab1.evolution_deplacement ;
  1010. ltps0 = extr evdep0 absc ;
  1011. ldep0 = extr evdep0 ordo ;
  1012. tps0 = extr ltps0 (dime ltps0) ;
  1013. dep0 = extr ldep0 (dime ldep0) ;
  1014. si icoup1 ;
  1015. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  1016. ldep1 = prog dep0 (dep0 + ll1) ;
  1017. sino ;
  1018. ltps1 = prog (tps0 + dt1) ;
  1019. ldep1 = prog (dep0 + ll1) ;
  1020. fins ;
  1021. ltps1 = ltps0 et ltps1 ;
  1022. ldep1 = ldep0 et ldep1 ;
  1023. fins ;
  1024. evdep1 = evol vert manu temp ltps1 ldep1 ;
  1025. tab1.evolution_deplacement = evdep1 ;
  1026.  
  1027. quit soudage ;
  1028. * Fin option DEPLA CERC :
  1029. fins ;
  1030.  
  1031. *----------------------------- DEPLA MAIL -----------------------------*
  1032. * Sous-option MAIL :
  1033. si (ega mot2 'MAIL') ;
  1034. icas2 = 3 ;
  1035.  
  1036. argu mail1*'MAILLAGE' ;
  1037. eltyp1 = mail1 elem type ;
  1038. imax1 = 0 ;
  1039. si (exis eltyp1 'SEG2') ; imax1 = imax1 + 1 ; fins ;
  1040. si (exis eltyp1 'SEG3') ; imax1 = imax1 + 1 ; fins ;
  1041. si ((dime eltyp1) > imax1) ;
  1042. erre '***** ERREUR : le maillage doit etre compose de SEG2 ou de SEG3.' ;
  1043. fins ;
  1044. ll1 = mesu mail1 ;
  1045.  
  1046. * Trajectoire DEPLA MAIL :
  1047. si idebut1 ;
  1048. P1 = mail1 poin 1 ;
  1049. tab1.point_de_depart = P1 ;
  1050. sino ;
  1051. mail0 = tab1.trajectoire ;
  1052. nbpts0 = nbno mail0 ;
  1053. P0 = mail0 poin nbpts0 ;
  1054. P1 = mail1 poin 1 ;
  1055. si (P1 neg P0) ;
  1056. erre '***** ERREUR : MAILLAGE incompatible.' ;
  1057. quit soudage ;
  1058. fins ;
  1059. si (nbpts0 > 1) ;
  1060. mail1 = mail1 coul vert ;
  1061. mail1 = mail0 et mail1 ;
  1062. fins ;
  1063. fins ;
  1064. tab1.trajectoire = mail1 ;
  1065.  
  1066. * Increment de temps DEPLA MAIL :
  1067. argu mot4/'MOT' ;
  1068. si (exis mot4) ;
  1069. si (ega mot4 'VITE') ;
  1070. argu vdep1*'FLOTTANT' ;
  1071. sino ;
  1072. erre '***** ERREUR : on attend le mot-cle VITE.' ;
  1073. quit soudage ;
  1074. fins ;
  1075. sino ;
  1076. vdep1 = tab1.vitesse_de_deplacement ;
  1077. fins ;
  1078. dt1 = ll1 / vdep1 ;
  1079.  
  1080. * Evolution puissance DEPLA MAIL :
  1081. qtot1 = 0. ;
  1082. icoup1 = faux ;
  1083. si idebut1 ;
  1084. ltps1 = prog 0. dt1 ;
  1085. lqtot1 = prog qtot1 qtot1 ;
  1086. lqi1 = prog 1. 1. ;
  1087. sino ;
  1088. evqtot0 = tab1.evolution_puissance ;
  1089. ltps0 = extr evqtot0 absc ;
  1090. lqtot0 = extr evqtot0 ordo ;
  1091. tps0 = extr ltps0 (dime ltps0) ;
  1092. qtot0 = extr lqtot0 (dime lqtot0) ;
  1093. * Si la puissance indiquee est differente de celle existante :
  1094. si ((abs(qtot0-qtot1)) > (abs(1.e-4*qtot1))) ;
  1095. icoup1 = vrai ;
  1096. dtcp1 = tab1.temps_de_coupure ;
  1097. * La duree de realisation du point de soudure doit etre sup. au temps de coupure :
  1098. * si (dtcp1 >EG dt1) ;
  1099. * erre '***** ERREUR : le temps de soudage est inferieur au temps de coupure.' ;
  1100. * quit soudage ;
  1101. * fins ;
  1102. dt1 = dt1 + dtcp1 ;
  1103. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  1104. lqtot1 = prog qtot1 qtot1 ;
  1105. lqi1 = prog 1. 1. ;
  1106. sino ;
  1107. ltps1 = prog (tps0 + dt1) ;
  1108. lqtot1 = prog qtot1 ;
  1109. lqi1 = prog 1. ;
  1110. fins ;
  1111. ltps1 = ltps0 et ltps1 ;
  1112. lqtot1 = lqtot0 et lqtot1 ;
  1113. fins ;
  1114. evqtot1 = evol roug manu temp ltps1 qtot lqtot1 ;
  1115. tab1.evolution_puissance = evqtot1 ;
  1116.  
  1117. * Evolution debit DEPLA MAIL :
  1118. debi1 = 0. ;
  1119. ldebi1 = debi1 * lqi1 ;
  1120. si (non idebut1) ;
  1121. ldebi1 = (extr tab1.evolution_debit ordo) et ldebi1 ;
  1122. fins ;
  1123. evdebi1 = evol roug manu temp ltps1 debi ldebi1 ;
  1124. tab1.evolution_debit = evdebi1 ;
  1125.  
  1126. * Evolution deplacement DEPLA MAIL :
  1127. si idebut1 ;
  1128. ltps1 = prog 0. dt1 ;
  1129. ldep1 = prog 0. ll1 ;
  1130. sino ;
  1131. evdep0 = tab1.evolution_deplacement ;
  1132. ltps0 = extr evdep0 absc ;
  1133. ldep0 = extr evdep0 ordo ;
  1134. tps0 = extr ltps0 (dime ltps0) ;
  1135. dep0 = extr ldep0 (dime ldep0) ;
  1136. si icoup1 ;
  1137. ltps1 = prog (tps0 + dtcp1) (tps0 + dt1) ;
  1138. ldep1 = prog dep0 (dep0 + ll1) ;
  1139. sino ;
  1140. ltps1 = prog (tps0 + dt1) ;
  1141. ldep1 = prog (dep0 + ll1) ;
  1142. fins ;
  1143. ltps1 = ltps0 et ltps1 ;
  1144. ldep1 = ldep0 et ldep1 ;
  1145. fins ;
  1146. evdep1 = evol vert manu temp ltps1 ldep1 ;
  1147. tab1.evolution_deplacement = evdep1 ;
  1148.  
  1149. quit soudage ;
  1150. * Fin option DEPLA MAIL :
  1151. fins ;
  1152.  
  1153. *---------------------------- DEPLA COUCHE ----------------------------*
  1154. * Sous-option COUCHE :
  1155. si (ega mot2 'COUCHE') ;
  1156. icas2 = 4 ;
  1157. tab1.depla_couche = vrai ;
  1158.  
  1159. * Option PAUSE :
  1160. argu mot3/'MOT' ;
  1161. si (exis mot3) ;
  1162. si (ega mot3 'PAUSE') ;
  1163. argu flot1*'FLOTTANT' ;
  1164. tab1.depla_pause = flot1 ;
  1165. fins ;
  1166. fins ;
  1167.  
  1168. * Fin option DEPLA COUCHE :
  1169. fins ;
  1170.  
  1171. si (icas2 ega 0) ;
  1172. erre '***** ERREUR : MOT option non reconnu.' ;
  1173. quit soudage ;
  1174. fins ;
  1175.  
  1176. * Fin option DEPLA :
  1177. fins ;
  1178.  
  1179. *----------------------------------------------------------------------*
  1180. * Option MAIL *
  1181. *----------------------------------------------------------------------*
  1182.  
  1183. si (ega mot1 'MAIL') ;
  1184. icas1 = 4 ;
  1185.  
  1186. *----------------------- Lecture des arguments ------------------------*
  1187.  
  1188. * Lecture maillage cordons :
  1189. argu mail1*'MAILLAGE' ;
  1190.  
  1191. * Lecture facultative liste ordonnancement couleurs ;
  1192. argu list1/'LISTENTI' ;
  1193. ilist1 = exis list1 ;
  1194. si (non ilist1) ;
  1195. argu list1/'LISTMOTS' ;
  1196. ilist1 = exis list1 ;
  1197. fins ;
  1198.  
  1199. * Lecture du mot 'PAS' ;
  1200. argu mot1*'MOT' ;
  1201. si (neg mot1 'PAS') ;
  1202. erre '***** ERREUR : on attend le mot-cle PAS' ;
  1203. quit soudage ;
  1204. sino ;
  1205. argu flot1*'FLOTTANT' ;
  1206. fins ;
  1207.  
  1208. * Lecture option 'TEMP' ;
  1209. argu mot2/'MOT' ;
  1210. si (exis mot2) ;
  1211. imot2 = ega mot2 'TEMP' ;
  1212. si (imot2) ;
  1213. argu flot2/'FLOTTANT' ;
  1214. si (non (exis flot2)) ;
  1215. flot2 = -1. ;
  1216. fins ;
  1217. sino ;
  1218. erre '***** ERREUR : on attend le mot-cle TEMP' ;
  1219. quit soudage ;
  1220. fins ;
  1221. fins ;
  1222.  
  1223. *----------------------- Indexation du maillage -----------------------*
  1224.  
  1225. * Informations trajectoire :
  1226. ltraj1 = tab1.trajectoire ;
  1227. chxs1 = ltraj1 coor curv ;
  1228. x1 y1 z1 = mail1 coor ;
  1229.  
  1230. * Informations evolution deplacements :
  1231. evxs1 = tab1.evolution_deplacement ;
  1232. ltxs1 = extr evxs1 absc ;
  1233. lxxs1 = extr evxs1 ordo ;
  1234. ievsx1 = evol manu lxxs1 ltxs1 ;
  1235. nbxs1 = dime lxxs1 ;
  1236. *list ltxs1 ;
  1237. *list lxxs1 ;
  1238.  
  1239. * Information apport de matiere :
  1240. evdf1 = tab1.evolution_debit ;
  1241. ldeb1 = extr evdf1 ordo ;
  1242.  
  1243. * tolerance dimensionnelle :
  1244. tol1 = 1.e-10 * (maxi ltxs1) ;
  1245. tol2 = 1.e-6 * (maxi ldeb1) ;
  1246.  
  1247. * Table resultat :
  1248. tab2 = table ;
  1249. tab2 . maillage = mail1 ;
  1250. tab2 . evolution_maillage = table ;
  1251. tab2 . evolution_maillage . temps = table ;
  1252. tab2 . evolution_maillage . maillage = table ;
  1253. ttps1 = table ;
  1254. tmai1 = table ;
  1255.  
  1256. * Boucle sur les segents rouges de la trajectoire :
  1257. nb1 = nbel ltraj1 ;
  1258. geoi1 = vide maillage ;
  1259. indi1 = 0 ;
  1260. ic1 = 1 ;
  1261. repe b1 nb1 ;
  1262. eli1 = ltraj1 elem &b1 ;
  1263.  
  1264. * Si pas trajectoire d'une passe, on saute en changeant de couleur :
  1265. si (neg ((eli1 elem coul) extr 1) 'ROUG') ;
  1266. ic1 = ic1 + 1 ;
  1267. iter b1 ;
  1268. fins ;
  1269.  
  1270. * Maillage cordon passe ic1 :
  1271. pi1 = eli1 poin 1 ;
  1272. xspi1 = chxs1 extr pi1 scal ;
  1273. si ilist1 ;
  1274. couli1 = extr list1 ic1 ;
  1275. si (ega (type couli1) 'MOT') ;
  1276. maili1 = mail1 elem couli1 ;
  1277. sino ;
  1278. maili1 = mail1 elem coul couli1 ;
  1279. fins ;
  1280. sino ;
  1281. maili1 = mail1 elem coul ic1 ;
  1282. fins ;
  1283. pci1 = maili1 poin proc pi1 ;
  1284. elci1 = maili1 elem appu larg pci1 ;
  1285. tpi1 = maili1 part nesc conn ;
  1286. repe bp1 (dime tpi1) ;
  1287. maili1 = tpi1.&bp1 ;
  1288. si (pci1 dans maili1) ; quit bp1 ; fins ;
  1289. fin bp1 ;
  1290.  
  1291. * Champ de distance du cordon le long de ce segment
  1292. pi2 = eli1 poin 2 ;
  1293. xspi2 = chxs1 extr pi2 scal ;
  1294. ni1 = (pi2 moin pi1) / (mesu eli1) ;
  1295. x1 y1 z1 = mail1 coor ;
  1296. xp1 yp1 zp1 = pi1 coor ;
  1297. xni1 yni1 zni1 = ni1 coor ;
  1298. chdi1 = ((x1 - xp1) * xni1) + ((y1 - yp1) * yni1) + ((z1 - zp1) * zni1) ;
  1299. chdi2 = chan cham chdi1 maili1 ;
  1300.  
  1301. * Extraction evolution deplacement sur ce segment :
  1302. lxxsi1 = prog xspi1 xspi2 ;
  1303. ltxsi1 = prog ;
  1304. iok1 = faux ;
  1305. repe bxs1 nbxs1 ;
  1306. xxsi1 = extr lxxs1 (nbxs1 + 1 - &bxs1) ;
  1307. txxix = extr ltxs1 (nbxs1 + 1 - &bxs1) ;
  1308. dxxi1 = ipol evdf1 txxix ;
  1309. * si ((non (xxsi1 < (xspi2 - tol1))) et (dxxi1 > tol2)) ;
  1310. si (non (xxsi1 < (xspi2 - tol1))) ;
  1311. txxi2 = txxix ;
  1312. fins ;
  1313. xxsi1 = extr lxxs1 &bxs1 ;
  1314. si (non (xxsi1 > (xspi1 + tol1))) ;
  1315. txxi1 = extr ltxs1 &bxs1 ;
  1316. fins ;
  1317. fin bxs1 ;
  1318. ltxsi1 = prog txxi1 txxi2 ;
  1319. *list lxxsi1 ;
  1320. *list ltxsi1 ;
  1321. * erre 21 ;
  1322.  
  1323. * Sequencage maillage cordon selon pas fourni :
  1324. nb2 = ((mesu eli1) / flot1 + 0.5) enti ;
  1325. xsi1 = 0. ;
  1326. repe b2 nb2 ;
  1327. xsi2 = xsi1 + flot1 ;
  1328. geoi2 = chdi2 elem egin (xsi2 + tol1) larg ;
  1329. tmai1 . indi1 = geoi1 et geoi2 ;
  1330. ti2 = ipol (xspi1 + xsi1) lxxsi1 ltxsi1 ;
  1331. ttps1 . indi1 = ti2 ;
  1332. indi1 = indi1 + 1 ;
  1333. xsi1 = xsi2 ;
  1334. fin b2 ;
  1335. geoi1 = geoi1 et geoi2 ;
  1336.  
  1337. * Retrait maillage cordon ic1 au maillage de tous les cordons
  1338. mail1 = mail1 diff maili1 ;
  1339. fin b1 ;
  1340. tab2 . evolution_maillage . temps = ttps1 ;
  1341. tab2 . evolution_maillage . maillage = tmai1 ;
  1342.  
  1343. *-------------------------- Sous-option TEMP --------------------------*
  1344.  
  1345. si imot2 ;
  1346.  
  1347. * Valeurs par defaut flot2 :
  1348. si (flot2 < 0.) ;
  1349. flot2 = flot1 / (tab1.vitesse_de_soudage) / pi ;
  1350. *list flot2 ;
  1351. fins ;
  1352.  
  1353. * Redecoupage de la liste des temps de l'evolution de la puissance thermique :
  1354. evqt1 = tab1.evolution_puissance ;
  1355. ltqt1 = extr evqt1 absc ;
  1356. lqqt1 = extr evqt1 ordo ;
  1357. tol2 = 1.e-6 * (maxi lqqt1) ;
  1358.  
  1359. nb1 = dime ltqt1 ;
  1360. t0 = extr ltqt1 1 ;
  1361. q0 = extr lqqt1 1 ;
  1362. ltca1 = prog t0 ;
  1363. repe b1 (nb1 - 1) ;
  1364. ip1 = &b1 + 1 ;
  1365. t1 = extr ltqt1 ip1 ;
  1366. q1 = extr lqqt1 ip1 ;
  1367. dt1 = t1 - t0 ;
  1368. si (&b1 ega 1) ; dt0 = dt1 ; fins ;
  1369. si (dt1 &lt;EG flot2) ;
  1370. ltca1 = ltca1 et (prog t1) ;
  1371. t0 = t1 ;
  1372. q0 = q1 ;
  1373. dt0 = dt1 ;
  1374. iter b1 ;
  1375. fins ;
  1376. si ((q0 > tol2) ou (q1 > tol2)) ;
  1377. ltca1 = ltca1 et ((prog t0 pas flot2 t1) enle 1) ;
  1378. sino ;
  1379. * mess 'dt0 = ' dt0 ;
  1380. * mess 'flot2 = ' flot2 ;
  1381. * mess 'dtf1 = ' dtf1 ;
  1382. ltca1 = ltca1 et ((prog t0 pas dt0 geom 2. t1) enle 1) ;
  1383. fins ;
  1384. t0 = t1 ;
  1385. q0 = q1 ;
  1386. ntca1 = dime ltca1 ;
  1387. dt0 = (ltca1 extr ntca1) - (ltca1 extr (ntca1-1)) ;
  1388. fin b1 ;
  1389.  
  1390. * Verification si liste temps calcules bien ordonnee :
  1391. ltca2 = ordo ltca1 ;
  1392. si (((ltca2 - ltca1) maxi abs) > (1.e-3*flot2)) ;
  1393. erre '***** ERREUR WAAM dans construction liste TEMPS_CALCULES' ;
  1394. quit waam ;
  1395. fins ;
  1396.  
  1397. tab2.temps_calcules = ltca1 ;
  1398.  
  1399. * Fin sous-option TEMP :
  1400. fins ;
  1401.  
  1402. * Sortie de la table resultat :
  1403. resp tab2 ;
  1404. quit soudage ;
  1405.  
  1406. * Fin option MAIL :
  1407. fins ;
  1408.  
  1409. *----------------------------------------------------------------------*
  1410. * FIN *
  1411. *----------------------------------------------------------------------*
  1412.  
  1413. * MOT1 n'est pas un des mots-cles des options de la procedure :
  1414. si (icas1 ega 0) ;
  1415. erre '***** ERREUR : MOT-cle option SOUDAGE non reconnu.' ;
  1416. quit soudage ;
  1417. fins ;
  1418.  
  1419. FINP ;
  1420.  
  1421.  
  1422.  
  1423.  
  1424.  
  1425.  
  1426.  

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