As 02
As 02
program gaussian_quadrature
implicit none
real::a,b,f,x(9,99),w(9,99),sol,s=0.,as,er
integer::i,j,n
open(1,file="input.dat")
open(2,file="output.dat")
do i=2,5
do j=1,i
read(1,*)x(i,j),w(i,j)
end do
end do
do j=1,n
s=s+w(n,j)*f(((b-a)*x(n,j)+b+a)/2.)
end do
sol=(b-a)/2.*s
as=atan(1.0)
write(*,3)sol
3 format("The required integeral is",f10.4)
er=abs(sol-as)/abs(sol)*100.
write(*,4)er
4 format("Error percentage is",8x,f8.4,x,"%")
end program
function f(m)
implicit none
real::f,m
f=1./(1+m**2)
return
end function
Input
EX- 02 - Euler , Modified Euler
program Euler_n_modified_Euler
implicit none
real::x(0:9999),y(0:9999),y2(0:9999,0:9999),as(0:9999),my(0:9999)
real::a,b,a0,h,f,f2,t=10**(-3.)
integer::i,k,n
open(1,file="input.dat")
open(2,file="output.dat")
open(3,file="output_COMPARISON.dat")
read(1,*)a,b,a0
write(*,*)"Enter n( n>1 )"
read(*,*)n
h=(b-a)/n
y(0)=a0
my(0)=a0
do i=0,n
x(i)=a+i*h
as(i)=f2(x(i))
end do
! Euler
do i=1,n
y(i)=y(i-1)+h*f(x(i-1),y(i-1))
end do
! Modified Euler
do i=1,n
y2(i,0)=my(i-1)+h*f(x(i-1),my(i-1))
k=1
7 y2(i,k)=y(i-1)+h/2.*(f(x(i-1),y(i-1))+f(x(i),y2(i,k-1)))
if(abs(y2(i,k)-y2(i,k-1))<t)then
my(i)=y2(i,k)
else
k=k+1
go to 7
end if
end do
write(2,4)
4 format(6x,"x(i)",8x,"y(i) in Euler",3x, &
"y(i) in mod. Euler",5x,"Actual solution",/)
write(2,3)(x(i),y(i),my(i),as(i),i=0,n)
3 format(2x,f9.3,6x,f9.4,10x,f9.4,14x,f9.4)
call comp(y,my,as,n)
end program
function f(p,q)
implicit none
real::f,p,q
f=p/(1+p**2)-q
return
end function
function f2(m)
implicit none
real::f2,m
f2=1/(1+m)
return
end function
subroutine comp(y,my,as,n)
implicit none
real,dimension(0:9999)::y,my,as,epe,epme
integer::i,n
do i=0,n
epe(i)=abs(y(i)-as(i))/abs(as(i))*100.
epme(i)=abs(my(i)-as(i))/abs(as(i))*100.
end do
write(3,5)
5 format("y(i) in Euler",3x,"Error %",4x,"y(i) in Mod. Euler",3x,"Error
%")
write(3,6)(y(i),epe(i),my(i),epme(i),i=0,n)
6 format(f9.4,6x,f6.3,"%",8x,f9.4,9x,f6.3,"%")
end subroutine
Input
EX- 03 -Runge Kutta method of order 2 & 4
program RK2_RK4
implicit none
real::x(0:9999),y2(0:9999),y4(0:9999),as(0:9999)
real::a,b,a0,h,k1,k2,k3,k4,f,f2
integer::i,n
open(1,file="input.dat")
open(2,file="output.dat")
open(3,file="output_COMPARISON.dat")
read(1,*)a,b,a0
write(*,*)"Enter n( n>1 )"
read(*,*)n
h=(b-a)/n
y2(0)=a0
y4(0)=a0
do i=0,n
x(i)=a+i*h
as(i)=f2(x(i))
end do
! RK-2
do i=1,n
k1=h*f(x(i-1),y2(i-1))
k2=h*f(x(i-1)+h,y2(i-1)+k1)
y2(i)=y2(i-1)+1./2.*(k1+k2)
end do
! RK-4
do i=1,n
k1=h*f(x(i-1),y2(i-1))
k2=h*f(x(i-1)+h/2.,y2(i-1)+k1/2.)
k3=h*f(x(i-1)+h/2.,y2(i-1)+k2/2.)
k4=h*f(x(i-1)+h,y2(i-1)+k3)
y4(i)=y4(i-1)+1./6.*(k1+2.*k2+2.*k3+k4)
end do
write(2,6)
6 format(4x,"x(i)",8x,"y(i) in RK-2",7x,"y(i) in RK-4",5x,"Actual
Solution",/)
write(2,4)(x(i),y2(i),y4(i),as(i),i=0,n)
4 format(f9.4,7x,f9.4,9x,f9.4,8x,f9.4)
call comp(y2,y4,as,n)
end program
function f(p,q)
implicit none
real::f,p,q
f=p/(1+p**2)-q
return
end function
function f2(m)
implicit none
real::f2,m
f2=1/(1+m)
return
end function
subroutine comp(y2,y4,as,n)
implicit none
real,dimension(0:9999)::y2,y4,as,ep2,ep4
integer::i,n
do i=0,n
ep2(i)=abs(y2(i)-as(i))/abs(as(i))*100.
ep4(i)=abs(y4(i)-as(i))/abs(as(i))*100.
end do
write(3,7)
7 format(4x,"y(i) in RK-2",4x,"Error % in RK-2",6x,"y(i) in RK-
4",4x,"Error % in RK-4",/)
write(3,5)(y2(i),ep2(i),y4(i),ep4(i),i=0,n)
5 format(4x,f9.4,8x,f6.2,"%",12x,f9.4,9x,f6.2,"%")
end subroutine
Input
EX- 04 - Solving system with Runge Kutta method of order 4
program RK_4_system
implicit none
real::a,b,h,x,f1,f2,v(99),k(99,99),w(99)
real,parameter::kk=1
integer::i,j,n
open(1,file="input.dat")
open(2,file="output.dat")
read(1,*)a,b,v(1),v(2)
write(*,*)"Enter n="
read(*,*)n
h=(b-a)/n
x=a
w(1)=v(1)
w(2)=v(2)
write(2,4)
4 format("Values of x",4x,"Values of u",4x,"Values of v",/)
do i=1,n
k(1,1)=h*f1(x,w(1),w(2))
k(1,2)=h*f2(x,w(1),w(2))
k(2,1)=h*f1(x+h/2.,w(1)+k(1,1)/2.,w(2)+k(1,2)/2.)
k(2,2)=h*f2(x+h/2.,w(1)+k(1,1)/2.,w(2)+k(1,2)/2.)
k(3,1)=h*f1(x+h/2.,w(1)+k(2,1)/2.,w(2)+k(2,2)/2.)
k(3,2)=h*f2(x+h/2.,w(1)+k(2,1)/2.,w(2)+k(2,2)/2.)
k(4,1)=h*f1(x+h,w(1)+k(3,1),w(2)+k(3,2))
k(4,2)=h*f2(x+h,w(1)+k(3,1),w(2)+k(3,2))
do j=1,2
w(j)=w(j)+(k(1,j)+2.*k(2,j)+2.*k(3,j)+k(4,j))/6.
end do
x=a+i*h
write(2,3)x,w(1),w(2)
3 format(f9.4,5x,f9.4,5x,f9.4)
end do
end program
function f1(p,u,v)
implicit none
real::f1,p,u,v,kk
f1=u*(kk-u-v)
return
end function
function f2(p,u,v)
implicit none
real::f2,p,u,v,kk
f2=v*(kk-u-v)
return
end function
Input