Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix/segfault hamiltonian get hr #469

Merged
merged 6 commits into from
Feb 16, 2024
Merged

Fix/segfault hamiltonian get hr #469

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
628855d
Allocating the arrays eigval_opt, eigval2 and utmp in the RAM.
mikibonacci Feb 15, 2024
f374c37
This commit optimize the allocation of eigval_opt, utmp and eigval2, …
mikibonacci Feb 15, 2024
e04e284
adding dimension hint as a comment for eigval_opt, eigval2 and utmp
mikibonacci Feb 15, 2024
8293cd5
making allocatable, in the routine sitesym_dis_extract_symmetry (site…
mikibonacci Feb 15, 2024
8daef34
pre-commit fix
mikibonacci Feb 16, 2024
210b2cd
adding the deallocation of variables
mikibonacci Feb 16, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
54 changes: 50 additions & 4 deletions src/hamiltonian.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -280,10 +280,10 @@ subroutine hamiltonian_get_hr(atom_data, dis_manifold, ham_logical, real_space_h
! local variables
integer :: loop_kpt, i, j, m, irpt, ierr, counter
real(kind=dp) :: rdotk
real(kind=dp) :: eigval_opt(num_bands, num_kpts)
real(kind=dp) :: eigval2(num_wann, num_kpts)
real(kind=dp), allocatable :: eigval_opt(:, :) !(num_bands, num_kpts)
real(kind=dp), allocatable :: eigval2(:, :) !(num_wann, num_kpts)
real(kind=dp) :: irvec_tmp(3)
complex(kind=dp) :: utmp(num_bands, num_wann)
complex(kind=dp), allocatable :: utmp(:, :) !(num_bands, num_wann)
complex(kind=dp) :: fac

if (print_output%timing_level > 1) call io_stopwatch_start('hamiltonian: get_hr', timer)
Expand All @@ -299,11 +299,33 @@ subroutine hamiltonian_get_hr(atom_data, dis_manifold, ham_logical, real_space_h
if (ham_logical%have_ham_k) go to 100

ham_k = cmplx_0
eigval_opt = 0.0_dp

allocate (eigval2(num_wann, num_kpts), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating eigval2 in hamiltonian_get_hr', comm)
return
endif

eigval2 = 0.0_dp

if (have_disentangled) then

! start allocation of eigval_opt, utmp; used only if have_disentangled.
allocate (eigval_opt(num_bands, num_kpts), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating eigval_opt in hamiltonian_get_hr', comm)
return
endif

allocate (utmp(num_bands, num_wann), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating utmp in hamiltonian_get_hr', comm)
return
endif

eigval_opt = 0.0_dp
! end allocation of eigval_opt, utmp

! slim down eigval to contain states within the outer window

do loop_kpt = 1, num_kpts
Expand Down Expand Up @@ -452,6 +474,30 @@ subroutine hamiltonian_get_hr(atom_data, dis_manifold, ham_logical, real_space_h
endif
end if

if (allocated(eigval2)) then
deallocate (eigval2, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating eigval2 in hamiltonian_get_hr', comm)
return
endif
end if

if (allocated(eigval_opt)) then
deallocate (eigval_opt, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating eigval_opt in hamiltonian_get_hr', comm)
return
endif
end if

if (allocated(utmp)) then
deallocate (utmp, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating utmp in hamiltonian_get_hr', comm)
return
endif
end if

if (print_output%timing_level > 1) call io_stopwatch_stop('hamiltonian: get_hr', timer)

return
Expand Down
59 changes: 54 additions & 5 deletions src/sitesym.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -560,7 +560,7 @@ subroutine sitesym_dis_extract_symmetry(sitesym, lambda, umat, zmat, ik, n, num_
!================================================!

use w90_wannier90_types, only: sitesym_type
use w90_error, only: w90_error_type, set_error_fatal
use w90_error, only: w90_error_type, set_error_fatal, set_error_alloc, set_error_dealloc

implicit none

Expand All @@ -579,15 +579,40 @@ subroutine sitesym_dis_extract_symmetry(sitesym, lambda, umat, zmat, ik, n, num_
complex(kind=dp), intent(inout) :: umat(:, :) !(num_bands, num_wann)

! local variables
complex(kind=dp) :: umatnew(num_bands, num_wann) !jj normally don't we alloc explicitly?
complex(kind=dp) :: ZU(num_bands, num_wann)
complex(kind=dp) :: deltaU(num_bands, num_wann), carr(num_bands)
complex(kind=dp), allocatable :: umatnew(:, :) !(num_bands, num_wann)
complex(kind=dp), allocatable :: ZU(:, :) !(num_bands, num_wann)
complex(kind=dp), allocatable :: deltaU(:, :) !(num_bands, num_wann)
complex(kind=dp), allocatable :: carr(:) !(num_bands)
integer :: i, m, INFO, IFAIL(2), IWORK(5*2)
complex(kind=dp) :: HP(3), SP(3), V(2, 2), CWORK(2*2)
real(kind=dp) :: W(2), RWORK(7*2), sp3
integer :: iter
integer :: iter, ierr
integer, parameter :: niter = 50

allocate (umatnew(num_bands, num_wann), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating umatnew in sitesym_dis_extract_symmetry', comm)
return
endif

allocate (ZU(num_bands, num_wann), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating ZU in sitesym_dis_extract_symmetry', comm)
return
endif

allocate (deltaU(num_bands, num_wann), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating deltaU in sitesym_dis_extract_symmetry', comm)
return
endif

allocate (carr(num_bands), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating carr in sitesym_dis_extract_symmetry', comm)
return
endif

do iter = 1, niter
! Z*U
call zgemm('N', 'N', n, num_wann, n, cmplx_1, zmat, num_bands, umat, num_bands, cmplx_0, ZU, &
Expand Down Expand Up @@ -642,6 +667,30 @@ subroutine sitesym_dis_extract_symmetry(sitesym, lambda, umat, zmat, ik, n, num_
umat(:, :) = umatnew(:, :)
enddo ! iter

deallocate (umatnew, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating umatnew in sitesym_dis_extract_symmetry', comm)
return
endif

deallocate (ZU, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating ZU in sitesym_dis_extract_symmetry', comm)
return
endif

deallocate (deltaU, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating deltaU in sitesym_dis_extract_symmetry', comm)
return
endif

deallocate (carr, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating carr in sitesym_dis_extract_symmetry', comm)
return
endif

return
end subroutine sitesym_dis_extract_symmetry

Expand Down
Loading