Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
Scribd
Upload
230 views

Fortran Program For Solving 2

2D steady state heat transfer using direct solver and iterative solver (guss jordan, gauss siedal etc) on fortran .

Uploaded by

Abhijit Kushwaha
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
230 views

Fortran Program For Solving 2

2D steady state heat transfer using direct solver and iterative solver (guss jordan, gauss siedal etc) on fortran .

Uploaded by

Abhijit Kushwaha
Copyright
© © All Rights Reserved
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 15

Fortran program for solving 2-D steady state heat equation using direct method and iterative solver.

program deheating
implicit none
real,dimension(:,:),allocatable::h
real,dimension(:,:),allocatable::p
real,dimension(:,:),allocatable::b
real,dimension(:,:),allocatable::y
real,dimension(:),allocatable::error1
real,dimension(:,:),allocatable::add,plus,error
real,dimension(:,:),allocatable::o
integer::j,n,ns,c,i,t1,t2,u,w,m,k,g,choose
real::s,t,x,y1,y2,sum,xmult,v,e,emax,error2,sor,weight
print*,'enter the number of computational cell per unit dimensions'
read*,m

print*,'enter thermal conductivity of the material'


read*,v

print*,'enter the source strength'


read*,s

print*,'enter the wall temperature'


read*,t

n=m-1
print*,'the number of unknown variables are n=',n

ns=n**2

print*, 'the size of matrix =',ns


error2=0
e=1d-6
x=1.0/real(m)
print*,'the size of each cell is ',x
allocate(h(ns,ns))
allocate(o(ns,ns))
allocate(p(ns,1))
allocate(b(ns,1))
allocate(y(1000,1000))
allocate(error(1000,1000))
allocate(error1(1000))
allocate(add(1000,1000))
allocate(plus(1000,1000))
do i=1,ns
do j=1,ns
do k=1,1000
o(i,j)=0
add(k,k)=0
plus(k,k)=0
y(k,k)=0
error(k,k)=0
error1(k)=0
h(i,j)=0
b(i,1)=0
p(i,1)=0
end do
end do

end do
!!!!!!!!!!!!!!!!!!EQUATION OF BOTTOM LEFT POINT!!!!!!!!!!!!!!!!!!!!!!
h(1,1)=-4
h(1,2)=1
h(1,n+1)=1
b(1,1)=((-1*(x**2)*s)/v)-2*t
!!!!!!!!!!!!!!!EQUATION OF BOTTOM RIGHT POINT!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
h(n,n)=-4
h(n,n-1)=1
h(n,n+n)=1
b(n,1)=((-1*(x**2)*s)/v)-2*t
!!!!!!!!!!!!!!!!!!!!!!EQUATION OF TOP LEFT POINT!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
h(n*(n-1)+1,n*(n-1)+1)=-4
h(n*(n-1)+1,n*(n-2)+1)=1
h(n*(n-1)+1,n*(n-1)+2)=1
b(n*(n-1)+1,1)=((-1*(x**2)*s)/v)-2*t
!!!!!!!!!!!!!!!!!!!!!!!!EQUATION OF TOP RIGHT POINT!!!!!!!!!!!!!!!!!!!!!!!!!!!
h(n*n,n*n)=-4
h(n*n,n*n-1)=1
h(n*n,n*n-n)=1
b(n*n,1)=((-1*(x**2)*s)/v)-2*t

!!!!!!!!!!!!!!!!!!!!!!!EQUATION OF LOWER HORIZONTAL ROW!!!!!!!!!!!!!!!!!!!!!!!!!!!1


do i=2,n-1
h(i,i)=-4
h(i,i+1)=1
h(i,i-1)=1
h(i,i+n)=1

b(i,1)= ((-1*(x**2)*s)/v)-t
end do
!!!!!!!!!!EQUATION OF TOP HORIZONTAL ROW!!!!!!!!!!!!!!!!!!!!!!!
t1=n*(n-1)+2
t2=n*n-1
do i=t1,t2
h(i,i)=-4
h(i,i+1)=1
h(i,i-1)=1
h(i,i-n)=1
b(i,1)= ((-1*(x**2)*s)/v)-t
end do

!!!!!!!!!!!!!!!!!!!!!!!!!!EQUATION OF LEFT VERTICAL COLUMN!!!!!!!!!!!!!!!!!!!!!1


t1=n+1
t2=n*(n-2)+1
do i=t1,t2,n
h(i,i)=-4
h(i,i+1)=1
h(i,i+n)=1
h(i,i-n)=1
b(i,1)= ((-1*(x**2)*s)/v)-t
end do
!!!!!!!!!!!!!!!!!!!!!!!!!EQUATION OF RIGHT VERTICAL COLUMN!!!!!!!!!!!!!!!!!!!!!!
t1=2*n
t2=n*(n-1)
do i=t1,t2,n
h(i,i)= -4

h(i,i-1)=1
h(i,i+n)=1
h(i,i-n)=1
b(i,1)= ((-1*(x**2)*s)/v)-t
end do
!!!!!!!!!!!!!!!!!!!!!!!!!!EQUATION OF NODES IN MIDDLE MATRIX!!!!!!!!!!!!!!!!!!!!!!!
do i=1,n-2
do j=(i*n)+2,((i+1)*n)-1
h(j,j)=-4
h(j,j+1)=1
h(j,j-1)=1
h(j,j+n)=1
h(j,j-n)=1
b(j,1)= (-1*(x**2)*s)/v
end do
end do

do i=1,ns
do j=1,ns
p(i,1)=b(i,1)
o(i,j)=h(i,j)
end do
end do
write(*,*)'To choose an iterative scheme, please enter respective number: GE=0,PJ=1,GS=2,SOR=3'
write(*,*)'Please enter the value, corresponds to method which you want to choose: '
read(*,*)choose
if (choose==0) then

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!gauss elimination scheme!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

print*,'gauss elimination scheme is selceted'


do k=1,ns-1
do i=k+1,ns
xmult=h(i,k)/h(k,k)
p(i,1)=p(i,1)-p(k,1)*xmult

do j=1,ns
h(i,j)=h(i,j)-xmult*h(k,j)
end do
end do
end do

do i=ns,1,-1
sum=p(i,1)
if (i .lt. ns) then
do j=i+1,ns
sum=sum-p(j,1)*h(i,j)
end do
end if
p(i,1)=sum/h(i,i)

!!!!!!!!!!!!!WRITING THE RESULT IN THE DAT. FILE!!!!!!!!!!!!!!!


open(unit=1,file='edata.dat')
write(1,*),i,p(i,1)
print*,i,p(i,1)

end do
print*,'values at (0.25,0.25) and (0.5,0.5) and (0.75,0.75) are:'

print*,p(n+2,1),p(3*n+4,1),p(5*n+6,1)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!ITERATIVE SCHEMES!!!!!!!!!!!!!!!!

else if(choose==1)then
write(*,*)'Selected POINT JACOBI method'
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!POINT JACOBI !!!!!!!!!!!!!!!!!!!

!!!!!!!!!!!!!!!INTIALIZING THE VARIABLES!!!!!!!!!!!

Print*,'Please enter intial guess :'


read(*,*)c
do k=1,1000
do j=1,1000
if(k==1)then
y(:,1) = c
else
y(j,k) = 0
end if
end do
end do

do i=1,1000
do j=1,1000
add(i,j) = 0
end do
end do

write(*,*)'Iteration no. node number

value '

do k=1,1000
do j =1,ns
do i =1,ns

add(j,k) = add(j,k)+ o(j,i)*y(i,k)

end do

y(j,k+1) = (( b(j,1) - add(j,k) + (o(j,j) * y(j,k)))/o(j,j))


if(j==1)then
if(abs(y(j,k+1) - y(j,k)).lt.e)then
do g=1,ns
print*,k,g,y(g,k)
open(unit=2,file='pdata.dat')
write(2,*),g,y(g,k)
end do
print*,'values at (0.25,0.25) and (0.5,0.5) and (0.75,0.75) are:'
print*,y(n+2,k),y(3*n+4,k),y(5*n+6,k)
stop
end if
end if
end do
end do
!!!!!!!!!!!!!!!!!!!!gauss siedal method!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
else if (choose==2) then

print*,'gauss siedal method selected'

write(*,*)'Please enter intial guess :'


read(*,*)c
do k=1,1000
do j=1,1000
if(k==1)then
y(:,1) = c
else
y(j,k) = 0
end if
end do
end do

do i=1,1000
do j=1,1000
add(i,j) = 0
add(i,j)=0
end do
end do

do k=1,1000
do j =1,ns
do i=1,j-1
if(j==1)then
add(j,k) = 0
else
add(j,k) = add(j,k)+ o(j,i)*y(i,k+1)

end if
end do
do i =j+1,ns
plus(j,k) = plus(j,k)+ o(j,i)*y(i,k)
end do
y(j,k+1) = (( b(j,1) - add(j,k)-plus(j,k) )/o(j,j))
!write(*,*)m,j,x(j,m+1)
if(j==1)then
if(abs(y(j,k+1) - y(j,k)).lt.e)then
do g=1,ns
print*,k,g,y(g,k)

open(unit=3,file='sdata.dat')
write(3,*),g,y(g,k)
end do
print*,'values at (0.25,0.25) and (0.5,0.5) and (0.75,0.75) are:'
print*,y(n+2,k),y(3*n+4,k),y(5*n+6,k)
stop
end if
end if

end do

end do
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SOR methods!!!!!!!!!!!!!!!!!

else if(choose==3) then


write(*,*)'Selected SOR method'

write(*,*)'Please enter intial guess :'


read(*,*)c
weight =1.0
do k=1,1000
do j=1,1000
if(k==1)then
y(:,1) = c
else
y(j,k) = 0
end if
end do
end do

do i=1,1000
do j=1,1000
add(i,j) = 0
plus(i,j)=0
end do
end do

do k=1,1000
do j =1,ns
do i=1,j-1
if(j==1)then
add(j,k) = 0
else
add(j,k) = add(j,k)+ (o(j,i)*y(i,k+1) )
end if

end do
do i =j,ns
plus(j,k) = plus(j,k)+ (o(j,i)*y(i,k) )
end do
sor = (( b(j,1) - add(j,k)-plus(j,k) )/(o(j,j)))
y(j,k+1) = y(j,k) + (weight*sor)
sor = 0
end do
do j =1,ns
error(j,k)=abs((y(j,k+1)-y(j,k))/y(j,k+1))
end do
error1 = maxval(error, 1)
error2=maxval(error1)
error=0.0d0
if (error2 .le. e ) then
do g=1,ns
print*,k,g,y(g,k)
open(4,file='sor.dat')
write(4,*)g,y(g,k)
end do
print*,'values at (0.25,0.25) and (0.5,0.5) and (0.75,0.75) are:'
print*,y(n+2,k),y(3*n+4,k),y(5*n+6,k)
open(9,file='sor1.dat')
write(9,*)y(n+2,k+1),y(3*n+4,k+1),y(5*n+6,k+1)

close(9)
close(3)
stop

end if
end do
end if
end program deheating

(B) Temperature at (0.25,0.25) ,(0.5,0.5) and (0.75,0.75) using SOR method are 300.088165,
300.143860 and 300.088684 respectively . This result is for of 8 number computational cells.
Using gauss siedal , temperature are 300.088928 ,300.144989 and 300.089111 respectively
Using point Jacobi , temperatures are 300.087708 ,300.142334 and 300.087708 respectively

You might also like