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