.....................................................

نقل قول:::

کد فرترن روش ماتریس معکوس برای حل دستگاه معادلات جبری خطی...این کد اول تعداد معادلات یا n را میگیرد و ماتریس ضرایب n در n رو تشکیل میدهد و همچنین دو ماتریس n در 1 را تشکیل میدهد که یکی برای مجهولات و دیگری برای معلومات در طرف راست تساوی هست.بعد خط به خط ماتریس ضرایب و ماتریس معلوم را میگیرد و شروع به محاسبه ماتریس همسازه ها میکند.اول دترمینان ماتریس ضرایب را محاسبه میکنه که اگر 0 باشه یک پیام خطا نمایش میده که ماتریس معکوس پذیر نیست.اگر دترمینان 0 نباشد محاسبه کردن را ادامه میدهد.برای ماتریس همسازه ها باید با استفاده از کهاد سطر ها و ستون ها مرتب دترمینان محاسبه بشود که برای این مورد یک سابروتین نوشته شده است که این کار را میکند.سپس ترانهاده ماتریس همسازه ها را بدست می اورد و ضرب در دترمینان ماتریس ضرایب میکند.ماتریس بدست امده همان معکوس ماتریس ضرایب است.سپس این ماتریس معکوس شده را در ماتریس معلوم ضرب میکند که این کار را هم یک سابروتین انجام میدهد.جواب های بدست امده از ضرب این دو ماتریس همان جواب های مجهولات ما هستند و انها را نمایش میدهد.…

program matrix_inverse_method
implicit none
INTEGER::i2,i,j,k,p,i1,j1,n,j2,i3
REAL::s,detr,deta
REAL,ALLOCATABLE::a(:,:),b(:,:),c(:,:),f(:),x(:,:),t(:,:),g(:,:)
PRINT*
PRINT*,"   _                _     _  _     _  _     "
PRINT*,"  | a11  a12 ..a1n1  |   | x1 |   | b1 |    "
PRINT*,"  |                  |   |    |   |    |    "
PRINT*,"  | a21  a22 ..a2n1  | X | x2 | = | b2 |    "
PRINT*,"  | .                |   | .  |   | .  |    "
PRINT*,"  | .                |   | .  |   | .  |    "
PRINT*,"  |_am11 am12..am1n1_|   |_xn_|   |_bn_|    "
PRINT*,"                    nxn       nx1       nx1 "
PRINT*
PRINT*,"------------------------------------------------------------------------"
PRINT*
PRINT*,"tedad moadelat ya n ra vared konid : "
READ*,n
ALLOCATE(a(n,n),b(n-1,n-1),c(n,n),f(n-1),x(n,1),t(n,1),g(n,n))
do i2=1,n
PRINT*,"khate",i2,"matris a ra vared konid : "
READ*,a(i2,:)
PRINT*,"b(",i2,") ra vared konid :"
READ*,x(i2,1)
end do
call det(n,a,deta)
if (deta==0) then
PRINT*,"matris makoos pazir nist! "
stop
end if
do i1=1,n
do j1=1,n
p=0
do i=1,n
if (i/=i1) then
k=0
do j=1,n
if (j/=j1) then
k=k+1
f(k)=a(i,j)
end if
end do
p=p+1
b(p,:)=f
end if
end do
call det(n-1,b,detr)
s=((-1)**(i1+j1))*detr
c(i1,j1)=s
end do
end do
do j2=1,n
g(:,j2)=c(j2,:)
end do
g=g/deta
call mat(n,g,x,t)
do i3=1,n
PRINT*,"   X(",i3,") = ",t(i3,1)
end do
PRINT*
end
subroutine det(n,a,t1)
implicit none
INTEGER::i,j,g,f,r,j1,k,s,n
REAL::landa,t,a(n,n),b(n),c(n,n),t1
c=a
k=0
do i=1,n
if (c(i,i)==0) then
do j=i+1,n
if (c(j,i)/=0) then
k=k+1
b=c(j,:)
c(j,:)=c(i,:)
c(i,:)=b
end if
end do
end if
do j1=i+1,n
landa=-c(j1,i)/c(i,i)
c(j1,:)=(landa*c(i,:))+c(j1,:)
end do
end do
t=1
do s=1,n
t=t*c(s,s)
end do
if (MOD(k,2)==0) then
t1=t
else
t1=-t
end if
end
subroutine mat(n,a,b,c)
implicit none
INTEGER::m1,n1,m2,n2,t,k1,k2,i,k,j,n
REAL::a(n,n),b(n,1),c(n,1),c1(n),c2(n),s
do i=1,3
do j=1,1
c1=a(i,:)
c2=b(:,j)
s=0.
do k=1,3
s=s+(c1(k)*c2(k))
end do
PRINT*
c(i,j)=s
end do
end do
end