روش کرامر(کد فرترن)-روش محاسبه معکوس(وارون) یک ماتریس(کد فرترن)- محاسبه دترمینان ماتریس n*n(کد فرترن
روش محاسبه معکوس(وارون) یک ماتریس(کد فرترن)
نقل قول :
کد فرترن محاسبه معکوس یک ماتریس...این برنامه اول 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
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
روش ضرب دو ماتریس(کد فرترن)
نقل قول :این کد اول m1 و n1 یا همان تعداد سطر و ستون ماتریس اول را میگیرد و سپس m2 و n2 مربوط به ماتریس دوم را میگیرد.بعد بررسی میکند که n1 و m2 برابر هستند یانه.برای ضرب ماتریس ها این دو عبارت باید برابر باشند.سپس یک ماتریس m1 در n2 تشکیل میدهد که همان ماتریس جواب ماست و شروع به محاسبه میکند و در آخر هم ماتریس بدست امده را نشان میدهد.…
program matrix
implicit none
INTEGER::m1,n1,m2,n2,t,k1,k2,i,k,j
REAL,allocatable::a(:,:),b(:,:),c(:,:),c1(:),c2(:)
REAL::s
PRINT*
PRINT*," _ _ _ _ _ _ "
PRINT*," | a11 a12 ..a1n1 | | b11 b12 ..b1n2 | | c11 c12 ..c1n2 | "
PRINT*," | | | | | | "
PRINT*," | a21 a22 ..a2n1 | X | b21 b22 ..b2n2 | = | c21 c22 ..c2n2 | "
PRINT*," | . | | . . . | | . . . | "
PRINT*," | . | | . . . | | . . . | "
PRINT*," |_am11 am12..am1n1_| |_bm21 bm22..bm2n2_| |_cm11 cm12..cm1n2_| "
PRINT*," m1xn1 m2xn2 m1xn2 "
PRINT*
PRINT*,"------------------------------------------------------------------------"
PRINT*
PRINT*,"input m1 and n1 : "
READ*,m1,n1
PRINT*,"input m1 and n2 : "
READ*,m2,n2
if (n1/=m2) then
PRINT*," n1 must be equal m2"
PRINT*
stop
end if
ALLOCATE(a(m1,n1),b(m2,n2),c(m1,n2),c1(n1),c2(m2))
PRINT*
do k1=1,m1
PRINT*,"input line",k1,"of matrix a :"
READ*,a(k1,:)
end do
do k2=1,m2
PRINT*,"input line",k2,"of matrix b :"
READ*,b(k2,:)
end do
do i=1,m1
do j=1,n2
c1=a(i,:)
c2=b(:,j)
s=0.
do k=1,m2
s=s+(c1(k)*c2(k))
end do
PRINT*
c(i,j)=s
end do
end do
PRINT*," C(",m1,",",n2,") :"
PRINT*
do t=1,m1
PRINT*," ",c(t,:)
end do
PRINT*
end program
implicit none
INTEGER::m1,n1,m2,n2,t,k1,k2,i,k,j
REAL,allocatable::a(:,:),b(:,:),c(:,:),c1(:),c2(:)
REAL::s
PRINT*
PRINT*," _ _ _ _ _ _ "
PRINT*," | a11 a12 ..a1n1 | | b11 b12 ..b1n2 | | c11 c12 ..c1n2 | "
PRINT*," | | | | | | "
PRINT*," | a21 a22 ..a2n1 | X | b21 b22 ..b2n2 | = | c21 c22 ..c2n2 | "
PRINT*," | . | | . . . | | . . . | "
PRINT*," | . | | . . . | | . . . | "
PRINT*," |_am11 am12..am1n1_| |_bm21 bm22..bm2n2_| |_cm11 cm12..cm1n2_| "
PRINT*," m1xn1 m2xn2 m1xn2 "
PRINT*
PRINT*,"------------------------------------------------------------------------"
PRINT*
PRINT*,"input m1 and n1 : "
READ*,m1,n1
PRINT*,"input m1 and n2 : "
READ*,m2,n2
if (n1/=m2) then
PRINT*," n1 must be equal m2"
PRINT*
stop
end if
ALLOCATE(a(m1,n1),b(m2,n2),c(m1,n2),c1(n1),c2(m2))
PRINT*
do k1=1,m1
PRINT*,"input line",k1,"of matrix a :"
READ*,a(k1,:)
end do
do k2=1,m2
PRINT*,"input line",k2,"of matrix b :"
READ*,b(k2,:)
end do
do i=1,m1
do j=1,n2
c1=a(i,:)
c2=b(:,j)
s=0.
do k=1,m2
s=s+(c1(k)*c2(k))
end do
PRINT*
c(i,j)=s
end do
end do
PRINT*," C(",m1,",",n2,") :"
PRINT*
do t=1,m1
PRINT*," ",c(t,:)
end do
PRINT*
end program
محاسبه دترمینان ماتریس n*n(کد فرترن)
نقل قول :
کد فرترن محاسبه دترمینان ماتریس n*n.....کدی که نوشته شده است اول از شما n که همان تعداد سطر و ستون ماتریس مربعی n*n است را میگیرد.بعد خط به خط درایه های ماتریس را از شما گرفته و برنامه در هر مرحله نگاه میکند میبیند که روی قطر اصلی عدد 0 وجود دارد یا نه.اگر باشد ان سطر را با سطری که درایه های آن 0 ندارد عوض میکند.این کار را برای همه سطرها در هر مرحله انجام میدهد تا همه آنها درست باشند.حالا شروع میکند به تبدیل این ماتریس به یک ماتریس بالا مثلثی.میدانید که یکی از روش های محاسبه دترمینان همین است. بعد از اینکه بالا مثلثی شد دترمینان برابر حاصلضرب درایه های قطر اصلی ماتریس می شود. این حاصلضرب را محاسبه میکند و دترمینان را نشان میدهد.…program determinan
implicit none
INTEGER::i,j,g,f,r,j1,k,s,n
REAL::landa,t
REAL,ALLOCATABLE::a(:,:),b(:)
PRINT*
PRINT*," for matrix(n,n) input n : "
READ*,n
ALLOCATE (a(n,n),b(n))
do g=1,n
PRINT*," input line",g,":"
READ*,a(g,:)
end do
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
PRINT*
PRINT*
t=1
do s=1,n
t=t*a(s,s)
end do
if (MOD(k,2)==0) then
PRINT*," Determinant = ",t
else
PRINT*," Determinant = ",-t
end if
PRINT*
PRINT*,"-----------------------------------------------------------------"
end
implicit none
INTEGER::i,j,g,f,r,j1,k,s,n
REAL::landa,t
REAL,ALLOCATABLE::a(:,:),b(:)
PRINT*
PRINT*," for matrix(n,n) input n : "
READ*,n
ALLOCATE (a(n,n),b(n))
do g=1,n
PRINT*," input line",g,":"
READ*,a(g,:)
end do
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
PRINT*
PRINT*
t=1
do s=1,n
t=t*a(s,s)
end do
if (MOD(k,2)==0) then
PRINT*," Determinant = ",t
else
PRINT*," Determinant = ",-t
end if
PRINT*
PRINT*,"-----------------------------------------------------------------"
end
+ نوشته شده در ساعت توسط علی پروری
|