Skip to content

Commit

Permalink
Faster implementation of implicit routines.
Browse files Browse the repository at this point in the history
  • Loading branch information
@stevensrjam
stevensrjam committed Feb 17, 2016
1 parent 042737a commit 2f6ab93
Show file tree
Hide file tree
Showing 3 changed files with 52 additions and 49 deletions.
41 changes: 18 additions & 23 deletions SolveImpEqnUpdate_Temp.F90
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -13,8 +13,8 @@ subroutine SolveImpEqnUpdate_Temp
use local_arrays, only : temp,rhs use local_arrays, only : temp,rhs
use decomp_2d, only: xstart,xend use decomp_2d, only: xstart,xend
implicit none implicit none
real, dimension(nx) :: amkl,apkl,ackl, fkl real, dimension(nx) :: amkl,apkl,ackl
integer :: jc,kc,info,ipkv(nx),ic integer :: jc,kc,info,ipkv(nx),ic,nrhs
real :: betadx,ackl_b real :: betadx,ackl_b
real :: amkT(nx-1),ackT(nx),apkT(nx-1),appk(nx-2) real :: amkT(nx-1),ackT(nx),apkT(nx-1),appk(nx-2)


Expand Down Expand Up @@ -45,30 +45,25 @@ subroutine SolveImpEqnUpdate_Temp
! No solving is done in this call. ! No solving is done in this call.


call dgttrf(nx,amkT,ackT,apkT,appk,ipkv,info) call dgttrf(nx,amkT,ackT,apkT,appk,ipkv,info)


nrhs=(xend(3)-xstart(3)+1)*(xend(2)-xstart(2)+1)
do ic=xstart(3),xend(3) do ic=xstart(3),xend(3)
do jc=xstart(2),xend(2) do jc=xstart(2),xend(2)

do kc=2,nxm
! Normalize RHS of equation ackl_b=1.0/(1.0-ac3ssk(kc)*betadx)

rhs(kc,jc,ic)=rhs(kc,jc,ic)*ackl_b
fkl(1)= 0.d0 end do
do kc=2,nxm
ackl_b=1.0/(1.-ac3ssk(kc)*betadx)
fkl(kc)=rhs(kc,jc,ic)*ackl_b
end do
fkl(nx)= 0.d0

! Solve equation using LAPACK library

call dgttrs('N',nx,1,amkT,ackT,apkT,appk,ipkv,fkl,nx,info)

! Update temperature field

do kc=2,nxm
temp(kc,jc,ic) = temp(kc,jc,ic) + fkl(kc)
end do end do
end do

call dgttrs('N',nx,nrhs,amkT,ackT,apkT,appk,ipkv,rhs,nx,info)


enddo do ic=xstart(3),xend(3)
do jc=xstart(2),xend(2)
do kc=2,nxm
temp(kc,jc,ic)=temp(kc,jc,ic) + rhs(kc,jc,ic)
end do
end do
end do end do


return return
Expand Down
33 changes: 18 additions & 15 deletions SolveImpEqnUpdate_X.F90
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -14,11 +14,11 @@ subroutine SolveImpEqnUpdate_X
use local_arrays, only : vx,rhs use local_arrays, only : vx,rhs
use decomp_2d, only: xstart,xend use decomp_2d, only: xstart,xend
implicit none implicit none
real, dimension(nx) :: amkl,apkl,ackl, fkl real, dimension(nx) :: amkl,apkl,ackl
real :: amkT(nx-1),apkT(nx-1) real :: amkT(nx-1),apkT(nx-1)
real :: appk(nx-2) real :: appk(nx-2)
real :: ackT(nx) real :: ackT(nx)
integer :: jc,kc,info,ic integer :: jc,kc,info,ic,nrhs
integer :: ipkv(nx) integer :: ipkv(nx)
real :: betadx,ackl_b real :: betadx,ackl_b


Expand All @@ -43,21 +43,24 @@ subroutine SolveImpEqnUpdate_X


call dgttrf(nx,amkT,ackT,apkT,appk,ipkv,info) call dgttrf(nx,amkT,ackT,apkT,appk,ipkv,info)


nrhs=(xend(3)-xstart(3)+1)*(xend(2)-xstart(2)+1)
do ic=xstart(3),xend(3) do ic=xstart(3),xend(3)
do jc=xstart(2),xend(2) do jc=xstart(2),xend(2)
fkl(1)= 0.d0 do kc=2,nxm
do kc=2,nxm ackl_b=1.0/(1.0-ac3ck(kc)*betadx)
ackl_b=1.0d0/(1.0d0-ac3ck(kc)*betadx) rhs(kc,jc,ic)=rhs(kc,jc,ic)*ackl_b
fkl(kc) = rhs(kc,jc,ic)*ackl_b end do
enddo end do
fkl(nx)= 0.d0 end do

call dgttrs('N',nx,1,amkT,ackT,apkT,appk,ipkv,fkl,nx,info) call dgttrs('N',nx,nrhs,amkT,ackT,apkT,appk,ipkv,rhs,nx,info)


do kc=2,nxm do ic=xstart(3),xend(3)
vx(kc,jc,ic)=vx(kc,jc,ic) + fkl(kc) do jc=xstart(2),xend(2)
enddo do kc=2,nxm
enddo vx(kc,jc,ic)=vx(kc,jc,ic) + rhs(kc,jc,ic)
end do
end do
end do end do


return return
Expand Down
27 changes: 16 additions & 11 deletions SolveImpEqnUpdate_YZ.F90
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -17,8 +17,8 @@ subroutine SolveImpEqnUpdate_YZ(q,rhs)
& xstart(3)-lvlhalo:xend(3)+lvlhalo) & xstart(3)-lvlhalo:xend(3)+lvlhalo)
real,intent(inout) :: rhs(1:nx,xstart(2):xend(2), & real,intent(inout) :: rhs(1:nx,xstart(2):xend(2), &
& xstart(3):xend(3)) & xstart(3):xend(3))
real, dimension(nx) :: amkl,apkl,ackl,fkl real, dimension(nx) :: amkl,apkl,ackl
integer :: jc,kc,info,ipkv(nxm),ic integer :: jc,kc,info,ipkv(nxm),ic,nrhs
real :: betadx,ackl_b real :: betadx,ackl_b
real :: amkT(nxm-1),ackT(nxm),apkT(nxm-1),appk(nx-3) real :: amkT(nxm-1),ackT(nxm),apkT(nxm-1),appk(nx-3)


Expand All @@ -37,19 +37,24 @@ subroutine SolveImpEqnUpdate_YZ(q,rhs)


call dgttrf(nxm,amkT,ackT,apkT,appk,ipkv,info) call dgttrf(nxm,amkT,ackT,apkT,appk,ipkv,info)


do ic=xstart(3),xend(3) nrhs=(xend(3)-xstart(3)+1)*(xend(2)-xstart(2)+1)
do jc=xstart(2),xend(2) do ic=xstart(3),xend(3)
do kc=1,nxm do jc=xstart(2),xend(2)
ackl_b=1.0d0/(1.-ac3sk(kc)*betadx) do kc=1,nxm
fkl(kc)=rhs(kc,jc,ic)*ackl_b ackl_b=1.0/(1.0-ac3sk(kc)*betadx)
rhs(kc,jc,ic)=rhs(kc,jc,ic)*ackl_b
end do
end do end do
end do


call dgttrs('N',nxm,1,amkT,ackT,apkT,appk,ipkv,fkl,nxm,info) call dgttrs('N',nxm,nrhs,amkT,ackT,apkT,appk,ipkv,rhs,nx,info)


do kc=1,nxm do ic=xstart(3),xend(3)
q(kc,jc,ic)=q(kc,jc,ic) + fkl(kc) do jc=xstart(2),xend(2)
do kc=1,nxm
q(kc,jc,ic)=q(kc,jc,ic) + rhs(kc,jc,ic)
end do
end do end do
end do
end do end do


return return
Expand Down

0 comments on commit 2f6ab93

Please sign in to comment.