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    CHAT      05/01/13    03:57:19     5004
  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.   22  P(1,I)=A(I)*RL
  48.       RLP=0.
  49.       DO 1 I=1,3
  50.    1  RLP=RLP+VECT(I)**2
  51.       RLP= SQRT(RLP)
  52. C
  53. C  TEST DE COLINEARITE
  54. C
  55.       PROD=0.D00
  56.       DO 4 I=1,3
  57.    4  PROD=PROD+VECT(I)*P(1,I)
  58.       IF(ABS(PROD).LT.0.99D00*RLP) GO TO 5
  59.       IF(IDEF.EQ.0) GOTO 41
  60.       VECT(1)= 0.D0
  61.       VECT(2)= -A(3)*RL
  62.       VECT(3)=  A(2)*RL
  63.       GOTO 5
  64.   41  CONTINUE
  65.       KERRE=2
  66.       RETURN
  67. C
  68. C  ORTHOGONALISATION ET REMPLISSAGE DE LA MATRICE P
  69. C
  70.   5   CONTINUE
  71.       RLP=0.D00
  72.       DO 6 I=1,3
  73.       VECT(I)=VECT(I)-PROD*P(1,I)
  74.   6   RLP=RLP+VECT(I)**2
  75.       RLP=1.D00/SQRT(RLP)
  76.       DO 2 I=1,3
  77.    2  P(2,I)=VECT(I)*RLP
  78.       P(3,1)= P(1,2)*P(2,3)- P(2,2)*P(1,3)
  79.       P(3,2)=P(1,3)*P(2,1)-P(1,1)*P(2,3)
  80.       P(3,3)= P(1,1)*P(2,2)-P(1,2)*P(2,1)
  81.       RETURN
  82.       END
  83.  
  84.  

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