TABLE OF CONTENTS


ABINIT/chkgrp [ Functions ]

[ Top ] [ Functions ]

FUNCTION

 Checks that a set of input symmetries constitutes a group.

COPYRIGHT

 Copyright (C) 1998-2018 ABINIT group (DCA, XG, GMR)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .
 For the initials of contributors, see ~abinit/doc/developers/contributors.txt .

INPUTS

 nsym = number of symmetry operations
 symafm = (anti)ferromagnetic part of symmetry operations
 symrel = 3D matrix containg symmetry operations

OUTPUT

  ierr=Status error.

TODO

 SHOULD ALSO CHECK THE tnons !

PARENTS

      chkinp,gensymspgr,m_bz_mesh,m_esymm,m_sigmaph,setsym

CHILDREN

SOURCE

 34 #if defined HAVE_CONFIG_H
 35 #include "config.h"
 36 #endif
 37 
 38 #include "abi_common.h"
 39 
 40 subroutine chkgrp(nsym,symafm,symrel,ierr)
 41 
 42  use defs_basis
 43  use m_errors
 44  use m_profiling_abi
 45 
 46 !This section has been created automatically by the script Abilint (TD).
 47 !Do not modify the following lines by hand.
 48 #undef ABI_FUNC
 49 #define ABI_FUNC 'chkgrp'
 50  use interfaces_32_util
 51 !End of the abilint section
 52 
 53  implicit none
 54 
 55 !Arguments ------------------------------------
 56 !scalars
 57  integer,intent(in) :: nsym
 58  integer,intent(out) :: ierr
 59 !arrays
 60  integer,intent(in) :: symafm(nsym),symrel(3,3,nsym)
 61 
 62 !Local variables-------------------------------
 63 !scalars
 64  integer :: isym,jsym,ksym,symafmchk,testeq=1
 65  logical :: found_inv
 66  character(len=500) :: msg
 67 !arrays
 68  integer :: chk(3,3)
 69 
 70 ! *************************************************************************
 71 
 72 !DEBUG
 73 !write(std_out,*)' chkgrp : enter'
 74 !write(std_out,*)'     isym         symrel            symafm '
 75 !do isym=1,nsym
 76 !write(std_out,'(i3,a,9i3,a,i3)' )isym,'   ',symrel(:,:,isym),'   ',symafm(isym)
 77 !end do
 78 !ENDDEBUG
 79 
 80  ierr = 0
 81 
 82 !1) Identity must be the first symmetry.
 83  if (ANY(symrel(:,:,1) /= identity_3d .or. symafm(1)/=1 )) then
 84    MSG_WARNING("First operation must be the identity operator")
 85    ierr = ierr+1
 86  end if
 87 !
 88 !2) The inverse of each element must belong to the group.
 89  do isym=1,nsym
 90    call mati3inv(symrel(:,:,isym),chk)
 91    chk = TRANSPOSE(chk)
 92    found_inv = .FALSE.
 93    do jsym=1,nsym
 94      if ( ALL(symrel(:,:,jsym) == chk) .and. (symafm(jsym)*symafm(isym) == 1 )) then
 95        found_inv = .TRUE.; EXIT
 96      end if
 97    end do
 98 
 99    if (.not.found_inv) then
100      write(msg,'(a,i0,2a)')&
101 &     "Cannot find the inverse of symmetry operation ",isym,ch10,&
102 &     "Input symmetries do not form a group "
103      MSG_WARNING(msg)
104      ierr = ierr+1
105    end if
106 
107  end do
108 !
109 !Closure relation under composition.
110  do isym=1,nsym
111    do jsym=1,nsym
112 !
113 !    Compute the product of the two symmetries
114      chk = MATMUL(symrel(:,:,jsym), symrel(:,:,isym))
115      symafmchk=symafm(jsym)*symafm(isym)
116 !
117 !    Check that product array is one of the original symmetries.
118      do ksym=1,nsym
119        testeq=1
120        if ( ANY(chk/=symrel(:,:,ksym) )) testeq=0
121 #if 0
122 !      FIXME this check make v4/t26 and v4/t27 fails.
123 !      The rotational part is in the group but with different magnetic part!
124        if (symafmchk/=symafm(ksym))testeq=0
125 #endif
126        if (testeq==1) exit ! The test is positive
127      end do
128 !
129      if(testeq==0) then ! The test is negative
130        write(msg, '(a,2i3,a,7a)' )&
131 &       'product of symmetries',isym,jsym,' is not in group.',ch10,&
132 &       'This indicates that the input symmetry elements',ch10,&
133 &       'do not possess closure under group composition.',ch10,&
134 &       'Action: check symrel, symafm and fix them.'
135        MSG_WARNING(msg)
136        ierr = ierr+1
137      end if
138 
139    end do ! jsym
140  end do ! isym
141 
142 end subroutine chkgrp

ABINIT/sg_multable [ Functions ]

[ Top ] [ Functions ]

NAME

 sg_multable

FUNCTION

 Checks that a set of input symmetries constitutes a group.

INPUTS

 nsym=number of symmetry operations
 symafm(nsym)=(anti)ferromagnetic part of symmetry operations
 symrel(3,3,nsym)=symmetry operations in real space.
 tnons(3,nsym)=Fractional translations.

OUTPUT

  ierr=Status error. A non-zero value signals a failure.
  [multable(4,nsym,nsym)]= Optional output.
    multable(1,sym1,sym2) gives the index of the symmetry product S1 * S2 in the symrel array. 0 if not found.
    multable(2:4,sym1,sym2)= the lattice vector that has to added to the fractional translation
      of the operation of index multable(1,sym1,sym2) to obtain the fractional traslation of the product S1 * S2.
  [toinv(4,nsym)]= Optional output.
    toinv(1,sym1)=Gives the index of the inverse of the symmetry operation.
     S1 * S1^{-1} = {E, L} with E identity and L a lattice vector
    toinv(2:4,sym1)=The lattice vector L
      Note that toinv can be easily obtained from multable but sometimes we do not need the full table.

TODO

  This improved version should replace chkgrp.

PARENTS

      m_crystal,m_shirley

CHILDREN

SOURCE

181 subroutine sg_multable(nsym,symafm,symrel,tnons,tnons_tol,ierr,multable,toinv)
182 
183  use defs_basis
184  use m_errors
185  use m_profiling_abi
186 
187  use m_numeric_tools,  only : isinteger
188 
189 !This section has been created automatically by the script Abilint (TD).
190 !Do not modify the following lines by hand.
191 #undef ABI_FUNC
192 #define ABI_FUNC 'sg_multable'
193 !End of the abilint section
194 
195  implicit none
196 
197 !Arguments ------------------------------------
198 !scalars
199  integer,intent(in) :: nsym
200  integer,intent(out) :: ierr
201  real(dp),intent(in) :: tnons_tol
202 !arrays
203  integer,intent(in) :: symafm(nsym),symrel(3,3,nsym)
204  integer,optional,intent(out) :: multable(4,nsym,nsym)
205  integer,optional,intent(out) :: toinv(4,nsym)
206  real(dp),intent(in) :: tnons(3,nsym)
207 
208 !Local variables-------------------------------
209 !scalars
210  integer :: sym1,sym2,sym3,prd_symafm
211  logical :: found_inv,iseq
212  character(len=500) :: msg
213 !arrays
214  integer :: prd_symrel(3,3)
215  real(dp) :: prd_tnons(3)
216 
217 ! *************************************************************************
218 
219  ierr = 0
220 
221 !1) Identity must be the first symmetry. Do not check tnons, cell might not be primitive.
222  if (ANY(symrel(:,:,1) /= identity_3d .or. symafm(1)/=1 )) then
223    MSG_WARNING("First operation must be the identity operator")
224    ierr = ierr+1
225  end if
226 !
227 !2) The inverse of each element must belong to the group.
228  do sym1=1,nsym
229    found_inv = .FALSE.
230    do sym2=1,nsym
231      prd_symrel = MATMUL(symrel(:,:,sym1), symrel(:,:,sym2))
232      prd_tnons = tnons(:,sym1) + MATMUL(symrel(:,:,sym1),tnons(:,sym2))
233      prd_symafm = symafm(sym1)*symafm(sym2)
234      if ( ALL(prd_symrel == identity_3d) .and. isinteger(prd_tnons,tnons_tol) .and. prd_symafm == 1 ) then
235        found_inv = .TRUE.
236        if (PRESENT(toinv)) then
237          toinv(1,sym1) = sym2
238          toinv(2:4,sym1) = NINT(prd_tnons)
239        end if
240        EXIT
241      end if
242    end do
243 
244    if (.not.found_inv) then
245      write(msg,'(a,i0,2a)')&
246 &     "Cannot find the inverse of symmetry operation ",sym1,ch10,&
247 &     "Input symmetries do not form a group "
248      MSG_WARNING(msg)
249      ierr = ierr+1
250    end if
251  end do
252 !
253 !Check closure relation under composition and construct multiplication table.
254  do sym1=1,nsym
255    do sym2=1,nsym
256 !
257 !    Compute the product of the two symmetries. Convention {A,a} {B,b} = {AB, a+Ab}
258      prd_symrel = MATMUL(symrel(:,:,sym1), symrel(:,:,sym2))
259      prd_symafm = symafm(sym1)*symafm(sym2)
260      prd_tnons = tnons(:,sym1) + MATMUL(symrel(:,:,sym1),tnons(:,sym2))
261 !
262      iseq=.FALSE.
263      do sym3=1,nsym ! Check that product array is one of the original symmetries.
264        iseq = ( ALL(prd_symrel==symrel(:,:,sym3) )           .and. &
265 &       isinteger(prd_tnons-tnons(:,sym3),tnons_tol) .and. &
266 &       prd_symafm==symafm(sym3) )  ! Here v4/t26 and v4/t27 will fail.
267 !      The rotational part is in the group but with different magnetic part!
268 
269        if (iseq) then ! The test is positive
270          if (PRESENT(multable)) then
271            multable(1,sym1,sym2) = sym3
272            multable(2:4,sym1,sym2) = NINT(prd_tnons-tnons(:,sym3))
273          end if
274          EXIT
275        end if
276      end do
277 !
278      if (.not.iseq) then ! The test is negative
279        write(msg, '(a,2(i0,1x),a,7a)' )&
280 &       'product of symmetries:',sym1,sym2,' is not in group.',ch10,&
281 &       'This indicates that the input symmetry elements',ch10,&
282 &       'do not possess closure under group composition.',ch10,&
283 &       'Action: check symrel, symafm and fix them.'
284        MSG_WARNING(msg)
285        ierr = ierr+1
286        if (PRESENT(multable)) then
287          multable(1,sym1,sym2) = 0
288          multable(2:4,sym1,sym2) = HUGE(0)
289        end if
290      end if
291 
292    end do ! sym2
293  end do ! sym1
294 
295 end subroutine sg_multable