mirror of https://gitlab.com/QEF/q-e.git
many calls to "setv" replaced by f90 assignements
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@314 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz
parent
e212a3e854
commit
ce8515b1be
99
CPV/cpr.f90
99
CPV/cpr.f90
|
|
@ -304,7 +304,7 @@
|
|||
allocate(rhor(nnr,nspin))
|
||||
allocate(rhos(nnrsx,nspin))
|
||||
allocate(rhog(ng,nspin))
|
||||
if (nlcc.gt.0) allocate(rhoc(nnr))
|
||||
if (nlcc > 0) allocate(rhoc(nnr))
|
||||
allocate(wrk1(nnr))
|
||||
allocate(qv(nnrb))
|
||||
allocate(c2(ngw))
|
||||
|
|
@ -332,7 +332,7 @@
|
|||
#ifdef __PARA
|
||||
allocate(aux(nnr))
|
||||
#endif
|
||||
call zero(nat*nhx*nhx*nspin,deeq)
|
||||
deeq(:,:,:,:) = 0.d0
|
||||
!
|
||||
666 continue
|
||||
!
|
||||
|
|
@ -357,12 +357,9 @@
|
|||
!
|
||||
hnew=h
|
||||
!
|
||||
do i=1,n
|
||||
call zero(n,lambda(1,i))
|
||||
!
|
||||
call zero(2*ngw,cm(1,i))
|
||||
call zero(2*ngw,c0(1,i))
|
||||
end do
|
||||
lambda(:,:)=0.d0
|
||||
cm(:,:) = (0.d0, 0.d0)
|
||||
c0(:,:) = (0.d0, 0.d0)
|
||||
!
|
||||
! mass preconditioning: ema0bg(i) = ratio of emass(g=0) to emass(g)
|
||||
! for g**2>emaec the electron mass ema0bg(g) rises quadratically
|
||||
|
|
@ -372,7 +369,7 @@
|
|||
if(iprsta.ge.10)print *,i,' ema0bg(i) ',ema0bg(i)
|
||||
end do
|
||||
!
|
||||
if (nbeg.lt.0) then
|
||||
if (nbeg < 0) then
|
||||
!======================================================================
|
||||
! nbeg = -1 or nbeg = -2 or nbeg = -3
|
||||
!======================================================================
|
||||
|
|
@ -571,22 +568,18 @@
|
|||
xnhp0=0.
|
||||
xnhpm=0.
|
||||
vnhp =0.
|
||||
fionm(:,:,:)=0.
|
||||
do is=1,nsp
|
||||
do ia=1,na(is)
|
||||
do i=1,3
|
||||
fionm(i,ia,is)=0.
|
||||
vels(i,ia,is)=(taus(i,ia,is)-tausm(i,ia,is))/delt
|
||||
vels (i,ia,is)=(taus(i,ia,is)-tausm(i,ia,is))/delt
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
do j=1,3
|
||||
do i=1,3
|
||||
xnhh0(i,j)=0.
|
||||
xnhhm(i,j)=0.
|
||||
vnhh(i,j) =0.
|
||||
velh(i,j)=(h(i,j)-hold(i,j))/delt
|
||||
end do
|
||||
end do
|
||||
xnhh0(:,:)=0.
|
||||
xnhhm(:,:)=0.
|
||||
vnhh (:,:) =0.
|
||||
velh (:,:)=(h(:,:)-hold(:,:))/delt
|
||||
!
|
||||
! ======================================================
|
||||
! kinetic energy of the electrons
|
||||
|
|
@ -610,11 +603,7 @@
|
|||
xnhem=0.
|
||||
vnhe =0.
|
||||
!
|
||||
do j=1,n
|
||||
do i=1,n
|
||||
lambdam(i,j)=lambda(i,j)
|
||||
end do
|
||||
end do
|
||||
lambdam(:,:)=lambda(:,:)
|
||||
!
|
||||
else
|
||||
!======================================================================
|
||||
|
|
@ -639,11 +628,7 @@
|
|||
if(trane.and.trhor) then
|
||||
call prefor(eigr,betae)
|
||||
call graham(betae,bec,c0)
|
||||
do i=1,n
|
||||
do j=1,ngw
|
||||
cm(j,i)=c0(j,i)
|
||||
end do
|
||||
end do
|
||||
cm(:, 1:n)=c0(:, 1:n)
|
||||
endif
|
||||
!
|
||||
if(iprsta.gt.2) then
|
||||
|
|
@ -673,21 +658,11 @@
|
|||
end if
|
||||
!
|
||||
if(.not.tfor) then
|
||||
do is=1,nsp
|
||||
do ia=1,na(is)
|
||||
do i=1,3
|
||||
fion(i,ia,is)=0.d0
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
fion (:,:,:) = 0.d0
|
||||
end if
|
||||
!
|
||||
if(.not.tpre) then
|
||||
do j=1,3
|
||||
do i=1,3
|
||||
stress(i,j)=0.
|
||||
end do
|
||||
end do
|
||||
stress (:,:) = 0.d0
|
||||
endif
|
||||
!
|
||||
fccc=1.
|
||||
|
|
@ -717,12 +692,8 @@
|
|||
fccc=1./(1.+0.5*delt*vnhe)
|
||||
endif
|
||||
if(tnoseh) then
|
||||
do i=1,3
|
||||
do j=1,3
|
||||
vnhh(i,j)=2.*(xnhh0(i,j)-xnhhm(i,j))/delt-vnhh(i,j)
|
||||
velh(i,j)=2.*(h(i,j)-hold(i,j))/delt-velh(i,j)
|
||||
end do
|
||||
end do
|
||||
vnhh(:,:)=2.*(xnhh0(:,:)-xnhhm(:,:))/delt-vnhh(:,:)
|
||||
velh(:,:)=2.*(h(:,:)-hold(:,:))/delt-velh(:,:)
|
||||
endif
|
||||
!
|
||||
if (tfor.or.thdyn.or.tfirst) then
|
||||
|
|
@ -831,17 +802,13 @@
|
|||
!
|
||||
if (tfor) call nlfq(c0,deeq,eigr,bec,becdr,fion)
|
||||
!
|
||||
if(tfor.or.thdyn)then
|
||||
do j=1,n
|
||||
do i=1,n
|
||||
if(tfor.or.thdyn) then
|
||||
!
|
||||
! interpolate new lambda at (t+dt) from lambda(t) and lambda(t-dt):
|
||||
!
|
||||
lambdap(i,j)=2.*lambda(i,j)-lambdam(i,j)
|
||||
lambdam(i,j)=lambda(i,j)
|
||||
lambda (i,j)=lambdap(i,j)
|
||||
end do
|
||||
end do
|
||||
lambdap(:,:) = 2.d0*lambda(:,:)-lambdam(:,:)
|
||||
lambdam(:,:)=lambda (:,:)
|
||||
lambda (:,:)=lambdap(:,:)
|
||||
endif
|
||||
!
|
||||
! calphi calculates phi
|
||||
|
|
@ -903,11 +870,7 @@
|
|||
! guessed displacement of ions
|
||||
!=======================================================================
|
||||
!
|
||||
do j=1,3
|
||||
do i=1,3
|
||||
hgamma(i,j)=0.
|
||||
enddo
|
||||
enddo
|
||||
hgamma(:,:) = 0.d0
|
||||
if(thdyn) then
|
||||
verl1=2./(1.+frich)
|
||||
verl2=1.-verl1
|
||||
|
|
@ -935,11 +898,9 @@
|
|||
enddo
|
||||
enddo
|
||||
endif
|
||||
do j=1,3
|
||||
do i=1,3
|
||||
velh(i,j) = (hnew(i,j)-hold(i,j))/twodel
|
||||
enddo
|
||||
enddo
|
||||
!
|
||||
velh(:,:) = (hnew(:,:)-hold(:,:))/twodel
|
||||
!
|
||||
do i=1,3
|
||||
do j=1,3
|
||||
do k=1,3
|
||||
|
|
@ -1337,12 +1298,8 @@
|
|||
xnhe0 = xnhep
|
||||
endif
|
||||
if(tnoseh) then
|
||||
do j=1,3
|
||||
do i=1,3
|
||||
xnhhm(i,j) = xnhh0(i,j)
|
||||
xnhh0(i,j) = xnhhp(i,j)
|
||||
enddo
|
||||
enddo
|
||||
xnhhm(:,:) = xnhh0(:,:)
|
||||
xnhh0(:,:) = xnhhp(:,:)
|
||||
endif
|
||||
end if
|
||||
!
|
||||
|
|
|
|||
|
|
@ -958,8 +958,8 @@
|
|||
allocate(dqgbs(ngb,3,3))
|
||||
allocate(qgbs(ngb))
|
||||
!
|
||||
call zero(ngb*nbrx*nbrx*lx*nsp,qradb)
|
||||
call zero(9*ngb*nbrx*nbrx*lx*nsp,dqrad)
|
||||
qradb(:,:,:,:,:) = 0.d0
|
||||
dqrad(:,:,:,:,:,:,:) = 0.d0
|
||||
!
|
||||
! ===============================================================
|
||||
! initialization for vanderbilt species
|
||||
|
|
@ -1147,14 +1147,14 @@
|
|||
real(kind=8) fpre(3,3), tmpbec(nhx,nx), tmpdh(nx,nhx), temp(nx,nx),&
|
||||
& SSUM, tt
|
||||
!
|
||||
call zero(9,fpre)
|
||||
fpre(:,:) = 0.d0
|
||||
do ii=1,3
|
||||
do jj=1,3
|
||||
do is=1,nvb
|
||||
do ia=1,na(is)
|
||||
!
|
||||
call zero(nhx*n,tmpbec)
|
||||
call zero(nhx*n,tmpdh)
|
||||
tmpbec(:, 1:n) = 0.d0
|
||||
tmpdh (1:n, :) = 0.d0
|
||||
!
|
||||
do iv=1,nh(is)
|
||||
do jv=1,nh(is)
|
||||
|
|
@ -1176,7 +1176,7 @@
|
|||
end do
|
||||
!
|
||||
if(nh(is).gt.0)then
|
||||
call zero(nx*n,temp)
|
||||
temp(:, 1:n) = 0.d0
|
||||
!
|
||||
call MXMA &
|
||||
& (tmpdh,1,nx,tmpbec,1,nhx,temp,1,nx,n,nh(is),n)
|
||||
|
|
@ -1296,10 +1296,10 @@
|
|||
allocate(qradx(mmx,nbrx,nbrx,lx,nsp))
|
||||
allocate(dqradx(mmx,nbrx,nbrx,lx,nsp))
|
||||
!
|
||||
call zero(ngb*nbrx*nbrx*lx*nsp,qradb)
|
||||
call zero(nhx*nhx*nsp,qq)
|
||||
call zero(nhx*nhx*nsp,dvan)
|
||||
if(tpre) call zero(9*ngb*nbrx*nbrx*lx*nsp,dqrad)
|
||||
qradb(:,:,:,:,:) = 0.d0
|
||||
qq (:,:,:) =0.d0
|
||||
dvan(:,:,:) =0.d0
|
||||
if(tpre) dqrad(:,:,:,:,:,:,:) = 0.d0
|
||||
!
|
||||
! ------------------------------------------------------------------
|
||||
! definition of indices nhtol, indv, indlm
|
||||
|
|
@ -1584,11 +1584,11 @@
|
|||
if(ivl.gt.nlx) call errore(' qvan ',' ivl.gt.nlx ',ivl)
|
||||
if(jvl.gt.nlx) call errore(' qvan ',' jvl.gt.nlx ',jvl)
|
||||
!
|
||||
call zero(2*ngb,qg)
|
||||
qg(:) = (0.d0, 0.d0)
|
||||
allocate(ylm(ngb))
|
||||
if(tpre) then
|
||||
allocate(dylm(ngb,3,3))
|
||||
call zero(2*9*ngb,dqg)
|
||||
dqg(:,:,:) = (0.d0, 0.d0)
|
||||
end if
|
||||
!
|
||||
! lpx = max number of allowed y_lm
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@ CONTAINS
|
|||
if ( sign /= 2 ) then
|
||||
call cft_1z( f, dfft%nsp(me), nr3, nr3x, sign, aux)
|
||||
call fft_scatter( aux, nr3x, dfft%nnr, f, dfft%nsp, dfft%npp, sign)
|
||||
call zero(2*dfft%nnr,f)
|
||||
f(:) = (0.d0, 0.d0)
|
||||
do i = 1, dfft%nst
|
||||
mc = dfft%ismap( i )
|
||||
do j = 1, dfft%npp(me)
|
||||
|
|
@ -94,7 +94,7 @@ CONTAINS
|
|||
else
|
||||
call cft_1z( f, dfft%nsw(me), nr3, nr3x, sign, aux)
|
||||
call fft_scatter( aux, nr3x, dfft%nnr, f, dfft%nsw, dfft%npp, sign)
|
||||
call zero( 2*dfft%nnr, f )
|
||||
f(:) = (0.d0, 0.d0)
|
||||
ii = 0
|
||||
do proc=1,nproc
|
||||
do i=1,dfft%nsw(proc)
|
||||
|
|
|
|||
|
|
@ -139,6 +139,7 @@ PHOBJS = ../PH/phcom.o \
|
|||
../PH/setlocq.o \
|
||||
../PH/setqmod.o \
|
||||
../PH/setup_dgc.o \
|
||||
../PH/setv.o \
|
||||
../PH/smallgq.o \
|
||||
../PH/solve_e.o \
|
||||
../PH/solve_linter.o \
|
||||
|
|
@ -338,7 +339,6 @@ PWOBJS = ../PW/pwcom.o \
|
|||
../PW/set_rhoc.o \
|
||||
../PW/setup.o \
|
||||
../PW/setupkpt.o \
|
||||
../PW/setv.o \
|
||||
../PW/set_vrs.o \
|
||||
../PW/sgama.o \
|
||||
../PW/sgam_at.o \
|
||||
|
|
|
|||
|
|
@ -112,7 +112,6 @@ PWOBJS=../PW/pwcom.o \
|
|||
../PW/restart_in_electrons.o \
|
||||
../PW/restart_in_ions.o \
|
||||
../PW/rho2zeta.o \
|
||||
../PW/setv.o \
|
||||
../PW/ruotaijk.o \
|
||||
../PW/s_axis_to_ca.o \
|
||||
../PW/save_in_cbands.o \
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ subroutine A_h(e,h,ah)
|
|||
dpsic => aux2
|
||||
drhoc => aux3
|
||||
!
|
||||
call setv(nrxx,0.d0,drho,1)
|
||||
drho(:) = 0.d0
|
||||
!
|
||||
! [(k+G)^2 - e ]psi
|
||||
do ibnd = 1,nbnd
|
||||
|
|
@ -45,8 +45,8 @@ subroutine A_h(e,h,ah)
|
|||
end do
|
||||
! V_Loc psi
|
||||
do ibnd = 1,nbnd, 2
|
||||
call setv(2*nrxx,0.d0,dpsic,1)
|
||||
call setv(2*nrxx,0.d0, psic,1)
|
||||
dpsic(:)= (0.d0, 0.d0)
|
||||
psic(:) = (0.d0, 0.d0)
|
||||
if (ibnd.lt.nbnd) then
|
||||
! two ffts at the same time
|
||||
do j = 1,npw
|
||||
|
|
|
|||
|
|
@ -33,11 +33,11 @@ subroutine cg_setupdgc
|
|||
if (igcx.eq.0 .and. igcc.eq.0) return
|
||||
call start_clock('setup_dgc')
|
||||
!
|
||||
call setv(nrxx*nspin*nspin,0.d0,dvxc_rr,1)
|
||||
call setv(nrxx*nspin*nspin,0.d0,dvxc_sr,1)
|
||||
call setv(nrxx*nspin*nspin,0.d0,dvxc_ss,1)
|
||||
call setv(nrxx*nspin*nspin,0.d0,dvxc_s ,1)
|
||||
call setv(3*nrxx*nspin,0.d0,grho ,1)
|
||||
dvxc_rr(:,:,:) = 0.d0
|
||||
dvxc_sr(:,:,:) = 0.d0
|
||||
dvxc_ss(:,:,:) = 0.d0
|
||||
dvxc_s (:,:,:) = 0.d0
|
||||
grho (:,:,:) = 0.d0
|
||||
!
|
||||
! add rho_core
|
||||
!
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ subroutine cgsolve (operator,npw,evc,npwx,nbnd,overlap, &
|
|||
if (.not.startwith0) then
|
||||
call operator(e,x,u)
|
||||
else
|
||||
call setv(2*npwx*nbnd,0.d0,u,1)
|
||||
u (:,:) = (0.d0, 0.d0)
|
||||
! note that we assume x=0 on input
|
||||
end if
|
||||
!
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ subroutine d2ion (nat,ntyp,ityp,zv,tau,alat,omega, &
|
|||
! appropriate for c60
|
||||
write(6,'(" d2ion: alpha = ",f6.2)') alpha
|
||||
!
|
||||
call setv(3*nat*nmodes,0.d0,dyn,1)
|
||||
dyn (:,:) = 0.d0
|
||||
!
|
||||
! G-space sum here
|
||||
!
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ subroutine dgradcor1 (rho, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, &
|
|||
allocate (h( 3, nrxx , nspin))
|
||||
allocate (dh( nrxx))
|
||||
|
||||
call setv (6 * nrxx * nspin, 0.d0, h, 1)
|
||||
h (:,:,:) = (0.d0, 0.d0)
|
||||
do is = 1, nspin
|
||||
call gradient1 (nrx1, nrx2, nrx3, nr1, nr2, nr3, nrxx, &
|
||||
drhoc(1, is), ngm, g, nl, nlm, alat, gdrho (1, 1, is) )
|
||||
|
|
@ -74,7 +74,7 @@ subroutine dgradcor1 (rho, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, &
|
|||
!
|
||||
! LSDA case
|
||||
!
|
||||
call setv (8, 0.d0, ps, 1)
|
||||
ps (:,:) = (0.d0, 0.d0)
|
||||
do is = 1, nspin
|
||||
do js = 1, nspin
|
||||
do ipol = 1, 3
|
||||
|
|
|
|||
|
|
@ -31,8 +31,8 @@ subroutine dielec(do_zstar)
|
|||
allocate (dpsi3( npwx, nbnd))
|
||||
allocate (work( nbnd, 3))
|
||||
!
|
||||
call setv(9,0.d0,epsilon0,1)
|
||||
if (do_zstar) call setv(9*nat,0.d0,zstar,1)
|
||||
epsilon0(:,:) = 0.d0
|
||||
if (do_zstar) zstar (:,:,:) = 0.d0
|
||||
! do kpoint=1,nks
|
||||
kpoint=1
|
||||
weight = wk(kpoint)
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ subroutine drhodv(nu_i)
|
|||
!
|
||||
call start_clock('drhodv')
|
||||
!
|
||||
call setv(nmodes,0.d0,dynel,1)
|
||||
dynel(:) = 0.d0
|
||||
kpoint = 1
|
||||
! do kpoint=1,nks
|
||||
!
|
||||
|
|
|
|||
|
|
@ -6,18 +6,18 @@
|
|||
! or http://www.gnu.org/copyleft/gpl.txt .
|
||||
!
|
||||
!---------------------------------------------------------------------
|
||||
subroutine dvb_cc (nlcc,npseu,ngm,nr1,nr2,nr3,nrx1, &
|
||||
subroutine dvb_cc (nlcc,npseu,ngm,nr1,nr2,nr3,nrx1,nrx2,nrx3, &
|
||||
nl,rho_core,dmuxc,ga,aux,dvb_nlcc)
|
||||
!---------------------------------------------------------------------
|
||||
! calcola il contributo core-correction al Delta V bare
|
||||
!
|
||||
#include "machine.h"
|
||||
implicit none
|
||||
integer:: npseu,ngm,nr1,nr2,nr3,nrx1,nrxx,np,ng,i
|
||||
integer:: npseu,ngm,nr1,nr2,nr3,nrx1,nrx2,nrx3,np,ng,i
|
||||
logical :: nlcc(npseu)
|
||||
integer :: nl(ngm)
|
||||
real(kind=8) :: rho_core(ngm), dmuxc(nrx1*nr2*nr3)
|
||||
complex(kind=8) :: ga(ngm), dvb_nlcc(ngm), aux(nrx1*nr2*nr3)
|
||||
real(kind=8) :: rho_core(ngm), dmuxc(nrx1*nrx2*nrx3)
|
||||
complex(kind=8) :: ga(ngm), dvb_nlcc(ngm), aux(nrx1*nrx2*nrx3)
|
||||
!
|
||||
do np=1,npseu
|
||||
if(nlcc(np)) go to 10
|
||||
|
|
@ -25,16 +25,14 @@ subroutine dvb_cc (nlcc,npseu,ngm,nr1,nr2,nr3,nrx1, &
|
|||
return
|
||||
10 continue
|
||||
!
|
||||
nrxx=nrx1*nr2*nr3
|
||||
call setv(2*nrxx,0.d0,aux,1)
|
||||
aux(:) = (0.d0, 0.d0)
|
||||
do ng=1,ngm
|
||||
aux(nl(ng)) = ga(ng) * rho_core(ng)
|
||||
end do
|
||||
call cft3(aux,nr1,nr2,nr3,nrx1,nr2,nr3,1)
|
||||
!
|
||||
do i=1,nrxx
|
||||
aux(i) = aux(i) * dmuxc(i)
|
||||
end do
|
||||
aux(:) = aux(:) * dmuxc(:)
|
||||
!
|
||||
call cft3(aux,nr1,nr2,nr3,nrx1,nr2,nr3,-1)
|
||||
do ng=1,ngm
|
||||
dvb_nlcc(ng) = aux(nl(ng))
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@ subroutine dvpsi_e(kpoint,ipol)
|
|||
end if
|
||||
!
|
||||
startwith0= .true.
|
||||
call setv(2*npwx*nbnd,0.d0,dvpsi,1)
|
||||
dvpsi(:,:) = (0.d0, 0.d0)
|
||||
!
|
||||
call cgsolve (H_h,npw,evc,npwx,nbnd,overlap,nbnd, &
|
||||
orthonormal,precondition,q,startwith0,et(1,kpoint),&
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@ subroutine dvpsi_kb(kpoint,nu)
|
|||
dv => auxr
|
||||
dvloc => aux2
|
||||
dvb_cc => aux3
|
||||
call setv(2*nrxx,0.d0,dvloc,1)
|
||||
call setv(2*nrxx,0.d0,dvb_cc,1)
|
||||
dvloc(:) = (0.d0, 0.d0)
|
||||
dvb_cc(:)= (0.d0, 0.d0)
|
||||
do na = 1,nat
|
||||
mu = 3*(na-1)
|
||||
if ( u(mu+1,nu)**2+u(mu+2,nu)**2+u(mu+3,nu)**2.gt. 1.0e-12) then
|
||||
|
|
@ -77,7 +77,7 @@ subroutine dvpsi_kb(kpoint,nu)
|
|||
!
|
||||
! vloc_psi calculates dVloc/dtau*psi(G)
|
||||
!
|
||||
call setv(2*npwx*nbnd,0.d0,dvpsi,1)
|
||||
dvpsi(:,:) = (0.d0, 0.d0)
|
||||
call vloc_psi(npwx, npw, nbnd, evc, dv, dvpsi)
|
||||
!
|
||||
! nonlocal (Kleinman-Bylander) contribution.
|
||||
|
|
|
|||
|
|
@ -87,7 +87,7 @@ subroutine dyndiar (dyn,nat3,nmodes,u,nat,ityp,amass,w2,dynout)
|
|||
write (6,'(5x,"diagonalizing the dynamical matrix ..."//)')
|
||||
write (6,'(1x,74("*"))')
|
||||
!
|
||||
call setv(nat3*nmodes,0.0,dynout,1)
|
||||
dynout (:,:) = 0.0
|
||||
do nu_i = 1,nmodes
|
||||
w1 = sqrt(abs(w2(nu_i)))
|
||||
if (w2(nu_i).lt.0.0) w1 = -w1
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ subroutine dynmatcc(dyncc)
|
|||
real(kind=DP) :: exg
|
||||
!
|
||||
!
|
||||
call setv(3*nat*nmodes,0.d0,dyncc,1)
|
||||
dyncc(:,:) = 0.d0
|
||||
!
|
||||
do nt=1,ntyp
|
||||
if(nlcc(nt)) go to 10
|
||||
|
|
@ -42,7 +42,7 @@ subroutine dynmatcc(dyncc)
|
|||
!
|
||||
call cft3(vxc,nr1,nr2,nr3,nrx1,nr2,nr3,-1)
|
||||
!
|
||||
call setv(3*nat*3*nat,0.d0,dyncc1,1)
|
||||
dyncc1(:,:,:,:) = 0.d0
|
||||
do na=1,nat
|
||||
nta=ityp(na)
|
||||
if (nlcc(nta)) then
|
||||
|
|
@ -68,7 +68,7 @@ subroutine dynmatcc(dyncc)
|
|||
end do
|
||||
end do
|
||||
do i=1,3
|
||||
call dvb_cc (nlcc,nt,ngm,nr1,nr2,nr3,nrx1, &
|
||||
call dvb_cc (nlcc,nt,ngm,nr1,nr2,nr3,nrx1,nrx2,nrx3, &
|
||||
nl,drhocc,dmuxc,gc(1,i),aux3,gc(1,i))
|
||||
end do
|
||||
do nb=1,nat
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ subroutine generate_effective_charges &
|
|||
call trntns(zstar(1,1,na),at,bg,-1)
|
||||
done(na)=.true.
|
||||
else
|
||||
call setv(9,0.d0,zstar(1,1,na),1)
|
||||
zstar(:,:,na) = 0.d0
|
||||
done(na)=.false.
|
||||
end if
|
||||
end do
|
||||
|
|
|
|||
|
|
@ -160,8 +160,8 @@ subroutine gradient (nrx1, nrx2, nrx3, nr1, nr2, nr3, nrxx, a, &
|
|||
!
|
||||
! copy a(r) to complex array...
|
||||
!
|
||||
call setv (nrxx, 0.d0, aux (2, 1), 2)
|
||||
call DCOPY (nrxx, a, 1, aux (1,1) , 2)
|
||||
aux(1,:) = a(:)
|
||||
aux(2,:) = 0.d0
|
||||
!
|
||||
! bring a(r) to G-space, a(G) ...
|
||||
!
|
||||
|
|
@ -216,13 +216,13 @@ subroutine grad_dot (nrx1, nrx2, nrx3, nr1, nr2, nr3, nrxx, a, &
|
|||
allocate (aux( 2,nrxx))
|
||||
allocate (gaux(2,nrxx))
|
||||
|
||||
call setv (2 * nrxx, 0.d0, gaux, 1)
|
||||
gaux(:,:) = 0.d0
|
||||
do ipol = 1, 3
|
||||
!
|
||||
! copy a(ipol,r) to a complex array...
|
||||
!
|
||||
call setv (nrxx, 0.d0, aux (2, 1), 2)
|
||||
call DCOPY (nrxx, a (ipol, 1), 3, aux, 2)
|
||||
aux(1,:) = a(ipol,:)
|
||||
aux(2,:) = 0.d0
|
||||
!
|
||||
! bring a(ipol,r) to G-space, a(G) ...
|
||||
!
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ subroutine macro
|
|||
call seqopn (iubar,filbar,'unformatted',here)
|
||||
!!! if (.not.here) then
|
||||
! calculate x * psi (if not already done)
|
||||
call setv(2*nbnd*npwx,0.d0,dvpsi,1)
|
||||
dvpsi(:,:) = (0.d0, 0.d0)
|
||||
!!! else
|
||||
! otherwise restart from x * psi that is present on from file
|
||||
!!! read(iubar) dvpsi
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ subroutine rhod2vkb(dyn0)
|
|||
! contribution from local potential
|
||||
!
|
||||
allocate ( dynloc( 3*nat, nmodes))
|
||||
call setv(3*nat*nmodes,0.d0,dynloc,1)
|
||||
dynloc (:,:) = 0.d0
|
||||
do ir = 1,nrxx
|
||||
psic(ir) = rho(ir,current_spin)
|
||||
end do
|
||||
|
|
@ -166,14 +166,15 @@ subroutine rhod2vkb(dyn0)
|
|||
deallocate ( becp1)
|
||||
deallocate ( dvkb)
|
||||
!
|
||||
call setv(3*nat*nmodes,0.d0,dyn0,1)
|
||||
dyn0 (:,:) = 0.d0
|
||||
!
|
||||
do nu_i = 1,nmodes
|
||||
if (has_equivalent( (nu_i-1)/3+1).eq.0 ) then
|
||||
do nu_j=1,nmodes
|
||||
do mu_i=1,3*nat
|
||||
do mu_j=1,3*nat
|
||||
dyn0(nu_i,nu_j) = dyn0(nu_i,nu_j) + dynkb(mu_i,mu_j)*u(mu_i,nu_i)*u(mu_j,nu_j)
|
||||
dyn0(nu_i,nu_j) = dyn0(nu_i,nu_j) + &
|
||||
dynkb(mu_i,mu_j)*u(mu_i,nu_i)*u(mu_j,nu_j)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ subroutine solve_e
|
|||
call seqopn (iudwf,fildwf,'unformatted',here)
|
||||
!!! if (.not.here) then
|
||||
! calculate Delta*psi (if not already done)
|
||||
call setv(2*nbnd*npwx,0.d0,dpsi,1)
|
||||
dpsi(:,:) = (0.d0, 0.d0)
|
||||
startwith0= .true.
|
||||
!!! else
|
||||
! otherwise restart from Delta*psi that is found on file
|
||||
|
|
|
|||
|
|
@ -89,7 +89,7 @@ subroutine solve_ph
|
|||
call dvpsi_kb(kpoint,nu)
|
||||
! initialize delta psi
|
||||
startwith0=.true.
|
||||
call setv(2*nbnd*npwx,0.d0,dpsi,1)
|
||||
dpsi(:,:) = (0.d0, 0.d0)
|
||||
! solve the linear system
|
||||
! NB: dvpsi is used also as work space and is destroyed by cgsolve
|
||||
call cgsolve (A_h,npw,evc,npwx,nbnd,overlap,nbnd, &
|
||||
|
|
|
|||
|
|
@ -85,6 +85,7 @@ set_irr_nosym.o \
|
|||
setlocq.o \
|
||||
setqmod.o \
|
||||
setup_dgc.o \
|
||||
setv.o \
|
||||
smallgq.o \
|
||||
solve_e.o \
|
||||
solve_linter.o \
|
||||
|
|
@ -284,7 +285,6 @@ PWOBJS = ../PW/pwcom.o \
|
|||
../PW/set_rhoc.o \
|
||||
../PW/setup.o \
|
||||
../PW/setupkpt.o \
|
||||
../PW/setv.o \
|
||||
../PW/set_vrs.o \
|
||||
../PW/sgama.o \
|
||||
../PW/sgam_at.o \
|
||||
|
|
|
|||
|
|
@ -209,7 +209,6 @@ PWOBJS = ../PW/pwcom.o \
|
|||
../PW/set_rhoc.o \
|
||||
../PW/setup.o \
|
||||
../PW/setupkpt.o \
|
||||
../PW/setv.o \
|
||||
../PW/set_vrs.o \
|
||||
../PW/sgama.o \
|
||||
../PW/sgam_at.o \
|
||||
|
|
|
|||
|
|
@ -196,7 +196,6 @@ setqf.o \
|
|||
set_rhoc.o \
|
||||
setup.o \
|
||||
setupkpt.o \
|
||||
setv.o \
|
||||
set_vrs.o \
|
||||
sgama.o \
|
||||
sgam_at.o \
|
||||
|
|
|
|||
|
|
@ -383,7 +383,7 @@ SUBROUTINE c_phase
|
|||
CALL ylm_q(lqx*lqx,dk,dkmod,ylm_dk)
|
||||
|
||||
! --- Form factor: 4 pi sum_LM c_ij^LM Y_LM(Omega) Q_ij^L(|r|) ---
|
||||
CALL setv(nhm*nhm*ntyp,0.d0,q_dk,1)
|
||||
q_dk(:,:,:) = (0.d0, 0.d0)
|
||||
DO np =1, ntyp
|
||||
DO iv = 1, nh(np)
|
||||
DO jv = iv, nh(np)
|
||||
|
|
@ -448,11 +448,11 @@ SUBROUTINE c_phase
|
|||
ENDIF
|
||||
|
||||
! --- Matrix elements calculation ---
|
||||
CALL setv(2*nbnd*nbnd,0.d0,mat,1)
|
||||
mat(:,:) = (0.d0, 0.d0)
|
||||
DO nb=1,nbnd
|
||||
DO mb=1,nbnd
|
||||
CALL setv(2*ngm,0.d0,aux,1)
|
||||
CALL setv(2*ngm,0.d0,aux0,1)
|
||||
aux(:) = (0.d0, 0.d0)
|
||||
aux0(:)= (0.d0, 0.d0)
|
||||
DO ik=1,npw0
|
||||
aux0(igk0(ik))=psi(ik,nb)
|
||||
END DO
|
||||
|
|
|
|||
|
|
@ -90,9 +90,9 @@ subroutine startup (nd_nmbr, code, version)
|
|||
nargs = iargc ()
|
||||
!
|
||||
do iiarg=1,nargs-1
|
||||
call getarg (iiarg, np)
|
||||
call getarg(iiarg, np)
|
||||
if (trim(np) == '-npool' .or. trim(np) == '-npools' ) then
|
||||
call getarg (iiarg+1, np)
|
||||
call getarg(iiarg+1, np)
|
||||
read (np,*) npool
|
||||
end if
|
||||
end do
|
||||
|
|
|
|||
3
TODO
3
TODO
|
|
@ -46,7 +46,8 @@ PW
|
|||
- remove residual direct calls to MPI routines,
|
||||
use (or merge with) existing routines in mp.f90 instead
|
||||
|
||||
- remove all calls to setv and to blas copy, scal
|
||||
- remove all calls to setv in PH and D3; all calls to zero and SSUM in
|
||||
CPV; calls to level-1 blas copy, scal
|
||||
|
||||
- remove potential mixing, save and start from rho instead of V,
|
||||
at least for scf calculations. For non-scf calculations: we may
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ PWOBJS = ../PW/error.o \
|
|||
../PW/kpoint_grid.o ../PW/sgama.o ../PW/sgam_at.o \
|
||||
../PW/sgam_ph.o ../PW/coset.o ../PW/multable.o \
|
||||
../PW/smallg_q.o ../PW/dsum.o ../PW/trnvecc.o ../PW/invmat.o \
|
||||
../PW/checksym.o ../PW/eqvect.o ../PW/setv.o \
|
||||
../PW/checksym.o ../PW/eqvect.o \
|
||||
../PW/irrek.o ../PW/mode_group.o \
|
||||
../PW/cft_3.o ../PW/error_handler.o
|
||||
MODULES = ../Modules/parameters.o ../Modules/kind.o ../Modules/fft_scalar.o
|
||||
|
|
|
|||
Loading…
Reference in New Issue