Download dychgl.eso

Back to the list

   1 : C DYCHGL    SOURCE    CHAT      05/01/12    23:06:07     5004           
   2 :       SUBROUTINE DYCHGL(IDIM,IGP,XPALB,NLIAB,I,I0,I1,XGLIS,XFN,XFT,             
   3 :      &                  XPUS)                                                   
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   6 : *--------------------------------------------------------------------*          
   7 : *                                                                    *          
   8 : *     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *          
   9 : *     ________________________________________________               *          
  10 : *                                                                    *          
  11 : *     Calcul de la force de glissement                               *          
  12 : *                                                                    *          
  13 : *     Param}tres:                                                    *          
  14 : *                                                                    *          
  15 : * es  XPALB   Tableau contenant les param}tres de la liaison         *          
  16 : * e   NLIAB   Nombre de liaisons sur la base B                       *          
  17 : * e   I       Num{ro de la liaison                                   *          
  18 : * e   I0      Pointeur de la vitesse tangentielle dans XPALB         *          
  19 : * e   I1      Pointeur de la force tangentielle dans XPALB           *          
  20 : * e   XFN     Valeur de la force de choc suivant la normale.         *          
  21 : * e   XGLIS   Valeur du coefficient d'adh{rence                      *          
  22 : *  s  IGP     Indice de glissement au pas pr{c{dent                  *          
  23 : *  s  XFT     Module de la force de choc projet{e sur le plan tangent*          
  24 : *  s  XPUS    Valeur de la puissance d'usure instantan{e             *          
  25 : *                                                                    *          
  26 : *                                                                    *          
  27 : *     Auteur, date de cr{ation:                                      *          
  28 : *                                                                    *          
  29 : *     Bertrand BEAUFILS, le 31 mai 1990.                             *          
  30 : *                                                                    *          
  31 : *--------------------------------------------------------------------*          
  32 :       DIMENSION XPALB(NLIAB,*)                                                  
  33 :       XFT = - XGLIS * ABS(XFN)                                                  
  34 :       IGP = 1                                                                   
  35 : *                                                                               
  36 :       PSVITT = 0.D0                                                             
  37 :       DO 10 ID = 1,IDIM                                                         
  38 :           PSVITT = PSVITT + XPALB(I,I0+ID) * XPALB(I,I0+ID)                     
  39 :  10       CONTINUE                                                              
  40 : *     end do                                                                    
  41 :       VITT = SQRT(PSVITT)                                                       
  42 :       XPUS = ABS(XFN * VITT)                                                    
  43 : *                                                                               
  44 :       IF (VITT.GT.1.D-20) THEN                                                  
  45 :          DO 11 ID = 1,IDIM                                                      
  46 :             XPALB(I,I1+ID) = XFT * XPALB(I,I0+ID) / VITT                        
  47 :  11         CONTINUE                                                            
  48 : *        end do                                                                 
  49 :       ELSE                                                                      
  50 :          DO 12 ID = 1,IDIM                                                      
  51 :             XPALB(I,I1+ID) = 0.D0                                               
  52 :  12         CONTINUE                                                            
  53 : *        end do                                                                 
  54 :       ENDIF                                                                     
  55 : *                                                                               
  56 :       RETURN                                                                    
  57 :       END                                                                       
  58 :  

© Cast3M 2003 - All rights reserved.
Disclaimer