C TUYPAS    SOURCE    CHAT      05/01/13    03:57:19     5004           
      SUBROUTINE TUYPAS(XE,XL,WORK,P,KERRE)
C-----------------------------------------------------------------------        
C  ROUTINE DE CALCUL DE LA MATRICE DE PASSAGE P DES AXES LOCAUX AUX AXES        
C  GLOBAUX :       DEPLOC= P * DEPGLO                                           
C                                                                               
C  ENTREE                                                                       
C         XE     COORDONNEES DES 2 NOEUDS
C         VECT   VECTEUR DEFINISSANT LE REPERE LOCAL DE LA POUTRE               
C                                                                               
C  SORTIE                                                                       
C         P      MATRICE DE CHANGEMENT DE BASE                                  
C         KERRE  = 0 SI PAS DE PB                                               
C                = 1 SI POINTS CONFONDUS                                        
C                = 2 SI LE VECTEUR LOCAL EST COLINEAIRE A L'ELEMENT             
C                                                                               
C-----------------------------------------------------------------------        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      DIMENSION XE(3,*),P(3,*),VECT(3),A(3),WORK(*)
C                                                                               
      KERRE=0                                                                   
      A(1)=XE(1,2)-XE(1,1)
      A(2)=XE(2,2)-XE(2,1)
      A(3)=XE(3,2)-XE(3,1)
      RL=1.D0/XL
C                                                                               
C-----------------------------------------------------------------------        
C   ON CHOISIT DE DETERMINER ICI LE VECTEUR DEFINISSANT LE                      
C   REPERE LOCAL DE LA POUTRE SI IL N A PAS ETE DONNE PAR L UTILISATEUR         
C-----------------------------------------------------------------------        
C                                                                               
      IDEF=0                                                                    
      VECT(1)=WORK(5)
      VECT(2)=WORK(6)
      VECT(3)=WORK(7)
      IF(VECT(1).NE.0..OR.VECT(2).NE.0..OR.VECT(3).NE.0.) GO TO 10              
C                                                                               
C  DEFINITION DU VECTEUR LOCAL PAR DEFAUT   ( NON NORME )                       
C                                                                               
      VECT(1)=-A(2)*RL                                                          
      VECT(2)=A(1)*RL                                                           
      VECT(3)=0.D00                                                             
      IDEF=1                                                                    
  10  CONTINUE                                                                  
      DO 22 I=1,3                                                               
  22  P(1,I)=A(I)*RL                                                            
      RLP=0.                                                                    
      DO 1 I=1,3                                                                
   1  RLP=RLP+VECT(I)**2                                                        
      RLP= SQRT(RLP)                                                            
C                                                                               
C  TEST DE COLINEARITE                                                          
C                                                                               
      PROD=0.D00                                                                
      DO 4 I=1,3                                                                
   4  PROD=PROD+VECT(I)*P(1,I)                                                  
      IF(ABS(PROD).LT.0.99D00*RLP) GO TO 5                                      
      IF(IDEF.EQ.0) GOTO 41                                                     
      VECT(1)= 0.D0                                                             
      VECT(2)= -A(3)*RL                                                         
      VECT(3)=  A(2)*RL                                                         
      GOTO 5                                                                    
  41  CONTINUE                                                                  
      KERRE=2                                                                   
      RETURN                                                                    
C                                                                               
C  ORTHOGONALISATION ET REMPLISSAGE DE LA MATRICE P                             
C                                                                               
  5   CONTINUE                                                                  
      RLP=0.D00                                                                 
      DO 6 I=1,3                                                                
      VECT(I)=VECT(I)-PROD*P(1,I)                                               
  6   RLP=RLP+VECT(I)**2                                                        
      RLP=1.D00/SQRT(RLP)                                                       
      DO 2 I=1,3                                                                
   2  P(2,I)=VECT(I)*RLP                                                        
      P(3,1)= P(1,2)*P(2,3)- P(2,2)*P(1,3)                                      
      P(3,2)=P(1,3)*P(2,1)-P(1,1)*P(2,3)                                        
      P(3,3)= P(1,1)*P(2,2)-P(1,2)*P(2,1)                                       
      RETURN                                                                    
      END