روش کرامر(کد فرترن)-روش محاسبه معکوس(وارون) یک ماتریس(کد فرترن)- محاسبه دترمینان ماتریس n*n(کد فرترن

روش کرامر(کد فرترن)

نقل قول :

کد فرترن روش کرامر........کدی که نوشته شده است اول تعداد معادلات یا همان n را میگیرد و ماتریس n در n رو تشکیل میدهد.حالا شروع میکند سطر به سطر درایه های ماتریس را به همراه b که همان بردار معلوم ماست میگیرد. بعد با استفاده از سابروتینی که کار آن محاسبه دترمینان است، دترمینان ماتریس a رو محاسبه میکند.بعد برای هر x یک ماتریس جدید را تشکیل می دهد(که همان روش کرامر است) و ان ماتریس را به سابروتین میدهد تا دترمینان آن را محاسبه کند.تقسیم دترمینان ماتریس جدید به دترمینان اصلی همان جواب های ماست.…

program keramer
implicit none
INTEGER::i,n,j
REAL::detnet,det
REAL,ALLOCATABLE::a(:,:),b(:),x(:),c(:)
PRINT*
PRINT*
PRINT*,"    1 |  X(1)a(1,1) + X(2)a(1,2) + ... + X(n)a(1,n) = b(1) |"
PRINT*,"    2 |  X(1)a(2,1) + X(2)a(2,2) + ... + X(n)a(2,n) = b(2) |"
PRINT*,"    . |    .   .        .  .        .      .  .     .   .  |"
PRINT*,"    . |    .   .        .  .        .      .  .     .   .  |"
PRINT*,"    . |    .   .        .  .        .      .  .     .   .  |"
PRINT*,"    . |    .   .        .  .        .      .  .     .   .  |"
PRINT*,"    n |_ X(1)a(n,1) + X(2)a(n,2) + ... + X(n)a(n,n) = b(n)_|"
PRINT*,"                                                          n*n+1"
PRINT*
PRINT*,"-------------------------------------------------------------------"
PRINT*,"  lotfan n ya tedad moadelat ra vared konid : "
READ*,n
ALLOCATE(a(n,n),b(n),x(n),c(n))
do i=1,n
PRINT*,"  satre",i,"matris ra vared konid :"
READ*,a(i,:)
PRINT*,"  b(",i,") ra vared konid : "
READ*,b(i)
end do
PRINT*
PRINT*
call determinant(n,a,det)
detnet=det
do j=1,n
c=a(:,j)
PRINT*
a(:,j)=b
call determinant(n,a,det)
x(j)=det/detnet
PRINT*,"    X(",j,") = ",x(j)
a(:,j)=c
end do
PRINT*
PRINT*,"------------------------------------------------"
PRINT*
end

subroutine determinant(n,a,det)
implicit none
INTEGER::i,j,g,f,r,i1,j1,k,s,n
REAL::landa,a(n,n),b(n),det,t,d(n,n)
d=a
k=0
do i=1,n
if (a(i,i)==0) then
do j=i+1,n
if (a(j,i)/=0) then
k=k+1
b=a(j,:)
a(j,:)=a(i,:)
a(i,:)=b
end if
end do
end if
do j1=i+1,n
landa=-a(j1,i)/a(i,i)
a(j1,:)=(landa*a(i,:))+a(j1,:)
end do
end do
t=1
do s=1,n
t=t*a(s,s)
end do
if (MOD(k,2)==0) then
det=t
else
det=-t
end if
a=d
end

 

منبع

ادامه نوشته