scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fix bugs on real-FFT box

This commit is contained in:
Satomichi Nishihara 2021-01-27 08:58:00 +09:00 committed by Minoru Otani
parent c2b0f90c7d
commit 25e4d9b22d
7 changed files with 48 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Modules/corrdipole_laue.f90
View File

@ -194,7 +194,7 @@ CONTAINS
!
! ... update R-space
!$omp parallel do default(shared) private(ir, i1, i2, i3, iz, isite, offrange)
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN

4
Modules/corrgxy0_laue.f90
View File

@ -93,7 +93,7 @@ CONTAINS
bg1 = 0.0_DP
#endif
!$omp do
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN
@ -156,7 +156,7 @@ CONTAINS
END IF
!
!$omp parallel do default(shared) private(ir, i1, i2, i3, iz, isite, offrange)
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN

6
Modules/do_3drism.f90
View File

@ -423,7 +423,11 @@ CONTAINS
!$omp parallel do default(shared) private(ir, i1, i2, i3, offrange)
DO ir = 1, rismt%dfft%nnr
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (ir <= rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p) THEN
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
ELSE
offrange = .TRUE.
END IF
!
IF (offrange) THEN
rismt%csr(ir, :) = 0.0_DP

14
Modules/do_lauerism.f90
View File

@ -523,7 +523,11 @@ CONTAINS
!$omp parallel do default(shared) private(ir, i1, i2, i3, iz, offrange) reduction(+:mgrid)
DO ir = 1, rismt%dfft%nnr
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (ir <= rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p) THEN
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
ELSE
offrange = .TRUE.
END IF
!
IF (offrange) THEN
IF (rismt%nsite > 0) THEN
@ -617,7 +621,7 @@ CONTAINS
! ... for R-space
!
!$omp parallel do default(shared) private(ir, i1, i2, i3, iz, offrange)
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN
@ -665,7 +669,7 @@ CONTAINS
END IF
!
!$omp parallel do default(shared) private(ir, i1, i2, i3, iz, offrange)
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN
@ -702,7 +706,7 @@ CONTAINS
END IF
!
!$omp parallel do default(shared) private(ir, i1, i2, i3, iz, offrange)
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN
@ -780,7 +784,7 @@ CONTAINS
dcst(:, iiq) = 0.0_DP
!
!$omp parallel do default(shared) private(ir, i1, i2, i3, iz, offrange)
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN

2
Modules/guess_3drism.f90
View File

@ -95,7 +95,7 @@ SUBROUTINE guess_3drism(rismt, ierr)
rismt%csr(:, iiq) = 0.0_DP
!
! ... set csr initially
DO ir = 1, rismt%dfft%nnr
DO ir = 1, rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (offrange) THEN

44
Modules/lj_solute.f90
View File

@ -252,7 +252,7 @@ SUBROUTINE lj_setup_solU_vlj_x(iq, rismt, rsmax, laue)
INTEGER :: iv
INTEGER :: isolV
INTEGER :: iatom
INTEGER :: ir, nr
INTEGER :: ir, nr, mr
INTEGER :: i1, i2, i3
INTEGER :: n1, n2, n3
INTEGER :: ia, iia
@ -273,7 +273,8 @@ SUBROUTINE lj_setup_solU_vlj_x(iq, rismt, rsmax, laue)
n1 = rismt%dfft%nr1
n2 = rismt%dfft%nr2
n3 = rismt%dfft%nr3
nr = rismt%dfft%nnr
nr = rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
mr = rismt%dfft%nnr
!
! ... solvent properties
iiq = iq - rismt%mp_site%isite_start + 1
@ -299,10 +300,15 @@ SUBROUTINE lj_setup_solU_vlj_x(iq, rismt, rsmax, laue)
! ... calculate potential on each FFT grid
!$omp parallel do default(shared) private(ir, i1, i2, i3, offrange, r1, r2, r3, tau_r, vlj, &
!$omp ia, iia, su, suv, rmax, rmin, xuv, yuv, zuv, ruv2, eu, euv, sr2, sr6, sr12)
DO ir = 1, nr
DO ir = 1, mr
!
! ... create coordinate of a FFT grid
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (ir <= nr) THEN
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
ELSE
offrange = .TRUE.
END IF
!
IF (offrange) THEN
rismt%uljr(ir, iiq) = 0.0_DP
CYCLE
@ -443,7 +449,7 @@ SUBROUTINE lj_setup_wall_x(iq, rismt, rsmax)
INTEGER :: iv
INTEGER :: isolV
INTEGER :: iatom
INTEGER :: ir, nr
INTEGER :: ir, nr, mr
INTEGER :: i1, i2, i3
INTEGER :: n1, n2, n3
LOGICAL :: offrange
@ -479,7 +485,8 @@ SUBROUTINE lj_setup_wall_x(iq, rismt, rsmax)
n1 = rismt%dfft%nr1
n2 = rismt%dfft%nr2
n3 = rismt%dfft%nr3
nr = rismt%dfft%nnr
nr = rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
mr = rismt%dfft%nnr
!
! ... solvent properties
iiq = iq - rismt%mp_site%isite_start + 1
@ -514,10 +521,15 @@ SUBROUTINE lj_setup_wall_x(iq, rismt, rsmax)
! ... calculate potential on each FFT grid
!$omp parallel do default(shared) private(ir, i1, i2, i3, offrange, r3, tau_z, &
!$omp vw, zuv, sr, sr2, sr3, sr6, sr9)
DO ir = 1, nr
DO ir = 1, mr
!
! ... create coordinate of a FFT grid
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
IF (ir <= nr) THEN
CALL fft_index_to_3d(ir, rismt%dfft, i1, i2, i3, offrange)
ELSE
offrange = .TRUE.
END IF
!
IF (offrange) THEN
rismt%uwr(ir, iiq) = 0.0_DP
CYCLE
@ -779,10 +791,10 @@ SUBROUTINE lj_get_force_x(iq, rismt, force, rsmax, laue)
#endif
!
! ... FFT box
n1 = rismt%dfft%nr1
n2 = rismt%dfft%nr2
n3 = rismt%dfft%nr3
nr = rismt%dfft%nnr
n1 = rismt%dfft%nr1
n2 = rismt%dfft%nr2
n3 = rismt%dfft%nr3
nr = rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
weight = omega / DBLE(n1 * n2 * n3)
!
@ -1030,10 +1042,10 @@ SUBROUTINE lj_get_stress_x(iq, rismt, sigma, rsmax, laue)
#endif
!
! ... FFT box
n1 = rismt%dfft%nr1
n2 = rismt%dfft%nr2
n3 = rismt%dfft%nr3
nr = rismt%dfft%nnr
n1 = rismt%dfft%nr1
n2 = rismt%dfft%nr2
n3 = rismt%dfft%nr3
nr = rismt%dfft%nr1x * rismt%dfft%my_nr2p * rismt%dfft%my_nr3p
!
weight = omega / DBLE(n1 * n2 * n3)
!

4
Modules/solvavg.f90
View File

@ -263,14 +263,14 @@ CONTAINS
n1 = lfft%dfft%nr1
n2 = lfft%dfft%nr2
n3 = lfft%dfft%nr3
nr = lfft%dfft%nnr
nr = lfft%dfft%nr1x * lfft%dfft%my_nr2p * lfft%dfft%my_nr3p
nrz = lfft%nrz
irz0 = lfft%izcell_start
ELSE
n1 = dfft%nr1
n2 = dfft%nr2
n3 = dfft%nr3
nr = dfft%nnr
nr = dfft%nr1x * dfft%my_nr2p * dfft%my_nr3p
nrz = dfft%nr3
irz0 = 1
END IF