Scribd
Upload
251 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
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
251 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
We take content rights seriously. If you suspect this is your content, claim it here.
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

pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy