Télécharger soudage.procedur

Retour à la liste

* SOUDAGE   PROCEDUR  SP204843  24/11/05    21:15:10     12065          
DEBP SOUDAGE TAB1*'TABLE' ; 
 
*-------------- Analyse donnees table de fabrication --------------* 
* 
si (non (exis tab1 'VITESSE_DE_SOUDAGE')) ; 
  erre '*****  ERREUR : VITESSE_DE_SOUDAGE non definie.' ; 
  quit soudage ; 
fins ; 
si (non (exis tab1 'PUISSANCE_DE_SOUDAGE')) ; 
  erre '*****  ERREUR : PUISSANCE_DE_SOUDAGE non definie.' ; 
  quit soudage ; 
fins ; 
 
* Diametre, vitesse et debit de fil : 
si (exis tab1 'DIAMETRE_DE_FIL') ; 
  dfil1    = tab1.diametre_de_fil ; 
  vfil1    = tab1.vitesse_de_fil ; 
  debi1    = pi * dfil1 * dfil1 * 0.25 * vfil1 ; 
  tab1.debit_de_fil = debi1 ; 
fins ; 
si (non (exis tab1 'DEBIT_DE_FIL')) ; 
  erre '*****  ERREUR : DEBIT_DE_FIL non defini.' ; 
  quit soudage ; 
fins ; 
 
* Vitesse de deplacement : 
si (non (exis tab1 'VITESSE_DE_DEPLACEMENT')) ; 
  tab1.vitesse_de_deplacement = tab1.vitesse_de_soudage ; 
fins ; 
 
* Point de depart : 
Si (non (exis tab1 'POINT_DE_DEPART')) ; 
  P1    = 0 0 0 ; 
  tab1.point_de_depart = P1 ; 
fins ; 
 
* Temps de coupure : 
si (non (exis tab1 'TEMPS_DE_COUPURE')) ; 
  tab1.temps_de_coupure = 0.1 ; 
fins ; 
 
* mettre a VRAI pou // PVEC sur liste de vecteurs.
* FAUX car probleme // avec creation points (COMMON MCOORD).
ipara1 = faux ;
 
*-------------------------- Initialisations ---------------------------* 
 
* Test dimension 3 : 
si ((vale dime) neg 3) ; 
  erreur '*****  SOUDAGE : fonctionne uniquement en dimension 3' ; 
  quit soudage ; 
fins ; 
 
* Indicateur 1er appel a soudage : 
si (exis tab1 'TRAJECTOIRE') ; 
  idebut1  = faux ; 
sino ; 
  idebut1  = vrai ; 
fins ; 
 
* Sous-indice WTABLE : sert a stocker les valeurs courantes des parametres de soudage 
si (exis tab1 'WTABLE') ; 
  wtab1 = tab1.wtable ; 
sino ; 
  wtab1 = table ; 
  wtab1 . vsou = tab1.vitesse_de_soudage ; 
  wtab1 . puis = tab1.puissance_de_soudage ; 
  wtab1 . debi = tab1.debit_de_fil ; 
  wtab1 . vdep = tab1.vitesse_de_deplacement ; 
  tab1.wtable = wtab1 ; 
fins ; 
 
* icas1 = 1 / 2 / 3 / 4 pour POINT / PASSE / DEPLA / MAIL 
* Si 0 in fine : erreur. 
icas1    = 0 ; 
 
* Vecteur nul pour dupliquer points lus : 
Pnul1    = 0 0 0 ; 
 
*------------------------- Lecture des options ------------------------* 
 
argu MOT1*'MOT' ; 
 
*----------------------------------------------------------------------* 
*                             Option POINT                             * 
*----------------------------------------------------------------------* 
 
si (ega mot1 'POINT') ; 
  icas1    = 1 ; 
 
* Lecture des arguments de l'option : 
  argu FLOT1*'FLOTTANT' ; 
 
* Lecture Arguments PUIS, DEBI, EVEN et DIRE option POINT : 
  imot2    = faux ; imot3    = faux ; imot4    = faux ;  imot5    = faux ;
  ieve1    = faux ; 
  repe b1 4 ; 
    argu MOT2/'MOT' ; 
    si (non (exis mot2)) ; quit B1 ; fins ; 
    si (ega mot2 'PUIS') ; 
      imot2    = vrai ; 
      argu qtot1*'FLOTTANT' ; 
    fins ; 
    si (ega mot2 'DEBI') ; 
      imot3    = vrai ; 
      argu debi1*'FLOTTANT' ; 
    fins ; 
    si (ega mot2 'DIRE') ; 
      imot5    = vrai ; 
      argu pdir1*'POINT' ; 
    fins ; 
    si (ega mot2 'EVEN') ; 
      imot4    = vrai ; 
      argu even1*'MOT' ; 
      argu teve1/'FLOTTANT' ; 
      ieve1    = exis teve1 ; 
    fins ; 
  fin b1 ; 
  si (non imot2) ; 
    qtot1    = tab1.puissance_de_soudage ; 
  fins ; 
  wtab1 . puis = qtot1 ; 
  si (non imot3) ; 
    debi1    = tab1.debit_de_fil ; 
  fins ; 
  wtab1 . debi = debi1 ; 
  si (non imot5) ;
    si (exis tab1 orientation_soudure) ;
      pdir1    = tab1.orientation_soudure ;
    sino ;
      erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
    fins ;
  fins ;
  wtab1 . dire = pdir1 ;
*list qtot1 ; 
*list debi1 ; 
*list idebut1 ; 
*list pdir1 ;
* 
* idtcp1   : temps de coupure ou pas ?
* iqtot1   : on chauffe ou pas ?
  idtcp1   = faux ; 
  iqtot1   = faux ;
  si idebut1 ; 
    iqtot1   = qtot1 > 0. ;
  sino ;
    evqtot0  = tab1.evolution_puissance ; 
    lqtot0   = extr evqtot0 ordo ; 
    qtot0    = extr lqtot0 (dime lqtot0) ; 
    idtcp1   = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ; 
 
    qmax1    = maxi (prog qtot0 qtot1) ;
    iqtot1   = qtot1 > (1.e-4 * qmax1) ;
 
    evdebi0  = tab1.evolution_debit ; 
    ldebi0   = extr evdebi0 ordo ; 
    debi0    = extr ldebi0 (dime ldebi0) ; 
    idtcp1   = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
  fins ; 
*  idtcp1   = idtcp1 ou ieve1 ; 
  si idtcp1 ; 
*    si ieve1 ; 
*      dtcp1    = teve1 ; 
*    sino ; 
      dtcp1    = tab1.temps_de_coupure ; 
*    fins ; 
    flot1    = flot1 + dtcp1 ; 
  fins ; 
 
* Evolution puissance option POINT : 
  si idebut1 ; 
    ltps1    = prog    0. flot1 ; 
    lqtot1   = prog qtot1 qtot1 ; 
    lti1     = ltps1 ; 
  sino ; 
    evqtot0  = tab1.evolution_puissance ; 
    ltps0    = extr evqtot0 absc ; 
    lqtot0   = extr evqtot0 ordo ; 
    tps0     = extr  ltps0 (dime  ltps0) ; 
    qtot0    = extr lqtot0 (dime lqtot0) ; 
*   Si la puissance indiquee est differente de celle existante : 
    si ((abs(qtot0-qtot1)) > (abs(1.e-4*qtot1))) ; 
*     Ajout temps de coupure au temps de realisation du POINT : 
      ltps1    = prog (tps0 + dtcp1) (tps0 + flot1) ; 
      lqtot1   = prog          qtot1          qtot1 ; 
    sino ; 
      ltps1    = prog (tps0 + flot1) ; 
      lqtot1   = prog          qtot1 ; 
    fins ; 
    lti1     = prog tps0 (tps0 + flot1) ; 
    ltps1    =  ltps0 et  ltps1 ; 
    lqtot1   = lqtot0 et lqtot1 ; 
  fins ; 
  evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
 
* Evolution debit POINT : 
  si idebut1 ; 
    ltps1    = prog    0. flot1 ; 
    ldebi1   = prog debi1 debi1 ; 
  sino ; 
    evdebi0  = tab1.evolution_debit ; 
    ltps0    = extr evdebi0 absc ; 
    ldebi0   = extr evdebi0 ordo ; 
    tps0     = extr  ltps0 (dime  ltps0) ; 
    debi0    = extr ldebi0 (dime ldebi0) ; 
*   Si la puissance indiquee est differente de celle existante : 
    si ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
*     Ajout temps de coupure au temps de realisation du POINT : 
      ltps1    = prog (tps0 + dtcp1) (tps0 + flot1) ; 
      ldebi1   = prog          debi1          debi1 ; 
      lqi1     = prog 1. 1. ; 
    sino ; 
      ltps1    = prog (tps0 + flot1) ; 
      ldebi1   = prog          debi1 ; 
      lqi1     = prog 1. ; 
    fins ; 
    ltps1    =  ltps0 et  ltps1 ; 
    ldebi1   = ldebi0 et ldebi1 ; 
  fins ; 
  evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
 
* Evolution deplacement POINT : 
  si idebut1 ; 
    ltps1    = prog 0. flot1 ; 
    ldep1    = prog 0.    0. ; 
    tps0     = 0. ; 
  sino ; 
    evdep0   = tab1.evolution_deplacement ; 
    ltps0    = extr evdep0 absc ; 
    ldep0    = extr evdep0 ordo ; 
    tps0     = extr ltps0 (dime  ltps0) ; 
    dep0     = extr ldep0 (dime ldep0) ; 
    ltps1    = prog (tps0 + flot1) ; 
    ldep1    = prog           dep0 ; 
    ltps1    = ltps0 et ltps1 ; 
    ldep1    = ldep0 et ldep1 ; 
  fins ; 
  evdep1   = evol vert manu temp ltps1 ldep1 ; 
 
* Evenement : 
  si imot4 ; 
    ttev1    = table ;
    ttev1 . nom   =  even1 ; 
    si ieve1 ; 
      ttev1 . temps = prog tps0 (tps0 + teve1) ; 
    sino ; 
      ttev1 . temps = prog tps0 ; 
    fins ; 
*list ttev1.temps ;
    si (exis tab1 'EVENEMENTS') ; 
      nbev1    = (dime tab1.evenements) + 1 ; 
    sino ; 
      tab1.evenements = table ; 
      nbev1    = 1 ; 
    fins ; 
    tab1.evenements.nbev1 = ttev1 ; 
  fins ; 
 
* Evolution direction POINT (que si on soude) :
  si iqtot1 ;
 
*   Direction transverse (DIRL) :
    ndir1    = norm pdir1 ;
    zprec1   = vale prec ;
    si ((abs ndir1) < zprec1) ;
      erre 239 ;
    fins ;
    xdir1 ydir1 zdir1 = pdir1 coor ;
    si ((abs xdir1) > (abs ydir1)) ;
      si ((abs zdir1) > (abs ydir1)) ;
        pdirl1   = zdir1 0. (-1. * xdir1) ;
      sino ;
        pdirl1   = (-1. * ydir1) xdir1 0. ;
      fins ;
    sino ;
      si ((abs xdir1) > (abs zdir1)) ;
        pdirl1   = (-1. * ydir1) xdir1 0. ;
      sino ;
        pdirl1   = 0. (-1. * zdir1) ydir1 ;
      fins ;
    fins ;
    pdirl1   = pdirl1 / (norm pdirl1) ;
 
    si idebut1 ;
      ltps1    = prog    0. flot1 ;
      ldir1    = enum pdir1 pdir1 ;
      ldirl1   = enum pdirl1 pdirl1 ;
    sino ;
      si (exis tab1 evolution_orientation) ;
        cgdir0   = tab1.evolution_orientation ;
        ltps0    = extr cgdir0 lree dire ;
        ldir0    = extr cgdir0 lobj dire ;
        ldirl0   = extr cgdir0 lobj dirl ;
        tps0dir  = extr ltps0 (dime  ltps0) ;
        pdir0    = extr ldir0 (dime  ltps0) ;
        si (tps0dir ega tps0) ;
          xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
          si (xcolli1 neg 1.) ;
            erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
          fins ;
          ltps1    = prog  (tps0 + flot1) ;
          ldir1    = enum           pdir1 ;
          ldirl1   = enum          pdirl1 ;
        sino ;
          ltps1    = prog   tps0 (tps0 + flot1) ;
          ldir1    = enum  pdir1          pdir1 ;
          ldirl1   = enum pdirl1         pdirl1 ;
        fins ;
        ltps1    = ltps0 et ltps1 ;
        ldir1    = ldir0 et ldir1 ;
        ldirl1   = ldirl0 et ldirl1 ;
      sino ;
        ltps1    = prog   tps0 (tps0 + flot1) ;
        ldir1    = enum  pdir1          pdir1 ;
        ldirl1   = enum pdirl1         pdir11 ;
      fins ;
    fins ;
    cgdir1   = char dire ltps1 ldir1 ;
*   Direction transverse (DIRL) :
    cgdir2   = char dirl ltps1 ldirl1 ;
    cgdir1   = cgdir1 et cgdir2 ;
  fins ;
 
* Enregistrement donnees POINT 
  si (exis tab1 points) ; 
    npt1     = dime tab1.points ; 
  sino ; 
    npt1     = 0 ; 
    tab1.points = table ; 
  fins ; 
  npt1     = npt1 + 1 ; 
  tab1.points.npt1 = table ; 
  tab1.points.npt1.point     = P1 ; 
  tab1.points.npt1.instants  = lti1 ; 
  tab1.points.npt1.puissance = qtot1 ; 
  tab1.points.npt1.debit     = debi1 ; 
 
* Enregistrements en fin de traitement option pour eviter
* modifier table avant fin realisation option
  si idebut1 ; 
    P1     = tab1.point_de_depart plus Pnul1 ; 
    tab1.trajectoire = manu poi1 P1 ; 
  fins ; 
  tab1.evolution_puissance = evqtot1 ; 
  tab1.evolution_debit = evdebi1 ; 
  tab1.evolution_deplacement = evdep1 ; 
  si iqtot1 ;
    tab1.evolution_orientation = cgdir1 ;
  fins ;
 
  quit soudage ; 
* Fin option POINT : 
fins ; 
 
*----------------------------------------------------------------------* 
*                             Option PASSE                             * 
*----------------------------------------------------------------------* 
si (ega mot1 'PASSE') ; 
  icas1    = 2 ; 
 
* Lecture des arguments de l'option : 
  argu MOT2*'MOT' ; 
 
* Triatement particulier option CERC ordre arguments : 
  si (ega mot2 'CERC') ; 
    argu N1/ENTIER ; 
  fins ; 
 
* Lecture arguments RELA/ABSO, VITE, PUIS, DEBI 
  imot3    = faux ; imot4    = faux ; imot5    = faux ; imot6    = faux ; imot7    = faux ; imot8    = faux ;
  iradext1 = faux ;
  iradint1 = faux ;
  irela1   = vrai ; 
  ieve1    = faux ; 
  repe b1 8 ; 
    argu mot3/'MOT' ; 
    si (non (exis mot3)) ; quit b1; fins ; 
    si (ega mot3 'ABSO') ; 
      imot3    = vrai ; 
      irela1   = faux ; 
    fins ; 
    si (ega mot3 'VITE') ; 
      imot4    = vrai ; 
      argu vdep1*'FLOTTANT' ; 
    fins ; 
    si (ega mot3 'PUIS') ; 
      imot5    = vrai ; 
      argu qtot1*'FLOTTANT' ; 
    fins ; 
    si (ega mot3 'DEBI') ; 
      imot6    = vrai ; 
      argu debi1*'FLOTTANT' ; 
    fins ; 
    si (ega mot3 'EVEN') ; 
      imot7    = vrai ; 
      argu even1*'MOT' ; 
      argu teve1/'FLOTTANT' ; 
      ieve1    = exis teve1 ; 
    fins ; 
    si (ega mot3 'DIRE') ; 
      imot8    = vrai ; 
    fins ; 
    si (ega mot3 'RADEXT') ;
      iradext1 = vrai ;
    fins ;
    si (ega mot3 'RADINT') ;
      iradint1 = vrai ;
    fins ;
  fin b1 ; 
 
* Vitesse & Increment de temps PASSE : 
  si (non imot4) ; 
    vdep1    = tab1.vitesse_de_soudage ; 
  fins ; 
  wtab1 . vsou = vdep1 ; 
 
* Puissance PASSE : 
  si (non imot5) ; 
    qtot1    = tab1.puissance_de_soudage ; 
  fins ; 
  wtab1 . puis = qtot1 ; 
 
* Debit PASSE : 
  si (non imot6) ; 
    debi1    = tab1.debit_de_fil ; 
  fins ; 
  wtab1 . debi = debi1 ; 
*list vdep1 ; 
*list qtot1 ; 
*list debi1 ; 
 
* idtcp1   : temps de coupure ou pas ?
* iqtot1   : on chauffe ou pas ?
  idtcp1   = faux ; 
  iqtot1   = faux ;
  si idebut1 ; 
    iqtot1   = qtot1 > 0. ;
  sino ;
    evqtot0  = tab1.evolution_puissance ; 
    lqtot0   = extr evqtot0 ordo ; 
    qtot0    = extr lqtot0 (dime lqtot0) ; 
    idtcp1   = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ; 
 
    qmax1    = maxi (prog qtot0 qtot1) ;
    iqtot1   = qtot1 > (1.e-4 * qmax1) ;
 
    evdebi0  = tab1.evolution_debit ; 
    ldebi0   = extr evdebi0 ordo ; 
    debi0    = extr ldebi0 (dime ldebi0) ; 
    idtcp1   = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
  fins ; 
*  idtcp1   = idtcp1 ou ieve1 ; 
*list idtcp1 ; 
  si idtcp1 ; 
*    si ieve1 ; 
*      dtcp1    = teve1 ; 
*    sino ; 
      dtcp1    = tab1.temps_de_coupure ; 
*    fins ; 
  fins ; 
 
* icas2 = indicateur sous-option realisee : 
  icas2    = 0 ; 
 
*----------------------------- PASSE DROI -----------------------------* 
* Sous-option DROI : 
  si (ega mot2 'DROI') ; 
    icas2    = 1 ; 
 
*   Lecture du point : 
    argu P1*'POINT' ; 
    P1       = P1 plus Pnul1 ; 
 
*   Lecture orientation de soudure :
    ipdir1   = faux ;
    si imot8 ;
      argu pdir1/'POINT' ;
      ipdir1   = exis pdir1 ;
      si (non ipdir1) ;
        argu pdir1*'LISTOBJE' ;
        si (neg (extr pdir1 type) 'POINT') ;
          erre '***** SOUDAGE : le LISTOBJE ne contient pas des objets POINT' ;
        fins ;
        si (vide pdir1) ;
          erre '***** SOUDAGE : le LISTOBJ est vide' ;
        fins ;
      fins ;
    fins ;
    si (non imot8) ;
      si (exis tab1 orientation_soudure) ;
        pdir1    = tab1.orientation_soudure ;
        ipdir1   = vrai ;
      sino ;
        erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
      fins ;
    fins ;
    wtab1 . dire = pdir1 ;
*list pdir1 ;
 
*   Trajectoire PASSE DROI : 
    si idebut1 ; 
      P0       = tab1.point_de_depart plus Pnul1 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
      fins ; 
      mail1    = P0 droi 1 P1 ; 
      mail1    = mail1 coul roug ; 
      ll1      = mesu mail1 ; 
      maili1   = mail1 ; 
    sino ; 
      mail0    = tab1.trajectoire ; 
      nbpts0   = nbno mail0 ; 
      P0       = mail0 poin nbpts0 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
      fins ; 
      mail1    = P0 droi 1 P1 ; 
      mail1    = mail1 coul roug ; 
      ll1      = mesu mail1 ; 
      maili1   = mail1 ; 
      si (nbpts0 > 1) ; 
        mail1    = mail0 et mail1 ; 
      fins ; 
    fins ; 
 
*   Increment de temps : 
    dt1    = ll1 / vdep1 ; 
    si idtcp1 ; 
      dt1    = dt1 + dtcp1 ; 
    fins ; 
 
*   Evolution puissance PASSE DROI : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      lqtot1   = prog qtot1 qtot1 ; 
      lti1     = ltps1 ; 
    sino ; 
      ltps0    = extr evqtot0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        lqtot1   = prog          qtot1        qtot1 ; 
      sino ; 
        lti1     = prog tps0 (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dt1) ; 
        lqtot1   = prog        qtot1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      lqtot1   = lqtot0 et lqtot1 ; 
    fins ; 
    evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
 
*   Evolution debit PASSE DROI : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      ldebi1   = prog debi1 debi1 ; 
    sino ; 
      ltps0    = extr evdebi0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldebi1   = prog          debi1        debi1 ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldebi1   = prog        debi1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      ldebi1   = ldebi0 et ldebi1 ; 
    fins ; 
    evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
 
*   Evolution deplacement PASSE DROI : 
    si idebut1 ; 
      ltps1    = prog 0. dt1 ; 
      ldep1    = prog 0. ll1 ; 
    tps0     = 0. ; 
    sino ; 
      evdep0   = tab1.evolution_deplacement ; 
      ltps0    = extr evdep0 absc ; 
      ldep0    = extr evdep0 ordo ; 
      tps0     = extr ltps0 (dime ltps0) ; 
      dep0     = extr ldep0 (dime ldep0) ; 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldep1    = prog           dep0 (dep0 + ll1) ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldep1    = prog (dep0 + ll1) ; 
      fins ; 
      ltps1    = ltps0 et ltps1 ; 
      ldep1    = ldep0 et ldep1 ; 
    fins ; 
    ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
    evdep1   = evol vert manu temp ltps1 ldep1 ; 
 
*   Evenement : 
    si imot7 ; 
      ttev1    = table ;
      ttev1 . nom   =  even1 ; 
      si ieve1 ; 
        ttev1 . temps = prog tps0 (tps0 + teve1) ; 
      sino ; 
        ttev1 . temps = prog tps0 ; 
      fins ; 
      si (exis tab1 'EVENEMENTS') ; 
        nbev1    = (dime tab1.evenements) + 1 ; 
      sino ; 
        tab1.evenements = table ; 
        nbev1    = 1 ; 
      fins ; 
      tab1.evenements.nbev1 = ttev1 ; 
    fins ; 
 
*   Evolution direction PASSE DROIT (si on soude) :
    si iqtot1 ;
      si idebut1 ;
        si ipdir1 ;
          ltps1    = prog    0.   dt1 ;
          ldir1    = enum pdir1 pdir1 ;
*         Direction transverse (DIRL) :
          pdirl1   = (P1 moin P0) pvec pdir1 ;
          pdirl1   = pdirl1 / (norm pdirl1) ;
          ldirl1   = enum pdirl1 pdirl1 ;
        sino ;
*         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
          nbdir1   = dime pdir1 ;
          si (nbdir1 ega 1) ;
            pdir1    = pdir1 et (pdir1 extr 1) ;
            nbdir1   = 2 ;
          fins ;
          ltps1    = prog 0. ;
          tpsi1    = 0. ;
          nbdir1   = nbdir1 - 1 ;
          dti1     = dt1 / (flot nbdir1) ;
          repe bdir1 nbdir1 ;
            tpsi1    = tpsi1 + dti1 ;
            si (&bdir1 ega nbdir1) ; tpsi1 = dt1 ; fins ;
            ltps1    = ltps1 et tpsi1 ;
          fin bdir1 ;
          ldir1    = pdir1 ;
*         Direction transverse (DIRL) :
          si ipara1 ;
            ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
            opti para vrai ; mess 'ici 1' ;
            ldirl2   = pvec ldirl1 ldir1 ;
            opti para faux ;
          sino ;
            ldirl2   = enum ;
            pdirn1   = P1 moin P0 ;
            repe bx (dime ldir1) ;
              pnx = ldir1 extr &bx ;
              plx = pvec pdirn1 pnx ;
              ldirl2 = ldirl2 et plx ;
            fin bx ;
          fins ;
          ldirl1   = ldirl2 ;
        fins ;
        ltpsl1   = ltps1  ;
      sino ;
        si (exis tab1 evolution_orientation) ;
          cgdir0   = tab1.evolution_orientation ;
          ltps0    = extr cgdir0 lree dire ;
          ldir0    = extr cgdir0 lobj dire ;
          ltpsl0   = extr cgdir0 lree dirl ;
          ldirl0   = extr cgdir0 lobj dirl ;
          tps0dir  = extr ltps0 (dime  ltps0) ;
          pdir0    = extr ldir0 (dime  ltps0) ;
          si (tps0dir ega tps0) ;
            si ipdir1 ;
              xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
              si (xcolli1 neg 1.) ;
                erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
              fins ;
              ltps1    = prog  (tps0 + dt1) ;
              ldir1    = enum         pdir1 ;
*             Direction transverse (DIRL) :
              pdirl1   = (P1 moin P0) pvec pdir1 ;
              pdirl1   = pdirl1 / (norm pdirl1) ;
              ldirl1   = enum pdirl1 ;
              pdirl0   = extr ldirl0 (dime ldirl0) ;
              pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
*si ((norm pdirl10) < 1.e-10) ; mess '**** passe droi cas 1' ; list pdirl10 ; fins ;
              si ((norm pdirl10) > 1.e-3) ;
                ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
              fins ;
            sino ;
              pdiri1   = pdir1 extr 1 ;
              xcolli1  = (psca pdir0 pdiri1) / (norm pdir0) / (norm pdiri1) ;
              si (xcolli1 neg 1.) ;
                erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
              fins ;
              nbdir1   = dime pdir1 ;
              si (nbdir1 ega 1) ;
                pdir1    = pdir1 et (pdir1 extr 1) ;
                nbdir1   = 2 ;
              fins ;
              ltps1    = prog ;
              tpsi1    = tps0 ;
              nbdir1   = nbdir1 - 1 ;
              dti1     = dt1 / (flot nbdir1) ;
              repe bdir1 nbdir1 ;
                tpsi1    = tpsi1 + dti1 ;
                si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
                ltps1    = ltps1 et tpsi1 ;
              fin bdir1 ;
              ldir1    = pdir1 enle 1 ;
*             Direction transverse (DIRL) :
              si ipara1 ;
                ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
                opti para vrai ; mess 'ici 2' ;
                ldirl2   = pvec ldirl1 ldir1 ;
                opti para faux ;
              sino ;
                ldirl2   = enum ;
                pdirn1   = P1 moin P0 ;
                repe bx (dime ldir1) ;
                  pnx = ldir1 extr &bx ;
                  plx = pvec pdirn1 pnx ;
                  ldirl2 = ldirl2 et plx ;
                fin bx ;
              fins ;
              ldirl1   = ldirl2 ;
              pdirl1   = extr ldirl1 1 ;
              pdirl0   = extr ldirl0 (dime ldirl0) ;
              pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
*si ((norm pdirl10) < 1.e-10) ; mess '**** passe droi cas 2' ; list pdirl10 ; fins ;
              si ((norm pdirl10) > 1.e-3) ;
                ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
              fins ;
            fins ;
          sino ;
            si ipdir1 ;
              ltps1    = prog  tps0 (tps0 + dt1) ;
              ldir1    = enum pdir1        pdir1 ;
*             Direction transverse (DIRL) :
              pdirl1   = (P1 moin P0) pvec pdir1 ;
              pdirl1   = pdirl1 / (norm pdirl1) ;
              ldirl1   = enum pdirl1 pdirl1 ;
            sino ;
              nbdir1   = dime pdir1 ;
              si (nbdir1 ega 1) ;
                pdir1    = pdir1 et (pdir1 extr 1) ;
                nbdir1   = 2 ;
              fins ;
              ltps1    = prog tps0 ;
              tpsi1    = tps0 ;
              nbdir1   = nbdir1 - 1 ;
              dti1     = dt1 / (flot nbdir1) ;
              repe bdir1 nbdir1 ;
                tpsi1    = tpsi1 + dti1 ;
                si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
                ltps1    = ltps1 et tpsi1 ;
              fin bdir1 ;
              ldir1    = pdir1 ;
*             Direction transverse (DIRL) :
              si ipara1 ;
                ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
                opti para vrai ; mess 'ici 3' ;
                ldirl2   = pvec ldirl1 ldir1 ;
                opti para faux ;
              sino ;
                ldirl2   = enum ;
                pdirn1   = P1 moin P0 ;
                repe bx (dime ldir1) ;
                  pnx = ldir1 extr &bx ;
                  plx = pvec pdirn1 pnx ;
                  ldirl2 = ldirl2 et plx ;
                fin bx ;
              fins ;
              ldirl1   = ldirl2 ;
            fins ;
          fins ;
          ltpsl1   = ltpsl0 et ltps1  ;
          ltps1    = ltps0 et ltps1 ;
          ldir1    = ldir0 et ldir1 ;
          ldirl1   = ldirl0 et ldirl1 ;
        sino ;
          si ipdir1 ;
            ltps1    = prog flot0   dt1 ;
            ldir1    = enum pdir1 pdir1 ;
*           Direction transverse (DIRL) :
            pdirl1   = (P1 moin P0) pvec pdir1 ;
            pdirl1   = pdirl1 / (norm pdirl1) ;
            ldirl1   = enum pdirl1 pdirl1 ;
          sino ;
*         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
            nbdir1   = dime pdir1 ;
            si (nbdir1 ega 1) ;
              pdir1    = pdir1 et (pdir1 extr 1) ;
              nbdir1   = 2 ;
            fins ;
            ltps1    = prog flot0 ;
            tpsi1    = flot0 ;
            nbdir1   = nbdir1 - 1 ;
            dti1     = dt1 / (flot nbdir1) ;
            repe bdir1 nbdir1 ;
              tpsi1    = tpsi1 + dti1 ;
              si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
              ltps1    = ltps1 et tpsi1 ;
            fin bdir1 ;
            ldir1    = pdir1 ;
*           Direction transverse (DIRL) :
            si ipara1 ;
              ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
              ldirl1   = enum (dime ldir1) * (P1 moin P0) ;
              opti para vrai ; mess 'ici 4' ;
              ldirl2   = pvec ldirl1 ldir1 ;
              opti para faux ;
            sino ;
              ldirl2   = enum ;
              pdirn1   = P1 moin P0 ;
              repe bx (dime ldir1) ;
                pnx = ldir1 extr &bx ;
                plx = pvec pdirn1 pnx ;
                ldirl2 = ldirl2 et plx ;
              fin bx ;
            fins ;
            ldirl1   = ldirl2 ;
          fins ;
          ltpsl1   = ltps1  ;
        fins ;
      fins ;
      cgdir1   = char dire ltps1 ldir1 ;
*     Direction transverse (DIRL) :
      cgdir2   = char dirl ltpsl1 ldirl1 ;
      cgdir1   = cgdir1 et cgdir2 ;
    fins ;
 
*   Enregistrement donnees PASSE DROI 
    si (exis tab1 passes) ; 
      nps1     = dime tab1.passes ; 
    sino ; 
      nps1     = 0 ; 
      tab1.passes = table ; 
    fins ; 
    nps1     = nps1 + 1 ; 
    tab1.passes.nps1 = table ; 
 
    tab1.passes.nps1.maillage  = maili1 ; 
    tab1.passes.nps1.geometrie = mot 'DROI' ; 
    tab1.passes.nps1.instants  = lti1 ; 
    tab1.passes.nps1.vitesse   = vdep1 ; 
    tab1.passes.nps1.puissance = qtot1 ; 
    tab1.passes.nps1.debit     = debi1 ; 
 
    si (exis tab1 'LARGEUR_DE_PASSE') ; 
      tab1.passes.nps1.largeur = tab1.largeur_de_passe ; 
    fins ; 
 
*   Enregistrements en fin de traitement option pour eviter
*   modifier table avant fin realisation option
    tab1.trajectoire = mail1 ; 
    tab1.evolution_puissance = evqtot1 ; 
    tab1.evolution_debit = evdebi1 ; 
    tab1.evolution_deplacement = evdep1 ; 
    si iqtot1 ;
      tab1.evolution_orientation = cgdir1 ;
    fins ;
 
    quit soudage ; 
*   Fin option PASSE DROI : 
  fins ; 
 
*----------------------------- PASSE CERC -----------------------------* 
* Sous-option CERC : 
  si (ega mot2 'CERC') ; 
    icas2    = 2 ; 
 
*   P1 est le centre du cercle, P2, l'extremite de la trajectoire 
    argu P2*'POINT' P1*'POINT' ; 
    P1       = P1 plus Pnul1 ; 
    P2       = P2 plus Pnul1 ; 
 
*   Lecture orientation de soudure :
    ipdir1   = faux ;
    iradx1   = iradext1 ou iradint1 ;
    si imot8 ;
      argu pdir1/'POINT' ;
      ipdir1   = exis pdir1 ;
    fins ;
    si ((non imot8) et (non iradx1)) ;
      si (exis tab1 orientation_soudure) ;
        pdir1    = tab1.orientation_soudure ;
        ipdir1   = vrai ;
      sino ;
        erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
      fins ;
    fins ;
    wtab1 . dire = pdir1 ;
*list pdir1 ;
*list iradext1 ;
*list iradint1 ;
 
*   Trajectoire PASSE CERC : 
    si idebut1 ; 
      P0       = tab1.point_de_depart plus Pnul1 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
        P2       = P0 plus P2 ; 
      fins ; 
      si (non (exis N1)) ; 
        V1       = P0 moin P1 ; 
        V2       = P2 moin P1 ; 
        V1       = V1 / (norm V1) ; 
        V2       = V2 / (norm V2) ; 
        N1       = (acos (psca V1 V2)) / 5. ; 
        N1       = maxi (lect (enti N1) 1) ; 
      fins ; 
      mail1    = CERC N1 P0 P1 P2 ; 
      mail1    = mail1 coul roug ; 
      maili1   = mail1 ; 
      ll1      = mesu mail1 ; 
    sino ; 
      mail0    = tab1.trajectoire ; 
      nbpts0   = nbno mail0 ; 
      P0       = mail0 poin nbpts0 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
        P2       = P0 plus P2 ; 
      fins ; 
      si (non (exis N1)) ; 
        V1       = P0 moin P1 ; 
        V2       = P2 moin P1 ; 
        V1       = V1 / (norm V1) ; 
        V2       = V2 / (norm V2) ; 
        N1       = (acos (psca V1 V2)) / 5. ; 
        N1       = maxi (lect (enti N1) 1) ; 
      fins ; 
      mail1    = CERC N1 P0 P1 P2 ; 
      mail1    = mail1 coul roug ; 
      maili1   = mail1 ; 
      ll1      = mesu mail1 ; 
      si (nbpts0 > 1) ; 
        mail1    = mail0 et mail1 ; 
      fins ; 
    fins ; 
 
*   Normale unitaire au plan du cercle pour DIRL :
    P1P0     = P1 moin P0 ;
    P1P2     = P1 moin P2 ;
    Pnc1     = pvec P1P0 P1P2 ;
    Pnc1     = Pnc1 / (norm Pnc1) ;
 
*   Increment de temps : 
    dt1    = ll1 / vdep1 ; 
    si idtcp1 ; 
      dt1    = dt1 + dtcp1 ; 
    fins ; 
 
*   Evolution puissance PASSE CERC : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      lqtot1   = prog qtot1 qtot1 ; 
      lti1     = ltps1 ; 
    sino ; 
      ltps0    = extr evqtot0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        lqtot1   = prog          qtot1        qtot1 ; 
      sino ; 
        lti1     = prog tps0 (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dt1) ; 
        lqtot1   = prog        qtot1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      lqtot1   = lqtot0 et lqtot1 ; 
    fins ; 
    evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
 
*   Evolution debit PASSE CERC : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      ldebi1   = prog debi1 debi1 ; 
    sino ; 
      ltps0    = extr evdebi0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldebi1   = prog          debi1        debi1 ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldebi1   = prog        debi1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      ldebi1   = ldebi0 et ldebi1 ; 
    fins ; 
    evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
 
*   Evolution deplacement PASSE CERC : 
    si idebut1 ; 
      ltps1    = prog 0. dt1 ; 
      ldep1    = prog 0. ll1 ; 
      tps0     = 0. ; 
    sino ; 
      evdep0   = tab1.evolution_deplacement ; 
      ltps0    = extr evdep0 absc ; 
      ldep0    = extr evdep0 ordo ; 
      tps0     = extr ltps0 (dime ltps0) ; 
      dep0     = extr ldep0 (dime ldep0) ; 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldep1    = prog           dep0 (dep0 + ll1) ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldep1    = prog (dep0 + ll1) ; 
      fins ; 
      ltps1    = ltps0 et ltps1 ; 
      ldep1    = ldep0 et ldep1 ; 
    fins ; 
    ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
    evdep1   = evol vert manu temp ltps1 ldep1 ; 
 
*   Evenement : 
    si imot7 ; 
      ttev1    = table ;
      ttev1 . nom   =  even1 ; 
      si ieve1 ; 
        ttev1 . temps = prog tps0 (tps0 + teve1) ; 
      sino ; 
        ttev1 . temps = prog tps0 ; 
      fins ; 
      si (exis tab1 'EVENEMENTS') ; 
        nbev1    = (dime tab1.evenements) + 1 ; 
      sino ; 
        tab1.evenements = table ; 
        nbev1    = 1 ; 
      fins ; 
      tab1.evenements.nbev1 = ttev1 ; 
    fins ; 
 
*   Evolution direction PASSE CERC (si on soude) :
    si iqtot1 ;
*     Traitement direction radiale ext./int. , combo Pdir1 :
*     & direction transverse (DIRL) :
      ldir1    = enum ;
      ldirn1   = enum ;
      nbnoc1   = nbno maili1 ;
      dti1     = dt1 / (flot (nbnoc1 - 1)) ;
      repe bmail1 nbnoc1 ;
        pi1      = maili1 poin &bmail1 ;
        vi1      = (pi1 moin p1) ;
        vi1      = vi1 / (norm vi1) ;
        vli1     = pvec pnc1 vi1 ;
        si iradint1 ;
          vi1      = -1. * vi1 ;
        fins ;
        si ipdir1 ;
          vi1      = vi1 plus pdir1 ;
        fins ;
*list vi1 ;
        ldir1    = ldir1 et vi1 ;
        ldirn1   = ldirn1 et vli1 ;
      fin bmail1 ;
      si iradx1 ;
*list (ldir1 extr 1) ;
*list (ldir1 extr 2) ;
*list (ldir1 extr 4) ;
        pdir1    = ldir1 ;
        ipdir1   = faux ;
      fins ;
*     Construction liste directions :
      si idebut1 ;
        ltpsl1   = prog 0. pas dti1 dt1 ;
        si ipdir1 ;
          ltps1    = prog    0.   dt1 ;
          ldir1    = enum pdir1 pdir1 ;
*         Direction transverse (DIRL) :
          si ipara1 ;
            ldirl1   = enum (dime ltpsl1) * pdir1 ;
            opti para vrai ; mess 'ici 5' ;
            ldirl2   = pvec ldirn1 ldirl1 ;
            opti para faux ;
          sino ;
            ldirl2   = enum ;
            repe bx (dime ltpsl1) ;
              pnx = ldirn1 extr &bx ;
              plx = pvec pnx pdir1 ;
              ldirl2 = ldirl2 et plx ;
            fin bx ;
          fins ;
          ldirl1   = ldirl2 ;
        sino ;
*         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
          nbdir1   = dime pdir1 ;
          si (nbdir1 ega 1) ;
            pdir1    = pdir1 et (pdir1 extr 1) ;
            nbdir1   = 2 ;
          fins ;
          ltps1    = prog 0. ;
          tpsi1    = 0. ;
          nbdir1   = nbdir1 - 1 ;
          dti1     = dt1 / (flot nbdir1) ;
          repe bdir1 nbdir1 ;
            tpsi1    = tpsi1 + dti1 ;
            si (&bdir1 ega nbdir1) ; tpsi1 = dt1 ; fins ;
            ltps1    = ltps1 et tpsi1 ;
          fin bdir1 ;
          ldir1    = pdir1 ;
*         Direction transverse (DIRL) :
          cgxx1    = char dirx ltps1 ldir1 ;
          ldirl1   = enum ;
          repe bxx1 (dime ltpsl1) ;
            tpsli1   = extr ltpsl1 &bxx1 ;
            pdirx1   = tire cgxx1 dirx tpsli1 ;
            pdirn1   = ldirn1 extr &bxx1 ;
            pdirli1  = pvec pdirn1 pdirx1 ;
            ldirl1   = ldirl1 et pdirli1 ;
          fin bxx1 ;
        fins ;
      sino ;
        ltpsl1   = prog tps0 pas dti1 (tps0 + dt1) ;
        si (exis tab1 evolution_orientation) ;
          cgdir0   = tab1.evolution_orientation ;
          ltps0    = extr cgdir0 lree dire ;
          ldir0    = extr cgdir0 lobj dire ;
          ltpsl0   = extr cgdir0 lree dirl ;
          ldirl0   = extr cgdir0 lobj dirl ;
          tps0dir  = extr ltps0 (dime  ltps0) ;
          pdir0    = extr ldir0 (dime  ltps0) ;
          si (tps0dir ega tps0) ;
            ltpsl1   = ltpsl1 enle 1 ;
            si ipdir1 ;
              xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
              si (xcolli1 neg 1.) ;
                erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
              fins ;
              ltps1    = prog  (tps0 + dt1) ;
              ldir1    = enum         pdir1 ;
*             Direction transverse (DIRL) :
              si ipara1 ;
                ldirl1   = enum (dime ltpsl1) * pdir1 ;
                opti para vrai ; mess 'ici 6' ;
                ldirl2   = pvec ldirn1 ldirl1 ;
                opti para faux ;
              sino ;
                ldirl2   = enum ;
                repe bx (dime ltpsl1) ;
                  pnx = ldirn1 extr &bx ;
                  plx = pvec pnx pdir1 ;
                  ldirl2 = ldirl2 et plx ;
                fin bx ;
              fins ;
              ldirl1   = ldirl2 ;
              pdirl1   = extr ldirl1 1 ;
              pdirl0   = extr ldirl0 (dime ldirl0) ;
              pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
*si ((norm pdirl10) < 1.e-10) ; mess '**** passe cerc cas 7' ; list pdirl10 ; fins ;
              si ((norm pdirl10) > 1.e-3) ;
                ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
              fins ;
            sino ;
              pdiri1   = pdir1 extr 1 ;
              xcolli1  = (psca pdir0 pdiri1) / (norm pdir0) / (norm pdiri1) ;
              si (xcolli1 neg 1.) ;
                erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
              fins ;
 
              nbdir1   = dime pdir1 ;
              si (nbdir1 ega 1) ;
                pdir1    = pdir1 et (pdir1 extr 1) ;
                nbdir1   = 2 ;
              fins ;
              ltps1    = prog ;
              tpsi1    = tps0 ;
              nbdir1   = nbdir1 - 1 ;
              dti1     = dt1 / (flot nbdir1) ;
              repe bdir1 nbdir1 ;
                tpsi1    = tpsi1 + dti1 ;
                si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
                ltps1    = ltps1 et tpsi1 ;
              fin bdir1 ;
              ldir1    = pdir1 enle 1 ;
*             Direction transverse (DIRL) :
              si (nbdir1 ega 1) ;
                ldirl1   = enum ;
                repe bxx1 (dime ltpsl1) ;
                  tpsli1   = extr ltpsl1 &bxx1 ;
                  pdirn1   = ldirn1 extr &bxx1 ;
                  pdirli1  = pvec pdirn1 (extr ldir1 1) ;
                  ldirl1   = ldirl1 et pdirli1 ;
                fin bxx1 ;
              sino ;
                cgxx1    = char dirx ltps1 ldir1 ;
                ldirl1   = enum ;
                repe bxx1 (dime ltpsl1) ;
                  tpsli1   = extr ltpsl1 &bxx1 ;
                  pdirx1   = tire cgxx1 dirx tpsli1 ;
                  pdirn1   = ldirn1 extr &bxx1 ;
                  pdirli1  = pvec pdirn1 pdirx1 ;
                  ldirl1   = ldirl1 et pdirli1 ;
                fin bxx1 ;
              fins ;
              pdirl1   = extr ldirl1 1 ;
              pdirl0   = extr ldirl0 (dime ldirl0) ;
              pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
*si ((norm pdirl10) < 1.e-10) ; mess '**** passe cerc cas 2' ; list pdirl10 ; fins ;
              si ((norm pdirl10) > 1.e-3) ;
                ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
              fins ;
            fins ;
          sino ;
            si ipdir1 ;
              ltps1    = prog  tps0 (tps0 + dt1) ;
              ldir1    = enum pdir1        pdir1 ;
*             Direction transverse (DIRL) :
              si ipara1 ;
                ldirl1   = enum (dime ltpsl1) * pdir1 ;
                opti para vrai ; mess 'ici 7' ;
                ldirl2   = pvec ldirn1 ldirl1 ;
                opti para faux ;
              sino ;
                ldirl2   = enum ;
                repe bx (dime ltpsl1) ;
                  pnx = ldirn1 extr &bx ;
                  plx = pvec pnx pdir1 ;
                  ldirl2 = ldirl2 et plx ;
                fin bx ;
              fins ;
              ldirl1   = ldirl2 ;
            sino ;
              nbdir1   = dime pdir1 ;
              si (nbdir1 ega 1) ;
                pdir1    = pdir1 et (pdir1 extr 1) ;
                nbdir1   = 2 ;
              fins ;
              ltps1    = prog tps0 ;
              tpsi1    = tps0 ;
              nbdir1   = nbdir1 - 1 ;
              dti1     = dt1 / (flot nbdir1) ;
              repe bdir1 nbdir1 ;
                tpsi1    = tpsi1 + dti1 ;
                si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
                ltps1    = ltps1 et tpsi1 ;
              fin bdir1 ;
              ldir1    = pdir1 ;
*             Direction transverse (DIRL) :
              cgxx1    = char dirx ltps1 ldir1 ;
              ldirl1   = enum ;
              repe bxx1 (dime ltpsl1) ;
                tpsli1   = extr ltpsl1 &bxx1 ;
                pdirx1   = tire cgxx1 dirx tpsli1 ;
                pdirn1   = ldirn1 extr &bxx1 ;
                pdirli1  = pvec pdirn1 pdirx1 ;
                ldirl1   = ldirl1 et pdirli1 ;
              fin bxx1 ;
            fins ;
          fins ;
          ltps1    = ltps0 et ltps1 ;
          ldir1    = ldir0 et ldir1 ;
          ltpsl1   = ltpsl0 et ltpsl1 ;
          ldirl1   = ldirl0 et ldirl1 ;
*list tps0 ;
*list ltpsl1 ;
        sino ;
          si ipdir1 ;
            ltps1    = prog flot0   dt1 ;
            ldir1    = enum pdir1 pdir1 ;
*           Direction transverse (DIRL) :
            si ipara1 ;
              ldirl1   = enum (dime ltpsl1) * pdir1 ;
              opti para vrai ; mess 'ici 8' ;
              ldirl2   = pvec ldirn1 ldirl1 ;
              opti para faux ;
            sino ;
              ldirl2   = enum ;
              repe bx (dime ltpsl1) ;
                pnx = ldirn1 extr &bx ;
                plx = pvec pnx pdir1 ;
                ldirl2 = ldirl2 et plx ;
              fin bx ;
            fins ;
            ldirl1   = ldirl2 ;
          sino ;
*         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
            nbdir1   = dime pdir1 ;
            si (nbdir1 ega 1) ;
              pdir1    = pdir1 et (pdir1 extr 1) ;
              nbdir1   = 2 ;
            fins ;
            ltps1    = prog flot0 ;
            tpsi1    = flot0 ;
            nbdir1   = nbdir1 - 1 ;
            dti1     = dt1 / (flot nbdir1) ;
            repe bdir1 nbdir1 ;
              tpsi1    = tpsi1 + dti1 ;
              si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
              ltps1    = ltps1 et tpsi1 ;
            fin bdir1 ;
            ldir1    = pdir1 ;
*           Direction transverse (DIRL) :
            cgxx1    = char dirx ltps1 ldir1 ;
            ldirl1   = enum ;
            repe bxx1 (dime ltpsl1) ;
              tpsli1   = extr ltpsl1 &bxx1 ;
              pdirx1   = tire cgxx1 dirx tpsli1 ;
              pdirn1   = ldirn1 extr &bxx1 ;
              pdirli1  = pvec pdirn1 pdirx1 ;
              ldirl1   = ldirl1 et pdirli1 ;
            fin bxx1 ;
          fins ;
        fins ;
      fins ;
      cgdir1   = char dire ltps1 ldir1 ;
*     Direction transverse (DIRL) :
      cgdir2   = char dirl ltpsl1 ldirl1 ;
      cgdir1   = cgdir1 et cgdir2 ;
    fins ;
 
*   Enregistrement donnees PASSE CERC 
    si (exis tab1 passes) ; 
      nps1     = dime tab1.passes ; 
    sino ; 
      nps1     = 0 ; 
      tab1.passes = table ; 
    fins ; 
    nps1     = nps1 + 1 ; 
    tab1.passes.nps1 = table ; 
 
    tab1.passes.nps1.maillage  = maili1 ; 
    tab1.passes.nps1.geometrie = mot 'CERC' ; 
    tab1.passes.nps1.centre    = P1 ; 
    tab1.passes.nps1.instants  = lti1 ; 
    tab1.passes.nps1.vitesse   = vdep1 ; 
    tab1.passes.nps1.puissance = qtot1 ; 
    tab1.passes.nps1.debit     = debi1 ; 
 
    si (exis tab1 'LARGEUR_DE_PASSE') ; 
      tab1.passes.nps1.largeur = tab1.largeur_de_passe ; 
    fins ; 
 
*   Enregistrements en fin de traitement option pour eviter
*   modifier table avant fin realisation option
    tab1.trajectoire = mail1 ; 
    tab1.evolution_puissance = evqtot1 ; 
    tab1.evolution_debit = evdebi1 ; 
    tab1.evolution_deplacement = evdep1 ; 
    si iqtot1 ;
      tab1.evolution_orientation = cgdir1 ;
    fins ;
 
    quit soudage ; 
*   Fin option PASSE CERC : 
  fins ; 
 
*----------------------------- PASSE MAIL -----------------------------* 
* Sous-option MAIL : 
  si (ega mot2 'MAIL') ; 
    icas2    = 3 ; 
 
    argu mail1*'MAILLAGE' ; 
    eltyp1   = mail1 elem type ; 
    imax1    = 0 ; 
    si (exis eltyp1 'SEG2') ; imax1 = imax1 + 1 ; fins ; 
    si (exis eltyp1 'SEG3') ; imax1 = imax1 + 1 ; fins ; 
    si ((dime eltyp1) > imax1) ; 
      erre '*****  ERREUR : le maillage doit etre compose de SEG2 ou de SEG3.' ; 
    fins ; 
    ll1      = mesu mail1 ; 
    maili1   = mail1 ; 
 
*   Lecture orientation de soudure :
    ipdir1   = faux ;
    si imot8 ;
      argu pdir1/'POINT' ;
      ipdir1   = exis pdir1 ;
      si (non ipdir1) ;
        argu pdir1*'LISTOBJE' ;
        si (neg (extr pdir1 type) 'POINT') ;
          erre '***** SOUDAGE : le LISTOBJE ne contient pas des objets POINT' ;
        fins ;
        si (vide pdir1) ;
          erre '***** SOUDAGE : le LISTOBJ est vide' ;
        fins ;
      fins ;
    fins ;
    si (non imot8) ;
      si (exis tab1 orientation_soudure) ;
        pdir1    = tab1.orientation_soudure ;
        ipdir1   = vrai ;
      sino ;
        erre '***** SOUDAGE : il manque la donnee de l''orientation de la soudure' ;
      fins ;
    fins ;
    wtab1 . dire = pdir1 ;
*list pdir1 ;
 
*   Trajectoire PASSE MAIL : 
    si idebut1 ; 
      P1       = mail1 poin 1 ; 
      tab1.point_de_depart = P1 ; 
      mail1    = mail1 coul roug ; 
    sino ; 
      mail0    = tab1.trajectoire ; 
      nbpts0   = nbno mail0 ; 
      P0       = mail0 poin nbpts0 ; 
      P1       = mail1 poin 1 ; 
      si (P1 neg P0) ; 
        tol1     = 1.e-10 * (mesu mail1) ; 
        si ((norm (P1 moin P0)) > tol1) ; 
          erre '*****  ERREUR : MAILLAGE incompatible.' ; 
          quit soudage ; 
        sino ; 
          elim (P0 et P1) tol1 ; 
        fins ; 
      fins ; 
      si (nbpts0 > 1) ; 
        mail1    = mail1 coul roug ; 
        mail1    = mail0 et mail1 ; 
      fins ; 
    fins ; 
 
*   Increment de temps : 
    dt1    = ll1 / vdep1 ; 
    si idtcp1 ; 
      dt1    = dt1 + dtcp1 ; 
    fins ; 
 
*   Evolution puissance PASSE MAIL : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      lqtot1   = prog qtot1 qtot1 ; 
      lti1     = ltps1 ; 
    sino ; 
      ltps0    = extr evqtot0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        lqtot1   = prog          qtot1        qtot1 ; 
      sino ; 
        lti1     = prog tps0 (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dt1) ; 
        lqtot1   = prog        qtot1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      lqtot1   = lqtot0 et lqtot1 ; 
    fins ; 
    evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
 
*   Evolution debit PASSE MAIL : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      ldebi1   = prog debi1 debi1 ; 
    sino ; 
      ltps0    = extr evdebi0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldebi1   = prog          debi1        debi1 ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldebi1   = prog        debi1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      ldebi1   = ldebi0 et ldebi1 ; 
    fins ; 
    evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
 
*   Evolution deplacement PASSE MAIL : 
    si idebut1 ; 
      ltps1    = prog 0. dt1 ; 
      ldep1    = prog 0. ll1 ; 
      tps0     = 0. ; 
    sino ; 
      evdep0   = tab1.evolution_deplacement ; 
      ltps0    = extr evdep0 absc ; 
      ldep0    = extr evdep0 ordo ; 
      tps0     = extr ltps0 (dime ltps0) ; 
      dep0     = extr ldep0 (dime ldep0) ; 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldep1    = prog           dep0 (dep0 + ll1) ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldep1    = prog (dep0 + ll1) ; 
      fins ; 
      ltps1    = ltps0 et ltps1 ; 
      ldep1    = ldep0 et ldep1 ; 
    fins ; 
    ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
    evdep1   = evol vert manu temp ltps1 ldep1 ; 
 
*   Evenement : 
    si imot7 ; 
      ttev1    = table ;
      ttev1 . nom   =  even1 ; 
      si ieve1 ; 
        ttev1 . temps = prog tps0 (tps0 + teve1) ; 
      sino ; 
        ttev1 . temps = prog tps0 ; 
      fins ; 
      si (exis tab1 'EVENEMENTS') ; 
        nbev1    = (dime tab1.evenements) + 1 ; 
      sino ; 
        tab1.evenements = table ; 
        nbev1    = 1 ; 
      fins ; 
      tab1.evenements.nbev1 = ttev1 ; 
    fins ; 
 
*   Evolution direction PASSE MAIL (si on soude) :
    si iqtot1 ;
*     Traitement direction direction transverse (DIRL) :
      ldirn1   = enum ;
      nbelm1   = nbel maili1 ;
      si (nbelm1 ega 1) ;
        dti1     = dt1 ;
      sino ;
        dti1     = dt1 / (flot (nbelm1 - 1)) ;
      fins ;
      repe bmail1 nbelm1 ;
        eli1     = maili1 elem &bmail1 ;
        pi1      = eli1 poin 1 ;
        pi2      = eli1 poin 2 ;
        vni1     = (pi2 moin pi1) ;
        vni1     = vni1 / (norm vni1) ;
*list vni1 ;
        ldirn1   = ldirn1 et vni1 ;
      fin bmail1 ;
      si (nbelm1 ega 1) ;
        ldirn1   = ldirn1 et vni1 ;
      fins ;
      si idebut1 ;
        ltpsl1   = prog 0. pas dti1 dt1 ;
        si ipdir1 ;
          ltps1    = prog    0.   dt1 ;
          ldir1    = enum pdir1 pdir1 ;
*         Direction transverse (DIRL) :
          si ipara1 ;
            ldirl1   = enum (dime ltpsl1) * pdir1 ;
            opti para vrai ; mess 'ici 9' ;
            ldirl2   = pvec ldirn1 ldirl1 ;
            opti para faux ;
          sino ;
            ldirl2   = enum ;
            repe bx (dime ltpsl1) ;
              pnx = ldirn1 extr &bx ;
              plx = pvec pnx pdir1 ;
              ldirl2 = ldirl2 et plx ;
            fin bx ;
          fins ;
          ldirl1   = ldirl2 ;
        sino ;
*         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
          nbdir1   = dime pdir1 ;
          si (nbdir1 ega 1) ;
            pdir1    = pdir1 et (pdir1 extr 1) ;
            nbdir1   = 2 ;
          fins ;
          ltps1    = prog 0. ;
          tpsi1    = 0. ;
          nbdir1   = nbdir1 - 1 ;
          dti1     = dt1 / (flot nbdir1) ;
          repe bdir1 nbdir1 ;
            tpsi1    = tpsi1 + dti1 ;
            si (&bdir1 ega nbdir1) ; tpsi1 = dt1 ; fins ;
            ltps1    = ltps1 et tpsi1 ;
          fin bdir1 ;
          ldir1    = pdir1 ;
*         Direction transverse (DIRL) :
          cgxx1    = char dirx ltps1 ldir1 ;
          ldirl1   = enum ;
          repe bxx1 (dime ltpsl1) ;
            tpsli1   = extr ltpsl1 &bxx1 ;
            pdirx1   = tire cgxx1 dirx tpsli1 ;
            pdirn1   = ldirn1 extr &bxx1 ;
            pdirli1  = pvec pdirn1 pdirx1 ;
            ldirl1   = ldirl1 et pdirli1 ;
          fin bxx1 ;
        fins ;
      sino ;
        ltpsl1   = prog tps0 pas dti1 (tps0 + dt1) ;
        si (exis tab1 evolution_orientation) ;
          cgdir0   = tab1.evolution_orientation ;
          ltps0    = extr cgdir0 lree dire ;
          ldir0    = extr cgdir0 lobj dire ;
          ltpsl0   = extr cgdir0 lree dirl ;
          ldirl0   = extr cgdir0 lobj dirl ;
          tps0dir  = extr ltps0 (dime  ltps0) ;
          pdir0    = extr ldir0 (dime  ltps0) ;
          si (tps0dir ega tps0) ;
            ltpsl1   = ltpsl1 enle 1 ;
 
            si ipdir1 ;
              xcolli1  = (psca pdir0 pdir1) / (norm pdir0) / (norm pdir1) ;
              si (xcolli1 neg 1.) ;
                erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
              fins ;
              ltps1    = prog  (tps0 + dt1) ;
              ldir1    = enum         pdir1 ;
*             Direction transverse (DIRL) :
              si ipara1 ;
                ldirl1   = enum (dime ltpsl1) * pdir1 ;
                opti para vrai ; mess 'ici 10' ;
                ldirl2   = pvec ldirn1 ldirl1 ;
                opti para faux ;
              sino ;
                ldirl2   = enum ;
                repe bx (dime ltpsl1) ;
                  pnx = ldirn1 extr &bx ;
                  plx = pvec pnx pdir1 ;
                  ldirl2 = ldirl2 et plx ;
                fin bx ;
              fins ;
              ldirl1   = ldirl2 ;
              pdirl1   = extr ldirl1 1 ;
              pdirl0   = extr ldirl0 (dime ldirl0) ;
              pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
*si ((norm pdirl10) < 1.e-10) ; mess '**** passe mail cas 1' ; list pdirl10 ; fins ;
              si ((norm pdirl10) > 1.e-3) ;
                ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
              fins ;
            sino ;
              pdiri1   = pdir1 extr 1 ;
              xcolli1  = (psca pdir0 pdiri1) / (norm pdir0) / (norm pdiri1) ;
              si (xcolli1 neg 1.) ;
                erre '*****  SOUDAGE : orientation de soudure incompatible avec precedente' ;
              fins ;
 
              nbdir1   = dime pdir1 ;
              si (nbdir1 ega 1) ;
                pdir1    = pdir1 et (pdir1 extr 1) ;
                nbdir1   = 2 ;
              fins ;
              ltps1    = prog ;
              tpsi1    = tps0 ;
              nbdir1   = nbdir1 - 1 ;
              dti1     = dt1 / (flot nbdir1) ;
              repe bdir1 nbdir1 ;
                tpsi1    = tpsi1 + dti1 ;
                si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
                ltps1    = ltps1 et tpsi1 ;
              fin bdir1 ;
              ldir1    = pdir1 enle 1 ;
*             Direction transverse (DIRL) :
              si (nbdir1 ega 1) ;
                ldirl1   = enum ;
                repe bxx1 (dime ltpsl1) ;
                  tpsli1   = extr ltpsl1 &bxx1 ;
                  pdirn1   = ldirn1 extr &bxx1 ;
                  pdirli1  = pvec pdirn1 (extr ldir1 1) ;
                  ldirl1   = ldirl1 et pdirli1 ;
                fin bxx1 ;
              sino ;
                cgxx1    = char dirx ltps1 ldir1 ;
                ldirl1   = enum ;
                repe bxx1 (dime ltpsl1) ;
                  tpsli1   = extr ltpsl1 &bxx1 ;
                  pdirx1   = tire cgxx1 dirx tpsli1 ;
                  pdirn1   = ldirn1 extr &bxx1 ;
                  pdirli1  = pvec pdirn1 pdirx1 ;
                  ldirl1   = ldirl1 et pdirli1 ;
                fin bxx1 ;
              fins ;
              pdirl1   = extr ldirl1 1 ;
              pdirl0   = extr ldirl0 (dime ldirl0) ;
              pdirl10  = 0.5 * (pdirl0 plus pdirl1) ;
*si ((norm pdirl10) < 1.e-10) ; mess '**** passe cerc cas 2' ; list pdirl10 ; fins ;
              si ((norm pdirl10) > 1.e-3) ;
                ldirl0   = (ldirl0 enle (dime ldirl0)) et pdirl10 ;
              fins ;
            fins ;
          sino ;
            si ipdir1 ;
              ltps1    = prog  tps0 (tps0 + dt1) ;
              ldir1    = enum pdir1        pdir1 ;
 
*             Direction transverse (DIRL) :
              si ipara1 ;
                ldirl1   = enum (dime ltpsl1) * pdir1 ;
                opti para vrai ; mess 'ici 11' ;
                ldirl2   = pvec ldirn1 ldirl1 ;
                opti para faux ;
              sino ;
                ldirl2   = enum ;
                repe bx (dime ltpsl1) ;
                  pnx = ldirn1 extr &bx ;
                  plx = pvec pnx pdir1 ;
                  ldirl2 = ldirl2 et plx ;
                fin bx ;
              fins ;
              ldirl1   = ldirl2 ;
            sino ;
              nbdir1   = dime pdir1 ;
              si (nbdir1 ega 1) ;
                pdir1    = pdir1 et (pdir1 extr 1) ;
                nbdir1   = 2 ;
              fins ;
              ltps1    = prog tps0 ;
              tpsi1    = tps0 ;
              nbdir1   = nbdir1 - 1 ;
              dti1     = dt1 / (flot nbdir1) ;
              repe bdir1 nbdir1 ;
                tpsi1    = tpsi1 + dti1 ;
                si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
                ltps1    = ltps1 et tpsi1 ;
              fin bdir1 ;
              ldir1    = pdir1 ;
*             Direction transverse (DIRL) :
              cgxx1    = char dirx ltps1 ldir1 ;
              ldirl1   = enum ;
              repe bxx1 (dime ltpsl1) ;
                tpsli1   = extr ltpsl1 &bxx1 ;
                pdirx1   = tire cgxx1 dirx tpsli1 ;
                pdirn1   = extr ldirn1 &bxx1 ;
                pdirli1  = pvec pdirn1 pdirx1 ;
                ldirl1   = ldirl1 et pdirli1 ;
              fin bxx1 ;
            fins ;
          fins ;
          ltps1    = ltps0 et ltps1 ;
          ldir1    = ldir0 et ldir1 ;
          ltpsl1   = ltpsl0 et ltpsl1 ;
          ldirl1   = ldirl0 et ldirl1 ;
*list tps0 ;
*list ltpsl1 ;
        sino ;
          si ipdir1 ;
            ltps1    = prog flot0   dt1 ;
            ldir1    = enum pdir1 pdir1 ;
*           Direction transverse (DIRL) :
            si ipara1 ;
              ldirl1   = enum (dime ltpsl1) * pdir1 ;
              opti para vrai ; mess 'ici 12' ;
              ldirl2   = pvec ldirn1 ldirl1 ;
              opti para faux ;
            sino ;
              ldirl2   = enum ;
              repe bx (dime ltpsl1) ;
                pnx = ldirn1 extr &bx ;
                plx = pvec pnx pdir1 ;
                ldirl2 = ldirl2 et plx ;
              fin bx ;
            fins ;
            ldirl1   = ldirl2 ;
          sino ;
*         Si ipdir1 FAUX, alors pdir1 LISTOBJE :
            nbdir1   = dime pdir1 ;
            si (nbdir1 ega 1) ;
              pdir1    = pdir1 et (pdir1 extr 1) ;
              nbdir1   = 2 ;
            fins ;
            ltps1    = prog flot0 ;
            tpsi1    = flot0 ;
            nbdir1   = nbdir1 - 1 ;
            dti1     = dt1 / (flot nbdir1) ;
            repe bdir1 nbdir1 ;
              tpsi1    = tpsi1 + dti1 ;
              si (&bdir1 ega nbdir1) ; tpsi1 = tps0 + dt1 ; fins ;
              ltps1    = ltps1 et tpsi1 ;
            fin bdir1 ;
            ldir1    = pdir1 ;
*           Direction transverse (DIRL) :
            cgxx1    = char dirx ltps1 ldir1 ;
            ldirl1   = enum ;
            repe bxx1 (dime ltpsl1) ;
              tpsli1   = extr ltpsl1 &bxx1 ;
              pdirx1   = tire cgxx1 dirx tpsli1 ;
              pdirn1   = ldirn1 extr &bxx1 ;
              pdirli1  = pvec pdirn1 pdirx1 ;
              ldirl1   = ldirl1 et pdirli1 ;
            fin bxx1 ;
          fins ;
        fins ;
      fins ;
      cgdir1   = char dire ltps1 ldir1 ;
*     Direction transverse (DIRL) :
      cgdir2   = char dirl ltpsl1 ldirl1 ;
      cgdir1   = cgdir1 et cgdir2 ;
    fins ;
 
*   Enregistrement donnees PASSE MAIL 
    si (exis tab1 passes) ; 
      nps1     = dime tab1.passes ; 
    sino ; 
      nps1     = 0 ; 
      tab1.passes = table ; 
    fins ; 
    nps1     = nps1 + 1 ; 
 
    tab1.passes.nps1 = table ; 
    tab1.passes.nps1.maillage  = maili1 ; 
    tab1.passes.nps1.geometrie = mot 'MAIL' ; 
    tab1.passes.nps1.instants  = lti1 ; 
    tab1.passes.nps1.vitesse   = vdep1 ; 
    tab1.passes.nps1.puissance = qtot1 ; 
    tab1.passes.nps1.debit     = debi1 ; 
 
    si (exis tab1 'LARGEUR_DE_PASSE') ; 
      tab1.passes.nps1.largeur = tab1.largeur_de_passe ; 
    fins ; 
 
*   Enregistrements en fin de traitement option pour eviter
*   modifier table avant fin realisation option
    tab1.trajectoire = mail1 ; 
    tab1.evolution_puissance = evqtot1 ; 
    tab1.evolution_debit = evdebi1 ; 
    tab1.evolution_deplacement = evdep1 ; 
    si iqtot1 ;
      tab1.evolution_orientation = cgdir1 ;
    fins ;
 
    quit soudage ; 
*   Fin option PASSE MAIL : 
  fins ; 
 
* Si mot2 ne correspond a aucune option connue, icas2 = 0 : erreur 
  si (icas2 ega 0) ; 
    erre '*****  ERREUR : MOT option non reconnu.' ; 
    quit soudage ; 
  fins ; 
 
* Fin option PASSE : 
fins ; 
 
*----------------------------------------------------------------------* 
*                             Option DEPLA                             * 
*----------------------------------------------------------------------* 
 
si (ega mot1 'DEPLA') ; 
  icas1    = 3 ; 
* 
* Lecture des arguments de l'option : 
  argu MOT2*'MOT' ; 
 
* Ajout ou pas du temps de coupure option PASSE : 
  idtcp1   = faux ; 
  qtot1    = 0. ; 
  debi1    = 0. ; 
  si ((non idebut1)) ; 
    evqtot0  = tab1.evolution_puissance ; 
    lqtot0   = extr evqtot0 ordo ; 
    evdebi0  = tab1.evolution_debit ; 
    ldebi0   = extr evdebi0 ordo ; 
    qtot0    = extr lqtot0 (dime lqtot0) ; 
    idtcp1   = (abs(qtot0-qtot1)) > (abs(1.e-4*qtot1)) ; 
    debi0    = extr ldebi0 (dime ldebi0) ; 
    idtcp1   = idtcp1 ou ((abs(debi0-debi1)) > (abs(1.e-4*debi1))) ; 
  fins ; 
*list idtcp1 ; 
  si idtcp1 ; 
    dtcp1    = tab1.temps_de_coupure ; 
  fins ; 
 
* icas2 = indicateur sous-option realisee : 
  icas2    = 0 ; 
 
*----------------------------- DEPLA DROI -----------------------------* 
  si (ega mot2 'DROI') ; 
    icas2    = 1 ; 
 
    argu P1*'POINT' ; 
    P1       = P1 plus Pnul1 ; 
 
* Deplacement relatif / absolu : 
    imot3    = faux ; imot4    = faux ; imot5    = faux ; 
    irela1   = vrai ; 
    ieve1    = faux ; 
    repe b1 3 ; 
      argu mot3/'MOT' ; 
      si (non (exis mot3)) ; quit b1 ; fins ; 
      si (ega mot3 'ABSO') ; 
        imot3    = vrai ; 
        irela1   = faux ; 
      fins ; 
      si (ega mot3 'VITE') ; 
        imot4    = vrai ; 
        argu vdep1*'FLOTTANT' ; 
      fins ; 
      si (ega mot3 'EVEN') ; 
        imot5    = vrai ; 
        argu even1*'MOT' ; 
        argu teve1/'FLOTTANT' ; 
        ieve1    = exis teve1 ; 
      fins ; 
    fin b1 ; 
 
*   Coupure et temps de coupure selon existence EVEN : 
*    idtcp1   = idtcp1 ou ieve1 ; 
*    si ieve1 ; 
*      dtcp1    = teve1 ; 
*    fins ; 
 
*   Trajectoire DEPLA DROI : 
*list idebut1 ; 
    si idebut1 ; 
      P0       = tab1.point_de_depart plus Pnul1 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
      fins ; 
      mail1    = P0 droi 1 P1 ; 
      mail1    = mail1 coul vert ; 
      ll1      = mesu mail1 ; 
    sino ; 
      mail0    = tab1.trajectoire ; 
      nbpts0   = nbno mail0 ; 
      P0       = mail0 poin nbpts0 ; 
*list P0 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
      fins ; 
      mail1    = P0 droi 1 P1 ; 
      mail1    = mail1 coul vert ; 
      ll1      = mesu mail1 ; 
      si (nbpts0 > 1) ; 
        mail1    = mail0 et mail1 ; 
      fins ; 
    fins ; 
 
*   Increment de temps DEPLA DROI : 
    si (non imot4) ; 
      vdep1    = tab1.vitesse_de_deplacement ; 
    fins ; 
    wtab1 . vdep = vdep1 ; 
    dt1    = ll1 / vdep1 ; 
    si idtcp1 ; 
      dt1    = dt1 + dtcp1 ; 
    fins ; 
 
*   Evolution puissance DEPLA DROI : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      lqtot1   = prog qtot1 qtot1 ; 
      lqi1     = prog 1. 1. ; 
    sino ; 
      ltps0    = extr evqtot0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        lqtot1   = prog          qtot1        qtot1 ; 
      sino ; 
        lti1     = prog tps0 (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dt1) ; 
        lqtot1   = prog        qtot1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      lqtot1   = lqtot0 et lqtot1 ; 
    fins ; 
    evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
 
*   Evolution debit DEPLA DROI : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      ldebi1   = prog debi1 debi1 ; 
    sino ; 
      ltps0    = extr evdebi0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldebi1   = prog          debi1        debi1 ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldebi1   = prog        debi1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      ldebi1   = ldebi0 et ldebi1 ; 
    fins ; 
    evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
 
*   Evolution deplacement DEPLA DROI : 
    si idebut1 ; 
      ltps1    = prog 0. dt1 ; 
      ldep1    = prog 0. ll1 ; 
      tps0     = 0. ; 
    sino ; 
      evdep0   = tab1.evolution_deplacement ; 
      ltps0    = extr evdep0 absc ; 
      ldep0    = extr evdep0 ordo ; 
      tps0     = extr ltps0 (dime ltps0) ; 
      dep0     = extr ldep0 (dime ldep0) ; 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldep1    = prog           dep0 (dep0 + ll1) ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldep1    = prog (dep0 + ll1) ; 
      fins ; 
      ltps1    = ltps0 et ltps1 ; 
      ldep1    = ldep0 et ldep1 ; 
    fins ; 
    ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
    evdep1   = evol vert manu temp ltps1 ldep1 ; 
 
*   Evenement : 
    si imot5 ; 
      ttev1    = table ;
      ttev1 . nom   =  even1 ; 
      si ieve1 ; 
        ttev1 . temps = prog tps0 (tps0 + teve1) ; 
      sino ; 
        ttev1 . temps = prog tps0 ; 
      fins ; 
      si (exis tab1 'EVENEMENTS') ; 
        nbev1    = (dime tab1.evenements) + 1 ; 
      sino ; 
        tab1.evenements = table ; 
        nbev1    = 1 ; 
      fins ; 
      tab1.evenements.nbev1 = ttev1 ; 
    fins ; 
 
*   Enregistrements en fin de traitement option pour eviter
*   modifier table avant fin realisation option
    tab1.trajectoire = mail1 ; 
    tab1.evolution_puissance = evqtot1 ; 
    tab1.evolution_debit = evdebi1 ; 
    tab1.evolution_deplacement = evdep1 ; 
 
    quit soudage ; 
*   Fin option DEPLA DROI : 
  fins ; 
 
*----------------------------- DEPLA CERC -----------------------------* 
  si (ega mot2 'CERC') ; 
    icas2    = 2 ; 
 
*   P1 est le centre du cercle, P2, l'extremite de la trajectoire 
    argu P2*'POINT' P1*'POINT' N1/'ENTIER'; 
    P1       = P1 plus Pnul1 ; 
    P2       = P2 plus Pnul1 ; 
 
*   Deplacement relatif / absolu : 
    imot3    = faux ; imot4    = faux ; imot5    = faux ; 
    irela1   = vrai ; 
    ieve1    = faux ; 
    repe b1 3 ; 
      argu mot3/'MOT' ; 
      si (non (exis mot3)) ; quit b1 ; fins ; 
      si (ega mot3 'ABSO') ; 
        imot3    = vrai ; 
        irela1   = faux ; 
      fins ; 
      si (ega mot3 'VITE') ; 
        imot4    = vrai ; 
        argu vdep1*'FLOTTANT' ; 
      fins ; 
      si (ega mot3 'EVEN') ; 
        imot5    = vrai ; 
        argu even1*'MOT' ; 
        argu teve1/'FLOTTANT' ; 
        ieve1    = exis teve1 ; 
      fins ; 
    fin b1 ; 
 
*   Coupure et temps de coupure selon existence EVEN : 
*    idtcp1   = idtcp1 ou ieve1 ; 
*    si ieve1 ; 
*      dtcp1    = teve1 ; 
*    fins ; 
 
*   Trajectoire DEPLA CERC : 
    si idebut1 ; 
      P0       = tab1.point_de_depart plus Pnul1 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
        P2       = P0 plus P2 ; 
      fins ; 
*     Par defaut, N1 calcule pour avoir angle de 5 deg. 
      si (non (exis N1)) ; 
        V1       = P0 moin P1 ; 
        V2       = P2 moin P1 ; 
        V1       = V1 / (norm V1) ; 
        V2       = V2 / (norm V2) ; 
        N1       = (acos (psca V1 V2)) / 5. ; 
        N1       = maxi (lect (enti N1) 1) ; 
      fins ; 
      mail1    = CERC N1 P0 P1 P2 ; 
      mail1    = mail1 coul vert ; 
      ll1      = mesu mail1 ; 
    sino ; 
      mail0    = tab1.trajectoire ; 
      nbpts0   = nbno mail0 ; 
      P0       = mail0 poin nbpts0 ; 
*     Deplacements relatifs : 
      si irela1 ; 
        P1       = P0 plus P1 ; 
        P2       = P0 plus P2 ; 
      fins ; 
      si (non (exis N1)) ; 
        V1       = P0 moin P1 ; 
        V2       = P2 moin P1 ; 
        V1       = V1 / (norm V1) ; 
        V2       = V2 / (norm V2) ; 
        N1       = (acos (psca V1 V2)) / 5. ; 
        N1       = maxi (lect (enti N1) 1) ; 
      fins ; 
      mail1    = CERC N1 P0 P1 P2 ; 
      mail1    = mail1 coul vert ; 
      ll1      = mesu mail1 ; 
      si (nbpts0 > 1) ; 
        mail1    = mail0 et mail1 ; 
      fins ; 
    fins ; 
 
*   Increment de temps DEPLA CERC : 
    si (non imot4) ; 
      vdep1    = tab1.vitesse_de_deplacement ; 
    fins ; 
    wtab1 . vdep = vdep1 ; 
    dt1    = ll1 / vdep1 ; 
    si idtcp1 ; 
      dt1    = dt1 + dtcp1 ; 
    fins ; 
 
*   Evolution puissance DEPLA CERC : 
    icoup1   = faux ; 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      lqtot1   = prog qtot1 qtot1 ; 
      lqi1     = prog 1. 1. ; 
    sino ; 
      ltps0    = extr evqtot0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        lqtot1   = prog          qtot1        qtot1 ; 
      sino ; 
        lti1     = prog tps0 (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dt1) ; 
        lqtot1   = prog        qtot1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      lqtot1   = lqtot0 et lqtot1 ; 
    fins ; 
    evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
 
*   Evolution debit DEPLA CERC : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      ldebi1   = prog debi1 debi1 ; 
    sino ; 
      ltps0    = extr evdebi0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldebi1   = prog          debi1        debi1 ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldebi1   = prog        debi1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      ldebi1   = ldebi0 et ldebi1 ; 
    fins ; 
    evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
 
*   Evolution deplacement DEPLA CERC : 
    si idebut1 ; 
      ltps1    = prog 0. dt1 ; 
      ldep1    = prog 0. ll1 ; 
      tps0     = 0. ; 
    sino ; 
      evdep0   = tab1.evolution_deplacement ; 
      ltps0    = extr evdep0 absc ; 
      ldep0    = extr evdep0 ordo ; 
      tps0     = extr ltps0 (dime ltps0) ; 
      dep0     = extr ldep0 (dime ldep0) ; 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldep1    = prog           dep0 (dep0 + ll1) ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldep1    = prog (dep0 + ll1) ; 
      fins ; 
      ltps1    = ltps0 et ltps1 ; 
      ldep1    = ldep0 et ldep1 ; 
    fins ; 
    ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
    evdep1   = evol vert manu temp ltps1 ldep1 ; 
 
*   Evenement : 
    si imot5 ; 
      ttev1    = table ;
      ttev1 . nom   =  even1 ; 
      si ieve1 ; 
        ttev1 . temps = prog tps0 (tps0 + teve1) ; 
      sino ; 
        ttev1 . temps = prog tps0 ; 
      fins ; 
      si (exis tab1 'EVENEMENTS') ; 
        nbev1    = (dime tab1.evenements) + 1 ; 
      sino ; 
        tab1.evenements = table ; 
        nbev1    = 1 ; 
      fins ; 
      tab1.evenements.nbev1 = ttev1 ; 
    fins ; 
 
*   Enregistrements en fin de traitement option pour eviter
*   modifier table avant fin realisation option
    tab1.trajectoire = mail1 ; 
    tab1.evolution_puissance = evqtot1 ; 
    tab1.evolution_debit = evdebi1 ; 
    tab1.evolution_deplacement = evdep1 ; 
 
    quit soudage ; 
*   Fin option DEPLA CERC : 
  fins ; 
 
*----------------------------- DEPLA MAIL -----------------------------* 
* Sous-option MAIL : 
  si (ega mot2 'MAIL') ; 
    icas2    = 3 ; 
 
    argu mail1*'MAILLAGE' ; 
    eltyp1   = mail1 elem type ; 
    imax1    = 0 ; 
    si (exis eltyp1 'SEG2') ; imax1 = imax1 + 1 ; fins ; 
    si (exis eltyp1 'SEG3') ; imax1 = imax1 + 1 ; fins ; 
    si ((dime eltyp1) > imax1) ; 
      erre '*****  ERREUR : le maillage doit etre compose de SEG2 ou de SEG3.' ; 
    fins ; 
    ll1      = mesu mail1 ; 
 
*   Trajectoire DEPLA MAIL : 
    si idebut1 ; 
      P1       = mail1 poin 1 ; 
      tab1.point_de_depart = P1 ; 
    sino ; 
      mail0    = tab1.trajectoire ; 
      nbpts0   = nbno mail0 ; 
      P0       = mail0 poin nbpts0 ; 
      P1       = mail1 poin 1 ; 
      si (P1 neg P0) ; 
        tol1     = 1.e-10 * (mesu mail1) ; 
        si ((norm (P1 moin P0)) > tol1) ; 
          erre '*****  ERREUR : MAILLAGE incompatible.' ; 
          quit soudage ; 
        sino ; 
          elim (P0 et P1) tol1 ; 
        fins ; 
      fins ; 
      si (nbpts0 > 1) ; 
        mail1    = mail1 coul vert ; 
        mail1    = mail0 et mail1 ; 
      fins ; 
    fins ; 
 
*   Increment de temps DEPLA MAIL : 
    imot4    = faux ; imot5    = faux ; 
    ieve1    = faux ; 
    repe b1 2 ; 
      argu mot4/'MOT' ; 
      si (non (exis mot4)) ; quit b1 ; fins ; 
      si (ega mot4 'VITE') ; 
        imot4    = vrai ; 
        argu vdep1*'FLOTTANT' ; 
      fins ; 
      si (ega mot4 'EVEN') ; 
        imot5    = vrai ; 
        argu even1*'MOT' ; 
        argu teve1/'FLOTTANT' ; 
        ieve1    = exis teve1 ; 
      fins ; 
    fin b1 ; 
 
*   Coupure et temps de coupure selon existence EVEN : 
*    idtcp1   = idtcp1 ou ieve1 ; 
*    si ieve1 ; 
*      dtcp1    = teve1 ; 
*    fins ; 
 
* Vitesse de deplacement : 
    si (non imot4) ; 
      vdep1    = tab1.vitesse_de_deplacement ; 
    fins ; 
    wtab1 . vdep = vdep1 ; 
    dt1    = ll1 / vdep1 ; 
    si idtcp1 ; 
      dt1    = dt1 + dtcp1 ; 
    fins ; 
 
*   Evolution puissance DEPLA MAIL : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      lqtot1   = prog qtot1 qtot1 ; 
      lqi1     = prog 1. 1. ; 
    sino ; 
      ltps0    = extr evqtot0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        lti1     = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        lqtot1   = prog          qtot1        qtot1 ; 
      sino ; 
        lti1     = prog tps0 (tps0 + dt1) ; 
        ltps1    = prog (tps0 + dt1) ; 
        lqtot1   = prog        qtot1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      lqtot1   = lqtot0 et lqtot1 ; 
    fins ; 
    evqtot1  = evol roug manu temp ltps1 qtot lqtot1 ; 
 
*   Evolution debit DEPLA MAIL : 
    si idebut1 ; 
      ltps1    = prog    0.   dt1 ; 
      ldebi1   = prog debi1 debi1 ; 
    sino ; 
      ltps0    = extr evdebi0 absc ; 
      tps0     = extr  ltps0 (dime  ltps0) ; 
*     Si la puissance indiquee est differente de celle existante : 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldebi1   = prog          debi1        debi1 ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldebi1   = prog        debi1 ; 
      fins ; 
      ltps1    =  ltps0 et  ltps1 ; 
      ldebi1   = ldebi0 et ldebi1 ; 
    fins ; 
    evdebi1  = evol roug manu temp ltps1 debi ldebi1 ; 
 
*   Evolution deplacement DEPLA MAIL : 
    si idebut1 ; 
      ltps1    = prog 0. dt1 ; 
      ldep1    = prog 0. ll1 ; 
      tps0     = 0. ; 
    sino ; 
      evdep0   = tab1.evolution_deplacement ; 
      ltps0    = extr evdep0 absc ; 
      ldep0    = extr evdep0 ordo ; 
      tps0     = extr ltps0 (dime ltps0) ; 
      dep0     = extr ldep0 (dime ldep0) ; 
      si idtcp1 ; 
        ltps1    = prog (tps0 + dtcp1) (tps0 + dt1) ; 
        ldep1    = prog           dep0 (dep0 + ll1) ; 
      sino ; 
        ltps1    = prog (tps0 + dt1) ; 
        ldep1    = prog (dep0 + ll1) ; 
      fins ; 
      ltps1    = ltps0 et ltps1 ; 
      ldep1    = ldep0 et ldep1 ; 
    fins ; 
    ldep1    = ldep1 / (maxi ldep1) * (mesu mail1) ; 
    evdep1   = evol vert manu temp ltps1 ldep1 ; 
 
*   Evenement : 
    si imot5 ; 
      ttev1    = table ;
      ttev1 . nom   =  even1 ; 
      si ieve1 ; 
        ttev1 . temps = prog tps0 (tps0 + teve1) ; 
      sino ; 
        ttev1 . temps = prog tps0 ; 
      fins ; 
      si (exis tab1 'EVENEMENTS') ; 
        nbev1    = (dime tab1.evenements) + 1 ; 
      sino ; 
        tab1.evenements = table ; 
        nbev1    = 1 ; 
      fins ; 
      tab1.evenements.nbev1 = ttev1 ; 
    fins ; 
 
*   Enregistrements en fin de traitement option pour eviter
*   modifier table avant fin realisation option
    tab1.trajectoire = mail1 ; 
    tab1.evolution_puissance = evqtot1 ; 
    tab1.evolution_debit = evdebi1 ; 
    tab1.evolution_deplacement = evdep1 ; 
 
    quit soudage ; 
*   Fin option DEPLA MAIL : 
  fins ; 
 
*---------------------------- DEPLA COUCHE ----------------------------* 
* Sous-option COUCHE : 
  si (ega mot2 'COUCHE') ; 
    icas2    = 4 ; 
 
*   Option PAUSE : 
    imot3    = faux ; imot4 = faux ; imot5 = faux ; imot6 = faux ; 
    ieve1    = faux ; 
    repe b1 4 ; 
      argu mot3/'MOT' ; 
      si (non (exis mot3)) ; quit b1; fins ; 
      si (ega mot3 'VITE') ; 
        imot3    = vrai ; 
        argu flot2*'FLOTTANT' ; 
      fins ; 
      si (ega mot3 'DEBI') ; 
        imot4    = vrai ; 
        argu flot3*'FLOTTANT' ; 
      fins ; 
      si (ega mot3 'PAUSE') ; 
        imot5    = vrai ; 
        argu flot4*'FLOTTANT' ; 
      fins ; 
      si (ega mot3 'EVEN') ; 
        imot6    = vrai ; 
        argu even1*'MOT' ; 
        argu teve1/'FLOTTANT' ; 
        ieve1    = exis teve1 ; 
      fins ; 
    fin b1 ; 
 
*   Epaisseur de la couche : 
    si imot3 ; 
      Vpf1     = flot2 ; 
    sino ; 
      Vpf1     = tab1.vitesse_de_soudage ; 
    fins ; 
    si imot4 ; 
      Dpf1     = flot3 ; 
    sino ; 
      Dpf1     = tab1.debit_de_fil ; 
    fins ; 
*List Dpf1 ; 
    si (exis tab1 'LARGEUR_DE_PASSE') ; 
      Lpf1     = tab1.largeur_de_passe ; 
    sinon ; 
      erre '*****  ERREUR : il manque la donnee de la largeur de passe.' ; 
      quit soudage ; 
    finsi ; 
    epf1     = Dpf1 / Vpf1 / Lpf1 ; 
*List epf1 ; 
 
*   Pause : 
    si imot5 ; 
      vdep2    = epf1 / flot4 ; 
    sino ; 
      vdep2    = tab1.vitesse_de_deplacement ; 
    fins ; 
    si imot6 ; 
      si ieve1 ; 
        soudage tab1 depla droi (0 0 epf1) vite vdep2 even even1 teve1 ; 
      sino ; 
        soudage tab1 depla droi (0 0 epf1) vite vdep2 even even1 ; 
      fins ; 
    sino ; 
      soudage tab1 depla droi (0 0 epf1) vite vdep2 ; 
    fins ; 
 
*   Fin option DEPLA COUCHE : 
  fins ; 
 
  si (icas2 ega 0) ; 
    erre '*****  ERREUR : MOT option non reconnu.' ; 
    quit soudage ; 
  fins ; 
 
* Fin option DEPLA : 
fins ; 
 
*----------------------------------------------------------------------* 
*                             Option MAIL                              * 
*----------------------------------------------------------------------* 
 
si (ega mot1 'MAIL') ; 
  icas1    = 4 ; 
 
*----------------------- Lecture des arguments ------------------------* 
 
* Lecture maillage cordons : 
  argu mail1*'MAILLAGE' ; 
 
* Lecture facultative liste ordonnancement couleurs ; 
  argu list1/'LISTENTI' ; 
  ilist1  = exis list1 ; 
  si (non ilist1) ; 
    argu list1/'LISTMOTS' ; 
    ilist1  = exis list1 ; 
  fins ; 
 
* Lecture du mot 'PAS' ; 
  argu mot1*'MOT' ; 
  si (neg mot1 'PAS') ; 
    erre '*****  ERREUR : on attend le mot-cle PAS' ; 
    quit soudage ; 
  sino ; 
    argu flot1*'FLOTTANT' ; 
  fins ; 
 
* Lecture options 'TEMP' et 'MESU' ; 
  imot2    = faux ; 
  imot3    = faux ; 
  repe bmot2 2 ; 
    argu mot2/'MOT' ; 
    si (exis mot2) ; 
      si (ega mot2 'TEMP') ; 
        imot2    = vrai ; 
        argu flot2/'FLOTTANT' ; 
        si (non (exis flot2)) ; 
          flot2    = 3. * pi ;
        fins ; 
        iter bmot2 ; 
      fins ; 
      si (ega mot2 'MESU') ; 
        imot3    = vrai ; 
        argu ps1*point ; 
        iter bmot2 ; 
      fins ; 
      si ((non imot2) et (non imot3)) ; 
        erre '*****  ERREUR : on attend les mots-cle TEMP ou MESU' ; 
*        quit soudage ; 
      fins ; 
    fins ; 
  fin bmot2 ; 
*list imot2 ; list imot3 ; 
 
*----------------------- Indexation du maillage -----------------------* 
 
* Informations trajectoire : 
  ltraj1   = tab1.trajectoire ; 
  chxs1    = ltraj1 coor curv ; 
  x1 y1 z1 = mail1 coor ; 
 
* Informations evolution deplacements : 
  evxs1    = tab1.evolution_deplacement ; 
  ltxs1    = extr evxs1 absc ; 
  lxxs1    = extr evxs1 ordo ; 
  nbxs1    = dime lxxs1 ; 
*list ltxs1 ; 
*list lxxs1 ; 
 
* Information apport de matiere : 
  evdf1    = tab1.evolution_debit ; 
  ldeb1    = extr evdf1 ordo ; 
 
* tolerance dimensionnelle : 
  tol1     = 1.e-10 * (maxi ltxs1) ; 
  tol2     = 1.e-6  * (maxi ldeb1) ; 
 
* Table resultat : 
  tab2                                 = table ; 
  tab2 . maillage                      = mail1 ; 
  tab2 . evolution_maillage            = table ; 
  tab2 . evolution_maillage . temps    = table ; 
  tab2 . evolution_maillage . maillage = table ; 
  ttps1    = table ; 
  tmai1    = table ; 
 
* Listreels de l'option MESU : 
  si imot3 ;
    llarg1   = prog ; 
    lhaut1   = prog ; 
  fins ;
 
* Boucle sur les segents rouges de la trajectoire : 
  nb1      = nbel ltraj1 ; 
  geoi1    = vide maillage ; 
  indi1    = 0 ; 
  ic1      = 1 ; 
  inewcor1 = vrai ; 
  isuidep1 = vrai ; 
  ifermee1 = faux ; 
  icourbe1 = faux ; 
  ipredep1 = vrai ; 
 
  repe b1 nb1 ; 
    pasi1    = flot1 ; 
 
    eli1     = ltraj1 elem &b1 ; 
    pi1      = eli1 poin 1 ; 
    pi2      = eli1 poin 2 ; 
    leli1    = mesu eli1 ; 
 
*   Si pas trajectoire d'une passe, on saute en changeant de couleur : 
    si (neg ((eli1 elem coul) extr 1) 'ROUG') ; 
      inewcor1 = vrai ; 
      ifermee1 = faux ; 
      icourbe1 = faux ; 
      si (non ipredep1) ; ic1 = ic1 + 1 ; fins ; 
      ipredep1 = vrai ; 
      iter b1 ; 
    sino ; 
      ipredep1 = faux ; 
      si (&b1 neg nb1) ; 
        eli2     = ltraj1 elem (&b1 + 1) ; 
        isuidep1 = ega ((eli2 elem coul) extr 1) 'VERT' ; 
        si ((non isuidep1) et (non (ifermee1 ou icourbe1))) ; 
          ifin1    = &b1 + 1 ; 
          elfin1   = eli2 ; 
          repe bfermee1 (nb1 - &b1 - 1) ; 
            eli2     = ltraj1 elem (&b1 + 1 + &bfermee1) ; 
            si (ega ((eli2 elem coul) extr 1) 'VERT') ; quit bfermee1 ; fins ; 
            ifin1    = &b1 + 1 + &bfermee1 ; 
            elfin1   = eli2 ; 
          fin bfermee1 ; 
          ideb1    = &b1 ; 
          ifermee1 = (norm ((elfin1 poin 2) moin pi1)) < tol1 ; 
          icourbe1 = non ifermee1 ; 
si icourbe1 ; mess '*****  Passes successives : n° elem. debut =' ideb1 ', fin = ' ifin1 ; fins ; 
si ifermee1 ; mess '*****  Passe fermee : n° elem. debut =' ideb1 ', fin = ' ifin1 ; fins ; 
        fins ; 
      fins ; 
    fins ; 
*list isuidep1 ; 
 
*   Maillage cordon passe ic1 : 
    si inewcor1 ; 
      inewcor1 = faux ; 
      si ilist1 ; 
        couli1   = extr list1 ic1 ; 
        si (ega (type couli1) 'MOT') ; 
          maili1   = mail1  elem couli1 ; 
        sino ; 
          maili1   = mail1  elem coul couli1 ; 
        fins ; 
      sino ; 
        maili1   = mail1  elem coul ic1 ; 
      fins ; 
      pci1     = maili1 poin proc pi1 ; 
      si ((norm (pci1 moin pi1)) > pasi1 ) ; 
        erre '*****  ERREUR : distance trajectoire cordon superieure au PAS' ; 
        erre '       Element de la trajectoire :' &b1 ; 
        quit soudage ; 
      fins ; 
      tpi1     = maili1 part nesc conn ; 
      repe bp1 (dime tpi1) ; 
        maili1   = tpi1.&bp1 ; 
        si (pci1 dans maili1) ; quit bp1 ; fins ; 
      fin  bp1 ; 
    fins ; 
 
*   Vecteur(s) unitaire(s) de la trajectoire : 
    si (icourbe1 ou ifermee1) ; 
      si (&b1 ega ideb1) ; 
        ni1      = (pi2 moin pi1) / leli1 ; 
        eli2     = ltraj1 elem (&b1 + 1) ; 
        pi21     = eli2 poin 1 ; 
        pi22     = eli2 poin 2 ; 
        ni2      = (pi22 moin pi21) / (mesu eli2) ; 
        ni2      = 0.5 * (ni1 plus ni2) ; 
        si ifermee1 ; 
          pfin1    = elfin1 poin 1 ; 
          pfin2    = elfin1 poin 2 ; 
          nfin1    = (pfin2 moin pfin1) / (mesu elfin1) ; 
          ndeb1    = ni1 ; 
          ni1      = 0.5 * (ni1 plus nfin1) ; 
        fins ; 
      fins ; 
      si (&b1 ega ifin1) ; 
        ni1      = (pi2 moin pi1) / leli1 ; 
        nix      = ni1 ; 
        ni1      = ni2 ; 
        ni2      = nix ; 
        si ifermee1 ; 
          ni2      = 0.5 * (ndeb1 plus ni2) ; 
        fins ; 
      fins ; 
      si ((ideb1 < &b1) et  (&b1 < ifin1)) ; 
        ni1      = (pi2 moin pi1) / leli1 ; 
        nix      = ni2 ; 
        eli2     = ltraj1 elem (&b1 + 1) ; 
        pi21     = eli2 poin 1 ; 
        pi22     = eli2 poin 2 ; 
        ni2      = (pi22 moin pi21) / (mesu eli2) ; 
        ni2      = 0.5 * (ni1 plus ni2) ; 
        ni1      = nix ; 
      fins ; 
    sino ; 
      ni1      = (pi2 moin pi1) / leli1 ; 
    fins ; 
*list ni1 ; list ni2 ; 
 
*   Champ(s) de distance au(x) point(s) pi1 (Pi2) sur le maillage du cordon dans la direction ni1 (ni2) 
    x1 y1 z1       = maili1 coor ; 
    xp1 yp1 zp1    = pi1 coor ; 
    xni1 yni1 zni1 = ni1 coor ; 
    chpdi1   = ((x1 - xp1) * xni1) + ((y1 - yp1) * yni1) + ((z1 - zp1) * zni1) ; 
    modi1    = mode maili1 mecanique ; 
    chedi1   = chan cham chpdi1 modi1 gravite ; 
*list ni1 ; list pi1 ; 
*trac chedi1 modi1 ; 
 
*   Option MESU : champs de distance dans les directions transverses (v et w) : 
    si imot3 ; 
      vi1      = ps1 / (norm ps1) ; 
      wi1      = pvec ni1 vi1 ; 
*list vi1 ; list wi1 ; 
      xvi1 yvi1 zvi1 = vi1 coor ; 
      xwi1 ywi1 zwi1 = wi1 coor ; 
      chli1    = ((x1 - xp1) * xwi1) + ((y1 - yp1) * ywi1) + ((z1 - zp1) * zwi1) ; 
      chhi1    = ((x1 - xp1) * xvi1) + ((y1 - yp1) * yvi1) + ((z1 - zp1) * zvi1) ; 
*trac chhi1 ; 
    fins ; 
 
 
*   Extraction evolution deplacement sur ce segment : 
    xspi1    = chxs1 extr pi1 scal ; 
    xspi2    = chxs1 extr pi2 scal ; 
    repe bxs1 nbxs1 ; 
      xxsi1    = extr lxxs1 (nbxs1 + 1 - &bxs1) ; 
      si (non (xxsi1 < (xspi2 - tol1))) ; 
        xxxi2    = xxsi1 ; 
        txxi2    = extr ltxs1 (nbxs1 + 1 - &bxs1) ; 
      fins ; 
      xxsi1    = extr lxxs1 &bxs1 ; 
      si (non (xxsi1 > (xspi1 + tol1))) ; 
        xxxi1    = xxsi1 ; 
        txxi1    = extr ltxs1 &bxs1 ; 
      fins ; 
    fin bxs1 ; 
    lxxsi1  = prog xxxi1 xxxi2 ; 
    ltxsi1  = prog txxi1 txxi2 ; 
*list lxxsi1 ; 
*list ltxsi1 ; 
 
*   Sequencage maillage cordon selon pas fourni : 
    si (leli1 >EG pasi1) ; 
      nb2      = (leli1 / pasi1) enti ; 
      nb2      = maxi (lect 1 nb2) ; 
    sino ; 
      nb2      = 1 ; 
      pasi1    = leli1 ; 
    fins ; 
*list nb2 ; 
 
    xsi1     = 0. ; 
    pmaili1  = maili1 poin proc pi1 ; 
    si ifermee1 ; 
      si (&b1 ega ideb1) ; 
        xdeb1    = 0. ; 
      sino ; 
        Sdeb1    = (enve tmai1 . (indi1 - 1)) inte (enve maili1) ; 
        pdeb1    = Sdeb1 poin proc pi1 ; 
        tconn1   = Sdeb1 part nesc conn ; 
        si (pdeb1 dans tconn1 . 1) ; 
          Sdeb1    = tconn1 . 1 ; 
        sino ; 
          Sdeb1    = tconn1 . 2 ; 
        fins ; 
*trac cach Sdeb1 ; 
        xdeb1    = (redu chpdi1 Sdeb1) mini ; 
      fins ; 
      geoi2    = chedi1 elem supe (xsi1 - tol1 + xdeb1) stri ; 
      chedi1   = redu chedi1 geoi2 ; 
    fins ; 
    repe b2 nb2 ; 
      xsi2     = xsi1 + pasi1 ; 
      si (xsi2 > leli1) ; 
        xsi2     = leli1 ; 
      fins ; 
      si ((&b2 ega nb2) et (isuidep1 ou (&b1 ega nb1))) ; 
        xsi2     = maxi chedi1 ; 
*mess '*** Maxi !' ; 
      fins ; 
      geoi2    = chedi1 elem infe (xsi2 + tol1) stri ; 
      si (non (vide geoi2)) ; 
        tgeoi2   = geoi2 part nesc conn ; 
        geoix    = vide maillage ; 
        repe bgeoi2 (dime tgeoi2) ; 
          si (pmaili1 dans tgeoi2.&bgeoi2) ; 
            geoix    = tgeoi2.&bgeoi2 ; 
            quit bgeoi2 ; 
          fins ; 
        fin bgeoi2 ; 
        geoi2    = geoix ; 
        tmai1 . indi1 = geoi1 et geoi2 ; 
        ti2      = ipol (xspi1 + xsi1) lxxsi1 ltxsi1 ; 
        ttps1 . indi1 = ti2 ; 
        indi1    = indi1 + 1 ; 
        xsi1     = xsi2 ; 
 
*       Option MESU :
        si imot3 ;
          chli1    = redu chli1 geoi2 ;
          chhi1    = redu chhi1 geoi2 ;
          lai1     = (maxi chli1) - (mini chli1) ; 
          lhi1     = (maxi chhi1) - (mini chhi1) ; 
*list lai1 ; list lhi1 ; 
          llarg1   = llarg1 et lai1 ; 
          lhaut1   = lhaut1 et lhi1 ; 
        fins ;
 
*      sino ; 
*mess '  ***** Geoi2 vide : indi1 = ' indi1 ; 
      fins ; 
    fin b2 ; 
    geoi1    = geoi1 et geoi2 ; 
 
*   Retrait du maillage deja indexe au maillage total -> reste a faire 
    mail1    = mail1 diff geoi1 ; 
    si (icourbe1 ou ifermee1) ; 
      maili1   = maili1 diff (geoi1 inte maili1) ; 
    fins ; 
  fin b1 ; 
  tab2 . evolution_maillage . temps    = ttps1 ; 
  tab2 . evolution_maillage . maillage = tmai1 ; 
 
* Option MESU : 
  si imot3 ; 
    lltps1   = prog table ttps1 ;
    evlarg1  = evol vert manu 'TEMP' lltps1 llarg1 ;
    evhaut1  = evol vert manu 'TEMP' lltps1 lhaut1 ;
    tab2 . largeur_cordons = evlarg1 ; 
    tab2 . hauteur_cordons = evhaut1 ; 
  fins ; 
 
*-------------------------- Sous-option TEMP --------------------------* 
 
  si imot2 ; 
 
*   Valeurs pas de temps de calcul :
    nbp1     = dime tab1.passes ;
    ldtca1   = prog ;
    si (nbp1 > 1) ;
      ltdpass1 = prog ;
      repe bp1 nbp1 ;
        vpi1     = tab1.passes.&bp1.vitesse ;
        dtcai1   = flot1 / vpi1 / flot2 ;
        ldtca1   = ldtca1 et dtcai1 ;
        tdpassi1 = tab1.passes.&bp1.instants extr 1 ;
        ltdpass1 = ltdpass1 et tdpassi1 ;
      fin bp1 ;
      dtca1    = ldtca1 extr 1 ;
      passp1   = 2 ;
      tdpassp1 = ltdpass1 extr passp1 ;
    sino ;
      dtca1    = flot1 / (tab1.vitesse_de_soudage) / flot2 ;
    fins ;
    nbdtca1  = dime ldtca1 ;
*list ldtca1 ;
*list ltdpass1 ;
 
*   Redecoupage de la liste des temps de l'evolution de la puissance thermique : 
    evqt1    = tab1.evolution_puissance ; 
    ltqt1    = extr evqt1 absc ; 
    lqqt1    = extr evqt1 ordo ; 
    tol2     = 1.e-6 * (maxi lqqt1) ; 
    tol3     = 0.001 * tab1.temps_de_coupure ; 
 
*   Gestion des evenements : 
    ieve1    = exis tab1 evenements ; 
    Si ieve1 ; 
      lteve1   = prog ; 
      lieve1   = lect ; 
      repe beve1 (dime tab1.evenements) ; 
        ie1      = &beve1 ; 
        lteve1   = lteve1 et tab1.evenements.ie1.temps ; 
        lieve1   = lieve1 et (lect (dime (tab1.evenements.ie1.temps)) * ie1) ; 
      fin beve1 ; 
      lpeve1   = posi ltqt1 dans lteve1 tol3 ; 
*list lteve1 ; 
*list lieve1 ; 
*list lpeve1 ; 
    sino ; 
      lpeve1   = lect (dime ltqt1) * 0 ; 
    fins ; 
 
*   Sous-decoupage de l'historique de puissance : 
    nb1      = dime ltqt1 ; 
    t0       = extr ltqt1 1 ; 
    q0       = extr lqqt1 1 ; 
 
*   Gestion evenements : 
    peve0    = extr lpeve1 1 ; 
    si (peve0 neg 0) ; 
      neve0    = extr lieve1 peve0 ; 
      si ((peve0 + 1) &lt;EG (dime lieve1)) ; 
        neve1    = extr lieve1 (peve0 + 1) ; 
      sino ; 
        neve1    = -1 ; 
      fins ; 
      idtev1   = neve0 ega neve1 ; 
      si idtev1 ; 
        tev1     = lteve1 extr (peve0 + 1) ; 
        dtev1    = tev1 - t0 ; 
*mess (chai 'Even. = ' neve0 ', dtev1 =' dtev1) ; 
      fins ; 
    sino ; 
      idtev1   = faux ; 
    fins ; 
 
*   Boucle sur les piquets de temps : 
    ltca1    = prog t0 ; 
    repe b1 (nb1 - 1) ; 
      ip1      = &b1 + 1 ; 
      t1       = extr ltqt1 ip1 ; 
      q1       = extr lqqt1 ip1 ; 
      peve1    = extr lpeve1 ip1 ; 
      dt1      = t1 - t0 ; 
      si (&b1 ega 1) ; dt0 = dt1 ; fins ; 
*     Gestion pas de temps (dtca1) en multipasses :
      si (nbdtca1 > 0) ;
        si ((t0 >EG tdpassp1) et (passp1 &lt;EG nbdtca1)) ;
          dtca1    = ldtca1 extr passp1 ;
          passp1   = passp1 + 1 ;
          si (passp1 > nbdtca1) ;
            tdpassp1 = (maxi ltqt1) + 1. ;
          sino ;
            tdpassp1 = ltdpass1 extr passp1 ;
          fins ;
*mess '***** t0, dtca1 ='  t0 ',' dtca1 ;
        fins ;
      fins ;
* Avec evements : 
      si idtev1 ; 
        si (dt1 &lt;EG dtca1) ; 
          si (dtev1 &lt;EG dtca1) ; 
            si (dt1 ega dtev1 tol3) ; 
              ltca1    = ltca1 et (prog t1) ; 
            sino ; 
              si (dt1 < dtev1) ; 
                ltca1    = ltca1 et (prog t1) et (prog tev1) ; 
                t1       = tev1 ; 
              sino ; 
                ltca1    = ltca1 et (prog tev1) et (prog t1) ; 
              fins ; 
            fins ; 
          sino ; 
            ltca1    = ltca1 et (prog t1) ; 
            si ((q0 > tol2) ou (q1 > tol2)) ; 
              ltca1    = ltca1 et ((prog t1 pas dtca1 tev1) enle 1) ; 
            sino ; 
              ltca1    = ltca1 et ((prog t1 pas dt1 geom 2. tev1) enle 1) ; 
            fins ; 
            t1       = tev1 ; 
          fins ; 
        sino ; 
          si (dt1 ega dtev1 tol3) ; 
            si ((q0 > tol2) ou (q1 > tol2)) ; 
              ltca1    = ltca1 et ((prog t0 pas dtca1 t1) enle 1) ; 
            sino ; 
              ltca1    = ltca1 et ((prog t0 pas dtev1 geom 2. t1) enle 1) ; 
            fins ; 
          sino ; 
            si (dtev1 < dt1) ; 
              si (dtev1 < dtca1) ; 
                ltca1    = ltca1 et (prog tev1) ; 
              sino ; 
                si ((q0 > tol2) ou (q1 > tol2)) ; 
*mess '############ Ici 1' ; 
                  ltca1    = ltca1 et ((prog t0 pas dtca1 tev1) enle 1) ; 
                  ltca1    = ltca1 et ((prog tev1 pas dtca1 t1) enle 1) ; 
                sino ; 
                  ltca1    = ltca1 et (prog tev1 pas dtev1 geom 2. t1) ; 
                fins ; 
              fins ; 
            sino ; 
              si ((q0 > tol2) ou (q1 > tol2)) ; 
*mess '############ Ici 2' ; 
                ltca1    = ltca1 et ((prog t0 pas dtca1 tev1) enle 1) ; 
              sino ; 
                ltca1    = ltca1 et ((prog t0 pas dt0 geom 2. tev1) enle 1) ; 
              fins ; 
              t1       = tev1 ; 
            fins ; 
          fins ; 
        fins ; 
* Pas d'evenement : 
      sino ; 
        si (dt1 &lt;EG dtca1) ; 
          ltca1    = ltca1 et (prog t1) ; 
        sino ; 
          si ((q0 > tol2) ou (q1 > tol2)) ; 
            ltca1    = ltca1 et ((prog t0 pas dtca1 t1) enle 1) ; 
          sino ; 
            ltca1    = ltca1 et ((prog t0 pas dt0 geom 2. t1) enle 1) ; 
          fins ; 
        fins ; 
      fins ; 
      t0       = t1 ; 
      q0       = q1 ; 
      ntca1    = dime ltca1 ; 
      dt0      = (ltca1 extr ntca1) - (ltca1 extr (ntca1-1)) ; 
*     Gestion evenement suivant : 
      peve0    = peve1 ; 
      si (peve0 neg 0) ; 
        neve0    = extr lieve1 peve0 ; 
        si ((peve0 + 1) &lt;EG (dime lieve1)) ; 
          neve1    = extr lieve1 (peve0 + 1) ; 
        sino ; 
          neve1    = -1 ; 
        fins ; 
        idtev1   = neve0 ega neve1 ; 
        si idtev1 ; 
          tev1     = lteve1 extr (peve0 + 1) ; 
          dtev1    = tev1 - t0 ; 
*mess (chai 'Even. = ' neve0 ', dtev1 =' dtev1) ; 
        fins ; 
      sino ; 
        idtev1   = faux ; 
      fins ; 
    fin b1 ; 
 
*   Verification si liste temps calcules bien ordonnee : 
    ltca2    = ordo ltca1 ; 
    si (((ltca2 - ltca1) maxi abs) > (1.e-3*flot2)) ; 
      erre '*****  ERREUR WAAM dans construction liste TEMPS_CALCULES' ; 
      quit waam ; 
    fins ; 
 
    tab2.temps_calcules = ltca1 ; 
 
*   Sorties si evenements : 
    si ieve1 ; 
      tab2.temps_evenements = lteve1 ; 
      tab2.index_evenements = lieve1 ; 
    fins ; 
 
* Fin sous-option TEMP : 
  fins ; 
 
* Sortie de la table resultat : 
  resp tab2 ; 
  quit soudage ; 
 
* Fin option MAIL : 
fins ; 
 
*----------------------------------------------------------------------* 
*                                  FIN                                 * 
*----------------------------------------------------------------------* 
 
* MOT1 n'est pas un des mots-cles des options de la procedure : 
si (icas1 ega 0) ; 
  erre '*****  ERREUR : MOT-cle option SOUDAGE non reconnu.' ; 
  quit soudage ; 
fins ; 
 
FINP ;