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

Updated Westpp. Eliminated import of classes where not needed. K and Q now...

Updated Westpp. Eliminated import of classes where not needed. K and Q now printed with 5 digits in stdout and json output files in all code.
parent 6fbd3e6e
......@@ -49,7 +49,8 @@ MODULE pdep_db
INTEGER, INTENT(IN), OPTIONAL :: iq
!
CHARACTER(LEN=512) :: fname
CHARACTER(LEN=6) :: my_label, my_label_q
CHARACTER(LEN=6) :: my_label
CHARACTER(LEN=5) :: my_label_q
REAL(DP), EXTERNAL :: GET_CLOCK
REAL(DP) :: time_spent(2)
CHARACTER(20),EXTERNAL :: human_readable_time
......@@ -144,7 +145,7 @@ MODULE pdep_db
! *****************************
!
!------------------------------------------------------------------------
SUBROUTINE pdep_db_read( nglob_to_be_read, iq_to_be_read )
SUBROUTINE pdep_db_read( nglob_to_be_read, iq_to_be_read, l_print_readin_info )
!------------------------------------------------------------------------
!
USE westcom, ONLY : n_pdep_eigen,ev,dvg,west_prefix,npwqx,wstat_save_dir
......@@ -161,9 +162,11 @@ MODULE pdep_db
!
INTEGER, INTENT(IN) :: nglob_to_be_read
INTEGER, INTENT(IN), OPTIONAL :: iq_to_be_read
LOGICAL, INTENT(IN), OPTIONAL :: l_print_readin_info
!
CHARACTER(LEN=512) :: fname
CHARACTER(LEN=6) :: my_label, my_label_q
CHARACTER(LEN=6) :: my_label
CHARACTER(LEN=5) :: my_label_q
REAL(DP), EXTERNAL :: GET_CLOCK
REAL(DP) :: time_spent(2)
CHARACTER(20),EXTERNAL :: human_readable_time
......@@ -174,6 +177,7 @@ MODULE pdep_db
LOGICAL :: found
TYPE(json_file) :: json
CHARACTER(20),ALLOCATABLE :: eigenpot_filename(:)
LOGICAL :: l_print_message
!
! MPI BARRIER
!
......@@ -196,8 +200,8 @@ MODULE pdep_db
CALL json%get('input.wstat_control.n_pdep_eigen', tmp_n_pdep_eigen, found)
IF (PRESENT(iq_to_be_read)) THEN
WRITE(my_label_q,'(i5.5)') iq_to_be_read
CALL json%get('output.Q'//TRIM(my_label_q)//').eigenval',tmp_ev, found)
CALL json%get('output.Q'//TRIM(my_label_q)//').eigenpot', eigenpot_filename, found)
CALL json%get('output.Q'//TRIM(my_label_q)//'.eigenval',tmp_ev, found)
CALL json%get('output.Q'//TRIM(my_label_q)//'.eigenpot', eigenpot_filename, found)
ELSE
CALL json%get('output.eigenval', tmp_ev, found)
CALL json%get('output.eigenpot', eigenpot_filename, found)
......@@ -262,12 +266,20 @@ MODULE pdep_db
time_spent(2)=get_clock('pdep_db')
CALL stop_clock('pdep_db')
!
WRITE(stdout,'( 5x," ")')
CALL io_push_bar()
WRITE(stdout, "(5x, 'SAVE read in ',a20)") human_readable_time(time_spent(2)-time_spent(1))
WRITE(stdout, "(5x, 'In location : ',a)") TRIM( wstat_save_dir )
WRITE(stdout, "(5x, 'Eigen. found : ',i12)") n_eigen_to_get
CALL io_push_bar()
IF (PRESENT(l_print_readin_info)) THEN
l_print_message = l_print_readin_info
ELSE
l_print_message = .TRUE.
ENDIF
!
IF (l_print_message) THEN
WRITE(stdout,'( 5x," ")')
CALL io_push_bar()
WRITE(stdout, "(5x, 'SAVE read in ',a20)") human_readable_time(time_spent(2)-time_spent(1))
WRITE(stdout, "(5x, 'In location : ',a)") TRIM( wstat_save_dir )
WRITE(stdout, "(5x, 'Eigen. found : ',i12)") n_eigen_to_get
CALL io_push_bar()
ENDIF
!
END SUBROUTINE
!
......
......@@ -717,7 +717,6 @@ MODULE wfreq_restart
USE io_files, ONLY : delete_if_present
USE distribution_center, ONLY : ifr,rfr
USE west_io, ONLY : serial_data_write
USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
......@@ -1029,7 +1028,6 @@ MODULE wfreq_restart
USE mp, ONLY : mp_barrier,mp_bcast,mp_get
USE distribution_center, ONLY : ifr,rfr
USE west_io, ONLY : serial_data_read
USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
......
......@@ -36,9 +36,7 @@ SUBROUTINE do_setup
USE io_push
USE westcom, ONLY : logfile
USE mp_world, ONLY : mpime, root
USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : k_grid, q_grid
!USE types_bz_grid, ONLY : k_grid, q_grid, kmq_grid, kpq_grid
!
IMPLICIT NONE
!
......
......@@ -22,7 +22,6 @@ SUBROUTINE set_npwq()
USE gvecw, ONLY : gcutw
USE pwcom, ONLY : npw,npwx
USE control_flags, ONLY : gamma_only
USE class_bz_grid, ONLY : bz_grid
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
......
......@@ -21,7 +21,7 @@ SUBROUTINE do_eigenpot2 ( )
& current_k,ngk
USE io_push, ONLY : io_push_title,io_push_bar
USE westcom, ONLY : westpp_sign,iuwfc,lrwfc,westpp_calculation,westpp_range,westpp_save_dir,fftdriver,&
& npwq,npwqx,dvg
& npwq,npwqx,dvg,ngq,igq_q,westpp_n_pdep_eigen_to_use
USE mp_global, ONLY : inter_image_comm,my_image_id
USE mp, ONLY : mp_bcast
USE fft_base, ONLY : dfftp,dffts
......@@ -33,55 +33,76 @@ SUBROUTINE do_eigenpot2 ( )
USE fft_at_k, ONLY : single_invfft_k
USE distribution_center, ONLY : pert
USE control_flags, ONLY : gamma_only
USE pdep_db, ONLY : pdep_db_read
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
!
! ... LOCAL variables
!
INTEGER :: i1,i2, ipol, ir, local_j, global_j, i, ig, iks, ibnd, local_ib, global_ib
INTEGER :: i1,i2, ipol, ir, local_j, global_j, i, ig, iks, ibnd, local_ib, global_ib, iq
REAL(DP),ALLOCATABLE :: auxr(:)
CHARACTER(LEN=512) :: fname
TYPE(bar_type) :: barra
CHARACTER(LEN=6) :: labelq,labeli
CHARACTER(LEN=6) :: labeli
CHARACTER(LEN=5) :: labelq
LOGICAL :: l_print_pdep_read
!
CALL io_push_title("(E)igenpotentials")
!
ALLOCATE(auxr(dffts%nnr))
!
auxr = 0._DP
psic = 0._DP
CALL start_bar_type( barra, 'westpp', pert%nloc*q_grid%np)
!
CALL start_bar_type( barra, 'westpp', pert%nloc )
!
DO local_j=1,pert%nloc
!
! local -> global
DO iq = 1, q_grid%np
!
global_j = pert%l2g(local_j)
IF( global_j < westpp_range(1) .OR. global_j > westpp_range(2) ) CYCLE
!
auxr = 0._DP
IF( gamma_only ) THEN
CALL single_invfft_gamma(dffts,npwq,npwqx,dvg(1,local_j),psic,TRIM(fftdriver))
IF (gamma_only) THEN
CALL pdep_db_read(westpp_n_pdep_eigen_to_use)
ELSE
CALL single_invfft_k(dffts,npwq,npwqx,dvg(1,local_j),psic,TRIM(fftdriver))
ENDIF
IF( westpp_sign ) THEN
DO ir = 1, dffts%nnr
auxr(ir) = REAL( psic(ir), KIND=DP) * ABS( REAL( psic(ir), KIND=DP) )
ENDDO
ELSE
DO ir = 1, dffts%nnr
auxr(ir) = REAL( psic(ir), KIND=DP) * REAL( psic(ir), KIND=DP)
ENDDO
l_print_pdep_read = .FALSE.
IF (iq==1) THEN
l_print_pdep_read = .TRUE.
ELSE
l_print_pdep_read = .FALSE.
ENDIF
CALL pdep_db_read(westpp_n_pdep_eigen_to_use,iq,l_print_pdep_read)
npwq = ngq(iq)
ENDIF
!
WRITE(labeli,'(i6.6)') global_j
WRITE(labelq,'(i6.6)') 1
fname = TRIM( westpp_save_dir ) // "/eigQ"//TRIM(labelq)//"I"//TRIM(labeli)
CALL dump_r( auxr, fname)
auxr = 0._DP
psic = 0._DP
!
CALL update_bar_type( barra,'westpp', 1 )
DO local_j=1,pert%nloc
!
! local -> global
!
global_j = pert%l2g(local_j)
IF( global_j < westpp_range(1) .OR. global_j > westpp_range(2) ) CYCLE
!
auxr = 0._DP
IF( gamma_only ) THEN
CALL single_invfft_gamma(dffts,npwq,npwqx,dvg(1,local_j),psic,TRIM(fftdriver))
ELSE
CALL single_invfft_k(dffts,npwq,npwqx,dvg(1,local_j),psic,'Wave',igq_q(1,iq))
ENDIF
IF( westpp_sign ) THEN
DO ir = 1, dffts%nnr
auxr(ir) = REAL( psic(ir), KIND=DP) * ABS( REAL( psic(ir), KIND=DP) )
ENDDO
ELSE
DO ir = 1, dffts%nnr
auxr(ir) = REAL( psic(ir), KIND=DP) * REAL( psic(ir), KIND=DP)
ENDDO
ENDIF
!
WRITE(labeli,'(i6.6)') global_j
WRITE(labelq,'(i5.5)') iq
fname = TRIM( westpp_save_dir ) // "/eigQ"//TRIM(labelq)//"I"//TRIM(labeli)
CALL dump_r( auxr, fname)
!
CALL update_bar_type( barra,'westpp', 1 )
!
ENDDO
!
ENDDO
!
......
......@@ -32,6 +32,7 @@ SUBROUTINE do_rho ( )
USE fft_at_k, ONLY : single_invfft_k
USE distribution_center, ONLY : aband
USE control_flags, ONLY : gamma_only
USE types_bz_grid, ONLY : k_grid
!
IMPLICIT NONE
!
......@@ -50,9 +51,9 @@ SUBROUTINE do_rho ( )
auxr = 0._DP
psic = 0._DP
!
CALL start_bar_type( barra, 'westpp', nks )
CALL start_bar_type( barra, 'westpp', k_grid%nps )
!
DO iks = 1, nks ! KPOINT-SPIN LOOP
DO iks = 1, k_grid%nps ! KPOINT-SPIN LOOP
!
! ... Set k-point, spin, kinetic energy, needed by Hpsi
!
......@@ -67,7 +68,7 @@ SUBROUTINE do_rho ( )
!
! ... read in wavefunctions from the previous iteration
!
IF(nks>1) THEN
IF(k_grid%nps>1) THEN
!iuwfc = 20
!lrwfc = nbnd * npwx * npol
!!CALL get_buffer( evc, nwordwfc, iunwfc, iks )
......
......@@ -20,7 +20,7 @@ SUBROUTINE do_sxx ( )
USE pwcom, ONLY : current_spin,wk,nks,nelup,neldw,isk,igk_k,xk,npw,npwx,lsda,nkstot,current_k,ngk,et
USE io_push, ONLY : io_push_title,io_push_bar
USE westcom, ONLY : iuwfc,lrwfc,westpp_range,westpp_save_dir,nbnd_occ,iks_l2g,westpp_epsinfty,dvg,ev,&
& npwq,npwqx,fftdriver,logfile
& npwq,npwqx,fftdriver,logfile,ngq,westpp_n_pdep_eigen_to_use
USE mp_global, ONLY : inter_image_comm,my_image_id,intra_bgrp_comm
USE mp, ONLY : mp_bcast,mp_sum
USE fft_base, ONLY : dfftp,dffts
......@@ -38,15 +38,19 @@ SUBROUTINE do_sxx ( )
USE mp_world, ONLY : mpime,root
USE constants, ONLY : rytoev
USE json_module, ONLY : json_file
USE class_coulomb, ONLY : coulomb
USE pdep_db, ONLY : pdep_db_read
USE types_bz_grid, ONLY : k_grid, q_grid, compute_phase
USE types_coulomb, ONLY : pot3D
!
IMPLICIT NONE
!
! ... LOCAL variables
!
INTEGER :: ir, ip, ig, iks, ib, iv, ip_glob
INTEGER :: ir, ip, ig, iks, ib, iv, ip_glob, ik, is, ikqs, iq, nbndval, npwkq
COMPLEX(DP),ALLOCATABLE :: pertg(:),pertr(:),pertr_nc(:,:)
COMPLEX(DP), ALLOCATABLE :: evckmq(:,:), phase(:)
LOGICAL :: l_gammaq
REAL(DP) :: g0(3)
TYPE(bar_type) :: barra
REAL(DP),ALLOCATABLE :: sigma_exx( :, : )
REAL(DP),ALLOCATABLE :: sigma_sxx( :, : )
......@@ -58,6 +62,7 @@ SUBROUTINE do_sxx ( )
REAL(DP),ALLOCATABLE :: dproj(:,:)
TYPE(json_file) :: json
INTEGER :: iunit
LOGICAL :: l_print_pdep_read
!
CALL io_push_title("(S)creened eXact eXchange")
!
......@@ -67,26 +72,30 @@ SUBROUTINE do_sxx ( )
sigma_exx = 0._DP
sigma_sxx = 0._DP
!
ALLOCATE( pertg(npwqx) )
!ALLOCATE( pertg(npwqx) )
ALLOCATE( pertg(ngm) )
IF(noncolin) THEN
ALLOCATE( pertr_nc( dffts%nnr, npol ) )
ELSE
ALLOCATE( pertr( dffts%nnr ) )
ENDIF
!
CALL pot3d%init('Wave','gb')
!
IF( gamma_only ) THEN
peso = 2._DP
ALLOCATE( dproj( 1, pert%nloc ) )
ELSE
peso = 1._DP
ALLOCATE( zproj( 1, pert%nloc ) )
ALLOCATE( phase(dffts%nnr) )
ALLOCATE( evckmq(npwx*npol,nbnd) )
ENDIF
!
CALL start_bar_type( barra, 'westpp', nks * (westpp_range(2)-westpp_range(1)+1) )
CALL start_bar_type( barra, 'westpp', k_grid%nps * (westpp_range(2)-westpp_range(1)+1) )
!
DO iks = 1, nks ! KPOINT-SPIN LOOP
DO iks = 1, k_grid%nps ! KPOINT-SPIN LOOP
!
ik = k_grid%ip(iks)
is = k_grid%is(iks)
!
! ... Set k-point, spin, kinetic energy, needed by Hpsi
!
......@@ -101,7 +110,7 @@ SUBROUTINE do_sxx ( )
!
! ... read in wavefunctions from the previous iteration
!
IF(nks>1) THEN
IF(k_grid%nps>1) THEN
!iuwfc = 20
!lrwfc = nbnd * npwx * npol
!!CALL get_buffer( evc, nwordwfc, iunwfc, iks )
......@@ -126,65 +135,111 @@ SUBROUTINE do_sxx ( )
CALL single_invfft_k(dffts,npw,npwx,evc(1,ib),psic,'Wave',igk_k(1,current_k))
ENDIF
!
DO iv = 1, nbnd_occ(iks)
DO iq = 1, q_grid%np
!
! Bring it to R-space
IF(gamma_only) THEN
CALL single_invfft_gamma(dffts,npw,npwx,evc(1,iv),pertr,'Wave')
DO ir=1,dffts%nnr
pertr(ir)=psic(ir)*pertr(ir)
ENDDO
CALL single_fwfft_gamma(dffts,npwq,npwqx,pertr,pertg,TRIM(fftdriver))
ELSEIF(noncolin) THEN
CALL single_invfft_k(dffts,npw,npwx,evc(1 ,iv),pertr_nc(1,1),'Wave',igk_k(1,current_k))
CALL single_invfft_k(dffts,npw,npwx,evc(1+npwx,iv),pertr_nc(1,2),'Wave',igk_k(1,current_k))
DO ir=1,dffts%nnr
pertr_nc(ir,1)=DCONJG(psic_nc(ir,1))*pertr_nc(ir,1)+DCONJG(psic_nc(ir,2))*pertr_nc(ir,2)
ENDDO
CALL single_fwfft_k(dffts,npwq,npwqx,pertr_nc(1,1),pertg,TRIM(fftdriver)) ! no igk
IF ( gamma_only ) THEN
!
l_gammaq = .TRUE.
nbndval = nbnd_occ(iks)
CALL pot3D%init('Dense',.FALSE.,'gb')
!
ELSE
CALL single_invfft_k(dffts,npw,npwx,evc(1,iv),pertr,'Wave',igk_k(1,current_k))
DO ir=1,dffts%nnr
pertr(ir)=DCONJG(psic(ir))*pertr(ir)
ENDDO
CALL single_fwfft_k(dffts,npwq,npwqx,pertr,pertg,TRIM(fftdriver)) ! no igk
ENDIF
!
l_gammaq = q_grid%l_pIsGamma(iq)
!
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
CALL compute_phase( g0, 'cart', phase )
!
nbndval = nbnd_occ(ikqs)
npwq = ngq(iq)
npwkq = ngk(ikqs)
!
CALL pot3D%init('Dense',.FALSE.,'gb',iq)
!
IF ( my_image_id == 0 ) CALL get_buffer( evckmq, lrwfc, iuwfc, ikqs )
CALL mp_bcast( evckmq, 0, inter_image_comm )
!
IF (iks==1 .AND. ib==1 .AND. iq==1) THEN
l_print_pdep_read = .TRUE.
ELSE
l_print_pdep_read = .FALSE.
ENDIF
!
ENDIF
!
DO ig = 1,npwq
pertg(ig) = pertg(ig) * 3Dpot%sqvc(ig)
ENDDO
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( ib == iv .AND. gstart == 2 ) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - pot3D%div
!
! -- < SXX >
IF( gamma_only ) THEN
CALL glbrak_gamma( pertg, dvg, dproj, npwq, npwqx, 1, pert%nloc, 1, npol)
CALL mp_sum( dproj, intra_bgrp_comm )
DO ip = 1, pert%nloc
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
ENDDO
IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * pot3D%div
ELSE
CALL glbrak_k( pertg, dvg, zproj, npwq, npwqx, 1, pert%nloc, 1, npol)
CALL mp_sum( zproj, intra_bgrp_comm )
DO ip = 1, pert%nloc
ip_glob = pert%l2g(ip)
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
DO iv = 1, nbndval
!
! Bring it to R-space
IF(gamma_only) THEN
CALL single_invfft_gamma(dffts,npw,npwx,evc(1,iv),pertr,'Wave')
DO ir=1,dffts%nnr
pertr(ir)=psic(ir)*pertr(ir)
ENDDO
CALL single_fwfft_gamma(dffts,npwq,npwqx,pertr,pertg,TRIM(fftdriver))
ELSEIF(noncolin) THEN
CALL single_invfft_k(dffts,npwkq,npwx,evckmq(1 ,iv),pertr_nc(1,1),'Wave',igk_k(1,ikqs))
CALL single_invfft_k(dffts,npwkq,npwx,evckmq(1+npwx,iv),pertr_nc(1,2),'Wave',igk_k(1,ikqs))
DO ir=1,dffts%nnr
pertr_nc(ir,1)=DCONJG(pertr_nc(ir,1)*phase(ir))*psic_nc(ir,1)+DCONJG(pertr_nc(ir,2)*phase(ir))*psic_nc(ir,2)
ENDDO
!CALL single_fwfft_k(dffts,npwq,npwqx,pertr_nc(1,1),pertg,'Dense') ! no igk
CALL single_fwfft_k(dffts,ngm,ngm,pertr_nc(1,1),pertg,'Dense') ! no igk
ELSE
CALL single_invfft_k(dffts,npwkq,npwx,evckmq(1,iv),pertr,'Wave',igk_k(1,ikqs))
DO ir=1,dffts%nnr
pertr(ir)=DCONJG(pertr(ir)*phase(ir)) * psic(ir)
ENDDO
!CALL single_fwfft_k(dffts,npwq,npwqx,pertr,pertg,'Dense') ! no igk
CALL single_fwfft_k(dffts,ngm,ngm,pertr,pertg,'Dense') ! no igk
ENDIF
!
!DO ig = 1,npwq
DO ig = 1,ngm
pertg(ig) = pertg(ig) * pot3D%sqvc(ig)
ENDDO
IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * pot3D%div
ENDIF
! -- </ SXX >
!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*ngm, pertg(1), 1, pertg(1), 1)/omega * q_grid%weight(iq)
!IF(gstart==2) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) + REAL( pertg(1), KIND = DP )**2 / omega
IF( ib == iv .AND. gstart == 2 .AND. l_gammaq ) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - pot3D%div
!
! -- < SXX >
!
IF (gamma_only) THEN
CALL pdep_db_read(westpp_n_pdep_eigen_to_use)
ELSE
CALL pdep_db_read(westpp_n_pdep_eigen_to_use,iq,l_print_pdep_read)
ENDIF
!
IF( gamma_only ) THEN
CALL glbrak_gamma( pertg, dvg, dproj, npwq, npwqx, 1, pert%nloc, 1, npol)
CALL mp_sum( dproj, intra_bgrp_comm )
DO ip = 1, pert%nloc
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
ENDDO
IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * pot3D%div
ELSE
CALL glbrak_k( pertg, dvg, zproj, npwq, npwqx, 1, pert%nloc, 1, npol)
CALL mp_sum( zproj, intra_bgrp_comm )
DO ip = 1, pert%nloc
ip_glob = pert%l2g(ip)
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 * q_grid%weight(iq)
ENDDO
!
IF( ib == iv ) sigma_sxx( ib, iks ) = sigma_sxx( ib, iks ) - (1._DP/westpp_epsinfty-1._DP) * pot3D%div
ENDIF
! -- </ SXX >
!
ENDDO ! iv
!
ENDDO
ENDDO ! iq
!
CALL update_bar_type( barra,'westpp', 1 )
!
ENDDO
ENDDO ! ib
!
ENDDO
ENDDO ! iks
!
CALL stop_bar_type( barra, 'westpp' )
!
......@@ -203,6 +258,8 @@ SUBROUTINE do_sxx ( )
DEALLOCATE( dproj )
ELSE
DEALLOCATE( zproj )
DEALLOCATE( evckmq )
DEALLOCATE( phase )
ENDIF
!
! Output it per k-point
......@@ -222,17 +279,18 @@ SUBROUTINE do_sxx ( )
!
ALLOCATE(out_tab(westpp_range(2)-westpp_range(1)+1,5))
!
DO iks=1,nks
DO iks=1,k_grid%nps
DO ib = westpp_range(1), westpp_range(2)
out_tab( ib - westpp_range(1) + 1, 1) = REAL( ib, KIND=DP)
out_tab( ib - westpp_range(1) + 1, 2) = et(ib,iks) * rytoev
out_tab( ib - westpp_range(1) + 1, 3) = sigma_exx(ib,iks) * rytoev
out_tab( ib - westpp_range(1) + 1, 4) = sigma_sxx(ib,iks) * rytoev
out_tab( ib - westpp_range(1) + 1, 5) = sigma_sxx(ib,iks) / sigma_exx(ib,iks)
WRITE(stdout,"(5X,i6.6,1X,i6.6,1X,1f14.6,1X,1f14.6,1X,1f14.6,1X,1f14.6)") &
WRITE(stdout,"(5X,i5.5,1X,i6.6,1X,1f14.6,1X,1f14.6,1X,1f14.6,1X,1f14.6)") &
& iks, ib, et(ib,iks)*rytoev, sigma_exx(ib,iks)*rytoev, sigma_sxx(ib,iks)*rytoev, sigma_sxx(ib,iks)/sigma_exx(ib,iks)
ENDDO
WRITE(myglobk,'(i6.6)') iks_l2g(iks)
IF (k_grid%nps>1.AND.iks<k_grid%nps) CALL io_push_bar()
WRITE(myglobk,'(i5.5)') iks_l2g(iks)
!
!CALL serial_table_output(mpime==root,4000,'sxx_K'//myglobk,out_tab,&
!& westpp_range(2)-westpp_range(1)+1,5,&
......
......@@ -17,7 +17,7 @@ SUBROUTINE do_wfc2 ( )
USE kinds, ONLY : DP
USE uspp, ONLY : vkb,nkb
USE io_global, ONLY : stdout
USE pwcom, ONLY : current_spin,wk,nks,nelup,neldw,isk,igk_k,xk,npw,npwx,lsda,nkstot,current_k,ngk
USE pwcom, ONLY : current_spin,wk,nelup,neldw,isk,igk_k,xk,npw,npwx,lsda,current_k,ngk
USE io_push, ONLY : io_push_title,io_push_bar
USE westcom, ONLY : westpp_sign,iuwfc,lrwfc,westpp_calculation,westpp_range,westpp_save_dir
USE mp_global, ONLY : inter_image_comm,my_image_id
......@@ -31,6 +31,7 @@ SUBROUTINE do_wfc2 ( )
USE fft_at_k, ONLY : single_invfft_k
USE distribution_center, ONLY : aband
USE control_flags, ONLY : gamma_only
USE types_bz_grid, ONLY : k_grid
!
IMPLICIT NONE
!
......@@ -49,9 +50,9 @@ SUBROUTINE do_wfc2 ( )
auxr = 0._DP
psic = 0._DP
!
CALL start_bar_type( barra, 'westpp', nks * MAX(aband%nloc,1) )
CALL start_bar_type( barra, 'westpp', k_grid%nps * MAX(aband%nloc,1) )
!
DO iks = 1, nks ! KPOINT-SPIN LOOP
DO iks = 1, k_grid%nps ! KPOINT-SPIN LOOP
!
! ... Set k-point, spin, kinetic energy, needed by Hpsi
!
......@@ -66,7 +67,7 @@ SUBROUTINE do_wfc2 ( )
!
! ... read in wavefunctions from the previous iteration
!
IF(nks>1) THEN
IF(k_grid%nps>1) THEN
!iuwfc = 20
!lrwfc = nbnd * npwx * npol
!!CALL get_buffer( evc, nwordwfc, iunwfc, iks )
......