fortran-programming.mihanblog.com|کد فرترن روش ماتریس معکوس|حل دستگاه معادلات جبری خطی به روش ماتریس معکوس|روش ماتریس معکوس برای حل معادلات جبری خطی|روش ماتریس معکوس به زبان فرترن|کد فرترن روش ماتریس معکوس برای حل دستگاه معادلات|
fortran-programming.mihanblog.com---------------------------------------------------------------------------------------------------------------------------------------------
کد فرترن روش ماتریس معکوس برای حل دستگاه معادلات جبری خطی...ین کد اول تعداد معادلات یا n رو میگیره و ماتریس ضرایب n در n رو تشکیل میده و همچنین دو ماتریس n در 1 رو تشکیل میده که یکی برای مجهولات و دیگری برای معلومات در طرف راست تساوی هستش.بعد خط به خط ماتریس ضرایب و ماتریس معلوم رو میگیره و شروع به محاسبه ماتریس همسازه ها میکنه.اول دترمینان ماتریس ضرایب رو محاسبه میکنه که اگر 0 باشه یک پیام خطا نمایش میده که ماتریس معکوس پذیر نیست.اگر دترمینان 0 نباشه محاسبه کردن رو ادامه میده.برای ماتریس همسازه ها باید با استفاده از کهاد سطر ها و ستون ها مرتب دترمینان محاسبه بشه که واسه این مورد یک سابروتین نوشتم که این کارو میکنه.سپس ترانهاده ماتریس همسازه ها رو بدست میاره و ضرب در دترمینان ماتریس ضرایب میکنه.ماتریس بدست اومده همون معکوس ماتریس ضرایبه.سپس این ماتریس معکوس شده رو در ماتریس معلوم ضرب میکنه که این کار رو هم یک سابروتین انجام میده.جواب های بدست اومده از ضرب این دو ماتریس همون جواب های مجهولات ما هستن و ا
fortran-programming.mihanblog.com|کد فرترن روش ماتریس معکوس|حل دستگاه معادلات جبری خطی به روش ماتریس معکوس|روش ماتریس معکوس برای حل معادلات جبری خطی|روش ماتریس معکوس به زبان فرترن|کد فرترن روش ماتریس معکوس برای حل دستگاه معادلات|
fortran-programming.mihanblog.com---------------------------------------------------------------------------------------------------------------------------------------------
کد فرترن روش ماتریس معکوس برای حل دستگاه معادلات جبری خطی...ین کد اول تعداد معادلات یا 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