Commit 5d394a7f authored by ccavazzoni's avatar ccavazzoni

- use FFT helper functions


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13737 c92efa57-630b-4861-b058-cf58834340f0
parent a5d5a350
......@@ -4567,7 +4567,7 @@ END SUBROUTINE compute_becpsi
USE mp_exx, ONLY : intra_egrp_comm, me_egrp, exx_mode, nproc_egrp, &
negrp, root_egrp
USE io_global, ONLY : stdout
USE fft_base, ONLY : dfftp, dffts, dtgs, smap, fft_base_info
USE fft_base, ONLY : dfftp, dffts, smap, fft_base_info
USE fft_types, ONLY : fft_type_init
USE recvec_subs, ONLY : ggen
! USE task_groups, ONLY : task_groups_init
......
......@@ -143,10 +143,14 @@ SUBROUTINE make_pointlists
(posi(3)-tau0(3,iat))**2)
IF (distance.LE.r_m(nt)) THEN
IF( ir .GT. SIZE( factlist ) .OR. ir .GT. SIZE( pointlist )) &
CALL errore( ' make_pointlists ', ' inconsistent sizes ', 1 )
factlist(ir) = 1.d0
pointlist(ir) = iat
GO TO 10
ELSE IF (distance.LE.1.2*r_m(nt)) THEN
IF( ir .GT. SIZE( factlist ) .OR. ir .GT. SIZE( pointlist )) &
CALL errore( ' make_pointlists ', ' inconsistent sizes ', 1 )
factlist(ir) = 1.d0 - (distance -r_m(nt))/(0.2d0*r_m(nt))
pointlist(ir) = iat
GO TO 10
......
......@@ -240,6 +240,7 @@ SUBROUTINE sum_band()
USE becmod, ONLY : becp
USE mp_bands, ONLY : me_bgrp
USE mp, ONLY : mp_sum, mp_get_comm_null
USE fft_helper_subroutines
!
IMPLICIT NONE
!
......@@ -251,6 +252,7 @@ SUBROUTINE sum_band()
COMPLEX(DP), ALLOCATABLE :: tg_psi(:)
REAL(DP), ALLOCATABLE :: tg_rho(:)
LOGICAL :: use_tg
INTEGER :: right_nnr, right_nr3, right_inc
!
!
! ... here we sum for each k point the contribution
......@@ -303,6 +305,8 @@ SUBROUTINE sum_band()
tg_psi(:) = ( 0.D0, 0.D0 )
ioff = 0
!
CALL tg_get_nnr( dffts, right_nnr )
!
DO idx = 1, 2*dffts%nproc2, 2
!
! ... 2*dffts%nproc2 ffts at the same time
......@@ -321,7 +325,7 @@ SUBROUTINE sum_band()
END DO
END IF
ioff = ioff + dffts%nnr
ioff = ioff + right_nnr
END DO
!
......@@ -354,7 +358,9 @@ SUBROUTINE sum_band()
w2 = w1
END IF
!
CALL get_rho_gamma(tg_rho, dffts%nr1x*dffts%nr2x*dffts%my_nr3p, w1, w2, tg_psi)
CALL tg_get_group_nr3( dffts, right_nr3 )
!
CALL get_rho_gamma(tg_rho, dffts%nr1x*dffts%nr2x*right_nr3, w1, w2, tg_psi)
!
ELSE
!
......@@ -437,22 +443,9 @@ SUBROUTINE sum_band()
END DO
!
IF( use_tg ) THEN
!
! reduce the charge across task group
!
CALL mp_sum( tg_rho, gid = dffts%comm2 )
!
! copy the charge back to processor location
!
nxyp = dffts%nr1x * dffts%my_nr2p
DO ir3 = 1, dffts%my_nr3p
ioff = dffts%nr1x * dffts%my_nr2p * (ir3-1)
ioff_tg = dffts%nr1x * dffts%nr2x * (ir3-1) + dffts%nr1x * dffts%my_i0r2p
rho%of_r(ioff+1:ioff+nxyp,current_spin) = rho%of_r(ioff+1:ioff+nxyp,current_spin) + &
tg_rho(ioff_tg+1:ioff_tg+nxyp)
END DO
!
CALL tg_reduce_rho( rho%of_r, tg_rho, current_spin, dffts )
!
END IF
!
! ... If we have a US pseudopotential we compute here the becsum term
......@@ -484,6 +477,7 @@ SUBROUTINE sum_band()
!
USE mp_bands, ONLY : me_bgrp
USE mp, ONLY : mp_sum, mp_get_comm_null
USE fft_helper_subroutines
!
IMPLICIT NONE
!
......@@ -497,6 +491,7 @@ SUBROUTINE sum_band()
COMPLEX(DP), ALLOCATABLE :: tg_psi(:), tg_psi_nc(:,:)
REAL(DP), ALLOCATABLE :: tg_rho(:), tg_rho_nc(:,:)
LOGICAL :: use_tg
INTEGER :: right_nnr, right_nr3, right_inc
!
! ... here we sum for each k point the contribution
! ... of the wavefunctions to the charge
......@@ -562,6 +557,8 @@ SUBROUTINE sum_band()
!
tg_psi_nc = ( 0.D0, 0.D0 )
!
CALL tg_get_nnr( dffts, right_nnr )
!
ioff = 0
!
DO idx = 1, dffts%nproc2
......@@ -577,7 +574,7 @@ SUBROUTINE sum_band()
END DO
END IF
ioff = ioff + dffts%nnr
ioff = ioff + right_nnr
END DO
!
......@@ -603,8 +600,10 @@ SUBROUTINE sum_band()
w1 = 0.0d0
END IF
!
CALL tg_get_group_nr3( dffts, right_nr3 )
!
DO ipol=1,npol
CALL get_rho(tg_rho_nc(:,1), dffts%nr1x * dffts%nr2x* dffts%my_nr3p, w1, tg_psi_nc(:,ipol))
CALL get_rho(tg_rho_nc(:,1), dffts%nr1x * dffts%nr2x* right_nr3, w1, tg_psi_nc(:,ipol))
ENDDO
!
IF (domag) CALL get_rho_domag(tg_rho_nc(:,:), dffts%nr1x*dffts%nr2x*dffts%my_nr3p, w1, tg_psi_nc(:,:))
......@@ -651,6 +650,8 @@ SUBROUTINE sum_band()
!
ioff = 0
!
CALL tg_get_nnr( dffts, right_nnr )
!
DO idx = 1, dffts%nproc2
!
! ... dffts%nproc2 ffts at the same time
......@@ -663,7 +664,7 @@ SUBROUTINE sum_band()
!$omp end do
END IF
ioff = ioff + dffts%nnr
ioff = ioff + right_nnr
END DO
!$omp end parallel
......@@ -689,7 +690,9 @@ SUBROUTINE sum_band()
w1 = 0.0d0
END IF
!
CALL get_rho(tg_rho, dffts%nr1x * dffts%nr2x *dffts%my_nr3p, w1, tg_psi)
CALL tg_get_group_nr3( dffts, right_nr3 )
!
CALL get_rho(tg_rho, dffts%nr1x * dffts%nr2x * right_nr3, w1, tg_psi)
!
ELSE
!
......@@ -729,37 +732,7 @@ SUBROUTINE sum_band()
!
! reduce the charge across task group
!
IF (noncolin) THEN
CALL mp_sum( tg_rho_nc, gid = dffts%comm2 )
ELSE
CALL mp_sum( tg_rho, gid = dffts%comm2 )
ENDIF
!
! copy the charge back to the proper processor location
!
nxyp = dffts%nr1x * dffts%my_nr2p
IF (noncolin) THEN
npol_ = 1 ; if (domag) npol_ = 4
endif
DO ir3=1,dffts%my_nr3p
ioff = dffts%nr1x * dffts%my_nr2p * (ir3-1)
ioff_tg = dffts%nr1x * dffts%nr2x * (ir3-1) + dffts%nr1x * dffts%my_i0r2p
IF (noncolin) THEN
!$omp parallel do
DO ipol=1, npol_
DO ir = 1, nxyp
rho%of_r(ir+ioff,ipol) = rho%of_r(ir+ioff,ipol) + tg_rho_nc(ir+ioff_tg,ipol)
END DO
END DO
!$omp end parallel do
ELSE
!$omp parallel do
DO ir = 1, nxyp
rho%of_r(ir+ioff,current_spin) = rho%of_r(ir+ioff,current_spin) + tg_rho(ir+ioff_tg)
END DO
!$omp end parallel do
END IF
END DO
CALL tg_reduce_rho( rho%of_r, tg_rho_nc, tg_rho, current_spin, noncolin, domag, dffts )
!
END IF
!
......
......@@ -19,6 +19,7 @@ SUBROUTINE vloc_psi_gamma(lda, n, m, psi, v, hpsi)
USE fft_base, ONLY : dffts
USE fft_interfaces,ONLY : fwfft, invfft
USE wavefunctions_module, ONLY: psic
USE fft_helper_subroutines
!
IMPLICIT NONE
!
......@@ -27,7 +28,7 @@ SUBROUTINE vloc_psi_gamma(lda, n, m, psi, v, hpsi)
COMPLEX(DP), INTENT(inout):: hpsi (lda, m)
REAL(DP), INTENT(in) :: v(dffts%nnr)
!
INTEGER :: ibnd, j, incr
INTEGER :: ibnd, j, incr, right_nnr, right_nr3, right_inc
COMPLEX(DP) :: fp, fm
!
LOGICAL :: use_tg
......@@ -61,6 +62,8 @@ SUBROUTINE vloc_psi_gamma(lda, n, m, psi, v, hpsi)
DO ibnd = 1, m, incr
!
IF( use_tg ) THEN
!
CALL tg_get_nnr( dffts, right_nnr )
!
tg_psic = (0.d0, 0.d0)
ioff = 0
......@@ -80,7 +83,7 @@ SUBROUTINE vloc_psi_gamma(lda, n, m, psi, v, hpsi)
ENDDO
ENDIF
ioff = ioff + dffts%nnr
ioff = ioff + right_nnr
ENDDO
!
......@@ -110,7 +113,9 @@ SUBROUTINE vloc_psi_gamma(lda, n, m, psi, v, hpsi)
!
CALL invfft ('tgWave', tg_psic, dffts )
!
DO j = 1, dffts%nr1x*dffts%nr2x*dffts%my_nr3p
CALL tg_get_group_nr3( dffts, right_nr3 )
!
DO j = 1, dffts%nr1x * dffts%nr2x * right_nr3
tg_psic (j) = tg_psic (j) * tg_v(j)
ENDDO
!
......@@ -134,6 +139,8 @@ SUBROUTINE vloc_psi_gamma(lda, n, m, psi, v, hpsi)
!
ioff = 0
!
CALL tg_get_recip_inc( dffts, right_inc )
!
DO idx = 1, 2*dffts%nproc2, 2
!
IF( idx + ibnd - 1 < m ) THEN
......@@ -154,7 +161,7 @@ SUBROUTINE vloc_psi_gamma(lda, n, m, psi, v, hpsi)
ENDDO
ENDIF
!
ioff = ioff + dffts%nnr
ioff = ioff + right_inc
!
ENDDO
!
......@@ -208,6 +215,7 @@ SUBROUTINE vloc_psi_k(lda, n, m, psi, v, hpsi)
USE mp_bands, ONLY : me_bgrp
USE fft_base, ONLY : dffts
USE fft_interfaces,ONLY : fwfft, invfft
USE fft_helper_subroutines
USE wavefunctions_module, ONLY: psic
!
IMPLICIT NONE
......@@ -218,7 +226,7 @@ SUBROUTINE vloc_psi_k(lda, n, m, psi, v, hpsi)
REAL(DP), INTENT(in) :: v(dffts%nnr)
!
INTEGER :: ibnd, j, incr
INTEGER :: i
INTEGER :: i, right_nnr, right_nr3, right_inc
!
LOGICAL :: use_tg
! Task Groups
......@@ -244,6 +252,8 @@ SUBROUTINE vloc_psi_k(lda, n, m, psi, v, hpsi)
!
IF( use_tg ) THEN
CALL tg_get_nnr( dffts, right_nnr )
DO ibnd = 1, m, dffts%nproc2
!
tg_psic = (0.d0, 0.d0)
......@@ -262,15 +272,17 @@ SUBROUTINE vloc_psi_k(lda, n, m, psi, v, hpsi)
!write (6,*) 'wfc G ', idx+ibnd-1
!write (6,99) (tg_psic(i+ioff), i=1,400)
ioff = ioff + dffts%nnr
ioff = ioff + right_nnr
ENDDO
!
CALL invfft ('tgWave', tg_psic, dffts )
!write (6,*) 'wfc R '
!write (6,99) (tg_psic(i), i=1,400)
!
CALL tg_get_group_nr3( dffts, right_nr3 )
!
!$omp parallel do
DO j = 1, dffts%nr1x*dffts%nr2x*dffts%my_nr3p
DO j = 1, dffts%nr1x*dffts%nr2x* right_nr3
tg_psic (j) = tg_psic (j) * tg_v(j)
ENDDO
!$omp end parallel do
......@@ -283,6 +295,8 @@ SUBROUTINE vloc_psi_k(lda, n, m, psi, v, hpsi)
!
ioff = 0
!
CALL tg_get_recip_inc( dffts, right_inc )
!
DO idx = 1, dffts%nproc2
!
IF( idx + ibnd - 1 <= m ) THEN
......@@ -297,7 +311,7 @@ SUBROUTINE vloc_psi_k(lda, n, m, psi, v, hpsi)
!write (6,*) 'v psi G ', idx+ibnd-1
!write (6,99) (tg_psic(i+ioff), i=1,400)
ioff = ioff + dffts%nnr
ioff = ioff + right_inc
!
ENDDO
!
......@@ -368,6 +382,7 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY: npol
USE wavefunctions_module, ONLY: psic_nc
USE fft_helper_subroutines
!
IMPLICIT NONE
!
......@@ -384,6 +399,7 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
REAL(DP), ALLOCATABLE :: tg_v(:,:)
COMPLEX(DP), ALLOCATABLE :: tg_psic(:,:)
INTEGER :: v_siz, idx, ioff
INTEGER :: right_nnr, right_nr3, right_inc
!
CALL start_clock ('vloc_psi')
!
......@@ -414,6 +430,8 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
DO ibnd = 1, m, incr
IF( use_tg ) THEN
!
CALL tg_get_nnr( dffts, right_nnr )
!
DO ipol = 1, npol
!
......@@ -429,7 +447,7 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
ENDDO
ENDIF
ioff = ioff + dffts%nnr
ioff = ioff + right_nnr
ENDDO
!
......@@ -451,8 +469,9 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
! product with the potential v = (vltot+vr) on the smooth grid
!
IF( use_tg ) THEN
CALL tg_get_group_nr3( dffts, right_nr3 )
IF (domag) THEN
DO j=1, dffts%nr1x*dffts%nr2x*dffts%my_nr3p
DO j=1, dffts%nr1x*dffts%nr2x*right_nr3
sup = tg_psic(j,1) * (tg_v(j,1)+tg_v(j,4)) + &
tg_psic(j,2) * (tg_v(j,2)-(0.d0,1.d0)*tg_v(j,3))
sdwn = tg_psic(j,2) * (tg_v(j,1)-tg_v(j,4)) + &
......@@ -461,7 +480,7 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
tg_psic(j,2)=sdwn
ENDDO
ELSE
DO j=1, dffts%nr1x*dffts%nr2x*dffts%my_nr3p
DO j=1, dffts%nr1x*dffts%nr2x*right_nr3
tg_psic(j,:) = tg_psic(j,:) * tg_v(j,1)
ENDDO
ENDIF
......@@ -492,6 +511,8 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
!
ioff = 0
!
CALL tg_get_recip_inc( dffts, right_inc )
!
DO idx = 1, dffts%nproc2
!
IF( idx + ibnd - 1 <= m ) THEN
......@@ -501,7 +522,7 @@ SUBROUTINE vloc_psi_nc (lda, n, m, psi, v, hpsi)
ENDDO
ENDIF
!
ioff = ioff + dffts%nnr
ioff = ioff + right_inc
!
ENDDO
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment