From f8527df440e5face8ec1ed089c7f8cc5c6e31b2d Mon Sep 17 00:00:00 2001 From: sjhong6230 Date: Tue, 16 Apr 2024 16:37:17 +0900 Subject: [PATCH] Revised arrays to allocatable for many kpoints --- src/kmesh.F90 | 58 +++++++++++++++---- .../tutorial34/Marzari-Vanderbilt/silicon.win | 19 ++---- 2 files changed, 51 insertions(+), 26 deletions(-) diff --git a/src/kmesh.F90 b/src/kmesh.F90 index 3fae9885..13ed705d 100644 --- a/src/kmesh.F90 +++ b/src/kmesh.F90 @@ -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 @@ -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 ----------------------------------*' @@ -734,6 +752,24 @@ 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 @@ -741,7 +777,7 @@ subroutine kmesh_get(kmesh_input, kmesh_info, print_output, kpt_latt, real_latti end subroutine kmesh_get subroutine kmesh_sort(kmesh_info, num_kpts, error, comm) - !==================================================================! + !==================================================================! ! ! !! Sorts b vectors ! ! ! @@ -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 @@ -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 @@ -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) @@ -1987,4 +2023,4 @@ function internal_maxloc(dist) end function internal_maxloc -end module w90_kmesh \ No newline at end of file +end module w90_kmesh diff --git a/tutorials/tutorial34/Marzari-Vanderbilt/silicon.win b/tutorials/tutorial34/Marzari-Vanderbilt/silicon.win index 55e9e9dc..a5f858ee 100644 --- a/tutorials/tutorial34/Marzari-Vanderbilt/silicon.win +++ b/tutorials/tutorial34/Marzari-Vanderbilt/silicon.win @@ -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