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

XClib - gnu+acc compatible acc declarations in GGA

This commit is contained in:
fabrizio22 2022-05-16 12:43:17 +02:00
parent 7befc1b13f
commit afb81f6c9a
2 changed files with 67 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
XClib/qe_funct_corr_gga.f90
View File

@ -17,7 +17,6 @@ CONTAINS
!
!-----------------------------------------------------------------------
SUBROUTINE perdew86( rho, grho, sc, v1c, v2c )
!$acc routine (perdew86) seq
!-----------------------------------------------------------------------
!! Perdew gradient correction on correlation: PRB 33, 8822 (1986).
!
@ -25,6 +24,8 @@ SUBROUTINE perdew86( rho, grho, sc, v1c, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sc, v1c, v2c
!
@ -69,7 +70,6 @@ END SUBROUTINE perdew86
!
!-----------------------------------------------------------------------
SUBROUTINE ggac( rho, grho, sc, v1c, v2c )
!$acc routine (ggac) seq
!-----------------------------------------------------------------------
!! Perdew-Wang GGA (PW91) correlation part
!
@ -77,6 +77,8 @@ SUBROUTINE ggac( rho, grho, sc, v1c, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sc, v1c, v2c
!
@ -148,7 +150,6 @@ END SUBROUTINE ggac
!
!-----------------------------------------------------------------------
SUBROUTINE glyp( rho, grho, sc, v1c, v2c )
!$acc routine (glyp) seq
!-----------------------------------------------------------------------
!! Lee Yang Parr: gradient correction part.
!
@ -156,6 +157,8 @@ SUBROUTINE glyp( rho, grho, sc, v1c, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sc, v1c, v2c
!
@ -190,7 +193,6 @@ END SUBROUTINE glyp
!
!---------------------------------------------------------------
SUBROUTINE pbec( rho, grho, iflag, sc, v1c, v2c )
!$acc routine (pbec) seq
!---------------------------------------------------------------
!! PBE correlation (without LDA part)
!
@ -202,6 +204,8 @@ SUBROUTINE pbec( rho, grho, iflag, sc, v1c, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
INTEGER, INTENT(IN) :: iflag
REAL(DP), INTENT(IN) :: rho, grho
! input: charge and squared gradient
@ -259,7 +263,6 @@ END SUBROUTINE pbec
!
!-----------------------------------------------------------------------
SUBROUTINE perdew86_spin( rho, zeta, grho, sc, v1c_up, v1c_dw, v2c )
!$acc routine (perdew86_spin) seq
!---------------------------------------------------------------------
!! Perdew gradient correction on correlation: PRB 33, 8822 (1986)
!! spin-polarized case.
@ -268,6 +271,8 @@ SUBROUTINE perdew86_spin( rho, zeta, grho, sc, v1c_up, v1c_dw, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho
!! the total charge density
REAL(DP), INTENT(IN) :: zeta
@ -332,7 +337,6 @@ END SUBROUTINE perdew86_spin
!
!-----------------------------------------------------------------------
SUBROUTINE ggac_spin( rho, zeta, grho, sc, v1c_up, v1c_dw, v2c )
!$acc routine (ggac_spin) seq
!---------------------------------------------------------------------
!! Perdew-Wang GGA (PW91) correlation part - spin-polarized
!
@ -340,6 +344,8 @@ SUBROUTINE ggac_spin( rho, zeta, grho, sc, v1c_up, v1c_dw, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho
!! the total charge density
REAL(DP), INTENT(IN) :: zeta
@ -438,7 +444,6 @@ END SUBROUTINE ggac_spin
!
!-------------------------------------------------------------------
SUBROUTINE pbec_spin( rho, zeta, grho, iflag, sc, v1c_up, v1c_dw, v2c )
!$acc routine (pbec_spin) seq
!-----------------------------------------------------------------
!! PBE correlation (without LDA part) - spin-polarized.
!
@ -449,6 +454,8 @@ SUBROUTINE pbec_spin( rho, zeta, grho, iflag, sc, v1c_up, v1c_dw, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
INTEGER, INTENT(IN) :: iflag
!! see main comments
REAL(DP), INTENT(IN) :: rho
@ -535,8 +542,8 @@ END SUBROUTINE pbec_spin
!
!
!------------------------------------------------------------------------
SUBROUTINE lsd_glyp( rho_in_up, rho_in_dw, grho_up, grho_dw, grho_ud, sc, v1c_up, v1c_dw, v2c_up, v2c_dw, v2c_ud )
!$acc routine (lsd_glyp) seq
SUBROUTINE lsd_glyp( rho_in_up, rho_in_dw, grho_up, grho_dw, grho_ud, sc, &
v1c_up, v1c_dw, v2c_up, v2c_dw, v2c_ud )
!----------------------------------------------------------------------
!! Lee, Yang, Parr: gradient correction part.
!
@ -544,6 +551,8 @@ SUBROUTINE lsd_glyp( rho_in_up, rho_in_dw, grho_up, grho_dw, grho_ud, sc, v1c_up
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho_in_up, rho_in_dw
!! the total charge density
REAL(DP), INTENT(IN) :: grho_up, grho_dw
@ -614,7 +623,6 @@ END SUBROUTINE lsd_glyp
!
!---------------------------------------------------------------
SUBROUTINE cpbe2d( rho, grho, sc, v1c, v2c )
!$acc routine (cpbe2d) seq
!---------------------------------------------------------------
!! 2D correction (last term of Eq. 5, PRL 108, 126402 (2012))
!
@ -622,6 +630,8 @@ SUBROUTINE cpbe2d( rho, grho, sc, v1c, v2c )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sc, v1c, v2c
!

73
XClib/qe_funct_exch_gga.f90
View File

@ -14,7 +14,6 @@ CONTAINS
!
!-----------------------------------------------------------------------
SUBROUTINE becke88( rho, grho, sx, v1x, v2x )
!$acc routine (becke88) seq
!-----------------------------------------------------------------------
!! Becke exchange: A.D. Becke, PRA 38, 3098 (1988)
!! only gradient-corrected part, no Slater term included
@ -23,6 +22,8 @@ SUBROUTINE becke88( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -58,7 +59,6 @@ END SUBROUTINE becke88
!
!-----------------------------------------------------------------------
SUBROUTINE ggax( rho, grho, sx, v1x, v2x )
!$acc routine (ggax) seq
!-----------------------------------------------------------------------
!! Perdew-Wang GGA (PW91), exchange part:
!! J.P. Perdew et al.,PRB 46, 6671 (1992)
@ -67,6 +67,8 @@ SUBROUTINE ggax( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -107,7 +109,6 @@ END SUBROUTINE ggax
!
!---------------------------------------------------------------
SUBROUTINE pbex( rho, grho, iflag, sx, v1x, v2x )
!$acc routine (pbex) seq
!---------------------------------------------------------------
!! PBE exchange (without Slater exchange):
!! iflag=1 J.P.Perdew, K.Burke, M.Ernzerhof, PRL 77, 3865 (1996)
@ -124,6 +125,8 @@ SUBROUTINE pbex( rho, grho, iflag, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
INTEGER, INTENT(IN) :: iflag
REAL(DP), INTENT(IN) :: rho, grho
! input: charge and squared gradient
@ -330,7 +333,6 @@ END SUBROUTINE pbex
!
!----------------------------------------------------------------------------
SUBROUTINE hcth( rho, grho, sx, v1x, v2x )
!$acc routine (hcth) seq
!--------------------------------------------------------------------------
!! HCTH/120, JCP 109, p. 6264 (1998)
!! Parameters set-up after N.L. Doltsisnis & M. Sprik (1999)
@ -346,6 +348,8 @@ SUBROUTINE hcth( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -457,13 +461,14 @@ END SUBROUTINE hcth
!
!-------------------------------------------------------
SUBROUTINE pwcorr( r, c, g, dg )
!$acc routine (pwcorr) seq
!-----------------------------------------------------
!
USE kind_l, ONLY: DP
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: r, c(6)
REAL(DP), INTENT(OUT) :: g, dg
!
@ -487,7 +492,6 @@ END SUBROUTINE hcth
!
!-----------------------------------------------------------------------------
SUBROUTINE optx( rho, grho, sx, v1x, v2x )
!$acc routine (optx) seq
!---------------------------------------------------------------------------
!! OPTX, Handy et al. JCP 116, p. 5411 (2002) and refs. therein
!! Present release: Mauro Boero, Tsukuba, 10/9/2002
@ -502,6 +506,8 @@ SUBROUTINE optx( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -534,7 +540,6 @@ END SUBROUTINE optx
!
!---------------------------------------------------------------
SUBROUTINE wcx( rho, grho, sx, v1x, v2x )
!$acc routine (wcx) seq
!---------------------------------------------------------------
!! Wu-Cohen exchange (without Slater exchange):
!! Z. Wu and R. E. Cohen, PRB 73, 235116 (2006)
@ -543,6 +548,8 @@ SUBROUTINE wcx( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -607,13 +614,14 @@ END SUBROUTINE wcx
!
!-----------------------------------------------------------------------
SUBROUTINE pbexsr( rho, grho, sxsr, v1xsr, v2xsr, omega )
!$acc routine (pbexsr) seq
!---------------------------------------------------------------------
! INCLUDE 'cnst.inc'
USE kind_l, ONLY: DP
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: omega
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sxsr, v1xsr, v2xsr
@ -662,10 +670,9 @@ END SUBROUTINE pbexsr
!
!
!-----------------------------------------------------------------------
SUBROUTINE axsr(IXC,RHO,GRHO,sx,V1X,V2X,OMEGA)
!$acc routine (axsr) seq
SUBROUTINE axsr( IXC, RHO, GRHO, sx, V1X, V2X, OMEGA )
!-----------------------------------------------------------------------
!!!! Per Hyldgaard, No warranties. adapted from the pbesrx version above
!*** [Per Hyldgaard, No warranties. adapted from the pbesrx version above]
!-----------------------------------------------------------------------
!
! INCLUDE 'cnst.inc'
@ -673,7 +680,9 @@ END SUBROUTINE pbexsr
use kind_l, ONLY : DP
!
IMPLICIT NONE
!
!$acc routine seq
!
INTEGER :: IXC
REAL(DP):: RHO, GRHO, V1X, V2X, OMEGA
REAL(DP), PARAMETER :: SMALL=1.D-20, SMAL2=1.D-08
@ -714,7 +723,6 @@ END SUBROUTINE pbexsr
!-----------------------------------------------------------------------
SUBROUTINE wggax_analy_erfc(rho,s,nggatyp,omega,Fx_wgga, &
dfxdn,dfxds)
!$acc routine (wggax_analy_erfc) seq
!--------------------------------------------------------------------
!
! Short-ranged wGGA Enhancement Factor (from erfc, analytical with
@ -749,6 +757,8 @@ END SUBROUTINE pbexsr
! USE constants, ONLY : pi
Implicit None
!$acc routine seq
REAL(DP), PARAMETER :: pi=3.14159265358979323846d0
Real(dp) :: rho,s,omega,Fx_wgga,dfxdn,dfxds
@ -955,7 +965,6 @@ END SUBROUTINE pbexsr
!
!-----------------------------------------------------------------------
SUBROUTINE rPW86( rho, grho, sx, v1x, v2x )
!$acc routine (rPW86) seq
!---------------------------------------------------------------------
!! PRB 33, 8800 (1986) and J. Chem. Theory comp. 5, 2754 (2009).
!
@ -963,6 +972,8 @@ SUBROUTINE rPW86( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -1000,7 +1011,6 @@ END SUBROUTINE rPW86
!
!-----------------------------------------------------------------
SUBROUTINE c09x( rho, grho, sx, v1x, v2x )
!$acc routine (c09x) seq
!---------------------------------------------------------------
!! Cooper '09 exchange for vdW-DF (without Slater exchange):
!! V. R. Cooper, Phys. Rev. B 81, 161104(R) (2010)
@ -1013,6 +1023,8 @@ SUBROUTINE c09x( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -1072,7 +1084,6 @@ END SUBROUTINE c09x
!
!---------------------------------------------------------------
SUBROUTINE sogga( rho, grho, sx, v1x, v2x )
!$acc routine (sogga) seq
!-------------------------------------------------------------
!! SOGGA exchange
!
@ -1080,6 +1091,8 @@ SUBROUTINE sogga( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
! input: charge and abs gradient
@ -1132,7 +1145,6 @@ END SUBROUTINE sogga
!
!-------------------------------------------------------------------------
SUBROUTINE pbexgau( rho, grho, sxsr, v1xsr, v2xsr, alpha_gau )
!$acc routine (pbexgau) seq
!-----------------------------------------------------------------------
!! PBEX gaussian.
!
@ -1140,6 +1152,8 @@ SUBROUTINE pbexgau( rho, grho, sxsr, v1xsr, v2xsr, alpha_gau )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: alpha_gau
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sxsr, v1xsr, v2xsr
@ -1181,13 +1195,14 @@ END SUBROUTINE pbexgau
!
!-----------------------------------------------------------------------
SUBROUTINE pbe_gauscheme( rho, s, alpha_gau, Fx, dFxdr, dFxds )
!$acc routine (pbe_gauscheme) seq
!--------------------------------------------------------------------
!
USE kind_l, ONLY: DP
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(dp) :: rho,s,alpha_gau,Fx,dFxdr,dFxds
! input: charge and squared gradient and alpha_gau
! output: GGA enhancement factor of gau-PBE
@ -1273,10 +1288,10 @@ END SUBROUTINE pbe_gauscheme
!
!-------------------------------------------------
FUNCTION TayExp(X)
!$acc routine (TayExp) seq
!-------------------------------------------
USE kind_l, ONLY: DP
IMPLICIT NONE
!$acc routine seq
REAL(DP), INTENT(IN) :: X
REAL(DP) :: TAYEXP
INTEGER :: NTERM,I
@ -1301,7 +1316,6 @@ END FUNCTION TayExp
!
!-------------------------------------------------------------------------
SUBROUTINE PW86( rho, grho, sx, v1x, v2x )
!$acc routine (PW86) seq
!-----------------------------------------------------------------------
!! Perdew-Wang 1986 exchange gradient correction: PRB 33, 8800 (1986)
!
@ -1309,6 +1323,8 @@ SUBROUTINE PW86( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -1346,7 +1362,6 @@ END SUBROUTINE PW86
!
!-----------------------------------------------------------------------
SUBROUTINE becke86b( rho, grho, sx, v1x, v2x )
!$acc routine (becke86b) seq
!-----------------------------------------------------------------------
!! Becke 1986 gradient correction to exchange
!! A.D. Becke, J. Chem. Phys. 85 (1986) 7184
@ -1355,6 +1370,8 @@ SUBROUTINE becke86b( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -1387,7 +1404,6 @@ END SUBROUTINE becke86b
!
!---------------------------------------------------------------
SUBROUTINE b86b( rho, grho, iflag, sx, v1x, v2x )
!$acc routine (b86b) seq
!-------------------------------------------------------------
!! Becke exchange (without Slater exchange):
!! iflag=1: A. D. Becke, J. Chem. Phys. 85, 7184 (1986) (B86b)
@ -1401,6 +1417,8 @@ SUBROUTINE b86b( rho, grho, iflag, sx, v1x, v2x )
USE kind_l, ONLY : DP
IMPLICIT NONE
!
!$acc routine seq
!
INTEGER, INTENT(IN) :: iflag
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
@ -1458,7 +1476,6 @@ END SUBROUTINE b86b
!
!-----------------------------------------------------------------------
SUBROUTINE cx13( rho, grho, sx, v1x, v2x )
!$acc routine (cx13) seq
!-----------------------------------------------------------------------
!! The new exchange partner for a vdW-DF1-cx suggested
!! by K. Berland and P. Hyldgaard, see PRB 89, 035412 (2014),
@ -1468,6 +1485,8 @@ SUBROUTINE cx13( rho, grho, sx, v1x, v2x )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho, grho
REAL(DP), INTENT(OUT) :: sx, v1x, v2x
!
@ -1516,7 +1535,6 @@ END SUBROUTINE cx13
!
!-----------------------------------------------------------------------
SUBROUTINE becke88_spin( rho_up, rho_dw, grho_up, grho_dw, sx_up, sx_dw, v1x_up, v1x_dw, v2x_up, v2x_dw )
!$acc routine (becke88_spin) seq
!-----------------------------------------------------------------------
!! Becke exchange: A.D. Becke, PRA 38, 3098 (1988) - Spin polarized case
!
@ -1524,6 +1542,8 @@ SUBROUTINE becke88_spin( rho_up, rho_dw, grho_up, grho_dw, sx_up, sx_dw, v1x_up,
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP), INTENT(IN) :: rho_up, rho_dw
!! charge
REAL(DP), INTENT(IN) :: grho_up, grho_dw
@ -1577,7 +1597,6 @@ END SUBROUTINE becke88_spin
!
!-----------------------------------------------------------------------------
SUBROUTINE wpbe_analy_erfc_approx_grad( rho, s, omega, Fx_wpbe, d1rfx, d1sfx )
!$acc routine (wpbe_analy_erfc_approx_grad) seq
!-----------------------------------------------------------------------
!! wPBE Enhancement Factor (erfc approx.,analytical, gradients).
!
@ -1585,6 +1604,8 @@ SUBROUTINE wpbe_analy_erfc_approx_grad( rho, s, omega, Fx_wpbe, d1rfx, d1sfx )
!
IMPLICIT NONE
!
!$acc routine seq
!
REAL(DP) rho,s,omega,Fx_wpbe,d1sfx,d1rfx
!
REAL(DP) f12,f13,f14,f18,f23,f43,f32,f72,f34,f94,f1516,f98
@ -2170,7 +2191,6 @@ END SUBROUTINE wpbe_analy_erfc_approx_grad
!
!------------------------------------------------------------------
FUNCTION EXPINT(n, x)
!$acc routine (expint) seq
!-----------------------------------------------------------------------
!! Evaluates the exponential integral \(E_n(x)\).
!! Inspired by Numerical Recipes.
@ -2181,6 +2201,7 @@ FUNCTION EXPINT(n, x)
!
USE kind_l, ONLY: DP
IMPLICIT NONE
!$acc routine seq
INTEGER, INTENT(IN) :: n
REAL(DP), INTENT(IN) :: x
REAL(DP) :: expint