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