Télécharger la plaquette Cast3M


fr en

Télécharger soudage.procedur

Retour à la liste

Numérotation des lignes : 

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

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