compilation ok with orthogonalize.f90 moved to LR_Modules

module control_ph split into PH/control_ph + a minimal LR_Modules/control_lr 


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12015 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
degironc 2016-01-19 22:39:03 +00:00
parent 8d5f5c5385
commit 78622ed13a
69 changed files with 115 additions and 255 deletions

View File

@ -323,7 +323,7 @@ subroutine h_psi_scissor( ik,lda, n, m, psi, hpsi )
USE wannier_gw, ONLY : scissor
USE mp, ONLY : mp_sum
USE mp_world, ONLY : world_comm
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE constants, ONLY : rytoev
implicit none

View File

@ -23,6 +23,7 @@ subroutine solve_head
USE becmod, ONLY : becp,calbec
USE uspp_param, ONLY : nhm
use qpoint, ONLY : npwq, nksq
use control_lr, ONLY : nbnd_occ
use phcom
USE wannier_gw, ONLY : n_gauss, omega_gauss, grid_type,&
nsteps_lanczos,second_grid_n,second_grid_i,&

View File

@ -11,6 +11,7 @@ LR_MODULES = \
apply_dpot.o \
cft_wave.o \
h_psiq.o \
orthogonalize.o \
lrcom.o
TLDEPS=libfft mods

View File

@ -35,3 +35,16 @@ MODULE qpoint
!
END MODULE qpoint
!
MODULE control_lr
USE kinds, ONLY : DP
USE parameters, ONLY: npk
!
! ... the variable controlling the phonon run
!
SAVE
!
INTEGER :: nbnd_occ(npk) ! occupated bands in metals
REAL(DP) :: alpha_pv ! the alpha value for shifting the bands
!
END MODULE control_lr

View File

@ -26,3 +26,13 @@ h_psiq.o : ../PW/src/scf_mod.o
h_psiq.o : lrcom.o
lrcom.o : ../Modules/kind.o
lrcom.o : ../Modules/parameters.o
orthogonalize.o : ../Modules/becmod.o
orthogonalize.o : ../Modules/control_flags.o
orthogonalize.o : ../Modules/kind.o
orthogonalize.o : ../Modules/mp.o
orthogonalize.o : ../Modules/mp_bands.o
orthogonalize.o : ../Modules/noncol.o
orthogonalize.o : ../Modules/recvec.o
orthogonalize.o : ../Modules/uspp.o
orthogonalize.o : ../PW/src/pwcom.o
orthogonalize.o : lrcom.o

View File

@ -17,18 +17,18 @@ SUBROUTINE orthogonalize(dvpsi, evq, ikk, ikq, dpsi, npwq)
!
! NB: IN/OUT is dvpsi ; dpsi is used as work_space
!
USE kinds, ONLY : DP
USE klist, ONLY : lgauss, degauss, ngauss
USE kinds, ONLY : DP
USE klist, ONLY : lgauss, degauss, ngauss
USE noncollin_module, ONLY : noncolin, npol
USE wvfct, ONLY : npwx, nbnd, et
USE ener, ONLY : ef
USE control_ph, ONLY : alpha_pv, nbnd_occ
USE wvfct, ONLY : npwx, nbnd, et
USE ener, ONLY : ef
USE becmod, ONLY : bec_type, becp, calbec
USE uspp, ONLY : vkb, okvan
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
USE control_flags, ONLY : gamma_only
USE gvect, ONLY : gstart
USE control_lr, ONLY : alpha_pv, nbnd_occ
!
IMPLICIT NONE
INTEGER, INTENT(IN) :: ikk, ikq ! the index of the k and k+q points

View File

@ -17,6 +17,7 @@ subroutine ch_psi_all2 (n, h, ah, e, ik, m)
USE uspp, ONLY: vkb
use becmod
use phcom
use control_lr, ONLY : alpha_pv
USE mp_global, ONLY: intra_pool_comm
USE mp, ONLY: mp_sum

View File

@ -55,6 +55,7 @@ SUBROUTINE d3_setup()
USE control_flags, ONLY : iverbosity, modenum
USE constants, ONLY : degspin
USE qpoint, ONLY : xq, ikks, ikqs, nksq
USE control_lr, ONLY : alpha_pv, nbnd_occ
USE phcom
USE d3com, ONLY : q0mode, wrmode, nsymg0, npertg0, nirrg0, &
npert_i, npert_f, q0mode_todo, allmodes, ug0, &

View File

@ -31,6 +31,7 @@ subroutine d3vrho()
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE qpoint, ONLY : nksq, npwq, igkq
USE control_lr, ONLY : nbnd_occ
USE phcom
USE d3com
!

View File

@ -19,6 +19,7 @@ subroutine dpsi_corr (evcq, psidvpsi_x, ik, ikq, nu)
USE kinds, only : DP
use pwcom
use qpoint, ONLY: npwq
use control_lr, ONLY : nbnd_occ
use phcom
use d3com

View File

@ -40,6 +40,7 @@ subroutine solve_linter_d3 (irr, imode0, npe, isw_sl)
USE uspp, ONLY : vkb
USE wavefunctions_module, ONLY : evc
use qpoint, ONLY : xq, igkq, npwq, nksq
use control_lr, ONLY : nbnd_occ
use phcom
use d3com
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm

View File

@ -103,7 +103,6 @@ mode_group.o \
newdq.o \
obsolete.o \
openfilq.o \
orthogonalize.o \
phcom.o \
ph_restart.o \
phescf.o \

View File

@ -29,9 +29,10 @@ subroutine add_dkmds(kpoint, uact, jpol, dvkb)
USE becmod, ONLY: calbec
USE qpoint, ONLY : igkq, npwq
USE phus, ONLY : becp1, alphap, dpqq, dpqq_so
USE control_ph, ONLY : nbnd_occ
USE eqv, ONLY : dvpsi
USE control_lr, ONLY : nbnd_occ
implicit none
integer, intent(in) :: kpoint, jpol

View File

@ -24,8 +24,8 @@ subroutine add_zstar_ue (imode0, npe)
USE qpoint, ONLY: npwq, nksq
USE eqv, ONLY: dpsi, dvpsi
USE efield_mod, ONLY: zstarue0_rec
USE control_ph, ONLY : nbnd_occ
USE units_ph, ONLY : iudwf, lrdwf, iuwfc, lrwfc
USE control_lr, ONLY : nbnd_occ
implicit none

View File

@ -26,13 +26,13 @@ subroutine add_zstar_ue_us(imode0,npe)
USE buffers, ONLY: get_buffer
USE qpoint, ONLY : npwq, nksq
USE efield_mod, ONLY: zstarue0_rec
USE control_ph, ONLY : nbnd_occ
USE eqv, ONLY : dpsi, dvpsi
USE modes, ONLY : u
USE units_ph, ONLY : iucom, lrcom, iuwfc, lrwfc
USE mp_bands, ONLY: intra_bgrp_comm
USE mp, ONLY: mp_sum
USE control_lr, ONLY : nbnd_occ
implicit none

View File

@ -22,8 +22,8 @@ SUBROUTINE adddvepsi_us(becp1,becp2,ipol,kpoint,dvpsi)
USE uspp_param, only: nh
USE phus, ONLY : dpqq, dpqq_so
USE becmod, ONLY : bec_type
USE control_ph, ONLY: nbnd_occ
USE control_flags, ONLY : gamma_only
USE control_lr, ONLY: nbnd_occ
implicit none

View File

@ -21,7 +21,7 @@ subroutine addusdbec (ik, wgt, psi, dbecsum)
USE uspp_param, only: upf, nh, nhm
USE phus, ONLY : becp1
USE qpoint, ONLY : npwq, ikks
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
!
USE mp_bands, ONLY : intra_bgrp_comm
!

View File

@ -24,7 +24,7 @@ subroutine addusdbec_nc (ik, wgt, psi, dbecsum_nc)
USE uspp_param, only: upf, nh, nhm
USE qpoint, ONLY : npwq, ikks
USE phus, ONLY : becp1
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
!
USE mp_bands, ONLY : intra_bgrp_comm
!

View File

@ -20,13 +20,14 @@ subroutine cch_psi_all (n, h, ah, e, ik, m)
USE wvfct, ONLY : npwx, nbnd
USE noncollin_module, ONLY : noncolin, npol
USE control_ph, ONLY : alpha_pv, nbnd_occ
USE eqv, ONLY : evq
USE qpoint, ONLY : ikqs
USE mp_bands, ONLY: intra_bgrp_comm
USE mp, ONLY: mp_sum
USE control_lr, ONLY : alpha_pv, nbnd_occ
implicit none
integer :: n, m, ik

View File

@ -26,13 +26,15 @@ SUBROUTINE ch_psi_all (n, h, ah, e, ik, m)
USE qpoint, ONLY : igkq
USE noncollin_module, ONLY : noncolin, npol
USE control_ph, ONLY : alpha_pv, nbnd_occ, lgamma
USE eqv, ONLY : evq
USE qpoint, ONLY : ikqs
USE mp_bands, ONLY : intra_bgrp_comm, ntask_groups
USE mp, ONLY : mp_sum
USE control_ph, ONLY : lgamma
USE control_lr, ONLY : alpha_pv, nbnd_occ
!Needed only for TDDFPT
USE control_flags, ONLY : gamma_only, tddfpt
USE wavefunctions_module, ONLY : evc

View File

@ -22,7 +22,7 @@ subroutine chi_test (dvscfs, chif, ik, depsi, auxr, auxg)
USE buffers, ONLY : get_buffer
USE qpoint, ONLY : npwq, nksq
USE eqv, ONLY : dpsi, dvpsi
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE wavefunctions_module, ONLY: evc
implicit none

View File

@ -31,7 +31,8 @@ subroutine compute_alphasum
USE phus, ONLY : alphasum, alphasum_nc, becp1, alphap
USE qpoint, ONLY : nksq, ikks, ikqs
USE control_ph, ONLY : nbnd_occ, rec_code_read
USE control_ph, ONLY : rec_code_read
USE control_lr, ONLY : nbnd_occ
implicit none

View File

@ -29,7 +29,8 @@ subroutine compute_becsum_ph
USE phus, ONLY : alphasum, alphasum_nc, becp1, becsum_nc
USE qpoint, ONLY : nksq, ikks, ikqs
USE control_ph, ONLY : nbnd_occ, rec_code_read
USE control_ph, ONLY : rec_code_read
USE control_lr, ONLY : nbnd_occ
implicit none

View File

@ -28,7 +28,8 @@ subroutine compute_nldyn (wdyn, wgg, becq, alpq)
USE modes, ONLY : u
USE phus, ONLY : becp1, alphap, int1, int2, &
int2_so, int1_nc
USE control_ph, ONLY : nbnd_occ, rec_code_read
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : rec_code_read
USE mp_bands, ONLY: intra_bgrp_comm
USE mp, ONLY: mp_sum

View File

@ -52,7 +52,7 @@ subroutine dhdrhopsi
USE qpoint, ONLY : npwq, nksq
USE phus, ONLY : becp1
USE units_ph, ONLY : lrdwf, iudwf, lrwfc, iuwfc
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE mp_pools, ONLY : inter_pool_comm
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum

View File

@ -26,7 +26,8 @@ subroutine dielec()
USE eqv, ONLY : dpsi, dvpsi
USE qpoint, ONLY : nksq
USE ph_restart, ONLY : ph_writefile
USE control_ph, ONLY : nbnd_occ, done_epsil, epsil
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : done_epsil, epsil
USE mp_pools, ONLY : inter_pool_comm
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum

View File

@ -25,7 +25,7 @@ subroutine dielec_test
USE efield_mod, ONLY : epsilon
USE qpoint, ONLY : nksq
USE eqv, ONLY : dpsi
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : lrwfc, iuwfc
USE ramanm, ONLY : a1j, a2j, lrd2w, iud2w

View File

@ -35,7 +35,7 @@ subroutine dvpsi_e (ik, ipol)
USE qpoint, ONLY : nksq, npwq
USE units_ph, ONLY : this_pcxpsi_is_on_file, lrcom, iucom, &
lrebar, iuebar
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
implicit none
!

View File

@ -27,7 +27,7 @@ subroutine dvpsi_e2
USE io_files, ONLY : iunigk
USE qpoint, ONLY : npwq, nksq
USE units_ph, ONLY : lrdrho, iudrho, lrdwf, iudwf, lrwfc, iuwfc
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE ramanm, ONLY : lrba2, iuba2, lrchf, iuchf, a1j, a2j
USE mp_pools, ONLY : my_pool_id, inter_pool_comm
USE mp_bands, ONLY : intra_bgrp_comm

View File

@ -39,7 +39,8 @@ SUBROUTINE dynmat_us()
USE modes, ONLY : u
USE dynmat, ONLY : dyn
USE phus, ONLY : becp1, alphap
USE control_ph, ONLY : nbnd_occ, lgamma
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : lgamma
USE units_ph, ONLY : iuwfc, lrwfc
USE io_global, ONLY : stdout
USE mp_pools, ONLY : my_pool_id, inter_pool_comm

View File

@ -35,7 +35,8 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
USE noncollin_module, ONLY : noncolin, npol, nspin_mag, nspin_lsda
! modules from phcom
USE qpoint, ONLY : nksq
USE control_ph, ONLY : nbnd_occ, lgamma_gamma
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : lgamma_gamma
USE units_ph, ONLY : lrwfc, iuwfc, lrdwf, iudwf
USE eqv, ONLY : dpsi
USE modes, ONLY : npert
@ -177,7 +178,8 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
USE ener, ONLY : ef
! modules from phcom
USE qpoint, ONLY : nksq
USE control_ph, ONLY : nbnd_occ, lgamma_gamma
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : lgamma_gamma
USE noncollin_module, ONLY : noncolin, npol, nspin_lsda, nspin_mag
USE units_ph, ONLY : lrwfc, iuwfc, lrdwf, iudwf
USE eqv, ONLY : dpsi

View File

@ -22,7 +22,7 @@ subroutine el_opt
USE qpoint, ONLY : nksq
USE wvfct, ONLY : nbnd, npw, npwx
USE units_ph, ONLY : iudrho, lrdrho, lrdwf, iudwf
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE buffers, ONLY : get_buffer
USE ph_restart, ONLY : ph_writefile
USE ramanm, ONLY : eloptns, jab, lrchf, iuchf, done_elop

View File

@ -24,7 +24,7 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
USE uspp_param,ONLY: nhm
USE wavefunctions_module, ONLY: evc
USE qpoint, ONLY : npwq, igkq, ikks
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE mp_bands, ONLY : me_bgrp, inter_bgrp_comm, ntask_groups
USE mp, ONLY : mp_sum

View File

@ -27,7 +27,7 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
USE wvfct, ONLY : npw, npwx, igk, nbnd
USE wavefunctions_module, ONLY: evc
USE qpoint, ONLY : npwq, igkq, ikks
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE mp_bands, ONLY : me_bgrp, inter_bgrp_comm, ntask_groups
USE mp, ONLY : mp_sum

View File

@ -26,7 +26,7 @@ subroutine incdrhous (drhoscf, weight, ik, dbecsum, evcr, wgg, becq, &
USE wvfct, ONLY : nbnd, npwx
USE qpoint, ONLY : nksq, igkq, npwq, ikks
USE phus, ONLY : becp1, alphap
USE control_ph, ONLY: nbnd_occ
USE control_lr, ONLY: nbnd_occ
USE eqv, ONLY : evq, dpsi
USE modes, ONLY : u
USE mp_bands, ONLY : intra_bgrp_comm

View File

@ -30,7 +30,7 @@ subroutine incdrhous_nc (drhoscf, weight, ik, dbecsum, evcr, wgg, becq, &
USE modes, ONLY : u
USE qpoint, ONLY : npwq, nksq, igkq, ikks
USE eqv, ONLY : dpsi, evq
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE phus, ONLY : becp1, alphap
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum

View File

@ -34,7 +34,7 @@ subroutine localdos_paw (ldos, ldoss, becsum1, dos_ef)
USE uspp, ONLY: okvan, nkb, vkb
USE uspp_param, ONLY: upf, nh, nhm
USE qpoint, ONLY : nksq
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : iuwfc, lrwfc
USE io_files, ONLY: iunigk

View File

@ -49,6 +49,7 @@ addcore.o : ../../Modules/kind.o
addcore.o : ../../Modules/recvec.o
addcore.o : ../../Modules/uspp.o
addcore.o : phcom.o
adddvepsi_us.o : ../../LR_Modules/lrcom.o
adddvepsi_us.o : ../../Modules/becmod.o
adddvepsi_us.o : ../../Modules/control_flags.o
adddvepsi_us.o : ../../Modules/ions_base.o
@ -793,7 +794,6 @@ incdrhoscf.o : ../../Modules/recvec.o
incdrhoscf.o : ../../Modules/uspp.o
incdrhoscf.o : ../../Modules/wavefunctions.o
incdrhoscf.o : ../../PW/src/pwcom.o
incdrhoscf.o : phcom.o
incdrhoscf_nc.o : ../../FFTXlib/fft_interfaces.o
incdrhoscf_nc.o : ../../LR_Modules/lrcom.o
incdrhoscf_nc.o : ../../Modules/cell_base.o
@ -807,7 +807,6 @@ incdrhoscf_nc.o : ../../Modules/recvec.o
incdrhoscf_nc.o : ../../Modules/uspp.o
incdrhoscf_nc.o : ../../Modules/wavefunctions.o
incdrhoscf_nc.o : ../../PW/src/pwcom.o
incdrhoscf_nc.o : phcom.o
incdrhous.o : ../../FFTXlib/fft_interfaces.o
incdrhous.o : ../../LR_Modules/lrcom.o
incdrhous.o : ../../Modules/becmod.o
@ -972,16 +971,7 @@ openfilq.o : elph.o
openfilq.o : phcom.o
openfilq.o : ramanm.o
openfilq.o : save_ph_input.o
orthogonalize.o : ../../Modules/becmod.o
orthogonalize.o : ../../Modules/control_flags.o
orthogonalize.o : ../../Modules/kind.o
orthogonalize.o : ../../Modules/mp.o
orthogonalize.o : ../../Modules/mp_bands.o
orthogonalize.o : ../../Modules/noncol.o
orthogonalize.o : ../../Modules/recvec.o
orthogonalize.o : ../../Modules/uspp.o
orthogonalize.o : ../../PW/src/pwcom.o
orthogonalize.o : phcom.o
pcgreen.o : ../../LR_Modules/lrcom.o
pcgreen.o : ../../Modules/kind.o
pcgreen.o : ../../Modules/mp.o
pcgreen.o : ../../Modules/mp_bands.o

View File

@ -1937,7 +1937,7 @@ subroutine localdos (ldos, ldoss, dos_ef)
USE uspp_param, ONLY: upf, nh, nhm
USE io_files, ONLY: iunigk
USE qpoint, ONLY : nksq
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : iuwfc, lrwfc
USE mp_global, ONLY : inter_pool_comm

View File

@ -1,176 +0,0 @@
!
! Copyright (C) 2008 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 orthogonalize(dvpsi, evq, ikk, ikq, dpsi, npwq)
!------------------------------------------------------------------------
!
! This routine ortogonalizes dvpsi to the valence states: ps = <evq|dvpsi>
! It should be quite general. It works for metals and insulators, with
! NC as well as with US PP, both SR or FR.
! Note that on output it changes sign. So it applies -P^+_c.
!
! NB: IN/OUT is dvpsi ; dpsi is used as work_space
!
USE kinds, ONLY : DP
USE klist, ONLY : lgauss, degauss, ngauss
USE noncollin_module, ONLY : noncolin, npol
USE wvfct, ONLY : npwx, nbnd, et
USE ener, ONLY : ef
USE control_ph, ONLY : alpha_pv, nbnd_occ
USE becmod, ONLY : bec_type, becp, calbec
USE uspp, ONLY : vkb, okvan
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
USE control_flags, ONLY : gamma_only
USE gvect, ONLY : gstart
!
IMPLICIT NONE
INTEGER, INTENT(IN) :: ikk, ikq ! the index of the k and k+q points
INTEGER, INTENT(IN) :: npwq ! the number of plane waves for q
COMPLEX(DP), INTENT(IN) :: evq(npwx*npol,nbnd)
COMPLEX(DP), INTENT(INOUT) :: dvpsi(npwx*npol,nbnd)
COMPLEX(DP), INTENT(INOUT) :: dpsi(npwx*npol,nbnd) ! work space allocated by
! the calling routine
COMPLEX(DP), ALLOCATABLE :: ps(:,:)
REAL(DP), ALLOCATABLE :: ps_r(:,:)
INTEGER :: ibnd, jbnd, nbnd_eff
REAL(DP) :: wg1, w0g, wgp, wwg, deltae, theta
REAL(DP), EXTERNAL :: w0gauss, wgauss
! functions computing the delta and theta function
CALL start_clock ('ortho')
IF (gamma_only) THEN
ALLOCATE(ps_r(nbnd,nbnd))
ps_r = 0.0_DP
ENDIF
ALLOCATE(ps(nbnd,nbnd))
ps = (0.0_DP, 0.0_DP)
!
if (lgauss) then
!
IF (gamma_only) CALL errore ('orthogonalize', "degauss with gamma &
& point algorithms",1)
!
! metallic case
!
IF (noncolin) THEN
CALL zgemm( 'C', 'N', nbnd, nbnd_occ (ikk), npwx*npol, (1.d0,0.d0), &
evq, npwx*npol, dvpsi, npwx*npol, (0.d0,0.d0), ps, nbnd )
ELSE
CALL zgemm( 'C', 'N', nbnd, nbnd_occ (ikk), npwq, (1.d0,0.d0), &
evq, npwx, dvpsi, npwx, (0.d0,0.d0), ps, nbnd )
END IF
!
DO ibnd = 1, nbnd_occ (ikk)
wg1 = wgauss ((ef-et(ibnd,ikk)) / degauss, ngauss)
w0g = w0gauss((ef-et(ibnd,ikk)) / degauss, ngauss) / degauss
DO jbnd = 1, nbnd
wgp = wgauss ( (ef - et (jbnd, ikq) ) / degauss, ngauss)
deltae = et (jbnd, ikq) - et (ibnd, ikk)
theta = wgauss (deltae / degauss, 0)
wwg = wg1 * (1.d0 - theta) + wgp * theta
IF (jbnd <= nbnd_occ (ikq) ) THEN
IF (abs (deltae) > 1.0d-5) THEN
wwg = wwg + alpha_pv * theta * (wgp - wg1) / deltae
ELSE
!
! if the two energies are too close takes the limit
! of the 0/0 ratio
!
wwg = wwg - alpha_pv * theta * w0g
ENDIF
ENDIF
!
ps(jbnd,ibnd) = wwg * ps(jbnd,ibnd)
!
ENDDO
IF (noncolin) THEN
CALL dscal (2*npwx*npol, wg1, dvpsi(1,ibnd), 1)
ELSE
call dscal (2*npwq, wg1, dvpsi(1,ibnd), 1)
END IF
END DO
nbnd_eff=nbnd
ELSE
!
! insulators
!
IF (noncolin) THEN
CALL zgemm( 'C', 'N',nbnd_occ(ikq), nbnd_occ(ikk), npwx*npol, &
(1.d0,0.d0), evq, npwx*npol, dvpsi, npwx*npol, &
(0.d0,0.d0), ps, nbnd )
ELSEIF (gamma_only) THEN
CALL dgemm( 'C', 'N', nbnd_occ(ikq), nbnd_occ (ikk), 2*npwq, &
2.0_DP, evq, 2*npwx, dvpsi, 2*npwx, &
0.0_DP, ps_r, nbnd )
IF (gstart == 2 ) THEN
CALL DGER( nbnd_occ(ikq), nbnd_occ (ikk), -1.0_DP, evq, &
& 2*npwq, dvpsi, 2*npwx, ps_r, nbnd )
ENDIF
ELSE
CALL zgemm( 'C', 'N', nbnd_occ(ikq), nbnd_occ (ikk), npwq, &
(1.d0,0.d0), evq, npwx, dvpsi, npwx, &
(0.d0,0.d0), ps, nbnd )
END IF
nbnd_eff=nbnd_occ(ikk)
END IF
IF (gamma_only) THEN
call mp_sum(ps_r(:,:),intra_bgrp_comm)
ELSE
call mp_sum(ps(:,1:nbnd_eff),intra_bgrp_comm)
ENDIF
!
! dpsi is used as work space to store S|evc>
!
IF (okvan) CALL calbec ( npwq, vkb, evq, becp, nbnd_eff)
CALL s_psi (npwx, npwq, nbnd_eff, evq, dpsi)
!
! |dvspi> = -(|dvpsi> - S|evq><evq|dvpsi>)
!
if (lgauss) then
!
! metallic case
!
IF (noncolin) THEN
CALL zgemm( 'N', 'N', npwx*npol, nbnd_occ(ikk), nbnd, &
(1.d0,0.d0), dpsi, npwx*npol, ps, nbnd, (-1.0d0,0.d0), &
dvpsi, npwx*npol )
ELSE
CALL zgemm( 'N', 'N', npwq, nbnd_occ(ikk), nbnd, &
(1.d0,0.d0), dpsi, npwx, ps, nbnd, (-1.0d0,0.d0), &
dvpsi, npwx )
END IF
ELSE
!
! Insulators: note that nbnd_occ(ikk)=nbnd_occ(ikq) in an insulator
!
IF (noncolin) THEN
CALL zgemm( 'N', 'N', npwx*npol, nbnd_occ(ikk), nbnd_occ(ikk), &
(1.d0,0.d0),dpsi,npwx*npol,ps,nbnd,(-1.0d0,0.d0), &
dvpsi, npwx*npol )
ELSEIF (gamma_only) THEN
ps = CMPLX (ps_r,0.0_DP, KIND=DP)
CALL ZGEMM( 'N', 'N', npwq, nbnd_occ(ikk), nbnd_occ(ikk), &
(1.d0,0.d0), dpsi, npwx, ps, nbnd, (-1.0d0,0.d0), &
dvpsi, npwx )
ELSE
CALL zgemm( 'N', 'N', npwq, nbnd_occ(ikk), nbnd_occ(ikk), &
(1.d0,0.d0), dpsi, npwx, ps, nbnd, (-1.0d0,0.d0), &
dvpsi, npwx )
END IF
ENDIF
DEALLOCATE(ps)
CALL stop_clock ('ortho')
RETURN
END SUBROUTINE orthogonalize

View File

@ -21,7 +21,7 @@ subroutine pcgreen (avg_iter, thresh, ik, et_ )
USE mp_bands, ONLY: intra_bgrp_comm
USE mp, ONLY: mp_sum
USE eqv, ONLY: dpsi, dvpsi, eprec
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
implicit none
!

View File

@ -279,15 +279,13 @@ MODULE control_ph
INTEGER, PARAMETER :: maxter = 100 ! maximum number of iterations
INTEGER :: niter_ph, & ! maximum number of iterations (read from input)
nmix_ph, & ! mixing type
nbnd_occ(npk), & ! occupated bands in metals
start_irr, & ! initial representation
last_irr, & ! last representation of this run
current_iq, & ! current q point
start_q, last_q ! initial q in the list, last_q in the list
REAL(DP) :: tr2_ph ! threshold for phonon calculation
REAL(DP) :: alpha_mix(maxter), & ! the mixing parameter
time_now, & ! CPU time up to now
alpha_pv ! the alpha value for shifting the bands
time_now ! CPU time up to now
CHARACTER(LEN=10) :: where_rec='no_recover'! where the ph run recovered
CHARACTER(LEN=12) :: electron_phonon
CHARACTER(LEN=256) :: flmixdpot, tmp_dir_ph, tmp_dir_phq

View File

@ -54,7 +54,8 @@ SUBROUTINE phq_init()
USE eqv, ONLY : vlocq, evq, eprec
USE phus, ONLY : becp1, alphap, dpqq, dpqq_so
USE nlcc_ph, ONLY : nlcc_any, drc
USE control_ph, ONLY : trans, zue, epsil, lgamma, all_done, nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : trans, zue, epsil, lgamma, all_done
USE units_ph, ONLY : lrwfc, iuwfc
USE qpoint, ONLY : xq, igkq, npwq, nksq, eigqts, ikks, ikqs

View File

@ -72,10 +72,11 @@ subroutine phq_setup
USE wvfct, ONLY : nbnd, et
USE nlcc_ph, ONLY : drc, nlcc_any
USE eqv, ONLY : dmuxc
USE control_lr, ONLY : alpha_pv, nbnd_occ
USE control_ph, ONLY : rec_code, lgamma_gamma, search_sym, start_irr, &
last_irr, niter_ph, alpha_mix, all_done, &
trans, epsil, lgamma, recover, where_rec, alpha_pv,&
nbnd_occ, flmixdpot, reduce_io, rec_code_read, &
trans, epsil, lgamma, recover, where_rec, &
flmixdpot, reduce_io, rec_code_read, &
done_epsil, zeu, done_zeu, current_iq, u_from_file
USE el_phon, ONLY : elph, comp_elph, done_elph
USE output, ONLY : fildrho

View File

@ -21,7 +21,7 @@ subroutine polariz ( iw, iu )
USE symme, ONLY : symmatrix, crys_to_cart
USE wvfct, ONLY : npw, npwx, igk
USE kinds, ONLY : DP
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : lrdwf, iudwf, lrebar, iuebar
USE buffers, ONLY : get_buffer
USE freq_ph, ONLY : polar, done_iu, comp_iu

View File

@ -28,7 +28,7 @@ subroutine raman_mat
USE wavefunctions_module, ONLY: evc
USE eqv, ONLY : dvpsi
USE phus, ONLY : becp1, alphap
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : lrdwf, iudwf, lrwfc, iuwfc
USE qpoint, ONLY : npwq, nksq
USE ramanm, ONLY : ramtns, jab, a1j, a2j, lrd2w, iud2w

View File

@ -47,8 +47,9 @@ subroutine solve_e
USE units_ph, ONLY : lrdwf, iudwf, lrwfc, iuwfc, lrdrho, &
iudrho
USE output, ONLY : fildrho
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : ext_recover, rec_code, &
lnoloc, nbnd_occ, convt, tr2_ph, nmix_ph, &
lnoloc, convt, tr2_ph, nmix_ph, &
alpha_mix, lgamma_gamma, niter_ph, &
lgamma, flmixdpot, rec_code_read
USE phus, ONLY : int3_paw

View File

@ -30,7 +30,8 @@ subroutine solve_e2
USE wavefunctions_module, ONLY: evc
USE eqv, ONLY : dpsi, dvpsi
USE qpoint, ONLY : npwq, igkq, nksq
USE control_ph, ONLY : convt, nmix_ph, alpha_mix, nbnd_occ, tr2_ph, &
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : convt, nmix_ph, alpha_mix, tr2_ph, &
niter_ph, lgamma, rec_code, flmixdpot, rec_code_read
USE units_ph, ONLY : lrwfc, iuwfc
USE ramanm, ONLY : lrba2, iuba2, lrd2w, iud2w

View File

@ -38,8 +38,9 @@ subroutine solve_e_fpol ( iw )
USE uspp, ONLY : okvan, vkb
USE uspp_param, ONLY : nhm
USE eqv, ONLY : dpsi, dvpsi, eprec
USE control_lr, ONLY : nbnd_occ
USE control_ph, ONLY : nmix_ph, tr2_ph, alpha_mix, convt, &
nbnd_occ, lgamma, niter_ph, &
lgamma, niter_ph, &
rec_code, flmixdpot
USE output, ONLY : fildrho
USE qpoint, ONLY : nksq, npwq, igkq

View File

@ -28,7 +28,7 @@ subroutine solve_e_nscf( avg_iter, thresh, ik, ipol, dvscfs, auxr )
USE eqv, ONLY : dpsi, dvpsi
USE units_ph, ONLY : this_pcxpsi_is_on_file, lrdwf, iudwf
USE qpoint, ONLY : nksq, npwq, igkq
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
implicit none
!

View File

@ -45,9 +45,10 @@ SUBROUTINE solve_linter (irr, imode0, npe, drhoscf)
USE paw_onecenter, ONLY : paw_dpotential
USE paw_symmetry, ONLY : paw_dusymmetrize, paw_dumqsymmetrize
USE buffers, ONLY : save_buffer, get_buffer
USE control_lr, ONLY : alpha_pv, nbnd_occ
USE control_ph, ONLY : rec_code, niter_ph, nmix_ph, tr2_ph, &
alpha_pv, lgamma, lgamma_gamma, convt, &
nbnd_occ, alpha_mix, rec_code_read, &
lgamma, lgamma_gamma, convt, &
alpha_mix, rec_code_read, &
where_rec, flmixdpot, ext_recover
USE el_phon, ONLY : elph
USE nlcc_ph, ONLY : nlcc_any

View File

@ -30,7 +30,8 @@ subroutine zstar_eu
USE eqv, ONLY : dvpsi, dpsi
USE efield_mod, ONLY : zstareu0, zstareu
USE units_ph, ONLY : iudwf, lrdwf, iuwfc, lrwfc
USE control_ph,ONLY : nbnd_occ, done_zeu
USE control_lr,ONLY : nbnd_occ
USE control_ph,ONLY : done_zeu
USE ph_restart, ONLY : ph_writefile
USE mp_pools, ONLY : inter_pool_comm

View File

@ -32,7 +32,7 @@ subroutine zstar_eu_us
USE uspp_param, ONLY : upf, nhm, nh
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE qpoint, ONLY : nksq, npwq
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE efield_mod, ONLY : zstareu0
USE eqv, ONLY : dvpsi, dpsi
USE phus, ONLY : becsumort, int3, int3_paw

View File

@ -25,7 +25,7 @@ SUBROUTINE lr_alloc_init()
USE charg_resp, ONLY : w_T, w_T_beta_store, w_T_gamma_store, &
& w_T_zeta_store, w_T_npol,chi
USE realus, ONLY : igk_k, npw_k, tg_psic
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE noncollin_module, ONLY : nspin_mag, npol, noncolin
USE eqv, ONLY : dmuxc, evq, dpsi, dvpsi
USE wavefunctions_module, ONLY : evc

View File

@ -38,7 +38,7 @@ SUBROUTINE lr_apply_liouvillian_eels ( evc1, evc1_new, sevc1_new, interaction )
USE wavefunctions_module, ONLY : evc, psic, psic_nc
USE units_ph, ONLY : lrwfc, iuwfc
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE uspp, ONLY : okvan
USE nlcc_ph, ONLY : nlcc_any
USE iso_c_binding, ONLY : c_int

View File

@ -38,7 +38,7 @@ SUBROUTINE lr_calc_dens_eels (drhoscf, dpsi)
USE wvfct, ONLY : nbnd,wg,npwx,npw,igk,g2kin
USE gvecw, ONLY : gcutw
USE qpoint, ONLY : npwq, igkq, nksq, ikks, ikqs
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : lrwfc, iuwfc
USE wavefunctions_module, ONLY : evc
USE eqv, ONLY : evq

View File

@ -37,7 +37,7 @@ SUBROUTINE lr_calc_dens_eels_nc (drhoscf, dpsi)
USE wvfct, ONLY : nbnd,wg,npwx,npw,igk,g2kin
USE gvecw, ONLY : gcutw
USE qpoint, ONLY : npwq, igkq, nksq, ikks, ikqs
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : lrwfc, iuwfc
USE wavefunctions_module, ONLY : evc
USE eqv, ONLY : evq

View File

@ -133,7 +133,7 @@ CONTAINS
USE kinds, ONLY : DP
USE lr_variables, ONLY : R, nbnd_total, n_ipol, project
USE wvfct, ONLY : nbnd
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
IMPLICIT NONE

View File

@ -30,7 +30,7 @@ FUNCTION lr_dot(x,y)
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE lr_variables, ONLY : lr_verbosity, lr_periodic, eels
USE noncollin_module, ONLY : noncolin, npol
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE qpoint, ONLY : npwq, igkq, ikks, ikqs, nksq
!
IMPLICIT NONE

View File

@ -32,7 +32,7 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
USE uspp_param, ONLY : nh, nhm
USE phus, ONLY : dpqq
USE control_flags, ONLY : gamma_only
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE realus, ONLY : npw_k
USE lr_variables, ONLY : lr_verbosity
USE io_global, ONLY : stdout

View File

@ -40,7 +40,7 @@ SUBROUTINE lr_dvpsi_eels (ik, dvpsi1, dvpsi2)
use klist, only : xk
use gvect, only : ngm, g
use cell_base, only : tpiba2
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
use lsda_mod, only : current_spin
USE io_files, ONLY : iunigk, iunwfc, prefix, diropn
use uspp, only : vkb, okvan

View File

@ -38,7 +38,8 @@ SUBROUTINE lr_init_nfo()
USE ener, ONLY : ef, ef_up, ef_dw
USE ktetra, ONLY : ltetra
USE lsda_mod, ONLY : lsda, current_spin, nspin, isk
USE control_ph, ONLY : alpha_pv, nbnd_occ, tmp_dir_phq
USE control_lr, ONLY : alpha_pv, nbnd_occ
USE control_ph, ONLY : tmp_dir_phq
USE wvfct, ONLY : npwx, wg
USE gvecw, ONLY : gcutw
USE io_files, ONLY : iunigk, seqopn, tmp_dir, prefix, &

View File

@ -171,7 +171,7 @@ CONTAINS
use gvect, only : ngm, g
use wvfct, only : g2kin
use gvecw, only : gcutw
use control_ph, only : nbnd_occ
use control_lr, only : nbnd_occ
!
IMPLICIT NONE
!

View File

@ -34,7 +34,7 @@ SUBROUTINE lr_ortho(dvpsi, evq, ikk, ikq, sevc, inverse)
USE noncollin_module, ONLY : noncolin, npol
USE wvfct, ONLY : npwx, nbnd, et
USE ener, ONLY : ef
USE control_ph, ONLY : alpha_pv, nbnd_occ
USE control_lr, ONLY : alpha_pv, nbnd_occ
USE uspp, ONLY : vkb, okvan
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum

View File

@ -292,7 +292,7 @@ SUBROUTINE virt_read()
!
! The modifications to read also the virtual orbitals.
!
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
USE becmod, ONLY : allocate_bec_type, deallocate_bec_type
!
IMPLICIT NONE

View File

@ -336,7 +336,7 @@ SUBROUTINE lr_recalc_sevc1_new_eels()
use gvect, only : ngm, g
use wvfct, only : g2kin
use gvecw, only : gcutw
use control_ph, only : nbnd_occ
use control_lr, only : nbnd_occ
implicit none
integer :: ikk, ikq

View File

@ -37,7 +37,7 @@ SUBROUTINE lr_solve_e
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_max, mp_min, mp_barrier
USE realus, ONLY : real_space, real_space_debug
USE control_ph, ONLY : alpha_pv
USE control_lr, ONLY : alpha_pv
USE qpoint, ONLY : nksq
!
IMPLICIT NONE

View File

@ -127,7 +127,7 @@ SUBROUTINE lr_apply_s_eels()
USE gvect, ONLY : ngm, g
USE wvfct, ONLY : g2kin
USE gvecw, ONLY : gcutw
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
IMPLICIT NONE
!

View File

@ -109,7 +109,7 @@ SUBROUTINE lr_sd0psi_eels()
USE gvect, ONLY : ngm, g
USE wvfct, ONLY : g2kin
USE gvecw, ONLY : gcutw
USE control_ph, ONLY : nbnd_occ
USE control_lr, ONLY : nbnd_occ
IMPLICIT NONE
!