C POUREA    SOURCE    CHAT      05/01/13    02:19:34     5004           
      SUBROUTINE POUREA(XX,YY,ZZ,XDDL,WORK,P,VECT,KERRE)                        
C-----------------------------------------------------------------------        
C  ROUTINE DE REACTUALISATION DU VECTEUR VECT                                   
C-----------------------------------------------------------------------        
C  ENTREE                                                                       
C         XX,YY,ZZ  LES COORDONNEES DES 2 NOEUDS                                
C         XDDL      LES DEPLACEMENTS EN AXES GLOBAUX                            
C         WORK      TABLEAU DE TRAVAIL                                          
C         P         MATRICE DE PASSAGE                                          
C                                                                               
C  SORTIE                                                                       
C         VECT      NOUVEAU VECTEUR                                             
C         KERRE     INDICE D'ERREUR  (  0 SI TOUT EST OK )                      
C                                                                               
C-----------------------------------------------------------------------        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      DIMENSION WORK(*),P(3,*),VECT(*),VN(3),VNP(3),XDDL(*)                     
      DIMENSION OMEG(3),PP(3,3),XX(*),YY(*),ZZ(*)                               
C                                                                               
C  CALCUL DE VNP                                                                
C                                                                               
      VNP(1)=XX(2)+XDDL(7)-XX(1)-XDDL(1)                                        
      VNP(2)=YY(2)+XDDL(8)-YY(1)-XDDL(2)                                        
      VNP(3)=ZZ(2)+XDDL(9)-ZZ(1)-XDDL(3)                                        
      RLVNP=SQRT(VNP(1)*VNP(1)+VNP(2)*VNP(2)+VNP(3)*VNP(3))                     
      IF(RLVNP.EQ.0.D0) THEN                                                    
      KERRE=1                                                                   
      RETURN                                                                    
      ENDIF                                                                     
      DO 1 I=1,3                                                                
      VNP(I)=VNP(I)/RLVNP                                                       
  1   OMEG(I)=VNP(I)                                                            
C                                                                               
C  CALCUL DE LA MATRICE DE PASSAGE                                              
C                                                                               
      CALL POUPAS(XX,YY,ZZ,OMEG,PP,KERRE)                                       
      IOMEG=KERRE                                                               
      KERRE=0                                                                   
C                                                                               
C  PASSAGE DES DEPLACEMENTS EN AXES LOCAUX - ROTATION PSI                       
C                                                                               
      CALL POUVEC(XDDL,WORK,P,1)                                                
      PSI=(WORK(4)+WORK(10))*0.5D0                                              
      C2=PP(1,1)*VNP(1)+PP(1,2)*VNP(2)+PP(1,3)*VNP(3)                           
      S2=PP(2,1)*VNP(1)+PP(2,2)*VNP(2)+PP(2,3)*VNP(3)                           
      C3=COS(PSI)                                                               
      S3=SIN(PSI)                                                               
C                                                                               
C  REACTUALISATION DU VECTEUR                                                   
C                                                                               
      IF(IOMEG.EQ.0) THEN                                                       
      DO 2 I=1,3                                                                
      VN(I)=0.D0                                                                
      DO 2 J=1,3                                                                
   2  VN(I)=VN(I)+PP(I,J)*VECT(J)                                               
      OMEG(1)=C2*VN(1)-S2*C3*VN(2)+S2*S3*VN(3)                                  
      OMEG(2)=S2*VN(1)+C2*C3*VN(2)-C2*S3*VN(3)                                  
      OMEG(3)=S3*VN(2)+C3*VN(3)                                                 
      DO 3 I=1,3                                                                
      VECT(I)=0.D0                                                              
      DO 3 J=1,3                                                                
   3  VECT(I)=VECT(I)+PP(J,I)*OMEG(J)                                           
      ELSE                                                                      
      VN(1)=0.D0                                                                
      VN(2)=C3                                                                  
      VN(3)=S3                                                                  
      DO 6 I=1,3                                                                
      VECT(I)=0.D0                                                              
      DO 6 J=1,3                                                                
   6  VECT(I)=VECT(I)+P(J,I)*VN(J)                                              
      ENDIF                                                                     
      RETURN                                                                    
      END