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

نقل قول:::

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

program matrix_inverse
implicit none
INTEGER::n,i,j,k,p,i1,j1,i2,j2,i3
REAL::s,detr,deta
REAL,ALLOCATABLE::a(:,:),b(:,:),c(:,:),f(:),g(:,:)
PRINT*
PRINT*,"     _                _ "
PRINT*,"    | a11  a12 ..a1n1  | "
PRINT*,"    |                  |       -1"
PRINT*,"A = | a21  a22 ..a2n1  |      A  = ?"
PRINT*,"    | .                |"
PRINT*,"    | .                |"
PRINT*,"    |_am11 am12..am1n1_|"
PRINT*,"                      nxn "
PRINT*
PRINT*,"------------------------------------------------------------------------"
PRINT*
PRINT*,"  n ra vared konid : "
READ*,n
ALLOCATE(a(n,n),b(n-1,n-1),c(n,n),f(n-1),g(n,n))
do i2=1,n
PRINT*,"  khate",i2,"matris a ra vared konid : "
READ*,a(i2,:)
end do
PRINT*,"-----------------------------------------------------"
PRINT*
call det(n,a,deta)
if (deta==0) then
PRINT*,"  matris makoos pazir nist! "
PRINT*
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
PRINT*,"   -1  "
PRINT*,"  A : "
PRINT*
do i3=1,n
PRINT*,"  ",g(i3,:)
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