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_rw_eig
8 : use m_juDFT
9 : #ifdef CPP_MPI
10 : #define CPP_HYBEIG
11 : #endif
12 : c****************************************************************
13 : c write WF1.eig and determine maximum of number of bands
14 : c Frank Freimuth, October 2006
15 : c****************************************************************
16 : CONTAINS
17 1 : SUBROUTINE wann_write_eig(
18 : > fmpi,cell,noco,nococonv,input,kpts,sym,atoms,
19 : > eig_id,l_real,
20 : > ntypd,nvd,jspd,
21 : > isize,jspin,
22 : > l_ss,l_noco,nrec,fullnkpts,
23 : > l_bzsym,l_byindex,l_bynumber,l_byenergy,
24 1 : > irreduc,band_min,band_max,numbands,
25 : > e1s,e2s,ef,l_paulimag,nkpt,
26 : < nbnd,kpoints,l_gwf,iqpt)
27 :
28 : use m_types
29 : use m_constants
30 : use m_cdnread, only:cdn_read
31 :
32 : IMPLICIT NONE
33 : TYPE(t_mpi), INTENT(IN) :: fmpi
34 : TYPE(t_cell), INTENT(IN) :: cell
35 : TYPE(t_noco), INTENT(IN) :: noco
36 : TYPE(t_nococonv), INTENT(IN) :: nococonv
37 : TYPE(t_input), INTENT(IN) :: input
38 : TYPE(t_kpts), INTENT(IN) :: kpts
39 : TYPE(t_sym), INTENT(IN) :: sym
40 : TYPE(t_atoms), INTENT(IN) :: atoms
41 : integer,intent(in) :: eig_id
42 : integer,intent(in) :: ntypd,nvd,jspd
43 : integer,intent(in) :: isize,jspin
44 : logical,intent(in) :: l_ss,l_noco,l_real
45 : integer,intent(in) :: nrec,fullnkpts
46 :
47 : logical,intent(in) :: l_byindex,l_bynumber,l_byenergy
48 : integer,intent(in) :: irreduc(fullnkpts)
49 : integer,intent(in) :: band_min,band_max,numbands
50 : logical,intent(in) :: l_bzsym
51 : real,intent(in) :: e1s,e2s,ef
52 : logical,intent(in) :: l_paulimag
53 : integer,intent(in) :: nkpt
54 :
55 : integer,intent(out):: nbnd
56 : real,intent(out) :: kpoints(fullnkpts)
57 :
58 : logical :: l_eig
59 : character(len=3) :: spin12(2)
60 : data spin12/'WF1' , 'WF2'/
61 : integer :: ikpt,kptibz
62 : integer :: nmat,nbands,nv(jspd)
63 1 : real :: wk, bkpt(3),eig(input%neig),cp_time(9)
64 : integer :: k1(nvd,jspd),k2(nvd,jspd),k3(nvd,jspd)
65 : integer :: nkbnd,i
66 : integer :: co
67 : integer :: bnd1,bnd2,kpt
68 1 : complex, allocatable :: paulimat(:,:,:,:)
69 : real :: sum1,sum2,sum3
70 : integer :: num_bands,err,numbasfcn
71 :
72 : ! BEGIN QPOINTS
73 : LOGICAL, INTENT(IN) :: l_gwf
74 : INTEGER, INTENT(IN) :: iqpt
75 : CHARACTER(len=12) :: fname
76 : ! END QPOINTS
77 : ! real,parameter :: hartree=27.21138505 !now in module constants
78 :
79 1 : TYPE(t_mat) :: zMat !z(nbasfcn,noccbd) !can be real/complex
80 1 : TYPE(t_lapw) :: lapw
81 :
82 :
83 1 : call timestart("wann_write_eig")
84 : ! zMat%l_real = l_real
85 : ! zMat%matsize1 = nbasfcn
86 : ! zMat%matsize2 = neigd
87 : ! IF(l_real) THEN !allocates not needed, due to zmat%init further below
88 : ! ALLOCATE (zMat%data_r(zMat%matsize1,zMat%matsize2))
89 : ! ELSE
90 : ! ALLOCATE (zMat%data_c(zMat%matsize1,zMat%matsize2))
91 : ! END IF
92 :
93 : ! WRITE(*,*)'min',band_min,'max',band_max,'num',numbands
94 : ! WRITE(*,*)'wann_rw_eig: neigd',neigd
95 : ! n_start=1
96 : ! n_end=neigd
97 1 : IF (l_gwf) THEN
98 0 : WRITE(fname,'("_",i4.4,".eig")')iqpt
99 0 : fname=spin12(jspin)//trim(fname)
100 : ELSE
101 1 : fname=spin12(jspin)//'.eig'
102 : ENDIF
103 :
104 : ! WRITE(*,*)'wann_rw_eig.F: writing eig file ',fname
105 :
106 1 : inquire (file=fname,exist=l_eig)
107 1 : if (l_eig) then
108 : open (306,file=fname,
109 0 : & form='formatted',status='old')
110 0 : rewind (306)
111 : else
112 : open (306,file=fname,
113 1 : & form='formatted',status='new')
114 : endif!l_eig
115 :
116 : if(l_paulimag.and..false.)then
117 : num_bands=band_max-band_min+1
118 : allocate( paulimat(num_bands,num_bands,3,nkpt),stat=err )
119 : IF (err/=0) CALL juDFT_error
120 : + ("error allocating paulimat",calledby
121 : + ="wann_rw_eig")
122 : open(655,file='wpmat')
123 : do ikpt=1,nkpt
124 : read(655,*)
125 : do co=1,3
126 : read(655,*)
127 : do bnd2=1,num_bands
128 : do bnd1=1,num_bands
129 : read(655,*)paulimat(bnd1,bnd2,co,ikpt)
130 : enddo
131 : enddo
132 : enddo
133 : enddo
134 : close(655)
135 : endif
136 1 : sum1=0.0
137 1 : sum2=0.0
138 1 : sum3=0.0
139 :
140 1 : nbnd=0
141 9 : do ikpt = 1,fullnkpts
142 :
143 8 : kptibz=ikpt
144 8 : if(l_bzsym) kptibz=irreduc(ikpt)
145 :
146 : CALL lapw%init(input,noco,nococonv,kpts,
147 8 : & atoms,sym,kptibz,cell,fmpi)
148 :
149 : numbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,
150 8 : & lapw%nv(1)+atoms%nlotot,noco%l_noco)
151 :
152 8 : CALL zMat%init(l_real,numbasfcn,input%neig)
153 :
154 :
155 8 : kptibz=ikpt
156 8 : if(l_bzsym) kptibz=irreduc(ikpt)
157 : call wann_read_eig(
158 : > eig_id,
159 : > ntypd,input%neig,nvd,jspd,
160 : > 0,isize,kptibz,jspin,numbasfcn,
161 : > l_ss,l_noco,nrec,
162 : < nmat,nbands,eig,zMat,
163 8 : > l_gwf,iqpt)
164 :
165 :
166 8 : nkbnd = 0
167 : ! WRITE(*,*)'wann_rw_eig: nbands',nbands
168 72 : do i = 1,nbands
169 : if((eig(i).ge.e1s .and. nkbnd.lt.numbands.and.l_bynumber).or.
170 64 : & (eig(i).ge.e1s.and.eig(i).le.e2s.and.l_byenergy ).or.
171 8 : & (i.ge.band_min.and.i.le.band_max.and.l_byindex)) then
172 64 : nkbnd = nkbnd + 1
173 64 : if(l_bynumber.or.l_byindex)then
174 64 : write (306,'(2i12,f19.13)') nkbnd,ikpt,(eig(i)-ef)*
175 128 : & hartree_to_ev_const
176 : endif
177 : if(l_paulimag.and..false.)then
178 : if(eig(i).le.ef)then
179 : sum1=sum1+paulimat(nkbnd,nkbnd,1,kptibz)
180 : sum2=sum2+paulimat(nkbnd,nkbnd,2,kptibz)
181 : sum3=sum3+paulimat(nkbnd,nkbnd,3,kptibz)
182 : endif
183 : endif
184 : endif
185 : enddo
186 : ! WRITE(*,*)'wann_rw_eig: nkbnd',nkbnd,'nbnd',nbnd
187 9 : if (nkbnd.ge.nbnd) nbnd = nkbnd
188 :
189 :
190 : enddo !ikpt
191 :
192 1 : if(l_paulimag)then
193 0 : write(oUnit,*)"sum1=",sum1/fullnkpts
194 0 : write(oUnit,*)"sum2=",sum2/fullnkpts
195 0 : write(oUnit,*)"sum3=",sum3/fullnkpts
196 : endif
197 :
198 :
199 1 : if(l_byenergy)then !now we know the maximum of bands
200 0 : do ikpt=1,fullnkpts
201 0 : kptibz=ikpt
202 0 : if(l_bzsym)kptibz=irreduc(ikpt)
203 : call wann_read_eig(
204 : > eig_id,
205 : > ntypd,input%neig,nvd,jspd,
206 : > 0,isize,kptibz,jspin,numbasfcn,
207 : > l_ss,l_noco,nrec,
208 : < nmat,nbands,eig,zMat,
209 0 : > l_gwf,iqpt)
210 :
211 :
212 0 : nkbnd = 0
213 0 : do i = 1,nbands
214 0 : if(eig(i).ge.e1s .and. nkbnd.lt.nbnd)then
215 0 : nkbnd = nkbnd + 1
216 0 : write (306,'(2i12,f19.13)')nkbnd,ikpt,(eig(i)-ef)*
217 0 : & hartree_to_ev_const
218 : endif
219 : enddo
220 : enddo
221 : endif
222 1 : close (306)
223 :
224 1 : call timestop("wann_write_eig")
225 1 : end subroutine wann_write_eig
226 :
227 : c*****************************************************************
228 : c read in eig file
229 : c*****************************************************************
230 8 : subroutine wann_read_eig(
231 : > eig_id,
232 : > ntypd,neigd,nvd,jspd,
233 : > irank,isize,kptibz,jspin,nbasfcn,
234 : > l_ss,l_noco,nrec,
235 8 : < nmat,nbands,eig,zMat,
236 : > l_gwf,iqpt)
237 : USE m_judft
238 : USE m_types
239 : use m_cdnread, only:cdn_read
240 : implicit none
241 : integer, intent (in) :: eig_id
242 : INTEGER, INTENT (IN) :: irank,isize,kptibz,nbasfcn,neigd
243 : INTEGER, INTENT (IN) :: nrec,nvd,jspd,jspin
244 : INTEGER, INTENT (IN) :: ntypd,iqpt
245 : LOGICAL, INTENT (IN) :: l_ss,l_noco,l_gwf
246 :
247 : INTEGER, INTENT (OUT) :: nbands,nmat
248 :
249 : REAL, INTENT (OUT) :: eig(neigd)
250 :
251 : TYPE(t_mat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex
252 :
253 : integer :: n_start,n_end
254 :
255 8 : call timestart("wann_read_eig")
256 :
257 8 : n_start=1
258 8 : n_end=neigd
259 :
260 : CALL cdn_read(
261 : > eig_id,
262 : > nvd,jspd,irank,isize,kptibz,jspin,nbasfcn,
263 : > l_ss,l_noco,neigd,n_start,n_end,
264 8 : < nbands,eig,zMat)
265 : ! CALL judft_error("BUG: wann_read in wann_rw_eig not implemented")
266 :
267 8 : call timestop("wann_read_eig")
268 8 : END SUBROUTINE wann_read_eig
269 : END MODULE m_wann_rw_eig
|
