Esope source files

   1 : C VECTP     SOURCE    CHAT      05/01/13    04:05:19     5004           
   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 :        x(1)=(b*e-c*d)/det3
  20 :        x(2)=(b*c-a*e)/det3
  21 :        x(3)=+1
  22 :       elseif (abs(det1).ge.abs(det2).and.abs(det1).ge.abs(det3)) then
  23 :        x(1)=+1
  24 :        x(2)=(c*e-b*f)/det1
  25 :        x(3)=(b*e-c*d)/det1
  26 :       elseif (abs(det2).ge.abs(det1).and.abs(det2).ge.abs(det3)) then
  27 :        x(1)=(c*e-b*f)/det2
  28 :        x(2)=+1
  29 :        x(3)=(b*c-a*e)/det2
  30 :       endif
  31 :       xn=sqrt(x(1)**2+x(2)**2+x(3)**2)
  32 :       x(1)=x(1)/xn
  33 :       x(2)=x(2)/xn
  34 :       x(3)=x(3)/xn
  35 :       elseif (n.eq.2) then
  36 :        if (abs(a).ge.abs(d).and.abs(a).ge.abs(f)) then
  37 :        x(1)=-b/a
  38 :        x(2)=1
  39 :        x(3)=0
  40 :        x(4)=-c/a
  41 :        x(5)=0
  42 :        x(6)=1
  43 :        elseif (abs(d).ge.abs(a).and.abs(d).ge.abs(f)) then
  44 :        x(1)=1
  45 :        x(2)=-b/d
  46 :        x(3)=0
  47 :        x(4)=0
  48 :        x(5)=-e/d
  49 :        x(6)=1
  50 :        elseif (abs(f).ge.abs(a).and.abs(f).ge.abs(d)) then
  51 :        x(1)=1
  52 :        x(2)=0
  53 :        x(3)=-c/f
  54 :        x(4)=0
  55 :        x(5)=1
  56 :        x(6)=-e/f
  57 :        endif
  58 :        xn=sqrt(x(1)**2+x(2)**2+x(3)**2)
  59 :        x(1)=x(1)/xn
  60 :        x(2)=x(2)/xn
  61 :        x(3)=x(3)/xn
  62 :        xsc=x(1)*x(4)+x(2)*x(5)+x(3)*x(6)
  63 :        x(4)=x(4)-xsc*x(1)
  64 :        x(5)=x(5)-xsc*x(2)
  65 :        x(6)=x(6)-xsc*x(3)
  66 :        xn=sqrt(x(4)**2+x(5)**2+x(6)**2)
  67 :        x(4)=x(4)/xn
  68 :        x(5)=x(5)/xn
  69 :        x(6)=x(6)/xn
  70 :       elseif (n.eq.3) then
  71 :        x(1)=1
  72 :        x(2)=0
  73 :        x(3)=0
  74 :        x(4)=0
  75 :        x(5)=1
  76 :        x(6)=0
  77 :        x(7)=0
  78 :        x(8)=0
  79 :        x(9)=1
  80 :       endif
  81 :       end
  82 : 
  83 : 
  84 : 
  85 : 
  86 : 
  87 : 
  88 : 
  89 : 
  90 :  
  91 :