TABLE OF CONTENTS


ABINIT/symcharac [ Functions ]

[ Top ] [ Functions ]

NAME

 symcharac

FUNCTION

 Get the type of axis for the symmetry.

COPYRIGHT

 Copyright (C) 2000-2018 ABINIT group (RC, XG)
 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

 center=bravais(2)
 determinant=the value of the determinant of sym
 iholohedry=bravais(1)
 isym=number of the symmetry operation that is currently analyzed
 order=the order of the symmetry
 symrel(3,3)= the symmetry matrix
 tnons(3)=nonsymmorphic translations

OUTPUT

 label=a human readable text for the characteristic of the symmetry
 type_axis=an identifier for the type of symmetry

PARENTS

      m_ab7_symmetry,symspgr

CHILDREN

      symaxes,symplanes,wrtout

SOURCE

 37 #if defined HAVE_CONFIG_H
 38 #include "config.h"
 39 #endif
 40 
 41 #include "abi_common.h"
 42 
 43 subroutine symcharac(center, determinant, iholohedry, isym, label, symrel, tnons, type_axis)
 44 
 45  use defs_basis
 46  use m_profiling_abi
 47 
 48 !This section has been created automatically by the script Abilint (TD).
 49 !Do not modify the following lines by hand.
 50 #undef ABI_FUNC
 51 #define ABI_FUNC 'symcharac'
 52  use interfaces_14_hidewrite
 53  use interfaces_41_geometry, except_this_one => symcharac
 54 !End of the abilint section
 55 
 56  implicit none
 57 
 58 !Arguments ------------------------------------
 59 !scalars
 60  integer, intent(in) :: determinant, center, iholohedry, isym
 61  integer, intent(out) :: type_axis
 62  character(len = 128), intent(out) :: label
 63  !arrays
 64  integer,intent(in) :: symrel(3,3)
 65  real(dp),intent(in) :: tnons(3)
 66 
 67  !Local variables-------------------------------
 68  !scalars
 69  logical,parameter :: verbose=.FALSE.
 70  integer :: tnons_order, identified, ii, order, iorder
 71  character(len=500) :: message
 72  !arrays
 73  integer :: identity(3,3),matrix(3,3),trial(3,3)
 74  real(dp) :: reduced(3),trialt(3)
 75 
 76  !**************************************************************************
 77 
 78  identity(:,:)=0
 79  identity(1,1)=1 ; identity(2,2)=1 ; identity(3,3)=1
 80  trial(:,:)=identity(:,:)
 81  matrix(:,:)=symrel(:,:)
 82 
 83  order=0
 84  do iorder=1,6
 85    trial=matmul(matrix,trial)
 86    if(sum((trial-identity)**2)==0)then
 87      order=iorder
 88      exit
 89    end if
 90    if(sum((trial+identity)**2)==0)then
 91      order=iorder
 92      exit
 93    end if
 94  end do
 95 
 96  if(order==0)then
 97    type_axis = -2
 98    return
 99  end if
100 
101 !Determination of the characteristics of proper symmetries (rotations)
102  if(determinant==1)then
103 
104 !  Determine the translation vector associated to the rotations
105 !  and its order : apply the symmetry operation
106 !  then analyse the resulting vector.
107    identified=0
108    trialt(:)=zero
109    do ii=1,order
110      trialt(:)=matmul(symrel(:,:),trialt(:))+tnons(:)
111    end do
112 !  Gives the associated translation, with components in the
113 !  interval [-0.5,0.5] .
114    reduced(:)=trialt(:)-nint(trialt(:)-tol6)
115 
116    if(sum(abs(reduced(:)))<tol6)identified=1
117    if( (center==1 .or. center==-3) .and. &
118 &   sum(abs(reduced(:)-(/zero,half,half/)))<tol6 )identified=2
119    if( (center==2 .or. center==-3) .and. &
120 &   sum(abs(reduced(:)-(/half,zero,half/)))<tol6 )identified=3
121    if( (center==3 .or. center==-3) .and. &
122 &   sum(abs(reduced(:)-(/half,half,zero/)))<tol6 )identified=4
123    if(center==-1.and. sum(abs(reduced(:)-(/half,half,half/)))<tol6 )identified=5
124 
125 !  If the symmetry operation has not been identified, there is a problem ...
126    if(identified==0) then
127      type_axis = -1
128      return
129    end if
130 
131 !  Compute the translation vector associated with one rotation
132    trialt(:)=trialt(:)/order
133    trialt(:)=trialt(:)-nint(trialt(:)-tol6)
134 
135 !  Analyse the resulting vector.
136    identified=0
137    do ii=1,order
138      reduced(:)=ii*trialt(:)-nint(ii*trialt(:)-tol6)
139      if(sum(abs(reduced(:)))<tol6)identified=1
140      if( (center==1 .or. center==-3) .and. &
141 &     sum(abs(reduced(:)-(/zero,half,half/)))<tol6 )identified=2
142      if( (center==2 .or. center==-3) .and. &
143 &     sum(abs(reduced(:)-(/half,zero,half/)))<tol6 )identified=3
144      if( (center==3 .or. center==-3) .and. &
145 &     sum(abs(reduced(:)-(/half,half,zero/)))<tol6 )identified=4
146      if(center==-1.and. sum(abs(reduced(:)-(/half,half,half/)))<tol6 )identified=5
147 
148      if(identified/=0)then
149        tnons_order=ii
150        exit
151      end if
152    end do ! ii
153 
154 !  Determinant (here=+1, as we are dealing with proper symmetry operations),
155 !  order, tnons_order and identified are enough to
156 !  determine the kind of symmetry operation
157 
158    select case(order)
159    case(1)                       ! point symmetry 1
160      if(identified==1) then
161        type_axis=8                 ! 1
162        write(label,'(a)') 'the identity'
163      else
164        type_axis=7                 ! t
165        write(label,'(a)') 'a pure translation '
166      end if
167 
168      if (verbose) then
169        write(message,'(a,i3,2a)')' symspgr : the symmetry operation no. ',isym,' is ',trim(label)
170        call wrtout(std_out,message,'COLL')
171      end if
172 
173    case(2,3,4,6)                 ! point symmetry 2,3,4,6 - rotations
174      call symaxes(center,iholohedry,isym,symrel,label,order,tnons_order,trialt,type_axis)
175    end select
176 
177  else if (determinant==-1)then
178 
179 !  Now, take care of the improper symmetry operations.
180 !  Their treatment is relatively easy, except for the mirror planes
181    select case(order)
182    case(1)                       ! point symmetry 1
183      type_axis=5                  ! -1
184      write(label,'(a)') 'an inversion'
185    case(2)                       ! point symmetry 2 - planes
186      call symplanes(center,iholohedry,isym,symrel,tnons,label,type_axis)
187    case(3)                       ! point symmetry 3
188      type_axis=3                  ! -3
189      write(label,'(a)') 'a -3 axis '
190    case(4)                       ! point symmetry 1
191      type_axis=2                  ! -4
192      write(label,'(a)') 'a -4 axis '
193    case(6)                       ! point symmetry 1
194      type_axis=1                  ! -6
195      write(label,'(a)') 'a -6 axis '
196    end select
197 
198    if (order /= 2 .and. verbose) then
199      write(message,'(a,i3,2a)')' symspgr : the symmetry operation no. ',isym,' is ',trim(label)
200      call wrtout(std_out,message,'COLL')
201    end if
202 
203  end if ! determinant==1 or -1
204 
205 end subroutine symcharac