quantum-espresso/Modules/eqn_3drism.f90

137 lines
3.6 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 eqn_3drism(rismt, ierr)
!---------------------------------------------------------------------------
!
! ... solve 3D-RISM equation, which is defined as
! ... h1(g) = c2(g) * x21(g)
! ...
! ... (A.Kovalenko, F.Hirata, Chem. Phys. Lett. 1998, 290, 237-244)
!
USE constants, ONLY : K_BOLTZMANN_RY
USE err_rism, ONLY : IERR_RISM_NULL, IERR_RISM_INCORRECT_DATA_TYPE
USE kinds, ONLY : DP
USE mp, ONLY : mp_sum
USE rism, ONLY : rism_type, ITYPE_3DRISM
USE solvmol, ONLY : get_nuniq_in_solVs
!
IMPLICIT NONE
!
TYPE(rism_type), INTENT(INOUT) :: rismt
INTEGER, INTENT(OUT) :: ierr
!
INTEGER :: nq
INTEGER :: iq1, iq2
INTEGER :: iiq1, iiq2
INTEGER :: ig
INTEGER :: igs
REAL(DP) :: beta
REAL(DP) :: xg21
COMPLEX(DP) :: cgz2
COMPLEX(DP), ALLOCATABLE :: hgz1(:)
#if defined (__DEBUG_RISM)
!
CALL start_clock('3DRISM_eqn')
#endif
!
! ... number of sites in solvents
nq = get_nuniq_in_solVs()
!
! ... check data type
IF (rismt%itype /= ITYPE_3DRISM) THEN
ierr = IERR_RISM_INCORRECT_DATA_TYPE
RETURN
END IF
!
IF (rismt%mp_site%nsite < nq) THEN
ierr = IERR_RISM_INCORRECT_DATA_TYPE
RETURN
END IF
!
IF (rismt%ngs < rismt%gvec%ngl) THEN
ierr = IERR_RISM_INCORRECT_DATA_TYPE
RETURN
END IF
!
IF (rismt%ng < rismt%gvec%ngm) THEN
ierr = IERR_RISM_INCORRECT_DATA_TYPE
RETURN
END IF
!
! ... beta = 1 / (kB * T)
beta = 1.0_DP / K_BOLTZMANN_RY / rismt%temp
!
! ... allocate working memory
IF (rismt%gvec%ngm > 0) THEN
ALLOCATE(hgz1(rismt%gvec%ngm))
END IF
!
! ... 3D-RISM equation
DO iq1 = 1, nq
! ... properties of site1
IF (rismt%mp_site%isite_start <= iq1 .AND. iq1 <= rismt%mp_site%isite_end) THEN
iiq1 = iq1 - rismt%mp_site%isite_start + 1
ELSE
iiq1 = 0
END IF
!
IF (rismt%gvec%ngm > 0) THEN
hgz1 = CMPLX(0.0_DP, 0.0_DP, kind=DP)
END IF
!
DO iq2 = rismt%mp_site%isite_start, rismt%mp_site%isite_end
! ... properties of site2
iiq2 = iq2 - rismt%mp_site%isite_start + 1
!
! ... solve 3D-RISM equation for each ig
!$omp parallel do default(shared) private(ig, igs, xg21, cgz2)
DO ig = rismt%gvec%gstart, rismt%gvec%ngm
igs = rismt%gvec%igtongl(ig)
xg21 = rismt%xgs(igs, iiq2, iq1)
cgz2 = rismt%csgz(ig, iiq2) - beta * rismt%ulgz(ig, iiq2)
hgz1(ig) = hgz1(ig) + cgz2 * xg21
END DO
!$omp end parallel do
!
END DO
!
IF (rismt%gvec%ngm > 0) THEN
CALL mp_sum(hgz1, rismt%mp_site%inter_sitg_comm)
END IF
!
! ... canonical condition
IF (rismt%gvec%gstart > 1) THEN
IF (rismt%gvec%ngm > 0) THEN
hgz1(1) = CMPLX(0.0_DP, 0.0_DP, kind=DP)
END IF
END IF
!
IF (iiq1 > 0) THEN
IF (rismt%gvec%ngm > 0) THEN
rismt%hgz(1:rismt%gvec%ngm, iiq1) = hgz1
END IF
END IF
!
END DO
!
! ... deallocate working memory
IF (rismt%gvec%ngm > 0) THEN
DEALLOCATE(hgz1)
END IF
!
! ... normally done
ierr = IERR_RISM_NULL
#if defined (__DEBUG_RISM)
!
CALL stop_clock('3DRISM_eqn')
#endif
!
END SUBROUTINE eqn_3drism