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

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