Commit 78622ed1 authored by degironc's avatar degironc

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
parent 8d5f5c53
......@@ -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
......
......@@ -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,&
......
......@@ -11,6 +11,7 @@ LR_MODULES = \
apply_dpot.o \
cft_wave.o \
h_psiq.o \
orthogonalize.o \
lrcom.o
TLDEPS=libfft mods
......
......@@ -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
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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, &
......
......@@ -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
!
......
......@@ -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
......
......@@ -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
......
......@@ -103,7 +103,6 @@ mode_group.o \
newdq.o \
obsolete.o \
openfilq.o \
orthogonalize.o \
phcom.o \
ph_restart.o \
phescf.o \
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
!
......
......@@ -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
!
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
!
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
!
! 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
......@@ -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
!
......
......@@ -279,15 +279,13 @@ MODULE control_ph
INTEGER