Télécharger vectp.eso

Retour à la liste

Numérotation des lignes :

vectp
  1. C VECTP SOURCE PV 22/04/15 13:20:15 11344
  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. -INC CCREEL
  8. dimension aa(3,3),x(*)
  9. a=aa(1,1)-vp
  10. b=aa(1,2)
  11. c=aa(1,3)
  12. d=aa(2,2)-vp
  13. e=aa(2,3)
  14. f=aa(3,3)-vp
  15. if (n.eq.1) then
  16. det1=d*f-e*e
  17. det2=a*f-c*c
  18. det3=a*d-b*b
  19. adet1=abs(det1)
  20. adet2=abs(det2)
  21. adet3=abs(det3)
  22. if (adet1.gt.xpetit) then
  23. det1i=1.d0/det1
  24. else
  25. det1i=1.d0
  26. endif
  27. if (adet2.gt.xpetit) then
  28. det2i=1.d0/det2
  29. else
  30. det2i=1.d0
  31. endif
  32. if (adet3.gt.xpetit) then
  33. det3i=1.d0/det3
  34. else
  35. det3i=1.d0
  36. endif
  37. if (adet3.ge.adet1.and.adet3.ge.adet2) then
  38. if (adet3.gt.xpetit) then
  39. x(1)=(b*e-c*d)*det3i
  40. x(2)=(b*c-a*e)*det3i
  41. else
  42. x(1)=0.D0
  43. x(2)=0.D0
  44. endif
  45. x(3)=+1.d0
  46. elseif (adet1.ge.adet2.and.adet1.ge.adet3) then
  47. if (adet1.gt.0.D0) then
  48. x(2)=(c*e-b*f)*det1i
  49. x(3)=(b*e-c*d)*det1i
  50. else
  51. x(2)=0.D0
  52. x(3)=0.D0
  53. endif
  54. x(1)=+1.d0
  55.  
  56. elseif (adet2.ge.adet1.and.adet2.ge.adet3) then
  57. if (adet2.gt.0.D0) then
  58. x(1)=(c*e-b*f)*det2i
  59. x(3)=(b*c-a*e)*det2i
  60. else
  61. x(1)=0.D0
  62. x(3)=0.D0
  63. endif
  64. x(2)=+1.d0
  65. endif
  66. xn=sqrt(x(1)**2+x(2)**2+x(3)**2)
  67. x(1)=x(1)/xn
  68. x(2)=x(2)/xn
  69. x(3)=x(3)/xn
  70. elseif (n.eq.2) then
  71. if (abs(a).ge.abs(d).and.abs(a).ge.abs(f)) then
  72. x(1)=-b/a
  73. x(2)=1
  74. x(3)=0
  75. x(4)=-c/a
  76. x(5)=0
  77. x(6)=1
  78. elseif (abs(d).ge.abs(a).and.abs(d).ge.abs(f)) then
  79. x(1)=1
  80. x(2)=-b/d
  81. x(3)=0
  82. x(4)=0
  83. x(5)=-e/d
  84. x(6)=1
  85. elseif (abs(f).ge.abs(a).and.abs(f).ge.abs(d)) then
  86. x(1)=1
  87. x(2)=0
  88. x(3)=-c/f
  89. x(4)=0
  90. x(5)=1
  91. x(6)=-e/f
  92. endif
  93. xn=sqrt(x(1)**2+x(2)**2+x(3)**2)
  94. x(1)=x(1)/xn
  95. x(2)=x(2)/xn
  96. x(3)=x(3)/xn
  97. xsc=x(1)*x(4)+x(2)*x(5)+x(3)*x(6)
  98. x(4)=x(4)-xsc*x(1)
  99. x(5)=x(5)-xsc*x(2)
  100. x(6)=x(6)-xsc*x(3)
  101. xn=sqrt(x(4)**2+x(5)**2+x(6)**2)
  102. x(4)=x(4)/xn
  103. x(5)=x(5)/xn
  104. x(6)=x(6)/xn
  105. elseif (n.eq.3) then
  106. x(1)=1
  107. x(2)=0
  108. x(3)=0
  109. x(4)=0
  110. x(5)=1
  111. x(6)=0
  112. x(7)=0
  113. x(8)=0
  114. x(9)=1
  115. endif
  116. end
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  

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