Sources Esope | Cast3M

pouloc
C POULOC    SOURCE    CB215821  26/10/26    21:15:56     12682          
      SUBROUTINE POULOC(XEPOU,VECT,KERRE)
C-----------------------------------------------------------------------
C        CALCUL DU VECTEUR LOCAL DE LA POUTRE PAR DEFAUT
C
C  ENTREE
C         XEPOU     COORDONNEES DES 2 NOEUDS
C  SORTIE
C         VECT   VECTEUR DEFINISSANT LE REPERE LOCAL DE LA POUTRE
C         KERRE  = 0 SI PAS DE PB
C                = 1 SI POINTS CONFONDUS
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XEPOU(3,*),P(3),VECT(*),A(3)
C
      KERRE=0
      A(1)=XEPOU(1,2)-XEPOU(1,1)
      A(2)=XEPOU(2,2)-XEPOU(2,1)
      A(3)=XEPOU(3,2)-XEPOU(3,1)
      XL=SQRT(A(1)**2+A(2)**2+A(3)**2)
      IF(XL.EQ.0.D0) THEN
      KERRE=1
      RETURN
      ENDIF
      RL=1.D00/XL
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
      DO 7 I=1,3
      P(I)=A(I)*RL
   7  CONTINUE
      RLP=0.D0
      DO 1 I=1,3
      RLP=RLP+VECT(I)**2
   1  CONTINUE
      RLP= SQRT(RLP)
C
C  TEST DE COLINEARITE
C
      PROD=0.D00
      DO 4 I=1,3
      PROD=PROD+VECT(I)*P(I)
   4  CONTINUE
      IF(ABS(PROD).LT.0.99D00*RLP) GO TO 5
      VECT(1)= 0.D0
      VECT(2)= -A(3)*RL
      VECT(3)=  A(2)*RL
C
C  ORTHOGONALISATION
C
  5   CONTINUE
      RLP=0.D00
      DO 6 I=1,3
      VECT(I)=VECT(I)-PROD*P(I)
      RLP=RLP+VECT(I)**2
  6   CONTINUE
      RLP=1.D00/SQRT(RLP)
      DO 2 I=1,3
      VECT(I)=VECT(I)*RLP
  2   CONTINUE
      RETURN
      END