Numérotation des lignes :

poupas
C POUPAS    SOURCE    CHAT      05/01/13    02:19:29     5004      SUBROUTINE POUPAS(XE,YE,ZE,VECT,P,KERRE)C-----------------------------------------------------------------------C  ROUTINE DE CALCUL DE LA MATRICE DE PASSAGE P DES AXES LOCAUX AUX AXESC  GLOBAUX :       DEPLOC= P * DEPGLOCC  ENTREEC         XE YE ZE  COORDONNEES DES 2 NOEUDSC         VECT   VECTEUR DEFINISSANT LE REPERE LOCAL DE LA POUTRECC  SORTIEC         P      MATRICE DE CHANGEMENT DE BASEC         KERRE  = 0 SI PAS DE PBC                = 1 SI POINTS CONFONDUSC                = 2 SI LE VECTEUR LOCAL EST COLINEAIRE A L'ELEMENTCC-----------------------------------------------------------------------      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8(A-H,O-Z)      DIMENSION XE(*),YE(*),ZE(*),P(3,*),VECT(*),A(3)C      KERRE=0      A(1)=XE(2)-XE(1)      A(2)=YE(2)-YE(1)      A(3)=ZE(2)-ZE(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/XLCC-----------------------------------------------------------------------C   ON CHOISIT DE DETERMINER ICI LE VECTEUR DEFINISSANT LEC   REPERE LOCAL DE LA POUTRE SI IL N A PAS ETE DONNE PAR L UTILISATEURC-----------------------------------------------------------------------C      IDEF=0      IF(VECT(1).NE.0..OR.VECT(2).NE.0..OR.VECT(3).NE.0.) GO TO 10CC  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)CC  TEST DE COLINEARITEC      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      RETURNCC  ORTHOGONALISATION ET REMPLISSAGE DE LA MATRICE PC  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  

© Cast3M 2003 - Tous droits réservés.
Mentions légales