1! 2! Copyright (C) 2001-2016 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!-------------------------------------------------------------------------- 9MODULE fermisurfer_common 10 ! 11 IMPLICIT NONE 12 ! 13 INTEGER,SAVE :: & 14 & b_low, & 15 & b_high 16 ! 17 CONTAINS 18 ! 19!---------------------------------------------------------------------------- 20SUBROUTINE rotate_k_fs(equiv) 21 !-------------------------------------------------------------------------- 22 ! 23 ! This routine find the equivalent k-point in irr-BZ for the whole BZ 24 ! Also compute the max. and min. band index containing Fermi surfaces. 25 ! 26 USE kinds, ONLY : DP 27 USE klist, ONLY : xk, nks, two_fermi_energies 28 USE symm_base, ONLY : nsym, s, time_reversal, t_rev 29 USE lsda_mod, ONLY : nspin 30 USE cell_base, ONLY : at 31 USE ener, ONLY : ef, ef_up, ef_dw 32 USE start_k, ONLY : k1, k2, k3, nk1, nk2, nk3 33 USE wvfct, ONLY : nbnd, et 34 USE io_global, ONLY : stdout 35 ! 36 IMPLICIT NONE 37 ! 38 INTEGER,INTENT(OUT) :: equiv(nk1,nk2,nk3) 39 ! 40 INTEGER :: isym, ik, ikv(3), nk, ibnd 41 REAL(8) :: xk_frac(3), kv(3), ef1, ef2 42 logical :: ldone(nk1,nk2,nk3) 43 ! 44 WRITE(stdout,*) 45 WRITE(stdout,'(5x,a,i7)') "Number of bands : ", nbnd 46 WRITE(stdout,'(5x,a,i7)') "Number of k times spin : ", nks 47 WRITE(stdout,'(5x,a,i7)') "Number of symmetries : ", nsym 48 ! 49 ! Which band contains Fermi level ? 50 ! 51 IF(two_fermi_energies) THEN 52 ef1 = ef_up 53 ef2 = ef_dw 54 ELSE 55 ef1 = ef 56 ef2 = ef 57 END IF 58 ! 59 DO ibnd = 1, nbnd 60 ! 61 IF(MINVAL(et( ibnd ,1:nks)) < MAX(ef1, ef2)) b_high = ibnd 62 IF(MAXVAL(et(nbnd - ibnd + 1,1:nks)) > MIN(ef1, ef2)) b_low = nbnd - ibnd + 1 63 ! 64 END DO 65 ! 66 WRITE(stdout,'(5x,a,i7)') "Lowest band which contains FS : ", b_low 67 WRITE(stdout,'(5x,a,i7)') "Highest band which contains FS : ", b_high 68 ! 69 IF(nspin == 2) THEN 70 nk = nks / 2 71 ELSE 72 nk = nks 73 END IF 74 ldone(1:nk1, 1:nk2, 1:nk3) = .FALSE. 75 ! 76 DO ik = 1, nk 77 ! 78 xk_frac(1:3) = matmul(xk(1:3,ik), at(1:3,1:3)) 79 ! 80 DO isym = 1, nsym 81 ! 82 kv(1:3) = MATMUL(REAL(s(1:3,1:3,isym), DP), xk_frac(1:3)) * REAL((/nk1, nk2, nk3/), DP) 83 IF(t_rev(isym)==1) kv(1:3) = - kv(1:3) 84 ! 85 kv(1:3) = kv(1:3) - 0.5_dp * REAL((/k1, k2, k3/), DP) 86 ikv(1:3) = NINT(kv(1:3)) 87 ! 88 IF(ANY(ABS(kv(1:3) - REAL(ikv(1:3), DP)) > 1d-8)) CYCLE 89 ! 90 ikv(1:3) = MODULO(ikv(1:3), (/nk1, nk2, nk3/)) + 1 91 ! 92 equiv(ikv(1), ikv(2), ikv(3)) = ik 93 ldone(ikv(1), ikv(2), ikv(3)) = .TRUE. 94 ! 95 ! Time-Reversal 96 ! 97 IF (time_reversal) THEN 98 ! 99 ikv(1:3) = - (ikv(1:3) - 1) - (/k1, k2, k3/) 100 ikv(1:3) = MODULO(ikv(1:3), (/nk1, nk2, nk3/)) + 1 101 ! 102 equiv(ikv(1), ikv(2), ikv(3)) = ik 103 ldone(ikv(1), ikv(2), ikv(3)) = .TRUE. 104 ! 105 END IF 106 ! 107 END DO ! END isym 108 ! 109 END DO ! End ik 110 ! 111 ! Check 112 ! 113 IF(COUNT(.NOT. ldone) /= 0) & 114 & WRITE(stdout,*) " # of elements that are not done : ", COUNT(.NOT. ldone) 115 ! 116END SUBROUTINE rotate_k_fs 117! 118!---------------------------------------------------------------------------- 119SUBROUTINE write_fermisurfer(eig, mat, filename) 120 !---------------------------------------------------------------------------- 121 ! 122 ! This routine output a matrix element on the Fermi surface 123 ! 124 USE kinds, ONLY : DP 125 USE constants, ONLY : tpi 126 USE cell_base, ONLY : bg, alat 127 USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3 128 USE io_global, ONLY : stdout, ionode 129 ! 130 IMPLICIT NONE 131 ! 132 REAL(dp),INTENT(IN) :: eig(b_low:b_high,nk1,nk2,nk3), & 133 & mat(b_low:b_high,nk1,nk2,nk3) 134 CHARACTER(*),INTENT(IN) :: filename 135 ! 136 INTEGER :: ibnd, i1, i2, i3, fo 137 ! 138 INTEGER, EXTERNAL :: find_free_unit 139 ! 140 WRITE(stdout,'(5x,a,f18.8,5x,a,f18.8)') & 141 & "Max : ", MAXVAL(mat(b_low:b_high,1:nk1,1:nk2,1:nk3)), & 142 & "Min : ", MINVAL(mat(b_low:b_high,1:nk1,1:nk2,1:nk3)) 143 ! 144 IF(ionode) THEN 145 ! 146 fo = find_free_unit() 147 OPEN(fo, file = TRIM(filename)) 148 ! 149 WRITE(fo,'(3i6)') nk1, nk2, nk3 150 ! 151 WRITE(fo,'(i6)') 1 + k1 152 ! 153 WRITE(fo,'(i6)') b_high - b_low + 1 154 ! 155 ! Write with single-precision 156 ! 157 WRITE(fo,*) REAL(bg(1:3,1)) * tpi / alat 158 WRITE(fo,*) REAL(bg(1:3,2)) * tpi / alat 159 WRITE(fo,*) REAL(bg(1:3,3)) * tpi / alat 160 ! 161 DO ibnd = b_low, b_high 162 DO i1 = 1, nk1 163 DO i2 = 1, nk2 164 DO i3 = 1, nk3 165 WRITE(fo,*) REAL(eig(ibnd,i1,i2,i3)) 166 END DO 167 END DO 168 END DO 169 END DO 170 ! 171 DO ibnd = b_low, b_high 172 DO i1 = 1, nk1 173 DO i2 = 1, nk2 174 DO i3 = 1, nk3 175 WRITE(fo,*) REAL(mat(ibnd,i1,i2,i3)) 176 END DO 177 END DO 178 END DO 179 END DO 180 ! 181 CLOSE(fo) 182 ! 183 END IF 184 ! 185END SUBROUTINE write_fermisurfer 186! 187END MODULE fermisurfer_common 188