scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Removal of unused or unmaintained stuff 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12500 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2016-06-16 08:27:42 +00:00
parent d49c829ae9
commit 9776f1f662
4 changed files with 0 additions and 525 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
PHonon/PH/Makefile
View File

@ -27,7 +27,6 @@ yambo.o \
bcast_ph_input.o \
cch_psi_all.o \
ccg_psi.o \
cgsolve_all_imfreq.o \
check_if_partial_dyn.o \
check_initial_status.o \
check_q_points_sym.o \

262
PHonon/PH/cgsolve_all_imfreq.f90
View File

@ -1,262 +0,0 @@
!
! Copyright (C) 2001-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 .
!
! author: P. Umari
!----------------------------------------------------------------------
subroutine cgsolve_all_imfreq (h_psi, cg_psi, e, d0psi, dpsi, h_diag, &
ndmx, ndim, ethr, ik, kter, conv_root, anorm, nbnd, freq)
!----------------------------------------------------------------------
!
! iterative solution of the linear system:
!
! ( h - e + iw Q ) * dpsi = d0psi (1)
!
! where h is a complex hermitean matrix, e is a real sca
! dpsi and d0psi are complex vectors, w= freq is a scalar (frequency)
! it solves (H-iw)(H+iw) * dpsi=(H-iw)d0psi
! on input:
! h_psi EXTERNAL name of a subroutine:
! h_psi(ndim,psi,psip)
! Calculates H*psi products.
! Vectors psi and psip should be dimensined
! (ndmx,nvec). nvec=1 is used!
!
! cg_psi EXTERNAL name of a subroutine:
! g_psi(ndmx,ndim,notcnv,psi,e)
! which calculates (h-e)^-1 * psi, with
! some approximation, e.g. (diag(h)-e)
!
! e real unperturbed eigenvalue.
!
! dpsi contains an estimate of the solution
! vector.
!
! d0psi contains the right hand side vector
! of the system.
!
! ndmx integer row dimension of dpsi, ecc.
!
! ndim integer actual row dimension of dpsi
!
! ethr real convergence threshold. solution
! improvement is stopped when the error in
! eq (1), defined as l.h.s. - r.h.s., becomes
! less than ethr in norm.
!
! on output: dpsi contains the refined estimate of the
! solution vector.
!
! d0psi is NOT corrupted on exit
!
! revised (extensively) 6 Apr 1997 by A. Dal Corso & F. Mauri
! revised (to reduce memory) 29 May 2004 by S. de Gironcoli
!
USE kinds, only : DP
USE mp, only : mp_sum
USE mp_world, only : world_comm
implicit none
!
! first the I/O variables
!
integer :: ndmx, & ! input: the maximum dimension of the vectors
ndim, & ! input: the actual dimension of the vectors
kter, & ! output: counter on iterations
nbnd, & ! input: the number of bands
ik ! input: the k point
real(DP) :: &
e(nbnd), & ! input: the actual eigenvalue
anorm, & ! output: the norm of the error in the solution
h_diag(ndmx,nbnd), & ! input: an estimate of ( H - \epsilon )
ethr,& ! input: the required precision
freq !the imaginary frequency
complex(DP) :: &
dpsi (ndmx, nbnd), & ! output: the solution of the linear syst
d0psi (ndmx, nbnd) ! input: the known term
logical :: conv_root ! output: if true the root is converged
external h_psi ! input: the routine computing h_psi
external cg_psi ! input: the routine computing cg_psi
!
! here the local variables
!
integer, parameter :: maxter = 200
! the maximum number of iterations
integer :: iter, ibnd, lbnd
! counters on iteration, bands
integer , allocatable :: conv (:)
! if 1 the root is converged
complex(DP), allocatable :: g (:,:), t (:,:), h (:,:), hold (:,:)
! the gradient of psi
! the preconditioned gradient
! the delta gradient
! the conjugate gradient
! work space
complex(DP) :: dcgamma, dclambda, zdotc
! the ratio between rho
! step length
! the scalar product
real(DP), allocatable :: rho (:), rhoold (:), eu (:), a(:), c(:)
! the residue
! auxiliary for h_diag
real(DP) :: kter_eff
! account the number of iterations with b
! coefficient of quadratic form
!
REAL(kind=DP), ALLOCATABLE :: zz(:)
COMPLEX(kind=DP), ALLOCATABLE :: tmp_psi0(:,:),tmp_psi1(:,:)
call start_clock ('cgsolve')
allocate ( g(ndmx,nbnd), t(ndmx,nbnd), h(ndmx,nbnd), hold(ndmx ,nbnd) )
allocate (a(nbnd), c(nbnd))
allocate (conv ( nbnd))
allocate (rho(nbnd),rhoold(nbnd))
allocate (eu ( nbnd))
allocate( zz(nbnd),tmp_psi0(ndmx,nbnd),tmp_psi1(ndmx,nbnd))
! WRITE( stdout,*) g,t,h,hold
!calculate (H-iw)d0psi
zz(:)=0.d0
call h_psi (ndim, d0psi, tmp_psi0, e, ik, nbnd)
do ibnd=1,nbnd
tmp_psi0(:,ibnd)=tmp_psi0(:,ibnd)-(0.d0,1.d0)*freq*d0psi(:,ibnd)
enddo
kter_eff = 0.d0
do ibnd = 1, nbnd
conv (ibnd) = 0
enddo
do iter = 1, maxter
!
! compute the gradient. can reuse information from previous step
!
if (iter == 1) then
!call h_psi (ndim, dpsi, g, e, ik, nbnd)
call h_psi (ndim, dpsi, tmp_psi1, e, ik, nbnd)
call h_psi (ndim, tmp_psi1,g, e, ik, nbnd)
do ibnd = 1, nbnd
g(:,ibnd)=g(:,ibnd)+freq**2.d0*dpsi(:,ibnd)
enddo
do ibnd = 1, nbnd
call ZAXPY (ndim, (-1.d0,0.d0), tmp_psi0(1,ibnd), 1, g(1,ibnd), 1)
enddo
endif
!
! compute preconditioned residual vector and convergence check
!
lbnd = 0
do ibnd = 1, nbnd
if (conv (ibnd) .eq.0) then
lbnd = lbnd+1
call ZCOPY (ndim, g (1, ibnd), 1, h (1, ibnd), 1)
call cg_psi(ndmx, ndim, 1, h(1,ibnd), h_diag(1,ibnd) )
rho(lbnd) = zdotc (ndim, h(1,ibnd), 1, g(1,ibnd), 1)
endif
enddo
kter_eff = kter_eff + DBLE (lbnd) / DBLE (nbnd)
call mp_sum(rho, world_comm)
!!!call reduce (lbnd, rho )
do ibnd = nbnd, 1, -1
if (conv(ibnd).eq.0) then
rho(ibnd)=rho(lbnd)
lbnd = lbnd -1
anorm = sqrt (rho (ibnd) )
if (anorm.lt.ethr) conv (ibnd) = 1
endif
enddo
!
conv_root = .true.
do ibnd = 1, nbnd
conv_root = conv_root.and. (conv (ibnd) .eq.1)
enddo
if (conv_root) goto 100
!
! compute the step direction h. Conjugate it to previous step
!
lbnd = 0
do ibnd = 1, nbnd
if (conv (ibnd) .eq.0) then
!
! change sign to h
!
call DSCAL (2 * ndim, - 1.d0, h (1, ibnd), 1)
if (iter.ne.1) then
dcgamma = rho (ibnd) / rhoold (ibnd)
call ZAXPY (ndim, dcgamma, hold (1, ibnd), 1, h (1, ibnd), 1)
endif
!
! here hold is used as auxiliary vector in order to efficiently compute t = A*h
! it is later set to the current (becoming old) value of h
!
lbnd = lbnd+1
call ZCOPY (ndim, h (1, ibnd), 1, hold (1, lbnd), 1)
eu (lbnd) = e (ibnd)
endif
enddo
!
! compute t = A*h
!
!call h_psi (ndim, hold, t, eu, ik, lbnd)
call h_psi (ndim, hold, tmp_psi1, eu, ik, lbnd)
call h_psi (ndim, tmp_psi1,t, eu, ik, lbnd)
do ibnd=1, nbnd
t(:,ibnd)=t(:,ibnd)+freq**2.d0*hold(:,ibnd)
enddo
!
! compute the coefficients a and c for the line minimization
! compute step length lambda
lbnd=0
do ibnd = 1, nbnd
if (conv (ibnd) .eq.0) then
lbnd=lbnd+1
a(lbnd) = zdotc (ndim, h(1,ibnd), 1, g(1,ibnd), 1)
c(lbnd) = zdotc (ndim, h(1,ibnd), 1, t(1,lbnd), 1)
end if
end do
call mp_sum(a, world_comm)
call mp_sum(c, world_comm)
!!!call reduce (lbnd, a)
!!!call reduce (lbnd, c)
lbnd=0
do ibnd = 1, nbnd
if (conv (ibnd) .eq.0) then
lbnd=lbnd+1
dclambda = CMPLX ( - a(lbnd) / c(lbnd), 0.0_dp, kind=dp )
!
! move to new position
!
call ZAXPY (ndim, dclambda, h(1,ibnd), 1, dpsi(1,ibnd), 1)
!
! update to get the gradient
!
!g=g+lam
call ZAXPY (ndim, dclambda, t(1,lbnd), 1, g(1,ibnd), 1)
!
! save current (now old) h and rho for later use
!
call ZCOPY (ndim, h(1,ibnd), 1, hold(1,ibnd), 1)
rhoold (ibnd) = rho (ibnd)
endif
enddo
enddo
100 continue
kter = kter_eff
deallocate (eu)
deallocate (rho, rhoold)
deallocate (conv)
deallocate (a,c)
deallocate (g, t, h, hold)
deallocate (zz,tmp_psi0, tmp_psi1)
call stop_clock ('cgsolve')
return
end subroutine cgsolve_all_imfreq

12
PHonon/PH/make.depend
View File

@ -154,9 +154,6 @@ cch_psi_all.o : ../../Modules/mp_bands.o
cch_psi_all.o : ../../Modules/noncol.o
cch_psi_all.o : ../../Modules/uspp.o
cch_psi_all.o : ../../PW/src/pwcom.o
cgsolve_all_imfreq.o : ../../Modules/kind.o
cgsolve_all_imfreq.o : ../../Modules/mp.o
cgsolve_all_imfreq.o : ../../Modules/mp_world.o
check_if_partial_dyn.o : ../../LR_Modules/lrcom.o
check_if_partial_dyn.o : ../../Modules/control_flags.o
check_if_partial_dyn.o : ../../Modules/ions_base.o
@ -199,7 +196,6 @@ clean_pw_ph.o : phcom.o
clean_pw_ph.o : save_ph_input.o
clinear.o : ../../Modules/kind.o
close_phq.o : ../../Modules/control_flags.o
close_phq.o : ../../Modules/io_files.o
close_phq.o : ../../Modules/io_global.o
close_phq.o : ../../Modules/paw_variables.o
close_phq.o : ../../Modules/uspp.o
@ -798,14 +794,10 @@ mix_pot.o : ../../Modules/mp.o
mix_pot.o : ../../Modules/mp_bands.o
mode_group.o : ../../Modules/constants.o
mode_group.o : ../../Modules/kind.o
obsolete.o : ../../FFTXlib/fft_interfaces.o
obsolete.o : ../../LR_Modules/lrcom.o
obsolete.o : ../../Modules/becmod.o
obsolete.o : ../../Modules/cell_base.o
obsolete.o : ../../Modules/constants.o
obsolete.o : ../../Modules/control_flags.o
obsolete.o : ../../Modules/fft_base.o
obsolete.o : ../../Modules/io_files.o
obsolete.o : ../../Modules/io_global.o
obsolete.o : ../../Modules/ions_base.o
obsolete.o : ../../Modules/kind.o
@ -815,9 +807,6 @@ obsolete.o : ../../Modules/noncol.o
obsolete.o : ../../Modules/random_numbers.o
obsolete.o : ../../Modules/recvec.o
obsolete.o : ../../Modules/run_info.o
obsolete.o : ../../Modules/uspp.o
obsolete.o : ../../Modules/wavefunctions.o
obsolete.o : ../../PW/src/buffers.o
obsolete.o : ../../PW/src/pwcom.o
obsolete.o : ../../PW/src/symm_base.o
obsolete.o : dfile_star.o
@ -896,7 +885,6 @@ phq_init.o : ../../Modules/becmod.o
phq_init.o : ../../Modules/cell_base.o
phq_init.o : ../../Modules/constants.o
phq_init.o : ../../Modules/gvecw.o
phq_init.o : ../../Modules/io_files.o
phq_init.o : ../../Modules/io_global.o
phq_init.o : ../../Modules/ions_base.o
phq_init.o : ../../Modules/kind.o

250
PHonon/PH/obsolete.f90
View File

@ -1911,253 +1911,3 @@ SUBROUTINE find_mode_sym (u, w2, at, bg, tau, nat, nsym, sr, irt, xq, &
RETURN
END SUBROUTINE find_mode_sym
!-----------------------------------------------------------------------
subroutine localdos (ldos, ldoss, dos_ef)
!-----------------------------------------------------------------------
!
! This routine compute the local and total density of state at Ef
!
! Note: this routine use psic as auxiliary variable. it should alread
! be defined
!
! NB: this routine works only with gamma
!
!
USE kinds, only : DP
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE ener, ONLY : ef
USE fft_base, ONLY: dffts, dfftp
USE fft_interfaces, ONLY: invfft
USE gvecs, ONLY : doublegrid, nls
USE klist, ONLY : xk, wk, degauss, ngauss
USE buffers, ONLY : get_buffer
USE lsda_mod, ONLY : nspin, lsda, current_spin, isk
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE wvfct, ONLY : nbnd, npw, npwx, igk, et
USE becmod, ONLY: calbec, bec_type, allocate_bec_type, deallocate_bec_type
USE wavefunctions_module, ONLY: evc, psic, psic_nc
USE uspp, ONLY: okvan, nkb, vkb
USE uspp_param, ONLY: upf, nh, nhm
USE io_files, ONLY: iunigk
USE qpoint, ONLY : nksq
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : iuwfc, lrwfc
USE mp_global, ONLY : inter_pool_comm
USE mp, ONLY : mp_sum
implicit none
complex(DP) :: ldos (dfftp%nnr, nspin_mag), ldoss (dffts%nnr, nspin_mag)
! output: the local density of states at Ef
! output: the local density of states at Ef without augmentation
real(DP) :: dos_ef
! output: the density of states at Ef
!
! local variables for Ultrasoft PP's
!
integer :: ikb, jkb, ijkb0, ih, jh, na, ijh, nt
! counters
real(DP), allocatable :: becsum1 (:,:,:)
complex(DP), allocatable :: becsum1_nc(:,:,:,:)
TYPE(bec_type) :: becp
!
! local variables
!
real(DP) :: weight, w1, wdelta
! weights
real(DP), external :: w0gauss
!
integer :: ik, is, ig, ibnd, j, is1, is2
! counters
integer :: ios
! status flag for i/o
!
! initialize ldos and dos_ef
!
call start_clock ('localdos')
allocate (becsum1( (nhm * (nhm + 1)) / 2, nat, nspin_mag))
IF (noncolin) THEN
allocate (becsum1_nc( (nhm * (nhm + 1)) / 2, nat, npol, npol))
becsum1_nc=(0.d0,0.d0)
ENDIF
CALL allocate_bec_type(nkb, nbnd, becp)
becsum1 (:,:,:) = 0.d0
ldos (:,:) = (0d0, 0.0d0)
ldoss(:,:) = (0d0, 0.0d0)
dos_ef = 0.d0
!
! loop over kpoints
!
if (nksq > 1) rewind (unit = iunigk)
do ik = 1, nksq
if (lsda) current_spin = isk (ik)
if (nksq > 1) then
read (iunigk, err = 100, iostat = ios) npw, igk
100 call errore ('solve_linter', 'reading igk', abs (ios) )
endif
weight = wk (ik)
!
! unperturbed wfs in reciprocal space read from unit iuwfc
!
if (nksq > 1) call get_buffer (evc, lrwfc, iuwfc, ik)
call init_us_2 (npw, igk, xk (1, ik), vkb)
!
call calbec ( npw, vkb, evc, becp)
do ibnd = 1, nbnd_occ (ik)
wdelta = w0gauss ( (ef-et(ibnd,ik)) / degauss, ngauss) / degauss
w1 = weight * wdelta / omega
!
! unperturbed wf from reciprocal to real space
!
IF (noncolin) THEN
psic_nc = (0.d0, 0.d0)
do ig = 1, npw
psic_nc (nls (igk (ig)), 1 ) = evc (ig, ibnd)
psic_nc (nls (igk (ig)), 2 ) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Smooth', psic_nc(:,1), dffts)
CALL invfft ('Smooth', psic_nc(:,2), dffts)
do j = 1, dffts%nnr
ldoss (j, 1) = ldoss (j, 1) + &
w1 * ( DBLE(psic_nc(j,1))**2+AIMAG(psic_nc(j,1))**2 + &
DBLE(psic_nc(j,2))**2+AIMAG(psic_nc(j,2))**2)
enddo
IF (nspin_mag==4) THEN
DO j = 1, dffts%nnr
!
ldoss(j,2) = ldoss(j,2) + w1*2.0_DP* &
(DBLE(psic_nc(j,1))* DBLE(psic_nc(j,2)) + &
AIMAG(psic_nc(j,1))*AIMAG(psic_nc(j,2)))
ldoss(j,3) = ldoss(j,3) + w1*2.0_DP* &
(DBLE(psic_nc(j,1))*AIMAG(psic_nc(j,2)) - &
DBLE(psic_nc(j,2))*AIMAG(psic_nc(j,1)))
ldoss(j,4) = ldoss(j,4) + w1* &
(DBLE(psic_nc(j,1))**2+AIMAG(psic_nc(j,1))**2 &
-DBLE(psic_nc(j,2))**2-AIMAG(psic_nc(j,2))**2)
!
END DO
END IF
ELSE
psic (:) = (0.d0, 0.d0)
do ig = 1, npw
psic (nls (igk (ig) ) ) = evc (ig, ibnd)
enddo
CALL invfft ('Smooth', psic, dffts)
do j = 1, dffts%nnr
ldoss (j, current_spin) = ldoss (j, current_spin) + &
w1 * ( DBLE ( psic (j) ) **2 + AIMAG (psic (j) ) **2)
enddo
END IF
!
! If we have a US pseudopotential we compute here the becsum term
!
w1 = weight * wdelta
ijkb0 = 0
do nt = 1, ntyp
if (upf(nt)%tvanp ) then
do na = 1, nat
if (ityp (na) == nt) then
ijh = 1
do ih = 1, nh (nt)
ikb = ijkb0 + ih
IF (noncolin) THEN
DO is1=1,npol
DO is2=1,npol
becsum1_nc (ijh, na, is1, is2) = &
becsum1_nc (ijh, na, is1, is2) + w1 * &
(CONJG(becp%nc(ikb,is1,ibnd))* &
becp%nc(ikb,is2,ibnd))
END DO
END DO
ELSE
becsum1 (ijh, na, current_spin) = &
becsum1 (ijh, na, current_spin) + w1 * &
DBLE (CONJG(becp%k(ikb,ibnd))*becp%k(ikb,ibnd) )
ENDIF
ijh = ijh + 1
do jh = ih + 1, nh (nt)
jkb = ijkb0 + jh
IF (noncolin) THEN
DO is1=1,npol
DO is2=1,npol
becsum1_nc(ijh,na,is1,is2) = &
becsum1_nc(ijh,na,is1,is2) + w1* &
(CONJG(becp%nc(ikb,is1,ibnd))* &
becp%nc(jkb,is2,ibnd) )
END DO
END DO
ELSE
becsum1 (ijh, na, current_spin) = &
becsum1 (ijh, na, current_spin) + w1 * 2.d0 * &
DBLE(CONJG(becp%k(ikb,ibnd))*becp%k(jkb,ibnd) )
END IF
ijh = ijh + 1
enddo
enddo
ijkb0 = ijkb0 + nh (nt)
endif
enddo
else
do na = 1, nat
if (ityp (na) == nt) ijkb0 = ijkb0 + nh (nt)
enddo
endif
enddo
dos_ef = dos_ef + weight * wdelta
enddo
enddo
if (doublegrid) then
do is = 1, nspin_mag
call cinterpolate (ldos (1, is), ldoss (1, is), 1)
enddo
else
ldos (:,:) = ldoss (:,:)
endif
IF (noncolin.and.okvan) THEN
DO nt = 1, ntyp
IF ( upf(nt)%tvanp ) THEN
DO na = 1, nat
IF (ityp(na)==nt) THEN
IF (upf(nt)%has_so) THEN
CALL transform_becsum_so(becsum1_nc,becsum1,na)
ELSE
CALL transform_becsum_nc(becsum1_nc,becsum1,na)
END IF
END IF
END DO
END IF
END DO
END IF
call addusldos (ldos, becsum1)
!
! Collects partial sums on k-points from all pools
!
call mp_sum ( ldoss, inter_pool_comm )
call mp_sum ( ldos, inter_pool_comm )
call mp_sum ( dos_ef, inter_pool_comm )
!check
! check =0.d0
! do is=1,nspin_mag
! call fwfft('Dense',ldos(:,is),dfftp)
! check = check + omega* DBLE(ldos(nl(1),is))
! call invfft('Dense',ldos(:,is),dfftp)
! end do
! WRITE( stdout,*) ' check ', check, dos_ef
!check
!
deallocate(becsum1)
IF (noncolin) deallocate(becsum1_nc)
call deallocate_bec_type(becp)
call stop_clock ('localdos')
return
end subroutine localdos