Télécharger la plaquette Cast3M


fr en

Télécharger soudage.procedur

Retour à la liste

Numérotation des lignes : 

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

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