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_int1_so(int1,na,iflag) 11!---------------------------------------------------------------------------- 12! 13! This routine multiply int1 by the identity and the Pauli 14! matrices, rotate it as appropriate for the spin-orbit case 15! and saves it in int1_nc. 16! 17USE kinds, ONLY : DP 18USE ions_base, ONLY : nat, ityp 19USE uspp_param, ONLY : nh, nhm 20USE noncollin_module, ONLY : npol, nspin_mag 21USE spin_orb, ONLY : fcoef, domag 22USE phus, ONLY : int1_nc 23! 24IMPLICIT NONE 25 26INTEGER :: na, iflag 27COMPLEX(DP) :: int1(nhm,nhm,3,nat,nspin_mag) 28! 29! ... local variables 30! 31INTEGER :: ih, jh, lh, kh, ipol, np, is1, is2, ijs 32COMPLEX(DP) :: fact(4) 33LOGICAL :: same_lj 34 35np=ityp(na) 36DO ih = 1, nh(np) 37 DO kh = 1, nh(np) 38 IF (same_lj(kh,ih,np)) THEN 39 DO jh = 1, nh(np) 40 DO lh= 1, nh(np) 41 IF (same_lj(lh,jh,np)) THEN 42 DO ipol=1,3 43 ijs=0 44 DO is1=1,npol 45 DO is2=1,npol 46 ijs=ijs+1 47 IF (iflag==0) THEN 48 fact(1)=int1(kh,lh,ipol,na,1) 49 ELSE 50 fact(1)=CONJG(int1(kh,lh,ipol,na,1)) 51 ENDIF 52 int1_nc(ih,jh,ipol,na,ijs)= & 53 int1_nc(ih,jh,ipol,na,ijs) + & 54 fact(1)* & 55 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,1,is2,np) + & 56 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,2,is2,np) ) 57 IF (domag) THEN 58 IF (iflag==0) THEN 59 fact(2)=int1 (kh,lh,ipol,na,2) 60 fact(3)=int1 (kh,lh,ipol,na,3) 61 fact(4)=int1 (kh,lh,ipol,na,4) 62 ELSE 63 fact(2)=CONJG(int1 (kh,lh,ipol,na,2)) 64 fact(3)=CONJG(int1 (kh,lh,ipol,na,3)) 65 fact(4)=CONJG(int1 (kh,lh,ipol,na,4)) 66 ENDIF 67 int1_nc(ih,jh,ipol,na,ijs)= & 68 int1_nc(ih,jh,ipol,na,ijs) + & 69 fact(2)* & 70 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,2,is2,np)+ & 71 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,1,is2,np))+& 72 (0.D0,-1.D0) * fact(3)* & 73 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,2,is2,np)- & 74 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,1,is2,np))+& 75 fact(4)* & 76 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,1,is2,np)- & 77 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,2,is2,np)) 78 END IF 79 END DO 80 END DO 81 END DO 82 END IF 83 END DO 84 END DO 85 END IF 86 END DO 87END DO 88 ! 89RETURN 90END SUBROUTINE transform_int1_so 91! 92!---------------------------------------------------------------------------- 93SUBROUTINE transform_int2_so(int2,nb,iflag) 94!---------------------------------------------------------------------------- 95! 96! This routine rotates int2 as appropriate for the spin-orbit case 97! and saves it in int2_so. 98! 99USE kinds, ONLY : DP 100USE ions_base, ONLY : nat, ityp 101USE uspp_param, ONLY : nh, nhm 102USE noncollin_module, ONLY : npol 103USE spin_orb, ONLY : fcoef 104USE phus, ONLY : int2_so 105! 106IMPLICIT NONE 107INTEGER :: nb, iflag 108COMPLEX(DP) :: int2(nhm,nhm,3,nat,nat) 109! 110! ... local variables 111! 112INTEGER :: ih, jh, lh, kh, ijs, np, is1, is2, na, ipol 113COMPLEX(DP) :: fact 114LOGICAL :: same_lj 115 116np=ityp(nb) 117DO ih = 1, nh(np) 118 DO kh = 1, nh(np) 119 IF (same_lj(kh,ih,np)) THEN 120 DO jh = 1, nh(np) 121 DO lh= 1, nh(np) 122 IF (same_lj(lh,jh,np)) THEN 123 DO na=1,nat 124 DO ipol=1,3 125 IF (iflag==0) THEN 126 fact=int2(kh,lh,ipol,na,nb) 127 ELSE 128 fact=CONJG(int2(kh,lh,ipol,na,nb)) 129 ENDIF 130 ijs=0 131 DO is1=1,npol 132 DO is2=1,npol 133 ijs=ijs+1 134 int2_so(ih,jh,ipol,na,nb,ijs)= & 135 int2_so(ih,jh,ipol,na,nb,ijs)+ & 136 fact* & 137 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,1,is2,np) + & 138 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,2,is2,np) ) 139 END DO 140 END DO 141 END DO 142 END DO 143 END IF 144 END DO 145 END DO 146 END IF 147 END DO 148END DO 149 ! 150RETURN 151END SUBROUTINE transform_int2_so 152! 153 154!---------------------------------------------------------------------------- 155SUBROUTINE transform_int4_so(int4,na) 156!---------------------------------------------------------------------------- 157! 158! This routine multiply int4 by the identity and the Pauli 159! matrices, rotate it as appropriate for the spin-orbit case 160! and saves it in int4_nc. 161! 162USE kinds, ONLY : DP 163USE ions_base, ONLY : nat, ityp 164USE uspp_param, ONLY : nh, nhm 165USE noncollin_module, ONLY : npol, nspin_mag 166USE uspp, ONLY : ijtoh 167USE spin_orb, ONLY : fcoef, domag 168USE phus, ONLY : int4_nc 169! 170IMPLICIT NONE 171 172INTEGER :: na 173COMPLEX(DP) :: int4(nhm*(nhm+1)/2,3,3,nat,nspin_mag) 174! 175! ... local variables 176! 177INTEGER :: ih, jh, lh, kh, ipol, jpol, np, is1, is2, ijs 178INTEGER :: ijh_l 179LOGICAL :: same_lj 180 181np=ityp(na) 182 183DO ih = 1, nh(np) 184 DO kh = 1, nh(np) 185 IF (same_lj(kh,ih,np)) THEN 186 DO jh = 1, nh(np) 187 DO lh= 1, nh(np) 188 IF (same_lj(lh,jh,np)) THEN 189 ijh_l=ijtoh(kh,lh,np) 190 DO ipol=1,3 191 DO jpol=1,3 192 ijs=0 193 DO is1=1,npol 194 DO is2=1,npol 195 ijs=ijs+1 196 int4_nc(ih,jh,ipol,jpol,na,ijs)= & 197 int4_nc(ih,jh,ipol,jpol,na,ijs) + & 198 int4(ijh_l,ipol,jpol,na,1) * & 199 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,1,is2,np)+& 200 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,2,is2,np)) 201 IF (domag) THEN 202 int4_nc(ih,jh,ipol,jpol,na,ijs)= & 203 int4_nc(ih,jh,ipol,jpol,na,ijs) + & 204 int4(ijh_l,ipol,jpol,na,2)* & 205 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,2,is2,np)+& 206 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,1,is2,np))+& 207 (0.D0,-1.D0) * int4(ijh_l,ipol,jpol,na,3) * & 208 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,2,is2,np)-& 209 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,1,is2,np))+& 210 int4(ijh_l,ipol,jpol,na,4)* & 211 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,1,is2,np)- & 212 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,2,is2,np)) 213 END IF 214 END DO 215 END DO 216 END DO 217 END DO 218 END IF 219 END DO 220 END DO 221 END IF 222 END DO 223END DO 224 ! 225RETURN 226END SUBROUTINE transform_int4_so 227 228!---------------------------------------------------------------------------- 229SUBROUTINE transform_int5_so(int5,nb) 230!---------------------------------------------------------------------------- 231! 232! This routine rotates int5 as appropriate for the spin-orbit case 233! and saves it in int5_so. 234! 235USE kinds, ONLY : DP 236USE ions_base, ONLY : nat, ityp 237USE uspp_param, ONLY : nh, nhm 238USE uspp, ONLY : ijtoh 239USE noncollin_module, ONLY : npol 240USE spin_orb, ONLY : fcoef 241USE phus, ONLY : int5_so 242! 243IMPLICIT NONE 244INTEGER :: nb 245COMPLEX(DP) :: int5(nhm*(nhm+1)/2,3,3,nat,nat) 246! 247! ... local variables 248! 249INTEGER :: ih, jh, lh, kh, ijs, np, is1, is2, na, ipol, jpol 250 251INTEGER :: ijh_l 252LOGICAL :: same_lj 253 254np=ityp(nb) 255 256DO ih = 1, nh(np) 257 DO kh = 1, nh(np) 258 IF (same_lj(kh,ih,np)) THEN 259 DO jh = 1, nh(np) 260 DO lh= 1, nh(np) 261 IF (same_lj(lh,jh,np)) THEN 262 ijh_l=ijtoh(kh,lh,np) 263 DO na=1,nat 264 DO ipol=1,3 265 DO jpol=1,3 266 ijs=0 267 DO is1=1,npol 268 DO is2=1,npol 269 ijs=ijs+1 270 int5_so(ih,jh,ipol,jpol,na,nb,ijs)= & 271 int5_so(ih,jh,ipol,jpol,na,nb,ijs)+ & 272 int5(ijh_l,ipol,jpol,na,nb)* & 273 (fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,1,is2,np) + & 274 fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,2,is2,np) ) 275 END DO 276 END DO 277 END DO 278 END DO 279 END DO 280 END IF 281 END DO 282 END DO 283 END IF 284 END DO 285END DO 286 ! 287RETURN 288END SUBROUTINE transform_int5_so 289