Branch data 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
|
