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

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 2003-09-17 21:50:03 +00:00
parent e212a3e854
commit ce8515b1be
31 changed files with 96 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
CPV/cpr.f90
View File

@ -304,7 +304,7 @@
allocate(rhor(nnr,nspin)) allocate(rhor(nnr,nspin))
allocate(rhos(nnrsx,nspin)) allocate(rhos(nnrsx,nspin))
allocate(rhog(ng,nspin)) allocate(rhog(ng,nspin))
if (nlcc.gt.0) allocate(rhoc(nnr)) if (nlcc > 0) allocate(rhoc(nnr))
allocate(wrk1(nnr)) allocate(wrk1(nnr))
allocate(qv(nnrb)) allocate(qv(nnrb))
allocate(c2(ngw)) allocate(c2(ngw))
@ -332,7 +332,7 @@
#ifdef __PARA #ifdef __PARA
allocate(aux(nnr)) allocate(aux(nnr))
#endif #endif
call zero(nat*nhx*nhx*nspin,deeq) deeq(:,:,:,:) = 0.d0
! !
666 continue 666 continue
! !
@ -357,12 +357,9 @@
! !
hnew=h hnew=h
! !
do i=1,n lambda(:,:)=0.d0
call zero(n,lambda(1,i)) cm(:,:) = (0.d0, 0.d0)
! c0(:,:) = (0.d0, 0.d0)
call zero(2*ngw,cm(1,i))
call zero(2*ngw,c0(1,i))
end do
! !
! mass preconditioning: ema0bg(i) = ratio of emass(g=0) to emass(g) ! mass preconditioning: ema0bg(i) = ratio of emass(g=0) to emass(g)
! for g**2>emaec the electron mass ema0bg(g) rises quadratically ! 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) if(iprsta.ge.10)print *,i,' ema0bg(i) ',ema0bg(i)
end do end do
! !
if (nbeg.lt.0) then if (nbeg < 0) then
!====================================================================== !======================================================================
! nbeg = -1 or nbeg = -2 or nbeg = -3 ! nbeg = -1 or nbeg = -2 or nbeg = -3
!====================================================================== !======================================================================
@ -571,22 +568,18 @@
xnhp0=0. xnhp0=0.
xnhpm=0. xnhpm=0.
vnhp =0. vnhp =0.
fionm(:,:,:)=0.
do is=1,nsp do is=1,nsp
do ia=1,na(is) do ia=1,na(is)
do i=1,3 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 end do
end do end do
do j=1,3 xnhh0(:,:)=0.
do i=1,3 xnhhm(:,:)=0.
xnhh0(i,j)=0. vnhh (:,:) =0.
xnhhm(i,j)=0. velh (:,:)=(h(:,:)-hold(:,:))/delt
vnhh(i,j) =0.
velh(i,j)=(h(i,j)-hold(i,j))/delt
end do
end do
! !
! ====================================================== ! ======================================================
! kinetic energy of the electrons ! kinetic energy of the electrons
@ -610,11 +603,7 @@
xnhem=0. xnhem=0.
vnhe =0. vnhe =0.
! !
do j=1,n lambdam(:,:)=lambda(:,:)
do i=1,n
lambdam(i,j)=lambda(i,j)
end do
end do
! !
else else
!====================================================================== !======================================================================
@ -639,11 +628,7 @@
if(trane.and.trhor) then if(trane.and.trhor) then
call prefor(eigr,betae) call prefor(eigr,betae)
call graham(betae,bec,c0) call graham(betae,bec,c0)
do i=1,n cm(:, 1:n)=c0(:, 1:n)
do j=1,ngw
cm(j,i)=c0(j,i)
end do
end do
endif endif
! !
if(iprsta.gt.2) then if(iprsta.gt.2) then
@ -673,21 +658,11 @@
end if end if
! !
if(.not.tfor) then if(.not.tfor) then
do is=1,nsp fion (:,:,:) = 0.d0
do ia=1,na(is)
do i=1,3
fion(i,ia,is)=0.d0
end do
end do
end do
end if end if
! !
if(.not.tpre) then if(.not.tpre) then
do j=1,3 stress (:,:) = 0.d0
do i=1,3
stress(i,j)=0.
end do
end do
endif endif
! !
fccc=1. fccc=1.
@ -717,12 +692,8 @@
fccc=1./(1.+0.5*delt*vnhe) fccc=1./(1.+0.5*delt*vnhe)
endif endif
if(tnoseh) then if(tnoseh) then
do i=1,3 vnhh(:,:)=2.*(xnhh0(:,:)-xnhhm(:,:))/delt-vnhh(:,:)
do j=1,3 velh(:,:)=2.*(h(:,:)-hold(:,:))/delt-velh(:,:)
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
endif endif
! !
if (tfor.or.thdyn.or.tfirst) then if (tfor.or.thdyn.or.tfirst) then
@ -832,16 +803,12 @@
if (tfor) call nlfq(c0,deeq,eigr,bec,becdr,fion) if (tfor) call nlfq(c0,deeq,eigr,bec,becdr,fion)
! !
if(tfor.or.thdyn) then if(tfor.or.thdyn) then
do j=1,n
do i=1,n
! !
! interpolate new lambda at (t+dt) from lambda(t) and lambda(t-dt): ! interpolate new lambda at (t+dt) from lambda(t) and lambda(t-dt):
! !
lambdap(i,j)=2.*lambda(i,j)-lambdam(i,j) lambdap(:,:) = 2.d0*lambda(:,:)-lambdam(:,:)
lambdam(i,j)=lambda(i,j) lambdam(:,:)=lambda (:,:)
lambda (i,j)=lambdap(i,j) lambda (:,:)=lambdap(:,:)
end do
end do
endif endif
! !
! calphi calculates phi ! calphi calculates phi
@ -903,11 +870,7 @@
! guessed displacement of ions ! guessed displacement of ions
!======================================================================= !=======================================================================
! !
do j=1,3 hgamma(:,:) = 0.d0
do i=1,3
hgamma(i,j)=0.
enddo
enddo
if(thdyn) then if(thdyn) then
verl1=2./(1.+frich) verl1=2./(1.+frich)
verl2=1.-verl1 verl2=1.-verl1
@ -935,11 +898,9 @@
enddo enddo
enddo enddo
endif endif
do j=1,3 !
do i=1,3 velh(:,:) = (hnew(:,:)-hold(:,:))/twodel
velh(i,j) = (hnew(i,j)-hold(i,j))/twodel !
enddo
enddo
do i=1,3 do i=1,3
do j=1,3 do j=1,3
do k=1,3 do k=1,3
@ -1337,12 +1298,8 @@
xnhe0 = xnhep xnhe0 = xnhep
endif endif
if(tnoseh) then if(tnoseh) then
do j=1,3 xnhhm(:,:) = xnhh0(:,:)
do i=1,3 xnhh0(:,:) = xnhhp(:,:)
xnhhm(i,j) = xnhh0(i,j)
xnhh0(i,j) = xnhhp(i,j)
enddo
enddo
endif endif
end if end if
! !

24
CPV/cprsub.f90
View File

@ -958,8 +958,8 @@
allocate(dqgbs(ngb,3,3)) allocate(dqgbs(ngb,3,3))
allocate(qgbs(ngb)) allocate(qgbs(ngb))
! !
call zero(ngb*nbrx*nbrx*lx*nsp,qradb) qradb(:,:,:,:,:) = 0.d0
call zero(9*ngb*nbrx*nbrx*lx*nsp,dqrad) dqrad(:,:,:,:,:,:,:) = 0.d0
! !
! =============================================================== ! ===============================================================
! initialization for vanderbilt species ! initialization for vanderbilt species
@ -1147,14 +1147,14 @@
real(kind=8) fpre(3,3), tmpbec(nhx,nx), tmpdh(nx,nhx), temp(nx,nx),& real(kind=8) fpre(3,3), tmpbec(nhx,nx), tmpdh(nx,nhx), temp(nx,nx),&
& SSUM, tt & SSUM, tt
! !
call zero(9,fpre) fpre(:,:) = 0.d0
do ii=1,3 do ii=1,3
do jj=1,3 do jj=1,3
do is=1,nvb do is=1,nvb
do ia=1,na(is) do ia=1,na(is)
! !
call zero(nhx*n,tmpbec) tmpbec(:, 1:n) = 0.d0
call zero(nhx*n,tmpdh) tmpdh (1:n, :) = 0.d0
! !
do iv=1,nh(is) do iv=1,nh(is)
do jv=1,nh(is) do jv=1,nh(is)
@ -1176,7 +1176,7 @@
end do end do
! !
if(nh(is).gt.0)then if(nh(is).gt.0)then
call zero(nx*n,temp) temp(:, 1:n) = 0.d0
! !
call MXMA & call MXMA &
& (tmpdh,1,nx,tmpbec,1,nhx,temp,1,nx,n,nh(is),n) & (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(qradx(mmx,nbrx,nbrx,lx,nsp))
allocate(dqradx(mmx,nbrx,nbrx,lx,nsp)) allocate(dqradx(mmx,nbrx,nbrx,lx,nsp))
! !
call zero(ngb*nbrx*nbrx*lx*nsp,qradb) qradb(:,:,:,:,:) = 0.d0
call zero(nhx*nhx*nsp,qq) qq (:,:,:) =0.d0
call zero(nhx*nhx*nsp,dvan) dvan(:,:,:) =0.d0
if(tpre) call zero(9*ngb*nbrx*nbrx*lx*nsp,dqrad) if(tpre) dqrad(:,:,:,:,:,:,:) = 0.d0
! !
! ------------------------------------------------------------------ ! ------------------------------------------------------------------
! definition of indices nhtol, indv, indlm ! definition of indices nhtol, indv, indlm
@ -1584,11 +1584,11 @@
if(ivl.gt.nlx) call errore(' qvan ',' ivl.gt.nlx ',ivl) if(ivl.gt.nlx) call errore(' qvan ',' ivl.gt.nlx ',ivl)
if(jvl.gt.nlx) call errore(' qvan ',' jvl.gt.nlx ',jvl) if(jvl.gt.nlx) call errore(' qvan ',' jvl.gt.nlx ',jvl)
! !
call zero(2*ngb,qg) qg(:) = (0.d0, 0.d0)
allocate(ylm(ngb)) allocate(ylm(ngb))
if(tpre) then if(tpre) then
allocate(dylm(ngb,3,3)) allocate(dylm(ngb,3,3))
call zero(2*9*ngb,dqg) dqg(:,:,:) = (0.d0, 0.d0)
end if end if
! !
! lpx = max number of allowed y_lm ! lpx = max number of allowed y_lm

4
CPV/fft_cp.f90
View File

@ -83,7 +83,7 @@ CONTAINS
if ( sign /= 2 ) then if ( sign /= 2 ) then
call cft_1z( f, dfft%nsp(me), nr3, nr3x, sign, aux) 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 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 do i = 1, dfft%nst
mc = dfft%ismap( i ) mc = dfft%ismap( i )
do j = 1, dfft%npp(me) do j = 1, dfft%npp(me)
@ -94,7 +94,7 @@ CONTAINS
else else
call cft_1z( f, dfft%nsw(me), nr3, nr3x, sign, aux) 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 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 ii = 0
do proc=1,nproc do proc=1,nproc
do i=1,dfft%nsw(proc) do i=1,dfft%nsw(proc)

2
D3/Makefile
View File

@ -139,6 +139,7 @@ PHOBJS = ../PH/phcom.o \
../PH/setlocq.o \ ../PH/setlocq.o \
../PH/setqmod.o \ ../PH/setqmod.o \
../PH/setup_dgc.o \ ../PH/setup_dgc.o \
../PH/setv.o \
../PH/smallgq.o \ ../PH/smallgq.o \
../PH/solve_e.o \ ../PH/solve_e.o \
../PH/solve_linter.o \ ../PH/solve_linter.o \
@ -338,7 +339,6 @@ PWOBJS = ../PW/pwcom.o \
../PW/set_rhoc.o \ ../PW/set_rhoc.o \
../PW/setup.o \ ../PW/setup.o \
../PW/setupkpt.o \ ../PW/setupkpt.o \
../PW/setv.o \
../PW/set_vrs.o \ ../PW/set_vrs.o \
../PW/sgama.o \ ../PW/sgama.o \
../PW/sgam_at.o \ ../PW/sgam_at.o \

1
Gamma/Makefile
View File

@ -112,7 +112,6 @@ PWOBJS=../PW/pwcom.o \
../PW/restart_in_electrons.o \ ../PW/restart_in_electrons.o \
../PW/restart_in_ions.o \ ../PW/restart_in_ions.o \
../PW/rho2zeta.o \ ../PW/rho2zeta.o \
../PW/setv.o \
../PW/ruotaijk.o \ ../PW/ruotaijk.o \
../PW/s_axis_to_ca.o \ ../PW/s_axis_to_ca.o \
../PW/save_in_cbands.o \ ../PW/save_in_cbands.o \

6
Gamma/a_h.f90
View File

@ -32,7 +32,7 @@ subroutine A_h(e,h,ah)
dpsic => aux2 dpsic => aux2
drhoc => aux3 drhoc => aux3
! !
call setv(nrxx,0.d0,drho,1) drho(:) = 0.d0
! !
! [(k+G)^2 - e ]psi ! [(k+G)^2 - e ]psi
do ibnd = 1,nbnd do ibnd = 1,nbnd
@ -45,8 +45,8 @@ subroutine A_h(e,h,ah)
end do end do
! V_Loc psi ! V_Loc psi
do ibnd = 1,nbnd, 2 do ibnd = 1,nbnd, 2
call setv(2*nrxx,0.d0,dpsic,1) dpsic(:)= (0.d0, 0.d0)
call setv(2*nrxx,0.d0, psic,1) psic(:) = (0.d0, 0.d0)
if (ibnd.lt.nbnd) then if (ibnd.lt.nbnd) then
! two ffts at the same time ! two ffts at the same time
do j = 1,npw do j = 1,npw

10
Gamma/cg_setupdgc.f90
View File

@ -33,11 +33,11 @@ subroutine cg_setupdgc
if (igcx.eq.0 .and. igcc.eq.0) return if (igcx.eq.0 .and. igcc.eq.0) return
call start_clock('setup_dgc') call start_clock('setup_dgc')
! !
call setv(nrxx*nspin*nspin,0.d0,dvxc_rr,1) dvxc_rr(:,:,:) = 0.d0
call setv(nrxx*nspin*nspin,0.d0,dvxc_sr,1) dvxc_sr(:,:,:) = 0.d0
call setv(nrxx*nspin*nspin,0.d0,dvxc_ss,1) dvxc_ss(:,:,:) = 0.d0
call setv(nrxx*nspin*nspin,0.d0,dvxc_s ,1) dvxc_s (:,:,:) = 0.d0
call setv(3*nrxx*nspin,0.d0,grho ,1) grho (:,:,:) = 0.d0
! !
! add rho_core ! add rho_core
! !

2
Gamma/cgsolve.f90
View File

@ -37,7 +37,7 @@ subroutine cgsolve (operator,npw,evc,npwx,nbnd,overlap, &
if (.not.startwith0) then if (.not.startwith0) then
call operator(e,x,u) call operator(e,x,u)
else else
call setv(2*npwx*nbnd,0.d0,u,1) u (:,:) = (0.d0, 0.d0)
! note that we assume x=0 on input ! note that we assume x=0 on input
end if end if
! !

2
Gamma/d2ion.f90
View File

@ -42,7 +42,7 @@ subroutine d2ion (nat,ntyp,ityp,zv,tau,alat,omega, &
! appropriate for c60 ! appropriate for c60
write(6,'(" d2ion: alpha = ",f6.2)') alpha write(6,'(" d2ion: alpha = ",f6.2)') alpha
! !
call setv(3*nat*nmodes,0.d0,dyn,1) dyn (:,:) = 0.d0
! !
! G-space sum here ! G-space sum here
! !

4
Gamma/dgradcorr.f90
View File

@ -40,7 +40,7 @@ subroutine dgradcor1 (rho, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, &
allocate (h( 3, nrxx , nspin)) allocate (h( 3, nrxx , nspin))
allocate (dh( nrxx)) allocate (dh( nrxx))
call setv (6 * nrxx * nspin, 0.d0, h, 1) h (:,:,:) = (0.d0, 0.d0)
do is = 1, nspin do is = 1, nspin
call gradient1 (nrx1, nrx2, nrx3, nr1, nr2, nr3, nrxx, & call gradient1 (nrx1, nrx2, nrx3, nr1, nr2, nr3, nrxx, &
drhoc(1, is), ngm, g, nl, nlm, alat, gdrho (1, 1, is) ) 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 ! LSDA case
! !
call setv (8, 0.d0, ps, 1) ps (:,:) = (0.d0, 0.d0)
do is = 1, nspin do is = 1, nspin
do js = 1, nspin do js = 1, nspin
do ipol = 1, 3 do ipol = 1, 3

4
Gamma/dielec.f90
View File

@ -31,8 +31,8 @@ subroutine dielec(do_zstar)
allocate (dpsi3( npwx, nbnd)) allocate (dpsi3( npwx, nbnd))
allocate (work( nbnd, 3)) allocate (work( nbnd, 3))
! !
call setv(9,0.d0,epsilon0,1) epsilon0(:,:) = 0.d0
if (do_zstar) call setv(9*nat,0.d0,zstar,1) if (do_zstar) zstar (:,:,:) = 0.d0
! do kpoint=1,nks ! do kpoint=1,nks
kpoint=1 kpoint=1
weight = wk(kpoint) weight = wk(kpoint)

2
Gamma/drhodv.f90
View File

@ -23,7 +23,7 @@ subroutine drhodv(nu_i)
! !
call start_clock('drhodv') call start_clock('drhodv')
! !
call setv(nmodes,0.d0,dynel,1) dynel(:) = 0.d0
kpoint = 1 kpoint = 1
! do kpoint=1,nks ! do kpoint=1,nks
! !

16
Gamma/dvb_cc.f90
View File

@ -6,18 +6,18 @@
! or http://www.gnu.org/copyleft/gpl.txt . ! 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) nl,rho_core,dmuxc,ga,aux,dvb_nlcc)
!--------------------------------------------------------------------- !---------------------------------------------------------------------
! calcola il contributo core-correction al Delta V bare ! calcola il contributo core-correction al Delta V bare
! !
#include "machine.h" #include "machine.h"
implicit none 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) logical :: nlcc(npseu)
integer :: nl(ngm) integer :: nl(ngm)
real(kind=8) :: rho_core(ngm), dmuxc(nrx1*nr2*nr3) real(kind=8) :: rho_core(ngm), dmuxc(nrx1*nrx2*nrx3)
complex(kind=8) :: ga(ngm), dvb_nlcc(ngm), aux(nrx1*nr2*nr3) complex(kind=8) :: ga(ngm), dvb_nlcc(ngm), aux(nrx1*nrx2*nrx3)
! !
do np=1,npseu do np=1,npseu
if(nlcc(np)) go to 10 if(nlcc(np)) go to 10
@ -25,16 +25,14 @@ subroutine dvb_cc (nlcc,npseu,ngm,nr1,nr2,nr3,nrx1, &
return return
10 continue 10 continue
! !
nrxx=nrx1*nr2*nr3 aux(:) = (0.d0, 0.d0)
call setv(2*nrxx,0.d0,aux,1)
do ng=1,ngm do ng=1,ngm
aux(nl(ng)) = ga(ng) * rho_core(ng) aux(nl(ng)) = ga(ng) * rho_core(ng)
end do end do
call cft3(aux,nr1,nr2,nr3,nrx1,nr2,nr3,1) call cft3(aux,nr1,nr2,nr3,nrx1,nr2,nr3,1)
! !
do i=1,nrxx aux(:) = aux(:) * dmuxc(:)
aux(i) = aux(i) * dmuxc(i) !
end do
call cft3(aux,nr1,nr2,nr3,nrx1,nr2,nr3,-1) call cft3(aux,nr1,nr2,nr3,nrx1,nr2,nr3,-1)
do ng=1,ngm do ng=1,ngm
dvb_nlcc(ng) = aux(nl(ng)) dvb_nlcc(ng) = aux(nl(ng))

2
Gamma/dvpsi_e.f90
View File

@ -128,7 +128,7 @@ subroutine dvpsi_e(kpoint,ipol)
end if end if
! !
startwith0= .true. 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, & call cgsolve (H_h,npw,evc,npwx,nbnd,overlap,nbnd, &
orthonormal,precondition,q,startwith0,et(1,kpoint),& orthonormal,precondition,q,startwith0,et(1,kpoint),&

6
Gamma/dvpsi_kb.f90
View File

@ -32,8 +32,8 @@ subroutine dvpsi_kb(kpoint,nu)
dv => auxr dv => auxr
dvloc => aux2 dvloc => aux2
dvb_cc => aux3 dvb_cc => aux3
call setv(2*nrxx,0.d0,dvloc,1) dvloc(:) = (0.d0, 0.d0)
call setv(2*nrxx,0.d0,dvb_cc,1) dvb_cc(:)= (0.d0, 0.d0)
do na = 1,nat do na = 1,nat
mu = 3*(na-1) 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 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) ! 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) call vloc_psi(npwx, npw, nbnd, evc, dv, dvpsi)
! !
! nonlocal (Kleinman-Bylander) contribution. ! nonlocal (Kleinman-Bylander) contribution.

2
Gamma/dyndiar.f90
View File

@ -87,7 +87,7 @@ subroutine dyndiar (dyn,nat3,nmodes,u,nat,ityp,amass,w2,dynout)
write (6,'(5x,"diagonalizing the dynamical matrix ..."//)') write (6,'(5x,"diagonalizing the dynamical matrix ..."//)')
write (6,'(1x,74("*"))') write (6,'(1x,74("*"))')
! !
call setv(nat3*nmodes,0.0,dynout,1) dynout (:,:) = 0.0
do nu_i = 1,nmodes do nu_i = 1,nmodes
w1 = sqrt(abs(w2(nu_i))) w1 = sqrt(abs(w2(nu_i)))
if (w2(nu_i).lt.0.0) w1 = -w1 if (w2(nu_i).lt.0.0) w1 = -w1

6
Gamma/dynmatcc.f90
View File

@ -23,7 +23,7 @@ subroutine dynmatcc(dyncc)
real(kind=DP) :: exg real(kind=DP) :: exg
! !
! !
call setv(3*nat*nmodes,0.d0,dyncc,1) dyncc(:,:) = 0.d0
! !
do nt=1,ntyp do nt=1,ntyp
if(nlcc(nt)) go to 10 if(nlcc(nt)) go to 10
@ -42,7 +42,7 @@ subroutine dynmatcc(dyncc)
! !
call cft3(vxc,nr1,nr2,nr3,nrx1,nr2,nr3,-1) 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 do na=1,nat
nta=ityp(na) nta=ityp(na)
if (nlcc(nta)) then if (nlcc(nta)) then
@ -68,7 +68,7 @@ subroutine dynmatcc(dyncc)
end do end do
end do end do
do i=1,3 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)) nl,drhocc,dmuxc,gc(1,i),aux3,gc(1,i))
end do end do
do nb=1,nat do nb=1,nat

2
Gamma/generate_effective_charges.f90
View File

@ -34,7 +34,7 @@ subroutine generate_effective_charges &
call trntns(zstar(1,1,na),at,bg,-1) call trntns(zstar(1,1,na),at,bg,-1)
done(na)=.true. done(na)=.true.
else else
call setv(9,0.d0,zstar(1,1,na),1) zstar(:,:,na) = 0.d0
done(na)=.false. done(na)=.false.
end if end if
end do end do

10
Gamma/gradcorr.f90
View File

@ -160,8 +160,8 @@ subroutine gradient (nrx1, nrx2, nrx3, nr1, nr2, nr3, nrxx, a, &
! !
! copy a(r) to complex array... ! copy a(r) to complex array...
! !
call setv (nrxx, 0.d0, aux (2, 1), 2) aux(1,:) = a(:)
call DCOPY (nrxx, a, 1, aux (1,1) , 2) aux(2,:) = 0.d0
! !
! bring a(r) to G-space, a(G) ... ! 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 (aux( 2,nrxx))
allocate (gaux(2,nrxx)) allocate (gaux(2,nrxx))
call setv (2 * nrxx, 0.d0, gaux, 1) gaux(:,:) = 0.d0
do ipol = 1, 3 do ipol = 1, 3
! !
! copy a(ipol,r) to a complex array... ! copy a(ipol,r) to a complex array...
! !
call setv (nrxx, 0.d0, aux (2, 1), 2) aux(1,:) = a(ipol,:)
call DCOPY (nrxx, a (ipol, 1), 3, aux, 2) aux(2,:) = 0.d0
! !
! bring a(ipol,r) to G-space, a(G) ... ! bring a(ipol,r) to G-space, a(G) ...
! !

2
Gamma/macro.f90
View File

@ -27,7 +27,7 @@ subroutine macro
call seqopn (iubar,filbar,'unformatted',here) call seqopn (iubar,filbar,'unformatted',here)
!!! if (.not.here) then !!! if (.not.here) then
! calculate x * psi (if not already done) ! calculate x * psi (if not already done)
call setv(2*nbnd*npwx,0.d0,dvpsi,1) dvpsi(:,:) = (0.d0, 0.d0)
!!! else !!! else
! otherwise restart from x * psi that is present on from file ! otherwise restart from x * psi that is present on from file
!!! read(iubar) dvpsi !!! read(iubar) dvpsi

7
Gamma/rhod2vkb.f90
View File

@ -32,7 +32,7 @@ subroutine rhod2vkb(dyn0)
! contribution from local potential ! contribution from local potential
! !
allocate ( dynloc( 3*nat, nmodes)) allocate ( dynloc( 3*nat, nmodes))
call setv(3*nat*nmodes,0.d0,dynloc,1) dynloc (:,:) = 0.d0
do ir = 1,nrxx do ir = 1,nrxx
psic(ir) = rho(ir,current_spin) psic(ir) = rho(ir,current_spin)
end do end do
@ -166,14 +166,15 @@ subroutine rhod2vkb(dyn0)
deallocate ( becp1) deallocate ( becp1)
deallocate ( dvkb) deallocate ( dvkb)
! !
call setv(3*nat*nmodes,0.d0,dyn0,1) dyn0 (:,:) = 0.d0
! !
do nu_i = 1,nmodes do nu_i = 1,nmodes
if (has_equivalent( (nu_i-1)/3+1).eq.0 ) then if (has_equivalent( (nu_i-1)/3+1).eq.0 ) then
do nu_j=1,nmodes do nu_j=1,nmodes
do mu_i=1,3*nat do mu_i=1,3*nat
do mu_j=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 end do
end do end do

2
Gamma/solve_e.f90
View File

@ -71,7 +71,7 @@ subroutine solve_e
call seqopn (iudwf,fildwf,'unformatted',here) call seqopn (iudwf,fildwf,'unformatted',here)
!!! if (.not.here) then !!! if (.not.here) then
! calculate Delta*psi (if not already done) ! calculate Delta*psi (if not already done)
call setv(2*nbnd*npwx,0.d0,dpsi,1) dpsi(:,:) = (0.d0, 0.d0)
startwith0= .true. startwith0= .true.
!!! else !!! else
! otherwise restart from Delta*psi that is found on file ! otherwise restart from Delta*psi that is found on file

2
Gamma/solve_ph.f90
View File

@ -89,7 +89,7 @@ subroutine solve_ph
call dvpsi_kb(kpoint,nu) call dvpsi_kb(kpoint,nu)
! initialize delta psi ! initialize delta psi
startwith0=.true. startwith0=.true.
call setv(2*nbnd*npwx,0.d0,dpsi,1) dpsi(:,:) = (0.d0, 0.d0)
! solve the linear system ! solve the linear system
! NB: dvpsi is used also as work space and is destroyed by cgsolve ! NB: dvpsi is used also as work space and is destroyed by cgsolve
call cgsolve (A_h,npw,evc,npwx,nbnd,overlap,nbnd, & call cgsolve (A_h,npw,evc,npwx,nbnd,overlap,nbnd, &

2
PH/Makefile
View File

@ -85,6 +85,7 @@ set_irr_nosym.o \
setlocq.o \ setlocq.o \
setqmod.o \ setqmod.o \
setup_dgc.o \ setup_dgc.o \
setv.o \
smallgq.o \ smallgq.o \
solve_e.o \ solve_e.o \
solve_linter.o \ solve_linter.o \
@ -284,7 +285,6 @@ PWOBJS = ../PW/pwcom.o \
../PW/set_rhoc.o \ ../PW/set_rhoc.o \
../PW/setup.o \ ../PW/setup.o \
../PW/setupkpt.o \ ../PW/setupkpt.o \
../PW/setv.o \
../PW/set_vrs.o \ ../PW/set_vrs.o \
../PW/sgama.o \ ../PW/sgama.o \
../PW/sgam_at.o \ ../PW/sgam_at.o \

0
PW/setv.f90 → PH/setv.f90
View File

1
PP/Makefile
View File

@ -209,7 +209,6 @@ PWOBJS = ../PW/pwcom.o \
../PW/set_rhoc.o \ ../PW/set_rhoc.o \
../PW/setup.o \ ../PW/setup.o \
../PW/setupkpt.o \ ../PW/setupkpt.o \
../PW/setv.o \
../PW/set_vrs.o \ ../PW/set_vrs.o \
../PW/sgama.o \ ../PW/sgama.o \
../PW/sgam_at.o \ ../PW/sgam_at.o \

1
PW/Makefile
View File

@ -196,7 +196,6 @@ setqf.o \
set_rhoc.o \ set_rhoc.o \
setup.o \ setup.o \
setupkpt.o \ setupkpt.o \
setv.o \
set_vrs.o \ set_vrs.o \
sgama.o \ sgama.o \
sgam_at.o \ sgam_at.o \

8
PW/bp_c_phase.f90
View File

@ -383,7 +383,7 @@ SUBROUTINE c_phase
CALL ylm_q(lqx*lqx,dk,dkmod,ylm_dk) 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|) --- ! --- 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 np =1, ntyp
DO iv = 1, nh(np) DO iv = 1, nh(np)
DO jv = iv, nh(np) DO jv = iv, nh(np)
@ -448,11 +448,11 @@ SUBROUTINE c_phase
ENDIF ENDIF
! --- Matrix elements calculation --- ! --- Matrix elements calculation ---
CALL setv(2*nbnd*nbnd,0.d0,mat,1) mat(:,:) = (0.d0, 0.d0)
DO nb=1,nbnd DO nb=1,nbnd
DO mb=1,nbnd DO mb=1,nbnd
CALL setv(2*ngm,0.d0,aux,1) aux(:) = (0.d0, 0.d0)
CALL setv(2*ngm,0.d0,aux0,1) aux0(:)= (0.d0, 0.d0)
DO ik=1,npw0 DO ik=1,npw0
aux0(igk0(ik))=psi(ik,nb) aux0(igk0(ik))=psi(ik,nb)
END DO END DO

3
TODO
View File

@ -46,7 +46,8 @@ PW
- remove residual direct calls to MPI routines, - remove residual direct calls to MPI routines,
use (or merge with) existing routines in mp.f90 instead 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, - remove potential mixing, save and start from rho instead of V,
at least for scf calculations. For non-scf calculations: we may at least for scf calculations. For non-scf calculations: we may

2
pwtools/Makefile
View File

@ -9,7 +9,7 @@ PWOBJS = ../PW/error.o \
../PW/kpoint_grid.o ../PW/sgama.o ../PW/sgam_at.o \ ../PW/kpoint_grid.o ../PW/sgama.o ../PW/sgam_at.o \
../PW/sgam_ph.o ../PW/coset.o ../PW/multable.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/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/irrek.o ../PW/mode_group.o \
../PW/cft_3.o ../PW/error_handler.o ../PW/cft_3.o ../PW/error_handler.o
MODULES = ../Modules/parameters.o ../Modules/kind.o ../Modules/fft_scalar.o MODULES = ../Modules/parameters.o ../Modules/kind.o ../Modules/fft_scalar.o