Télécharger la plaquette Cast3M


fr en

Télécharger tuypas.eso

Retour à la liste

Numérotation des lignes : 

tuypas

  1. C TUYPAS    SOURCE    CB215821  26/10/26    21:16:25     12682          
  2.       SUBROUTINE TUYPAS(XE,XL,WORK,P,KERRE)
  3. C-----------------------------------------------------------------------
  4. C  ROUTINE DE CALCUL DE LA MATRICE DE PASSAGE P DES AXES LOCAUX AUX AXES
  5. C  GLOBAUX :       DEPLOC= P * DEPGLO
  6. C
  7. C  ENTREE
  8. C         XE     COORDONNEES DES 2 NOEUDS
  9. C         VECT   VECTEUR DEFINISSANT LE REPERE LOCAL DE LA POUTRE
  10. C
  11. C  SORTIE
  12. C         P      MATRICE DE CHANGEMENT DE BASE
  13. C         KERRE  = 0 SI PAS DE PB
  14. C                = 1 SI POINTS CONFONDUS
  15. C                = 2 SI LE VECTEUR LOCAL EST COLINEAIRE A L'ELEMENT
  16. C
  17. C-----------------------------------------------------------------------
  18.       IMPLICIT INTEGER(I-N)
  19.       IMPLICIT REAL*8(A-H,O-Z)
  20.       DIMENSION XE(3,*),P(3,*),VECT(3),A(3),WORK(*)
  21. C
  22.       KERRE=0
  23.       A(1)=XE(1,2)-XE(1,1)
  24.       A(2)=XE(2,2)-XE(2,1)
  25.       A(3)=XE(3,2)-XE(3,1)
  26.       RL=1.D0/XL
  27. C
  28. C-----------------------------------------------------------------------
  29. C   ON CHOISIT DE DETERMINER ICI LE VECTEUR DEFINISSANT LE
  30. C   REPERE LOCAL DE LA POUTRE SI IL N A PAS ETE DONNE PAR L UTILISATEUR
  31. C-----------------------------------------------------------------------
  32. C
  33.       IDEF=0
  34.       VECT(1)=WORK(5)
  35.       VECT(2)=WORK(6)
  36.       VECT(3)=WORK(7)
  37.       IF(VECT(1).NE.0..OR.VECT(2).NE.0..OR.VECT(3).NE.0.) GO TO 10
  38. C
  39. C  DEFINITION DU VECTEUR LOCAL PAR DEFAUT   ( NON NORME )
  40. C
  41.       VECT(1)=-A(2)*RL
  42.       VECT(2)=A(1)*RL
  43.       VECT(3)=0.D00
  44.       IDEF=1
  45.   10  CONTINUE
  46.       DO 22 I=1,3
  47.       P(1,I)=A(I)*RL
  48.   22  CONTINUE
  49.       RLP=0.
  50.       DO 1 I=1,3
  51.       RLP=RLP+VECT(I)**2
  52.    1  CONTINUE
  53.       RLP= SQRT(RLP)
  54. C
  55. C  TEST DE COLINEARITE
  56. C
  57.       PROD=0.D00
  58.       DO 4 I=1,3
  59.       PROD=PROD+VECT(I)*P(1,I)
  60.    4  CONTINUE
  61.       IF(ABS(PROD).LT.0.99D00*RLP) GO TO 5
  62.       IF(IDEF.EQ.0) GOTO 41
  63.       VECT(1)= 0.D0
  64.       VECT(2)= -A(3)*RL
  65.       VECT(3)=  A(2)*RL
  66.       GOTO 5
  67.   41  CONTINUE
  68.       KERRE=2
  69.       RETURN
  70. C
  71. C  ORTHOGONALISATION ET REMPLISSAGE DE LA MATRICE P
  72. C
  73.   5   CONTINUE
  74.       RLP=0.D00
  75.       DO 6 I=1,3
  76.       VECT(I)=VECT(I)-PROD*P(1,I)
  77.       RLP=RLP+VECT(I)**2
  78.   6   CONTINUE
  79.       RLP=1.D00/SQRT(RLP)
  80.       DO 2 I=1,3
  81.       P(2,I)=VECT(I)*RLP
  82.    2  CONTINUE
  83.       P(3,1)= P(1,2)*P(2,3)- P(2,2)*P(1,3)
  84.       P(3,2)=P(1,3)*P(2,1)-P(1,1)*P(2,3)
  85.       P(3,3)= P(1,1)*P(2,2)-P(1,2)*P(2,1)
  86.       RETURN
  87.       END
  88.  
  89.  
  90.  

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