Branch data Line data Source code
1 : : !!****m* ABINIT/m_ptgroups
2 : : !! NAME
3 : : !! m_ptgroups
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains the irreducible representations and the
7 : : !! character tables of the 32 point groups.
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 2010-2026 ABINIT group (MG)
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !!
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_ptgroups
23 : :
24 : : use defs_basis
25 : : use m_errors
26 : : use m_abicore
27 : : use m_defs_ptgroups
28 : :
29 : : use m_io_tools, only : open_file
30 : : use m_fstrings, only : sjoin
31 : : use m_numeric_tools, only : get_trace, cmplx_sphcart
32 : : use m_matrix, only : mati3inv
33 : : use m_symtk, only : sg_multable
34 : :
35 : : ! Import group tables
36 : : use m_ptg_C1
37 : : use m_ptg_Ci
38 : : use m_ptg_C2
39 : : use m_ptg_Cs
40 : : use m_ptg_C2h
41 : : use m_ptg_D2
42 : : use m_ptg_C2v
43 : : use m_ptg_D2h
44 : : use m_ptg_C4
45 : : use m_ptg_S4
46 : : use m_ptg_C4h
47 : : use m_ptg_D4
48 : : use m_ptg_C4v
49 : : use m_ptg_D2d
50 : : use m_ptg_D4h
51 : : use m_ptg_C3
52 : : use m_ptg_C3i
53 : : use m_ptg_D3
54 : : use m_ptg_C3v
55 : : use m_ptg_D3d
56 : : use m_ptg_C6
57 : : use m_ptg_C3h
58 : : use m_ptg_C6h
59 : : use m_ptg_D6
60 : : use m_ptg_C6v
61 : : use m_ptg_D3h
62 : : use m_ptg_D6h
63 : : use m_ptg_T
64 : : use m_ptg_Th
65 : : use m_ptg_O
66 : : use m_ptg_Td
67 : : use m_ptg_Oh
68 : :
69 : : implicit none
70 : :
71 : : private
72 : :
73 : : public :: get_point_group
74 : : public :: get_classes
75 : : public :: show_character_tables
76 : : public :: point_group_init
77 : : public :: sum_irreps
78 : : public :: mult_table
79 : : !public :: polish_irreps
80 : :
81 : :
82 : : contains
83 : : !!***
84 : :
85 : : !----------------------------------------------------------------------
86 : :
87 : : !!****f* m_ptgroups/get_point_group
88 : : !! NAME
89 : : !! get_point_group
90 : : !!
91 : : !! FUNCTION
92 : : !!
93 : : !! INPUTS
94 : : !! ptg_name=point group name as returned by symptgroup.
95 : : !!
96 : : !! OUTPUT
97 : : !! nsym=Number of symmetries in the point group.
98 : : !! nclass=Number of classes.
99 : : !! sym(3,3,nsym)=Elements of the point group ordered by classe.
100 : : !! class_ids(2,nclass)=Initial and final index in sym, for each
101 : : !! Irreps(nclass)=Datatype gathering data on the different irreducible representations.
102 : : !!
103 : : !! SOURCE
104 : :
105 : 0 : subroutine get_point_group(ptg_name, nsym, nclass, sym, class_ids, class_names, Irreps)
106 : :
107 : : !Arguments ------------------------------------
108 : : !scalars
109 : : character(len=*),intent(in) :: ptg_name
110 : : integer,intent(out) :: nsym, nclass
111 : : !arrays
112 : : integer,allocatable,intent(out) :: sym(:,:,:),class_ids(:,:)
113 : : character(len=5),allocatable,intent(out) :: class_names(:)
114 : : type(irrep_t),allocatable,intent(out) :: Irreps(:)
115 : :
116 : : !Local variables-------------------------------
117 : : integer :: irp,isym
118 : : ! *************************************************************************
119 : :
120 : 0 : SELECT CASE (TRIM(ADJUSTL(ptg_name)))
121 : : CASE ('1')
122 [ # # # # : 0 : call ptg_C1 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
123 : : CASE ('-1')
124 [ # # # # : 0 : call ptg_Ci (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
125 : : CASE ('2')
126 [ # # # # : 0 : call ptg_C2 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
127 : : CASE ('m',"-2") ! Abinit uses "-2"
128 [ # # # # : 0 : call ptg_Cs (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
129 : : CASE ('2/m')
130 [ # # # # : 0 : call ptg_C2h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
131 : : CASE ('222')
132 [ # # # # : 0 : call ptg_D2 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
133 : : CASE ('mm2')
134 [ # # # # : 0 : call ptg_C2v (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
135 : : CASE ('mmm')
136 [ # # # # : 0 : call ptg_D2h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
137 : : CASE ('4')
138 [ # # # # : 0 : call ptg_C4 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
139 : : CASE ('-4')
140 [ # # # # : 0 : call ptg_S4 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
141 : : CASE ('4/m')
142 [ # # # # : 0 : call ptg_C4h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
143 : : CASE ('422')
144 [ # # # # : 0 : call ptg_D4 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
145 : : CASE ('4mm')
146 [ # # # # : 0 : call ptg_C4v (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
147 : : CASE ('-42m')
148 [ # # # # : 0 : call ptg_D2d (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
149 : : CASE ('4/mmm')
150 [ # # # # : 0 : call ptg_D4h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
151 : : CASE ('3')
152 [ # # # # : 0 : call ptg_C3 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
153 : : CASE ('-3')
154 [ # # # # : 0 : call ptg_C3i (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
155 : : CASE ('32')
156 [ # # # # : 0 : call ptg_D3 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
157 : : CASE ('3m')
158 [ # # # # : 0 : call ptg_C3v (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
159 : : CASE ('-3m')
160 [ # # # # : 0 : call ptg_D3d (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
161 : : CASE ('6')
162 [ # # # # : 0 : call ptg_C6 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
163 : : CASE ('-6')
164 [ # # # # : 0 : call ptg_C3h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
165 : : CASE ('6/m')
166 [ # # # # : 0 : call ptg_C6h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
167 : : CASE ('622')
168 [ # # # # : 0 : call ptg_D6 (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
169 : : CASE ('6mm')
170 [ # # # # : 0 : call ptg_C6v (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
171 : : CASE ('-62m')
172 [ # # # # : 0 : call ptg_D3h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
173 : : CASE ('6/mmm')
174 [ # # # # : 0 : call ptg_D6h (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
175 : : CASE ('23')
176 [ # # # # : 0 : call ptg_T (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
177 : : CASE ('m-3')
178 [ # # # # : 0 : call ptg_Th (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
179 : : CASE ('432')
180 [ # # # # : 0 : call ptg_O (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
181 : : CASE ('-43m')
182 [ # # # # : 0 : call ptg_Td (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
183 : : CASE ('m-3m')
184 [ # # # # : 0 : call ptg_Oh (nsym,nclass,sym,class_ids,class_names,Irreps)
# # # # #
# # # # #
# # ]
185 : : CASE DEFAULT
186 [ # # # # : 0 : ABI_BUG(sjoin("Unknown value for ptg_name:", ptg_name))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
187 : : END SELECT
188 : :
189 : : ! Calculate the trace of each irreducible representation in order to have the character at hand.
190 [ # # ]: 0 : do irp=1,SIZE(Irreps)
191 [ # # # # : 0 : ABI_MALLOC(Irreps(irp)%trace, (nsym))
# # # # #
# # # #
# ]
192 [ # # ]: 0 : do isym=1,nsym
193 : 0 : Irreps(irp)%trace(isym) = get_trace(Irreps(irp)%mat(:,:,isym))
194 : : end do
195 : : end do
196 : :
197 : 0 : end subroutine get_point_group
198 : : !!***
199 : :
200 : : !----------------------------------------------------------------------
201 : :
202 : : !!****f* m_ptgroups/get_classes
203 : : !! NAME
204 : : !! get_classes
205 : : !!
206 : : !! FUNCTION
207 : : !! Given a set of nsym 3x3 operations in reciprocal or real space,
208 : : !! which are supposed to form a group, this routine divides the group into classes.
209 : : !!
210 : : !! INPUTS
211 : : !! nsym=number of symmetry operation.
212 : : !! sym(3,3,nsym)=The symmetry operations.
213 : : !!
214 : : !! OUTPUT
215 : : !! nclass=The number of classes
216 : : !! nelements(1:nclass)=For each class, the number of elements
217 : : !! elements_idx(ii,1:nclass)=For each class, this table gives the index of its elements (ii=1,..,nelements(iclass))
218 : : !!
219 : : !! NOTES
220 : : !! * A class is defined as the set of distinct elements obtained by
221 : : !! considering for each element, S, of the group all its conjugate
222 : : !! elements X^-1 S X where X ranges over all the elements of the group.
223 : : !!
224 : : !! * It does not work in case of non-collinear magnetism.
225 : : !!
226 : : !! * The routine assumes that anti-ferromagnetic symmetries (if any) have been removed by the caller.
227 : : !!
228 : : !! SOURCE
229 : :
230 : 0 : subroutine get_classes(nsym, sym, nclass, nelements, elements_idx)
231 : :
232 : : !Arguments ------------------------------------
233 : : !scalars
234 : : integer,intent(in) :: nsym
235 : : integer,intent(out) :: nclass
236 : : !arrays
237 : : integer,intent(in) :: sym(3,3,nsym)
238 : : integer,intent(out) :: nelements(nsym),elements_idx(nsym,nsym)
239 : :
240 : : !Local variables-------------------------------
241 : : !scalars
242 : : integer :: isym,jsym,ksym,identity_idx,ierr
243 : : character(len=500) :: msg
244 : : !arrays
245 : 0 : integer :: cjg(3,3),ss(3,3),xx(3,3),xxm1(3,3),test(3,3), identity(3,3), dummy_symafm(nsym)
246 : 0 : logical :: found(nsym),found_identity
247 : : !************************************************************************
248 : :
249 : : ! Check if identity is present in the first position
250 : 0 : identity=RESHAPE((/1,0,0,0,1,0,0,0,1/),(/3,3/)); found_identity=.FALSE.
251 : :
252 [ # # ]: 0 : do isym=1,nsym
253 [ # # # # : 0 : if (all(sym(:,:,isym) == identity)) then
# # # # ]
254 : 0 : found_identity=.TRUE.; identity_idx=isym; exit
255 : : end if
256 : : end do
257 : :
258 [ # # ]: 0 : if (.not. found_identity .or. identity_idx /= 1) then
259 : : write(msg, '(3a)')&
260 : 0 : 'Either identity is not present or it is not the first operation ',ch10,'Check set of symmetry operations '
261 : 0 : ABI_ERROR(msg)
262 : : end if
263 : :
264 [ # # ]: 0 : dummy_symafm = 1
265 : 0 : call sg_multable(nsym, dummy_symafm, sym, ierr)
266 [ # # ]: 0 : ABI_CHECK(ierr == 0, "Error in group closure")
267 : :
268 [ # # # # : 0 : nclass=0; nelements(:)=0; elements_idx(:,:)=0; found(:)=.FALSE.
# # # # ]
269 [ # # ]: 0 : do isym=1,nsym
270 [ # # ]: 0 : if (.not.found(isym)) then
271 : 0 : nclass=nclass+1
272 [ # # # # ]: 0 : ss(:,:)=sym(:,:,isym)
273 : :
274 [ # # ]: 0 : do jsym=1,nsym ! Form conjugate.
275 [ # # # # ]: 0 : xx(:,:)=sym(:,:,jsym)
276 [ # # # # : 0 : call mati3inv(xx,xxm1) ; xxm1=TRANSPOSE(xxm1)
# # # # ]
277 : 0 : cjg(:,:)=MATMUL(xxm1,MATMUL(ss,xx))
278 [ # # ]: 0 : do ksym=1,nsym ! Is it already found?
279 [ # # # # ]: 0 : test(:,:)=sym(:,:,ksym)
280 [ # # # # : 0 : if (.not.found(ksym).and.(ALL((test-cjg)==0))) then
# # # # ]
281 : 0 : found(ksym)=.TRUE.
282 : 0 : nelements(nclass)=nelements(nclass)+1
283 : 0 : elements_idx(nelements(nclass),nclass)=ksym
284 : : end if
285 : : end do
286 : : end do
287 : :
288 : : end if
289 : : end do
290 : :
291 : 0 : end subroutine get_classes
292 : : !!***
293 : :
294 : : !----------------------------------------------------------------------
295 : :
296 : : !!****f* m_ptgroups/show_character_tables
297 : : !! NAME
298 : : !! show_character_tables
299 : : !!
300 : : !! FUNCTION
301 : : !! Printout of the caracter tables of the 32 point groups.
302 : : !!
303 : : !! INPUTS
304 : : !! [unit]=Unit number of output file. Defaults to std_out
305 : : !!
306 : : !! OUTPUT
307 : : !! Only writing.
308 : : !!
309 : : !! SOURCE
310 : :
311 : 0 : subroutine show_character_tables(unit)
312 : :
313 : : !Arguments ------------------------------------
314 : : !scalars
315 : : integer,optional,intent(in) :: unit
316 : :
317 : : !Local variables-------------------------------
318 : : integer :: igrp,my_unt
319 : : character(len=5) :: ptg_name
320 : 0 : type(point_group_t) :: Ptg
321 : : !arrays
322 : : !integer,allocatable :: elements_idx(:,:),nelements(:)
323 : : ! *********************************************************************
324 : :
325 [ # # ]: 0 : my_unt = std_out; if (PRESENT(unit)) my_unt=unit
326 : :
327 [ # # ]: 0 : do igrp=1,SIZE(ptgroup_names)
328 : 0 : ptg_name = ptgroup_names(igrp)
329 : 0 : call point_group_init(Ptg, ptg_name)
330 : 0 : call Ptg%print(unit=my_unt)
331 : : !allocate(nelements(Ptg%nsym),elements_idx(Ptg%nsym,Ptg%nsym))
332 : : !call get_classes(Ptg%nsym,Ptg%sym,nclass,nelements,elements_idx)
333 : : !deallocate(nelements,elements_idx)
334 : 0 : call Ptg%free()
335 : : end do
336 : :
337 [ # # # # : 0 : end subroutine show_character_tables
# # # # #
# # # # #
# # ]
338 : : !!***
339 : :
340 : : !----------------------------------------------------------------------
341 : :
342 : : !!****f* m_ptgroups/point_group_init
343 : : !! NAME
344 : : !! point_group_init
345 : : !!
346 : : !! FUNCTION
347 : : !! Creation method for the point_group_t datatype.
348 : : !!
349 : : !! INPUTS
350 : : !! ptg_name=The name of the point group (International conventions).
351 : : !!
352 : : !! OUTPUT
353 : : !! The datatype completely initialized.
354 : : !!
355 : : !! SOURCE
356 : :
357 : 0 : subroutine point_group_init(Ptg, ptg_name)
358 : :
359 : : !Arguments ------------------------------------
360 : : class(point_group_t),intent(inout) :: Ptg
361 : : character(len=5),intent(in) :: ptg_name
362 : : ! *********************************************************************
363 : :
364 : 0 : Ptg%gname = ptg_name
365 [ # # # # : 0 : call get_point_group(Ptg%gname,Ptg%nsym,Ptg%nclass,Ptg%sym,Ptg%class_ids,Ptg%class_names,Ptg%Irreps)
# # # # #
# # # # #
# # ]
366 : :
367 : 0 : end subroutine point_group_init
368 : : !!***
369 : :
370 : : !----------------------------------------------------------------------
371 : :
372 : : !!****f* m_ptgroups/mult_table
373 : : !! NAME
374 : : !! mult_table
375 : : !!
376 : : !! FUNCTION
377 : : !! Given a set of nsym 3x3 operations which are supposed to form a group,
378 : : !! this routine constructs the multiplication table of the group.
379 : : !!
380 : : !! INPUTS
381 : : !! nsym=number of symmetry operation
382 : : !! sym(3,3,nsym)=the operations
383 : : !!
384 : : !! OUTPUT
385 : : !! mtab(nsym,nsym)=The index of the product S_i * S_j in the input set sym.
386 : : !!
387 : : !! SOURCE
388 : :
389 : 0 : subroutine mult_table(nsym, sym, mtab)
390 : :
391 : : !Arguments ------------------------------------
392 : : !scalars
393 : : integer,intent(in) :: nsym
394 : : !arrays
395 : : integer,intent(in) :: sym(3,3,nsym)
396 : : integer,intent(out) :: mtab(nsym,nsym)
397 : :
398 : : !Local variables-------------------------------
399 : : !scalars
400 : : integer :: isym,jsym,ksym
401 : : !character(len=500) :: msg
402 : : !arrays
403 : 0 : integer :: prod_ij(3,3),found(nsym)
404 : : !************************************************************************
405 : :
406 [ # # ]: 0 : do jsym=1,nsym
407 [ # # ]: 0 : found(:)=0 ! Each symmetry should compare only once in a given (row|col).
408 : :
409 [ # # ]: 0 : do isym=1,nsym
410 : 0 : prod_ij = MATMUL(sym(:,:,isym),sym(:,:,jsym))
411 [ # # ]: 0 : do ksym=1,nsym
412 [ # # # # : 0 : if ( ALL(prod_ij == sym(:,:,ksym)) ) then
# # # # ]
413 : 0 : found(ksym)=found(ksym)+1
414 : 0 : mtab(isym,jsym) = ksym
415 : : end if
416 : : end do
417 : : end do ! jsym
418 : :
419 [ # # # # : 0 : if (any(found /= 1)) then
# # ]
420 : 0 : write(std_out,*)"found = ",found
421 : 0 : ABI_ERROR("Input elements do not form a group")
422 : : end if
423 : : end do ! isym
424 : :
425 : 0 : end subroutine mult_table
426 : : !!***
427 : :
428 : : !----------------------------------------------------------------------
429 : :
430 : : !!****f* m_ptgroups/groupk_from_file
431 : : !! NAME
432 : : !! groupk_from_file
433 : : !!
434 : : !! FUNCTION
435 : : !! Initialize the group_k_t datatype from an external database retrieved from
436 : : !! the Bilbao server via the ptg.py script.
437 : : !!
438 : : !! INPUTS
439 : : !! fname(len=*)=file name
440 : : !!
441 : : !! OUTPUT
442 : : !! ierr=Status error
443 : : !! Lgrps<group_k_t>=The structure completely initialized.
444 : : !!
445 : : !! TODO
446 : : !! This is a stub. I still have to complete the fileformat for the Bilbao database.
447 : : !!
448 : : !! SOURCE
449 : :
450 : 0 : subroutine groupk_from_file(Lgrps, spgroup, fname, nkpt, klist, ierr)
451 : :
452 : : !Arguments ------------------------------------
453 : : !scalars
454 : : integer,intent(in) :: spgroup
455 : : integer,intent(out) :: ierr,nkpt
456 : : character(len=fnlen),intent(in) :: fname
457 : : !arrays
458 : : type(group_k_t),target,allocatable :: Lgrps(:)
459 : : real(dp),pointer :: klist(:,:)
460 : :
461 : : !Local variables-------------------------------
462 : : !scalars
463 : : integer,parameter :: last_file_version=1
464 : : integer :: unt,fvers,ik,nsym_ltgk,isym,nirreps_k,irp,icls
465 : : integer :: irrep_idx,irrep_dim,sym_idx,ita_spgroup,nels,prev,now
466 : : character(len=IRREPNAME_LEN) :: irrep_name
467 : : character(len=1) :: basis
468 : : character(len=500) :: msg
469 : : type(group_k_t),pointer :: Gk
470 : : !arrays
471 : 0 : integer,allocatable :: nelements(:),elements_idx(:,:)
472 : : real(dp) :: kpt(3)
473 : 0 : character(len=10),allocatable :: kname(:)
474 : : type(irrep_t),pointer :: OneIrr
475 : : ! *************************************************************************
476 : :
477 : 0 : ierr=0
478 [ # # ]: 0 : if (open_file(fname,msg,newunit=unt,form="formatted") /=0) then
479 : 0 : ABI_ERROR(msg)
480 : : end if
481 : :
482 [ # # ]: 0 : read(unt,*,ERR=10) ! Skip the header.
483 [ # # ]: 0 : read(unt,*,ERR=10) fvers ! File version.
484 [ # # ]: 0 : if (fvers > last_file_version) then
485 : 0 : write(msg,"(2(a,i0))")" Found file format= ",fvers," but the latest supported version is: ",last_file_version
486 : 0 : ABI_ERROR(msg)
487 : : end if
488 [ # # ]: 0 : read(unt,*,ERR=10) ita_spgroup
489 [ # # ]: 0 : read(unt,*,ERR=10) basis
490 : :
491 [ # # ]: 0 : if (spgroup/=ita_spgroup) then
492 : 0 : write(msg,'(a,2i0)')" Input space group does not match with the value reported on file: ",spgroup,ita_spgroup
493 : 0 : ABI_ERROR(msg)
494 : : end if
495 : :
496 [ # # ]: 0 : if (basis /= "b") then
497 [ # # ]: 0 : ABI_ERROR(" Wrong value for basis: "//TRIM(basis))
498 : : end if
499 : :
500 : : ! Read the list of the k-points.
501 [ # # ]: 0 : read(unt,*,ERR=10) nkpt
502 : :
503 [ # # # # : 0 : ABI_MALLOC(Lgrps,(nkpt))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
504 [ # # # # : 0 : ABI_MALLOC(klist,(3,nkpt))
# # # # #
# # # ]
505 [ # # # # : 0 : ABI_MALLOC(kname,(nkpt))
# # # # #
# # # #
# ]
506 [ # # ]: 0 : do ik=1,nkpt
507 [ # # ]: 0 : read(unt,*,ERR=10) klist(:,ik), kname(ik)
508 : : end do
509 : :
510 : : ! Read tables for each k-point
511 [ # # ]: 0 : do ik=1,nkpt
512 : :
513 [ # # ]: 0 : read(unt,*,ERR=10) kpt
514 [ # # ]: 0 : read(unt,*,ERR=10) nsym_ltgk
515 : 0 : Gk => Lgrps(ik)
516 : :
517 : 0 : Gk%spgroup = ita_spgroup
518 : 0 : Gk%nsym = nsym_ltgk
519 [ # # ]: 0 : Gk%point = kpt
520 [ # # # # : 0 : ABI_MALLOC(Gk%sym,(3,3,nsym_ltgk))
# # # # #
# # # #
# ]
521 [ # # # # : 0 : ABI_MALLOC(Gk%tnons,(3,nsym_ltgk))
# # # # #
# # # #
# ]
522 : :
523 [ # # ]: 0 : do isym=1,nsym_ltgk ! Read symmetries of the little group.
524 [ # # ]: 0 : read(unt,*,ERR=10) Gk%sym(:,:,isym)
525 [ # # ]: 0 : read(unt,*,ERR=10) Gk%tnons(:,isym)
526 : : end do
527 : :
528 [ # # # # : 0 : ABI_MALLOC(nelements,(nsym_ltgk))
# # # # #
# # # #
# ]
529 [ # # # # : 0 : ABI_MALLOC(elements_idx,(nsym_ltgk,nsym_ltgk))
# # # # #
# # # # #
# # # # ]
530 : :
531 : 0 : call get_classes(nsym_ltgk,Gk%sym,Gk%nclass,nelements,elements_idx)
532 : :
533 : : ! The operations reported on the file are supposed to be packed in classes
534 : : ! otherwise one should perform a rearrangement of the indices.
535 : 0 : prev = 0
536 [ # # ]: 0 : do icls=1,Gk%nclass
537 [ # # ]: 0 : do isym=1,nelements(icls)
538 : 0 : now = elements_idx(isym,icls)
539 [ # # ]: 0 : if ( (now-prev) /= 1 ) then
540 : 0 : write(msg,"(2(a,i0))")" Symmetries on file are not ordered in classes. icls= ",icls,", isym= ",isym
541 : 0 : ABI_ERROR(msg)
542 : : else
543 : 0 : prev = now
544 : : end if
545 : : end do
546 : : end do
547 : :
548 [ # # # # : 0 : ABI_MALLOC(Gk%class_ids,(2,Gk%nclass))
# # # # #
# # # #
# ]
549 [ # # ]: 0 : do icls=1,Gk%nclass
550 : 0 : nels = nelements(icls)
551 : 0 : Gk%class_ids(1,icls) = elements_idx(1, icls)
552 : 0 : Gk%class_ids(2,icls) = elements_idx(nels,icls)
553 : : end do
554 : :
555 [ # # ]: 0 : ABI_FREE(nelements)
556 [ # # ]: 0 : ABI_FREE(elements_idx)
557 : :
558 : : ! Read the irreducible representations.
559 [ # # ]: 0 : read(unt,*,ERR=10) nirreps_k
560 [ # # ]: 0 : ABI_CHECK(Gk%nclass == nirreps_k,"Gk%nclass /= nirreps_k")
561 : :
562 : : !$$ allocate(Gk%class_names(Gk%nclass))
563 [ # # # # : 0 : ABI_MALLOC(Gk%Irreps, (nirreps_k))
# # # # #
# # # # #
# # # # #
# # # ]
564 : :
565 [ # # ]: 0 : do irp=1,nirreps_k
566 : 0 : OneIrr => Gk%Irreps(irp)
567 [ # # ]: 0 : read(unt,*,ERR=10) irrep_idx, irrep_dim, irrep_name
568 : 0 : call OneIrr%init(nsym_ltgk, irrep_dim, irrep_name)
569 [ # # ]: 0 : do isym=1,nsym_ltgk
570 [ # # ]: 0 : read(unt,*,ERR=10) sym_idx, OneIrr%mat(:,:,isym)
571 [ # # ]: 0 : ABI_CHECK(sym_idx==irp,"sym_idx/=irp!")
572 : : ! Matrix elements on file are in the form (rho, theta) with theta given in degrees.
573 : 0 : call cmplx_sphcart(OneIrr%mat(:,:,isym),from="Sphere",units="Degrees")
574 : 0 : OneIrr%trace(isym) = get_trace(OneIrr%mat(:,:,isym))
575 : : end do
576 : : end do
577 : :
578 : : end do
579 : :
580 : 0 : close(unt)
581 : 0 : RETURN
582 : :
583 : : ! Handle IO-error.
584 : 0 : 10 ierr=1
585 : 0 : close(unt)
586 : 0 : RETURN
587 : :
588 [ # # # # : 0 : end subroutine groupk_from_file
# # ]
589 : : !!***
590 : :
591 : : !----------------------------------------------------------------------
592 : :
593 : : !!****f* m_ptgroups/sum_irreps
594 : : !! NAME
595 : : !! sum_irreps
596 : : !!
597 : : !! FUNCTION
598 : : !!
599 : : !! INPUTS
600 : : !!
601 : : !! OUTPUT
602 : : !!
603 : : !! SOURCE
604 : :
605 : 0 : function sum_irreps(Irrep1,Irrep2,ii,jj,kk,ll) result(res)
606 : :
607 : : !Arguments ------------------------------------
608 : : !scalars
609 : : class(irrep_t),intent(in) :: Irrep1,Irrep2
610 : : integer,intent(in) :: ii,jj,kk,ll
611 : : !arrays
612 : : complex(dp) :: res
613 : :
614 : : !Local variables-------------------------------
615 : : integer :: isym,nsym,ierr
616 : : !character(len=500) :: msg
617 : : ! *********************************************************************
618 : :
619 : 0 : ierr=0; res = czero
620 : :
621 : 0 : nsym = Irrep1%nsym
622 [ # # ]: 0 : if (nsym /= Irrep2%nsym) then
623 : 0 : ABI_WARNING("Irreps have different nsym")
624 : 0 : ierr=ierr+1
625 : : end if
626 : :
627 [ # # ]: 0 : if (Irrep1%dim /= Irrep2%dim) then
628 : 0 : ABI_WARNING("Irreps have different dimensions")
629 : 0 : write(std_out,*)Irrep1%dim,Irrep2%dim
630 : 0 : ierr=ierr+1
631 : : end if
632 : :
633 [ # # ]: 0 : if (ii > Irrep2%dim .or. jj > Irrep2%dim .or. kk > Irrep1%dim .or. ll > Irrep1%dim) then
634 : 0 : ABI_WARNING("Wrong indices")
635 : 0 : write(std_out,*)ii,Irrep2%dim,jj,Irrep2%dim,kk>Irrep1%dim,ll,Irrep1%dim
636 : 0 : ierr=ierr+1
637 : : end if
638 : :
639 [ # # ]: 0 : if (ierr/=0) RETURN
640 : :
641 [ # # ]: 0 : do isym=1,nsym
642 : 0 : res = res + DCONJG(Irrep1%mat(ii,jj,isym)) * Irrep2%mat(kk,ll,isym)
643 : : end do
644 : :
645 : 0 : end function sum_irreps
646 : : !!***
647 : :
648 : : end module m_ptgroups
649 : : !!***
|
