Procédures | Cast3M

* LIMEMECA  PROCEDUR  AM        96/12/23    21:42:40     2448           
'DEBPROC' limemeca mod1*'MMODEL' tab1*'TABLE' tab2*'TABLE' 
                   mch1*'MCHAML' chp1*'CHPOINT' 
                   chp2/'CHPOINT' coeff/'FLOTTANT';
*
* Analyse limite par l'approche cinematique de structure de poutre
*
* P.Pegon, Aout 90
*
nbmeca1='DIME' tab1;
'SI' ('NEG' nbmeca1 ('DIME' tab2)); 
  'MESS' 'LIMEMECA: input tables without the same dimension';
  lok=faux;
'SINON';
  lok=vrai; 
'FINSI';
nbmeca1=nbmeca1-1;
*
'SI' lok;
  'SI' ('EXISTE' tab1 'SOUSTYPE');
    'SI' ('EGA' tab1 . 'SOUSTYPE' 'MECANISMES_PAR_NOEUDS');
      lok=vrai;
    'SINON';
      lok=faux;
      'MESS' 'LIMEMECA: input table 1 without the right "SOUSTYPE"';
    'FINSI';
  'FINSI';
  'SI' ('EXISTE' tab2 'SOUSTYPE');
    'SI' ('EGA' tab2 . 'SOUSTYPE' 'MECANISMES_PAR_ELEMENTS');
      lok=lok 'ET' vrai;
    'SINON';
      lok=faux;
      'MESS' 'LIMEMECA: input table 2 without the right "SOUSTYPE"';
    'FINSI';
  'FINSI';
'FINSI';
*
'SI' lok;
  chlm1=tab2 . 1;
  comp1='EXTR' chlm1 'COMP';
  laxi1=faux; ndonn1=4;
  'SI' (('DIME' comp1) > 2);
    'SI' ('EGA' ('EXTR' comp1 3) 'UP2 ');
      laxi1=vrai; ndonn1=6;
    'FINSI';
  'FINSI';
*
  comp1='EXTR' mch1 'COMP';
  'SI' ('NEG' ('DIME' comp1) ndonn1); 
     'MESS' 'LIMEMECA: characteristic field without ' ndonn1 
            ' components';
     lok=faux; 
  'FINSI';
  'OUBL' comp1;
*
'FINSI';
*
'SI' lok;
  mot1='MOTS' 'UX' 'UY' 'RZ'; mot2='MOTS' 'FX' 'FY' 'MZ';
*
  me1='EXTR' mod1 'MAIL'; nbme1='NBEL' me1;
  nbthet2=ndonn1*nbme1;
*
  'SI' ('NON' ('EXISTE' coeff));
    coeff=1.d0;
  'FINSI';
*
  tabf1='TABLE' 'VECTEUR';
  'REPE' lab1 nbme1;
    elemj0='ELEM' me1 &lab1;
    chelmk='REDU' mch1 elemj0;
    ind0=nbmeca1+((&lab1-1)*ndonn1);
    ind0=ind0+1;
    tabf1 . ind0=(-1.d0)*('EXTR' chelmk 1 1 1 'MZ1+');
    ind0=ind0+1;
    tabf1 . ind0=(-1.d0)*('EXTR' chelmk 1 1 1 'MZ1-');
    ind0=ind0+1;
    tabf1 . ind0=(-1.d0)*('EXTR' chelmk 1 1 1 'MZ2+');
    ind0=ind0+1;
    tabf1 . ind0=(-1.d0)*('EXTR' chelmk 1 1 1 'MZ2-');
    'SI' laxi1;
      ind0=ind0+1;
      tabf1 . ind0=(-1.d0)*('EXTR' chelmk 1 1 1 'F2+ ');
      ind0=ind0+1;
      tabf1 . ind0=(-1.d0)*('EXTR' chelmk 1 1 1 'F2- ');
    'FINSI';
  'FIN' lab1;
*
  'SI' ('EXISTE' chp2);
    tabf10=0.d0;
    'REPE' lab1 nbmeca1;
      aa1='XTY' tab1 . &lab1 chp2 mot1 mot2;
      tabf1 . &lab1=aa1;
      tabf10=tabf10 - (coeff*aa1);
    'FIN' lab1;
    tabf1 . 0=tabf10;
  'FINSI';
*
  tabi1=tabl;
*
  nchp1='XTY' chp1 chp1 mot2 mot2; nchp1=(nchp1**0.5d0)/2.d0;
  chp1=chp1/nchp1;
*
  tabe1='TABLE'; tdum1='TABLE' 'VECTEUR';
  tabe1 . 1=tdum1;
  tdum10=1.d0;
  'REPE' lab1 nbmeca1;
    aa1='XTY' tab1 . &lab1 chp1 mot1 mot2;
    tdum1 . &lab1=aa1;
    tdum10=tdum10 + (coeff*aa1);
  'FIN' lab1;
  tdum1 . 0=tdum10;
  'OUBL' mot1; 'OUBL' mot2;
*
  'REPE' lab1 nbme1;
    elemj0='ELEM' me1 &lab1;
    ind0=1+((ndonn1/2)*(&lab1-1));
**
    ind0=ind0+1;
    tdum1='TABLE' 'VECTEUR';
    tabe1 . ind0=tdum1;
    tdum10=0.d0;
    'REPE' lab2 nbmeca1;
      chelmk='REDU' tab2 . &lab2 elemj0;
      rzp1='EXTR' chelmk 1 1 1 'RZP1';
      tdum1 . &lab2=rzp1;
      tdum10=tdum10 + (coeff*rzp1);
    fin lab2;
    tdum1 . 0=tdum10;
    jnd0=nbmeca1+(ndonn1*(&lab1-1));
    tdum1 . (jnd0 + 1)=-1.d0;
    tdum1 . (jnd0 + 2)=1.d0;
**
    ind0=ind0+1;
    tdum1='TABLE' 'VECTEUR';
    tabe1 . ind0=tdum1;
    tdum10=0.d0;
    'REPE' lab2 nbmeca1;
      chelmk='REDU' tab2 . &lab2 elemj0;
      rzp2='EXTR' chelmk 1 1 1 'RZP2';
      tdum1 . &lab2=rzp2;
      tdum10=tdum10 + (coeff*rzp2);
    fin lab2;
    tdum1 . 0=tdum10;
    jnd0=nbmeca1+(ndonn1*(&lab1-1));
    tdum1 . (jnd0 + 3)=-1.d0;
    tdum1 . (jnd0 + 4)=1.d0;
**
    'SI' laxi1;
      ind0=ind0+1;
      tdum1='TABLE' 'VECTEUR';
      tabe1 . ind0=tdum1;
      tdum10=0.d0;
      'REPE' lab2 nbmeca1;
        chelmk='REDU' tab2 . &lab2 elemj0;
        up2='EXTR' chelmk 1 1 1 'UP2 ';
        tdum1 . &lab2=up2;
        tdum10=tdum10 + (coeff*up2);
      fin lab2;
      tdum1 . 0=tdum10;
      jnd0=nbmeca1+(ndonn1*(&lab1-1));
      tdum1 . (jnd0 + 5)=-1.d0;
      tdum1 . (jnd0 + 6)=1.d0;
    'FINSI';
**
  'FIN' lab1;
  'OUBL' me1;
*
  iok tabp1 tabs1='SIMP' tabf1 tabi1 tabe1;
  'OUBL' tabs1; 'OUBL' tabf1; 'OUBL' tabi1; 'OUBL' tabe1; 'OUBL' tdum1;
  'SI' ('NEG' iok 0); 
    lok=faux;
    'MESS' 'LIMEMECA: simplex error code' iok;
    'SI' ('EGA' iok 1);
      'MESS' 'LIMEMECA: unbounded objective function';
    'SINON';
      'MESS' 'LIMEMECA: no solution for the given constraints';
    'FINSI';
  'FINSI';
*
'FINSI';
*
'SI' lok;
  colim1=(-1.d0)/nchp1*tabp1 . 0;
*
  tx1='TABL';
  'REPE' lab1 nbmeca1;
    xlab1=(-1.d0)*coeff;
    lok='EXISTE' tabp1 &lab1;
    'SI' lok;
      'SI' ('EGA' tabp1 . &lab1 0.d0);
        lok=faux;
      'FINSI';
    'FINSI';
    'SI' lok;
      xlab1=xlab1+tabp1 . &lab1;
    'SINON';
      'MESS' 'LIMEMECA: the mechanism number'
                        &lab1 'is not activated --> increase coeff';
      'OUBL' tx1;
      'QUITTER' lab1;
    'FINSI';
    tx1 . &lab1=xlab1;
  'FIN' lab1;
*
'FINSI';
*
'SI' lok;
  'REPE' lab1 nbmeca1;
    'SI' ('EGA' &lab1 1);
      chdlim1=(tx1 . &lab1)*(tab1 . &lab1);
      chrlim1=(tx1 . &lab1)*(tab2 . &lab1);
    'SINON';
      chdlim1=chdlim1+((tx1 . &lab1)*(tab1 . &lab1));
      chrlim1=chrlim1+((tx1 . &lab1)*(tab2 . &lab1));
    'FINSI';
  'FIN' lab1;
  'OUBL' tx1;
'SINON';
  colim1=''; chdlim1=''; chrlim1='';
'FINSI';
*
'FINPROC' lok colim1 chdlim1 chrlim1;