Télécharger la plaquette Cast3M


fr en

Télécharger poupas.eso

Retour à la liste

Numérotation des lignes : 

poupas

  1. C POUPAS    SOURCE    CHAT      05/01/13    02:19:29     5004
  2.       SUBROUTINE POUPAS(XE,YE,ZE,VECT,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 YE ZE  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(*),YE(*),ZE(*),P(3,*),VECT(*),A(3)
  21. C
  22.       KERRE=0
  23.       A(1)=XE(2)-XE(1)
  24.       A(2)=YE(2)-YE(1)
  25.       A(3)=ZE(2)-ZE(1)
  26.       XL=SQRT(A(1)**2+A(2)**2+A(3)**2)
  27.       IF(XL.EQ.0.D0) THEN
  28.       KERRE=1
  29.       RETURN
  30.       ENDIF
  31.       RL=1.D00/XL
  32. C
  33. C-----------------------------------------------------------------------
  34. C   ON CHOISIT DE DETERMINER ICI LE VECTEUR DEFINISSANT LE
  35. C   REPERE LOCAL DE LA POUTRE SI IL N A PAS ETE DONNE PAR L UTILISATEUR
  36. C-----------------------------------------------------------------------
  37. C
  38.       IDEF=0
  39.       IF(VECT(1).NE.0..OR.VECT(2).NE.0..OR.VECT(3).NE.0.) GO TO 10
  40. C
  41. C  DEFINITION DU VECTEUR LOCAL PAR DEFAUT   ( NON NORME )
  42. C
  43.       VECT(1)=-A(2)*RL
  44.       VECT(2)=A(1)*RL
  45.       VECT(3)=0.D00
  46.       IDEF=1
  47.   10  CONTINUE
  48.       DO 22 I=1,3
  49.   22  P(1,I)=A(I)*RL
  50.       RLP=0.
  51.       DO 1 I=1,3
  52.    1  RLP=RLP+VECT(I)**2
  53.       RLP= SQRT(RLP)
  54. C
  55. C  TEST DE COLINEARITE
  56. C
  57.       PROD=0.D00
  58.       DO 4 I=1,3
  59.    4  PROD=PROD+VECT(I)*P(1,I)
  60.       IF(ABS(PROD).LT.0.99D00*RLP) GO TO 5
  61.       IF(IDEF.EQ.0) GOTO 41
  62.       VECT(1)= 0.D0
  63.       VECT(2)= -A(3)*RL
  64.       VECT(3)=  A(2)*RL
  65.       GOTO 5
  66.   41  CONTINUE
  67.       KERRE=2
  68.       RETURN
  69. C
  70. C  ORTHOGONALISATION ET REMPLISSAGE DE LA MATRICE P
  71. C
  72.   5   CONTINUE
  73.       RLP=0.D00
  74.       DO 6 I=1,3
  75.       VECT(I)=VECT(I)-PROD*P(1,I)
  76.   6   RLP=RLP+VECT(I)**2
  77.       RLP=1.D00/SQRT(RLP)
  78.       DO 2 I=1,3
  79.    2  P(2,I)=VECT(I)*RLP
  80.       P(3,1)= P(1,2)*P(2,3)- P(2,2)*P(1,3)
  81.       P(3,2)=P(1,3)*P(2,1)-P(1,1)*P(2,3)
  82.       P(3,3)= P(1,1)*P(2,2)-P(1,2)*P(2,1)
  83.       RETURN
  84.       END
  85.  
  86.  

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