Skip to content

GitLab

Commit 63d77a0e authored by Marco Govoni's avatar Marco Govoni
Browse files

kWest first draft by Matteo Gerosa.

parent f08f89dc
Hide whitespace changes
Inline Side-by-side
Coulomb_kernel/Makefile
View file @ 63d77a0e
......@@ -5,6 +5,8 @@ include ../../make.inc
# location of needed modules
MODFLAGS= $(MOD_FLAG)../../iotk/src $(MOD_FLAG)../../Modules $(MOD_FLAG)../../LAXlib \
$(MOD_FLAG)../../FFTXlib $(MOD_FLAG)../../PW/src \
$(MOD_FLAG)../Modules \
$(MOD_FLAG)../Tools \
$(MOD_FLAG).
IFLAGS=
......@@ -14,6 +16,7 @@ store_sqvc.o
PWOBJS = ../../PW/src/libpw.a
QEMODS = ../../Modules/libqemod.a ../../FFTXlib/libqefft.a ../../LAXlib/libqela.a
WESTLIBS = ../Tools/libtools.a
TLDEPS= bindir mods libs pw
......
Coulomb_kernel/make.depend
View file @ 63d77a0e
......@@ -3,8 +3,11 @@ store_sqvc.o : ../../Modules/constants.o
store_sqvc.o : ../../Modules/io_global.o
store_sqvc.o : ../../Modules/kind.o
store_sqvc.o : ../../Modules/recvec.o
store_sqvc.o : ../Tools/class_bz_grid.o
store_sqvc.o : ../Tools/types_bz_grid.o
store_sqvc.o : ../../PW/src/exx.o
store_sqvc.o : ../../PW/src/pwcom.o
store_sqvc.o : ../../West/Modules/westcom.o
store_vspx.o : ../../Modules/cell_base.o
store_vspx.o : ../../Modules/constants.o
store_vspx.o : ../../Modules/kind.o
......
Coulomb_kernel/store_sqvc.f90
View file @ 63d77a0e
......@@ -11,11 +11,12 @@
! Marco Govoni
!
!-----------------------------------------------------------------------
SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div,printout_div)
!-----------------------------------------------------------------------
!
! This routine computes results of applying sqVc to a potential
! associated with vector q. Coulomb cutoff technique can be used
! Used for gamma_only case
!
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
......@@ -27,9 +28,11 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
USE mp, ONLY : mp_sum
USE mp_global, ONLY : intra_bgrp_comm
USE mp_world, ONLY : mpime,world_comm,nproc
USE gvecw, ONLY : ecutwfc
USE gvecw, ONLY : ecutwfc, gcutw
USE control_flags, ONLY : gamma_only
USE random_numbers, ONLY : randy
USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
!
......@@ -39,6 +42,7 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
REAL(DP),INTENT(OUT) :: sqvc_tmp(numg)
INTEGER,INTENT(IN) :: singularity_removal_mode
REAL(DP),INTENT(OUT) :: div
LOGICAL,INTENT(IN) :: printout_div
!
! Workspace
!
......@@ -46,7 +50,9 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
INTEGER :: ig, ipol, iq1, iq2, iq3, i1, i2, i3
LOGICAL :: on_double_grid
REAL(DP),PARAMETER :: eps=1.d-6
REAL(DP),PARAMETER :: eps_qdiv=1.d-8
REAL(DP) :: grid_factor = 8.d0/7.d0
! REAL(DP) :: grid_factor = 1.0_DP
TYPE(vcut_type) :: vcut
LOGICAL :: try_ort_div=.TRUE.,i_am_ort
REAL(DP) :: prod(3,3), qhelp, edge(3), qbz(3), rand, qmo, vbz, vhelp
......@@ -54,6 +60,16 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
!
CALL start_clock('storesqvc')
!
IF ( gamma_only ) THEN
nq(1)=1._DP
nq(2)=1._DP
nq(3)=1._DP
ELSE
nq(1) = REAL( q_grid%np1, KIND=DP )
nq(2) = REAL( q_grid%np2, KIND=DP )
nq(3) = REAL( q_grid%np3, KIND=DP )
ENDIF
!
! ======
! BODY
! ======
......@@ -74,9 +90,6 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
!
! In this case we use Gygi-Baldereschi method
!
nq(1)=1._DP
nq(2)=1._DP
nq(3)=1._DP
!
sqvc_tmp(1)=0._DP
DO ig = gstart,numg
......@@ -98,10 +111,6 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
!
! In this case we use CUT_WS
!
!
nq(1)=1._DP
nq(2)=1._DP
nq(3)=1._DP
ecutvcut = 0.7_DP
!
! build the superperiodicity direct lattice
......@@ -136,8 +145,9 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
!
! In this case we use the spherical region
!
div = ( (6._DP * pi * pi / omega )**(1._DP/3._DP) ) / ( 2._DP * pi * pi ) * fpi * e2
WRITE(stdout,"(5X,'Spherical div = ',es14.6)") div
div = ( (6._DP * pi * pi / ( omega*nq(1)*nq(2)*nq(3) ) )**(1._DP/3._DP) ) / ( 2._DP * pi * pi ) * fpi * e2
!
IF ( printout_div ) WRITE(stdout,"(5X,'Spherical div = ',es14.6)") div
!
IF( try_ort_div ) THEN
!
......@@ -157,7 +167,7 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
DO i2 = 1, 3
IF( i1 == i2 ) CYCLE
IF( ABS( prod(i1,i2)) > 1.d-8 ) THEN
WRITE(stdout,"(5X,'Warning: non orthorombic RL')")
IF ( printout_div ) WRITE(stdout,"(5X,'Warning: non orthorombic RL')")
i_am_ort = .FALSE.
ENDIF
ENDDO
......@@ -168,9 +178,10 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
edge(1) = SQRT(prod(1,1)) / 2._DP
edge(2) = SQRT(prod(2,2)) / 2._DP
edge(3) = SQRT(prod(3,3)) / 2._DP
edge(:) = edge(:) / nq(:)
!
qhelp = MIN( edge(1),edge(2),edge(3) )
vbz = tpi**3 / omega
vbz = tpi**3 / ( omega*nq(1)*nq(2)*nq(3) )
vhelp = fpi / 3._DP * qhelp**3
!
rand=randy(mpime)
......@@ -196,7 +207,7 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
div = div / REAL(nproc,KIND=DP)
CALL mp_sum(div,world_comm)
!
WRITE(stdout,"(5X,'Orthorombic div = ',es14.6)") div
IF ( printout_div ) WRITE(stdout,"(5X,'Orthorombic div = ',es14.6)") div
!
ENDIF
!
......@@ -208,22 +219,19 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
!
alpha = 10._DP / ecutwfc
!
nq(1)=1._DP
nq(2)=1._DP
nq(3)=1._DP
!
dq(1)=1._DP/nq(1)
dq(2)=1._DP/nq(2)
dq(3)=1._DP/nq(3)
!
div = 0._DP
!
DO iq1=1,1,INT(nq(1))
DO iq2=1,1,INT(nq(2))
DO iq3=1,1,INT(nq(3))
DO iq1=1,INT(nq(1))
DO iq2=1,INT(nq(2))
DO iq3=1,INT(nq(3))
xq(:) = bg(:,1)*(iq1-1)*dq(1) + bg(:,2)*(iq2-1)*dq(2) + bg(:,3)*(iq3-1)*dq(3)
!
DO ig = gstart,numg
!DO ig = gstart,numg
DO ig = 1,numg
q(:) = g(:,ig) + xq(:)
gnorm2 = SUM(q(:)**2) * tpiba2
on_double_grid = .TRUE.
......@@ -231,7 +239,7 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
x = 0.5_DP*( q(1)*at(1,ipol)+q(2)*at(2,ipol)+q(3)*at(3,ipol) )*nq(ipol)
on_double_grid = on_double_grid .AND. (ABS(x-NINT(x))<eps)
ENDDO
IF(.NOT.on_double_grid) THEN
IF( .NOT.on_double_grid .AND. gnorm2 > eps_qdiv ) THEN
div = div - EXP( -alpha * gnorm2 ) / gnorm2
ENDIF
ENDDO
......@@ -245,10 +253,10 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
IF( gamma_only ) THEN
div = div * grid_factor * e2 * fpi / omega * 2._DP
ELSE
div = div * grid_factor * e2 * fpi / omega
div = div * grid_factor * e2 * fpi / (omega* nq(1)*nq(2)*nq(3))
ENDIF
!
div = div + nq(1)*nq(2)*nq(3) * e2 / SQRT( alpha * pi )
div = div + e2 / SQRT( alpha * pi )
!
CASE(3)
!
......@@ -262,10 +270,155 @@ SUBROUTINE store_sqvc(sqvc_tmp,numg,singularity_removal_mode,div)
!
END SUBROUTINE
!
!------------------------------------------------------------------
!
!
!---------------------------------------------------------------------------------
SUBROUTINE store_sqvc_q(sqvc_tmp,numg,singularity_removal_mode,iq,l_use_igq)
!-------------------------------------------------------------------------------
!
! This routine computes results of applying sqVc to a potential
! associated with vector q.
!
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE constants, ONLY : fpi, e2, tpi, pi
USE cell_base, ONLY : tpiba2,tpiba,omega,at,alat,bg
USE gvect, ONLY : g, gstart
USE mp, ONLY : mp_sum
USE mp_global, ONLY : intra_bgrp_comm
USE mp_world, ONLY : mpime,world_comm,nproc
USE gvecw, ONLY : ecutwfc
USE gvect, ONLY : g, gstart
USE westcom, ONLY : igq_q
USE coulomb_vcut_module, ONLY : vcut_init, vcut_type, vcut_info, &
vcut_get, vcut_spheric_get, vcut_destroy
USE random_numbers, ONLY : randy
USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
!
! I/O
!
INTEGER, INTENT(IN) :: numg
REAL(DP), INTENT(OUT) :: sqvc_tmp(numg)
INTEGER, INTENT(IN) :: singularity_removal_mode
INTEGER, INTENT(IN) :: iq
LOGICAL, INTENT(IN) :: l_use_igq
!
! Workspace
!
REAL(DP) :: gnorm2,nq(3),q(3),qq(3),ecutvcut,atws(3,3),alpha,x
INTEGER :: ig, ipol, i1, i2, i3
LOGICAL :: on_double_grid
REAL(DP),PARAMETER :: eps=1.d-6
REAL(DP), PARAMETER :: eps_qdiv = 1.d-8
REAL(DP) :: grid_factor = 8.d0/7.d0
! REAL(DP) :: grid_factor = 1.0_DP
TYPE(vcut_type) :: vcut
LOGICAL :: try_ort_div=.TRUE.,i_am_ort
REAL(DP) :: prod(3,3), qhelp, edge(3), qbz(3), rand, qmo, vbz, vhelp
REAL(DP) :: intcounter
!
CALL start_clock( 'storesqvcq' )
!
nq(1) = REAL( q_grid%np1, KIND=DP )
nq(2) = REAL( q_grid%np2, KIND=DP )
nq(3) = REAL( q_grid%np3, KIND=DP )
!
q(:) = q_grid%xp_cart(:,iq)
!
! =======
! BODY
! =======
!
SELECT CASE(singularity_removal_mode)
!
CASE(1)
!
! In this case we use the spherical region
!
DO ig = 1,numg
IF (l_use_igq) THEN
qq(:) = q(:) + g(:,igq_q(ig,iq))
ELSE
qq(:) = q(:) + g(:,ig)
ENDIF
gnorm2 = SUM(qq(:)**2) * tpiba2
IF ( gnorm2 < eps_qdiv ) THEN
sqvc_tmp(ig) = 0._DP
ELSE
sqvc_tmp(ig) = SQRT(e2*fpi/gnorm2)
ENDIF
ENDDO
!
CASE(2)
!
! In this case we use Gygi-Baldereschi method
!
DO ig = 1,numg
IF (l_use_igq) THEN
qq(:) = q(:) + g(:,igq_q(ig,iq))
ELSE
qq(:) = q(:) + g(:,ig)
ENDIF
gnorm2 = SUM(qq(:)**2) * tpiba2
on_double_grid = .TRUE.
DO ipol = 1,3
x = 0.5_DP*( qq(1)*at(1,ipol)+qq(2)*at(2,ipol)+qq(3)*at(3,ipol) )*nq(ipol)
on_double_grid = on_double_grid .AND. (ABS(x-NINT(x))<eps)
ENDDO
IF( on_double_grid .OR. gnorm2 < eps_qdiv ) THEN
sqvc_tmp(ig)=0._DP
ELSE
sqvc_tmp(ig)=SQRT(e2*fpi*grid_factor/gnorm2)
ENDIF
ENDDO
!
CASE(3)
!
! In this case we use CUT_WS
!
!
ecutvcut = 0.7_DP
!
! build the superperiodicity direct lattice
!
atws = alat * at
!
DO ipol=1,3
atws(:,ipol) = atws(:,ipol) * nq(ipol)
ENDDO
!
CALL vcut_init( vcut, atws, ecutvcut )
!
DO ig = 1,numg
!
IF (l_use_igq) THEN
qq(:) = (q(:) + g(:,igq_q(ig,iq))) * tpiba
ELSE
qq(:) = (q(:) + g(:,ig)) * tpiba
ENDIF
!
sqvc_tmp( ig ) = DSQRT( vcut_get(vcut,qq) )
!
ENDDO
!
CALL vcut_destroy(vcut)
!
END SELECT
!
CALL stop_clock( 'storesqvcq' )
!
END SUBROUTINE
!
!
!
!----------------------------------------------------------------------------
SUBROUTINE store_vcspecial_H(vc_tmp,numg)
!----------------------------------------------------------------------------
!
! vcspecail_H
! vcspecial_H
!
USE kinds, ONLY : DP
USE cell_base, ONLY : tpiba, at,omega
......
DFPT_kernel/dfpt.f90
View file @ 63d77a0e
......@@ -36,7 +36,7 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
USE io_files, ONLY : tmp_dir, nwordwfc, iunwfc, diropn
USE uspp, ONLY : nkb, vkb, okvan
USE constants, ONLY : e2,fpi
USE westcom, ONLY : npwq0,sqvc,nbnd_occ,iuwfc,lrwfc,npwq0x,fftdriver
USE westcom, ONLY : npwq,sqvc,nbnd_occ,iuwfc,lrwfc,npwqx,fftdriver
USE io_push, ONLY : io_push_title
USE mp_world, ONLY : mpime,world_comm
!
......@@ -45,8 +45,8 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
! I/O
!
INTEGER,INTENT(IN) :: m
COMPLEX(DP),INTENT(IN) :: dvg(npwq0x,m)
COMPLEX(DP),INTENT(OUT) :: dng(npwq0x,m)
COMPLEX(DP),INTENT(IN) :: dvg(npwqx,m)
COMPLEX(DP),INTENT(OUT) :: dng(npwqx,m)
REAL(DP),INTENT(IN) :: tr2
!
! Workspace
......@@ -85,7 +85,6 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
dng=0.0_DP
!
CALL start_bar_type( barra, 'dfpt', MAX(m,1) * nks )
!
!IF(nks>1) CALL diropn(iuwfc,'wfc',lrwfc,exst)
!
DO iks = 1, nks ! KPOINT-SPIN LOOP
......@@ -143,20 +142,20 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
!
DO ipert = 1, m
!
ALLOCATE(aux_g(npwq0x))
ALLOCATE(aux_g(npwqx))
ALLOCATE(aux_r(dffts%nnr))
!
aux_g = 0._DP
aux_r = 0._DP
!
DO ig = 1, npwq0 ! perturbation acts only on body
DO ig = 1, npwq ! perturbation acts only on body
aux_g(ig) = dvg(ig,ipert) * sqvc(ig)
ENDDO
!
IF(gamma_only) THEN
CALL single_invfft_gamma(dffts,npwq0,npwq0x,aux_g,aux_r,TRIM(fftdriver))
CALL single_invfft_gamma(dffts,npwq,npwqx,aux_g,aux_r,TRIM(fftdriver))
ELSE
CALL single_invfft_k(dffts,npwq0,npwq0x,aux_g,aux_r,TRIM(fftdriver)) ! no igk
CALL single_invfft_k(dffts,npwq,npwqx,aux_g,aux_r,TRIM(fftdriver)) ! no igk
ENDIF
!
! The perturbation is in aux_r
......@@ -283,14 +282,14 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
!
! The perturbation is in aux_r
!
ALLOCATE(aux_g(npwq0x))
ALLOCATE(aux_g(npwqx))
IF(gamma_only) THEN
CALL single_fwfft_gamma(dffts,npwq0,npwq0x,aux_r,aux_g,TRIM(fftdriver))
CALL single_fwfft_gamma(dffts,npwq,npwqx,aux_r,aux_g,TRIM(fftdriver))
ELSE
CALL single_fwfft_k(dffts,npwq0,npwq0x,aux_r,aux_g,TRIM(fftdriver)) ! no igk
CALL single_fwfft_k(dffts,npwq,npwqx,aux_r,aux_g,TRIM(fftdriver)) ! no igk
ENDIF
!
DO ig=1,npwq0 ! pert acts only on body
DO ig=1,npwq ! pert acts only on body
dng(ig,ipert) = dng(ig,ipert) + 2._DP * wk(iks) * aux_g(ig) * sqvc(ig) / omega
ENDDO
!
......@@ -327,3 +326,323 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
!ENDIF
!
END SUBROUTINE
!
!
!-------------------------------------------------------------------------
SUBROUTINE dfpt_q (m,dvg,dng,tr2,iq)
!-----------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE io_global, ONLY : stdout
USE wvfct, ONLY : nbnd,g2kin,et
USE fft_base, ONLY : dfftp,dffts
USE gvect, ONLY : nl,nl,gstart,ig_l2g,g,ngm
USE wavefunctions_module, ONLY : evc,psic
USE gvecs, ONLY : ngms,nls
USE gvecw, ONLY : gcutw
USE mp, ONLY : mp_sum,mp_barrier,mp_bcast
USE mp_global, ONLY : inter_image_comm,inter_pool_comm,my_image_id
USE mp_bands, ONLY : me_bgrp
USE fft_at_k, ONLY : single_fwfft_k,single_invfft_k
USE fft_interfaces, ONLY : fwfft, invfft
USE buffers, ONLY : get_buffer
USE noncollin_module, ONLY : noncolin,npol
USE bar, ONLY : bar_type,start_bar_type,update_bar_type,stop_bar_type
USE pwcom, ONLY : current_spin,wk,nks,nelup,neldw,isk,xk,npw,npwx,lsda,nkstot,&
& current_k,ngk,igk_k
USE cell_base, ONLY : tpiba2,omega,at
USE control_flags, ONLY : gamma_only, io_level
USE io_files, ONLY : tmp_dir, nwordwfc, iunwfc, diropn
USE uspp, ONLY : nkb, vkb, okvan
USE westcom, ONLY : sqvc,nbnd_occ,iuwfc,lrwfc,l_gammaq,npwqx,npwq,igq_q
USE io_push, ONLY : io_push_title
USE mp_world, ONLY : mpime,world_comm
USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : kmq_grid
!
IMPLICIT NONE
!
! I/O
!
INTEGER, INTENT(IN) :: iq
INTEGER, INTENT(IN) :: m
COMPLEX(DP), INTENT(IN) :: dvg(npwqx,m)
COMPLEX(DP), INTENT(OUT) :: dng(npwqx,m)
REAL(DP),INTENT(IN) :: tr2
!
! Workspace
!
INTEGER :: ipert, ig, ir, ibnd, iks, ikqs
! Counter on perturbations
! Counter on plane waves
! Counter on real space grids
! Counter on bands
! Counter on k-points
! Counter on (k-q)-points
INTEGER :: i, j, k
! Counter on real space grid
INTEGER :: nbndval, ierr
! Current k-q point
INTEGER :: npwkq
!
REAL(DP) :: anorm, prod
REAL(DP), ALLOCATABLE :: eprec(:)
! Preconditioning matrix
!
COMPLEX(DP), ALLOCATABLE :: dvpsi(:,:),dpsi(:,:)
COMPLEX(DP), ALLOCATABLE :: aux_r(:),aux_g(:)
COMPLEX(DP), ALLOCATABLE :: dpsic(:)
!
COMPLEX(DP), ALLOCATABLE :: evckmq(:,:)
COMPLEX(DP), ALLOCATABLE :: phase(:)
!
TYPE(bar_type) :: barra
!
LOGICAL :: conv_dfpt
LOGICAL :: exst,exst_mem
LOGICAL :: l_dost
!
CHARACTER(LEN=512) :: title
!
CALL mp_barrier( world_comm )
!
CALL report_dynamical_memory( )
!
l_dost = ( tr2 >= 0._DP )
!
IF( l_dost ) THEN
WRITE(title,'(a,es14.6)') "Sternheimer eq. solver... with threshold = ", tr2
ELSE
WRITE(title,'(a,es14.6)') "Sternheimer eq. solver... with lite-solver"
ENDIF
CALL io_push_title(TRIM(ADJUSTL(title)))
!
dng=0.0_DP
!
CALL start_bar_type( barra, 'dfpt_q', MAX(m,1) * nks )
!
ALLOCATE( evckmq(npwx*npol,nbnd) )
ALLOCATE( phase(dffts%nnr) )
!
DO iks = 1, nks ! KPOINT-SPIN LOOP
!
current_k = iks
!
ikqs = kmq_grid%index_kq(iks,iq)
!
! computes the phase needed to bring the wavefunction at k-q
! to the equivalent [k-q] point in the first BZ
!
CALL kmq_grid%get_phase(iks,iq)
phase = kmq_grid%phase
!
IF ( lsda ) current_spin = isk(iks)
CALL g2_kin(iks)
!
!
nbndval = nbnd_occ(iks)
!
!
! Number of G vectors for planewave expansion of wavefunctions
! at k and k-q; max number over all processors defined by npwx
! for both (see set_psi_kmq)
!
npw = ngk(iks)
npwkq = ngk(ikqs)
!
! ... More stuff needed by the hamiltonian: nonlocal projectors
!
IF ( nkb > 0 ) CALL init_us_2( ngk(iks), igk_k(1,iks), xk(1,iks), vkb )
!
! Read wavefuctions at k in G space, for all bands,
! and store them in evc
!
IF ( my_image_id == 0 ) CALL get_buffer( evc, lrwfc, iuwfc, iks )
CALL mp_bcast( evc, 0, inter_image_comm )
!
! Set wavefunctions at [k-q] in G space, for all bands,
! and store them in evckmq
!
IF ( my_image_id == 0 ) CALL get_buffer( evckmq, lrwfc, iuwfc, ikqs )
CALL mp_bcast( evckmq, 0, inter_image_comm )
!
ALLOCATE(eprec(nbndval))
CALL set_eprec(nbndval,evc(1,1),eprec)
!
ALLOCATE(dvpsi(npwx*npol,nbndval))
ALLOCATE(dpsi(npwx*npol,nbndval))
!
DO ipert = 1, m
!
ALLOCATE( aux_g(npwqx) )
ALLOCATE( aux_r(dffts%nnr) )
!