Numérotation des lignes :

C PDIRE3    SOURCE    CHAT      05/01/13    02:11:26     5004c---------------------------------------------------------------------c      SUBROUTINE PDIRE3 (S, XL, V)cc=====================================================================c                                                                    =c   This routine computes the eigenvectors.                          =c                                                                    =c    Input :     xl  (3)   eigenvalues                               =c                s   (6)   original matrix                           =c    Output:     v (3,3)   eigenvectors (normalised)                 =c                                                                    =c    Note:   s  = (Sxx, Syy, Szz, Sxy, Sxz, Syz)                     =c            xl = (S11, S22, S33)                                    =c                                                                    =c=====================================================================      IMPLICIT INTEGER(I-N)      real*8    s (6), xl (3), v (3,3)c      real*8    toler, comp, compi, comp2, a1, a2, a3, dot, xnc      parameter (toler = 1.0 d-07)c      comp2 = xl (1)**2 + xl (2)**2 + xl (3)**2      compi = 1.0 d0 / sqrt(comp2)c      a1 = abs ((xl(2)-xl(3))*compi)      a2 = abs ((xl(1)-xl(3))*compi)      a3 = abs ((xl(1)-xl(2))*compi)c=====----------------------------------------------------------------c  case-a: three equal eigenvalues                                   |c=====----------------------------------------------------------------      if (a1 .lt. toler .and. a2 .lt. toler)  then          v (1,1) = 1.0 d0          v (2,2) = 1.0 d0          v (3,3) = 1.0 d0          v (1,2) = 0.0 d0          v (1,3) = 0.0 d0          v (2,1) = 0.0 d0          v (2,3) = 0.0 d0          v (3,1) = 0.0 d0          v (3,2) = 0.0 d0          return      end ifc=====----------------------------------------------------------------c  case-b: two equal eigenvalues                                     |c=====----------------------------------------------------------------      if (a1 .lt. toler)  then          call pvecto (s, xl(1), v(1,1), comp2)          call vecbas (v(1,1), v(1,2), v(1,3))          return      end if      if (a2 .lt. toler)  then          call pvecto (s, xl(2), v(1,2), comp2)          call vecbas (v(1,2), v(1,3), v(1,1))          return      end if      if (a3 .lt. toler)  then          call pvecto (s, xl (3), v(1,3), comp2)          call vecbas (v(1,3), v(1,1), v(1,2))          return      end ifc=====----------------------------------------------------------------c  case-c: three different eigenvalues                               |c=====----------------------------------------------------------------      call pvecto (s, xl(1), v(1,1), comp2)      call pvecto (s, xl(2), v(1,2), comp2)c      dot = v (1,1) * v (1,2) + v (2,1) * v (2,2) + v (3,1) * v (3,2)c      v (1,2) = v (1,2) - dot * v (1,1)      v (2,2) = v (2,2) - dot * v (2,1)      v (3,2) = v (3,2) - dot * v (3,1)c      xn = 1.0 d0 / SQRT (v(1,2)**2+v(2,2)**2+v(3,2)**2)c      v (1,2) = v (1,2) * xn      v (2,2) = v (2,2) * xn      v (3,2) = v (3,2) * xn      v (1,3) = v (2,1) * v (3,2) - v (3,1) * v (2,2)      v (2,3) = v (3,1) * v (1,2) - v (1,1) * v (3,2)      v (3,3) = v (1,1) * v (2,2) - v (2,1) * v (1,2)c      return      end

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