Download 33.eso

Back to the list

   1 : C RESO33    SOURCE    CHAT      05/01/13    02:52:56     5004           
   2 :       subroutine reso33(a,b,nmax,idi,kerre)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8( A-H,O-Z)
   5 :       dimension a(nmax,*),b(*)
   6 :       kerre=0
   7 :       if(idi.eq.2) then
   8 :         det = a(1,1) *a(2,2) - a(1,2)*a(2,1)
   9 :         if( det .eq.0.d0) then
  10 :             kerre=6
  11 :             return
  12 :         endif
  13 :         aa = b(1)*a(2,2) - a(1,2)*b(2)
  14 :         bb =  a(1,1) *b(2) - b(1)*a(2,1)
  15 :         b(1) = aa/ det
  16 :         b(2)= bb/det
  17 :         return
  18 :       elseif ( idi.eq.3) then
  19 :         det = a(1,1) *(a(2,2) *a(3,3) -  a(3,2)*a(2,3))
  20 :      $       + a(2,1)* (a(3,2)*a(1,3) -a(3,3)*a(1,2))
  21 :      $       + a(3,1)*(a(1,2)*a(2,3) - a(2,2)*a(1,3))
  22 :         if( det .eq.0.d0) then
  23 :             kerre=6
  24 :             return
  25 :         endif
  26 :         a1=  b(1) *(a(2,2) *a(3,3) -  a(3,2)*a(2,3))
  27 :      $       + b(2)* (a(3,2)*a(1,3) -a(3,3)*a(1,2))
  28 :      $       + b(3)*(a(1,2)*a(2,3) - a(2,2)*a(1,3))
  29 :         a2 = a(1,1) *(b(2) *a(3,3) -  b(3)*a(2,3))
  30 :      $       + a(2,1)* (b(3)*a(1,3) -a(3,3)*b(1))
  31 :      $       + a(3,1)*(b(1)*a(2,3) - b(2)*a(1,3))
  32 :         a3 = a(1,1) *(a(2,2) *b(3) -  a(3,2)*b(2))
  33 :      $       + a(2,1)* (a(3,2)*b(1) -b(3)*a(1,2))
  34 :      $       + a(3,1)*(a(1,2)*b(2) - a(2,2)*b(1))
  35 :          b(1) = a1 / det
  36 :          b(2) = a2 / det
  37 :          b(3) = a3 / det
  38 :         return
  39 :       else
  40 :          kerre=5
  41 :       endif
  42 :       return
  43 :       end
  44 :  
  45 :  

© Cast3M 2003 - All rights reserved.
Disclaimer