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

Merge branch 'beef_acc_workaround' into 'develop' 

Beef acc workaround

See merge request QEF/q-e!1554
This commit is contained in:
Ye Luo 2021-09-17 14:09:06 +00:00
parent b491033ad3 1ca8f30c9a
commit 66e154a149
3 changed files with 258 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
XClib/qe_drivers_d_gga.f90
View File

@ -35,7 +35,7 @@ SUBROUTINE dgcxc_unpol( length, r_in, s2_in, vrrx, vsrx, vssx, vrrc, vsrc, vssc
!! This routine computes the derivative of the exchange and correlation
!! potentials of GGA family.
!
USE qe_drivers_gga, ONLY: gcxc
USE qe_drivers_gga, ONLY: gcxc, gcxc_beef
!
IMPLICIT NONE
!
@ -92,6 +92,9 @@ SUBROUTINE dgcxc_unpol( length, r_in, s2_in, vrrx, vsrx, vssx, vrrc, vsrc, vssc
!
CALL gcxc( length*4, raux, s2aux, sx, sc, v1x, v2x, v1c, v2c )
!
IF ( igcx==43 .OR. igcc==14 ) CALL gcxc_beef( length*4, raux, s2aux, &
sx, sc, v1x, v2x, v1c, v2c )
!
! ... to avoid NaN in the next operations
WHERE( r_in<=small .OR. s2_in<=small )
dr = 1._DP ; ds = 1._DP ; s = 1._DP
@ -126,7 +129,7 @@ SUBROUTINE dgcxc_spin( length, r_in, g_in, vrrx, vrsx, vssx, vrrc, vrsc, &
!! This routine computes the derivative of the exchange and correlation
!! potentials in the spin-polarized case.
!
USE qe_drivers_gga, ONLY: gcx_spin, gcc_spin
USE qe_drivers_gga, ONLY: gcx_spin, gcc_spin, gcx_spin_beef, gcc_spin_beef
!
IMPLICIT NONE
!
@ -236,7 +239,8 @@ SUBROUTINE dgcxc_spin( length, r_in, g_in, vrrx, vrsx, vssx, vrrc, vrsc, &
raux(i8:f8,:) = r ; s2aux(i8:f8,:) = (s-dsdw)**2
!
!
CALL gcx_spin( length*8, raux, s2aux, sx, v1x, v2x )
IF ( igcx/=43 ) CALL gcx_spin( length*8, raux, s2aux, sx, v1x, v2x )
IF ( igcx==43 ) CALL gcx_spin_beef( length*8, raux, s2aux, sx, v1x, v2x )
!
! ... up
vrrx(:,1) = 0.5_DP * (v1x(i1:f1,1) - v1x(i2:f2,1)) / drup(:,1)
@ -307,7 +311,8 @@ SUBROUTINE dgcxc_spin( length, r_in, g_in, vrrx, vrsx, vssx, vrrc, vrsc, &
rtaux(i5:f5) = rt ; s2taux(i5:f5) = s2t ; zetaux(i5:f5) = zeta+dz
rtaux(i6:f6) = rt ; s2taux(i6:f6) = s2t ; zetaux(i6:f6) = zeta-dz
!
CALL gcc_spin( length*6, rtaux, zetaux, s2taux, sc, v1c, v2c )
IF ( igcc/=14 ) CALL gcc_spin( length*6, rtaux, zetaux, s2taux, sc, v1c, v2c )
IF ( igcc==14 ) CALL gcc_spin_beef( length*6, rtaux, zetaux, s2taux, sc, v1c, v2c )
!
vrrc(:,1) = 0.5_DP * (v1c(i1:f1,1) - v1c(i2:f2,1)) / dr * null_v(:,1)
vrrc(:,2) = 0.5_DP * (v1c(i1:f1,2) - v1c(i2:f2,2)) / dr * null_v(:,1)

306
XClib/qe_drivers_gga.f90
View File

@ -25,14 +25,15 @@ MODULE qe_drivers_gga
!
PRIVATE
!
PUBLIC :: gcxc, gcx_spin, gcc_spin, gcc_spin_more
PUBLIC :: gcxc, gcx_spin, gcc_spin, gcc_spin_more, gcxc_beef, gcx_spin_beef, &
gcc_spin_beef
!
!
CONTAINS
!
!-----------------------------------------------------------------------
SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, &
v2x_out, v1c_out, v2c_out )
v2x_out, v1c_out, v2c_out )
!---------------------------------------------------------------------
!! Gradient corrections for exchange and correlation - Hartree a.u.
!! See comments at the beginning of module for implemented cases
@ -81,10 +82,6 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, &
!
!
#if defined(_OPENACC)
!
IF (igcx==43 .OR. igcc==14) CALL xclib_error( 'gcxc', 'BEEF not available with&
& OpenACC enabled', 1 )
!
!$acc data copyin(rho_in,grho_in), copyout(sx_out,sc_out,v1x_out,v2x_out,v1c_out,v2c_out)
!$acc parallel loop
#endif
@ -301,13 +298,6 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, &
v2x = (1.0_DP - exx_fraction) * v2x
ENDIF
!
#if !defined(_OPENACC)
CASE( 43 ) ! 'beefx' --- BEEF unavailable with OpenACC-- Will be enabled soon
! last parameter = 0 means do not add LDA (=Slater) exchange
! (espresso) will add it itself
CALL beefx(rho, grho, sx, v1x, v2x, 0)
#endif
!
CASE( 44 ) ! 'RPBE'
!
CALL pbex( rho, grho, 8, sx, v1x, v2x )
@ -379,13 +369,6 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, &
v2c = 0.871_DP * v2c
ENDIF
!
#if !defined(_OPENACC)
CASE( 14 ) ! BEEF unavailable with OpenACC-- Will be enabled soon
! last parameter 0 means: do not add lda contributions
! espresso will do that itself
call beeflocalcorr(rho, grho, sc, v1c, v2c, 0)
#endif
!
CASE DEFAULT
!
sc = 0.0_DP
@ -399,14 +382,12 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, &
v2x_out(ir) = v2x ; v2c_out(ir) = v2c
!
ENDDO
#if defined(_OPENMP) && !defined(_OPENACC)
#if defined(_OPENACC)
!$acc end data
#else
!$omp end do
!$omp end parallel
#endif
#if defined(_OPENACC)
!$acc end data
#endif
!
!
RETURN
!
@ -462,14 +443,9 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out )
sx_tot = 0.0_DP
!
#if defined(_OPENACC)
!
IF (igcx==43) CALL xclib_error( 'gcx_spin', 'BEEF not available with&
& OpenACC enabled', 1 )
!
!$acc data copyin(rho_in, grho2_in), copyout(sx_tot, v1x_out, v2x_out)
!$acc parallel loop
#endif
#if defined(_OPENMP) && !defined(_OPENACC)
#else
!$omp parallel if(ntids==1) default(none) &
!$omp private( rho_up, rho_dw, grho2_up, grho2_dw, rnull_up, rnull_dw, &
!$omp sx_up, sx_dw, sxsr_up, sxsr_dw, v1xsr_up, v1xsr_dw, &
@ -480,7 +456,6 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out )
!$omp gau_parameter )
!$omp do
#endif
!
DO ir = 1, length
!
rho_up = rho_in(ir,1)
@ -846,24 +821,11 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out )
v2x_dw = (1.0_DP - exx_fraction) * v2x_dw
ENDIF
!
#if !defined(_OPENACC)
CASE( 43 ) ! 'beefx' --- BEEF unavailable with OpenACC-- Will be enabled soon
!
rho_up = 2.0_DP * rho_up ; rho_dw = 2.0_DP * rho_dw
grho2_up = 4.0_DP * grho2_up ; grho2_dw = 4.0_DP * grho2_dw
! case igcx == 5 (HCTH) and 6 (OPTX) not implemented
! case igcx == 7 (meta-GGA) must be treated in a separate call to another
! routine: needs kinetic energy density in addition to rho and grad rho
!
CALL beefx(rho_up, grho2_up, sx_up, v1x_up, v2x_up, 0)
CALL beefx(rho_dw, grho2_dw, sx_dw, v1x_dw, v2x_dw, 0)
!
sx_tot(ir) = 0.5_DP * (sx_up*rnull_up + sx_dw*rnull_dw)
v2x_up = 2.0_DP * v2x_up
v2x_dw = 2.0_DP * v2x_dw
#endif
!
! case igcx == 5 (HCTH) and 6 (OPTX) not implemented
! case igcx == 7 (meta-GGA) must be treated in a separate call to another
! routine: needs kinetic energy density in addition to rho and grad rho
!
CASE DEFAULT
!
sx_tot(ir) = 0.0_DP
@ -878,12 +840,11 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out )
v2x_out(ir,2) = v2x_dw * rnull_dw
!
ENDDO
#if defined(_OPENMP) && !defined(_OPENACC)
!$omp end do
!$omp end parallel
#endif
#if defined(_OPENACC)
!$acc end data
#else
!$omp end do
!$omp end parallel
#endif
!
!
@ -933,13 +894,9 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out
#endif
!
#if defined(_OPENACC)
IF (igcc==14) CALL xclib_error( 'gcc_spin', 'BEEF not available with&
& OpenACC enabled', 1 )
!
!$acc data copyin(rho_in, grho_in), copyout(sc_out, v1c_out, v2c_out), copy(zeta_io)
!$acc parallel loop
#endif
#if defined(_OPENMP) && !defined(_OPENACC)
#else
!$omp parallel if(ntids==1) default(none) &
!$omp private( rho, zeta, grho, sc, v1c_up, v1c_dw, v2c ) &
!$omp shared( igcc, sc_out, v1c_out, v2c_out, &
@ -987,12 +944,6 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out
!
CALL pbec_spin( rho, zeta, grho, 2, sc, v1c_up, v1c_dw, v2c )
!
#if !defined(_OPENACC)
CASE( 14 ) !*****BEEF unavailable with OpenACC-- Will be enabled soon
!
call beeflocalcorrspin(rho, zeta, grho, sc, v1c_up, v1c_dw, v2c, 0)
#endif
!
CASE DEFAULT
!
sc = 0.0_DP
@ -1008,12 +959,11 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out
v2c_out(ir) = v2c
!
ENDDO
#if defined(_OPENMP) && !defined(_OPENACC)
!$omp end do
!$omp end parallel
#endif
#if defined(_OPENACC)
!$acc end data
#else
!$omp end do
!$omp end parallel
#endif
!
RETURN
@ -1076,8 +1026,7 @@ SUBROUTINE gcc_spin_more( length, rho_in, grho_in, grho_ud_in, &
#if defined(_OPENACC)
!$acc data copyin(rho_in, grho_in, grho_ud_in), copyout(sc, v1c, v2c, v2c_ud)
!$acc parallel loop
#endif
#if defined(_OPENMP) && !defined(_OPENACC)
#else
!$omp parallel if(ntids==1) default(none) &
!$omp private( rho_up, rho_dw, grho_up, grho_dw, grho_ud ) &
!$omp shared( length, rho_in, grho_in, grho_ud_in, &
@ -1139,17 +1088,228 @@ SUBROUTINE gcc_spin_more( length, rho_in, grho_in, grho_ud_in, &
END SELECT
!
ENDDO
#if defined(_OPENMP) && !defined(_OPENACC)
#if defined(_OPENACC)
!$acc end data
#else
!$omp end do
!$omp end parallel
#endif
#if defined(_OPENACC)
!$acc end data
#endif
!
RETURN
!
END SUBROUTINE gcc_spin_more
!
!
! ========> BEEF GGA DRIVERS <========================
!
!------------------------------------------------------------------------
SUBROUTINE gcxc_beef( length, rho_in, grho_in, sx_out, sc_out, v1x_out, &
v2x_out, v1c_out, v2c_out )
!---------------------------------------------------------------------
!! Driver for BEEF gga xc terms. Unpolarized case.
!
USE beef_interface, ONLY: beefx, beeflocalcorr
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: length
REAL(DP), INTENT(IN), DIMENSION(length) :: rho_in
REAL(DP), INTENT(IN), DIMENSION(length) :: grho_in
REAL(DP), INTENT(OUT), DIMENSION(length) :: sx_out, sc_out
REAL(DP), INTENT(OUT), DIMENSION(length) :: v1x_out, v2x_out
REAL(DP), INTENT(OUT), DIMENSION(length) :: v1c_out, v2c_out
!
! ... local variables
!
INTEGER :: ir
REAL(DP) :: rho, grho
REAL(DP) :: sx, v1x, v2x
REAL(DP) :: sc, v1c, v2c
!
IF (igcx == 43 .OR. igcc == 14) THEN
!
DO ir = 1, length
grho = grho_in(ir)
IF ( rho_in(ir) <= rho_threshold_gga .OR. grho <= grho_threshold_gga ) THEN
sx_out(ir) = 0.0_DP ; sc_out(ir) = 0.0_DP
v1x_out(ir) = 0.0_DP ; v1c_out(ir) = 0.0_DP
v2x_out(ir) = 0.0_DP ; v2c_out(ir) = 0.0_DP
CYCLE
ENDIF
!
rho = ABS(rho_in(ir))
!
IF ( igcx == 43 ) THEN
! last parameter = 0 means do not add LDA (=Slater) exchange
! (espresso) will add it itself
CALL beefx( rho, grho, sx, v1x, v2x, 0 )
sx_out(ir) = sx
v1x_out(ir) = v1x
v2x_out(ir) = v2x
ENDIF
!
IF ( igcc == 14 ) THEN
! last parameter 0 means: do not add lda contributions
! espresso will do that itself
CALL beeflocalcorr( rho, grho, sc, v1c, v2c, 0 )
sc_out(ir) = sc
v1c_out(ir) = v1c
v2c_out(ir) = v2c
ENDIF
ENDDO
!
ENDIF
!
RETURN
!
END SUBROUTINE gcxc_beef
!
!-----------------------------------------------------------------------------
SUBROUTINE gcx_spin_beef( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out )
!--------------------------------------------------------------------------
!! Driver for BEEF gga exchange term. Polarized case.
!
USE beef_interface, ONLY: beefx
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: length
REAL(DP), INTENT(IN), DIMENSION(length,2) :: rho_in
REAL(DP), INTENT(IN), DIMENSION(length,2) :: grho2_in
REAL(DP), INTENT(OUT), DIMENSION(length) :: sx_tot
REAL(DP), INTENT(OUT), DIMENSION(length,2) :: v1x_out
REAL(DP), INTENT(OUT), DIMENSION(length,2) :: v2x_out
!
! ... local variables
!
INTEGER :: ir, is, iflag
REAL(DP) :: rho_up, rho_dw, grho2_up, grho2_dw
REAL(DP) :: v1x_up, v1x_dw, v2x_up, v2x_dw
REAL(DP) :: sx_up, sx_dw, rnull_up, rnull_dw
REAL(DP) :: sxsr_up, sxsr_dw
REAL(DP) :: v1xsr_up, v1xsr_dw, v2xsr_up, v2xsr_dw
!
REAL(DP), PARAMETER :: small=1.D-10
REAL(DP), PARAMETER :: rho_trash=0.5_DP, grho2_trash=0.2_DP
! ... Temporary workaround for BEEF, which does not support GPU.
IF ( igcx == 43 ) THEN
!
DO ir = 1, length
!
rho_up = rho_in(ir,1)
rho_dw = rho_in(ir,2)
grho2_up = grho2_in(ir,1)
grho2_dw = grho2_in(ir,2)
rnull_up = 1.0_DP
rnull_dw = 1.0_DP
!
IF ( rho_up+rho_dw <= small ) THEN
sx_tot(ir) = 0.0_DP
v1x_out(ir,1) = 0.0_DP
v2x_out(ir,1) = 0.0_DP
v1x_out(ir,2) = 0.0_DP
v2x_out(ir,2) = 0.0_DP
CYCLE
ELSE
IF ( rho_up<=small .OR. SQRT(ABS(grho2_up))<=small ) THEN
rho_up = rho_trash
grho2_up = grho2_trash
rnull_up = 0.0_DP
ENDIF
IF ( rho_dw<=small .OR. SQRT(ABS(grho2_dw))<=small ) THEN
rho_dw = rho_trash
grho2_dw = grho2_trash
rnull_dw = 0.0_DP
ENDIF
ENDIF
!
rho_up = 2.0_DP * rho_up ; rho_dw = 2.0_DP * rho_dw
grho2_up = 4.0_DP * grho2_up ; grho2_dw = 4.0_DP * grho2_dw
!
CALL beefx(rho_up, grho2_up, sx_up, v1x_up, v2x_up, 0)
CALL beefx(rho_dw, grho2_dw, sx_dw, v1x_dw, v2x_dw, 0)
!
sx_tot(ir) = 0.5_DP * (sx_up*rnull_up + sx_dw*rnull_dw)
v2x_up = 2.0_DP * v2x_up
v2x_dw = 2.0_DP * v2x_dw
!
v1x_out(ir,1) = v1x_up * rnull_up
v1x_out(ir,2) = v1x_dw * rnull_dw
v2x_out(ir,1) = v2x_up * rnull_up
v2x_out(ir,2) = v2x_dw * rnull_dw
!
ENDDO
!
ENDIF
!
RETURN
!
END SUBROUTINE gcx_spin_beef
!
!
!--------------------------------------------------------------------------------
SUBROUTINE gcc_spin_beef( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out )
!-------------------------------------------------------------------------------
!! BEEF Gradient correction.
!
USE beef_interface, ONLY: beeflocalcorrspin
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: length
REAL(DP), INTENT(IN), DIMENSION(length) :: rho_in
REAL(DP), INTENT(INOUT), DIMENSION(length) :: zeta_io
REAL(DP), INTENT(IN), DIMENSION(length) :: grho_in
REAL(DP), INTENT(OUT), DIMENSION(length) :: sc_out
REAL(DP), INTENT(OUT), DIMENSION(length,2) :: v1c_out
REAL(DP), INTENT(OUT), DIMENSION(length) :: v2c_out
!
! ... local variables
!
INTEGER :: ir
REAL(DP) :: rho, zeta, grho
REAL(DP) :: sc, v1c_up, v1c_dw, v2c
!
IF ( igcc == 14 ) THEN
!
DO ir = 1, length
!
rho = rho_in(ir)
grho = grho_in(ir)
IF ( ABS(zeta_io(ir))<=1.0_DP ) zeta_io(ir) = SIGN( MIN(ABS(zeta_io(ir)), &
(1.0_DP-rho_threshold_gga)), zeta_io(ir) )
zeta = zeta_io(ir)
!
IF ( ABS(zeta)>1.0_DP .OR. rho<=rho_threshold_gga .OR. &
SQRT(ABS(grho))<=rho_threshold_gga ) THEN
sc_out(ir) = 0.0_DP
v1c_out(ir,1) = 0.0_DP ; v2c_out(ir) = 0.0_DP
v1c_out(ir,2) = 0.0_DP
CYCLE
ENDIF
rho = rho_in(ir)
grho = grho_in(ir)
zeta = zeta_io(ir)
!
IF ( ABS(zeta)>1.0_DP .OR. rho<=rho_threshold_gga .OR. &
SQRT(ABS(grho))<=rho_threshold_gga ) CYCLE
!
CALL beeflocalcorrspin( rho, zeta, grho, sc, v1c_up, v1c_dw, v2c, 0 )
!
sc_out(ir) = sc
v1c_out(ir,1) = v1c_up
v1c_out(ir,2) = v1c_dw
v2c_out(ir) = v2c
!
ENDDO
!
ENDIF
!
RETURN
!
END SUBROUTINE gcc_spin_beef
!
!
END MODULE qe_drivers_gga

22
XClib/xc_wrapper_gga.f90
View File

@ -86,7 +86,6 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
ec = 0.0_DP ; v1c = 0.0_DP ; v2c = 0.0_DP
IF ( PRESENT(v2c_ud) ) v2c_ud = 0.0_DP
!
!
#if defined(__LIBXC)
!
fkind_x = -1
@ -136,7 +135,10 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
!
IF ( ns==1 .AND. ANY(.NOT.is_libxc(3:4)) ) THEN
!
CALL gcxc( length, ABS(rho(:,1)), sigma, ex, ec, v1x(:,1), v2x(:,1), v1c(:,1), v2c(:,1) )
CALL gcxc( length, ABS(rho(:,1)), sigma, ex, ec, v1x(:,1), v2x(:,1), v1c(:,1), v2c(:,1) )
!
IF ( igcx==43 .OR. igcc==14 ) CALL gcxc_beef( length, ABS(rho(:,1)), grho2(:,1), ex, ec, &
v1x(:,1), v2x(:,1), v1c(:,1), v2c(:,1) )
!
DO k = 1, length
sgn(1) = SIGN(1._DP, rho(k,1))
@ -215,7 +217,8 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
( grho(2,:,1) + grho(2,:,2) )**2 + &
( grho(3,:,1) + grho(3,:,2) )**2
!
CALL gcc_spin( length, rh, zeta, grho2(:,1), ec, v1c, v2c(:,1) )
IF ( igcc/=14 ) CALL gcc_spin( length, rh, zeta, grho2(:,1), ec, v1c, v2c(:,1) )
IF ( igcc==14 ) CALL gcc_spin_beef( length, rh, zeta, grho2(:,1), ec, v1c, v2c(:,1) )
!
v2c(:,2) = v2c(:,1)
IF ( PRESENT(v2c_ud) ) v2c_ud(:) = v2c(:,1)
@ -263,7 +266,8 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
grho2(:,is) = grho(1,:,is)**2 + grho(2,:,is)**2 + grho(3,:,is)**2
ENDDO
!
CALL gcx_spin( length, rho, grho2, ex, v1x, v2x )
IF ( igcx/=43 ) CALL gcx_spin( length, rho, grho2, ex, v1x, v2x )
IF ( igcx==43 ) CALL gcx_spin_beef( length, rho, grho2, ex, v1x, v2x )
!
ENDIF
!
@ -293,6 +297,9 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
!
CALL gcxc( length, ABS(rho(:,1)), grho2(:,1), ex, ec, v1x(:,1), v2x(:,1), v1c(:,1), v2c(:,1) )
!
IF ( igcx==43 .OR. igcc==14 ) CALL gcxc_beef( length, ABS(rho(:,1)), grho2(:,1), ex, ec, &
v1x(:,1), v2x(:,1), v1c(:,1), v2c(:,1) )
!
DO k = 1, length
sgn(1) = SIGN(1._DP, rho(k,1))
ex(k) = ex(k) * sgn(1)
@ -305,7 +312,8 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
grho2(:,is) = grho(1,:,is)**2 + grho(2,:,is)**2 + grho(3,:,is)**2
ENDDO
!
CALL gcx_spin( length, rho, grho2, ex, v1x, v2x )
IF ( igcx/=43 ) CALL gcx_spin( length, rho, grho2, ex, v1x, v2x )
IF ( igcx==43 ) CALL gcx_spin_beef( length, rho, grho2, ex, v1x, v2x )
!
IF (igcc==3 .OR. igcc==7 .OR. igcc==13 ) THEN
!
@ -333,7 +341,9 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
( grho(2,:,1) + grho(2,:,2) )**2 + &
( grho(3,:,1) + grho(3,:,2) )**2
!
CALL gcc_spin( length, rh, zeta, grho2(:,1), ec, v1c, v2c(:,1) )
IF ( igcc/=14 ) CALL gcc_spin( length, rh, zeta, grho2(:,1), ec, v1c, v2c(:,1) )
IF ( igcc==14 ) CALL gcc_spin_beef( length, rh, zeta, grho2(:,1), ec, v1c, v2c(:,1) )
!
v2c(:,2) = v2c(:,1)
IF ( PRESENT(v2c_ud) ) v2c_ud(:) = v2c(:,1)