دانلود رایگان

کلیه کد های درس محاسبات عددی به زبان فرترن - دانلود رایگان



دانلود رایگان کلیه کد های درس محاسبات عددی به زبان فرترن

دانلود رایگان کلیه کد های درس محاسبات عددی به زبان فرترن کد فرترن روش ماتریس معکوس در حل دستگاه معادلات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
کد فرترن معکوس یک ماتریس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
کد فرترن ضرب دو ماتریس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
کد فرترن انتگرال به روش ذوزنقهprogram antegral
implicit none
INTEGER::n
REAL::t,i,s,fa,fb,b,a,delx
PRINT*
PRINT*," f(x) = x - 2**x"
PRINT*," baraye antegral az a ta b , a va b ra vared konid : "
PRINT*," a = "
READ*,a
PRINT*," b = "
READ*,b
PRINT*," n ra vared konid : "
READ*,n
delx=(b-a)/n
s=0.
do i=a+delx,b-delx,delx
s=s+(i-2**(i))
end do
fa=a-2**(a)
fb=b-2**(b)
t=(s+((fa+fb)/2))*delx
PRINT*," javab antegral az",a,"ta",b," = ",t
PRINT*
end
کد فرترن اثر ماتریساین کد اول n رو که همون تعداد سطر و ستون ماتریس مربعی ماست رو میگره.سپس سطر به سطر درایه های های ماتریس رو از کاربر میگیره و شروع به محاسبه تریس ماریس میکنه.تریس یا اثر یک ماتریس برابر حاصل جمع درایه های روی قطر اصلی ماتریسه.در آخر هم جواب رو نمایش میده.
program trace
implicit none
INTEGER::n,i,t
REAL::s
REAL,ALLOCATABLE::a(:,:)
PRINT*," input n : "
READ*,n
ALLOCATE (a(n,n))
do t=1,n
PRINT*," input a(",t,", 1 ) to a(",t,",",n,") :"
PRINT*
READ*,a(t,:)
end do
s=0.
do i=1,n
s=s+a(i,i)
end do
PRINT*," trace = ",s
PRINT*
end
کد فرترن روش تکرار نیوتنprogram nioton
implicit none
INTEGER::k,i
REAL::x,fpx,fx,c,e,y
!F(x)= x - cos(x)
PRINT*
PRINT*," F(X) = X - cos(X) X = ? "
PRINT*
PRINT*," Nerkhe hamgarayi ra vared konid : "
READ*,c
x=0
k=0
do
k=k+1
y=x
fx=x - COS(x)
fpx=1 + SIN(x)
x=x-(fx/fpx)
e=(ABS(x-y))/ABS(x)
if (e < c) exit
end do
PRINT*," Javab dar tekrar",k," barabar ast ba : X =",x
PRINT*
end
کد فرترن روش نابجاییprogram nabejayi
implicit none
INTEGER::k
REAL::a,b,fa,fb,x,e,c,y
!F(x)=x^2 - 2^x
PRINT*
PRINT*," F(X) = X^2 - 2^X X = ? "
PRINT*
PRINT*," Baraye baze [a,b], a & b ra vared konid : "
READ*,a,b
PRINT*," Nerkhe hamgarayi ra vared konid : "
READ*,c
x=0
k=0
do
k=k+1
y=x
fa=(a**2)-(2**a)
fb=(b**2)-(2**b)
x=(a*fb - b*fa)/(fb-fa)
e=ABS((x-y))/ABS(x)
if (e < c) then
exit
end if
if ((x*fa) > 0) then
a=x
else
if ((x*fa) < 0) then
b=x
else
exit
end if
end if
end do
PRINT*," Javab dar tekrar",k," barabar ast ba : X =",x
PRINT*
end
کد فرترن مشتق مرتبه اول به روش تفاضل مرکزیprogram dif
implicit none
REAL::x,fp,y1,y2,n,e,yp
!f(x)=(x**3)-2x+1
PRINT*
PRINT*," F(x) = x^3 - 2x + 1"
PRINT*
PRINT*," input n :"
READ*,n
PRINT*," , "
PRINT*," baraye F(x), noghte x ra vared konid:"
READ*,x
y2=((x+(1/n))**3)-2*(x+(1/n))+1
y1=((x-(1/n))**3)-2*(x-(1/n))+1
fp=(y2-y1)*n/2
PRINT*,"-------------------------------------------------"
PRINT*," moshtagh F(x) dar noghte",x," = ",fp
yp=3*(x**2)-2
e=(ABS(yp-fp)/yp)*100
PRINT*
PRINT*," Error =",e,"%"
PRINT*,"-------------------------------------------------"
PRINT*
end
کد فرترن روش کرامر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
کد فرترن محاسبه دترمینان ماتریس n در nprogram 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
کد فرترن روش تکرار سادهprogram tekrar_sade
implicit none
!f(x)=(e**x)-x-4
!x=(e**x)-4
!g(x)=(e**x)-4
INTEGER::k
REAL::x,y,e,c,t,r1,r2,a,b
PRINT*,"baze [a,b] ra vared konid : "
PRINT*,"a = "
READ*,a
PRINT*,"b = "
READ*,b
t=(a+b)/2
r1=(2.71828182**t)-4
r2=2.71828182**t
if ( ( r1 > a ) .and. ( r1 < b ) .and. (( ABS(r2)) < 1)) then
PRINT*
PRINT*,"nerkh hamgarayi ra vared konid : "
READ*,c
x=0
k=0
do
k=k+1
y=(2.71828182**x)-4
e=(y-x)/y
if ( e < c ) then
exit
else
x=y
end if
end do
PRINT*,"javab dar tekrar",k," barabar : ",y
else
PRINT*,"dar baze [",a,",",b,"] hich javabi vojood nadarad."
end if
PRINT*
end
کد فرترن الگوریتم توماسprogram toomas
implicit none
INTEGER::n,i,j,k,l
REAL::landa
REAL,ALLOCATABLE::a(:,:),r(:),x(:)
PRINT*
PRINT*," _ _"
PRINT*," | | | "
PRINT*," 1 | b(1) c(1) 0 0 0 . 0 | r(1) | "
PRINT*," | | |"
PRINT*," 2 | a(2) b(2) c(2) 0 0 . 0 | r(2) | "
PRINT*," | | |"
PRINT*," 3 | 0 a(3) b(3) c(3) 0 . 0 | r(3) | "
PRINT*," | | |"
PRINT*," . | 0 0 a(4) b(4) . . . | r(4) | "
PRINT*," . | | | "
PRINT*," . | . . . . . . 0 | . | "
PRINT*," . | | | "
PRINT*," . | . . . . . . c(n) | . | "
PRINT*," | | |"
PRINT*," n | 0 0 0 . 0 a(n) b(n) | r(n) | "
PRINT*," |_ | _| "
PRINT*," (n , n+1)"
PRINT*
PRINT*,"-----------------------------------------------------------------"
PRINT*
PRINT*," n ya tedad moadelat ra vared konid : "
READ*,n
ALLOCATE (a(n,n),r(n),x(n))
PRINT*
PRINT*," b( 1 ) va c( 1 ) ra be tartib vared konid :"
READ*,a(1,1),a(1,2)
do i=2,n-1
PRINT*," a(",i,") , b(",i,") , c(",i,") ra be tartib vared konid : "
READ*,a(i,i-1:i+1)
end do
PRINT*," a(",n,") va b(",n,") ra be tartib vared konid : "
READ*,a(n,n-1),a(n,n)
PRINT*
PRINT*," r(1) ta r(",n,") ra be tartib vared konid : "
READ*,r(1:n)
PRINT*
PRINT*,"------------------------------------------------------------------"
PRINT*
do j=1,n-1
landa=-a(j+1,j)/a(j,j)
a(j+1,j)=0
a(j+1,j+1)=(a(j,j+1)*landa)+a(j+1,j+1)
r(j+1)=(landa*r(j))+r(j+1)
end do
x(n)=r(n)/a(n,n)
do k=n,1,-1
x(k)=(r(k)-(a(k,k+1)*x(k+1)))/a(k,k)
end do
do l=1,n
PRINT*," X(",l,") = ",x(l)
end do
PRINT*
end
کد فرترن ریشه های معادله درجه دومprogram daraje_2
implicit none
REAL::a,b,c,x1,x2,delta
PRINT*
PRINT*," 2 "
PRINT*," aX + bX + c = 0 ===> a , b , c = ?"
PRINT*
PRINT*," a : "
READ*,a
PRINT*," b : "
READ*,b
PRINT*," c : "
READ*,c
PRINT*
PRINT*,"-----------------------------------------------------------------"
PRINT*
delta=(b**2)-(4*a*c)
if (delta>0) then
x1=(-b+SQRT(delta))/(2*a)
x2=(-b-SQRT(delta))/(2*a)
PRINT*," X(1) =",x1
PRINT*
PRINT*," X(2) =",x2
PRINT*
else
if (delta==0) then
x1=-b/(2*a)
PRINT*," X =",x1
PRINT*
else
x1=-b/(2*a)
x2=-delta/(2*a)
PRINT*," X(1) and X(2) are complex : "
PRINT*
PRINT*," X(1) =",x1,"+",x2,"i"
PRINT*
PRINT*," X(2) =",x1,"-",x2,"i"
PRINT*
end if
end if
PRINT*,"-----------------------------------------------------------------"
end
کد فرترن تبدیل عدد از مبنایی به مبنای دیگرprogram mabna_m_be_n
implicit none
INTEGER::a,m,n,k,s1,s2,j,i,r,a10,am
PRINT*
PRINT*," (a) = (?)"
PRINT*," m n"
PRINT*
PRINT*," a ra vared konid : "
READ*,a
PRINT*
PRINT*,"mabnaye m ra vared konid : "
READ*,m
PRINT*
PRINT*,"mabnaye n ra vared konid : "
READ*,n
PRINT*
am=a
k=1
do
if (a<(10**k)) then
exit
else
k=k+1
end if
end do
s1=0
do i=0,k-1
r=MOD(a,10)
s1=s1+(r*(m**i))
a=INT(a/10)
end do
a10=s1
s2=0
j=0
do
if (s1==0) then
exit
else
r=MOD(s1,n)
s2=s2+(r*10**j)
j=j+1
s1=INT(s1/n)
end if
END do
PRINT*," (",am,") =",a10,"= (",s2,")"
PRINT*," ",m," ",n
end
کد فرترن روش تنصیف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 تاnprogram 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


کد فرترن تجزیه ی یک عدد به اعداد اول


کد فرترن روش ماتریس معکوس در حل دستگاه معادلات


کد فرترن معکوس یک ماتریس


کد فرترن ضرب دو ماتریس


کد فرترن ا


مقاله


پاورپوینت


فایل فلش


کارآموزی


گزارش تخصصی


اقدام پژوهی


درس پژوهی


جزوه


خلاصه


مهندسی عمران راه و ساختمان

نقل قول : عنوان : تحلیل دینامیکی طیفی ساختمان­های منظم بر اساس ایین نامه 2800 زلزله ...

مرجع دانلود کتاب - فهرست کامل کتاب ها

تفسیر پدیدار شناسی روح هگل ، درس ... محاسبات ابری و چالش های ... قرآن کریم به زبان ...

اعضاي هيأت علمي: علی خالقی

موضوع: توضیحات: فایل: تاریخ: قابل توجه دانشجویان محترم درس برنامه نویسی: با سلام و عرض ...

انجام پایان نامه کارشناسی ارشد-مشاوره پایان نامه - …

شو لیست پرومو. مرکز مشاوره پایان نامه خانه مشاور ایران. مرکز مشاوره خانه مشاور ایران ...

پروژه های دانشجویی

www.it2.ir. www.sour3.com. پروژه داروخانه به زبان دلفی پروژه دفترچه تلفن به زبان دلفی با سورس کامل

مرجع دانلود کتاب - خرید پستی کتاب

همچنین جهت اطلاع از آخرین کتاب های اضافه شده به سایت از طریق پیامک می توانید نام و ...

برنامه های درس محاسبات عددی (به زبان فرترن و مطلب ...

برنامه,درس,محاسبات ,عددی, فرترن, ... به دو زبان فرترن و ... های درس محاسبات عددی (به ...

انجام پروژه های درسی به زبان های فرترن، متلب، c و …

... درسی به زبان های فرترن ... کلیه پروژه های کد ... های کد نویسی درس محاسبات ...

برنامه نویسی ومحاسبات عددی به زبان فرترن - محاسبات عددی

... عددی به زبان فرترن ... سطر به سطر درایه های ... کد رایگان|محاسبات عددی ...

برنامه های درس محاسبات عددی (به زبان فرترن و …

برنامه های درس محاسبات عددی (به زبان فرترن ... (این برنامه ها به دو زبان فرترن و مطلب ...

کدنویسی به زبان فرترن و متلب - کد فرترن روش …

reymoh.blogfa.com|کد فرترن روش کرامر|کد روش کرامر به فرترن|کد روش کرامر در فرترن|حل دستگاه ...

دانلود برنامه های درس محاسبات عددی (به زبان فرترن و …

برنامه های درس محاسبات عددی ... 3 سوال از محاسبات رو به زبان فرترن قبول می کنید ...

دانلود برنامه های درس محاسبات عددی (به زبان فرترن و …

عددی (این برنامه ها به دو زبان ... پروژه رایگان محاسبات عددی انتگرال به ... عطاری های ...

برنامه نویسی به زبان فرترن - خلاصه جزوه محاسبات عددی

... خلاصه جزوه محاسبات عددی - ... کردن آنها به زبان فرترن ایجاد شده ... های فرترن;

برنامه های درس محاسبات عددی (به زبان فرترن و مطلب ... - کد ...

... ... - کد رانگ کوتا مرتبه ۲ در ... ابزار معرفی وبلاگ به ... mamisite.com تزیین کوزه های قدیمی ...

دانلود برنامه های درس محاسبات عددی (به زبان فرترن و …

... (این برنامه ها به دو زبان فرترن و ... patugh.ir زیباترین جملات و متن های زیبا ... اشعار به ...

مهندسی عمران راه و ساختمان

نقل قول : عنوان : تحلیل دینامیکی طیفی ساختمان­های منظم بر اساس ایین نامه 2800 زلزله ...

مرجع دانلود کتاب - فهرست کامل کتاب ها

تفسیر پدیدار شناسی روح هگل ، درس ... محاسبات ابری و چالش های ... قرآن کریم به زبان ...

اعضاي هيأت علمي: علی خالقی

موضوع: توضیحات: فایل: تاریخ: قابل توجه دانشجویان محترم درس برنامه نویسی: با سلام و عرض ...

انجام پایان نامه کارشناسی ارشد-مشاوره پایان نامه - …

شو لیست پرومو. مرکز مشاوره پایان نامه خانه مشاور ایران. مرکز مشاوره خانه مشاور ایران ...

پروژه های دانشجویی

www.it2.ir. www.sour3.com. پروژه داروخانه به زبان دلفی پروژه دفترچه تلفن به زبان دلفی با سورس کامل

مرجع دانلود کتاب - خرید پستی کتاب

همچنین جهت اطلاع از آخرین کتاب های اضافه شده به سایت از طریق پیامک می توانید نام و ...

كاربرد معادلات ديفرانسيل در مكانيك

بسته ویژه افزایش قد

HikaMarket Multi-vendor 1.7.0

مبانی نظری و پیشینه ذهن آگاهی

دانلود طرح توجیهی طلا و جواهر سازی

تاریخچه بیماری هلندی

تحقیق در مورد حيات وحش ايران 17 ص

فایل گزارش کارورزی اداره ثبت اسناد و املاک مشهد ..

پیدایش عکاسی در جهان

تحقیق در مورد فقر

جزوه درس سیستم های تصمیم یار هوشمند DSS

دانلود پرسشنامه مقیاس ارزیابی اهمال کاری دانش آموز با فرمت ورد

تحقیق در مورد حقوق اقتصادي اساسي دولتها 27 ص

تحقیق در مورد قانون اساسی دولت موقت 50 ص (word)

مقاله: اخلاق و عرفان اسلامي

استاندارد حسابداري‌ شماره‌ 3 درآمد عملياتي

پاورپوینت در مورد اختصاصات ماهی قزل آلا

ترجمه مقاله امنیت، حریم خصوصی و اعتماد در اینترنت اشیا: راه پیش رو

تحقیق درباره شیمی سبز و کاربرد آن

راهنمای جامع زبان انگلیسی عمومی-براساس کتاب محمود علیمحمدی و حسن خلیلی-پیام نور

تحقیق در مورد ناهنجاری های رفتاری کودکان

دانلود کتاب مهارت های هفت گانه ICDL بصورت PDF (کامل ترین مجموعه)

برنامه ریزی کالبدی

عقاب

فایل فلش مارشال Marshal ME-711 MT6582 با مین برد MZ706-D3_V2

پاورپوینت درمورد انرژی وانتقال آن

آموزش رفع مشکل DRK گوشی سامسونگ SM-G925I android 6.0.1

تحقیق در مورد مدد کاری word

دانلود تحقیق پيغمبر اسلام يا برانگيخته شدن آن حضرت به مقام عالى نبوت و خا

کتاب راهکارهای برقراری ارتباط موثر و بهبود فردی