1

Contents
BISECTION ................................................................................................................................... 2
NEWTON RAPHSON METHOD .................................................................................................. 4
INTERPOLATION ......................................................................................................................... 5
MODIFIED EULER METHOD ...................................................................................................... 7
RUNGE KUTTA 4TH ORDER ........................................................................................................ 8
SIMPSON 1/3 ................................................................................................................................. 9
LEAST SQUARE FIT .................................................................................................................. 10
BINARY SEARCH....................................................................................................................... 11
BUBBLE SORT ........................................................................................................................... 12
GAUSS ELIMINATION .............................................................................................................. 13

BISECTION
!PROGRAM TO FIND THE ROOTS OF THE EQUATIONS USING BISECTION
METHOD!
PROGRAM BISECTION
IMPLICIT NONE
REAL, PARAMETER :: e=0.0001
INTEGER :: I
REAL :: a,b,Xm,f
WRITE(*,*)' ENTER THE VALUE OF LOWER AND UPPER LIMIT [a,b] OF THE
EQUATION'
READ(*,*) a,b
IF (f(a)*f(b)>0) THEN
WRITE(*,*)' INVALID INTERVAL'
STOP
ENDIF
WRITE(*,*)'_______________________________________________'
WRITE(*,*)'
I
a
b
Xm'
WRITE(*,*)'-----------------------------------------------------------------------'
I=0
do WHILE (abs(b-a)>e)
Xm = (a+b)*.5
IF(F(Xm)==0) GOTO 10
IF(f(a)*f(Xm)<0) THEN
b=Xm
ELSE
a=Xm
ENDIF
WRITE(*,*)I, a,b,Xm
I=I+1
ENDDO
10 WRITE(*,*)'ROOT OF THE GIVEN EQUATION IS=',Xm
WRITE(*,*)'------------------------------------------------------------------------'
STOP
END PROGRAM BISECTION
REAL FUNCTION f(X)
IMPLICIT NONE
REAL :: X
f =X**3-9*X+1
END FUNCTION f

OUTPUT
ENTER THE VALUE OF LOWER AND UPPER LIMIT [a,b] OF THE EQUATION
2
4
_______________________________________________
I
a
b
Xm
----------------------------------------------------------------------0 2.00000000
3.00000000
3.00000000
1 2.50000000
3.00000000
2.50000000
2 2.75000000
3.00000000
2.75000000
3 2.87500000
3.00000000
2.87500000
4 2.93750000
3.00000000
2.93750000
5 2.93750000
2.96875000
2.96875000
6 2.93750000
2.95312500
2.95312500
7 2.93750000
2.94531250
2.94531250
8 2.94140625
2.94531250
2.94140625
9 2.94140625
2.94335938
2.94335938
10 2.94238281
2.94335938
2.94238281
11 2.94238281
2.94287109
2.94287109
12 2.94262695
2.94287109
2.94262695
13 2.94274902
2.94287109
2.94274902
14 2.94281006
2.94287109
2.94281006
ROOT OF THE GIVEN EQUATION IS= 2.94281006
--------------------------------------------------------------------------

NEWTON RAPHSON METHOD

!PROGRAM TO FIND THE ROOT USING NEWTON RAPHSON METHOD
PROGRAM NR
IMPLICIT NONE
REAL :: x,xo,fx,dfx
REAL, PARAMETER:: tol=1e-6
integer :: k
WRITE(*,*)'ENTER THE INITIAL VALUE XO'
READ(*,*) xo
WRITE(*,*)'____________________________'
WRITE(*,*)'__________I_______XO________'
k=0
10 k=k+1
call fun (xo,fx,dfx)
x=xo-fx/dfx
if(abs(x-xo)<tol) goto 20
WRITE(*,*) k,x
xo=x
goto 10
20 WRITE(*,*)'The Root is',x
WRITE(*,*)'____________________________'
END PROGRAM NR
subroutine fun (x,fx,dfx)
implicit none
real ::x,fx,dfx
fx=x**3-x**2-2*x+1
dfx=3*x**2-2*x-2
end subroutine fun

OUTPUT

ENTER THE INITIAL VALUE XO

2
____________________________
_____I______XO______________
1 1.83333337
2 1.80293500
3 1.80193877
4 1.80193770
The Root is 1.80193770
____________________________

INTERPOLATION
PROGRAM LAGRANGE_INTERPOLATION
IMPLICIT NONE
INTEGER,PARAMETER :: N=4
INTEGER :: I,J
REAL ::P,S
REAL,PARAMETER ::K=3.0
REAL,DIMENSION(20):: X(20),Y(20)
DATA (X(I), I=1,4)/3.2,2.7,1,4.8/
DATA (Y(I), I=1,4)/22,17.8,14.2,38.3/
S=0
DO I=1,N
P=1
DO J=1,N
IF (I==J) GOTO 5
P=P*(K-X(J))/(X(I)-X(J))
5 ENDDO
S=S+P*Y(I)
ENDDO
WRITE(*,*)'INTERPOLATION OF(',K,')=',S
END PROGRAM LAGRANGE_INTERPOLATION

OUTPUT
INTERPOLATION OF( 3.00000000

)= 20.2119598

DIFFERENTIATION
PROGRAM THREE_POINT_FORMULA_DIFFERENTIATION
IMPLICIT NONE
INTEGER, PARAMETER :: NN=20
REAL, DIMENSION(0:NN) :: x,fx
INTEGER :: I,N=4
REAL :: fp0,fp1,fp2,h=0.2
DO I=0,N
x(I)=I*h
fx(I)=(x(I))**4
WRITE(*,*)I,x(I),fx(I),4*((x(I))**3)
END DO
WRITE(*,*)'**************'
DO I=1,(N-1)
fp0=(1/(2*h))*(-3*fx(I-1)+4*fx(I)-fx(I+1))
fp1=(1/(2*h))*(-fx(I-1)+fx(I+1))
fp2=(1/(2*h))*(fx(I-1)-4*fx(I)+3*fx(I+1))
WRITE(*,*)I,fp0,fp1,fp2
END DO
END PROGRAM THREE_POINT_FORMULA_DIFFERENTIATION

output

0 0.00000000
0.00000000
0.00000000
1 0.200000003
1.60000008E-03 3.20000015E-02
2 0.400000006
2.56000012E-02 0.256000012
3 0.600000024
0.129600018
0.864000082
4 0.800000012
0.409600019
2.04800010
**************
1 -4.80000004E-02 6.40000030E-02 0.175999999
2 -8.00000355E-02 0.320000052
0.720000088
3 8.00001249E-02 0.960000038
1.83999991

MODIFIED EULER METHOD

! to find the value of ode by modified euler method
PROGRAM PCM
IMPLICIT NONE
INTEGER, PARAMETER :: MM=10
INTEGER :: n,I
REAL, DIMENSION(0:MM) :: xn=0,yn=0
REAL :: yp,h=0.1,k1,k2,py
WRITE(*,*)'ENTER THE VALUE OF N'
READ(*,*)n
DO I=1,n
xn(I)=xn(I-1)+h
END DO
WRITE(*,*)'__________n_________xn____________yn_________'
WRITE(*,*)0,xn(0),yn(0)
DO I=1,n
k1=h*yp(xn(I-1),yn(I-1))
py=yn(I-1)+k1
k2=h*yp(xn(I),py)
yn(I)=yn(I-1)+0.5*(k1+k2)
WRITE(*,*)I,xn(I),yn(I)
END DO
WRITE(*,*)'_____________________________________________'
END PROGRAM PCM
REAL FUNCTION yp(xn,yn)
IMPLICIT NONE
REAL :: xn,yn
yp=1-yn
RETURN
END FUNCTION yp
output
ENTER THE VALUE OF N
3
__________n_________xn____________yn_________
0 0.00000000
0.00000000
1 0.100000001
9.49999988E-02
2 0.200000003 0.180974990
3 0.300000012 0.258782357
_____________________________________________

RUNGE KUTTA 4TH ORDER

PROGRAM RUNGE_KUTTA_Fourth_Order
IMPLICIT NONE
INTEGER, PARAMETER :: NN=20
INTEGER :: I,n
REAL, DIMENSION(0:NN) :: x,y
REAL :: h,fx,k1,k2,k3,k4
h=0.1
x(0)=0
y(0)=1
WRITE(*,*)x(0),y(0)
READ(*,*)n
DO I=1,n
k1=h*fx(x(I-1),y(I-1))
k2=h*fx(x(I-1)+0.5*h,y(I-1)+0.5*k1)
k3=h*fx(x(I-1)+0.5*h,y(I-1)+0.5*k2)
k4=h*fx(x(I-1)+h,y(I-1)+k3)
x(I)=x(I-1)+h
y(I)=y(I-1)+(1/6.)*(k1+2*k2+2*k3+k4)
WRITE(*,*)k1,k2,k3,k4,y(I)
END DO
STOP
END PROGRAM RUNGE_KUTTA_Fourth_Order
REAL FUNCTION fx(x,y)
IMPLICIT NONE
REAL :: x,y
fx=x+y
RETURN
END FUNCTION fx

output
0.00000000

1.00000000

0.100000001
0.121034168
0.144280523
0.169971704
0.198364839
0.229744121

0.109999992
0.132085875
0.156494543
0.183470294
0.213283092
0.246231347

6
0.110499993
0.132638454
0.157105252
0.184145212
0.214028999
0.247055694

0.121050000
0.144298017
0.169991046
0.198386222
0.229767755
0.264449686

1.11034167
1.24280512
1.39971697
1.58364844
1.79744124
2.04423594

SIMPSON 1/3
program simpson_123
implicit none
INTEGER, PARAMETER :: NN=20
REAL, DIMENSION(0:NN) :: fx
REAL :: a,b,h,sf
INTEGER :: I,m
m=10
a=0
b=1
IF ((m/2)*2/=m) THEN
WRITE(*,*)'number of intervals not even'
STOP
ENDIF
h=(b-a)/m
DO I=0,m
fx(I)=exp(-(a+I*h)*(a+I*h))
WRITE(*,*)I,fx(I)
END DO
sf=fx(0)+fx(m)
DO I=1,(m-1)
IF ((I/2)*2==I) THEN
sf=sf+2*fx(I)
ELSE
sf=sf+4*fx(I)
ENDIF
END DO
sf=sf*(h/3.)
WRITE(*,*)sf
end program simpson_123
output...
0 1.00000000
1 0.990049839
2 0.960789442
3 0.913931191
4 0.852143764
5 0.778800786
6 0.697676301
7 0.612626374
8 0.527292371
9 0.444858074
10 0.367879450
0.746824980

10

LEAST SQUARE FIT

!PROGRAM FOR LEAST SQUARE FIT
PROGRAM LEAST
IMPLICIT NONE
INTEGER :: I,N
INTEGER,PARAMETER :: NOP=20
REAL :: SX=0,SY=0,SX2=0,SY2=0,SXY=0
REAL :: M,C,rn
REAL, DIMENSION(NOP) :: X,Y
OPEN(UNIT=1,FILE='LEAST',STATUS='OLD',ACTION='READ')
READ(1,*)N
rn= REAL(N)
DO I=1,N
READ(1,*)X(I),Y(I)
SX=SX+X(I)
SY=SY+Y(I)
SX2=SX2+X(I)*X(I)
SY2=SY2+Y(I)*Y(I)
SXY=SXY+X(I)*Y(I)
ENDDO
M=((SXY)-SX*(SY/rn))/((SX2)-SX*(SX/rn))
C=(SY/rn)-M*(SX/rn)
WRITE(*,*) M,C
END PROGRAM LEAST
output
0.699999988

2.59999990

11

BINARY SEARCH
PROGRAM binary_search
IMPLICIT NONE
INTEGER, PARAMETER :: MM=20
INTEGER, DIMENSION(1:MM) :: AA
INTEGER :: N,I,J,x,iu,il,im
WRITE(*,*)'No of elements in the array'
READ(*,*) N
WRITE(*,*)'Type in the list'
DO I=1,N
READ(*,*)AA(I)
END DO
WRITE(*,*)'Search for'
READ(*,*)x
iu=1
il=N
im=(iu+il)/2
DO
IF (il<iu) THEN
WRITE(*,*)x,'not found in the list'
STOP
ENDIF
im=(iu+il)/2
IF (AA(im)==x) THEN
WRITE(*,*)x,'is found in the list at',im
STOP
ENDIF
IF (AA(im)>x) THEN
il=im-1
ELSE
iu=im+1
ENDIF
END DO
END PROGRAM binary_search
output...
No of elements in the array
5
Type in the list
2
6
8
15
9
Search for
8
8 is found in the list at

12

BUBBLE SORT
PROGRAM bubble_sort
IMPLICIT NONE
INTEGER, PARAMETER :: MM=20
INTEGER, DIMENSION(1:MM) :: AA
INTEGER :: N,I,J,K,x,y
WRITE(*,*)'type in the number of elements'
READ(*,*)N
WRITE(*,*)'read in the list to be sorted'
DO I=1,N
READ(*,*)AA(I)
END DO
DO I=1,N-1
K=I
DO J=I+1,N-1
IF (AA(J)>AA(K)) THEN
K=J
ENDIF
END DO
IF (K/=I) THEN
x=AA(I)
AA(I)=AA(K)
AA(K)=x
ENDIF
END DO
WRITE(*,*)(AA(I),I=1,N)
END PROGRAM bubble_sort

outpu..
type in the number of elements
5
read in the list to be sorted
12
4
9
54
0
54
12
9
4

13

GAUSS ELIMINATION
PROGRAM ELMN
IMPLICIT NONE
real,allocatable,dimension(:,:) :: a
real,allocatable,dimension(:) :: x
real :: temp1,temp2,sum
integer ::n,k,i,j
write(*,*) 'no. of eqn'
read (*,*) n
allocate (a(1:n,1:n+1))
allocate (x(1:n))
write(*,*)'enter coeff'
do i=1,n
read(*,*)(a(i,j),j=1,n+1)
enddo
do k=1,n-1
temp1= a(k,k)
if(temp1==0)then
write(*,*)' 0 division'
stop
do i= k+1,n
temp2= a(i,k)/temp1
do j=k ,n+1
a(i,j)=a(i,j)-temp2*(a(k,j))
enddo
enddo
endif
enddo
x(n) = a(n,n+1)/a(n,n)
do i=n-1,1,-1
sum=0.0
do j=i+1,n
sum= sum+a(i,j)*x(j)
enddo
x(i) = (a(i,n+1)-sum)/a(i,i)
end do
write(*,*)'soln'
do i=1,n
write(*,*)i,x(i)
enddo
END PROGRAM ELMN
output ..........................................................................
no. of eqn
3
enter coeff
10 -1 -2 4
1 10 -1 3
2 3 20 7
soln
1 0.503499985
2 0.335000008
3 0.349999994