$$$$ TRACMECA
* TRACMECA  PROCEDUR  AM        96/12/23    22:09:13     2448           
'DEBPROC' tracmeca mod1*'MMODEL' tab1*'TABLE' tab2*'TABLE'
                                              coeff/'FLOTTANT';
*
* trace des mecanismes generes pas l'operateur MESM
*
* P.Pegon, Aout 90
*
*
'SI' ('NON' ('EXISTE' coeff));
  coeff=1.d0;
'FINSI';
*
dtab1='DIME' tab1;
'SI' ('NEG' dtab1 ('DIME' tab2)); lok=faux;
'SINON';                          lok=vrai; 'FINSI';
dtab1=dtab1-1;
*
'SI' lok;
  lok=faux;
  'SI' ('EXISTE' tab1 'SOUSTYPE');
    'SI' ('EGA' tab1.'SOUSTYPE' 'MECANISMES_PAR_NOEUDS');
      lok=vrai;
    'FINSI';
  'FINSI';
  'SI' ('EXISTE' tab2 'SOUSTYPE');
    'SI' ('EGA' tab1.'SOUSTYPE' 'MECANISMES_PAR_ELEMENTS');
      lok=lok 'ET' vrai;
    'FINSI';
  'FINSI';
'SINON';
  'MESS' 'TRACMECA: input tables without the same dimension';
'FINSI';
*
'SI' lok;
  chlm1=tab2 . 1;
  comp1='EXTR' chlm1 'COMP';
  laxi1=faux;
  'SI' (('DIME' comp1) > 2);
    'SI' ('EGA' ('EXTR' comp1 3) 'UP2 ');
      laxi1=vrai;
    'FINSI';
  'FINSI';
  'OUBLIER' chlm1; 'OUBLIER' comp1;
'SINON';
  'MESS' 'TRACMECA: input table without the right "SOUSTYPE"';
'FINSI';
*
* cercle unite centre en 0 et champ de contraction/dilatation
*
'SI' lok;
  p0=0 0;
  p1=1 0; p2=0 1; p3=-1 0; p4=0 -1;
  ce0=('CERC' 10 p1 p0 p2) 'ET' ('CERC' 10 p2 p0 p3) 'ET'
      ('CERC' 10 p3 p0 p4) 'ET' ('CERC' 10 p4 p0 p1);
  xce0 yce0='COOR' ce0;
  uce0=('EXCO' xce0 'SCAL' 'UX') 'ET' ('EXCO' yce0 'SCAL' 'UY');
  'OUBLIER' xce0; 'OUBLIER' yce0;
*
* etoile unite centree en 0 et champ de contraction/dilatation
*
  p5=1 1; p6=-1 1; p7=-1 -1; p8=1 -1;
  st0=('DROI' 1 p1 p3) 'ET' ('DROI' 1 p2 p4) 'ET' 
      ('DROI' 1 p5 p7) 'ET' ('DROI' 1 p6 p8);
  xst0 yst0='COOR' st0;
  ust0=('EXCO' xst0 'SCAL' 'UX') 'ET' ('EXCO' yst0 'SCAL' 'UY');
  'OUBLIER' xst0; 'OUBLIER' yst0;
*
* taille mini des elements
*
  ta0='MANU' 'CHML' mod1 'LONG' 1. 'TYPE' 'CARACTERISTIQUES' 'RIGIDITE';
  ta0='INTG' 'ELEM' mod1 ta0;
  ta0='MINI' ta0;
  lemes9m1=-1+(ta0/9);
  ta0=ta0/8;
*
* boucle sur les modes
*
  tab3='TABLE';
  mes1='EXTR' mod1 'MAIL'; nel1='NBEL' mes1;
  mmes1=mes1 'ET' (('CHAN' mes1 'POI1') 'COUL' 'JAUN');
  'REPE' labmod dtab1;
*
* objet de type deformee de base
*
    chpmo1=coeff*tab1 . &labmod;
    defmo1='DEFO' mmes1 chpmo1 1.;
    'DEPL' 'PLUS' mes1 chpmo1;
*
    chmod1=tab2 . &labmod;
    maxmo1='MAXI' chmod1 'ABS';
*
* loop sur les elements
*
    'REPE' labmes nel1;
*
*   coordonee des points de l'element deforme et longueur
*
      elmes1='ELEM' mes1 &labmes;
      xel1 yel1='COOR' (elmes1 'POINT' 1);
      xel2 yel2='COOR' (elmes1 'POINT' 2);
      lemes1=(((xel2-xel1)**2)+((yel2-yel1)**2) )**0.5;
      tb0=ta0/lemes1; tb1=1.-tb0;
*
*   ajout eventuel des cercles et de l'etoile
*
      chelm1='REDU' chmod1 elmes1;
*
      'SI' laxi1;
        up2 ='EXTR' chelm1 1 1 1 'UP2 ';
        'SI' (('ABS' (up2/maxmo1)) > 1.d-9);
          tst0='MANU' chpo st0 2 'UX' ((xel1+xel2)/2) 
                                 'UY' ((yel1+yel2)/2);
          'SI' (up2 '>' 0.);
            defmo1=defmo1 'ET' 
                  ('DEFO' st0 (tst0+(lemes9m1*ust0)) 1 'TURQ');
          'SINON';
            defmo1=defmo1 'ET'
                  ('DEFO' st0 (tst0+(lemes9m1*ust0)) 1 'BLEU');
          'FINSI';
        'FINSI';
      'FINSI';
*
      rzp1='EXTR' chelm1 1 1 1 'RZP1';
      'SI' (('ABS' (rzp1/maxmo1)) > 1.d-9);
        tce0='MANU' chpo ce0 2 'UX' ((tb1*xel1)+(tb0*xel2))
                               'UY' ((tb1*yel1)+(tb0*yel2));
        'SI' (rzp1 '>' 0.);
          defmo1=defmo1 'ET'
                ('DEFO' ce0 (tce0+(lemes9m1*uce0)) 1 'ROUG');
        'SINON';
          defmo1=defmo1 'ET'
                ('DEFO' ce0 (tce0+(lemes9m1*uce0)) 1 'ROSE');
        'FINSI';
      'FINSI';
*
      rzp2='EXTR' chelm1 1 1 1 'RZP2';
      'SI' (('ABS' (rzp2/maxmo1)) > 1.d-9);
        tce0='MANU' chpo ce0 2 'UX' ((tb1*xel2)+(tb0*xel1))
                               'UY' ((tb1*yel2)+(tb0*yel1));
        'SI' (rzp2 '>' 0.);
          defmo1=defmo1 'ET'
                ('DEFO' ce0 (tce0+(lemes9m1*uce0)) 1 'ROUG');
        'SINON';
          defmo1=defmo1 'ET'
                ('DEFO' ce0 (tce0+(lemes9m1*uce0)) 1 'ROSE');
        'FINSI';
      'FINSI';
*
    'FIN' labmes;
*
    'DEPL' 'MOINS' mes1 chpmo1;
    tab3 . &labmod=defmo1;
  'FIN' labmod;
'FINSI';
'FINPROC' tab3;