From 02327270a01984fefc6f3c65ffbd9d2e6b845855 Mon Sep 17 00:00:00 2001 From: giannozz Date: Sun, 5 May 2013 20:57:23 +0000 Subject: [PATCH] Calculation of atomic wavefunctions split into two cases: - for DFT+U, only needed wavefunctions are stored in iunhub - for wannier/one_atom_occupations, all wvfcts are stored in iunsat as before In this way there is no confusion between these two distinct usages of atomic wavefunctions. git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@10218 c92efa57-630b-4861-b058-cf58834340f0 --- PP/src/wannier_ham.f90 | 3 +- PW/src/allocate_wfc.f90 | 20 +++------ PW/src/close_files.f90 | 14 ++++--- PW/src/hinit1.f90 | 3 +- PW/src/openfil.f90 | 7 ++-- PW/src/orthoatwfc.f90 | 90 ++++++++++++++++++++++++++++++++++++----- PW/src/wannier_init.f90 | 2 - PW/src/wannier_proj.f90 | 4 +- PW/src/wfcinit.f90 | 4 +- 9 files changed, 103 insertions(+), 44 deletions(-) diff --git a/PP/src/wannier_ham.f90 b/PP/src/wannier_ham.f90 index ae658a7ce..cd65626e5 100644 --- a/PP/src/wannier_ham.f90 +++ b/PP/src/wannier_ham.f90 @@ -138,8 +138,7 @@ SUBROUTINE new_hamiltonian(plot_bands) IF ( nks > 1 ) WRITE( iunigk ) igk ENDDO ! - - CALL orthoatwfc() + CALL orthoatwfc( .true. ) wan_func = ZERO pp = ZERO diff --git a/PW/src/allocate_wfc.f90 b/PW/src/allocate_wfc.f90 index 94f149348..d88980500 100644 --- a/PW/src/allocate_wfc.f90 +++ b/PW/src/allocate_wfc.f90 @@ -25,20 +25,12 @@ SUBROUTINE allocate_wfc() IMPLICIT NONE ! ! - IF (noncolin) THEN - ALLOCATE( evc( npwx*npol, nbnd ) ) - IF ( ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) & - .OR. one_atom_occupations ) ALLOCATE( swfcatom( npwx*npol, natomwfc) ) - IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) & - ALLOCATE( wfcU(npwx*npol, nwfcU) ) - ELSE - ALLOCATE( evc( npwx, nbnd ) ) - IF ( ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) .OR. use_wannier & - .OR. one_atom_occupations ) ALLOCATE( swfcatom( npwx, natomwfc) ) - IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) & - ALLOCATE( wfcU(npwx, nwfcU) ) - ENDIF + ALLOCATE( evc( npwx*npol, nbnd ) ) + IF ( one_atom_occupations .OR. use_wannier ) & + ALLOCATE( swfcatom( npwx*npol, natomwfc) ) + IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) & + ALLOCATE( wfcU(npwx*npol, nwfcU) ) ! RETURN ! -END subroutine allocate_wfc +END SUBROUTINE allocate_wfc diff --git a/PW/src/close_files.f90 b/PW/src/close_files.f90 index 4d7ec6506..350d83d0a 100644 --- a/PW/src/close_files.f90 +++ b/PW/src/close_files.f90 @@ -45,17 +45,19 @@ SUBROUTINE close_files(lflag) ! ... iunsat contains the (orthogonalized) atomic wfcs * S ! ... iunhub as above, only for wavefcts having an associated Hubbard U ! - IF ( ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) .OR. & - use_wannier .OR. one_atom_occupations ) THEN - ! + IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) THEN IF ( io_level < 0 ) THEN - CALL close_buffer ( iunsat,'DELETE' ) CALL close_buffer ( iunhub,'DELETE' ) ELSE - CALL close_buffer ( iunsat,'KEEP' ) CALL close_buffer ( iunhub,'KEEP' ) END IF - ! + END IF + IF ( use_wannier .OR. one_atom_occupations ) THEN + IF ( io_level < 0 ) THEN + CALL close_buffer ( iunsat,'DELETE' ) + ELSE + CALL close_buffer ( iunsat,'KEEP' ) + END IF END IF ! ! ... close unit for electric field if needed diff --git a/PW/src/hinit1.f90 b/PW/src/hinit1.f90 index 13e6714d9..b7593a6c5 100644 --- a/PW/src/hinit1.f90 +++ b/PW/src/hinit1.f90 @@ -61,7 +61,8 @@ SUBROUTINE hinit1() ! ... and recalculate the products of the S with the atomic wfcs used ! ... in LDA+U calculations ! - IF ( lda_plus_u .OR. use_wannier ) CALL orthoatwfc() + IF ( lda_plus_u ) CALL orthoUwfc () + IF ( use_wannier ) CALL orthoatwfc( .true. ) ! call tag_wg_corr_as_obsolete ! diff --git a/PW/src/openfil.f90 b/PW/src/openfil.f90 index 621557f22..2b0242ca8 100644 --- a/PW/src/openfil.f90 +++ b/PW/src/openfil.f90 @@ -44,11 +44,10 @@ SUBROUTINE openfil() nwordatwfc= npwx*natomwfc*npol nwordwfcU = npwx*nwfcU*npol ! - IF ( ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) .OR. & - use_wannier .OR. one_atom_occupations ) THEN - CALL open_buffer ( iunsat, 'satwfc', nwordatwfc, io_level, exst ) + IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) & CALL open_buffer ( iunhub, 'hub', nwordwfcU, io_level, exst ) - END IF + IF ( use_wannier .OR. one_atom_occupations ) & + CALL open_buffer ( iunsat, 'satwfc', nwordatwfc, io_level, exst ) ! ! ... iunigk contains the number of PW and the indices igk ! diff --git a/PW/src/orthoatwfc.f90 b/PW/src/orthoatwfc.f90 index 529074e86..df4d4c3df 100644 --- a/PW/src/orthoatwfc.f90 +++ b/PW/src/orthoatwfc.f90 @@ -7,17 +7,18 @@ ! ! !----------------------------------------------------------------------- -SUBROUTINE orthoatwfc +SUBROUTINE orthoUwfc !----------------------------------------------------------------------- ! - ! This routine is meant to orthogonalize all the atomic wfcs. This is - ! useful when we want to compute the occupation of the atomic orbitals - ! in order to make lda+U calculations + ! This routine saves to buffer "iunhub" atomic wavefunctions having an + ! associated Hubbard U term, for DFT+U calculations. Atomic wavefunctions + ! are orthogonalized if desired, depending upon the value of "U_projection" + ! "swfcatom" must NOT be allocated on input. ! USE kinds, ONLY : DP USE buffers, ONLY : save_buffer USE io_global, ONLY : stdout - USE io_files, ONLY : iunsat, iunhub, nwordwfcU, nwordatwfc, iunigk + USE io_files, ONLY : iunhub, nwordwfcU, iunigk USE ions_base, ONLY : nat USE basis, ONLY : natomwfc, swfcatom USE klist, ONLY : nks, xk, ngk @@ -66,6 +67,79 @@ SUBROUTINE orthoatwfc CALL errore ("orthoatwfc"," this U_projection_type is not valid",1) END IF + ALLOCATE ( wfcatom(npwx*npol, natomwfc), swfcatom(npwx*npol, natomwfc) ) + + ! Allocate the array becp = + CALL allocate_bec_type (nkb,natomwfc, becp) + + IF (nks > 1) REWIND (iunigk) + + DO ik = 1, nks + + npw = ngk (ik) + IF (nks > 1) READ (iunigk) igk + + IF (noncolin) THEN + CALL atomic_wfc_nc_updown (ik, wfcatom) + ELSE + CALL atomic_wfc (ik, wfcatom) + ENDIF + CALL init_us_2 (npw, igk, xk (1, ik), vkb) + CALL calbec (npw, vkb, wfcatom, becp) + CALL s_psi (npwx, npw, natomwfc, wfcatom, swfcatom) + + IF (orthogonalize_wfc) & + CALL ortho_swfc ( normalize_only, natomwfc, wfcatom, swfcatom ) + ! + ! copy atomic wavefunctions with Hubbard U term only in wfcU + ! save to unit iunhub + ! + CALL copy_U_wfc (swfcatom) + CALL save_buffer (wfcU, nwordwfcU, iunhub, ik) + ! + ENDDO + DEALLOCATE (wfcatom, swfcatom) + CALL deallocate_bec_type ( becp ) + ! + RETURN + +END SUBROUTINE orthoUwfc +! +!----------------------------------------------------------------------- +SUBROUTINE orthoatwfc (orthogonalize_wfc) + !----------------------------------------------------------------------- + ! + ! This routine calculates atomic wavefunctions, orthogonalizes them + ! if "orthogonalzie_wfc" is .true., saves them into buffer "iunsat". + ! "swfcatom" must be allocated on input. + ! Useful for options "wannier" and "one_atom_occupations" + ! + USE kinds, ONLY : DP + USE buffers, ONLY : save_buffer + USE io_global, ONLY : stdout + USE io_files, ONLY : iunsat, nwordatwfc, iunigk + USE ions_base, ONLY : nat + USE basis, ONLY : natomwfc, swfcatom + USE klist, ONLY : nks, xk, ngk + USE wvfct, ONLY : npwx, npw, igk + USE uspp, ONLY : nkb, vkb + USE becmod, ONLY : allocate_bec_type, deallocate_bec_type, & + bec_type, becp, calbec + USE control_flags, ONLY : gamma_only + USE noncollin_module, ONLY : noncolin, npol + ! + IMPLICIT NONE + ! + LOGICAL, INTENT(in) :: orthogonalize_wfc + ! + INTEGER :: ik, ibnd, info, i, j, k, na, nb, nt, isym, n, ntemp, m, & + l, lm, ltot, ntot, ipol + ! ik: the k point under consideration + ! ibnd: counter on bands + LOGICAL :: normalize_only = .FALSE. + COMPLEX(DP) , ALLOCATABLE :: wfcatom (:,:) + + normalize_only=.FALSE. ALLOCATE (wfcatom( npwx*npol, natomwfc)) ! Allocate the array becp = @@ -94,12 +168,6 @@ SUBROUTINE orthoatwfc ! CALL save_buffer (swfcatom, nwordatwfc, iunsat, ik) ! - ! copy atomic wavefunctions with Hubbard U term only in wfcU - ! save to unit iunhub - ! - CALL copy_U_wfc (swfcatom) - CALL save_buffer (wfcU, nwordwfcU, iunhub, ik) - ! ENDDO DEALLOCATE (wfcatom) CALL deallocate_bec_type ( becp ) diff --git a/PW/src/wannier_init.f90 b/PW/src/wannier_init.f90 index 0d2403306..4255217d4 100644 --- a/PW/src/wannier_init.f90 +++ b/PW/src/wannier_init.f90 @@ -23,7 +23,6 @@ SUBROUTINE wannier_init(hwwa) USE klist, only: nks USE io_files USE buffers - USE ldaU, ONLY : U_projection USE noncollin_module, ONLY : npol IMPLICIT NONE @@ -71,7 +70,6 @@ SUBROUTINE wannier_init(hwwa) IF(.NOT. opnd) CALL seqopn( iunigk, 'igk', 'UNFORMATTED', exst ) IF(.NOT. ALLOCATED(swfcatom)) ALLOCATE( swfcatom( npwx, natomwfc)) - U_projection = 'ortho-atomic' nwordatwfc = npwx*natomwfc*npol INQUIRE( UNIT = iunsat, OPENED = opnd ) diff --git a/PW/src/wannier_proj.f90 b/PW/src/wannier_proj.f90 index d2308e391..277ed7d3d 100644 --- a/PW/src/wannier_proj.f90 +++ b/PW/src/wannier_proj.f90 @@ -58,7 +58,7 @@ subroutine wannier_proj(ik, wan_func) swfcatom = ZERO CALL get_buffer (swfcatom, nwordatwfc, iunsat, ik) - ! generates trial wavefunctions as a summ of ingridients + ! generates trial wavefunctions as a sum of ingredients trialwf = ZERO do iwan=1, nwan do j=1,wan_in(iwan,current_spin)%ning @@ -70,7 +70,7 @@ subroutine wannier_proj(ik, wan_func) end do end do - ! copmputes <\Psi|\hat S|\phi> for all \Psi and \phi + ! computes <\Psi|\hat S|\phi> for all \Psi and \phi ! later one should select only few columns pp = ZERO DO ibnd = 1, nbnd diff --git a/PW/src/wfcinit.f90 b/PW/src/wfcinit.f90 index a70cf447a..b874b5920 100644 --- a/PW/src/wfcinit.f90 +++ b/PW/src/wfcinit.f90 @@ -40,8 +40,8 @@ SUBROUTINE wfcinit() ! ! ... Orthogonalized atomic functions needed for LDA+U and other cases ! - IF ( use_wannier .OR. one_atom_occupations .or. lda_plus_u ) & - CALL orthoatwfc() + IF ( use_wannier .OR. one_atom_occupations ) CALL orthoatwfc ( use_wannier ) + IF ( lda_plus_u ) CALL orthoUwfc() ! ! ... open files/buffer for wavefunctions (nwordwfc set in openfil) ! ... io_level > 1 : open file, otherwise: open buffer