diff --git a/PP/src/bgw2pw.f90 b/PP/src/bgw2pw.f90 index b24ce8215..6610b4494 100644 --- a/PP/src/bgw2pw.f90 +++ b/PP/src/bgw2pw.f90 @@ -134,10 +134,6 @@ PROGRAM bgw2pw CALL read_file ( ) - ! this is needed to compute k+G indices and store them into igk_k - - CALL hinit0 ( ) - CALL openfil_pp ( ) IF ( wfng_flag ) THEN diff --git a/PP/src/do_initial_state.f90 b/PP/src/do_initial_state.f90 index 0be42370a..fa9581669 100644 --- a/PP/src/do_initial_state.f90 +++ b/PP/src/do_initial_state.f90 @@ -34,8 +34,8 @@ SUBROUTINE do_initial_state (excite) USE extfield, ONLY : tefield, forcefield USE uspp, ONLY : nkb, vkb USE uspp_param, ONLY : nh - USE klist, ONLY : nks, xk - USE wvfct, ONLY : npw, npwx, igk + USE klist, ONLY : nks, xk, ngk, igk_k + USE wvfct, ONLY : npwx USE ener, ONLY : ef USE parameters, ONLY : ntypx USE control_flags, ONLY: gamma_only @@ -139,7 +139,7 @@ SUBROUTINE do_initial_state (excite) IF ( nks == 1 ) THEN ik = 1 - IF ( nkb > 0 ) CALL init_us_2( npw, igk, xk(1,ik), vkb ) + IF ( nkb > 0 ) CALL init_us_2( ngk(ik), igk_k(1,ik), xk(1,ik), vkb ) ENDIF shift_nl = - shift_nl shift_lc = - shift_lc @@ -158,7 +158,7 @@ SUBROUTINE do_initial_state (excite) IF(nkb>0) ALLOCATE(vkb(npwx,nkb)) IF ( nks == 1 ) THEN ik = 1 - IF ( nkb > 0 ) CALL init_us_2( npw, igk, xk(1,ik), vkb ) + IF ( nkb > 0 ) CALL init_us_2( ngk(ik), igk_k(1,ik), xk(1,ik), vkb ) ENDIF ENDIF diff --git a/PP/src/initial_state.f90 b/PP/src/initial_state.f90 index b0f620579..42e27212f 100644 --- a/PP/src/initial_state.f90 +++ b/PP/src/initial_state.f90 @@ -19,8 +19,7 @@ PROGRAM initial_state USE kinds, ONLY : DP USE io_files, ONLY : prefix, tmp_dir, iunwfc, nwordwfc USE ions_base, ONLY : nat - USE klist, ONLY : nks, xk - USE wvfct, ONLY : npw, igk + USE klist, ONLY : nks, xk, igk_k, ngk USE uspp, ONLY : nkb, vkb USE wavefunctions_module, ONLY : evc USE parameters, ONLY : ntypx @@ -78,15 +77,12 @@ PROGRAM initial_state ! CALL read_file CALL openfil_pp - CALL hinit0 IF ( nks == 1 ) THEN ik = 1 CALL davcio( evc, 2*nwordwfc, iunwfc, ik, -1 ) - IF ( nkb > 0 ) CALL init_us_2( npw, igk, xk(1,ik), vkb ) + IF ( nkb > 0 ) CALL init_us_2( ngk(ik), igk_k(1,ik), xk(1,ik), vkb ) ENDIF - !CALL sum_band - ! CALL do_initial_state (excite) ! CALL environment_end ( 'initstate' ) diff --git a/PP/src/pw2bgw.f90 b/PP/src/pw2bgw.f90 index 1808cb339..362583b8e 100644 --- a/PP/src/pw2bgw.f90 +++ b/PP/src/pw2bgw.f90 @@ -286,9 +286,6 @@ PROGRAM pw2bgw 'with real wavefunctions are not implemented, compute them in ' // & 'Sigma using VXC.', 7) - ! this is needed to compute k+G indices and store them into igk_k - CALL hinit0 ( ) - CALL openfil_pp ( ) if ( ionode ) WRITE ( 6, '("")' ) diff --git a/PW/src/allocate_nlpot.f90 b/PW/src/allocate_nlpot.f90 index cc5c95859..b80a83c7f 100644 --- a/PW/src/allocate_nlpot.f90 +++ b/PW/src/allocate_nlpot.f90 @@ -15,7 +15,6 @@ SUBROUTINE allocate_nlpot ! ! It computes the following global quantities: ! - ! ngk ! number of plane waves (for each k point) ! npwx ! maximum number of plane waves ! nqx ! number of points of the interpolation table ! nqxq ! as above, for q-function interpolation table @@ -24,7 +23,7 @@ SUBROUTINE allocate_nlpot USE ions_base, ONLY : nat, nsp, ityp USE cellmd, ONLY : cell_factor USE gvect, ONLY : ngm, gcutm, g - USE klist, ONLY : xk, wk, ngk, nks, qnorm, igk_k + USE klist, ONLY : xk, wk, nks, qnorm USE lsda_mod, ONLY : nspin USE ldaU, ONLY : Hubbard_lmax USE scf, ONLY : rho @@ -48,13 +47,10 @@ SUBROUTINE allocate_nlpot ! ! calculate number of PWs for all kpoints ! - ALLOCATE (ngk( nks )) - ! npwx = n_plane_waves (gcutw, nks, xk, g, ngm) ! ! igk relates the index of PW k+G to index in the list of G vector ! - ALLOCATE ( igk_k( npwx,nks ) ) ALLOCATE (igk( npwx ), g2kin ( npwx ) ) ! ! Note: computation of the number of beta functions for diff --git a/PW/src/clean_pw.f90 b/PW/src/clean_pw.f90 index 2f902b75a..37d7d6153 100644 --- a/PW/src/clean_pw.f90 +++ b/PW/src/clean_pw.f90 @@ -26,7 +26,7 @@ SUBROUTINE clean_pw( lflag ) USE gvecs, ONLY : nls, nlsm USE fixed_occ, ONLY : f_inp USE ktetra, ONLY : tetra - USE klist, ONLY : ngk, igk_k + USE klist, ONLY : deallocate_igk USE gvect, ONLY : ig_l2g USE vlocal, ONLY : strf, vloc USE wvfct, ONLY : igk, g2kin, et, wg, btype @@ -142,8 +142,6 @@ SUBROUTINE clean_pw( lflag ) ! ! ... arrays allocated in allocate_nlpot.f90 ( and never deallocated ) ! - IF ( ALLOCATED( ngk ) ) DEALLOCATE( ngk ) - IF ( ALLOCATED( igk_k ) ) DEALLOCATE( igk_k ) IF ( ALLOCATED( igk ) ) DEALLOCATE( igk ) IF ( ALLOCATED( g2kin ) ) DEALLOCATE( g2kin ) IF ( ALLOCATED( qrad ) ) DEALLOCATE( qrad ) @@ -153,6 +151,7 @@ SUBROUTINE clean_pw( lflag ) IF ( ALLOCATED( fcoef ) ) DEALLOCATE( fcoef ) END IF ! + CALL deallocate_igk ( ) CALL deallocate_uspp() CALL deallocate_gth() CALL deallocate_noncol() diff --git a/PW/src/hinit0.f90 b/PW/src/hinit0.f90 index 6dd8b1b97..a2031e2cf 100644 --- a/PW/src/hinit0.f90 +++ b/PW/src/hinit0.f90 @@ -18,7 +18,7 @@ SUBROUTINE hinit0() USE basis, ONLY : startingconfig USE cell_base, ONLY : at, bg, omega, tpiba2 USE cellmd, ONLY : omega_old, at_old, lmovecell - USE klist, ONLY : nks, xk, ngk, igk_k + USE klist, ONLY : init_igk USE wvfct, ONLY : npw, npwx, igk USE fft_base, ONLY : dfftp USE gvect, ONLY : ngm, ig_l2g, g, eigts1, eigts2, eigts3 @@ -44,20 +44,7 @@ SUBROUTINE hinit0() IF ( lda_plus_U .AND. ( U_projection == 'pseudo' ) ) CALL init_q_aeps() CALL init_at_1() ! - ! ... The following loop must NOT be called more than once in a run - ! ... or else there will be problems with variable-cell calculations - ! ... Note that with just one k-point all one needs are npw and igk - ! - ALLOCATE ( gk(npwx) ) - igk_k(:,:) = 0 - DO ik = 1, nks - ! - CALL gk_sort( xk(1,ik), ngm, g, gcutw, npw, igk, gk ) - ngk(ik) = npw - igk_k(1:npw,ik)= igk(1:npw) - ! - END DO - DEALLOCATE ( gk ) + CALL init_igk ( npwx, ngm, g, gcutw ) ! IF ( lmovecell .AND. startingconfig == 'file' ) THEN ! diff --git a/PW/src/pw_restart.f90 b/PW/src/pw_restart.f90 index 2065aa563..ad632acb6 100644 --- a/PW/src/pw_restart.f90 +++ b/PW/src/pw_restart.f90 @@ -129,8 +129,7 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, & USE basis, ONLY : natomwfc USE gvecs, ONLY : ngms_g, dual USE fft_base, ONLY : dffts - USE wvfct, ONLY : npw, npwx, g2kin, et, wg, & - igk, nbnd + USE wvfct, ONLY : npw, npwx, et, wg, nbnd USE ener, ONLY : ef, ef_up, ef_dw, vtxc, etxc, ewld, etot, & ehart, eband, demet USE gvecw, ONLY : ecutwfc diff --git a/PW/src/pwcom.f90 b/PW/src/pwcom.f90 index 740f91558..17ea78b7e 100644 --- a/PW/src/pwcom.f90 +++ b/PW/src/pwcom.f90 @@ -7,6 +7,7 @@ ! !-------------------------------------------------------------------------- ! +! MODULE klist ! ! ... The variables for the k-points @@ -14,6 +15,7 @@ MODULE klist USE kinds, ONLY : DP USE parameters, ONLY : npk ! + IMPLICIT NONE SAVE ! CHARACTER (len=32) :: & @@ -44,9 +46,40 @@ MODULE klist two_fermi_energies ! if .TRUE.: nelup and neldw set ef_up and ef_dw ! separately ! +CONTAINS + ! + SUBROUTINE init_igk ( npwx, ngm, g, gcutw ) + ! + ! ... Initialize indices igk_k and number of plane waves per k-point: + ! ... (k_ik+G)_i = k_ik+G_igk, i=1,ngk(ik), igk=igk_k(i,ik) + ! + INTEGER, INTENT (IN) :: npwx, ngm + REAL(dp), INTENT(IN) :: gcutw, g(3,ngm) + ! + REAL(dp), ALLOCATABLE :: gk (:) + INTEGER :: ik + ! + ALLOCATE ( igk_k(npwx,nks), ngk(nks) ) + ALLOCATE ( gk(npwx) ) + igk_k(:,:) = 0 + ! + ! ... The following loop must NOT be called more than once in a run + ! ... or else there will be problems with variable-cell calculations + ! + DO ik = 1, nks + CALL gk_sort( xk(1,ik), ngm, g, gcutw, ngk(ik), igk_k(1,ik), gk ) + END DO + DEALLOCATE ( gk ) + ! + END SUBROUTINE init_igk + ! + SUBROUTINE deallocate_igk ( ) + IF ( ALLOCATED( ngk ) ) DEALLOCATE( ngk ) + IF ( ALLOCATED( igk_k ) ) DEALLOCATE( igk_k ) + END SUBROUTINE deallocate_igk + END MODULE klist ! -! MODULE lsda_mod ! ! ... The variables needed for the lsda calculation diff --git a/PW/src/read_file.f90 b/PW/src/read_file.f90 index 2af393ae4..46166c186 100644 --- a/PW/src/read_file.f90 +++ b/PW/src/read_file.f90 @@ -16,7 +16,6 @@ SUBROUTINE read_file() USE buffers, ONLY : open_buffer, close_buffer USE wvfct, ONLY : nbnd, npwx USE noncollin_module, ONLY : npol - USE klist, ONLY : nks USE paw_variables, ONLY : okpaw, ddd_PAW USE paw_onecenter, ONLY : paw_potential USE uspp, ONLY : becsum @@ -27,6 +26,9 @@ SUBROUTINE read_file() USE ldaU, ONLY : lda_plus_u, U_projection USE pw_restart, ONLY : pw_readfile USE control_flags, ONLY : io_level + USE klist, ONLY : init_igk + USE gvect, ONLY : ngm, g + USE gvecw, ONLY : gcutw ! IMPLICIT NONE INTEGER :: ierr @@ -48,6 +50,11 @@ SUBROUTINE read_file() io_level = 1 CALL open_buffer ( iunwfc, 'wfc', nwordwfc, io_level, exst ) ! + ! ... Allocate and compute k+G indices and number of plane waves + ! ... FIXME: should be read from file, not re-computed + ! + CALL init_igk ( npwx, ngm, g, gcutw ) + ! ! ... Read orbitals, write them in 'distributed' form to iunwfc ! CALL pw_readfile( 'wave', ierr )