کد فرترن روش تنصیف
program bisection
implicit none
INTEGER::k
REAL::x,xo,a,b,e,e1,a1,x1,t1,t2
!y=x**2-e**x
do
PRINT*,"baze [a,b] ra vared konid : "
PRINT*,"a = "
READ*,a
PRINT*,"b = "
READ*,b
t1=(a**2)-((2.71828182)**a)
t2=(b**2)-((2.71828182)**b)
if ((t1*t2)>0) then
PRINT*,"dar baze [",a,",",b,"] hich javabi vojood nadarad."
PRINT*
else
exit
end if
END do
xo=0
PRINT*
PRINT*,"nerkh hamgarayi ra vared konid : "
READ*,e
k=0
do
k=k+1
x=(a+b)/2
a1=(a**2)-((2.71828182)**a)
x1=(x**2)-((2.71828182)**x)
if ((a1*x1)>0) then
a=x
else
if ((a1*x1) < 0) then
b=x
else
exit
end if
end if
e1=abs(x-xo)/ABS(x)
if (e1 < e) then
exit
else
xo=x
end if
END do
PRINT*,"javab dar tekrar",k," barabar : ",x
PRINT*
end
کد فرترن روش گاوس-سایدل
program gauss_sidel
implicit none
INTEGER::i,j,i1,j1,k,t1,n,j2,k1
REAL::s,e
REAL,ALLOCATABLE::a(:,:),x(:),y(:),t(:)
PRINT*
PRINT*
PRINT*," 1 2 . . . n n+1"
PRINT*," _ - - - - - _ "
PRINT*," 1 | X(1)a(1,1) + X(2)a(1,2) + ... + X(n)a(1,n) = a(1,n+1) |"
PRINT*," 2 | X(1)a(2,1) + X(2)a(2,2) + ... + X(n)a(2,n) = a(2,n+1) |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," n |_ X(1)a(n,1) + X(2)a(n,2) + ... + X(n)a(n,n) = a(n,n+1)_|"
PRINT*," n*n+1"
PRINT*
PRINT*,"baraye matris n*n+1 bala lotfan n (tedad moadalat) ra vared konid :"
READ*,n
ALLOCATE (a(n,n+1),x(n),y(n),t(n))
do i1=1,n
PRINT*,"khate",i1,"ra vared konid ( az a(",i1,", 1) ta a(",i1,",",n+1,")) : "
READ*,a(i1,:)
end do
PRINT*,"nerkh hamgarayi ra vared konid : "
READ*,e
do j2=1,n
x(j2)=0
y(j2)=0
end do
k=1
do
do i=1,n
s=0
do j=1,n
if (j.ne.i) then
s=s+x(j)*a(i,j)
end if
end do
x(i)=(a(i,n+1)-s)/a(i,i)
end do
do t1=1,n
t(t1)=(abs(x(t1)-y(t1)))/ABS(x(t1))
end do
if (MAXVAL(t) < e) then
exit
else
k=k+1
y(1:n)=x(1:n)
end if
end do
PRINT*,"javab ha dar tekrar ",k," ba hadse avaliye X(1:n)=0 ::"
PRINT*
do k1=1,n
PRINT*," X(",k1,") = ",x(k1)
end do
PRINT*
end
کد فرترن تعویض درایه های ماتریس نسبت به قطر اصلی
د فرترن برنامه ای که درایه های یک ماتریس مربعی n در n را نسبت به قطر اصلی عوض میکنه.این برنامه اول n رو میگیره و ماتریس n در n رو تشکیل میده سپس ماتریس رو خط به خط از بالا به پایین از کاربر میگیره و در آخر درایه هارو نسبت به قطر اصلی عوض میکنه و نمایش میده.
program matris
implicit none
INTEGER::b,i,j,k,n,t
INTEGER,ALLOCATABLE::a(:,:)
PRINT*,"baraye matris n*n lotfan n ra vared konid : "
READ*,n
ALLOCATE (a(n,n))
do t=1,n
PRINT*,"khate",t,"ra vared konid : "
READ*,a(t,:)
end do
PRINT*
do i=1,n-1
do j=i+1,n
b=a(i,j)
a(i,j)=a(j,i)
a(j,i)=b
end do
end do
do k=1,n
PRINT*,a(k,:)
end do
PRINT*
end
کد فرترن روش تکرار ژاکوبی
program jacobi
implicit none
INTEGER::i,j,i1,i2,j1,n,j2,k,k1,t1
REAL::s,e
REAL,ALLOCATABLE::a(:,:),x(:),y(:),t(:)
PRINT*
PRINT*
PRINT*," 1 2 . . . n n+1"
PRINT*," _ - - - - - _ "
PRINT*," 1 | X(1)a(1,1) + X(2)a(1,2) + ... + X(n)a(1,n) = a(1,n+1) |"
PRINT*," 2 | X(1)a(2,1) + X(2)a(2,2) + ... + X(n)a(2,n) = a(2,n+1) |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," . | . . . . . . . . . . . |"
PRINT*," n |_ X(1)a(n,1) + X(2)a(n,2) + ... + X(n)a(n,n) = a(n,n+1)_|"
PRINT*," n*n+1"
PRINT*
PRINT*,"baraye matris n*n+1 bala lotfan n (tedad moadalat) ra vared konid :"
READ*,n
ALLOCATE (a(n,n+1),x(n),y(n),t(n))
do i1=1,n
PRINT*,"khate",i1,"ra vared konid ( az a(",i1,", 1) ta a(",i1,",",n+1,")) : "
READ*,a(i1,:)
end do
PRINT*,"nerkh hamgarayi ra vared konid : "
READ*,e
do j2=1,n
x(j2)=0
end do
k=1
do
do i=1,n
s=0
do j=1,n
if (j.ne.i) then
s=s+x(j)*a(i,j)
end if
end do
y(i)=(a(i,n+1)-s)/a(i,i)
end do
do t1=1,n
t(t1)=(abs(y(t1)-x(t1)))/ABS(y(t1))
end do
if ( MAXVAL(t) < e ) then
exit
else
k=k+1
x(1:n)=y(1:n)
end if
end do
PRINT*
PRINT*,"javab ha dar tekrar ",k," ba hadse avaliye X(1:n)=0 ::"
PRINT*
do k1=1,n
PRINT*,"X(",k1,") = ",x(k1)
end do
PRINT*
PRINT*
end
کد فرترن روش حذفی گاوس
program gauss
implicit none
INTEGER::n,i,j,j1,i2,i3,j3,i4,k
REAL::landa,s
REAL,allocatable::a(:,:),x(:),b(:)
PRINT*
PRINT*,"matrix n dar n+1 zir ra dar nazar begirid::"
PRINT*
PRINT*," _ _ "
PRINT*," 1 | a(1,1) a(1,2) ... a(1,n) | a(1,n+1) | "
PRINT*," 2 | a(2,1) a(2,2) ... a(2,n) | a(2,n+1) | "
PRINT*," 3 | a(3,1) a(3,2) ... a(3,n) | a(3,n+1) | "
PRINT*," . | . . . . | . | "
PRINT*," . | . . . . | . | "
PRINT*," . | . . . . | . | "
PRINT*," . | . . . . | . | "
PRINT*," . | . . . . | . | "
PRINT*," n |_ a(n,1) a(n,2) ... a(n,n) | a(n,n+1) _| "
PRINT*," (n,n+1)"
PRINT*," ------------------------- -----------"
PRINT*," matris zarayeb bordar ma-loom"
PRINT*
PRINT*,"__________________________________________________________________"
PRINT*
PRINT*,"lotafan tedad moadelat ya (n) ra vared konid:"
READ*,n
ALLOCATE (a(n,n+1),x(n),b(n+1))
do k=1,n
PRINT*,"khate",k,"ra vared konid ( az a(",k,", 1) ta a(",k,",",n+1,") ) :"
READ*,a(k,:)
end do
PRINT*,"-----------------------------------------------------------------"
do i=1,n
if (a(i,i)==0) then
do j=i+1,n
if (a(j,i)/=0) then
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*
x(n)=a(n,n+1)/a(n,n)
do i3=n-1,1,-1
s=0.
do j3=i3+1,n
s=s+(a(i3,j3)*x(j3))
end do
x(i3)=(a(i3,n+1)-s)/a(i3,i3)
end do
do i4=1,n
PRINT*," x(",i4,") = ",x(i4)
END do
PRINT*
PRINT*
PRINT*,"__________________________________________________________"
end
کد فرترن ضرایب دوجمله ای نیوتن
program khayam
implicit none
INTEGER::n,i,t1,t2,t3,j1,j2,j3
INTEGER,ALLOCATABLE::a(:)
PRINT*," n ra vared konid : "
READ*,n
PRINT*
ALLOCATE (a(n+1))
t1=1
do j1=1,n
t1=t1*j1
end do
do i=0,n
t3=1
t2=1
do j2=1,i
t2=t2*j2
end do
do j3=1,n-i
t3=t3*j3
end do
a(i+1)=t1/(t2*t3)
end do
PRINT*,"zarayeb baraye tavan",n," : ",a
PRINT*
end
کد فرترن اعداد اول بین دو عدد
program prime
implicit none
INTEGER::n,i,k,j,m
READ*,m,n
PRINT*
do i=m+1,n-1
k=0
do j=1,i
if (MOD(i,j)==0) then
k=k+1
end if
end do
if (k==2) then
PRINT*,i
end if
end do
end
کد فرترن اعداد اول 1 تاn
program prime
implicit none
INTEGER::n,i,k,j
READ*,n
PRINT*
do i=1,n
k=0
do j=1,i
if (MOD(i,j)==0) then
k=k+1
end if
end do
if (k==2) then
PRINT*,i
end if
end do
end
کد فرترن تعداد ارقام یک عدد
program ragham
implicit none
INTEGER::n,i
READ*,n
PRINT*
i=1
do
if (n<(10**i)) then
exit
else
i=i+1
end if
end do
PRINT*,i
end
کد فرترن مجموع معکوس فاکتوریل n عدد
s=(1/1!)+(1/2!)+(1/3!) =1.666666
--------------------------------------------------------------------------------------------------------------------------------------
program fuct
implicit none
INTEGER::n,t,i
REAL::s
READ*,n
t=1
s=0
do i=1,n
t=t*i
s=s+(1/REAL(t))
end do
PRINT*,s
end
کد فرترن مجموع فاکتوریل n عدد
s=1!+2!+3! =9
-----------------------------------------------------------------------------------------------------------------------------------
program fuct
implicit none
INTEGER::n,s,t,i
READ*,n
t=1
s=0
do i=1,n
t=t*i
s=s+t
end do
PRINT*,s
end
کد فرترن سری فیبوناچی
کد فرترن برنامه ای که که عدد n رو میگیره و تا جمله n ام سری فیبوناچی رو به صورت سطری چاپ میکنه.در پست قبل همین سری به صورت ستونی چاپ میشه.
program fibo
implicit none
INTEGER::f1,f2,f3,i,n
INTEGER,allocatable::a(:)
READ*,n
ALLOCATE (a(n))
PRINT*
f1=1
f2=1
a(1)=f1
a(2)=f2
do i=3,n
f3=f2+f1
a(i)=f3
f1=f2
f2=f3
end do
PRINT*,a
end
کد فرترن سری فیبوناچی
کد فرترن برنامه ای که عدد n رو میگیره و تا جمله n ام سری فیبوناچی رو به صورت زیر هم دیگه چاپ میکنه.در پست بعد کد برنامه ایه مه سری فیبوناپی رو در یک سطر چاپ میکنه.
program fibo
implicit none
INTEGER::f1,f2,f3,i,n
READ*,n
PRINT*
f1=1
f2=1
PRINT*,f1
PRINT*,f2
do i=3,n
f3=f2+f1
PRINT*,f3
f1=f2
f2=f3
end do
end
کد فرترن نمایش معکوس یک عدد
کد فرترن برنامه ای که ای عددی رو میگیره و اون رو به صورت برعکس نمایش میده
مثلا 12345 رو به صورت 54321 نشون میده
program makoos
implicit none
INTEGER::n,b,p,i,s,k,j
INTEGER,ALLOCATABLE::a(:)
READ*,n
p=1
do
if (n<10**p) then
exit
else
p=p+1
end if
end do
ALLOCATE (a(p))
do i=1,p
a(i)=MOD(n,10)
n=INT(n/10)
end do
s=0
k=p
do j=0,p-1
t=a(k)*(10**j)
s=s+t
k=k-1
end do
PRINT*,s
end program
کد فرترن مقسوم علیه های مشترک دو عدد
کد فرترن برنامه ای که دو عدد رو میگیره و مقسوم علیه های مشترک رو نشون میده
program mas
implicit none
INTEGER::n,s,i,a,m
READ*,m,n
if (n>m) then
a=m
m=n
n=a
end if
do i=1,n
if (MOD(n,i)==0) then
if (MOD(m,i)==0) then
PRINT*,i
end if
end if
end do
end
کد فرترن به صورت نزولی مرتب کردن
کد فرترن برنامه ای که تعداد دلخواه عدد رو میگیره و اونا رو به ترتیب نزولی(از بزرگ به کوچک) مرتب میکنه
n=تعداد اعدادی که میخواید وارد کنید
program ny
implicit none
INTEGER::n,i
INTEGER,ALLOCATABLE::a(:),b(:)
READ*,n
ALLOCATE (a(n),b(n))
READ*,a
do i=1,n
b(i)=MAXVAL(a)
a(MAXLOC(a))=MINVAL(a)
end do
PRINT*,b
end
کد فرترن به صورت صعودی مرتب کردن
کد فرترن برنامه ای که تعداد دلخواه عدد رو میگیره و اونا رو به ترتیب صعودی(از کوپک به بزرگ) مرتب میکنه
n=تعداد اعدادی میخواید وارد کنید
program nyy
implicit none
INTEGER::n,i
INTEGER,ALLOCATABLE::a(:),b(:)
READ*,n
ALLOCATE (a(n),b(n))
READ*,a
do i=1,n
b(i)=minVAL(a)
a(minLOC(a))=maxVAL(a)
end do
PRINT*,b
end
کد فرترن تشخیص عدد کامل
کد فرترن برنامه ای که تعداد دلخواه عدد رو میگیره و اونا رو به ترتیب نزولی(از بزرگ به کوچک) مرتب میکنه
عدد کامل عددیه که مجموع مقسوم علیه های غیر از خوش برابر خود عدد بشه.مثل عدد 6 که مجموع 1 و2 و3 که مقسوم عیه های غیر خودش هستن میشه 6
program kamel
implicit none
INTEGER::n,s,i
READ*,n
s=0
do i=1,(n/2)+1
if (MOD(n,i)==0) then
s=s+i
end if
end do
if (s==n) then
PRINT*,"yes"
else
PRINT*,"no"
end if
end program
کد فرترن محاسبه فاکتوریل
کد فرترن محاسبه ی فاکتوریل یک عدد
program fuct
implicit none
INTEGER::n,s,i
READ*,n
s=1
do i=1,n
s=s*i
end do
PRINT*,s
end
کد فرترن تشخیص عدد اول
کد فرترن برنامه ای که عددی رو میگیره و نشون میده اول هست یا نه.
یکی از راه های تشخیص عدد اول اینه که تعداد مقسوم علیه هاش فقط 2 تا است.من هم از همین روش استفاده کردم.
program fuct
implicit none
INTEGER::n,i,k
READ*,n
k=0
do i=1,n
if (MOD(n,i)==0) then
k=k+1
end if
end do
if (k==2) then
PRINT*,"yes"
else
PRINT*,"no"
end if
end
کد فرترن به توان رساندن بدون استفاده از عمل توان و ضرب
program tavan
implicit none
INTEGER::k,t,i,j,m,n
READ*,m,n
t=0
k=m
do i=1,n-1
do j=1,m
t=t+k
end do
k=t
t=0
end do
PRINT*,k
end program
کد فرترن تبدیل مبنای 2 به 10
کد فرترن تبدیل یک عدد از مبنای 2 به مبنای 10
program mabna
implicit none
INTEGER::n,s,i,j,t,k
READ*,n
j=1
do
if (n<(10**j)) then
k=i
exit
else
j=j+1
end if
end do
s=0
do i=0,k-1
t=MOD(n,10)*(2**i)
s=s+t
n=INT(n/10)
end do
PRINT*,s
end
کد فرترن ب.م.م و ک.م.م دو عدد
کد فرترن بزرگ ترین مقسوم علیه مشترک (ب.م.م) و کوچکترین مضرب مشترک دو عدد (ک.م.م)
program bmm_kmm
implicit none
INTEGER::n ,i,r,m,a,b,kmm
READ*,m,n
a=m
b=n
do
r=MOD(m,n)
if (r==0) then
PRINT*,"bmm =",n
exit
else
m=n
n=r
end if
end do
kmm=(a*b)/n
PRINT*,"kmm =",kmm
end
کد فرترن تجزیه ی یک عدد به اعداد اول
program tajziye
implicit none
INTEGER::i,n,a
READ*,n
a=n+1
i=2
do
if (MOD(n,i)==0) then
PRINT*,i
n=n/i
else
i=i+1
if (i==a) then
exit
end if
end if
end do
end program
کد های درس محاسبات عددی به زبان فرترن (رایگان)2