quantum-espresso/atomic/ld1_setup.f90

185 lines
5.8 KiB
Fortran

!
! Copyright (C) 2004 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!---------------------------------------------------------------
SUBROUTINE ld1_setup
!---------------------------------------------------------------
!
! this routine computes the general variables needed in
! the atomic calculation
!
!
USE kinds, ONLY : dp
USE ld1inc, ONLY : iswitch, lsd, rel,sl3, lmx, nconf, &
nbeta, lloc, nsloc, etot, etot0, etots0, vxt, tau, vtau, &
file_wavefunctions, file_logder, &
file_wavefunctionsps, file_logderps, file_pawexp, &
prefix, new, core_state, enls, enl, &
nwf, jj, el, isw, oc, nstoae, &
nwfs, lls, jjs, els, isws, ocs, &
nwfts, nnts, llts, jjts, elts, iswts, octs, nstoaets, &
nwftsc, nntsc, lltsc, jjtsc, eltsc, iswtsc, octsc, nstoaec, lpaw
USE funct, ONLY : get_iexch, dft_is_meta, start_exx, dft_is_nonlocc
IMPLICIT NONE
INTEGER :: n, n1, nc
LOGICAL :: hf, oep, meta, non_locc
real(DP) :: ocs_loc
!
!
meta = dft_is_meta()
IF ( meta .and. rel > 1 ) &
CALL errore('setup','meta-GGA not implemented for fully-relativistic case', 1)
IF ( meta .and. lsd == 1 ) &
CALL errore('setup','meta-GGA not implemented for LSDA', 2)
IF ( meta .and. iswitch > 1 ) &
CALL errore('setup','meta-GGA implemented only for all-electron case', 3)
hf = get_iexch()==5
IF (hf) CALL errore('setup','HF not implemented yet',1)
oep = get_iexch()==4
IF (oep.and.iswitch>1) &
CALL errore('setup','OEP is implemented only for all-electron calc.',1)
IF (oep.and.rel>0) &
CALL errore('setup','OEP is implemented only for non-relativistic calc.',1)
IF (oep) CALL start_exx
!
non_locc = dft_is_nonlocc()
IF ( non_locc ) &
CALL errore('setup','non-local functionals not implemented yet', 1)
!
CALL set_sl3(sl3,lmx)
!
! make the correspondence all-electron pseudopotential
!
IF (iswitch >= 3) THEN
DO nc=1, nconf
DO n=1,nwftsc(nc)
nstoaec(n,nc)=0
DO n1=1,nwf
IF (lsd==1) THEN
IF (eltsc(n,nc)==el(n1) &
.and.iswtsc(n,nc)==isw(n1)) THEN
nstoaec(n,nc)=n1
ENDIF
ELSE
IF (eltsc(n,nc)==el(n1).and.abs(jjtsc(n,nc)-jj(n1))<1.d-7) &
& nstoaec(n,nc)=n1
ENDIF
ENDDO
IF (nstoaec(n,nc)==0) CALL errore('ld1_setup', &
'all electron wfc corresponding to pseudo-state ' &
& //eltsc(n,nc)//' not found',nc)
ENDDO
ENDDO
!
! set the test configuration for descreening
!
IF (iswitch == 3) THEN
nwfts=nwftsc(1)
DO n=1,nwfts
nnts(n)=nntsc(n,1)
llts(n)=lltsc(n,1)
elts(n)=eltsc(n,1)
jjts(n) = jjtsc(n,1)
iswts(n)=iswtsc(n,1)
octs(n)=octsc(n,1)
nstoaets(n)=nstoaec(n,1)
ENDDO
ENDIF
ENDIF
!
new(:)=.false.
!
! divide the core and valence states
!
gen_and_test:&
IF (iswitch == 3) THEN
isws=1
DO n=1,nwf
core_state(n)=.true.
ENDDO
DO n=1,nwfs
nstoae(n)=0
DO n1=1,nwf
IF (rel==2) THEN
IF (els(n)==el(n1).and.jjs(n)==jj(n1)) THEN
nstoae(n)=n1
core_state(n1)=.false.
ENDIF
ELSE
IF (els(n)==el(n1)) THEN
nstoae(n)=n1
core_state(n1)=.false.
ENDIF
ENDIF
ENDDO
IF (nstoae(n)==0) CALL errore('ld1_setup', &
'no all electron for this ps',n)
IF (enls(n)/=0.0_dp) new(n)=.true.
ENDDO
IF (lloc > -1) THEN
nsloc=nwfs
nbeta=nwfs-1
IF (rel==2.and.lloc/=0) THEN
nsloc=nwfs-1
nbeta=nwfs-2
IF (lls(nsloc+1)/=lloc) &
CALL errore('ld1_setup','mismatch between lloc and l of ' // &
& 'spin-orbit split wfc chosen for local potential',nsloc)
ENDIF
IF (lls(nsloc)/=lloc) THEN
IF (rel==2) THEN
CALL errore('ld1_setup','mismatch between lloc and l of ' // &
& 'spin-orbit split wfc chosen for local potential',nsloc)
ELSE
CALL errore('ld1_setup','mismatch between lloc and l of ' // &
& 'the wavefunction chosen for local potential',nsloc)
ENDIF
ENDIF
ocs_loc=ocs(nsloc)
IF (rel==2.and.lloc>0) ocs_loc=ocs_loc+ocs(nsloc+1)
IF (lpaw .and. ocs_loc>0.0_DP) &
CALL errore('ld1_setup','Paw generation with electrons' // &
& 'in the local channel is not available',1)
ELSE
nsloc=-1
nbeta=nwfs
ENDIF
!
! test the occupations: for pseudopotential generation
! all-electron and pseudopotential occupations must match
!
DO n=1,nwfs
IF (.not.new(n)) THEN
IF (abs(oc(nstoae(n))-ocs(n)) > 1.0d-8 ) CALL errore &
('ld1_setup','mismatched all-electron/pseudo occupations',n)
ENDIF
ENDDO
ENDIF gen_and_test
!
! zero the external potential, metaGGA potential, total energies
!
vxt=0.0_dp
vtau=0.0_dp
tau=0.0_dp
etot0=0.0_dp
etots0=0.0_dp
enl=0.0_dp
!
! initialize file names (used in all_electron)
!
file_wavefunctions = trim(prefix)//'.wfc'
file_wavefunctionsps= trim(prefix)//'ps.wfc'
file_logder = trim(prefix)//'.dlog'
file_logderps = trim(prefix)//'ps.dlog'
file_pawexp = trim(prefix)//'.pwe'
RETURN
END SUBROUTINE ld1_setup