Télécharger vectp.eso

Retour à la liste

Numérotation des lignes :

  1. C VECTP SOURCE GF238795 18/02/05 21:16:21 9726
  2. subroutine vectp(aa,vp,x,n)
  3. * recherche vecteur propre associe a une valeur propre (matrice 3x3)
  4. * n : multiplicite de la valeur propre
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. dimension aa(3,3),x(9)
  8. a=aa(1,1)-vp
  9. b=aa(1,2)
  10. c=aa(1,3)
  11. d=aa(2,2)-vp
  12. e=aa(2,3)
  13. f=aa(3,3)-vp
  14. if (n.eq.1) then
  15. det3=a*d-b*b
  16. det2=a*f-c*c
  17. det1=d*f-e*e
  18. if (abs(det3).ge.abs(det1).and.abs(det3).ge.abs(det2)) then
  19.  
  20. if (abs(det3).gt.0.D0) then
  21. x(1)=(b*e-c*d)/det3
  22. x(2)=(b*c-a*e)/det3
  23. x(3)=+1
  24. else
  25. x(1)=0.D0
  26. x(2)=0.D0
  27. x(3)=+1
  28. endif
  29. elseif (abs(det1).ge.abs(det2).and.abs(det1).ge.abs(det3)) then
  30. if (abs(det1).gt.0.D0) then
  31. x(1)=+1
  32. x(2)=(c*e-b*f)/det1
  33. x(3)=(b*e-c*d)/det1
  34. else
  35. x(1)=+1
  36. x(2)=0.D0
  37. x(3)=0.D0
  38. endif
  39.  
  40. elseif (abs(det2).ge.abs(det1).and.abs(det2).ge.abs(det3)) then
  41. if (abs(det2).gt.0.D0) then
  42. x(1)=(c*e-b*f)/det2
  43. x(2)=+1
  44. x(3)=(b*c-a*e)/det2
  45. else
  46. x(1)=0.D0
  47. x(2)=+1
  48. x(3)=0.D0
  49. endif
  50. endif
  51. xn=sqrt(x(1)**2+x(2)**2+x(3)**2)
  52. x(1)=x(1)/xn
  53. x(2)=x(2)/xn
  54. x(3)=x(3)/xn
  55. elseif (n.eq.2) then
  56. if (abs(a).ge.abs(d).and.abs(a).ge.abs(f)) then
  57. x(1)=-b/a
  58. x(2)=1
  59. x(3)=0
  60. x(4)=-c/a
  61. x(5)=0
  62. x(6)=1
  63. elseif (abs(d).ge.abs(a).and.abs(d).ge.abs(f)) then
  64. x(1)=1
  65. x(2)=-b/d
  66. x(3)=0
  67. x(4)=0
  68. x(5)=-e/d
  69. x(6)=1
  70. elseif (abs(f).ge.abs(a).and.abs(f).ge.abs(d)) then
  71. x(1)=1
  72. x(2)=0
  73. x(3)=-c/f
  74. x(4)=0
  75. x(5)=1
  76. x(6)=-e/f
  77. endif
  78. xn=sqrt(x(1)**2+x(2)**2+x(3)**2)
  79. x(1)=x(1)/xn
  80. x(2)=x(2)/xn
  81. x(3)=x(3)/xn
  82. xsc=x(1)*x(4)+x(2)*x(5)+x(3)*x(6)
  83. x(4)=x(4)-xsc*x(1)
  84. x(5)=x(5)-xsc*x(2)
  85. x(6)=x(6)-xsc*x(3)
  86. xn=sqrt(x(4)**2+x(5)**2+x(6)**2)
  87. x(4)=x(4)/xn
  88. x(5)=x(5)/xn
  89. x(6)=x(6)/xn
  90. elseif (n.eq.3) then
  91. x(1)=1
  92. x(2)=0
  93. x(3)=0
  94. x(4)=0
  95. x(5)=1
  96. x(6)=0
  97. x(7)=0
  98. x(8)=0
  99. x(9)=1
  100. endif
  101. end
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  

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