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

Old D3 package deleted, reference to new D3Q package added 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12654 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2016-08-03 08:51:10 +00:00
parent 54756af677
commit 6732b38539
71 changed files with 9 additions and 10863 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
PHonon/D3/Makefile
View File

@ -1,87 +0,0 @@
# Makefile for 3rd derivative calculations - D3
include ../../make.inc
# location of needed modules and included files (if any)
MODFLAGS= $(MOD_FLAG)../../iotk/src $(MOD_FLAG)../../Modules $(MOD_FLAG)../../FFTXlib \
$(MOD_FLAG)../../LAXlib $(MOD_FLAG)../../PW/src $(MOD_FLAG)../../LR_Modules $(MOD_FLAG)../../PHonon/PH $(MOD_FLAG).
IFLAGS=
LIBOBJS = ../../clib/clib.a ../../iotk/src/libiotk.a
D3OBJS = \
allocate_d3.o \
allocate_pert_d3.o \
bcast_d3_input.o \
ch_psi_all2.o \
close_open.o \
d0rhod2v.o \
d2mxc.o \
d3_exc.o \
d3_init.o \
d3_readin.o \
d3_recover.o \
d3_setup.o \
d3_summary.o \
d3_symdyn.o \
d3_symdynph.o \
d3_valence.o \
d3com.o \
d3dyn_cc.o \
d3ionq.o \
d3matrix.o \
d3toten.o \
d3vrho.o \
davcio_drho2.o \
dpsi_corr.o \
dpsidpsidv.o \
dpsidvdpsi.o \
dqrhod2v.o \
drho_cc.o \
drho_drc.o \
drhod2v.o \
dvdpsi.o \
dvscf.o \
gen_dpdvp.o \
gen_dwfc.o \
incdrhoscf2.o \
openfild3.o \
print_clock_d3.o \
psymd0rho.o \
qstar_d3.o \
read_ef.o \
rotate_and_add_d3.o \
set_d3irr.o \
set_efsh.o \
set_sym_irr.o \
solve_linter_d3.o \
stop_d3.o \
sym_def1.o \
symd0rho.o \
trntnsc_3.o \
w_1gauss.o \
write_aux.o \
write_d3dyn.o \
write_igk.o \
writed3dyn_5.o
PHOBJS = ../../PHonon/PH/libph.a
LRMODS = ../../LR_Modules/liblrmod.a
PWOBJS = ../../PW/src/libpw.a
QEMODS = ../../Modules/libqemod.a ../../FFTXlib/libqefft.a ../../LAXlib/libqela.a
all : tldeps d3.x
d3.x : $(D3OBJS) $(PHOBJS) $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS)
$(LD) $(LDFLAGS) -o d3.x $(D3OBJS) \
$(PHOBJS) $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(LIBS)
- ( cd ../../bin ; ln -fs ../PHonon/D3/d3.x . )
tldeps :
( cd .. ; $(MAKE) phonon || exit 1 )
clean :
- /bin/rm -f d3.x *.o *~ *_tmp.f90 *.d *.i *.mod *.L
- /bin/rm -f ../../bin/d3.x
include make.depend

62
PHonon/D3/allocate_d3.f90
View File

@ -1,62 +0,0 @@
!
! Copyright (C) 2001 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 allocate_d3
!-----------------------------------------------------------------------
!
! dynamical allocation of arrays: quantities needed for the third
! derivative of the total energy
!
USE ions_base, ONLY : nat, ntyp => nsp
USE uspp, ONLY : nkb, vkb
use pwcom
use phcom
use d3com
use control_lr, ONLY : lgamma
implicit none
call allocate_phq
if (lgamma) then
vlocg0 => vlocq
npertg0=> npert
vkb0 => vkb
ug0 => u
else
allocate (vlocg0( ngm, ntyp))
allocate (ug0( 3*nat, 3*nat))
allocate (npertg0( 3*nat))
allocate (vkb0( npwx , nkb))
endif
allocate (psidqvpsi( nbnd, nbnd))
allocate (d3dyn( 3 * nat, 3 * nat, 3 * nat))
if (degauss.ne.0.d0) allocate (ef_sh( 3 * nat))
allocate (d3dyn_aux1 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux2 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux3 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux4 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux5 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux6 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux7 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux8 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn_aux9 ( 3 * nat, 3 * nat, 3 * nat))
d3dyn_aux1 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux2 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux3 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux4 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux5 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux6 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux7 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux8 (:,:,:) = (0.d0, 0.d0)
d3dyn_aux9 (:,:,:) = (0.d0, 0.d0)
return
end subroutine allocate_d3

37
PHonon/D3/allocate_pert_d3.f90
View File

@ -1,37 +0,0 @@
!
! Copyright (C) 2001-2009 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 allocate_pert_d3()
!-----------------------------------------------------------------------
!
! dynamical allocation of arrays: quantities depending on the
! maximum number of perturbations
!
USE kinds, only : DP
USE ions_base, ONLY : nat
USE modes, ONLY : npertx, t, tmq
USE modesg0, ONLY : tg0
USE control_lr, ONLY : lgamma
implicit none
!
! allocate space for the quantities with dimensions that depend
! on the maximum number of perturbations
!
ALLOCATE (t (npertx, npertx, 48, 3*nat))
ALLOCATE (tmq (npertx, npertx, 3*nat))
IF (lgamma) THEN
tg0 => t
ELSE
allocate (tg0( npertx, npertx, 48, 3*nat))
ENDIF
RETURN
END SUBROUTINE allocate_pert_d3

64
PHonon/D3/bcast_d3_input.f90
View File

@ -1,64 +0,0 @@
!
! Copyright (C) 2001-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 bcast_d3_input
!-----------------------------------------------------------------------
!
! In this routine the first processor sends input data to all
! the other processors
!
!
#ifdef __MPI
use pwcom
use phcom
use d3com
use mp, only: mp_bcast
use mp_world, only: world_comm
use io_files, only: prefix, tmp_dir
use ions_base, only: amass
use control_flags, only: iverbosity
use run_info, only: title
use qpoint, ONLY: xq
use control_lr, ONLY : lgamma
implicit none
integer :: root = 0
!
! logicals
!
call mp_bcast (lgamma, root, world_comm)
call mp_bcast (wraux, root, world_comm)
call mp_bcast (recv, root, world_comm)
call mp_bcast (testflag,root, world_comm)
!
! integers
!
call mp_bcast (iverbosity, root, world_comm)
call mp_bcast (testint, root, world_comm)
call mp_bcast (q0mode_todo, root, world_comm)
call mp_bcast (istop, root, world_comm)
!
! real*8
!
call mp_bcast (amass, root, world_comm)
call mp_bcast (xq, root, world_comm)
call mp_bcast (ethr_ph, root, world_comm)
call mp_bcast (testreal, root, world_comm)
!
! characters
!
call mp_bcast (title, root, world_comm)
call mp_bcast (fildyn, root, world_comm)
call mp_bcast (fildrho, root, world_comm)
call mp_bcast (fild0rho, root, world_comm)
call mp_bcast (tmp_dir, root, world_comm)
call mp_bcast (prefix, root, world_comm)
#endif
return
end subroutine bcast_d3_input

111
PHonon/D3/ch_psi_all2.f90
View File

@ -1,111 +0,0 @@
!
! Copyright (C) 2001 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 ch_psi_all2 (n, h, ah, e, ik, m)
!-----------------------------------------------------------------------
!
! This routine applies the operator ( H - \epsilon S + alpha_pv P_v)
! to a vector h. The result is given in Ah.
!
USE kinds, only : DP
use pwcom
USE uspp, ONLY: vkb
use becmod
use phcom
USE mp_global, ONLY: intra_pool_comm
USE mp, ONLY: mp_sum
use control_lr, ONLY : alpha_pv, lgamma
implicit none
integer :: n, m, ik
! input: the dimension of h
! input: the number of bands
! input: the k point
real (DP) :: e (m)
! input: the eigenvalue
complex (DP) :: h (npwx, m), ah (npwx, m)
! input: the vector
! output: the operator applied to the vector
!
! local variables
!
integer :: ibnd, ikq, ig
! counter on bands
! the point k+q
! counter on G vetors
complex (DP), allocatable :: ps (:,:), hpsi (:,:), spsi (:,:)
! scalar products
! the product of the Hamiltonian and h
! the product of the S matrix and h
call start_clock ('ch_psi')
allocate (ps( nbnd, m))
allocate (hpsi( npwx, m))
allocate (spsi( npwx, m))
hpsi = (0.d0, 0.d0)
spsi = (0.d0, 0.d0)
!
! compute the product of the hamiltonian with the h vector
!
call h_psiq (npwx, n, m, h, hpsi, spsi)
call start_clock ('last')
!
! then we compute the operator H-epsilon S
!
do ibnd = 1, m
do ig = 1, n
ah (ig, ibnd) = hpsi (ig, ibnd) - e (ibnd) * spsi (ig, ibnd)
enddo
enddo
!
! Here we compute the projector in the valence band
!
hpsi = (0.d0, 0.d0)
if (lgamma) then
ikq = ik
else
ikq = 2 * ik
endif
ps = (0.d0, 0.d0)
call zgemm ('C', 'N', nbnd, m, n, (1.d0, 0.d0) , evq, npwx, spsi, &
npwx, (0.d0, 0.d0) , ps, nbnd)
ps = ps * alpha_pv
#ifdef __MPI
call mp_sum( ps, intra_pool_comm )
#endif
call zgemm ('N', 'N', n, m, nbnd, (1.d0, 0.d0) , evq, npwx, ps, &
nbnd, (1.d0, 0.d0) , hpsi, npwx)
spsi = hpsi
!
! And apply S again
!
call calbec (n, vkb, hpsi, becp, m)
call s_psi (npwx, n, m, hpsi, spsi)
do ibnd = 1, m
do ig = 1, n
ah (ig, ibnd) = ah (ig, ibnd) + spsi (ig, ibnd)
enddo
enddo
deallocate (spsi)
deallocate (hpsi)
deallocate (ps)
call stop_clock ('last')
call stop_clock ('ch_psi')
return
end subroutine ch_psi_all2

97
PHonon/D3/close_open.f90
View File

@ -1,97 +0,0 @@
!
! Copyright (C) 2001-2003 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 close_open (isw)
!-----------------------------------------------------------------------
!
! Close and open some units. It is useful in case of interrupted run
!
!
USE pwcom, ONLY : degauss
USE phcom, ONLY : iudwf, lrdwf
USE io_files, ONLY : prefix, diropn, seqopn
USE d3com
USE io_global, ONLY : ionode
use control_lr, ONLY : lgamma
!
IMPLICIT NONE
!
INTEGER :: isw
CHARACTER (len=256) :: file_extension
! the name of the file
LOGICAL :: exst
! logical variable to check file existence
IF (LEN_TRIM(prefix) == 0) CALL errore ('close_open', 'wrong prefix', 1)
!
IF (isw.EQ.3) THEN
!
! This is to be used after gen_dwf(3)
!
IF ( ionode ) THEN
!
IF (degauss.NE.0.d0) THEN
CLOSE (unit = iuef, status = 'keep')
file_extension = 'efs'
CALL seqopn (iuef, file_extension, 'unformatted', exst)
ENDIF
!
END IF
CLOSE (unit = iupd0vp, status = 'keep')
file_extension = 'p0p'
IF (lgamma) file_extension = 'pdp'
CALL diropn (iupd0vp, file_extension, lrpdqvp, exst)
CLOSE (unit = iudwf, status = 'keep')
file_extension = 'dwf'
CALL diropn (iudwf, file_extension, lrdwf, exst)
!
ELSE IF (isw.EQ.1) THEN
!
! This is to be used after gen_dwf(1)
!
IF (lgamma) CALL errore (' close_open ', ' isw=1 ; lgamma', 1)
CLOSE (unit = iupdqvp, status = 'keep')
file_extension = 'pdp'
CALL diropn (iupdqvp, file_extension, lrpdqvp, exst)
CLOSE (unit = iudqwf, status = 'keep')
file_extension = 'dqwf'
CALL diropn (iudqwf, file_extension, lrdwf, exst)
ELSEIF (isw.EQ.2) THEN
!
! This is to be used after gen_dwf(2)
!
IF (lgamma) CALL errore (' close_open ', ' isw=2 ; lgamma', 1)
CLOSE (unit = iud0qwf, status = 'keep')
file_extension = 'd0wf'
CALL diropn (iud0qwf, file_extension, lrdwf, exst)
ELSEIF (isw.EQ.4) THEN
!
! This is to be used after gen_dpdvp
!
IF (degauss.EQ.0.d0) RETURN
CLOSE (unit = iudpdvp_1, status = 'keep')
file_extension = 'pv1'
CALL diropn (iudpdvp_1, file_extension, lrdpdvp, exst)
IF (.NOT.lgamma) THEN
CLOSE (unit = iudpdvp_2, status = 'keep')
file_extension = 'pv2'
CALL diropn (iudpdvp_2, file_extension, lrdpdvp, exst)
CLOSE (unit = iudpdvp_3, status = 'keep')
file_extension = 'pv3'
CALL diropn (iudpdvp_3, file_extension, lrdpdvp, exst)
ENDIF
ENDIF
RETURN
END SUBROUTINE close_open

230
PHonon/D3/d0rhod2v.f90
View File

@ -1,230 +0,0 @@
!
! Copyright (C) 2001 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 d0rhod2v (ipert, drhoscf)
!-----------------------------------------------------------------------
! calculates the term containing the second variation of the potential
! and the first variation of the charge density with respect to a
! perturbation at q=0
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp, tau
USE io_global, ONLY : stdout
USE io_files, ONLY : iunigk
USE kinds, ONLY : DP
USE uspp, ONLY : dvan
USE uspp_param, ONLY : nh
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE pwcom
USE wavefunctions_module, ONLY : evc
USE phcom
USE d3com
USE mp_global, ONLY : my_pool_id, inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
USE qpoint, ONLY : igkq, nksq, npwq
USE control_lr, ONLY : lgamma
!
IMPLICIT NONE
!
INTEGER :: ipert ! index of the perturbation associated with drho
COMPLEX (DP) :: drhoscf (dfftp%nnr)! the variation of the charge density
!
INTEGER :: icart, & ! counter on polarizations
jcart, & ! counter on polarizations
na_icart, & ! counter on modes
na_jcart, & ! counter on modes
na, & ! counter on atoms
ng, & ! counter on G vectors
nt, & ! counter on atomic types
ik, & ! counter on k points
ikk, & ! counter on k points
ig, & ! counter on G vectors
ibnd, & ! counter on bands
nu_i, & ! counter on modes
nu_j, & ! counter on modes
nu_k, & ! counter on modes
ikb, jkb, & ! counter on beta functions
nrec, & ! record position of dwfc
ios ! integer variable for I/O control
REAL (DP) :: gtau, & ! the product G*\tau_s
wgg ! the weight of a K point
COMPLEX (DP) :: zdotc, d3dywrk (3*nat,3*nat), fac, alpha(8), work
COMPLEX (DP), ALLOCATABLE :: work0 (:), work1 (:), work2 (:), &
work3 (:), work4 (:), work5 (:), &
work6 (:)
! auxiliary space
ALLOCATE (work0(dfftp%nnr))
ALLOCATE (work1(npwx))
ALLOCATE (work2(npwx))
ALLOCATE (work3(npwx))
ALLOCATE (work4(npwx))
ALLOCATE (work5(npwx))
ALLOCATE (work6(npwx))
d3dywrk (:,:) = (0.d0, 0.d0)
!
! Here the contribution deriving from the local part of the potential
!
IF ( my_pool_id == 0 ) THEN
!
! ... computed only by the first pool (no sum over k needed)
!
work0 (:) = drhoscf (:)
CALL fwfft ('Dense', work0, dfftp)
DO na = 1, nat
DO icart = 1,3
na_icart = 3*(na-1)+icart
DO jcart = 1,3
na_jcart = 3*(na-1)+jcart
DO ng = 1, ngm
gtau = tpi * ( g(1,ng)*tau(1,na) + &
g(2,ng)*tau(2,na) + &
g(3,ng)*tau(3,na) )
fac = CMPLX(COS(gtau),SIN(gtau),kind=DP)
d3dywrk(na_icart,na_jcart) = &
d3dywrk(na_icart,na_jcart) - &
tpiba2 * g(icart,ng) * g(jcart,ng) * &
omega * vloc(igtongl(ng),ityp(na)) * &
fac*work0(nl(ng))
ENDDO
ENDDO
ENDDO
WRITE( stdout,*) na
WRITE( stdout,'(3(2f10.6,2x))') &
((d3dywrk(3*(na-1)+icart,3*(na-1)+jcart), &
jcart=1,3),icart=1,3)
ENDDO
CALL mp_sum( d3dywrk, intra_pool_comm )
!
END IF
!
! each pool contributes to next term
!
! Here we compute the nonlocal (Kleinman-Bylander) contribution.
!
REWIND (unit=iunigk)
DO ik = 1, nksq
READ (iunigk, err = 200, iostat = ios) npw, igk
200 CALL errore ('d0rhod2v', 'reading igk', ABS (ios) )
IF (lgamma) THEN
ikk = ik
npwq = npw
ELSE
ikk = 2 * ik - 1
READ (iunigk, err = 300, iostat = ios) npwq, igkq
300 CALL errore ('d0rhod2v', 'reading igkq', ABS (ios) )
npwq = npw
ENDIF
wgg = wk (ikk)
CALL davcio (evc, lrwfc, iuwfc, ikk, - 1)
CALL init_us_2 (npw, igk, xk (1, ikk), vkb0)
!
! Reads the first variation of the wavefunction projected on conduction
!
nrec = (ipert - 1) * nksq + ik
CALL davcio (dpsi, lrdwf, iudwf, nrec, - 1)
!
! In the metallic case corrects dpsi so as that the density matrix
! will be: Sum_{k,nu} 2 * | dpsi > < psi |
!
IF (degauss /= 0.d0) THEN
nrec = ipert + (ik - 1) * 3 * nat
CALL davcio (psidqvpsi, lrpdqvp, iupd0vp, nrec, - 1)
CALL dpsi_corr (evc, psidqvpsi, ikk, ikk, ipert)
ENDIF
DO icart = 1, 3
DO jcart = 1, 3
DO ibnd = 1, nbnd
DO ig = 1, npw
work1(ig)= evc(ig,ibnd)*tpiba*(xk(icart,ikk)+g(icart,igk(ig)))
work2(ig)= evc(ig,ibnd)*tpiba*(xk(jcart,ikk)+g(jcart,igk(ig)))
work3(ig)=dpsi(ig,ibnd)*tpiba*(xk(icart,ikk)+g(icart,igk(ig)))
work4(ig)=dpsi(ig,ibnd)*tpiba*(xk(jcart,ikk)+g(jcart,igk(ig)))
work5(ig)= work1(ig)*tpiba*(xk(jcart,ikk)+g(jcart,igk(ig)))
work6(ig)= work3(ig)*tpiba*(xk(jcart,ikk)+g(jcart,igk(ig)))
ENDDO
jkb=0
DO nt = 1, ntyp
DO na = 1, nat
IF (ityp (na) == nt) THEN
na_icart = 3 * (na - 1) + icart
na_jcart = 3 * (na - 1) + jcart
DO ikb = 1, nh (nt)
jkb=jkb+1
alpha (1) = zdotc (npw, work1, 1, vkb0(1,jkb), 1)
alpha (2) = zdotc (npw, vkb0(1,jkb), 1, work4, 1)
alpha (3) = zdotc (npw, work2, 1, vkb0(1,jkb), 1)
alpha (4) = zdotc (npw, vkb0(1,jkb), 1, work3, 1)
alpha (5) = zdotc (npw, work5, 1, vkb0(1,jkb), 1)
alpha (6) = zdotc (npw, vkb0(1,jkb), 1, dpsi (1,ibnd), 1)
alpha (7) = zdotc (npw, evc (1,ibnd), 1, vkb0(1,jkb), 1)
alpha (8) = zdotc (npw, vkb0(1,jkb), 1, work6, 1)
#ifdef __MPI
CALL mp_sum( alpha, intra_pool_comm )
#endif
d3dywrk (na_icart, na_jcart) = d3dywrk (na_icart, na_jcart) &
+ (alpha(1)*alpha(2) + alpha(3)*alpha(4) &
- alpha(5)*alpha(6) - alpha(7)*alpha(8)) * &
dvan (ikb,ikb,nt) * wgg * 2.0d0
ENDDO
END IF
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
!
CALL mp_sum ( d3dywrk, inter_pool_comm )
!
! Rotate the dynamical matrix on the basis of patterns
! first index does not need to be rotated
!
nu_k = ipert
DO nu_i = 1, 3 * nat
DO nu_j = 1, 3 * nat
work = (0.0d0, 0.0d0)
DO na = 1, nat
DO icart = 1, 3
na_icart = 3 * (na-1) + icart
DO jcart = 1, 3
na_jcart = 3 * (na-1) + jcart
work = work + CONJG(u(na_icart,nu_i)) * &
d3dywrk(na_icart,na_jcart) * &
u(na_jcart,nu_j)
ENDDO
ENDDO
ENDDO
d3dyn(nu_k,nu_i,nu_j) = d3dyn(nu_k,nu_i,nu_j) + work
IF (allmodes) THEN
d3dyn(nu_j,nu_k,nu_i) = d3dyn(nu_j,nu_k,nu_i) + work
d3dyn(nu_i,nu_j,nu_k) = d3dyn(nu_i,nu_j,nu_k) + work
ENDIF
ENDDO
ENDDO
DEALLOCATE (work6)
DEALLOCATE (work5)
DEALLOCATE (work4)
DEALLOCATE (work3)
DEALLOCATE (work2)
DEALLOCATE (work1)
DEALLOCATE (work0)
RETURN
END SUBROUTINE d0rhod2v

65
PHonon/D3/d2mxc.f90
View File

@ -1,65 +0,0 @@
!
! Copyright (C) 2001 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 .
!
!
!-----------------------------------------------------------------------
function d2mxc (rho)
!-----------------------------------------------------------------------
!
! second derivative of the xc potential with respect to the local densi
! Perdew and Zunger parameterization of the C.A. functional
!
USE kinds, only : DP
USE constants, only : pi
implicit none
real (DP) :: rho, d2mxc
! input: the charge density ( positive )
! output: the second derivative of the xc potent
real (DP) :: b1, b2, gc, a, b, c, d, thofpi_3, fpioth_3, &
thopi_3, tm1, tm2, tm3, tm4, tm5, tm6
! _ parameters defining the functionals
! /
! pi
! (3/4/pi)^0.333
! (4*pi/3)^0.333
! (3/pi)^0.333
! 35.d0*b1,
! 76.d0*b1*b1 + 64.d0*b2
! 35.d0*b1*b1*b1 + 234.d0*b1*b2
! 140.d0*b2*b1*b1 + 176.d0*b2*b2
! 175.d0*b1*b2*b2
! 64.d0*b2*b2*b2
parameter (b1 = 1.0529d0, b2 = 0.3334d0, gc = - 0.1423d0, a = &
0.0311d0, b = - 0.0480d0, c = 0.0020d0, d = - 0.0116d0, &
fpioth_3 = 1.61199195401647d0, thofpi_3 = 0.620350490899400d0, &
thopi_3 = 0.98474502184270d0, tm1 = 36.85150d0, tm2 = &
105.59107916d0, tm3 = 122.996139546115d0, tm4 = &
71.30831794516d0, tm5 = 20.4812455967d0, tm6 = 2.371792877056d0)
real (DP) :: rs, x, den
rs = thofpi_3 * (1.d0 / rho) **0.3333333333333333d0
if (rs.ge.1.d0) then
x = sqrt (rs)
den = 1.d0 + x * b1 + b2 * x**2
d2mxc = - gc * (tm1 * x + tm2 * x**2 + tm3 * x**3 + tm4 * x**4 &
+ tm5 * x**5 + tm6 * x**6) / ( (rho**2) * (den**4) * 216.d0)
else
d2mxc = (9.d0 * a + (6.d0 * c + 8.d0 * d) * rs + 8.d0 * c * rs &
* log (rs) ) / (rho**2) / 27.d0
endif
rs = rs * fpioth_3
d2mxc = d2mxc + (2.d0 / 9.d0 * thopi_3 * rs**5)
d2mxc = 2.d0 * d2mxc
return
end function d2mxc

97
PHonon/D3/d3_exc.f90
View File

@ -1,97 +0,0 @@
!
! Copyright (C) 2001 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 d3_exc
!-----------------------------------------------------------------------
!
! Calculates the contribution to the derivative of the dynamical
! matrix due to the third derivative of the exchange and correlation
! energy
!
USE ions_base, ONLY : nat
USE kinds, ONLY : DP
USE pwcom
USE scf, only : rho, rho_core
USE fft_base, only : dfftp
USE phcom
USE d3com
USE io_global, ONLY : ionode_id
USE mp_global, ONLY : inter_pool_comm, my_pool_id, &
npool, intra_pool_comm
USE mp, ONLY : mp_bcast, mp_sum
IMPLICIT NONE
INTEGER :: errcode, ir, ipert, jpert, kpert, npert1, npert2
REAL (DP) :: d2mxc, rhotot, xq0 (3)
REAL (DP), ALLOCATABLE :: d2muxc (:)
COMPLEX (DP) :: aux
COMPLEX (DP), ALLOCATABLE :: work1 (:), work2 (:), &
work3 (:), d3dyn1 (:,:,:)
ALLOCATE (d2muxc( dfftp%nnr))
ALLOCATE (work1 ( dfftp%nnr))
ALLOCATE (work2 ( dfftp%nnr))
ALLOCATE (work3 ( dfftp%nnr))
ALLOCATE (d3dyn1( 3*nat, 3*nat, 3*nat))
! IF ( my_pool_id == 0 ) THEN
!
! Calculates third derivative of Exc
!
d2muxc(:) = 0.d0
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
IF (rhotot > 1.d-30) d2muxc (ir) = d2mxc (rhotot)
IF (rhotot < - 1.d-30) d2muxc (ir) = - d2mxc ( - rhotot)
ENDDO
!
! Calculates the contribution to d3dyn
!
d3dyn1 (:,:,:) = (0.d0, 0.d0)
DO ipert = 1, 3 * nat
IF (q0mode (ipert) ) THEN
CALL davcio_drho (work1, lrdrho, iud0rho, ipert, - 1)
DO jpert = 1, 3 * nat
CALL davcio_drho (work2, lrdrho, iudrho, jpert, - 1)
DO kpert = 1, 3 * nat
CALL davcio_drho (work3, lrdrho, iudrho, kpert, - 1)
aux = CMPLX(0.d0, 0.d0,kind=DP)
DO ir = 1, dfftp%nnr
aux = aux + &
d2muxc (ir) * work1 (ir) * &
CONJG (work2 (ir) ) * work3 (ir)
ENDDO
!
CALL mp_sum ( aux, intra_pool_comm )
!
d3dyn1 (ipert, jpert, kpert) = omega * aux / (dfftp%nr1 * dfftp%nr2 * dfftp%nr3)
!
ENDDO
ENDDO
ENDIF
ENDDO
!
! END IF
!
IF ( npool /= 1 ) CALL mp_bcast( d3dyn1, ionode_id, inter_pool_comm )
!
d3dyn = d3dyn + d3dyn1
d3dyn_aux9 = d3dyn1
!
DEALLOCATE (d2muxc)
DEALLOCATE (work1)
DEALLOCATE (work2)
DEALLOCATE (work3)
DEALLOCATE (d3dyn1)
!
RETURN
!
END SUBROUTINE d3_exc

143
PHonon/D3/d3_init.f90
View File

@ -1,143 +0,0 @@
!
! Copyright (C) 2001 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 d3_init
!-----------------------------------------------------------------------
!
USE ions_base, ONLY : nat, ntyp => nsp
USE pwcom
USE uspp_param, ONLY : upf
USE atom, ONLY : msh, rgrid
USE fft_base, ONLY : dfftp
USE phcom
USE d3com
USE mp, ONLY : mp_barrier
USE mp_world, ONLY : world_comm
USE symm_base, ONLY : s, ftau
USE nlcc_ph, ONLY : drc
USE uspp, ONLY : nlcc_any
USE control_lr, ONLY : lgamma
USE lr_symm_base, ONLY : irgq
IMPLICIT NONE
INTEGER :: nt, irr, irr1, ipert, imode0, errcode
REAL (DP) :: work (3)
COMPLEX (DP), ALLOCATABLE :: drhoscf (:,:)
COMPLEX (DP), ALLOCATABLE :: drhoscf2 (:,:,:)
ALLOCATE (drhoscf( dfftp%nnr, 3))
!
! the fourier trasform of the core charge both for q=0 and q.ne.0
!
IF (nlcc_any) THEN
!
! drc is allocated in phq_setup
!
IF (.NOT.lgamma) THEN
ALLOCATE (d0rc( ngm, ntyp))
work = 0.d0
CALL set_drhoc (work, drc)
d0rc (:,:) = drc (:,:)
ELSE
d0rc => drc
ENDIF
!
! drc is calculated in phq_init
! call set_drhoc(xq)
ENDIF
!
! uses the same initialization routines as the phonon program
! Temporary: Note that now phq_init uses buffers so the size of the
! records must be declared 1/2 of davcio (please fix me or use buffers in
! d3)
!
lrwfc=lrwfc/2
CALL phq_init
lrwfc=lrwfc*2
CALL write_igk
!
! the fourier components of the local potential at q+G for q=0
!
IF (.NOT.lgamma) THEN
vlocg0 (:,:) = 0.d0
work = 0.d0
DO nt = 1, ntyp
CALL setlocq (work, rgrid(nt)%mesh, msh(nt), rgrid(nt)%rab, &
rgrid(nt)%r, upf(nt)%vloc, upf(nt)%zp, tpiba2, ngm, g, &
omega, vlocg0(1,nt) )
ENDDO
ENDIF
!
! Reads the q=0 variation of the charge --d0rho-- and symmetrizes it
!
DO irr = 1, nirrg0
imode0 = 0
DO irr1 = 1, irr - 1
imode0 = imode0 + npertg0 (irr1)
ENDDO
DO ipert = 1, npertg0 (irr)
CALL davcio_drho2 (drhoscf(1,ipert), lrdrho, iud0rho, &
imode0+ipert, - 1)
ENDDO
#ifdef __MPI
CALL psymd0rho (npertg0(irr), irr, drhoscf)
#else
CALL symd0rho (npertx, npertg0(irr), irr, drhoscf, s, ftau, nsymg0, &
irgq, tg0, nat, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, &
dfftp%nr2x, dfftp%nr3x)
#endif
DO ipert = 1, npertg0 (irr)
CALL davcio_drho2 (drhoscf(1,ipert), lrdrho, iud0rho, &
imode0+ipert, +1)
ENDDO
ENDDO
!
! Reads the variation of the charge --drho-- and symmetrizes it
!
IF (.NOT.lgamma) THEN
imode0 = 0
DO irr = 1, nirr
imode0 = 0
DO irr1 = 1, irr - 1
imode0 = imode0 + npert (irr1)
ENDDO
ALLOCATE (drhoscf2( dfftp%nnr, nspin,npert(irr) ))
DO ipert = 1, npert (irr)
CALL davcio_drho (drhoscf2(1,1,ipert), lrdrho, iudrho, &
imode0+ipert, -1)
ENDDO
#ifdef __MPI
CALL psymdvscf (npert(irr), irr, drhoscf2)
#else
CALL symdvscf (npert(irr), irr, drhoscf2)
#endif
DO ipert = 1, npert(irr)
CALL davcio_drho (drhoscf2(1,1,ipert), lrdrho, iudrho, &
imode0+ipert, +1)
ENDDO
DEALLOCATE (drhoscf2)
ENDDO
ENDIF
CALL mp_barrier( world_comm )
DEALLOCATE(drhoscf)
RETURN
END SUBROUTINE d3_init

174
PHonon/D3/d3_readin.f90
View File

@ -1,174 +0,0 @@
!
! Copyright (C) 2001-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 d3_readin()
!-----------------------------------------------------------------------
!
! This routine reads the control variables for the program d3
!
USE ions_base, ONLY : nat, ntyp => nsp, amass
USE uspp, ONLY : okvan
USE pwcom
USE run_info, ONLY : title
USE control_flags, ONLY : iverbosity
USE phcom
USE d3com
USE fft_base, ONLY : dffts
USE noncollin_module, ONLY : noncolin
USE io_files, ONLY : tmp_dir, prefix
USE io_global, ONLY : ionode, ionode_id
USE mp_bands, ONLY : nbgrp, ntask_groups
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
USE qpoint, ONLY : xq, nksq
USE control_lr, ONLY : lgamma
!
IMPLICIT NONE
!
CHARACTER(LEN=256), EXTERNAL :: trimcheck
!
INTEGER :: ios, ipol, iter, na, it, ii
! counters
CHARACTER(len=256) :: outdir
NAMELIST / inputph / ethr_ph, amass, iverbosity, outdir, prefix, &
fildyn, fildrho, fild0rho, q0mode_todo, wraux, recv, istop, &
testflag, testint, testreal
! convergence threshold
! atomic masses
! write control
! directory for temporary files
! the punch file produced by pwscf
! the file with the dynamical matrix
! the file with the deltarho
! the file with q=0 deltarho
! list of the q=0 modes to be computed
! .true.==> writes some auxiliary
! .true.==> this is a recover run
! to stop the program at a given point
! variables used for testing purposes
IF ( ionode ) THEN
!
CALL input_from_file ( )
!
! Read the first line of the input file
!
READ (5, '(a)', iostat = ios) title
!
END IF
!
CALL mp_bcast(ios, ionode_id, world_comm )
IF (ios/=0) CALL errore ('d3_readin', 'reading title ', ABS (ios) )
!
IF ( ionode ) THEN
!
! set default values for variables in namelist
!
ethr_ph = 1.d-5
iverbosity = 0
CALL get_environment_variable( 'ESPRESSO_TMPDIR', outdir )
IF ( TRIM( outdir ) == ' ' ) outdir = './'
prefix = 'pwscf'
fildyn = 'd3dyn'
fildrho = ' '
fild0rho = ' '
DO ii = 1, 300
q0mode_todo (ii) = 0
ENDDO
wraux = .FALSE.
recv = .FALSE.
istop = 0
DO ii = 1, 50
testflag (ii) = .FALSE.
ENDDO
!
! reading the namelist inputph
!
READ (5, inputph, iostat = ios)
!
END IF
!
CALL mp_bcast(ios, ionode_id, world_comm )
IF (ios/=0) CALL errore ('d3_readin', 'reading inputph namelist', ABS (ios) )
!
IF ( ionode ) THEN
!
! reads the q point
!
READ (5, *, iostat = ios) (xq (ipol), ipol = 1, 3)
!
lgamma = xq (1) .EQ.0.d0.AND.xq (2) .EQ.0.d0.AND.xq (3) .EQ.0.d0
tmp_dir = trimcheck (outdir)
!
END IF
!
CALL mp_bcast(ios, ionode_id, world_comm )
IF (ios/=0) CALL errore ('d3_readin', 'reading xq', ABS (ios) )
!
CALL bcast_d3_input()
!
! Check all namelist variables
!
IF (ethr_ph.LE.0.d0) CALL errore (' d3_readin', ' Wrong ethr_ph ', 1)
IF (iverbosity.NE.0.AND.iverbosity.NE.1) &
CALL errore ('d3_readin', ' Wrong iverbosity ', 1)
IF (fildrho.EQ.' ') CALL errore ('d3_readin', ' Wrong fildrho ', 1)
IF (fild0rho.EQ.' ') CALL errore ('d3_readin', ' Wrong fild0rho ', 1)
!
! FIXME: workaround for filename mess - needed to find the correct
! location of files
if ( .not. lgamma) tmp_dir = TRIM(tmp_dir)//'_ph0/'
!
! Here we finished the reading of the input file.
! Now allocate space for pwscf variables, read and check them.
!
CALL read_file ( )
!
IF (lgamma) THEN
nksq = nks
ELSE
nksq = nks / 2
ENDIF
!
IF (lsda) CALL errore ('d3_readin', 'lsda not implemented', 1)
IF (okvan) CALL errore ('d3_readin', 'US not implemented', 1)
IF (noncolin) call errore('d3_readin', &
'd3 is not working in the noncolinear case', 1)
!
! band group not available
!
IF (nbgrp /=1 ) &
CALL errore('d3_readin','band parallelization not available',1)
!
! There might be other variables in the input file which describe
! partial computation of the dynamical matrix. Read them here
!
CALL allocate_part ( nat )
DO it = 1, ntyp
IF (amass (it) .LE.0.d0) CALL errore ('d3_readin', 'Wrong masses', &
it)
ENDDO
IF (MOD (nks, 2) .NE.0.AND..NOT.lgamma) CALL errore ('d3_readin', &
'k-points are odd', nks)
!
! q0mode, and q0mode_todo are not allocated dynamically. Their
! dimension is fixed to 300
!
IF (3 * nat.GT.300) CALL errore ('d3_readin', 'wrong dimension of &
&q0mode variable', 1)
DO ii = 1, 3 * nat
IF (q0mode_todo (ii) .GT.3 * nat) CALL errore ('d3_readin', ' wrong &
& q0mode_todo ', 1)
ENDDO
RETURN
END SUBROUTINE d3_readin

65
PHonon/D3/d3_recover.f90
View File

@ -1,65 +0,0 @@
!
! Copyright (C) 2001-2003 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 d3_recover (ilab, isw)
!-----------------------------------------------------------------------
!
! isw = +1 Writes d3dyn in a file for possible recover
! isw = -1 Starts a recover run
!
USE pwcom
USE phcom
USE d3com
USE io_global, ONLY : ionode
USE mp, ONLY: mp_bcast
USE mp_world, ONLY: world_comm
USE io_files, ONLY : seqopn
!
IMPLICIT NONE
!
INTEGER :: ilab, isw
INTEGER :: root = 0
LOGICAL :: exst
iunrec = 98
IF (isw.EQ.1) THEN
!
IF ( .NOT. ionode ) RETURN
CALL seqopn (iunrec, 'recv_d3', 'unformatted', exst)
IF (ilab.LE.4) THEN
WRITE (iunrec) ilab
ELSE
WRITE (iunrec) ilab, d3dyn
ENDIF
CLOSE (unit = iunrec, status = 'keep')
ELSEIF (isw.EQ. - 1) THEN
!
IF ( ionode ) THEN
!
CALL seqopn (iunrec, 'recv_d3', 'unformatted', exst)
READ (iunrec) ilab
IF (ilab.GE.5) THEN
REWIND (iunrec)
READ (iunrec) ilab, d3dyn
ENDIF
!
CLOSE (unit = iunrec, status = 'keep')
!
END IF
!
CALL mp_bcast (d3dyn, root, world_comm)
CALL mp_bcast (ilab, root, world_comm)
!
ENDIF
RETURN
END SUBROUTINE d3_recover

337
PHonon/D3/d3_setup.f90
View File

@ -1,337 +0,0 @@
!
! Copyright (C) 2001-2008 Quantm-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 d3_setup()
!-----------------------------------------------------------------------
!
! This subroutine prepares several variables which are needed in the
! d3toten program:
! 1) computes the total local potential (external+scf) on the smoot
! grid to be used in h_psi and similia
! 2) computes dmuxc 3.1) with GC if needed
! 3) for metals sets the occupated bands
! 4) computes alpha_pv
! 5.1) computes the variables needed to pass to the pattern representat
! of the small group of q
! u the patterns
! t the matrices of the small group of q on the pattern basis
! tmq the matrix of the symmetry which sends q -> -q + G
! gi the G associated to each symmetry operation
! gimq the G of the q -> -q+G symmetry
! irgq the small group indices
! nsymq the order of the small group of q
! irotmq the index of the q->-q+G symmetry
! nirr the number of irreducible representation
! npert the dimension of each irreducible representation
! nmodes the number of modes
! minus_q true if there is a symmetry sending q -> -q+G
! 5.2) computes the variables needed to pass to the pattern representat
! of the group of the crystal
! ug0 the patterns
! tg0 the matrices of the group on the pattern basis
! nsymg0 the order of the group of the crystal
! nirrg0 the number of irreducible representation
! npertg0 the dimension of each irreducible representation
! 6) set the variables needed to deal with nlcc
! 7) set the variables needed to distribute one loop between pools
! 8) set the variables needed to calculate only selected q=0 modes
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp, tau
USE io_global, ONLY : stdout, ionode, ionode_id
USE io_files, ONLY : tmp_dir
USE kinds, ONLY : DP
USE pwcom
USE fft_base, ONLY : dfftp
USE scf, only : rho, rho_core, v, vltot, vrs, kedtau
USE symm_base, ONLY : nrot, nsym, s, ftau, irt, invs, inverse_s, &
s_axis_to_cart, find_sym, copy_sym, s_axis_to_cart
USE uspp_param, ONLY : upf
USE uspp, ONLY : nlcc_any
USE control_flags, ONLY : iverbosity, modenum
USE constants, ONLY : degspin
USE qpoint, ONLY : xq, ikks, ikqs, nksq
USE phcom
USE d3com, ONLY : q0mode, wrmode, nsymg0, npertg0, nirrg0, &
npert_i, npert_f, q0mode_todo, allmodes, ug0, &
fild0rho
USE mp_global, ONLY : npool, my_pool_id, inter_pool_comm, intra_image_comm
USE mp, ONLY : mp_max, mp_min, mp_bcast
USE funct, ONLY : dmxc, dmxc_spin
USE lr_symm_base, ONLY : nsymq, irotmq, irgq, gi, gimq, minus_q, rtau
USE control_lr, ONLY : alpha_pv, nbnd_occ, lgamma
!
IMPLICIT NONE
!
REAL (DP) :: rhotot, rhoup, rhodw, TARGET, small, fac, xmax, emin, &
emax, wrk, xqck(3)
! total charge
! total up charge
! total down charge
! auxiliary variables used
! to set nbnd_occ in the metallic case
! minimum band energy
! maximum band energy
! working array
INTEGER :: ir, isym, jsym, iinv, irot, jrot, ik, &
ibnd, ipol, mu, nu, imode0, irr, ipert, nt, ii, nu_i
! counters
LOGICAL :: sym (48), magnetic_sym
! the symmetry operations
REAL (DP) :: mdum(3)
CHARACTER(LEN=256) :: tmp_dir_save
#ifdef __MPI
INTEGER :: nlength_w, nlength (npool), nresto
#endif
CALL start_clock ('d3_setup')
!
! 1) Computes the total local potential (external+scf) on the smoot grid
!
CALL set_vrs (vrs, vltot, v%of_r, kedtau, v%kin_r, dfftp%nnr, nspin, doublegrid)
!
! 2) Computes the derivative of the xc potential
!
dmuxc (:,:,:) = 0.d0
IF (lsda) THEN
DO ir = 1, dfftp%nnr
rhoup = rho%of_r (ir, 1) + 0.5d0 * rho_core (ir)
rhodw = rho%of_r (ir, 2) + 0.5d0 * rho_core (ir)
CALL dmxc_spin (rhoup, rhodw, dmuxc (ir, 1, 1), &
dmuxc (ir, 2, 1), dmuxc (ir, 1, 2), dmuxc (ir, 2, 2) )
ENDDO
ELSE
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, nspin) + rho_core (ir)
IF (rhotot > 1.d-30) dmuxc (ir, 1, 1) = dmxc (rhotot)
IF (rhotot < - 1.d-30) dmuxc (ir, 1, 1) = - dmxc ( - rhotot)
ENDDO
ENDIF
!
! 3) Computes the number of occupated bands for each k point
!
call setup_nbnd_occ()
!
! 4) Computes alpha_pv
!
emin = et (1, 1)
DO ik = 1, nks
DO ibnd = 1, nbnd
emin = MIN (emin, et (ibnd, ik) )
ENDDO
ENDDO
! find the minimum across pools
CALL mp_min( emin, inter_pool_comm )
emax = et (1, 1)
DO ik = 1, nks
DO ibnd = 1, nbnd
emax = MAX (emax, et (ibnd, ik) )
ENDDO
ENDDO
! find the maximum across pools
CALL mp_max( emax, inter_pool_comm )
alpha_pv = 2.d0 * (emax - emin)
! avoid zero value for alpha_pv
alpha_pv = MAX (alpha_pv, 1.0d-2)
!
! 5) set all the variables needed to use the pattern representation
!
! 5.0) Computes the inverse of each matrix
!
! TEMP TEMP TEMP TEMP: this should not be needed any longer
!
modenum = 0
magnetic_sym = .false.
CALL find_sym ( nat, tau, ityp, dfftp%nr1, dfftp%nr2, dfftp%nr3, &
magnetic_sym, mdum )
sym(:) =.false.
sym(1:nsym)=.true.
!
! Here we re-order all rotations in such a way that true sym.ops.
! are the first nsymq; rotations that are not sym.ops. follow
!
call smallg_q (xq, modenum, at, bg, nsym, s, ftau, sym, minus_q)
nsymq = copy_sym ( nsym, sym )
!
nsymg0 = nsym
CALL inverse_s ( )
CALL s_axis_to_cart ( )
nsym = nsymq
!
! the first nsymq matrices are symmetries of the small group of q
!
! 5.1) Finds the variables needeed for the pattern representation
! of the small group of q
!
sym(1:nsymg0)=.true.
CALL sgam_ph (at, bg, nsymg0, s, irt, tau, rtau, nat, sym)
nmodes = 3 * nat
! if minus_q=.t. set_irr will search for
! Sq=-q+G symmetry. On output minus_q=.t.
! if such a symmetry has been found
minus_q = (modenum .eq. 0)
!
! BEWARE: In set_irr, smallgq is called
!
! FIXME: workaround for filename mess - needed to find where
! the patterns are
tmp_dir_save=tmp_dir
if ( lgamma ) tmp_dir=TRIM(tmp_dir)//'_ph0/'
! FIXME END
IF (modenum .ne. 0) THEN
npertx=1
CALL allocate_pert_d3()
CALL set_irr_mode (nat, at, bg, xq, s, invs, nsym, rtau, irt, &
irgq, nsymq, minus_q, irotmq, t, tmq, npertx, u, &
npert, nirr, gi, gimq, iverbosity, modenum)
ELSE
IF(ionode) CALL io_pattern ( nat, fildrho, nirr, npert, u, xqck, tmp_dir, -1 )
call mp_bcast(u, ionode_id, intra_image_comm)
call mp_bcast(nirr, ionode_id, intra_image_comm)
call mp_bcast(npert, ionode_id, intra_image_comm)
call mp_bcast(xqck, ionode_id, intra_image_comm)
IF(SUM(ABS(xqck(:)-xq(:))) > 1.d-4) CALL errore('d3_setup', 'Wrong drho for q', 1)
npertx = 0
DO irr = 1, nirr
npertx = max (npertx, npert (irr) )
ENDDO
IF (.not.lgamma) THEN
IF(ionode) call io_pattern ( nat, fild0rho, nirrg0, npertg0, ug0, xqck, tmp_dir, -1 )
call mp_bcast(ug0, ionode_id, intra_image_comm)
call mp_bcast(nirrg0, ionode_id, intra_image_comm)
call mp_bcast(npertg0, ionode_id, intra_image_comm)
call mp_bcast(xqck, ionode_id, intra_image_comm)
IF(SUM(ABS(xqck(:))) > 1.d-4) CALL errore('d3_setup', 'Wrong drho for Gamma', 2)
DO irr = 1, nirrg0
npertx = max (npertx, npertg0 (irr) )
ENDDO
ENDIF
CALL allocate_pert_d3()
CALL set_sym_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, &
irgq, nsymq, minus_q, irotmq, t, tmq, npertx, u, &
npert, nirr, gi, gimq, iverbosity)
ENDIF
IF ( lgamma ) THEN
!
nksq = nks
ALLOCATE(ikks(nksq), ikqs(nksq))
DO ik=1,nksq
ikks(ik) = ik
ikqs(ik) = ik
ENDDO
!
ELSE
!
nksq = nks / 2
ALLOCATE(ikks(nksq), ikqs(nksq))
DO ik=1,nksq
ikks(ik) = 2 * ik - 1
ikqs(ik) = 2 * ik
ENDDO
!
END IF
!
! 5.2) Finds the variables needeed for the pattern representation
! of the small group of the crystal
!
IF (lgamma) THEN
nirrg0 = nirr
ELSE
!
! Calculates the variables need for the pattern representation
! for the q=0 symmetries
!
CALL set_d3irr ( )
!
ENDIF
!
! FIXME: workaround for filename mess - needed to find where
! the patterns are
tmp_dir=tmp_dir_save
! FIXME END
npertx = 0
do irr = 1, nirr
npertx = max (npertx, npert (irr) )
enddo
do irr = 1, nirrg0
npertx = max (npertx, npertg0 (irr) )
enddo
!
! 6) Set non linear core correction stuff
!
nlcc_any = ANY ( upf(1:ntyp)%nlcc )
!
IF (nlcc_any) ALLOCATE (drc( ngm, ntyp))
!
! 7) Sets up variables needed to distribute one loop between pools
!
npert_i = 1
npert_f = 3 * nat
#ifdef __MPI
nlength_w = (3 * nat) / npool
nresto = 3 * nat - nlength_w * npool
DO ii = 1, npool
IF (ii <= nresto) THEN
nlength (ii) = nlength_w + 1
ELSE
nlength (ii) = nlength_w
ENDIF
ENDDO
npert_i = 1
DO ii = 1, my_pool_id
npert_i = npert_i + nlength (ii)
ENDDO
npert_f = npert_i - 1 + nlength (my_pool_id+1)
#endif
!
! 8) Sets up variables needed to calculate only selected
! modes at q=0 --the first index of the third order matrix--
!
IF (q0mode_todo (1) <= 0) THEN
DO ii = 1, 3 * nat
q0mode (ii) = .TRUE.
ENDDO
ELSE
DO ii = 1, 3 * nat
q0mode (ii) = .FALSE.
ENDDO
ii = 1
DO WHILE (q0mode_todo (ii) > 0)
q0mode (q0mode_todo (ii) ) = .TRUE.
ii = ii + 1
ENDDO
ENDIF
!
! if you want to compute all the modes; and lgamma=.true.
! the calculation can be simplyfied, in this case allmodes
! is set .true.
!
allmodes = lgamma .AND. (q0mode_todo (1) <= 0)
!
! Sets up variables needed to write only selected
! modes at q=0 --the first index of the third order matrix--
!
DO ii = 1, 3 * nat
wrk = 0.d0
DO nu_i = 1, 3 * nat
IF (q0mode (nu_i) ) THEN
wrk = wrk + ug0 (ii, nu_i) * CONJG (ug0 (ii, nu_i) )
ENDIF
ENDDO
wrmode (ii) = .FALSE.
IF (wrk > 1.d-8) wrmode (ii) = .TRUE.
ENDDO
CALL stop_clock ('d3_setup')
RETURN
END SUBROUTINE d3_setup

303
PHonon/D3/d3_summary.f90
View File

@ -1,303 +0,0 @@
!
! Copyright (C) 2001-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 d3_summary
!-----------------------------------------------------------------------
!
! This routine writes on output the quantities which have been read
! from the punch file, and the quantities computed in the d3_setup
! file.
!
! if iverbosity = 0 only a partial summary is done.
!
USE kinds, only : DP
USE constants, ONLY : amu_ry
USE ions_base, ONLY : nat, ityp, ntyp => nsp, atm, tau, amass
USE run_info, ONLY : title
USE io_global, ONLY : stdout
USE symm_base, ONLY : s, sr, sname, ftau
USE control_flags, ONLY : iverbosity
USE fft_base, ONLY : dffts, dfftp
USE gvecw, ONLY : ecutwfc
use pwcom
use phcom
use d3com
use lr_symm_base, ONLY : irotmq, minus_q, nsymq
use qpoint, ONLY : xq
use control_lr, ONLY : lgamma
!
implicit none
integer :: i, l, nt, mu, nu, ipol, apol, na, isymq, isym, nsymtot, &
ik, ib, irr, imode0, iaux
! generic counter
! counter on angular momenta
! counter on atomic types
! counter on modes
! counter on modes
! counter on polarizations
! counter on polarizations
! counter on atoms
! counter on symmetries
! counter on symmetries
! counter on symmetries
! counter on k points
! counter on beta functions
! counter on irreducible representation
! the first mode
real (DP) :: ft1, ft2, ft3, xkg (3)
! fractionary translation
! k point in crystal coordinates
WRITE( stdout, 100) title, ibrav, alat, omega, nat, ntyp, &
ecutwfc, ecutwfc * dual
100 format (/,5x,a75,/,/, &
& 'bravais-lattice index = ',i12,/,5x, &
& 'lattice parameter (a_0) = ',f12.4,' a.u.',/,5x, &
& 'unit-cell volume = ',f12.4,' (a.u.)^3',/,5x, &
& 'number of atoms/cell = ',i12,/,5x, &
& 'number of atomic types = ',i12,/,5x, &
& 'kinetic-energy cut-off = ',f12.4,' Ry',/,5x, &
& 'charge density cut-off = ',f12.4,' Ry',/,5x,/)
!
! and here more detailed information. Description of the unit cell
!
WRITE( stdout, '(2(3x,3(2x,"celldm(",i1,")=",f11.5),/))') (i, &
celldm (i) , i = 1, 6)
WRITE( stdout, '(5x, &
& "crystal axes: (cart. coord. in units of a_0)",/, &
& 3(15x,"a(",i1,") = (",3f8.4," ) ",/ ) )') (apol, &
& (at (ipol, apol) , ipol = 1, 3) , apol = 1, 3)
WRITE( stdout, '(5x, &
&"reciprocal axes: (cart. coord. in units 2 pi/a_0)",/, &
& 3(15x,"b(",i1,") = (",3f8.4," ) ",/ ) )') (apol, &
& (bg (ipol, apol) , ipol = 1, 3) , apol = 1, 3)
!
! description of the atoms inside the unit cell
!
WRITE( stdout, '(/, 5x,"Atoms inside the unit cell: ")')
WRITE( stdout, '(/,3x,"Cartesian axes")')
WRITE( stdout, '(/,5x,"site n. atom mass ", &
& " positions (a_0 units)")')
WRITE( stdout, '(7x,i2,5x,a6,f8.4," tau(",i2, ") = (",3f11.5," )")') &
(na, atm (ityp (na) ) , amass (ityp (na) ) / amu_ry, na, &
(tau (ipol, na ) , ipol = 1, 3) , na = 1, nat)
WRITE( stdout, '(/,5x,"Computing dynamical matrix for ")')
WRITE( stdout, '(20x,"q = (",3f11.5," )")') (xq (ipol) , ipol = 1, 3)
if (q0mode_todo (1) .le.0) then
WRITE( stdout, '(/,5x,"Computing all the modes ")')
else
WRITE( stdout, '(/,5x,"Computing only selected modes: ")')
do i = 1, 3 * nat
if (q0mode (i) ) WRITE( stdout, '(5x,"Mode to be computed: ",i5)') i
enddo
endif
!
! description of symmetries
!
WRITE( stdout, * )
if (nsymg0.le.1) then
WRITE( stdout, '(5x,"No symmetry! for q=0 ")')
else
WRITE( stdout, '(5x,i2," + 1 = ",i2," q=0 Sym.Ops. ",/)') &
nsymg0, nsymg0 + 1
endif
if (.not.lgamma) then
WRITE( stdout, * )
if (nsymq.le.1.and..not.minus_q) then
WRITE( stdout, '(5x,"No symmetry!")')
else
if (minus_q) then
WRITE( stdout, '(5x,i2," Sym.Ops. (with q -> -q+G )",/)') &
nsymq + 1
else
WRITE( stdout, '(5x,i2," Sym.Ops. (no q -> -q+G )",/)') &
nsymq
endif
endif
endif
if (iverbosity.eq.1) then
WRITE( stdout, '(36x,"s",24x,"frac. trans.")')
if (minus_q) then
iaux = 0
else
iaux = 1
endif
do isymq = iaux, nsymg0
if (isymq.eq.0) then
isym = irotmq
WRITE( stdout, '(/,5x,"This transformation sends q -> -q+G")')
else
!
! It seems to me variable irgq is useless !
! isym = irgq(isymq)
isym = isymq
endif
if (isymq.eq.nsymq + 1) then
WRITE( stdout, '(//,5x,&
&"In the following are listed symmetries of the crystal")')
WRITE( stdout, '(5x,"not belonging to the small group of q")')
endif
WRITE( stdout, '(/6x,"isym = ",i2,5x,a45/)') isymq, sname (isym)
if (ftau (1, isym) .ne.0.or.ftau (2, isym) .ne.0.or.ftau (3, &
isym) .ne.0) then
ft1 = at (1, 1) * ftau (1, isym) / dfftp%nr1 + at (1, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (1, 3) * ftau (3, isym) / dfftp%nr3
ft2 = at (2, 1) * ftau (1, isym) / dfftp%nr1 + at (2, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (2, 3) * ftau (3, isym) / dfftp%nr3
ft3 = at (3, 1) * ftau (1, isym) / dfftp%nr1 + at (3, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (3, 3) * ftau (3, isym) / dfftp%nr3
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
&" ) f =( ",f10.7," )")') isymq, (s (1, ipol, isym),&
ipol = 1, 3) , DBLE (ftau (1, isym) ) / DBLE (dfftp%nr1)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )")') &
(s (2, ipol, &
&isym) , ipol = 1, 3) , DBLE (ftau (2, isym) ) / DBLE (dfftp%nr2)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )"/)') (s (3, ipol, &
& isym) , ipol = 1, 3) , DBLE (ftau (3, isym) ) / DBLE (dfftp%nr3)
WRITE( stdout,'(1x,"cart.",3x,"s(",i2,") = (",3f11.7, &
& " ) f =( ", f10.7," )")') &
isymq, (sr (1,ipol,isym), ipol=1,3), ft1
WRITE( stdout, '(17x," (",3f11.7, " ) ( ",f10.7," )")') &
(sr (2,ipol,isym) , ipol = 1, 3) , ft2
WRITE( stdout, '(17x," (",3f11.7, " ) ( ",f10.7," )"/)')&
(sr (3,ipol,isym) , ipol = 1, 3) , ft3
else
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), " )")') &
isymq, (s (1, ipol, isym) , ipol = 1, 3)
WRITE( stdout, '(17x," (",3(i6,5x)," )")') &
(s (2, ipol, isym), ipol = 1, 3)
WRITE( stdout, '(17x," (",3(i6,5x)," )"/)') &
(s (3, ipol, isym) , ipol = 1, 3)
WRITE( stdout, '(1x,"cart.",3x,"s(",i2,") = (",3f11.7, " )")') &
isymq, (sr (1, ipol, isym) , ipol = 1, 3)
WRITE( stdout, '(17x," (",3f11.7," )")') &
(sr (2, ipol, isym) , ipol = 1, 3)
WRITE( stdout, '(17x," (",3f11.7," )"/)') &
(sr (3, ipol, isym) , ipol = 1, 3)
endif
enddo
endif
!
! Description of the reciprocal lattice vectors
!
WRITE( stdout, '(/5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," FFT grid: (",i3, &
& ",",i3,",",i3,")")') gcutm, ngm, dfftp%nr1, dfftp%nr2, dfftp%nr3
if (doublegrid) WRITE( stdout, '(5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," smooth grid: (",i3, &
& ",",i3,",",i3,")")') gcutms, ngms, &
&dffts%nr1, dffts%nr2, dffts%nr3
if (degauss.eq.0.d0) then
WRITE( stdout, '(5x,"number of k points=",i5)') nkstot
else
WRITE( stdout, '(5x,"number of k points=",i5, &
& " gaussian broad. (Ry)=",f8.4,5x, &
& "ngauss = ",i3)') nkstot, degauss, ngauss
endif
WRITE( stdout, '(23x,"cart. coord. in units 2pi/a_0")')
do ik = 1, nkstot
WRITE( stdout, '(8x,"k(",i5,") = (",3f12.7,"), wk =",f12.7)') ik, &
(xk (ipol, ik) , ipol = 1, 3) , wk (ik)
enddo
if (iverbosity.eq.1) then
WRITE( stdout, '(/23x,"cryst. coord.")')
do ik = 1, nkstot
do ipol = 1, 3
! xkg are the compone
xkg (ipol) = at (1, ipol) * xk (1, ik) + at (2, ipol) * xk (2, &
ik) + at (3, ipol) * xk (3, ik)
! of xk in the crysta
! rec. lattice basis
enddo
WRITE( stdout, '(8x,"k(",i5,") = (",3f12.7,"), wk =",f12.7)') &
ik, (xkg (ipol) , ipol = 1, 3) , wk (ik)
enddo
endif
!
CALL print_ps_info ( )
!
! Representation for q=0
!
if (.not.lgamma) then
WRITE( stdout, '(//5x,"Atomic displacements (q=0 Repr):")')
WRITE( stdout, '(5x,"There are ",i5, &
& " irreducible representations")') nirrg0
imode0 = 0
do irr = 1, nirrg0
WRITE( stdout, '(/, 5x,"Representation ",i5,i7, &
& " modes - To be done")') irr, npertg0 (irr)
if (iverbosity.eq.1) then
WRITE( stdout, '(5x,"Phonon polarizations are as follows:",/)')
if (npertg0 (irr) .eq.1) then
WRITE( stdout, '(20x," mode # ",i3)') imode0 + 1
WRITE( stdout, '(20x," (",2f10.5," ) ")') ( (ug0 (mu, nu) , nu = &
& imode0 + 1, imode0 + npertg0 (irr) ) , mu = 1, 3 * nat)
elseif (npertg0 (irr) .eq.2) then
WRITE( stdout, '(2(10x," mode # ",i3,16x))') imode0 + 1, &
imode0 + 2
WRITE( stdout, '(2(10x," (",2f10.5," ) "))') ( (ug0 (mu, nu),&
nu = imode0 + 1, imode0 + npertg0 (irr) ) , mu = 1, 3 * nat)
else
WRITE( stdout, '(4x,3(" mode # ",i3,13x))') imode0 + 1, &
imode0 + 2, imode0 + 3
WRITE( stdout, '((5x,3("(",2f10.5," ) ")))') ( (ug0 (mu, &
nu) , nu = imode0 + 1, imode0 + npertg0 (irr) ) , mu = 1, &
3 * nat)
endif
imode0 = imode0 + npertg0 (irr)
endif
enddo
endif
!
! Representation for a generic q
!
WRITE( stdout, '(//5x,"Atomic displacements:")')
WRITE( stdout, '(5x,"There are ",i5," irreducible representations") &
&') nirr
imode0 = 0
do irr = 1, nirr
WRITE( stdout, '(/, 5x,"Representation ",i5,i7, &
& " modes - To be done")') irr, npert (irr)
if (iverbosity.eq.1) then
WRITE( stdout, '(5x,"Phonon polarizations are as follows:",/)')
if (npert (irr) .eq.1) then
WRITE( stdout, '(20x," mode # ",i3)') imode0 + 1
WRITE( stdout, '(20x," (",2f10.5," ) ")') ( (u (mu, nu) , nu = &
imode0 + 1, imode0 + npert (irr) ) , mu = 1, 3 * nat)
elseif (npert (irr) .eq.2) then
WRITE( stdout, '(2(10x," mode # ",i3,16x))') imode0 + 1, &
imode0 + 2
WRITE( stdout, '(2(10x," (",2f10.5," ) "))') ( (u (mu, nu) , &
nu = imode0 + 1, imode0 + npert (irr) ) , mu = 1, 3 * nat)
else
WRITE( stdout, '(4x,3(" mode # ",i3,13x))') imode0 + 1, imode0 &
+ 2, imode0 + 3
WRITE( stdout, '((5x,3("(",2f10.5," ) ")))') ( (u (mu, nu) , &
nu = imode0 + 1, imode0 + npert (irr) ) , mu = 1, 3 * nat)
endif
imode0 = imode0 + npert (irr)
endif
enddo
WRITE( stdout, '(/20x,"** Complex Version **")')
!
FLUSH( stdout )
!
return
end subroutine d3_summary

131
PHonon/D3/d3_symdyn.f90
View File

@ -1,131 +0,0 @@
!
! Copyright (C) 2001 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 d3_symdyn (d3dyn, u, ug0, xq, s, invs, rtau, irt, irgq, &
at, bg, nsymq, nat, irotmq, minus_q, npert_i, npert_f)
!-----------------------------------------------------------------------
!
! This routine symmetrize the dynamical matrix written in the basis
! of the modes
!
!
USE kinds, only : DP
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
implicit none
integer :: nat, s (3, 3, 48), irt (48, nat), irgq (48), invs (48), &
nsymq, npert_i, npert_f, irotmq
! input: the number of atoms
! input: the symmetry matrices
! input: the rotated of each atom
! input: the small group of q
! input: the inverse of each matrix
! input: the order of the small gro
! input: the symmetry q -> -q+G
real (DP) :: xq (3), rtau (3, 48, nat), at (3, 3), bg (3, 3)
! input: the coordinates of q
! input: the R associated at each r
! input: direct lattice vectors
! input: reciprocal lattice vectors
logical :: minus_q
! input: if true symmetry sends q->
complex (DP) :: d3dyn (3 * nat, 3 * nat, 3 * nat), &
ug0 (3 * nat, 3 * nat), u (3 * nat, 3 * nat)
! inp/out: matrix to symmetr
! input: the q=0 patterns
! input: the patterns
integer :: i, j, i1, icart, jcart, kcart, na, nb, nc, mu, nu, om
! counters
complex (DP) :: work, wrk (3, 3)
! auxiliary variables
complex (DP), allocatable :: phi (:,:,:,:,:,:)
! the dynamical matrix
allocate (phi( 3, 3, 3, nat, nat, nat))
!
! First we transform in the cartesian coordinates
!
phi = (0.d0, 0.d0)
do i1 = npert_i, npert_f
nc = (i1 - 1) / 3 + 1
kcart = i1 - 3 * (nc - 1)
do i = 1, 3 * nat
na = (i - 1) / 3 + 1
icart = i - 3 * (na - 1)
do j = 1, 3 * nat
nb = (j - 1) / 3 + 1
jcart = j - 3 * (nb - 1)
work = (0.d0, 0.d0)
do om = 1, 3 * nat
do mu = 1, 3 * nat
do nu = 1, 3 * nat
work = work + CONJG(ug0 (i1, om) ) * u (i, mu) * &
d3dyn (om, mu, nu) * CONJG(u (j, nu) )
enddo
enddo
enddo
phi (kcart, icart, jcart, nc, na, nb) = work
enddo
enddo
enddo
#ifdef __MPI
call mp_sum( phi, inter_pool_comm )
#endif
!
! Then we transform to the crystal axis
!
do nc = 1, nat
do na = 1, nat
do nb = 1, nat
call trntnsc_3 (phi (1, 1, 1, nc, na, nb), at, bg, - 1)
enddo
enddo
enddo
!
! And we symmetrize in this basis
!
call d3_symdynph (xq, phi, s, invs, rtau, irt, irgq, nsymq, nat, &
irotmq, minus_q)
!
! Back to cartesian coordinates
!
do nc = 1, nat
do na = 1, nat
do nb = 1, nat
call trntnsc_3 (phi (1, 1, 1, nc, na, nb), at, bg, + 1)
enddo
enddo
enddo
!
! rewrite the dynamical matrix on the array dyn with dimension 3nat x 3
!
do i1 = 1, 3 * nat
nc = (i1 - 1) / 3 + 1
kcart = i1 - 3 * (nc - 1)
do i = 1, 3 * nat
na = (i - 1) / 3 + 1
icart = i - 3 * (na - 1)
do j = 1, 3 * nat
nb = (j - 1) / 3 + 1
jcart = j - 3 * (nb - 1)
d3dyn (i1, i, j) = phi (kcart, icart, jcart, nc, na, nb)
enddo
enddo
enddo
deallocate (phi)
return
end subroutine d3_symdyn

217
PHonon/D3/d3_symdynph.f90
View File

@ -1,217 +0,0 @@
!
! Copyright (C) 2001 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 d3_symdynph (xq, phi, s, invs, rtau, irt, irgq, nsymq, &
nat, irotmq, minus_q)
!-----------------------------------------------------------------------
!
! This routine receives as input an unsymmetrized dynamical
! matrix expressed on the crystal axes and imposes the symmetry
! of the small group of q. Furthermore it imposes also the symmetry
! q -> -q+G if present.
!
!
USE kinds, only : DP
USE constants, only : tpi
implicit none
!
! The dummy variables
!
integer :: nat, s (3, 3, 48), irt (48, nat), irgq (48), invs (48), &
nsymq, irotmq
! input: the number of atoms
! input: the symmetry matrices
! input: the rotated of each vector
! input: the small group of q
! input: the inverse of each matrix
! input: the order of the small gro
! input: the rotation sending q ->
real (DP) :: xq (3), rtau (3, 48, nat)
! input: the q point
! input: the R associated at each t
logical :: minus_q
! input: true if a symmetry q->-q+G
complex (DP) :: phi (3, 3, 3, nat, nat, nat)
! inp/out: the matrix to symmetrize
!
! local variables
!
integer :: isymq, sna, snb, snc, irot, na, nb, nc, ipol, jpol, &
lpol, kpol, mpol, npol
! counters
integer, allocatable:: iflb (:,:,:)
! used to account for symmetrized elements
real (DP) :: arg
! the argument of the phase
complex (DP), allocatable :: phip (:,:,:,:,:,:)
! work space
complex (DP) :: work (3, 3, 3), fase, faseq (48)
! the phase factor
! the phases for each symmetry
!
! We start by imposing hermiticity
!
do nc = 1, nat
do na = 1, nat
do nb = 1, nat
do kpol = 1, 3
do ipol = 1, 3
do jpol = 1, 3
phi (kpol, ipol, jpol, nc, na, nb) = 0.5d0 * &
(phi (kpol, ipol, jpol, nc, na, nb) + &
CONJG(phi (kpol, jpol, ipol, nc, nb, na) ) )
phi (kpol, jpol, ipol, nc, nb, na) = &
CONJG(phi (kpol, ipol, jpol, nc, na, nb) )
enddo
enddo
enddo
enddo
enddo
enddo
!
! If no other symmetry is present we quit here
!
if ( (nsymq == 1) .and. (.not.minus_q) ) return
allocate (phip( 3, 3, 3, nat, nat, nat))
!
! Then we impose the symmetry q -> -q+G if present
!
if (minus_q) then
do nc = 1, nat
do na = 1, nat
do nb = 1, nat
do mpol = 1, 3
do ipol = 1, 3
do jpol = 1, 3
work = (0.d0, 0.d0)
snc = irt (irotmq, nc)
sna = irt (irotmq, na)
snb = irt (irotmq, nb)
arg = 0.d0
do kpol = 1, 3
arg = arg + (xq (kpol) * (rtau (kpol, irotmq, na) - &
rtau (kpol, irotmq, nb) ) )
enddo
arg = arg * tpi
fase = CMPLX(cos (arg), sin (arg) ,kind=DP)
do npol = 1, 3
do kpol = 1, 3
do lpol = 1, 3
work (mpol, ipol, jpol) = work (mpol, ipol, jpol) + &
fase * s (ipol, kpol, irotmq) * &
s (jpol, lpol, irotmq) * &
s (mpol, npol, irotmq) * &
phi (npol, kpol, lpol, snc, sna, snb)
enddo
enddo
enddo
phip (mpol, ipol, jpol, nc, na, nb) = &
(phi (mpol, ipol, jpol, nc, na, nb) + &
CONJG(work (mpol, ipol, jpol) ) ) * 0.5d0
enddo
enddo
enddo
enddo
enddo
enddo
phi = phip
endif
deallocate (phip)
!
! Here we symmetrize with respect to the small group of q
!
if (nsymq == 1) return
allocate (iflb( nat, nat, nat))
do na = 1, nat
do nb = 1, nat
do nc = 1, nat
iflb (nc, na, nb) = 0
enddo
enddo
enddo
do nc = 1, nat
do na = 1, nat
do nb = 1, nat
if (iflb (nc, na, nb) .eq.0) then
work = (0.d0, 0.d0)
do isymq = 1, nsymq
irot = irgq (isymq)
snc = irt (irot, nc)
sna = irt (irot, na)
snb = irt (irot, nb)
arg = 0.d0
do ipol = 1, 3
arg = arg + (xq (ipol) * (rtau (ipol, irot, na) - &
rtau (ipol, irot, nb) ) )
enddo
arg = arg * tpi
faseq (isymq) = CMPLX(cos (arg), sin (arg) ,kind=DP)
do mpol = 1, 3
do ipol = 1, 3
do jpol = 1, 3
do npol = 1, 3
do kpol = 1, 3
do lpol = 1, 3
work (mpol, ipol, jpol) = work (mpol, ipol, jpol) + &
s (ipol, kpol, irot) * &
s (jpol, lpol, irot) * &
s (mpol, npol, irot) * &
phi (npol, kpol, lpol, snc, sna, snb) &
* faseq (isymq)
enddo
enddo
enddo
enddo
enddo
enddo
enddo
do isymq = 1, nsymq
irot = irgq (isymq)
snc = irt (irot, nc)
sna = irt (irot, na)
snb = irt (irot, nb)
do mpol = 1, 3
do ipol = 1, 3
do jpol = 1, 3
phi (mpol, ipol, jpol, snc, sna, snb) = (0.d0, 0.d0)
do npol = 1, 3
do kpol = 1, 3
do lpol = 1, 3
phi (mpol, ipol, jpol, snc, sna, snb) = &
phi (mpol, ipol, jpol, snc, sna, snb) +&
s (mpol, npol, invs (irot) ) * &
s (ipol, kpol, invs (irot) ) * &
s (jpol, lpol, invs (irot) ) * &
work (npol, kpol, lpol) * &
CONJG(faseq (isymq) )
enddo
enddo
enddo
enddo
enddo
enddo
iflb (snc, sna, snb) = 1
enddo
endif
enddo
enddo
enddo
phi = phi / DBLE(nsymq)
deallocate (iflb)
return
end subroutine d3_symdynph

254
PHonon/D3/d3_valence.f90
View File

@ -1,254 +0,0 @@
!
! Copyright (C) 2001 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 d3_valence
!-----------------------------------------------------------------------
!
USE ions_base, ONLY : nat
USE kinds, only : DP
use pwcom
use phcom
use d3com
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
use qpoint, ONLY: nksq
use control_lr, ONLY : lgamma
implicit none
integer :: ik, ikk, ikq, nu_i, nu_j, nu_k, ibnd, jbnd, kbnd, nrec
real (DP) :: de1, de2, de3, wg1, wg2, wg3, wwg1, wwg2, d_dos, wrk, &
wga (nbnd), wgq (nbnd), w0g (nbnd), w1g (nbnd)
real (DP), external :: wgauss, w0gauss, w_1gauss
complex (DP) :: wrk1, aux (3 * nat)
complex (DP), allocatable :: pdvp_i (:,:), pdvp_j (:,:), dpsidvpsi (:,:), &
pdvp_k (:,:), aux1 (:,:,:), aux2 (:,:,:), aux3 (:,:,:), aux4 (:,:,:)
if (degauss == 0.d0) return
allocate (pdvp_i( nbnd, nbnd))
allocate (pdvp_j( nbnd, nbnd))
allocate (pdvp_k( nbnd, nbnd))
allocate (aux1 ( 3 * nat, 3 * nat, 3 * nat))
allocate (aux2 ( 3 * nat, 3 * nat, 3 * nat))
allocate (aux3 ( 3 * nat, 3 * nat, 3 * nat))
allocate (aux4 ( 3 * nat, 3 * nat, 3 * nat))
allocate (dpsidvpsi( nbnd, nbnd))
aux1(:,:,:) = (0.d0, 0.d0)
aux2(:,:,:) = (0.d0, 0.d0)
aux3(:,:,:) = (0.d0, 0.d0)
aux4(:,:,:) = (0.d0, 0.d0)
call read_ef
do ik = 1, nksq
if (lgamma) then
ikk = ik
ikq = ik
else
ikk = 2 * ik - 1
ikq = 2 * ik
endif
do ibnd = 1, nbnd
wga (ibnd) = wgauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss)
wgq (ibnd) = wgauss ( (ef - et (ibnd, ikq) ) / degauss, ngauss)
w0g (ibnd) = w0gauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss) &
/ degauss
w1g (ibnd) = w_1gauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss) &
/ (degauss**2)
enddo
do nu_i = 1, 3 * nat
if (q0mode (nu_i) ) then
nrec = nu_i + (ik - 1) * 3 * nat
call davcio (pdvp_i, lrpdqvp, iupd0vp, nrec, - 1)
do nu_j = 1, 3 * nat
nrec = nu_j + (ik - 1) * 3 * nat
call davcio (pdvp_j, lrpdqvp, iupdqvp, nrec, - 1)
do nu_k = 1, 3 * nat
nrec = nu_k + (ik - 1) * 3 * nat
call davcio (pdvp_k, lrpdqvp, iupdqvp, nrec, - 1)
do ibnd = 1, nbnd
wg1 = wga (ibnd)
wwg1 = w0g (ibnd)
do jbnd = 1, nbnd
wg2 = wga (jbnd)
wwg2 = w0g (jbnd)
de1 = et (ibnd, ikk) - et (jbnd, ikk)
do kbnd = 1, nbnd
wg3 = wgq (kbnd)
de2 = et (jbnd, ikk) - et (kbnd, ikq)
de3 = et (kbnd, ikq) - et (ibnd, ikk)
if (abs (de1) < 2.0d-5 .and. abs (de2) < 2.0d-5 &
.and. abs (de3) < 2.0d-5) then
wrk = 0.5d0 * w1g (ibnd)
elseif (abs (de1) < 1.0d-5) then
wrk = ( (wg1 - wg3) / de2 + wwg1) / de3
elseif (abs (de2) < 1.0d-5) then
wrk = ( (wg2 - wg1) / de3 + wwg2) / de1
elseif (abs (de3) < 1.0d-5) then
wrk = ( (wg3 - wg2) / de1 + wwg1) / de2
else
wrk = - (wg1 * de2 + wg2 * de3 + wg3 * de1) / &
(de1 * de2 * de3)
endif
aux1 (nu_i, nu_j, nu_k) = aux1 (nu_i, nu_j, nu_k) + &
2.d0 * wrk * wk (ikk) * pdvp_i (ibnd, jbnd) * &
CONJG(pdvp_j (kbnd, jbnd) ) * pdvp_k (kbnd, ibnd)
enddo
enddo
enddo
enddo
enddo
endif
enddo
enddo
do ik = 1, nksq
if (lgamma) then
ikk = ik
ikq = ik
else
ikk = 2 * ik - 1
ikq = 2 * ik
endif
do nu_j = 1, 3 * nat
nrec = nu_j + (ik - 1) * 3 * nat
call davcio (pdvp_j, lrpdqvp, iupdqvp, nrec, - 1)
do nu_k = 1, 3 * nat
nrec = nu_k + (ik - 1) * 3 * nat
call davcio (pdvp_k, lrpdqvp, iupdqvp, nrec, - 1)
nrec = nu_j + (nu_k - 1) * 3 * nat + (ik - 1) * 9 * nat * nat
call davcio (dpsidvpsi, lrdpdvp, iudpdvp_1, nrec, - 1)
do nu_i = 1, 3 * nat
if (q0mode (nu_i) .or.lgamma) then
wrk1 = CMPLX(0.d0, 0.d0,kind=DP)
do ibnd = 1, nbnd
do jbnd = 1, nbnd
de1 = et (ibnd, ikk) - et (jbnd, ikq)
if (abs (de1) > 1.0d-5) then
wrk = (w0gauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss) &
/ degauss - w0gauss ( (ef - et (jbnd, ikq) ) / degauss, &
ngauss) / degauss) / de1
else
wrk = - w_1gauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss) &
/ (degauss**2)
endif
wrk1 = wrk1 + wk (ikk) * wrk * ef_sh (nu_i) * CONJG(pdvp_j ( &
jbnd, ibnd) ) * pdvp_k (jbnd, ibnd)
enddo
enddo
aux2 (nu_i, nu_j, nu_k) = aux2 (nu_i, nu_j, nu_k) + wrk1
if (lgamma) then
aux2 (nu_k, nu_i, nu_j) = aux2 (nu_k, nu_i, nu_j) + wrk1
aux2 (nu_j, nu_k, nu_i) = aux2 (nu_j, nu_k, nu_i) + wrk1
endif
wrk1 = CMPLX(0.d0, 0.d0,kind=DP)
do ibnd = 1, nbnd
wrk1 = wrk1 + wk (ikk) * ef_sh (nu_i) * dpsidvpsi (ibnd, ibnd) &
* w0gauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss) / &
degauss
enddo
aux2 (nu_i, nu_j, nu_k) = aux2 (nu_i, nu_j, nu_k) + wrk1
aux2 (nu_i, nu_k, nu_j) = aux2 (nu_i, nu_k, nu_j) + &
CONJG(wrk1)
if (lgamma) then
aux2 (nu_k, nu_i, nu_j) = aux2 (nu_k, nu_i, nu_j) + wrk1
aux2 (nu_j, nu_i, nu_k) = aux2 (nu_j, nu_i, nu_k) + &
CONJG(wrk1)
aux2 (nu_j, nu_k, nu_i) = aux2 (nu_j, nu_k, nu_i) + wrk1
aux2 (nu_k, nu_j, nu_i) = aux2 (nu_k, nu_j, nu_i) + &
CONJG(wrk1)
endif
endif
enddo
enddo
enddo
enddo
if (lgamma) then
do nu_i = 1, 3 * nat
if (.not.q0mode (nu_i) ) then
do nu_j = 1, 3 * nat
do nu_k = 1, 3 * nat
aux2 (nu_i, nu_j, nu_k) = CMPLX(0.d0, 0.d0,kind=DP)
enddo
enddo
endif
enddo
endif
if (lgamma) then
d_dos = 0.d0
aux(:) = (0.d0, 0.d0)
do ik = 1, nksq
ikk = ik
do ibnd = 1, nbnd
d_dos = d_dos + wk (ikk) * w_1gauss ( (ef - et (ibnd, ikk) ) &
/ degauss, ngauss) / (degauss**2)
enddo
do nu_i = 1, 3 * nat
nrec = nu_i + (ik - 1) * 3 * nat
call davcio (pdvp_i, lrpdqvp, iupd0vp, nrec, - 1)
do ibnd = 1, nbnd
aux (nu_i) = aux (nu_i) + pdvp_i (ibnd, ibnd) * wk (ikk) &
* w_1gauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss) / &
(degauss**2)
enddo
enddo
enddo
do nu_i = 1, 3 * nat
if (q0mode (nu_i) ) then
do nu_j = 1, 3 * nat
do nu_k = 1, 3 * nat
aux3 (nu_i, nu_j, nu_k) = aux3 (nu_i, nu_j, nu_k) + &
ef_sh (nu_i) * ef_sh (nu_j) * aux (nu_k) + &
ef_sh (nu_j) * ef_sh (nu_k) * aux (nu_i) + &
ef_sh (nu_k) * ef_sh (nu_i) * aux (nu_j)
aux4 (nu_i, nu_j, nu_k) = aux4 (nu_i, nu_j, nu_k) - &
ef_sh (nu_i) * ef_sh (nu_j) * ef_sh (nu_k) * d_dos
enddo
enddo
endif
enddo
endif
#ifdef __MPI
call mp_sum( aux1, inter_pool_comm )
call mp_sum( aux2, inter_pool_comm )
if (lgamma) then
call mp_sum( aux3, inter_pool_comm )
call mp_sum( aux4, inter_pool_comm )
endif
#endif
d3dyn = d3dyn + aux1 + aux2 + aux3 + aux4
d3dyn_aux7 = d3dyn_aux7 + aux1 + aux2 + aux3 + aux4
deallocate (pdvp_i)
deallocate (pdvp_j)
deallocate (pdvp_k)
deallocate (aux1)
deallocate (aux2)
deallocate (aux3)
deallocate (aux4)
deallocate (dpsidvpsi)
return
end subroutine d3_valence

126
PHonon/D3/d3com.f90
View File

@ -1,126 +0,0 @@
!
! Copyright (C) 2001-2003 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 .
!
!
! Common for d3toten
!
module g0aux
USE kinds, only: DP
real(DP), pointer:: vlocg0(:,:) ! local potential at q+G for q=0
complex(DP), pointer:: vkb0 (:,:) ! contains beta functions at q=0
complex(DP), pointer:: d0rc(:,:)! contain the rhoc for q=0
end module g0aux
!
! the units of the files and the record lengths
!
module units_d3
integer:: iudqwf, &! the unit with | Pc d/du(q) psi_{k+q} >
iud0qwf, &! the unit with | Pc d/du(0) psi_{k+q} >
iud0rho ! the unit where q=0 delta rho is written
end module units_d3
!
! the name of the files
!
module d0rho
character(len=256) :: fild0rho
end module d0rho
!
! the variable needed to describe the patterns when q=0
!
module modesg0
USE kinds, only: DP
integer :: nsymg0, &! the number of symmetries of the crystal
nirrg0 ! the number of irreducible representation
!
integer, pointer :: npertg0(:) ! the number of perturbations per IR
complex(DP), pointer :: ug0(:,:), tg0(:,:,:,:)
! ug0: transformation modes patterns
! tg0: the symmetry in the base of pattern (q=0)
end module modesg0
!
! third order dynamical matrices (auxiliary)
!
module d3aux
USE kinds, only: DP
complex(DP), allocatable :: &
d3dyn_aux1(:,:,:), d3dyn_aux2(:,:,:), d3dyn_aux3(:,:,:), &
d3dyn_aux4(:,:,:), d3dyn_aux5(:,:,:), d3dyn_aux6(:,:,:), &
d3dyn_aux7(:,:,:), d3dyn_aux8(:,:,:), d3dyn_aux9(:,:,:)
end module d3aux
!
! third order dynamical matrix
!
module thirdorder
USE kinds, only: DP
complex(DP), allocatable :: d3dyn(:,:,:)
! third order dynamical matrix
complex(DP), allocatable :: psidqvpsi(:,:)
! <psi| dqV |psi>
real(DP) :: ethr_ph ! eigenvalues convergence threshold
real(DP), allocatable :: ef_sh(:) ! E_Fermi shift
integer :: istop
logical :: wraux, recv
end module thirdorder
!
! test variables
!
module testvar
USE kinds, only: DP
real(DP) :: testreal(50)
integer :: testint(50)
logical :: testflag(50)
end module testvar
!
! the units of the files and the record lengths
!
module units_d3ph
integer :: &
iuef, &! unit with ef_sh
iupdqvp, &! unit with <psi| dqV |psi>
iupd0vp, &! unit with <psi| d0V |psi>
lrpdqvp, &! length of <psi| dV |psi>
iudpdvp_1, &! unit with <dqpsi| dqV |psi>
iudpdvp_2, &! unit with <dqpsi| d0V |psi>
iudpdvp_3, &! unit with <d0psi| dqV |psi>
lrdpdvp ! length of <dpsi | dV |psi> records
end module units_d3ph
!
! In the parallel version of the program some loop on perturbations
! may be split betweem pools. npert_i and npert_f are the initial
! and final value for a counter on the modes to be split among pools
!
module npert_mod
integer :: &
npert_i, &! starting value for the mode counter
npert_f ! final value for the mode counter
end module npert_mod
!
! Variables used for computing and writing only selected modes at q=0
! --the first index of the dthird matrix--
!
module q0modes
integer :: q0mode_todo(300) ! list of the q=0 modes to be computed
!
logical :: &
q0mode(300), &! if .true. this mode is to be computed
wrmode(300), &! if .true. this mode is to be written
allmodes ! it is .true. if you are at gamma and you
! want to compute all the modes
end module q0modes
module d3com
use g0aux
use units_d3
use units_d3ph
use d0rho
use d3aux
use thirdorder
use testvar
use modesg0
use npert_mod
use q0modes
end module d3com

266
PHonon/D3/d3dyn_cc.f90
View File

@ -1,266 +0,0 @@
!
! Copyright (C) 2001 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 d3dyn_cc
!-----------------------------------------------------------------------
!
! It calculates contribution due to non-linear-core-correction
! The variation of the density with respect to the perturbation must
! be corrected before calling this routine:
! while reading the variation of the density on unit iudrho and iud0rho
! it assumes it is the total density, i.e. sum of valence + core.
!
USE ions_base, ONLY : nat, ityp, tau
USE kinds, only : DP
USE funct, only : xc
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
use pwcom
use scf, only : rho, rho_core
use qpoint, ONLY : xq
use phcom
use d3com
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
USE uspp, ONLY : nlcc_any
implicit none
integer :: na, nta, ig, ir, i_cart, j_cart, k_cart, na_i, na_j, &
na_k, nu_i, nu_j, nu_k, na_icart, nb_jcart, nc_kcart
real (DP) :: rhox, arhox, ex, ec, vx, vc, arg
! the total charge in each point
! the absolute value of the charge
! local exchange energy
! local correlation energy
! local exchange potential
! local correlation potential
! argument of the phase factor
complex (DP) :: exc, work, work0, work1, work2, work3
complex (DP), allocatable :: drc_exp (:,:), aux (:), d3dyn0 (:,:,:), &
d3dyn1 (:,:,:), d3dyn2 (:,:,:), d3dyn3 (:,:,:), d3dyn4 (:,:,:)
if (.not.nlcc_any) return
allocate (aux ( dfftp%nnr))
allocate (drc_exp ( ngm, nat))
allocate (d3dyn0 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn1 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn2 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn3 ( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn4 ( 3 * nat, 3 * nat, 3 * nat))
d3dyn0(:,:,:) = (0.d0, 0.d0)
d3dyn1(:,:,:) = (0.d0, 0.d0)
d3dyn2(:,:,:) = (0.d0, 0.d0)
d3dyn3(:,:,:) = (0.d0, 0.d0)
drc_exp(:,:) = (0.d0, 0.d0)
do na = 1, nat
nta = ityp (na)
do ig = 1, ngm
arg = - tpi * (g (1, ig) * tau (1, na) + g (2, ig) * tau (2, na) &
+ g (3, ig) * tau (3, na) )
exc = CMPLX(cos (arg), sin (arg) ,kind=DP)
drc_exp (ig, na) = d0rc (ig, nta) * exc
enddo
enddo
aux(:) = (0.d0, 0.d0)
do ir = 1, dfftp%nnr
rhox = rho%of_r (ir, 1) + rho_core (ir)
arhox = abs (rhox)
if (arhox > 1.0d-30) then
call xc (arhox, ex, ec, vx, vc)
aux (ir) = CMPLX(e2 * (vx + vc), 0.d0,kind=DP)
endif
enddo
CALL fwfft ('Dense', aux, dfftp)
do na_i = npert_i, npert_f
na = (na_i - 1) / 3 + 1
i_cart = na_i - 3 * (na - 1)
do j_cart = 1, 3
na_j = j_cart + 3 * (na - 1)
do k_cart = 1, 3
na_k = k_cart + 3 * (na - 1)
work = (0.d0, 0.d0)
do ig = 1, ngm
work = work + (0.d0, 1.d0) * g (i_cart, ig) * g (j_cart, ig) &
* g (k_cart, ig) * CONJG(aux (nl (ig) ) ) * drc_exp (ig, na)
enddo
d3dyn0 (na_i, na_j, na_k) = work * omega * tpiba2 * tpiba
enddo
enddo
enddo
#ifdef __MPI
do nu_i = 1, 3 * nat
call davcio_drho (aux, lrdrho, iud0rho, nu_i, - 1)
enddo
do nu_i = 1, npert_i - 1
call davcio_drho (aux, lrdrho, iud0rho, nu_i, - 1)
enddo
#endif
do nu_i = npert_i, npert_f
call davcio_drho (aux, lrdrho, iud0rho, nu_i, - 1)
do ir = 1, dfftp%nnr
aux (ir) = aux (ir) * dmuxc (ir, 1, 1)
enddo
CALL fwfft ('Dense', aux, dfftp)
do na = 1, nat
do i_cart = 1, 3
na_i = i_cart + 3 * (na - 1)
do j_cart = 1, 3
na_j = j_cart + 3 * (na - 1)
work = (0.d0, 0.d0)
do ig = 1, ngm
work = work - CONJG(aux (nl (ig) ) ) * g (i_cart, ig) * g ( &
j_cart, ig) * drc_exp (ig, na)
enddo
d3dyn1 (nu_i, na_i, na_j) = work * tpiba2 * omega
enddo
enddo
enddo
enddo
#ifdef __MPI
do nu_i = npert_f + 1, 3 * nat
call davcio_drho (aux, lrdrho, iud0rho, nu_i, - 1)
enddo
#endif
drc_exp(:,:) = (0.d0, 0.d0)
do na = 1, nat
nta = ityp (na)
do ig = 1, ngm
arg = - tpi * ( (g (1, ig) + xq (1) ) * tau (1, na) + (g (2, ig) &
+ xq (2) ) * tau (2, na) + (g (3, ig) + xq (3) ) * tau (3, na) )
exc = CMPLX(cos (arg), sin (arg) ,kind=DP)
drc_exp (ig, na) = drc (ig, nta) * exc
enddo
enddo
#ifdef __MPI
do nu_i = 1, 3 * nat
call davcio_drho (aux, lrdrho, iudrho, nu_i, - 1)
enddo
do nu_i = 1, npert_i - 1
call davcio_drho (aux, lrdrho, iudrho, nu_i, - 1)
enddo
#endif
do nu_i = npert_i, npert_f
call davcio_drho (aux, lrdrho, iudrho, nu_i, - 1)
do ir = 1, dfftp%nnr
aux (ir) = aux (ir) * dmuxc (ir, 1, 1)
enddo
CALL fwfft ('Dense', aux, dfftp)
do na = 1, nat
do i_cart = 1, 3
na_i = i_cart + 3 * (na - 1)
do j_cart = 1, 3
na_j = j_cart + 3 * (na - 1)
work = (0.d0, 0.d0)
do ig = 1, ngm
work = work - CONJG(aux (nl (ig) ) ) * drc_exp (ig, na) * &
(g (i_cart, ig) + xq (i_cart) ) * (g (j_cart, ig) + xq (j_cart) )
enddo
d3dyn2 (na_i, nu_i, na_j) = work * omega * tpiba2
d3dyn3 (na_i, na_j, nu_i) = CONJG(work) * omega * tpiba2
enddo
enddo
enddo
enddo
#ifdef __MPI
do nu_i = npert_f + 1, 3 * nat
call davcio_drho (aux, lrdrho, iudrho, nu_i, - 1)
enddo
call mp_sum ( d3dyn0, intra_pool_comm )
call mp_sum ( d3dyn1, intra_pool_comm )
call mp_sum ( d3dyn2, intra_pool_comm )
call mp_sum ( d3dyn3, intra_pool_comm )
call mp_sum ( d3dyn0, inter_pool_comm )
call mp_sum ( d3dyn1, inter_pool_comm )
call mp_sum ( d3dyn2, inter_pool_comm )
call mp_sum ( d3dyn3, inter_pool_comm )
#endif
!
! The dynamical matrix was computed in cartesian axis and now we put
! it on the basis of the modes
!
d3dyn4(:,:,:) = (0.d0, 0.d0)
do nu_k = npert_i, npert_f
if (q0mode (nu_k) ) then
do nu_i = 1, 3 * nat
do nu_j = 1, 3 * nat
work0 = (0.d0, 0.d0)
do nc_kcart = 1, 3 * nat
do na_icart = 1, 3 * nat
do nb_jcart = 1, 3 * nat
work0 = work0 + ug0 (nc_kcart, nu_k) * &
CONJG(u (na_icart, nu_i) ) * &
d3dyn0 (nc_kcart, na_icart, nb_jcart) * &
u (nb_jcart, nu_j)
enddo
enddo
enddo
work1 = (0.d0, 0.d0)
do na_icart = 1, 3 * nat
do nb_jcart = 1, 3 * nat
work1 = work1 + CONJG(u (na_icart, nu_i) ) * d3dyn1 (nu_k, &
na_icart, nb_jcart) * u (nb_jcart, nu_j)
enddo
enddo
work2 = (0.d0, 0.d0)
do nc_kcart = 1, 3 * nat
do nb_jcart = 1, 3 * nat
work2 = work2 + ug0 (nc_kcart, nu_k) * d3dyn2 (nc_kcart, nu_i, &
nb_jcart) * u (nb_jcart, nu_j)
enddo
enddo
work3 = (0.d0, 0.d0)
do nc_kcart = 1, 3 * nat
do na_icart = 1, 3 * nat
work3 = work3 + ug0 (nc_kcart, nu_k) * &
CONJG(u (na_icart, nu_i) ) * &
d3dyn3 (nc_kcart, na_icart, nu_j)
enddo
enddo
d3dyn4 (nu_k, nu_i, nu_j) = work0 + work1 + work2 + work3
enddo
enddo
endif
enddo
#ifdef __MPI
call mp_sum( d3dyn4, inter_pool_comm )
#endif
d3dyn (:,:,:) = d3dyn(:,:,:) + d3dyn4(:,:,:)
d3dyn_aux8(:,:,:) = d3dyn4(:,:,:)
deallocate (aux)
deallocate (drc_exp)
deallocate (d3dyn0)
deallocate (d3dyn1)
deallocate (d3dyn2)
deallocate (d3dyn3)
deallocate (d3dyn4)
return
end subroutine d3dyn_cc

481
PHonon/D3/d3ionq.f90
View File

@ -1,481 +0,0 @@
!
! Copyright (C) 2010 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 d3ionq (nat, ntyp, ityp, zv, tau, alat, omega, q, at, &
bg, g, gg, ngm, gcutm, nmodes, u, ug0, npert_1, npert_f, q0mode, &
d3dyn)
!-----------------------------------------------------------------------
!
! This routine computes the contribution of the ions to the third order derivative
! of the total energy. Both the real and reciprocal space terms are included.
!
! This version of the routine is general, i.e. it can compute D3^ewald(q1,q2,q3) with
! the only condition q1+q2+q3 = 0. Notice however, that only the case q1=q, q2=-q, q3=0
! has been extensively tested.
!
! Written in February 2010 by L.Paulatto, T.Wassmann and M.Lazzeri
!
! The exact mechanism of this subroutine is quite complicated, a LaTeX form of all
! implemented formulas is reported here for reference and future extensions.
! Note that unit-of-measure dependent factors are missing (they can be derived from the code).
!
! \begin{eqnarray*}
! atom1 & = & \{s_{1}(atom\_index),\tau_{s1}(position),Z_{s1}(charge)\}
! perturbation\_\nu_{1} & = & \{\alpha(cartensian\_direction),s_{1}(atom\_displaced)\}\end{eqnarray*}
! \begin{eqnarray*}
! D_{\nu1,\nu2,\nu3}^{3} & = & \delta_{s3,s1}Z_{s1}Z_{s2}F_{\alpha\beta\gamma}(q_{2},\tau_{s1}-\tau_{s2})
! & + & \delta_{s1,s2}Z_{s2}Z_{s3}F_{\alpha\beta\gamma}(q_{3},\tau_{s2}-\tau_{s3})
! & + & \delta_{s2,s3}Z_{s3}Z_{s1}F_{\alpha\beta\gamma}(q_{1},\tau_{s3}-\tau_{s1})
! & - & \delta_{s1,s2,s3}Z_{s3}\sum_{s'}Z_{s'}F_{\alpha\beta\gamma}(0,\tau_{s3}-\tau_{s'})\end{eqnarray*}
! \begin{eqnarray*}
! F_{\alpha\beta\gamma}(q,\tau) & = & \frac{4\pi e^{2}}{\Omega}e^{i(G+q)\tau}
! \sum_{G}i(G+q)_{\alpha}(G+q)_{\beta}(G+q)_{\gamma}\frac{e^{-(G+q)^{2}/4\eta^{2}}}{(G+q)^{2}}
! & & -e^{2}\sum_{R}e^{iqR}\left.\frac{d^{3}f}{dx_{\alpha}dx_{\beta}dx_{\gamma}}\right|_{x=|\tau-R|}\end{eqnarray*}
! \begin{eqnarray*}
! \frac{d^{3}f(x)}{dx_{\alpha}dx_{\beta}dx_{\gamma}} & = &
! (\delta_{\alpha\beta}x_{\gamma}+\delta_{\alpha\gamma}x_{\beta}+\delta_{\beta\gamma}x_{\alpha})f_{1}(x)
! & & +x_{\alpha}x_{\beta}x_{\gamma}f_{3}(x)\end{eqnarray*}
! \begin{eqnarray*}
! f_{1}(x) &=& \frac{3erfc(\eta x)+a(\eta x)(3+2x^{2}\eta^{2})}{x^{5}}
! f_{3}(x) &=& -\frac{15erfc(\eta x)+a(\eta x)(15+10\eta^{2}x^{2}+4\eta^{4}x^{4})}{x^{7}}
! a(\xi) &=& \frac{2\xi}{\sqrt{\pi}}e^{-\xi^{2}}
! \end{eqnarray*}
!
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE constants, ONLY : e2, tpi, fpi, eps16, eps8
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
!
IMPLICIT NONE
!
! I/O variables
INTEGER,INTENT(IN) :: nat, & ! number of atoms
ntyp, & ! number of types of atoms
ngm, & ! number of G vectors
ityp (nat), & ! type of each atom
nmodes, & ! number of modes
npert_1, & ! only compute perturbations ...
npert_f ! ... npert_1 < n < npert_f
REAL (DP),INTENT(IN) :: tau (3, nat), & ! positions of the atoms
g (3, ngm), & ! coordinates of g vectors
gg (ngm), & ! modulus of g vectors
zv (ntyp), & ! charge of each type
at (3, 3), & ! direct lattice vectors
bg (3, 3), & ! reciprocal lattice vectors
omega, & ! volume of the unit cell
alat, & ! length scale
gcutm, & ! cut-off of g vectors
q (3) ! q vector of perturbation -> D3(q,-q,0)
COMPLEX (DP), INTENT(IN) :: u (3*nat, nmodes), & ! pattern of the modes
ug0 (3*nat, nmodes) ! pattern of the modes (q=0)
COMPLEX (DP), INTENT(INOUT) :: d3dyn (3*nat, nmodes, 3*nat) ! derivative of the dyn. matrix
LOGICAL, INTENT(IN) :: q0mode (300) ! if .true. this mode is to be computed
! Actually: all the modes between npert_1 and npert_f are always computed,
! but only the ones in q0mode are added to the dynamical matrix
!
! Local variables
!
REAL(DP) :: q1(3),q2(3),q3(3) ! three q-vectors of the perturbations
! these will become INPUT parameters in future versions,
! at the moment it is always q1=q, q2=-q, q3=0
REAL(DP),PARAMETER :: gamma(3) = (/ 0._dp, 0._dp, 0._dp /)
INTEGER :: nu_1, nu_2, nu_3, & ! perturbation indexes
a_1, a_2, a_3, & ! xyz indexes
na_1, na_2, na_3, na_p,& ! atom indexes
nc_3cart,na_1cart,nb_2cart! additional indexes for changing to irrep. basis
REAL(DP):: alpha, eta, & ! dumping factor of ewald sum, eta=sqrt(alpha)
upperbound, charge, &! total charge in the cell
dtau(3) ! aux: tau_s1 - tau_s2
INTEGER :: abc(3) ! aux: {\alpha,\beta,\gamma}
REAL (DP), EXTERNAL :: qe_erfc
COMPLEX (DP), ALLOCATABLE :: d3dion (:,:,:), d3dy2 (:,:,:) ! workspace
COMPLEX (DP) :: work ! more workspace
!
! Undefine the following macros to esclude one of the terms
#define _D3_EWALD_G_SPACE
#define _D3_EWALD_REAL_SPACE
!
! Temporary solution: this choice of q1,q2 and q3 reproduces the
! results of the previous code, minus a bug
q1 = 0._dp
q2 = q ! GOOD FOR G-SPACE
q3 = -q
! This alternative choice of q1,q2 and q3 reproduces the "wrong" value of the
! real-space term in the old code (only substantial for alpha < 1.0)
!q1 = q
!q2 = -q ! GOOD FOR R-SPACE
!q3 = 0._dp
!
charge = SUM(zv(ityp(1:nat)))
!
! choose alpha in order to have convergence in the sum over G
! upperbound is an estimate of the error in the sum over G
! (empirical trust!)
!
upperbound = 1._dp
alpha = 2.9_dp
DO WHILE(upperbound > 1.e-9_dp)
alpha = alpha - 0.1d0
IF (alpha <= 0._dp) CALL errore ('d3ion', 'optimal alpha not found', 1)
upperbound = 2 * charge**2 * SQRT(2 * alpha / tpi) &
* qe_erfc( SQRT((tpi/alat)**2 * gcutm / 4 / alpha) )
ENDDO
!
eta = SQRT(alpha)
WRITE( stdout, '(/5x,"Alpha used in Ewald sum = ",f6.2)') alpha
!
ALLOCATE (d3dion( 3 * nat, nmodes, 3 * nat))
d3dion (:,:,:) = (0.d0, 0.d0)
!
DO na_1 = 1,nat
loop_a : &
DO a_1 = 1,3
nu_1 = a_1 + (na_1-1)*3
!
! Inefficient but simple way to do only a subset of the perturbations
! (note: when nu_1 > npert_f BREAK would work as well)
IF (nu_1 < npert_1 .or. nu_1 > npert_f) THEN
CYCLE loop_a
ENDIF
!
DO na_2 = 1,nat
DO a_2 = 1,3
nu_2 = a_2 + (na_2-1)*3
!
DO na_3 = 1,nat
DO a_3 = 1,3
nu_3 = a_3 + (na_3-1)*3
!
! abc (read alpha-beta-gamma) is a list of the polarization
! for the three modes involved
abc = (/ a_1,a_2,a_3 /)
!
! delta_s1,s3
IF (na_1==na_3) THEN
dtau = tau(:,na_2) - tau(:,na_1) ! tau_s2 - tau_s1
work = zv(ityp(na_1)) * zv(ityp(na_2)) & ! z_s1 * z_s2
* F_abc(q2,dtau,abc,eta)
!
d3dion(nu_1, nu_2, nu_3) = d3dion(nu_1, nu_2, nu_3) &
+ work
ENDIF
!
! delta_s1,s2
IF (na_1==na_2) THEN
dtau = tau(:,na_3) - tau(:,na_2) ! tau_s3 - tau_s2
work = zv(ityp(na_2)) * zv(ityp(na_3)) & ! z_s2 * z_s3
* F_abc(q3,dtau,abc,eta)
!
d3dion(nu_1, nu_2, nu_3) = d3dion(nu_1, nu_2, nu_3) &
+ work
ENDIF
!
! delta_s2,s3
IF (na_2==na_3) THEN
dtau = tau(:,na_1) - tau(:,na_3) ! tau_s1 - tau_s3
work = zv(ityp(na_3)) * zv(ityp(na_1)) & ! z_s3 * z_s1
* F_abc(q1,dtau,abc,eta)
!
d3dion(nu_1, nu_2, nu_3) = d3dion(nu_1, nu_2, nu_3) &
+ work
ENDIF
!
! delta_s1,s3,s3
IF (na_1==na_2.and.na_2==na_3) THEN
DO na_p = 1,nat
dtau = tau(:,na_3) - tau(:,na_p) ! tau_s3 - tau_sp
work = zv(ityp(na_3)) * zv(ityp(na_p)) & ! z_s3 * z_sp
* F_abc(gamma,dtau,abc,eta)
!
d3dion(nu_1, nu_2, nu_3) = d3dion(nu_1, nu_2, nu_3) &
+ work
ENDDO
ENDIF
!
ENDDO !a_3
ENDDO !na_3
!
ENDDO !a_2
ENDDO !na_2
!
ENDDO loop_a !a_1
ENDDO !na_1
!
#ifdef __MPI
! in the parallel case, recollect the modes
CALL mp_sum( d3dion, intra_pool_comm )
CALL mp_sum( d3dion, inter_pool_comm )
#endif
!
! The dynamical matrix was computed in cartesian axis, now it is
! put on the basis of the modes; d3dy2 used as working array
!
ALLOCATE(d3dy2( 3*nat, nmodes, 3*nat))
d3dy2 (:,:,:) = (0.d0, 0.d0)
DO nu_3 = npert_1, npert_f
!
IF (q0mode (nu_3) ) THEN
!
DO nu_1 = 1, 3 * nat
DO nu_2 = 1, 3 * nat
!
work = (0.d0, 0.d0)
!
DO nc_3cart = 1, 3 * nat
DO na_1cart = 1, 3 * nat
DO nb_2cart = 1, 3 * nat
work = work + ug0 (nc_3cart, nu_3) &
* CONJG(u (na_1cart, nu_1) ) &
* d3dion (nc_3cart, na_1cart, nb_2cart) &
* u (nb_2cart, nu_2)
ENDDO
ENDDO
ENDDO
!
d3dy2 (nu_3, nu_1, nu_2) = work
!
ENDDO
ENDDO
!
ENDIF
!
ENDDO
!
#ifdef __MPI
CALL mp_sum ( d3dy2, inter_pool_comm )
#endif
!
! For debugging purposes (to be removed), the Ewald contribution
! can be dumped to file (uncomment the lines that apply).
! 1. using internal debugging subroutine
! CALL writed3dyn_5(d3dy2,'d3qewald',-1)
! 2. using iotk
! CALL iotk_write_dat(1077, 'd3ionq', d3dy2)
! 3. by hand, the old way
! open(unit=1077, file='d3ionq-n.xml', action='write', status='unknown')
! do a_1 = 1,3*nat
! do a_2 = 1,3*nat
! do a_3 = 1,3*nat
! write(1077, '(3i4,2f32.16)') a_1, a_2, a_3, d3dy2(a_1,a_2,a_3)
! enddo
! enddo
! enddo
! close(1077)
!
! Add the Ewald term to the rest of D3 matrix
d3dyn = d3dyn+d3dy2
!
DEALLOCATE (d3dion, d3dy2)
!
RETURN
!-----------------------------------------------------------------------
CONTAINS
!-------------------------------------------------------------------
!
! dumping factor of Ewald sum
! 2/sqrt(pi) eta*x exp(-eta**2 x**2)
!-----------------------------------------------------------------------
FUNCTION a_fct(xeta)
!-------------------------------------------------------------------
USE constants, ONLY : sqrtpm1 ! 1/sqrt(pi)
IMPLICIT NONE
REAL(DP) :: a_fct
REAL(DP),INTENT(IN) :: xeta
a_fct = 2*sqrtpm1*xeta*exp(-(xeta)**2)
! note: 2*sqrtpm1 == 2/sqrt(pi) == sqrt (8.d0 / tpi) <- from old code
END FUNCTION
!
! Used by d3f_abc, it's (related to) the second derivative of erfc function
! f1
!-----------------------------------------------------------------------
FUNCTION d2f_fct(xx, eta)
!-------------------------------------------------------------------
IMPLICIT NONE
REAL(DP) :: d2f_fct
REAL(DP),INTENT(IN) :: xx, eta
REAL(DP) :: xeta
REAL(DP), EXTERNAL :: qe_erfc
xeta = xx*eta
!
d2f_fct = 3._dp*qe_erfc(xeta) + a_fct(xeta)*(3._dp + 2*(xeta**2))
d2f_fct = d2f_fct/xx**5
END FUNCTION
!
! Used by d3f_abc, it's (related to) the third derivative of erfc function
! f3
!-----------------------------------------------------------------------
FUNCTION d3f_fct(xx, eta)
!-------------------------------------------------------------------
IMPLICIT NONE
REAL(DP) :: d3f_fct
REAL(DP),INTENT(IN) :: xx, eta
REAL(DP) :: xeta, xeta2
REAL(DP), EXTERNAL :: qe_erfc
xeta = xx*eta
xeta2 = xeta**2
d3f_fct = 15._dp*qe_erfc(xeta) &
+ a_fct(xeta)*(15._dp + 10._dp*xeta2 + 4*(xeta2**2))
d3f_fct = -d3f_fct/xx**7
END FUNCTION
!
! Used for real-space term
! d3f(x)/dx_a dx_b dx_c
!-----------------------------------------------------------------------
FUNCTION d3f_abc(x, xx, abc, eta)
!-------------------------------------------------------------------
IMPLICIT NONE
REAL(DP) :: d3f_abc
REAL(DP),INTENT(IN) :: x(3), xx, eta
INTEGER,INTENT(IN) :: abc(3)
!
REAL(DP) :: delta3 ! delta_{a,b} x_c + delta_{a,c} x_b + delta_{b,c} x_a
REAL(DP) :: xa_xb_xc ! x_a * x_b * x_c
!
d3f_abc=0._dp
!
!
delta3 = 0._dp
IF(abc(1)==abc(2)) delta3 = delta3 + x(abc(3))
IF(abc(2)==abc(3)) delta3 = delta3 + x(abc(1))
IF(abc(3)==abc(1)) delta3 = delta3 + x(abc(2))
delta3 = delta3*alat
!
IF( ABS(delta3) > eps16) THEN
d3f_abc = d3f_abc + delta3*d2f_fct(xx, eta)
ENDIF
!
!
xa_xb_xc = x(abc(1))*x(abc(2))*x(abc(3))*alat**3
!
IF( ABS(xa_xb_xc) > eps16) THEN
d3f_abc = d3f_abc + xa_xb_xc*d3f_fct(xx, eta)
ENDIF
!
END FUNCTION
!
!
!-----------------------------------------------------------------------
FUNCTION F_abc(q,tau,abc,eta)
!-------------------------------------------------------------------
USE constants, ONLY : tpi, fpi, e2, eps8
USE mp_global, ONLY : nproc_image, me_image, intra_image_comm
IMPLICIT NONE
COMPLEX(DP) :: F_abc
REAL(DP),INTENT(IN) :: q(3), tau(3), eta
INTEGER, INTENT(IN) :: abc(3)
COMPLEX(DP),PARAMETER :: ii = (0._dp, 1._dp), &
zero = (0._dp, 0._dp), &
one = (1._dp, 0._dp)
!
REAL(DP) :: prefG, facq ! prefactors for G-space term
REAL(DP) :: Gpq_abc
REAL(DP) :: Gpq_tau
INTEGER :: ng
!
INTEGER,PARAMETER :: mxr = 100 ! max number of neighbours
REAL(DP) :: r (3,mxr), r2 (mxr) ! shells of neighbours (r and r**2)
REAL(DP) :: rr ! sqrt(r2)*alat
REAL(DP) :: rmax ! radius containg the shells of ngbrs
INTEGER :: nrm, nr ! number of neighbours in teh shell, and their index
INTEGER :: nr_s, nr_e, mykey ! used to parallelize r-space sum
COMPLEX(DP) :: facr
REAL(DP) :: qdr ! q*g
REAL(DP) :: gtq2 ! (g+q)**2 (atomic units)
!
! First part: the reciprocal space term
!
F_abc = zero
prefG = fpi * e2 * (tpi/alat)**3 / omega
!
#ifdef _D3_EWALD_G_SPACE
!
sum_on_G : &
DO ng = 1, ngm
!
Gpq_abc = ( g(abc(1), ng) + q(abc(1)) ) &
* ( g(abc(2), ng) + q(abc(2)) ) &
* ( g(abc(3), ng) + q(abc(3)) )
!
! Skip null terms
IF (ABS(Gpq_abc) < eps8) &
CYCLE sum_on_G
!
gtq2 = ( (g(1, ng) + q(1)) **2 &
+ (g(2, ng) + q(2)) **2 &
+ (g(3, ng) + q(3)) **2 ) * (tpi/alat) **2
!
facq = Gpq_abc * prefG * EXP( - gtq2 / eta**2 / 4._dp) / gtq2
!
Gpq_tau = tpi *( ( g(1, ng) + q(1) ) * tau(1) &
+ ( g(2, ng) + q(2) ) * tau(2) &
+ ( g(3, ng) + q(3) ) * tau(3) )
!
F_abc = F_abc - ii*facq* EXP(ii*Gpq_tau)
!
ENDDO sum_on_G
!
#endif
! print*, " nrm",nrm
#ifdef _D3_EWALD_REAL_SPACE
!
! Second part: the real space term
!
rmax = 5.d0 / eta / alat
CALL rgen (tau, rmax, mxr, at, bg, r, r2, nrm)
! note: r = R - tau : R is a real-space cell vector
!
! In some cases the real-space term does not include any term
IF( nrm>0 ) THEN
!
! Parallelize the real space sum, it will hardly give any performance
! improvement, but cannot hurt (alternatively this term must be computed
! by one processor only, i.e. ionode)
CALL block_distribute( nrm, me_image, nproc_image, nr_s, nr_e, mykey )
!
! If we have more CPUs than nrm some will do nothing
IF(mykey==0)THEN
sum_on_R : &
DO nr = nr_s, nr_e
rr = SQRT(r2(nr)) * alat
qdr = tpi * ( q (1) * (r(1, nr) + tau (1)) &
+ q (2) * (r(2, nr) + tau (2)) &
+ q (3) * (r(3, nr) + tau (3)) )
!
IF (ABS(qdr) < eps16) THEN
facr = - e2*one
ELSE
facr = - e2*CMPLX(cos(qdr), sin(qdr), kind=DP)
ENDIF
!
F_abc = F_abc + facr*d3f_abc(r(1:3,nr),rr,abc,eta)
!
ENDDO sum_on_R
ENDIF
!
ENDIF
!
#endif
!
RETURN
!
END FUNCTION F_abc
END SUBROUTINE d3ionq

69
PHonon/D3/d3matrix.f90
View File

@ -1,69 +0,0 @@
!
! Copyright (C) 2001-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 d3matrix
!-----------------------------------------------------------------------
!
! This routine is driver which computes the symmetrized derivative
! of the dynamical matrix at q and in the star of q.
! The result is written on a iudyn file
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp, tau, atm, amass
USE run_info, ONLY : title
USE kinds, only : DP
use pwcom
USE symm_base, ONLY : s, irt, invs
USE qpoint, ONLY : xq
use phcom
use d3com
USE lr_symm_base, ONLY : nsymq, minus_q, irotmq, irgq, rtau
implicit none
integer :: nq, isq (48), imq, na, nt, j
! degeneracy of the star of q
! index of q in the star of a given sym.op.
! index of -q in the star of q (0 if not present)
! counter on atoms
! counter on atomic type
! generic counter
real (DP) :: sxq (3, 48)
! list of vectors in the star of q
!
! Symmetrizes the dynamical matrix w.r.t. the small group of q
!
call d3_symdyn (d3dyn, u, ug0, xq, s, invs, rtau, irt, irgq, at, &
bg, nsymq, nat, irotmq, minus_q, npert_i, npert_f)
!
! Generates the star of q
!
call star_q (xq, at, bg, nsymg0, s, invs, nq, sxq, isq, imq, .TRUE.)
!
! Write on file information on the system
!
write (iudyn, '("Derivative of the force constants")')
write (iudyn, '(a)') title
write (iudyn, '(i3,i5,i3,6f11.7)') ntyp, nat, ibrav, celldm
do nt = 1, ntyp
write (iudyn, * ) nt, " '", atm (nt) , "' ", amass (nt)
enddo
do na = 1, nat
write (iudyn, '(2i5,3f15.7)') na, ityp (na) , (tau (j, na) , j = &
1, 3)
enddo
!
! Rotates and writes on iudyn the dyn.matrix derivative of the star of q
!
call qstar_d3 (d3dyn, at, bg, nat, nsymg0, s, invs, irt, rtau, nq, &
sxq, isq, imq, iudyn, wrmode)
return
end subroutine d3matrix

297
PHonon/D3/d3toten.f90
View File

@ -1,297 +0,0 @@
!
! 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 .
!
!
!-----------------------------------------------------------------------
program d3toten
!-----------------------------------------------------------------------
!
use pwcom
use phcom
use d3com
USE ions_base, ONLY : nat, ityp, ntyp => nsp, zv, tau
USE io_global, ONLY : stdout
use io_files, ONLY : prefix
use control_flags, ONLY : gamma_only
USE mp_global, ONLY : mp_startup
USE environment, ONLY : environment_start
use qpoint, ONLY : xq
use control_lr, ONLY : lgamma
implicit none
character(len=9) :: cdate, ctime, code = 'D3TOTEN'
integer :: nu_i, nu_i0, irecv
real (DP) :: t0, t1, get_clock
!
!
gamma_only = .false.
all_done=.false.
!
! Initialize MPI, clocks, print initial messages
!
#ifdef __MPI
CALL mp_startup ( )
#endif
CALL environment_start ( code )
!
! Initialization routines
!
call d3_readin
call allocate_d3
call d3_setup
call d3_summary
call openfild3
call d3_init
call print_clock ('D3TOTEN')
!
! Used for testing purposes: if wraux=.true. it writes
! different terms of the third derivative matrix in different files.
!
if (wraux) call write_aux (1)
d3dyn(:,:,:) = (0.d0, 0.d0)
!
nu_i0 = 1
if (recv) then
!
! If recv.eq.true. this is a recover run
!
call d3_recover (irecv, - 1)
WRITE( stdout, * ) ' Recover Run index:', irecv
if (irecv.ge.401.and.irecv.lt.499) then
nu_i0 = irecv - 400
goto 304
else
goto (301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, &
312, 313) irecv
endif
endif
!
! Non-selfconsistent calculation of the wavefunctions
!
write( stdout, '(/,5x,"Nscf calculating of the perturbed wavefunctions")')
!
! It calculates the variation of wavefunctions | d/du(q) psi(k) >
!
t0 = get_clock ('D3TOTEN')
if (.not.lgamma) then
! WRITE( stdout, '(/,5x,"calling gen_dwfc(1)")')
write( stdout, '(/,5x,"Calculating for the wavevector q")')
call gen_dwfc (1)
call d3_recover (1, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"gen_dwfc(1) cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
endif
if (istop.eq.1) stop
!
! It calculates the variation of wavefunctions | d/du(q=0) psi(k) >
!
301 continue
! WRITE( stdout, '(/,5x,"calling gen_dwfc(3)")')
write( stdout, '(/,5x,"Calculating for the wavevector q=0 at the original k-points")')
call gen_dwfc (3)
call d3_recover (2, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"gen_dwfc(3) cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (istop.eq.2) stop
!
! It calculates the variation of wavefunctions | d/du(q=0) psi(k+q) >
! to be used for the terms < dpsi | dpsi ><psi| dH |psi>
!
302 continue
if (.not.lgamma) then
write( stdout, '(/,5x,"Calculating for the wavevector q=0 at the (k+q)-points")')
WRITE( stdout, '(/,5x,"calling gen_dwfc(2)")')
call gen_dwfc (2)
call d3_recover (3, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"gen_dwfc(2) cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
endif
write( stdout, '(/,5x,"Finished the ncf calculation of the perturbed wavefunctions")')
if (istop.eq.3) stop
!
! It writes on files terms of the type: <dpsi| dH | psi>, that
! will be used for the metallic case
!
303 continue
WRITE( stdout, '(/,5x,"calling gen_dpdvp")')
call gen_dpdvp
call d3_recover (4, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"gen_dpdvp cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (istop.eq.4) stop
!
! It calculates the term < dpsi| dH | dpsi >
!
304 continue
WRITE( stdout, '(/,5x,"Calculating the matrix elements <dpsi |dH |dpsi>")')
do nu_i = nu_i0, 3 * nat
if (q0mode (nu_i) ) then
WRITE( stdout, '(/,5x,"calling dpsidvdpsi:",i3)') nu_i
call dpsidvdpsi (nu_i)
call d3_recover (401 + nu_i, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"dpsidvdpsi",i3," cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') nu_i, t1, t0
if (istop.gt.400.and.nu_i.eq. (istop - 400) ) stop
endif
enddo
call d3_recover (5, + 1)
if (istop.eq.5) stop
!
! It calculates the term < dpsi| dpsi > < psi | dH | psi>
!
305 continue
WRITE( stdout, '(/,5x,"Calculating the matrix elements <dpsi|dpsi>< psi|dH|psi> ")')
WRITE( stdout, '(/,5x,"calling dpsidpsidv")')
call dpsidpsidv
call d3_recover (6, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"dpsidpsidv cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (istop.eq.6) stop
!
! It calculates the term drho * d2V
!
306 continue
WRITE( stdout, '(/,5x,"Calculating the matrix elements <psi |d^2 v |dpsi>")')
WRITE( stdout, '(/,5x,"calling drhod2v")')
call drhod2v
call d3_recover (7, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"drhod2v cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (istop.eq.7) stop
!
! It calculates the term rho * d3V
!
307 continue
WRITE( stdout, '(/,5x,"Calculating the matrix elements <psi |d^3v |psi>")')
WRITE( stdout, '(/,5x,"calling d3vrho")')
call d3vrho
call d3_recover (8, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"d3vrho cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (istop.eq.8) stop
!
! It calculates the contribution due to ionic term
!
308 continue
WRITE( stdout, '(/,5x,"Calculating the Ewald contribution")')
WRITE( stdout, '(/,5x,"calling d3ionq")')
call d3ionq (nat, ntyp, ityp, zv, tau, alat, omega, xq, at, bg, g, &
gg, ngm, gcutm, nmodes, u, ug0, npert_i, npert_f, q0mode, d3dyn)
call d3_recover (9, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"d3ionq cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (istop.eq.9) stop
!
! In the metallic case some additional terms are needed
!
309 continue
WRITE( stdout, '(/,5x,"Calculating the valence contribution")')
WRITE( stdout, '(/,5x,"calling d3_valence")')
call d3_valence
call d3_recover (10, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"d3_valence cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (istop.eq.10) stop
!
! drho_cc(+1) adds to the variation or the charge -written on a file-
! the variation of the core charge. The variation of the charge,
! modified this way is used by the routines d3_exc and d3dyn_cc.
! drho_cc(-1) restores drho as it was before (useless)
!
310 continue
WRITE( stdout, '(/,5x,"calling drho_cc(+1)")')
call drho_cc ( + 1)
call d3_recover (11, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"drho_cc(+1) cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
!
! It calculates d3Ei * drho * drho * drho, where drho is the variation
! of the charge and d3Ei is the third derivative of the
! Kohn-Sham-Energy term depending on the charge density.
!
311 continue
WRITE( stdout, '(/,5x,"Calculating the exchange-correlation contribution")')
WRITE( stdout, '(/,5x,"calling d3_exc")')
call d3_exc
call d3_recover (12, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"d3_exc cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
!
! It calculates additional terms due to non_linear-core-corrections
!
312 continue
WRITE( stdout, '(/,5x,"Calculating the core-correction contribution")')
WRITE( stdout, '(/,5x,"calling d3dyn_cc")')
call d3dyn_cc
call d3_recover (13, + 1)
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"d3dyn_cc cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
!
! drho is restored as it was before
!
! WRITE( stdout,'(/,5x,"calling drho_cc(-1)")')
! call drho_cc(-1)
! t1 = get_clock('D3TOTEN') - t0
! t0 = get_clock('D3TOTEN')
! WRITE( stdout,'(5x,"drho_cc(-1) time: ",f12.2,
! + " sec Total time:",f12.2," sec")') t1,t0
if (wraux) call write_aux (2)
!
! Symmetrizes d3dyn, calculates the q in the star and writes the result
! for every q on a file.
!
313 continue
WRITE( stdout, '(/,5x,"Symmetrizing and writing the tensor to disc")')
WRITE( stdout, '(/,5x,"calling d3matrix")')
call d3matrix
t1 = get_clock ('D3TOTEN') - t0
t0 = get_clock ('D3TOTEN')
WRITE( stdout, '(5x,"d3matrix cpu time:",f9.2, &
& " sec Total time:",f12.2," sec")') t1, t0
if (wraux) call write_aux (3)
call stop_d3 (.true.)
end program d3toten

199
PHonon/D3/d3vrho.f90
View File

@ -1,199 +0,0 @@
!
! Copyright (C) 2001-2006 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 d3vrho()
!-----------------------------------------------------------------------
!
! This routine calculates the electronic term: <psi|V"'|psi>
! of the third order dynamical matrix.
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE ions_base, ONLY : nat, ityp, ntyp => nsp, tau
USE uspp, ONLY : dvan
USE scf, ONLY : rho
USE gvect, ONLY : g, ngm, nl, igtongl
USE wvfct, ONLY : npw, npwx, nbnd, igk, wg
USE vlocal, ONLY : vloc
USE klist, ONLY : xk
USE cell_base, ONLY : omega, tpiba, tpiba2
USE uspp_param, ONLY : nh
USE wavefunctions_module, ONLY : evc
USE io_files, ONLY : iunigk
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE phcom
USE d3com
USE qpoint, ONLY : nksq, npwq, igkq
USE control_lr, ONLY : nbnd_occ, lgamma
!
implicit none
integer :: icart, jcart, kcart, na_i, na_j, na_k, na, ng, ir, nt, &
ik, ikk, ig, ibnd, ikb, jkb, ios, igg, ia
! counters
real (DP) :: gtau, fac, wgg
! the product G*\tau_s
! auxiliary variable
! the true weight of a K point
complex (DP) :: alpha (8), zdotc, work
complex (DP), allocatable :: d3dynwrk (:,:,:), d3dynwrk2 (:,:,:), &
rhog (:), work1 (:,:), work2 (:,:), work3 (:)
allocate (rhog( dfftp%nnr))
allocate (d3dynwrk( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dynwrk2(3 * nat, 3 * nat, 3 * nat))
allocate (work1( npwx, 3))
allocate (work2( npwx, 3))
allocate (work3( npwx))
d3dynwrk (:,:,:) = (0.d0, 0.d0)
do ir = 1, dfftp%nnr
rhog (ir) = CMPLX(rho%of_r (ir, 1), 0.d0,kind=DP)
enddo
CALL fwfft ('Dense', rhog, dfftp)
!
! Contribution deriving from the local part of the potential
!
do na_i = npert_i, npert_f
na = (na_i - 1) / 3 + 1
icart = na_i - 3 * (na - 1)
do jcart = 1, 3
na_j = 3 * (na - 1) + jcart
do kcart = 1, 3
na_k = 3 * (na - 1) + kcart
do ng = 1, ngm
gtau = tpi * (g (1, ng) * tau (1, na) + g (2, ng) * tau (2, na) &
+ g (3, ng) * tau (3, na) )
fac = vloc (igtongl (ng), ityp (na) ) * tpiba2 * tpiba * omega *&
(DBLE (rhog (nl (ng) ) ) * sin (gtau) + &
AIMAG (rhog (nl (ng) ) ) * cos (gtau) )
d3dynwrk (na_i, na_j, na_k) = d3dynwrk (na_i, na_j, na_k) + &
fac * g (icart, ng) * g (jcart, ng) * g (kcart, ng)
enddo
enddo
enddo
enddo
#ifdef __MPI
call mp_sum ( d3dynwrk, intra_pool_comm )
#endif
!
! Non local Kleinman-Bylander potential contribution
!
rewind (unit = iunigk)
do ik = 1, nksq
read (iunigk, err = 100, iostat = ios) npw, igk
if (lgamma) then
ikk = ik
else
read (iunigk, err = 200, iostat = ios) npwq, igkq
ikk = 2 * ik - 1
endif
100 call errore ('d3vrho', 'reading igk', abs (ios) )
200 call errore ('d3vrho', 'reading igkq', abs (ios) )
call davcio (evc, lrwfc, iuwfc, ikk, - 1)
call init_us_2 (npw, igk, xk (1, ikk), vkb0)
do kcart = 1, 3
do icart = 1, 3
do jcart = 1, 3
do ibnd = 1, nbnd_occ (ikk)
wgg = wg (ibnd, ikk)
do ig = 1, npw
work3 (ig) = evc (ig, ibnd) * tpiba * g (icart, igk (ig) )&
* tpiba * g (jcart, igk (ig) ) * tpiba * g (kcart, igk (ig) )
work2 (ig, 1) = evc (ig, ibnd) * tpiba * g (icart, igk (ig) ) &
* tpiba * g (jcart, igk (ig) )
work2 (ig, 2) = evc (ig, ibnd) * tpiba * g (jcart, igk (ig) ) &
* tpiba * g (kcart, igk (ig) )
work2 (ig, 3) = evc (ig, ibnd) * tpiba * g (kcart, igk (ig) ) &
* tpiba * g (icart, igk (ig) )
work1 (ig, 1) = evc (ig, ibnd) * tpiba * g (kcart, igk (ig) )
work1 (ig, 2) = evc (ig, ibnd) * tpiba * g (icart, igk (ig) )
work1 (ig, 3) = evc (ig, ibnd) * tpiba * g (jcart, igk (ig) )
enddo
jkb=0
do nt = 1, ntyp
do na = 1, nat
if (ityp (na) == nt) then
na_k = 3 * (na - 1) + kcart
na_i = 3 * (na - 1) + icart
na_j = 3 * (na - 1) + jcart
do ikb = 1, nh (nt)
jkb=jkb+1
alpha (1) = zdotc (npw, work3, 1, vkb0(1,jkb), 1)
alpha (2) = zdotc (npw, vkb0(1,jkb), 1, evc (1, ibnd), 1)
alpha (3) = zdotc (npw,work1(1, 1),1,vkb0(1,jkb),1)
alpha (4) = zdotc (npw,vkb0(1,jkb),1,work2(1, 1),1)
alpha (5) = zdotc (npw,work1(1, 2),1,vkb0(1,jkb),1)
alpha (6) = zdotc (npw,vkb0(1,jkb),1,work2(1, 2),1)
alpha (7) = zdotc (npw,work1(1, 3),1,vkb0(1,jkb),1)
alpha (8) = zdotc (npw,vkb0(1,jkb),1,work2(1, 3),1)
#ifdef __MPI
call mp_sum ( alpha, intra_pool_comm )
#endif
d3dynwrk (na_k, na_i, na_j) = d3dynwrk (na_k, na_i, na_j) - &
2.0d0 * dvan(ikb,ikb,nt) * wgg * &
AIMAG(alpha(1)*alpha(2) + alpha(3)*alpha(4) +&
alpha(5)*alpha(6) + alpha(7)*alpha(8))
enddo
endif
enddo
enddo
enddo
enddo
enddo
enddo
enddo
#ifdef __MPI
call mp_sum( d3dynwrk, inter_pool_comm )
#endif
!
! The dynamical matrix was computed in cartesian axis and now we put
! it on the basis of the modes
!
d3dynwrk2(:,:,:) = (0.d0, 0.d0)
do na_k = npert_i, npert_f
if (q0mode (na_k) ) then
do na_i = 1, 3 * nat
do na_j = 1, 3 * nat
work = (0.d0, 0.d0)
do kcart = 1, 3 * nat
do icart = 1, 3 * nat
do jcart = 1, 3 * nat
work = work + ug0 (kcart, na_k) * CONJG(u (icart, na_i) ) &
* d3dynwrk (kcart, icart, jcart) * u (jcart, na_j)
enddo
enddo
enddo
d3dynwrk2 (na_k, na_i, na_j) = work
enddo
enddo
endif
enddo
#ifdef __MPI
call mp_sum( d3dynwrk2, inter_pool_comm )
#endif
d3dyn (:,:,:) = d3dyn (:,:,:) + d3dynwrk2 (:,:,:)
d3dyn_aux1(:,:,:) = d3dynwrk2 (:,:,:)
deallocate (work1)
deallocate (work2)
deallocate (work3)
deallocate (d3dynwrk2)
deallocate (d3dynwrk)
deallocate (rhog)
return
end subroutine d3vrho

73
PHonon/D3/davcio_drho2.f90
View File

@ -1,73 +0,0 @@
!
! Copyright (C) 2001 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 davcio_drho2 (drho, lrec, iunit, nrec, isw)
!-----------------------------------------------------------------------
!
! reads/writes variation of the charge with respect to a perturbation
! on a file.
! isw = +1 : gathers data from the nodes and writes on a single file
! isw = -1 : reads data from a single file and distributes them
!
USE pwcom
USE kinds, ONLY : DP
USE phcom
USE io_global, ONLY : ionode_id, ionode
USE mp_global, ONLY : intra_pool_comm, inter_pool_comm, me_pool, root_pool
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : world_comm
USE fft_base, ONLY : dfftp
USE scatter_mod, ONLY : gather_grid
!
IMPLICIT NONE
!
INTEGER :: iunit, lrec, nrec, isw
COMPLEX(DP) :: drho (dfftp%nnr)
#ifdef __MPI
!
! local variables
!
INTEGER :: root, errcode, itmp, proc
COMPLEX(DP), ALLOCATABLE :: ddrho (:)
ALLOCATE (ddrho( dfftp%nr1x*dfftp%nr2x*dfftp%nr3x))
IF (isw == 1) THEN
!
! First task of the pool gathers and writes in the file
!
CALL gather_grid (dfftp, drho, ddrho)
root = 0
CALL mp_barrier( world_comm )
IF ( ionode ) CALL davcio (ddrho, lrec, iunit, nrec, + 1)
ELSEIF (isw < 0) THEN
!
! First task of the pool reads ddrho, and broadcasts to all the
! processors of the pool
!
IF ( ionode ) CALL davcio (ddrho, lrec, iunit, nrec, - 1)
CALL mp_bcast( ddrho, ionode_id, inter_pool_comm )
CALL mp_bcast( ddrho, root_pool, intra_pool_comm )
!
! Distributes ddrho between between the tasks of the pool
!
itmp = 1
DO proc = 1, me_pool
itmp = itmp + dfftp%nnp * dfftp%npp (proc)
ENDDO
drho (:) = (0.d0, 0.d0)
CALL zcopy (dfftp%nnp * dfftp%npp (me_pool+1), ddrho (itmp), 1, drho, 1)
ENDIF
DEALLOCATE(ddrho)
#else
CALL davcio (drho, lrec, iunit, nrec, isw)
#endif
RETURN
END SUBROUTINE davcio_drho2

87
PHonon/D3/dpsi_corr.f90
View File

@ -1,87 +0,0 @@
!
! Copyright (C) 2001 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 dpsi_corr (evcq, psidvpsi_x, ik, ikq, nu)
!-----------------------------------------------------------------------
! Used in the metallic case.
! If dpsi common variable contains the projection on the conduction
! states of the first variation of a wavefunction at a given k-point,
! this routine corrects dpsi in such a way that the density matrix
! is given by: Sum_{k,nu} 2 * | dpsi > < psi |
!
USE kinds, only : DP
use pwcom
use qpoint, ONLY: npwq
use control_lr, ONLY : nbnd_occ
use phcom
use d3com
implicit none
integer :: ik, ikq, nu, ibnd, jbnd
! index of the k-point under consideration
! index of the corresponding k+q point
! mode under consideration
! counter on bands
! counter on bands
real (DP) :: wfshift, wgauss, w0gauss, deltae, wg1, wg2, wwg
! the shift coefficent for the wave function
! function computing the theta function
! function computing the derivative of theta
! difference of energy
! weight for metals
! weight for metals
! weight for metals
complex (DP) :: evcq (npwx, nbnd), psidvpsi_x (nbnd, nbnd), &
psidvpsi
! k+q point wavefunction
! < psi_{k+q} | V(q) | psi_k >
!
! Multiplies dpsi by the theta function
!
do ibnd = 1, nbnd
wg1 = wgauss ( (ef - et (ibnd, ik) ) / degauss, ngauss)
call dscal (2 * npwq, wg1, dpsi (1, ibnd), 1)
enddo
!
! Adds to dpsi the term containing the valence wavefunctions
!
do ibnd = 1, nbnd
do jbnd = 1, nbnd
deltae = et (ibnd, ik) - et (jbnd, ikq)
if (abs (deltae) .gt.1.0d-5) then
wg1 = wgauss ( (ef - et (ibnd, ik) ) / degauss, ngauss)
wg2 = wgauss ( (ef - et (jbnd, ikq) ) / degauss, ngauss)
wwg = (wg1 - wg2) / deltae
else
wwg = - w0gauss ( (ef - et (ibnd, ik) ) / degauss, ngauss) &
/ degauss
endif
psidvpsi = 0.5d0 * wwg * psidvpsi_x (jbnd, ibnd)
call zaxpy (npwq, psidvpsi, evcq (1, jbnd), 1, dpsi (1, ibnd), &
1)
enddo
enddo
!
! If necessary corrects dpsi with a term depending on FermiEnergy shift
!
if (ik.eq.ikq) then
do ibnd = 1, nbnd_occ (ik)
wfshift = 0.5d0 * ef_sh (nu) * w0gauss ( (ef - et (ibnd, ik) ) &
/ degauss, ngauss) / degauss
call daxpy (2 * npw, wfshift, evcq (1, ibnd), 1, dpsi (1, ibnd) &
, 1)
enddo
endif
return
end subroutine dpsi_corr

233
PHonon/D3/dpsidpsidv.f90
View File

@ -1,233 +0,0 @@
!
! Copyright (C) 2001 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 dpsidpsidv
!-----------------------------------------------------------------------
!
USE ions_base, ONLY : nat
USE kinds, only : DP
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
use pwcom
use phcom
use d3com
use qpoint, ONLY : nksq, npwq
use control_lr, ONLY : lgamma
implicit none
integer :: ik, ikk, ikq, ibnd, jbnd, nu_i, nu_j, nu_z, nrec
real (DP) :: wgauss, wga (nbnd), wgq (nbnd), w0gauss, w0g (nbnd), &
deltae, wg1, wg2, wwg
complex (DP) :: wrk, wrk0, zdotc
complex (DP), allocatable :: dqpsi (:,:), ps1_ij (:,:), ps1_ji (:,:),&
ps3_ij (:,:), ps2_ji (:,:), d3dyn1 (:,:,:), d3dyn2 (:,:,:),&
d3dyn3 (:,:,:)
allocate (dqpsi( npwx, nbnd))
if (degauss /= 0.d0) then
allocate (ps1_ij( nbnd, nbnd))
allocate (ps1_ji( nbnd, nbnd))
allocate (ps3_ij( nbnd, nbnd))
allocate (ps2_ji( nbnd, nbnd))
endif
allocate (d3dyn1( 3 * nat, 3 * nat, 3 * nat))
if (.not.allmodes) then
allocate (d3dyn2( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn3( 3 * nat, 3 * nat, 3 * nat))
endif
d3dyn1 (:,:,:) = (0.d0, 0.d0)
if (.not.allmodes) then
d3dyn2 (:,:,:) = (0.d0, 0.d0)
d3dyn3 (:,:,:) = (0.d0, 0.d0)
endif
do ik = 1, nksq
if (lgamma) then
ikk = ik
ikq = ik
else
ikk = 2 * ik - 1
ikq = 2 * ik
endif
if (degauss /= 0.d0) then
do ibnd = 1, nbnd
wga (ibnd) = wgauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss)
wgq (ibnd) = wgauss ( (ef - et (ibnd, ikq) ) / degauss, ngauss)
w0g (ibnd) = w0gauss ( (ef - et (ibnd, ikk) ) / degauss, &
ngauss) / degauss
enddo
endif
do nu_i = 1, 3 * nat
nrec = (nu_i - 1) * nksq + ik
call davcio (dpsi, lrdwf, iudqwf, nrec, - 1)
do nu_j = 1, 3 * nat
nrec = (nu_j - 1) * nksq + ik
call davcio (dqpsi, lrdwf, iudqwf, nrec, - 1)
if (degauss /= 0.d0) then
nrec = nu_i + (nu_j - 1) * 3 * nat + (ik - 1) * 9 * nat * nat
call davcio (ps1_ij, lrdpdvp, iudpdvp_1, nrec, - 1)
nrec = nu_j + (nu_i - 1) * 3 * nat + (ik - 1) * 9 * nat * nat
call davcio (ps1_ji, lrdpdvp, iudpdvp_1, nrec, - 1)
endif
do nu_z = 1, 3 * nat
if (q0mode (nu_z) ) then
nrec = nu_z + (ik - 1) * 3 * nat
call davcio (psidqvpsi, lrpdqvp, iupd0vp, nrec, - 1)
wrk0 = CMPLX(0.d0, 0.d0,kind=DP)
wrk = CMPLX(0.d0, 0.d0,kind=DP)
do ibnd = 1, nbnd
do jbnd = 1, nbnd
if (degauss /= 0.d0) then
deltae = et (ibnd, ikk) - et (jbnd, ikk)
if (abs (deltae) > 1.0d-5) then
wg1 = wga (ibnd) / deltae
wg2 = wga (jbnd) / deltae
wrk0 = wrk0 + psidqvpsi (jbnd, ibnd) * &
(wg1 * ps1_ij (ibnd, jbnd) - &
wg2 * CONJG(ps1_ji (jbnd, ibnd) ) )
else
wg1 = wga (ibnd)
wwg = w0g (ibnd)
wrk0 = wrk0 - psidqvpsi (jbnd, ibnd) * wwg * &
ps1_ij (ibnd, jbnd)
wrk = wrk - psidqvpsi (jbnd, ibnd) * wg1 * zdotc &
(npwq, dpsi (1, ibnd), 1, dqpsi (1, jbnd), 1)
endif
else
wrk = wrk - psidqvpsi (jbnd, ibnd) * zdotc &
(npwq, dpsi (1, ibnd), 1, dqpsi (1, jbnd), 1)
endif
enddo
enddo
#ifdef __MPI
call mp_sum( wrk, intra_pool_comm )
#endif
wrk = wrk + wrk0
wrk = 2.d0 * wk (ikk) * wrk
d3dyn1 (nu_z, nu_i, nu_j) = d3dyn1 (nu_z, nu_i, nu_j) + wrk
endif
enddo
enddo
enddo
if (.not.allmodes) then
do nu_j = 1, 3 * nat
nrec = (nu_j - 1) * nksq + ik
call davcio (dqpsi, lrdwf, iudqwf, nrec, - 1)
do nu_i = 1, 3 * nat
if (q0mode (nu_i) ) then
nrec = (nu_i - 1) * nksq + ik
call davcio (dpsi, lrdwf, iud0qwf, nrec, - 1)
if (degauss /= 0.d0) then
nrec = nu_i + (nu_j - 1) * 3 * nat + (ik - 1) * 9 * nat * &
nat
call davcio (ps3_ij, lrdpdvp, iudpdvp_3, nrec, - 1)
nrec = nu_j + (nu_i - 1) * 3 * nat + (ik - 1) * 9 * nat * &
nat
call davcio (ps2_ji, lrdpdvp, iudpdvp_2, nrec, - 1)
endif
do nu_z = 1, 3 * nat
nrec = nu_z + (ik - 1) * 3 * nat
call davcio (psidqvpsi, lrpdqvp, iupdqvp, nrec, - 1)
wrk0 = CMPLX(0.d0, 0.d0,kind=DP)
wrk = CMPLX(0.d0, 0.d0,kind=DP)
do ibnd = 1, nbnd
do jbnd = 1, nbnd
if (degauss /= 0.d0) then
deltae = et (ibnd, ikk) - et (jbnd, ikq)
if (abs (deltae) > 1.0d-5) then
wg1 = wga (ibnd) / deltae
wg2 = wgq (jbnd) / deltae
wrk0 = wrk0 + psidqvpsi (jbnd, ibnd) * &
(wg1 * ps2_ji (ibnd, jbnd) - &
wg2 * CONJG(ps3_ij (jbnd, ibnd) ) )
else
wg1 = wga (ibnd)
wwg = w0g (ibnd)
wrk0 = wrk0 - psidqvpsi (jbnd, ibnd) * wwg * &
ps2_ji (ibnd, jbnd)
wrk = wrk - psidqvpsi (jbnd, ibnd) * wg1 * &
zdotc (npwq, dqpsi (1, ibnd), 1, &
dpsi (1, jbnd), 1)
endif
else
wrk = wrk - psidqvpsi (jbnd, ibnd) * zdotc &
(npwq, dqpsi (1, ibnd), 1, dpsi (1, jbnd), 1)
endif
enddo
enddo
#ifdef __MPI
call mp_sum( wrk, intra_pool_comm )
#endif
wrk = wrk + wrk0
wrk = 2.d0 * wk (ikk) * wrk
d3dyn2 (nu_i, nu_j, nu_z) = d3dyn2 (nu_i, nu_j, nu_z) &
+ wrk
d3dyn3 (nu_i, nu_z, nu_j) = d3dyn3 (nu_i, nu_z, nu_j) &
+ CONJG(wrk)
enddo
endif
enddo
enddo
endif
enddo
#ifdef __MPI
call mp_sum( d3dyn1, inter_pool_comm )
if (.not.allmodes) then
call mp_sum( d3dyn2, inter_pool_comm )
call mp_sum( d3dyn3, inter_pool_comm )
endif
#endif
do nu_i = 1, 3 * nat
do nu_j = 1, 3 * nat
do nu_z = 1, 3 * nat
if (allmodes) then
d3dyn (nu_i, nu_j, nu_z) = d3dyn (nu_i, nu_j, nu_z) + &
d3dyn1 (nu_i, nu_j, nu_z) + d3dyn1 (nu_j, nu_z, nu_i) + &
d3dyn1 (nu_z, nu_i, nu_j)
d3dyn_aux6 (nu_i, nu_j, nu_z) = d3dyn_aux6 (nu_i, nu_j, nu_z) &
+ d3dyn1 (nu_i, nu_j, nu_z) + d3dyn1 (nu_j, nu_z, nu_i) &
+ d3dyn1 (nu_z, nu_i, nu_j)
else
d3dyn (nu_i, nu_j, nu_z) = d3dyn (nu_i, nu_j, nu_z) + &
d3dyn1 (nu_i, nu_j, nu_z) + d3dyn2 (nu_i, nu_j, nu_z) + &
d3dyn3 (nu_i, nu_j, nu_z)
d3dyn_aux6 (nu_i, nu_j, nu_z) = d3dyn_aux6 (nu_i, nu_j, nu_z) &
+ d3dyn1 (nu_i, nu_j, nu_z) + d3dyn2 (nu_i, nu_j, nu_z) &
+ d3dyn3 (nu_i, nu_j, nu_z)
endif
enddo
enddo
enddo
deallocate (dqpsi)
if (degauss /= 0.d0) then
deallocate (ps1_ij)
deallocate (ps1_ji)
deallocate (ps3_ij)
deallocate (ps2_ji)
endif
deallocate (d3dyn1)
if (.not.allmodes) then
deallocate (d3dyn2)
deallocate (d3dyn3)
endif
return
end subroutine dpsidpsidv

194
PHonon/D3/dpsidvdpsi.f90
View File

@ -1,194 +0,0 @@
!
! Copyright (C) 2001 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 dpsidvdpsi (nu_q0)
!-----------------------------------------------------------------------
!
USE ions_base, ONLY : nat
USE kinds, only : DP
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
use pwcom
USE fft_base, ONLY : dfftp
USE uspp, ONLY : nkb, vkb
use phcom
use d3com
USE io_files, ONLY : iunigk
use qpoint, ONLY : igkq, npwq, nksq, xq
use control_lr, ONLY : lgamma
implicit none
integer :: nu_q0
!
integer :: ik, ikk, ikq, ig, ibnd, nu_i, nu_j, nu_z, nrec, ios
real (DP) :: zero (3), wgauss, wga (nbnd), wg1
complex (DP) :: wrk, zdotc
complex (DP), allocatable :: dqpsi (:,:), dvloc (:), d3dyn1 (:,:,:), &
d3dyn2 (:,:,:), d3dyn3 (:,:,:)
allocate (dqpsi( npwx, nbnd))
allocate (dvloc( dfftp%nnr))
allocate (d3dyn1( 3 * nat, 3 * nat, 3 * nat))
if (.not.allmodes) then
allocate (d3dyn2( 3 * nat, 3 * nat, 3 * nat))
allocate (d3dyn3( 3 * nat, 3 * nat,3 * nat))
endif
zero = 0.d0
d3dyn1 (:,:,:) = (0.d0, 0.d0)
if (.not.allmodes) then
d3dyn2 (:,:,:) = (0.d0, 0.d0)
d3dyn3 (:,:,:) = (0.d0, 0.d0)
endif
nu_z = nu_q0
call dvscf (nu_z, dvloc, zero)
rewind (unit = iunigk)
do ik = 1, nksq
if (.not.lgamma) read (iunigk, err = 100, iostat = ios) npwq, igkq
read (iunigk, err = 100, iostat = ios) npwq, igkq
100 call errore ('dpsidvdpsi', 'reading iunigk-iunigkq', abs (ios) )
npw = npwq
do ig = 1, npwx
igk (ig) = igkq (ig)
enddo
if (lgamma) then
ikk = ik
ikq = ik
else
ikk = 2 * ik - 1
ikq = 2 * ik
endif
call init_us_2 (npwq, igkq, xk (1, ikq), vkb)
wg1 = wk (ikk)
if (degauss /= 0.d0) then
do ibnd = 1, nbnd
wga (ibnd) = wgauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss)
enddo
endif
do nu_i = 1, 3 * nat
nrec = (nu_i - 1) * nksq + ik
call davcio (dpsi, lrdwf, iudqwf, nrec, - 1)
call dvdpsi (nu_z, zero, dvloc, vkb, vkb, dpsi, dvpsi)
do nu_j = 1, 3 * nat
nrec = (nu_j - 1) * nksq + ik
call davcio (dqpsi, lrdwf, iudqwf, nrec, - 1)
wrk = CMPLX(0.d0, 0.d0,kind=DP)
do ibnd = 1, nbnd
if (degauss /= 0.d0) wg1 = wk (ikk) * wga (ibnd)
wrk = wrk + 2.d0 * wg1 * &
zdotc (npwq, dqpsi (1, ibnd), 1, dvpsi (1, ibnd), 1)
enddo
#ifdef __MPI
call mp_sum( wrk, intra_pool_comm )
#endif
d3dyn1 (nu_z, nu_j, nu_i) = d3dyn1 (nu_z, nu_j, nu_i) + wrk
enddo
enddo
enddo
if (.not.allmodes) then
rewind (unit = iunigk)
do ik = 1, nksq
read (iunigk, err = 110, iostat = ios) npw, igk
if (.not.lgamma) read (iunigk, err = 110, iostat = ios) npwq, &
igkq
110 call errore ('dpsidvdpsi', 'reading iunigk-iunigkq', abs (ios) )
if (lgamma) then
npwq = npw
ikk = ik
ikq = ik
else
ikk = 2 * ik - 1
ikq = 2 * ik
endif
call init_us_2 (npw, igk, xk (1, ikk), vkb0)
call init_us_2 (npwq, igkq, xk (1, ikq), vkb)
wg1 = wk (ikk)
if (degauss /= 0.d0) then
do ibnd = 1, nbnd
wga (ibnd) = wgauss ( (ef - et (ibnd, ikk) ) / degauss, &
ngauss)
enddo
endif
nu_i = nu_q0
do nu_z = 1, 3 * nat
call dvscf (nu_z, dvloc, xq)
nrec = (nu_i - 1) * nksq + ik
call davcio (dpsi, lrdwf, iudwf, nrec, - 1)
call dvdpsi (nu_z, xq, dvloc, vkb0, vkb, dpsi, dvpsi)
do nu_j = 1, 3 * nat
nrec = (nu_j - 1) * nksq + ik
call davcio (dqpsi, lrdwf, iudqwf, nrec, - 1)
wrk = CMPLX(0.d0, 0.d0,kind=DP)
do ibnd = 1, nbnd
if (degauss.ne.0.d0) wg1 = wk (ikk) * wga (ibnd)
wrk = wrk + 2.d0 * wg1 * &
zdotc (npwq, dvpsi (1, ibnd), 1, dqpsi (1, ibnd), 1)
enddo
#ifdef __MPI
call mp_sum( wrk, intra_pool_comm )
#endif
d3dyn2 (nu_i, nu_z, nu_j) = d3dyn2 (nu_i, nu_z, nu_j) + wrk
d3dyn3 (nu_i, nu_j, nu_z) = d3dyn3 (nu_i, nu_j, nu_z) + CONJG(wrk)
enddo
enddo
enddo
endif
#ifdef __MPI
call mp_sum( d3dyn1, inter_pool_comm )
if (.not.allmodes) then
call mp_sum( d3dyn2, inter_pool_comm )
call mp_sum( d3dyn3, inter_pool_comm )
endif
#endif
do nu_i = 1, 3 * nat
do nu_j = 1, 3 * nat
do nu_z = 1, 3 * nat
if (allmodes) then
d3dyn (nu_i, nu_j, nu_z) = d3dyn (nu_i, nu_j, nu_z) + &
d3dyn1(nu_i, nu_j, nu_z) + &
d3dyn1(nu_j, nu_z, nu_i) + &
d3dyn1(nu_z, nu_i, nu_j)
d3dyn_aux5 (nu_i, nu_j, nu_z) = d3dyn_aux5 (nu_i, nu_j, nu_z) &
+ d3dyn1 (nu_i, nu_j, nu_z) + d3dyn1 (nu_j, nu_z, nu_i) &
+ d3dyn1 (nu_z, nu_i, nu_j)
else
d3dyn (nu_i, nu_j, nu_z) = d3dyn (nu_i, nu_j, nu_z) + &
d3dyn1(nu_i, nu_j, nu_z) + &
d3dyn2(nu_i, nu_j, nu_z) + &
d3dyn3(nu_i, nu_j, nu_z)
d3dyn_aux5 (nu_i, nu_j, nu_z) = d3dyn_aux5 (nu_i, nu_j, nu_z) &
+ d3dyn1 (nu_i, nu_j, nu_z) + d3dyn2 (nu_i, nu_j, nu_z) &
+ d3dyn3 (nu_i, nu_j, nu_z)
endif
enddo
enddo
enddo
if (.not.allmodes) then
deallocate (d3dyn3)
deallocate (d3dyn2)
endif
deallocate (d3dyn1)
deallocate (dqpsi)
deallocate (dvloc)
return
end subroutine dpsidvdpsi

222
PHonon/D3/dqrhod2v.f90
View File

@ -1,222 +0,0 @@
!
! Copyright (C) 2001 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 dqrhod2v (ipert, drhoscf)
!-----------------------------------------------------------------------
! calculates the term containing the second variation of the potential
! and the first variation of the charge density with respect to a
! perturbation at a generic q
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp, tau
USE kinds, ONLY : DP
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE pwcom
USE uspp, ONLY : vkb, dvan
USE uspp_param, ONLY : nh
USE wavefunctions_module, ONLY : evc
USE io_files, ONLY : iunigk
USE phcom
USE d3com
USE mp_global, ONLY : my_pool_id
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
use qpoint, ONLY : xq, npwq, nksq, igkq
use control_lr, ONLY : lgamma
!
IMPLICIT NONE
!
INTEGER :: ipert
! index of the perturbation associated with drho
COMPLEX (DP) :: drhoscf (dfftp%nnr)
! the variation of the charge density
!
! local variables
!
INTEGER :: icart, jcart, na_icart, na_jcart, na, ng, nt, &
ik, ikk, ikq, ig, ibnd, nu_i, nu_j, nu_k, ikb, jkb, nrec, ios
! counters
REAL (DP) :: gtau, wgg
! the product G*\tau_s
! the weight of a K point
COMPLEX (DP) :: zdotc, fac, alpha (8), work
COMPLEX (DP), ALLOCATABLE :: d3dywrk (:,:), work0 (:), &
work1 (:), work2 (:), work3 (:), work4 (:), work5 (:), work6 (:)
! work space
ALLOCATE (d3dywrk( 3 * nat, 3 * nat))
ALLOCATE (work0( dfftp%nnr))
ALLOCATE (work1( npwx))
ALLOCATE (work2( npwx))
ALLOCATE (work3( npwx))
ALLOCATE (work4( npwx))
ALLOCATE (work5( npwx))
ALLOCATE (work6( npwx))
d3dywrk (:,:) = (0.d0, 0.d0)
!
! Here the contribution deriving from the local part of the potential
!
! ... computed only by the first pool (no sum over k needed)
!
IF ( my_pool_id == 0 ) THEN
!
work0 (:) = drhoscf(:)
CALL fwfft ('Dense', work0, dfftp)
DO na = 1, nat
DO icart = 1, 3
na_icart = 3 * (na - 1) + icart
DO jcart = 1, 3
na_jcart = 3 * (na - 1) + jcart
DO ng = 1, ngm
gtau = tpi * ( (xq (1) + g (1, ng) ) * tau (1, na) + &
(xq (2) + g (2, ng) ) * tau (2, na) + &
(xq (3) + g (3, ng) ) * tau (3, na) )
fac = CMPLX(COS (gtau), - SIN (gtau) ,kind=DP)
d3dywrk (na_icart, na_jcart) = d3dywrk (na_icart, na_jcart) &
- tpiba2 * omega * (xq (icart) + g (icart, ng) ) * &
(xq (jcart) + g (jcart, ng) ) * &
vlocq (ng, ityp (na) ) * fac * CONJG (work0 (nl (ng) ) )
ENDDO
ENDDO
ENDDO
ENDDO
!
CALL mp_sum( d3dywrk, intra_pool_comm )
!
END IF
!
! each pool contributes to next term
!
! Here we compute the nonlocal (Kleinman-Bylander) contribution.
!
REWIND (unit = iunigk)
DO ik = 1, nksq
READ (iunigk, err = 200, iostat = ios) npw, igk
200 CALL errore ('dqrhod2v', 'reading igk', ABS (ios) )
IF (lgamma) THEN
ikk = ik
ikq = ik
npwq = npw
ELSE
ikk = 2 * ik - 1
ikq = 2 * ik
READ (iunigk, err = 300, iostat = ios) npwq, igkq
300 CALL errore ('dqrhod2v', 'reading igkq', ABS (ios) )
ENDIF
wgg = wk (ikk)
CALL davcio (evc, lrwfc, iuwfc, ikk, - 1)
!
! In metallic case it necessary to know the wave function at k+q point
! so as to correct dpsi. dvpsi is used as working array
!
IF (degauss /= 0.d0) CALL davcio (dvpsi, lrwfc, iuwfc, ikq, -1)
CALL init_us_2 (npwq, igkq, xk (1, ikq), vkb)
CALL init_us_2 (npw, igk, xk (1, ikk), vkb0)
!
! Reads the first variation of the wavefunction projected on conduction
!
nrec = (ipert - 1) * nksq + ik
CALL davcio (dpsi, lrdwf, iudqwf, nrec, - 1)
!
! In the metallic case corrects dpsi so as that the density matrix
! will be: Sum_{k,nu} 2 * | dpsi > < psi |
!
IF (degauss /= 0.d0) THEN
nrec = ipert + (ik - 1) * 3 * nat
CALL davcio (psidqvpsi, lrpdqvp, iupdqvp, nrec, - 1)
CALL dpsi_corr (dvpsi, psidqvpsi, ikk, ikq, ipert)
ENDIF
!
DO icart = 1, 3
DO jcart = 1, 3
DO ibnd = 1, nbnd
DO ig = 1, npw
work1(ig)=evc(ig,ibnd)*tpiba*(xk(icart,ikk)+g(icart,igk(ig)))
work2(ig)=evc(ig,ibnd)*tpiba*(xk(jcart,ikk)+g(jcart,igk(ig)))
work5(ig)= work1(ig)*tpiba*(xk(jcart,ikk)+g(jcart,igk(ig)))
ENDDO
DO ig = 1, npwq
work3(ig)=dpsi(ig,ibnd)*tpiba*(xk(icart,ikq)+g(icart,igkq(ig)))
work4(ig)=dpsi(ig,ibnd)*tpiba*(xk(jcart,ikq)+g(jcart,igkq(ig)))
work6(ig)= work3(ig)*tpiba*(xk(jcart,ikq)+g(jcart,igkq(ig)))
ENDDO
jkb=0
DO nt = 1, ntyp
DO na = 1, nat
IF (ityp (na).EQ.nt) THEN
na_icart = 3 * (na - 1) + icart
na_jcart = 3 * (na - 1) + jcart
DO ikb = 1, nh (nt)
jkb = jkb+1
alpha(1) = zdotc(npw, work1, 1,vkb0(1,jkb), 1)
alpha(2) = zdotc(npwq,vkb(1,jkb), 1, work4, 1)
alpha(3) = zdotc(npw, work2, 1,vkb0(1,jkb), 1)
alpha(4) = zdotc(npwq,vkb(1,jkb), 1, work3, 1)
alpha(5) = zdotc(npw, work5, 1,vkb0(1,jkb), 1)
alpha(6) = zdotc(npwq,vkb(1,jkb),1,dpsi(1,ibnd),1)
alpha(7) = zdotc(npw, evc(1,ibnd),1,vkb0(1,jkb),1)
alpha(8) = zdotc(npwq,vkb(1,jkb),1,work6, 1)
!
CALL mp_sum( alpha, intra_pool_comm )
!
d3dywrk(na_icart,na_jcart) = d3dywrk(na_icart,na_jcart) &
+ CONJG(alpha(1) * alpha(2) + alpha(3) * alpha(4) - &
alpha(5) * alpha(6) - alpha(7) * alpha(8) ) &
* dvan (ikb, ikb, nt) * wgg * 2.0d0
ENDDO
ENDIF
ENDDO
END DO
END DO
ENDDO
ENDDO
ENDDO
!
CALL mp_sum( d3dywrk, inter_pool_comm )
!
! Rotate the dynamical matrix on the basis of patterns
! some indices do not need to be rotated
!
nu_k = ipert
DO nu_i = 1, 3 * nat
IF (q0mode (nu_i) ) THEN
DO nu_j = 1, 3 * nat
work = (0.0d0, 0.0d0)
DO na = 1, nat
DO icart = 1, 3
na_icart = 3 * (na - 1) + icart
DO jcart = 1, 3
na_jcart = 3 * (na - 1) + jcart
work = work + ug0 (na_icart, nu_i) * &
d3dywrk (na_icart,na_jcart) * u (na_jcart, nu_j)
ENDDO
ENDDO
ENDDO
d3dyn (nu_i, nu_k, nu_j) = d3dyn (nu_i, nu_k, nu_j) + work
d3dyn (nu_i, nu_j, nu_k) = d3dyn (nu_i, nu_j, nu_k) + CONJG(work)
ENDDO
ENDIF
ENDDO
DEALLOCATE (work6)
DEALLOCATE (work5)
DEALLOCATE (work4)
DEALLOCATE (work3)
DEALLOCATE (work2)
DEALLOCATE (work1)
DEALLOCATE (work0)
DEALLOCATE (d3dywrk)
RETURN
END SUBROUTINE dqrhod2v

50
PHonon/D3/drho_cc.f90
View File

@ -1,50 +0,0 @@
!
! Copyright (C) 2001 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 drho_cc (iflag)
!-----------------------------------------------------------------------
!
! Used when non_linear_core_correction are present to change the files
! containing the variation of the charge
! iflag = +1 :
! adds the variation of the core charge to the variation of the
! valence charge ( both for xq.eq.0 and xq.ne.0 )
!
! iflag = -1 :
! subtracts the variation of the core charge to the variation of
! the total charge --used to set drho and d0rho as they were
! before the first call of drho_cc--
!
USE kinds, only : DP
use pwcom
use phcom
use d3com
use qpoint, ONLY : xq
use control_lr, ONLY : lgamma
use uspp, ONLY : nlcc_any
implicit none
integer :: iflag
real (DP) :: xq0 (3), scalef
if (.not.nlcc_any) return
if (iflag.eq. - 1) then
iudrho = iudrho-1000
iud0rho=iud0rho-1000
RETURN
else
scalef = 1.d0
end if
xq0 = 0.d0
call drho_drc (iud0rho, ug0, xq0, d0rc, scalef)
if (.not.lgamma) call drho_drc (iudrho, u, xq, drc, scalef)
return
end subroutine drho_cc

86
PHonon/D3/drho_drc.f90
View File

@ -1,86 +0,0 @@
!
! Copyright (C) 2001 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 drho_drc (iudrho_x, u_x, xq_x, drc_x, scalef)
!-----------------------------------------------------------------------
! Reads the variation of the charge saved on a file and changes
! it according to the variation of the core_charge
! It is used by drho_cc. Have a look there for more explanation
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp, tau
USE kinds, ONLY : DP
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : invfft
USE pwcom
USE phcom
USE d3com
USE uspp_param, ONLY : upf
USE mp, ONLY : mp_barrier
USE mp_world, ONLY : world_comm
IMPLICIT NONE
INTEGER :: iudrho_x
!input: the unit containing the charge variation
REAL (DP) :: xq_x (3), scalef
!input: q point
!input: drhocore will be added to the valence charge scaled by this factor
COMPLEX (DP) :: u_x (3 * nat, 3 * nat), drc_x (ngm, ntyp)
!input: the transformation modes patterns
!input: contain the rhoc (without structu
INTEGER :: ipert, na, mu, nt, ig, errcode, iudrho_tmp
REAL (DP) :: gtau
COMPLEX (DP) :: guexp
COMPLEX (DP), ALLOCATABLE :: drhoc (:), drhov (:), uact (:)
iudrho_tmp = iudrho_x
iudrho_x = iudrho_tmp+1000 ! this must be already opened, see openfild3
ALLOCATE (drhoc( dfftp%nnr))
ALLOCATE (drhov( dfftp%nnr))
ALLOCATE (uact( 3 * nat))
DO ipert = 1, 3 * nat
drhoc(:) = (0.d0, 0.d0)
uact(:) = u_x (:, ipert)
DO na = 1, nat
mu = 3 * (na - 1)
IF (ABS (uact (mu + 1) ) + ABS (uact (mu + 2) ) + &
ABS (uact (mu + 3) ) > 1.0d-12) THEN
nt = ityp (na)
IF (upf(nt)%nlcc) THEN
DO ig = 1, ngm
gtau = tpi * ( (g (1, ig) + xq_x (1) ) * tau (1, na) &
+ (g (2, ig) + xq_x (2) ) * tau (2, na) &
+ (g (3, ig) + xq_x (3) ) * tau (3, na) )
guexp = tpiba * ( (g (1, ig) + xq_x (1) ) * uact (mu + 1) &
+ (g (2, ig) + xq_x (2) ) * uact (mu + 2) &
+ (g (3, ig) + xq_x (3) ) * uact (mu + 3) )&
* CMPLX(0.d0, - 1.d0,kind=DP) &
* CMPLX(COS (gtau), - SIN (gtau) ,kind=DP)
drhoc (nl (ig) ) = drhoc (nl (ig) ) + drc_x (ig, nt) * guexp
ENDDO
ENDIF
ENDIF
ENDDO
CALL invfft ('Dense', drhoc, dfftp)
CALL davcio_drho2 (drhov, lrdrho, iudrho_tmp, ipert, - 1)
drhov(:) = drhov(:) + scalef * drhoc(:)
CALL davcio_drho2 (drhov, lrdrho, iudrho_x, ipert, + 1)
ENDDO
CALL mp_barrier( world_comm )
DEALLOCATE (drhoc)
DEALLOCATE (drhov)
DEALLOCATE (uact)
RETURN
END SUBROUTINE drho_drc

56
PHonon/D3/drhod2v.f90
View File

@ -1,56 +0,0 @@
!
! Copyright (C) 2001 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 drhod2v
!-----------------------------------------------------------------------
! It calls the routines which calculate the term containing the first
! variation of the charge and the secon variation of the potential with
! respect to the perturbation.
! d0rhod2v: contains the terms depending on the first variation of the c
! with respect to a perturbaation at q=0
! dqrhod2v: contains the terms depending on the first variation of the c
! with respect to a perturbaation at a generic q
! The variation of the charge can be read from a file or calculated dire
! --this last option is to be used for testing pourposes--
!
USE ions_base, ONLY : nat
USE kinds, only : DP
USE fft_base, ONLY : dfftp
use pwcom
use phcom
use d3com
!
implicit none
integer :: irr, irr1, imode0, ipert, ir
real (DP) :: xq0 (3)
complex (DP), allocatable :: drhoscf (:)
! the change of density due to perturbations
allocate (drhoscf( dfftp%nnr))
call read_ef
if (.not.allmodes) then
do ipert = 1, 3 * nat
call davcio_drho (drhoscf, lrdrho, iudrho, ipert, - 1)
call dqrhod2v (ipert, drhoscf)
enddo
endif
do ipert = 1, 3 * nat
if (q0mode (ipert) ) then
call davcio_drho (drhoscf, lrdrho, iud0rho, ipert, - 1)
call d0rhod2v (ipert, drhoscf)
endif
enddo
deallocate (drhoscf)
return
end subroutine drhod2v

132
PHonon/D3/dvdpsi.f90
View File

@ -1,132 +0,0 @@
!
! Copyright (C) 2001 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 dvdpsi (nu_i, xq_, dvloc, vkb_, vkbq_, psi_, dvpsi_)
!-----------------------------------------------------------------------
!
! Receives in input the variation of the local part of the KS-potential
! and calculates dV(xq_)_KS*psi_ in G_space, for all bands
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE cell_base, ONLY : tpiba
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : g
USE gvecs, ONLY : nls
USE wvfct, ONLY : nbnd, npwx, npw, igk
use qpoint, ONLY : npwq, igkq
use phcom
use d3com
USE uspp, ONLY : nkb, dvan
USE uspp_param, ONLY : nh
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
!
implicit none
integer :: nu_i
! input: the mode under consideration
real (DP) :: xq_ (3)
! input: coordinates of the q point describing the perturbation
complex (DP) :: dvloc (dfftp%nnr), psi_ (npwx, nbnd), dvpsi_ (npwx, nbnd)
! input: local part of the KS potential
! input: wavefunction
! output: variation of the KS potential applied to psi_
complex(DP) :: vkb_(npwx,nkb), vkbq_(npwx,nkb)
!
! Local variables
!
integer :: na, mu, ig, igg, ir, ibnd, nt, ikb, jkb
! counters
complex (DP), pointer :: u_x (:,:)
! the transformation modes patterns
complex (DP), allocatable :: aux (:), ps (:,:), wrk2 (:)
! work space
complex (DP) , external:: zdotc
logical :: q_eq_zero
!
allocate (aux( dfftp%nnr))
allocate (ps( 2, nbnd))
allocate (wrk2( npwx))
q_eq_zero = xq_ (1) == 0.d0 .and. xq_ (2) == 0.d0 .and. xq_ (3) == 0.d0
if (q_eq_zero) then
u_x => ug0
else
u_x => u
endif
!
do ibnd = 1, nbnd
aux (:) = (0.d0, 0.d0)
do ig = 1, npw
aux (nls (igk (ig) ) ) = psi_ (ig, ibnd)
enddo
CALL invfft ('Wave', aux, dffts)
do ir = 1, dffts%nnr
aux (ir) = aux (ir) * dvloc (ir)
enddo
CALL fwfft ('Wave', aux, dffts)
do ig = 1, npwq
dvpsi_ (ig, ibnd) = aux (nls (igkq (ig) ) )
enddo
enddo
!
! Now the contribution of the non local part in the KB form
!
jkb=0
do nt = 1, ntyp
do na = 1, nat
if (ityp (na).eq.nt) then
mu = 3 * (na - 1)
do ikb = 1, nh (nt)
jkb = jkb+1
if (abs (u_x (mu + 1, nu_i) ) + abs (u_x (mu + 2, nu_i) ) + &
abs (u_x (mu + 3, nu_i) ) > 1.0d-12) then
!
! first term: sum_l v_l beta_l(k+q+G) \sum_G' beta^*_l(k+G') (iG'*u) psi
! second term: sum_l E_l(-i(q+G)*u) beta_l(k+q+G)\sum_G'beta^*_l(k+G')ps
!
do ig = 1, npw
wrk2 (ig) = vkb_(ig,jkb) * &
CONJG(CMPLX(0.d0,1.d0,kind=DP) *tpiba * &
(g (1, igk (ig) ) * u_x (mu + 1, nu_i) + &
g (2, igk (ig) ) * u_x (mu + 2, nu_i) + &
g (3, igk (ig) ) * u_x (mu + 3, nu_i) ) )
enddo
do ibnd = 1, nbnd
ps(1,ibnd) = dvan(ikb,ikb,nt) * &
zdotc(npw, wrk2, 1, psi_(1,ibnd), 1)
ps(2,ibnd) = dvan(ikb,ikb,nt) * &
zdotc(npw,vkb_(1,jkb),1,psi_(1,ibnd),1)
enddo
!
! when build is serial this call does nothing, we leave it there
!
call mp_sum ( ps, intra_pool_comm )
do ig = 1, npwq
wrk2 (ig) = vkbq_(ig,jkb) * CMPLX(0.d0,-1.d0,kind=DP) * tpiba * &
( (g (1, igkq (ig) ) + xq_ (1) ) * u_x (mu+1, nu_i) +&
(g (2, igkq (ig) ) + xq_ (2) ) * u_x (mu+2, nu_i) +&
(g (3, igkq (ig) ) + xq_ (3) ) * u_x (mu+3, nu_i) )
enddo
do ibnd = 1, nbnd
call zaxpy(npwq,ps(1,ibnd),vkbq_(1,jkb),1,dvpsi_(1,ibnd),1)
call zaxpy(npwq,ps(2,ibnd), wrk2, 1,dvpsi_(1,ibnd),1)
enddo
endif
enddo
end if
end do
end do
deallocate (wrk2)
deallocate (ps)
deallocate (aux)
return
end subroutine dvdpsi

136
PHonon/D3/dvscf.f90
View File

@ -1,136 +0,0 @@
!
! Copyright (C) 2001 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 dvscf (nu_i, dvloc, xq_x)
!-----------------------------------------------------------------------
!
! It reads the variation of the charge density from a file and
! calculates the variation of the local part of the variation of the
! K-S potential.
!
USE ions_base, ONLY : nat, ityp, tau
USE kinds, ONLY : DP
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft, invfft
use pwcom
USE uspp_param, ONLY: upf
USE uspp, ONLY: nlcc_any
use phcom
use d3com
!USE dv_of_drho_lr
!
implicit none
integer :: nu_i
! input: mode under consideration
real (DP) :: xq_x (3)
! input: coordinates of the q point
complex (DP) :: dvloc (dfftp%nnr)
! output: local part of the variation
! of the K_S potential
!
! Local variables
!
integer :: iudrho_x, ig, ir, mu, na, nt
! unit containing the charge variation
! countes
real (DP) :: qg2, gtau
! the modulus of (q+G)^2
! auxiliary variable: g*tau
complex (DP) :: guexp
! auxiliary variable: g*u*exp(gtau)
real (DP), pointer :: vloc_x (:,:)
! the local potential at G+q
complex (DP), pointer :: u_x(:,:), drc_x (:,:)
complex (DP), allocatable :: aux1 (:), aux2 (:)
! the transformation modes patterns
! contain drho_core for all atomic types
logical :: q_eq_zero
! true if xq equal zero
allocate (aux1( dfftp%nnr))
allocate (aux2( dfftp%nnr))
q_eq_zero = xq_x(1) == 0.d0 .and. xq_x(2) == 0.d0 .and. xq_x(3) == 0.d0
if (q_eq_zero) then
u_x => ug0
if (nlcc_any) drc_x => d0rc
vloc_x => vlocg0
iudrho_x = iud0rho
else
u_x => u
if (nlcc_any) drc_x => drc
vloc_x => vlocq
iudrho_x = iudrho
endif
call davcio_drho (aux2, lrdrho, iudrho_x, nu_i, - 1)
! IT: Warning, if you uncomment the following line,
! you have to precompute the response core charge density
! and pass it as the input to dv_of_drho.
!
! call dv_of_drho (aux2(1), .true., ???)
! dvloc = aux2(:)
! deallocate (aux1, aux2)
! return
dvloc (:) = aux2(:) * dmuxc(:,1,1)
CALL fwfft ('Dense', aux2, dfftp)
aux1 (:) = (0.d0, 0.d0)
do ig = 1, ngm
qg2 = (g(1,ig)+xq_x(1))**2 + (g(2,ig)+xq_x(2))**2 + (g(3,ig)+xq_x(3))**2
if (qg2 > 1.d-8) then
aux1(nl(ig)) = e2 * fpi * aux2(nl(ig)) / (tpiba2 * qg2)
endif
enddo
if (nlcc_any) aux2 (:) = (0.d0, 0.d0)
do na = 1, nat
mu = 3 * (na - 1)
if (abs(u_x(mu+1,nu_i)) + abs(u_x(mu+2,nu_i)) + &
abs(u_x(mu+3,nu_i)) > 1.0d-12) then
nt = ityp (na)
do ig = 1, ngm
gtau = tpi * ( (g(1,ig) + xq_x(1)) * tau(1,na) + &
(g(2,ig) + xq_x(2)) * tau(2,na) + &
(g(3,ig) + xq_x(3)) * tau(3,na) )
guexp = tpiba * ( (g(1,ig) + xq_x(1)) * u_x(mu+1,nu_i) + &
(g(2,ig) + xq_x(2)) * u_x(mu+2,nu_i) + &
(g(3,ig) + xq_x(3)) * u_x(mu+3,nu_i) ) * &
(0.d0,-1.d0) * CMPLX(cos(gtau),-sin(gtau),kind=DP)
aux1 (nl(ig)) = aux1 (nl(ig)) + vloc_x (ig,nt) * guexp
if (upf(nt)%nlcc) then
aux2 (nl(ig)) = aux2 (nl(ig)) + drc_x(ig,nt) * guexp
end if
enddo
endif
enddo
CALL invfft ('Dense', aux1, dfftp)
dvloc (:) = dvloc(:) + aux1 (:)
if (nlcc_any) then
CALL invfft ('Dense', aux2, dfftp)
dvloc (:) = dvloc(:) + aux2 (:) * dmuxc(:,1,1)
endif
if (doublegrid) call cinterpolate (dvloc, dvloc, - 1)
deallocate (aux1)
deallocate (aux2)
return
end subroutine dvscf

142
PHonon/D3/gen_dpdvp.f90
View File

@ -1,142 +0,0 @@
!
! Copyright (C) 2001 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 gen_dpdvp
!-----------------------------------------------------------------------
!
! It calculates the scalar product < Pc dpsi/du | dH/du | psi > and
! writes it on a file. Used in the metallic case.
! Three files are used:
! iudpdvp_1 : < Pc dpsi_k/du(-q) | dH/du(q) | psi_k >
! iudpdvp_2 : < Pc dpsi_k/du(-q) | dH/du(0) | psi_{k+q} >
! iudpdvp_3 : < Pc dpsi_{k+q}/du(0) | dH/du(q) | psi_k >
!
USE ions_base, ONLY : nat
USE kinds, only : DP
use pwcom
USE fft_base, ONLY : dfftp
USE uspp, ONLY: vkb
USE wavefunctions_module, ONLY: evc
USE io_files, ONLY : iunigk
use phcom
use d3com
USE mp_global, ONLY: intra_pool_comm
USE mp, ONLY: mp_sum
use qpoint, ONLY : xq, igkq, nksq, npwq
use control_lr, ONLY : lgamma
implicit none
integer :: ik, ikk, ikq, ig, nrec, nu_i, nu_j, ibnd, jbnd, ios
real (DP) :: zero (3)
complex (DP) :: zdotc
complex (DP), allocatable :: dvloc (:), dpsidvpsi (:,:)
if (degauss.eq.0.d0) return
allocate (dvloc( dfftp%nnr))
allocate (dpsidvpsi( nbnd, nbnd))
rewind (unit = iunigk)
zero = 0.0_dp
do ik = 1, nksq
read (iunigk, err = 100, iostat = ios) npw, igk
if (lgamma) then
ikk = ik
ikq = ik
npwq = npw
else
ikk = 2 * ik - 1
ikq = 2 * ik
read (iunigk, err = 100, iostat = ios) npwq, igkq
endif
100 call errore ('gen_dpdvp', 'reading iunigk-iunigkq', abs (ios) )
call init_us_2 (npw, igk, xk (1, ikk), vkb0)
call init_us_2 (npwq, igkq, xk (1, ikq), vkb)
call davcio (evc, lrwfc, iuwfc, ikk, - 1)
if (.not.lgamma) call davcio (evq, lrwfc, iuwfc, ikq, - 1)
do nu_j = 1, 3 * nat
call dvscf (nu_j, dvloc, xq)
call dvdpsi (nu_j, xq, dvloc, vkb0, vkb, evc, dvpsi)
do nu_i = 1, 3 * nat
nrec = (nu_i - 1) * nksq + ik
call davcio (dpsi, lrdwf, iudqwf, nrec, - 1)
do ibnd = 1, nbnd
do jbnd = 1, nbnd
dpsidvpsi (ibnd, jbnd) = &
zdotc (npwq, dpsi (1,ibnd), 1, dvpsi (1,jbnd), 1)
enddo
enddo
#ifdef __MPI
call mp_sum( dpsidvpsi, intra_pool_comm )
#endif
nrec = nu_i + (nu_j - 1) * 3 * nat + (ik - 1) * 9 * nat * nat
call davcio (dpsidvpsi, lrdpdvp, iudpdvp_1, nrec, + 1)
enddo
if (.not.lgamma) then
do nu_i = 1, 3 * nat
nrec = (nu_i - 1) * nksq + ik
call davcio (dpsi, lrdwf, iud0qwf, nrec, - 1)
do ibnd = 1, nbnd
do jbnd = 1, nbnd
dpsidvpsi (ibnd, jbnd) = &
zdotc (npwq, dpsi (1, ibnd), 1, dvpsi (1, jbnd), 1)
enddo
enddo
#ifdef __MPI
call mp_sum( dpsidvpsi, intra_pool_comm )
#endif
nrec = nu_i + (nu_j - 1) * 3 * nat + (ik - 1) * 9 * nat * nat
call davcio (dpsidvpsi, lrdpdvp, iudpdvp_3, nrec, + 1)
enddo
endif
enddo
if (.not.lgamma) then
npw = npwq
do ig = 1, npwx
igk (ig) = igkq (ig)
enddo
do nu_j = 1, 3 * nat
call dvscf (nu_j, dvloc, zero)
call dvdpsi (nu_j, zero, dvloc, vkb,vkb, evq, dvpsi)
do nu_i = 1, 3 * nat
nrec = (nu_i - 1) * nksq + ik
call davcio (dpsi, lrdwf, iudqwf, nrec, - 1)
do ibnd = 1, nbnd
do jbnd = 1, nbnd
dpsidvpsi (ibnd, jbnd) = &
zdotc (npwq, dpsi (1,ibnd), 1, dvpsi(1,jbnd), 1)
enddo
enddo
#ifdef __MPI
call mp_sum( dpsidvpsi, intra_pool_comm )
#endif
nrec = nu_i + (nu_j - 1) * 3 * nat + (ik - 1) * 9 * nat * nat
call davcio (dpsidvpsi, lrdpdvp, iudpdvp_2, nrec, + 1)
enddo
enddo
endif
enddo
call close_open (4)
deallocate (dvloc)
deallocate (dpsidvpsi)
return
end subroutine gen_dpdvp

80
PHonon/D3/gen_dwfc.f90
View File

@ -1,80 +0,0 @@
!
! Copyright (C) 2001 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 gen_dwfc (isw_sl)
!-----------------------------------------------------------------------
!
! Calculates and writes | d/du(0) psi(k+q) >
!
! Several cases are possible:
! isw_sl = 1 : it calculates | d/du(q) psi_k >
! isw_sl = 2 : it calculates | d/du(0) psi_k+q >
! isw_sl = 3,4 : it calculates | d/du(0) psi_k >
!
USE io_global, ONLY : stdout, ionode
USE pwcom
USE phcom
USE d3com
!
IMPLICIT NONE
!
INTEGER isw_sl, nirr_x, irr, irr1, imode0
! switch
! the number of irreducible representation
! counter on the representations
! counter on the representations
! counter on the modes
INTEGER, POINTER :: npert_x (:)
! the number of perturbations per IR
IF (isw_sl.EQ.1) THEN
nirr_x = nirr
npert_x => npert
ELSE
nirr_x = nirrg0
npert_x => npertg0
ENDIF
!
! For each irreducible representation we compute the change
! of the wavefunctions
!
DO irr = 1, nirr_x
imode0 = 0
DO irr1 = 1, irr - 1
imode0 = imode0 + npert_x (irr1)
ENDDO
IF (npert_x (irr) .EQ.1) THEN
WRITE( stdout, '(//,5x,"Representation #", i3, &
& " mode # ",i3)') irr, imode0 + 1
ELSE
WRITE( stdout, '(//,5x,"Representation #", i3, &
& " modes # ",3i3)') irr, (imode0 + irr1, irr1 = &
& 1, npert_x (irr) )
ENDIF
CALL solve_linter_d3 (irr, imode0, npert_x (irr), isw_sl)
ENDDO
!
! Writes FermiEnergy shift on a file
!
IF ( ionode ) THEN
!
IF (isw_sl.EQ.3.AND.degauss.NE.0.d0) THEN
REWIND (unit = iuef)
WRITE (iuef) ef_sh
ENDIF
!
END IF
!
! closes and opens some units --useful in case of interrupted run--
!
CALL close_open (isw_sl)
RETURN
END SUBROUTINE gen_dwfc

119
PHonon/D3/incdrhoscf2.f90
View File

@ -1,119 +0,0 @@
!
! Copyright (C) 2001 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 incdrhoscf2 (drhoscf, weight, ik, dbecsum, mode, flag)
!-----------------------------------------------------------------------
!
! This routine computes the change of the charge density due to the
! perturbation. It is called at the end of the computation of the
! change of the wavefunction for a given k point.
!
!
USE ions_base, ONLY : nat
USE kinds, only : DP
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : invfft
use pwcom
USE wavefunctions_module, ONLY: evc
USE uspp, ONLY: okvan
USE uspp_param, ONLY: nhm
use phcom
USE qpoint, ONLY : npwq, igkq
USE control_lr, ONLY : lgamma
implicit none
integer :: ik
! input: the k point
real (DP) :: weight
! input: the weight of the k point
complex (DP) :: drhoscf (dffts%nnr), dbecsum (nhm * (nhm + 1) / 2, nat)
! output: the change of the charge densit
! inp/out: the accumulated dbec
integer :: mode, flag
! flag =1 if dpsi is used (in solve_linte
! flag!=1 if dpsi is not used (in addusdd
!
! here the local variable
!
real (DP) :: wgt
! the effective weight of the k point
complex (DP), allocatable :: psi (:), dpsic (:)
! the wavefunctions in real space
! the change of wavefunctions in real space
integer :: ibnd, jbnd, ikk, ir, ig
! counters
call start_clock ('incdrhoscf')
allocate (dpsic( dffts%nnr))
allocate (psi ( dffts%nnr))
wgt = 2.d0 * weight / omega
if (lgamma) then
ikk = ik
else
ikk = 2 * ik - 1
endif
!
! dpsi contains the perturbed wavefunctions of this k point
! evc contains the unperturbed wavefunctions of this k point
!
! do ibnd = 1,nbnd_occ(ikk)
do ibnd = 1, nbnd
psi (:) = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk (ig) ) ) = evc (ig, ibnd)
enddo
CALL invfft ('Wave', psi, dffts)
dpsic(:) =(0.d0, 0.d0)
!
! here we add the term in the valence due to the change of the
! constraint. dvpsi is used as work space, dpsi is unchanged
!
if (flag == 1) then
dvpsi (:, ibnd) = dpsi (:, ibnd)
else
dvpsi (:, ibnd) = (0.d0, 0.d0)
endif
! call zgemm('N','N', npwq, nbnd, nbnd, (1.d0,0.d0),
! + evq, npwx, prodval(1,1,mode),nbnd,
! + (1.d0,0.d0),dvpsi,npwx)
if (okvan) then
call errore ('incdrhoscf2', 'US not allowed', 1)
! do jbnd=1,nbnd
! call zaxpy(npwq,prodval(jbnd,ibnd,mode),
! + evq(1,jbnd),1,dvpsi(1,ibnd),1)
! enddo
endif
do ig = 1, npwq
dpsic (nls (igkq (ig) ) ) = dvpsi (ig, ibnd)
enddo
CALL invfft ('Wave', dpsic, dffts)
do ir = 1, dffts%nnr
drhoscf (ir) = drhoscf (ir) + wgt * CONJG(psi (ir) ) * dpsic (ir)
! if (ir.lt.20) WRITE( stdout,*) drhoscf(ir)
enddo
enddo
call addusdbec (ik, wgt, dvpsi, dbecsum)
! WRITE( stdout,*) '*********************'
! do ig=1,20
! WRITE( stdout,*) dbecsum(ig,1)
! enddo
! call stoallocate (ph(.true.))
deallocate (psi)
deallocate (dpsic)
call stop_clock ('incdrhoscf')
return
end subroutine incdrhoscf2

403
PHonon/D3/make.depend
View File

@ -1,403 +0,0 @@
allocate_d3.o : ../../LR_Modules/lrcom.o
allocate_d3.o : ../../Modules/ions_base.o
allocate_d3.o : ../../Modules/uspp.o
allocate_d3.o : ../../PHonon/PH/phcom.o
allocate_d3.o : ../../PW/src/pwcom.o
allocate_d3.o : d3com.o
allocate_pert_d3.o : ../../LR_Modules/lrcom.o
allocate_pert_d3.o : ../../Modules/ions_base.o
allocate_pert_d3.o : ../../Modules/kind.o
allocate_pert_d3.o : ../../PHonon/PH/phcom.o
allocate_pert_d3.o : d3com.o
bcast_d3_input.o : ../../LR_Modules/lrcom.o
bcast_d3_input.o : ../../Modules/control_flags.o
bcast_d3_input.o : ../../Modules/io_files.o
bcast_d3_input.o : ../../Modules/ions_base.o
bcast_d3_input.o : ../../Modules/mp.o
bcast_d3_input.o : ../../Modules/mp_world.o
bcast_d3_input.o : ../../Modules/run_info.o
bcast_d3_input.o : ../../PHonon/PH/phcom.o
bcast_d3_input.o : ../../PW/src/pwcom.o
bcast_d3_input.o : d3com.o
ch_psi_all2.o : ../../LR_Modules/lrcom.o
ch_psi_all2.o : ../../Modules/becmod.o
ch_psi_all2.o : ../../Modules/kind.o
ch_psi_all2.o : ../../Modules/mp.o
ch_psi_all2.o : ../../Modules/mp_global.o
ch_psi_all2.o : ../../Modules/uspp.o
ch_psi_all2.o : ../../PHonon/PH/phcom.o
ch_psi_all2.o : ../../PW/src/pwcom.o
close_open.o : ../../LR_Modules/lrcom.o
close_open.o : ../../Modules/io_files.o
close_open.o : ../../Modules/io_global.o
close_open.o : ../../PHonon/PH/phcom.o
close_open.o : ../../PW/src/pwcom.o
close_open.o : d3com.o
d0rhod2v.o : ../../FFTXlib/fft_interfaces.o
d0rhod2v.o : ../../LR_Modules/lrcom.o
d0rhod2v.o : ../../Modules/fft_base.o
d0rhod2v.o : ../../Modules/io_files.o
d0rhod2v.o : ../../Modules/io_global.o
d0rhod2v.o : ../../Modules/ions_base.o
d0rhod2v.o : ../../Modules/kind.o
d0rhod2v.o : ../../Modules/mp.o
d0rhod2v.o : ../../Modules/mp_global.o
d0rhod2v.o : ../../Modules/uspp.o
d0rhod2v.o : ../../Modules/wavefunctions.o
d0rhod2v.o : ../../PHonon/PH/phcom.o
d0rhod2v.o : ../../PW/src/pwcom.o
d0rhod2v.o : d3com.o
d2mxc.o : ../../Modules/constants.o
d2mxc.o : ../../Modules/kind.o
d3_exc.o : ../../Modules/fft_base.o
d3_exc.o : ../../Modules/io_global.o
d3_exc.o : ../../Modules/ions_base.o
d3_exc.o : ../../Modules/kind.o
d3_exc.o : ../../Modules/mp.o
d3_exc.o : ../../Modules/mp_global.o
d3_exc.o : ../../PHonon/PH/phcom.o
d3_exc.o : ../../PW/src/pwcom.o
d3_exc.o : ../../PW/src/scf_mod.o
d3_exc.o : d3com.o
d3_init.o : ../../LR_Modules/lrcom.o
d3_init.o : ../../Modules/atom.o
d3_init.o : ../../Modules/fft_base.o
d3_init.o : ../../Modules/ions_base.o
d3_init.o : ../../Modules/mp.o
d3_init.o : ../../Modules/mp_world.o
d3_init.o : ../../Modules/uspp.o
d3_init.o : ../../PHonon/PH/phcom.o
d3_init.o : ../../PW/src/pwcom.o
d3_init.o : ../../PW/src/symm_base.o
d3_init.o : d3com.o
d3_readin.o : ../../LR_Modules/lrcom.o
d3_readin.o : ../../Modules/control_flags.o
d3_readin.o : ../../Modules/fft_base.o
d3_readin.o : ../../Modules/io_files.o
d3_readin.o : ../../Modules/io_global.o
d3_readin.o : ../../Modules/ions_base.o
d3_readin.o : ../../Modules/mp.o
d3_readin.o : ../../Modules/mp_bands.o
d3_readin.o : ../../Modules/mp_world.o
d3_readin.o : ../../Modules/noncol.o
d3_readin.o : ../../Modules/run_info.o
d3_readin.o : ../../Modules/uspp.o
d3_readin.o : ../../PHonon/PH/phcom.o
d3_readin.o : ../../PW/src/pwcom.o
d3_readin.o : d3com.o
d3_recover.o : ../../Modules/io_files.o
d3_recover.o : ../../Modules/io_global.o
d3_recover.o : ../../Modules/mp.o
d3_recover.o : ../../Modules/mp_world.o
d3_recover.o : ../../PHonon/PH/phcom.o
d3_recover.o : ../../PW/src/pwcom.o
d3_recover.o : d3com.o
d3_setup.o : ../../LR_Modules/lrcom.o
d3_setup.o : ../../Modules/constants.o
d3_setup.o : ../../Modules/control_flags.o
d3_setup.o : ../../Modules/fft_base.o
d3_setup.o : ../../Modules/funct.o
d3_setup.o : ../../Modules/io_files.o
d3_setup.o : ../../Modules/io_global.o
d3_setup.o : ../../Modules/ions_base.o
d3_setup.o : ../../Modules/kind.o
d3_setup.o : ../../Modules/mp.o
d3_setup.o : ../../Modules/mp_global.o
d3_setup.o : ../../Modules/uspp.o
d3_setup.o : ../../PHonon/PH/phcom.o
d3_setup.o : ../../PW/src/pwcom.o
d3_setup.o : ../../PW/src/scf_mod.o
d3_setup.o : ../../PW/src/symm_base.o
d3_setup.o : d3com.o
d3_summary.o : ../../LR_Modules/lrcom.o
d3_summary.o : ../../Modules/constants.o
d3_summary.o : ../../Modules/control_flags.o
d3_summary.o : ../../Modules/fft_base.o
d3_summary.o : ../../Modules/gvecw.o
d3_summary.o : ../../Modules/io_global.o
d3_summary.o : ../../Modules/ions_base.o
d3_summary.o : ../../Modules/kind.o
d3_summary.o : ../../Modules/run_info.o
d3_summary.o : ../../PHonon/PH/phcom.o
d3_summary.o : ../../PW/src/pwcom.o
d3_summary.o : ../../PW/src/symm_base.o
d3_summary.o : d3com.o
d3_symdyn.o : ../../Modules/kind.o
d3_symdyn.o : ../../Modules/mp.o
d3_symdyn.o : ../../Modules/mp_global.o
d3_symdynph.o : ../../Modules/constants.o
d3_symdynph.o : ../../Modules/kind.o
d3_valence.o : ../../LR_Modules/lrcom.o
d3_valence.o : ../../Modules/ions_base.o
d3_valence.o : ../../Modules/kind.o
d3_valence.o : ../../Modules/mp.o
d3_valence.o : ../../Modules/mp_global.o
d3_valence.o : ../../PHonon/PH/phcom.o
d3_valence.o : ../../PW/src/pwcom.o
d3_valence.o : d3com.o
d3com.o : ../../Modules/kind.o
d3dyn_cc.o : ../../FFTXlib/fft_interfaces.o
d3dyn_cc.o : ../../LR_Modules/lrcom.o
d3dyn_cc.o : ../../Modules/fft_base.o
d3dyn_cc.o : ../../Modules/funct.o
d3dyn_cc.o : ../../Modules/ions_base.o
d3dyn_cc.o : ../../Modules/kind.o
d3dyn_cc.o : ../../Modules/mp.o
d3dyn_cc.o : ../../Modules/mp_global.o
d3dyn_cc.o : ../../Modules/uspp.o
d3dyn_cc.o : ../../PHonon/PH/phcom.o
d3dyn_cc.o : ../../PW/src/pwcom.o
d3dyn_cc.o : ../../PW/src/scf_mod.o
d3dyn_cc.o : d3com.o
d3ionq.o : ../../Modules/constants.o
d3ionq.o : ../../Modules/io_global.o
d3ionq.o : ../../Modules/kind.o
d3ionq.o : ../../Modules/mp.o
d3ionq.o : ../../Modules/mp_global.o
d3matrix.o : ../../LR_Modules/lrcom.o
d3matrix.o : ../../Modules/ions_base.o
d3matrix.o : ../../Modules/kind.o
d3matrix.o : ../../Modules/run_info.o
d3matrix.o : ../../PHonon/PH/phcom.o
d3matrix.o : ../../PW/src/pwcom.o
d3matrix.o : ../../PW/src/symm_base.o
d3matrix.o : d3com.o
d3toten.o : ../../LR_Modules/lrcom.o
d3toten.o : ../../Modules/control_flags.o
d3toten.o : ../../Modules/environment.o
d3toten.o : ../../Modules/io_files.o
d3toten.o : ../../Modules/io_global.o
d3toten.o : ../../Modules/ions_base.o
d3toten.o : ../../Modules/mp_global.o
d3toten.o : ../../PHonon/PH/phcom.o
d3toten.o : ../../PW/src/pwcom.o
d3toten.o : d3com.o
d3vrho.o : ../../FFTXlib/fft_interfaces.o
d3vrho.o : ../../LR_Modules/lrcom.o
d3vrho.o : ../../Modules/cell_base.o
d3vrho.o : ../../Modules/constants.o
d3vrho.o : ../../Modules/fft_base.o
d3vrho.o : ../../Modules/io_files.o
d3vrho.o : ../../Modules/ions_base.o
d3vrho.o : ../../Modules/kind.o
d3vrho.o : ../../Modules/mp.o
d3vrho.o : ../../Modules/mp_global.o
d3vrho.o : ../../Modules/recvec.o
d3vrho.o : ../../Modules/uspp.o
d3vrho.o : ../../Modules/wavefunctions.o
d3vrho.o : ../../PHonon/PH/phcom.o
d3vrho.o : ../../PW/src/pwcom.o
d3vrho.o : ../../PW/src/scf_mod.o
d3vrho.o : d3com.o
davcio_drho2.o : ../../FFTXlib/scatter_mod.o
davcio_drho2.o : ../../Modules/fft_base.o
davcio_drho2.o : ../../Modules/io_global.o
davcio_drho2.o : ../../Modules/kind.o
davcio_drho2.o : ../../Modules/mp.o
davcio_drho2.o : ../../Modules/mp_global.o
davcio_drho2.o : ../../Modules/mp_world.o
davcio_drho2.o : ../../PHonon/PH/phcom.o
davcio_drho2.o : ../../PW/src/pwcom.o
dpsi_corr.o : ../../LR_Modules/lrcom.o
dpsi_corr.o : ../../Modules/kind.o
dpsi_corr.o : ../../PHonon/PH/phcom.o
dpsi_corr.o : ../../PW/src/pwcom.o
dpsi_corr.o : d3com.o
dpsidpsidv.o : ../../LR_Modules/lrcom.o
dpsidpsidv.o : ../../Modules/ions_base.o
dpsidpsidv.o : ../../Modules/kind.o
dpsidpsidv.o : ../../Modules/mp.o
dpsidpsidv.o : ../../Modules/mp_global.o
dpsidpsidv.o : ../../PHonon/PH/phcom.o
dpsidpsidv.o : ../../PW/src/pwcom.o
dpsidpsidv.o : d3com.o
dpsidvdpsi.o : ../../LR_Modules/lrcom.o
dpsidvdpsi.o : ../../Modules/fft_base.o
dpsidvdpsi.o : ../../Modules/io_files.o
dpsidvdpsi.o : ../../Modules/ions_base.o
dpsidvdpsi.o : ../../Modules/kind.o
dpsidvdpsi.o : ../../Modules/mp.o
dpsidvdpsi.o : ../../Modules/mp_global.o
dpsidvdpsi.o : ../../Modules/uspp.o
dpsidvdpsi.o : ../../PHonon/PH/phcom.o
dpsidvdpsi.o : ../../PW/src/pwcom.o
dpsidvdpsi.o : d3com.o
dqrhod2v.o : ../../FFTXlib/fft_interfaces.o
dqrhod2v.o : ../../LR_Modules/lrcom.o
dqrhod2v.o : ../../Modules/fft_base.o
dqrhod2v.o : ../../Modules/io_files.o
dqrhod2v.o : ../../Modules/ions_base.o
dqrhod2v.o : ../../Modules/kind.o
dqrhod2v.o : ../../Modules/mp.o
dqrhod2v.o : ../../Modules/mp_global.o
dqrhod2v.o : ../../Modules/uspp.o
dqrhod2v.o : ../../Modules/wavefunctions.o
dqrhod2v.o : ../../PHonon/PH/phcom.o
dqrhod2v.o : ../../PW/src/pwcom.o
dqrhod2v.o : d3com.o
drho_cc.o : ../../LR_Modules/lrcom.o
drho_cc.o : ../../Modules/kind.o
drho_cc.o : ../../Modules/uspp.o
drho_cc.o : ../../PHonon/PH/phcom.o
drho_cc.o : ../../PW/src/pwcom.o
drho_cc.o : d3com.o
drho_drc.o : ../../FFTXlib/fft_interfaces.o
drho_drc.o : ../../Modules/fft_base.o
drho_drc.o : ../../Modules/ions_base.o
drho_drc.o : ../../Modules/kind.o
drho_drc.o : ../../Modules/mp.o
drho_drc.o : ../../Modules/mp_world.o
drho_drc.o : ../../Modules/uspp.o
drho_drc.o : ../../PHonon/PH/phcom.o
drho_drc.o : ../../PW/src/pwcom.o
drho_drc.o : d3com.o
drhod2v.o : ../../Modules/fft_base.o
drhod2v.o : ../../Modules/ions_base.o
drhod2v.o : ../../Modules/kind.o
drhod2v.o : ../../PHonon/PH/phcom.o
drhod2v.o : ../../PW/src/pwcom.o
drhod2v.o : d3com.o
dvdpsi.o : ../../FFTXlib/fft_interfaces.o
dvdpsi.o : ../../LR_Modules/lrcom.o
dvdpsi.o : ../../Modules/cell_base.o
dvdpsi.o : ../../Modules/fft_base.o
dvdpsi.o : ../../Modules/ions_base.o
dvdpsi.o : ../../Modules/mp.o
dvdpsi.o : ../../Modules/mp_global.o
dvdpsi.o : ../../Modules/recvec.o
dvdpsi.o : ../../Modules/uspp.o
dvdpsi.o : ../../PHonon/PH/phcom.o
dvdpsi.o : ../../PW/src/pwcom.o
dvdpsi.o : d3com.o
dvscf.o : ../../FFTXlib/fft_interfaces.o
dvscf.o : ../../Modules/fft_base.o
dvscf.o : ../../Modules/ions_base.o
dvscf.o : ../../Modules/kind.o
dvscf.o : ../../Modules/uspp.o
dvscf.o : ../../PHonon/PH/phcom.o
dvscf.o : ../../PW/src/pwcom.o
dvscf.o : d3com.o
gen_dpdvp.o : ../../LR_Modules/lrcom.o
gen_dpdvp.o : ../../Modules/fft_base.o
gen_dpdvp.o : ../../Modules/io_files.o
gen_dpdvp.o : ../../Modules/ions_base.o
gen_dpdvp.o : ../../Modules/kind.o
gen_dpdvp.o : ../../Modules/mp.o
gen_dpdvp.o : ../../Modules/mp_global.o
gen_dpdvp.o : ../../Modules/uspp.o
gen_dpdvp.o : ../../Modules/wavefunctions.o
gen_dpdvp.o : ../../PHonon/PH/phcom.o
gen_dpdvp.o : ../../PW/src/pwcom.o
gen_dpdvp.o : d3com.o
gen_dwfc.o : ../../Modules/io_global.o
gen_dwfc.o : ../../PHonon/PH/phcom.o
gen_dwfc.o : ../../PW/src/pwcom.o
gen_dwfc.o : d3com.o
incdrhoscf2.o : ../../FFTXlib/fft_interfaces.o
incdrhoscf2.o : ../../LR_Modules/lrcom.o
incdrhoscf2.o : ../../Modules/fft_base.o
incdrhoscf2.o : ../../Modules/ions_base.o
incdrhoscf2.o : ../../Modules/kind.o
incdrhoscf2.o : ../../Modules/uspp.o
incdrhoscf2.o : ../../Modules/wavefunctions.o
incdrhoscf2.o : ../../PHonon/PH/phcom.o
incdrhoscf2.o : ../../PW/src/pwcom.o
openfild3.o : ../../LR_Modules/lrcom.o
openfild3.o : ../../Modules/control_flags.o
openfild3.o : ../../Modules/fft_base.o
openfild3.o : ../../Modules/io_files.o
openfild3.o : ../../Modules/io_global.o
openfild3.o : ../../Modules/mp_global.o
openfild3.o : ../../Modules/uspp.o
openfild3.o : ../../PHonon/PH/phcom.o
openfild3.o : ../../PW/src/pwcom.o
openfild3.o : d3com.o
print_clock_d3.o : ../../Modules/io_global.o
print_clock_d3.o : d3com.o
psymd0rho.o : ../../FFTXlib/scatter_mod.o
psymd0rho.o : ../../LR_Modules/lrcom.o
psymd0rho.o : ../../Modules/fft_base.o
psymd0rho.o : ../../Modules/ions_base.o
psymd0rho.o : ../../Modules/kind.o
psymd0rho.o : ../../Modules/mp_global.o
psymd0rho.o : ../../PHonon/PH/phcom.o
psymd0rho.o : ../../PW/src/pwcom.o
psymd0rho.o : ../../PW/src/symm_base.o
psymd0rho.o : d3com.o
qstar_d3.o : ../../Modules/kind.o
read_ef.o : ../../Modules/io_global.o
read_ef.o : ../../Modules/mp.o
read_ef.o : ../../Modules/mp_world.o
read_ef.o : ../../PW/src/pwcom.o
read_ef.o : d3com.o
rotate_and_add_d3.o : ../../Modules/constants.o
rotate_and_add_d3.o : ../../Modules/kind.o
set_d3irr.o : ../../LR_Modules/lrcom.o
set_d3irr.o : ../../Modules/control_flags.o
set_d3irr.o : ../../Modules/io_files.o
set_d3irr.o : ../../Modules/ions_base.o
set_d3irr.o : ../../Modules/kind.o
set_d3irr.o : ../../PHonon/PH/phcom.o
set_d3irr.o : ../../PW/src/pwcom.o
set_d3irr.o : ../../PW/src/symm_base.o
set_d3irr.o : d3com.o
set_efsh.o : ../../FFTXlib/fft_interfaces.o
set_efsh.o : ../../LR_Modules/lrcom.o
set_efsh.o : ../../Modules/fft_base.o
set_efsh.o : ../../Modules/io_global.o
set_efsh.o : ../../Modules/kind.o
set_efsh.o : ../../Modules/mp.o
set_efsh.o : ../../Modules/mp_global.o
set_efsh.o : ../../PHonon/PH/phcom.o
set_efsh.o : ../../PW/src/pwcom.o
set_efsh.o : d3com.o
set_sym_irr.o : ../../Modules/constants.o
set_sym_irr.o : ../../Modules/kind.o
set_sym_irr.o : ../../Modules/mp.o
set_sym_irr.o : ../../Modules/mp_world.o
solve_linter_d3.o : ../../LR_Modules/lrcom.o
solve_linter_d3.o : ../../Modules/cell_base.o
solve_linter_d3.o : ../../Modules/fft_base.o
solve_linter_d3.o : ../../Modules/io_files.o
solve_linter_d3.o : ../../Modules/io_global.o
solve_linter_d3.o : ../../Modules/ions_base.o
solve_linter_d3.o : ../../Modules/kind.o
solve_linter_d3.o : ../../Modules/mp.o
solve_linter_d3.o : ../../Modules/mp_global.o
solve_linter_d3.o : ../../Modules/recvec.o
solve_linter_d3.o : ../../Modules/uspp.o
solve_linter_d3.o : ../../Modules/wavefunctions.o
solve_linter_d3.o : ../../PHonon/PH/phcom.o
solve_linter_d3.o : ../../PW/src/pwcom.o
solve_linter_d3.o : d3com.o
stop_d3.o : ../../LR_Modules/lrcom.o
stop_d3.o : ../../Modules/control_flags.o
stop_d3.o : ../../Modules/io_files.o
stop_d3.o : ../../Modules/mp_global.o
stop_d3.o : ../../Modules/uspp.o
stop_d3.o : ../../PHonon/PH/phcom.o
stop_d3.o : ../../PW/src/pwcom.o
stop_d3.o : d3com.o
sym_def1.o : ../../LR_Modules/lrcom.o
sym_def1.o : ../../Modules/kind.o
sym_def1.o : ../../PHonon/PH/phcom.o
sym_def1.o : ../../PW/src/pwcom.o
sym_def1.o : d3com.o
symd0rho.o : ../../Modules/kind.o
trntnsc_3.o : ../../Modules/kind.o
w_1gauss.o : ../../Modules/constants.o
w_1gauss.o : ../../Modules/kind.o
write_aux.o : ../../Modules/ions_base.o
write_aux.o : ../../PHonon/PH/phcom.o
write_aux.o : ../../PW/src/pwcom.o
write_aux.o : d3com.o
write_d3dyn.o : ../../Modules/kind.o
write_igk.o : ../../LR_Modules/lrcom.o
write_igk.o : ../../Modules/io_files.o
write_igk.o : ../../PW/src/pwcom.o
writed3dyn_5.o : ../../Modules/io_global.o
writed3dyn_5.o : ../../Modules/ions_base.o
writed3dyn_5.o : ../../Modules/kind.o
writed3dyn_5.o : ../../PHonon/PH/phcom.o
writed3dyn_5.o : ../../PW/src/pwcom.o
writed3dyn_5.o : d3com.o

196
PHonon/D3/openfild3.f90
View File

@ -1,196 +0,0 @@
!
! Copyright (C) 2001-2003 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 openfild3
!-----------------------------------------------------------------------
!
! This subroutine opens all the files necessary for the
! third derivative calculation.
!
USE pwcom
USE phcom
USE d3com
USE fft_base, ONLY : dfftp
USE control_flags, ONLY : twfcollect
USE io_files, ONLY : iunigk, prefix, tmp_dir, diropn, seqopn
USE io_global, ONLY : ionode
USE mp_global, ONLY : kunit, me_pool, root_pool
USE uspp, ONLY : nlcc_any
USE control_lr, ONLY : lgamma
!
IMPLICIT NONE
!
INTEGER :: ios
! integer variable for I/O control
CHARACTER (len=256) :: filint, tmp_dir_save
! the name of the file
LOGICAL :: exst
! logical variable to check file existe
INTEGER :: ndr, kunittmp, ierr
REAL(DP) :: edum(1,1), wdum(1,1)
twfcollect=.FALSE.
IF (LEN_TRIM(prefix) == 0) CALL errore ('openfild3', 'wrong prefix', 1)
!
! The file with the wavefunctions
!
iuwfc = 20
lrwfc = 2 * nbnd * npwx
CALL diropn (iuwfc, 'wfc', lrwfc, exst)
IF (.NOT.exst) THEN
CALL errore ('openfild3', 'file ' // TRIM(prefix) //'.wfc not found', 1)
END IF
!
! The file with deltaV_{bare} * psi
!
iubar = 21
lrbar = 2 * nbnd * npwx
CALL diropn (iubar, 'bar', lrbar, exst)
IF (recover.AND..NOT.exst) &
CALL errore ('openfild3', 'file ' // TRIM(prefix) //'.bar not found', 1)
!
! The file with the solution delta psi
!
iudwf = 22
lrdwf = 2 * nbnd * npwx
CALL diropn (iudwf, 'dwf', lrdwf, exst)
IF (recover.AND..NOT.exst) &
CALL errore ('openfild3', 'file ' // TRIM(prefix) //'.dwf not found', 1)
!
! Here the sequential files
!
! The igk at a given k (and k+q if q!=0)
!
iunigk = 24
CALL seqopn (iunigk, 'igk', 'unformatted', exst)
!
! a formatted file which contains the dynamical matrix in cartesian
! coordinates is opened in the current directory
!
! ... by the first node only, other nodes write on unit 6 (i.e. /dev/null)
!
IF ( ionode ) THEN
!
iudyn = 26
OPEN (unit=iudyn, file=fildyn, status='unknown', err=110, iostat=ios)
110 CALL errore ('openfild3', 'opening file'//fildyn, ABS (ios) )
REWIND (iudyn)
!
ELSE
!
iudyn = 6
!
END IF
!cccccccccccccccccccccccccccccccccccccccccccccccccccccc
!
! Variation of the charge density with respect to a perturbation
! with a generic q
!
iudrho = 25
iud0rho = 33
IF (lgamma) iud0rho = iudrho
lrdrho = 2 * dfftp%nr1x * dfftp%nr2x * dfftp%nr3x * nspin
!
! is opened only by the first task of each pool
!
IF ( me_pool == root_pool ) THEN
!
filint = TRIM(fildrho) !//".u"
! FIXME: workaround for filename mess
tmp_dir_save=tmp_dir
if ( lgamma) tmp_dir=TRIM(tmp_dir)//'_ph0/'
!
CALL diropn (iudrho, filint, lrdrho, exst)
IF(nlcc_any) CALL diropn (iudrho+1000, trim(filint)//"_cc", lrdrho, exst)
!
tmp_dir=tmp_dir_save
! FIXME END
!
! Variation of the charge density with respect to a perturbation with q=
! Not needed if q=0
!
IF (.NOT.lgamma) THEN
filint = TRIM(fild0rho) !//".u"
CALL diropn (iud0rho, filint, lrdrho, exst)
IF(nlcc_any) CALL diropn (iud0rho+1000, trim(filint)//"_cc", lrdrho, exst)
ENDIF
!
END IF
!
! If q=0, we need only one file with the variation of the wavefunctions
!
iud0qwf = iudwf
iudqwf = iudwf
IF (.NOT.lgamma) THEN
!
! Open the file with the solution q=0 delta psi
!
iud0qwf = 34
CALL diropn (iud0qwf, 'd0wf', lrdwf, exst)
!
! Open the file with the solution q=0 delta psi
!
iudqwf = 35
CALL diropn (iudqwf, 'dqwf', lrdwf, exst)
ENDIF
!
! The file with <psi| dqV |psi>
!
iupdqvp = 36
lrpdqvp = 2 * nbnd * nbnd
CALL diropn (iupdqvp, 'pdp' , lrpdqvp, exst)
!
! The file with <psi| d0V |psi>
!
iupd0vp = iupdqvp
IF (.NOT.lgamma) THEN
iupd0vp = 37
CALL diropn (iupd0vp, 'p0p', lrpdqvp, exst)
ENDIF
IF (degauss.NE.0.d0) THEN
!
! The file with <dqpsi| dqV |psi> (only in the metallic case)
!
iudpdvp_1 = 38
lrdpdvp = 2 * nbnd * nbnd
CALL diropn (iudpdvp_1, 'pv1' , lrdpdvp, exst)
!
! The file with <dqpsi| d0V |psi>
!
iudpdvp_2 = iudpdvp_1
iudpdvp_3 = iudpdvp_1
IF (.NOT.lgamma) THEN
iudpdvp_2 = 39
CALL diropn (iudpdvp_2, 'pv2' , lrdpdvp, exst)
!
! The file with <d0psi| dqV |psi>
!
iudpdvp_3 = 40
CALL diropn (iudpdvp_3, 'pv3', lrdpdvp, exst)
ENDIF
!
! The file containing the variation of the FermiEnergy ef_sh
!
! opened only by the first task of the first pool
!
IF ( ionode ) THEN
!
iuef = 41
CALL seqopn (iuef, 'efs', 'unformatted', exst)
!
END IF
!
ENDIF
RETURN
END SUBROUTINE openfild3

60
PHonon/D3/print_clock_d3.f90
View File

@ -1,60 +0,0 @@
!
! Copyright (C) 2001 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 print_clock_d3
USE io_global, ONLY : stdout
use d3com
implicit none
WRITE( stdout, * )
call print_clock ('D3TOTEN')
call print_clock ('d3_setup')
call print_clock ('phq_init')
WRITE( stdout, * )
call print_clock ('solve_linter')
call print_clock ('ortho')
call print_clock ('cgsolve')
call print_clock ('incdrhoscf')
call print_clock ('dv_of_drho')
#ifdef __MPI
call print_clock ('psymdvscf')
call print_clock ('psymd0rho')
#else
call print_clock ('symdvscf')
#endif
WRITE( stdout, * )
call print_clock ('cgsolve')
call print_clock ('ch_psi')
WRITE( stdout, * )
call print_clock ('ch_psi')
call print_clock ('h_psiq')
call print_clock ('last')
WRITE( stdout, * )
call print_clock ('h_psiq')
call print_clock ('firstfft')
call print_clock ('product')
call print_clock ('secondfft')
WRITE( stdout, * )
WRITE( stdout, * ) ' General routines'
call print_clock ('calbec')
call print_clock ('fft')
call print_clock ('ffts')
call print_clock ('fftw')
call print_clock ('cinterpolate')
call print_clock ('davcio')
WRITE( stdout, * )
#ifdef __MPI
WRITE( stdout, * ) ' Parallel routines'
call print_clock ('reduce')
#endif
return
end subroutine print_clock_d3

69
PHonon/D3/psymd0rho.f90
View File

@ -1,69 +0,0 @@
!
! Copyright (C) 2001 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 psymd0rho (nper, irr, dvtosym)
!-----------------------------------------------------------------------
! p-symmetrize the charge density.
!
#ifdef __MPI
USE kinds, ONLY : DP
USE ions_base, ONLY : nat
USE symm_base, ONLY : s, ftau
USE pwcom
USE phcom
USE d3com
USE mp_global, ONLY : me_pool
USE fft_base, ONLY : dfftp
USE scatter_mod, ONLY : cgather_sym
USE lr_symm_base, ONLY : irgq
IMPLICIT NONE
integer :: nper, irr
! the number of perturbations
! the representation under consideration
complex (DP) :: dvtosym (dfftp%nnr, nper)
! the potential to symmetrize
! local variables
integer :: i, iper, npp0
complex (DP),pointer :: ddvtosym (:,:)
! the potential to symmetrize
! if (nsymq.eq.1.and. (.not.minus_q) ) return
call start_clock ('psymd0rho')
allocate ( ddvtosym(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x, nper))
npp0 = 0
do i = 1, me_pool
npp0 = npp0 + dfftp%npp (i)
enddo
npp0 = npp0 * dfftp%nnp + 1
do iper = 1, nper
call cgather_sym (dfftp, dvtosym (:, iper), ddvtosym (:, iper) )
enddo
call symd0rho (npertx, nper, irr, ddvtosym, s, ftau, nsymg0, irgq, tg0, &
nat, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x)
do iper = 1, nper
call zcopy (dfftp%npp (me_pool+1) * dfftp%nnp, ddvtosym (npp0, iper), 1, dvtosym &
(1, iper), 1)
enddo
deallocate(ddvtosym)
call stop_clock ('psymd0rho')
#endif
return
end subroutine psymd0rho

126
PHonon/D3/qstar_d3.f90
View File

@ -1,126 +0,0 @@
!
! Copyright (C) 2001 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 qstar_d3 (d3dyn, at, bg, nat, nsym, s, invs, irt, rtau, &
nq, sxq, isq, imq, iudyn, wrmode)
!-----------------------------------------------------------------------
!
USE kinds, only : DP
implicit none
!
! input variables
!
integer :: nat, nsym, s (3, 3, 48), invs (48), irt (48, nat), &
nq, isq (48), imq, iudyn
! number of atoms in the unit cell
! number of symmetry operations
! the symmetry operations
! index of the inverse operations
! index of the rotated atom
! degeneracy of the star of q
! symmetry op. giving the rotated q
! index of -q in the star (0 if nont present)
! unit number
complex (DP) :: d3dyn (3 * nat, 3 * nat, 3 * nat)
! the dynmatrix derivative
real (DP) :: at (3, 3), bg (3, 3), rtau (3, 48, nat), sxq (3, 48)
! direct lattice vectors
! reciprocal lattice vectors
! position of rotated atoms for each sym.op.
! list of q in the star
logical :: wrmode (3 * nat )
! if .true. this mode is to be written
!
! local variables
!
integer :: iq, nsq, isym, na, nb, nc, icar, jcar, kcar, i, j, k
! counters
complex (DP), allocatable :: phi (:,:,:,:,:,:), phi2 (:,:,:,:,:,:)
! work space
allocate (phi (3,3,3,nat,nat,nat))
allocate (phi2(3,3,3,nat,nat,nat))
!
! Sets number of symmetry operations giving each q in the list
!
nsq = nsym / nq
if (nsq * nq /= nsym) call errore ('qstar_d3', 'wrong degeneracy', 1)
!
! Writes dyn.mat d3dyn(3*nat,3*nat,3*nat)
! on the 6-index array phi(3,3,3,nat,nat,nat)
!
do i = 1, 3 * nat
na = (i - 1) / 3 + 1
icar = i - 3 * (na - 1)
do j = 1, 3 * nat
nb = (j - 1) / 3 + 1
jcar = j - 3 * (nb - 1)
do k = 1, 3 * nat
nc = (k - 1) / 3 + 1
kcar = k - 3 * (nc - 1)
phi (icar, jcar, kcar, na, nb, nc) = d3dyn (i, j, k)
enddo
enddo
enddo
!
! Goes to crystal coordinates
!
do na = 1, nat
do nb = 1, nat
do nc = 1, nat
call trntnsc_3 (phi (1, 1, 1, na, nb, nc), at, bg, - 1)
enddo
enddo
enddo
!
! For each q of the star rotates phi with the appropriate sym.op. -> phi
!
do iq = 1, nq
phi2 (:,:,:,:,:,:) = (0.d0, 0.d0)
do isym = 1, nsym
if (isq (isym) == iq) then
call rotate_and_add_d3 (phi, phi2, nat, isym, s, invs, irt, &
rtau, sxq (1, iq) )
endif
enddo
phi2 = phi2 / DBLE (nsq)
!
! Back to cartesian coordinates
!
do na = 1, nat
do nb = 1, nat
do nc = 1, nat
call trntnsc_3 (phi2 (1, 1, 1, na, nb, nc), at, bg, + 1)
enddo
enddo
enddo
!
! Writes the dynamical matrix in cartesian coordinates on file
!
call write_d3dyn (sxq (1, iq), phi2, nat, iudyn, wrmode)
if (imq == 0) then
!
! if -q is not in the star recovers its matrix by time reversal
!
phi2 (:,:,:,:,:,:) = CONJG(phi2 (:,:,:,:,:,:) )
!
! and writes it (changing temporarily sign to q)
!
sxq (:, iq) = - sxq (:, iq)
call write_d3dyn (sxq (1, iq), phi2, nat, iudyn, wrmode)
sxq (:, iq) = - sxq (:, iq)
endif
enddo
deallocate (phi)
deallocate (phi2)
return
end subroutine qstar_d3

42
PHonon/D3/read_ef.f90
View File

@ -1,42 +0,0 @@
!
! Copyright (C) 2001-2003 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 read_ef()
!-----------------------------------------------------------------------
!
! Reads the shift of the Fermi Energy
!
USE pwcom
USE d3com
USE io_global, ONLY : ionode, ionode_id
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm
!
IMPLICIT NONE
!
INTEGER :: ios
!
IF (degauss == 0.d0 ) RETURN
!
IF ( ionode ) THEN
!
REWIND (unit = iuef)
READ (iuef, err = 100, iostat = ios) ef_sh
!
!
END IF
100 CALL mp_bcast(ios, ionode_id, world_comm)
CALL errore ('d3_valence', 'reading iuef', ABS (ios) )
CALL mp_bcast( ef_sh, ionode_id, world_comm )
RETURN
END SUBROUTINE read_ef

89
PHonon/D3/rotate_and_add_d3.f90
View File

@ -1,89 +0,0 @@
!
! Copyright (C) 2001 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 rotate_and_add_d3 (phi, phi2, nat, isym, s, invs, irt, &
rtau, sxq)
!-----------------------------------------------------------------------
! Rotates a third order matrix (phi) in crystal coordinates according
! to the specified symmetry operation and add the rotated matrix
! to phi2. phi is left unmodified.
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
implicit none
!
! input variables
!
integer :: nat, isym, s (3, 3, 48), invs (48), irt (48, nat)
! number of atoms in the unit cell
! index of the symm.op.
! the symmetry operations
! index of the inverse operations
! index of the rotated atom
complex (DP) :: phi (3, 3, 3, nat, nat, nat), phi2 (3, 3, 3, nat, nat, nat)
! the input d3dyn.mat.
! in crystal coordinates
! the rotated d3dyn.mat
! in crystal coordinates
real (DP) :: rtau (3, 48, nat), sxq (3)
! for each atom and rotation gives
! the R vector involved
! the rotated q involved in this sym.op
!
! local variables
!
integer :: na, nb, nc, sna, snb, snc, ism1, i, j, k, l, m, n
! counters on atoms
! indices of rotated atoms
! index of the inverse symm.op.
! generic counters
real (DP) :: arg
! argument of the phase
complex (DP) :: phase, work
ism1 = invs(isym)
do nc = 1, nat
snc = irt(isym,nc)
do na = 1, nat
do nb = 1, nat
sna = irt(isym,na)
snb = irt(isym,nb)
arg = (sxq (1) * (rtau(1,isym,na) - rtau(1,isym,nb) ) &
+ sxq (2) * (rtau(2,isym,na) - rtau(2,isym,nb) ) &
+ sxq (3) * (rtau(3,isym,na) - rtau(3,isym,nb) ) ) * tpi
phase = CMPLX(cos(arg),-sin(arg),kind=DP)
do m = 1, 3
do i = 1, 3
do j = 1, 3
work = CMPLX(0.d0, 0.d0,kind=DP)
do k = 1, 3
do l = 1, 3
do n = 1, 3
work = work &
+ s(m,n,ism1) * s(i,k,ism1) * s(j,l,ism1) &
* phi(n,k,l,nc,na,nb) * phase
enddo
enddo
enddo
phi2(m,i,j,snc,sna,snb) = phi2(m,i,j,snc,sna,snb) + work
enddo
enddo
enddo
enddo
enddo
enddo
return
end subroutine rotate_and_add_d3

68
PHonon/D3/set_d3irr.f90
View File

@ -1,68 +0,0 @@
!
! Copyright (C) 2001 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 set_d3irr
!-----------------------------------------------------------------------
!
! It computes a basis for all the irreducible representations of the
! group of the crystal, which are contained in the representation
! which has as basis the displacement vectors.
! This basis will be used for those quantities that depend on the
! q=0 perturbation.
!
! Receives in input: nsymg0, s, invs, irt, rtau
! Calculates: ug0, tg0, npertg0, nirrg0, irgq
!
! NB: It assumes that the phonon calculation for the q=0 case, has been
! performed with iswitch=-2 (modenum=0). If this is not the case the following
! routine does not work.
!
USE ions_base, ONLY : nat
USE kinds, only : DP
use pwcom
use symm_base, only : s, irt, invs
USE control_flags, ONLY : iverbosity
use phcom
use d3com
use io_files, only: tmp_dir
use lr_symm_base, ONLY : rtau, irgq
implicit none
integer :: w_nsymq, w_irotmq
! work array
! work array
real (DP) :: zero (3), w_gi (3, 48), w_gimq (3), xqck(3)
! a null vector
! work array
complex (DP) :: w_tmq (npertx, npertx, 3 * nat)
! work array
logical :: w_minus_q
! work array
zero = 0.0_dp
w_minus_q = .true.
if (nsymg0.gt.1) then
!call io_pattern(nat,fild0rho,nirrg0,npertg0,ug0,xqck,tmp_dir,-1)
call set_sym_irr (nat, at, bg, zero, s, invs, nsymg0, rtau, irt, &
irgq, w_nsymq, w_minus_q, w_irotmq, tg0, w_tmq, npertx, &
ug0, npertg0, nirrg0, w_gi, w_gimq, iverbosity)
else
call set_irr_nosym (nat, at, bg, zero, s, invs, nsymg0, rtau, &
irt, irgq, w_nsymq, w_minus_q, w_irotmq, tg0, w_tmq, &
npertx, ug0, npertg0, nirrg0, w_gi, w_gimq, iverbosity)
endif
return
end subroutine set_d3irr

97
PHonon/D3/set_efsh.f90
View File

@ -1,97 +0,0 @@
!
! Copyright (C) 2001 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 set_efsh (drhoscf, imode0, irr, npe)
!-----------------------------------------------------------------------
! This routine calculates the FermiEnergy shift
! and stores it in the variable ef_sh
!
USE kinds, only : DP
USE io_global, ONLY : stdout
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
use pwcom
use phcom
use d3com
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
use qpoint, ONLY : nksq
use control_lr, ONLY : lgamma
implicit none
integer :: npe, imode0, irr
! input: the number of perturbation
! input: the position of the current mode
! input: index of the current irr. rep.
complex (DP) :: drhoscf (dfftp%nnr, npe)
! input: variation of the charge density
integer :: ipert, ik, ikk, ibnd
! counters
complex (DP) :: delta_n, def (npertx)
! the change in electron number
! the change of the Fermi energy for each perturbation
real (DP) :: weight, wdelta
! kpoint weight
! delta function weight
real (DP), save :: dos_ef
! density of states at Ef
real (DP), external :: w0gauss
logical, save :: first = .true.
! Used for initialization
!
! first call: calculates density of states at Ef
!
if (first) then
first = .false.
dos_ef = 0.d0
do ik = 1, nksq
if (lgamma) then
ikk = ik
else
ikk = 2 * ik - 1
endif
weight = wk (ikk)
do ibnd = 1, nbnd
wdelta = w0gauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss) &
/ degauss
dos_ef = dos_ef + weight * wdelta
enddo
enddo
#ifdef __MPI
call mp_sum( dos_ef, inter_pool_comm )
#endif
endif
!
! determines Fermi energy shift (such that each pertubation is neutral)
!
WRITE( stdout, * )
do ipert = 1, npe
CALL fwfft ('Dense', drhoscf (:, ipert), dfftp)
#ifdef __MPI
delta_n = (0.d0, 0.d0)
if (gg (1) < 1.0d-8) delta_n = omega * drhoscf (nl (1), ipert)
call mp_sum ( delta_n, intra_pool_comm )
#else
delta_n = omega * drhoscf (nl (1), ipert)
#endif
def (ipert) = - delta_n / dos_ef
enddo
!
! symmetrizes the Fermi energy shift
!
call sym_def1 (def, irr)
do ipert = 1, npe
ef_sh (imode0 + ipert) = DBLE (def (ipert) )
enddo
WRITE( stdout, '(5x,"Pert. #",i3,": Fermi energy shift (Ry) =", &
& 2f10.4)') (ipert, def (ipert) , ipert = 1, npe)
return
end subroutine set_efsh

239
PHonon/D3/set_sym_irr.f90
View File

@ -1,239 +0,0 @@
!
! Copyright (C) 2001 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 set_sym_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, &
irgq, nsymq, minus_q, irotmq, t, tmq, npertx, u, &
npert, nirr, gi, gimq, iverbosity)
!---------------------------------------------------------------------
!
! This subroutine computes a basis for all the irreducible
! representations of the small group of q, which are contained
! in the representation which has as basis the displacement vectors.
! This is achieved by building a random hermitean matrix,
! symmetrizing it and diagonalizing the result. The eigenvectors
! give a basis for the irreducible representations of the
! small group of q.
!
! Furthermore it computes:
! 1) the small group of q
! 2) the possible G vectors associated to every symmetry operation
! 3) the matrices which represent the small group of q on the
! pattern basis.
!
! Original routine was from C. Bungaro.
! Revised Oct. 1995 by Andrea Dal Corso.
! April 1997: parallel stuff added (SdG)
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : world_comm, mpime, root
!
IMPLICIT NONE
!
! first the dummy variables
!
INTEGER :: nat, nsym, s (3, 3, 48), invs (48), irt (48, nat), &
iverbosity, npert (3 * nat), irgq (48), nsymq, irotmq, nirr, npertx
! input: the number of atoms
! input: the number of symmetries
! input: the symmetry matrices
! input: the inverse of each matrix
! input: the rotated of each atom
! input: write control
! output: the dimension of each represe
! output: the small group of q
! output: the order of the small group
! output: the symmetry sending q -> -q+
! output: the number of irr. representa
REAL(DP) :: xq (3), rtau (3, 48, nat), at (3, 3), bg (3, 3), &
gi (3, 48), gimq (3)
! input: the q point
! input: the R associated to each tau
! input: the direct lattice vectors
! input: the reciprocal lattice vectors
! output: [S(irotq)*q - q]
! output: [S(irotmq)*q + q]
COMPLEX(DP) :: u (3 * nat, 3 * nat), &
t (npertx, npertx, 48, 3 * nat), &
tmq (npertx, npertx, 3 * nat)
! output: the pattern vectors
! output: the symmetry matrices
! output: the matrice sending q -> -q+G
LOGICAL :: minus_q
! output: if true one symmetry send q -
!
INTEGER :: na, nb, imode, jmode, ipert, jpert, nsymtot, imode0, &
irr, ipol, jpol, isymq, irot, sna
! counter on atoms
! counter on atoms
! counter on modes
! counter on modes
! counter on perturbations
! counter on perturbations
! total number of symmetries
! auxiliry variable for mode counting
! counter on irreducible representation
! counter on polarizations
! counter on polarizations
! counter on symmetries
! counter on rotations
! the rotated atom
REAL(DP) :: eigen (3 * nat), modul, arg
! the eigenvalues of dynamical ma
! the modulus of the mode
! the argument of the phase
COMPLEX(DP) :: wdyn (3, 3, nat, nat), phi (3 * nat, 3 * nat), &
wrk_u (3, nat), wrk_ru (3, nat), fase
! the dynamical matrix
! the bi-dimensional dynamical ma
! one pattern
! the rotated of one pattern
! the phase factor
LOGICAL :: lgamma
! if true gamma point
IF ( mpime == root ) THEN
!
! Allocate the necessary quantities
!
lgamma = (xq(1).EQ.0.d0 .AND. xq(2).EQ.0.d0 .AND. xq(3).EQ.0.d0)
!
! find the small group of q
!
CALL smallgq (xq,at,bg,s,nsym,irgq,nsymq,irotmq,minus_q,gi,gimq)
!
! And we compute the matrices which represent the symmetry transformat
! in the basis of the displacements
!
t(:,:,:,:) = (0.d0, 0.d0)
tmq(:,:,:) = (0.d0, 0.d0)
IF (minus_q) THEN
nsymtot = nsymq + 1
ELSE
nsymtot = nsymq
ENDIF
DO isymq = 1, nsymtot
IF (isymq.LE.nsymq) THEN
irot = irgq (isymq)
ELSE
irot = irotmq
ENDIF
imode0 = 0
DO irr = 1, nirr
DO ipert = 1, npert (irr)
imode = imode0 + ipert
DO na = 1, nat
DO ipol = 1, 3
jmode = 3 * (na - 1) + ipol
wrk_u (ipol, na) = u (jmode, imode)
ENDDO
ENDDO
!
! transform this pattern to crystal basis
!
DO na = 1, nat
CALL trnvecc (wrk_u (1, na), at, bg, - 1)
ENDDO
!
! the patterns are rotated with this symmetry
!
wrk_ru(:,:) = (0.d0, 0.d0)
DO na = 1, nat
sna = irt (irot, na)
arg = 0.d0
DO ipol = 1, 3
arg = arg + xq (ipol) * rtau (ipol, irot, na)
ENDDO
arg = arg * tpi
IF (isymq.EQ.nsymtot.AND.minus_q) THEN
fase = CMPLX(COS (arg), SIN (arg) ,kind=DP)
ELSE
fase = CMPLX(COS (arg), - SIN (arg) ,kind=DP)
ENDIF
DO ipol = 1, 3
DO jpol = 1, 3
wrk_ru (ipol, sna) = wrk_ru (ipol, sna) + s (jpol, ipol, irot) &
* wrk_u (jpol, na) * fase
ENDDO
ENDDO
ENDDO
!
! Transform back the rotated pattern
!
DO na = 1, nat
CALL trnvecc (wrk_ru (1, na), at, bg, 1)
ENDDO
!
! Computes the symmetry matrices on the basis of the pattern
!
DO jpert = 1, npert (irr)
imode = imode0 + jpert
DO na = 1, nat
DO ipol = 1, 3
jmode = ipol + (na - 1) * 3
IF (isymq.EQ.nsymtot.AND.minus_q) THEN
tmq (jpert, ipert, irr) = tmq (jpert, ipert, irr) + CONJG (u ( &
jmode, imode) * wrk_ru (ipol, na) )
ELSE
t (jpert, ipert, irot, irr) = t (jpert, ipert, irot, irr) &
+ CONJG (u (jmode, imode) ) * wrk_ru (ipol, na)
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO
imode0 = imode0 + npert (irr)
ENDDO
ENDDO
!
! Note: the following lines are for testing purposes
!
! nirr = 1
! npert(1)=1
! do na=1,3*nat/2
! u(na,1)=(0.d0,0.d0)
! u(na+3*nat/2,1)=(0.d0,0.d0)
! enddo
! u(1,1)=(-1.d0,0.d0)
! WRITE( stdout,'(" Setting mode for testing ")')
! do na=1,3*nat
! WRITE( stdout,*) u(na,1)
! enddo
! nsymq=1
! minus_q=.false.
!
! parallel stuff: first node broadcasts everything to all nodes
!
END IF
CALL mp_bcast (gi, root, world_comm)
CALL mp_bcast (gimq, root, world_comm)
CALL mp_bcast (t, root, world_comm)
CALL mp_bcast (tmq, root, world_comm)
CALL mp_bcast (u, root, world_comm)
CALL mp_bcast (nsymq, root, world_comm)
CALL mp_bcast (npert, root, world_comm)
CALL mp_bcast (nirr, root, world_comm)
CALL mp_bcast (irotmq, root, world_comm)
CALL mp_bcast (irgq, root, world_comm)
CALL mp_bcast (minus_q, root, world_comm)
RETURN
END SUBROUTINE set_sym_irr

334
PHonon/D3/solve_linter_d3.f90
View File

@ -1,334 +0,0 @@
!
! Copyright (C) 2001 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 solve_linter_d3 (irr, imode0, npe, isw_sl)
!-----------------------------------------------------------------------
! This routine is a driver for the solution of the linear system whic
! defines the change of the wavefunction due to the perturbation.
! It reads from a file the charge variation due to perturbation
! and calculates variation of the wavefunctions.
!
! 1) It writes on file the proiection on conduction band of the variation
! of the wavefunction with respect to the perturbation
!
! Several cases are possible:
! isw_sl = 1 : calculates | Pc d/du(q) psi_k > and writes on: iudqwf
! isw_sl = 2 : calculates | Pc d/du(0) psi_k+q > and writes on: iud0qwf
! isw_sl = 3 : calculates | Pc d/du(0) psi_k > and writes on: iudwf
!
! 2) It writes on a file the scalar product of the wavefunctions with the
! K-S Hamiltonian
! isw_sl = 1 : calculates <psi_k+q|dH/du(q)|psi_k > and writes on: iupdqvp
! isw_sl = 3 : calculates <psi_k |dH/du(0)|psi_k > and writes on: iupd0vp
!
USE ions_base, ONLY : nat
USE cell_base, ONLY : tpiba2
USE io_global, ONLY : stdout
USE io_files, ONLY : iunigk
USE gvect, ONLY : g
USE fft_base, ONLY : dfftp
USE ener, ONLY : ef
USE klist, ONLY : xk, wk, degauss, ngauss
USE wvfct, ONLY : nbnd, npwx, npw, igk, g2kin, et
USE kinds, only : DP
USE uspp, ONLY : vkb
USE wavefunctions_module, ONLY : evc
use phcom
use d3com
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
use qpoint, ONLY : xq, igkq, npwq, nksq
use control_lr, ONLY : nbnd_occ, lgamma
implicit none
integer :: irr, npe, imode0, isw_sl
! input: the irreducible representation
! input: the number of perturbation
! input: the position of the modes
! input: a switch
real (DP) :: thresh, wg1, wg2, wwg, deltae, theta, anorm, averlt, &
eprec1, aux_avg (2), tcpu, xq_ (3)
! the convergence threshold
! weight for metals
! weight for metals
! weight for metals
! difference of energy
! the theta function
! the norm of the error
! average number of iterations
! cut-off for preconditioning
! auxiliary variable for avg. iter. coun
real (DP), external :: w0gauss, wgauss, get_clock
! function computing the delta function
! function computing the theta function
! cpu time
complex (DP) :: ps (nbnd), dbecsum, psidvpsi
! the scalar products
! dummy variable
! auxiliary dpsi dV matrix element between k+q and k wavefunctions
complex (DP), external :: zdotc
real (DP), allocatable :: h_diag (:,:)
! the diagonal part of the Hamiltonian
complex (DP), allocatable :: drhoscf (:,:), dvloc (:,:), &
spsi (:), auxg (:), dpsiaux (:,:)
! the variation of the charge
! variation of local part of the potential
! the function spsi
logical :: q0mode_f, conv_root, lmetq0
! if .true. it is useless to compute this
! true if linter is converged
! true if xq=(0,0,0) in a metal
integer :: ipert, ibnd, jbnd, lter, ltaver, lintercall, ik, ikk, &
ikq, ig, ir, nrec, ios, mode, iuaux
! counters
!
external ch_psi_all2, cg_psi
!
call start_clock ('solve_linter')
allocate (drhoscf( dfftp%nnr, npe))
allocate (dvloc( dfftp%nnr, npe))
allocate (spsi( npwx))
allocate (auxg( npwx))
if (degauss /= 0.d0) allocate (dpsiaux( npwx, nbnd))
allocate (h_diag( npwx, nbnd))
ltaver = 0
lintercall = 0
lmetq0 = (degauss /= 0.d0) .and. (isw_sl >= 3)
thresh = ethr_ph
if (isw_sl == 1) then
xq_ = xq
else
xq_ = 0.d0
endif
!
! calculates the variation of the local part of the K-S potential
!
do ipert = 1, npe
mode = imode0 + ipert
call dvscf (mode, dvloc (1, ipert), xq_)
enddo
drhoscf (:,:) = (0.d0, 0.d0)
rewind (unit = iunigk)
do ik = 1, nksq
read (iunigk, err = 100, iostat = ios) npw, igk
100 call errore ('solve_linter_d3', 'reading igk', abs (ios) )
if (lgamma) then
ikk = ik
ikq = ik
npwq = npw
else
read (iunigk, err = 200, iostat = ios) npwq, igkq
200 call errore ('solve_linter_d3', 'reading igkq', abs (ios) )
if (isw_sl == 1) then
ikk = 2 * ik - 1
ikq = 2 * ik
elseif (isw_sl == 2) then
ikk = 2 * ik
ikq = 2 * ik
npw = npwq
do ig = 1, npwx
igk (ig) = igkq (ig)
enddo
elseif (isw_sl == 3) then
ikk = 2 * ik - 1
ikq = 2 * ik - 1
npwq = npw
do ig = 1, npwx
igkq (ig) = igk (ig)
enddo
endif
endif
call init_us_2 (npw , igk , xk (1, ikk), vkb0)
call init_us_2 (npwq, igkq, xk (1, ikq), vkb )
!
! reads unperturbed wavefuctions psi(k) and psi(k+q)
!
call davcio (evc, lrwfc, iuwfc, ikk, - 1)
if (.not.lgamma) call davcio (evq, lrwfc, iuwfc, ikq, - 1)
!
! compute the kinetic energy
!
do ig = 1, npwq
g2kin (ig) = ( (xk (1, ikq) + g (1, igkq (ig) ) ) **2 + &
(xk (2, ikq) + g (2, igkq (ig) ) ) **2 + &
(xk (3, ikq) + g (3, igkq (ig) ) ) **2) * tpiba2
enddo
!
do ipert = 1, npe
q0mode_f = (.not.q0mode (imode0 + ipert) ) .and. (.not.lgamma) &
.and. (isw_sl /= 1)
if (q0mode_f) then
psidqvpsi(:,:) = (0.d0, 0.d0)
dpsi(:,:) = (0.d0, 0.d0)
lintercall = 1
goto 120
endif
!
! calculates dvscf_q*psi_k in G_space, for all bands
!
mode = imode0 + ipert
call dvdpsi (mode, xq_, dvloc (1, ipert), vkb0, vkb, evc, dvpsi)
!
! calculates matrix element of dvscf between k+q and k wavefunctions,
! that will be written on a file
!
if (degauss /= 0.d0) then
dpsiaux(:,:) = (0.d0, 0.d0)
end if
do ibnd = 1, nbnd
if (isw_sl /= 2) then
do jbnd = 1, nbnd
psidvpsi = zdotc(npwq, evq (1, jbnd), 1, dvpsi (1, ibnd),1)
#ifdef __MPI
call mp_sum ( psidvpsi, intra_pool_comm )
#endif
psidqvpsi (jbnd, ibnd) = psidvpsi
if (degauss /= 0.d0) then
deltae = et (ibnd, ikk) - et (jbnd, ikq)
! theta = 2.0d0*wgauss(deltae/degauss,0)
theta = 1.0d0
if (abs (deltae) > 1.0d-5) then
wg1 = wgauss ( (ef-et (ibnd, ikk) ) / degauss, ngauss)
wg2 = wgauss ( (ef-et (jbnd, ikq) ) / degauss, ngauss)
wwg = (wg1 - wg2) / deltae
else
wwg = - w0gauss ( (ef - et (ibnd, ikk) ) / degauss, &
ngauss) / degauss
endif
psidvpsi = 0.5d0 * wwg * psidvpsi * theta
call zaxpy(npwq,psidvpsi,evq(1,jbnd),1,dpsiaux(1,ibnd),1)
endif
enddo
endif
enddo
!
! Ortogonalize dvpsi
!
call start_clock ('ortho')
wwg = 1.0d0
do ibnd = 1, nbnd_occ (ikk)
auxg (:) = (0.d0, 0.d0)
do jbnd = 1, nbnd
ps (jbnd) = - wwg * zdotc(npwq, evq(1,jbnd), 1, dvpsi(1,ibnd), 1)
enddo
call mp_sum ( ps, intra_pool_comm )
do jbnd = 1, nbnd
call zaxpy (npwq, ps (jbnd), evq (1, jbnd), 1, auxg, 1)
enddo
call zcopy (npwq, auxg, 1, spsi, 1)
call daxpy (2 * npwq, 1.0d0, spsi, 1, dvpsi (1, ibnd), 1)
enddo
call stop_clock ('ortho')
call dscal (2 * npwx * nbnd, - 1.d0, dvpsi, 1)
!
! solution of the linear system (H-eS)*dpsi=dvpsi,
! dvpsi=-P_c^+ (dvscf)*psi
!
dpsi (:,:) = (0.d0, 0.d0)
do ibnd = 1, nbnd_occ (ikk)
conv_root = .true.
do ig = 1, npwq
auxg (ig) = g2kin (ig) * evq (ig, ibnd)
enddo
eprec1 = zdotc (npwq, evq (1, ibnd), 1, auxg, 1)
call mp_sum ( eprec1, intra_pool_comm )
do ig = 1, npwq
h_diag (ig, ibnd) = 1.d0/ max (1.0d0, g2kin (ig) / eprec1)
enddo
enddo
call cgsolve_all (ch_psi_all2, cg_psi, et (1, ikk), dvpsi, dpsi, &
h_diag, npwx, npwq, thresh, ik, lter, conv_root, anorm, &
nbnd_occ (ikk), 1 )
ltaver = ltaver + lter
lintercall = lintercall + 1
if (.not.conv_root) WRITE( stdout, '(5x,"kpoint",i4," ibnd",i4, &
& " linter: root not converged ",e10.3)') ikk, ibnd, anorm
120 continue
!
! writes psidqvpsi on iupdqvp
!
nrec = imode0 + ipert + (ik - 1) * 3 * nat
if (isw_sl == 1) then
call davcio (psidqvpsi, lrpdqvp, iupdqvp, nrec, + 1)
elseif (isw_sl >= 3) then
call davcio (psidqvpsi, lrpdqvp, iupd0vp, nrec, + 1)
endif
!
! writes delta_psi on iunit iudwf, k=kpoint,
!
if (isw_sl == 1) then
iuaux = iudqwf
elseif (isw_sl >= 3) then
iuaux = iudwf
elseif (isw_sl == 2) then
iuaux = iud0qwf
endif
nrec = (imode0 + ipert - 1) * nksq + ik
call davcio (dpsi, lrdwf, iuaux, nrec, + 1)
if (q0mode_f) goto 110
if (isw_sl /= 2) then
if (degauss /= 0.d0) then
do ibnd = 1, nbnd
wg1 = wgauss ( (ef - et (ibnd, ikk) ) / degauss, ngauss)
call dscal (2 * npwq, wg1, dpsi (1, ibnd), 1)
enddo
call daxpy (2 * npwx * nbnd, 1.0d0, dpsiaux, 1, dpsi, 1)
endif
endif
110 continue
!
! This is used to calculate Fermi energy shift at q=0 in metals
!
if (lmetq0) call incdrhoscf2 (drhoscf (1, ipert), wk (ikk), &
ik, dbecsum, 1, 1)
enddo
enddo
if (lmetq0) then
do ipert = 1, npe
call cinterpolate (drhoscf (1, ipert), drhoscf (1, ipert), 1)
enddo
endif
#ifdef __MPI
call mp_sum( drhoscf, inter_pool_comm )
#endif
if (lmetq0) call set_efsh (drhoscf, imode0, irr, npe)
aux_avg (1) = DBLE (ltaver)
aux_avg (2) = DBLE (lintercall)
call mp_sum( aux_avg, inter_pool_comm )
averlt = aux_avg (1) / aux_avg (2)
tcpu = get_clock ('D3TOTEN')
WRITE( stdout, '(//,5x," thresh=",e10.3," total cpu time : ",f8.1, &
& " s av.# it.: ",f5.1)') thresh, tcpu, averlt
!
FLUSH( stdout )
!
deallocate (h_diag)
if (degauss /= 0.d0) deallocate (dpsiaux)
deallocate (auxg)
deallocate (spsi)
deallocate (dvloc)
deallocate (drhoscf)
call stop_clock ('solve_linter')
return
end subroutine solve_linter_d3

69
PHonon/D3/stop_d3.f90
View File

@ -1,69 +0,0 @@
!
! Copyright (C) 2001 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 stop_d3 (flag)
!-----------------------------------------------------------------------
!
! This routine closes all files before stopping
! flag is no longer used
!
USE pwcom
USE phcom
USE d3com
USE control_flags, ONLY : twfcollect
USE io_files, ONLY : iunigk
USE mp_global, ONLY : me_pool, root_pool, mp_global_end
USE uspp, ONLY : nlcc_any
use control_lr, ONLY : lgamma
IMPLICIT NONE
LOGICAL :: flag
IF (twfcollect ) THEN
CLOSE (unit = iuwfc, status = 'delete')
ELSE
CLOSE (unit = iuwfc, status = 'keep')
END IF
CLOSE (unit = iubar, status = 'keep')
CLOSE (unit = iudwf, status = 'keep')
IF ( me_pool == root_pool ) THEN
!
CLOSE (unit = iudrho, status = 'keep')
IF (.NOT.lgamma) CLOSE (unit = iud0rho, status = 'keep')
IF(nlcc_any) THEN
CLOSE (unit = iudrho+1000, status = 'keep')
IF (.NOT.lgamma) CLOSE (unit = iud0rho+1000, status = 'keep')
ENDIF
!
END IF
CLOSE (unit = iunigk, status = 'delete')
IF (.NOT.lgamma) THEN
CLOSE (unit = iud0qwf, status = 'keep')
CLOSE (unit = iudqwf, status = 'keep')
ENDIF
CLOSE (unit = iupdqvp, status = 'keep')
IF (.NOT.lgamma) CLOSE (unit = iupd0vp, status = 'keep')
IF (degauss.NE.0.d0) THEN
CLOSE (unit = iudpdvp_1, status = 'keep')
IF (.NOT.lgamma) THEN
CLOSE (unit = iudpdvp_2, status = 'keep')
CLOSE (unit = iudpdvp_3, status = 'keep')
ENDIF
ENDIF
CALL print_clock_d3
CALL mp_global_end ()
STOP
RETURN
END SUBROUTINE stop_d3

64
PHonon/D3/sym_def1.f90
View File

@ -1,64 +0,0 @@
!
! Copyright (C) 2001 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 sym_def1 (def, irr)
!---------------------------------------------------------------------
! Symmetrizes the first order changes of the Fermi energies of an
! irreducible representation. These objects are defined complex because
! perturbations may be complex
!
! Used in the q=0 metallic case only.
!
USE kinds, only : DP
use pwcom
use phcom
use d3com
USE lr_symm_base, ONLY : nsymq, irgq
implicit none
integer :: irr
! input: the representation under consideration
complex (DP) :: def (npertx)
! inp/out: the fermi energy changes
integer :: ipert, jpert, isym, irot
! counter on perturbations
! counter on perturbations
! counter on symmetries
! the rotation
complex (DP) :: w_def (npertx)
! the fermi energy changes (work array)
do ipert = 1, npertg0 (irr)
def (ipert) = DBLE (def (ipert) )
enddo
if (nsymq == 1) return
!
! Here we symmetrize with respect to the small group of q
!
w_def (:) = (0.d0, 0.d0)
do ipert = 1, npertg0 (irr)
do isym = 1, nsymg0
irot = irgq (isym)
do jpert = 1, npertg0 (irr)
w_def (ipert) = w_def (ipert) + tg0 (jpert, ipert, irot, irr) &
* def (jpert)
enddo
enddo
enddo
!
! normalize and exit
!
def (:) = w_def(:) / DBLE(nsymq)
return
end subroutine sym_def1

86
PHonon/D3/symd0rho.f90
View File

@ -1,86 +0,0 @@
!
! Copyright (C) 2001 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 symd0rho (npertx, nper, irr, d0rho, s, ftau, nsymq, &
irgq, t, nat, nr1, nr2, nr3, nr1x, nr2x, nr3x)
!---------------------------------------------------------------------
! symmetrizes q=0 drho
!
!
USE kinds, only : DP
implicit none
integer :: nper, irr, s (3, 3, 48), ftau (3, 48), nsymq, irgq (48) &
, nat, nr1, nr2, nr3, nr1x, nr2x, nr3x, npertx
! nper: the number of perturbations
! irr: the representation under consideration
complex (DP) :: d0rho (nr1x, nr2x, nr3x, nper), &
t (npertx, npertx, 48, 3 * nat)
! charge variation to symmetrize
integer :: ri, rj, rk, i, j, k, ipert, jpert, isym, irot
! ri, rj, rk: rotated points
! counters
complex (DP), allocatable :: aux1 (:,:,:,:)
! the symmetrized charge
call start_clock ('symd0rho')
do k = 1, nr3
do j = 1, nr2
do i = 1, nr1
do ipert = 1, nper
d0rho (i, j, k, ipert) = DBLE (d0rho (i, j, k, ipert) )
enddo
enddo
enddo
enddo
if (nsymq == 1) return
allocate (aux1( nr1x, nr2x, nr3x, nper))
!
! Here we symmetrize with respect to the group
!
aux1 (:,:,:,:) = (0.d0, 0.d0)
do k = 1, nr3
do j = 1, nr2
do i = 1, nr1
do isym = 1, nsymq
irot = irgq (isym)
ri = s (1, 1, irot) * (i - 1) + s (2, 1, irot) * (j - 1) + &
s (3, 1, irot) * (k - 1) - ftau (1, irot)
ri = mod (ri, nr1) + 1
if (ri < 1) ri = ri + nr1
rj = s (1, 2, irot) * (i - 1) + s (2, 2, irot) * (j - 1) + &
s (3, 2, irot) * (k - 1) - ftau (2, irot)
rj = mod (rj, nr2) + 1
if (rj < 1) rj = rj + nr2
rk = s (1, 3, irot) * (i - 1) + s (2, 3, irot) * (j - 1) + &
s (3, 3, irot) * (k - 1) - ftau (3, irot)
rk = mod (rk, nr3) + 1
if (rk < 1) rk = rk + nr3
do ipert = 1, nper
do jpert = 1, nper
aux1 (i, j, k, ipert) = aux1 (i, j, k, ipert) + &
t(jpert, ipert, irot, irr) * d0rho (ri, rj, rk, jpert)
enddo
enddo
enddo
enddo
enddo
enddo
d0rho (:,:,:,:) = aux1 (:,:,:,:) / DBLE (nsymq)
deallocate (aux1)
call stop_clock ('symd0rho')
return
end subroutine symd0rho

82
PHonon/D3/trntnsc_3.f90
View File

@ -1,82 +0,0 @@
!
! Copyright (C) 2001 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 trntnsc_3 (phi, at, bg, iflg)
!-----------------------------------------------------------------------
!
! trasforms a COMPLEX third order tensor
!(like the derivative of the dynamical matrix)
! from crystal to cartesian axis (iflg >= 1) or viceversa (iflg <= -1)
!
USE kinds, only : DP
implicit none
integer :: iflg
! input: gives the versus of the trans.
complex (DP) :: phi (3, 3, 3)
! inp/out: the matrix to transform
real (DP) :: at (3, 3), bg (3, 3)
! input: the direct lattice vectors
! input: the reciprocal lattice
integer :: i, j, k, l, m, n
!
! counters on polarizations
!
complex (DP) :: wrk (3, 3, 3)
! a work array
if (iflg.gt.0) then
!
! forward transformation (crystal to cartesian axis)
!
call zcopy (27, phi, 1, wrk, 1)
do m = 1, 3
do i = 1, 3
do j = 1, 3
phi (m, i, j) = (0.d0, 0.d0)
do n = 1, 3
do k = 1, 3
do l = 1, 3
phi (m, i, j) = phi (m, i, j) + wrk (n, k, l) * bg (i, k) &
* bg (j, l) * bg (m, n)
enddo
enddo
enddo
enddo
enddo
enddo
else
!
! backward transformation (cartesian to crystal axis)
!
do m = 1, 3
do i = 1, 3
do j = 1, 3
wrk (m, i, j) = (0.d0, 0.d0)
do n = 1, 3
do k = 1, 3
do l = 1, 3
wrk (m, i, j) = wrk (m, i, j) + phi (n, k, l) * at (k, i) &
* at (l, j) * at (n, m)
enddo
enddo
enddo
enddo
enddo
enddo
call zcopy (27, wrk, 1, phi, 1)
endif
return
end subroutine trntnsc_3

67
PHonon/D3/w_1gauss.f90
View File

@ -1,67 +0,0 @@
!
! Copyright (C) 2001 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 .
!
!
!-----------------------------------------------------------------------
function w_1gauss (x, n)
!-----------------------------------------------------------------------
!
! the derivative of w0gauss:
!
! --> (n=-99): second derivative of Fermi-Dirac function
!
USE kinds, ONLY : DP
USE constants, ONLY : sqrtpm1
!
implicit none
real (DP) :: w_1gauss, x
! output: the value of the function
! input: the point where to compute the function
integer :: n
! input: the order of the smearing function
!
! here the local variables
!
real (DP) :: a, arg, hp, hd, aux1, aux2
! the coefficients a_n
! the argument of the exponential
! the hermite function
! the hermite function
! auxiliary variable
! auxiliary variable
integer :: i, ni
! counter on n values
! counter on 2n values
! Fermi-Dirac smearing
if (n.eq. - 99) then
aux1 = exp (x)
aux2 = exp ( - x)
w_1gauss = (aux2 - aux1) / (2.d0 + aux1 + aux2) **2
return
endif
!
arg = min (200.d0, x**2)
w_1gauss = - 2.d0 * x * exp ( - arg) * sqrtpm1
if (n.eq.0) return
hd = exp ( - arg)
hp = 2.d0 * x * exp ( - arg)
ni = 1
a = sqrtpm1
do i = 1, n
hd = 2.0d0 * x * hp - 2.0d0 * DBLE (ni) * hd
ni = ni + 1
a = - a / (DBLE (i) * 4.0d0)
hp = 2.0d0 * x * hd-2.0d0 * DBLE (ni) * hp
ni = ni + 1
w_1gauss = w_1gauss - a * hp
enddo
return
end function w_1gauss

60
PHonon/D3/write_aux.f90
View File

@ -1,60 +0,0 @@
!
! Copyright (C) 2001 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 write_aux (isw)
!-----------------------------------------------------------------------
!
! Writes on files partial computation of d3dyn
!
USE ions_base, ONLY : nat
use pwcom
use phcom
use d3com
!
implicit none
integer :: isw
!
if (isw.eq.1) then
d3dyn_aux1 = (0.0_dp,0.0_dp)
d3dyn_aux2 = (0.0_dp,0.0_dp)
d3dyn_aux3 = (0.0_dp,0.0_dp)
d3dyn_aux4 = (0.0_dp,0.0_dp)
d3dyn_aux5 = (0.0_dp,0.0_dp)
d3dyn_aux6 = (0.0_dp,0.0_dp)
d3dyn_aux7 = (0.0_dp,0.0_dp)
d3dyn_aux8 = (0.0_dp,0.0_dp)
d3dyn_aux9 = (0.0_dp,0.0_dp)
elseif (isw.eq.2) then
call zcopy (27 * nat * nat * nat, d3dyn, 1, d3dyn_aux4, 1)
call daxpy (2 * 27 * nat * nat * nat, - 1.d0, d3dyn_aux5, 1, &
d3dyn_aux4, 1)
call daxpy (2 * 27 * nat * nat * nat, - 1.d0, d3dyn_aux6, 1, &
d3dyn_aux4, 1)
call daxpy (2 * 27 * nat * nat * nat, - 1.d0, d3dyn_aux7, 1, &
d3dyn_aux4, 1)
call daxpy (2 * 27 * nat * nat * nat, - 1.d0, d3dyn_aux8, 1, &
d3dyn_aux4, 1)
call daxpy (2 * 27 * nat * nat * nat, - 1.d0, d3dyn_aux9, 1, &
d3dyn_aux4, 1)
call daxpy (2 * 27 * nat * nat * nat, - 1.d0, d3dyn_aux1, 1, &
d3dyn_aux4, 1)
call writed3dyn_5 (d3dyn_aux1, 'd3mat.1', - 1)
call writed3dyn_5 (d3dyn_aux4, 'd3mat.4', - 1)
call writed3dyn_5 (d3dyn_aux5, 'd3mat.5', - 1)
call writed3dyn_5 (d3dyn_aux6, 'd3mat.6', - 1)
call writed3dyn_5 (d3dyn_aux7, 'd3mat.7', - 1)
call writed3dyn_5 (d3dyn_aux8, 'd3mat.8', - 1)
call writed3dyn_5 (d3dyn_aux9, 'd3mat.9', - 1)
call writed3dyn_5 (d3dyn, 'd3mat.ns', - 1)
elseif (isw.eq.3) then
call writed3dyn_5 (d3dyn, 'd3mat.sy', 1)
endif
return
end subroutine write_aux

56
PHonon/D3/write_d3dyn.f90
View File

@ -1,56 +0,0 @@
!
! Copyright (C) 2001 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 write_d3dyn (xq, phi, nat, iudyn, wrmode)
!-----------------------------------------------------------------------
!
USE kinds, only : DP
implicit none
!
! input variables
!
integer :: iudyn, nat
! unit number
! number of atom in the unit cell
complex (DP) :: phi (3, 3, 3, nat, nat, nat)
! derivative of the dynamical matrix
real (DP) :: xq (3)
! the q vector
logical :: wrmode (3 * nat)
! if .true. this mode is to be written
!
! local variables
!
integer :: na, nb, nc, icar, jcar, kcar, i
! counters on atoms
! cartesian coordinate counters
! generic counter
write (iudyn, 9000) (xq (icar), icar = 1, 3)
do i = 1, 3 * nat
if (wrmode (i) ) then
write (iudyn, '(/,12x,"modo:",i5,/)') i
nc = (i - 1) / 3 + 1
kcar = i - 3 * (nc - 1)
do na = 1, nat
do nb = 1, nat
write (iudyn, '(2i3)') na, nb
do icar = 1, 3
write (iudyn, '(3e24.12)') (phi (kcar, icar, jcar, nc, na, nb) &
, jcar = 1, 3)
enddo
enddo
enddo
endif
enddo
return
9000 format(/,5x,'Third derivative in cartesian axes', &
& //,5x,'q = ( ',3f14.9,' ) ',/)
end subroutine write_d3dyn

30
PHonon/D3/write_igk.f90
View File

@ -1,30 +0,0 @@
!
! Copyright (C) 2001 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 write_igk
!
USE klist, ONLY: ngk, igk_k
USE wvfct, ONLY: npwx
USE io_files, ONLY: iunigk
USE qpoint, ONLY: nksq, ikks, ikqs
USE control_lr, ONLY: lgamma
implicit none
integer :: ik, ikk, ikq
rewind (unit = iunigk)
do ik =1,nksq
ikk=ikks(ik)
write (iunigk) ngk(ikk), igk_k(:,ikk)
if (.not.lgamma) then
ikq=ikqs(ik)
write (iunigk) ngk(ikq), igk_k(:,ikq)
end if
end do
return
end subroutine write_igk

97
PHonon/D3/writed3dyn_5.f90
View File

@ -1,97 +0,0 @@
!
! Copyright (C) 2001 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 writed3dyn_5 (d3dyn_x, filename, isw)
!-----------------------------------------------------------------------
!
! writes in a file the third derivative of dynamical matrix
! isw = +1 : d3dyn_x is in cartesian axis
! isw = -1 : rotates d3dyn_x from the basis of pattern to
! cartesian axis
!
USE ions_base, ONLY : nat
USE kinds, ONLY : DP
USE io_global, ONLY : ionode
USE pwcom
USE phcom
USE d3com
!
IMPLICIT NONE
!
INTEGER :: isw, iud3dyn, n_d3, na, nb, icart, jcart, kcart, na_i, &
na_j, na_k
! input: switch
! index on cartesian coordinates
! index on cartesian coordinates
! index on cartesian coordinates
! index on modes
! index on modes
! index on modes
COMPLEX (DP) :: d3dyn_x (3 * nat, 3 * nat, 3 * nat), work
! input: the third derivative of the dynamical matrix
COMPLEX (DP), ALLOCATABLE :: aux (:,:,:)
! auxiliary space
CHARACTER (len=*) :: filename
! input: the name of the file
IF ( .NOT. ionode ) RETURN
ALLOCATE (aux( 3 * nat, 3 * nat, 3 * nat))
IF (isw.EQ. + 1) THEN
CALL zcopy (27 * nat * nat * nat, d3dyn_x, 1, aux, 1)
ELSEIF (isw.EQ. - 1) THEN
!
! Rotates third derivative of the dynamical basis from the basis
! of modes to cartesisn axis
!
DO kcart = 1, 3 * nat
DO icart = 1, 3 * nat
DO jcart = 1, 3 * nat
work = (0.d0, 0.d0)
DO na_k = 1, 3 * nat
DO na_i = 1, 3 * nat
DO na_j = 1, 3 * nat
work = work + CONJG (ug0 (kcart, na_k) ) * u (icart, na_i) &
* d3dyn_x (na_k, na_i, na_j) * CONJG (u (jcart, na_j) )
ENDDO
ENDDO
ENDDO
aux (kcart, icart, jcart) = work
ENDDO
ENDDO
ENDDO
ENDIF
iud3dyn = 57
OPEN (unit = iud3dyn, file = TRIM(filename), status = 'unknown')
DO n_d3 = 1, 3 * nat
WRITE (iud3dyn, * )
WRITE (iud3dyn, * ) ' modo:', n_d3
WRITE (iud3dyn, * )
DO na = 1, nat
DO nb = 1, nat
WRITE (iud3dyn, '(2i3)') na, nb
DO icart = 1, 3
WRITE (iud3dyn, '(3E24.12)') (aux (n_d3, icart + 3 * (na - 1) , &
jcart + 3 * (nb - 1) ) , jcart = 1, 3)
ENDDO
ENDDO
ENDDO
ENDDO
CLOSE (iud3dyn)
DEALLOCATE (aux)
RETURN
END SUBROUTINE writed3dyn_5

13
PHonon/Doc/Makefile
View File

@ -24,7 +24,7 @@ clean:
- rm -rf user_guide/ developer_man/
- rm -f INPUT_*.html INPUT_*.txt INPUT_*.xml
- rm -rf input_xx.xsl
- rm -rf ../../Doc/INPUT_PH.* ../../Doc/INPUT_D3.*
- rm -rf ../../Doc/INPUT_PH.*
user_guide: user_guide.pdf
rm -rf user_guide/
@ -68,11 +68,9 @@ developer_man: developer_man.pdf
@echo ""
defs: link_input_xx INPUT_PH.txt INPUT_D3.txt INPUT_PH.html INPUT_D3.html link_on_main_doc
defs: link_input_xx INPUT_PH.txt INPUT_PH.html link_on_main_doc
INPUT_PH.txt: %.txt: %.def
$(HELPDOC) $<
INPUT_D3.txt: %.txt: %.def
$(HELPDOC) $<
link_input_xx:
@(if test ! -f input_xx.xsl; then \
(if test -f ../../dev-tools/input_xx.xsl; then \
@ -85,13 +83,8 @@ link_input_xx:
INPUT_PH.html: %.html: %.def input_xx.xsl
$(HELPDOC) $<
INPUT_D3.html: %.html: %.def input_xx.xsl
$(HELPDOC) $<
link_on_main_doc:
-( cd ../../Doc ; ln -fs ../PHonon/Doc/INPUT_PH.html . ; \
ln -fs ../PHonon/Doc/INPUT_PH.xml . ; \
ln -fs ../PHonon/Doc/INPUT_PH.txt . ; \
ln -fs ../PHonon/Doc/INPUT_D3.html . ; \
ln -fs ../PHonon/Doc/INPUT_D3.xml . ; \
ln -fs ../PHonon/Doc/INPUT_D3.txt)
ln -fs ../PHonon/Doc/INPUT_PH.txt . )

12
PHonon/Doc/user_guide.tex
View File

@ -71,12 +71,13 @@ of the main \qe\ tree:
\texttt{PH/} & : source files for phonon calculations
and analysis\\
\texttt{Gamma/} & : source files for Gamma-only phonon calculation\\
\texttt{D3/} & : source files for third-order derivative
calculations \\
\end{tabular}\\
{\em Important Notice:} since v.5.4, many modules and routines that were
common to all linear-response \qe\ codes are moved into the new
\texttt{LR\_Modules} subdirectory of the main tree.
\texttt{LR\_Modules} subdirectory of the main tree. Since v.6.0, the
\texttt{D3} code for anharmonic force constant calculations has been
superseded by the \texttt{D3Q} coda, available on
\texttt{http://www.qe-forge.org/gf/project/d3q/}.
The codes available in the \PHonon\ package can perform the following
types of calculations:
@ -86,7 +87,6 @@ types of calculations:
\item effective charges and dielectric tensors;
\item electron-phonon interaction coefficients for metals;
\item interatomic force constants in real space;
\item third-order anharmonic phonon lifetimes;
\item Infrared and Raman (nonresonant) cross section.
\end{itemize}
@ -163,10 +163,6 @@ from the \PHonon\ directory, produces the following codes:
plus $T_c$ for superconductivity using the McMillan formula
\item \texttt{PH/fqha.x}: a simple code to calculate vibrational entropy with
the quasi-harmonic approximation
\item \texttt{D3/d3.x}:
calculates anharmonic phonon lifetimes (third-order derivatives
of the energy), using data produced by \pwx\ and \phx\ (USPP
and PAW not supported).
\item \texttt{Gamma/phcg.x}:
a version of \phx\ that calculates phonons at ${\bf q} = 0$ using
conjugate-gradient minimization of the density functional expanded to

9
PHonon/Makefile
View File

@ -3,8 +3,7 @@ sinclude ../make.inc
default: all
#all: phonon phgamma_only third_order third_order_q
all: phonon phgamma_only third_order finite_diffs
all: phonon phgamma_only finite_diffs #third_order_q
phonon:
( cd PH ; $(MAKE) all || exit 1 )
@ -12,9 +11,6 @@ phonon:
phgamma_only:
( cd Gamma ; $(MAKE) all || exit 1 )
third_order: phonon
( cd D3 ; $(MAKE) all || exit 1 )
finite_diffs:
( cd FD ; $(MAKE) all || exit 1 )
@ -29,9 +25,6 @@ phonon_clean:
phgamma_only_clean:
( cd Gamma ; $(MAKE) clean )
third_order_clean:
( cd D3 ; $(MAKE) clean )
#third_order_q_clean:
# ( cd D3q ; $(MAKE) clean )

3
PHonon/examples/README
View File

@ -120,8 +120,7 @@ example12:
modes of a molecule (SiH4) at Gamma.
example13:
This example shows how to use pw.x, ph.x and d3.x to calculate the
third-order expansion coefficients of the total energy of Si.
Deleted
example14:
This example shows how to use ph.x to calculate the phonon frequencies

40
PHonon/examples/example13/README
View File

@ -1,40 +0,0 @@
This example shows the use of th D3 code to calculate
the third-order expansion coefficients with respect to
atomic displacement for Silicon.
First a normal self-consistent calculation is done.
Then a phonon calculation for the Gamma point is performed.
With these preliminary steps the coefficients C(0,0,0) are calculated.
For the X-point a non self-consistent calculation of groundstate
and the phonon calculation for this point is done.
Afterwards C(0,X,-X) is calculated.
By displacing one atom, one can get also these coefficients by a
finite-difference mathod. We give first the values obtained by
the 2n+1 method, then the values by the finite-differences.
All units are in Ryd/(a_b)^3.
tensor | 2n+1 | fin. dif.
------------------------------------------------------------
C_{x,y,z} (0,0,0|1,1,1) | 0.38314 | 0.38446
------------------------------------------------------------
C_{x,y,z} (0,X,-X|1,1,1) | 0.34043 | 0.34109
C_{x,x,z} (0,X,-X|1,1,2) | -0.25316 | -0.25296
C_{z,x,y} (0,X,-X|1,1,1) | 0.35781 | 0.35767
C_{z,x,x} (0,X,-X|1,1,2) | -0.25706 | -0.25491
C_{z,z,z} (0,X,-X|1,1,2) | -0.13133 | -0.12813
The results of these calculations are also compared with the ones of
Debernardi given in paranthesis, see Debernardi, PhD thesis (1995),
page 81, available at http://digitallibrary.sissa.it
The units are in eV/(Angstrom)^3.
B_xyz = -281.43 (-284.25)
I_zaa = 225.82 (227.37)
I_zbb = -37.00 (-37.64)
I_zcc = 48.23 (49.91)
I_xac = 436.01 (441.32)
I_ybc = -64.10 (-63.91)

197
PHonon/examples/example13/reference/si.anh_G
View File

@ -1,197 +0,0 @@
Derivative of the force constants
1 2 2 10.2000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000
1 'Si ' 28.0860000000000
1 1 0.0000000 0.0000000 0.0000000
2 1 0.2500000 0.2500000 0.2500000
Third derivative in cartesian axes
q = ( 0.000000000 0.000000000 0.000000000 )
modo: 1
1 1
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
0.416333634234E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.383235688562E+00 0.000000000000E+00
-0.693889390391E-16 0.000000000000E+00 0.383235688562E+00
0.000000000000E+00 -0.693889390391E-16 0.000000000000E+00
1 2
0.555111512313E-16 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
0.416333634234E-16 0.000000000000E+00 -0.693889390391E-16
0.000000000000E+00 -0.385638438801E+00 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 -0.385638438801E+00
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
2 1
-0.832667268469E-16 0.000000000000E+00 -0.416333634234E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.277555756156E-16 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 -0.385638438801E+00 0.000000000000E+00
-0.971445146547E-16 0.000000000000E+00 -0.385638438801E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
2 2
-0.138777878078E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
-0.277555756156E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.385638438801E+00 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 0.385638438801E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
modo: 2
1 1
-0.277555756156E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.383235688562E+00 0.000000000000E+00
-0.416333634234E-16 0.000000000000E+00 -0.832667268469E-16
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
0.383235688562E+00 0.000000000000E+00 0.111022302463E-15
0.000000000000E+00 -0.416333634234E-16 0.000000000000E+00
1 2
0.000000000000E+00 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 -0.385638438801E+00 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 -0.416333634234E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
-0.385638438801E+00 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
2 1
-0.555111512313E-16 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 -0.385638438801E+00 0.000000000000E+00
0.128395329626E-33 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.385638438801E+00 0.000000000000E+00 -0.693889390391E-16
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
2 2
0.971445146547E-16 0.000000000000E+00 0.555111512313E-16
0.000000000000E+00 0.385638438801E+00 0.000000000000E+00
0.138777878078E-15 0.000000000000E+00 0.832667268469E-16
0.000000000000E+00 -0.124900090270E-15 0.000000000000E+00
0.385638438801E+00 0.000000000000E+00 -0.111022302463E-15
0.000000000000E+00 0.180411241502E-15 0.000000000000E+00
modo: 3
1 1
0.277555756156E-16 0.000000000000E+00 0.383235688562E+00
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
0.383235688562E+00 0.000000000000E+00 0.832667268469E-16
0.000000000000E+00 0.138777878078E-16 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 -0.555111512313E-16
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
1 2
0.555111512313E-16 0.000000000000E+00 -0.385638438801E+00
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
-0.385638438801E+00 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
0.693889390391E-16 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
2 1
0.128395329626E-33 0.000000000000E+00 -0.385638438801E+00
0.000000000000E+00 0.832667268469E-16 0.000000000000E+00
-0.385638438801E+00 0.000000000000E+00 0.693889390391E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 0.693889390391E-16
0.000000000000E+00 0.832667268469E-16 0.000000000000E+00
2 2
0.416333634234E-16 0.000000000000E+00 0.385638438801E+00
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
0.385638438801E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.138777878078E-16 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
modo: 4
1 1
-0.277555756156E-16 0.000000000000E+00 0.693889390391E-16
0.000000000000E+00 0.832667268469E-16 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 0.971445146547E-16
0.000000000000E+00 -0.385638438801E+00 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 -0.385638438801E+00
0.000000000000E+00 0.832667268469E-16 0.000000000000E+00
1 2
0.416333634234E-16 0.000000000000E+00 0.641976648129E-34
0.000000000000E+00 -0.641976648129E-34 0.000000000000E+00
-0.277555756156E-16 0.000000000000E+00 -0.641976648129E-34
0.000000000000E+00 0.385638438801E+00 0.000000000000E+00
0.555111512313E-16 0.000000000000E+00 0.385638438801E+00
0.000000000000E+00 -0.641976648129E-34 0.000000000000E+00
2 1
-0.124900090270E-15 0.000000000000E+00 -0.555111512313E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 0.555111512313E-16
0.000000000000E+00 0.385638438801E+00 0.000000000000E+00
-0.693889390391E-16 0.000000000000E+00 0.385638438801E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
2 2
-0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.383235688562E+00 0.000000000000E+00
-0.555111512313E-16 0.000000000000E+00 -0.383235688562E+00
0.000000000000E+00 -0.555111512313E-16 0.000000000000E+00
modo: 5
1 1
-0.277555756156E-16 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 -0.385638438801E+00 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.385638438801E+00 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
-0.138777878078E-16 0.000000000000E+00 -0.111022302463E-15
0.000000000000E+00 0.385638438801E+00 0.000000000000E+00
-0.832667268469E-16 0.000000000000E+00 -0.111022302463E-15
0.000000000000E+00 -0.555111512313E-16 0.000000000000E+00
0.385638438801E+00 0.000000000000E+00 0.111022302463E-15
0.000000000000E+00 0.641976648129E-34 0.000000000000E+00
2 1
-0.693889390391E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.385638438801E+00 0.000000000000E+00
0.555111512313E-16 0.000000000000E+00 0.111022302463E-15
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
0.385638438801E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
2 2
-0.138777878078E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.383235688562E+00 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
-0.383235688562E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
modo: 6
1 1
-0.832667268469E-16 0.000000000000E+00 -0.385638438801E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.385638438801E+00 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.277555756156E-16 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
-0.416333634234E-16 0.000000000000E+00 0.385638438801E+00
0.000000000000E+00 -0.111022302463E-15 0.000000000000E+00
0.385638438801E+00 0.000000000000E+00 -0.641976648129E-34
0.000000000000E+00 0.641976648129E-34 0.000000000000E+00
0.555111512313E-16 0.000000000000E+00 0.555111512313E-16
0.000000000000E+00 -0.555111512313E-16 0.000000000000E+00
2 1
-0.416333634234E-16 0.000000000000E+00 0.385638438801E+00
0.000000000000E+00 0.832667268469E-16 0.000000000000E+00
0.385638438801E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
0.971445146547E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
2 2
-0.416333634234E-16 0.000000000000E+00 -0.383235688562E+00
0.000000000000E+00 -0.555111512313E-16 0.000000000000E+00
-0.383235688562E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00

579
PHonon/examples/example13/reference/si.anh_X
View File

@ -1,579 +0,0 @@
Derivative of the force constants
1 2 2 10.2000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000
1 'Si ' 28.0855000000000
1 1 0.0000000 0.0000000 0.0000000
2 1 0.2500000 0.2500000 0.2500000
Third derivative in cartesian axes
q = ( 0.000000000 0.000000000 1.000000000 )
modo: 1
1 1
0.000000000000E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.138777878078E-16 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.340446311468E+00 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 0.340446311468E+00
0.000000000000E+00 0.138777878078E-16 0.000000000000E+00
1 2
-0.555111512313E-16 -0.385185988877E-32 0.693889390391E-16
-0.308148791102E-32 -0.253164369419E+00 -0.155018457822E-16
0.138777878078E-16 -0.539260384428E-32 0.138777878078E-16
-0.462223186653E-32 0.000000000000E+00 -0.693334779979E-32
-0.253422131712E+00 -0.155176411577E-16 -0.693889390391E-16
0.000000000000E+00 0.000000000000E+00 -0.231111593326E-32
2 1
-0.138777878078E-16 0.385185988877E-32 0.000000000000E+00
0.308148791102E-32 -0.253422131712E+00 0.155176411577E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
-0.154074395551E-32 -0.277555756156E-16 0.000000000000E+00
-0.253164369419E+00 0.155018457822E-16 0.277555756156E-16
0.616297582204E-32 0.000000000000E+00 -0.616297582204E-32
2 2
-0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.342150971095E+00 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 0.342150971095E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
modo: 2
1 1
0.000000000000E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.340446311468E+00 0.000000000000E+00
0.832667268469E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.138777878078E-16 0.000000000000E+00
0.340446311468E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.971445146547E-16 0.000000000000E+00
1 2
-0.555111512313E-16 -0.770371977755E-33 -0.693889390391E-16
0.000000000000E+00 0.000000000000E+00 -0.693334779979E-32
0.138777878078E-16 0.770371977755E-33 -0.693889390391E-16
0.154074395551E-32 -0.253164369419E+00 -0.155018457822E-16
0.693889390391E-16 0.231111593326E-32 -0.253422131712E+00
-0.155176411577E-16 0.000000000000E+00 -0.385185988877E-32
2 1
-0.138777878078E-16 0.231111593326E-32 0.000000000000E+00
0.462223186653E-32 0.000000000000E+00 -0.616297582204E-32
0.000000000000E+00 -0.154074395551E-32 0.000000000000E+00
0.000000000000E+00 -0.253422131712E+00 0.155176411577E-16
-0.277555756156E-16 -0.231111593326E-32 -0.253164369419E+00
0.155018457822E-16 -0.555111512313E-16 -0.616297582204E-32
2 2
0.416333634234E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.342150971095E+00 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 -0.555111512313E-16
0.000000000000E+00 0.693889390391E-16 0.000000000000E+00
0.342150971095E+00 0.000000000000E+00 0.832667268469E-16
0.000000000000E+00 0.693889390391E-16 0.000000000000E+00
modo: 3
1 1
0.277555756156E-16 0.000000000000E+00 0.357823756898E+00
0.000000000000E+00 0.693889390391E-16 0.000000000000E+00
0.357823756898E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 -0.138777878078E-15
0.000000000000E+00 -0.971445146547E-16 0.000000000000E+00
1 2
-0.257063113968E+00 -0.157405864745E-16 0.138777878078E-16
0.000000000000E+00 0.000000000000E+00 0.770371977755E-33
0.138777878078E-16 -0.770371977755E-33 -0.257063113968E+00
-0.157405864745E-16 0.000000000000E+00 -0.385185988877E-32
-0.138777878078E-16 -0.231111593326E-32 -0.138777878078E-16
-0.616297582204E-32 -0.131333405365E+00 -0.804185127136E-17
2 1
-0.257063113968E+00 0.157405864745E-16 0.555111512313E-16
0.000000000000E+00 0.000000000000E+00 0.308148791102E-32
0.277555756156E-16 0.308148791102E-32 -0.257063113968E+00
0.157405864745E-16 -0.832667268469E-16 0.000000000000E+00
-0.555111512313E-16 -0.231111593326E-32 -0.277555756156E-16
0.000000000000E+00 -0.131333405365E+00 0.804185127136E-17
2 2
-0.416333634234E-16 0.000000000000E+00 0.359700640775E+00
0.000000000000E+00 -0.693889390391E-16 0.000000000000E+00
0.359700640775E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.693889390391E-16 0.000000000000E+00
modo: 4
1 1
0.138777878078E-16 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 -0.342150971095E+00 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 -0.342150971095E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
1 2
-0.138777878078E-16 -0.770371977755E-33 -0.111022302463E-15
0.154074395551E-32 0.253422131712E+00 0.155176190858E-16
-0.277555756156E-16 -0.385185988877E-32 -0.832667268469E-16
0.462223186653E-32 0.138777878078E-16 -0.462223186653E-32
0.253164369419E+00 0.155018476845E-16 -0.277555756156E-16
0.154074395551E-32 0.138777878078E-16 0.462223186653E-32
2 1
0.000000000000E+00 -0.231111593326E-32 0.555111512313E-16
0.539260384428E-32 0.253164369419E+00 -0.155018476845E-16
0.000000000000E+00 -0.308148791102E-32 0.277555756156E-16
0.231111593326E-32 0.277555756156E-16 -0.924446373306E-32
0.253422131712E+00 -0.155176190858E-16 0.555111512313E-16
0.539260384428E-32 0.555111512313E-16 0.000000000000E+00
2 2
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
0.416333634234E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.340446311468E+00 0.000000000000E+00
-0.693889390391E-16 0.000000000000E+00 -0.340446311468E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
modo: 5
1 1
0.416333634234E-16 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 -0.342150971095E+00 0.000000000000E+00
0.416333634234E-16 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.342150971095E+00 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
1 2
0.693889390391E-16 0.770371977755E-33 0.000000000000E+00
0.462223186653E-32 0.416333634234E-16 -0.462223186653E-32
0.000000000000E+00 -0.231111593326E-32 -0.277555756156E-16
0.462223186653E-32 0.253422131712E+00 0.155176190858E-16
0.832667268469E-16 0.231111593326E-32 0.253164369419E+00
0.155018476845E-16 -0.138777878078E-16 0.154074395551E-32
2 1
0.277555756156E-16 -0.231111593326E-32 0.277555756156E-16
0.770371977755E-33 0.555111512313E-16 -0.308148791102E-32
0.277555756156E-16 -0.308148791102E-32 0.000000000000E+00
0.770371977755E-33 0.253164369419E+00 -0.155018476845E-16
0.138777878078E-16 0.616297582204E-32 0.253422131712E+00
-0.155176190858E-16 -0.555111512313E-16 -0.308148791102E-32
2 2
-0.555111512313E-16 0.000000000000E+00 -0.555111512313E-16
0.000000000000E+00 -0.340446311468E+00 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.340446311468E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.832667268469E-16 0.000000000000E+00
modo: 6
1 1
-0.138777878078E-16 0.000000000000E+00 -0.359700640775E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.359700640775E+00 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.416333634234E-16 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
0.257063113968E+00 0.157405654955E-16 -0.555111512313E-16
0.154074395551E-32 -0.416333634234E-16 -0.154074395551E-32
0.000000000000E+00 0.770371977755E-33 0.257063113968E+00
0.157405654955E-16 -0.416333634234E-16 0.462223186653E-32
-0.832667268469E-16 -0.770371977755E-33 -0.277555756156E-16
0.154074395551E-32 0.131333405365E+00 0.804185217874E-17
2 1
0.257063113968E+00 -0.157405654955E-16 0.000000000000E+00
0.539260384428E-32 0.000000000000E+00 -0.308148791102E-32
0.000000000000E+00 0.154074395551E-32 0.257063113968E+00
-0.157405654955E-16 0.277555756156E-16 -0.308148791102E-32
-0.138777878078E-16 0.000000000000E+00 -0.555111512313E-16
-0.770371977755E-33 0.131333405365E+00 -0.804185217874E-17
2 2
0.277555756156E-16 0.000000000000E+00 -0.357823756898E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.357823756898E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
Third derivative in cartesian axes
q = ( 1.000000000 0.000000000 0.000000000 )
modo: 1
1 1
0.277555756156E-16 0.000000000000E+00 0.693889390391E-16
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
0.693889390391E-16 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 0.357823756898E+00 0.000000000000E+00
-0.416333634234E-16 0.000000000000E+00 0.357823756898E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
-0.131333405365E+00 -0.804185127136E-17 -0.277555756156E-16
0.385185988877E-32 0.000000000000E+00 -0.385185988877E-32
0.000000000000E+00 -0.385185988877E-32 -0.257063113968E+00
-0.157405864745E-16 0.000000000000E+00 -0.231111593326E-32
0.000000000000E+00 0.770371977755E-33 -0.277555756156E-16
0.231111593326E-32 -0.257063113968E+00 -0.157405864745E-16
2 1
-0.131333405365E+00 0.804185127136E-17 -0.971445146547E-16
0.231111593326E-32 0.971445146547E-16 -0.154074395551E-32
-0.693889390391E-16 -0.770371977755E-33 -0.257063113968E+00
0.157405864745E-16 0.416333634234E-16 0.000000000000E+00
0.416333634234E-16 -0.231111593326E-32 -0.138777878078E-16
-0.385185988877E-32 -0.257063113968E+00 0.157405864745E-16
2 2
-0.416333634234E-16 0.000000000000E+00 -0.416333634234E-16
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
0.555111512313E-16 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 0.359700640775E+00 0.000000000000E+00
-0.416333634234E-16 0.000000000000E+00 0.359700640775E+00
0.000000000000E+00 -0.138777878078E-16 0.000000000000E+00
modo: 2
1 1
-0.555111512313E-16 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 0.340446311468E+00 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 -0.693889390391E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
0.340446311468E+00 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
0.000000000000E+00 0.385185988877E-32 -0.253422131712E+00
-0.155176411577E-16 0.832667268469E-16 0.539260384428E-32
-0.253164369419E+00 -0.155018457822E-16 0.000000000000E+00
-0.231111593326E-32 -0.277555756156E-16 -0.385185988877E-32
0.832667268469E-16 -0.770371977755E-33 -0.277555756156E-16
0.770371977755E-33 0.277555756156E-16 0.385185988877E-32
2 1
0.138777878078E-16 -0.616297582204E-32 -0.253164369419E+00
0.155018457822E-16 -0.138777878078E-16 -0.462223186653E-32
-0.253422131712E+00 0.155176411577E-16 -0.138777878078E-16
-0.385185988877E-32 -0.138777878078E-16 0.462223186653E-32
0.416333634234E-16 -0.847409175530E-32 0.416333634234E-16
0.385185988877E-32 0.138777878078E-16 -0.385185988877E-32
2 2
-0.138777878078E-16 0.000000000000E+00 -0.138777878078E-16
0.000000000000E+00 0.342150971095E+00 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 -0.416333634234E-16
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
0.342150971095E+00 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 -0.416333634234E-16 0.000000000000E+00
modo: 3
1 1
0.000000000000E+00 0.000000000000E+00 0.340446311468E+00
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
0.340446311468E+00 0.000000000000E+00 0.693889390391E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.971445146547E-16 0.000000000000E+00 0.138777878078E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
0.277555756156E-16 0.770371977755E-33 -0.277555756156E-16
0.693334779979E-32 -0.253422131712E+00 -0.155176411577E-16
0.000000000000E+00 -0.385185988877E-32 -0.555111512313E-16
0.231111593326E-32 0.000000000000E+00 0.385185988877E-32
-0.253164369419E+00 -0.155018457822E-16 -0.277555756156E-16
-0.770371977755E-33 0.000000000000E+00 -0.693334779979E-32
2 1
0.416333634234E-16 0.000000000000E+00 -0.416333634234E-16
0.231111593326E-32 -0.253164369419E+00 0.155018457822E-16
-0.693889390391E-16 -0.770371977755E-33 0.138777878078E-16
0.385185988877E-32 0.416333634234E-16 -0.308148791102E-32
-0.253422131712E+00 0.155176411577E-16 -0.138777878078E-16
-0.385185988877E-32 -0.138777878078E-16 0.385185988877E-32
2 2
-0.138777878078E-16 0.000000000000E+00 0.342150971095E+00
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
0.342150971095E+00 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 -0.416333634234E-16 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 -0.416333634234E-16
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
modo: 4
1 1
-0.416333634234E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.359700640775E+00 0.000000000000E+00
-0.832667268469E-16 0.000000000000E+00 -0.359700640775E+00
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
1 2
0.131333405365E+00 0.804185217874E-17 -0.124900090270E-15
0.770371977755E-33 0.138777878078E-16 0.000000000000E+00
-0.416333634234E-16 0.154074395551E-32 0.257063113968E+00
0.157405654955E-16 -0.138777878078E-16 -0.154074395551E-32
-0.138777878078E-16 -0.154074395551E-32 -0.138777878078E-16
-0.847409175530E-32 0.257063113968E+00 0.157405654955E-16
2 1
0.131333405365E+00 -0.804185217874E-17 0.000000000000E+00
0.154074395551E-32 0.416333634234E-16 -0.770371977755E-33
0.277555756156E-16 -0.231111593326E-32 0.257063113968E+00
-0.157405654955E-16 -0.138777878078E-16 0.231111593326E-32
-0.138777878078E-16 -0.385185988877E-32 0.000000000000E+00
0.462223186653E-32 0.257063113968E+00 -0.157405654955E-16
2 2
0.416333634234E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.357823756898E+00 0.000000000000E+00
0.693889390391E-16 0.000000000000E+00 -0.357823756898E+00
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
modo: 5
1 1
-0.138777878078E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.342150971095E+00 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
-0.342150971095E+00 0.000000000000E+00 -0.832667268469E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
0.416333634234E-16 -0.154074395551E-32 0.253164369419E+00
0.155018476845E-16 0.693889390391E-16 0.000000000000E+00
0.253422131712E+00 0.155176190858E-16 -0.693889390391E-16
-0.539260384428E-32 0.138777878078E-16 0.000000000000E+00
0.138777878078E-16 -0.924446373306E-32 0.138777878078E-16
-0.693334779979E-32 0.416333634234E-16 0.000000000000E+00
2 1
0.416333634234E-16 0.770371977755E-33 0.253422131712E+00
-0.155176190858E-16 -0.138777878078E-16 0.693334779979E-32
0.253164369419E+00 -0.155018476845E-16 0.555111512313E-16
0.462223186653E-32 0.138777878078E-16 -0.231111593326E-32
0.138777878078E-16 -0.847409175530E-32 0.555111512313E-16
-0.154074395551E-32 -0.138777878078E-16 0.770371977755E-33
2 2
0.138777878078E-16 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 -0.340446311468E+00 0.000000000000E+00
0.416333634234E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
-0.340446311468E+00 0.000000000000E+00 -0.555111512313E-16
0.000000000000E+00 -0.416333634234E-16 0.000000000000E+00
modo: 6
1 1
-0.138777878078E-16 0.000000000000E+00 -0.342150971095E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.342150971095E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 0.832667268469E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
-0.138777878078E-16 0.462223186653E-32 -0.138777878078E-16
-0.231111593326E-32 0.253164369419E+00 0.155018476845E-16
-0.138777878078E-16 -0.154074395551E-32 0.693889390391E-16
0.539260384428E-32 0.138777878078E-16 0.154074395551E-32
0.253422131712E+00 0.155176190858E-16 -0.693889390391E-16
0.385185988877E-32 -0.416333634234E-16 0.308148791102E-32
2 1
-0.138777878078E-16 -0.231111593326E-32 -0.555111512313E-16
0.770371977755E-32 0.253422131712E+00 -0.155176190858E-16
-0.277555756156E-16 -0.539260384428E-32 -0.555111512313E-16
-0.154074395551E-32 0.138777878078E-16 0.231111593326E-32
0.253164369419E+00 -0.155018476845E-16 0.000000000000E+00
0.462223186653E-32 -0.416333634234E-16 -0.770371977755E-33
2 2
0.416333634234E-16 0.000000000000E+00 -0.340446311468E+00
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
-0.340446311468E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.416333634234E-16 0.000000000000E+00
0.693889390391E-16 0.000000000000E+00 0.555111512313E-16
0.000000000000E+00 0.416333634234E-16 0.000000000000E+00
Third derivative in cartesian axes
q = ( 0.000000000 1.000000000 0.000000000 )
modo: 1
1 1
0.277555756156E-16 0.000000000000E+00 0.138777878078E-15
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
0.138777878078E-16 0.000000000000E+00 0.111022302463E-15
0.000000000000E+00 0.340446311468E+00 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 0.340446311468E+00
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
1 2
-0.277555756156E-16 0.000000000000E+00 -0.253164369419E+00
-0.155018457822E-16 -0.693889390391E-16 0.154074395551E-32
-0.253422131712E+00 -0.155176411577E-16 -0.138777878078E-16
0.308148791102E-32 0.416333634234E-16 0.462223186653E-32
-0.555111512313E-16 -0.462223186653E-32 0.138777878078E-16
-0.123259516441E-31 -0.555111512313E-16 -0.231111593326E-32
2 1
0.000000000000E+00 -0.462223186653E-32 -0.253422131712E+00
0.155176411577E-16 0.000000000000E+00 -0.154074395551E-32
-0.253164369419E+00 0.155018457822E-16 0.277555756156E-16
-0.539260384428E-32 0.000000000000E+00 -0.616297582204E-32
0.000000000000E+00 0.154074395551E-32 -0.277555756156E-16
-0.385185988877E-32 0.138777878078E-16 0.308148791102E-32
2 2
0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.416333634234E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.342150971095E+00 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 0.342150971095E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
modo: 2
1 1
0.000000000000E+00 0.000000000000E+00 0.111022302463E-15
0.000000000000E+00 0.357823756898E+00 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 0.832667268469E-16
0.000000000000E+00 -0.555111512313E-16 0.000000000000E+00
0.357823756898E+00 0.000000000000E+00 -0.555111512313E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
1 2
-0.257063113968E+00 -0.157405864745E-16 -0.693889390391E-16
-0.154074395551E-32 -0.138777878078E-16 0.770371977755E-32
-0.277555756156E-16 0.308148791102E-32 -0.131333405365E+00
-0.804185127136E-17 0.971445146547E-16 0.462223186653E-32
-0.277555756156E-16 0.154074395551E-32 -0.138777878078E-16
-0.308148791102E-32 -0.257063113968E+00 -0.157405864745E-16
2 1
-0.257063113968E+00 0.157405864745E-16 -0.277555756156E-16
-0.231111593326E-32 0.555111512313E-16 -0.154074395551E-32
0.555111512313E-16 -0.154074395551E-32 -0.131333405365E+00
0.804185127136E-17 0.555111512313E-16 -0.616297582204E-32
0.000000000000E+00 0.154074395551E-32 -0.832667268469E-16
0.770371977755E-33 -0.257063113968E+00 0.157405864745E-16
2 2
0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.359700640775E+00 0.000000000000E+00
-0.416333634234E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
0.359700640775E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
modo: 3
1 1
0.111022302463E-15 0.000000000000E+00 0.340446311468E+00
0.000000000000E+00 0.111022302463E-15 0.000000000000E+00
0.340446311468E+00 0.000000000000E+00 0.000000000000E+00
0.000000000000E+00 0.555111512313E-16 0.000000000000E+00
0.000000000000E+00 0.000000000000E+00 0.555111512313E-16
0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
1 2
0.277555756156E-16 0.000000000000E+00 0.693889390391E-16
-0.462223186653E-32 -0.138777878078E-16 0.154074395551E-32
0.277555756156E-16 0.616297582204E-32 -0.138777878078E-16
-0.154074395551E-32 -0.253422131712E+00 -0.155176411577E-16
0.000000000000E+00 -0.308148791102E-32 -0.253164369419E+00
-0.155018457822E-16 0.000000000000E+00 0.770371977755E-33
2 1
0.000000000000E+00 -0.462223186653E-32 0.277555756156E-16
-0.770371977755E-33 0.000000000000E+00 -0.308148791102E-32
0.000000000000E+00 -0.107852076886E-31 -0.277555756156E-16
0.770371977755E-33 -0.253164369419E+00 0.155018457822E-16
0.555111512313E-16 0.154074395551E-32 -0.253422131712E+00
0.155176411577E-16 0.138777878078E-16 0.308148791102E-32
2 2
0.138777878078E-16 0.000000000000E+00 0.342150971095E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
0.342150971095E+00 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
modo: 4
1 1
0.138777878078E-16 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 0.416333634234E-16
0.000000000000E+00 -0.342150971095E+00 0.000000000000E+00
0.277555756156E-16 0.000000000000E+00 -0.342150971095E+00
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
1 2
0.555111512313E-16 -0.385185988877E-32 0.253422131712E+00
0.155176190858E-16 0.277555756156E-16 -0.770371977755E-33
0.253164369419E+00 0.155018476845E-16 0.277555756156E-16
-0.693334779979E-32 0.277555756156E-16 0.539260384428E-32
0.277555756156E-16 -0.693334779979E-32 0.000000000000E+00
0.385185988877E-32 0.000000000000E+00 -0.539260384428E-32
2 1
-0.277555756156E-16 -0.770371977755E-32 0.253164369419E+00
-0.155018476845E-16 0.277555756156E-16 -0.154074395551E-32
0.253422131712E+00 -0.155176190858E-16 0.277555756156E-16
0.154074395551E-32 0.555111512313E-16 0.308148791102E-32
-0.277555756156E-16 -0.154074395551E-32 -0.277555756156E-16
-0.924446373306E-32 0.277555756156E-16 0.616297582204E-32
2 2
-0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.277555756156E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.340446311468E+00 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 -0.340446311468E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
modo: 5
1 1
0.693889390391E-16 0.000000000000E+00 0.971445146547E-16
0.000000000000E+00 -0.359700640775E+00 0.000000000000E+00
0.416333634234E-16 0.000000000000E+00 0.971445146547E-16
0.000000000000E+00 -0.832667268469E-16 0.000000000000E+00
-0.359700640775E+00 0.000000000000E+00 -0.693889390391E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
1 2
0.257063113968E+00 0.157405654955E-16 0.832667268469E-16
-0.385185988877E-32 -0.277555756156E-16 0.385185988877E-32
0.832667268469E-16 -0.231111593326E-32 0.131333405365E+00
0.804185217874E-17 0.832667268469E-16 -0.231111593326E-32
-0.832667268469E-16 0.385185988877E-32 0.000000000000E+00
-0.385185988877E-32 0.257063113968E+00 0.157405654955E-16
2 1
0.257063113968E+00 -0.157405654955E-16 0.277555756156E-16
0.308148791102E-32 -0.277555756156E-16 -0.154074395551E-32
0.111022302463E-15 0.154074395551E-32 0.131333405365E+00
-0.804185217874E-17 0.555111512313E-16 0.308148791102E-32
-0.277555756156E-16 0.154074395551E-32 0.277555756156E-16
0.154074395551E-32 0.257063113968E+00 -0.157405654955E-16
2 2
-0.138777878078E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.357823756898E+00 0.000000000000E+00
-0.277555756156E-16 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.357823756898E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
modo: 6
1 1
-0.416333634234E-16 0.000000000000E+00 -0.342150971095E+00
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
-0.342150971095E+00 0.000000000000E+00 -0.693889390391E-16
0.000000000000E+00 0.832667268469E-16 0.000000000000E+00
-0.277555756156E-16 0.000000000000E+00 0.693889390391E-16
0.000000000000E+00 0.277555756156E-16 0.000000000000E+00
1 2
0.832667268469E-16 -0.231111593326E-32 -0.555111512313E-16
-0.231111593326E-32 0.555111512313E-16 -0.385185988877E-32
-0.277555756156E-16 0.770371977755E-33 0.277555756156E-16
-0.100148357108E-31 0.253164369419E+00 0.155018476845E-16
0.832667268469E-16 -0.231111593326E-32 0.253422131712E+00
0.155176190858E-16 0.555111512313E-16 -0.539260384428E-32
2 1
0.000000000000E+00 -0.462223186653E-32 -0.832667268469E-16
-0.123259516441E-31 0.832667268469E-16 -0.462223186653E-32
0.000000000000E+00 0.154074395551E-32 0.277555756156E-16
-0.770371977755E-32 0.253422131712E+00 -0.155176190858E-16
0.000000000000E+00 -0.154074395551E-32 0.253164369419E+00
-0.155018476845E-16 0.832667268469E-16 0.308148791102E-32
2 2
0.138777878078E-16 0.000000000000E+00 -0.340446311468E+00
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.340446311468E+00 0.000000000000E+00 -0.277555756156E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00
-0.138777878078E-16 0.000000000000E+00 0.277555756156E-16
0.000000000000E+00 -0.277555756156E-16 0.000000000000E+00

246
PHonon/examples/example13/reference/si.d3G.out
View File

@ -1,246 +0,0 @@
Program D3TOTEN v.4.0 starts ...
Today is 28Apr2008 at 15:57:30
READING PATTERNS FROM FILE si.drho_G.pat
crystal is
bravais-lattice index = 2
lattice parameter (a_0) = 10.2000 a.u.
unit-cell volume = 265.3020 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
kinetic-energy cut-off = 24.0000 Ry
charge density cut-off = 96.0000 Ry
celldm(1)= 10.20000 celldm(2)= 0.00000 celldm(3)= 0.00000
celldm(4)= 0.00000 celldm(5)= 0.00000 celldm(6)= 0.00000
crystal axes: (cart. coord. in units of a_0)
a(1) = ( -0.5000 0.0000 0.5000 )
a(2) = ( 0.0000 0.5000 0.5000 )
a(3) = ( -0.5000 0.5000 0.0000 )
reciprocal axes: (cart. coord. in units 2 pi/a_0)
b(1) = ( -1.0000 -1.0000 1.0000 )
b(2) = ( 1.0000 1.0000 1.0000 )
b(3) = ( -1.0000 1.0000 -1.0000 )
Atoms inside the unit cell:
Cartesian axes
site n. atom mass positions (a_0 units)
1 Si 0.0308 tau( 1) = ( 0.00000 0.00000 0.00000 )
2 Si 0.0308 tau( 2) = ( 0.25000 0.25000 0.25000 )
Computing dynamical matrix for
q = ( 0.00000 0.00000 0.00000 )
Computing all the modes
48 + 1 = 49 q=0 Sym.Ops.
G cutoff = 252.9949 ( 4279 G-vectors) FFT grid: ( 24, 24, 24)
number of k points= 10
cart. coord. in units 2pi/a_0
k( 1) = ( -0.1250000 0.1250000 0.1250000), wk = 0.0625000
k( 2) = ( -0.3750000 0.3750000 -0.1250000), wk = 0.1875000
k( 3) = ( 0.3750000 -0.3750000 0.6250000), wk = 0.1875000
k( 4) = ( 0.1250000 -0.1250000 0.3750000), wk = 0.1875000
k( 5) = ( -0.1250000 0.6250000 0.1250000), wk = 0.1875000
k( 6) = ( 0.6250000 -0.1250000 0.8750000), wk = 0.3750000
k( 7) = ( 0.3750000 0.1250000 0.6250000), wk = 0.3750000
k( 8) = ( -0.1250000 -0.8750000 0.1250000), wk = 0.1875000
k( 9) = ( -0.3750000 0.3750000 0.3750000), wk = 0.0625000
k( 10) = ( 0.3750000 -0.3750000 1.1250000), wk = 0.1875000
PseudoPot. # 1 for Si read from file Si.vbc.UPF
Pseudo is Norm-conserving, Zval = 4.0
Generated by new atomic code, or converted to UPF format
Using radial grid of 431 points, 2 beta functions with:
l(1) = 0
l(2) = 1
Atomic displacements:
There are 2 irreducible representations
Representation 1 3 modes - To be done
Representation 2 3 modes - To be done
** Complex Version **
D3TOTEN : 0.47s CPU time, 0.48s wall time
Nscf calculating of the perturbed wavefunctions
Calculating for the wavevector q=0 at the original k-points
Representation # 1 modes # 1 2 3
thresh= 0.100E-04 total cpu time : 12.4 secs av.it.: 160.9
Representation # 2 modes # 4 5 6
thresh= 0.100E-04 total cpu time : 23.8 secs av.it.: 158.7
gen_dwfc(3) cpu time: 23.37 sec Total time: 23.84 sec
Finished the ncf calculation of the perturbed wavefunctions
calling gen_dpdvp
gen_dpdvp cpu time: 0.00 sec Total time: 23.84 sec
Calculating the matrix elements <dpsi |dH |dpsi>
calling dpsidvdpsi: 1
dpsidvdpsi 1 cpu time: 0.16 sec Total time: 24.00 sec
calling dpsidvdpsi: 2
dpsidvdpsi 2 cpu time: 0.17 sec Total time: 24.16 sec
calling dpsidvdpsi: 3
dpsidvdpsi 3 cpu time: 0.16 sec Total time: 24.32 sec
calling dpsidvdpsi: 4
dpsidvdpsi 4 cpu time: 0.16 sec Total time: 24.49 sec
calling dpsidvdpsi: 5
dpsidvdpsi 5 cpu time: 0.16 sec Total time: 24.65 sec
calling dpsidvdpsi: 6
dpsidvdpsi 6 cpu time: 0.16 sec Total time: 24.81 sec
Calculating the matrix elements <dpsi|dpsi>< psi|dH|psi>
calling dpsidpsidv
dpsidpsidv cpu time: 0.02 sec Total time: 24.83 sec
Calculating the matrix elements <psi |d^2 v |dpsi>
calling drhod2v
1
0.000000 0.000000 -0.574542 0.000000 -0.432938 0.000000
-0.574542 0.000000 0.000000 0.000000 0.109853 0.000000
-0.432938 0.000000 0.109853 0.000000 0.000000 0.000000
2
0.000000 0.000000 -0.574542 0.000000 -0.432938 0.000000
-0.574542 0.000000 0.000000 0.000000 0.109853 0.000000
-0.432938 0.000000 0.109853 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.439858 0.000000 -0.579528 0.000000
0.439858 0.000000 0.000000 0.000000 0.016539 0.000000
-0.579528 0.000000 0.016539 0.000000 0.000000 0.000000
2
0.000000 0.000000 0.439858 0.000000 -0.579528 0.000000
0.439858 0.000000 0.000000 0.000000 0.016539 0.000000
-0.579528 0.000000 0.016539 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.077641 0.000000 0.079455 0.000000
0.077641 0.000000 0.000000 0.000000 0.719208 0.000000
0.079455 0.000000 0.719208 0.000000 0.000000 0.000000
2
0.000000 0.000000 0.077641 0.000000 0.079455 0.000000
0.077641 0.000000 0.000000 0.000000 0.719208 0.000000
0.079455 0.000000 0.719208 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.976940 0.000000 0.303098 0.000000
0.976940 0.000000 0.000000 0.000000 -0.589267 0.000000
0.303098 0.000000 -0.589267 0.000000 0.000000 0.000000
2
0.000000 0.000000 -0.976940 0.000000 -0.303098 0.000000
-0.976940 0.000000 0.000000 0.000000 0.589267 0.000000
-0.303098 0.000000 0.589267 0.000000 0.000000 0.000000
1
0.000000 0.000000 -0.653905 0.000000 0.270991 0.000000
-0.653905 0.000000 0.000000 0.000000 -0.944715 0.000000
0.270991 0.000000 -0.944715 0.000000 0.000000 0.000000
2
0.000000 0.000000 0.653905 0.000000 -0.270991 0.000000
0.653905 0.000000 0.000000 0.000000 0.944715 0.000000
-0.270991 0.000000 0.944715 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.107292 0.000000 -1.108247 0.000000
0.107292 0.000000 0.000000 0.000000 -0.392165 0.000000
-1.108247 0.000000 -0.392165 0.000000 0.000000 0.000000
2
0.000000 0.000000 -0.107292 0.000000 1.108247 0.000000
-0.107292 0.000000 0.000000 0.000000 0.392165 0.000000
1.108247 0.000000 0.392165 0.000000 0.000000 0.000000
drhod2v cpu time: 0.13 sec Total time: 24.96 sec
Calculating the matrix elements <psi |d^3v |psi>
calling d3vrho
d3vrho cpu time: 0.07 sec Total time: 25.03 sec
Calculating the Ewald contribution
calling d3ionq
Alpha used in Ewald sum = 1.0000
d3ionq cpu time: 0.01 sec Total time: 25.04 sec
Calculating the valence contribution
calling d3_valence
d3_valence cpu time: 0.00 sec Total time: 25.04 sec
calling drho_cc(+1)
drho_cc(+1) cpu time: 0.00 sec Total time: 25.04 sec
Calculating the exchange-correlation contribution
calling d3_exc
d3_exc cpu time: 0.01 sec Total time: 25.05 sec
Calculating the core-correction contribution
calling d3dyn_cc
d3dyn_cc cpu time: 0.00 sec Total time: 25.05 sec
Symmetrizing and writing the tensor to disc
calling d3matrix
Number of q in the star = 1
List of q in the star:
1 0.000000000 0.000000000 0.000000000
d3matrix cpu time: 0.00 sec Total time: 25.06 sec
D3TOTEN : 25.06s CPU time, 25.41s wall time
d3_setup : 0.00s CPU
phq_init : 0.02s CPU
solve_linter : 23.37s CPU ( 2 calls, 11.683 s avg)
ortho : 0.00s CPU ( 60 calls, 0.000 s avg)
cgsolve : 23.19s CPU ( 60 calls, 0.387 s avg)
cgsolve : 23.19s CPU ( 60 calls, 0.387 s avg)
ch_psi : 22.73s CPU ( 10393 calls, 0.002 s avg)
ch_psi : 22.73s CPU ( 10393 calls, 0.002 s avg)
h_psiq : 21.53s CPU ( 10393 calls, 0.002 s avg)
last : 1.13s CPU ( 10393 calls, 0.000 s avg)
h_psiq : 21.53s CPU ( 10393 calls, 0.002 s avg)
firstfft : 9.84s CPU ( 38437 calls, 0.000 s avg)
secondfft : 9.56s CPU ( 38437 calls, 0.000 s avg)
General routines
calbec : 0.75s CPU ( 20826 calls, 0.000 s avg)
cft3 : 0.02s CPU ( 34 calls, 0.001 s avg)
cft3s : 19.18s CPU ( 80234 calls, 0.000 s avg)
davcio : 0.00s CPU ( 5668 calls, 0.000 s avg)

347
PHonon/examples/example13/reference/si.d3X.out
View File

@ -1,347 +0,0 @@
Program D3TOTEN v.4.0 starts ...
Today is 28Apr2008 at 15:58:20
READING PATTERNS FROM FILE si.drho_X.pat
READING PATTERNS FROM FILE si.drho_G.pat
crystal is
bravais-lattice index = 2
lattice parameter (a_0) = 10.2000 a.u.
unit-cell volume = 265.3020 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
kinetic-energy cut-off = 24.0000 Ry
charge density cut-off = 96.0000 Ry
celldm(1)= 10.20000 celldm(2)= 0.00000 celldm(3)= 0.00000
celldm(4)= 0.00000 celldm(5)= 0.00000 celldm(6)= 0.00000
crystal axes: (cart. coord. in units of a_0)
a(1) = ( -0.5000 0.0000 0.5000 )
a(2) = ( 0.0000 0.5000 0.5000 )
a(3) = ( -0.5000 0.5000 0.0000 )
reciprocal axes: (cart. coord. in units 2 pi/a_0)
b(1) = ( -1.0000 -1.0000 1.0000 )
b(2) = ( 1.0000 1.0000 1.0000 )
b(3) = ( -1.0000 1.0000 -1.0000 )
Atoms inside the unit cell:
Cartesian axes
site n. atom mass positions (a_0 units)
1 Si 0.0308 tau( 1) = ( 0.00000 0.00000 0.00000 )
2 Si 0.0308 tau( 2) = ( 0.25000 0.25000 0.25000 )
Computing dynamical matrix for
q = ( 0.00000 0.00000 1.00000 )
Computing all the modes
16 + 1 = 17 q=0 Sym.Ops.
17 Sym.Ops. (with q -> -q+G )
G cutoff = 252.9949 ( 4279 G-vectors) FFT grid: ( 24, 24, 24)
number of k points= 40
cart. coord. in units 2pi/a_0
k( 1) = ( -0.1250000 0.1250000 0.1250000), wk = 0.0625000
k( 2) = ( -0.1250000 0.1250000 1.1250000), wk = 0.0000000
k( 3) = ( -0.3750000 0.3750000 -0.1250000), wk = 0.0625000
k( 4) = ( -0.3750000 0.3750000 0.8750000), wk = 0.0000000
k( 5) = ( 0.3750000 -0.3750000 0.6250000), wk = 0.0625000
k( 6) = ( 0.3750000 -0.3750000 1.6250000), wk = 0.0000000
k( 7) = ( 0.1250000 -0.1250000 0.3750000), wk = 0.0625000
k( 8) = ( 0.1250000 -0.1250000 1.3750000), wk = 0.0000000
k( 9) = ( -0.1250000 0.6250000 0.1250000), wk = 0.1250000
k( 10) = ( -0.1250000 0.6250000 1.1250000), wk = 0.0000000
k( 11) = ( 0.6250000 -0.1250000 0.8750000), wk = 0.1250000
k( 12) = ( 0.6250000 -0.1250000 1.8750000), wk = 0.0000000
k( 13) = ( 0.3750000 0.1250000 0.6250000), wk = 0.1250000
k( 14) = ( 0.3750000 0.1250000 1.6250000), wk = 0.0000000
k( 15) = ( -0.1250000 -0.8750000 0.1250000), wk = 0.1250000
k( 16) = ( -0.1250000 -0.8750000 1.1250000), wk = 0.0000000
k( 17) = ( -0.3750000 0.3750000 0.3750000), wk = 0.0625000
k( 18) = ( -0.3750000 0.3750000 1.3750000), wk = 0.0000000
k( 19) = ( 0.3750000 -0.3750000 1.1250000), wk = 0.0625000
k( 20) = ( 0.3750000 -0.3750000 2.1250000), wk = 0.0000000
k( 21) = ( -0.1250000 -0.3750000 -0.3750000), wk = 0.1250000
k( 22) = ( -0.1250000 -0.3750000 0.6250000), wk = 0.0000000
k( 23) = ( 0.6250000 0.3750000 0.3750000), wk = 0.1250000
k( 24) = ( 0.6250000 0.3750000 1.3750000), wk = 0.0000000
k( 25) = ( 0.3750000 0.1250000 0.1250000), wk = 0.1250000
k( 26) = ( 0.3750000 0.1250000 1.1250000), wk = 0.0000000
k( 27) = ( 0.1250000 0.1250000 0.6250000), wk = 0.0625000
k( 28) = ( 0.1250000 0.1250000 1.6250000), wk = 0.0000000
k( 29) = ( 0.8750000 0.1250000 0.6250000), wk = 0.1250000
k( 30) = ( 0.8750000 0.1250000 1.6250000), wk = 0.0000000
k( 31) = ( -0.6250000 0.8750000 -0.1250000), wk = 0.1250000
k( 32) = ( -0.6250000 0.8750000 0.8750000), wk = 0.0000000
k( 33) = ( 0.6250000 -0.1250000 0.3750000), wk = 0.1250000
k( 34) = ( 0.6250000 -0.1250000 1.3750000), wk = 0.0000000
k( 35) = ( -0.3750000 0.6250000 0.1250000), wk = 0.1250000
k( 36) = ( -0.3750000 0.6250000 1.1250000), wk = 0.0000000
k( 37) = ( 0.1250000 0.1250000 -0.8750000), wk = 0.0625000
k( 38) = ( 0.1250000 0.1250000 0.1250000), wk = 0.0000000
k( 39) = ( 1.1250000 0.3750000 0.3750000), wk = 0.1250000
k( 40) = ( 1.1250000 0.3750000 1.3750000), wk = 0.0000000
PseudoPot. # 1 for Si read from file Si.vbc.UPF
Pseudo is Norm-conserving, Zval = 4.0
Generated by new atomic code, or converted to UPF format
Using radial grid of 431 points, 2 beta functions with:
l(1) = 0
l(2) = 1
Atomic displacements (q=0 Repr):
There are 2 irreducible representations
Representation 1 3 modes - To be done
Representation 2 3 modes - To be done
Atomic displacements:
There are 3 irreducible representations
Representation 1 2 modes - To be done
Representation 2 2 modes - To be done
Representation 3 2 modes - To be done
** Complex Version **
D3TOTEN : 0.55s CPU time, 0.60s wall time
Nscf calculating of the perturbed wavefunctions
Calculating for the wavevector q
Representation # 1 modes # 1 2
kpoint 1 ibnd 5 linter: root not converged 0.214E-04
kpoint 1 ibnd 5 linter: root not converged 0.214E-04
kpoint 17 ibnd 5 linter: root not converged 0.118E-04
kpoint 17 ibnd 5 linter: root not converged 0.120E-04
kpoint 21 ibnd 5 linter: root not converged 0.139E-04
kpoint 21 ibnd 5 linter: root not converged 0.139E-04
kpoint 25 ibnd 5 linter: root not converged 0.173E-04
kpoint 25 ibnd 5 linter: root not converged 0.171E-04
thresh= 0.100E-04 total cpu time : 17.4 secs av.it.: 158.6
Representation # 2 modes # 3 4
kpoint 1 ibnd 5 linter: root not converged 0.227E-04
kpoint 1 ibnd 5 linter: root not converged 0.240E-04
kpoint 17 ibnd 5 linter: root not converged 0.125E-04
kpoint 17 ibnd 5 linter: root not converged 0.113E-04
kpoint 21 ibnd 5 linter: root not converged 0.123E-04
kpoint 21 ibnd 5 linter: root not converged 0.118E-04
kpoint 25 ibnd 5 linter: root not converged 0.164E-04
kpoint 25 ibnd 5 linter: root not converged 0.130E-04
thresh= 0.100E-04 total cpu time : 34.3 secs av.it.: 162.1
Representation # 3 modes # 5 6
thresh= 0.100E-04 total cpu time : 50.3 secs av.it.: 151.9
gen_dwfc(1) cpu time: 49.73 sec Total time: 50.28 sec
Calculating for the wavevector q=0 at the original k-points
Representation # 1 modes # 1 2 3
thresh= 0.100E-04 total cpu time : 75.7 secs av.it.: 159.1
Representation # 2 modes # 4 5 6
thresh= 0.100E-04 total cpu time : 100.8 secs av.it.: 160.0
gen_dwfc(3) cpu time: 50.48 sec Total time: 100.76 sec
Calculating for the wavevector q=0 at the (k+q)-points
calling gen_dwfc(2)
Representation # 1 modes # 1 2 3
thresh= 0.100E-04 total cpu time : 125.5 secs av.it.: 159.4
Representation # 2 modes # 4 5 6
thresh= 0.100E-04 total cpu time : 150.4 secs av.it.: 159.9
gen_dwfc(2) cpu time: 49.60 sec Total time: 150.35 sec
Finished the ncf calculation of the perturbed wavefunctions
calling gen_dpdvp
gen_dpdvp cpu time: 0.00 sec Total time: 150.35 sec
Calculating the matrix elements <dpsi |dH |dpsi>
calling dpsidvdpsi: 1
dpsidvdpsi 1 cpu time: 0.85 sec Total time: 151.20 sec
calling dpsidvdpsi: 2
dpsidvdpsi 2 cpu time: 0.96 sec Total time: 152.16 sec
calling dpsidvdpsi: 3
dpsidvdpsi 3 cpu time: 0.84 sec Total time: 153.00 sec
calling dpsidvdpsi: 4
dpsidvdpsi 4 cpu time: 0.83 sec Total time: 153.84 sec
calling dpsidvdpsi: 5
dpsidvdpsi 5 cpu time: 0.84 sec Total time: 154.67 sec
calling dpsidvdpsi: 6
dpsidvdpsi 6 cpu time: 0.83 sec Total time: 155.50 sec
Calculating the matrix elements <dpsi|dpsi>< psi|dH|psi>
calling dpsidpsidv
dpsidpsidv cpu time: 0.10 sec Total time: 155.61 sec
Calculating the matrix elements <psi |d^2 v |dpsi>
calling drhod2v
1
0.000000 0.000000 -0.574542 0.000000 -0.432938 0.000000
-0.574542 0.000000 0.000000 0.000000 0.109853 0.000000
-0.432938 0.000000 0.109853 0.000000 0.000000 0.000000
2
0.000000 0.000000 -0.574542 0.000000 -0.432938 0.000000
-0.574542 0.000000 0.000000 0.000000 0.109853 0.000000
-0.432938 0.000000 0.109853 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.439858 0.000000 -0.579528 0.000000
0.439858 0.000000 0.000000 0.000000 0.016539 0.000000
-0.579528 0.000000 0.016539 0.000000 0.000000 0.000000
2
0.000000 0.000000 0.439858 0.000000 -0.579528 0.000000
0.439858 0.000000 0.000000 0.000000 0.016539 0.000000
-0.579528 0.000000 0.016539 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.077641 0.000000 0.079455 0.000000
0.077641 0.000000 0.000000 0.000000 0.719208 0.000000
0.079455 0.000000 0.719208 0.000000 0.000000 0.000000
2
0.000000 0.000000 0.077641 0.000000 0.079455 0.000000
0.077641 0.000000 0.000000 0.000000 0.719208 0.000000
0.079455 0.000000 0.719208 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.976940 0.000000 0.303098 0.000000
0.976940 0.000000 0.000000 0.000000 -0.589267 0.000000
0.303098 0.000000 -0.589267 0.000000 0.000000 0.000000
2
0.000000 0.000000 -0.976940 0.000000 -0.303098 0.000000
-0.976940 0.000000 0.000000 0.000000 0.589267 0.000000
-0.303098 0.000000 0.589267 0.000000 0.000000 0.000000
1
0.000000 0.000000 -0.653905 0.000000 0.270991 0.000000
-0.653905 0.000000 0.000000 0.000000 -0.944715 0.000000
0.270991 0.000000 -0.944715 0.000000 0.000000 0.000000
2
0.000000 0.000000 0.653905 0.000000 -0.270991 0.000000
0.653905 0.000000 0.000000 0.000000 0.944715 0.000000
-0.270991 0.000000 0.944715 0.000000 0.000000 0.000000
1
0.000000 0.000000 0.107292 0.000000 -1.108247 0.000000
0.107292 0.000000 0.000000 0.000000 -0.392165 0.000000
-1.108247 0.000000 -0.392165 0.000000 0.000000 0.000000
2
0.000000 0.000000 -0.107292 0.000000 1.108247 0.000000
-0.107292 0.000000 0.000000 0.000000 0.392165 0.000000
1.108247 0.000000 0.392165 0.000000 0.000000 0.000000
drhod2v cpu time: 0.50 sec Total time: 156.11 sec
Calculating the matrix elements <psi |d^3v |psi>
calling d3vrho
d3vrho cpu time: 0.12 sec Total time: 156.23 sec
Calculating the Ewald contribution
calling d3ionq
Alpha used in Ewald sum = 1.0000
d3ionq cpu time: 0.01 sec Total time: 156.24 sec
Calculating the valence contribution
calling d3_valence
d3_valence cpu time: 0.00 sec Total time: 156.24 sec
calling drho_cc(+1)
drho_cc(+1) cpu time: 0.00 sec Total time: 156.24 sec
Calculating the exchange-correlation contribution
calling d3_exc
d3_exc cpu time: 0.02 sec Total time: 156.26 sec
Calculating the core-correction contribution
calling d3dyn_cc
d3dyn_cc cpu time: 0.00 sec Total time: 156.26 sec
Symmetrizing and writing the tensor to disc
calling d3matrix
Number of q in the star = 3
List of q in the star:
1 0.000000000 0.000000000 1.000000000
2 1.000000000 0.000000000 0.000000000
3 0.000000000 1.000000000 0.000000000
d3matrix cpu time: 0.00 sec Total time: 156.26 sec
D3TOTEN : 2m36.26s CPU time, 2m40.30s wall time
d3_setup : 0.00s CPU
phq_init : 0.03s CPU
solve_linter : 149.81s CPU ( 7 calls, 21.401 s avg)
ortho : 0.02s CPU ( 360 calls, 0.000 s avg)
cgsolve : 148.75s CPU ( 360 calls, 0.413 s avg)
symdvscf : 0.04s CPU ( 3 calls, 0.013 s avg)
cgsolve : 148.75s CPU ( 360 calls, 0.413 s avg)
ch_psi : 145.98s CPU ( 62666 calls, 0.002 s avg)
ch_psi : 145.98s CPU ( 62666 calls, 0.002 s avg)
h_psiq : 138.71s CPU ( 62666 calls, 0.002 s avg)
last : 6.76s CPU ( 62666 calls, 0.000 s avg)
h_psiq : 138.71s CPU ( 62666 calls, 0.002 s avg)
firstfft : 63.36s CPU ( 229341 calls, 0.000 s avg)
secondfft : 61.80s CPU ( 229341 calls, 0.000 s avg)
General routines
calbec : 4.26s CPU ( 125412 calls, 0.000 s avg)
cft3 : 0.56s CPU ( 1504 calls, 0.000 s avg)
cft3s : 122.92s CPU ( 473082 calls, 0.000 s avg)
davcio : 0.05s CPU ( 22838 calls, 0.000 s avg)

327
PHonon/examples/example13/reference/si.nscf.out
View File

@ -1,327 +0,0 @@
Program PWSCF v.4.0 starts ...
Today is 28Apr2008 at 15:57:56
For Norm-Conserving or Ultrasoft (Vanderbilt) Pseudopotentials or PAW
Current dimensions of program pwscf are:
Max number of different atomic species (ntypx) = 10
Max number of k-points (npk) = 40000
Max angular momentum in pseudopotentials (lmaxx) = 3
bravais-lattice index = 2
lattice parameter (a_0) = 10.2000 a.u.
unit-cell volume = 265.3020 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
number of electrons = 8.00
number of Kohn-Sham states= 4
kinetic-energy cutoff = 24.0000 Ry
charge density cutoff = 96.0000 Ry
convergence threshold = 1.0E-08
mixing beta = 0.7000
number of iterations used = 8 plain mixing
Exchange-correlation = SLA PZ NOGX NOGC (1100)
celldm(1)= 10.200000 celldm(2)= 0.000000 celldm(3)= 0.000000
celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000
crystal axes: (cart. coord. in units of a_0)
a(1) = ( -0.500000 0.000000 0.500000 )
a(2) = ( 0.000000 0.500000 0.500000 )
a(3) = ( -0.500000 0.500000 0.000000 )
reciprocal axes: (cart. coord. in units 2 pi/a_0)
b(1) = ( -1.000000 -1.000000 1.000000 )
b(2) = ( 1.000000 1.000000 1.000000 )
b(3) = ( -1.000000 1.000000 -1.000000 )
PseudoPot. # 1 for Si read from file Si.vbc.UPF
Pseudo is Norm-conserving, Zval = 4.0
Generated by new atomic code, or converted to UPF format
Using radial grid of 431 points, 2 beta functions with:
l(1) = 0
l(2) = 1
atomic species valence mass pseudopotential
Si 4.00 28.08550 Si( 1.00)
16 Sym.Ops. (with inversion)
Cartesian axes
site n. atom positions (a_0 units)
1 Si tau( 1) = ( 0.0000000 0.0000000 0.0000000 )
2 Si tau( 2) = ( 0.2500000 0.2500000 0.2500000 )
number of k points= 40
cart. coord. in units 2pi/a_0
k( 1) = ( -0.1250000 0.1250000 0.1250000), wk = 0.0625000
k( 2) = ( -0.1250000 0.1250000 1.1250000), wk = 0.0000000
k( 3) = ( -0.3750000 0.3750000 -0.1250000), wk = 0.0625000
k( 4) = ( -0.3750000 0.3750000 0.8750000), wk = 0.0000000
k( 5) = ( 0.3750000 -0.3750000 0.6250000), wk = 0.0625000
k( 6) = ( 0.3750000 -0.3750000 1.6250000), wk = 0.0000000
k( 7) = ( 0.1250000 -0.1250000 0.3750000), wk = 0.0625000
k( 8) = ( 0.1250000 -0.1250000 1.3750000), wk = 0.0000000
k( 9) = ( -0.1250000 0.6250000 0.1250000), wk = 0.1250000
k( 10) = ( -0.1250000 0.6250000 1.1250000), wk = 0.0000000
k( 11) = ( 0.6250000 -0.1250000 0.8750000), wk = 0.1250000
k( 12) = ( 0.6250000 -0.1250000 1.8750000), wk = 0.0000000
k( 13) = ( 0.3750000 0.1250000 0.6250000), wk = 0.1250000
k( 14) = ( 0.3750000 0.1250000 1.6250000), wk = 0.0000000
k( 15) = ( -0.1250000 -0.8750000 0.1250000), wk = 0.1250000
k( 16) = ( -0.1250000 -0.8750000 1.1250000), wk = 0.0000000
k( 17) = ( -0.3750000 0.3750000 0.3750000), wk = 0.0625000
k( 18) = ( -0.3750000 0.3750000 1.3750000), wk = 0.0000000
k( 19) = ( 0.3750000 -0.3750000 1.1250000), wk = 0.0625000
k( 20) = ( 0.3750000 -0.3750000 2.1250000), wk = 0.0000000
k( 21) = ( -0.1250000 -0.3750000 -0.3750000), wk = 0.1250000
k( 22) = ( -0.1250000 -0.3750000 0.6250000), wk = 0.0000000
k( 23) = ( 0.6250000 0.3750000 0.3750000), wk = 0.1250000
k( 24) = ( 0.6250000 0.3750000 1.3750000), wk = 0.0000000
k( 25) = ( 0.3750000 0.1250000 0.1250000), wk = 0.1250000
k( 26) = ( 0.3750000 0.1250000 1.1250000), wk = 0.0000000
k( 27) = ( 0.1250000 0.1250000 0.6250000), wk = 0.0625000
k( 28) = ( 0.1250000 0.1250000 1.6250000), wk = 0.0000000
k( 29) = ( 0.8750000 0.1250000 0.6250000), wk = 0.1250000
k( 30) = ( 0.8750000 0.1250000 1.6250000), wk = 0.0000000
k( 31) = ( -0.6250000 0.8750000 -0.1250000), wk = 0.1250000
k( 32) = ( -0.6250000 0.8750000 0.8750000), wk = 0.0000000
k( 33) = ( 0.6250000 -0.1250000 0.3750000), wk = 0.1250000
k( 34) = ( 0.6250000 -0.1250000 1.3750000), wk = 0.0000000
k( 35) = ( -0.3750000 0.6250000 0.1250000), wk = 0.1250000
k( 36) = ( -0.3750000 0.6250000 1.1250000), wk = 0.0000000
k( 37) = ( 0.1250000 0.1250000 -0.8750000), wk = 0.0625000
k( 38) = ( 0.1250000 0.1250000 0.1250000), wk = 0.0000000
k( 39) = ( 1.1250000 0.3750000 0.3750000), wk = 0.1250000
k( 40) = ( 1.1250000 0.3750000 1.3750000), wk = 0.0000000
G cutoff = 252.9949 ( 4279 G-vectors) FFT grid: ( 24, 24, 24)
Largest allocated arrays est. size (Mb) dimensions
Kohn-Sham Wavefunctions 0.03 Mb ( 534, 4)
NL pseudopotentials 0.07 Mb ( 534, 8)
Each V/rho on FFT grid 0.21 Mb ( 13824)
Each G-vector array 0.03 Mb ( 4279)
G-vector shells 0.00 Mb ( 86)
Largest temporary arrays est. size (Mb) dimensions
Auxiliary wavefunctions 0.13 Mb ( 534, 16)
Each subspace H/S matrix 0.00 Mb ( 16, 16)
Each <psi_i|beta_j> matrix 0.00 Mb ( 8, 4)
Arrays for rho mixing 1.69 Mb ( 13824, 8)
The potential is recalculated from file :
si.save/charge-density.dat
Starting wfc are 8 atomic wfcs
total cpu time spent up to now is 0.06 secs
per-process dynamical memory: 2.2 Mb
Band Structure Calculation
Davidson diagonalization with overlap
ethr = 1.25E-10, avg # of iterations = 11.9
total cpu time spent up to now is 1.71 secs
End of band structure calculation
k =-0.1250 0.1250 0.1250 band energies (ev):
-5.6138 4.6327 5.9404 5.9404
k =-0.1250 0.1250 1.1250 band energies (ev):
-2.4719 -0.6037 2.7180 3.5015
k =-0.3750 0.3750-0.1250 band energies (ev):
-4.5483 1.5828 3.8822 5.4511
k =-0.3750 0.3750 0.8750 band energies (ev):
-2.8345 -0.4465 2.1552 4.3149
k = 0.3750-0.3750 0.6250 band energies (ev):
-3.3458 -0.5903 3.9246 4.6467
k = 0.3750-0.3750 1.6250 band energies (ev):
-4.0927 0.2251 5.1322 5.1322
k = 0.1250-0.1250 0.3750 band energies (ev):
-5.0672 3.0066 4.8907 4.9782
k = 0.1250-0.1250 1.3750 band energies (ev):
-3.9985 1.2999 3.5091 3.9849
k =-0.1250 0.6250 0.1250 band energies (ev):
-3.9985 1.2999 3.5091 3.9849
k =-0.1250 0.6250 1.1250 band energies (ev):
-2.2825 -0.7123 2.0738 3.2050
k = 0.6250-0.1250 0.8750 band energies (ev):
-2.2825 -0.7123 2.0738 3.2050
k = 0.6250-0.1250 1.8750 band energies (ev):
-3.9985 1.2999 3.5091 3.9849
k = 0.3750 0.1250 0.6250 band energies (ev):
-3.5604 0.3663 2.8491 4.2661
k = 0.3750 0.1250 1.6250 band energies (ev):
-4.5483 1.5828 3.8822 5.4511
k =-0.1250-0.8750 0.1250 band energies (ev):
-2.4719 -0.6037 2.7180 3.5015
k =-0.1250-0.8750 1.1250 band energies (ev):
-2.4719 -0.6037 2.7180 3.5015
k =-0.3750 0.3750 0.3750 band energies (ev):
-4.0927 0.2251 5.1322 5.1322
k =-0.3750 0.3750 1.3750 band energies (ev):
-3.3458 -0.5903 3.9246 4.6467
k = 0.3750-0.3750 1.1250 band energies (ev):
-2.8345 -0.4465 2.1552 4.3149
k = 0.3750-0.3750 2.1250 band energies (ev):
-4.5483 1.5828 3.8822 5.4511
k =-0.1250-0.3750-0.3750 band energies (ev):
-4.5483 1.5828 3.8822 5.4511
k =-0.1250-0.3750 0.6250 band energies (ev):
-3.5604 0.3663 2.8491 4.2661
k = 0.6250 0.3750 0.3750 band energies (ev):
-3.3458 -0.5903 3.9246 4.6467
k = 0.6250 0.3750 1.3750 band energies (ev):
-3.3458 -0.5903 3.9246 4.6467
k = 0.3750 0.1250 0.1250 band energies (ev):
-5.0672 3.0066 4.8907 4.9782
k = 0.3750 0.1250 1.1250 band energies (ev):
-2.2825 -0.7123 2.0738 3.2050
k = 0.1250 0.1250 0.6250 band energies (ev):
-3.9985 1.2999 3.5091 3.9849
k = 0.1250 0.1250 1.6250 band energies (ev):
-5.0672 3.0066 4.8907 4.9782
k = 0.8750 0.1250 0.6250 band energies (ev):
-2.2825 -0.7123 2.0738 3.2050
k = 0.8750 0.1250 1.6250 band energies (ev):
-2.2825 -0.7123 2.0738 3.2050
k =-0.6250 0.8750-0.1250 band energies (ev):
-2.2825 -0.7123 2.0738 3.2050
k =-0.6250 0.8750 0.8750 band energies (ev):
-5.0672 3.0066 4.8907 4.9782
k = 0.6250-0.1250 0.3750 band energies (ev):
-3.5604 0.3663 2.8491 4.2661
k = 0.6250-0.1250 1.3750 band energies (ev):
-2.8345 -0.4465 2.1552 4.3149
k =-0.3750 0.6250 0.1250 band energies (ev):
-3.5604 0.3663 2.8491 4.2661
k =-0.3750 0.6250 1.1250 band energies (ev):
-3.5604 0.3663 2.8491 4.2661
k = 0.1250 0.1250-0.8750 band energies (ev):
-2.4719 -0.6037 2.7180 3.5015
k = 0.1250 0.1250 0.1250 band energies (ev):
-5.6138 4.6327 5.9404 5.9404
k = 1.1250 0.3750 0.3750 band energies (ev):
-2.8345 -0.4465 2.1552 4.3149
k = 1.1250 0.3750 1.3750 band energies (ev):
-3.5604 0.3663 2.8491 4.2661
Writing output data file si.save
PWSCF : 1.81s CPU time, 1.92s wall time
init_run : 0.04s CPU
electrons : 1.65s CPU
Called by init_run:
wfcinit : 0.00s CPU
potinit : 0.00s CPU
Called by electrons:
c_bands : 1.65s CPU
v_of_rho : 0.00s CPU
Called by c_bands:
init_us_2 : 0.00s CPU ( 40 calls, 0.000 s avg)
cegterg : 1.42s CPU ( 40 calls, 0.035 s avg)
Called by *egterg:
h_psi : 1.38s CPU ( 556 calls, 0.002 s avg)
g_psi : 0.04s CPU ( 476 calls, 0.000 s avg)
cdiaghg : 0.07s CPU ( 516 calls, 0.000 s avg)
Called by h_psi:
add_vuspsi : 0.03s CPU ( 556 calls, 0.000 s avg)
General routines
calbec : 0.03s CPU ( 556 calls, 0.000 s avg)
cft3 : 0.00s CPU ( 3 calls, 0.000 s avg)
cft3s : 1.16s CPU ( 4168 calls, 0.000 s avg)
davcio : 0.00s CPU ( 40 calls, 0.000 s avg)

215
PHonon/examples/example13/reference/si.phG.out
View File

@ -1,215 +0,0 @@
Program PHONON v.4.0 starts ...
Today is 28Apr2008 at 15:57:21
Ultrasoft (Vanderbilt) Pseudopotentials
WRITING PATTERNS TO FILE si.drho_G.pat
bravais-lattice index = 2
lattice parameter (a_0) = 10.2000 a.u.
unit-cell volume = 265.3020 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
kinetic-energy cut-off = 24.0000 Ry
charge density cut-off = 96.0000 Ry
convergence threshold = 1.0E-12
beta = 0.7000
number of iterations used = 4
Exchange-correlation = SLA PZ NOGX NOGC (1100)
celldm(1)= 10.20000 celldm(2)= 0.00000 celldm(3)= 0.00000
celldm(4)= 0.00000 celldm(5)= 0.00000 celldm(6)= 0.00000
crystal axes: (cart. coord. in units of a_0)
a(1) = ( -0.5000 0.0000 0.5000 )
a(2) = ( 0.0000 0.5000 0.5000 )
a(3) = ( -0.5000 0.5000 0.0000 )
reciprocal axes: (cart. coord. in units 2 pi/a_0)
b(1) = ( -1.0000 -1.0000 1.0000 )
b(2) = ( 1.0000 1.0000 1.0000 )
b(3) = ( -1.0000 1.0000 -1.0000 )
Atoms inside the unit cell:
Cartesian axes
site n. atom mass positions (a_0 units)
1 Si 28.0855 tau( 1) = ( 0.00000 0.00000 0.00000 )
2 Si 28.0855 tau( 2) = ( 0.25000 0.25000 0.25000 )
Computing dynamical matrix for
q = ( 0.00000 0.00000 0.00000 )
49 Sym.Ops. (with q -> -q+G )
G cutoff = 252.9949 ( 4279 G-vectors) FFT grid: ( 24, 24, 24)
number of k points= 10
cart. coord. in units 2pi/a_0
k( 1) = ( -0.1250000 0.1250000 0.1250000), wk = 0.0625000
k( 2) = ( -0.3750000 0.3750000 -0.1250000), wk = 0.1875000
k( 3) = ( 0.3750000 -0.3750000 0.6250000), wk = 0.1875000
k( 4) = ( 0.1250000 -0.1250000 0.3750000), wk = 0.1875000
k( 5) = ( -0.1250000 0.6250000 0.1250000), wk = 0.1875000
k( 6) = ( 0.6250000 -0.1250000 0.8750000), wk = 0.3750000
k( 7) = ( 0.3750000 0.1250000 0.6250000), wk = 0.3750000
k( 8) = ( -0.1250000 -0.8750000 0.1250000), wk = 0.1875000
k( 9) = ( -0.3750000 0.3750000 0.3750000), wk = 0.0625000
k( 10) = ( 0.3750000 -0.3750000 1.1250000), wk = 0.1875000
PseudoPot. # 1 for Si read from file Si.vbc.UPF
Pseudo is Norm-conserving, Zval = 4.0
Generated by new atomic code, or converted to UPF format
Using radial grid of 431 points, 2 beta functions with:
l(1) = 0
l(2) = 1
Atomic displacements:
There are 2 irreducible representations
Representation 1 3 modes - To be done
Representation 2 3 modes - To be done
PHONON : 0.37s CPU time, 0.46s wall time
Alpha used in Ewald sum = 1.0000
Representation # 1 modes # 1 2 3
Self-consistent Calculation
iter # 1 total cpu time : 1.0 secs av.it.: 5.0
thresh= 0.100E-01 alpha_mix = 0.700 |ddv_scf|^2 = 0.110E-06
iter # 2 total cpu time : 2.0 secs av.it.: 10.2
thresh= 0.332E-04 alpha_mix = 0.700 |ddv_scf|^2 = 0.197E-08
iter # 3 total cpu time : 3.0 secs av.it.: 9.9
thresh= 0.444E-05 alpha_mix = 0.700 |ddv_scf|^2 = 0.246E-10
iter # 4 total cpu time : 3.9 secs av.it.: 9.5
thresh= 0.496E-06 alpha_mix = 0.700 |ddv_scf|^2 = 0.209E-13
End of self-consistent calculation
Convergence has been achieved
Representation # 2 modes # 4 5 6
Self-consistent Calculation
iter # 1 total cpu time : 4.6 secs av.it.: 5.0
thresh= 0.100E-01 alpha_mix = 0.700 |ddv_scf|^2 = 0.779E-07
iter # 2 total cpu time : 5.6 secs av.it.: 10.1
thresh= 0.279E-04 alpha_mix = 0.700 |ddv_scf|^2 = 0.287E-08
iter # 3 total cpu time : 6.6 secs av.it.: 10.1
thresh= 0.536E-05 alpha_mix = 0.700 |ddv_scf|^2 = 0.314E-10
iter # 4 total cpu time : 7.6 secs av.it.: 9.9
thresh= 0.560E-06 alpha_mix = 0.700 |ddv_scf|^2 = 0.609E-13
End of self-consistent calculation
Convergence has been achieved
Number of q in the star = 1
List of q in the star:
1 0.000000000 0.000000000 0.000000000
Diagonalizing the dynamical matrix
q = ( 0.000000000 0.000000000 0.000000000 )
**************************************************************************
omega( 1) = 0.473285 [THz] = 15.787194 [cm-1]
omega( 2) = 0.473285 [THz] = 15.787194 [cm-1]
omega( 3) = 0.473285 [THz] = 15.787194 [cm-1]
omega( 4) = 15.271022 [THz] = 509.389865 [cm-1]
omega( 5) = 15.271022 [THz] = 509.389865 [cm-1]
omega( 6) = 15.271022 [THz] = 509.389865 [cm-1]
**************************************************************************
Mode symmetry, O_h (m-3m) point group:
omega( 1 - 3) = 15.8 [cm-1] --> T_1u G_15 G_4- I
omega( 4 - 6) = 509.4 [cm-1] --> T_2g G_25' G_5+ R
**************************************************************************
Calling punch_plot_ph
Writing on file si.drho_G
PHONON : 7.70s CPU time, 9.53s wall time
INITIALIZATION:
phq_setup : 0.00s CPU
phq_init : 0.02s CPU
phq_init : 0.02s CPU
init_vloc : 0.00s CPU ( 2 calls, 0.000 s avg)
init_us_1 : 0.01s CPU
DYNAMICAL MATRIX:
dynmat0 : 0.01s CPU
phqscf : 7.21s CPU
dynmatrix : 0.00s CPU
phqscf : 7.21s CPU
solve_linter : 7.18s CPU ( 2 calls, 3.592 s avg)
drhodv : 0.02s CPU ( 2 calls, 0.010 s avg)
dynmat0 : 0.01s CPU
dynmat_us : 0.01s CPU
d2ionq : 0.00s CPU
dynmat_us : 0.01s CPU
phqscf : 7.21s CPU
solve_linter : 7.18s CPU ( 2 calls, 3.592 s avg)
solve_linter : 7.18s CPU ( 2 calls, 3.592 s avg)
dvqpsi_us : 0.20s CPU ( 60 calls, 0.003 s avg)
ortho : 0.03s CPU ( 240 calls, 0.000 s avg)
cgsolve : 5.40s CPU ( 240 calls, 0.023 s avg)
incdrhoscf : 0.58s CPU ( 240 calls, 0.002 s avg)
vpsifft : 0.42s CPU ( 180 calls, 0.002 s avg)
dv_of_drho : 0.03s CPU ( 24 calls, 0.001 s avg)
mix_pot : 0.02s CPU ( 8 calls, 0.003 s avg)
symdvscf : 0.56s CPU ( 10 calls, 0.056 s avg)
dvqpsi_us : 0.20s CPU ( 60 calls, 0.003 s avg)
dvqpsi_us_on : 0.01s CPU ( 60 calls, 0.000 s avg)
cgsolve : 5.40s CPU ( 240 calls, 0.023 s avg)
ch_psi : 5.29s CPU ( 2364 calls, 0.002 s avg)
ch_psi : 5.29s CPU ( 2364 calls, 0.002 s avg)
h_psiq : 4.99s CPU ( 2364 calls, 0.002 s avg)
last : 0.28s CPU ( 2364 calls, 0.000 s avg)
h_psiq : 4.99s CPU ( 2364 calls, 0.002 s avg)
firstfft : 2.25s CPU ( 8784 calls, 0.000 s avg)
secondfft : 2.23s CPU ( 8784 calls, 0.000 s avg)
add_vuspsi : 0.12s CPU ( 2364 calls, 0.000 s avg)
incdrhoscf : 0.58s CPU ( 240 calls, 0.002 s avg)
General routines
calbec : 0.17s CPU ( 5308 calls, 0.000 s avg)
cft3 : 0.03s CPU ( 76 calls, 0.000 s avg)
cft3s : 5.19s CPU ( 21480 calls, 0.000 s avg)
davcio : 0.01s CPU ( 882 calls, 0.000 s avg)
write_rec : 0.00s CPU ( 8 calls, 0.000 s avg)

272
PHonon/examples/example13/reference/si.phX.out
View File

@ -1,272 +0,0 @@
Program PHONON v.4.0 starts ...
Today is 28Apr2008 at 15:57:58
Ultrasoft (Vanderbilt) Pseudopotentials
WRITING PATTERNS TO FILE si.drho_X.pat
bravais-lattice index = 2
lattice parameter (a_0) = 10.2000 a.u.
unit-cell volume = 265.3020 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
kinetic-energy cut-off = 24.0000 Ry
charge density cut-off = 96.0000 Ry
convergence threshold = 1.0E-12
beta = 0.7000
number of iterations used = 4
Exchange-correlation = SLA PZ NOGX NOGC (1100)
celldm(1)= 10.20000 celldm(2)= 0.00000 celldm(3)= 0.00000
celldm(4)= 0.00000 celldm(5)= 0.00000 celldm(6)= 0.00000
crystal axes: (cart. coord. in units of a_0)
a(1) = ( -0.5000 0.0000 0.5000 )
a(2) = ( 0.0000 0.5000 0.5000 )
a(3) = ( -0.5000 0.5000 0.0000 )
reciprocal axes: (cart. coord. in units 2 pi/a_0)
b(1) = ( -1.0000 -1.0000 1.0000 )
b(2) = ( 1.0000 1.0000 1.0000 )
b(3) = ( -1.0000 1.0000 -1.0000 )
Atoms inside the unit cell:
Cartesian axes
site n. atom mass positions (a_0 units)
1 Si 28.0855 tau( 1) = ( 0.00000 0.00000 0.00000 )
2 Si 28.0855 tau( 2) = ( 0.25000 0.25000 0.25000 )
Computing dynamical matrix for
q = ( 0.00000 0.00000 1.00000 )
17 Sym.Ops. (with q -> -q+G )
G cutoff = 252.9949 ( 4279 G-vectors) FFT grid: ( 24, 24, 24)
number of k points= 40
cart. coord. in units 2pi/a_0
k( 1) = ( -0.1250000 0.1250000 0.1250000), wk = 0.0625000
k( 2) = ( -0.1250000 0.1250000 1.1250000), wk = 0.0000000
k( 3) = ( -0.3750000 0.3750000 -0.1250000), wk = 0.0625000
k( 4) = ( -0.3750000 0.3750000 0.8750000), wk = 0.0000000
k( 5) = ( 0.3750000 -0.3750000 0.6250000), wk = 0.0625000
k( 6) = ( 0.3750000 -0.3750000 1.6250000), wk = 0.0000000
k( 7) = ( 0.1250000 -0.1250000 0.3750000), wk = 0.0625000
k( 8) = ( 0.1250000 -0.1250000 1.3750000), wk = 0.0000000
k( 9) = ( -0.1250000 0.6250000 0.1250000), wk = 0.1250000
k( 10) = ( -0.1250000 0.6250000 1.1250000), wk = 0.0000000
k( 11) = ( 0.6250000 -0.1250000 0.8750000), wk = 0.1250000
k( 12) = ( 0.6250000 -0.1250000 1.8750000), wk = 0.0000000
k( 13) = ( 0.3750000 0.1250000 0.6250000), wk = 0.1250000
k( 14) = ( 0.3750000 0.1250000 1.6250000), wk = 0.0000000
k( 15) = ( -0.1250000 -0.8750000 0.1250000), wk = 0.1250000
k( 16) = ( -0.1250000 -0.8750000 1.1250000), wk = 0.0000000
k( 17) = ( -0.3750000 0.3750000 0.3750000), wk = 0.0625000
k( 18) = ( -0.3750000 0.3750000 1.3750000), wk = 0.0000000
k( 19) = ( 0.3750000 -0.3750000 1.1250000), wk = 0.0625000
k( 20) = ( 0.3750000 -0.3750000 2.1250000), wk = 0.0000000
k( 21) = ( -0.1250000 -0.3750000 -0.3750000), wk = 0.1250000
k( 22) = ( -0.1250000 -0.3750000 0.6250000), wk = 0.0000000
k( 23) = ( 0.6250000 0.3750000 0.3750000), wk = 0.1250000
k( 24) = ( 0.6250000 0.3750000 1.3750000), wk = 0.0000000
k( 25) = ( 0.3750000 0.1250000 0.1250000), wk = 0.1250000
k( 26) = ( 0.3750000 0.1250000 1.1250000), wk = 0.0000000
k( 27) = ( 0.1250000 0.1250000 0.6250000), wk = 0.0625000
k( 28) = ( 0.1250000 0.1250000 1.6250000), wk = 0.0000000
k( 29) = ( 0.8750000 0.1250000 0.6250000), wk = 0.1250000
k( 30) = ( 0.8750000 0.1250000 1.6250000), wk = 0.0000000
k( 31) = ( -0.6250000 0.8750000 -0.1250000), wk = 0.1250000
k( 32) = ( -0.6250000 0.8750000 0.8750000), wk = 0.0000000
k( 33) = ( 0.6250000 -0.1250000 0.3750000), wk = 0.1250000
k( 34) = ( 0.6250000 -0.1250000 1.3750000), wk = 0.0000000
k( 35) = ( -0.3750000 0.6250000 0.1250000), wk = 0.1250000
k( 36) = ( -0.3750000 0.6250000 1.1250000), wk = 0.0000000
k( 37) = ( 0.1250000 0.1250000 -0.8750000), wk = 0.0625000
k( 38) = ( 0.1250000 0.1250000 0.1250000), wk = 0.0000000
k( 39) = ( 1.1250000 0.3750000 0.3750000), wk = 0.1250000
k( 40) = ( 1.1250000 0.3750000 1.3750000), wk = 0.0000000
PseudoPot. # 1 for Si read from file Si.vbc.UPF
Pseudo is Norm-conserving, Zval = 4.0
Generated by new atomic code, or converted to UPF format
Using radial grid of 431 points, 2 beta functions with:
l(1) = 0
l(2) = 1
Atomic displacements:
There are 3 irreducible representations
Representation 1 2 modes - To be done
Representation 2 2 modes - To be done
Representation 3 2 modes - To be done
PHONON : 0.44s CPU time, 0.46s wall time
Alpha used in Ewald sum = 1.0000
Representation # 1 modes # 1 2
Self-consistent Calculation
iter # 1 total cpu time : 1.4 secs av.it.: 5.7
thresh= 0.100E-01 alpha_mix = 0.700 |ddv_scf|^2 = 0.108E-04
iter # 2 total cpu time : 2.7 secs av.it.: 9.7
thresh= 0.329E-03 alpha_mix = 0.700 |ddv_scf|^2 = 0.148E-04
iter # 3 total cpu time : 3.9 secs av.it.: 8.8
thresh= 0.385E-03 alpha_mix = 0.700 |ddv_scf|^2 = 0.297E-08
iter # 4 total cpu time : 5.2 secs av.it.: 9.5
thresh= 0.545E-05 alpha_mix = 0.700 |ddv_scf|^2 = 0.493E-10
iter # 5 total cpu time : 6.4 secs av.it.: 9.2
thresh= 0.702E-06 alpha_mix = 0.700 |ddv_scf|^2 = 0.138E-11
iter # 6 total cpu time : 7.5 secs av.it.: 9.0
thresh= 0.117E-06 alpha_mix = 0.700 |ddv_scf|^2 = 0.477E-14
End of self-consistent calculation
Convergence has been achieved
Representation # 2 modes # 3 4
Self-consistent Calculation
iter # 1 total cpu time : 8.4 secs av.it.: 5.5
thresh= 0.100E-01 alpha_mix = 0.700 |ddv_scf|^2 = 0.227E-05
iter # 2 total cpu time : 9.6 secs av.it.: 9.7
thresh= 0.151E-03 alpha_mix = 0.700 |ddv_scf|^2 = 0.636E-06
iter # 3 total cpu time : 10.9 secs av.it.: 9.2
thresh= 0.798E-04 alpha_mix = 0.700 |ddv_scf|^2 = 0.124E-09
iter # 4 total cpu time : 12.0 secs av.it.: 9.1
thresh= 0.111E-05 alpha_mix = 0.700 |ddv_scf|^2 = 0.103E-11
iter # 5 total cpu time : 13.2 secs av.it.: 9.2
thresh= 0.102E-06 alpha_mix = 0.700 |ddv_scf|^2 = 0.297E-14
End of self-consistent calculation
Convergence has been achieved
Representation # 3 modes # 5 6
Self-consistent Calculation
iter # 1 total cpu time : 14.0 secs av.it.: 4.2
thresh= 0.100E-01 alpha_mix = 0.700 |ddv_scf|^2 = 0.758E-08
iter # 2 total cpu time : 15.2 secs av.it.: 9.5
thresh= 0.871E-05 alpha_mix = 0.700 |ddv_scf|^2 = 0.388E-09
iter # 3 total cpu time : 16.5 secs av.it.: 8.9
thresh= 0.197E-05 alpha_mix = 0.700 |ddv_scf|^2 = 0.130E-10
iter # 4 total cpu time : 17.7 secs av.it.: 8.9
thresh= 0.360E-06 alpha_mix = 0.700 |ddv_scf|^2 = 0.148E-13
End of self-consistent calculation
Convergence has been achieved
Number of q in the star = 3
List of q in the star:
1 0.000000000 0.000000000 1.000000000
2 1.000000000 0.000000000 0.000000000
3 0.000000000 1.000000000 0.000000000
Diagonalizing the dynamical matrix
q = ( 0.000000000 0.000000000 1.000000000 )
**************************************************************************
omega( 1) = 4.245101 [THz] = 141.602272 [cm-1]
omega( 2) = 4.245101 [THz] = 141.602272 [cm-1]
omega( 3) = 12.229441 [THz] = 407.932965 [cm-1]
omega( 4) = 12.229441 [THz] = 407.932965 [cm-1]
omega( 5) = 13.711492 [THz] = 457.369177 [cm-1]
omega( 6) = 13.711492 [THz] = 457.369177 [cm-1]
**************************************************************************
Calling punch_plot_ph
Writing on file si.drho_X
PHONON : 17.79s CPU time, 22.58s wall time
INITIALIZATION:
phq_setup : 0.00s CPU
phq_init : 0.03s CPU
phq_init : 0.03s CPU
init_vloc : 0.00s CPU ( 2 calls, 0.001 s avg)
init_us_1 : 0.01s CPU
DYNAMICAL MATRIX:
dynmat0 : 0.01s CPU
phqscf : 17.28s CPU
dynmatrix : 0.00s CPU
phqscf : 17.28s CPU
solve_linter : 17.24s CPU ( 3 calls, 5.748 s avg)
drhodv : 0.04s CPU ( 3 calls, 0.013 s avg)
dynmat0 : 0.01s CPU
dynmat_us : 0.01s CPU
d2ionq : 0.00s CPU
dynmat_us : 0.01s CPU
phqscf : 17.28s CPU
solve_linter : 17.24s CPU ( 3 calls, 5.748 s avg)
solve_linter : 17.24s CPU ( 3 calls, 5.748 s avg)
dvqpsi_us : 0.40s CPU ( 120 calls, 0.003 s avg)
ortho : 0.07s CPU ( 600 calls, 0.000 s avg)
cgsolve : 13.62s CPU ( 600 calls, 0.023 s avg)
incdrhoscf : 1.54s CPU ( 600 calls, 0.003 s avg)
vpsifft : 1.20s CPU ( 480 calls, 0.002 s avg)
dv_of_drho : 0.05s CPU ( 30 calls, 0.002 s avg)
mix_pot : 0.03s CPU ( 15 calls, 0.002 s avg)
symdvscf : 0.24s CPU ( 18 calls, 0.013 s avg)
dvqpsi_us : 0.40s CPU ( 120 calls, 0.003 s avg)
dvqpsi_us_on : 0.02s CPU ( 120 calls, 0.000 s avg)
cgsolve : 13.62s CPU ( 600 calls, 0.023 s avg)
ch_psi : 13.36s CPU ( 5733 calls, 0.002 s avg)
ch_psi : 13.36s CPU ( 5733 calls, 0.002 s avg)
h_psiq : 12.63s CPU ( 5733 calls, 0.002 s avg)
last : 0.68s CPU ( 5733 calls, 0.000 s avg)
h_psiq : 12.63s CPU ( 5733 calls, 0.002 s avg)
firstfft : 5.68s CPU ( 21077 calls, 0.000 s avg)
secondfft : 5.62s CPU ( 21077 calls, 0.000 s avg)
add_vuspsi : 0.28s CPU ( 5733 calls, 0.000 s avg)
incdrhoscf : 1.54s CPU ( 600 calls, 0.003 s avg)
General routines
calbec : 0.48s CPU ( 12746 calls, 0.000 s avg)
cft3 : 0.04s CPU ( 94 calls, 0.000 s avg)
cft3s : 13.20s CPU ( 51892 calls, 0.000 s avg)
davcio : 0.02s CPU ( 2556 calls, 0.000 s avg)
write_rec : 0.00s CPU ( 15 calls, 0.000 s avg)

267
PHonon/examples/example13/reference/si.scf.out
View File

@ -1,267 +0,0 @@
Program PWSCF v.4.0 starts ...
Today is 28Apr2008 at 15:57:20
For Norm-Conserving or Ultrasoft (Vanderbilt) Pseudopotentials or PAW
Current dimensions of program pwscf are:
Max number of different atomic species (ntypx) = 10
Max number of k-points (npk) = 40000
Max angular momentum in pseudopotentials (lmaxx) = 3
bravais-lattice index = 2
lattice parameter (a_0) = 10.2000 a.u.
unit-cell volume = 265.3020 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
number of electrons = 8.00
number of Kohn-Sham states= 4
kinetic-energy cutoff = 24.0000 Ry
charge density cutoff = 96.0000 Ry
convergence threshold = 1.0E-08
mixing beta = 0.7000
number of iterations used = 8 plain mixing
Exchange-correlation = SLA PZ NOGX NOGC (1100)
celldm(1)= 10.200000 celldm(2)= 0.000000 celldm(3)= 0.000000
celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000
crystal axes: (cart. coord. in units of a_0)
a(1) = ( -0.500000 0.000000 0.500000 )
a(2) = ( 0.000000 0.500000 0.500000 )
a(3) = ( -0.500000 0.500000 0.000000 )
reciprocal axes: (cart. coord. in units 2 pi/a_0)
b(1) = ( -1.000000 -1.000000 1.000000 )
b(2) = ( 1.000000 1.000000 1.000000 )
b(3) = ( -1.000000 1.000000 -1.000000 )
PseudoPot. # 1 for Si read from file Si.vbc.UPF
Pseudo is Norm-conserving, Zval = 4.0
Generated by new atomic code, or converted to UPF format
Using radial grid of 431 points, 2 beta functions with:
l(1) = 0
l(2) = 1
atomic species valence mass pseudopotential
Si 4.00 28.08600 Si( 1.00)
48 Sym.Ops. (with inversion)
Cartesian axes
site n. atom positions (a_0 units)
1 Si tau( 1) = ( 0.0000000 0.0000000 0.0000000 )
2 Si tau( 2) = ( 0.2500000 0.2500000 0.2500000 )
number of k points= 10
cart. coord. in units 2pi/a_0
k( 1) = ( -0.1250000 0.1250000 0.1250000), wk = 0.0625000
k( 2) = ( -0.3750000 0.3750000 -0.1250000), wk = 0.1875000
k( 3) = ( 0.3750000 -0.3750000 0.6250000), wk = 0.1875000
k( 4) = ( 0.1250000 -0.1250000 0.3750000), wk = 0.1875000
k( 5) = ( -0.1250000 0.6250000 0.1250000), wk = 0.1875000
k( 6) = ( 0.6250000 -0.1250000 0.8750000), wk = 0.3750000
k( 7) = ( 0.3750000 0.1250000 0.6250000), wk = 0.3750000
k( 8) = ( -0.1250000 -0.8750000 0.1250000), wk = 0.1875000
k( 9) = ( -0.3750000 0.3750000 0.3750000), wk = 0.0625000
k( 10) = ( 0.3750000 -0.3750000 1.1250000), wk = 0.1875000
G cutoff = 252.9949 ( 4279 G-vectors) FFT grid: ( 24, 24, 24)
Largest allocated arrays est. size (Mb) dimensions
Kohn-Sham Wavefunctions 0.03 Mb ( 534, 4)
NL pseudopotentials 0.07 Mb ( 534, 8)
Each V/rho on FFT grid 0.21 Mb ( 13824)
Each G-vector array 0.03 Mb ( 4279)
G-vector shells 0.00 Mb ( 86)
Largest temporary arrays est. size (Mb) dimensions
Auxiliary wavefunctions 0.13 Mb ( 534, 16)
Each subspace H/S matrix 0.00 Mb ( 16, 16)
Each <psi_i|beta_j> matrix 0.00 Mb ( 8, 4)
Arrays for rho mixing 1.69 Mb ( 13824, 8)
Initial potential from superposition of free atoms
starting charge 7.99901, renormalised to 8.00000
Starting wfc are 8 atomic wfcs
total cpu time spent up to now is 0.09 secs
per-process dynamical memory: 4.1 Mb
Self-consistent Calculation
iteration # 1 ecut= 24.00 Ry beta=0.70
Davidson diagonalization with overlap
ethr = 1.00E-02, avg # of iterations = 2.0
Threshold (ethr) on eigenvalues was too large:
Diagonalizing with lowered threshold
Davidson diagonalization with overlap
ethr = 7.88E-04, avg # of iterations = 1.0
total cpu time spent up to now is 0.27 secs
total energy = -15.84726260 Ry
Harris-Foulkes estimate = -15.86830186 Ry
estimated scf accuracy < 0.06187593 Ry
iteration # 2 ecut= 24.00 Ry beta=0.70
Davidson diagonalization with overlap
ethr = 7.73E-04, avg # of iterations = 1.0
total cpu time spent up to now is 0.34 secs
total energy = -15.85036021 Ry
Harris-Foulkes estimate = -15.85065771 Ry
estimated scf accuracy < 0.00215540 Ry
iteration # 3 ecut= 24.00 Ry beta=0.70
Davidson diagonalization with overlap
ethr = 2.69E-05, avg # of iterations = 2.5
total cpu time spent up to now is 0.42 secs
total energy = -15.85079920 Ry
Harris-Foulkes estimate = -15.85083148 Ry
estimated scf accuracy < 0.00007288 Ry
iteration # 4 ecut= 24.00 Ry beta=0.70
Davidson diagonalization with overlap
ethr = 9.11E-07, avg # of iterations = 2.2
total cpu time spent up to now is 0.53 secs
total energy = -15.85081676 Ry
Harris-Foulkes estimate = -15.85082023 Ry
estimated scf accuracy < 0.00000739 Ry
iteration # 5 ecut= 24.00 Ry beta=0.70
Davidson diagonalization with overlap
ethr = 9.24E-08, avg # of iterations = 2.0
total cpu time spent up to now is 0.63 secs
total energy = -15.85081790 Ry
Harris-Foulkes estimate = -15.85081794 Ry
estimated scf accuracy < 0.00000009 Ry
iteration # 6 ecut= 24.00 Ry beta=0.70
Davidson diagonalization with overlap
ethr = 1.09E-09, avg # of iterations = 2.5
total cpu time spent up to now is 0.73 secs
End of self-consistent calculation
k =-0.1250 0.1250 0.1250 ( 534 PWs) bands (ev):
-5.6138 4.6327 5.9404 5.9404
k =-0.3750 0.3750-0.1250 ( 526 PWs) bands (ev):
-4.5483 1.5828 3.8822 5.4511
k = 0.3750-0.3750 0.6250 ( 530 PWs) bands (ev):
-3.3458 -0.5903 3.9247 4.6467
k = 0.1250-0.1250 0.3750 ( 531 PWs) bands (ev):
-5.0672 3.0066 4.8907 4.9783
k =-0.1250 0.6250 0.1250 ( 528 PWs) bands (ev):
-3.9985 1.2999 3.5091 3.9849
k = 0.6250-0.1250 0.8750 ( 522 PWs) bands (ev):
-2.2825 -0.7123 2.0739 3.2050
k = 0.3750 0.1250 0.6250 ( 526 PWs) bands (ev):
-3.5604 0.3664 2.8491 4.2661
k =-0.1250-0.8750 0.1250 ( 521 PWs) bands (ev):
-2.4719 -0.6036 2.7181 3.5015
k =-0.3750 0.3750 0.3750 ( 528 PWs) bands (ev):
-4.0927 0.2251 5.1322 5.1322
k = 0.3750-0.3750 1.1250 ( 526 PWs) bands (ev):
-2.8345 -0.4465 2.1552 4.3149
! total energy = -15.85081793 Ry
Harris-Foulkes estimate = -15.85081793 Ry
estimated scf accuracy < 6.6E-10 Ry
The total energy is the sum of the following terms:
one-electron contribution = 4.78743606 Ry
hartree contribution = 1.07829534 Ry
xc contribution = -4.81679075 Ry
ewald contribution = -16.89975858 Ry
convergence has been achieved in 6 iterations
Forces acting on atoms (Ry/au):
atom 1 type 1 force = 0.00000000 0.00000000 0.00000000
atom 2 type 1 force = 0.00000000 0.00000000 0.00000000
Total force = 0.000000 Total SCF correction = 0.000000
entering subroutine stress ...
total stress (Ry/bohr**3) (kbar) P= -0.54
-0.00000365 0.00000000 0.00000000 -0.54 0.00 0.00
0.00000000 -0.00000365 0.00000000 0.00 -0.54 0.00
0.00000000 0.00000000 -0.00000365 0.00 0.00 -0.54
Writing output data file si.save
PWSCF : 0.83s CPU time, 0.91s wall time
init_run : 0.09s CPU
electrons : 0.64s CPU
forces : 0.01s CPU
stress : 0.03s CPU
Called by init_run:
wfcinit : 0.05s CPU
potinit : 0.00s CPU
Called by electrons:
c_bands : 0.51s CPU ( 7 calls, 0.073 s avg)
sum_band : 0.10s CPU ( 7 calls, 0.014 s avg)
v_of_rho : 0.01s CPU ( 7 calls, 0.002 s avg)
mix_rho : 0.01s CPU ( 7 calls, 0.001 s avg)
Called by c_bands:
init_us_2 : 0.02s CPU ( 170 calls, 0.000 s avg)
cegterg : 0.49s CPU ( 70 calls, 0.007 s avg)
Called by *egterg:
h_psi : 0.48s CPU ( 212 calls, 0.002 s avg)
g_psi : 0.01s CPU ( 132 calls, 0.000 s avg)
cdiaghg : 0.02s CPU ( 192 calls, 0.000 s avg)
Called by h_psi:
add_vuspsi : 0.01s CPU ( 212 calls, 0.000 s avg)
General routines
calbec : 0.01s CPU ( 232 calls, 0.000 s avg)
cft3 : 0.00s CPU ( 27 calls, 0.000 s avg)
cft3s : 0.47s CPU ( 1952 calls, 0.000 s avg)
davcio : 0.00s CPU ( 240 calls, 0.000 s avg)

203
PHonon/examples/example13/run_example
View File

@ -1,203 +0,0 @@
#!/bin/sh
###############################################################################
##
## HIGH VERBOSITY EXAMPLE
##
###############################################################################
# run from directory where this script is
cd `echo $0 | sed 's/\(.*\)\/.*/\1/'` # extract pathname
EXAMPLE_DIR=`pwd`
# check whether echo has the -e option
if test "`echo -e`" = "-e" ; then ECHO=echo ; else ECHO="echo -e" ; fi
$ECHO
$ECHO "$EXAMPLE_DIR : starting"
$ECHO
$ECHO "This example shows how to use pw.x, ph.x and d3.x to calculate the"
$ECHO "third-order expansion coefficients of the total energy of Si."
# set the needed environment variables
. ../../../environment_variables
# required executables and pseudopotentials
BIN_LIST="pw.x ph.x d3.x"
PSEUDO_LIST="Si.pz-vbc.UPF"
$ECHO
$ECHO " executables directory: $BIN_DIR"
$ECHO " pseudo directory: $PSEUDO_DIR"
$ECHO " temporary directory: $TMP_DIR"
$ECHO " checking that needed directories and files exist...\c"
# check for directories
for DIR in "$BIN_DIR" "$PSEUDO_DIR" ; do
if test ! -d $DIR ; then
$ECHO
$ECHO "ERROR: $DIR not existent or not a directory"
$ECHO "Aborting"
exit 1
fi
done
for DIR in "$TMP_DIR" "$EXAMPLE_DIR/results" ; do
if test ! -d $DIR ; then
mkdir $DIR
fi
done
cd $EXAMPLE_DIR/results
# check for executables
for FILE in $BIN_LIST ; do
if test ! -x $BIN_DIR/$FILE ; then
$ECHO
$ECHO "ERROR: $BIN_DIR/$FILE not existent or not executable"
$ECHO "Aborting"
exit 1
fi
done
# check for pseudopotentials
for FILE in $PSEUDO_LIST ; do
if test ! -r $PSEUDO_DIR/$FILE ; then
$ECHO
$ECHO "Downloading $FILE to $PSEUDO_DIR...\c"
$WGET $PSEUDO_DIR/$FILE $NETWORK_PSEUDO/$FILE 2> /dev/null
fi
if test $? != 0; then
$ECHO
$ECHO "ERROR: $PSEUDO_DIR/$FILE not existent or not readable"
$ECHO "Aborting"
exit 1
fi
done
$ECHO " done"
# how to run executables
PW_COMMAND="$PARA_PREFIX $BIN_DIR/pw.x $PARA_POSTFIX"
PH_COMMAND="$PARA_PREFIX $BIN_DIR/ph.x $PARA_POSTFIX"
D3_COMMAND="$PARA_PREFIX $BIN_DIR/d3.x $PARA_POSTFIX"
$ECHO
$ECHO " running pw.x as: $PW_COMMAND"
$ECHO " running ph.x as: $PH_COMMAND"
$ECHO " running d3.x as: $D3_COMMAND"
$ECHO
# clean TMP_DIR
$ECHO " cleaning $TMP_DIR...\c"
rm -rf $TMP_DIR/silicon*
rm -rf $TMP_DIR/_ph0/silicon*
$ECHO " done"
# self-consistent calculation
cat > si.scf.in << EOF
&control
calculation = 'scf'
restart_mode='from_scratch',
prefix='silicon',
tstress = .true.
tprnfor = .true.
pseudo_dir = '$PSEUDO_DIR/',
outdir='$TMP_DIR/'
/
&system
ibrav= 2, celldm(1) =10.20, nat= 2, ntyp= 1,
ecutwfc =24.0,
/
&electrons
mixing_beta = 0.7
conv_thr = 1.0d-8
/
ATOMIC_SPECIES
Si 28.086 Si.pz-vbc.UPF
ATOMIC_POSITIONS
Si 0.00 0.00 0.00
Si 0.25 0.25 0.25
K_POINTS {automatic}
4 4 4 1 1 1
EOF
$ECHO " running the scf calculation for Si...\c"
$PW_COMMAND < si.scf.in > si.scf.out
check_failure $?
$ECHO " done"
# calculation of the dynamical matrix at Gamma
cat > si.phG.in << EOF
phonons of Si at Gamma
&inputph
tr2_ph=1.0d-12,
prefix='silicon',
epsil=.false.,
trans=.true.,
zue=.false.,
amass(1)=28.0855,
amass(2)=28.0855,
outdir='$TMP_DIR/',
fildyn='si.dyn_G',
fildrho='si.drho_G',
/
0.0 0.0 0.0
EOF
$ECHO " running the phonon calculation for Si at Gamma...\c"
$PH_COMMAND < si.phG.in > si.phG.out
check_failure $?
$ECHO " done"
# calculation of the anharmonic tensor at Gamma
cat > si.d3G.in << EOF
Anharm at Gamma
&inputph
prefix = 'silicon',
fildrho = 'si.drho_G',
fild0rho = 'si.drho_G',
amass(1) = 28.0855,
outdir = '$TMP_DIR/',
fildyn = 'si.anh_G',
/
0.0 0.0 0.0
EOF
$ECHO " running the calculation of D3(0,0,0)...\c"
$D3_COMMAND < si.d3G.in > si.d3G.out
check_failure $?
$ECHO " done"
# calculation of the dynamical matrix at the X-point
cat > si.phX.in << EOF
phonons of Si at the X-point
&inputph
tr2_ph=1.0d-12,
prefix='silicon',
trans=.true.,
amass(1)=28.0855,
outdir='$TMP_DIR/',
fildyn='si.dyn_X',
fildrho='si.drho_X',
/
0.0 0.0 1.0
EOF
$ECHO " running the phonon calculation for Si at X...\c"
$PH_COMMAND < si.phX.in > si.phX.out
check_failure $?
$ECHO " done"
# calculation of the anharmonic tensor at X
cat > si.d3X.in << EOF
Anharm at the X-point
&inputph
prefix = 'silicon',
fildrho = 'si.drho_X',
fild0rho = 'si.drho_G',
amass(1) = 28.0855,
outdir = '$TMP_DIR/',
fildyn = 'si.anh_X',
/
0.0 0.0 1.0
EOF
$ECHO " running the calculation of D3(0,X,-X)...\c"
$D3_COMMAND < si.d3X.in > si.d3X.out
check_failure $?
$ECHO " done"
$ECHO
$ECHO "$EXAMPLE_DIR: done"

286
PHonon/examples/example13/run_xml_example
View File

@ -1,286 +0,0 @@
#!/bin/sh
###############################################################################
##
## HIGH VERBOSITY EXAMPLE
##
###############################################################################
# run from directory where this script is
cd `echo $0 | sed 's/\(.*\)\/.*/\1/'` # extract pathname
EXAMPLE_DIR=`pwd`
# check whether echo has the -e option
if test "`echo -e`" = "-e" ; then ECHO=echo ; else ECHO="echo -e" ; fi
$ECHO
$ECHO "$EXAMPLE_DIR : starting"
$ECHO
$ECHO "This example shows how to use pw.x, ph.x and d3.x to calculate the"
$ECHO "third-order expansion coefficients of the total energy of Si."
# set the needed environment variables
. ../../../environment_variables
# required executables and pseudopotentials
BIN_LIST="pw.x ph.x d3.x"
PSEUDO_LIST="Si.pz-vbc.UPF"
$ECHO
$ECHO " executables directory: $BIN_DIR"
$ECHO " pseudo directory: $PSEUDO_DIR"
$ECHO " temporary directory: $TMP_DIR"
$ECHO " checking that needed directories and files exist...\c"
# check for directories
for DIR in "$BIN_DIR" "$PSEUDO_DIR" ; do
if test ! -d $DIR ; then
$ECHO
$ECHO "ERROR: $DIR not existent or not a directory"
$ECHO "Aborting"
exit 1
fi
done
for DIR in "$TMP_DIR" "$EXAMPLE_DIR/results" ; do
if test ! -d $DIR ; then
mkdir $DIR
fi
done
cd $EXAMPLE_DIR/results
# check for executables
for FILE in $BIN_LIST ; do
if test ! -x $BIN_DIR/$FILE ; then
$ECHO
$ECHO "ERROR: $BIN_DIR/$FILE not existent or not executable"
$ECHO "Aborting"
exit 1
fi
done
# check for pseudopotentials
for FILE in $PSEUDO_LIST ; do
if test ! -r $PSEUDO_DIR/$FILE ; then
$ECHO
$ECHO "Downloading $FILE to $PSEUDO_DIR...\c"
$WGET $PSEUDO_DIR/$FILE \
http://www.quantum-espresso.org/pseudo/1.3/UPF/$FILE 2> /dev/null
fi
if test $? != 0; then
$ECHO
$ECHO "ERROR: $PSEUDO_DIR/$FILE not existent or not readable"
$ECHO "Aborting"
exit 1
fi
done
$ECHO " done"
# how to run executables
PW_COMMAND="$PARA_PREFIX $BIN_DIR/pw.x $PARA_POSTFIX"
PH_COMMAND="$PARA_PREFIX $BIN_DIR/ph.x $PARA_POSTFIX"
D3_COMMAND="$PARA_PREFIX $BIN_DIR/d3.x $PARA_POSTFIX"
$ECHO
$ECHO " running pw.x as: $PW_COMMAND"
$ECHO " running ph.x as: $PH_COMMAND"
$ECHO " running d3.x as: $D3_COMMAND"
$ECHO
# clean TMP_DIR
$ECHO " cleaning $TMP_DIR...\c"
rm -rf $TMP_DIR/*
$ECHO " done"
# self-consistent calculation
cat > si.scf.xml << EOF
<?xml version="1.0" encoding="UTF-8"?>
<input calculation="scf" prefix="si">
<cell type="qecell">
<qecell ibrav="2" alat="10.20">
<real rank="1" n1="5">
0.0 0.0 0.0 0.0 0.0
</real>
</qecell>
</cell>
<atomic_species ntyp="1">
<specie name="Si">
<property name="mass">
<real>28.086</real>
</property>
<property name="pseudofile">
<string>Si.pz-vbc.UPF</string>
</property>
</specie>
</atomic_species>
<atomic_list units="alat" nat="2" >
<atom name="Si">
<position>
<real rank="1" n1="3">
0.00 0.00 0.00
</real>
</position>
</atom>
<atom name="Si">
<position>
<real rank="1" n1="3">
0.25 0.25 0.25
</real>
</position>
</atom>
</atomic_list>
<field name="InputOutput">
<parameter name="restart_mode">
<string>
from_scratch
</string>
</parameter>
<parameter name="pseudo_dir">
<string>
$PSEUDO_DIR/
</string>
</parameter>
<parameter name="outdir">
<string>
$TMP_DIR
</string>
</parameter>
<parameter name="tstress">
<logical>
true
</logical>
</parameter>
<parameter name="tprnfor">
<logical>
true
</logical>
</parameter>
</field>
<field name="Numerics">
<parameter name="ecutwfc">
<real>
24.0
</real>
</parameter>
<parameter name="mixing_beta">
<real>
0.7
</real>
</parameter>
<parameter name="conv_thr">
<real>
1.0d-8
</real>
</parameter>
</field>
<k_points type="automatic">
<mesh>
<integer rank="1" n1="6">
4 4 4 1 1 1
</integer>
</mesh>
</k_points>
</input>
EOF
$ECHO " running the scf calculation for Si...\c"
$PW_COMMAND < si.scf.xml > si.scf.out
check_failure $?
$ECHO " done"
# calculation of the dynamical matrix at Gamma
cat > si.phG.in << EOF
phonons of Si at Gamma
&inputph
tr2_ph=1.0d-12,
prefix='si',
epsil=.false.,
trans=.true.,
zue=.false.,
amass(1)=28.0855,
amass(2)=28.0855,
outdir='$TMP_DIR/',
fildyn='si.dyn_G',
fildrho='si.drho_G',
/
0.0 0.0 0.0
EOF
$ECHO " running the phonon calculation for Si at Gamma...\c"
$PH_COMMAND < si.phG.in > si.phG.out
check_failure $?
$ECHO " done"
# calculation of the anharmonic tensor at Gamma
cat > si.d3G.in << EOF
Anharm at Gamma
&inputph
prefix = 'si',
fildrho = 'si.drho_G',
fild0rho = 'si.drho_G',
amass(1) = 28.0855,
outdir = '$TMP_DIR/',
fildyn = 'si.anh_G',
/
0.0 0.0 0.0
EOF
$ECHO " running the calculation of D3(0,0,0)...\c"
$D3_COMMAND < si.d3G.in > si.d3G.out
check_failure $?
$ECHO " done"
# calculation of the dynamical matrix at the X-point
cat > si.phX.in << EOF
phonons of Si at the X-point
&inputph
tr2_ph=1.0d-12,
prefix='si',
trans=.true.,
amass(1)=28.0855,
amass(2)=28.0855,
outdir='$TMP_DIR/',
fildyn='si.dyn_X',
fildrho='si.drho_X',
/
0.0 0.0 1.0
EOF
$ECHO " running the phonon calculation for Si at X...\c"
$PH_COMMAND < si.phX.in > si.phX.out
check_failure $?
$ECHO " done"
# calculation of the anharmonic tensor at X
cat > si.d3X.in << EOF
Anharm at the X-point
&inputph
prefix = 'si',
fildrho = 'si.drho_X',
fild0rho = 'si.drho_G',
amass(1) = 28.0855,
outdir = '$TMP_DIR/',
fildyn = 'si.anh_X',
/
0.0 0.0 1.0
EOF
$ECHO " running the calculation of D3(0,X,-X)...\c"
$D3_COMMAND < si.d3X.in > si.d3X.out
check_failure $?
$ECHO " done"
$ECHO
$ECHO "$EXAMPLE_DIR: done"