Download viteunil.procedur

Back to the list

   1 : * VITEUNIL  PROCEDUR  PV        13/12/06    21:15:12     7877           
   2 : * VITEUNIL  PROCEDUR  NOBODY    92/01/01    00:00:00     001                    
   3 :   'DEBPROC'   VITEUNIL  ROP*'RIGIDITE' M*'RIGIDITE' V*'CHPOINT' 
   4 :  DX*'CHPOINT' DEPINI*'CHPOINT'  H*'FLOTTANT'  RESI*'CHPOINT'
   5 : preced*'TABLE';                        
   6 : * correction de la vitesse en cas d'appui unilateraux en cas de dynamique       
   7 : * ROP   matrice (K + 4M/h2)                                                     
   8 : * M     matrice masse                                                           
   9 : * V vitesse calculee par l'algorithme                                           
  10 : * DX increment de dplacement au cours du pas 
  11 : * depini deplacement initial du pas 
  12 : * h pas de temps ( on pourrait s'en passer)
  13 : * RESI  second memebre initial du début du pas ( contiebnt les jeux initiaux)   
  14 : *   en sortie la nouvelle vitesse                                               
  15 : *
  16 :   MTA= 'EXTRAIRE' ROP   'CONTACT'; 
  17 :            MDI = 'DIME' MTA;                                                    
  18 :           VAUX = V;                                                             
  19 :           'SI' ( 'EGA' MDI 0) ;  quitter VITEUNIL; finsi;    
  20 : 
  21 :   BLOT = MTA.7 ;
  22 :   mlx = extr blot maillage ; 
  23 :  bloi = extra mta . 1  'RIGI' mult ;
  24 : 
  25 :   blo = bloi  et blot; 
  26 : 
  27 : newlam=('EXCO' dx 'LX' 'NOID' ) 'EXTR' 'MAILLAGE';
  28 : si ( newlam ega 0) ; 
  29 : * newlam est vide ((alors que oldlam ne l'est pas)) 
  30 :    quitter VITEUNIL;
  31 : sinon;
  32 :    suppo = newlam; 
  33 : finsi;
  34 : si ( nbel mlx ega 0) quitter VITEUNIL; 
  35 : sinon;
  36 : suppo = suppo inte ( chang poi1 mlx);
  37 : finsi;
  38 : *si imppp; mess ' nouveau suppo '; list suppo;fins;
  39 : fflx = (exco resi 'FLX' 'NOID' 'FLX')  redu suppo;
  40 : 
  41 : llx = (exco (dx * -1.)'LX' 'NOID' 'LX') redu suppo ;
  42 : *si imppp; mess 'fflx '; list fflx; mess ' llx'; list llx; finsi;
  43 : enic = fflx llx * ( MOTS 'FLX' ) ( MOTS 'LX') ( MOTS 'SCAL');
  44 : vgen = blo * V ;vgenflx = ( vgen exco 'FLX' 'FLX' ) redu suppo;
  45 : MBLO = M et bloi;
  46 : eninul = point enic  egale 0.;
  47 : *si imppp ; mess ' eninul ' ; list eninul;finsi;
  48 : si (( nbno eninul )  neg 0) ;
  49 :   si (( nbno eninul ) ega ( nbno suppo)) ; quitter VITEUNIL;finsi;
  50 :   suppo = diff suppo eninul;
  51 :   enic = redu enic suppo;
  52 :   llx = llx redu suppo;
  53 : finsi;
  54 : *  test si la correction est necessaire
  55 :   enicr = (resu enic) maxi abs;
  56 :   encin = xtmx v m;
  57 :   si (enicr < (encin * 1d-11)); quitter VITEUNIL; finsi;
  58 : 
  59 : li0 = manu chpo suppo 1 'SCAL' -0.2 nature diffus;
  60 : li20=manu chpo suppo 1 'SCAL' -20. nature diffus;
  61 : li1= manu chpo suppo 1 'SCAL' 1. nature diffus;
  62 : enic2= enic / 2.;
  63 : vgenflx = ( vgen exco 'FLX' 'FLX' ) redu suppo;
  64 : llxscal= llx  nomc SCAL;
  65 : vgenllx =(vgenflx * llxscal )NOMC 'SCAL'; 
  66 : *si imppp; mess ' vgenllx ' ; list vgenllx; finsi;
  67 : h2sur2 = h * h * 0.5; 
  68 : ite = 0;neq3= nbno suppo * 20;si ( neq3 < 500); neq3=500; finsi;
  69 : relax = 0.5;unmrelax= 0.5;plusgr=-20.;
  70 : cc = 1;
  71 : aref = maxi abs (v    enle 'LX');
  72 : *mess 'aref ' aref; list v;
  73 : repeter nfoi ;  ite = ite + 1;
  74 : 
  75 :   fsecf= llx * li0 * blo;
  76 : *mess ' fsecf ' ; list fsecf;
  77 :   rem = (resou Mblo  ( -1. * fsecf )   ) * -1. ;
  78 : *mess  ' rem'; list rem;
  79 :   cte = enic2 * li0;
  80 :   prem = vgenllx * h * li0;
  81 : remblor = (rem * blo) 'REDU' suppo;
  82 : mremblor = remblor 'EXTR' 'MAIL';
  83 : 'SI' ('EGA' ('TYPE' mremblor) 'ENTIER'); 'QUIT' VITEUNIL; 'FINSI';
  84 : 'SI' (('NBEL' mremblor) 'EGA' 0);'QUIT' VITEUNIL; 'FINSI';
  85 : az= h2sur2 * llxscal; 
  86 :   deuxi =   h2sur2 * llxscal *
  87 :  remblor 'NOMC' 'SCAL';
  88 : 
  89 :  libis= ravc deuxi prem cte;
  90 : 
  91 : *mess ' solne '  ; list solne;
  92 : si (ite > 50); solne = (solne +libis)* 0.5; 
  93 : sinon ; solne = libis ; finsi;
  94 : *si imppp; mess 'libis';   list libis;finsi;
  95 :  si ( (nbno suppo ) 'EGA' 1 ) ; 'QUIT' nfoi;finsi;
  96 :   si (ite > 1) ; aa = li0 - solne;               
  97 :          si ( aref neg 0.) ;
  98 :                cc  = (aa / aref ) maxi abs ;
  99 :           sinon;
 100 :           mess ' aref nul';
 101 :               cc = 1000.;
 102 :           finsi;
 103 : *                mess ' ite cc ' ite cc ;
 104 :               si ( cc < 1e-8 ) ;
 105 : *                 mess ' sortie de la boucle itération ' ite;
 106 :                  quitter nfoi;
 107 :              finsi;
 108 :   finsi; 
 109 :   si (( &nfoi > neq3) 'ET' (cc >EG ccold)) ;
 110 :     mess ' pas de convergence aprés ' neq3 'itérations dans VITEUNIL';
 111 :     preced . 'RATE_VITEUNIL'= VRAI; 'QUITTER' VITEUNIL;
 112 :   finsi; 
 113 : li0 = solne;
 114 : fin nfoi;
 115 : 
 116 : *mess ' solne ' ; list solne;
 117 : lr2 = ((solne *  llx  * rop  ) enlever 'FLX' ) * h;
 118 : *mess ' avant resou';
 119 : dv2 = (resou Mblo  (-1. * lr2) )* -1. ;
 120 : vauxnep= v + dv2;
 121 : *mess ' dv2 ' ; list dv2;
 122 : *mess ' vauxnep ' ; list vauxnep;
 123 : vaux = vauxnep 'ENLE' 'LX';
 124 : LISEA = MTA.6;MALI = 'MAXI' LISEA;                                 
 125 : 'SI' ( 'EGA' MALI 1 ) ;                                            
 126 :     MV =    M  * VAUX ;                                                     
 127 :     VP = 'RESOU'  ( M et blo)  'NOUNIL' MV;  
 128 :     V2 = ('ENLE' VP   'LX' )*  2.    - VAUX;
 129 :     VAux = V2;
 130 : finsi;
 131 : *nno= nbno suppo  / 2;
 132 : *mess 'Modification vitesses due aux'  nno  ' appuis unilaréraux';
 133 : * messs ' vaux   '; list resume vaux;
 134 : *vcinn=  xtmx m vaux; ; vcinanc= encin;
 135 : * mess 'ener cin avant '  vcinanc;
 136 : * mess 'ener cin apres '  vcinn;
 137 : * mess ' ener injectée par reactions ' (maxi (resu enic));
 138 : FINPROC VAUX;                                                                
 139 :  
 140 :  
 141 :  
 142 :  

© Cast3M 2003 - All rights reserved.
Disclaimer