1
2! Copyright (C) 2012 Quantum-Espresso group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!----------------------------------------------------------------------
9SUBROUTINE transform_qq_so(qq,qq_so)
10  !----------------------------------------------------------------------
11  !
12  !
13  USE kinds,        ONLY : DP
14  USE ions_base,    ONLY : ntyp => nsp
15  USE uspp_param,   ONLY : upf, nhm, nh
16  USE spin_orb,     ONLY : lspinorb, fcoef
17  !
18  implicit none
19  !
20  !     here a few local variables
21  !
22  integer :: nt, ih, jh, kh, lh, ijs, is1, is2, is
23  complex(DP) :: qq(nhm,nhm,ntyp), qq_so(nhm,nhm,4,ntyp)
24
25  qq_so=(0.0_DP, 0.0_DP)
26  DO nt = 1, ntyp
27    IF ( upf(nt)%tvanp ) THEN
28      IF (upf(nt)%has_so) THEN
29        DO ih=1,nh(nt)
30          DO jh=1,nh(nt)
31            DO kh=1,nh(nt)
32              DO lh=1,nh(nt)
33                ijs=0
34                DO is1=1,2
35                  DO is2=1,2
36                    ijs=ijs+1
37                    DO is=1,2
38                      qq_so(kh,lh,ijs,nt) = qq_so(kh,lh,ijs,nt)       &
39                          + qq(ih,jh,nt)*fcoef(kh,ih,is1,is,nt)&
40                                               *fcoef(jh,lh,is,is2,nt)
41                    ENDDO
42                  ENDDO
43                ENDDO
44              ENDDO
45            ENDDO
46          ENDDO
47        ENDDO
48      ELSE
49        DO ih = 1, nh (nt)
50          DO jh = ih, nh (nt)
51             IF (lspinorb) THEN
52                 qq_so (ih, jh, 1, nt) = qq (ih, jh, nt)
53                 qq_so (jh, ih, 1, nt) = qq_so (ih, jh, 1, nt)
54                 qq_so (ih, jh, 4, nt) = qq_so (ih, jh, 1, nt)
55                 qq_so (jh, ih, 4, nt) = qq_so (ih, jh, 4, nt)
56             ENDIF
57          ENDDO
58        ENDDO
59      ENDIF
60    ENDIF
61  ENDDO
62
63  RETURN
64END SUBROUTINE transform_qq_so
65