mirror of https://gitlab.com/QEF/q-e.git
166 lines
4.7 KiB
Fortran
166 lines
4.7 KiB
Fortran
!
|
|
! Copyright (C) 2015-2016 Satomichi Nishihara
|
|
!
|
|
! This file is distributed under the terms of the
|
|
! GNU General Public License. See the file `License'
|
|
! in the root directory of the present distribution,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
!---------------------------------------------------------------------------
|
|
SUBROUTINE potential_vv(rismt, ierr)
|
|
!---------------------------------------------------------------------------
|
|
!
|
|
! ... create potentials for 1D-RISM
|
|
! ...
|
|
! ... short-range R-space potential:
|
|
! ... Lennard-Jones:
|
|
! ... [ / sig \12 / sig \6 ]
|
|
! ... 4 * esp * [ |-----| - |-----| ]
|
|
! ... [ \ r / \ r / ]
|
|
! ... Coulomb:
|
|
! ... erfc(r / tau)
|
|
! ... e^2 * q1 * q2 * ---------------
|
|
! ... r
|
|
! ... long-range R-space potential:
|
|
! ... Coulomb:
|
|
! ... erf(r / tau)
|
|
! ... e^2 * q1 * q2 * --------------
|
|
! ... r
|
|
! ... long-range G-space potential:
|
|
! ... Coulomb:
|
|
! ... exp(-g^2 * tau^2 / 4)
|
|
! ... e^2 * 4 * pi * q1 * q2 * ------------------------
|
|
! ... g^2
|
|
!
|
|
USE constants, ONLY : fpi, sqrtpi, ele2 => e2
|
|
USE err_rism, ONLY : IERR_RISM_NULL, IERR_RISM_INCORRECT_DATA_TYPE
|
|
USE kinds, ONLY : DP
|
|
USE rism, ONLY : rism_type, ITYPE_1DRISM
|
|
USE solvmol, ONLY : solVs, get_nsite_in_solVs, isite_to_isolV, isite_to_iatom
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
TYPE(rism_type), INTENT(INOUT) :: rismt
|
|
INTEGER, INTENT(OUT) :: ierr
|
|
!
|
|
INTEGER :: nv
|
|
INTEGER :: iv1, iv2
|
|
INTEGER :: ivv
|
|
INTEGER :: isolV1, isolV2
|
|
INTEGER :: iatom1, iatom2
|
|
INTEGER :: ir, iir, jr
|
|
INTEGER :: ig, iig, jg
|
|
REAL(DP) :: q1, q2, q12
|
|
REAL(DP) :: e1, e2, e12
|
|
REAL(DP) :: s1, s2, s12
|
|
REAL(DP) :: r
|
|
REAL(DP) :: tau
|
|
REAL(DP) :: g
|
|
REAL(DP) :: sr, sr2, sr6, sr12
|
|
REAL(DP) :: ulj_r
|
|
REAL(DP) :: utc_r
|
|
REAL(DP) :: usc_r
|
|
REAL(DP) :: ulc_r
|
|
REAL(DP) :: ulc_g
|
|
REAL(DP) :: erf0
|
|
!
|
|
! ... number of sites in solvents
|
|
nv = get_nsite_in_solVs()
|
|
!
|
|
! ... check data type
|
|
IF (rismt%itype /= ITYPE_1DRISM) THEN
|
|
ierr = IERR_RISM_INCORRECT_DATA_TYPE
|
|
RETURN
|
|
END IF
|
|
!
|
|
IF (rismt%nr /= rismt%ng) THEN
|
|
ierr = IERR_RISM_INCORRECT_DATA_TYPE
|
|
RETURN
|
|
END IF
|
|
!
|
|
IF (rismt%nsite < (nv * (nv + 1) / 2)) THEN
|
|
ierr = IERR_RISM_INCORRECT_DATA_TYPE
|
|
RETURN
|
|
END IF
|
|
!
|
|
! ... coulomb smearing radius
|
|
tau = rismt%tau
|
|
!
|
|
! ... calculate potentials
|
|
DO iv1 = 1, nv
|
|
! ... properties of site1
|
|
isolV1 = isite_to_isolV(iv1)
|
|
iatom1 = isite_to_iatom(iv1)
|
|
q1 = solVs(isolV1)%charge(iatom1)
|
|
e1 = solVs(isolV1)%ljeps(iatom1)
|
|
s1 = solVs(isolV1)%ljsig(iatom1)
|
|
!
|
|
DO iv2 = 1, iv1
|
|
! ... properties of site2
|
|
isolV2 = isite_to_isolV(iv2)
|
|
iatom2 = isite_to_iatom(iv2)
|
|
q2 = solVs(isolV2)%charge(iatom2)
|
|
e2 = solVs(isolV2)%ljeps(iatom2)
|
|
s2 = solVs(isolV2)%ljsig(iatom2)
|
|
!
|
|
! ... properties of pair of site1 and 2
|
|
ivv = iv1 * (iv1 - 1) / 2 + iv2
|
|
q12 = q1 * q2
|
|
e12 = SQRT(e1 * e2)
|
|
s12 = 0.5_DP * (s1 + s2)
|
|
!
|
|
! ... short-range potential in R-space
|
|
! ... in case R = 0
|
|
IF (rismt%mp_task%ivec_start == 1) THEN
|
|
jr = 2
|
|
rismt%usr(1, ivv) = 0.0_DP
|
|
rismt%ulr(1, ivv) = ele2 * q12 * 2.0_DP / sqrtpi / tau
|
|
ELSE
|
|
jr = 1
|
|
END IF
|
|
! ... in case R /= 0
|
|
!$omp parallel do default(shared) private(ir, iir, r, sr, sr2, sr6, sr12, &
|
|
!$omp ulj_r, utc_r, usc_r, ulc_r, erf0)
|
|
DO ir = jr, rismt%nr
|
|
iir = rismt%mp_task%ivec_start + ir - 1
|
|
r = rismt%rfft%rgrid(iir)
|
|
sr = s12 / r
|
|
sr2 = sr * sr
|
|
sr6 = sr2 * sr2 * sr2
|
|
sr12 = sr6 * sr6
|
|
ulj_r = 4.0_DP * e12 * (sr12 - sr6)
|
|
utc_r = ele2 * q12 / r
|
|
erf0 = erf(r / tau)
|
|
usc_r = utc_r * (1.0_DP - erf0)
|
|
ulc_r = utc_r * erf0
|
|
rismt%usr(ir, ivv) = ulj_r + usc_r
|
|
rismt%ulr(ir, ivv) = ulc_r
|
|
END DO
|
|
!$omp end parallel do
|
|
!
|
|
! ... long-range potential in G-space
|
|
! ... in case G = 0
|
|
IF (rismt%mp_task%ivec_start == 1) THEN
|
|
jg = 2
|
|
rismt%ulg(1, ivv) = 0.0_DP
|
|
ELSE
|
|
jg = 1
|
|
END IF
|
|
! ... in case G /= 0
|
|
!$omp parallel do default(shared) private(ig, iig, g, ulc_g)
|
|
DO ig = jg, rismt%ng
|
|
iig = rismt%mp_task%ivec_start + ig - 1
|
|
g = rismt%rfft%ggrid(iig)
|
|
ulc_g = ele2 * fpi * q12 * EXP(-0.25_DP * g * g * tau * tau) / g / g
|
|
rismt%ulg(ig, ivv) = ulc_g
|
|
END DO
|
|
!$omp end parallel do
|
|
!
|
|
END DO
|
|
END DO
|
|
!
|
|
! ... normally done
|
|
ierr = IERR_RISM_NULL
|
|
!
|
|
END SUBROUTINE potential_vv
|