Line data Source code
1 : !!****m* ABINIT/m_fold2block
2 : !! NAME
3 : !! m_fold2block
4 : !!
5 : !! FUNCTION
6 : !! This module contains basic tools to operate on vectors expressed in reduced coordinates.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2008-2026 ABINIT group (AB)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! SOURCE
15 :
16 : #if defined HAVE_CONFIG_H
17 : #include "config.h"
18 : #endif
19 :
20 : #include "abi_common.h"
21 :
22 : MODULE m_fold2block
23 :
24 : use defs_basis
25 : use m_abicore
26 : use m_errors
27 :
28 : implicit none
29 :
30 : public
31 : !private
32 :
33 : CONTAINS !===========================================================
34 : !!***
35 :
36 : !----------------------------------------------------------------------
37 :
38 : !!****f* m_fold2block/SortC
39 : !! NAME
40 : !! SortC
41 : !!
42 : !! FUNCTION
43 : !! Part of fold2Bloch that unfolds the wavefunction and calculates
44 : !! the weight of each band.
45 : !!
46 : !! INPUTS
47 : !! FX, FY, FZ= Number of folds in each dimention
48 : !! vector= Array of energy coefficient position vectors
49 : !! coefc= Array of energy coefficients of in a certain band
50 : !! NV= Number of vectors/coefficients
51 : !!
52 : !! OUTPUT
53 : !! wegihts= Calculated weights of a band in an unfolded state.
54 : !! Depends on the number of folds the WFK file was structured with.
55 : !!
56 : !! SOURCE
57 :
58 :
59 168 : subroutine SortC(FX, FY, FZ, Vector, CoefC, NV, Weights)
60 :
61 : !Arguments ------------------------------------
62 : !scalars
63 : integer, intent(in) :: FX, FY, FZ, NV
64 : !arrays
65 : integer, intent(in) :: Vector(3,NV)
66 : real(dp), intent(in) :: CoefC(2,NV)
67 : real(dp), intent(inout) :: Weights(FX*FY*FZ)
68 :
69 : !Local variables-------------------------------
70 : !scalars
71 : real :: sumtot
72 : integer :: remainder_x, remainder_y, remainder_z, jj, kk, ll, pp, el
73 : !arrays
74 168 : real(dp), allocatable :: Sums(:)
75 168 : real(dp), allocatable :: coefsqr(:),TGroupC(:,:,:,:)
76 168 : integer, allocatable :: counter(:,:,:)
77 :
78 : ! *************************************************************************
79 :
80 1008 : ABI_MALLOC(TGroupC,(FX, FY, FZ, NV))
81 504 : ABI_MALLOC(Sums,(FX*FY*FZ))
82 840 : ABI_MALLOC(counter,(FX,FY,FZ))
83 504 : ABI_MALLOC(coefsqr,(NV))
84 :
85 : !Convert to sum of squares
86 108100 : do jj=1, NV
87 108100 : coefsqr(jj)=coefc(1,jj)*coefc(1,jj)+coefc(2,jj)*coefc(2,jj)
88 : end do
89 :
90 : !Initiates the counter and TGroupC elements at 0
91 336 : do jj=1,FX
92 672 : do kk=1,FY
93 1512 : do ll=1,FZ
94 1008 : counter(jj,kk,ll)=0
95 648936 : do pp=1,NV
96 648600 : TGroupC(jj,kk,ll,pp)=0.0
97 : end do
98 : end do
99 : end do
100 : end do
101 :
102 : !Sorts the energy coeeficients
103 108100 : do jj=1, (NV)
104 107932 : remainder_x=MODULO(Vector(1,jj), FX)
105 107932 : remainder_y=MODULO(Vector(2,jj), FY)
106 107932 : remainder_z=MODULO(Vector(3,jj), FZ)
107 107932 : counter(remainder_x+1, remainder_y+1, remainder_z+1)=counter(remainder_x+1, remainder_y+1, remainder_z+1)+1
108 108100 : TGroupC(remainder_x+1, remainder_y+1, remainder_z+1, counter(remainder_x+1, remainder_y+1, remainder_z+1))=Coefsqr(jj)
109 : end do
110 :
111 : !Sums the squares of all coefficients per group
112 : el=1
113 336 : do jj=1, FX
114 672 : do kk=1, FY
115 1512 : do ll=1, FZ
116 1344 : if (counter(jj, kk, ll)>0) then
117 108940 : Sums(el)=SUM(TGroupC(jj, kk, ll,1:counter(jj, kk, ll)))
118 1008 : el=el+1
119 : else
120 0 : Sums(el)=0.0
121 0 : el=el+1
122 : end if
123 : end do
124 : end do
125 : end do
126 :
127 : !Assign weights to an array
128 1176 : sumtot=SUM(Sums)
129 1176 : do jj=1, (FX*FY*FZ)
130 1176 : Weights(jj)=Sums(jj)/sumtot
131 : end do
132 168 : ABI_FREE(TGroupC)
133 168 : ABI_FREE(Sums)
134 168 : ABI_FREE(counter)
135 168 : ABI_FREE(coefsqr)
136 :
137 168 : end subroutine SortC
138 : !!***
139 :
140 : !!****f* m_fold2block/NewK
141 : !! NAME
142 : !! NewK
143 : !!
144 : !! FUNCTION
145 : !! Part of fold2Bloch that determines the unfolded
146 : !! positions of each K point.
147 : !!
148 : !! INPUTS
149 : !! FX, FY, FZ= Number of folds in each dimention
150 : !! XX, YY, ZZ= Original K point coordinates
151 : !!
152 : !! OUTPUT
153 : !! nkval= Array of determined coordinates of unfolded K point locaations.
154 : !! Depends on the number of folds the WFK file was structured with.
155 : !!
156 : !! SOURCE
157 :
158 42 : subroutine NewK(XX, YY, ZZ, FX, FY, FZ, NKVal)
159 :
160 : !Arguments ------------------------------------
161 : !scalars
162 : integer, intent(in) :: FX, FY, FZ
163 : real(dp), intent(in) :: XX, YY, ZZ
164 : real(dp), intent(inout) :: NKVal (3,FX*FY*FZ)
165 : !arrays
166 :
167 : !Local variables-------------------------------
168 : !scalars
169 : real(dp) :: field_x, field_y, field_z
170 : real(dp) :: TX, TY, TZ
171 : integer :: loop, ii, jj, kk, size
172 : !arrays
173 :
174 : ! *************************************************************************
175 :
176 42 : size=FX*FY*FZ
177 :
178 : !Brillouin zone range
179 42 : field_x=0.5*FX
180 42 : field_y=0.5*FY
181 42 : field_z=0.5*FZ
182 42 : loop=1
183 :
184 : !Determine new K point states
185 84 : do ii=0, (FX-1)
186 42 : if ((XX+ii)>(field_x)) then !if falls outside of field, loop it around
187 0 : TX=XX-(field_x*2)+ii
188 : else
189 : TX=XX+ii
190 : end if
191 168 : do jj=0, (FY-1)
192 84 : if ((YY+jj)>(field_y)) then
193 10 : TY=YY-(field_y*2)+jj
194 : else
195 : TY=YY+jj
196 : end if
197 378 : do kk=0,(FZ-1)
198 252 : if ((ZZ+kk)>(field_z)) then
199 82 : TZ=ZZ-(field_z*2)+kk
200 : else
201 : TZ=ZZ+kk
202 : end if
203 252 : NKVal(1,loop)=TX !Assign to an output array
204 252 : NKVal(2,loop)=TY
205 252 : NKVal(3,loop)=TZ
206 336 : loop=loop+1
207 : end do
208 : end do
209 : end do
210 :
211 : !reduce the values to fit in Brillouin zone
212 294 : do ii=1, FX*FY*FZ
213 252 : nkval(1,ii)=nkval(1,ii)/FX
214 252 : nkval(2,ii)=nkval(2,ii)/FY
215 294 : nkval(3,ii)=nkval(3,ii)/FZ
216 : end do
217 :
218 42 : END SUBROUTINE NewK
219 : !!***
220 :
221 : !!****f* m_fold2block/getargs
222 : !! NAME
223 : !! getargs
224 : !!
225 : !! FUNCTION
226 : !! Part of fold2Bloch that interprets the command line
227 : !! arguments and checks for their corectness.
228 : !!
229 : !! INPUTS
230 : !! fname: Name of input file
231 : !! folds: Number of folds in x, y, and z directions.
232 : !!
233 : !! OUTPUT
234 : !! folds: Number of folds in x, y, and z directions.
235 : !! Returns the folds array filled with each element.
236 : !!
237 : !! SOURCE
238 :
239 0 : subroutine getargs(folds, fname)
240 :
241 : !Arguments ------------------------------------
242 : !scalars
243 : character(len=fnlen), intent(inout) :: fname
244 : !arrays
245 : integer, intent(inout) :: folds(3)
246 :
247 : !Local variables-------------------------------
248 : !scalars
249 : integer :: num_args, argcount, ii, ios
250 : character(len=fnlen) :: argfolds
251 : logical :: dir
252 : !arrays
253 0 : character(len=fnlen), allocatable :: args(:)
254 :
255 : ! *************************************************************************
256 :
257 : !get number of args
258 0 : num_args=command_argument_count()
259 0 : ABI_MALLOC(args,(num_args))
260 :
261 : !Check for errors in arguments
262 0 : if (num_args>2) then
263 0 : write(std_out,*) " Too many arguments."
264 0 : write(std_out,*) " Usage: $fold2Bloch file_WFK x:y:z (folds)"
265 0 : ABI_ERROR("Aborting now")
266 0 : elseif (num_args<2) then
267 0 : if (num_args==1) then
268 0 : call get_command_argument(1,args(1))
269 0 : if ((args(1)=="-h").or.(args(1)=="--help")) then
270 0 : write(std_out,*) " Usage: fold2Bloch file_WFK x:y:z (folds)"
271 0 : write(std_out,*) " file_WFK is the WFK file name (ex. Ex_WFK)"
272 0 : write(std_out,*) " x:y:z integers, greater than 0 that represent a multiplicity"
273 0 : write(std_out,*) " in the corresponding directions used when constructing the supercell."
274 0 : ABI_ERROR("Aborting now")
275 : else
276 0 : write(std_out,*) " Not all arguments are present."
277 0 : write(std_out,*) " Make sure that file name and number of folds are indicated."
278 0 : write(std_out,*) " Usage: $fold2Bloch file_WFK x:y:z (folds)"
279 0 : ABI_ERROR("Aborting now")
280 : end if
281 : else
282 0 : write(std_out,*) " Not all arguments are present."
283 0 : write(std_out,*) " Make sure that file name and number of folds are indicated."
284 0 : write(std_out,*) " Usage: $fold2Bloch file_WFK x:y:z (folds)"
285 0 : ABI_ERROR("Aborting now")
286 : end if
287 : else
288 0 : do argcount=1, num_args
289 0 : call get_command_argument(argcount,args(argcount))
290 0 : if (argcount==1) then
291 0 : read(args(argcount), "(a)") fname !read first argument
292 : else
293 0 : read(args(argcount), "(a)") argfolds !read second argument
294 : end if
295 : end do
296 : end if
297 :
298 : ! Does intput file exist?
299 0 : inquire(file=fname, exist=dir)
300 0 : if (.not.(dir)) then
301 0 : write(std_out,*) " Case file not found: ", trim(fname)
302 0 : write(std_out,*) " Usage: $fold2Bloch file_WFK x:y:z (folds)"
303 0 : ABI_ERROR("Aborting now")
304 : end if
305 :
306 : !Was the number of folds entered in correct format?
307 0 : ii=0
308 0 : ii=INDEX(argfolds, ':') !look for first ":" to differentiate between axis
309 0 : if (ii==0) then
310 0 : write(std_out,*) " Unknown number of folds. See below or type:"
311 0 : write(std_out,*) " fold2Bloch <-h> or fold2Bloch <--help> for more information."
312 0 : write(std_out,*) ' Usage: $fold2Bloch file_WFK x:y:z (folds)'
313 0 : ABI_ERROR("Aborting now")
314 : end if
315 0 : read (argfolds(1:ii-1), *, iostat=ios) folds(1) !read X folds
316 0 : if ((ios/=0).or.(folds(1)<=0)) then
317 0 : ABI_ERROR('Number of folds has to be a positive integer greater than 0')
318 : end if
319 0 : argfolds=argfolds(ii+1:) !Start argfolds from the first ":"
320 0 : ii=0
321 0 : ii=INDEX(argfolds, ':') !look for second ":"
322 0 : if (ii==0) then
323 0 : write(std_out,*) ' Unknown number of folds. See below or type:'
324 0 : write(std_out,*) " fold2Bloch <-h> or fold2Bloch <--help> for more information."
325 0 : write(std_out,*) ' Usage: $fold2Bloch file_WFK x:y:z (folds)'
326 0 : ABI_ERROR("Aborting now")
327 : end if
328 0 : read (argfolds(1:ii-1),*, iostat=ios) folds(2) !read Y folds
329 0 : if ((ios/=0).or.(folds(2)<=0)) then
330 0 : ABI_ERROR('Number of folds has to be a positive integer greater than 0')
331 : end if
332 0 : read(argfolds(ii+1:),*, iostat=ios) Folds(3) !read Z folds
333 0 : if ((ios/=0).or.(folds(3)<=0)) then
334 0 : ABI_ERROR('Number of folds has to be a positive integer greater than 0')
335 : end if
336 :
337 0 : ABI_FREE(args)
338 :
339 0 : end subroutine getargs
340 : !!***
341 :
342 : !!****f* m_fold2block/progress
343 : !! NAME
344 : !! progress
345 : !!
346 : !! FUNCTION
347 : !! Part of fold2Bloch that unfolds the wavefunction and calculates
348 : !! the weight of each band.
349 : !!
350 : !! INPUTS
351 : !! ikpt: K point index
352 : !! nkpt: Total number of K points in the function
353 : !! kpt: Current K point being procesed.
354 : !!
355 : !! OUTPUT
356 : !! Write to screen K point being processed and percent complete.
357 : !!
358 : !! SOURCE
359 :
360 42 : subroutine progress(ikpt, nkpt, kpt)
361 :
362 : !Arguments ------------------------------------
363 : !scalars
364 : integer, intent(in) :: ikpt, nkpt
365 : !arrays
366 : real(dp), intent(in) :: kpt(3)
367 : ! *************************************************************************
368 :
369 42 : write(std_out, '(a,i10, a1)', advance='no') ''//achar(27)//'[97m',100*ikpt/nkpt,'%'//achar(27)//'[0m'
370 42 : write(std_out, '(a25,3f12.6,a)') ''//achar(27)//'[32m Processing K point: ', kpt,''//achar(27)//'[0m'
371 :
372 42 : end subroutine progress
373 : !!***
374 :
375 : end module m_fold2block
|
