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