1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
!
! Copyright (C) 2001-2016 Quantum ESPRESSO group
! 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 setup_dmuxc
!-----------------------------------------------------------------------
!! This subroutine computes dmuxc (derivative of the XC potential).
!
USE kinds, ONLY : DP
USE eqv, ONLY : dmuxc
USE lsda_mod, ONLY : lsda
USE fft_base, ONLY : dfftp
USE scf, ONLY : rho, rho_core
USE noncollin_module, ONLY : noncolin, nspin_mag
USE spin_orb, ONLY : domag
!
IMPLICIT NONE
!
REAL(DP), ALLOCATABLE, DIMENSION(:,:) :: rho_aux
! auxiliary array for density
INTEGER :: ir, is, js, ns
!
CALL start_clock ('setup_dmuxc')
!
ns = 1
IF ( lsda ) ns = 2
IF ( (.NOT. lsda) .AND. noncolin .AND. domag ) ns = 4
!
ALLOCATE( rho_aux(dfftp%nnr,ns) )
!
dmuxc(:,:,:) = 0.d0
!
IF ( lsda ) THEN
!
rho_aux(:,1) = ( rho%of_r(:,1) + rho%of_r(:,2) + rho_core(:) )*0.5_DP
rho_aux(:,2) = ( rho%of_r(:,1) - rho%of_r(:,2) + rho_core(:) )*0.5_DP
!
CALL dmxc( dfftp%nnr, 2, rho_aux, dmuxc )
!
ELSE
!
IF ( noncolin .AND. domag ) THEN
!
rho_aux(:,1) = rho%of_r(:,1) + rho_core(:)
rho_aux(:,2:4) = rho%of_r(:,2:4)
CALL dmxc( dfftp%nnr, 4, rho_aux, dmuxc )
!
ELSE
!
rho_aux(:,1) = rho%of_r(:,1) + rho_core(:)
CALL dmxc( dfftp%nnr, 1, rho_aux, dmuxc )
!
ENDIF
!
ENDIF
!
DEALLOCATE( rho_aux )
!
CALL stop_clock ('setup_dmuxc')
!
RETURN
!
END SUBROUTINE setup_dmuxc
|
