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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
!
! Copyright (C) 2001-2018 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 apply_dpot(nrxxs, aux1, dv, current_spin)
!
! This routine applies the change of the self consistent potential to
! one wavefunction
!
USE kinds, ONLY : DP
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE spin_orb, ONLY : domag
USE mp_bands, ONLY : me_bgrp
USE fft_base, ONLY : dffts
IMPLICIT NONE
INTEGER, INTENT(IN) :: current_spin, nrxxs
COMPLEX(DP), INTENT(IN) :: dv(nrxxs,nspin_mag)
COMPLEX(DP), INTENT(INOUT) :: aux1(nrxxs,npol)
COMPLEX(DP) :: sup, sdwn
INTEGER :: ir
IF (noncolin) THEN
!
IF ( dffts%has_task_groups ) THEN
!
! Noncollinear part with task groups
!
IF (domag) THEN
DO ir=1, dffts%nr1x*dffts%nr2x*dffts%my_nr3p
sup = aux1(ir,1) * (dv(ir,1)+dv(ir,4)) + &
aux1(ir,2) * (dv(ir,2)-(0.d0,1.d0)*dv(ir,3))
sdwn = aux1(ir,2) * (dv(ir,1)-dv(ir,4)) + &
aux1(ir,1) * (dv(ir,2)+(0.d0,1.d0)*dv(ir,3))
aux1(ir,1)=sup
aux1(ir,2)=sdwn
ENDDO
ELSE
DO ir=1, dffts%nr1x*dffts%nr2x*dffts%my_nr3p
aux1(ir,:) = aux1(ir,:) * dv(ir,1)
ENDDO
ENDIF
!
ELSE
!
! Noncollinear part without task groups
!
IF (domag) then
DO ir = 1, nrxxs
sup=aux1(ir,1)*(dv(ir,1)+dv(ir,4))+ &
aux1(ir,2)*(dv(ir,2)-(0.d0,1.d0)*dv(ir,3))
sdwn=aux1(ir,2)*(dv(ir,1)-dv(ir,4)) + &
aux1(ir,1)*(dv(ir,2)+(0.d0,1.d0)*dv(ir,3))
aux1(ir,1)=sup
aux1(ir,2)=sdwn
ENDDO
ELSE
DO ir = 1, nrxxs
aux1(ir,:)=aux1(ir,:)*dv(ir,1)
ENDDO
ENDIF
!
ENDIF
!
ELSE
!
IF ( dffts%has_task_groups ) THEN
!
! Collinear part with task groups
!
DO ir = 1, dffts%nr1x*dffts%nr2x*dffts%my_nr3p
aux1 (ir,1) = aux1 (ir,1) * dv(ir,1)
ENDDO
!
ELSE
!
! Collinear part without task groups
!
DO ir = 1, nrxxs
aux1(ir,1)=aux1(ir,1)*dv(ir,current_spin)
ENDDO
!
ENDIF
!
ENDIF
!
RETURN
!
END SUBROUTINE apply_dpot
|
