Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2018 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_unfold_band_kpts
8 :
9 : CONTAINS
10 :
11 48 : SUBROUTINE build_primitive_cell(banddos,p_cell,cell)
12 : USE m_types
13 : USE m_inv3
14 : USE m_constants, ONLY : tpi_const
15 : implicit none
16 : TYPE(t_banddos),INTENT(IN) :: banddos
17 : TYPE(t_cell),INTENT(IN) :: cell
18 : TYPE(t_cell),INTENT(INOUT) :: p_cell
19 : REAL :: unfold(3,3) !this variable should be given in the input xml
20 : REAL :: inv_unfold(3,3)
21 : REAL :: inv_unfold_det
22 : INTEGER :: i
23 312 : unfold=banddos%unfoldTransMat
24 24 : unfold(1,1)=banddos%unfoldTransMat(1,1)*banddos%s_cell_x
25 24 : unfold(2,2)=banddos%unfoldTransMat(2,2)*banddos%s_cell_y
26 24 : unfold(3,3)=banddos%unfoldTransMat(3,3)*banddos%s_cell_z
27 :
28 24 : CALL inv3(unfold,inv_unfold,inv_unfold_det)
29 :
30 96 : DO i =1,3
31 1248 : p_cell%amat(:,i)=matmul(inv_unfold,cell%amat(:,i))
32 : END DO
33 24 : CALL inv3(p_cell%amat,p_cell%bmat,p_cell%omtil)
34 312 : p_cell%bmat=p_cell%bmat*tpi_const
35 24 : END SUBROUTINE build_primitive_cell
36 : !---------- the following routines are not used anymore (but instructive)-----
37 0 : SUBROUTINE unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts)
38 : USE m_types
39 : USE m_inv3
40 : USE m_constants, ONLY : tpi_const
41 :
42 : implicit none
43 :
44 : TYPE(t_banddos),INTENT(IN) :: banddos
45 : TYPE(t_cell),INTENT(IN) :: cell
46 : TYPE(t_cell),INTENT(INOUT) :: p_cell
47 : TYPE(t_kpts),INTENT(INOUT) :: p_kpts
48 : TYPE(t_kpts),INTENT(INOUT) :: kpts
49 :
50 0 : CALL build_primitive_cell(banddos,p_cell,cell)
51 :
52 0 : p_kpts=kpts
53 : !write(1088,*) 'banddos%unfoldband: ', banddos%unfoldband
54 : !write(1088,*) 'brav. matrix: '
55 : !write(1088,'(f15.8,f15.8,f15.8)') cell%amat(1,1), cell%amat(1,2), cell%amat(1,3)
56 : !write(1088,'(f15.8,f15.8,f15.8)') cell%amat(2,1), cell%amat(2,2), cell%amat(2,3)
57 : !write(1088,'(f15.8,f15.8,f15.8)') cell%amat(3,1), cell%amat(3,2), cell%amat(3,3)
58 0 : END SUBROUTINE unfold_band_kpts
59 :
60 0 : SUBROUTINE find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts)
61 : USE m_types
62 : USE m_juDFT
63 : USE m_inv3
64 : implicit none
65 :
66 : TYPE(t_banddos),INTENT(IN) :: banddos
67 : TYPE(t_cell),INTENT(IN) :: cell
68 : TYPE(t_cell),INTENT(IN) :: p_cell
69 : TYPE(t_kpts),INTENT(IN) :: p_kpts
70 : TYPE(t_kpts),INTENT(INOUT) :: kpts
71 :
72 : INTEGER :: i,m1,m2,m3
73 : REAL :: rez_inv_to_internal(3,3)
74 : REAL :: rez_inv_det
75 0 : REAL :: list(13,p_kpts%nkpt) !cartesion coordinates for k,K,m
76 : REAL :: pc_kpoint_i(3) !primitive cell kpoint internal
77 : REAL :: sc_kpoint_i(3) !super cell kpoint internal
78 : REAL :: pc_kpoint_c(3) !primitive cell kpoint cartesian
79 : REAL :: sc_kpoint_c(3) !super cell kpoint cartesian
80 : REAL :: eps(3)
81 : REAL :: eps_r, eps_kpt
82 : LOGICAL :: representation_found
83 : REAL ::kpt_dist
84 :
85 : eps = 1.0e-10
86 0 : eps_r = 0.000000001
87 :
88 0 : CALL inv3(cell%bmat,rez_inv_to_internal,rez_inv_det)
89 : !write(1088,*) p_kpts%specialPoints
90 : !write(333,'(3f15.8)')p_kpts%bk
91 0 : kpt_dist=0
92 0 : DO i= 1,size(list,2)
93 0 : pc_kpoint_c(1)=p_kpts%bk(1,i)*p_cell%bmat(1,1)+p_kpts%bk(2,i)*p_cell%bmat(2,1)+p_kpts%bk(3,i)*p_cell%bmat(3,1)
94 0 : pc_kpoint_c(2)=p_kpts%bk(1,i)*p_cell%bmat(1,2)+p_kpts%bk(2,i)*p_cell%bmat(2,2)+p_kpts%bk(3,i)*p_cell%bmat(3,2)
95 0 : pc_kpoint_c(3)=p_kpts%bk(1,i)*p_cell%bmat(1,3)+p_kpts%bk(2,i)*p_cell%bmat(2,3)+p_kpts%bk(3,i)*p_cell%bmat(3,3)
96 0 : list(1,i)=pc_kpoint_c(1)
97 0 : list(2,i)=pc_kpoint_c(2)
98 0 : list(3,i)=pc_kpoint_c(3)
99 : !----------------------- method internal coordintes --------------------
100 0 : sc_kpoint_i(:)=matmul(pc_kpoint_c,rez_inv_to_internal)
101 : pc_kpoint_i(:)=p_kpts%bk(1:3,i)
102 : !sc_kpoint_i(:) = sc_kpoint_i(:) + 0.5
103 0 : m1 = FLOOR(sc_kpoint_i(1))
104 0 : m2 = FLOOR(sc_kpoint_i(2))
105 0 : m3 = FLOOR(sc_kpoint_i(3))
106 0 : m1=0
107 0 : m2=0
108 0 : m3=0
109 : sc_kpoint_i(1) = sc_kpoint_i(1) - m1
110 : sc_kpoint_i(2) = sc_kpoint_i(2) - m2
111 : sc_kpoint_i(3) = sc_kpoint_i(3) - m3
112 : !sc_kpoint_i(:) = sc_kpoint_i(:) - 0.5
113 0 : list(4,i)=sc_kpoint_i(1)
114 0 : list(5,i)=sc_kpoint_i(2)
115 0 : list(6,i)=sc_kpoint_i(3)
116 0 : list(7,i)=m1
117 0 : list(8,i)=m2
118 0 : list(9,i)=m3 !this whole block is to move kpoints into first BZ within -0.5 to 0.5
119 :
120 : ! kpts%bk(:,i)=matmul(rez_inv_to_internal,pc_kpoint_c)
121 : !-------------saving old kpts----------
122 0 : list(11:13,i)=kpts%bk(:,i)
123 : !------finished---------
124 0 : kpts%bk(:,i)=list(4:6,i)
125 :
126 0 : IF (i>1) THEN
127 0 : kpt_dist=kpt_dist+sqrt(dot_product(list(1:3,i)-list(1:3,i-1),list(1:3,i)-list(1:3,i-1)))
128 : END IF
129 0 : list(10,i)=kpt_dist
130 : END DO
131 : !write(91,'(3f15.8)') kpts%bk
132 : !write(92,*) kpts%wtkpt
133 0 : ALLOCATE (kpts%sc_list(13,p_kpts%nkpt))
134 0 : kpts%specialPointIndices(:) = p_kpts%specialPointIndices(:)
135 0 : kpts%sc_list=list
136 0 : write(90,'(10f15.8)') kpts%sc_list
137 0 : END SUBROUTINE find_supercell_kpts
138 : !----------------------------------------------------------------
139 24 : SUBROUTINE calculate_plot_w_n(banddos,cell,kpts,zMat,lapw,i_kpt,jsp,eig,results,input,atoms,unfoldingBuffer,fmpi,l_soc,smat_unfold,zso)
140 : USE m_types
141 : USE m_juDFT
142 : USE m_inv3
143 : USE m_types_mpimat
144 : USE m_constants
145 : implicit none
146 :
147 : TYPE(t_input),INTENT(IN) :: input
148 : TYPE(t_atoms),INTENT(IN) :: atoms
149 : TYPE(t_banddos),INTENT(IN) :: banddos
150 : TYPE(t_results),INTENT(INOUT) :: results
151 : TYPE(t_cell),INTENT(IN) :: cell
152 : TYPE(t_kpts),INTENT(IN) :: kpts
153 : CLASS(t_mat),OPTIONAL,INTENT(INOUT) :: smat_unfold
154 : CLASS(t_mat),INTENT(IN) :: zMat
155 : TYPE(t_lapw),INTENT(IN) :: lapw
156 : TYPE(t_mpi),INTENT(IN) :: fmpi
157 : TYPE(t_cell) :: p_cell
158 : LOGICAL, INTENT(IN) :: l_soc
159 : INTEGER, INTENT(IN) :: i_kpt,jsp
160 : REAL, INTENT(IN) :: eig(:)
161 : COMPLEX, INTENT(IN), OPTIONAL ::zso(:,:,:)
162 : COMPLEX, INTENT(INOUT) :: unfoldingBuffer(:,:,:)
163 : INTEGER :: i,j,k,l,n
164 : INTEGER :: na,n_i,nn,nk,nki,gi,lo
165 24 : REAL, ALLOCATABLE ::w_n(:)
166 24 : COMPLEX, ALLOCATABLE ::w_n_c(:)
167 24 : REAL, ALLOCATABLE ::w_n_sum(:)
168 24 : COMPLEX, ALLOCATABLE ::w_n_c_sum(:)
169 : LOGICAL :: method_rubel = .FALSE.
170 : LOGICAL :: write_to_file = .false.
171 72 : CLASS(t_mat), ALLOCATABLE :: zMat_s
172 : REAL :: unfold(3,3) !this variable should be given in the input xml
173 : REAL :: multiple(3)
174 : REAL :: inv_unfold(3,3)
175 : REAL :: inv_unfold_det
176 : REAL :: eps_r=0.0000000001
177 : !---------combining matrix input and unfolding factor input-----------
178 312 : unfold=banddos%unfoldTransMat
179 24 : unfold(1,1)=banddos%unfoldTransMat(1,1)*banddos%s_cell_x
180 24 : unfold(2,2)=banddos%unfoldTransMat(2,2)*banddos%s_cell_y
181 24 : unfold(3,3)=banddos%unfoldTransMat(3,3)*banddos%s_cell_z
182 24 : CALL inv3(unfold,inv_unfold,inv_unfold_det)
183 24 : method_rubel = .NOT.banddos%unfoldUseOlap
184 :
185 24 : CALL build_primitive_cell(banddos,p_cell,cell)
186 :
187 24 : IF (.not. method_rubel) THEN
188 6578 : DO j = 1, lapw%nv(jsp)
189 898294 : DO i = 1, j-1
190 898270 : IF(smat_unfold%l_real) THEN
191 0 : smat_unfold%data_r(j,i) = smat_unfold%data_r(i,j)
192 : ELSE
193 891716 : smat_unfold%data_c(j,i) = CONJG(smat_unfold%data_c(i,j))
194 : END IF
195 : END DO
196 : END DO
197 : END IF
198 : ! write_to_file=.true.
199 24 : IF (write_to_file) THEN
200 0 : IF (i_kpt==1) THEN
201 0 : IF (jsp==1) OPEN (679,file='bands_sc_old.1',status='unknown') !This is kind of my birthday 6 july 1992 (S.R.)
202 0 : IF (jsp==2) OPEN (680,file='bands_sc_old.2',status='unknown')
203 : END IF
204 : END IF
205 :
206 24 : IF (zmat%l_real) THEN
207 0 : ALLOCATE(w_n(zMat%matsize2))
208 0 : w_n = 0
209 : ! IF (method_rubel) THEN
210 0 : ALLOCATE(w_n_sum(zMat%matsize2))
211 0 : w_n_sum = 0
212 : ! END IF
213 : ELSE
214 72 : ALLOCATE(w_n_c(zMat%matsize2))
215 1944 : w_n_c=0
216 : ! IF (method_rubel) THEN
217 72 : ALLOCATE(w_n_c_sum(zMat%matsize2))
218 1944 : w_n_c_sum=0
219 : ! END IF
220 : END IF
221 : !---------create zmat_s--- smat*zmat---------------------
222 : select type(zMat)
223 : type is (t_mat)
224 24 : allocate(t_mat::zMat_s)
225 : select type(zMat_s)
226 : type is (t_mat)
227 24 : zMat_s=zMat
228 : end select
229 : type is (t_mpimat)
230 0 : allocate(t_mpimat::zMat_s)
231 : select type(zMat_s)
232 : type is (t_mpimat)
233 0 : zMat_s=zMat
234 : end select
235 : end select
236 : !---------------------------------------------------------
237 : ! write(345,'(3I6)') lapw%gvec(:,:,jsp)
238 24 : write (*,*)results%ef
239 24 : write (*,*) i_kpt
240 24 : IF (.not. method_rubel) THEN
241 : ! IF (fmpi%n_size==1) THEN
242 : ! call smat_unfold%multiply(zMat,zMat_s)
243 : ! ELSE
244 : ! call smat_unfold%mpimat_multiply(zMat,zMat_s)
245 : ! ENDIF
246 24 : call smat_unfold%multiply(zMat,zMat_s)
247 : END IF
248 24 : !$omp parallel default(none) private(j,n_i,nn,na,lo,nk,nki,gi,multiple) shared(zmat,method_rubel,jsp,lapw,w_n_sum, w_n_c_sum,inv_unfold,eps_r,w_n,w_n_c,atoms,zmat_s,write_to_file,i_kpt,kpts,eig,results,unfoldingBuffer,zso,l_soc)
249 : !$omp do
250 : DO i=1,zMat%matsize2
251 : ! write (*,*) 'here i work 1 -', i
252 : IF (method_rubel) THEN
253 : DO j=1,lapw%nv(jsp)
254 : IF (zmat%l_real) THEN
255 : w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
256 : ! write(*,*) 'zMat is real'
257 : ELSE
258 : IF (l_soc) THEN
259 : w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zso(j,i,jsp))*zso(j,i,jsp)
260 : ELSE
261 : w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
262 : END IF
263 : ! write(*,*) 'zMat is complex', j,i
264 : END IF
265 : multiple=matmul(inv_unfold,lapw%gvec(:,j,jsp))
266 : IF ((abs(modulo(multiple(1),1.0))<eps_r).AND.&
267 : &(abs(modulo(multiple(2),1.0))<eps_r).AND.&
268 : &(abs(modulo(multiple(3),1.0))<eps_r)) THEN
269 : IF (zmat%l_real) THEN
270 : w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
271 : !write(*,*) 'zMat is real'
272 : ELSE
273 : IF (l_soc) THEN
274 : w_n_c(i)=w_n_c(i)+CONJG(zso(j,i,jsp))*zso(j,i,jsp)
275 : ELSE
276 : w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
277 : END IF
278 : !write(*,*) 'zMat is complex - restricted sum'
279 : END IF
280 : END IF
281 : END DO
282 : !------------------LO's------------------------
283 : na=0
284 : !write(*,*) 'start lo', i
285 : DO n_i=1,atoms%ntype
286 : DO nn=1,atoms%neq(n_i)
287 : na=na+1
288 : DO lo=1,atoms%nlo(n_i)
289 : nk=lapw%nkvec(lo,na)
290 : DO nki=1,nk
291 : gi=lapw%kvec(nki,lo,na)
292 : j=lapw%nv(jsp)+lapw%index_lo(lo,na)+nki
293 : IF (zmat%l_real) THEN
294 : w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
295 : ELSE
296 : w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
297 : END IF
298 : multiple=matmul(inv_unfold,lapw%gvec(:,gi,jsp))
299 : IF ((abs(modulo(multiple(1),1.0))<eps_r).AND.&
300 : &(abs(modulo(multiple(2),1.0))<eps_r).AND.&
301 : &(abs(modulo(multiple(3),1.0))<eps_r)) THEN
302 : IF (zmat%l_real) THEN
303 : w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
304 : !write(*,*) zMat%data_r(j,i)*zMat%data_r(j,i)
305 : ELSE
306 : w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
307 : !write (*,*) CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
308 : END IF
309 : END IF
310 : END DO
311 : END DO
312 : END DO
313 : END DO
314 : !write(*,*) 'finished lo', i
315 : !--------------------------LO's finished----------------
316 : ELSE
317 : !write (*,*) 'start else'
318 : !write (*,*) 'lapw%nv',lapw%nv(jsp),'j',j
319 : !DO j=1,lapw%nv(jsp)
320 : ! write (*,*) 'test loop', j
321 : !END DO
322 : DO j=1,lapw%nv(jsp)
323 : !write (*,*) 'start do',j
324 : !DO k=1,zMat%matsize1
325 : IF (zmat%l_real) THEN
326 : !w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
327 : w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
328 : !write (*,*) 'weight sum real'
329 : ELSE
330 : !w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
331 : w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
332 : END IF
333 : ! END DO
334 : ! write (*,*) lapw%gvec(:,j,jsp)
335 : ! write (*,*) kpts%sc_list(:,i_kpt)
336 : ! write (*,*) banddos%s_cell_x,banddos%s_cell_y,banddos%s_cell_z
337 : !CALL juDFT_error('debugging stop, unfolding')
338 : multiple=matmul(inv_unfold,lapw%gvec(:,j,jsp))
339 : IF ((abs(modulo(multiple(1),1.0))<eps_r).AND.&
340 : &(abs(modulo(multiple(2),1.0))<eps_r).AND.&
341 : &(abs(modulo(multiple(3),1.0))<eps_r)) THEN
342 : IF (zmat%l_real) THEN
343 : w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
344 : ELSE
345 : w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
346 : !write (*,*) CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
347 : END IF
348 : END IF
349 : END DO
350 : !------------------LO's------------------------
351 : na=0
352 : DO n_i=1,atoms%ntype
353 : DO nn=1,atoms%neq(n_i)
354 : na=na+1
355 : DO lo=1,atoms%nlo(n_i)
356 : nk=lapw%nkvec(lo,na)
357 : DO nki=1,nk
358 : gi=lapw%kvec(nki,lo,na)
359 : j=lapw%nv(jsp)+lapw%index_lo(lo,na)+nki
360 : IF (zmat%l_real) THEN
361 : w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
362 : ELSE
363 : w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
364 : END IF
365 : multiple=matmul(inv_unfold,lapw%gvec(:,gi,jsp))
366 : IF ((abs(modulo(multiple(1),1.0))<eps_r).AND.&
367 : &(abs(modulo(multiple(2),1.0))<eps_r).AND.&
368 : &(abs(modulo(multiple(3),1.0))<eps_r)) THEN
369 : IF (zmat%l_real) THEN
370 : w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
371 : ELSE
372 : w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
373 : END IF
374 : END IF
375 : END DO
376 : END DO
377 : END DO
378 : END DO
379 : !--------------------------LO's finished----------------
380 : END IF
381 : !IF (method_rubel) THEN
382 : IF (write_to_file) THEN
383 : IF (zmat%l_real) THEN
384 : IF (w_n(i)/w_n_sum(i)<0) w_n(i)=0 ! delete negative entries
385 : IF (jsp==1) write(679,'(3f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)/w_n_sum(i)
386 : IF (jsp==2) write(680,'(3f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)/w_n_sum(i)
387 : IF ((w_n(i)/w_n_sum(i)>1).or.(w_n(i)/w_n_sum(i)<0)) write(*,*) 'w_n/sum larger 1 or smaller 0', w_n(i)/w_n_sum(i), 'eigenvalue',eig(i)
388 : ELSE
389 : IF (real(w_n_c(i))<0) w_n_c(i)=0 ! delete negative entries
390 : IF (jsp==1) write(679,'(4f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n_c(i)/w_n_c_sum(i)
391 : IF (jsp==2) write(680,'(4f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n_c(i)/w_n_c_sum(i)
392 : IF ((abs(w_n_c(i)/w_n_c_sum(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c/sum larger 1 or smaller 0', w_n_c(i)/w_n_c_sum(i), 'eigenvalue',eig(i)
393 : END IF
394 : END IF
395 : IF (zmat%l_real) THEN
396 : IF (w_n(i)/w_n_sum(i)<0) w_n(i)=0 ! delete negative entries
397 : unfoldingBuffer(i,i_kpt,jsp)=w_n(i)/w_n_sum(i)
398 : IF ((w_n(i)/w_n_sum(i)>1).or.(w_n(i)/w_n_sum(i)<0)) write(*,*) 'w_n/sum larger 1 or smaller 0', w_n(i)/w_n_sum(i), 'eigenvalue',eig(i)
399 : ELSE
400 : IF (real(w_n_c(i))<0) w_n_c(i)=0 ! delete negative entries
401 : unfoldingBuffer(i,i_kpt,jsp)=w_n_c(i)/w_n_c_sum(i)
402 : IF ((abs(w_n_c(i)/w_n_c_sum(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c/sum larger 1 or smaller 0', w_n_c(i)/w_n_c_sum(i), 'eigenvalue',eig(i)
403 : END IF
404 : END DO
405 : !$omp end do
406 : !$omp end parallel
407 24 : write (*,*) 'finished',i_kpt
408 24 : IF (i_kpt==kpts%nkpt) THEN
409 2 : IF (write_to_file .AND. jsp==1) CLOSE (679)
410 2 : IF (jsp==input%jspins) THEN
411 1 : IF (write_to_file .AND. jsp==2) CLOSE (680)
412 : !kpts%bk(:,:)=kpts%sc_list(11:13,:)
413 1 : write(*,*) 'Unfolded Bandstructure calculated succesfully, calledby=calculate_plot_w_n'
414 : !CALL juDFT_error('Unfolded Bandstructure created succesfully - use band_sc.gnu to plot', calledby='calculate_plot_w_n')
415 : END IF
416 : END IF
417 1296 : END SUBROUTINE
418 :
419 1 : SUBROUTINE write_band_sc(banddos,cell,kpts,results,eFermiPrev)
420 : USE m_types
421 : USE m_juDFT
422 : USE m_constants
423 : USE m_inv3
424 : IMPLICIT NONE
425 : TYPE(t_results),INTENT(IN) :: results
426 : TYPE(t_banddos),INTENT(IN) :: banddos
427 : TYPE(t_kpts),INTENT(IN) :: kpts
428 : REAL, INTENT(IN) :: eFermiPrev
429 : INTEGER :: i,i_kpt,jsp
430 : TYPE(t_cell),INTENT(IN) :: cell
431 : TYPE(t_cell) :: p_cell
432 :
433 :
434 : REAL :: kpt_dist
435 1 : REAL :: list(4,kpts%nkpt)
436 : !-------------build primitive cell ----------
437 1 : p_cell=cell
438 4 : DO i =1,3
439 3 : p_cell%amat(1,i)=cell%amat(1,i)/banddos%s_cell_x
440 3 : p_cell%amat(2,i)=cell%amat(2,i)/banddos%s_cell_y
441 4 : p_cell%amat(3,i)=cell%amat(3,i)/banddos%s_cell_z
442 : END DO
443 1 : CALL inv3(p_cell%amat,p_cell%bmat,p_cell%omtil)
444 13 : p_cell%bmat=p_cell%bmat*tpi_const
445 :
446 : !-------------- calculate distance ------------
447 1 : kpt_dist=0
448 13 : DO i=1,size(list,2)
449 12 : list(1,i)=kpts%bk(1,i)*p_cell%bmat(1,1)+kpts%bk(2,i)*p_cell%bmat(2,1)+kpts%bk(3,i)*p_cell%bmat(3,1)
450 12 : list(2,i)=kpts%bk(1,i)*p_cell%bmat(1,2)+kpts%bk(2,i)*p_cell%bmat(2,2)+kpts%bk(3,i)*p_cell%bmat(3,2)
451 12 : list(3,i)=kpts%bk(1,i)*p_cell%bmat(1,3)+kpts%bk(2,i)*p_cell%bmat(2,3)+kpts%bk(3,i)*p_cell%bmat(3,3)
452 12 : IF (i>1) THEN
453 44 : kpt_dist=kpt_dist+sqrt(dot_product(list(1:3,i)-list(1:3,i-1),list(1:3,i)-list(1:3,i-1)))
454 : END IF
455 13 : list(4,i)=kpt_dist
456 : END DO
457 : !--------------------------------------
458 1 : OPEN (679,file='bands_sc.1',status='unknown') !This is kind of my birthday 6 july 1992 (S.R.)
459 1 : IF (SIZE(results%unfolding_weights,3)==2) OPEN (680,file='bands_sc.2',status='unknown')
460 3 : DO jsp=1,SIZE(results%unfolding_weights,3)
461 27 : DO i_kpt=1,SIZE(results%unfolding_weights,2)
462 1946 : DO i=1,results%neig(i_kpt,jsp)
463 1920 : IF (jsp==1) write(679,'(4f15.8)') list(4,i_kpt), ((results%eig(i,i_kpt,1)-eFermiPrev)*hartree_to_ev_const),results%unfolding_weights(i,i_kpt,1)
464 1944 : IF (jsp==2) write(680,'(4f15.8)') list(4,i_kpt), ((results%eig(i,i_kpt,2)-eFermiPrev)*hartree_to_ev_const),results%unfolding_weights(i,i_kpt,2)
465 : END DO
466 : END DO
467 : END DO
468 1 : CLOSE (679)
469 1 : IF (SIZE(results%unfolding_weights,3)==2) CLOSE (680)
470 1 : write(*,*) 'Unfolded Bandstructure written succesfully - use band_sc.gnu to plot, calledby=write_band_sc',eFermiPrev
471 1 : END SUBROUTINE
472 :
473 : !---- new subroutine in gnuplot.F90
474 : ! SUBROUTINE write_gnu_sc_old(nosyp,d,ssy,input)
475 : ! USE m_types
476 : ! USE m_juDFT
477 : ! IMPLICIT NONE
478 : !
479 : ! TYPE(t_input),INTENT(IN) :: input
480 : ! INTEGER, INTENT (IN) :: nosyp
481 : ! REAL, INTENT (IN) :: d(nosyp)
482 : ! CHARACTER(len=1), INTENT (IN) :: ssy(nosyp)
483 : !
484 : ! INTEGER n,aoff,adel
485 : ! CHARACTER(LEN=200) tempTitle
486 : ! aoff = iachar('a')-1
487 : ! adel = iachar('a')-iachar('A')
488 : ! !write(*,*) aoff,adel
489 : !
490 : ! OPEN (27,file='band_sc.gnu',status='unknown')
491 : ! WRITE (27,*) 'reset'
492 : ! WRITE (27,900)
493 : ! WRITE (27,901)
494 : ! WRITE (27,902)
495 : ! WRITE (27,903)
496 : ! WRITE(tempTitle,'(10a)') input%comment
497 : ! IF(TRIM(ADJUSTL(tempTitle)).EQ.'') THEN
498 : ! tempTitle = "Fleur Bandstructure"
499 : ! END IF
500 : ! WRITE (27,904) TRIM(ADJUSTL(tempTitle))
501 : ! DO n = 1, nosyp
502 : ! WRITE (27,905) d(n),d(n)
503 : ! ENDDO
504 : ! WRITE (27,906) d(1),d(nosyp)
505 : !!
506 : !! nomal labels
507 : !!
508 : ! IF (iachar(ssy(1)) < aoff ) THEN
509 : ! WRITE (27,907) ssy(1),d(1),achar(92)
510 : ! ELSE
511 : ! WRITE (27,907) " ",d(1),achar(92)
512 : ! ENDIF
513 : ! DO n = 2, nosyp-1
514 : ! IF (iachar(ssy(n)) < aoff ) THEN
515 : ! WRITE (27,908) ssy(n),d(n),achar(92)
516 : ! ELSE
517 : ! WRITE (27,908) " ",d(n),achar(92)
518 : ! ENDIF
519 : ! ENDDO
520 : ! IF (iachar(ssy(nosyp)) < aoff ) THEN
521 : ! WRITE (27,909) ssy(nosyp),d(nosyp)
522 : ! ELSE
523 : ! WRITE (27,909) " ",d(nosyp)
524 : ! ENDIF
525 : !!
526 : !! greek labels
527 : !!
528 : ! DO n = 1, nosyp
529 : ! IF (iachar(ssy(n)) > aoff ) THEN
530 : ! WRITE (27,914) achar(iachar(ssy(n))-adel),d(n)
531 : ! ENDIF
532 : ! ENDDO
533 : !!
534 : !! now write the rest
535 : !!
536 : ! WRITE (27,910)
537 : ! WRITE (27,*) 'set palette model RGB'
538 : ! WRITE (27,*) 'set palette defined (-2 "black", -1 "white" ,0 "white",',achar(92)
539 : ! WRITE (27,*) '0.67 "light-blue",1 "blue")'
540 : ! WRITE (27,*) 'set cbrange [-2:1]'
541 : ! WRITE (27,*) 'unset colorbox'
542 : ! WRITE (27,*) 'size1(x)=0.9*x**(0.4)'
543 : ! WRITE (27,*) 'color1(x)=0.3+x/2.4'
544 : ! WRITE (27,*) 'size2(x)=0.35*(1-x**(0.01))'
545 : ! WRITE (27,*) 'color2(x)=1.15*(x-1)'
546 : ! WRITE (27,*) 'e_f=0.000000 #fermi energy is already corrected when using hdf5'
547 : ! WRITE (27,911) d(nosyp)+0.00001,achar(92)
548 : ! IF (input%jspins == 2) THEN
549 : ! WRITE (27,912) achar(92)
550 : ! WRITE (27,916) achar(92)
551 : ! END IF
552 : ! WRITE (27,913) achar(92)
553 : ! WRITE (27,915)
554 : ! CLOSE (27)
555 : !
556 : ! 900 FORMAT ('set terminal postscript enhanced color "Times-Roman" 20')
557 : ! 901 FORMAT ('set xlabel ""')
558 : ! 902 FORMAT ('set ylabel "E - E_F (eV)"')
559 : ! 903 FORMAT ('set nokey')
560 : ! 904 FORMAT ('set title "',a,'"')
561 : ! 905 FORMAT ('set arrow from',f9.5,', -9.0 to',f9.5,', 5.0 nohead')
562 : ! 906 FORMAT ('set arrow from',f9.5,', 0.0 to',f9.5,', 0.0 nohead lt 3')
563 : ! 907 FORMAT ('set xtics ("',a1,'"',f9.5,', ',a)
564 : ! 908 FORMAT (' "',a1,'"',f9.5,', ',a)
565 : ! 909 FORMAT (' "',a1,'"',f9.5,' )')
566 : ! 910 FORMAT ('set ytics -8,2,4')
567 : ! 911 FORMAT ('plot [0:',f9.5,'] [-9:5] ',a)
568 : ! 912 FORMAT ('"bands_sc.2" using 1:($2-e_f):(size1($3)):(color1($3)) w p pt 7 ps variable lc palette, ',a)
569 : ! 916 FORMAT ('"bands_sc.2" using 1:($2-e_f):(size2($3)):(color2($3)) w p pt 7 ps variable lc palette,',a)
570 : ! 913 FORMAT ('"bands_sc.1" using 1:($2-e_f):(size1($3)):(color1($3)) w p pt 7 ps variable lc palette, ',a)
571 : ! 915 FORMAT ('"bands_sc.1" using 1:($2-e_f):(size2($3)):(color2($3)) w p pt 7 ps variable lc palette')
572 : ! 914 FORMAT ('set label "',a1,'" at ',f9.5,', -9.65 center font "Symbol,20"')
573 : ! END SUBROUTINE write_gnu_sc_old
574 48 : END MODULE m_unfold_band_kpts
|
