Line data Source code
1 : !!****m* ABINIT/m_lgroup
2 : !! NAME
3 : !! m_lgroup
4 : !!
5 : !! FUNCTION
6 : !! The little group of a q-point is defined as the subgroup of rotations that preserves q,
7 : !! modulo a G0 vector (also called umklapp vector). Namely:
8 : !!
9 : !! Sq = q + G0
10 : !!
11 : !! where S is an operation in reciprocal space (symrec)
12 : !! If time reversal symmetry can be used, it is possible to enlarge the little group by
13 : !! including the operations such as:
14 : !!
15 : !! -Sq = q + G0
16 : !!
17 : !! The operations of little group define an irriducible wedge, IBZ(q), that is usually larger
18 : !! than the irredubile zone defined by the point group of the crystal. The two zones coincide when q=0
19 : !!
20 : !! COPYRIGHT
21 : !! Copyright (C) 2008-2026 ABINIT group (MG)
22 : !! This file is distributed under the terms of the
23 : !! GNU General Public License, see ~abinit/COPYING
24 : !! or http://www.gnu.org/copyleft/gpl.txt .
25 : !!
26 : !! SOURCE
27 :
28 : #if defined HAVE_CONFIG_H
29 : #include "config.h"
30 : #endif
31 :
32 : #include "abi_common.h"
33 :
34 : module m_lgroup
35 :
36 : use defs_basis
37 : use m_errors
38 : use m_abicore
39 : use m_copy
40 : use m_symkpt
41 : use m_sort
42 : use m_xmpi
43 :
44 : use m_fstrings, only : ftoa, ktoa, sjoin, ltoa, itoa
45 : use m_numeric_tools, only : wrap2_pmhalf
46 : use m_geometry, only : normv
47 : use m_crystal, only : crystal_t
48 : use m_kpts, only : listkk
49 : use m_symtk, only : sg_multable, littlegroup_q
50 :
51 : implicit none
52 :
53 : private
54 : !!***
55 :
56 : !!****t* m_sigmaph/lgroup_t
57 : !! NAME
58 : !! lgroup_t
59 : !!
60 : !! FUNCTION
61 : !! Stores tables associated to the little-group.
62 : !!
63 : !! SOURCE
64 :
65 : type, public :: lgroup_t
66 :
67 : integer :: nibz
68 : ! Number of points in the IBZ(q)
69 :
70 : integer :: nbz
71 : ! Number of points in the full BZ
72 :
73 : integer :: nsym_lg
74 : ! Number of operations in the little group. Including "time-reversed" symmetries
75 : ! i.e. symmetries S for which -S q = q + G. See also littlegroup_q
76 :
77 : integer :: input_timrev
78 : ! 1 if time-reversal symmetry can be used, 0 otherwise.
79 : ! NB: This flag refers to the generation of the initial set of k-points.
80 : ! One should pay attention when calling other routines in which timrev is required
81 : ! Because from Sq = q does not necessarily follow that -Sq = q if q is not on zone-border.
82 : ! The operations in G-space stored here already include time-reversal if input_timrev == 1
83 : ! so one should call k-point routines with timrev = 0 when using the operations of the little group.
84 :
85 : real(dp) :: point(3)
86 : ! The external q-point in reduced coordinates.
87 :
88 : integer,allocatable :: symtab(:,:,:)
89 : ! symtab(4, 2, cryst%nsym)
90 : ! nsym is the **total** number of spatial symmetries of the system as given by cryst%nsym
91 : ! three first numbers define the G vector;
92 : ! fourth number is zero if the q-vector is not preserved, is 1 otherwise.
93 : ! second index is one without time-reversal symmetry, two with time-reversal symmetry
94 :
95 : integer, allocatable :: symrec_lg(:, :, :)
96 : ! symrec_lg(3, 3, nsym_lg)
97 : ! Symmetry operations in G-space (including time-reversed operations if any)
98 :
99 : integer, allocatable :: symafm_lg(:)
100 : ! symafm_lg(nsym_lg)
101 : ! Anti-ferromagnetic character associated to symrec_lg
102 :
103 : integer,allocatable :: bz2ibz_smap(:,:)
104 : ! bz2ibz_smap(6, nbz)
105 : ! Mapping BZ --> IBZ(q)
106 : ! Note that here we used the symmetries of the little group.
107 :
108 : integer, allocatable :: lgsym2glob(:, :)
109 : ! lgsym2glob(2, nsym_lg)
110 : ! Mapping isym_lg --> [isym, itime]
111 : ! where isym is the index of the operation in the global array crystal%symrec
112 : ! and itime is 2 if time-reversal T must be included else 1.
113 :
114 : real(dp) :: gmet(3,3)
115 : ! Reciprocal space metric in bohr^{-2}
116 :
117 : real(dp),allocatable :: ibz(:,:)
118 : ! ibz(3, nibz)
119 : ! K-points in the IBZ(q)
120 :
121 : real(dp),allocatable :: weights(:)
122 : ! weights(nibz)
123 : ! Weights in the IBZ(q), normalized to 1
124 :
125 : contains
126 :
127 : procedure :: init => lgroup_init
128 : ! Creation method.
129 :
130 : procedure :: findq_ibzk => lgroup_findq_ibzk
131 : ! Find the index of the point in the IBZ(k).
132 :
133 : procedure :: find_ibzimage => lgroup_find_ibzimage
134 : ! Find the symmetrical image in the IBZ(k) of a qpoint in the BZ.
135 :
136 : procedure :: find_ibzimage_sym => lgroup_find_ibzimage_sym
137 : ! Like find_ibzimage, but also returns the little-group symmetry (in local
138 : ! 1:nsym_lg indexing) relating the IBZ(k) representative to the input qpoint.
139 :
140 : procedure :: print => lgroup_print
141 : ! Print the object
142 :
143 : procedure :: free => lgroup_free
144 : ! Free memory.
145 :
146 : end type lgroup_t
147 : !!***
148 :
149 : contains !=====================================================
150 : !!***
151 :
152 : !!****f* m_sigmaph/lgroup_init
153 : !! NAME
154 : !! lgroup_init
155 : !!
156 : !! FUNCTION
157 : !! Build the little group of the k-point. Return IBZ(k) points packed in shells.
158 : !! to facilitate optimization of loops.
159 : !!
160 : !! INPUTS
161 : !! cryst=Crystalline structure
162 : !! kpoint(3)=External k-point defining the little-group
163 : !! timrev=1 if time-reversal symmetry can be used, 0 otherwise.
164 : !! nkbz=Number of k-points in the BZ.
165 : !! kbz(3,nkbz)=K-points in the BZ.
166 : !! nkibz=Number of k-points in the IBZ
167 : !! kibz(3,nkibz)=Irreducible zone.
168 : !! comm= MPI communicator.
169 : !! sord=Defines how to order the points in %ibz. ">" for increasing norm. "<" decreasing. Default: ">"
170 : !!
171 : !! SOURCE
172 :
173 209 : subroutine lgroup_init(new, cryst, kpoint, timrev, nkbz, kbz, nkibz, kibz, comm, &
174 : sord) ! optional
175 :
176 : !Arguments ------------------------------------
177 : !scalars
178 : class(lgroup_t),intent(out) :: new
179 : integer,intent(in) :: timrev,nkibz,nkbz,comm
180 : type(crystal_t),intent(in) :: cryst
181 : character(len=1),optional,intent(in) :: sord
182 : !arrays
183 : real(dp),intent(in) :: kpoint(3),kbz(3,nkbz),kibz(3,nkibz)
184 :
185 : !Local variables ------------------------------
186 : !scalars
187 : integer,parameter :: iout0=0, my_timrev0 = 0, chksymbreak0 = 0, debug = 0
188 : integer :: otimrev_k,ierr,itim,isym,ik_ibz,ik_bz,ksign,isym_lgk
189 : !arrays
190 418 : integer :: symrec_lg(3,3,2*cryst%nsym), symafm_lg(2*cryst%nsym), lgsym2glob(2, 2*cryst%nsym)
191 209 : integer,allocatable :: ibz2bz(:), iperm(:), inv_iperm(:)
192 : real(dp) :: kred(3), shift(3)
193 209 : real(dp),allocatable :: wtk_folded(:), kord(:,:)
194 : ! *************************************************************************
195 :
196 : ! TODO: Add option to exclude umklapp/time-reversal symmetry and kptopt
197 836 : new%point = kpoint
198 209 : new%input_timrev = timrev
199 2717 : new%gmet = cryst%gmet
200 209 : new%nbz = nkbz
201 :
202 : ! Determines the symmetry operations by which the k-point is preserved,
203 627 : ABI_MALLOC(new%symtab, (4, 2, cryst%nsym))
204 209 : call littlegroup_q(cryst%nsym, kpoint, new%symtab, cryst%symrec, cryst%symafm, otimrev_k, prtvol=0)
205 :
206 209 : new%nsym_lg = 0
207 627 : do itim=1,new%input_timrev + 1
208 18259 : do isym=1,cryst%nsym
209 17632 : if (cryst%symafm(isym) == -1) cycle
210 17632 : if (new%symtab(4, itim, isym) /= 1) cycle ! not \pm Sq = q+g0
211 7572 : new%nsym_lg = new%nsym_lg + 1
212 98436 : symrec_lg(:,:,new%nsym_lg) = cryst%symrec(:,:,isym) * (-2* itim + 3)
213 7572 : symafm_lg(new%nsym_lg) = cryst%symafm(isym)
214 33194 : lgsym2glob(:, new%nsym_lg) = [isym, itim]
215 : end do
216 : end do
217 :
218 209 : call alloc_copy(symrec_lg(:, :, 1:new%nsym_lg), new%symrec_lg)
219 209 : call alloc_copy(symafm_lg(1:new%nsym_lg), new%symafm_lg)
220 209 : call alloc_copy(lgsym2glob(:, 1:new%nsym_lg), new%lgsym2glob)
221 :
222 : ! Check group closure.
223 : if (debug /= 0) then
224 : call sg_multable(new%nsym_lg, symafm_lg, symrec_lg, ierr)
225 : ABI_CHECK_IEQ(ierr, 0, "Error in group closure")
226 : end if
227 :
228 : ! Find the irreducible zone with the little group operations.
229 : ! Do not use time-reversal since it has been manually introduced previously
230 627 : ABI_MALLOC(ibz2bz, (nkbz))
231 627 : ABI_MALLOC(new%bz2ibz_smap, (6, nkbz))
232 : ! IBZ2BZ ?
233 :
234 : ! TODO: In principle here we would like to have a set that contains the initial IBZ.
235 : call symkpt_new(chksymbreak0, cryst%gmet, ibz2bz, iout0, kbz, nkbz, new%nibz,&
236 209 : new%nsym_lg, new%symrec_lg, my_timrev0, new%bz2ibz_smap, comm)
237 :
238 627 : ABI_MALLOC(new%ibz, (3, new%nibz))
239 215448 : ABI_CALLOC(new%weights, (new%nibz))
240 :
241 820945 : do ik_bz=1,nkbz
242 820736 : ik_ibz = new%bz2ibz_smap(1, ik_bz)
243 820736 : isym_lgk = new%bz2ibz_smap(2, ik_bz)
244 820736 : new%bz2ibz_smap(2, ik_bz) = lgsym2glob(1, isym_lgk)
245 820736 : new%bz2ibz_smap(3, ik_bz) = lgsym2glob(2, isym_lgk)
246 820945 : new%weights(ik_ibz) = new%weights(ik_ibz) + 1
247 : end do
248 215030 : new%weights(:) = new%weights(:) / nkbz
249 :
250 215030 : do ik_ibz=1,new%nibz
251 214821 : ik_bz = ibz2bz(ik_ibz)
252 859493 : new%ibz(:, ik_ibz) = kbz(:, ik_bz)
253 : end do
254 :
255 : ! TODO: Activate this part so that we can cache the q-point in the IBZ.
256 : ! Results are ok but this change is postponed because it leads to an increase
257 : ! in the walltime spent in listkk likely because of the different order.
258 :
259 : ! Need to repack the IBZ points and rearrange the other arrays dimensioned with nibz.
260 : ! In principle, the best approach would be to pack in stars using crystal%symrec.
261 : ! For the time being we pack in shells (much easier). Use wtk_folded as workspace to store the norm.
262 :
263 : !ksign = 0
264 209 : ksign = +1
265 209 : if (present(sord)) then
266 0 : if (sord == "<") ksign = -1
267 209 : if (sord == ">") ksign = +1
268 : !if (sord == "r") ksign = 0
269 : end if
270 :
271 : if (ksign /= 0) then
272 627 : ABI_MALLOC(wtk_folded, (new%nibz))
273 215030 : do ik_ibz=1,new%nibz
274 859284 : call wrap2_pmhalf(new%ibz(:, ik_ibz), kred, shift)
275 215030 : wtk_folded(ik_ibz) = ksign * normv(kred, cryst%gmet, "G")
276 : end do
277 :
278 627 : ABI_MALLOC(iperm, (new%nibz))
279 644881 : iperm = [(ik_ibz, ik_ibz=1, new%nibz)]
280 209 : call sort_dp(new%nibz, wtk_folded, iperm, tol12)
281 : !iperm = [(ik_ibz, ik_ibz=1, new%nibz)]
282 :
283 : ! Trasfer data.
284 627 : ABI_MALLOC(kord, (3, new%nibz))
285 215030 : do ik_ibz=1,new%nibz
286 859284 : kord(:, ik_ibz) = new%ibz(:, iperm(ik_ibz))
287 215030 : wtk_folded(ik_ibz) = new%weights(iperm(ik_ibz))
288 : end do
289 859702 : new%ibz = kord(:, 1:new%nibz)
290 215239 : new%weights = wtk_folded(1:new%nibz)
291 :
292 : ! Rearrange bz2ibz_smap as well --> need the inverse of iperm.
293 627 : ABI_MALLOC(inv_iperm, (new%nibz))
294 215030 : do ik_ibz=1,new%nibz
295 215030 : inv_iperm(iperm(ik_ibz)) = ik_ibz
296 : end do
297 :
298 820945 : do ik_bz=1,new%nbz
299 820736 : ik_ibz = new%bz2ibz_smap(1, ik_bz)
300 820945 : new%bz2ibz_smap(1, ik_bz) = inv_iperm(ik_ibz)
301 : end do
302 :
303 209 : ABI_FREE(inv_iperm)
304 209 : ABI_FREE(kord)
305 209 : ABI_FREE(iperm)
306 209 : ABI_FREE(wtk_folded)
307 : end if
308 :
309 209 : ABI_FREE(ibz2bz)
310 :
311 : ! Debugging section.
312 215030 : ABI_CHECK(sum(new%weights) - one < tol6, sjoin("Weights don't sum up to one but to:", ftoa(sum(new%weights))))
313 :
314 : if (debug /= 0) then
315 : do ik_ibz=1,new%nibz
316 : if (ik_ibz <= nkibz) then
317 : write(std_out,"(a)")sjoin(ktoa(new%ibz(:,ik_ibz)), ktoa(new%ibz(:,ik_ibz) - kibz(:,ik_ibz)), ftoa(new%weights(ik_ibz)))
318 : else
319 : write(std_out,"(a)")sjoin(ktoa(new%ibz(:,ik_ibz)), "[---]", ftoa(new%weights(ik_ibz)))
320 : end if
321 : end do
322 : end if
323 :
324 209 : end subroutine lgroup_init
325 : !!***
326 :
327 : !!****f* m_lgroup/lgroup_findq_ibzk
328 : !! NAME
329 : !! lgroup_findq_ibzk
330 : !!
331 : !! FUNCTION
332 : !! Find the index of the q-point in the IBZ(k). Umklapp vectors are not allowed.
333 : !! Returns -1 if not found.
334 : !!
335 : !! INPUTS
336 : !! qpt(3)=q-point in reduced coordinates.
337 : !! [qtol]=Optional tolerance for q-point comparison.
338 : !! For each reduced direction the absolute difference between the coordinates must be less that qtol
339 : !!
340 : !! SOURCE
341 :
342 368 : integer pure function lgroup_findq_ibzk(self, qpt, qtol) result(iqpt)
343 :
344 : !Arguments ------------------------------------
345 : !scalars
346 : class(lgroup_t),intent(in) :: self
347 : real(dp),optional,intent(in) :: qtol
348 : !arrays
349 : real(dp),intent(in) :: qpt(3)
350 :
351 : !Local variables-------------------------------
352 : integer :: iq
353 : real(dp) :: my_qtol
354 : ! *************************************************************************
355 :
356 368 : my_qtol = tol6; if (present(qtol)) my_qtol = qtol
357 :
358 368 : iqpt = -1
359 2600 : do iq=1,self%nibz
360 3668 : if (all(abs(self%ibz(:, iq) - qpt) < my_qtol)) then
361 : iqpt = iq; exit
362 : end if
363 : end do
364 :
365 368 : end function lgroup_findq_ibzk
366 : !!***
367 :
368 : !----------------------------------------------------------------------
369 :
370 : !!****f* m_lgroup/lgroup_find_ibzimage
371 : !! NAME
372 : !! lgroup_find_ibzimage
373 : !!
374 : !! FUNCTION
375 : !! Find the symmetrical image in the IBZ(k) of a qpoint in the BZ
376 : !! Returns -1 if not found.
377 : !!
378 : !! INPUTS
379 : !!
380 : !! OUTPUT
381 : !!
382 : !! SOURCE
383 :
384 0 : integer function lgroup_find_ibzimage(self, qpt) result(iq_ibz)
385 :
386 : !Arguments ------------------------------------
387 : class(lgroup_t),intent(in) :: self
388 : real(dp),intent(in) :: qpt(3)
389 :
390 : !Local variables-------------------------------
391 : !scalars
392 : integer, parameter :: timrev0 = 0
393 : real(dp) :: dksqmax
394 : !arrays
395 : integer :: indkk(6)
396 : ! *************************************************************************
397 :
398 : ! Note use_symrec and timrev0
399 : call listkk(dksqmax, self%gmet, indkk, self%ibz, qpt, self%nibz, 1, self%nsym_lg, &
400 0 : 1, self%symafm_lg, self%symrec_lg, timrev0, xmpi_comm_self, use_symrec=.True.)
401 :
402 0 : iq_ibz = indkk(1)
403 0 : if (dksqmax > tol12) iq_ibz = -1
404 :
405 0 : end function lgroup_find_ibzimage
406 : !!***
407 :
408 : !----------------------------------------------------------------------
409 :
410 : !!****f* m_lgroup/lgroup_find_ibzimage_sym
411 : !! NAME
412 : !! lgroup_find_ibzimage_sym
413 : !!
414 : !! FUNCTION
415 : !! Like find_ibzimage, but also returns the little-group symmetry (in local
416 : !! 1:nsym_lg indexing, translate via lgsym2glob to get the global isym/itime)
417 : !! relating the IBZ(k) representative self%ibz(:,iq_ibz) to the input qpt, i.e.
418 : !! qpt = symrec_lg(:,:,isym_lg) . self%ibz(:,iq_ibz) (up to a reciprocal lattice
419 : !! vector). Returns iq_ibz=-1 (isym_lg, itime_lg undefined) if not found.
420 : !!
421 : !! INPUTS
422 : !! qpt(3)=q-point in reduced coordinates.
423 : !!
424 : !! OUTPUT
425 : !! isym_lg=Local index (1:nsym_lg) of the little-group symmetry relating
426 : !! self%ibz(:,iq_ibz) to qpt.
427 : !! itime_lg=1 if no time reversal is needed, 2 if it is (see lgsym2glob).
428 : !!
429 : !! SOURCE
430 :
431 0 : integer function lgroup_find_ibzimage_sym(self, qpt, isym_lg, itime_lg) result(iq_ibz)
432 :
433 : !Arguments ------------------------------------
434 : class(lgroup_t),intent(in) :: self
435 : real(dp),intent(in) :: qpt(3)
436 : integer,intent(out) :: isym_lg, itime_lg
437 :
438 : !Local variables-------------------------------
439 : !scalars
440 : integer, parameter :: timrev0 = 0
441 : real(dp) :: dksqmax
442 : !arrays
443 : integer :: indkk(6)
444 : ! *************************************************************************
445 :
446 : ! Note use_symrec and timrev0
447 : call listkk(dksqmax, self%gmet, indkk, self%ibz, qpt, self%nibz, 1, self%nsym_lg, &
448 0 : 1, self%symafm_lg, self%symrec_lg, timrev0, xmpi_comm_self, use_symrec=.True.)
449 :
450 0 : iq_ibz = indkk(1); isym_lg = indkk(2); itime_lg = indkk(6) + 1
451 0 : if (dksqmax > tol12) iq_ibz = -1
452 :
453 0 : end function lgroup_find_ibzimage_sym
454 : !!***
455 :
456 : !----------------------------------------------------------------------
457 :
458 : !!****f* m_lgroup/lgroup_print
459 : !! NAME
460 : !! lgroup_print
461 : !!
462 : !! FUNCTION
463 : !! Print the object
464 : !!
465 : !! INPUTS
466 : !! units=Unit numbers
467 : !! [title]=String to be printed as header for additional info.
468 : !! [prtvol]=Verbosity level
469 : !!
470 : !! OUTPUT
471 : !! Only printing
472 : !!
473 : !! SOURCE
474 :
475 68 : subroutine lgroup_print(self, units, title, prtvol)
476 :
477 : !Arguments ------------------------------------
478 : class(lgroup_t),intent(in) :: self
479 : integer,intent(in) :: units(:)
480 : character(len=*),optional,intent(in) :: title
481 : integer,optional,intent(in) :: prtvol
482 :
483 : !Local variables-------------------------------
484 : !scalars
485 : integer :: my_prtvol, ik, ii
486 : character(len=500) :: msg
487 : ! *************************************************************************
488 :
489 34 : my_prtvol = 0; if (present(prtvol)) my_prtvol = prtvol
490 :
491 34 : msg = ' ==== Info on the <lgroup_t> object ==== '
492 34 : if (present(title)) msg = ' ==== '//trim(adjustl(title))//' ==== '
493 34 : call wrtout(units, msg)
494 :
495 : write(msg, '(3a, 2(a, i0, a))') &
496 34 : ' Little group point: ................... ', trim(ktoa(self%point)), ch10, &
497 34 : ' Number of points in IBZ(p) ............ ', self%nibz, ch10, &
498 68 : ' Time-reversal flag (0: No, 1: Yes) .... ', self%input_timrev, ch10
499 34 : call wrtout(units, msg)
500 :
501 34 : if (my_prtvol > 1) then
502 0 : do ii=1,self%nsym_lg
503 0 : call wrtout(units, sjoin("lgsym2glob:", ltoa(self%lgsym2glob(:, ii))))
504 : end do
505 0 : do ik=1,self%nibz
506 0 : call wrtout(units, sjoin(ktoa(self%ibz(:,ik)), ftoa(self%weights(ik))))
507 : end do
508 : end if
509 :
510 34 : end subroutine lgroup_print
511 : !!***
512 :
513 : !!****f* m_sigmaph/lgroup_free
514 : !! NAME
515 : !! lgroup_free
516 : !!
517 : !! FUNCTION
518 : !! Free memory
519 : !!
520 : !! SOURCE
521 :
522 1297 : subroutine lgroup_free(self)
523 :
524 : !Arguments ------------------------------------
525 : class(lgroup_t),intent(inout) :: self
526 : ! *************************************************************************
527 :
528 : ! integer
529 1297 : ABI_SFREE(self%symrec_lg)
530 1297 : ABI_SFREE(self%symafm_lg)
531 1297 : ABI_SFREE(self%bz2ibz_smap)
532 1297 : ABI_SFREE(self%lgsym2glob)
533 1297 : ABI_SFREE(self%symtab)
534 : ! real
535 1297 : ABI_SFREE(self%ibz)
536 1297 : ABI_SFREE(self%weights)
537 :
538 1297 : end subroutine lgroup_free
539 : !!***
540 :
541 627 : end module m_lgroup
542 : !!***
|
