Commit 022b4ecc authored by giannozz's avatar giannozz

More cft3/cft3s => fwfft/invfft conversion


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@7026 c92efa57-630b-4861-b058-cf58834340f0
parent 3e12d6f1
!
!
! Copyright (C) 2001-2007 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
......@@ -11,7 +11,7 @@ subroutine add_dkmds(kpoint, uact, jpol, dvkb)
!
! This subroutine adds to dvpsi the terms which depend on the augmentation
! charge. It assumes that the variable dpqq, has been set. In the noncollinear
! and spin_orbit case the variable dpqq_so must be set.
! and spin_orbit case the variable dpqq_so must be set.
!
USE kinds, ONLY : DP
......@@ -45,22 +45,22 @@ subroutine add_dkmds(kpoint, uact, jpol, dvkb)
logical :: ok
complex(DP), allocatable :: ps1(:,:), ps2(:,:,:)
complex(DP), allocatable :: ps1_nc(:,:,:), ps2_nc(:,:,:,:)
complex(DP), allocatable :: ps1(:,:), ps2(:,:,:)
complex(DP), allocatable :: ps1_nc(:,:,:), ps2_nc(:,:,:,:)
complex(DP), allocatable :: alphadk(:,:,:), becp2(:,:)
complex(DP), allocatable :: alphadk_nc(:,:,:,:), becp2_nc(:,:,:)
complex(DP), allocatable :: aux(:), aux1(:,:)
integer :: i,j,is
integer :: i,j,is
#ifdef TIMING_ADD_DKMDS
call start_clock('add_dkmds')
call start_clock('add_dkmds2')
#endif
#endif
allocate(aux(npwx))
allocate(aux1(npwx*npol,nbnd))
if (nkb.gt.0) then
if (nkb.gt.0) then
if (noncolin) then
allocate (ps1_nc(nkb,npol,nbnd))
allocate (ps2_nc(nkb,npol,3,nbnd))
......@@ -100,12 +100,12 @@ subroutine add_dkmds(kpoint, uact, jpol, dvkb)
do ipol = 1, 3
do ibnd = 1, nbnd
do ig = 1, npw
aux1 (ig, ibnd) = evc(ig,ibnd) * tpiba * (0.d0,1.d0) * &
aux1 (ig, ibnd) = evc(ig,ibnd) * tpiba * (0.d0,1.d0) * &
( xk(ipol,kpoint) + g(ipol,igk(ig)) )
enddo
if (noncolin) then
do ig = 1, npw
aux1 (ig+npwx, ibnd) = evc(ig+npwx,ibnd)*tpiba*(0.d0,1.d0) * &
aux1 (ig+npwx, ibnd) = evc(ig+npwx,ibnd)*tpiba*(0.d0,1.d0) * &
( xk(ipol,kpoint) + g(ipol,igk(ig)) )
enddo
endif
......@@ -133,13 +133,13 @@ subroutine add_dkmds(kpoint, uact, jpol, dvkb)
ikb = ijkb0 + ih
do jh = 1, nh (nt)
jkb = ijkb0 + jh
do ipol = 1, 3
do ipol = 1, 3
do ibnd=1, nbnd_occ(kpoint)
!
! first we calculate the part coming from the
! first we calculate the part coming from the
! overlapp matrix S
!
if (noncolin) then
if (noncolin) then
if (lspinorb) then
ps1_nc (ikb,1,ibnd)=ps1_nc(ikb,1,ibnd) + &
(qq_so(ih,jh,1,nt)* &
......@@ -223,7 +223,7 @@ subroutine add_dkmds(kpoint, uact, jpol, dvkb)
qq (ih, jh, nt) * &
becp2(jkb, ibnd) * &
uact (mu + ipol) * tpiba
!
!
! and here the part of the matrix K(r)
!
ps1 (ikb, ibnd) = ps1 (ikb, ibnd) + &
......@@ -258,7 +258,7 @@ subroutine add_dkmds(kpoint, uact, jpol, dvkb)
else
call zgemm ('N', 'N', npwq, nbnd*npol, nkb, &
(1.d0, 0.d0), vkb, npwx, ps1, nkb, (1.d0, 0.d0) , dvpsi, npwx)
! dvpsi = matmul(vkb, ps1) + dvpsi
! dvpsi = matmul(vkb, ps1) + dvpsi
endif
endif
#ifdef TIMING_ADD_DKMDS
......
......@@ -78,11 +78,11 @@ subroutine add_for_charges (ik, uact)
CALL allocate_bec_type(nkb,nbnd,alphapp(ipol))
ENDDO
IF (noncolin) THEN
allocate (ps1_nc ( nkb, npol, nbnd))
allocate (ps2_nc ( nkb, npol, nbnd , 3))
allocate (ps1_nc ( nkb, npol, nbnd))
allocate (ps2_nc ( nkb, npol, nbnd , 3))
ELSE
allocate (ps1 ( nkb , nbnd))
allocate (ps2 ( nkb , nbnd , 3))
allocate (ps1 ( nkb , nbnd))
allocate (ps2 ( nkb , nbnd , 3))
ENDIF
if (lgamma) then
ikk = ik
......@@ -112,7 +112,7 @@ subroutine add_for_charges (ik, uact)
aux1 = (0.d0, 0.d0)
!
! first we calculate the products of the beta functions with dpsi
! first we calculate the products of the beta functions with dpsi
!
CALL calbec (npw, vkb, dpsi, bedp)
do ipol = 1, 3
......@@ -120,13 +120,13 @@ subroutine add_for_charges (ik, uact)
do ibnd = 1, nbnd
do ig = 1, npw
aux1 (ig, ibnd) = dpsi(ig,ibnd) * &
tpiba * (0.d0,1.d0) * &
tpiba * (0.d0,1.d0) * &
( xk(ipol,ikk) + g(ipol,igk(ig)) )
enddo
if (noncolin) then
do ig = 1, npw
aux1 (ig+npwx, ibnd) = dpsi(ig+npwx,ibnd) * &
tpiba * (0.d0,1.d0) * &
tpiba * (0.d0,1.d0) * &
( xk(ipol,ikk) + g(ipol,igk(ig)) )
enddo
endif
......
......@@ -10,7 +10,7 @@ subroutine add_zstar_ue_us(imode0,npe)
!----------===============-------------------------------
! add the contribution of the modes imode0+1 -> imode+npe
! to the effective charges Z(Us,E) (Us=scf,E=bare)
!
!
! This subroutine is just for the USPP case
!
! trans =.true. is needed for this calculation to be meaningful
......@@ -37,8 +37,8 @@ subroutine add_zstar_ue_us(imode0,npe)
implicit none
integer, intent(in) :: imode0, npe
integer :: ik, jpol, nrec, mode, ipert, ibnd, jbnd, i,j
integer :: ik, jpol, nrec, mode, ipert, ibnd, jbnd, i,j
real(DP) :: weight
......@@ -48,7 +48,7 @@ subroutine add_zstar_ue_us(imode0,npe)
call start_clock('add_zstar_us')
! call compute_qdipol(dpqq)
allocate (pdsp(nbnd,nbnd))
allocate (dvkb(npwx,nkb,3))
if (nksq.gt.1) rewind (iunigk)
......@@ -68,7 +68,7 @@ subroutine add_zstar_ue_us(imode0,npe)
call dvpsi_e(ik,jpol)
!
! Calculate the matrix elements <psi_v'k|dS/du|psi_vk>
! Note: we need becp1
! Note: we need becp1
!
pdsp = (0.d0,0.d0)
call psidspsi (ik, u (1, mode), pdsp,npw)
......@@ -90,8 +90,8 @@ subroutine add_zstar_ue_us(imode0,npe)
dvpsi = (0.d0,0.d0)
dpsi = (0.d0,0.d0)
!
! For the last part, we read the commutator from disc,
! but this time we calculate
! For the last part, we read the commutator from disc,
! but this time we calculate
! dS/du P_c [H-eS]|psi> + (dK(r)/du - dS/du)r|psi>
!
! first we read P_c [H-eS]|psi> and store it in dpsi
......@@ -107,7 +107,7 @@ subroutine add_zstar_ue_us(imode0,npe)
!
call add_dkmds(ik, u(1,mode),jpol, dvkb)
!
! And calculate finally the scalar product
! And calculate finally the scalar product
!
do ibnd = 1, nbnd_occ(ik)
zstarue0_rec(mode,jpol)=zstarue0_rec(mode,jpol) - weight * &
......@@ -116,7 +116,7 @@ subroutine add_zstar_ue_us(imode0,npe)
enddo
enddo
enddo
deallocate(dvkb)
deallocate(pdsp)
call stop_clock('add_zstar_us')
......
......@@ -16,8 +16,9 @@ subroutine addcore (mode, drhoc)
use uspp_param, only: upf
use ions_base, only: nat, ityp
use cell_base, only: tpiba
use gvect, only: ngm, nrxx, nrx1, nrx2, nrx3, nr1, nr2, nr3, nl, &
ig1, ig2, ig3, eigts1, eigts2, eigts3, g
use fft_base, only: dfftp
use fft_interfaces, only: invfft
use gvect, only: ngm, nrxx, nl, ig1, ig2, ig3, eigts1, eigts2, eigts3, g
use modes, only: u
use qpoint, only: eigqts, xq
use nlcc_ph, only: nlcc_any, drc
......@@ -68,7 +69,7 @@ subroutine addcore (mode, drhoc)
!
! transform to real space
!
call cft3 (drhoc, nr1, nr2, nr3, nrx1, nrx2, nrx3, + 1)
CALL invfft ('Dense', drhoc, dfftp)
!
return
......
......@@ -35,9 +35,9 @@ subroutine adddvepsi_us(becp2,ipol,kpoint)
integer:: ijkb0, nt, na, ih, jh, ikb, jkb, ibnd, ip, is, js, ijs
IF (noncolin) THEN
allocate (ps_nc(nbnd,npol))
allocate (ps_nc(nbnd,npol))
ELSE
allocate (ps(nbnd))
allocate (ps(nbnd))
END IF
ijkb0 = 0
......@@ -78,7 +78,7 @@ subroutine adddvepsi_us(becp2,ipol,kpoint)
ELSE
ps(ibnd) = ps(ibnd)+qq(ih,jh,nt)*becp2%k(jkb,ibnd) &
*(0.d0,1.d0) + &
dpqq(ih,jh,ipol,nt)* becp1(kpoint)%k(jkb,ibnd)
dpqq(ih,jh,ipol,nt)* becp1(kpoint)%k(jkb,ibnd)
END IF
enddo
enddo
......@@ -104,7 +104,7 @@ subroutine adddvepsi_us(becp2,ipol,kpoint)
ELSE
deallocate(ps)
END IF
RETURN
END SUBROUTINE adddvepsi_us
......@@ -17,7 +17,7 @@ subroutine adddvscf (ipert, ik)
!
USE kinds, ONLY : DP
USE uspp_param, ONLY : upf, nh
USE uspp_param, ONLY : upf, nh
USE uspp, ONLY : vkb, okvan
! modules from pwcom
USE lsda_mod, ONLY : lsda, current_spin, isk
......
......@@ -59,8 +59,8 @@ subroutine addnlcc (imode0, drhoscf, npe)
if (.not.nlcc_any) return
allocate (drhoc( nrxx))
allocate (dvaux( nrxx , nspin_mag))
allocate (drhoc( nrxx))
allocate (dvaux( nrxx , nspin_mag))
dyn1 (:,:) = (0.d0, 0.d0)
!
......@@ -98,8 +98,8 @@ subroutine addnlcc (imode0, drhoscf, npe)
!
if ( dft_is_gradient() ) &
call dgradcorr (rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, &
drhoscf (1, 1, ipert), nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, &
nspin_mag, nspin_gga, nl, ngm, g, alat, dvaux)
drhoscf (1, 1, ipert), nrxx, nspin_mag, nspin_gga, nl, ngm, g, alat,&
dvaux)
do is = 1, nspin_lsda
call daxpy (2 * nrxx, - fac, drhoc, 1, drhoscf (1, is, ipert), 1)
enddo
......@@ -125,7 +125,7 @@ subroutine addnlcc (imode0, drhoscf, npe)
!
call mp_sum ( dyn1, intra_pool_comm )
#endif
dyn (:,:) = dyn(:,:) + dyn1(:,:)
dyn (:,:) = dyn(:,:) + dyn1(:,:)
dyn_rec(:,:)=dyn_rec(:,:)+dyn1(:,:)
deallocate (dvaux)
deallocate (drhoc)
......
......@@ -4,10 +4,10 @@
! 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 addnlcc_zstar_eu_us( drhoscf )
SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
!----------===================-------------------
USE kinds, ONLY : DP
......@@ -26,10 +26,10 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
USE gc_ph, ONLY: grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s
USE mp_global, ONLY : my_pool_id
IMPLICIT NONE
COMPLEX(DP) :: drhoscf (nrxx,nspin,3)
......@@ -37,7 +37,7 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
INTEGER :: imode0, npe, ipol
REAL(DP) :: fac
COMPLEX(DP), DIMENSION(nrxx) :: drhoc
COMPLEX(DP), DIMENSION(nrxx,nspin) :: dvaux
......@@ -56,10 +56,10 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
fac = 1.d0 / DBLE (nspin_lsda)
DO ipert = 1, npe
mode = imode0 + ipert
dvaux = (0.0_dp,0.0_dp)
CALL addcore (mode, drhoc)
DO is = 1, nspin_lsda
rho%of_r(:,is) = rho%of_r(:,is) + fac * rho_core
END DO
......@@ -79,18 +79,18 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
!
IF ( dft_is_gradient() ) &
CALL dgradcorr (rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, &
xq, drhoscf (1, 1, ipert), nr1, nr2, nr3, nrx1, nrx2, &
nrx3, nrxx, nspin, nspin_gga, nl, ngm, g, alat, dvaux)
CALL dgradcorr (rho%of_r, grho, &
dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, drhoscf (1,1,ipert),&
nrxx, nspin, nspin_gga, nl, ngm, g, alat, dvaux)
DO is = 1, nspin_lsda
rho%of_r(:,is) = rho%of_r(:,is) - fac * rho_core
END DO
DO is = 1, nspin_lsda
zstareu0(ipol,mode) = zstareu0(ipol,mode) - &
omega * fac / REAL(nrtot, DP) * &
DOT_PRODUCT(dvaux(1:nrxx,is),drhoc(1:nrxx))
DOT_PRODUCT(dvaux(1:nrxx,is),drhoc(1:nrxx))
END DO
END DO
imode0 = imode0 + npe
......
......@@ -10,7 +10,7 @@
subroutine addusdbec (ik, wgt, psi, dbecsum)
!----------------------------------------------------------------------
!
! This routine adds to dbecsum the contribution of this
! This routine adds to dbecsum the contribution of this
! k point. It implements Eq. B15 of PRB 64, 235118 (2001).
!
USE kinds, only : DP
......@@ -57,7 +57,7 @@ subroutine addusdbec (ik, wgt, psi, dbecsum)
call start_clock ('addusdbec')
allocate (dbecq( nkb, nbnd))
allocate (dbecq( nkb, nbnd))
ikk = ikks(ik)
!
! First compute the product of psi and vkb
......
......@@ -60,7 +60,7 @@ subroutine addusdbec_nc (ik, wgt, psi, dbecsum_nc)
if (.not.okvan) return
call start_clock ('addusdbec_nc')
allocate (dbecq_nc( nkb,npol, nbnd))
allocate (dbecq_nc( nkb,npol, nbnd))
ikk = ikks(ik)
!
! First compute the product of psi and vkb
......
......@@ -16,18 +16,20 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
! change of the becsum term. It calculates Eq. B31 of Ref [1].
! If called from drho (iflag=1), dbecsum and drhoscf contain the
! orthogonalization contribution to the change of the wavefunctions
! and the terms with alphasum and becsum are added. If called
! from solve_* (iflag=0) drhoscf and dbecsum contain the contribution
! and the terms with alphasum and becsum are added. If called
! from solve_* (iflag=0) drhoscf and dbecsum contain the contribution
! of the solution of the linear system and the terms due to alphasum
! and becsum are not added. In this case the change of the charge
! calculated by drho (called \Delta \rho in [1]) is read from file
! and added. The contribution of the change of
! and becsum are not added. In this case the change of the charge
! calculated by drho (called \Delta \rho in [1]) is read from file
! and added. The contribution of the change of
! the Fermi energy is not calculated here but added later by ef_shift.
! [1] PRB 64, 235118 (2001).
!
!
USE kinds, only : DP
USE gvect, ONLY : gg, ngm, nrxx, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
use fft_base, only: dfftp
use fft_interfaces, only: invfft
USE gvect, ONLY : gg, ngm, nrxx, &
nl, g, eigts1, eigts2, eigts3, ig1, ig2, ig3
USE uspp, ONLY : okvan, becsum
USE cell_base, ONLY : tpiba
......@@ -89,12 +91,12 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
if (.not.okvan) return
call start_clock ('addusddens')
allocate (aux( ngm , nspin_mag , npe))
allocate (sk ( ngm))
allocate (ylmk0(ngm , lmaxq * lmaxq))
allocate (qgm( ngm))
allocate (qmod( ngm))
if (.not.lgamma) allocate (qpg( 3 , ngm))
allocate (aux( ngm , nspin_mag , npe))
allocate (sk ( ngm))
allocate (ylmk0(ngm , lmaxq * lmaxq))
allocate (qgm( ngm))
allocate (qmod( ngm))
if (.not.lgamma) allocate (qpg( 3 , ngm))
! WRITE( stdout,*) aux, ylmk0, qmod
!
! And then we compute the additional charge in reciprocal space
......@@ -187,7 +189,7 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
do ig = 1, ngm
psic (nl (ig) ) = aux (ig, is, ipert)
enddo
call cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
call daxpy (2*nrxx, 1.0_DP, psic, 1, drhoscf(1,is,ipert), 1)
enddo
enddo
......@@ -199,7 +201,7 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
deallocate (aux)
if (iflag == 0) then
allocate (drhous( nrxx, nspin_mag))
allocate (drhous( nrxx, nspin_mag))
do ipert = 1, npe
mu = mode0 + ipert
call davcio (drhous, lrdrhous, iudrhous, mu, -1)
......
......@@ -11,17 +11,19 @@ subroutine addusddense (drhoscf, dbecsum)
!----------------------------------------------------------------------
!
! This routine adds to the change of the charge and magnetization
! densities due to an electric field perturbation
! densities due to an electric field perturbation
! the part due to the US augmentation.
! It assumes that the array dbecsum has already accumulated the
! change of the becsum term.
! change of the becsum term.
! The expression implemented is given in Eq. B32 of PRB 64, 235118
! (2001) with b=c=0.
!
USE kinds, only : DP
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE gvect, ONLY : nrxx, nrx1, nrx2, nrx3, nr1, nr2, nr3, nl, g, gg, &
use fft_base, only: dfftp
use fft_interfaces, only: invfft
USE gvect, ONLY : nrxx, nl, g, gg, &
ngm, eigts1, eigts2, eigts3, ig1, ig2, ig3
USE uspp, ONLY: okvan
USE uspp_param, ONLY: upf, lmaxq, nh, nhm
......@@ -60,12 +62,12 @@ subroutine addusddense (drhoscf, dbecsum)
if (.not.okvan) return
call start_clock ('addusddense')
allocate (aux( ngm, nspin_mag, 3))
allocate (sk ( ngm))
allocate (qg ( nrxx))
allocate (ylmk0(ngm , lmaxq * lmaxq))
allocate (qgm (ngm))
allocate (qmod (ngm))
allocate (aux( ngm, nspin_mag, 3))
allocate (sk ( ngm))
allocate (qg ( nrxx))
allocate (ylmk0(ngm , lmaxq * lmaxq))
allocate (qgm (ngm))
allocate (qmod (ngm))
!
! And then we compute the additional charge in reciprocal space
......@@ -114,7 +116,7 @@ subroutine addusddense (drhoscf, dbecsum)
do ipert = 1, 3
qg (:) = (0.d0, 0.d0)
qg (nl (:) ) = aux (:, is, ipert)
call cft3 (qg, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', qg, dfftp)
drhoscf(:,is,ipert) = drhoscf(:,is,ipert) + 2.d0*qg(:)
enddo
enddo
......
......@@ -75,8 +75,8 @@ subroutine addusdynmat (dynwrk)
DO is2=1,npol
ijs=ijs+1
dynwrk(nu_i, nu_j)=dynwrk(nu_i, nu_j) + &
int4_nc(ih,jh,ipol,jpol,na,ijs) * &
becsum_nc(ijh,na,is1,is2)
int4_nc(ih,jh,ipol,jpol,na,ijs) * &
becsum_nc(ijh,na,is1,is2)
IF (ih.NE.jh) THEN
dynwrk(nu_i, nu_j)=dynwrk(nu_i, nu_j) + &
int4_nc(jh,ih,ipol,jpol,na,ijs) * &
......
......@@ -16,7 +16,9 @@ subroutine addusldos (ldos, becsum1)
!
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE gvect, ONLY : nrxx, nrx1, nrx2, nrx3, nr1, nr2, nr3, nl, &
use fft_base, only: dfftp
use fft_interfaces, only: invfft
USE gvect, ONLY : nrxx, nl, &
eigts1, eigts2, eigts3, ig1, ig2, ig3, gg, g, ngm
USE wavefunctions_module, ONLY: psic
USE uspp, ONLY: okvan
......@@ -42,8 +44,8 @@ subroutine addusldos (ldos, becsum1)
complex(DP), allocatable :: aux (:,:), qgm (:)
! work space
allocate (aux ( ngm , nspin_mag))
allocate (ylmk0(ngm , lmaxq * lmaxq))
allocate (aux ( ngm , nspin_mag))
allocate (ylmk0(ngm , lmaxq * lmaxq))
allocate (qgm ( ngm))
allocate (qmod( ngm))
......@@ -88,7 +90,7 @@ subroutine addusldos (ldos, becsum1)
do ig = 1, ngm
psic (nl (ig) ) = aux (ig, is)
enddo
call cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
call daxpy (nrxx, 1.d0, psic, 2, ldos(1,is), 2 )
enddo
endif
......
......@@ -6,7 +6,7 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
!-----------------------------------------------------------------------
subroutine allocate_part ( nat )
subroutine allocate_part ( nat )
!-----------------------------------------------------------------------
!
! dynamical allocation of arrays for the control of partial computation
......@@ -18,9 +18,9 @@ subroutine allocate_part ( nat )
!
! allocate space for several arrays which control the run
!
allocate (comp_irr ( 0:3 * nat))
allocate (done_irr ( 0:3 * nat))
allocate (list ( 3 * nat))
allocate (comp_irr ( 0:3 * nat))
allocate (done_irr ( 0:3 * nat))
allocate (list ( 3 * nat))
allocate (atomo ( nat))
list(:) = 0
atomo(:) = 0
......
......@@ -10,7 +10,7 @@
subroutine allocate_pert()
!-----------------------------------------------------------------------
!
! dynamical allocation of arrays: quantities depending on the
! dynamical allocation of arrays: quantities depending on the
! maximum number of perturbations npertx
!
USE ions_base, ONLY : nat
......@@ -22,8 +22,8 @@ subroutine allocate_pert()
! 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 ) )
ALLOCATE ( t ( npertx, npertx, 48, 3 * nat ) )
ALLOCATE ( tmq ( npertx, npertx, 3 * nat ) )
RETURN
END SUBROUTINE allocate_pert
......@@ -32,7 +32,7 @@ END SUBROUTINE allocate_pert
subroutine deallocate_pert()
!-----------------------------------------------------------------------
!
! dynamical allocation of arrays: quantities depending on the
! dynamical allocation of arrays: quantities depending on the
! maximum number of perturbations npertx
!
USE modes, ONLY : t, tmq
......@@ -42,8 +42,8 @@ subroutine deallocate_pert()
! allocate space for the quantities with dimensions that depend
! on the maximum number of perturbations
!
IF (ASSOCIATED(t)) DEALLOCATE ( t )
IF (ASSOCIATED(tmq)) DEALLOCATE ( tmq )
IF (ASSOCIATED(t)) DEALLOCATE ( t )
IF (ASSOCIATED(tmq)) DEALLOCATE ( tmq )
RETURN
END SUBROUTINE deallocate_pert
......@@ -58,60 +58,60 @@ subroutine allocate_phq
!
! q!=0 : evq, igkq are allocated and calculated at point k+q
!
allocate (evq ( npwx*npol , nbnd))
allocate (igkq ( npwx))
allocate (evq ( npwx*npol , nbnd))
allocate (igkq ( npwx))
endif
!
allocate (dvpsi ( npwx*npol , nbnd))
allocate ( dpsi ( npwx*npol , nbnd))
allocate (dvpsi ( npwx*npol , nbnd))
allocate ( dpsi ( npwx*npol , nbnd))
!
allocate (vlocq ( ngm , ntyp))
allocate (dmuxc ( nrxx , nspin_mag , nspin_mag))
allocate (vlocq ( ngm , ntyp))
allocate (dmuxc ( nrxx , nspin_mag , nspin_mag))
allocate (eprec ( nbnd, nksq) )
!
allocate (eigqts ( nat))
allocate (rtau ( 3, 48, nat))
allocate (u ( 3 * nat, 3 * nat))
allocate (ubar ( 3 * nat))
allocate (dyn ( 3 * nat, 3 * nat))
allocate (dyn_rec ( 3 * nat