Esope source files

   1 : C TUYPAS    SOURCE    CHAT      05/01/13    03:57:19     5004           
   2 :       SUBROUTINE TUYPAS(XE,XL,WORK,P,KERRE)
   3 : C-----------------------------------------------------------------------        
   4 : C  ROUTINE DE CALCUL DE LA MATRICE DE PASSAGE P DES AXES LOCAUX AUX AXES        
   5 : C  GLOBAUX :       DEPLOC= P * DEPGLO                                           
   6 : C                                                                               
   7 : C  ENTREE                                                                       
   8 : C         XE     COORDONNEES DES 2 NOEUDS
   9 : C         VECT   VECTEUR DEFINISSANT LE REPERE LOCAL DE LA POUTRE               
  10 : C                                                                               
  11 : C  SORTIE                                                                       
  12 : C         P      MATRICE DE CHANGEMENT DE BASE                                  
  13 : C         KERRE  = 0 SI PAS DE PB                                               
  14 : C                = 1 SI POINTS CONFONDUS                                        
  15 : C                = 2 SI LE VECTEUR LOCAL EST COLINEAIRE A L'ELEMENT             
  16 : C                                                                               
  17 : C-----------------------------------------------------------------------        
  18 :       IMPLICIT INTEGER(I-N)
  19 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  20 :       DIMENSION XE(3,*),P(3,*),VECT(3),A(3),WORK(*)
  21 : C                                                                               
  22 :       KERRE=0                                                                   
  23 :       A(1)=XE(1,2)-XE(1,1)
  24 :       A(2)=XE(2,2)-XE(2,1)
  25 :       A(3)=XE(3,2)-XE(3,1)
  26 :       RL=1.D0/XL
  27 : C                                                                               
  28 : C-----------------------------------------------------------------------        
  29 : C   ON CHOISIT DE DETERMINER ICI LE VECTEUR DEFINISSANT LE                      
  30 : C   REPERE LOCAL DE LA POUTRE SI IL N A PAS ETE DONNE PAR L UTILISATEUR         
  31 : C-----------------------------------------------------------------------        
  32 : C                                                                               
  33 :       IDEF=0                                                                    
  34 :       VECT(1)=WORK(5)
  35 :       VECT(2)=WORK(6)
  36 :       VECT(3)=WORK(7)
  37 :       IF(VECT(1).NE.0..OR.VECT(2).NE.0..OR.VECT(3).NE.0.) GO TO 10              
  38 : C                                                                               
  39 : C  DEFINITION DU VECTEUR LOCAL PAR DEFAUT   ( NON NORME )                       
  40 : C                                                                               
  41 :       VECT(1)=-A(2)*RL                                                          
  42 :       VECT(2)=A(1)*RL                                                           
  43 :       VECT(3)=0.D00                                                             
  44 :       IDEF=1                                                                    
  45 :   10  CONTINUE                                                                  
  46 :       DO 22 I=1,3                                                               
  47 :   22  P(1,I)=A(I)*RL                                                            
  48 :       RLP=0.                                                                    
  49 :       DO 1 I=1,3                                                                
  50 :    1  RLP=RLP+VECT(I)**2                                                        
  51 :       RLP= SQRT(RLP)                                                            
  52 : C                                                                               
  53 : C  TEST DE COLINEARITE                                                          
  54 : C                                                                               
  55 :       PROD=0.D00                                                                
  56 :       DO 4 I=1,3                                                                
  57 :    4  PROD=PROD+VECT(I)*P(1,I)                                                  
  58 :       IF(ABS(PROD).LT.0.99D00*RLP) GO TO 5                                      
  59 :       IF(IDEF.EQ.0) GOTO 41                                                     
  60 :       VECT(1)= 0.D0                                                             
  61 :       VECT(2)= -A(3)*RL                                                         
  62 :       VECT(3)=  A(2)*RL                                                         
  63 :       GOTO 5                                                                    
  64 :   41  CONTINUE                                                                  
  65 :       KERRE=2                                                                   
  66 :       RETURN                                                                    
  67 : C                                                                               
  68 : C  ORTHOGONALISATION ET REMPLISSAGE DE LA MATRICE P                             
  69 : C                                                                               
  70 :   5   CONTINUE                                                                  
  71 :       RLP=0.D00                                                                 
  72 :       DO 6 I=1,3                                                                
  73 :       VECT(I)=VECT(I)-PROD*P(1,I)                                               
  74 :   6   RLP=RLP+VECT(I)**2                                                        
  75 :       RLP=1.D00/SQRT(RLP)                                                       
  76 :       DO 2 I=1,3                                                                
  77 :    2  P(2,I)=VECT(I)*RLP                                                        
  78 :       P(3,1)= P(1,2)*P(2,3)- P(2,2)*P(1,3)                                      
  79 :       P(3,2)=P(1,3)*P(2,1)-P(1,1)*P(2,3)                                        
  80 :       P(3,3)= P(1,1)*P(2,2)-P(1,2)*P(2,1)                                       
  81 :       RETURN                                                                    
  82 :       END                                                                       
  83 :