Skip to content

Commit 440e168

Browse files
committed
Switch to pardiso solver
1 parent 31cf45d commit 440e168

4 files changed

Lines changed: 25 additions & 19 deletions

File tree

src/heatflow/mod_evolve.f90

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ module evolution
3131
use boundary_vector, only: boundary
3232
use cattaneo, only: S_catS
3333
! use tempdep, only: ChangeProp
34-
use sparse_solver, only: bicgstab
34+
use sparse_solver, only: bicgstab, solve_pardiso
3535
implicit none
3636

3737
private
@@ -46,8 +46,8 @@ module evolution
4646
!!!#################################################################################################
4747
subroutine simulate(itime)
4848
integer(int12), intent(in) :: itime
49-
real(real12), dimension(NA) :: S, x, Q, Qdens, S_CAT, B
50-
real(real12), dimension(:), allocatable :: x0
49+
real(real12), dimension(NA) :: S, Q, Qdens, S_CAT, B
50+
real(real12), dimension(:), allocatable :: x
5151
integer:: ncg, itol, itmax !, iss
5252
integer :: iter
5353
real(real12) :: e, err, tol
@@ -140,21 +140,23 @@ subroutine simulate(itime)
140140
! iter: Output - gives the number of the final iteration.
141141
! err: Output - records the error of the final iteration.
142142
! iss: Input - sets the Sparse Storage type (1=SRS, 2=SDS).
143-
x=Temp_p+(Temp_p-Temp_pp)
144-
if (any(x-Temp_p .lt. TINY)) x=x+TINY !avoid nan solver issue
143+
! x=Temp_p+(Temp_p-Temp_pp)
144+
! if (any(x-Temp_p .lt. TINY)) x=x+TINY !avoid nan solver issue
145145
itol=1
146146
tol=1.e-32_real12
147147
itmax=50000
148148
ncg = 0
149-
iter=ncg
149+
iter= 0
150150
err=E
151151

152152

153-
CALL bicgstab(acsr, ia, ja, S, itmax, x, x0, iter)
153+
! CALL bicgstab(acsr, ia, ja, S, itmax, x, x0, iter)
154+
155+
CALL solve_pardiso(acsr, S, ia, ja, x)
154156
! CALL linbcg(S,x,itol=int(itol,I4B),tol=tol, itmax=int(itmax,I4B), iter=iter, &
155-
! err=E)
157+
! err=E)
156158

157-
x=x0
159+
!
158160
if (any(isnan(x(:)))) then
159161
write(0,*) "fatal error: NAN in x tempurature vector"
160162
write(0,*) 'time step ', itime, " T ", sum(Temp_p)/size(Temp_p), E ,iter

src/heatflow/mod_global.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,8 @@ module globe_data
1414
TYPE(sprs2_dp) :: ra !Techniqually rH
1515
TYPE(diag_sprs_dp) :: da !Techniqually dH
1616
real(real12), dimension(:), allocatable :: acsr
17-
integer (kind=8), dimension(:), allocatable :: ja
18-
integer (kind=8), dimension(:), allocatable :: ia
17+
integer, dimension(:), allocatable :: ja
18+
integer, dimension(:), allocatable :: ia
1919

2020
end module globe_data
2121

src/heatflow/mod_setup.f90

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,8 @@ subroutine set_global_variables()
8181
CALL sparse_Hmatrix()
8282
! Allocate the arrays to hold the H matrix in CSR format
8383
allocate(acsr(ra%len), ja(ra%len), ia(ra%n+1))
84-
CALL coo2csr(ra%n, ra%len, ra%val, ra%irow, ra%jcol, acsr, ja, ia)
84+
CALL coo2csr(ra%n, ra%len, ra%val, ra%irow, ra%jcol, acsr, ja, ia)
85+
! print*, ra%val
8586
end if
8687
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
8788

src/heatflow/mod_sparse_solver.f90

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -56,8 +56,8 @@ subroutine coo2csr( nrow, &
5656
integer (kind=8), dimension(nnz), intent(in) :: ir
5757
integer (kind=8), dimension(nnz), intent(in) :: jc
5858
real(8), dimension(nnz), intent(out) :: acsr
59-
integer (kind=8), dimension(nnz), intent(out) :: ja
60-
integer (kind=8), dimension(nrow+1), intent(out) :: ia
59+
integer, dimension(nnz), intent(out) :: ja
60+
integer, dimension(nrow+1), intent(out) :: ia
6161

6262
! Local variables.
6363
integer (kind=8) :: i, iad, j, k, k0
@@ -151,16 +151,17 @@ subroutine bicgstab( acsr, &
151151
call mkl_dcsrgemv("N",n,acsr,ia,ja,x,temp1)
152152

153153
r = b - temp1
154-
154+
155155
call random_number(rst)
156156

157157
p = r
158+
158159
delta = dot_product(rst,r)
159-
160+
160161
write(*,'(a,1x,f15.3)') "Starting delta: ", delta
161162

162163
delta0 = delta
163-
164+
164165
do i = 1, maxiter
165166

166167
if ( norm2(r) /= norm2(r) ) then
@@ -187,7 +188,7 @@ subroutine bicgstab( acsr, &
187188
delta = dot_product(rst,r)
188189
beta = (delta/delta_old)*(alpha/omega)
189190
p = r + beta*(p - omega*temp1)
190-
191+
191192
if(norm2(r) .lt. cc) then
192193
iter = i
193194
return
@@ -247,7 +248,9 @@ subroutine solve_pardiso( acsr, &
247248
mnum = 1
248249

249250
if (.not.(allocated(x))) allocate(x(n))
250-
251+
252+
253+
251254
allocate(iparm(64)) !set up pardiso control parameter
252255

253256
do i=1,64

0 commit comments

Comments
 (0)