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