Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 :
7 : MODULE m_wann_read_umatrix
8 : use m_juDFT
9 : c************************************************************
10 : c Read in the transformation matrix between Bloch
11 : c and Wannier functions which is calculated by
12 : c wannier90.
13 : c Frank Freimuth, October 2006
14 : c************************************************************
15 : CONTAINS
16 0 : SUBROUTINE wann_read_umatrix2(
17 : > fullnkpts,num_wann,num_bands,
18 : > um_format,jspin,wan90version,
19 : < have_disentangled,
20 0 : < lwindow,ndimwin,
21 0 : < u_matrix_opt,u_matrix_tmp,m_matrix)
22 : implicit none
23 : integer,intent(in) :: fullnkpts,jspin
24 : integer,intent(in) :: num_wann,num_bands
25 : logical,intent(in) :: um_format
26 : integer,intent(in) :: wan90version
27 : logical,intent(out) :: have_disentangled
28 : logical,intent(out) :: lwindow(num_bands,fullnkpts)
29 : integer,intent(out) :: ndimwin(fullnkpts)
30 : complex,intent(out) :: u_matrix_opt(num_bands,num_wann,fullnkpts)
31 : complex,intent(out) :: u_matrix_tmp(num_wann,num_wann,fullnkpts)
32 : complex,intent(out),optional :: m_matrix(:,:,:,:)
33 :
34 0 : integer,allocatable :: exclude_bands(:)
35 : integer :: num_kpts,chk_unit,mp_grid(3),l
36 : integer :: i,j,k,nkp,ntmp,num_nnmax,nntot
37 : logical :: l_chk,l_umdat
38 : character(len=3) :: spin12(2)
39 : character(len=33) :: header
40 : real :: tmp_latt(3,3)
41 0 : real,allocatable :: tmp_kpt_latt(:,:)
42 : character(len=20) :: checkpoint
43 : real :: tmp_omi
44 : real :: omega_invariant
45 : character(len=2) :: spinspin12(2)
46 : data spin12/'WF1' , 'WF2'/
47 : data spinspin12/'.1','.2'/
48 :
49 : c**************************************************************
50 : c read in chk
51 : c**************************************************************
52 :
53 0 : write(6,*)"read in chk"
54 0 : l_chk=.false.
55 0 : inquire (file=spin12(jspin)//'.chk',exist=l_chk)
56 0 : IF(.NOT.l_chk) then
57 0 : write(*,*)spin12(jspin)//'.chk'
58 : CALL juDFT_error("file chk not found",calledby
59 0 : + ="wann_read_umatrix")
60 : ENDIF
61 :
62 0 : chk_unit=152
63 : open(chk_unit,file=spin12(jspin)//'.chk',status='old',
64 0 : & form='unformatted')
65 :
66 : !write(*,*)'wan90version',wan90version
67 0 : if(wan90version.eq.1)then !wannier90 version 1.1
68 : ! Read comment line
69 0 : read(chk_unit) header
70 0 : write(6,*)header
71 : ! Real and reciprocal lattice (units: Angstroem)
72 0 : read(chk_unit) ((tmp_latt(i,j),i=1,3),j=1,3) ! Real lattice
73 0 : write(6,*)tmp_latt
74 0 : read(chk_unit) ((tmp_latt(i,j),i=1,3),j=1,3) ! Reciprocal lattice
75 0 : write(6,*)tmp_latt
76 :
77 0 : read(chk_unit) num_kpts ! K-points
78 0 : write(6,*)"num_kpts=",num_kpts
79 0 : if (num_kpts.ne.fullnkpts) CALL
80 : & juDFT_error("num_kpts.ne.fullnkpts",calledby
81 0 : + ="wann_read_umatrix")
82 0 : elseif((wan90version.eq.2).or.(wan90version.eq.3)) then
83 : !wannier90 version 1.2 or wannier90 version 2.0
84 :
85 : ! Read comment line
86 0 : read(chk_unit) header
87 0 : write(6,*)header
88 :
89 0 : read(chk_unit) ntmp
90 :
91 0 : read(chk_unit) ntmp
92 0 : allocate(exclude_bands(ntmp))
93 0 : read(chk_unit) (exclude_bands(i),i=1,ntmp) ! Excluded bands
94 :
95 : ! Real and reciprocal lattice (units: Angstroem)
96 0 : read(chk_unit) ((tmp_latt(i,j),i=1,3),j=1,3) ! Real lattice
97 0 : write(6,*)tmp_latt
98 0 : read(chk_unit) ((tmp_latt(i,j),i=1,3),j=1,3) ! Reciprocal lattice
99 0 : write(6,*)tmp_latt
100 :
101 0 : read(chk_unit) num_kpts ! K-points
102 0 : write(6,*)"num_kpts=",num_kpts
103 0 : if (num_kpts.ne.fullnkpts) stop "num_kpts.ne.fullnkpts"
104 0 : read(chk_unit) (mp_grid(i),i=1,3) ! M-P grid
105 : else
106 : CALL juDFT_error("unknown wan90version",calledby
107 0 : + ="wann_read_umatrix")
108 : endif
109 :
110 0 : allocate(tmp_kpt_latt(3,fullnkpts))
111 0 : read(chk_unit) ((tmp_kpt_latt(i,nkp),i=1,3),nkp=1,fullnkpts)
112 0 : deallocate(tmp_kpt_latt)
113 :
114 0 : read(chk_unit) nntot ! nntot
115 0 : read(chk_unit) ntmp ! num_wann
116 0 : IF (ntmp/=num_wann) CALL juDFT_error("mismatch in num_wann"
117 0 : + ,calledby ="wann_read_umatrix")
118 :
119 0 : read(chk_unit) checkpoint ! checkpoint
120 0 : checkpoint=adjustl(trim(checkpoint))
121 0 : write(6,*)checkpoint
122 :
123 :
124 :
125 :
126 :
127 0 : read(chk_unit) have_disentangled
128 : ! whether a disentanglement has been performed
129 :
130 0 : if (have_disentangled) then
131 0 : write(6,*)"You used disentangling"
132 0 : write(6,*)"Reading in disentangling information"
133 0 : read(chk_unit) omega_invariant ! omega invariant
134 0 : write(6,*)omega_invariant
135 :
136 :
137 : ! U matrix opt
138 0 : read(chk_unit) ((lwindow(i,nkp),i=1,num_bands),nkp=1,num_kpts)
139 0 : read(chk_unit) (ndimwin(nkp),nkp=1,num_kpts)
140 0 : read(chk_unit)(((u_matrix_opt(i,j,nkp),i=1,num_bands)
141 0 : & ,j=1,num_wann),nkp=1,num_kpts)
142 :
143 : endif
144 :
145 :
146 :
147 0 : if(.not.wan90version.eq.0)then
148 :
149 0 : read(chk_unit) (((u_matrix_tmp(i,j,k),i=1,num_wann),
150 0 : & j=1,num_wann),k=1,num_kpts)
151 :
152 : endif
153 :
154 0 : if(present(m_matrix))then
155 0 : write(*,*)"nntot=",nntot
156 0 : write(*,*)"num_kpts=",num_kpts
157 0 : write(*,*)"num_wann=",num_wann
158 0 : read(chk_unit) ((((m_matrix(i,j,k,l),i=1,num_wann),
159 0 : & j=1,num_wann),k=1,nntot),l=1,num_kpts)
160 : endif
161 :
162 0 : close(chk_unit)
163 :
164 0 : if(wan90version.eq.0)then
165 : c****************************************************************
166 : c read in _um.dat (old version of wannier90)
167 : c****************************************************************
168 0 : l_umdat=.false.
169 0 : inquire (file=spin12(jspin)//'_um.dat',exist=l_umdat)
170 0 : IF(.NOT.l_umdat) CALL juDFT_error("where is your um_dat?",
171 0 : + calledby ="wann_read_umatrix")
172 :
173 0 : open(111,file=spin12(jspin)//'_um.dat',form='unformatted')
174 0 : write(6,*)"read in um_data"
175 0 : read(111)header
176 0 : read(111)tmp_omi
177 0 : read(111) ntmp,num_kpts,num_nnmax
178 0 : IF(ntmp/=num_wann) CALL judft_error("mismatch in num_wann",
179 0 : + calledby ="wann_read_umatrix")
180 :
181 0 : read(111)(((u_matrix_tmp(i,j,k),i=1,num_wann),j=1,num_wann),
182 0 : & k=1,num_kpts)
183 0 : close(111)
184 : endif !wannier90 version
185 :
186 : c$$$ if (um_format) then
187 : c$$$ write(6,*)"write um_data to formatted file WF1.umn/WF2.umn"
188 : c$$$ open(222,
189 : c$$$ & file=spin12(jspin)//'.umn',form='formatted')
190 : c$$$c write(222,*)header
191 : c$$$c write(222,*)tmp_omi
192 : c$$$c write(222,*)num_wann,num_kpts,num_nnmax
193 : c$$$ write(222,*)"transformation between Bloch and Wannier"
194 : c$$$ write(222,*)num
195 : c$$$ do k=1,num_kpts
196 : c$$$ do i=1,num_wann
197 : c$$$ do j=1,num_wann
198 : c$$$ write(222,'(i3,3x,i3,3x,i3,3x,f20.16,f20.16)')
199 : c$$$ & i,j,k,u_matrix_tmp(i,j,k)
200 : c$$$ enddo
201 : c$$$ enddo
202 : c$$$ enddo
203 : c$$$ close(222)
204 : c$$$ endif !um_format
205 0 : END SUBROUTINE wann_read_umatrix2
206 :
207 0 : SUBROUTINE wann_read_umatrix(
208 : > fullnkpts,num_wann,num_bands,
209 : > um_format,jspin,wan90version,
210 : < have_disentangled,
211 0 : < lwindow,ndimwin,u_matrix)
212 : implicit none
213 : integer,intent(in) :: fullnkpts,jspin
214 : integer,intent(in) :: num_wann,num_bands
215 : logical,intent(in) :: um_format
216 : integer,intent(in) :: wan90version
217 : logical,intent(out) :: have_disentangled
218 : logical,intent(out) :: lwindow(num_bands,fullnkpts)
219 : integer,intent(out) :: ndimwin(fullnkpts)
220 : complex,intent(out) :: u_matrix(num_bands,num_wann,fullnkpts)
221 :
222 0 : complex :: u_matrix_opt(num_bands,num_wann,fullnkpts)
223 0 : complex :: u_matrix_tmp(num_wann,num_wann,fullnkpts)
224 : integer :: i,j,k
225 : character(len=3) :: spin12(2)
226 : data spin12/'WF1' , 'WF2'/
227 :
228 : call wann_read_umatrix2(
229 : > fullnkpts,num_wann,num_bands,
230 : > um_format,jspin,wan90version,
231 : < have_disentangled,
232 : < lwindow,ndimwin,u_matrix_opt,
233 0 : < u_matrix_tmp)
234 :
235 0 : u_matrix(:,:,:)=0.0
236 0 : if (have_disentangled) then
237 : c**************************************************************
238 : c calculate u_matrix for the entangled case
239 : c*************************************************************
240 0 : do k=1,fullnkpts
241 0 : do i=1,num_wann
242 0 : do j=1,num_wann
243 : u_matrix(:,j,k)= u_matrix(:,j,k)+
244 0 : & u_matrix_opt(:,i,k)*u_matrix_tmp(i,j,k)
245 : enddo
246 : enddo
247 : enddo
248 : else
249 0 : IF(num_bands/=num_wann) CALL juDFT_error("num_bands/=num_wann"
250 0 : + ,calledby ="wann_read_umatrix")
251 0 : u_matrix(:,:,:)=u_matrix_tmp(:,:,:)
252 : endif
253 :
254 0 : if (um_format) then
255 0 : write(6,*)"write um_data to formatted file WF1.umn/WF2.umn"
256 : open(222,
257 0 : & file=spin12(jspin)//'.umn',form='formatted')
258 : c write(222,*)header
259 : c write(222,*)tmp_omi
260 : c write(222,*)num_wann,num_kpts,num_nnmax
261 0 : write(222,*)"transformation between Bloch and Wannier"
262 0 : write(222,*)num_bands,fullnkpts,num_wann
263 0 : do k=1,fullnkpts
264 0 : do i=1,num_wann
265 0 : do j=1,num_bands
266 : write(222,'(i5,1x,i5,1x,i5,1x,f18.12,1x,f18.12)')
267 0 : & j,i,k,u_matrix(j,i,k)
268 : enddo
269 : enddo
270 : enddo
271 0 : close(222)
272 : endif !um_format
273 :
274 :
275 0 : END SUBROUTINE wann_read_umatrix
276 : END MODULE m_wann_read_umatrix
|
