C JACOBA    SOURCE    CMAU      06/01/10    21:15:29     5284           
C JACOB3    SOURCE    CHAT      05/01/13    00:48:17     5004           
      subroutine jacoba(a,idim,d,x)
C====================================================================== 
C routine calquée sur jacob3.eso avec ajout de valeur absolue au moment 
C des test         
C     OBJET                                                                     
C     -----                                                                     
C     DIAGONALISATION D UNE MATRICE 3*3 SYMETRIQUE                              
C                                                                               
C     ENTREES                                                                   
C     -------                                                                   
C     A(3,3) = MATRICE SYMETRIQUE                                               
C     IDIM   = 2 OU 3  SI 2 ON NE S OCCUPE QUE DE A(2,2)                        
C                      SI 3                    DE A(3,3)                        
C     SORTIES                                                                   
C     -------                                                                   
C     D(3)   = VALEURS PROPRES ORDONNEES D(1)>D(2)>D(3)
C
C     X(3,3) = VECTEURS PROPRES ( X(IP,2) EST LE VECTEUR
C                                 ASSOCIE A D(2) )
C                                                                               
C===============================================================                
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      dimension a(3,3),d(3),x(3,3)
      if (idim.ne.3) then
        call jacob2(a,d,x)
        return
      endif
      c3=-1.e0
      c2=a(1,1)+a(2,2)+a(3,3)
      c1=-(a(1,1)*a(2,2)+a(2,2)*a(3,3)+a(3,3)*a(1,1))+
     >  a(1,3)**2+a(1,2)**2+a(2,3)**2
      c0=2*a(1,2)*a(1,3)*a(2,3)-a(1,1)*a(2,3)**2-
     >  a(2,2)*a(1,3)**2-a(3,3)*a(1,2)**2+
     >  a(1,1)*a(2,2)*a(3,3)
      c0=c0/c3
      c1=c1/c3
      c2=c2/c3
      call degre3(c0,c1,c2,d1,XI1,d2,XI2,d3,XI3)
      d(1)=max(d1,d2,d3)
      d(3)=min(d1,d2,d3)
      d(2)=d1+d2+d3-d(1)-d(3)
      deps=max(abs(d1),abs(d2),abs(d3))*1e-4
* A ttention j'ai du mettre des val abs 
* car ça ne marchait pas trop bien lorsque les
* d(1) tend vers 0+ 
* d(2) tend vers 0- 
* d(3) négatif 
* comme on avait deps tends vers 0+ 
* d(1) - d(2) = 2.*0+
* il considérait ce cas comme normal 
* alors qu'on a une valeur propre double  
*        PRINT *,'d1,d2,d3',d1,d2,d3
*        PRINT *,'d(1),d(2),d(3),deps',d(1),d(2),d(3),deps
*        PRINT *,'c0,c1,c2',c0,c1,c2
      if ((abs(d(1)-d(2))).le.deps) then
*      valeur propre double
       if ((abs(d(2)-d(3))).le.deps) then
*       valeur propre triple
        call vectp(a,d(1),x(1,1),3)
       else
        call vectp(a,d(1),x(1,1),2)
        call vectp(a,d(3),x(1,3),1)
       endif
      else
       if ((abs(d(2)-d(3))).le.deps) then

*       valeur propre double 
*        PRINT *,'JACOBA VP BOUBLE' 

        call vectp(a,d(1),x(1,1),1)
        call vectp(a,d(2),x(1,2),2)
       else
*       cas normal
*        PRINT *,'JACOBA CAS normal'  
        call vectp(a,d(1),x(1,1),1)
        call vectp(a,d(2),x(1,2),1)
        call vectp(a,d(3),x(1,3),1)
       endif
      endif
      end
*