1!
2! Copyright (C) 2006 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!
9!----------------------------------------------------------------------------
10SUBROUTINE transform_becsum_nc( becsum_nc, becsum, na )
11  !----------------------------------------------------------------------------
12  !! This routine multiply becsum_nc by the identity and the Pauli
13  !! matrices and saves it in becsum for the calculation of
14  !! augmentation charge and magnetization.
15  !
16  USE kinds,                ONLY : DP
17  USE ions_base,            ONLY : nat, ntyp => nsp, ityp
18  USE uspp_param,           ONLY : nh, nhm
19  USE lsda_mod,             ONLY : nspin
20  USE noncollin_module,     ONLY : npol, nspin_mag
21  USE spin_orb,             ONLY : domag
22  !
23  IMPLICIT NONE
24  !
25  COMPLEX(DP) :: becsum_nc(nhm*(nhm+1)/2,nat,npol,npol)
26  !! input: becsum contains \sum_i <\psi_i | \beta_n><\beta_m| \psi_i > + (m-n)
27  REAL(DP) :: becsum(nhm*(nhm+1)/2,nat,nspin_mag)
28  !! output: see routine comments.
29  INTEGER :: na
30  !! input: number of atoms
31  !
32  ! ... local variables
33  !
34  INTEGER :: ih, jh, ijh, np
35  !
36np=ityp(na)
37ijh=1
38DO ih = 1, nh(np)
39   becsum(ijh,na,1)= becsum(ijh,na,1)+  &
40               becsum_nc(ijh,na,1,1)+becsum_nc(ijh,na,2,2)
41   IF (domag) THEN
42      becsum(ijh,na,2)= becsum(ijh,na,2)+  &
43               becsum_nc(ijh,na,1,2)+becsum_nc(ijh,na,2,1)
44      becsum(ijh,na,3)= becsum(ijh,na,3)+(0.d0,-1.d0)*  &
45              (becsum_nc(ijh,na,1,2)-becsum_nc(ijh,na,2,1))
46      becsum(ijh,na,4)= becsum(ijh,na,4)+  &
47               becsum_nc(ijh,na,1,1)-becsum_nc(ijh,na,2,2)
48   END IF
49   ijh=ijh+1
50   DO jh = ih+1, nh(np)
51      becsum(ijh,na,1)= becsum(ijh,na,1) +     &
52                 (becsum_nc(ijh,na,1,1)+becsum_nc(ijh,na,2,2))  &
53                + CONJG(becsum_nc(ijh,na,1,1)+becsum_nc(ijh,na,2,2))
54      IF (domag) THEN
55         becsum(ijh,na,2)= becsum(ijh,na,2) +     &
56                  becsum_nc(ijh,na,1,2)+becsum_nc(ijh,na,2,1)   &
57                + CONJG(becsum_nc(ijh,na,2,1)+becsum_nc(ijh,na,1,2))
58         becsum(ijh,na,3)= becsum(ijh,na,3) +(0.d0,-1.d0)*     &
59                 (becsum_nc(ijh,na,1,2)-becsum_nc(ijh,na,2,1)   &
60                + CONJG(becsum_nc(ijh,na,2,1)-becsum_nc(ijh,na,1,2)) )
61         becsum(ijh,na,4)= becsum(ijh,na,4) +     &
62                 (becsum_nc(ijh,na,1,1)-becsum_nc(ijh,na,2,2))  &
63                + CONJG(becsum_nc(ijh,na,1,1)-becsum_nc(ijh,na,2,2))
64      END IF
65      ijh=ijh+1
66   END DO
67END DO
68
69RETURN
70END SUBROUTINE transform_becsum_nc
71