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