mirror of https://gitlab.com/QEF/q-e.git
409 lines
14 KiB
Fortran
409 lines
14 KiB
Fortran
!
|
|
! Copyright (C) 2001-2009 Quantum ESPRESSO 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 solve_e
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! This routine is a driver for the solution of the linear system which
|
|
! defines the change of the wavefunction due to an electric field.
|
|
! It performs the following tasks:
|
|
! a) computes the bare potential term x | psi >
|
|
! b) adds to it the screening term Delta V_{SCF} | psi >
|
|
! c) applies P_c^+ (orthogonalization to valence states)
|
|
! d) calls cgsolve_all to solve the linear system
|
|
! e) computes Delta rho, Delta V_{SCF} and symmetrizes them
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE ions_base, ONLY : nat, ntyp => nsp, ityp
|
|
USE io_global, ONLY : stdout, ionode
|
|
USE io_files, ONLY : prefix, iunigk, diropn
|
|
USE cell_base, ONLY : tpiba2
|
|
USE klist, ONLY : lgauss, xk, wk
|
|
USE gvect, ONLY : nrxx, g
|
|
USE gsmooth, ONLY : doublegrid, nrxxs
|
|
USE lsda_mod, ONLY : lsda, nspin, current_spin, isk
|
|
USE spin_orb, ONLY : domag
|
|
USE wvfct, ONLY : nbnd, npw, npwx, igk, g2kin, et
|
|
USE check_stop, ONLY : check_stop_now
|
|
USE wavefunctions_module, ONLY : evc
|
|
USE uspp, ONLY : okvan, vkb
|
|
USE uspp_param, ONLY : upf, nhm
|
|
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
|
|
USE scf, ONLY : rho
|
|
USE paw_variables, ONLY : okpaw
|
|
USE paw_onecenter, ONLY : paw_dpotential, paw_desymmetrize
|
|
|
|
USE eqv, ONLY : dpsi, dvpsi, eprec
|
|
USE units_ph, ONLY : lrdwf, iudwf, lrwfc, iuwfc, lrdrho, &
|
|
iudrho
|
|
USE output, ONLY : fildrho
|
|
USE control_ph, ONLY : ext_recover, rec_code, &
|
|
lnoloc, nbnd_occ, convt, tr2_ph, nmix_ph, &
|
|
alpha_mix, lgamma_gamma, niter_ph, &
|
|
lgamma, flmixdpot, rec_code_read
|
|
USE phus, ONLY : int3_paw
|
|
USE qpoint, ONLY : igkq, npwq, nksq
|
|
USE recover_mod, ONLY : read_rec, write_rec
|
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
|
|
USE mp, ONLY : mp_sum
|
|
|
|
implicit none
|
|
|
|
real(DP) :: thresh, anorm, averlt, dr2
|
|
! thresh: convergence threshold
|
|
! anorm : the norm of the error
|
|
! averlt: average number of iterations
|
|
! dr2 : self-consistency error
|
|
real(DP), allocatable :: h_diag (:,:)
|
|
! h_diag: diagonal part of the Hamiltonian
|
|
|
|
complex(DP) , allocatable, target :: &
|
|
dvscfin (:,:,:) ! change of the scf potential (input)
|
|
complex(DP) , pointer :: &
|
|
dvscfins (:,:,:) ! change of the scf potential (smooth)
|
|
complex(DP) , allocatable :: &
|
|
dvscfout (:,:,:), & ! change of the scf potential (output)
|
|
dbecsum(:,:,:,:), & ! the becsum with dpsi
|
|
dbecsum_nc(:,:,:,:,:), & ! the becsum with dpsi
|
|
mixin(:), mixout(:), & ! auxiliary for paw mixing
|
|
aux1 (:,:), ps (:,:)
|
|
|
|
complex(DP), EXTERNAL :: zdotc ! the scalar product function
|
|
|
|
logical :: conv_root, exst
|
|
! conv_root: true if linear system is converged
|
|
|
|
integer :: kter, iter0, ipol, ibnd, jbnd, iter, lter, &
|
|
ik, ig, irr, ir, is, nrec, na, nt, ndim, ios
|
|
! counters
|
|
integer :: ltaver, lintercall
|
|
|
|
real(DP) :: tcpu, get_clock
|
|
! timing variables
|
|
|
|
external ch_psi_all, cg_psi
|
|
|
|
|
|
|
|
call start_clock ('solve_e')
|
|
allocate (dvscfin( nrxx, nspin_mag, 3))
|
|
if (doublegrid) then
|
|
allocate (dvscfins( nrxxs, nspin_mag, 3))
|
|
else
|
|
dvscfins => dvscfin
|
|
endif
|
|
allocate (dvscfout( nrxx , nspin_mag, 3))
|
|
IF (okpaw) THEN
|
|
ALLOCATE (mixin(nrxx*nspin_mag*3+(nhm*(nhm+1)*nat*nspin_mag*3)/2) )
|
|
ALLOCATE (mixout(nrxx*nspin_mag*3+(nhm*(nhm+1)*nat*nspin_mag*3)/2) )
|
|
ENDIF
|
|
allocate (dbecsum( nhm*(nhm+1)/2, nat, nspin_mag, 3))
|
|
IF (noncolin) allocate (dbecsum_nc (nhm, nhm, nat, nspin, 3))
|
|
allocate (aux1(nrxxs,npol))
|
|
allocate (h_diag(npwx*npol, nbnd))
|
|
IF (okpaw) mixin=(0.0_DP,0.0_DP)
|
|
|
|
if (rec_code_read == -20.AND.ext_recover) then
|
|
! restarting in Electric field calculation
|
|
IF (okpaw) THEN
|
|
CALL read_rec(dr2, iter0, 3, dvscfin, dvscfins, dvscfout, dbecsum)
|
|
CALL setmixout(3*nrxx*nspin_mag,(nhm*(nhm+1)*nat*nspin_mag*3)/2, &
|
|
mixin, dvscfin, dbecsum, ndim, -1 )
|
|
ELSE
|
|
CALL read_rec(dr2, iter0, 3, dvscfin, dvscfins)
|
|
ENDIF
|
|
else if (rec_code_read > -20 .AND. rec_code_read <= -10) then
|
|
! restarting in Raman: proceed
|
|
convt = .true.
|
|
else
|
|
convt = .false.
|
|
iter0 = 0
|
|
endif
|
|
!
|
|
IF ( ionode .AND. fildrho /= ' ') THEN
|
|
INQUIRE (UNIT = iudrho, OPENED = exst)
|
|
IF (exst) CLOSE (UNIT = iudrho, STATUS='keep')
|
|
CALL diropn (iudrho, TRIM(fildrho)//'.E', lrdrho, exst)
|
|
end if
|
|
IF (rec_code_read > -20) convt=.TRUE.
|
|
!
|
|
if (convt) go to 155
|
|
!
|
|
! if q=0 for a metal: allocate and compute local DOS at Ef
|
|
!
|
|
if (lgauss.or..not.lgamma) call errore ('solve_e', &
|
|
'called in the wrong case', 1)
|
|
|
|
!
|
|
! The outside loop is over the iterations
|
|
!
|
|
do kter = 1, niter_ph
|
|
|
|
! write(6,*) 'kter', kter
|
|
CALL flush_unit( stdout )
|
|
iter = kter + iter0
|
|
ltaver = 0
|
|
lintercall = 0
|
|
|
|
dvscfout(:,:,:)=(0.d0,0.d0)
|
|
dbecsum(:,:,:,:)=(0.d0,0.d0)
|
|
IF (noncolin) dbecsum_nc=(0.d0,0.d0)
|
|
|
|
if (nksq.gt.1) rewind (unit = iunigk)
|
|
do ik = 1, nksq
|
|
if (lsda) current_spin = isk (ik)
|
|
! write(6,*) 'current spin', current_spin, ik
|
|
if (nksq.gt.1) then
|
|
read (iunigk, err = 100, iostat = ios) npw, igk
|
|
100 call errore ('solve_e', 'reading igk', abs (ios) )
|
|
endif
|
|
!
|
|
! reads unperturbed wavefuctions psi_k in G_space, for all bands
|
|
!
|
|
if (nksq.gt.1) call davcio (evc, lrwfc, iuwfc, ik, - 1)
|
|
npwq = npw
|
|
call init_us_2 (npw, igk, xk (1, ik), vkb)
|
|
!
|
|
! compute the kinetic energy
|
|
!
|
|
do ig = 1, npwq
|
|
g2kin (ig) = ( (xk (1,ik ) + g (1,igkq (ig)) ) **2 + &
|
|
(xk (2,ik ) + g (2,igkq (ig)) ) **2 + &
|
|
(xk (3,ik ) + g (3,igkq (ig)) ) **2 ) * tpiba2
|
|
enddo
|
|
h_diag=0.d0
|
|
do ibnd = 1, nbnd_occ (ik)
|
|
do ig = 1, npw
|
|
h_diag(ig,ibnd)=1.d0/max(1.0d0,g2kin(ig)/eprec(ibnd,ik))
|
|
enddo
|
|
IF (noncolin) THEN
|
|
do ig = 1, npw
|
|
h_diag(ig+npwx,ibnd)=1.d0/max(1.0d0,g2kin(ig)/eprec(ibnd,ik))
|
|
enddo
|
|
END IF
|
|
enddo
|
|
!
|
|
do ipol = 1, 3
|
|
!
|
|
! computes/reads P_c^+ x psi_kpoint into dvpsi array
|
|
!
|
|
call dvpsi_e (ik, ipol)
|
|
!
|
|
if (iter > 1) then
|
|
!
|
|
! calculates dvscf_q*psi_k in G_space, for all bands, k=kpoint
|
|
! dvscf_q from previous iteration (mix_potential)
|
|
!
|
|
do ibnd = 1, nbnd_occ (ik)
|
|
call cft_wave (evc (1, ibnd), aux1, +1)
|
|
call apply_dpot(aux1, dvscfins(1,1,ipol), current_spin)
|
|
call cft_wave (dvpsi (1, ibnd), aux1, -1)
|
|
enddo
|
|
!
|
|
call adddvscf(ipol,ik)
|
|
!
|
|
endif
|
|
!
|
|
! Orthogonalize dvpsi to valence states: ps = <evc|dvpsi>
|
|
!
|
|
CALL orthogonalize(dvpsi, evc, ik, ik, dpsi)
|
|
!
|
|
if (iter == 1) then
|
|
!
|
|
! At the first iteration dpsi and dvscfin are set to zero,
|
|
!
|
|
dpsi(:,:)=(0.d0,0.d0)
|
|
dvscfin(:,:,:)=(0.d0,0.d0)
|
|
!
|
|
! starting threshold for the iterative solution of the linear
|
|
! system
|
|
!
|
|
thresh = 1.d-2
|
|
if (lnoloc) thresh = 1.d-5
|
|
else
|
|
! starting value for delta_psi is read from iudwf
|
|
!
|
|
nrec = (ipol - 1) * nksq + ik
|
|
call davcio (dpsi, lrdwf, iudwf, nrec, - 1)
|
|
!
|
|
! threshold for iterative solution of the linear system
|
|
!
|
|
thresh = min (0.1d0 * sqrt (dr2), 1.0d-2)
|
|
endif
|
|
!
|
|
! iterative solution of the linear system (H-e)*dpsi=dvpsi
|
|
! dvpsi=-P_c+ (dvbare+dvscf)*psi , dvscf fixed.
|
|
!
|
|
|
|
conv_root = .true.
|
|
|
|
call cgsolve_all (ch_psi_all,cg_psi,et(1,ik),dvpsi,dpsi, &
|
|
h_diag,npwx,npw,thresh,ik,lter,conv_root,anorm,nbnd_occ(ik),npol)
|
|
|
|
ltaver = ltaver + lter
|
|
lintercall = lintercall + 1
|
|
if (.not.conv_root) WRITE( stdout, "(5x,'kpoint',i4,' ibnd',i4, &
|
|
& ' solve_e: root not converged ',e10.3)") ik &
|
|
&, ibnd, anorm
|
|
!
|
|
! writes delta_psi on iunit iudwf, k=kpoint,
|
|
!
|
|
nrec = (ipol - 1) * nksq + ik
|
|
call davcio (dpsi, lrdwf, iudwf, nrec, + 1)
|
|
!
|
|
! calculates dvscf, sum over k => dvscf_q_ipert
|
|
!
|
|
IF (noncolin) THEN
|
|
call incdrhoscf_nc(dvscfout(1,1,ipol),wk(ik),ik, &
|
|
dbecsum_nc(1,1,1,1,ipol), dpsi)
|
|
ELSE
|
|
call incdrhoscf (dvscfout(1,current_spin,ipol), wk(ik), &
|
|
ik, dbecsum(1,1,current_spin,ipol), dpsi)
|
|
ENDIF
|
|
enddo ! on polarizations
|
|
enddo ! on k points
|
|
#ifdef __PARA
|
|
!
|
|
! The calculation of dbecsum is distributed across processors
|
|
! (see addusdbec) - we sum over processors the contributions
|
|
! coming from each slice of bands
|
|
!
|
|
IF (noncolin) THEN
|
|
call mp_sum ( dbecsum_nc, intra_pool_comm )
|
|
ELSE
|
|
call mp_sum ( dbecsum, intra_pool_comm )
|
|
END IF
|
|
#endif
|
|
|
|
if (doublegrid) then
|
|
do is=1,nspin_mag
|
|
do ipol=1,3
|
|
call cinterpolate (dvscfout(1,is,ipol), dvscfout(1,is,ipol), 1)
|
|
enddo
|
|
enddo
|
|
endif
|
|
!
|
|
IF (noncolin.and.okvan) CALL set_dbecsum_nc(dbecsum_nc, dbecsum, 3)
|
|
!
|
|
call addusddense (dvscfout, dbecsum)
|
|
!
|
|
! dvscfout contains the (unsymmetrized) linear charge response
|
|
! for the three polarizations - symmetrize it
|
|
!
|
|
#ifdef __PARA
|
|
call mp_sum ( dvscfout, inter_pool_comm )
|
|
#endif
|
|
if (.not.lgamma_gamma) then
|
|
#ifdef __PARA
|
|
call psyme (dvscfout)
|
|
IF ( noncolin.and.domag ) CALL psym_dmage(dvscfout)
|
|
#else
|
|
call syme (dvscfout)
|
|
IF ( noncolin.and.domag ) CALL sym_dmage(dvscfout)
|
|
#endif
|
|
endif
|
|
!
|
|
! save the symmetrized linear charge response to file
|
|
! calculate the corresponding linear potential response
|
|
!
|
|
do ipol=1,3
|
|
if (fildrho.ne.' ') call davcio_drho(dvscfout(1,1,ipol),lrdrho, &
|
|
iudrho,ipol,+1)
|
|
IF (lnoloc) then
|
|
dvscfout(:,:,ipol)=(0.d0,0.d0)
|
|
ELSE
|
|
call dv_of_drho (0, dvscfout (1, 1, ipol), .false.)
|
|
ENDIF
|
|
enddo
|
|
!
|
|
! mix the new potential with the old
|
|
!
|
|
IF (okpaw) THEN
|
|
!
|
|
! In this case we mix also dbecsum
|
|
!
|
|
call setmixout(3*nrxx*nspin_mag,(nhm*(nhm+1)*nat*nspin_mag*3)/2, &
|
|
mixout, dvscfout, dbecsum, ndim, -1 )
|
|
call mix_potential (2*3*nrxx*nspin_mag+2*ndim, mixout, mixin, &
|
|
alpha_mix(kter), dr2, 3*tr2_ph/npol, iter, &
|
|
nmix_ph, flmixdpot, convt)
|
|
call setmixout(3*nrxx*nspin_mag,(nhm*(nhm+1)*nat*nspin_mag*3)/2, &
|
|
mixin, dvscfin, dbecsum, ndim, 1 )
|
|
ELSE
|
|
call mix_potential (2*3*nrxx*nspin_mag, dvscfout, dvscfin, alpha_mix ( &
|
|
kter), dr2, 3 * tr2_ph / npol, iter, nmix_ph, flmixdpot, convt)
|
|
ENDIF
|
|
if (doublegrid) then
|
|
do is=1,nspin_mag
|
|
do ipol = 1, 3
|
|
call cinterpolate (dvscfin(1,is,ipol),dvscfins(1,is,ipol),-1)
|
|
enddo
|
|
enddo
|
|
endif
|
|
|
|
IF (okpaw) THEN
|
|
IF (noncolin) THEN
|
|
! call PAW_dpotential(dbecsum_nc,becsum_nc,int3_paw,3)
|
|
ELSE
|
|
!
|
|
! The presence of c.c. in the formula gives a factor 2.0
|
|
!
|
|
dbecsum=2.0_DP * dbecsum
|
|
IF (.NOT. lgamma_gamma) CALL PAW_desymmetrize(dbecsum)
|
|
call PAW_dpotential(dbecsum,rho%bec,int3_paw,3)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
call newdq(dvscfin,3)
|
|
|
|
averlt = DBLE (ltaver) / DBLE (lintercall)
|
|
|
|
tcpu = get_clock ('PHONON')
|
|
WRITE( stdout, '(/,5x," iter # ",i3," total cpu time :",f8.1, &
|
|
& " secs av.it.: ",f5.1)') iter, tcpu, averlt
|
|
dr2 = dr2 / 3
|
|
WRITE( stdout, "(5x,' thresh=',e10.3, ' alpha_mix = ',f6.3, &
|
|
& ' |ddv_scf|^2 = ',e10.3 )") thresh, alpha_mix (kter), dr2
|
|
!
|
|
CALL flush_unit( stdout )
|
|
!
|
|
! rec_code: state of the calculation
|
|
! rec_code=-20 Electric Field
|
|
!
|
|
rec_code=-20
|
|
IF (okpaw) THEN
|
|
CALL write_rec('solve_e...', irr, dr2, iter, convt, 3, dvscfin, &
|
|
dvscfout, dbecsum)
|
|
ELSE
|
|
CALL write_rec('solve_e...', irr, dr2, iter, convt, 3, dvscfin)
|
|
ENDIF
|
|
|
|
if (check_stop_now()) call stop_smoothly_ph (.false.)
|
|
|
|
if (convt) goto 155
|
|
|
|
enddo
|
|
155 continue
|
|
deallocate (h_diag)
|
|
deallocate (aux1)
|
|
deallocate (dbecsum)
|
|
deallocate (dvscfout)
|
|
IF (okpaw) THEN
|
|
DEALLOCATE(mixin)
|
|
DEALLOCATE(mixout)
|
|
ENDIF
|
|
if (doublegrid) deallocate (dvscfins)
|
|
deallocate (dvscfin)
|
|
if (noncolin) deallocate(dbecsum_nc)
|
|
|
|
call stop_clock ('solve_e')
|
|
return
|
|
end subroutine solve_e
|