Télécharger la plaquette Cast3M


fr en

Télécharger soudage.procedur

Retour à la liste

Numérotation des lignes : 

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

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