Assignment-1

Solved by Md Ashik Ali (AE-123-082)

Answer to the question no. 1

Code: A1Q1.f90
program apple
implicit none
integer::i,j,d3,d2
integer,Dimension(4,4)::A

open(unit=44,file='matins.dat')
open(unit=55,file='outmat.txt')

read(44,*)((A(i,j),j=1,4),i=1,4)

write(55,*)"Answer of No (i)"
write(55,'(4I3)')((A(i,j),j=1,4),i=1,4)

write(55,'(/a)')"Answer of No (ii)"
write(55,'(16I3)')((A(i,j),j=1,4),i=1,4)

write(55,'(/a)')"Answer of No (iii)"
write(55,'(I3)')((A(i,j),j=1,4),i=1,4)

write(55,'(/a)')"Answer of No (iv)"
write(55,'(4I3)')(A(1,j),j=1,4)
write(55,'(I3)')(A(i,1),i=2,4)

write(55,'(/a)')"Answer of No (v)"

do i=1,4
do j=1,4

d3=0;
if(i==j)then
d3=d3+A(i,j)**3
end if
end do
end do

d2=0;
do i=1,4
d2=d2+A(i,5-i)
end do

write(55,*)"D3= ",d3
write(55,*)"D2= ",d2
If(d3>d2)write(55,*)"D3>D2"

write(55,'(/a)')"Answer of No (vi)"
write(55,'(4I3)')((A(i,j),i=1,4),j=1,4)
close(44)
close(55)
end

Input: matins.dat
1 7 3 4
5 2 6 0
0 9 3 5
8 1 7 6

Output: outmat.txt
Answer of No (i)
1 7 3 4
5 2 6 0
0 9 3 5
8 1 7 6

Answer of No (ii)
1 7 3 4 5 2 6 0 0 9 3 5 8 1 7 6

Answer of No (iii)
1
7
3
4
5
2
6
0
0
9
3
5
8
1
7
6

Answer of No (iv)
1 7 3 4
5
0
8

Answer of No (v)
D3= 216
D2= 27
D3>D2

Answer of No (vi)
1 5 0 8
7 2 9 1
3 6 3 7
4 0 5 6

Answer to the question no. 2

Code: A1Q2.f90
program array
implicit none
integer::i,j,temp,n
integer,allocatable::arr(:)
open(unit=2,file='arrayout.txt')

write(*,*)"Write the value of n: "

read(*,*)n
if(n<5)then
write(*,*)"Error! Obviously n must at least 5."
stop
end if

allocate(arr(n))

do i=1,n
read(*,*)arr(i)
end do

do i=1,n-1
do j=1,n-1
if(arr(j)>arr(j+1))then
temp=arr(j)
arr(j)=arr(j+1)
arr(j+1)=temp
end if
end do
end do

write(2,*)"Ascendending Order: "

do i=1,n
write(2,*)arr(i)
end do

write(2,*)"Discendending Order: "

do i=n,1,-1
write(2,*)arr(i)
end do

end program
Output: arrayout.txt
Ascendending Order:
23
34
43
64
68
Discendending Order:
68
64
43
34
23

Answer to the question no. 3

Code: A1Q3.f90
program descriptor
implicit none
integer::i,j
real,dimension(6,6)::a

open(unit=3,file='desout.txt')

do i=1,6
do j=1,6
call random_number (a(i,j))
a(i,j)=10+10*a(i,j)
end do
end do

open(unit=55,file='desoutput')
write(3,'(a/)')"F Descriptor."
write(3,'(6f20.8)')((a(i,j),j=1,6),i=1,6)

write(3,'(a/)')"E Descriptor."
write(3,'(6e20.7)')((a(i,j),j=1,6),i=1,6)

write(3,'(a/)')"Es Descriptor."
write(3,'(6es20.7)')((a(i,j),j=1,6),i=1,6)

end

Output: desout.txt
F Descriptor.

19.97559547 15.66824722 19.65915298 17.47927666

13.67390823 14.80636883
10.73754215 10.05355167 13.47081280 13.42243767
12.17951679 11.33160400
19.00524521 13.86765957 14.45482254 16.61932182
10.16108322 16.50854874
 16.46408844 13.22987270 18.55692291 14.01286888
12.06874275 19.68539429
15.98399544 16.72980690 14.56882286 13.30015087
11.00382900 17.55453300
16.05693245 17.19047928 18.97334671 16.58229065
11.50716782 16.12314796
E Descriptor.

0.1997560E+02 0.1566825E+02 0.1965915E+02 0.1747928E+02

0.1367391E+02 0.1480637E+02
0.1073754E+02 0.1005355E+02 0.1347081E+02 0.1342244E+02
0.1217952E+02 0.1133160E+02
0.1900525E+02 0.1386766E+02 0.1445482E+02 0.1661932E+02
0.1016108E+02 0.1650855E+02
0.1646409E+02 0.1322987E+02 0.1855692E+02 0.1401287E+02
0.1206874E+02 0.1968539E+02
0.1598400E+02 0.1672981E+02 0.1456882E+02 0.1330015E+02
0.1100383E+02 0.1755453E+02
0.1605693E+02 0.1719048E+02 0.1897335E+02 0.1658229E+02
0.1150717E+02 0.1612315E+02
Es Descriptor.

1.9975595E+01 1.5668247E+01 1.9659153E+01 1.7479277E+01

1.3673908E+01 1.4806369E+01
1.0737542E+01 1.0053552E+01 1.3470813E+01 1.3422438E+01
1.2179517E+01 1.1331604E+01
1.9005245E+01 1.3867660E+01 1.4454823E+01 1.6619322E+01
1.0161083E+01 1.6508549E+01
1.6464088E+01 1.3229873E+01 1.8556923E+01 1.4012869E+01
1.2068743E+01 1.9685394E+01
1.5983995E+01 1.6729807E+01 1.4568823E+01 1.3300151E+01
1.1003829E+01 1.7554533E+01
1.6056932E+01 1.7190479E+01 1.8973347E+01 1.6582291E+01
1.1507168E+01 1.6123148E+01

Answer to the question no. 4

Code: A1Q4.f90
program gcd
implicit none
integer::a,b,ans
open(unit=4,file='gcd_in.txt')
open(unit=6,file='gcd_out.txt')

read(4,*)a,b
ans=g(a,b)
write(6,*)ans

contains
recursive function g(x,y) result(gcd)
integer::x,y,gcd

if(mod(x,y)==0)then
 gcd=y
else
gcd=g(y,mod(x,y))
end if
end function
end program

Input: gcd_in.txt
40
60

Output: gcd_out.txt
20

Answer to the question no. 5

Code: A1Q5.f90
program prime_number
implicit none
integer::i,n,f,prime
logical::p

open(unit=34,file='PrimeOutput.txt')
write(34,'(t12,"n",15x,"Fn",6x,"Prime Test")')
write(34,'(t8,40("-"))')
do n=1,4
f=2**(2**n)+1
p=prime(f)
write(34,'(t11,i2,12x,i5,10x,l)')n,f,p
end do

end program

function prime(n)
implicit none
integer::i,n,prime
logical::p
do i=1,n/2
if(mod(n,i)==0)then
p=.false.
else
p=.true.
end if
end do
end function

Output: PrimeOutput.txt
n Fn Prime Test
----------------------------------------
1 5 T
2 17 T
3 257 T
4 65537 T
Answer to the question no. 6
Code: A1Q6.f90
program matmultp
implicit none
integer::r1,c1,r2,c2,i,j,k
real,allocatable::a(:,:),b(:,:),c(:,:)
logical::v

read(*,*)r1,c1,r2,c2
open(unit=987,file='matmult_in.txt')
open(unit=977,file='matmult_out.txt')
allocate(a(1:r1, 1:c1), b(1:r2, 1:c2), c(1:r1, 1:c2))
read(987,*)((a(i,j),j=1,c1),i=1,r1)
read(987,*)((b(i,j),j=1,c2),i=1,r2)

call mat(a,r1,c1,b,r2,c2,c)
write(977,'(2(f15.4,2x))')((c(i,j),j=1,c2),i=1,r1)

v=g(a,r1,c1,b,r2,c2,c)
write(977,*)v

contains
function g(a,r1,c1,b,r2,c2,c) result(v)
implicit none
integer::i,j,r1,r2,c1,c2
real::a(1:r1,1:c1),b(1:r2,1:c2),c(1:r1, 1:c2),d(1:r1, 1:c2)
logical::v

d=matmul(a,b)
v=.true.
do i=1,r1
do j=1,c2
if(c(i,j)/=d(i,j))then
v=.false.
exit
end if
end do
end do
end function

end program
subroutine mat(a,r1,c1,b,r2,c2,c)
integer::r1,c1,r2,c2
real::a(1:r1,1:c1),b(1:r2,1:c2),c(1:r1, 1:c2)
c=0
do i=1,r1
do j=1,c2
do k=1,c1
c(i,j)=c(i,j)+a(i,k)*b(k,j)
 end do
end do

end do
end subroutine

Input: matmult_in.txt
1. 2. 3. 4. 4. 6. 7.
5. 6. 7. 8. 5. 8. 3.
9. 10. 11. 12. 1. 4. 6.
13. 14. 15. 16. 5. 5. 7.
1. 5. 6. 7. 8. 5. 5.
3. 4. 5. 8. 5. 4. 2.

Output: matmult_out.txt
34.0000 46.0000
78.0000 104.0000
T

Answer to the question no. 7

Code: A1Q7.f90
program Calc_Amicable_Num
implicit none
integer, parameter :: N=67000
integer :: i, calc_divisor_sum, divisorSum1, divisorSum2, prev
open(unit=78,file='amicable_out.txt')

do i=1, N
divisorSum1 = calc_divisor_sum(i)
divisorSum2 = calc_divisor_sum(divisorSum1)
if((divisorSum2 == i ).and. (i .ne. divisorSum1)) then
if(prev .ne. divisorSum1) then
write(78,*) i, divisorSum1
end if
prev = i
end if
end do
end program

function calc_divisor_sum(n)
implicit none
integer :: i, n, res, calc_divisor_sum
res=0
do i=1, nint(sqrt(real(n)))
if(mod(n, i) == 0) then
res = res + i
! As we are considering proper divisors
if(i == 1) then
cycle
end if
res = res + (n/i)
end if
end do
calc_divisor_sum = res
end function

Output: amicable_out.txt
220 284
1184 1210
2620 2924
5020 5564
6232 6368
10744 10856
12285 14595
17296 18416
63020 76084
66928 66992
 Assignment-2

Solved by Md Ashik Ali (AE-123-082)

Answer to the question no. 1

Code: A2Q1.f90

program bisection
implicit none
integer:: i=1
real::a=1,b=2,p0,p,f
real,parameter::tol=1e-8

open(unit=21,file='bisectout.txt')

p0=a
p=(a+b)/2.

9 format(3x,"Iteration No",13x,"a",13x,"b",14x,"x",14x,"f(x)",7x,"Relative Error")

write(21,9)
10 format(120('_'))
write(21,10)
11 format(i9,t17,5F15.6)
do while(.true.)
write(21,11)i,a,b,p,f(p),abs(p-p0)/p

if(abs(p-p0)<tol .or. abs(f(p))<tol)then

exit
end if

if (f(a)*f(p)>0)then
a=p
end if
if (f(a)*f(p)<0)then
b=p
end if
p0=p
p=a+b/2.
i=i+1

end do
end

function f(x)
implicit none
real::x,f
f=x**3-x-1
end function
Output: bisectout.txt

Iteration No a b x f(x)
Relative Error
________________________________________________________________________________________
________________________________
1 1.000000 2.000000 1.500000 0.875000
0.333333
2 1.000000 1.500000 1.750000 2.609375
0.142857
3 1.000000 1.750000 1.875000 3.716797
0.066667
4 1.000000 1.875000 1.937500 4.335693
0.032258
5 1.000000 1.937500 1.968750 4.662079
0.015873
6 1.000000 1.968750 1.984375 4.829586
0.007874
7 1.000000 1.984375 1.992188 4.914428
0.003922
8 1.000000 1.992188 1.996094 4.957123
0.001957
9 1.000000 1.996094 1.998047 4.978539
0.000978
10 1.000000 1.998047 1.999023 4.989264
0.000489
11 1.000000 1.999023 1.999512 4.994630
0.000244
12 1.000000 1.999512 1.999756 4.997315
0.000122
13 1.000000 1.999756 1.999878 4.998657
0.000061
14 1.000000 1.999878 1.999939 4.999329
0.000031
15 1.000000 1.999939 1.999969 4.999664
0.000015
16 1.000000 1.999969 1.999985 4.999832
0.000008
17 1.000000 1.999985 1.999992 4.999916
0.000004
18 1.000000 1.999992 1.999996 4.999958
0.000002
19 1.000000 1.999996 1.999998 4.999979
0.000001
20 1.000000 1.999998 1.999999 4.999990
0.000000
21 1.000000 1.999999 2.000000 4.999995
0.000000
22 1.000000 2.000000 2.000000 4.999998
0.000000
23 1.000000 2.000000 2.000000 4.999999
0.000000
 24 1.000000 2.000000 2.000000 5.000000
0.000000
25 1.000000 2.000000 2.000000 5.000000
0.000000

Answer to the question no. 2

Code: A2Q2.f90

program fixed_point
implicit none
integer::i=1
real:: x,p(3)=[0.5,1.0,1.5],x1,f,g1,g1d,j,g2d,g2
real,parameter::tol=1e-6

open(unit=2,file='fixed_point_output.dat')

8 format(3x,"Iteration No",6x,"Pn-1",8x,"Pn",10x,"f(Pn)",10x,"Abs error")

9 format(i9,6f16.6)

do j=1,3
x=p(j)

if(abs(g1d(x))<tol)then

write(2,8)
write(2,'(100("_"))')

do while(.true.)
x1=g1(x)

write(2,9)i,x,x1,g1(x1),abs(x1-x)

if(abs(x1-x)<tol)then
exit
end if
x=x1
i=i+1
end do
else
write(2,*)"Error"
end if
end do

write(2,'(///)')

do j=1,3
x=p(j)

if(abs(g2d(x))<tol)then

write(2,8)
write(2,'(100("_"))')
do while(.true.)
x1=g2(x)

write(2,9)i,x,x1,g1(x1),abs(x1-x)

if(abs(x1-x)<tol)then
exit
end if
x=x1
i=i+1
end do
else
write(2,*)"Error"
end if
end do

end

function g1(x)
implicit none
real::x,g1
g1=sqrt(x+10)/x
end function

function g1d(x)
implicit none
real::x,g1d
g1d=1/(2*x*sqrt(x+10))-sqrt(x+10)/x**2
end function

function g2(x)
implicit none
real::x,g2
g2=(x+10)**(1/4)
end function

function g2d(x)
implicit none
real::x,g2d
g2d=(1/4)*(x+10)**(-3/4)
end function

Output: fixed_point_output.dat

Error
Error
Error
 Iteration No Pn-1 Pn f(Pn) Abs error
________________________________________________________________________________________
____________
1 0.500000 1.000000 3.316625 0.500000
2 1.000000 1.000000 3.316625 0.000000
Iteration No Pn-1 Pn f(Pn) Abs error
________________________________________________________________________________________
____________
2 1.000000 1.000000 3.316625 0.000000
Iteration No Pn-1 Pn f(Pn) Abs error
________________________________________________________________________________________
____________
2 1.500000 1.000000 3.316625 0.500000
3 1.000000 1.000000 3.316625 0.000000

Answer to the question no. 3

Code: A2Q3.f90

program newton
implicit none
integer::i=1
real::x0=5,x,f,fd
real,parameter::tol=1e-5

open(unit=23,file='newtonoutput.txt')

7 format(3x, "Iteration
No",7x,"Pn-1",10x,"f'(Pn-1)",12x,"Pn",12x,"f(Pn)",12x,"Relative Error")
write(23,7)
write(23,'(100("_"))')

8 format(i9,t17,5f16.8)
do while(.true.)

x=x0-f(x0)/fd(x0)
write(23,8)i,x0,fd(x0),x,f(x),abs(x-x0)/x

if(abs(x-x0)<tol)then
exit
end if
x0=x
i=i+1
end do
end program

function f(y)
real::y,f
f=5*(y**2)+ cos(3*y)-2*exp(y)-exp(-y)
end function

function fd(y)
 real::x,fd
fd=10*y-3*sin(3*y)-2*exp(y)+exp(-y)
end function

Output: newtonoutput.txt

Iteration No Pn-1 f'(Pn-1) Pn f(Pn)

Relative Error
________________________________________________________________________________________
____________
1 5.00000000 -248.77044678 4.30621672 -54.67616653
0.16111203
2 4.30621672 -106.27825165 3.79175425 -16.43313980
0.13567927
3 3.79175425 -47.94177628 3.44898129 -4.09515142
0.09938383
4 3.44898129 -26.02430916 3.29162264 -0.53661358
0.04780580
5 3.29162264 -19.51435089 3.26412416 -0.01327465
0.00842446
6 3.26412416 -18.55679321 3.26340890 -0.00001160
0.00021917
7 3.26340890 -18.53252411 3.26340818 0.00000363
0.00000022

Answer to the question no. 4

Code: A2Q4.f90

program secant
implicit none
integer::i=1
real::x=0,x1=2.,x2,f
real,parameter::t=1e-6

open(unit=678,file='secant_out.txt')

write(678,'(3x,"iteration no",12x,"xn_1",13x,"xn",14x,"xn+1",14x,"abs error")')

write(678,'(90("_"))')
3 format(t6,i3,t20,f15.7,3(2x,f15.7))

do while(.true.)
x2=x1-((f(x1)*(x-x1))/(f(x)-f(x1)))

write(678,3)i,x,x1,x2,abs(x2-x1)

if(abs(x2-x1)<t )then
exit
end if

x=x1
 x1=x2
i=i+1

end do

close(678)
end program
function f(y)
real::y
f=4.*y**3-1.-exp((x**2)/2.)
end function

Output: secant_out.txt

iteration no xn_1 xn xn+1 abs error

________________________________________________________________________________________
__
1 0.0000000 2.0000000 0.1250000 1.8750000
2 2.0000000 0.1250000 0.2417582 0.1167582
3 0.1250000 0.2417582 4.9005117 4.6587534
4 0.2417582 4.9005117 0.2609944 4.6395173
5 4.9005117 0.2609944 0.2800078 0.0190134
6 0.2609944 0.2800078 2.4568796 2.1768718
7 0.2800078 2.4568796 0.3502818 2.1065979
8 2.4568796 0.3502818 0.4153887 0.0651069
9 0.3502818 0.4153887 1.3872030 0.9718143
10 0.4153887 1.3872030 0.5756238 0.8115792
11 1.3872030 0.5756238 0.6768853 0.1012616
12 0.5756238 0.6768853 0.8379075 0.1610222
13 0.6768853 0.8379075 0.7867994 0.0511081
14 0.8379075 0.7867994 0.7933280 0.0065286
15 0.7867994 0.7933280 0.7937038 0.0003758
16 0.7933280 0.7937038 0.7937005 0.0000033
17 0.7937038 0.7937005 0.7937005 0.0000000

Answer to the question no. 5

Code: A2Q5.f90

program false_position
implicit none
integer::i=1
real::a=1.,b=2.,c,f
real,parameter::t=1e-5

open(unit=789,file='falsi_out.txt')

write(789,'(3x,"iteration no",15x,"a",15x,"b",15x,"c",15x,"f(c)",12x,"abs error")')

write(789,'(100("_"))')
4 format(t6,i3,t20,f15.6,4(2x,f15.6))

do while(.true.)
c=b-((b-a)*f(b)/(f(b)-f(a)))

write(789,4)i,a,b,c,f(c),abs(c-b)
 if(abs(c-b)<t .or. abs(f(c))<t)then
exit
end if

if(f(a)*f(c)<0)then
b=c
end if
if(f(a)*f(c)>0)then
a=c
end if

i=i+1
end do
close(789)

end program
function f(y)
real::y
f=exp(y)+2.**(-y)+(2.*cos(y))-6.

end function

Output: falsi_out.txt

iteration no a b c f(c)
abs error
________________________________________________________________________________________
____________
1 1.000000 2.000000 1.678308 -0.545674
0.321692
2 1.678308 2.000000 1.808103 -0.085739
0.191897
3 1.808103 2.000000 1.826538 -0.011645
0.173462
4 1.826538 2.000000 1.829006 -0.001549
0.170994
5 1.829006 2.000000 1.829334 -0.000205
0.170666
6 1.829334 2.000000 1.829377 -0.000027
0.170623
7 1.829377 2.000000 1.829383 -0.000003
0.170617
 Assignment-3

Solved by Md Ashik Ali (AE-123-082)

Answer to the question no. 1

Code: a3q1.f90
program forward_backward
implicit none
integer::i,j,k
real::f(1:6),d(6,6),h=4.,x0=2.,xn=10.,x=8.,x1=4.,a,a1,fact,term,fact1,term1

a=(x-x0)/h
a1=(x1-xn)/h

open(unit=555,file='1i.txt')
open(unit=755,file='1o.txt')
read(555,*)(f(i),i=1,6)

do i=1,5
d(1,i)=f(i+1)-f(i)
end do

k=0
do i=2,5
do j=1,4-k
d(i,j)=d(i-1,j+1)-d(i-1,j)
end do
k=k+1
end do

term=f(1)
fact=1.
term1=f(6)
fact1=1.

do i=0,4
fact=fact*(a-i)/(i+1)
term=term+fact*d(i+1,1)

fact1=fact1*(a1+i)/(i+1)
term1=term1+fact1*d(i+1,5-i)
end do

write(755,'("water level at 8:00 AM = ",f7.4,a7)')term,"meter"

write(755,'("water level at 4:00 PM = ",f7.4,a7)')term1,"meter"

close(555)
close(755)
end program
Input: 1i.txt
1.2
1.5
1.9
2.3
2.1
1.8

Output: 1o.txt
water level at 8:00 AM = 1.6633 meter
water level at 4:00 PM = 2.2883 meter

Answer to the question no. 2

Code: a3q2.f90
program interpolate
implicit none
integer::n=5,i,j
real::xp,ylag,ynewton,l,term,x(5),y(5),dd(5,5)
open(unit=10,file='2i.txt')
open(unit=20,file='2o.txt')

do i=1,n
read(10,*) x(i),y(i)
end do
read(10,*) xp
close(10)

! lagrange interpolation
ylag=0.0
do i=1,n
l=1.0
do j=1,n
if(j/=i) l=l*(xp - x(j))/(x(i) - x(j))
end do
ylag=ylag + l*y(i)
end do

! newton's divided difference

do i=1,n
dd(i,1)=y(i)
end do
do j=2,n
do i=1,n-j+1
dd(i,j)=(dd(i+1,j-1)-dd(i,j-1))/(x(i+j-1)-x(i))
end do
end do

ynewton=dd(1,1)
term=1.0
do i=1,n-1
term=term*(xp - x(i))
ynewton=ynewton + term*dd(1,i+1)
end do

write(20,'(a,f6.2)') 'interpolated value at x =',xp

write(20,'(a,f10.5)') 'lagrange interpolation :',ylag
write(20,'(a,f10.5)') 'newton divided difference :',ynewton
close(20)
end program

Input: 2i.txt
1.0 52.0
2.0 5.0
4.0 -5.0
5.0 -40.0
7.0 10.0
3.0

Output: 2o.txt
interpolated value at x = 3.00
lagrange interpolation : 6.00000
newton divided difference : 6.00000

Answer to the question no. 3

Code: a3q3.f90
program backward
implicit none
integer::i,j,k
real::f(1:6),d(6,6),h=5.,xn=40.,x1=38.,a1,fact1,term1

a1=(x1-xn)/h

open(unit=55,file='3i.txt')
open(unit=75,file='3o.txt')
read(55,*)(f(i),i=1,6)

do i=1,5
d(1,i)=f(i+1)-f(i)
end do

k=0
do i=2,5
do j=1,4-k
d(i,j)=d(i-1,j+1)-d(i-1,j)
end do
k=k+1
end do

term1=f(6)
fact1=1.

do i=0,4
fact1=fact1*(a1+i)/(i+1)
 term1=term1+fact1*d(i+1,5-i)
end do

write(75,'("Sin(38) = ",f7.4)')term1

close(55)
close(75)
end program

Input: 3i.txt
0.2588190
0.3420201
0.4226183
0.5
0.5735764
0.6427876

Output: 3o.txt
Sin(38) = 0.6157
 Assignment-4

Solved by Md Ashik Ali (AE-123-082)

Answer to the question no. 1

Code: A4Q1.f90
Program Current
Implicit none
integer::i
real::t,h,m(0:100),n(0:100),I1,I2,I3,I4,f,fd,exact
t=5

Open(unit=41,file='CurrentOutput.txt')

exact=fd(t)
write(41,*)"The Exact Value of Current is:",exact
write(41,'(/)')

2 format(t37,"Approximation Value",6x,"Error")
write(41,2)

h=-.25
do i=0,2
m(i)=f(t+i*h)
n(i)=f(t-i*h)
end do
I1=(m(1)-n(1))/(2*h)
Write(41,*)"Using Three Point Midpoint Formula:",I1,abs(I1-exact)

h=.25
do i=0,2
m(i)=f(t+i*h)
n(i)=f(t-i*h)
end do
I2=(-3*m(0)+4*m(1)-m(2))/(2*h)
Write(41,*)"Using Three Point Endpoint Formula:",I2,abs(I2-exact)

h=.5
do i=1,2
m(i)=f(t+i*h)
n(i)=f(t-i*h)
end do
I3=(n(2)-8*n(1)+8*m(1)-m(2))/(12*h)
Write(41,*)"Using Five Point Midpoint Formula:",I3,abs(I3-exact)

h=.5
do i=0,4
m(i)=f(t+i*h)
 n(i)=f(t-i*h)
end do
I4=(-25*m(0)+48*m(1)-36*m(2)+16*m(3)-3*m(4))/(12*h)
Write(41,*)"Using Five Point Endpoint Formula:",I4,abs(I4-exact)

end program

function f(t)
implicit none
real::f,t
f=60-60*exp(-t/5)
end function

function fd(t)
implicit none
real::fd,t
fd=12*exp(-t/5)
end function

Output: CurrentOutput.txt
The Exact Value of Current is: 4.41455364

Approximation Value Error

Using Three Point Midpoint Formula: 4.41639709 1.84345245E-03
Using Three Point Endpoint Formula: 4.41099548 3.55815887E-03
Using Five Point Midpoint Formula: 4.41454172 1.19209290E-05
Using Five Point Endpoint Formula: 4.41447449 7.91549683E-05

Answer to the question no. 2

Code: A4Q2.f90
program richardson
implicit none
integer::i,j
real::n(5),h=0.11,d(5,5),x,x0=2.,f,fd,exact

Open(unit=5,file='RichardOutPut.txt')

exact=fd(x0)
Write(5,*)"The Exact Value is: ",exact

do i=0,4
n(i+1)=h/2**i

end do

do i=1,5
d(i,1)=(f(x0+n(i))-f(x0-n(i)))/(2*n(i))

end do
 do j=2,5
do i=j,5
d(i,j)=(4**(j-1)*d(i,j-1)-d(i-1,j-1))/(4**(j-1)-1)
end do
end do

write(5,'(/)')
Write(5,'(t5,"O(h**2)",10x,"O(h**4)",10x,"O(h**6)",10x,"O(h**8)",10x,"O(h**10)")')
10 format(90('_'))
write(5,10)

Do i=1,5
Write(5,*)(d(i,j),j=1,i)
End Do

end program
function f(x)
real::x
f=x*exp(x)
end function

function fd(x)
real:: fd,x
fd=x*exp(x)+exp(x)
end function

Output: RichardOutPut.txt
The Exact Value is: 22.1671677

O(h**2) O(h**4) O(h**6) O(h**8) O(h**10)

________________________________________________________________________________________
__
22.2417221
22.1858120 22.1671753
22.1718006 22.1671295 22.1671257
22.1683502 22.1672001 22.1672039 22.1672058
22.1675529 22.1672878 22.1672935 22.1672935 22.1672955

Answer to the question no. 3

Code: A4Q3.f90
program motion
implicit none
real::t(7),x(7),v1,v2,a1,a2
integer::i
open(10,file='3input.txt')
open(12,file='3output.txt')

do i=1,7
 read(10,*) t(i),x(i)
end do

! when t=0.0 s
v1=(x(2)-x(1))/(t(2)-t(1))
a1=(x(3)-2*x(2)+x(1))/((t(3)-t(2))*(t(2)-t(1)))

! when t=0.6 s
v2=(x(7)-x(6))/(t(7)-t(6))
a2=(x(7)-2*x(6)+x(5))/((t(7)-t(6))*(t(6)-t(5)))

write(12,'(t17,"velocity",8x,"acceleration")')
write(12,'(50("_"))')
write(12,*) "when t=0.0s:",v1,a1
write(12,*) "when t=0.6s:",v2,a2
close(10)
close(12)
end program motion

Input: 3input.txt
0.0 30.13
0.1 31.62
0.2 32.87
0.3 33.64
0.4 33.95
0.5 33.81
0.6 33.24

Output: 3output.txt
velocity acceleration
__________________________________________________
when t=0.0s: 14.9000168 -24.0003586
when t=0.6s: -5.69999552 -43.0000229

Answer to the question no. 4

Code: A4Q4.f90
Program integral
implicit none
integer::i,n=30
real:: a=-0.4,b=0.6,f,fd,exact,h,I1,I2,I3,I4,s,m(0:100)
h=(b-a)/n
exact=fd(b)-fd(a)

open(unit=4,file='integralOutput.txt')

write(4,*)"The exact Value is: ",exact

Write(4,'(t40,"Aproximation Value",3x,"Abs Error",6x,"Relative Error")')

!Using Trapezoidal Rule

s=0
do i=1,n-1
 s=s+f(a+i*h)
end do
I1=(h/2)*(f(a)+2*s+f(b))
write(4,*)"Using Trapezoidal Rule the value is:
",I1,Abs(exact-I1),Abs(exact-I1)/exact

!Using Simpson's 1/3 Rule

s=0
do i=1,n-1
if(mod(i,2)==0)then
s=s+2*f(a+i*h)
else
s=s+4*f(a+i*h)
end if
end do
I2=(h/3)*(f(a)+s+f(b))
write(4,*)"Using Simpson's 1/3 Rule the value is:
",I2,Abs(exact-I2),Abs(exact-I2)/exact

!Using Simpson's 3/8 Rule

s=0
do i=1,n-1
if(mod(i,3)==0)then
s=s+2*f(a+i*h)
else
s=s+3*f(a+i*h)
end if
end do
I3=(3*h/8)*(f(a)+s+f(b))
write(4,*)"Using Simpson's 3/8 Rule the value is:
",I3,Abs(exact-I3),Abs(exact-I3)/exact

!Using Weddles Rule

do i=1,n-1
m(i)=f(a+i*h)
end do
I4=(3*h/10)*(f(a)+5*m(1)+m(2)+6*m(3)+m(4)+5*m(5)+f(b))
write(4,'(a,3f14.10)')"Using Weddles Formula the value is:
",I4,Abs(exact-I4),Abs(exact-I4)/exact

end program

function f(x)
implicit none
real::f,x
f=-1/((x-1)*(2+sqrt(2.)-2*x))
end function

function fd(x)
implicit none
real::fd,x
fd=-(1/sqrt(2.))*log(abs((x-1)/(sqrt(2.)-2*(x-1))))
end function

Output: integralOutput.txt
The exact Value is: 0.430767536
Aproximation Value Abs Error Relative
Error
Using Trapezoidal Rule the value is: 0.431104422 3.36885452E-04
7.82058574E-04
Using Simpson's 1/3 Rule the value is: 0.430768639 1.10268593E-06
2.55981672E-06
Using Simpson's 3/8 Rule the value is: 0.430769980 2.44379044E-06
5.67310735E-06
Using Weddles Formula the value is: 0.0475881808 0.3831793666 0.8895270228

Answer to the question no. 5

Code: A4Q5.f90
program romberg_integration
implicit none
integer, parameter :: nmax = 10
integer :: i, j, k, n
real :: a, b, h, s, tol,f
real :: R(nmax, nmax)
open(unit=8,file='RombergOutput.txt')

a = 0.0
b = 1.0
tol = 1.0e-5

R(1,1) = 0.5 * (b -a)*(f(a)+f(b))

do i = 2,nmax
n = 2**(i-1)
h = (b - a) /n
s=0.0

do k = 1, n/2
s= s+f(a +(2*k-1)*h)
end do

R(i,1) = 0.5 * R(i-1,1) + h * s

do j = 2, i
R(i,j) = R(i,j-1) + (R(i,j-1) - R(i-1,j-1)) / (4.0**(j-1) - 1.0)
end do

write(8,*)( R(i,j),j = 1, i)

if (abs(R(i,i) - R(i-1,i-1)) < tol) then

write(8,*)"Romberg integration result:",R(i,i)
write(8,*)"Estimated error:",abs(R(i,i) - R(i-1,i-1))
stop
end if
 end do

write(8,*)"Did not converge after",nmax, "iterations."

end program

real function f(x)

real:: x
f = 1.0 / (1.0 + x*x)
end function

Output: RombergOutPut.txt
0.774999976 0.783333302
0.782794118 0.785392165 0.785529435
0.784747124 0.785398126 0.785398543 0.785396457
0.785235405 0.785398185 0.785398185 0.785398185 0.785398185
Romberg integration result: 0.785398185
Estimated error: 1.72853470E-06
 Assignment-5

Solved by Md Ashik Ali (AE-123-082)

Answer to the question no. 1

Code: A5Q1.f90

Program mersenne
implicit none
integer(kind=8)::m(70),Mn,n
logical::prime

open(unit=5,file='mersenneoutput.txt')

write(5,'(t10,"n",29x,"Mn",6x,"Prime Test")')
write(5,'(t8,60("-"))')
do n=0,69
Mn=2**n-1
write(5,'(t10,i2,5x,i25,9x,l)')n,Mn,prime(Mn)
end do

end program

function prime(num)
implicit none
logical::prime
integer::num,i

if(num<2)then
prime=.false.
else
prime=.true.
end if

do i=2,int(num/i)
if(mod(num,i)==0)then
prime=.false.
else
prime=.true.
end if
end do

end function

Output: mersenneoutput.txt

n Mn Prime Test
------------------------------------------------------------
0 0 F
1 1 F
2 3 T
 3 7 T
4 15 T
5 31 T
6 63 T
7 127 T
8 255 T
9 511 T
10 1023 T
11 2047 T
12 4095 T
13 8191 T
14 16383 T
15 32767 T
16 65535 T
17 131071 T
18 262143 T
19 524287 T
20 1048575 T
21 2097151 T
22 4194303 T
23 8388607 T
24 16777215 F
25 33554431 T
26 67108863 T
27 134217727 T
28 268435455 T
29 536870911 T
30 1073741823 T
31 2147483647 T
32 4294967295 F
33 8589934591 F
34 17179869183 F
35 34359738367 F
36 68719476735 F
37 137438953471 F
38 274877906943 F
39 549755813887 F
40 1099511627775 F
41 2199023255551 F
42 4398046511103 F
43 8796093022207 F
44 17592186044415 F
45 35184372088831 F
46 70368744177663 F
47 140737488355327 F
48 281474976710655 F
49 562949953421311 F
50 1125899906842623 F
51 2251799813685247 F
52 4503599627370495 F
53 9007199254740991 F
54 18014398509481983 F
55 36028797018963967 F
56 72057594037927935 F
 57 144115188075855871 F
58 288230376151711743 F
59 576460752303423487 F
60 1152921504606846975 F
61 2305843009213693951 F
62 4611686018427387903 F
63 9223372036854775807 F
64 -1 F
65 -1 F
66 -1 F
67 -1 F
68 -1 F
69 -1 F

Answer to the question no. 2

Code: A5Q2.f90

Program Hanoy_Tower
implicit none
integer::i
real(kind=16)::tol_sec,tol_days,Hn,Mn,n,disk(8),hanoi

open(unit=6,file='HanoyOutPut.txt')

disk=(/1,4,9,16,25,36,49,64/)
write(*,'(2x,"N",26x,"Hn(Moves)",30x,"Days",28x,"Mn")')
write(*,'(120("-")))')

do i=1,8
n=disk(i)
Hn=hanoi(n)
tol_sec=Hn*5
tol_days=tol_sec/(86400)
Mn=2.**n-1

write(*,'(f3.0,5x,F30.0,5x,f30.2,f30.2)')n,Hn,tol_days,Mn
end do

end program

recursive function hanoi(n) result(moves)

implicit none
integer::i
real(kind=16)::Hn,ans,n,moves,H

if(n==1)then
moves=1
else
moves=2*hanoi(n-1)+1
end if
end function

function Mn(n)
 implicit none

Real(kind=16)::Mn,n
if(n==0)then
Mn=0
else if(n==1)then
Mn=1
else
Mn=2**n-1
end if
end function

Output: HanoyOutPut.txt

N Hn(Moves) Days
Mn
----------------------------------------------------------------------------------------
--------------------------------
1. 1. 0.00
1.00
4. 15. 0.00
15.00
9. 511. 0.03
511.00
16. 65535. 3.79
65535.00
25. 33554431. 1941.81
33554431.00
36. 68719476735. 3976821.57
68719476735.00
49. 562949953421311. 32578122304.47
562949953421311.00
64. 18446744073709551615. 1067519911673006.46
18446744073709551615.00

Answer to the question no. 3

Code: A5Q3.f90

program fibonacci
implicit none
integer,parameter::n=20
integer::i,fib,f(n),r,rfib

open(unit=7,file='FibonacciOutPut.txt')

2 format("Using Function",3x,"Using Recursive Function")

write(7,2)

r=fib(n,f)
r=rfib(n,f)
do i=1,n
write(7,*)f(i),f(i)
end do
end program
function fib(n,f)
implicit none
integer::i,n,fib,f(n)
f(1)=0
f(2)=1
do i=3,n
f(i)=f(i-2)+f(i-1)
end do
end function

recursive function rfib(n,f)result(r)

implicit none
integer::i,n,r,f(n)
if(n==1)then
f(n)=0
r=f(n)

else if(n==2)then
f(n)=1
r=f(n)

else
f(n)=rfib(n-2,f)+rfib(n-1,f)
r=f(n)
end if
end function

Output: FibonacciOutPut.txt

Using Function Using Recursive Function

0 0
1 1
1 1
2 2
3 3
5 5
8 8
13 13
21 21
34 34
55 55
89 89
144 144
233 233
377 377
610 610
987 987
1597 1597
2584 2584
 4181 4181

Answer to the question no. 4

Code: A5Q4.f90

PROGRAM BitStringGenerator
IMPLICIT NONE
INTEGER, PARAMETER :: n = 8
INTEGER :: i,c
CHARACTER(len=n) :: bitString
OPEN(UNIT=10, FILE="4o.txt")
c = 0
WRITE(10,*) "Valid bit strings in ascending order:"

DO i = 0, 2**n - 1
WRITE(bitString, '(B8)') i ! Convert integer to binary string
IF (IsValid(bitString)) THEN
WRITE(10, *) TRIM(bitString)
c = c + 1
END IF
END DO

WRITE(10, *) "Valid bit strings in descending order:"

DO i = 2**n - 1, 0, -1
WRITE(bitString, '(B8)') i
IF (IsValid(bitString)) THEN
WRITE(10, *) TRIM(bitString)
END IF
END DO

WRITE(10, *) "Number of valid bit strings:",c

CLOSE(10)

CONTAINS
FUNCTION IsValid(str) RESULT(valid)
CHARACTER(len=n), INTENT(IN) :: str
LOGICAL :: valid
valid = .NOT. (INDEX(str, '101') > 0 .OR. INDEX(str, '100') > 0)
END FUNCTION
END PROGRAM BitStringGenerator

Output: 4o.txt

Valid bit strings in ascending order:

0
1
10
11
110
111
1110
1111
11110
11111
111110
 111111
1111110
1111111
11111110
11111111
Valid bit strings in descending order:
11111111
11111110
1111111
1111110
111111
111110
11111
11110
1111
1110
111
110
11
10
1
0
Number of valid bit strings: 16

Answer to the question no. 5

Code: A5Q5.f90

program factorial
implicit none
integer:: n,r,fact,ncr,npr

open(unit=4,file='factorialoutputtttttttt.txt')

write(4,*)"10P6=",npr(10,6)
write(4,*)"10C4=",ncr(10,4)
write(4,*)"10C6=",ncr(10,6)

end program

recursive function fact(n) result(ans)

implicit none
integer::n,ans
if(n==0)then
ans=1
else if(n==1)then
ans=1
else
ans=n*fact(n-1)
end if
end function

function ncr(n,r)
implicit none
integer::n,r,ncr,ans,fact
 ans=fact(n)/(fact(r)*fact(n-r))
end function

function npr(n,r)
implicit none
integer::n,r,npr,ans,fact
ans=fact(n)/(fact(n-r))
end function

Output: factorialoutputtttttttt.txt

10P6= 151200
10C4= 210
10C6= 210

Answer to the question no. 6

Code: A5Q6.f90

Program tautology
implicit none
integer::i,j,k,exp1,m=.true.,exp2,n=.true.
logical::p,q,r

Open(unit=8,file="TAutologyOutput.txt")

write(8,'(3x,"p",5x,"q",5x,"r",5x,"(p^q)vr",5x,"(pvr)^(qvr)")')
write(8,'(50("-"))')
do i=0,1
do j=0,1
do k=0,1
p=(i==1)
q=(j==1)
r=(k==1)

if(.not.((p.and.q).or.r))then
exp1=.false.
end if

if(.not.((p.or.r).and.(q.or.r)))then
exp2=.false.
end if

write(8,'(3x,l,5x,l,5x,l,8x,l,12x,l)')p,q,r,(p.and.q).or.r,(p.or.r).and.(q.or.r)
end do
end do
end do
 if(exp1==m)then
write(8,*)"(p^q)vr is a tautology."
else
write(8,*)"(p^q)vr is not a tautology."
end if

if(exp2==n)then
write(8,*)"(pvr)^(qvr) is a tautology."
else
write(8,*)"(pvr)^(qvr) is not a tautology."
end if

end program

Output: TAutologyOutput.txt

p q r (p^q)vr (pvr)^(qvr)
--------------------------------------------------
F F F F F
F F T T T
F T F F F
F T T T T
T F F F F
T F T T T
T T F T T
T T T T T
(p^q)vr is not a tautology.
(pvr)^(qvr) is not a tautology.

Answer to the question no. 7

Code: A5Q7.f90

program rec_relation
implicit none
integer::n
real::a(50),a1(50)

open(unit=2,file='RecurrenceOutput.txt')

Write(2,'(t12,"n",4x,"Recurrenrence",4x,"Exact Value")')
Write(2,'(t10,40("-"))')
a(0)=1
a(1)=5

do n=2,50
a(n)=2*a(n-1)-a(n-2)+3
end do

do n=1,50
a1(n)=(3/2)*n**2+(5/2)*n+1
write(2,'(10x,i2,3x,f10.0,4x,f10.0)')n,a(n),a1(n)
end do
end program

Output: RecurrenceOutput.txt

n Recurrenrence Exact Value

----------------------------------------
1 5. 4.
2 12. 9.
3 22. 16.
4 35. 25.
5 51. 36.
6 70. 49.
7 92. 64.
8 117. 81.
9 145. 100.
10 176. 121.
11 210. 144.
12 247. 169.
13 287. 196.
14 330. 225.
15 376. 256.
16 425. 289.
17 477. 324.
18 532. 361.
19 590. 400.
20 651. 441.
21 715. 484.
22 782. 529.
23 852. 576.
24 925. 625.
25 1001. 676.
26 1080. 729.
27 1162. 784.
28 1247. 841.
29 1335. 900.
30 1426. 961.
31 1520. 1024.
32 1617. 1089.
33 1717. 1156.
34 1820. 1225.
35 1926. 1296.
36 2035. 1369.
37 2147. 1444.
38 2262. 1521.
39 2380. 1600.
40 2501. 1681.
41 2625. 1764.
42 2752. 1849.
43 2882. 1936.
44 3015. 2025.
45 3151. 2116.
46 3290. 2209.
47 3432. 2304.
48 3577. 2401.
49 3725. 2500.
50 3876. 2601.
 Assignment-6

Answer to the question no. 1

Code: A6Q1.f90
Program Jacobi
implicit none
integer,Parameter::n=6,max_iter=1000
real::A(n,n),x1(n),b(n),x2(n),tol=1.0e-3,er,s
integer::i,j,iter,k

open(unit=2,file='Jacobiinput.txt')
open(unit=4,file='JacobiOut.txt')
do i=1,n
read(2,*)(A(i,j),j=1,n)
end do

read(2,*)(b(i),i=1,n)
read(2,*)(x1(i),i=1,n)
close(2)

write(4,'("Iteration",10x,"x1",10x,"x2"10x,"x3",10x,"x4",10x,"x5",10x,"x6",10x,"Error")'
)
write(4,'(120("-"))')
do k=1,max_iter
do i=1,n
s=0.0
do j=1,n
if(i/=j) s=s+A(i,j)*x1(j)
end do
x2(i)=(b(i)-s)/A(i,i)

end do
er=maxval(abs(x2-x1))

write(4,'(i4,10x,6f11.5,6x,f12.5)')k,x2,er

if(er < tol)exit

x1=x2

end do
end program

Input: Jacobiinput.txt
4. -1. 0. -1. 0. 0.
-1. 4. -1. 0. -1. 0.
0. -1. 4. 0. 0. -1.
-1. 0. 0. 4. -1. 0.
0. -1. 0. -1. 4. -1.
0. 0. -1. 0. -1. 4.

0. 5. 0. 6. -2. 6.

0. 0. 0. 0. 0. 0.

Output: JacobiOut.txt
Iteration x1 x2 x3 x4 x5 x6
Error
----------------------------------------------------------------------------------------
--------------------------------
1 0.00000 1.25000 0.00000 1.50000 -0.50000 1.50000
1.50000
2 0.68750 1.12500 0.68750 1.37500 0.56250 1.37500
1.06250
3 0.62500 1.73438 0.62500 1.81250 0.46875 1.81250
0.60938
4 0.88672 1.67969 0.88672 1.77344 0.83984 1.77344
0.37109
5 0.86328 1.90332 0.86328 1.93164 0.80664 1.93164
0.22363
6 0.95874 1.88330 0.95874 1.91748 0.94165 1.91748
0.13501
7 0.95020 1.96478 0.95020 1.97510 0.92957 1.97510
0.08148
8 0.98497 1.95749 0.98497 1.96994 0.97874 1.96994
0.04918
9 0.98186 1.98717 0.98186 1.99093 0.97434 1.99093
0.02968
10 0.99452 1.98451 0.99452 1.98905 0.99226 1.98905
0.01791
11 0.99339 1.99533 0.99339 1.99670 0.99065 1.99670
0.01081
12 0.99801 1.99436 0.99801 1.99601 0.99718 1.99601
0.00653
13 0.99759 1.99830 0.99759 1.99880 0.99660 1.99880
0.00394
14 0.99927 1.99795 0.99927 1.99855 0.99897 1.99855
0.00238
15 0.99912 1.99938 0.99912 1.99956 0.99876 1.99956
0.00143
16 0.99974 1.99925 0.99974 1.99947 0.99963 1.99947
0.00087

Answer to the question no. 2

Code: A6Q2.f90
Program Jacobi_2
implicit none
integer,parameter::n=3,max_iter=25
real::b(n),x1(n),x2(n),er,A(n,n),exact(n),s
integer::i,j,iter
open(unit=3,file='jacobinputttttttttttttttttt.txt')
 open(unit=4,file='out2jacobi.txt')

do i=1,n
read(3,*)(A(i,j),j=1,n)
end do

read(3,*)(b(i),i=1,n)
read(3,*)(x1(i),i=1,n)
read(3,*)(exact(i),i=1,n)
close(3)

write(4,'("Iteration",7x,"x1",12x,"x2",15x,"x3",10x,"Error")')
write(4,'(70("-"))')

do iter=1,max_iter
do i=1,n
s=0.0
do j=1,n
if(i/=j)s=s+A(i,j)*x1(j)
end do
x2(i)=(b(i)-s)/A(i,i)
end do
er=maxval(abs(x2-exact))
write(4,'(i2,3f17.5,f10.5)')iter,x2,er
x1=x2
end do

end program

Input: jacobinputttttttttttttttttt.txt
2 -1 1
2 2 2
-1 -1 2

-1 4 -5

0 0 0

1 2 -1

Output: out2jacobi.txt
Iteration x1 x2 x3 Error
----------------------------------------------------------------------
1 -0.50000 2.00000 -2.50000 1.50000
2 1.75000 5.00000 -1.75000 3.00000
3 2.87500 2.00000 0.87500 1.87500
4 0.06250 -1.75000 -0.06250 3.75000
5 -1.34375 2.00000 -3.34375 2.34375
6 2.17188 6.68750 -2.17188 4.68750
 7 3.92969 2.00000 1.92969 2.92969
8 -0.46484 -3.85938 0.46484 5.85938
9 -2.66211 2.00000 -4.66211 3.66211
10 2.83105 9.32422 -2.83105 7.32422
11 5.57764 2.00000 3.57764 4.57764
12 -1.28882 -7.15527 1.28882 9.15527
13 -4.72205 2.00000 -6.72205 5.72205
14 3.86102 13.44409 -3.86102 11.44409
15 8.15256 2.00000 6.15256 7.15256
16 -2.57628 -12.30511 2.57628 14.30511
17 -7.94070 2.00000 -9.94070 8.94070
18 5.47035 19.88139 -5.47035 17.88139
19 12.17587 2.00000 10.17587 11.17587
20 -4.58794 -20.35174 4.58794 22.35174
21 -12.96984 2.00000 -14.96984 13.96984
22 7.98492 29.93968 -7.98492 27.93968
23 18.46230 2.00000 16.46230 17.46230
24 -7.73115 -32.92460 7.73115 34.92460
25 -20.82787 2.00000 -22.82787 21.82787

Answer to the question no. 3

Code: A6Q3.f90
program sor_iterative
implicit none
integer,parameter::n=6,max_i=1000
integer::i,j,k
real::a(n,n),b(n),x(n),x0(n),e(n),w=1.1,t=1e-5,ssum
open(unit=24,file='3i.txt')
open(unit=23,file='3o.txt')

do i = 1, n
read(24, *) (a(i,j), j = 1, n)
end do
read(24, *) (b(i), i = 1, n)
read(24, *) (x(i), i = 1, n)

write(23,'("itteration",6x,"x1",15x,"x2",15x,"x3"15x,"x4"15x,"x5"15x,"x6",/,104("_"))')
do k=1,max_i
x0=x
do i=1,n
ssum=0.0
do j=1,n
if(i<j) ssum=ssum+a(i,j)*x0(j)
if(i>j) ssum=ssum+a(i,j)*x(j)
end do
x(i)=(1-w)*x0(i)+(w)*(b(i)-ssum)/a(i,i)
end do
e=abs(x-x0)
write(23,'(5x,i0,6(6x,f10.6))')k,x
if(maxval(e)<t) exit
end do
 write(23,'(//,"converged solution : ",6f10.6)')x
close(23)
close(24)
end program

Input: 3i.txt
4. -1. 0. 0. 0. 0.
-1. 4. -1. 0. 0. 0.
0. -1. 4. 0. 0. 0.
0. 0. 0. 4. -1. 0.
0. 0. 0. -1. 4. -1.
0. 0. 0. 0. -1. 4.
3. 2. 3. 3. 2. 3.
0. 0. 0. 0. 0. 0.

Output: 3o.txt
itteration x1 x2 x3 x4 x5
x6
________________________________________________________________________________________
________________
1 0.825000 0.776875 1.038641 0.825000 0.776875
1.038641
2 0.956141 1.020877 1.001877 0.956141 1.020877
1.001877
3 1.010127 1.001213 1.000146 1.010127 1.001213
1.000146
4 0.999321 0.999732 0.999912 0.999321 0.999732
0.999912
5 0.999994 1.000001 1.000009 0.999994 1.000001
1.000009
6 1.000001 1.000003 1.000000 1.000001 1.000003
1.000000

converged solution : 1.000001 1.000003 1.000000 1.000001 1.000003 1.000000

Answer to the question no. 4

Code: A6Q4.f90
program gram_schmidt
implicit none
integer::i,j
real:: u(3,3),v(3,3)
open(unit=43,file='4i.txt')
open(unit=32,file='4o.txt')

do j = 1, 3
read(43,*) u(:, j)
end do
write(32,'("the orthonormal vectors are :")')
do i=1,3
v(:,i)=u(:,i)
do j=1,i-1
 v(:,i)=v(:,i)-(dot_product(u(:,i),v(:,j))/dot_product(v(:,j),v(:,j)))*v(:,j)
end do
v(:,i)= v(:,i)/sqrt(dot_product( v(:,i),v(:,i)))
write(32,'("w",i0,"=")')i
write(32,*), v(:,i)
end do
close(43)
close(32)
end program

Input: 4i.txt
1. 1. 1.
1. 1. 0.
1. 0. 0.

Output: 4o.txt
the orthonormal vectors are :
w1=
0.577350259 0.577350259 0.577350259
w2=
0.408248305 0.408248305 -0.816496611
w3=
0.707106769 -0.707106769 -1.40489496E-08

Answer to the question no. 5

Code: A6Q5.f90
program solvelinearsystem
implicit none
integer,parameter::n=3
real::a(n,n),b(n),l(n,n),u(n,n)
real::y(n),x(n)
real::a_orig(n,n),b_orig(n)
integer::i,j,k
open(unit=20,file='5o.txt')
open(unit=10,file='5i.txt')
! read a and b from input file
do i=1,n
read(10,*) a(i,:)
end do
read(10,*) b
close(10)

! store original a and b

a_orig=a
b_orig=b

! gaussian elimination
do k=1,n-1
do i=k+1,n
b(i)=b(i)-a(i,k)/a(k,k)*b(k)
a(i,:)=a(i,:)-a(i,k)/a(k,k)*a(k,:)
end do
end do

! back-substitution
x(n)=b(n)/a(n,n)
do i=n-1,1,-1
x(i)=(b(i)-sum(a(i,i+1:n)*x(i+1:n)))/a(i,i)
end do

! open output file

write(20,*) 'solution using gaussian elimination:'

write(20,'(3f10.5)') x

! reset a and b for lu decomposition

a=a_orig
b=b_orig

! initialize l and u
l=0.0
u=0.0
do i=1,n
l(i,i)=1.0
do j=i,n
u(i,j)=a(i,j)-sum(l(i,1:i-1)*u(1:i-1,j))
end do
do j=i+1,n
l(j,i)=(a(j,i)-sum(l(j,1:i-1)*u(1:i-1,i)))/u(i,i)
end do
end do

! solve ly=b
y(1)=b(1)
do i=2,n
y(i)=b(i)-sum(l(i,1:i-1)*y(1:i-1))
end do

! solve ux=y
x(n)=y(n)/u(n,n)
do i=n-1,1,-1
x(i)=(y(i)-sum(u(i,i+1:n)*x(i+1:n)))/u(i,i)
end do

write(20,*) 'solution using lu decomposition:'

write(20,'(3f10.5)') x
close(20)

end program solvelinearsystem

Input: 5i.txt
2.0 -1.0 1.0
2.0 2.0 2.0
-1.0 -1.0 2.0
-1.0 4.0 -5.0
Output: 5o.txt
solution using gaussian elimination:
1.00000 2.00000 -1.00000
solution using lu decomposition:
1.00000 2.00000 -1.00000