xc_deriv - gga_d_wrapper with openacc

This commit is contained in:
fabrizio22 2021-12-20 13:04:48 +01:00
parent 9dbe7a8cdc
commit 188db86322
4 changed files with 69 additions and 8 deletions

View File

@ -22,7 +22,7 @@ SUBROUTINE setup_dgc
USE noncollin_module, ONLY : noncolin, domag, ux, nspin_gga, nspin_mag
USE wavefunctions, ONLY : psic
USE kinds, ONLY : DP
USE xc_lib, ONLY : xclib_dft_is, xc_gcx
USE xc_lib, ONLY : xclib_dft_is, xc_gcx, dgcxc
USE uspp, ONLY : nlcc_any
USE gc_lr, ONLY : grho, gmag, dvxc_rr, dvxc_sr, &
dvxc_ss, dvxc_s, vsgga, segni

View File

@ -1801,7 +1801,7 @@ MODULE paw_onecenter
USE lsda_mod, ONLY : nspin
USE atom, ONLY : g => rgrid
USE constants, ONLY : pi,e2, eps => eps12, eps2 => eps24
USE xc_lib, ONLY : xclib_set_threshold, xc_gcx
USE xc_lib, ONLY : xclib_set_threshold, xc_gcx, dgcxc
!
TYPE(paw_info), INTENT(IN) :: i
!! atom's minimal info

View File

@ -21,7 +21,7 @@ MODULE xc_lib
!
PUBLIC :: xc, dmxc !LDA
!
PUBLIC :: xc_gcx !, dgcxc !GGA
PUBLIC :: xc_gcx, dgcxc !GGA
!
PUBLIC :: xc_metagcx !MGGA
!
@ -113,5 +113,20 @@ MODULE xc_lib
END SUBROUTINE
END INTERFACE
!
!
INTERFACE dgcxc
SUBROUTINE dgcxc( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss, gpu_args_ )
USE kind_l, ONLY: DP
IMPLICIT NONE
INTEGER, INTENT(IN) :: length
INTEGER, INTENT(IN) :: sp
REAL(DP), INTENT(IN) :: r_in(length,sp)
REAL(DP), INTENT(IN) :: g_in(length,3,sp)
REAL(DP), INTENT(OUT) :: dvxc_rr(length,sp,sp), dvxc_sr(length,sp,sp), &
dvxc_ss(length,sp,sp)
LOGICAL, OPTIONAL, INTENT(IN) :: gpu_args_
END SUBROUTINE
END INTERFACE
!
END MODULE xc_lib
!--------------------------------------------------

View File

@ -5,12 +5,58 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!-----------------------------------------------------------------------
!------- DRIVERS FOR DERIVATIVES OF XC POTENTIAL (GGA CASE) ------------
!-----------------------------------------------------------------------
!---------------------------------------------------------------------
SUBROUTINE dgcxc( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss, gpu_args_ )
!---------------------------------------------------------------------
!! Wrapper routine. Calls dgcx-driver routines from internal libraries
!! or from the external libxc, depending on the input choice.
!
USE kind_l, ONLY: DP
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: length
!! length of the I/O arrays
INTEGER, INTENT(IN) :: sp
!! number of spin components
REAL(DP), INTENT(IN) :: r_in(length,sp)
!! charge density
REAL(DP), INTENT(IN) :: g_in(length,3,sp)
!! gradient
REAL(DP), INTENT(OUT) :: dvxc_rr(length,sp,sp), dvxc_sr(length,sp,sp), &
dvxc_ss(length,sp,sp)
LOGICAL, OPTIONAL, INTENT(IN) :: gpu_args_
!! whether you wish to run on gpu in case use_gpu is true
!
LOGICAL :: gpu_args
!
gpu_args = .FALSE.
IF ( PRESENT(gpu_args_) ) gpu_args = gpu_args_
!
IF ( gpu_args ) THEN
!
!$acc data present( r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
! !$acc host_data use_device( r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
CALL dgcxc_( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
! !$acc end host_data
!$acc end data
!
ELSE
!
!$acc data copyin( r_in, g_in ), copyout( dvxc_rr, dvxc_sr, dvxc_ss )
! !$acc host_data use_device( r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
CALL dgcxc_( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
! !$acc end host_data
!$acc end data
!
ENDIF
!
RETURN
END SUBROUTINE
!
!---------------------------------------------------------------------
SUBROUTINE dgcxc( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
SUBROUTINE dgcxc_( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
!---------------------------------------------------------------------
!! Wrapper routine. Calls dgcx-driver routines from internal libraries
!! or from the external libxc, depending on the input choice.
@ -350,4 +396,4 @@ SUBROUTINE dgcxc( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
!
RETURN
!
END SUBROUTINE dgcxc
END SUBROUTINE dgcxc_