Practical manual: FORTRAN 90
I. Sample Fortran program:
1. Program to add to numbers and print the results
program add_num ! program name
implicit none ! important?
integer :: num_1, num_2
real :: reslt ! variable declaration
print*,"enter the values to be added with a (,/enter key) inbetween"
read*, num_1, num_2 !input statement
reslt=num_1+num_2 ! executable statement
print*,"first number is =",num_1
print*,"second number is =",num_2
print*, "the result is =",reslt
print*, "******************************"
end program add_num
2. Write a program to create array and sort the elements and find max, min & average
!program to create array, sort elements and find max min avg
program mark_data
implicit none
integer:: i,j,n
real::temp,summ,avg,maxx,minn,maximum,minimum
real,dimension(100)::a
!real::a(100)
print*,"enter n"
read(*,*) n
print*, "enter the array"
read(*,*) (a(i), i=1,n) !a(1), a(2)…….a(n)
do 10 i=1,n-1
do 20 j=i+1,n
if (a(i).lt. a(j)) then
temp=a(i)
a(i)=a(j)
a(j)=temp
end if
20 continue
10 continue
print*,"mark in order"
write(*,*) (a(i), i=1,n)
do i=1,n
maxx=a(1)
if (a(i).ge.maxx)then
maximum=a(i)
end if
end do
print*,"max is =",maximum
do i=1,n
minn=a(1)
if (a(i).le.minn)then
minimum=a(i)
end if
end do
print*,"min is =",minimum
summ=0
do i=1,n
summ=summ+a(i)
end do
avg=summ/n
print*, "avg value is=",avg
end program
3. Program to multiply two matrices and compare the result using intrinsic matrix
multiplication function
program mat_multip
implicit none
integer :: i,j,k,flag
real :: A(3,3),B(3,3),AB(3,3),C(3,3),s
print*,"ENTER THE ELEMENTS OF THE MATRIX A"
do i=1,3
do j=1,3
read*, A(i,j)
end do
end do
!DISPLAY MATRIX A
do i=1,3
write (*,*) (A(i,j),j=1,3)
end do
print*,"ENTER THE ELEMENTS OF THE MATRIX B"
do i=1,3
do j=1,3
read*, B(i,j)
end do
end do
!DISPLAY MATRIX B
do i=1,3
write (*,*) (B(i,j),j=1,3)
end do
!TO PERFORM THE MULTIPLICATION OPERATION
c=0
do i=1,3 !To change rows
do j=1,3 !To change columns
s=0 !To reset the sum for the next element in the row
do k=1,3 !Notice why the number of columns of A have to
be equal to the number of rows of B
s=A(i,k)*B(k,j)+s
end do
AB(i,j)=s !To assign values to each element of the product
end do
end do
write (*,*) "matrix AB (the result)" !To display the result
do i=1,3
write (*,*) (AB(i,j),j=1,3)
end do
!MULTIPLICATION USING INTRINSIC FUNCTION
C=matmul(A,B)
write(*,*) "The product of matrices A and B by intrinsic
function"
do i=1,3
write(*,*) (C(i,j),j=1,3)
end do
end program mat_multip
4. Program to find the transpose of matrix
program trans
implicit none
real:: a(10,10),b(10,10)
integer:: i,j,m,n
write(*,*)"Enter m and n"
read(*,*) m,n
write(*,*)'Enter the matrix elements'
do i=1,m
read(*,*) (a(i,j),j=1,n)
end do
!Display the matrix a
write(*,*)"Matrix a is :"
do i=1,m
write (*,*) (a(i,j),j=1,n)
end do
! Find the transpose
do i=1,m
do j=1,n
b(i,j)=a(j,i)
end do
end do
!Display the transposed matrix b
write(*,*)"Matrix b=a' is :"
do i=1,m
write (*,*) (b(i,j),j=1,n)
end do
end program trans
5. To find the sine value using Taylor expansion.
!To find the sine value using Taylor expansion
!sin(x) = x-x^3/3!+x^5/5!-…………..
program Taylor
implicit none
real x,t,angle,sum1,sum2
integer np,n,i
!To read the angle in degrees
write (*,*) "Give the number whose sine value you wish to compute (in degrees)"
read (*,*) x
write(*,*) "Calculating the sine of ",x
!To convert the angle to to radians
angle=0.0174532925*x
write (*,*) "The angle in Radians is= ",angle
write (*,*) "Give the value of n (the no. of terms in the Taylor series)"
read (*,*) n
write (*,*) "The given value of n (the no. of terms in the Taylor series) is ",n
!To sum up terms in Taylor series
t=angle
sum1=angle
np=(2*(n-1))+1
do i=3,np,2
t=(((-t)*(angle**2))/(i*(i-1)))
sum1=sum1+t
end do
write (*,*) "By Taylor series, sin(",x,")= ",sum1
!To compare value using the intrinsic function
sum2=sin(angle)
write(*,*) "By using the intrinsic function, sin(",x,")= ",sum2
if ((abs(sum1-sum2))<0.00001) then
write(*,*) "The result matches the value given by the intrinsic function"
else
write(*,*)"The value found does not match the value given by the intrinsic function"
end if
end program Taylor
6. To find the smallest among three given numbers and print the result in a file
program smallest_among_three_numbers
implicit none
real::a,b,c,smallest
print*,"Enter the three numbers you want to compare"
read*,a,b,c
if (a<b) then
if (a<c) then
smallest=a
print*,"Smallest is=",smallest ! to print the result on the terminal
else
smallest=c
print*,"Smallest is=",smallest
end if
else if (b<c) then
smallest=b
print*,"Smallest is=",smallest
else
smallest=c
print*,"Smallest is=",smallest
end if
open (2,file='Smallest.dat',status='new')
write(2,*) "The three numbers are" !write* is commanding to write the file in the
!'Smallest.dat' file
write(2,*) a,b,c
write(2,*) !provides a space of one line in the output 'Smallest.dat' file
write(2,*) "The smallest one among these numbers is="
Write(2,*) smallest
close(2)
end program
7. Program to find the factorial of a number
program factr
implicit none
integer (kind=16) :: number, fact, n
print*,'enter a positive integer'
read*, number
fact = 1
do n = 2, number, 1
fact = fact*n
end do
print*, fact
end program factr
II. Solution of quadratic equation
!To find the roots of a quadratic equation
program quadratic
implicit none
real :: a,b,c,d,p,rootd,x1,x2,realroot,imagroot
write(*,*) "Give a,b,c"
read (*,*) a,b,c
write(*,*) "a= ",a,"b= ",b,"c= ",c
d=(b*b)-(4*a*c)
write (*,*) "The discriminant is", d
write (*,*) "Finding the solutions to the quadratic equation:"
write (*,*) "(",a,")x^2+ (",b,")x + (",c,")"
!For complex roots
If (d<0) then
rootd=sqrt(-d)
write (*,*) "The discriminant is less than zero. Roots are complex"
x1=(-b)/(2*a) + (-rootd)/(2*a)
x2=(-b)/(2*a) - (-rootd)/(2*a)
realroot=(x1+x2)/2
imagroot=(x1-x2)/2
write (*,*) "Root1= ",realroot," + ",imagroot,"i"
write (*,*) "Root2= ",realroot," - ",imagroot,"i"
write(*,*) "Real part of root= ", abs(realroot)," Imaginary part of root= ", abs(imagroot)
write (*,*) "The modulus is", sqrt(realroot**2+imagroot**2)
else
!For real roots
p=(-b)
rootd=sqrt(d)
write (*,*) "The discriminant is greater than or equal to zero. The roots are real."
if (p>0) then
x1=(-b)/(2*a)+rootd/(2*a)
else
x1=(-b)/(2*a)-rootd/(2*a)
end if
x2=c/(a*x1)
write(*,*) "Root1= ",x1,"Root2= ",x2
write (*,*) "The sum of the roots is ",x1+x2," and (-b/a) is ",-b/a
write (*,*) "The product of the roots is ",x1*x2," and (c/a) is ",c/a
end if
end program quadratic
III. Least square fitting:
Principle of least square states that, the best fit ̂ to a set of data is that, which minimizes the
sum of the squares of the deviations of the data from the fit
∑( ̂) ( ̂)
To minimize ( ̂) ,
∑( ̂)
̂
∑ ∑̂
∑ ̂
̂ ∑
To fit a line
• Fit to a set of data ( ) ( )
• Error is defined as,
∑( )
For the best fit, this error should be minimum
Hence,
[∑( ) ]
∑ ( )
∑ ∑ ∑ ( )
Similarly ,
∑ ∑ ( )
From (1) and (2)
!To find points on a straight line fitting the data
program sqfit
implicit none
real :: sumx,sumy,sumx2,sumxy,xbar,ybar,a,b
integer :: n,i
real :: x(1000),y(1000)!To read data
real, allocatable :: yfit(:)
n=10
do i=1,n
x(i) = i
y(i) = 1.5183*x(i)+0.3049
end do
open (5,file='file1.dat')
!write (5,15) "x","y"
!15 format (10x,a1,15x,a1)
do i=1,n
write (5,*) x(i),y(i) !This write statement is in the output
end do
sumx=0
sumy=0
sumx2=0
sumxy=0
do i=1,n
sumx=sumx+x(i)
sumy=sumy+y(i)
sumx2=sumx2+x(i)*x(i)
sumxy=sumxy+x(i)*y(i)
xbar=sumx/n
ybar=sumy/n
end do
print*,sumx,sumy,sumx2,sumxy,xbar,ybar
!Formula for the y-intercept !of the best linear curve
a=((ybar*sumx2)-(xbar*sumxy))/(sumx2-(real(n)*(xbar**2)))
!Formula for the slope of the best linear curve
b=(sumxy-(real(n)*xbar*ybar))/(sumx2-(real(n)*(xbar**2)))
allocate (yfit(n))
do i=1,n
yfit(i)=a+b*x(i)
end do
write (*,*) "y-intercept, a= ",a !To display the output
write (*,*) "slope ,b= ",b
write (*,20)"x","y","yfit"
20 format (10x,a1,15x,a1,13x,a4)
do i=1,n
write (*,*)x(i),y(i),yfit(i)
end do
open (unit=7, file='file2.dat') !To write the output to a file
do i=1,n
write (7,*) x(i),yfit(i)
end do
end program sqfit
! to plot using gnuplot, use [ plot 'C:\Users\Hirak\Desktop\test\file1.dat' with points,
!'C:\Users\Hirak\Desktop\test\file2.dat' with linespoints]]
IV. Runge Kutta method of 4th order:
Consider initial value problem
( ) ( )
Here y is an unknown function of x and for the initial value of x0, the corresponding y value is
y0.
So the RK4 approximation of y(xn+1) is
yn+1=yn+1/6 h (k1+2k2+2k3+k4)
xn+1=xn+h
( )
( )
( )
( )
Here
k1 is the slope at the beginning of the interval, using y
k2 is the slope at the midpoint of the interval, using y and k1
k3 is again the slope at the midpoint, but now using y and k2
k4 is the slope at the end of the interval, using y and k3
h is the step size
Example:
y(0) =1, find y(0.2) where h = 0.1 using RK4 method
x0=0 y0=1
x1=0.1 y1=…
x2=0.2 y2=…
now put n=0 in the formula
k1=hf(x0,y0) = h(x0+y02) = 0.1(0+1)=0.1
k2=0.11525
k3=0.1169
k4=0.1347
y1=y0+k , k=1/6h(k1+2k2+2k3+k4)
y1=1.1165
now put n=1
k1=hf(x1,y1) = h(x1+y12) = 0.1347
k2=0.1552
k3=0.1576
k4=0.1823
y2=y1+k =1.2736
! Program Runge-Kutta Method to solve differential equation
program rungekutta
implicit none
real:: x,y,xp,h,m1,m2,m3,m4,f
integer:: n,int,i
write(*,*)'input values of x and y'
read(*,*)x,y
write(*,*)'input value of x at which y is required'
read(*,*)xp
write(*,*)'input size h'
read(*,*)h
!Compute number of steps
n=int((xp-x)/h)
write(*,*) n
do i=1,n
m1=h*f(x,y)
m2=h*f(x+0.5*h,y+0.5*m1)
m3=h*f(x+0.5*h,y+0.5*m2)
m4=h*f(x+h,y+m3)
x=x+h
y=y+(m1+2.0*m2+2.0*m3+m4)*(1/6.0)
write(*,*) i,x,y
end do
!final value of y
write(*,*)'value of y at x=',x,'is',y
end program
!define your function here
real function f(x,y)
real:: x,y
f=x+y**2
end function
