Skip to content

Commit

Permalink
Revised arrays to allocatable for many kpoints
Browse files Browse the repository at this point in the history
  • Loading branch information
@sjhong6230
sjhong6230 committed Apr 16, 2024
1 parent a49f38a commit f8527df
Show file tree
Hide file tree
Showing 2 changed files with 51 additions and 26 deletions.
58 changes: 47 additions & 11 deletions src/kmesh.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ subroutine kmesh_get(kmesh_input, kmesh_info, print_output, kpt_latt, real_latti
! local variables
real(kind=dp), allocatable :: bvec_tmp(:, :)
real(kind=dp), allocatable :: kpt_cart(:, :)
real(kind=dp) :: bk_local(3, num_nnmax, num_kpts) !, kpbvec(3)
real(kind=dp), allocatable :: bk_local(:, :, :) !, kpbvec(3)
real(kind=dp) :: bweight(max_shells)
real(kind=dp), parameter :: eta = 99999999.0_dp ! eta = very large
real(kind=dp) :: dist, dnn0, dnn1, bb1, bbn, ddelta
Expand All @@ -102,13 +102,31 @@ subroutine kmesh_get(kmesh_input, kmesh_info, print_output, kpt_latt, real_latti
integer, allocatable :: nnlist_tmp(:, :), nncell_tmp(:, :, :) ![ysl]
integer :: ifound, counter, na, nap, loop_s, loop_b, shell !, nbvec, bnum
integer :: ifpos, ifneg, ierr, multi(kmesh_input%search_shells)
integer :: lmn(3, (2*nsupcell + 1)**3) ! Order in which to search the cells (ordered in dist from origin)
integer, allocatable :: lmn(:, :) ! Order in which to search the cells (ordered in dist from origin)
integer :: nlist, nkp, nkp2, l, m, n, ndnn, ndnnx, ndnntot
integer :: nnshell(num_kpts, kmesh_input%search_shells)
integer, allocatable :: nnshell(:, :)
integer :: nnsh, nn, nnx, loop, i, j

if (print_output%timing_level > 0) call io_stopwatch_start('kmesh: get', timer)

allocate (bk_local(3, num_nnmax, num_kpts), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating bk_local in kmesh_get', comm)
return
endif

allocate (lmn(3, (2*nsupcell + 1)**3), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating lmn in kmesh_get', comm)
return
endif

allocate (nnshell(num_kpts, kmesh_input%search_shells), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating nnshell in kmesh_get', comm)
return
endif

call utility_recip_lattice(real_lattice, recip_lattice, volume, error, comm)
if (print_output%iprint > 0) write (stdout, '(/1x,a)') &
'*---------------------------------- K-MESH ----------------------------------*'
Expand Down Expand Up @@ -734,14 +752,32 @@ subroutine kmesh_get(kmesh_input, kmesh_info, print_output, kpt_latt, real_latti
return
endif

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

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

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

if (print_output%timing_level > 0) call io_stopwatch_stop('kmesh: get', timer)

return

end subroutine kmesh_get

subroutine kmesh_sort(kmesh_info, num_kpts, error, comm)
!==================================================================!
!==================================================================!
! !
!! Sorts b vectors !
! !
Expand All @@ -764,7 +800,7 @@ subroutine kmesh_sort(kmesh_info, num_kpts, error, comm)
integer, allocatable :: nnlist_tmp(:), nncell_tmp(:, :)
integer :: na, nn, nkp, ifpos, ifneg, ierr

allocate(wb_tmp(kmesh_info%nntot), stat=ierr)
allocate (wb_tmp(kmesh_info%nntot), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating wb_tmp in kmesh_sort', comm)
return
Expand All @@ -781,24 +817,24 @@ subroutine kmesh_sort(kmesh_info, num_kpts, error, comm)
enddo
enddo
kmesh_info%wb(:) = wb_tmp(:)

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

allocate(nnlist_tmp(kmesh_info%nntot), stat=ierr)
allocate (nnlist_tmp(kmesh_info%nntot), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating nnlist_tmp in kmesh_sort', comm)
return
endif
allocate(bk_tmp(3, kmesh_info%nntot), stat=ierr)
allocate (bk_tmp(3, kmesh_info%nntot), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating bk_tmp in kmesh_sort', comm)
return
endif
allocate(nncell_tmp(3, kmesh_info%nntot), stat=ierr)
allocate (nncell_tmp(3, kmesh_info%nntot), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating nncell_tmp in kmesh_sort', comm)
return
Expand All @@ -823,7 +859,7 @@ subroutine kmesh_sort(kmesh_info, num_kpts, error, comm)
kmesh_info%nncell(:, nkp, :) = nncell_tmp(:, :)
kmesh_info%bk(:, :, nkp) = bk_tmp(:, :)
enddo

deallocate (nnlist_tmp, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error in deallocating nnlist_tmp in kmesh_sort', comm)
Expand Down Expand Up @@ -1987,4 +2023,4 @@ function internal_maxloc(dist)

end function internal_maxloc

end module w90_kmesh
end module w90_kmesh
19 changes: 4 additions & 15 deletions tutorials/tutorial34/Marzari-Vanderbilt/silicon.win
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,26 +12,15 @@ length_unit = bohr
use_ss_functional = .false.

begin projections
!! !! Bond-centred s-orbitals
f=-0.125,-0.125, 0.375:s
f= 0.375,-0.125,-0.125:s
f=-0.125, 0.375,-0.125:s
f=-0.125,-0.125,-0.125:s
!! !! Atom-centred sp3-orbitals
Si:sp3
end projections

!! (1) Valence bands
num_wann = 4
select_projections 1 2 3 4
dis_froz_max = 6.5
dis_win_max = 6.5

!! !! (2) Valence + conduction bands
!! num_wann = 8
!! select_projections 5-12
!! dis_froz_max = 6.5
!! dis_win_max = 17.0
!! (2) Valence + conduction bands
num_wann = 8
dis_froz_max = 6.5
dis_win_max = 17.0


begin unit_cell_cart
Expand Down

0 comments on commit f8527df

Please sign in to comment.