Télécharger la plaquette Cast3M


fr en

Télécharger soudage.procedur

Retour à la liste

Numérotation des lignes : 

  1. * SOUDAGE   PROCEDUR  SP204843  25/04/25    21:15:06     12252          
  2. DEBP SOUDAGE TAB1*'TABLE' ; 
  3.  
  4. *-------------- Analyse donnees table de fabrication --------------* 
  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. * mettre a VRAI pou // PVEC sur liste de vecteurs.
  44. * FAUX car probleme // avec creation points (COMMON MCOORD).
  45. ipara1 = faux ;
  46.  
  47. *-------------------------- Initialisations ---------------------------* 
  48.  
  49. * Test dimension 3 : 
  50. si ((vale dime) neg 3) ; 
  51.   erreur '*****  SOUDAGE : fonctionne uniquement en dimension 3' ; 
  52.   quit soudage ; 
  53. fins ; 
  54.  
  55. * Indicateur 1er appel a soudage : 
  56. si (exis tab1 'TRAJECTOIRE') ; 
  57.   idebut1  = faux ; 
  58. sino ; 
  59.   idebut1  = vrai ; 
  60. fins ; 
  61.  
  62. * icas1 = 1 / 2 / 3 / 4 pour POINT / PASSE / DEPLA / MAIL 
  63. * Si 0 in fine : erreur. 
  64. icas1    = 0 ; 
  65.  
  66. * Vecteur nul pour dupliquer points lus : 
  67. Pnul1    = 0 0 0 ; 
  68.  
  69. *------------------------- Lecture des options ------------------------* 
  70.  
  71. argu MOT1*'MOT' ; 
  72.  
  73. *----------------------------------------------------------------------* 
  74. *                             Option POINT                             * 
  75. *----------------------------------------------------------------------* 
  76.  
  77. si (ega mot1 'POINT') ; 
  78.   icas1    = 1 ; 
  79.  
  80. * Lecture des arguments de l'option : 
  81.   argu FLOT1*'FLOTTANT' ; 
  82.  
  83. * Lecture Arguments PUIS, DEBI, EVEN et DIRE option POINT : 
  84.   imot2    = faux ; imot3    = faux ; imot4    = faux ;  imot5    = faux ;
  85.   ieve1    = faux ; 
  86.   repe b1 4 ; 
  87.     argu MOT2/'MOT' ; 
  88.     si (non (exis mot2)) ; quit B1 ; fins ; 
  89.     si (ega mot2 'PUIS') ; 
  90.       imot2    = vrai ; 
  91.       argu qtot1*'FLOTTANT' ; 
  92.     fins ; 
  93.     si (ega mot2 'DEBI') ; 
  94.       imot3    = vrai ; 
  95.       argu debi1*'FLOTTANT' ; 
  96.     fins ; 
  97.     si (ega mot2 'DIRE') ; 
  98.       imot5    = vrai ; 
  99.       argu pdir1*'POINT' ; 
  100.       ndir1    = norm pdir1 ;
  101.       zprec1   = vale prec ;
  102.       si ((abs ndir1) < zprec1) ;
  103.         erre 239 ;
  104.       fins ;
  105.       pdir1    = pdir1 / (norm pdir1) ;
  106.     fins ; 
  107.     si (ega mot2 'EVEN') ; 
  108.       imot4    = vrai ; 
  109.       argu even1*'MOT' ; 
  110.       argu teve1/'FLOTTANT' ; 
  111.       ieve1    = exis teve1 ; 
  112.     fins ; 
  113.   fin b1 ; 
  114.   si (non imot2) ; 
  115.     qtot1    = tab1.puissance_de_soudage ; 
  116.   fins ; 
  117.   si (non imot3) ; 
  118.     debi1    = tab1.debit_de_fil ; 
  119.   fins ; 
  120.   si (non imot5) ;
  121.     si (exis tab1 orientation_soudure) ;
  122.       pdir1    = tab1.orientation_soudure ;
  123.       ndir1    = norm pdir1 ;
  124.       zprec1   = vale prec ;
  125.       si ((abs ndir1) < zprec1) ;
  126.         erre 239 ;
  127.       fins ;
  128.       pdir1    = pdir1 / (norm pdir1) ;
  129.     sino ;
  130.       erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
  131.     fins ;
  132.   fins ;
  133. *list qtot1 ; 
  134. *list debi1 ; 
  135. *list idebut1 ; 
  136. *list pdir1 ;
  137. * 
  138. * idtcp1   : temps de coupure ou pas ?
  139. * iqtot1   : on chauffe ou pas ?
  140.   idtcp1   = faux ; 
  141.   iqtot1   = faux ;
  142.   si idebut1 ; 
  143.     iqtot1   = qtot1 > 0. ;
  144.   sino ;
  145.     evqtot0  = tab1.evolution_puissance ; 
  146.     lqtot0   = extr evqtot0 ordo ; 
  147.     qtot0    = extr lqtot0 (dime lqtot0) ; 
  148.     idtcp1   = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ; 
  149.  
  150.     qmax1    = maxi (prog qtot0 qtot1) ;
  151.     iqtot1   = qtot1 > (1.e-4 * qmax1) ;
  152.  
  153.     evdebi0  = tab1.evolution_debit ; 
  154.     ldebi0   = extr evdebi0 ordo ; 
  155.     debi0    = extr ldebi0 (dime ldebi0) ; 
  156.     idtcp1   = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
  157.   fins ; 
  158. *  idtcp1   = idtcp1 ou ieve1 ; 
  159.   si idtcp1 ; 
  160. *    si ieve1 ; 
  161. *      dtcp1    = teve1 ; 
  162. *    sino ; 
  163.       dtcp1    = tab1.temps_de_coupure ; 
  164. *    fins ; 
  165.     flot1    = flot1 + dtcp1 ; 
  166.   fins ; 
  167.  
  168. * Evolution puissance option POINT : 
  169.   si idebut1 ; 
  170.     ltps1    = prog    0. flot1 ; 
  171.     lqtot1   = prog qtot1 qtot1 ; 
  172.     lti1     = ltps1 ; 
  173.   sino ; 
  174.     evqtot0  = tab1.evolution_puissance ; 
  175.     ltps0    = extr evqtot0 absc ; 
  176.     lqtot0   = extr evqtot0 ordo ; 
  177.     tps0     = extr  ltps0 (dime  ltps0) ; 
  178.     qtot0    = extr lqtot0 (dime lqtot0) ; 
  179. *   Si la puissance indiquee est differente de celle existante : 
  180.     si ((abs(qtot0-qtot1)) > (abs(1.e-4*qtot1))) ; 
  181. *     Ajout temps de coupure au temps de realisation du POINT : 
  182.       ltps1    = prog (tps0 + dtcp1) (tps0 + flot1) ; 
  183.       lqtot1   = prog          qtot1          qtot1 ; 
  184.     sino ; 
  185.       ltps1    = prog (tps0 + flot1) ; 
  186.       lqtot1   = prog          qtot1 ; 
  187.     fins ; 
  188.     lti1     = prog tps0 (tps0 + flot1) ; 
  189.     ltps1    =  ltps0 et  ltps1 ; 
  190.     lqtot1   = lqtot0 et lqtot1 ; 
  191.   fins ; 
  192.   evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
  193.  
  194. * Evolution debit POINT : 
  195.   si idebut1 ; 
  196.     ltps1    = prog    0. flot1 ; 
  197.     ldebi1   = prog debi1 debi1 ; 
  198.   sino ; 
  199.     evdebi0  = tab1.evolution_debit ; 
  200.     ltps0    = extr evdebi0 absc ; 
  201.     ldebi0   = extr evdebi0 ordo ; 
  202.     tps0     = extr  ltps0 (dime  ltps0) ; 
  203.     debi0    = extr ldebi0 (dime ldebi0) ; 
  204. *   Si la puissance indiquee est differente de celle existante : 
  205.     si ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
  206. *     Ajout temps de coupure au temps de realisation du POINT : 
  207.       ltps1    = prog (tps0 + dtcp1) (tps0 + flot1) ; 
  208.       ldebi1   = prog          debi1          debi1 ; 
  209.       lqi1     = prog 1. 1. ; 
  210.     sino ; 
  211.       ltps1    = prog (tps0 + flot1) ; 
  212.       ldebi1   = prog          debi1 ; 
  213.       lqi1     = prog 1. ; 
  214.     fins ; 
  215.     ltps1    =  ltps0 et  ltps1 ; 
  216.     ldebi1   = ldebi0 et ldebi1 ; 
  217.   fins ; 
  218.   evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
  219.  
  220. * Evolution deplacement POINT : 
  221.   si idebut1 ; 
  222.     ltps1    = prog 0. flot1 ; 
  223.     ldep1    = prog 0.    0. ; 
  224.     tps0     = 0. ; 
  225.   sino ; 
  226.     evdep0   = tab1.evolution_deplacement ; 
  227.     ltps0    = extr evdep0 absc ; 
  228.     ldep0    = extr evdep0 ordo ; 
  229.     tps0     = extr ltps0 (dime  ltps0) ; 
  230.     dep0     = extr ldep0 (dime ldep0) ; 
  231.     ltps1    = prog (tps0 + flot1) ; 
  232.     ldep1    = prog           dep0 ; 
  233.     ltps1    = ltps0 et ltps1 ; 
  234.     ldep1    = ldep0 et ldep1 ; 
  235.   fins ; 
  236.   evdep1   = evol vert manu temp ltps1 ldep1 ; 
  237.  
  238. * Evenement : 
  239.   si imot4 ; 
  240.     ttev1    = table ;
  241.     ttev1 . nom   =  even1 ; 
  242.     si ieve1 ; 
  243.       ttev1 . temps = prog tps0 (tps0 + teve1) ; 
  244.     sino ; 
  245.       ttev1 . temps = prog tps0 ; 
  246.     fins ; 
  247. *list ttev1.temps ;
  248.     si (exis tab1 'EVENEMENTS') ; 
  249.       nbev1    = (dime tab1.evenements) + 1 ; 
  250.     sino ; 
  251.       tab1.evenements = table ; 
  252.       nbev1    = 1 ; 
  253.     fins ; 
  254.     tab1.evenements.nbev1 = ttev1 ; 
  255.   fins ; 
  256.  
  257. * Evolution direction POINT (que si on soude) :
  258.   si iqtot1 ;
  259.  
  260. *   Direction transverse (DIRL) :
  261.     xdir1 ydir1 zdir1 = pdir1 coor ;
  262.     si ((abs xdir1) > (abs ydir1)) ;
  263.       si ((abs zdir1) > (abs ydir1)) ;
  264.         pdirl1   = zdir1 0. (-1. * xdir1) ;
  265.       sino ;
  266.         pdirl1   = (-1. * ydir1) xdir1 0. ;
  267.       fins ;
  268.     sino ;
  269.       si ((abs xdir1) > (abs zdir1)) ;
  270.         pdirl1   = (-1. * ydir1) xdir1 0. ;
  271.       sino ;
  272.         pdirl1   = 0. (-1. * zdir1) ydir1 ;
  273.       fins ;
  274.     fins ;
  275.     pdirl1   = pdirl1 / (norm pdirl1) ;
  276.  
  277.     si idebut1 ;
  278.       ltps1    = prog    0. flot1 ;
  279.       ldir1    = enum pdir1 pdir1 ;
  280.       ldirl1   = enum pdirl1 pdirl1 ;
  281.     sino ;
  282.       si (exis tab1 evolution_orientation) ;
  283.         cgdir0   = tab1.evolution_orientation ;
  284.         ltps0    = extr cgdir0 lree dire ;
  285.         ldir0    = extr cgdir0 lobj dire ;
  286.         ldirl0   = extr cgdir0 lobj dirl ;
  287.         tps0dir  = extr ltps0 (dime  ltps0) ;
  288.         pdir0    = extr ldir0 (dime  ltps0) ;
  289.         si (tps0dir ega tps0) ;
  290.           xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
  291.           si (xcolli1 neg 1.) ;
  292.             erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
  293.           fins ;
  294.           ltps1    = prog  (tps0 + flot1) ;
  295.           ldir1    = enum           pdir1 ;
  296.           ldirl1   = enum          pdirl1 ;
  297.         sino ;
  298.           ltps1    = prog   tps0 (tps0 + flot1) ;
  299.           ldir1    = enum  pdir1          pdir1 ;
  300.           ldirl1   = enum pdirl1         pdirl1 ;
  301.         fins ;
  302.         ltps1    = ltps0 et ltps1 ;
  303.         ldir1    = ldir0 et ldir1 ;
  304.         ldirl1   = ldirl0 et ldirl1 ;
  305.       sino ;
  306.         ltps1    = prog   tps0 (tps0 + flot1) ;
  307.         ldir1    = enum  pdir1          pdir1 ;
  308.         ldirl1   = enum pdirl1         pdir11 ;
  309.       fins ;
  310.     fins ;
  311.     cgdir1   = char dire ltps1 ldir1 ;
  312. *   Direction transverse (DIRL) :
  313.     cgdir2   = char dirl ltps1 ldirl1 ;
  314.     cgdir1   = cgdir1 et cgdir2 ;
  315.   fins ;
  316.  
  317. * Enregistrement donnees POINT 
  318.   si (exis tab1 points) ; 
  319.     npt1     = dime tab1.points ; 
  320.   sino ; 
  321.     npt1     = 0 ; 
  322.     tab1.points = table ; 
  323.   fins ; 
  324.   npt1     = npt1 + 1 ; 
  325.   tab1.points.npt1 = table ; 
  326.   tab1.points.npt1.point     = P1 ; 
  327.   tab1.points.npt1.instants  = lti1 ; 
  328.   tab1.points.npt1.puissance = qtot1 ; 
  329.   tab1.points.npt1.debit     = debi1 ; 
  330.  
  331. * Enregistrements en fin de traitement option pour eviter
  332. * modifier table avant fin realisation option
  333.   si idebut1 ; 
  334.     P1     = tab1.point_de_depart plus Pnul1 ; 
  335.     tab1.trajectoire = manu poi1 P1 ; 
  336.   fins ; 
  337.   tab1.evolution_puissance = evqtot1 ; 
  338.   tab1.evolution_debit = evdebi1 ; 
  339.   tab1.evolution_deplacement = evdep1 ; 
  340.   si iqtot1 ;
  341.     tab1.evolution_orientation = cgdir1 ;
  342.   fins ;
  343.  
  344.   quit soudage ; 
  345. * Fin option POINT : 
  346. fins ; 
  347.  
  348. *----------------------------------------------------------------------* 
  349. *                             Option PASSE                             * 
  350. *----------------------------------------------------------------------* 
  351. si (ega mot1 'PASSE') ; 
  352.   icas1    = 2 ; 
  353.  
  354. * Lecture des arguments de l'option : 
  355.   argu MOT2*'MOT' ; 
  356.  
  357. * Triatement particulier option CERC ordre arguments : 
  358.   si (ega mot2 'CERC') ; 
  359.     argu N1/ENTIER ; 
  360.   fins ; 
  361.  
  362. * Lecture arguments RELA/ABSO, VITE, PUIS, DEBI 
  363.   imot3    = faux ; comm mot-cle 'ABSO' ;
  364.   imot4    = faux ; comm mot-cle 'VITE' ;
  365.   imot5    = faux ; comm mot-cle 'PUIS' ;
  366.   imot6    = faux ; comm mot-cle 'DEBI' ;
  367.   imot7    = faux ; comm mot-cle 'EVEN' ;
  368.   imot8    = faux ; comm mot-cle 'DIRE' ;
  369.   imot9    = faux ; comm mot-cle 'PART' ;
  370.   imot10   = faux ; comm mot-cle 'LARG' ;
  371.   irela1   = vrai ; 
  372.   ieve1    = faux ; 
  373.   iradext1 = faux ;
  374.   iradint1 = faux ;
  375.   icouche1 = faux ;
  376.   repe b1 20 ; comm on itere volontairement plus que necessaire ;
  377.     argu mot3/'MOT' ; 
  378.     si (non (exis mot3)) ; quit b1; fins ; 
  379.     si (ega mot3 'ABSO') ; 
  380.       imot3    = vrai ; 
  381.       irela1   = faux ; 
  382.     fins ; 
  383.     si (ega mot3 'VITE') ; 
  384.       imot4    = vrai ; 
  385.       argu vdep1*'FLOTTANT' ; 
  386.     fins ; 
  387.     si (ega mot3 'PUIS') ; 
  388.       imot5    = vrai ; 
  389.       argu qtot1*'FLOTTANT' ; 
  390.     fins ; 
  391.     si (ega mot3 'DEBI') ; 
  392.       imot6    = vrai ; 
  393.       argu debi1*'FLOTTANT' ; 
  394.     fins ; 
  395.     si (ega mot3 'EVEN') ; 
  396.       imot7    = vrai ; 
  397.       argu even1*'MOT' ; 
  398.       argu teve1/'FLOTTANT' ; 
  399.       ieve1    = exis teve1 ; 
  400.     fins ; 
  401.     si (ega mot3 'DIRE') ; 
  402.       imot8    = vrai ; 
  403.     fins ; 
  404.     si (ega mot3 'RADEXT') ;
  405.       iradext1 = vrai ;
  406.     fins ;
  407.     si (ega mot3 'RADINT') ;
  408.       iradint1 = vrai ;
  409.     fins ;
  410.     si (ega mot3 'PART') ;
  411.       imot9    = vrai ;
  412.       argu numpart1*'ENTIER' ;
  413.       argu mot3b/'MOT' ;
  414.       si ((exis mot3b) et (ega mot3b 'COUCHE')) ;
  415.         icouche1 = vrai ;
  416.       fins ;
  417.     fins ;
  418.     si (ega mot3 'LARG') ;
  419.       imot10   = vrai ;
  420.       argu larg1*'FLOTTANT' ;
  421.     fins ;
  422.  
  423.   fin b1 ; 
  424.  
  425. * Vitesse & Increment de temps PASSE : 
  426.   si (non imot4) ; 
  427.     vdep1    = tab1.vitesse_de_soudage ; 
  428.   fins ; 
  429.  
  430. * Puissance PASSE : 
  431.   si (non imot5) ; 
  432.     qtot1    = tab1.puissance_de_soudage ; 
  433.   fins ; 
  434.  
  435. * Debit PASSE : 
  436.   si (non imot6) ; 
  437.     debi1    = tab1.debit_de_fil ; 
  438.   fins ; 
  439.  
  440. * Largeur de passe :
  441.   ilarg1   = imot10 ou (exis tab1 'LARGEUR_DE_PASSE') ;
  442.   si ((non imot10) et ilarg1) ;
  443.     larg1    = tab1.largeur_de_passe ;
  444.   fins ;
  445. *list vdep1 ; 
  446. *list qtot1 ; 
  447. *list debi1 ; 
  448.  
  449. * idtcp1   : temps de coupure ou pas ?
  450. * iqtot1   : on chauffe ou pas ?
  451.   idtcp1   = faux ; 
  452.   iqtot1   = faux ;
  453.   si idebut1 ; 
  454.     iqtot1   = qtot1 > 0. ;
  455.   sino ;
  456.     evqtot0  = tab1.evolution_puissance ; 
  457.     lqtot0   = extr evqtot0 ordo ; 
  458.     qtot0    = extr lqtot0 (dime lqtot0) ; 
  459.     idtcp1   = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ; 
  460.  
  461.     qmax1    = maxi (prog qtot0 qtot1) ;
  462.     iqtot1   = qtot1 > (1.e-4 * qmax1) ;
  463.  
  464.     evdebi0  = tab1.evolution_debit ; 
  465.     ldebi0   = extr evdebi0 ordo ; 
  466.     debi0    = extr ldebi0 (dime ldebi0) ; 
  467.     idtcp1   = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
  468.   fins ; 
  469. *  idtcp1   = idtcp1 ou ieve1 ; 
  470. *list idtcp1 ; 
  471.   si idtcp1 ; 
  472. *    si ieve1 ; 
  473. *      dtcp1    = teve1 ; 
  474. *    sino ; 
  475.       dtcp1    = tab1.temps_de_coupure ; 
  476. *    fins ; 
  477.   fins ; 
  478.  
  479. * Indications PART et changement de COUCHE :
  480. * Initialisation de PART_COURANTE et NB_COUCHES_PART si besoin :
  481.   si (exis tab1 'PART_COURANTE') ;
  482.     ipar1    = tab1.part_courante ;
  483.     si imot9 ;
  484.       si icouche1 ;
  485.         si (ipar1 ega numpart1) ;
  486.           erre '***** SOUDAGE : on ne peut pas changer de COUCHE dans la meme PART' ;
  487.         fins ;
  488.         si (non (exis tab1.nb_couches_part numpart1)) ;
  489.           tab1.nb_couches_part.numpart1 = 1 ;
  490.         sino ;
  491.           icou1    = tab1.nb_couches_part.numpart1 ;
  492.           tab1.nb_couches_part.numpart1 = icou1 + 1 ;
  493.         fins ;
  494.       sino ;
  495.         si (non (exis tab1.nb_couches_part numpart1)) ;
  496.           tab1.nb_couches_part.numpart1 = 1 ;
  497.         fins ;
  498.       fins ;
  499.       tab1.part_courante = numpart1 ;
  500.     fins ;
  501.   sino ;
  502.     si (non imot9) ;
  503.       numpart1 = 1 ;
  504.     fins ;
  505.     tab1.part_courante = numpart1 ;
  506.     tab1.nb_couches_part = table ;
  507.     tab1.nb_couches_part.numpart1 = 1 ;
  508.   fins ;
  509.   ipar1    = tab1.part_courante ;
  510.   icou1    = tab1.nb_couches_part.ipar1 ;
  511.  
  512. * icas2 = indicateur sous-option realisee : 
  513.   icas2    = 0 ; 
  514.  
  515. *----------------------------- PASSE DROI -----------------------------* 
  516. * Sous-option DROI : 
  517.   si (ega mot2 'DROI') ; 
  518.     icas2    = 1 ; 
  519.  
  520. *   Lecture du point : 
  521.     argu P1*'POINT' ; 
  522.     P1       = P1 plus Pnul1 ; 
  523.  
  524. *   Lecture orientation de soudure :
  525.     ipdir1   = faux ;
  526.     si imot8 ;
  527.       argu pdir1/'POINT' ;
  528.       ipdir1   = exis pdir1 ;
  529.       si (non ipdir1) ;
  530.         argu pdir1*'LISTOBJE' ;
  531.         si (neg (extr pdir1 type) 'POINT') ;
  532.           erre '***** SOUDAGE : le LISTOBJE ne contient pas des objets POINT' ;
  533.         fins ;
  534.         si (vide pdir1) ;
  535.           erre '***** SOUDAGE : le LISTOBJ est vide' ;
  536.         fins ;
  537.       fins ;
  538.     fins ;
  539.     si (non imot8) ;
  540.       si (exis tab1 orientation_soudure) ;
  541.         pdir1    = tab1.orientation_soudure ;
  542.         ipdir1   = vrai ;
  543.       sino ;
  544.         erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
  545.       fins ;
  546.     fins ;
  547. *list pdir1 ;
  548.  
  549. *   Trajectoire PASSE DROI : 
  550.     si idebut1 ; 
  551.       P0       = tab1.point_de_depart plus Pnul1 ; 
  552. *     Deplacements relatifs : 
  553.       si irela1 ; 
  554.         P1       = P0 plus P1 ; 
  555.       fins ; 
  556.       mail1    = P0 droi 1 P1 ; 
  557.       mail1    = mail1 coul roug ; 
  558.       ll1      = mesu mail1 ; 
  559.       maili1   = mail1 ; 
  560.     sino ; 
  561.       mail0    = tab1.trajectoire ; 
  562.       nbpts0   = nbno mail0 ; 
  563.       P0       = mail0 poin nbpts0 ; 
  564. *     Deplacements relatifs : 
  565.       si irela1 ; 
  566.         P1       = P0 plus P1 ; 
  567.       fins ; 
  568.       mail1    = P0 droi 1 P1 ; 
  569.       mail1    = mail1 coul roug ; 
  570.       ll1      = mesu mail1 ; 
  571.       maili1   = mail1 ; 
  572.       si (nbpts0 > 1) ; 
  573.         mail1    = mail0 et mail1 ; 
  574.       fins ; 
  575.     fins ; 
  576.  
  577. *   Increment de temps : 
  578.     dt1    = ll1 / vdep1 ; 
  579.     si idtcp1 ; 
  580.       dt1    = dt1 + dtcp1 ; 
  581.     fins ; 
  582.  
  583. *   Evolution puissance PASSE DROI : 
  584.     si idebut1 ; 
  585.       ltps1    = prog    0.   dt1 ; 
  586.       lqtot1   = prog qtot1 qtot1 ; 
  587.       lti1     = ltps1 ; 
  588.     sino ; 
  589.       ltps0    = extr evqtot0 absc ; 
  590.       tps0     = extr  ltps0 (dime  ltps0) ; 
  591. *     Si la puissance indiquee est differente de celle existante : 
  592.       si idtcp1 ; 
  593.         lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  594.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  595.         lqtot1   = prog          qtot1        qtot1 ; 
  596.       sino ; 
  597.         lti1     = prog tps0 (tps0 + dt1) ; 
  598.         ltps1    = prog (tps0 + dt1) ; 
  599.         lqtot1   = prog        qtot1 ; 
  600.       fins ; 
  601.       ltps1    =  ltps0 et  ltps1 ; 
  602.       lqtot1   = lqtot0 et lqtot1 ; 
  603.     fins ; 
  604.     evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
  605.  
  606. *   Evolution debit PASSE DROI : 
  607.     si idebut1 ; 
  608.       ltps1    = prog    0.   dt1 ; 
  609.       ldebi1   = prog debi1 debi1 ; 
  610.     sino ; 
  611.       ltps0    = extr evdebi0 absc ; 
  612.       tps0     = extr  ltps0 (dime  ltps0) ; 
  613. *     Si la puissance indiquee est differente de celle existante : 
  614.       si idtcp1 ; 
  615.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  616.         ldebi1   = prog          debi1        debi1 ; 
  617.       sino ; 
  618.         ltps1    = prog (tps0 + dt1) ; 
  619.         ldebi1   = prog        debi1 ; 
  620.       fins ; 
  621.       ltps1    =  ltps0 et  ltps1 ; 
  622.       ldebi1   = ldebi0 et ldebi1 ; 
  623.     fins ; 
  624.     evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
  625.  
  626. *   Evolution deplacement PASSE DROI : 
  627.     si idebut1 ; 
  628.       ltps1    = prog 0. dt1 ; 
  629.       ldep1    = prog 0. ll1 ; 
  630.     tps0     = 0. ; 
  631.     sino ; 
  632.       evdep0   = tab1.evolution_deplacement ; 
  633.       ltps0    = extr evdep0 absc ; 
  634.       ldep0    = extr evdep0 ordo ; 
  635.       tps0     = extr ltps0 (dime ltps0) ; 
  636.       dep0     = extr ldep0 (dime ldep0) ; 
  637.       si idtcp1 ; 
  638.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  639.         ldep1    = prog           dep0 (dep0 + ll1) ; 
  640.       sino ; 
  641.         ltps1    = prog (tps0 + dt1) ; 
  642.         ldep1    = prog (dep0 + ll1) ; 
  643.       fins ; 
  644.       ltps1    = ltps0 et ltps1 ; 
  645.       ldep1    = ldep0 et ldep1 ; 
  646.     fins ; 
  647.     ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
  648.     evdep1   = evol vert manu temp ltps1 ldep1 ; 
  649.  
  650. *   Evenement : 
  651.     si imot7 ; 
  652.       ttev1    = table ;
  653.       ttev1 . nom   =  even1 ; 
  654.       si ieve1 ; 
  655.         ttev1 . temps = prog tps0 (tps0 + teve1) ; 
  656.       sino ; 
  657.         ttev1 . temps = prog tps0 ; 
  658.       fins ; 
  659.       si (exis tab1 'EVENEMENTS') ; 
  660.         nbev1    = (dime tab1.evenements) + 1 ; 
  661.       sino ; 
  662.         tab1.evenements = table ; 
  663.         nbev1    = 1 ; 
  664.       fins ; 
  665.       tab1.evenements.nbev1 = ttev1 ; 
  666.     fins ; 
  667.  
  668. *   Evolution direction PASSE DROIT (si on soude) :
  669.     si iqtot1 ;
  670.       si idebut1 ;
  671.         si ipdir1 ;
  672.           ltps1    = prog    0.   dt1 ;
  673.           ldir1    = enum pdir1 pdir1 ;
  674. *         Direction transverse (DIRL) :
  675.           pdirl1   = (P1 moin P0) pvec pdir1 ;
  676.           pdirl1   = pdirl1 / (norm pdirl1) ;
  677.           ldirl1   = enum pdirl1 pdirl1 ;
  678.         sino ;
  679. *         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
  680.           nbdir1   = dime pdir1 ;
  681.           si (nbdir1 ega 1) ;
  682.             pdir1    = pdir1 et (pdir1 extr 1) ;
  683.             nbdir1   = 2 ;
  684.           fins ;
  685.           ltps1    = prog 0. ;
  686.           tpsi1    = 0. ;
  687.           nbdir1   = nbdir1 - 1 ;
  688.           dti1     = dt1 / (flot nbdir1) ;
  689.           repe bdir1 nbdir1 ;
  690.             tpsi1    = tpsi1 + dti1 ;
  691.             si (&bdir1 ega nbdir1) ; tpsi1 = dt1 ; fins ;
  692.             ltps1    = ltps1 et tpsi1 ;
  693.           fin bdir1 ;
  694.           ldir1    = pdir1 ;
  695. *         Direction transverse (DIRL) :
  696.           si ipara1 ;
  697.             ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
  698.             opti para vrai ; mess 'ici 1' ;
  699.             ldirl2   = pvec ldirl1 ldir1 ;
  700.             opti para faux ;
  701.           sino ;
  702.             ldirl2   = enum ;
  703.             pdirn1   = P1 moin P0 ;
  704.             repe bx (dime ldir1) ;
  705.               pnx = ldir1 extr &bx ;
  706.               plx = pvec pdirn1 pnx ;
  707.               ldirl2 = ldirl2 et plx ;
  708.             fin bx ;
  709.           fins ;
  710.           ldirl1   = ldirl2 ;
  711.         fins ;
  712.         ltpsl1   = ltps1  ;
  713.       sino ;
  714.         si (exis tab1 evolution_orientation) ;
  715.           cgdir0   = tab1.evolution_orientation ;
  716.           ltps0    = extr cgdir0 lree dire ;
  717.           ldir0    = extr cgdir0 lobj dire ;
  718.           ltpsl0   = extr cgdir0 lree dirl ;
  719.           ldirl0   = extr cgdir0 lobj dirl ;
  720.           tps0dir  = extr ltps0 (dime  ltps0) ;
  721.           pdir0    = extr ldir0 (dime  ltps0) ;
  722.           si (tps0dir ega tps0) ;
  723.             si ipdir1 ;
  724.               xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
  725.               si (xcolli1 neg 1.) ;
  726.                 erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
  727.               fins ;
  728.               ltps1    = prog  (tps0 + dt1) ;
  729.               ldir1    = enum         pdir1 ;
  730. *             Direction transverse (DIRL) :
  731.               pdirl1   = (P1 moin P0) pvec pdir1 ;
  732.               pdirl1   = pdirl1 / (norm pdirl1) ;
  733.               ldirl1   = enum pdirl1 ;
  734.               pdirl0   = extr ldirl0 (dime ldirl0) ;
  735.               pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
  736. *si ((norm pdirl10) < 1.e-10) ; mess '**** passe droi cas 1' ; list pdirl10 ; fins ;
  737.               si ((norm pdirl10) > 1.e-3) ;
  738.                 ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
  739.               fins ;
  740.             sino ;
  741.               pdiri1   = pdir1 extr 1 ;
  742.               xcolli1  = (psca pdir0 pdiri1) / (norm pdir0) / (norm pdiri1) ;
  743.               si (xcolli1 neg 1.) ;
  744.                 erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
  745.               fins ;
  746.               nbdir1   = dime pdir1 ;
  747.               si (nbdir1 ega 1) ;
  748.                 pdir1    = pdir1 et (pdir1 extr 1) ;
  749.                 nbdir1   = 2 ;
  750.               fins ;
  751.               ltps1    = prog ;
  752.               tpsi1    = tps0 ;
  753.               nbdir1   = nbdir1 - 1 ;
  754.               dti1     = dt1 / (flot nbdir1) ;
  755.               repe bdir1 nbdir1 ;
  756.                 tpsi1    = tpsi1 + dti1 ;
  757.                 si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  758.                 ltps1    = ltps1 et tpsi1 ;
  759.               fin bdir1 ;
  760.               ldir1    = pdir1 enle 1 ;
  761. *             Direction transverse (DIRL) :
  762.               si ipara1 ;
  763.                 ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
  764.                 opti para vrai ; mess 'ici 2' ;
  765.                 ldirl2   = pvec ldirl1 ldir1 ;
  766.                 opti para faux ;
  767.               sino ;
  768.                 ldirl2   = enum ;
  769.                 pdirn1   = P1 moin P0 ;
  770.                 repe bx (dime ldir1) ;
  771.                   pnx = ldir1 extr &bx ;
  772.                   plx = pvec pdirn1 pnx ;
  773.                   ldirl2 = ldirl2 et plx ;
  774.                 fin bx ;
  775.               fins ;
  776.               ldirl1   = ldirl2 ;
  777.               pdirl1   = extr ldirl1 1 ;
  778.               pdirl0   = extr ldirl0 (dime ldirl0) ;
  779.               pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
  780. *si ((norm pdirl10) < 1.e-10) ; mess '**** passe droi cas 2' ; list pdirl10 ; fins ;
  781.               si ((norm pdirl10) > 1.e-3) ;
  782.                 ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
  783.               fins ;
  784.             fins ;
  785.           sino ;
  786.             si ipdir1 ;
  787.               ltps1    = prog  tps0 (tps0 + dt1) ;
  788.               ldir1    = enum pdir1        pdir1 ;
  789. *             Direction transverse (DIRL) :
  790.               pdirl1   = (P1 moin P0) pvec pdir1 ;
  791.               pdirl1   = pdirl1 / (norm pdirl1) ;
  792.               ldirl1   = enum pdirl1 pdirl1 ;
  793.             sino ;
  794.               nbdir1   = dime pdir1 ;
  795.               si (nbdir1 ega 1) ;
  796.                 pdir1    = pdir1 et (pdir1 extr 1) ;
  797.                 nbdir1   = 2 ;
  798.               fins ;
  799.               ltps1    = prog tps0 ;
  800.               tpsi1    = tps0 ;
  801.               nbdir1   = nbdir1 - 1 ;
  802.               dti1     = dt1 / (flot nbdir1) ;
  803.               repe bdir1 nbdir1 ;
  804.                 tpsi1    = tpsi1 + dti1 ;
  805.                 si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  806.                 ltps1    = ltps1 et tpsi1 ;
  807.               fin bdir1 ;
  808.               ldir1    = pdir1 ;
  809. *             Direction transverse (DIRL) :
  810.               si ipara1 ;
  811.                 ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
  812.                 opti para vrai ; mess 'ici 3' ;
  813.                 ldirl2   = pvec ldirl1 ldir1 ;
  814.                 opti para faux ;
  815.               sino ;
  816.                 ldirl2   = enum ;
  817.                 pdirn1   = P1 moin P0 ;
  818.                 repe bx (dime ldir1) ;
  819.                   pnx = ldir1 extr &bx ;
  820.                   plx = pvec pdirn1 pnx ;
  821.                   ldirl2 = ldirl2 et plx ;
  822.                 fin bx ;
  823.               fins ;
  824.               ldirl1   = ldirl2 ;
  825.             fins ;
  826.           fins ;
  827.           ltpsl1   = ltpsl0 et ltps1  ;
  828.           ltps1    = ltps0 et ltps1 ;
  829.           ldir1    = ldir0 et ldir1 ;
  830.           ldirl1   = ldirl0 et ldirl1 ;
  831.         sino ;
  832.           si ipdir1 ;
  833.             ltps1    = prog flot0   dt1 ;
  834.             ldir1    = enum pdir1 pdir1 ;
  835. *           Direction transverse (DIRL) :
  836.             pdirl1   = (P1 moin P0) pvec pdir1 ;
  837.             pdirl1   = pdirl1 / (norm pdirl1) ;
  838.             ldirl1   = enum pdirl1 pdirl1 ;
  839.           sino ;
  840. *         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
  841.             nbdir1   = dime pdir1 ;
  842.             si (nbdir1 ega 1) ;
  843.               pdir1    = pdir1 et (pdir1 extr 1) ;
  844.               nbdir1   = 2 ;
  845.             fins ;
  846.             ltps1    = prog flot0 ;
  847.             tpsi1    = flot0 ;
  848.             nbdir1   = nbdir1 - 1 ;
  849.             dti1     = dt1 / (flot nbdir1) ;
  850.             repe bdir1 nbdir1 ;
  851.               tpsi1    = tpsi1 + dti1 ;
  852.               si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  853.               ltps1    = ltps1 et tpsi1 ;
  854.             fin bdir1 ;
  855.             ldir1    = pdir1 ;
  856. *           Direction transverse (DIRL) :
  857.             si ipara1 ;
  858.               ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
  859.               ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
  860.               opti para vrai ; mess 'ici 4' ;
  861.               ldirl2   = pvec ldirl1 ldir1 ;
  862.               opti para faux ;
  863.             sino ;
  864.               ldirl2   = enum ;
  865.               pdirn1   = P1 moin P0 ;
  866.               repe bx (dime ldir1) ;
  867.                 pnx = ldir1 extr &bx ;
  868.                 plx = pvec pdirn1 pnx ;
  869.                 ldirl2 = ldirl2 et plx ;
  870.               fin bx ;
  871.             fins ;
  872.             ldirl1   = ldirl2 ;
  873.           fins ;
  874.           ltpsl1   = ltps1  ;
  875.         fins ;
  876.       fins ;
  877.       cgdir1   = char dire ltps1 ldir1 ;
  878. *     Direction transverse (DIRL) :
  879.       cgdir2   = char dirl ltpsl1 ldirl1 ;
  880.       cgdir1   = cgdir1 et cgdir2 ;
  881.     fins ;
  882.  
  883. *   Enregistrement donnees PASSE DROI 
  884.     si (exis tab1 passes) ; 
  885.       nps1     = dime tab1.passes ; 
  886.     sino ; 
  887.       nps1     = 0 ; 
  888.       tab1.passes = table ; 
  889.     fins ; 
  890.     nps1     = nps1 + 1 ; 
  891.     tab1.passes.nps1 = table ; 
  892.  
  893.     tab1.passes.nps1.maillage  = maili1 ; 
  894.     tab1.passes.nps1.geometrie = mot 'DROI' ; 
  895.     tab1.passes.nps1.instants  = lti1 ; 
  896.     tab1.passes.nps1.vitesse   = vdep1 ; 
  897.     tab1.passes.nps1.puissance = qtot1 ; 
  898.     tab1.passes.nps1.debit     = debi1 ; 
  899.     tab1.passes.nps1.part      = ipar1 ; 
  900.     tab1.passes.nps1.couche    = icou1 ; 
  901.  
  902.     si ilarg1 ;
  903.       tab1.passes.nps1.largeur = larg1 ;
  904.     fins ; 
  905.  
  906. *   Enregistrements en fin de traitement option pour eviter
  907. *   modifier table avant fin realisation option
  908.     tab1.trajectoire = mail1 ; 
  909.     tab1.evolution_puissance = evqtot1 ; 
  910.     tab1.evolution_debit = evdebi1 ; 
  911.     tab1.evolution_deplacement = evdep1 ; 
  912.     si iqtot1 ;
  913.       tab1.evolution_orientation = cgdir1 ;
  914.     fins ;
  915.  
  916.     quit soudage ; 
  917. *   Fin option PASSE DROI : 
  918.   fins ; 
  919.  
  920. *----------------------------- PASSE CERC -----------------------------* 
  921. * Sous-option CERC : 
  922.   si (ega mot2 'CERC') ; 
  923.     icas2    = 2 ; 
  924.  
  925. *   P1 est le centre du cercle, P2, l'extremite de la trajectoire 
  926.     argu P2*'POINT' P1*'POINT' ; 
  927.     P1       = P1 plus Pnul1 ; 
  928.     P2       = P2 plus Pnul1 ; 
  929.  
  930. *   Lecture orientation de soudure :
  931.     ipdir1   = faux ;
  932.     iradx1   = iradext1 ou iradint1 ;
  933.     si imot8 ;
  934.       argu pdir1/'POINT' ;
  935.       ipdir1   = exis pdir1 ;
  936.     fins ;
  937.     si ((non imot8) et (non iradx1)) ;
  938.       si (exis tab1 orientation_soudure) ;
  939.         pdir1    = tab1.orientation_soudure ;
  940.         ipdir1   = vrai ;
  941.       sino ;
  942.         erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
  943.       fins ;
  944.     fins ;
  945. *list pdir1 ;
  946. *list iradext1 ;
  947. *list iradint1 ;
  948.  
  949. *   Trajectoire PASSE CERC : 
  950.     si idebut1 ; 
  951.       P0       = tab1.point_de_depart plus Pnul1 ; 
  952. *     Deplacements relatifs : 
  953.       si irela1 ; 
  954.         P1       = P0 plus P1 ; 
  955.         P2       = P0 plus P2 ; 
  956.       fins ; 
  957.       si (non (exis N1)) ; 
  958.         V1       = P0 moin P1 ; 
  959.         V2       = P2 moin P1 ; 
  960.         V1       = V1 / (norm V1) ; 
  961.         V2       = V2 / (norm V2) ; 
  962.         N1       = (acos (psca V1 V2)) / 5. ; 
  963.         N1       = maxi (lect (enti N1) 1) ; 
  964.       fins ; 
  965.       mail1    = CERC N1 P0 P1 P2 ; 
  966.       mail1    = mail1 coul roug ; 
  967.       maili1   = mail1 ; 
  968.       ll1      = mesu mail1 ; 
  969.     sino ; 
  970.       mail0    = tab1.trajectoire ; 
  971.       nbpts0   = nbno mail0 ; 
  972.       P0       = mail0 poin nbpts0 ; 
  973. *     Deplacements relatifs : 
  974.       si irela1 ; 
  975.         P1       = P0 plus P1 ; 
  976.         P2       = P0 plus P2 ; 
  977.       fins ; 
  978.       si (non (exis N1)) ; 
  979.         V1       = P0 moin P1 ; 
  980.         V2       = P2 moin P1 ; 
  981.         V1       = V1 / (norm V1) ; 
  982.         V2       = V2 / (norm V2) ; 
  983.         N1       = (acos (psca V1 V2)) / 5. ; 
  984.         N1       = maxi (lect (enti N1) 1) ; 
  985.       fins ; 
  986.       mail1    = CERC N1 P0 P1 P2 ; 
  987.       mail1    = mail1 coul roug ; 
  988.       maili1   = mail1 ; 
  989.       ll1      = mesu mail1 ; 
  990.       si (nbpts0 > 1) ; 
  991.         mail1    = mail0 et mail1 ; 
  992.       fins ; 
  993.     fins ; 
  994.  
  995. *   Normale unitaire au plan du cercle pour DIRL :
  996.     P1P0     = P1 moin P0 ;
  997.     P1P2     = P1 moin P2 ;
  998.     Pnc1     = pvec P1P0 P1P2 ;
  999.     Pnc1     = Pnc1 / (norm Pnc1) ;
  1000.  
  1001. *   Increment de temps : 
  1002.     dt1    = ll1 / vdep1 ; 
  1003.     si idtcp1 ; 
  1004.       dt1    = dt1 + dtcp1 ; 
  1005.     fins ; 
  1006.  
  1007. *   Evolution puissance PASSE CERC : 
  1008.     si idebut1 ; 
  1009.       ltps1    = prog    0.   dt1 ; 
  1010.       lqtot1   = prog qtot1 qtot1 ; 
  1011.       lti1     = ltps1 ; 
  1012.     sino ; 
  1013.       ltps0    = extr evqtot0 absc ; 
  1014.       tps0     = extr  ltps0 (dime  ltps0) ; 
  1015. *     Si la puissance indiquee est differente de celle existante : 
  1016.       si idtcp1 ; 
  1017.         lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1018.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1019.         lqtot1   = prog          qtot1        qtot1 ; 
  1020.       sino ; 
  1021.         lti1     = prog tps0 (tps0 + dt1) ; 
  1022.         ltps1    = prog (tps0 + dt1) ; 
  1023.         lqtot1   = prog        qtot1 ; 
  1024.       fins ; 
  1025.       ltps1    =  ltps0 et  ltps1 ; 
  1026.       lqtot1   = lqtot0 et lqtot1 ; 
  1027.     fins ; 
  1028.     evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
  1029.  
  1030. *   Evolution debit PASSE CERC : 
  1031.     si idebut1 ; 
  1032.       ltps1    = prog    0.   dt1 ; 
  1033.       ldebi1   = prog debi1 debi1 ; 
  1034.     sino ; 
  1035.       ltps0    = extr evdebi0 absc ; 
  1036.       tps0     = extr  ltps0 (dime  ltps0) ; 
  1037. *     Si la puissance indiquee est differente de celle existante : 
  1038.       si idtcp1 ; 
  1039.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1040.         ldebi1   = prog          debi1        debi1 ; 
  1041.       sino ; 
  1042.         ltps1    = prog (tps0 + dt1) ; 
  1043.         ldebi1   = prog        debi1 ; 
  1044.       fins ; 
  1045.       ltps1    =  ltps0 et  ltps1 ; 
  1046.       ldebi1   = ldebi0 et ldebi1 ; 
  1047.     fins ; 
  1048.     evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
  1049.  
  1050. *   Evolution deplacement PASSE CERC : 
  1051.     si idebut1 ; 
  1052.       ltps1    = prog 0. dt1 ; 
  1053.       ldep1    = prog 0. ll1 ; 
  1054.       tps0     = 0. ; 
  1055.     sino ; 
  1056.       evdep0   = tab1.evolution_deplacement ; 
  1057.       ltps0    = extr evdep0 absc ; 
  1058.       ldep0    = extr evdep0 ordo ; 
  1059.       tps0     = extr ltps0 (dime ltps0) ; 
  1060.       dep0     = extr ldep0 (dime ldep0) ; 
  1061.       si idtcp1 ; 
  1062.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1063.         ldep1    = prog           dep0 (dep0 + ll1) ; 
  1064.       sino ; 
  1065.         ltps1    = prog (tps0 + dt1) ; 
  1066.         ldep1    = prog (dep0 + ll1) ; 
  1067.       fins ; 
  1068.       ltps1    = ltps0 et ltps1 ; 
  1069.       ldep1    = ldep0 et ldep1 ; 
  1070.     fins ; 
  1071.     ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
  1072.     evdep1   = evol vert manu temp ltps1 ldep1 ; 
  1073.  
  1074. *   Evenement : 
  1075.     si imot7 ; 
  1076.       ttev1    = table ;
  1077.       ttev1 . nom   =  even1 ; 
  1078.       si ieve1 ; 
  1079.         ttev1 . temps = prog tps0 (tps0 + teve1) ; 
  1080.       sino ; 
  1081.         ttev1 . temps = prog tps0 ; 
  1082.       fins ; 
  1083.       si (exis tab1 'EVENEMENTS') ; 
  1084.         nbev1    = (dime tab1.evenements) + 1 ; 
  1085.       sino ; 
  1086.         tab1.evenements = table ; 
  1087.         nbev1    = 1 ; 
  1088.       fins ; 
  1089.       tab1.evenements.nbev1 = ttev1 ; 
  1090.     fins ; 
  1091.  
  1092. *   Evolution direction PASSE CERC (si on soude) :
  1093.     si iqtot1 ;
  1094. *     Traitement direction radiale ext./int. , combo Pdir1 :
  1095. *     & direction transverse (DIRL) :
  1096.       ldir1    = enum ;
  1097.       ldirn1   = enum ;
  1098.       nbnoc1   = nbno maili1 ;
  1099.       dti1     = dt1 / (flot (nbnoc1 - 1)) ;
  1100.       repe bmail1 nbnoc1 ;
  1101.         pi1      = maili1 poin &bmail1 ;
  1102.         vi1      = (pi1 moin p1) ;
  1103.         vi1      = vi1 / (norm vi1) ;
  1104.         vli1     = pvec pnc1 vi1 ;
  1105.         si iradint1 ;
  1106.           vi1      = -1. * vi1 ;
  1107.         fins ;
  1108.         si ipdir1 ;
  1109.           vi1      = vi1 plus pdir1 ;
  1110.         fins ;
  1111. *list vi1 ;
  1112.         ldir1    = ldir1 et vi1 ;
  1113.         ldirn1   = ldirn1 et vli1 ;
  1114.       fin bmail1 ;
  1115.       si iradx1 ;
  1116. *list (ldir1 extr 1) ;
  1117. *list (ldir1 extr 2) ;
  1118. *list (ldir1 extr 4) ;
  1119.         pdir1    = ldir1 ;
  1120.         ipdir1   = faux ;
  1121.       fins ;
  1122. *     Construction liste directions :
  1123.       si idebut1 ;
  1124.         ltpsl1   = prog 0. pas dti1 dt1 ;
  1125.         si ipdir1 ;
  1126.           ltps1    = prog    0.   dt1 ;
  1127.           ldir1    = enum pdir1 pdir1 ;
  1128. *         Direction transverse (DIRL) :
  1129.           si ipara1 ;
  1130.             ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1131.             opti para vrai ; mess 'ici 5' ;
  1132.             ldirl2   = pvec ldirn1 ldirl1 ;
  1133.             opti para faux ;
  1134.           sino ;
  1135.             ldirl2   = enum ;
  1136.             repe bx (dime ltpsl1) ;
  1137.               pnx = ldirn1 extr &bx ;
  1138.               plx = pvec pnx pdir1 ;
  1139.               ldirl2 = ldirl2 et plx ;
  1140.             fin bx ;
  1141.           fins ;
  1142.           ldirl1   = ldirl2 ;
  1143.         sino ;
  1144. *         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
  1145.           nbdir1   = dime pdir1 ;
  1146.           si (nbdir1 ega 1) ;
  1147.             pdir1    = pdir1 et (pdir1 extr 1) ;
  1148.             nbdir1   = 2 ;
  1149.           fins ;
  1150.           ltps1    = prog 0. ;
  1151.           tpsi1    = 0. ;
  1152.           nbdir1   = nbdir1 - 1 ;
  1153.           dti1     = dt1 / (flot nbdir1) ;
  1154.           repe bdir1 nbdir1 ;
  1155.             tpsi1    = tpsi1 + dti1 ;
  1156.             si (&bdir1 ega nbdir1) ; tpsi1 = dt1 ; fins ;
  1157.             ltps1    = ltps1 et tpsi1 ;
  1158.           fin bdir1 ;
  1159.           ldir1    = pdir1 ;
  1160. *         Direction transverse (DIRL) :
  1161.           cgxx1    = char dirx ltps1 ldir1 ;
  1162.           ldirl1   = enum ;
  1163.           repe bxx1 (dime ltpsl1) ;
  1164.             tpsli1   = extr ltpsl1 &bxx1 ;
  1165.             pdirx1   = tire cgxx1 dirx tpsli1 ;
  1166.             pdirn1   = ldirn1 extr &bxx1 ;
  1167.             pdirli1  = pvec pdirn1 pdirx1 ;
  1168.             pdirli1  = pdirli1 / (norm pdirli1) ;
  1169.             ldirl1   = ldirl1 et pdirli1 ;
  1170.           fin bxx1 ;
  1171.         fins ;
  1172.       sino ;
  1173.         ltpsl1   = prog tps0 pas dti1 (tps0 + dt1) ;
  1174.         si (exis tab1 evolution_orientation) ;
  1175.           cgdir0   = tab1.evolution_orientation ;
  1176.           ltps0    = extr cgdir0 lree dire ;
  1177.           ldir0    = extr cgdir0 lobj dire ;
  1178.           ltpsl0   = extr cgdir0 lree dirl ;
  1179.           ldirl0   = extr cgdir0 lobj dirl ;
  1180.           tps0dir  = extr ltps0 (dime  ltps0) ;
  1181.           pdir0    = extr ldir0 (dime  ltps0) ;
  1182.           si (tps0dir ega tps0) ;
  1183.             ltpsl1   = ltpsl1 enle 1 ;
  1184.             si ipdir1 ;
  1185.               xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
  1186.               si (xcolli1 neg 1.) ;
  1187.                 erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
  1188.               fins ;
  1189.               ltps1    = prog  (tps0 + dt1) ;
  1190.               ldir1    = enum         pdir1 ;
  1191. *             Direction transverse (DIRL) :
  1192.               si ipara1 ;
  1193.                 ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1194.                 opti para vrai ; mess 'ici 6' ;
  1195.                 ldirl2   = pvec ldirn1 ldirl1 ;
  1196.                 opti para faux ;
  1197.               sino ;
  1198.                 ldirl2   = enum ;
  1199.                 repe bx (dime ltpsl1) ;
  1200.                   pnx = ldirn1 extr &bx ;
  1201.                   plx = pvec pnx pdir1 ;
  1202.                   ldirl2 = ldirl2 et plx ;
  1203.                 fin bx ;
  1204.               fins ;
  1205.               ldirl1   = ldirl2 ;
  1206.               pdirl1   = extr ldirl1 1 ;
  1207.               pdirl0   = extr ldirl0 (dime ldirl0) ;
  1208.               pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
  1209. *si ((norm pdirl10) < 1.e-10) ; mess '**** passe cerc cas 7' ; list pdirl10 ; fins ;
  1210.               si ((norm pdirl10) > 1.e-3) ;
  1211.                 ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
  1212.               fins ;
  1213.             sino ;
  1214.               pdiri1   = pdir1 extr 1 ;
  1215.               xcolli1  = (psca pdir0 pdiri1) / (norm pdir0) / (norm pdiri1) ;
  1216.               si (xcolli1 neg 1.) ;
  1217.                 erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
  1218.               fins ;
  1219.  
  1220.               nbdir1   = dime pdir1 ;
  1221.               si (nbdir1 ega 1) ;
  1222.                 pdir1    = pdir1 et (pdir1 extr 1) ;
  1223.                 nbdir1   = 2 ;
  1224.               fins ;
  1225.               ltps1    = prog ;
  1226.               tpsi1    = tps0 ;
  1227.               nbdir1   = nbdir1 - 1 ;
  1228.               dti1     = dt1 / (flot nbdir1) ;
  1229.               repe bdir1 nbdir1 ;
  1230.                 tpsi1    = tpsi1 + dti1 ;
  1231.                 si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  1232.                 ltps1    = ltps1 et tpsi1 ;
  1233.               fin bdir1 ;
  1234.               ldir1    = pdir1 enle 1 ;
  1235. *             Direction transverse (DIRL) :
  1236.               si (nbdir1 ega 1) ;
  1237.                 ldirl1   = enum ;
  1238.                 repe bxx1 (dime ltpsl1) ;
  1239.                   tpsli1   = extr ltpsl1 &bxx1 ;
  1240.                   pdirn1   = ldirn1 extr &bxx1 ;
  1241.                   pdirli1  = pvec pdirn1 (extr ldir1 1) ;
  1242.                   pdirli1  = pdirli1 / (norm pdirli1) ;
  1243.                   ldirl1   = ldirl1 et pdirli1 ;
  1244.                 fin bxx1 ;
  1245.               sino ;
  1246.                 cgxx1    = char dirx ltps1 ldir1 ;
  1247.                 ldirl1   = enum ;
  1248.                 repe bxx1 (dime ltpsl1) ;
  1249.                   tpsli1   = extr ltpsl1 &bxx1 ;
  1250.                   pdirx1   = tire cgxx1 dirx tpsli1 ;
  1251.                   pdirn1   = ldirn1 extr &bxx1 ;
  1252.                   pdirli1  = pvec pdirn1 pdirx1 ;
  1253.                   pdirli1  = pdirli1 / (norm pdirli1) ;
  1254.                   ldirl1   = ldirl1 et pdirli1 ;
  1255.                 fin bxx1 ;
  1256.               fins ;
  1257.               pdirl1   = extr ldirl1 1 ;
  1258.               pdirl0   = extr ldirl0 (dime ldirl0) ;
  1259.               pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
  1260. *si ((norm pdirl10) < 1.e-10) ; mess '**** passe cerc cas 2' ; list pdirl10 ; fins ;
  1261.               si ((norm pdirl10) > 1.e-3) ;
  1262.                 ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
  1263.               fins ;
  1264.             fins ;
  1265.           sino ;
  1266.             si ipdir1 ;
  1267.               ltps1    = prog  tps0 (tps0 + dt1) ;
  1268.               ldir1    = enum pdir1        pdir1 ;
  1269. *             Direction transverse (DIRL) :
  1270.               si ipara1 ;
  1271.                 ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1272.                 opti para vrai ; mess 'ici 7' ;
  1273.                 ldirl2   = pvec ldirn1 ldirl1 ;
  1274.                 opti para faux ;
  1275.               sino ;
  1276.                 ldirl2   = enum ;
  1277.                 repe bx (dime ltpsl1) ;
  1278.                   pnx = ldirn1 extr &bx ;
  1279.                   plx = pvec pnx pdir1 ;
  1280.                   ldirl2 = ldirl2 et plx ;
  1281.                 fin bx ;
  1282.               fins ;
  1283.               ldirl1   = ldirl2 ;
  1284.             sino ;
  1285.               nbdir1   = dime pdir1 ;
  1286.               si (nbdir1 ega 1) ;
  1287.                 pdir1    = pdir1 et (pdir1 extr 1) ;
  1288.                 nbdir1   = 2 ;
  1289.               fins ;
  1290.               ltps1    = prog tps0 ;
  1291.               tpsi1    = tps0 ;
  1292.               nbdir1   = nbdir1 - 1 ;
  1293.               dti1     = dt1 / (flot nbdir1) ;
  1294.               repe bdir1 nbdir1 ;
  1295.                 tpsi1    = tpsi1 + dti1 ;
  1296.                 si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  1297.                 ltps1    = ltps1 et tpsi1 ;
  1298.               fin bdir1 ;
  1299.               ldir1    = pdir1 ;
  1300. *             Direction transverse (DIRL) :
  1301.               cgxx1    = char dirx ltps1 ldir1 ;
  1302.               ldirl1   = enum ;
  1303.               repe bxx1 (dime ltpsl1) ;
  1304.                 tpsli1   = extr ltpsl1 &bxx1 ;
  1305.                 pdirx1   = tire cgxx1 dirx tpsli1 ;
  1306.                 pdirn1   = ldirn1 extr &bxx1 ;
  1307.                 pdirli1  = pvec pdirn1 pdirx1 ;
  1308.                 pdirli1  = pdirli1 / (norm pdirli1) ;
  1309.                 ldirl1   = ldirl1 et pdirli1 ;
  1310.               fin bxx1 ;
  1311.             fins ;
  1312.           fins ;
  1313.           ltps1    = ltps0 et ltps1 ;
  1314.           ldir1    = ldir0 et ldir1 ;
  1315.           ltpsl1   = ltpsl0 et ltpsl1 ;
  1316.           ldirl1   = ldirl0 et ldirl1 ;
  1317. *list tps0 ;
  1318. *list ltpsl1 ;
  1319.         sino ;
  1320.           si ipdir1 ;
  1321.             ltps1    = prog flot0   dt1 ;
  1322.             ldir1    = enum pdir1 pdir1 ;
  1323. *           Direction transverse (DIRL) :
  1324.             si ipara1 ;
  1325.               ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1326.               opti para vrai ; mess 'ici 8' ;
  1327.               ldirl2   = pvec ldirn1 ldirl1 ;
  1328.               opti para faux ;
  1329.             sino ;
  1330.               ldirl2   = enum ;
  1331.               repe bx (dime ltpsl1) ;
  1332.                 pnx = ldirn1 extr &bx ;
  1333.                 plx = pvec pnx pdir1 ;
  1334.                 ldirl2 = ldirl2 et plx ;
  1335.               fin bx ;
  1336.             fins ;
  1337.             ldirl1   = ldirl2 ;
  1338.           sino ;
  1339. *         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
  1340.             nbdir1   = dime pdir1 ;
  1341.             si (nbdir1 ega 1) ;
  1342.               pdir1    = pdir1 et (pdir1 extr 1) ;
  1343.               nbdir1   = 2 ;
  1344.             fins ;
  1345.             ltps1    = prog flot0 ;
  1346.             tpsi1    = flot0 ;
  1347.             nbdir1   = nbdir1 - 1 ;
  1348.             dti1     = dt1 / (flot nbdir1) ;
  1349.             repe bdir1 nbdir1 ;
  1350.               tpsi1    = tpsi1 + dti1 ;
  1351.               si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  1352.               ltps1    = ltps1 et tpsi1 ;
  1353.             fin bdir1 ;
  1354.             ldir1    = pdir1 ;
  1355. *           Direction transverse (DIRL) :
  1356.             cgxx1    = char dirx ltps1 ldir1 ;
  1357.             ldirl1   = enum ;
  1358.             repe bxx1 (dime ltpsl1) ;
  1359.               tpsli1   = extr ltpsl1 &bxx1 ;
  1360.               pdirx1   = tire cgxx1 dirx tpsli1 ;
  1361.               pdirn1   = ldirn1 extr &bxx1 ;
  1362.               pdirli1  = pvec pdirn1 pdirx1 ;
  1363.               pdirli1  = pdirli1 / (norm pdirli1) ;
  1364.               ldirl1   = ldirl1 et pdirli1 ;
  1365.             fin bxx1 ;
  1366.           fins ;
  1367.         fins ;
  1368.       fins ;
  1369.       cgdir1   = char dire ltps1 ldir1 ;
  1370. *     Direction transverse (DIRL) :
  1371.       cgdir2   = char dirl ltpsl1 ldirl1 ;
  1372.       cgdir1   = cgdir1 et cgdir2 ;
  1373.     fins ;
  1374.  
  1375. *   Enregistrement donnees PASSE CERC 
  1376.     si (exis tab1 passes) ; 
  1377.       nps1     = dime tab1.passes ; 
  1378.     sino ; 
  1379.       nps1     = 0 ; 
  1380.       tab1.passes = table ; 
  1381.     fins ; 
  1382.     nps1     = nps1 + 1 ; 
  1383.     tab1.passes.nps1 = table ; 
  1384.  
  1385.     tab1.passes.nps1.maillage  = maili1 ; 
  1386.     tab1.passes.nps1.geometrie = mot 'CERC' ; 
  1387.     tab1.passes.nps1.centre    = P1 ; 
  1388.     tab1.passes.nps1.instants  = lti1 ; 
  1389.     tab1.passes.nps1.vitesse   = vdep1 ; 
  1390.     tab1.passes.nps1.puissance = qtot1 ; 
  1391.     tab1.passes.nps1.debit     = debi1 ; 
  1392.     tab1.passes.nps1.part      = ipar1 ; 
  1393.     tab1.passes.nps1.couche    = icou1 ; 
  1394.  
  1395.     si ilarg1 ;
  1396.       tab1.passes.nps1.largeur = larg1 ;
  1397.     fins ; 
  1398.  
  1399. *   Enregistrements en fin de traitement option pour eviter
  1400. *   modifier table avant fin realisation option
  1401.     tab1.trajectoire = mail1 ; 
  1402.     tab1.evolution_puissance = evqtot1 ; 
  1403.     tab1.evolution_debit = evdebi1 ; 
  1404.     tab1.evolution_deplacement = evdep1 ; 
  1405.     si iqtot1 ;
  1406.       tab1.evolution_orientation = cgdir1 ;
  1407.     fins ;
  1408.  
  1409.     quit soudage ; 
  1410. *   Fin option PASSE CERC : 
  1411.   fins ; 
  1412.  
  1413. *----------------------------- PASSE MAIL -----------------------------* 
  1414. * Sous-option MAIL : 
  1415.   si (ega mot2 'MAIL') ; 
  1416.     icas2    = 3 ; 
  1417.  
  1418.     argu mail1*'MAILLAGE' ; 
  1419.     eltyp1   = mail1 elem type ; 
  1420.     imax1    = 0 ; 
  1421.     si (exis eltyp1 'SEG2') ; imax1 = imax1 + 1 ; fins ; 
  1422.     si (exis eltyp1 'SEG3') ; imax1 = imax1 + 1 ; fins ; 
  1423.     si ((dime eltyp1) > imax1) ; 
  1424.       erre '*****  ERREUR : le maillage doit etre compose de SEG2 ou de SEG3.' ; 
  1425.     fins ; 
  1426.     ll1      = mesu mail1 ; 
  1427.     maili1   = mail1 ; 
  1428.  
  1429. *   Lecture orientation de soudure :
  1430.     ipdir1   = faux ;
  1431.     si imot8 ;
  1432.       argu pdir1/'POINT' ;
  1433.       ipdir1   = exis pdir1 ;
  1434.       si (non ipdir1) ;
  1435.         argu pdir1*'LISTOBJE' ;
  1436.         si (neg (extr pdir1 type) 'POINT') ;
  1437.           erre '***** SOUDAGE : le LISTOBJE ne contient pas des objets POINT' ;
  1438.         fins ;
  1439.         si (vide pdir1) ;
  1440.           erre '***** SOUDAGE : le LISTOBJ est vide' ;
  1441.         fins ;
  1442.       fins ;
  1443.     fins ;
  1444.     si (non imot8) ;
  1445.       si (exis tab1 orientation_soudure) ;
  1446.         pdir1    = tab1.orientation_soudure ;
  1447.         ipdir1   = vrai ;
  1448.       sino ;
  1449.         erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
  1450.       fins ;
  1451.     fins ;
  1452. *list pdir1 ;
  1453.  
  1454. *   Trajectoire PASSE MAIL : 
  1455.     si idebut1 ; 
  1456.       P1       = mail1 poin 1 ; 
  1457.       tab1.point_de_depart = P1 ; 
  1458.       mail1    = mail1 coul roug ; 
  1459.     sino ; 
  1460.       mail0    = tab1.trajectoire ; 
  1461.       nbpts0   = nbno mail0 ; 
  1462.       P0       = mail0 poin nbpts0 ; 
  1463.       P1       = mail1 poin 1 ; 
  1464.       si (P1 neg P0) ; 
  1465.         tol1     = 1.e-10 * (mesu mail1) ; 
  1466.         si ((norm (P1 moin P0)) > tol1) ; 
  1467.           erre '*****  ERREUR : MAILLAGE incompatible.' ; 
  1468.           quit soudage ; 
  1469.         sino ; 
  1470.           elim (P0 et P1) tol1 ; 
  1471.         fins ; 
  1472.       fins ; 
  1473.       si (nbpts0 > 1) ; 
  1474.         mail1    = mail1 coul roug ; 
  1475.         mail1    = mail0 et mail1 ; 
  1476.       fins ; 
  1477.     fins ; 
  1478.  
  1479. *   Increment de temps : 
  1480.     dt1    = ll1 / vdep1 ; 
  1481.     si idtcp1 ; 
  1482.       dt1    = dt1 + dtcp1 ; 
  1483.     fins ; 
  1484.  
  1485. *   Evolution puissance PASSE MAIL : 
  1486.     si idebut1 ; 
  1487.       ltps1    = prog    0.   dt1 ; 
  1488.       lqtot1   = prog qtot1 qtot1 ; 
  1489.       lti1     = ltps1 ; 
  1490.     sino ; 
  1491.       ltps0    = extr evqtot0 absc ; 
  1492.       tps0     = extr  ltps0 (dime  ltps0) ; 
  1493. *     Si la puissance indiquee est differente de celle existante : 
  1494.       si idtcp1 ; 
  1495.         lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1496.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1497.         lqtot1   = prog          qtot1        qtot1 ; 
  1498.       sino ; 
  1499.         lti1     = prog tps0 (tps0 + dt1) ; 
  1500.         ltps1    = prog (tps0 + dt1) ; 
  1501.         lqtot1   = prog        qtot1 ; 
  1502.       fins ; 
  1503.       ltps1    =  ltps0 et  ltps1 ; 
  1504.       lqtot1   = lqtot0 et lqtot1 ; 
  1505.     fins ; 
  1506.     evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
  1507.  
  1508. *   Evolution debit PASSE MAIL : 
  1509.     si idebut1 ; 
  1510.       ltps1    = prog    0.   dt1 ; 
  1511.       ldebi1   = prog debi1 debi1 ; 
  1512.     sino ; 
  1513.       ltps0    = extr evdebi0 absc ; 
  1514.       tps0     = extr  ltps0 (dime  ltps0) ; 
  1515. *     Si la puissance indiquee est differente de celle existante : 
  1516.       si idtcp1 ; 
  1517.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1518.         ldebi1   = prog          debi1        debi1 ; 
  1519.       sino ; 
  1520.         ltps1    = prog (tps0 + dt1) ; 
  1521.         ldebi1   = prog        debi1 ; 
  1522.       fins ; 
  1523.       ltps1    =  ltps0 et  ltps1 ; 
  1524.       ldebi1   = ldebi0 et ldebi1 ; 
  1525.     fins ; 
  1526.     evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
  1527.  
  1528. *   Evolution deplacement PASSE MAIL : 
  1529.     si idebut1 ; 
  1530.       ltps1    = prog 0. dt1 ; 
  1531.       ldep1    = prog 0. ll1 ; 
  1532.       tps0     = 0. ; 
  1533.     sino ; 
  1534.       evdep0   = tab1.evolution_deplacement ; 
  1535.       ltps0    = extr evdep0 absc ; 
  1536.       ldep0    = extr evdep0 ordo ; 
  1537.       tps0     = extr ltps0 (dime ltps0) ; 
  1538.       dep0     = extr ldep0 (dime ldep0) ; 
  1539.       si idtcp1 ; 
  1540.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  1541.         ldep1    = prog           dep0 (dep0 + ll1) ; 
  1542.       sino ; 
  1543.         ltps1    = prog (tps0 + dt1) ; 
  1544.         ldep1    = prog (dep0 + ll1) ; 
  1545.       fins ; 
  1546.       ltps1    = ltps0 et ltps1 ; 
  1547.       ldep1    = ldep0 et ldep1 ; 
  1548.     fins ; 
  1549.     ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
  1550.     evdep1   = evol vert manu temp ltps1 ldep1 ; 
  1551.  
  1552. *   Evenement : 
  1553.     si imot7 ; 
  1554.       ttev1    = table ;
  1555.       ttev1 . nom   =  even1 ; 
  1556.       si ieve1 ; 
  1557.         ttev1 . temps = prog tps0 (tps0 + teve1) ; 
  1558.       sino ; 
  1559.         ttev1 . temps = prog tps0 ; 
  1560.       fins ; 
  1561.       si (exis tab1 'EVENEMENTS') ; 
  1562.         nbev1    = (dime tab1.evenements) + 1 ; 
  1563.       sino ; 
  1564.         tab1.evenements = table ; 
  1565.         nbev1    = 1 ; 
  1566.       fins ; 
  1567.       tab1.evenements.nbev1 = ttev1 ; 
  1568.     fins ; 
  1569.  
  1570. *   Evolution direction PASSE MAIL (si on soude) :
  1571.     si iqtot1 ;
  1572. *     Traitement direction direction transverse (DIRL) :
  1573.       ldirn1   = enum ;
  1574.       nbelm1   = nbel maili1 ;
  1575.       si (nbelm1 ega 1) ;
  1576.         dti1     = dt1 ;
  1577.       sino ;
  1578.         dti1     = dt1 / (flot (nbelm1 - 1)) ;
  1579.       fins ;
  1580.       repe bmail1 nbelm1 ;
  1581.         eli1     = maili1 elem &bmail1 ;
  1582.         pi1      = eli1 poin 1 ;
  1583.         pi2      = eli1 poin 2 ;
  1584.         vni1     = (pi2 moin pi1) ;
  1585.         vni1     = vni1 / (norm vni1) ;
  1586. *list vni1 ;
  1587.         ldirn1   = ldirn1 et vni1 ;
  1588.       fin bmail1 ;
  1589.       si (nbelm1 ega 1) ;
  1590.         ldirn1   = ldirn1 et vni1 ;
  1591.       fins ;
  1592.       si idebut1 ;
  1593.         ltpsl1   = prog 0. pas dti1 dt1 ;
  1594.         si ipdir1 ;
  1595.           ltps1    = prog    0.   dt1 ;
  1596.           ldir1    = enum pdir1 pdir1 ;
  1597. *         Direction transverse (DIRL) :
  1598.           si ipara1 ;
  1599.             ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1600.             opti para vrai ; mess 'ici 9' ;
  1601.             ldirl2   = pvec ldirn1 ldirl1 ;
  1602.             opti para faux ;
  1603.           sino ;
  1604.             ldirl2   = enum ;
  1605.             repe bx (dime ltpsl1) ;
  1606.               pnx = ldirn1 extr &bx ;
  1607.               plx = pvec pnx pdir1 ;
  1608.               ldirl2 = ldirl2 et plx ;
  1609.             fin bx ;
  1610.           fins ;
  1611.           ldirl1   = ldirl2 ;
  1612.         sino ;
  1613. *         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
  1614.           nbdir1   = dime pdir1 ;
  1615.           si (nbdir1 ega 1) ;
  1616.             pdir1    = pdir1 et (pdir1 extr 1) ;
  1617.             nbdir1   = 2 ;
  1618.           fins ;
  1619.           ltps1    = prog 0. ;
  1620.           tpsi1    = 0. ;
  1621.           nbdir1   = nbdir1 - 1 ;
  1622.           dti1     = dt1 / (flot nbdir1) ;
  1623.           repe bdir1 nbdir1 ;
  1624.             tpsi1    = tpsi1 + dti1 ;
  1625.             si (&bdir1 ega nbdir1) ; tpsi1 = dt1 ; fins ;
  1626.             ltps1    = ltps1 et tpsi1 ;
  1627.           fin bdir1 ;
  1628.           ldir1    = pdir1 ;
  1629. *         Direction transverse (DIRL) :
  1630.           cgxx1    = char dirx ltps1 ldir1 ;
  1631.           ldirl1   = enum ;
  1632.           repe bxx1 (dime ltpsl1) ;
  1633.             tpsli1   = extr ltpsl1 &bxx1 ;
  1634.             pdirx1   = tire cgxx1 dirx tpsli1 ;
  1635.             pdirn1   = ldirn1 extr &bxx1 ;
  1636.             pdirli1  = pvec pdirn1 pdirx1 ;
  1637.             pdirli1  = pdirli1 / (norm pdirli1) ;
  1638.             ldirl1   = ldirl1 et pdirli1 ;
  1639.           fin bxx1 ;
  1640.         fins ;
  1641.       sino ;
  1642.         ltpsl1   = prog tps0 pas dti1 (tps0 + dt1) ;
  1643.         si (exis tab1 evolution_orientation) ;
  1644.           cgdir0   = tab1.evolution_orientation ;
  1645.           ltps0    = extr cgdir0 lree dire ;
  1646.           ldir0    = extr cgdir0 lobj dire ;
  1647.           ltpsl0   = extr cgdir0 lree dirl ;
  1648.           ldirl0   = extr cgdir0 lobj dirl ;
  1649.           tps0dir  = extr ltps0 (dime  ltps0) ;
  1650.           pdir0    = extr ldir0 (dime  ltps0) ;
  1651.           si (tps0dir ega tps0) ;
  1652.             ltpsl1   = ltpsl1 enle 1 ;
  1653.  
  1654.             si ipdir1 ;
  1655.               xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
  1656.               si (xcolli1 neg 1.) ;
  1657.                 erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
  1658.               fins ;
  1659.               ltps1    = prog  (tps0 + dt1) ;
  1660.               ldir1    = enum         pdir1 ;
  1661. *             Direction transverse (DIRL) :
  1662.               si ipara1 ;
  1663.                 ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1664.                 opti para vrai ; mess 'ici 10' ;
  1665.                 ldirl2   = pvec ldirn1 ldirl1 ;
  1666.                 opti para faux ;
  1667.               sino ;
  1668.                 ldirl2   = enum ;
  1669.                 repe bx (dime ltpsl1) ;
  1670.                   pnx = ldirn1 extr &bx ;
  1671.                   plx = pvec pnx pdir1 ;
  1672.                   ldirl2 = ldirl2 et plx ;
  1673.                 fin bx ;
  1674.               fins ;
  1675.               ldirl1   = ldirl2 ;
  1676.               pdirl1   = extr ldirl1 1 ;
  1677.               pdirl0   = extr ldirl0 (dime ldirl0) ;
  1678.               pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
  1679. *si ((norm pdirl10) < 1.e-10) ; mess '**** passe mail cas 1' ; list pdirl10 ; fins ;
  1680.               si ((norm pdirl10) > 1.e-3) ;
  1681.                 ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
  1682.               fins ;
  1683.             sino ;
  1684.               pdiri1   = pdir1 extr 1 ;
  1685.               xcolli1  = (psca pdir0 pdiri1) / (norm pdir0) / (norm pdiri1) ;
  1686.               si (xcolli1 neg 1.) ;
  1687.                 erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
  1688.               fins ;
  1689.  
  1690.               nbdir1   = dime pdir1 ;
  1691.               si (nbdir1 ega 1) ;
  1692.                 pdir1    = pdir1 et (pdir1 extr 1) ;
  1693.                 nbdir1   = 2 ;
  1694.               fins ;
  1695.               ltps1    = prog ;
  1696.               tpsi1    = tps0 ;
  1697.               nbdir1   = nbdir1 - 1 ;
  1698.               dti1     = dt1 / (flot nbdir1) ;
  1699.               repe bdir1 nbdir1 ;
  1700.                 tpsi1    = tpsi1 + dti1 ;
  1701.                 si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  1702.                 ltps1    = ltps1 et tpsi1 ;
  1703.               fin bdir1 ;
  1704.               ldir1    = pdir1 enle 1 ;
  1705. *             Direction transverse (DIRL) :
  1706.               si (nbdir1 ega 1) ;
  1707.                 ldirl1   = enum ;
  1708.                 repe bxx1 (dime ltpsl1) ;
  1709.                   tpsli1   = extr ltpsl1 &bxx1 ;
  1710.                   pdirn1   = ldirn1 extr &bxx1 ;
  1711.                   pdirli1  = pvec pdirn1 (extr ldir1 1) ;
  1712.                   pdirli1  = pdirli1 / (norm pdirli1) ;
  1713.                   ldirl1   = ldirl1 et pdirli1 ;
  1714.                 fin bxx1 ;
  1715.               sino ;
  1716.                 cgxx1    = char dirx ltps1 ldir1 ;
  1717.                 ldirl1   = enum ;
  1718.                 repe bxx1 (dime ltpsl1) ;
  1719.                   tpsli1   = extr ltpsl1 &bxx1 ;
  1720.                   pdirx1   = tire cgxx1 dirx tpsli1 ;
  1721.                   pdirn1   = ldirn1 extr &bxx1 ;
  1722.                   pdirli1  = pvec pdirn1 pdirx1 ;
  1723.                   pdirli1  = pdirli1 / (norm pdirli1) ;
  1724.                   ldirl1   = ldirl1 et pdirli1 ;
  1725.                 fin bxx1 ;
  1726.               fins ;
  1727.               pdirl1   = extr ldirl1 1 ;
  1728.               pdirl0   = extr ldirl0 (dime ldirl0) ;
  1729.               pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
  1730. *si ((norm pdirl10) < 1.e-10) ; mess '**** passe cerc cas 2' ; list pdirl10 ; fins ;
  1731.               si ((norm pdirl10) > 1.e-3) ;
  1732.                 ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
  1733.               fins ;
  1734.             fins ;
  1735.           sino ;
  1736.             si ipdir1 ;
  1737.               ltps1    = prog  tps0 (tps0 + dt1) ;
  1738.               ldir1    = enum pdir1        pdir1 ;
  1739.  
  1740. *             Direction transverse (DIRL) :
  1741.               si ipara1 ;
  1742.                 ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1743.                 opti para vrai ; mess 'ici 11' ;
  1744.                 ldirl2   = pvec ldirn1 ldirl1 ;
  1745.                 opti para faux ;
  1746.               sino ;
  1747.                 ldirl2   = enum ;
  1748.                 repe bx (dime ltpsl1) ;
  1749.                   pnx = ldirn1 extr &bx ;
  1750.                   plx = pvec pnx pdir1 ;
  1751.                   ldirl2 = ldirl2 et plx ;
  1752.                 fin bx ;
  1753.               fins ;
  1754.               ldirl1   = ldirl2 ;
  1755.             sino ;
  1756.               nbdir1   = dime pdir1 ;
  1757.               si (nbdir1 ega 1) ;
  1758.                 pdir1    = pdir1 et (pdir1 extr 1) ;
  1759.                 nbdir1   = 2 ;
  1760.               fins ;
  1761.               ltps1    = prog tps0 ;
  1762.               tpsi1    = tps0 ;
  1763.               nbdir1   = nbdir1 - 1 ;
  1764.               dti1     = dt1 / (flot nbdir1) ;
  1765.               repe bdir1 nbdir1 ;
  1766.                 tpsi1    = tpsi1 + dti1 ;
  1767.                 si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  1768.                 ltps1    = ltps1 et tpsi1 ;
  1769.               fin bdir1 ;
  1770.               ldir1    = pdir1 ;
  1771. *             Direction transverse (DIRL) :
  1772.               cgxx1    = char dirx ltps1 ldir1 ;
  1773.               ldirl1   = enum ;
  1774.               repe bxx1 (dime ltpsl1) ;
  1775.                 tpsli1   = extr ltpsl1 &bxx1 ;
  1776.                 pdirx1   = tire cgxx1 dirx tpsli1 ;
  1777.                 pdirn1   = extr ldirn1 &bxx1 ;
  1778.                 pdirli1  = pvec pdirn1 pdirx1 ;
  1779.                 pdirli1  = pdirli1 / (norm pdirli1) ;
  1780.                 ldirl1   = ldirl1 et pdirli1 ;
  1781.               fin bxx1 ;
  1782.             fins ;
  1783.           fins ;
  1784.           ltps1    = ltps0 et ltps1 ;
  1785.           ldir1    = ldir0 et ldir1 ;
  1786.           ltpsl1   = ltpsl0 et ltpsl1 ;
  1787.           ldirl1   = ldirl0 et ldirl1 ;
  1788. *list tps0 ;
  1789. *list ltpsl1 ;
  1790.         sino ;
  1791.           si ipdir1 ;
  1792.             ltps1    = prog flot0   dt1 ;
  1793.             ldir1    = enum pdir1 pdir1 ;
  1794. *           Direction transverse (DIRL) :
  1795.             si ipara1 ;
  1796.               ldirl1   = enum (dime ltpsl1) * pdir1 ;
  1797.               opti para vrai ; mess 'ici 12' ;
  1798.               ldirl2   = pvec ldirn1 ldirl1 ;
  1799.               opti para faux ;
  1800.             sino ;
  1801.               ldirl2   = enum ;
  1802.               repe bx (dime ltpsl1) ;
  1803.                 pnx = ldirn1 extr &bx ;
  1804.                 plx = pvec pnx pdir1 ;
  1805.                 ldirl2 = ldirl2 et plx ;
  1806.               fin bx ;
  1807.             fins ;
  1808.             ldirl1   = ldirl2 ;
  1809.           sino ;
  1810. *         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
  1811.             nbdir1   = dime pdir1 ;
  1812.             si (nbdir1 ega 1) ;
  1813.               pdir1    = pdir1 et (pdir1 extr 1) ;
  1814.               nbdir1   = 2 ;
  1815.             fins ;
  1816.             ltps1    = prog flot0 ;
  1817.             tpsi1    = flot0 ;
  1818.             nbdir1   = nbdir1 - 1 ;
  1819.             dti1     = dt1 / (flot nbdir1) ;
  1820.             repe bdir1 nbdir1 ;
  1821.               tpsi1    = tpsi1 + dti1 ;
  1822.               si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
  1823.               ltps1    = ltps1 et tpsi1 ;
  1824.             fin bdir1 ;
  1825.             ldir1    = pdir1 ;
  1826. *           Direction transverse (DIRL) :
  1827.             cgxx1    = char dirx ltps1 ldir1 ;
  1828.             ldirl1   = enum ;
  1829.             repe bxx1 (dime ltpsl1) ;
  1830.               tpsli1   = extr ltpsl1 &bxx1 ;
  1831.               pdirx1   = tire cgxx1 dirx tpsli1 ;
  1832.               pdirn1   = ldirn1 extr &bxx1 ;
  1833.               pdirli1  = pvec pdirn1 pdirx1 ;
  1834.               pdirli1  = pdirli1 / (norm pdirli1) ;
  1835.               ldirl1   = ldirl1 et pdirli1 ;
  1836.             fin bxx1 ;
  1837.           fins ;
  1838.         fins ;
  1839.       fins ;
  1840.       cgdir1   = char dire ltps1 ldir1 ;
  1841. *     Direction transverse (DIRL) :
  1842.       cgdir2   = char dirl ltpsl1 ldirl1 ;
  1843.       cgdir1   = cgdir1 et cgdir2 ;
  1844.     fins ;
  1845.  
  1846. *   Enregistrement donnees PASSE MAIL 
  1847.     si (exis tab1 passes) ; 
  1848.       nps1     = dime tab1.passes ; 
  1849.     sino ; 
  1850.       nps1     = 0 ; 
  1851.       tab1.passes = table ; 
  1852.     fins ; 
  1853.     nps1     = nps1 + 1 ; 
  1854.  
  1855.     tab1.passes.nps1 = table ; 
  1856.     tab1.passes.nps1.maillage  = maili1 ; 
  1857.     tab1.passes.nps1.geometrie = mot 'MAIL' ; 
  1858.     tab1.passes.nps1.instants  = lti1 ; 
  1859.     tab1.passes.nps1.vitesse   = vdep1 ; 
  1860.     tab1.passes.nps1.puissance = qtot1 ; 
  1861.     tab1.passes.nps1.debit     = debi1 ; 
  1862.     tab1.passes.nps1.part      = ipar1 ; 
  1863.     tab1.passes.nps1.couche    = icou1 ; 
  1864.  
  1865.     si ilarg1 ;
  1866.       tab1.passes.nps1.largeur = larg1 ;
  1867.     fins ; 
  1868.  
  1869. *   Enregistrements en fin de traitement option pour eviter
  1870. *   modifier table avant fin realisation option
  1871.     tab1.trajectoire = mail1 ; 
  1872.     tab1.evolution_puissance = evqtot1 ; 
  1873.     tab1.evolution_debit = evdebi1 ; 
  1874.     tab1.evolution_deplacement = evdep1 ; 
  1875.     si iqtot1 ;
  1876.       tab1.evolution_orientation = cgdir1 ;
  1877.     fins ;
  1878.  
  1879.     quit soudage ; 
  1880. *   Fin option PASSE MAIL : 
  1881.   fins ; 
  1882.  
  1883. * Si mot2 ne correspond a aucune option connue, icas2 = 0 : erreur 
  1884.   si (icas2 ega 0) ; 
  1885.     erre '*****  ERREUR : MOT option non reconnu.' ; 
  1886.     quit soudage ; 
  1887.   fins ; 
  1888.  
  1889. * Fin option PASSE : 
  1890. fins ; 
  1891.  
  1892. *----------------------------------------------------------------------* 
  1893. *                             Option DEPLA                             * 
  1894. *----------------------------------------------------------------------* 
  1895.  
  1896. si (ega mot1 'DEPLA') ; 
  1897.   icas1    = 3 ; 
  1898. * 
  1899. * Lecture des arguments de l'option : 
  1900.   argu MOT2*'MOT' ; 
  1901.  
  1902. * Ajout ou pas du temps de coupure option PASSE : 
  1903.   idtcp1   = faux ; 
  1904.   qtot1    = 0. ; 
  1905.   debi1    = 0. ; 
  1906.   si ((non idebut1)) ; 
  1907.     evqtot0  = tab1.evolution_puissance ; 
  1908.     lqtot0   = extr evqtot0 ordo ; 
  1909.     evdebi0  = tab1.evolution_debit ; 
  1910.     ldebi0   = extr evdebi0 ordo ; 
  1911.     qtot0    = extr lqtot0 (dime lqtot0) ; 
  1912.     idtcp1   = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ; 
  1913.     debi0    = extr ldebi0 (dime ldebi0) ; 
  1914.     idtcp1   = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
  1915.   fins ; 
  1916. *list idtcp1 ; 
  1917.   si idtcp1 ; 
  1918.     dtcp1    = tab1.temps_de_coupure ; 
  1919.   fins ; 
  1920.  
  1921. * icas2 = indicateur sous-option realisee : 
  1922.   icas2    = 0 ; 
  1923.  
  1924. *----------------------------- DEPLA DROI -----------------------------* 
  1925.   si (ega mot2 'DROI') ; 
  1926.     icas2    = 1 ; 
  1927.  
  1928.     argu P1*'POINT' ; 
  1929.     P1       = P1 plus Pnul1 ; 
  1930.  
  1931. *   Lecture arguments optionnels :
  1932.     imot3    = faux ; comm mot-cle 'ABSO' ;
  1933.     imot4    = faux ; comm mot-cle 'VITE' ;
  1934.     imot5    = faux ; comm mot-cle 'EVEN' ;
  1935.     imot6    = faux ; comm mot-cle 'PART' ;
  1936.     imot7    = faux ; comm mot-cle 'COUCHE' ;
  1937.     irela1   = vrai ; 
  1938.     ieve1    = faux ; 
  1939.     repe b1 10 ; comm on itere volontairement plus que necessaire ;
  1940.       argu mot3/'MOT' ; 
  1941.       si (non (exis mot3)) ; quit b1 ; fins ; 
  1942.       si (ega mot3 'ABSO') ; 
  1943.         imot3    = vrai ; 
  1944.         irela1   = faux ; 
  1945.       fins ; 
  1946.       si (ega mot3 'VITE') ; 
  1947.         imot4    = vrai ; 
  1948.         argu vdep1*'FLOTTANT' ; 
  1949.       fins ; 
  1950.       si (ega mot3 'EVEN') ; 
  1951.         imot5    = vrai ; 
  1952.         argu even1*'MOT' ; 
  1953.         argu teve1/'FLOTTANT' ; 
  1954.         ieve1    = exis teve1 ; 
  1955.       fins ; 
  1956.       si (ega mot3 'PART') ; 
  1957.         imot6    = vrai ; 
  1958.         argu numpart1*'ENTIER' ; 
  1959.       fins ; 
  1960.       si (ega mot3 'COUCHE') ; 
  1961.         imot7    = vrai ; 
  1962.       fins ; 
  1963.     fin b1 ; 
  1964.  
  1965. * Indications PART et changement de COUCHE :
  1966.   si (exis tab1 'PART_COURANTE') ;
  1967.     si imot6 ;
  1968.       tab1.part_courante = numpart1 ;
  1969.       si (non (exis tab1.nb_couches_part numpart1)) ;
  1970.         tab1.nb_couches_part.numpart1 = 1 ;
  1971.       fins ;
  1972.     fins ;
  1973.     ipar1    = tab1.part_courante ;
  1974.     si imot7 ;
  1975.       icou1    = tab1.nb_couches_part.ipar1 ;
  1976.       tab1.nb_couches_part.ipar1 = icou1 + 1 ;
  1977.     fins ;
  1978.   sino ;
  1979.     si (imot6 ou imot7) ;
  1980.       erre '***** SOUDAGE : option PART ou COUCHE impossible avant toute passe' ;
  1981.     fins ;
  1982.   fins ;
  1983.  
  1984. *   Coupure et temps de coupure selon existence EVEN : 
  1985. *    idtcp1   = idtcp1 ou ieve1 ; 
  1986. *    si ieve1 ; 
  1987. *      dtcp1    = teve1 ; 
  1988. *    fins ; 
  1989.  
  1990. *   Trajectoire DEPLA DROI : 
  1991. *list idebut1 ; 
  1992.     si idebut1 ; 
  1993.       P0       = tab1.point_de_depart plus Pnul1 ; 
  1994. *     Deplacements relatifs : 
  1995.       si irela1 ; 
  1996.         P1       = P0 plus P1 ; 
  1997.       fins ; 
  1998.       mail1    = P0 droi 1 P1 ; 
  1999.       mail1    = mail1 coul vert ; 
  2000.       ll1      = mesu mail1 ; 
  2001.     sino ; 
  2002.       mail0    = tab1.trajectoire ; 
  2003.       nbpts0   = nbno mail0 ; 
  2004.       P0       = mail0 poin nbpts0 ; 
  2005. *list P0 ; 
  2006. *     Deplacements relatifs : 
  2007.       si irela1 ; 
  2008.         P1       = P0 plus P1 ; 
  2009.       fins ; 
  2010.       mail1    = P0 droi 1 P1 ; 
  2011.       mail1    = mail1 coul vert ; 
  2012.       ll1      = mesu mail1 ; 
  2013.       si (nbpts0 > 1) ; 
  2014.         mail1    = mail0 et mail1 ; 
  2015.       fins ; 
  2016.     fins ; 
  2017.  
  2018. *   Increment de temps DEPLA DROI : 
  2019.     si (non imot4) ; 
  2020.       vdep1    = tab1.vitesse_de_deplacement ; 
  2021.     fins ; 
  2022.     dt1    = ll1 / vdep1 ; 
  2023.     si idtcp1 ; 
  2024.       dt1    = dt1 + dtcp1 ; 
  2025.     fins ; 
  2026.  
  2027. *   Evolution puissance DEPLA DROI : 
  2028.     si idebut1 ; 
  2029.       ltps1    = prog    0.   dt1 ; 
  2030.       lqtot1   = prog qtot1 qtot1 ; 
  2031.       lqi1     = prog 1. 1. ; 
  2032.     sino ; 
  2033.       ltps0    = extr evqtot0 absc ; 
  2034.       tps0     = extr  ltps0 (dime  ltps0) ; 
  2035. *     Si la puissance indiquee est differente de celle existante : 
  2036.       si idtcp1 ; 
  2037.         lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2038.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2039.         lqtot1   = prog          qtot1        qtot1 ; 
  2040.       sino ; 
  2041.         lti1     = prog tps0 (tps0 + dt1) ; 
  2042.         ltps1    = prog (tps0 + dt1) ; 
  2043.         lqtot1   = prog        qtot1 ; 
  2044.       fins ; 
  2045.       ltps1    =  ltps0 et  ltps1 ; 
  2046.       lqtot1   = lqtot0 et lqtot1 ; 
  2047.     fins ; 
  2048.     evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
  2049.  
  2050. *   Evolution debit DEPLA DROI : 
  2051.     si idebut1 ; 
  2052.       ltps1    = prog    0.   dt1 ; 
  2053.       ldebi1   = prog debi1 debi1 ; 
  2054.     sino ; 
  2055.       ltps0    = extr evdebi0 absc ; 
  2056.       tps0     = extr  ltps0 (dime  ltps0) ; 
  2057. *     Si la puissance indiquee est differente de celle existante : 
  2058.       si idtcp1 ; 
  2059.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2060.         ldebi1   = prog          debi1        debi1 ; 
  2061.       sino ; 
  2062.         ltps1    = prog (tps0 + dt1) ; 
  2063.         ldebi1   = prog        debi1 ; 
  2064.       fins ; 
  2065.       ltps1    =  ltps0 et  ltps1 ; 
  2066.       ldebi1   = ldebi0 et ldebi1 ; 
  2067.     fins ; 
  2068.     evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
  2069.  
  2070. *   Evolution deplacement DEPLA DROI : 
  2071.     si idebut1 ; 
  2072.       ltps1    = prog 0. dt1 ; 
  2073.       ldep1    = prog 0. ll1 ; 
  2074.       tps0     = 0. ; 
  2075.     sino ; 
  2076.       evdep0   = tab1.evolution_deplacement ; 
  2077.       ltps0    = extr evdep0 absc ; 
  2078.       ldep0    = extr evdep0 ordo ; 
  2079.       tps0     = extr ltps0 (dime ltps0) ; 
  2080.       dep0     = extr ldep0 (dime ldep0) ; 
  2081.       si idtcp1 ; 
  2082.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2083.         ldep1    = prog           dep0 (dep0 + ll1) ; 
  2084.       sino ; 
  2085.         ltps1    = prog (tps0 + dt1) ; 
  2086.         ldep1    = prog (dep0 + ll1) ; 
  2087.       fins ; 
  2088.       ltps1    = ltps0 et ltps1 ; 
  2089.       ldep1    = ldep0 et ldep1 ; 
  2090.     fins ; 
  2091.     ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
  2092.     evdep1   = evol vert manu temp ltps1 ldep1 ; 
  2093.  
  2094. *   Evenement : 
  2095.     si imot5 ; 
  2096.       ttev1    = table ;
  2097.       ttev1 . nom   =  even1 ; 
  2098.       si ieve1 ; 
  2099.         ttev1 . temps = prog tps0 (tps0 + teve1) ; 
  2100.       sino ; 
  2101.         ttev1 . temps = prog tps0 ; 
  2102.       fins ; 
  2103.       si (exis tab1 'EVENEMENTS') ; 
  2104.         nbev1    = (dime tab1.evenements) + 1 ; 
  2105.       sino ; 
  2106.         tab1.evenements = table ; 
  2107.         nbev1    = 1 ; 
  2108.       fins ; 
  2109.       tab1.evenements.nbev1 = ttev1 ; 
  2110.     fins ; 
  2111.  
  2112. *   Enregistrements en fin de traitement option pour eviter
  2113. *   modifier table avant fin realisation option
  2114.     tab1.trajectoire = mail1 ; 
  2115.     tab1.evolution_puissance = evqtot1 ; 
  2116.     tab1.evolution_debit = evdebi1 ; 
  2117.     tab1.evolution_deplacement = evdep1 ; 
  2118.  
  2119.     quit soudage ; 
  2120. *   Fin option DEPLA DROI : 
  2121.   fins ; 
  2122.  
  2123. *----------------------------- DEPLA CERC -----------------------------* 
  2124.   si (ega mot2 'CERC') ; 
  2125.     icas2    = 2 ; 
  2126.  
  2127. *   P1 est le centre du cercle, P2, l'extremite de la trajectoire 
  2128.     argu P2*'POINT' P1*'POINT' N1/'ENTIER'; 
  2129.     P1       = P1 plus Pnul1 ; 
  2130.     P2       = P2 plus Pnul1 ; 
  2131.  
  2132. *   Lecture arguments optionnels :
  2133.     imot3    = faux ; comm mot-cle 'ABSO' ;
  2134.     imot4    = faux ; comm mot-cle 'VITE' ;
  2135.     imot5    = faux ; comm mot-cle 'EVEN' ;
  2136.     imot6    = faux ; comm mot-cle 'PART' ;
  2137.     imot7    = faux ; comm mot-cle 'COUCHE' ;
  2138.     irela1   = vrai ; 
  2139.     ieve1    = faux ; 
  2140.     repe b1 10 ; comm on itere volontairement plus que necessaire ;
  2141.       argu mot3/'MOT' ; 
  2142.       si (non (exis mot3)) ; quit b1 ; fins ; 
  2143.       si (ega mot3 'ABSO') ; 
  2144.         imot3    = vrai ; 
  2145.         irela1   = faux ; 
  2146.       fins ; 
  2147.       si (ega mot3 'VITE') ; 
  2148.         imot4    = vrai ; 
  2149.         argu vdep1*'FLOTTANT' ; 
  2150.       fins ; 
  2151.       si (ega mot3 'EVEN') ; 
  2152.         imot5    = vrai ; 
  2153.         argu even1*'MOT' ; 
  2154.         argu teve1/'FLOTTANT' ; 
  2155.         ieve1    = exis teve1 ; 
  2156.       fins ; 
  2157.       si (ega mot3 'PART') ; 
  2158.         imot6    = vrai ; 
  2159.         argu numpart1*'ENTIER' ; 
  2160.       fins ; 
  2161.       si (ega mot3 'COUCHE') ; 
  2162.         imot7    = vrai ; 
  2163.       fins ; 
  2164.     fin b1 ; 
  2165.  
  2166. * Indications PART et changement de COUCHE :
  2167.   si (exis tab1 'PART_COURANTE') ;
  2168.     si imot6 ;
  2169.       tab1.part_courante = numpart1 ;
  2170.       si (non (exis tab1.nb_couches_part numpart1)) ;
  2171.         tab1.nb_couches_part.numpart1 = 1 ;
  2172.       fins ;
  2173.     fins ;
  2174.     ipar1    = tab1.part_courante ;
  2175.     si imot7 ;
  2176.       icou1    = tab1.nb_couches_part.ipar1 ;
  2177.       tab1.nb_couches_part.ipar1 = icou1 + 1 ;
  2178.     fins ;
  2179.   sino ;
  2180.     si (imot6 ou imot7) ;
  2181.       erre '***** SOUDAGE : option PART ou COUCHE impossible avant toute passe' ;
  2182.     fins ;
  2183.   fins ;
  2184.  
  2185. *   Coupure et temps de coupure selon existence EVEN : 
  2186. *    idtcp1   = idtcp1 ou ieve1 ; 
  2187. *    si ieve1 ; 
  2188. *      dtcp1    = teve1 ; 
  2189. *    fins ; 
  2190.  
  2191. *   Trajectoire DEPLA CERC : 
  2192.     si idebut1 ; 
  2193.       P0       = tab1.point_de_depart plus Pnul1 ; 
  2194. *     Deplacements relatifs : 
  2195.       si irela1 ; 
  2196.         P1       = P0 plus P1 ; 
  2197.         P2       = P0 plus P2 ; 
  2198.       fins ; 
  2199. *     Par defaut, N1 calcule pour avoir angle de 5 deg. 
  2200.       si (non (exis N1)) ; 
  2201.         V1       = P0 moin P1 ; 
  2202.         V2       = P2 moin P1 ; 
  2203.         V1       = V1 / (norm V1) ; 
  2204.         V2       = V2 / (norm V2) ; 
  2205.         N1       = (acos (psca V1 V2)) / 5. ; 
  2206.         N1       = maxi (lect (enti N1) 1) ; 
  2207.       fins ; 
  2208.       mail1    = CERC N1 P0 P1 P2 ; 
  2209.       mail1    = mail1 coul vert ; 
  2210.       ll1      = mesu mail1 ; 
  2211.     sino ; 
  2212.       mail0    = tab1.trajectoire ; 
  2213.       nbpts0   = nbno mail0 ; 
  2214.       P0       = mail0 poin nbpts0 ; 
  2215. *     Deplacements relatifs : 
  2216.       si irela1 ; 
  2217.         P1       = P0 plus P1 ; 
  2218.         P2       = P0 plus P2 ; 
  2219.       fins ; 
  2220.       si (non (exis N1)) ; 
  2221.         V1       = P0 moin P1 ; 
  2222.         V2       = P2 moin P1 ; 
  2223.         V1       = V1 / (norm V1) ; 
  2224.         V2       = V2 / (norm V2) ; 
  2225.         N1       = (acos (psca V1 V2)) / 5. ; 
  2226.         N1       = maxi (lect (enti N1) 1) ; 
  2227.       fins ; 
  2228.       mail1    = CERC N1 P0 P1 P2 ; 
  2229.       mail1    = mail1 coul vert ; 
  2230.       ll1      = mesu mail1 ; 
  2231.       si (nbpts0 > 1) ; 
  2232.         mail1    = mail0 et mail1 ; 
  2233.       fins ; 
  2234.     fins ; 
  2235.  
  2236. *   Increment de temps DEPLA CERC : 
  2237.     si (non imot4) ; 
  2238.       vdep1    = tab1.vitesse_de_deplacement ; 
  2239.     fins ; 
  2240.     dt1    = ll1 / vdep1 ; 
  2241.     si idtcp1 ; 
  2242.       dt1    = dt1 + dtcp1 ; 
  2243.     fins ; 
  2244.  
  2245. *   Evolution puissance DEPLA CERC : 
  2246.     icoup1   = faux ; 
  2247.     si idebut1 ; 
  2248.       ltps1    = prog    0.   dt1 ; 
  2249.       lqtot1   = prog qtot1 qtot1 ; 
  2250.       lqi1     = prog 1. 1. ; 
  2251.     sino ; 
  2252.       ltps0    = extr evqtot0 absc ; 
  2253.       tps0     = extr  ltps0 (dime  ltps0) ; 
  2254. *     Si la puissance indiquee est differente de celle existante : 
  2255.       si idtcp1 ; 
  2256.         lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2257.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2258.         lqtot1   = prog          qtot1        qtot1 ; 
  2259.       sino ; 
  2260.         lti1     = prog tps0 (tps0 + dt1) ; 
  2261.         ltps1    = prog (tps0 + dt1) ; 
  2262.         lqtot1   = prog        qtot1 ; 
  2263.       fins ; 
  2264.       ltps1    =  ltps0 et  ltps1 ; 
  2265.       lqtot1   = lqtot0 et lqtot1 ; 
  2266.     fins ; 
  2267.     evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
  2268.  
  2269. *   Evolution debit DEPLA CERC : 
  2270.     si idebut1 ; 
  2271.       ltps1    = prog    0.   dt1 ; 
  2272.       ldebi1   = prog debi1 debi1 ; 
  2273.     sino ; 
  2274.       ltps0    = extr evdebi0 absc ; 
  2275.       tps0     = extr  ltps0 (dime  ltps0) ; 
  2276. *     Si la puissance indiquee est differente de celle existante : 
  2277.       si idtcp1 ; 
  2278.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2279.         ldebi1   = prog          debi1        debi1 ; 
  2280.       sino ; 
  2281.         ltps1    = prog (tps0 + dt1) ; 
  2282.         ldebi1   = prog        debi1 ; 
  2283.       fins ; 
  2284.       ltps1    =  ltps0 et  ltps1 ; 
  2285.       ldebi1   = ldebi0 et ldebi1 ; 
  2286.     fins ; 
  2287.     evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
  2288.  
  2289. *   Evolution deplacement DEPLA CERC : 
  2290.     si idebut1 ; 
  2291.       ltps1    = prog 0. dt1 ; 
  2292.       ldep1    = prog 0. ll1 ; 
  2293.       tps0     = 0. ; 
  2294.     sino ; 
  2295.       evdep0   = tab1.evolution_deplacement ; 
  2296.       ltps0    = extr evdep0 absc ; 
  2297.       ldep0    = extr evdep0 ordo ; 
  2298.       tps0     = extr ltps0 (dime ltps0) ; 
  2299.       dep0     = extr ldep0 (dime ldep0) ; 
  2300.       si idtcp1 ; 
  2301.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2302.         ldep1    = prog           dep0 (dep0 + ll1) ; 
  2303.       sino ; 
  2304.         ltps1    = prog (tps0 + dt1) ; 
  2305.         ldep1    = prog (dep0 + ll1) ; 
  2306.       fins ; 
  2307.       ltps1    = ltps0 et ltps1 ; 
  2308.       ldep1    = ldep0 et ldep1 ; 
  2309.     fins ; 
  2310.     ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
  2311.     evdep1   = evol vert manu temp ltps1 ldep1 ; 
  2312.  
  2313. *   Evenement : 
  2314.     si imot5 ; 
  2315.       ttev1    = table ;
  2316.       ttev1 . nom   =  even1 ; 
  2317.       si ieve1 ; 
  2318.         ttev1 . temps = prog tps0 (tps0 + teve1) ; 
  2319.       sino ; 
  2320.         ttev1 . temps = prog tps0 ; 
  2321.       fins ; 
  2322.       si (exis tab1 'EVENEMENTS') ; 
  2323.         nbev1    = (dime tab1.evenements) + 1 ; 
  2324.       sino ; 
  2325.         tab1.evenements = table ; 
  2326.         nbev1    = 1 ; 
  2327.       fins ; 
  2328.       tab1.evenements.nbev1 = ttev1 ; 
  2329.     fins ; 
  2330.  
  2331. *   Enregistrements en fin de traitement option pour eviter
  2332. *   modifier table avant fin realisation option
  2333.     tab1.trajectoire = mail1 ; 
  2334.     tab1.evolution_puissance = evqtot1 ; 
  2335.     tab1.evolution_debit = evdebi1 ; 
  2336.     tab1.evolution_deplacement = evdep1 ; 
  2337.  
  2338.     quit soudage ; 
  2339. *   Fin option DEPLA CERC : 
  2340.   fins ; 
  2341.  
  2342. *----------------------------- DEPLA MAIL -----------------------------* 
  2343. * Sous-option MAIL : 
  2344.   si (ega mot2 'MAIL') ; 
  2345.     icas2    = 3 ; 
  2346.  
  2347.     argu mail1*'MAILLAGE' ; 
  2348.     eltyp1   = mail1 elem type ; 
  2349.     imax1    = 0 ; 
  2350.     si (exis eltyp1 'SEG2') ; imax1 = imax1 + 1 ; fins ; 
  2351.     si (exis eltyp1 'SEG3') ; imax1 = imax1 + 1 ; fins ; 
  2352.     si ((dime eltyp1) > imax1) ; 
  2353.       erre '*****  ERREUR : le maillage doit etre compose de SEG2 ou de SEG3.' ; 
  2354.     fins ; 
  2355.     ll1      = mesu mail1 ; 
  2356.  
  2357. *   Trajectoire DEPLA MAIL : 
  2358.     si idebut1 ; 
  2359.       P1       = mail1 poin 1 ; 
  2360.       tab1.point_de_depart = P1 ; 
  2361.     sino ; 
  2362.       mail0    = tab1.trajectoire ; 
  2363.       nbpts0   = nbno mail0 ; 
  2364.       P0       = mail0 poin nbpts0 ; 
  2365.       P1       = mail1 poin 1 ; 
  2366.       si (P1 neg P0) ; 
  2367.         tol1     = 1.e-10 * (mesu mail1) ; 
  2368.         si ((norm (P1 moin P0)) > tol1) ; 
  2369.           erre '*****  ERREUR : MAILLAGE incompatible.' ; 
  2370.           quit soudage ; 
  2371.         sino ; 
  2372.           elim (P0 et P1) tol1 ; 
  2373.         fins ; 
  2374.       fins ; 
  2375.       si (nbpts0 > 1) ; 
  2376.         mail1    = mail1 coul vert ; 
  2377.         mail1    = mail0 et mail1 ; 
  2378.       fins ; 
  2379.     fins ; 
  2380.  
  2381. *   Lecture arguments optionnels :
  2382.     imot4    = faux ; comm mot-cle 'VITE' ;
  2383.     imot5    = faux ; comm mot-cle 'EVEN' ;
  2384.     imot6    = faux ; comm mot-cle 'PART' ;
  2385.     imot7    = faux ; comm mot-cle 'COUCHE' ;
  2386.     ieve1    = faux ; 
  2387.     repe b1 10 ; comm on itere volontairement plus que necessaire ;
  2388.       argu mot4/'MOT' ; 
  2389.       si (non (exis mot4)) ; quit b1 ; fins ; 
  2390.       si (ega mot4 'VITE') ; 
  2391.         imot4    = vrai ; 
  2392.         argu vdep1*'FLOTTANT' ; 
  2393.       fins ; 
  2394.       si (ega mot4 'EVEN') ; 
  2395.         imot5    = vrai ; 
  2396.         argu even1*'MOT' ; 
  2397.         argu teve1/'FLOTTANT' ; 
  2398.         ieve1    = exis teve1 ; 
  2399.       fins ; 
  2400.       si (ega mot4 'PART') ; 
  2401.         imot6    = vrai ; 
  2402.         argu numpart1*'ENTIER' ; 
  2403.       fins ; 
  2404.       si (ega mot4 'COUCHE') ; 
  2405.         imot7    = vrai ; 
  2406.       fins ; 
  2407.     fin b1 ; 
  2408.  
  2409. * Indications PART et changement de COUCHE :
  2410.   si (exis tab1 'PART_COURANTE') ;
  2411.     si imot6 ;
  2412.       tab1.part_courante = numpart1 ;
  2413.       si (non (exis tab1.nb_couches_part numpart1)) ;
  2414.         tab1.nb_couches_part.numpart1 = 1 ;
  2415.       fins ;
  2416.     fins ;
  2417.     ipar1    = tab1.part_courante ;
  2418.     si imot7 ;
  2419.       icou1    = tab1.nb_couches_part.ipar1 ;
  2420.       tab1.nb_couches_part.ipar1 = icou1 + 1 ;
  2421.     fins ;
  2422.   sino ;
  2423.     si (imot6 ou imot7) ;
  2424.       erre '***** SOUDAGE : option PART ou COUCHE impossible avant toute passe' ;
  2425.     fins ;
  2426.   fins ;
  2427.  
  2428. *   Coupure et temps de coupure selon existence EVEN : 
  2429. *    idtcp1   = idtcp1 ou ieve1 ; 
  2430. *    si ieve1 ; 
  2431. *      dtcp1    = teve1 ; 
  2432. *    fins ; 
  2433.  
  2434. * Vitesse de deplacement : 
  2435.     si (non imot4) ; 
  2436.       vdep1    = tab1.vitesse_de_deplacement ; 
  2437.     fins ; 
  2438.     dt1    = ll1 / vdep1 ; 
  2439.     si idtcp1 ; 
  2440.       dt1    = dt1 + dtcp1 ; 
  2441.     fins ; 
  2442.  
  2443. *   Evolution puissance DEPLA MAIL : 
  2444.     si idebut1 ; 
  2445.       ltps1    = prog    0.   dt1 ; 
  2446.       lqtot1   = prog qtot1 qtot1 ; 
  2447.       lqi1     = prog 1. 1. ; 
  2448.     sino ; 
  2449.       ltps0    = extr evqtot0 absc ; 
  2450.       tps0     = extr  ltps0 (dime  ltps0) ; 
  2451. *     Si la puissance indiquee est differente de celle existante : 
  2452.       si idtcp1 ; 
  2453.         lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2454.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2455.         lqtot1   = prog          qtot1        qtot1 ; 
  2456.       sino ; 
  2457.         lti1     = prog tps0 (tps0 + dt1) ; 
  2458.         ltps1    = prog (tps0 + dt1) ; 
  2459.         lqtot1   = prog        qtot1 ; 
  2460.       fins ; 
  2461.       ltps1    =  ltps0 et  ltps1 ; 
  2462.       lqtot1   = lqtot0 et lqtot1 ; 
  2463.     fins ; 
  2464.     evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
  2465.  
  2466. *   Evolution debit DEPLA MAIL : 
  2467.     si idebut1 ; 
  2468.       ltps1    = prog    0.   dt1 ; 
  2469.       ldebi1   = prog debi1 debi1 ; 
  2470.     sino ; 
  2471.       ltps0    = extr evdebi0 absc ; 
  2472.       tps0     = extr  ltps0 (dime  ltps0) ; 
  2473. *     Si la puissance indiquee est differente de celle existante : 
  2474.       si idtcp1 ; 
  2475.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2476.         ldebi1   = prog          debi1        debi1 ; 
  2477.       sino ; 
  2478.         ltps1    = prog (tps0 + dt1) ; 
  2479.         ldebi1   = prog        debi1 ; 
  2480.       fins ; 
  2481.       ltps1    =  ltps0 et  ltps1 ; 
  2482.       ldebi1   = ldebi0 et ldebi1 ; 
  2483.     fins ; 
  2484.     evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
  2485.  
  2486. *   Evolution deplacement DEPLA MAIL : 
  2487.     si idebut1 ; 
  2488.       ltps1    = prog 0. dt1 ; 
  2489.       ldep1    = prog 0. ll1 ; 
  2490.       tps0     = 0. ; 
  2491.     sino ; 
  2492.       evdep0   = tab1.evolution_deplacement ; 
  2493.       ltps0    = extr evdep0 absc ; 
  2494.       ldep0    = extr evdep0 ordo ; 
  2495.       tps0     = extr ltps0 (dime ltps0) ; 
  2496.       dep0     = extr ldep0 (dime ldep0) ; 
  2497.       si idtcp1 ; 
  2498.         ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
  2499.         ldep1    = prog           dep0 (dep0 + ll1) ; 
  2500.       sino ; 
  2501.         ltps1    = prog (tps0 + dt1) ; 
  2502.         ldep1    = prog (dep0 + ll1) ; 
  2503.       fins ; 
  2504.       ltps1    = ltps0 et ltps1 ; 
  2505.       ldep1    = ldep0 et ldep1 ; 
  2506.     fins ; 
  2507.     ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
  2508.     evdep1   = evol vert manu temp ltps1 ldep1 ; 
  2509.  
  2510. *   Evenement : 
  2511.     si imot5 ; 
  2512.       ttev1    = table ;
  2513.       ttev1 . nom   =  even1 ; 
  2514.       si ieve1 ; 
  2515.         ttev1 . temps = prog tps0 (tps0 + teve1) ; 
  2516.       sino ; 
  2517.         ttev1 . temps = prog tps0 ; 
  2518.       fins ; 
  2519.       si (exis tab1 'EVENEMENTS') ; 
  2520.         nbev1    = (dime tab1.evenements) + 1 ; 
  2521.       sino ; 
  2522.         tab1.evenements = table ; 
  2523.         nbev1    = 1 ; 
  2524.       fins ; 
  2525.       tab1.evenements.nbev1 = ttev1 ; 
  2526.     fins ; 
  2527.  
  2528. *   Enregistrements en fin de traitement option pour eviter
  2529. *   modifier table avant fin realisation option
  2530.     tab1.trajectoire = mail1 ; 
  2531.     tab1.evolution_puissance = evqtot1 ; 
  2532.     tab1.evolution_debit = evdebi1 ; 
  2533.     tab1.evolution_deplacement = evdep1 ; 
  2534.  
  2535.     quit soudage ; 
  2536. *   Fin option DEPLA MAIL : 
  2537.   fins ; 
  2538.  
  2539. *---------------------------- DEPLA COUCHE ----------------------------* 
  2540. * Sous-option COUCHE : 
  2541.   si (ega mot2 'COUCHE') ; 
  2542.     icas2    = 4 ; 
  2543.  
  2544. *   Option PAUSE : 
  2545.     imot2    = faux ; comm mot-cle 'LARG' ;
  2546.     imot3    = faux ; comm mot-cle 'VITE' ;
  2547.     imot4    = faux ; comm mot-cle 'DEBI' ;
  2548.     imot5    = faux ; comm mot-cle 'PAUSE' ;
  2549.     imot6    = faux ; comm mot-cle 'EVEN' ;
  2550.     ieve1    = faux ; 
  2551.     repe b1 10 ; comm on itere volontairement plus que necessaire ;
  2552.       argu mot3/'MOT' ; 
  2553.       si (non (exis mot3)) ; quit b1; fins ; 
  2554.       si (ega mot3 'LARG') ; 
  2555.         imot2    = vrai ; 
  2556.         argu flot1*'FLOTTANT' ; 
  2557.       fins ; 
  2558.       si (ega mot3 'VITE') ; 
  2559.         imot3    = vrai ; 
  2560.         argu flot2*'FLOTTANT' ; 
  2561.       fins ; 
  2562.       si (ega mot3 'DEBI') ; 
  2563.         imot4    = vrai ; 
  2564.         argu flot3*'FLOTTANT' ; 
  2565.       fins ; 
  2566.       si (ega mot3 'PAUSE') ; 
  2567.         imot5    = vrai ; 
  2568.         argu flot4*'FLOTTANT' ; 
  2569.       fins ; 
  2570.       si (ega mot3 'EVEN') ; 
  2571.         imot6    = vrai ; 
  2572.         argu even1*'MOT' ; 
  2573.         argu teve1/'FLOTTANT' ; 
  2574.         ieve1    = exis teve1 ; 
  2575.       fins ; 
  2576.     fin b1 ; 
  2577.  
  2578. *   Mise a jour NB_COUCHES_PART :
  2579.     si (exis tab1 'PART_COURANTE') ;
  2580.       ipar1    = tab1.part_courante ;
  2581.       icou1    = tab1.nb_couches_part.ipar1 ;
  2582.       tab1.nb_couches_part.ipar1 = icou1 + 1 ;
  2583.     fins ;
  2584.  
  2585. *   Epaisseur de la couche : 
  2586.     si imot3 ; 
  2587.       Vpf1     = flot2 ; 
  2588.     sino ; 
  2589.       Vpf1     = tab1.vitesse_de_soudage ; 
  2590.     fins ; 
  2591.     si imot4 ; 
  2592.       Dpf1     = flot3 ; 
  2593.     sino ; 
  2594.       Dpf1     = tab1.debit_de_fil ; 
  2595.     fins ; 
  2596. *List Dpf1 ; 
  2597.     si imot2 ;
  2598.       Lpf1     = flot1 ;
  2599.     sino ;
  2600.       si (exis tab1 'LARGEUR_DE_PASSE') ;
  2601.         Lpf1     = tab1.largeur_de_passe ; 
  2602.       sinon ; 
  2603.         erre '*****  ERREUR : il manque la donnee de la largeur de passe.' ; 
  2604.       fins ; 
  2605.     fins ;
  2606. *List Lpf1 ;
  2607.     epf1     = Dpf1 / Vpf1 / Lpf1 ; 
  2608. *List epf1 ; 
  2609.  
  2610. *   Pause : 
  2611.     si imot5 ; 
  2612.       vdep2    = epf1 / flot4 ; 
  2613.     sino ; 
  2614.       vdep2    = tab1.vitesse_de_deplacement ; 
  2615.     fins ; 
  2616.     si imot6 ; 
  2617.       si ieve1 ; 
  2618.         soudage tab1 depla droi (0 0 epf1) vite vdep2 even even1 teve1 ; 
  2619.       sino ; 
  2620.         soudage tab1 depla droi (0 0 epf1) vite vdep2 even even1 ; 
  2621.       fins ; 
  2622.     sino ; 
  2623.       soudage tab1 depla droi (0 0 epf1) vite vdep2 ; 
  2624.     fins ; 
  2625.  
  2626. *   Fin option DEPLA COUCHE : 
  2627.   fins ; 
  2628.  
  2629.   si (icas2 ega 0) ; 
  2630.     erre '*****  ERREUR : MOT option non reconnu.' ; 
  2631.     quit soudage ; 
  2632.   fins ; 
  2633.  
  2634. * Fin option DEPLA : 
  2635. fins ; 
  2636.  
  2637. *----------------------------------------------------------------------* 
  2638. *                             Option MAIL                              * 
  2639. *----------------------------------------------------------------------* 
  2640.  
  2641. si (ega mot1 'MAIL') ; 
  2642.   icas1    = 4 ; 
  2643.  
  2644. *----------------------- Lecture des arguments ------------------------* 
  2645.  
  2646. * Lecture maillage cordons : 
  2647.   argu mail1*'MAILLAGE' ; 
  2648.  
  2649. * Lecture facultative liste ordonnancement couleurs ; 
  2650.   argu list1/'LISTENTI' ; 
  2651.   ilist1  = exis list1 ; 
  2652.   si (non ilist1) ; 
  2653.     argu list1/'LISTMOTS' ; 
  2654.     ilist1  = exis list1 ; 
  2655.   fins ; 
  2656.  
  2657. * Lecture du mot 'PAS' ; 
  2658.   argu mot1*'MOT' ; 
  2659.   si (neg mot1 'PAS') ; 
  2660.     erre '*****  ERREUR : on attend le mot-cle PAS' ; 
  2661.     quit soudage ; 
  2662.   sino ; 
  2663.     argu flot1*'FLOTTANT' ; 
  2664.   fins ; 
  2665.  
  2666. * Lecture options 'TEMP', 'MAXI' et 'MESU' ; 
  2667.   imot2    = faux ; comm option TEMP ;
  2668.   imot3    = faux ; comm option TEMP MAXI ;
  2669.   imot4    = faux ; comm option MESU ;
  2670.   repe bmot2 3 ; 
  2671.     argu mot2/'MOT' ; 
  2672.     si (exis mot2) ; 
  2673.       si (ega mot2 'TEMP') ; 
  2674.         imot2    = vrai ; 
  2675.         argu flot2/'FLOTTANT' ; 
  2676.         si (non (exis flot2)) ; 
  2677.           flot2    = 3. * pi ;
  2678.         fins ; 
  2679.       fins ; 
  2680.       si (ega mot2 'MAXI') ;
  2681.         imot3    = vrai ;
  2682.         argu flot3*'FLOTTANT' ;
  2683.         iter bmot2 ; 
  2684.       fins ;
  2685.       si (ega mot2 'MESU') ; 
  2686.         imot4    = vrai ; 
  2687.         argu ps1*point ; 
  2688.         iter bmot2 ; 
  2689.       fins ; 
  2690.       si ((non imot2) et (non imot4)) ; 
  2691.         erre '*****  ERREUR : on attend les mots-cle TEMP ou MESU' ; 
  2692. *        quit soudage ; 
  2693.       fins ; 
  2694.     fins ; 
  2695.   fin bmot2 ; 
  2696. *list imot2 ; list imot3 ; list imot4 ; 
  2697.  
  2698. *----------------------- Indexation du maillage -----------------------* 
  2699.  
  2700. * Informations trajectoire : 
  2701.   ltraj1   = tab1.trajectoire ; 
  2702.   chxs1    = ltraj1 coor curv ; 
  2703.   x1 y1 z1 = mail1 coor ; 
  2704.  
  2705. * Informations evolution deplacements : 
  2706.   evxs1    = tab1.evolution_deplacement ; 
  2707.   ltxs1    = extr evxs1 absc ; 
  2708.   lxxs1    = extr evxs1 ordo ; 
  2709.   nbxs1    = dime lxxs1 ; 
  2710. *list ltxs1 ; 
  2711. *list lxxs1 ; 
  2712.  
  2713. * Information apport de matiere : 
  2714.   evdf1    = tab1.evolution_debit ; 
  2715.   ldeb1    = extr evdf1 ordo ; 
  2716.  
  2717. * tolerance dimensionnelle : 
  2718.   tol1     = 1.e-10 * (maxi ltxs1) ; 
  2719.   tol2     = 1.e-6  * (maxi ldeb1) ; 
  2720.  
  2721. * Table resultat : 
  2722.   tab2                                 = table ; 
  2723.   tab2 . maillage                      = mail1 ; 
  2724.   tab2 . evolution_maillage            = table ; 
  2725.   tab2 . evolution_maillage . temps    = table ; 
  2726.   tab2 . evolution_maillage . maillage = table ; 
  2727.   ttps1    = table ; 
  2728.   tmai1    = table ; 
  2729.  
  2730. * Listreels de l'option MESU : 
  2731.   si imot4 ;
  2732.     llarg1   = prog ; 
  2733.     lhaut1   = prog ; 
  2734.   fins ;
  2735.  
  2736. * Boucle sur les segents rouges de la trajectoire : 
  2737.   nb1      = nbel ltraj1 ; 
  2738.   geoi1    = vide maillage ; 
  2739.   indi1    = 0 ; 
  2740.   ic1      = 1 ; 
  2741. *  ic1      = 16 ; 
  2742.   inewcor1 = vrai ; 
  2743.   isuidep1 = vrai ; 
  2744.   ifermee1 = faux ; 
  2745.   icourbe1 = faux ; 
  2746.   ipredep1 = vrai ; 
  2747.  
  2748.   repe b1 nb1 ; 
  2749.     i1       = &b1 ;
  2750. *    i1       = &b1 + 9548 ;
  2751.     pasi1    = flot1 ; 
  2752.  
  2753.     eli1     = ltraj1 elem i1 ;
  2754.     pi1      = eli1 poin 1 ; 
  2755.     pi2      = eli1 poin 2 ; 
  2756.     leli1    = mesu eli1 ; 
  2757.  
  2758. *   Si pas trajectoire d'une passe, on saute en changeant de couleur : 
  2759.     si (neg ((eli1 elem coul) extr 1) 'ROUG') ; 
  2760. *mess '##### segment pas rouge' ;
  2761.       inewcor1 = vrai ; 
  2762.       ifermee1 = faux ; 
  2763.       icourbe1 = faux ; 
  2764.       si (non ipredep1) ; ic1 = ic1 + 1 ; fins ; 
  2765.       ipredep1 = vrai ; 
  2766.       iter b1 ; 
  2767.     sino ; 
  2768.       ipredep1 = faux ; 
  2769.       si (i1 neg nb1) ; 
  2770.         eli2     = ltraj1 elem (i1 + 1) ; 
  2771.         isuidep1 = ega ((eli2 elem coul) extr 1) 'VERT' ; 
  2772.         si ((non isuidep1) et (non (ifermee1 ou icourbe1))) ; 
  2773.           ifin1    = i1 + 1 ; 
  2774.           elfin1   = eli2 ; 
  2775.           repe bfermee1 (nb1 - i1 - 1) ; 
  2776.             eli2     = ltraj1 elem (i1 + 1 + &bfermee1) ; 
  2777.             si (ega ((eli2 elem coul) extr 1) 'VERT') ; quit bfermee1 ; fins ; 
  2778.             ifin1    = i1 + 1 + &bfermee1 ; 
  2779.             elfin1   = eli2 ; 
  2780.           fin bfermee1 ; 
  2781.           ideb1    = i1 ; 
  2782.           ifermee1 = (norm ((elfin1 poin 2) moin pi1)) < tol1 ; 
  2783.           icourbe1 = non ifermee1 ; 
  2784. si icourbe1 ; mess '*****  Passes successives : n° elem. debut =' ideb1 ', fin = ' ifin1 ; fins ; 
  2785. si ifermee1 ; mess '*****  Passe fermee : n° elem. debut =' ideb1 ', fin = ' ifin1 ; fins ; 
  2786.         fins ; 
  2787.       fins ; 
  2788.     fins ; 
  2789. *list isuidep1 ; 
  2790.  
  2791. *   Maillage cordon passe ic1 : 
  2792.     si inewcor1 ; 
  2793.       inewcor1 = faux ; 
  2794.       si ilist1 ; 
  2795.         couli1   = extr list1 ic1 ; 
  2796.         si (ega (type couli1) 'MOT') ; 
  2797.           maili1   = mail1 elem couli1 ; 
  2798.         sino ; 
  2799.           maili1   = mail1 elem coul couli1 ; 
  2800.         fins ; 
  2801.       sino ; 
  2802.         maili1   = mail1 elem coul ic1 ;
  2803.       fins ; 
  2804.       pci1     = maili1 poin proc pi1 ; 
  2805.       si ((norm (pci1 moin pi1)) > pasi1 ) ; 
  2806.         erre '*****  ERREUR : distance trajectoire cordon superieure au PAS' ; 
  2807.         erre '       Element de la trajectoire :' i1 ; 
  2808.         quit soudage ; 
  2809.       fins ; 
  2810.       tpi1     = maili1 part nesc conn ; 
  2811.       repe bp1 (dime tpi1) ; 
  2812.         maili1   = tpi1.&bp1 ; 
  2813.         si (pci1 dans maili1) ; quit bp1 ; fins ; 
  2814.       fin  bp1 ; 
  2815. *trac maili1 cach titr 'nouveau cordon' ;
  2816.     sino ;
  2817.       si (vide maili1) ; iter b1 ; fins ;
  2818.     fins ; 
  2819.  
  2820. *   Vecteur(s) unitaire(s) de la trajectoire : 
  2821.     si (icourbe1 ou ifermee1) ; 
  2822.       si (i1 ega ideb1) ; 
  2823.         ni1      = (pi2 moin pi1) / leli1 ; 
  2824.         eli2     = ltraj1 elem (i1 + 1) ; 
  2825.         pi21     = eli2 poin 1 ; 
  2826.         pi22     = eli2 poin 2 ; 
  2827.         ni2      = (pi22 moin pi21) / (mesu eli2) ; 
  2828.         ni2      = 0.5 * (ni1 plus ni2) ; 
  2829.         si ifermee1 ; 
  2830.           pfin1    = elfin1 poin 1 ; 
  2831.           pfin2    = elfin1 poin 2 ; 
  2832.           nfin1    = (pfin2 moin pfin1) / (mesu elfin1) ; 
  2833.           ndeb1    = ni1 ; 
  2834.           ni1      = 0.5 * (ni1 plus nfin1) ; 
  2835.         fins ; 
  2836.       fins ; 
  2837.       si (i1 ega ifin1) ; 
  2838.         ni1      = (pi2 moin pi1) / leli1 ; 
  2839.         nix      = ni1 ; 
  2840.         ni1      = ni2 ; 
  2841.         ni2      = nix ; 
  2842.         si ifermee1 ; 
  2843.           ni2      = 0.5 * (ndeb1 plus ni2) ; 
  2844.         fins ; 
  2845.       fins ; 
  2846.       si ((ideb1 < i1) et  (i1 < ifin1)) ; 
  2847.         ni1      = (pi2 moin pi1) / leli1 ; 
  2848.         nix      = ni2 ; 
  2849.         eli2     = ltraj1 elem (i1 + 1) ; 
  2850.         pi21     = eli2 poin 1 ; 
  2851.         pi22     = eli2 poin 2 ; 
  2852.         ni2      = (pi22 moin pi21) / (mesu eli2) ; 
  2853.         ni2      = 0.5 * (ni1 plus ni2) ; 
  2854.         ni1      = nix ; 
  2855.       fins ; 
  2856.     sino ; 
  2857.       ni1      = (pi2 moin pi1) / leli1 ; 
  2858.     fins ; 
  2859. *list ni1 ; list ni2 ; 
  2860.  
  2861. *   Champ(s) de distance au(x) point(s) pi1 (Pi2) sur le maillage du cordon dans la direction ni1 (ni2) 
  2862.     x1 y1 z1       = maili1 coor ; 
  2863.     xp1 yp1 zp1    = pi1 coor ; 
  2864.     xni1 yni1 zni1 = ni1 coor ; 
  2865.     chpdi1   = ((x1 - xp1) * xni1) + ((y1 - yp1) * yni1) + ((z1 - zp1) * zni1) ; 
  2866.     modi1    = mode maili1 mecanique ; 
  2867.     chedi1   = chan cham chpdi1 modi1 gravite ; 
  2868. *    chedi1   = chan cham chpdi1 modi1 noeud ; 
  2869. *list ni1 ; list pi1 ; 
  2870. *trac nclk chedi1 modi1 ;
  2871.  
  2872. *   Option MESU : champs de distance dans les directions transverses (v et w) : 
  2873.     si imot4 ; 
  2874.       vi1      = ps1 / (norm ps1) ; 
  2875.       wi1      = pvec ni1 vi1 ; 
  2876. *list vi1 ; list wi1 ; 
  2877.       xvi1 yvi1 zvi1 = vi1 coor ; 
  2878.       xwi1 ywi1 zwi1 = wi1 coor ; 
  2879.       chli1    = ((x1 - xp1) * xwi1) + ((y1 - yp1) * ywi1) + ((z1 - zp1) * zwi1) ; 
  2880.       chhi1    = ((x1 - xp1) * xvi1) + ((y1 - yp1) * yvi1) + ((z1 - zp1) * zvi1) ; 
  2881. *trac chhi1 ; 
  2882.     fins ; 
  2883.  
  2884.  
  2885. *   Extraction evolution deplacement sur ce segment : 
  2886.     xspi1    = chxs1 extr pi1 scal ; 
  2887.     xspi2    = chxs1 extr pi2 scal ; 
  2888.     repe bxs1 nbxs1 ; 
  2889.       xxsi1    = extr lxxs1 (nbxs1 + 1 - &bxs1) ; 
  2890.       si (non (xxsi1 < (xspi2 - tol1))) ; 
  2891.         xxxi2    = xxsi1 ; 
  2892.         txxi2    = extr ltxs1 (nbxs1 + 1 - &bxs1) ; 
  2893.       fins ; 
  2894.       xxsi1    = extr lxxs1 &bxs1 ; 
  2895.       si (non (xxsi1 > (xspi1 + tol1))) ; 
  2896.         xxxi1    = xxsi1 ; 
  2897.         txxi1    = extr ltxs1 &bxs1 ; 
  2898.       fins ; 
  2899.     fin bxs1 ; 
  2900.     lxxsi1  = prog xxxi1 xxxi2 ; 
  2901.     ltxsi1  = prog txxi1 txxi2 ; 
  2902. *list lxxsi1 ; 
  2903. *list ltxsi1 ; 
  2904.  
  2905. *   Sequencage maillage cordon selon pas fourni : 
  2906.     si (leli1 >EG pasi1) ; 
  2907.       nb2      = (leli1 / pasi1) enti ; 
  2908.       nb2      = maxi (lect 1 nb2) ; 
  2909.     sino ; 
  2910.       nb2      = 1 ; 
  2911.       pasi1    = leli1 ; 
  2912.     fins ; 
  2913.  
  2914. *mess 'i1, nb2 = ' i1 nb2 ; 
  2915.  
  2916.     xsi1     = 0. ; 
  2917.     pmaili1  = maili1 poin proc pi1 ; 
  2918.     si ifermee1 ; 
  2919.       si (i1 ega ideb1) ; 
  2920.         xdeb1    = 0. - (extr chpdi1 scal pmaili1) ; 
  2921.       sino ; 
  2922.         Sdeb1    = (enve tmai1 . (indi1 - 1)) inte (enve maili1) ; 
  2923.         pdeb1    = Sdeb1 poin proc pi1 ; 
  2924.         tconn1   = Sdeb1 part nesc conn ; 
  2925.         si (pdeb1 dans tconn1 . 1) ; 
  2926.           Sdeb1    = tconn1 . 1 ; 
  2927.         sino ; 
  2928.           Sdeb1    = tconn1 . 2 ; 
  2929.         fins ; 
  2930. *trac cach Sdeb1 ; 
  2931.         xdeb1    = (redu chpdi1 Sdeb1) mini ; 
  2932.       fins ; 
  2933.       geoi2    = chedi1 elem supe (xsi1 - tol1 + xdeb1) stri ; 
  2934.       modi1    = redu modi1  geoi2 ; 
  2935.       chedi1   = redu chedi1 modi1 ; 
  2936. *trac geoi2 titr ' partie maillage passe dans le sens de la trajectoire' ;
  2937.     fins ; 
  2938.     repe b2 nb2 ; 
  2939.       xsi2     = xsi1 + pasi1 ; 
  2940.       si (xsi2 > leli1) ; 
  2941.         xsi2     = leli1 ; 
  2942.       fins ; 
  2943.       si ((&b2 ega nb2) et (isuidep1 ou (i1 ega nb1))) ; 
  2944.         xsi2     = maxi chedi1 ; 
  2945. *mess '*** Maxi !' ; 
  2946.       fins ; 
  2947.       geoi2    = chedi1 elem infe (xsi2 + tol1) stri ; 
  2948.       si (non (pmaili1 dans geoi2)) ;
  2949.         geoi2    = vide maillage ;
  2950.       sino ;
  2951. *trac (geoi2 et (aret maili1)) titr 'non vide' ;
  2952. *       Cas rare ou geoi2 ne fait pas la largeur de la passe et 1er bloc d'apport :
  2953. *       => augmentation critere jusqu'a avoir toute la lergeur de la passe
  2954.         si (i1 ega ideb1) ;
  2955.           sintxx1  = (enve geoi2) inte (enve (geoi2 diff maili1)) ;
  2956.           inolarg1 = ((sintxx1 part conn nesc) dime) ega 1 ;
  2957.           si inolarg1 ;
  2958.             xsix     = xsi2 ;
  2959.             repe bxx 10 ;
  2960.               xsix     = 1.05 * xsix ;
  2961.               geoixx   = chedi1 elem infe (xsix + tol1) stri ;
  2962.               sintxx1  = (enve geoixx) inte (enve (geoixx diff maili1)) ;
  2963.               ilargi1  = ((sintxx1 part conn nesc) dime) > 1 ;
  2964.               si ilargi1 ; quit bxx ; fins ;
  2965.             fin bxx ;
  2966.             si ilargi1 ;
  2967.               geoi2    = geoixx ;
  2968.             sino ;
  2969.               erre (chai '***** Probleme initialisation pas d''apport de matiere No elem traj:' ' ' i1) ;
  2970.             fins ;
  2971.           fins ;
  2972.         fins ;
  2973.       fins ;
  2974.       si (non (vide geoi2)) ; 
  2975. *trac (geoi2 et (aret maili1)) titr 'non vide' ;
  2976.         tgeoi2   = geoi2 part nesc conn ; 
  2977.         geoix    = vide maillage ; 
  2978.         repe bgeoi2 (dime tgeoi2) ; 
  2979.           si (pmaili1 dans tgeoi2.&bgeoi2) ; 
  2980.             geoix    = tgeoi2.&bgeoi2 ; 
  2981.             quit bgeoi2 ; 
  2982.           fins ; 
  2983.         fin bgeoi2 ; 
  2984.         geoi2    = geoix ; 
  2985. *trac geoi2 titr 'non vide 2' ;
  2986.         tmai1 . indi1 = geoi1 et geoi2 ; 
  2987. *si (i1 mult 200 ) ; trac nclk cach tmai1 . indi1 ; fins ;
  2988.         ti2      = ipol (xspi1 + xsi1) lxxsi1 ltxsi1 ; 
  2989.         ttps1 . indi1 = ti2 ; 
  2990.         indi1    = indi1 + 1 ; 
  2991.         xsi1     = xsi2 ; 
  2992.  
  2993. *       Option MESU :
  2994.         si imot4 ;
  2995.           chli1    = redu chli1 geoi2 ;
  2996.           chhi1    = redu chhi1 geoi2 ;
  2997.           lai1     = (maxi chli1) - (mini chli1) ; 
  2998.           lhi1     = (maxi chhi1) - (mini chhi1) ; 
  2999. *list lai1 ; list lhi1 ; 
  3000.           llarg1   = llarg1 et lai1 ; 
  3001.           lhaut1   = lhaut1 et lhi1 ; 
  3002.         fins ;
  3003.  
  3004.       sino ; 
  3005.         ideb1    = ideb1 + 1 ;
  3006. *mess '  ***** Geoi2 vide : ideb1 = ' ideb1 ; 
  3007.       fins ; 
  3008.     fin b2 ; 
  3009.     geoi1    = geoi1 et geoi2 ; 
  3010.  
  3011. *   Retrait du maillage deja indexe au maillage total -> reste a faire 
  3012.     mail1    = mail1 diff geoi1 ; 
  3013.     si (icourbe1 ou ifermee1) ; 
  3014.       maili2   = maili1 diff (geoi1 inte maili1) ; 
  3015.       maili1   = maili2 ;
  3016.     fins ; 
  3017. *trac nclk cach maili1 ;
  3018.   fin b1 ; 
  3019.   tab2 . evolution_maillage . temps    = ttps1 ; 
  3020.   tab2 . evolution_maillage . maillage = tmai1 ; 
  3021.  
  3022. * Option MESU : 
  3023.   si imot4 ; 
  3024.     lltps1   = prog table ttps1 ;
  3025.     evlarg1  = evol vert manu 'TEMP' lltps1 llarg1 ;
  3026.     evhaut1  = evol vert manu 'TEMP' lltps1 lhaut1 ;
  3027.     tab2 . largeur_cordons = evlarg1 ; 
  3028.     tab2 . hauteur_cordons = evhaut1 ; 
  3029.   fins ; 
  3030.  
  3031. *-------------------------- Sous-option TEMP --------------------------* 
  3032.  
  3033.   si imot2 ; 
  3034.  
  3035. *   Valeurs pas de temps de calcul :
  3036.     nbp1     = dime tab1.passes ;
  3037.     ldtca1   = prog ;
  3038.     si (nbp1 > 1) ;
  3039.       ltdpass1 = prog ;
  3040.       repe bp1 nbp1 ;
  3041.         vpi1     = tab1.passes.&bp1.vitesse ;
  3042.         dtcai1   = flot1 / vpi1 / flot2 ;
  3043.         ldtca1   = ldtca1 et dtcai1 ;
  3044.         tdpassi1 = tab1.passes.&bp1.instants extr 1 ;
  3045.         ltdpass1 = ltdpass1 et tdpassi1 ;
  3046.       fin bp1 ;
  3047.       dtca1    = ldtca1 extr 1 ;
  3048.       passp1   = 2 ;
  3049.       tdpassp1 = ltdpass1 extr passp1 ;
  3050.     sino ;
  3051.       dtca1    = flot1 / (tab1.vitesse_de_soudage) / flot2 ;
  3052.     fins ;
  3053.     nbdtca1  = dime ldtca1 ;
  3054. *list ldtca1 ;
  3055. *list ltdpass1 ;
  3056.  
  3057. *   Redecoupage de la liste des temps de l'evolution de la puissance thermique : 
  3058.     evqt1    = tab1.evolution_puissance ; 
  3059.     ltqt1    = extr evqt1 absc ; 
  3060.     lqqt1    = extr evqt1 ordo ; 
  3061.     tol2     = 1.e-6 * (maxi lqqt1) ; 
  3062.     tol3     = 0.001 * tab1.temps_de_coupure ; 
  3063.  
  3064. *   Gestion des evenements : 
  3065.     ieve1    = exis tab1 evenements ; 
  3066.     Si ieve1 ; 
  3067.       lteve1   = prog ; 
  3068.       lieve1   = lect ; 
  3069.       repe beve1 (dime tab1.evenements) ; 
  3070.         ie1      = &beve1 ; 
  3071.         lteve1   = lteve1 et tab1.evenements.ie1.temps ; 
  3072.         lieve1   = lieve1 et (lect (dime (tab1.evenements.ie1.temps)) * ie1) ; 
  3073.       fin beve1 ; 
  3074.       lpeve1   = posi ltqt1 dans lteve1 tol3 ; 
  3075. *list lteve1 ; 
  3076. *list lieve1 ; 
  3077. *list lpeve1 ; 
  3078.     sino ; 
  3079.       lpeve1   = lect (dime ltqt1) * 0 ; 
  3080.     fins ; 
  3081.  
  3082. *   Sous-decoupage de l'historique de puissance : 
  3083.     nb1      = dime ltqt1 ; 
  3084.     t0       = extr ltqt1 1 ; 
  3085.     q0       = extr lqqt1 1 ; 
  3086.  
  3087. *   Gestion evenements : 
  3088.     peve0    = extr lpeve1 1 ; 
  3089.     si (peve0 neg 0) ; 
  3090.       neve0    = extr lieve1 peve0 ; 
  3091.       si ((peve0 + 1) &lt;EG (dime lieve1)) ; 
  3092.         neve1    = extr lieve1 (peve0 + 1) ; 
  3093.       sino ; 
  3094.         neve1    = -1 ; 
  3095.       fins ; 
  3096.       idtev1   = neve0 ega neve1 ; 
  3097.       si idtev1 ; 
  3098.         tev1     = lteve1 extr (peve0 + 1) ; 
  3099.         dtev1    = tev1 - t0 ; 
  3100. *mess (chai 'Even. = ' neve0 ', dtev1 =' dtev1) ; 
  3101.       fins ; 
  3102.     sino ; 
  3103.       idtev1   = faux ; 
  3104.     fins ; 
  3105.  
  3106. *   Boucle sur les piquets de temps : 
  3107.     ltca1    = prog t0 ; 
  3108.     repe b1 (nb1 - 1) ; 
  3109.       ip1      = &b1 + 1 ; 
  3110.       t1       = extr ltqt1 ip1 ; 
  3111.       q1       = extr lqqt1 ip1 ; 
  3112.       peve1    = extr lpeve1 ip1 ; 
  3113.       dt1      = t1 - t0 ; 
  3114.       si (&b1 ega 1) ; dt0 = dt1 ; fins ; 
  3115. *     Gestion pas de temps (dtca1) en multipasses :
  3116.       si (nbdtca1 > 0) ;
  3117.         si ((t0 >EG tdpassp1) et (passp1 &lt;EG nbdtca1)) ;
  3118.           dtca1    = ldtca1 extr passp1 ;
  3119.           passp1   = passp1 + 1 ;
  3120.           si (passp1 > nbdtca1) ;
  3121.             tdpassp1 = (maxi ltqt1) + 1. ;
  3122.           sino ;
  3123.             tdpassp1 = ltdpass1 extr passp1 ;
  3124.           fins ;
  3125. *mess '***** t0, dtca1 ='  t0 ',' dtca1 ;
  3126.         fins ;
  3127.       fins ;
  3128. * Avec evements : 
  3129.       si idtev1 ; 
  3130.         si (dt1 &lt;EG dtca1) ; 
  3131.           si (dtev1 &lt;EG dtca1) ; 
  3132.             si (dt1 ega dtev1 tol3) ; 
  3133.               ltca1    = ltca1 et (prog t1) ; 
  3134.             sino ; 
  3135.               si (dt1 < dtev1) ; 
  3136.                 ltca1    = ltca1 et (prog t1) et (prog tev1) ; 
  3137.                 t1       = tev1 ; 
  3138.               sino ; 
  3139.                 ltca1    = ltca1 et (prog tev1) et (prog t1) ; 
  3140.               fins ; 
  3141.             fins ; 
  3142.           sino ; 
  3143.             ltca1    = ltca1 et (prog t1) ; 
  3144.             si ((q0 > tol2) ou (q1 > tol2)) ; 
  3145.               ltca1    = ltca1 et ((prog t1 pas dtca1 tev1) enle 1) ; 
  3146.             sino ; 
  3147.               ltca1    = ltca1 et ((prog t1 pas dt1 geom 2. tev1) enle 1) ; 
  3148.             fins ; 
  3149.             t1       = tev1 ; 
  3150.           fins ; 
  3151.         sino ; 
  3152.           si (dt1 ega dtev1 tol3) ; 
  3153.             si ((q0 > tol2) ou (q1 > tol2)) ; 
  3154.               ltca1    = ltca1 et ((prog t0 pas dtca1 t1) enle 1) ; 
  3155.             sino ; 
  3156.               ltca1    = ltca1 et ((prog t0 pas dtev1 geom 2. t1) enle 1) ; 
  3157.             fins ; 
  3158.           sino ; 
  3159.             si (dtev1 < dt1) ; 
  3160.               si (dtev1 < dtca1) ; 
  3161.                 ltca1    = ltca1 et (prog tev1) ; 
  3162.               sino ; 
  3163.                 si ((q0 > tol2) ou (q1 > tol2)) ; 
  3164. *mess '############ Ici 1' ; 
  3165.                   ltca1    = ltca1 et ((prog t0 pas dtca1 tev1) enle 1) ; 
  3166.                   ltca1    = ltca1 et ((prog tev1 pas dtca1 t1) enle 1) ; 
  3167.                 sino ; 
  3168.                   ltca1    = ltca1 et (prog tev1 pas dtev1 geom 2. t1) ; 
  3169.                 fins ; 
  3170.               fins ; 
  3171.             sino ; 
  3172.               si ((q0 > tol2) ou (q1 > tol2)) ; 
  3173. *mess '############ Ici 2' ; 
  3174.                 ltca1    = ltca1 et ((prog t0 pas dtca1 tev1) enle 1) ; 
  3175.               sino ; 
  3176.                 ltca1    = ltca1 et ((prog t0 pas dt0 geom 2. tev1) enle 1) ; 
  3177.               fins ; 
  3178.               t1       = tev1 ; 
  3179.             fins ; 
  3180.           fins ; 
  3181.         fins ; 
  3182. * Pas d'evenement : 
  3183.       sino ; 
  3184.         si (dt1 &lt;EG dtca1) ; 
  3185.           ltca1    = ltca1 et (prog t1) ; 
  3186.         sino ; 
  3187.           si ((q0 > tol2) ou (q1 > tol2)) ; 
  3188.             ltca1    = ltca1 et ((prog t0 pas dtca1 t1) enle 1) ; 
  3189.           sino ; 
  3190.             ltca1    = ltca1 et ((prog t0 pas dt0 geom 2. t1) enle 1) ; 
  3191.           fins ; 
  3192.         fins ; 
  3193.       fins ; 
  3194.       t0       = t1 ; 
  3195.       q0       = q1 ; 
  3196.       ntca1    = dime ltca1 ; 
  3197.       dt0      = (ltca1 extr ntca1) - (ltca1 extr (ntca1-1)) ; 
  3198. *     Gestion evenement suivant : 
  3199.       peve0    = peve1 ; 
  3200.       si (peve0 neg 0) ; 
  3201.         neve0    = extr lieve1 peve0 ; 
  3202.         si ((peve0 + 1) &lt;EG (dime lieve1)) ; 
  3203.           neve1    = extr lieve1 (peve0 + 1) ; 
  3204.         sino ; 
  3205.           neve1    = -1 ; 
  3206.         fins ; 
  3207.         idtev1   = neve0 ega neve1 ; 
  3208.         si idtev1 ; 
  3209.           tev1     = lteve1 extr (peve0 + 1) ; 
  3210.           dtev1    = tev1 - t0 ; 
  3211. *mess (chai 'Even. = ' neve0 ', dtev1 =' dtev1) ; 
  3212.         fins ; 
  3213.       sino ; 
  3214.         idtev1   = faux ; 
  3215.       fins ; 
  3216.     fin b1 ; 
  3217.  
  3218. *   Option TEMP MAXI : raffinement si pas > flot3
  3219.     si imot3 ;
  3220.       ltca1    = ltca1 raff flot3 ;
  3221.     fins ;
  3222.  
  3223. *   Verification si liste temps calcules bien ordonnee : 
  3224.     ltca2    = ordo ltca1 ; 
  3225.     si (((ltca2 - ltca1) maxi abs) > (1.e-3*flot2)) ; 
  3226.       erre '*****  ERREUR WAAM dans construction liste TEMPS_CALCULES' ; 
  3227.       quit waam ; 
  3228.     fins ; 
  3229.  
  3230.     tab2.temps_calcules = ltca1 ; 
  3231.  
  3232. *   Sorties si evenements : 
  3233.     si ieve1 ; 
  3234.       tab2.temps_evenements = lteve1 ; 
  3235.       tab2.index_evenements = lieve1 ; 
  3236.     fins ; 
  3237.  
  3238. * Fin sous-option TEMP : 
  3239.   fins ; 
  3240.  
  3241. * Sortie de la table resultat : 
  3242.   resp tab2 ; 
  3243.   quit soudage ; 
  3244.  
  3245. * Fin option MAIL : 
  3246. fins ; 
  3247.  
  3248. *----------------------------------------------------------------------* 
  3249. *                                  FIN                                 * 
  3250. *----------------------------------------------------------------------* 
  3251.  
  3252. * MOT1 n'est pas un des mots-cles des options de la procedure : 
  3253. si (icas1 ega 0) ; 
  3254.   erre '*****  ERREUR : MOT-cle option SOUDAGE non reconnu.' ; 
  3255.   quit soudage ; 
  3256. fins ; 
  3257.  
  3258. FINP ; 
  3259.  
  3260.  
  3261.  
  3262.  
  3263.  
  3264.  
  3265.  
  3266.  
  3267.  
  3268.  
  3269.  

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