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_wannierize
8 : #ifdef CPP_WANN
9 : use m_juDFT
10 : c****************************************************
11 : c Call wannier90 subroutines needed for
12 : c wannierization from within Fleur.
13 : c
14 : c Frank Freimuth
15 : c****************************************************
16 : CONTAINS
17 0 : SUBROUTINE wann_wannierize(
18 0 : > film,wann,fmpi,kpoints,fullnkpts,jspins,
19 0 : > natd,pos,
20 0 : > amat,bmat,ntype,neq,zatom)
21 : USE m_types
22 : use m_wann_read_umatrix
23 : implicit none
24 : logical,intent(in) :: film
25 : TYPE(t_wann), INTENT(IN) :: wann
26 : TYPE(t_mpi), INTENT(IN) :: fmpi
27 : real, intent (in) :: kpoints(:,:)
28 : integer, intent(in) :: fullnkpts
29 : integer,intent(in) :: jspins
30 : integer,intent(in) :: natd
31 : real,intent(in) :: pos(3,natd)
32 : real,intent(in) :: amat(3,3)
33 : real,intent(in) :: bmat(3,3)
34 : integer,intent(in) :: ntype
35 : integer,intent(in) :: neq(ntype)
36 : real,intent(in) :: zatom(ntype)
37 :
38 : integer :: num_wann
39 0 : real,allocatable :: centers(:,:)
40 : integer :: nkpts,dim,i,j,at
41 : character(len=50) :: seedname
42 : integer :: jspin
43 : character(len=3) :: spin12(2)
44 : integer :: nntot
45 : data spin12/'WF1' , 'WF2'/
46 : integer :: num(3)
47 : integer :: num_kpts,num_wann2
48 : real :: real_lattice(3,3)
49 : real :: recip_lattice(3,3)
50 : integer :: num_bands
51 : integer :: num_atoms
52 0 : real :: atoms_cart(3,natd)
53 0 : character(len=2) :: atom_symbols(natd)
54 : logical :: gamma_only
55 0 : complex,allocatable :: M_matrix(:,:,:,:)
56 0 : complex,allocatable :: A_matrix(:,:,:)
57 0 : real,allocatable :: eigenvalues(:,:)
58 0 : complex,allocatable :: U_matrix(:,:,:)
59 0 : complex,allocatable :: U_matrix_opt(:,:,:)
60 0 : logical,allocatable :: lwindow(:,:)
61 0 : integer,allocatable :: ndimwin(:)
62 0 : real,allocatable :: wann_spreads(:)
63 : real :: spread(3),maxi,mini
64 : logical :: l_file,l_bkpts
65 : integer :: iter
66 : real :: increm,compare
67 : ! real,allocatable :: kpoints(:,:)
68 : real,parameter :: bohr=0.5291772108
69 : character(len=2) :: namat(0:103)
70 : real :: realp,imagp
71 : real :: scale
72 : integer :: ikpt,ikpt_b,nwf,nwf2,i2,ikpt2
73 : logical :: have_disentangled
74 :
75 : ! Taken from wannier90-1.2/src/wannier_lib.F90
76 : interface
77 : subroutine wannier_run(seed__name,mp_grid_loc,num_kpts_loc,
78 : + real_lattice_loc,recip_lattice_loc,kpt_latt_loc,num_bands_loc,
79 : + num_wann_loc,nntot_loc,num_atoms_loc,atom_symbols_loc,
80 : + atoms_cart_loc,gamma_only_loc,M_matrix_loc,A_matrix_loc,
81 : + eigenvalues_loc,
82 : + U_matrix_loc,U_matrix_opt_loc,lwindow_loc,wann_centres_loc,
83 : + wann_spreads_loc,spread_loc)
84 : implicit none
85 : integer, parameter :: dp = selected_real_kind(15,300)
86 : character(len=*), intent(in) :: seed__name
87 : integer, dimension(3), intent(in) :: mp_grid_loc
88 : integer, intent(in) :: num_kpts_loc
89 : real(kind=dp), dimension(3,3), intent(in) :: real_lattice_loc
90 : real(kind=dp), dimension(3,3), intent(in) :: recip_lattice_loc
91 : real(kind=dp), dimension(3,num_kpts_loc), intent(in) ::
92 : + kpt_latt_loc
93 : integer, intent(in) :: num_bands_loc
94 : integer, intent(in) :: num_wann_loc
95 : integer, intent(in) :: nntot_loc
96 : integer, intent(in) :: num_atoms_loc
97 : character(len=*), dimension(num_atoms_loc), intent(in) ::
98 : + atom_symbols_loc
99 : real(kind=dp), dimension(3,num_atoms_loc), intent(in) ::
100 : + atoms_cart_loc
101 : logical, intent(in) :: gamma_only_loc
102 : complex(kind=dp), dimension(num_bands_loc,num_bands_loc,
103 : + nntot_loc,num_kpts_loc), intent(in) :: M_matrix_loc
104 : complex(kind=dp),
105 : + dimension(num_bands_loc,num_wann_loc,num_kpts_loc),
106 : + intent(in) :: A_matrix_loc
107 : real(kind=dp), dimension(num_bands_loc,num_kpts_loc),
108 : + intent(in) :: eigenvalues_loc
109 : complex(kind=dp),
110 : + dimension(num_wann_loc,num_wann_loc,num_kpts_loc),
111 : + intent(out) :: U_matrix_loc
112 : complex(kind=dp),
113 : + dimension(num_bands_loc,num_wann_loc,num_kpts_loc),
114 : + optional, intent(out) :: U_matrix_opt_loc
115 : logical, dimension(num_bands_loc,num_kpts_loc),
116 : + optional, intent(out) :: lwindow_loc
117 : real(kind=dp), dimension(3,num_wann_loc),
118 : + optional, intent(out) :: wann_centres_loc
119 : real(kind=dp), dimension(num_wann_loc), optional,
120 : + intent(out) :: wann_spreads_loc
121 : real(kind=dp), dimension(3), optional,
122 : + intent(out) :: spread_loc
123 : end subroutine wannier_run
124 : end interface
125 :
126 : DATA namat/'va',' h','he','li','be',' b',' c',' n',' o',' f','ne',
127 : + 'na','mg','al','si',' p',' s','cl','ar',' k','ca','sc','ti',
128 : + ' v','cr','mn','fe','co','ni','cu','zn','ga','ge','as','se',
129 : + 'br','kr','rb','sr',' y','zr','nb','mo','tc','ru','rh','pd',
130 : + 'ag','cd','in','sn','sb','te',' j','xe','cs','ba','la','ce',
131 : + 'pr','nd','pm','sm','eu','gd','tb','dy','ho','er','tm','yb',
132 : + 'lu','hf','ta',' w','re','os','ir','pt','au','hg','tl','pb',
133 : + 'bi','po','at','rn','fr','ra','ac','th','pa',' u','np','pu',
134 : + 'am','cm','bk','cf','es','fm','md','no','lw'/
135 :
136 :
137 0 : gamma_only=.false.
138 0 : atoms_cart=pos*bohr
139 : c**********************************************************
140 : c read the bkpts file
141 : c**********************************************************
142 0 : l_bkpts = .false.
143 0 : inquire (file='bkpts',exist=l_bkpts)
144 0 : IF (.NOT.l_bkpts) CALL juDFT_error("need bkpts for matrixmmn"
145 0 : + ,calledby ="wann_wannierize")
146 0 : open (202,file='bkpts',form='formatted',status='old')
147 0 : rewind (202)
148 0 : read (202,'(i4)') nntot
149 0 : close(202)
150 :
151 : c**********************************************************
152 : c information on atoms
153 : c**********************************************************
154 0 : num_atoms=0
155 0 : do i=1,ntype
156 0 : at=nint(zatom(i))
157 0 : do j=1,neq(i)
158 0 : num_atoms=num_atoms+1
159 0 : atom_symbols(num_atoms)=namat(at)
160 : enddo !j
161 : enddo !i
162 :
163 : c**********************************************************
164 : c read in kpoints from kpts/w90kpts file
165 : c**********************************************************
166 : ! if(wann%l_bzsym)then
167 : ! l_file=.false.
168 : ! inquire(file='w90kpts',exist=l_file)
169 : ! IF(.NOT.l_file) CALL juDFT_error("where is w90kpts?",calledby
170 : ! + ="wann_wannierize")
171 : ! open(987,file='w90kpts',status='old',form='formatted')
172 : ! read(987,*)nkpts,scale
173 : ! print*,"nkpts=",nkpts
174 : ! allocate(kpoints(3,nkpts))
175 : ! do iter=1,nkpts
176 : ! read(987,*)kpoints(:,iter)
177 : ! enddo
178 : ! close(987)
179 : ! do iter=1,nkpts
180 : ! print*,kpoints(:,iter)
181 : ! enddo
182 : ! kpoints=kpoints/scale
183 : ! else
184 : ! l_file=.false.
185 : ! inquire(file='kpts',exist=l_file)
186 : ! IF(.NOT.l_file) CALL juDFT_error("where is kpts?",calledby
187 : ! + ="wann_wannierize")
188 : ! open(987,file='kpts',status='old',form='formatted')
189 : ! read(987,*)nkpts,scale
190 : ! allocate(kpoints(3,nkpts))
191 : ! do iter=1,nkpts
192 : ! read(987,*)kpoints(:,iter)
193 : ! enddo
194 : ! close(987)
195 : ! if(film) kpoints(3,:)=0.0
196 : ! kpoints=kpoints/scale
197 : ! do iter=1,nkpts
198 : ! print*,kpoints(:,iter)
199 : ! enddo
200 : ! endif
201 0 : num_kpts=fullnkpts
202 0 : nkpts=fullnkpts
203 0 : allocate(ndimwin(num_kpts))
204 : c*********************************************************
205 : c find out the structure of k-point set
206 : c*********************************************************
207 0 : do dim=1,3
208 0 : maxi=maxval(kpoints(dim,:))
209 0 : mini=minval(kpoints(dim,:))
210 0 : if(mini==maxi)then
211 0 : num(dim)=1
212 : else
213 0 : increm=maxi-mini
214 0 : do iter=1,nkpts
215 0 : compare=maxi-kpoints(dim,iter)
216 0 : if(abs(compare).lt.1e-6)cycle
217 0 : if(compare.lt.increm) then
218 0 : increm=compare
219 : endif
220 : enddo
221 0 : num(dim)=(maxi-mini)/increm+1.01
222 : endif
223 : enddo
224 0 : print*,"num(:)=",num(:)
225 0 : IF(num(1)*num(2)*num(3)/=nkpts) CALL juDFT_error
226 0 : + ("mysterious kpoints",calledby ="wann_wannierize")
227 :
228 : c********************************************************
229 : c proj file provides num_wann and num_bands
230 : c********************************************************
231 0 : l_file=.false.
232 0 : inquire(file='proj',exist=l_file)
233 0 : IF(.NOT.l_file) CALL juDFT_error("where is proj?",calledby
234 0 : + ="wann_wannierize")
235 0 : open(712,file='proj',form='formatted',status='old')
236 0 : read(712,*)num_wann2,num_bands
237 0 : close(712)
238 0 : num_wann=num_wann2
239 0 : print*,"num_wann=",num_wann
240 0 : print*,"num_bands=",num_bands
241 :
242 0 : real_lattice = transpose(amat)*bohr
243 0 : recip_lattice = bmat/bohr
244 :
245 0 : allocate( M_matrix(num_bands,num_bands,nntot,num_kpts) )
246 0 : allocate( A_matrix(num_bands,num_wann,num_kpts) )
247 0 : allocate( eigenvalues(num_bands,num_kpts) )
248 0 : allocate( U_matrix(num_wann,num_wann,num_kpts) )
249 0 : allocate( U_matrix_opt(num_bands,num_wann,num_kpts) )
250 0 : allocate( lwindow(num_bands,num_kpts) )
251 0 : do jspin=1,jspins
252 0 : seedname=spin12(jspin)
253 : c******** read mmn-matrix
254 : open (305,file=spin12(jspin)//'.mmn',
255 0 : & form='formatted',status='old')
256 0 : read (305,*)
257 0 : read (305,'(3i5)')
258 0 : do ikpt = 1,num_kpts
259 0 : do ikpt_b = 1,nntot
260 0 : read (305,'(2i5,3x,3i4)')
261 0 : do i = 1,num_bands
262 0 : do j = 1,num_bands
263 0 : read (305,*)realp,imagp
264 0 : m_matrix(j,i,ikpt_b,ikpt)=cmplx(realp,imagp)
265 : enddo !j
266 : enddo !i
267 : enddo !ikpt_b
268 : enddo !ikpt
269 0 : close(305)
270 : c******** read amn-matrix
271 : open (303,file=spin12(jspin)//'.amn',
272 0 : & form='formatted',status='old')
273 0 : read (303,*)
274 : ! read (303,'(3i5)')
275 0 : read(303,*)
276 0 : do ikpt = 1,num_kpts
277 0 : do nwf = 1,num_wann
278 0 : do i = 1,num_bands
279 : c print*,"ikpt=",ikpt,"nwf=",nwf,"i=",i
280 : c read (303,'(3i5,3x,2f18.12)') i2,nwf2,ikpt2,realp,imagp
281 0 : read (303,*) i2,nwf2,ikpt2,realp,imagp
282 0 : a_matrix(i,nwf,ikpt)=cmplx(realp,imagp)
283 : c print*,"i2=",i2,"nwf2=",nwf2,"ikpt2=2",ikpt2
284 : enddo
285 : enddo
286 : enddo
287 0 : close (303)
288 : c********* read eigenvalues
289 : open(303,file=spin12(jspin)//'.eig',
290 0 : & form='formatted',status='old')
291 0 : do ikpt=1,num_kpts
292 0 : do i=1,num_bands
293 0 : read(303,*)nwf2,ikpt2,eigenvalues(i,ikpt)
294 : enddo
295 : enddo
296 0 : allocate( centers(3,num_wann) )
297 0 : allocate( wann_spreads(num_wann) )
298 : call wannier_run(
299 : > seedname,num,num_kpts,
300 : > real_lattice,recip_lattice,kpoints,num_bands,
301 : > num_wann,nntot,num_atoms,atom_symbols,
302 : > atoms_cart,gamma_only,M_matrix,A_matrix,eigenvalues,
303 : > U_matrix,U_matrix_opt,lwindow,
304 : < centers(:,:),
305 0 : < wann_spreads,spread)
306 0 : deallocate( centers )
307 0 : deallocate( wann_spreads )
308 : c********read the u_matrix and write it to a formatted file
309 : ! call wann_read_umatrix(
310 : ! > num_kpts,num_wann,num_bands,
311 : ! > .true.,jspin,1,
312 : ! < have_disentangled,
313 : ! < lwindow,ndimwin,u_matrix_opt)
314 :
315 : enddo !jspin
316 :
317 0 : END SUBROUTINE wann_wannierize
318 : #endif
319 : END MODULE m_wann_wannierize
320 :
|
