Commit cbe386bb authored by Matteo Gerosa's avatar Matteo Gerosa
Browse files

Completed coulomb class, all code made consistent with changes.

parent 415f03af
...@@ -23,9 +23,10 @@ MODULE class_coulomb ...@@ -23,9 +23,10 @@ MODULE class_coulomb
TYPE, PUBLIC :: coulomb TYPE, PUBLIC :: coulomb
! !
REAL(DP) :: div ! divergece REAL(DP) :: div ! divergece
CHARACTER(LEN=*) :: singularity_removal_mode ! singularity_removal_mode CHARACTER(LEN=7) :: singularity_removal_mode ! singularity_removal_mode
INTEGER :: iq ! q-point INTEGER :: iq ! q-point
REAL(DP),ALLOCATABLE :: sqvc(:) ! square root of Coulomb potential in PW REAL(DP),ALLOCATABLE :: sqvc(:) ! square root of Coulomb potential in PW
INTEGER :: numg, numgx
! !
CONTAINS CONTAINS
! !
...@@ -38,16 +39,17 @@ MODULE class_coulomb ...@@ -38,16 +39,17 @@ MODULE class_coulomb
CONTAINS CONTAINS
! !
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
SUBROUTINE sqvc_init(this,iq,singularity_removal_mode) SUBROUTINE sqvc_init(this,cdriver,singularity_removal_mode,iq)
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
! !
! This routine computes results of applying sqVc to a potential ! This routine computes results of applying sqVc to a potential
! associated with vector q. Coulomb cutoff technique can be used ! associated with vector q. Coulomb cutoff technique can be used
! !
USE kinds, ONLY : DP USE kinds, ONLY : DP
USE constants, ONLY : pi, tpi, fpi, e2, eps8 USE constants, ONLY : fpi, e2, eps8
USE cell_base, ONLY : alat, omega, at, bg, tpiba, tpiba2 USE cell_base, ONLY : at, tpiba2
USE gvect, ONLY : g USE gvect, ONLY : g
USE gvecs, ONLY : ngms
USE westcom, ONLY : igq_q,npwqx,npwq USE westcom, ONLY : igq_q,npwqx,npwq
USE types_bz_grid, ONLY : q_grid USE types_bz_grid, ONLY : q_grid
USE control_flags, ONLY : gamma_only USE control_flags, ONLY : gamma_only
...@@ -57,26 +59,46 @@ MODULE class_coulomb ...@@ -57,26 +59,46 @@ MODULE class_coulomb
! I/O ! I/O
! !
CLASS(coulomb) :: this CLASS(coulomb) :: this
CHARACTER(LEN=*), INTENT(IN) :: cdriver
CHARACTER(LEN=*), INTENT(IN) :: singularity_removal_mode CHARACTER(LEN=*), INTENT(IN) :: singularity_removal_mode
INTEGER, INTENT(IN) :: iq INTEGER, INTENT(IN), OPTIONAL :: iq
! !
! Workspace ! Workspace
! !
REAL(DP) :: qgnorm2,qg(3),x REAL(DP) :: qgnorm2,qg(3),x
INTEGER :: numg, numgx
INTEGER :: ig, ipol INTEGER :: ig, ipol
LOGICAL :: on_double_grid, l_print LOGICAL :: on_double_grid, l_print
REAL(DP) :: grid_factor REAL(DP) :: grid_factor
! !
CALL start_clock('storesqvc') CALL start_clock('sqvc_init')
!
SELECT CASE ( cdriver )
CASE ( 'Wave' )
this%numg = npwq
this%numgx = npwqx
CASE ( 'Smooth' )
this%numg = ngms
this%numgx = ngms
CASE DEFAULT
CALL errore("sqvc_init", "cdriver value not supported, supported only Wave and Smooth",1)
END SELECT
! !
IF( ALLOCATED(this%sqvc) ) DEALLOCATE( this%sqvc ) IF( ALLOCATED(this%sqvc) ) DEALLOCATE( this%sqvc )
ALLOCATE( this%sqvc( npwqx ) ) ALLOCATE( this%sqvc( this%numgx ) )
!
IF ( PRESENT(iq) ) THEN
this%iq = iq
ELSE
this%iq = 1 ! gamma-only
ENDIF
! !
this%iq = iq this%singularity_removal_mode = TRIM(singularity_removal_mode)
this%singularity_removal_mode = singularity_removal_mode IF (this%singularity_removal_mode /= "gb" .AND. this%singularity_removal_mode /= "default") &
& CALL errore( 'sqvc_init', 'singularity removal mode not supported, supported only default and gb', 1 )
! !
this%sqvc = 0._DP this%sqvc = 0._DP
DO ig = 1,npwq DO ig = 1,this%numg
! !
IF ( gamma_only ) THEN IF ( gamma_only ) THEN
qg(:) = g(:,ig) qg(:) = g(:,ig)
...@@ -109,32 +131,26 @@ MODULE class_coulomb ...@@ -109,32 +131,26 @@ MODULE class_coulomb
! !
ENDDO ENDDO
! !
this%div = this%compute_divergence() IF ( q_grid%l_pIsGamma(this%iq) ) this%div = this%compute_divergence()
! !
CALL stop_clock('storesqvc') CALL stop_clock('sqvc_init')
! !
END SUBROUTINE END SUBROUTINE
! !
SUBROUTINE print_divergence( this )
!
! I/O
!
CLASS(coulomb) :: this
!
WRITE(stdout,"(5X,'Divergence = ',es14.6)") div
!
END SUBROUTINE
!
! !
FUNCTION compute_divergence( this ) RESULT( div ) FUNCTION compute_divergence( this ) RESULT( div )
! !
USE io_global, ONLY : stdout USE constants, ONLY : pi, tpi, fpi, e2, eps8
USE cell_base, ONLY : omega, at, bg, tpiba2
USE mp, ONLY : mp_sum USE mp, ONLY : mp_sum
USE mp_global, ONLY : intra_bgrp_comm USE mp_global, ONLY : intra_bgrp_comm
USE mp_world, ONLY : mpime, world_comm, nproc USE mp_world, ONLY : mpime, world_comm, nproc
USE control_flags, ONLY : gamma_only USE control_flags, ONLY : gamma_only
USE gvecw, ONLY : ecutwfc USE gvecw, ONLY : ecutwfc
USE random_numbers, ONLY : randy USE random_numbers, ONLY : randy
USE gvect, ONLY : g
USE westcom, ONLY : ngq,igq_q
USE types_bz_grid, ONLY : q_grid
! !
! I/O ! I/O
! !
...@@ -149,13 +165,11 @@ MODULE class_coulomb ...@@ -149,13 +165,11 @@ MODULE class_coulomb
INTEGER :: i1, i2, i3, iq, ig, ipol INTEGER :: i1, i2, i3, iq, ig, ipol
REAL(DP) :: prod(3,3), qhelp, edge(3), qbz(3), rand, qmo, vbz, vhelp, intcounter, x REAL(DP) :: prod(3,3), qhelp, edge(3), qbz(3), rand, qmo, vbz, vhelp, intcounter, x
! !
div = 0 div = 0._DP
!
IF ( .NOT. q_grid%l_pIsGamma(this%iq) ) RETURN
! !
SELECT CASE( this%singularity_removal_mode ) SELECT CASE( this%singularity_removal_mode )
! !
CASE("spherical") CASE("default")
! !
! In this case we use the spherical region ! In this case we use the spherical region
! !
...@@ -238,8 +252,8 @@ MODULE class_coulomb ...@@ -238,8 +252,8 @@ MODULE class_coulomb
! !
DO iq = 1, q_grid%np DO iq = 1, q_grid%np
! !
DO ig = 1,ngq(iq) ! MATTEO CONTROLLA DO ig = 1,ngq(iq)
qg(:) = q_grid%p_cart(:,iq) + g(:,igq_q(ig,iq)) ! MATTEO CONTROLLA qg(:) = q_grid%p_cart(:,iq) + g(:,igq_q(ig,iq))
qgnorm2 = SUM( qg(:)**2 ) * tpiba2 qgnorm2 = SUM( qg(:)**2 ) * tpiba2
on_double_grid = .TRUE. on_double_grid = .TRUE.
DO ipol = 1,3 DO ipol = 1,3
...@@ -265,7 +279,22 @@ MODULE class_coulomb ...@@ -265,7 +279,22 @@ MODULE class_coulomb
! !
END SELECT END SELECT
! !
END SUBROUTINE END FUNCTION
!
!
SUBROUTINE print_divergence( this )
!
USE io_global, ONLY : stdout
USE types_bz_grid, ONLY : q_grid
!
! I/O
!
CLASS(coulomb) :: this
!
IF ( .NOT. q_grid%l_pIsGamma(this%iq) ) RETURN
WRITE(stdout,"(5X,'Divergence = ',es14.6)") this%div
!
END SUBROUTINE
! !
! !
! !
......
...@@ -8,6 +8,7 @@ MODFLAGS= $(MOD_FLAG)../../iotk/src $(MOD_FLAG)../../Modules $(MOD_FLAG)../../LA ...@@ -8,6 +8,7 @@ MODFLAGS= $(MOD_FLAG)../../iotk/src $(MOD_FLAG)../../Modules $(MOD_FLAG)../../LA
$(MOD_FLAG)../Modules \ $(MOD_FLAG)../Modules \
$(MOD_FLAG)../Tools \ $(MOD_FLAG)../Tools \
$(MOD_FLAG)../FFT_kernel \ $(MOD_FLAG)../FFT_kernel \
$(MOD_FLAG)../Coulomb_kernel \
$(MOD_FLAG). $(MOD_FLAG).
IFLAGS= IFLAGS=
......
...@@ -36,9 +36,10 @@ SUBROUTINE dfpt (m,dvg,dng,tr2) ...@@ -36,9 +36,10 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
USE io_files, ONLY : tmp_dir, nwordwfc, iunwfc, diropn USE io_files, ONLY : tmp_dir, nwordwfc, iunwfc, diropn
USE uspp, ONLY : nkb, vkb, okvan USE uspp, ONLY : nkb, vkb, okvan
USE constants, ONLY : e2,fpi USE constants, ONLY : e2,fpi
USE westcom, ONLY : npwq,sqvc,nbnd_occ,iuwfc,lrwfc,npwqx,fftdriver USE westcom, ONLY : npwq,nbnd_occ,iuwfc,lrwfc,npwqx,fftdriver
USE io_push, ONLY : io_push_title USE io_push, ONLY : io_push_title
USE mp_world, ONLY : mpime,world_comm USE mp_world, ONLY : mpime,world_comm
USE types_coulomb, ONLY : pot3D
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -149,7 +150,7 @@ SUBROUTINE dfpt (m,dvg,dng,tr2) ...@@ -149,7 +150,7 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
aux_r = 0._DP aux_r = 0._DP
! !
DO ig = 1, npwq ! perturbation acts only on body DO ig = 1, npwq ! perturbation acts only on body
aux_g(ig) = dvg(ig,ipert) * sqvc(ig) aux_g(ig) = dvg(ig,ipert) * pot3D%sqvc(ig)
ENDDO ENDDO
! !
IF(gamma_only) THEN IF(gamma_only) THEN
...@@ -290,7 +291,7 @@ SUBROUTINE dfpt (m,dvg,dng,tr2) ...@@ -290,7 +291,7 @@ SUBROUTINE dfpt (m,dvg,dng,tr2)
ENDIF ENDIF
! !
DO ig=1,npwq ! 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 dng(ig,ipert) = dng(ig,ipert) + 2._DP * wk(iks) * aux_g(ig) * pot3D%sqvc(ig) / omega
ENDDO ENDDO
! !
DEALLOCATE(aux_g) DEALLOCATE(aux_g)
...@@ -354,11 +355,12 @@ SUBROUTINE dfpt_q (m,dvg,dng,tr2,iq) ...@@ -354,11 +355,12 @@ SUBROUTINE dfpt_q (m,dvg,dng,tr2,iq)
USE control_flags, ONLY : gamma_only, io_level USE control_flags, ONLY : gamma_only, io_level
USE io_files, ONLY : tmp_dir, nwordwfc, iunwfc, diropn USE io_files, ONLY : tmp_dir, nwordwfc, iunwfc, diropn
USE uspp, ONLY : nkb, vkb, okvan USE uspp, ONLY : nkb, vkb, okvan
USE westcom, ONLY : sqvc,nbnd_occ,iuwfc,lrwfc,npwqx,npwq,igq_q USE westcom, ONLY : nbnd_occ,iuwfc,lrwfc,npwqx,npwq,igq_q
USE io_push, ONLY : io_push_title USE io_push, ONLY : io_push_title
USE mp_world, ONLY : mpime,world_comm USE mp_world, ONLY : mpime,world_comm
USE class_bz_grid, ONLY : bz_grid USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : k_grid, q_grid, compute_phase USE types_bz_grid, ONLY : k_grid, q_grid, compute_phase
USE types_coulomb, ONLY : pot3D
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -489,7 +491,7 @@ SUBROUTINE dfpt_q (m,dvg,dng,tr2,iq) ...@@ -489,7 +491,7 @@ SUBROUTINE dfpt_q (m,dvg,dng,tr2,iq)
aux_r = (0._DP,0._DP) aux_r = (0._DP,0._DP)
! !
DO ig = 1, npwq ! perturbation acts only on body DO ig = 1, npwq ! perturbation acts only on body
aux_g(ig) = dvg(ig,ipert) * sqvc(ig) aux_g(ig) = dvg(ig,ipert) * pot3D%sqvc(ig)
ENDDO ENDDO
! !
! inverse Fourier transform of the perturbation: (q+)G ---> R ! inverse Fourier transform of the perturbation: (q+)G ---> R
...@@ -621,7 +623,7 @@ SUBROUTINE dfpt_q (m,dvg,dng,tr2,iq) ...@@ -621,7 +623,7 @@ SUBROUTINE dfpt_q (m,dvg,dng,tr2,iq)
CALL single_fwfft_k(dffts,npwq,npwqx,aux_r,aux_g,'Wave',igq_q(1,iq)) CALL single_fwfft_k(dffts,npwq,npwqx,aux_r,aux_g,'Wave',igq_q(1,iq))
! !
DO ig = 1, npwq ! 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 dng(ig,ipert) = dng(ig,ipert) + 2._DP * k_grid%weight(iks) * aux_g(ig) * pot3D%sqvc(ig) / omega
ENDDO ENDDO
! !
DEALLOCATE( aux_g ) DEALLOCATE( aux_g )
......
...@@ -19,7 +19,7 @@ MODULE scratch_area ...@@ -19,7 +19,7 @@ MODULE scratch_area
SAVE SAVE
! !
! COULOMB ! COULOMB
REAL(DP),ALLOCATABLE :: sqvc(:) ! REAL(DP),ALLOCATABLE :: sqvc(:)
INTEGER :: npwq,npwqx,npwq_g INTEGER :: npwq,npwqx,npwq_g
CHARACTER(LEN=6) :: fftdriver CHARACTER(LEN=6) :: fftdriver
INTEGER,ALLOCATABLE :: iks_l2g(:) INTEGER,ALLOCATABLE :: iks_l2g(:)
...@@ -70,7 +70,7 @@ MODULE scratch_area ...@@ -70,7 +70,7 @@ MODULE scratch_area
! I/O ! I/O
!INTEGER :: io_comm ! communicator for head of images (me_bgrp==0) !INTEGER :: io_comm ! communicator for head of images (me_bgrp==0)
! !
REAL(DP) :: isz ! REAL(DP) :: isz
! !
END MODULE END MODULE
! !
......
...@@ -32,7 +32,6 @@ clean_scratchfiles.o \ ...@@ -32,7 +32,6 @@ clean_scratchfiles.o \
set_nbndocc.o \ set_nbndocc.o \
get_alpha_pv.o \ get_alpha_pv.o \
set_iks_l2g.o \ set_iks_l2g.o \
set_isz.o \
v_x.o \ v_x.o \
gradcorr_x.o \ gradcorr_x.o \
west_environment.o \ west_environment.o \
......
...@@ -39,7 +39,8 @@ SUBROUTINE do_sxx ( ) ...@@ -39,7 +39,8 @@ SUBROUTINE do_sxx ( )
USE mp_world, ONLY : mpime,root USE mp_world, ONLY : mpime,root
USE constants, ONLY : rytoev USE constants, ONLY : rytoev
USE json_module, ONLY : json_file USE json_module, ONLY : json_file
USE coulomb, ONLY : store_sqvc USE class_coulomb, ONLY : coulomb
USE types_coulomb, ONLY : pot3D
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -47,9 +48,9 @@ SUBROUTINE do_sxx ( ) ...@@ -47,9 +48,9 @@ SUBROUTINE do_sxx ( )
! !
INTEGER :: ir, ip, ig, iks, ib, iv, ip_glob INTEGER :: ir, ip, ig, iks, ib, iv, ip_glob
COMPLEX(DP),ALLOCATABLE :: pertg(:),pertr(:),pertr_nc(:,:) COMPLEX(DP),ALLOCATABLE :: pertg(:),pertr(:),pertr_nc(:,:)
REAL(DP),ALLOCATABLE :: mysqvc(:) ! REAL(DP),ALLOCATABLE :: mysqvc(:)
TYPE(bar_type) :: barra TYPE(bar_type) :: barra
REAL(DP) :: mydiv ! REAL(DP) :: mydiv
REAL(DP),ALLOCATABLE :: sigma_exx( :, : ) REAL(DP),ALLOCATABLE :: sigma_exx( :, : )
REAL(DP),ALLOCATABLE :: sigma_sxx( :, : ) REAL(DP),ALLOCATABLE :: sigma_sxx( :, : )
REAL(DP) :: peso REAL(DP) :: peso
...@@ -61,8 +62,9 @@ SUBROUTINE do_sxx ( ) ...@@ -61,8 +62,9 @@ SUBROUTINE do_sxx ( )
TYPE(json_file) :: json TYPE(json_file) :: json
INTEGER :: iunit INTEGER :: iunit
! !
ALLOCATE( mysqvc(npwq) ) CALL pot3d%init('Wave','gb')
CALL store_sqvc(mysqvc,npwq,'spherical',1,.FALSE.,mydiv) ! ALLOCATE( mysqvc(npwq) )
! CALL store_sqvc(mysqvc,npwq,'spherical',1,.FALSE.,mydiv)
!CALL store_sqvc(mysqvc,npwq,1,mydiv) !CALL store_sqvc(mysqvc,npwq,1,mydiv)
! !
CALL io_push_title("(S)creened eXact eXchange") CALL io_push_title("(S)creened eXact eXchange")
...@@ -155,11 +157,11 @@ SUBROUTINE do_sxx ( ) ...@@ -155,11 +157,11 @@ SUBROUTINE do_sxx ( )
ENDIF ENDIF
! !
DO ig = 1,npwq DO ig = 1,npwq
pertg(ig) = pertg(ig) * mysqvc(ig) pertg(ig) = pertg(ig) * 3Dpot%sqvc(ig)
ENDDO ENDDO
sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - peso * DDOT( 2*npwq, pertg(1), 1, pertg(1), 1) / omega sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - peso * DDOT( 2*npwq, pertg(1), 1, pertg(1), 1) / omega
!IF(gstart==2) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) + REAL( pertg(1), KIND = DP )**2 / omega !IF(gstart==2) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) + REAL( pertg(1), KIND = DP )**2 / omega
IF( ib == iv .AND. gstart == 2 ) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - mydiv IF( ib == iv .AND. gstart == 2 ) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - pot3D%div
! !
! -- < SXX > ! -- < SXX >
IF( gamma_only ) THEN IF( gamma_only ) THEN
...@@ -169,7 +171,7 @@ SUBROUTINE do_sxx ( ) ...@@ -169,7 +171,7 @@ SUBROUTINE do_sxx ( )
ip_glob = pert%l2g(ip) ip_glob = pert%l2g(ip)
sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - dproj(1,ip)**2 * (ev(ip_glob)/(1._DP-ev(ip_glob))) / omega sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - dproj(1,ip)**2 * (ev(ip_glob)/(1._DP-ev(ip_glob))) / omega
ENDDO ENDDO
IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * mydiv IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * pot3D%div
ELSE ELSE
CALL glbrak_k( pertg, dvg, zproj, npwq, npwqx, 1, pert%nloc, 1, npol) CALL glbrak_k( pertg, dvg, zproj, npwq, npwqx, 1, pert%nloc, 1, npol)
CALL mp_sum( zproj, intra_bgrp_comm ) CALL mp_sum( zproj, intra_bgrp_comm )
...@@ -178,7 +180,7 @@ SUBROUTINE do_sxx ( ) ...@@ -178,7 +180,7 @@ SUBROUTINE do_sxx ( )
sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - REAL(zproj(1,ip)*CONJG(zproj(1,ip)),KIND=DP) & sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - REAL(zproj(1,ip)*CONJG(zproj(1,ip)),KIND=DP) &
& * (ev(ip_glob)/(1._DP-ev(ip_glob))) / omega & * (ev(ip_glob)/(1._DP-ev(ip_glob))) / omega
ENDDO ENDDO
IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * mydiv IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * pot3D%div
ENDIF ENDIF
! -- </ SXX > ! -- </ SXX >
! !
...@@ -198,7 +200,7 @@ SUBROUTINE do_sxx ( ) ...@@ -198,7 +200,7 @@ SUBROUTINE do_sxx ( )
sigma_sxx = sigma_exx + sigma_sxx sigma_sxx = sigma_exx + sigma_sxx
! !
DEALLOCATE( pertg ) DEALLOCATE( pertg )
DEALLOCATE( mysqvc ) ! DEALLOCATE( mysqvc )
IF( noncolin ) THEN IF( noncolin ) THEN
DEALLOCATE( pertr_nc ) DEALLOCATE( pertr_nc )
ELSE ELSE
......
...@@ -14,9 +14,9 @@ ...@@ -14,9 +14,9 @@
SUBROUTINE westpp_setup SUBROUTINE westpp_setup
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
! !
USE westcom, ONLY : alphapv_dfpt,npwq,sqvc,west_prefix,westpp_save_dir,& USE westcom, ONLY : alphapv_dfpt,npwq,west_prefix,westpp_save_dir,&
& n_imfreq,nbnd_occ,l_macropol,macropol_calculation,& & n_imfreq,nbnd_occ,l_macropol,macropol_calculation,&
& n_refreq,isz,qp_bandrange,westpp_calculation,westpp_n_pdep_eigen_to_use & n_refreq,qp_bandrange,westpp_calculation,westpp_n_pdep_eigen_to_use
USE mp, ONLY : mp_max USE mp, ONLY : mp_max
USE mp_global, ONLY : intra_bgrp_comm USE mp_global, ONLY : intra_bgrp_comm
USE pwcom, ONLY : nbnd USE pwcom, ONLY : nbnd
...@@ -28,7 +28,8 @@ SUBROUTINE westpp_setup ...@@ -28,7 +28,8 @@ SUBROUTINE westpp_setup
USE wavefunctions_module, ONLY : evc USE wavefunctions_module, ONLY : evc
USE mod_mpiio, ONLY : set_io_comm USE mod_mpiio, ONLY : set_io_comm
USE pdep_db, ONLY : pdep_db_read USE pdep_db, ONLY : pdep_db_read
USE coulomb, ONLY : store_sqvc USE class_coulomb, ONLY : coulomb
USE types_coulomb, ONLY : pot3D
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -36,15 +37,16 @@ SUBROUTINE westpp_setup ...@@ -36,15 +37,16 @@ SUBROUTINE westpp_setup
REAL(DP) :: qq REAL(DP) :: qq
COMPLEX(DP),EXTERNAL :: get_alpha_pv COMPLEX(DP),EXTERNAL :: get_alpha_pv
INTEGER :: ig, i INTEGER :: ig, i
LOGICAL :: l_printout_div = .TRUE.
! !
CALL do_setup ( ) CALL do_setup ( )
! !
CALL set_npwq() CALL set_npwq()
! !
ALLOCATE(sqvc(npwq)) ! ALLOCATE(sqvc(npwq))
! !
CALL store_sqvc(sqvc,npwq,'spherical',1,.FALSE.,isz,l_printout_div) CALL pot3D%init('Wave','default')
CALL pot3D%print_divergence()
! CALL store_sqvc(sqvc,npwq,'spherical',1,.FALSE.,isz,l_printout_div)
!CALL store_sqvc(sqvc,npwq,1,isz) !CALL store_sqvc(sqvc,npwq,1,isz)
! !
CALL set_nbndocc() CALL set_nbndocc()
......
...@@ -24,13 +24,12 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose) ...@@ -24,13 +24,12 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose)
USE cell_base, ONLY : omega USE cell_base, ONLY : omega
USE constants, ONLY : tpi,fpi,rytoev,e2,pi USE constants, ONLY : tpi,fpi,rytoev,e2,pi
USE pwcom, ONLY : et,nks,current_spin,isk,xk,nbnd,lsda,g2kin,nspin,current_k,wk USE pwcom, ONLY : et,nks,current_spin,isk,xk,nbnd,lsda,g2kin,nspin,current_k,wk
USE westcom, ONLY : qp_bandrange,isz,& USE westcom, ONLY : qp_bandrange,nbnd_occ,l_enable_lanczos,n_lanczos,iks_l2g,l_macropol,&
& nbnd_occ,l_enable_lanczos,&
& n_lanczos,iks_l2g,l_macropol,&
& d_head_ifr,z_head_rfr,d_body1_ifr,d_body2_ifr,d_diago,z_body_rfr & d_head_ifr,z_head_rfr,d_body1_ifr,d_body2_ifr,d_diago,z_body_rfr
USE bar, ONLY : bar_type,start_bar_type,update_bar_type,stop_bar_type USE bar, ONLY : bar_type,start_bar_type,update_bar_type,stop_bar_type
USE io_push, ONLY : io_push_bar,io_push_value,io_push_title USE io_push, ONLY : io_push_bar,io_push_value,io_push_title
USE distribution_center, ONLY : pert,ifr,rfr,aband USE distribution_center, ONLY : pert,ifr,rfr,aband
USE types_coulomb, ONLY : pot3D
! !