1 : C JACOB3 SOURCE FANDEUR 12/03/15 21:26:30 7312 2 : subroutine jacob3(a,idim,d,x) 3 : C====================================================================== 4 : C OBJET 5 : C ----- 6 : C DIAGONALISATION D UNE MATRICE 3*3 SYMETRIQUE 7 : C 8 : C ENTREES 9 : C ------- 10 : C A(3,3) = MATRICE SYMETRIQUE 11 : C IDIM = 2 OU 3 SI 2 ON NE S OCCUPE QUE DE A(2,2) 12 : C SI 3 DE A(3,3) 13 : C SORTIES 14 : C ------- 15 : C D(3) = VALEURS PROPRES ORDONNEES D(1)>D(2)>D(3) 16 : C 17 : C S(3,3) = VECTEURS PROPRES ( S(IP,2) EST LE VECTEUR 18 : C ASSOCIE A D(2) ) 19 : C 20 : C=============================================================== 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8 (A-H,O-Z) 23 : dimension a(3,3),d(3),x(3,3) 24 : 25 : if (idim.ne.3) then 25 : call jacob2(a,d,x) 26 : return 27 : endif 28 : 29 : c2=-a(1,1)-a(2,2)-a(3,3) 30 : c1= (a(1,1)*a(2,2)+a(2,2)*a(3,3)+a(3,3)*a(1,1)) 31 : & - a(1,3)**2 - a(1,2)**2 - a(2,3)**2 32 : c0=-2.*a(1,2)*a(1,3)*a(2,3) + a(1,1)*a(2,3)**2 33 : & + a(2,2)*a(1,3)**2 + a(3,3)*a(1,2)**2 34 : & - a(1,1)*a(2,2)*a(3,3) 34 : call degre3(c0,c1,c2,d1,XI1,d2,XI2,d3,XI3) 35 : d(1)=max(d1,d2,d3) 36 : d(3)=min(d1,d2,d3) 37 : d(2)=d1+d2+d3-(d(1)+d(3)) 38 : deps=d(1)*1.e-6 39 : if (d(1)-d(2).le.deps) then 40 : * valeur propre double 41 : if (d(2)-d(3).le.deps) then 42 : * valeur propre triple 42 : call vectp(a,d(1),x(1,1),3) 43 : else 43 : call vectp(a,d(1),x(1,1),2) 43 : call vectp(a,d(3),x(1,3),1) 44 : endif 45 : else 46 : deps=d(2)*1.e-6 47 : if (d(2)-d(3).le.deps) then 48 : * valeur propre double 48 : call vectp(a,d(1),x(1,1),1) 48 : call vectp(a,d(2),x(1,2),2) 49 : else 50 : * cas normal 50 : call vectp(a,d(1),x(1,1),1) 50 : call vectp(a,d(2),x(1,2),1) 50 : call vectp(a,d(3),x(1,3),1) 51 : endif 52 : endif 53 : 54 : return 55 : end 56 : 57 :
© Cast3M 2003 - All rights reserved.
Disclaimer