0% found this document useful (0 votes)
5 views15 pages

As 02

The document contains multiple Fortran programs implementing numerical methods for solving integrals and differential equations, including Gaussian Quadrature, Euler's method, Modified Euler, Runge-Kutta methods of orders 2 and 4, and solving systems of equations using the Runge-Kutta method. Each program reads input data from files, performs calculations, and outputs results, including error percentages compared to actual solutions. The programs utilize functions and subroutines for specific calculations and error comparisons.

Uploaded by

MD Mehedi Hassan
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
5 views15 pages

As 02

The document contains multiple Fortran programs implementing numerical methods for solving integrals and differential equations, including Gaussian Quadrature, Euler's method, Modified Euler, Runge-Kutta methods of orders 2 and 4, and solving systems of equations using the Runge-Kutta method. Each program reads input data from files, performs calculations, and outputs results, including error percentages compared to actual solutions. The programs utilize functions and subroutines for specific calculations and error comparisons.

Uploaded by

MD Mehedi Hassan
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 15

Ex-01 –Gaussian Quadrature

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")

write(*,*)"Enter a(Lower Limit),b(Upper Limit) & n(between 2 to 5)="


read(*,*)a,b,n

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

You might also like