Skip to content
Snippets Groups Projects
Commit 43e380e5 authored by Jonathan Chico's avatar Jonathan Chico
Browse files

Changes to unify findgroup and pointgroup

parent 68208dc5
No related branches found
No related tags found
No related merge requests found
......@@ -160,7 +160,7 @@ add_executable(
source/KKRhost/etotb1.f90
source/KKRhost/ewald2d.f90
source/KKRhost/exch91.f90
source/KKRhost/findgroup.f90
source/common/findgroup.f90
source/KKRhost/force.f90
source/KKRhost/forceh.f90
source/KKRhost/forcxc.f90
......@@ -253,7 +253,7 @@ add_executable(
source/KKRhost/phicalc.f90
source/KKRhost/pnsqns.f90
source/KKRhost/pnstmat.f90
source/KKRhost/pointgrp.f90
source/common/pointgrp.f90
source/KKRhost/potcut.f90
source/KKRhost/projtau.f90
source/KKRhost/readimppot.f90
......@@ -410,7 +410,7 @@ if(ENABLE_BdG)
source/KKRhost/symtaumat.f90
source/KKRhost/taustruc.f90
source/KKRhost/bzkint0.f90
source/KKRhost/findgroup.f90
source/common/findgroup.f90
source/KKRhost/calcrotmat.f90
source/KKRhost/errortrap.f90
source/KKRhost/bzkmesh.f90
......@@ -463,7 +463,7 @@ if(ENABLE_BdG)
source/KKRhost/latvec.f90
source/KKRhost/length.f90
source/KKRhost/nrmliz.f90
source/KKRhost/pointgrp.f90
source/common/pointgrp.f90
source/KKRhost/potcut.f90
source/KKRhost/rinit.f90
source/KKRhost/decimaread.f90
......
......@@ -15,6 +15,8 @@
add_executable(
Pkkr.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/main.f90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
......@@ -47,6 +49,8 @@ endif()
add_executable(
band.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
source/PKKprime/mod_ioformat.f90
......@@ -68,6 +72,8 @@ endif()
add_executable(
mergerefined.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
source/PKKprime/mod_ioformat.f90
......@@ -97,6 +103,8 @@ endif()
add_executable(
refineBZparts.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/mod_mathtools.f90
source/PKKprime/mod_vtkxml.f90
source/PKKprime/mod_ioinput.f90
......@@ -110,6 +118,8 @@ endif()
add_executable(
Amatprecalc.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
source/PKKprime/mod_ioformat.f90
......@@ -141,6 +151,8 @@ endif()
add_executable(
calculate_spinmixing.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/calculate_spinmixing.F90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
......@@ -173,6 +185,8 @@ endif()
add_executable(
visdata.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/visdata.F90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
......@@ -205,6 +219,8 @@ endif()
add_executable(
vis2int.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/vis2int.F90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
......@@ -237,6 +253,8 @@ endif()
add_executable(
test.x
source/common/mod_verify77.f90
source/common/findgroup.f90
source/common/pointgrp.f90
source/PKKprime/type_inc.F90
source/PKKprime/mod_mympi.F90
source/PKKprime/mod_ioformat.f90
......
......@@ -10,10 +10,12 @@ module mod_symmetries
use mod_mympi, only: nranks, myrank, master
use mod_pointgrp, only: pointgrp
use mod_findgroup, only: findgroup
implicit none
private
public :: symmetries_type, set_symmetries, pointgrp, get_IBZwedge_faces, points_in_wedge, singlepoint_in_wedge, rotate_kpoints, expand_visarrays, expand_areas, expand_spinvalues, expand_torqvalues, unfold_visarrays, get_2DIBZwedge_lines
public :: symmetries_type, set_symmetries, get_IBZwedge_faces, points_in_wedge, singlepoint_in_wedge, rotate_kpoints, expand_visarrays, expand_areas, expand_spinvalues, expand_torqvalues, unfold_visarrays, get_2DIBZwedge_lines
type :: symmetries_TYPE
......@@ -191,9 +193,9 @@ contains
do ipt=1,npts
lpoints(ipt) = singlepoint_in_wedge(nfaces, nvec, dscal, points(:,ipt))
end do!ipt
end do`!ipt
selectcase( mode )
select case( mode )
case( 'any' ) ; points_in_wedge = any(lpoints)
case( 'all' ) ; points_in_wedge = all(lpoints)
case default ; stop "Mode for 'points_in_wedge' not known."
......@@ -761,404 +763,6 @@ contains
1040 FORMAT(' Symmetries set by hand: ',I5)
end subroutine read_sym_inp
!-------------------------------------------------------------------------------
!> Summary: Find symmetry operations that leave crystal lattice invariant
!> Author:
!> Category: PKKprime, geometry
!> Deprecated: False ! This needs to be set to True for deprecated subroutines
!>
!> @note copied from host code @endnote
!>
!> This subroutine finds the rotation matrices that leave the
!> real lattice unchanged.
!> input: bravais(i,j) true bravais lattice vectors
!> i = x,y,z ; j = A, B, C (a.u.)
!> recbv(i,j) reciprocal basis vectors
!> rbasis coordinates of basis atoms
!> nbasis number of basis atoms
!> rfctor alat/4/pi
!> output: rotmat all 64 rotation matrices.
!> rotname names for the rotation matrices
!> nsymat number of rotations that restore the lattice.
!> isymindex index for the symmeties found
!>
!> This sub makes all 64 rotations in the basis vectors and bravais
!> vectors and checks if the new rotated vectror belongs in the
!> lattice. The proper rotation must bring all vectors to a lattice
!> vector. Information about the rotations found is printed in the end.
!> The array isymindex holds the numbers of the symmetry operations
!> that are stored in array RSYMAT
!-------------------------------------------------------------------------------
subroutine findgroup( nbasis,naezd,nembd,bravais,rbasis, &
& rfctor,recbv,nbzdim, &
& rotmat,rotname,nsymat,isymindex_out )
implicit none
integer, intent(in) :: nbasis, naezd, nembd, nbzdim
double precision, intent(in) :: bravais(3,3),rbasis(3,naezd+nembd)
double precision, intent(in) :: rfctor,recbv(3,3)
double precision, intent(out) :: rotmat(64,3,3)
character(len=10), intent(out) :: rotname(64)
integer, intent(out) :: nsymat
integer, allocatable, intent(out) :: isymindex_out(:)
integer, parameter :: NSYMAXD=48
integer :: isymindex(NSYMAXD)
! Local variables
double precision :: r(3,4),rotrbas(3,naezd+nembd)
double precision :: alat,bravais1(3,3)
integer :: i,j,isym,nsym,i0,ia
character(len=10) :: charstr(64)
logical :: llatbas,lbulk
! -------------------------------------------------------------
nsym = 0
call pointgrp(rotmat,rotname)
! alat = rfctor*8.d0*datan(1.0d0)
! - ---------------------------------
do i=1,3
do j=1,3
bravais1(j,i) = bravais(j,i) !/alat
end do
end do
!Check for surface mode. If so, set bravais1(3,3) very large, so
!that only the in-plane symmetries are found. Not checked, be careful of z--> -z!
if(nbzdim==2)then
lbulk=.false.
else!nbzdim==2
lbulk=.true.
end if!nbzdim==2
! !Now check the bravais vectors if they have a z component
! if ((bravais(1,3).eq.0.d0).and.(bravais(2,3).eq.0.d0).and.&
! & (bravais(3,3).eq.0.d0)) then
! lbulk=.false.
! end if
! write(100,*) 'bravais:'
! write(100,'(3ES25.16)') bravais
! write(100,*) 'lbulk=', lbulk
do isym=1,64
!rotate bravais lattice vectors
!In the case of slab/interface geometry look only for
!symmetry opperations that preserve the z axis..
if (lbulk .or. (rotmat(isym,3,3).eq.1) ) then
!do rotation only in case bulk or if slab and z axis is restored..
do i=1,3 ! Loop on bravais vectors
do j=1,3 ! Loop on coordinates
r(j,i) = rotmat(isym,j,1)*bravais1(1,i) + &
& rotmat(isym,j,2)*bravais1(2,i) + &
& rotmat(isym,j,3)*bravais1(3,i)
enddo
enddo
!rotate the basis atoms p and take RSYMAT.p - p then
!find if R = (RSYMAT.bravais + RSYMAT.p - p) belongs to the
!lattice. This is done by function latvec by checking
!if R.q = integer (q reciprocal lattice vector)
llatbas = .true.
do ia=1,nbasis ! Loop on basis atoms
do j=1,3 ! Loop on coordinates
rotrbas(j,ia) = rotmat(isym,j,1)*rbasis(1,ia) + &
& rotmat(isym,j,2)*rbasis(2,ia) + &
& rotmat(isym,j,3)*rbasis(3,ia)
rotrbas(j,ia) = rotrbas(j,ia) - rbasis(j,ia)
r(j,4) = rotrbas(j,ia)
enddo
if (.not.latvec(4,recbv,r)) llatbas=.false.
enddo ! ia=1,nbasis
!if llatbas=.true. the rotation does not change the lattice
if (llatbas) then
nsym = nsym + 1
isymindex(nsym) = isym
end if
end if ! (lbulk .OR. (rotmat(isym,3,3).EQ.1) )
end do ! isym=1,nmatd
!nsym symmetries were found
!the isymindex array has the numbers of the symmetries found
nsymat = nsym
allocate(isymindex_out(nsymat))
isymindex_out(:) = isymindex(1:nsymat)
!write info to the screen
if(myrank==master)then
write(6,*) 'Information from FindGroup'
if (.not.lbulk) write(6,*) 'Surface Symmetries '
write(6,1020) nsymat
do i=1,nsymat
I0 = isymindex(i)
charstr(i) = rotname(I0)
end do
write(6,1010) (charstr(i),i=1,nsymat)
write(6,*) '----------- * findgroup ends here * ---------------'
write(6,*)
end if!myrank==master
1010 FORMAT(5(A10,2X))
1020 FORMAT(' Symmetries found for this lattice: ',I5)
end subroutine findgroup
!-------------------------------------------------------------------------------
!> Summary: Rotation matrices of 32 point groups
!> Author:
!> Category: PKKprime, geometry
!> Deprecated: False ! This needs to be set to True for deprecated subroutines
!>
!> @note copied from host code @endnote
!> This subroutine defines the rotation matrices for
!> all the 32 point groups and names them after
!> J.F. Cornwell (Group Theory?) second edition
!> Appendix D, p 324-325
!-------------------------------------------------------------------------------
subroutine pointgrp(rotmat,rotname)
implicit none
double precision, intent(out) :: ROTMAT(64,3,3)
character(len=10), intent(out) :: ROTNAME(64)
!Locals
integer i,j,i1,is
double precision RTHREE,HALF
integer, parameter :: iou=3514
logical :: writesymfile = .true.
RTHREE = sqrt(3.d0)/2.d0
HALF = 0.5d0
! set to zero
do i1=1,64
do i=1,3
do j=1,3
ROTMAT(i1,i,j) = 0.d0
end do
end do
end do
ROTMAT(1,1,1) = 1.d0
ROTMAT(1,2,2) = 1.d0
ROTMAT(1,3,3) = 1.d0
ROTNAME(1) = 'E'
ROTMAT(2,1,2) = 1.d0
ROTMAT(2,2,3) = -1.d0
ROTMAT(2,3,1) = -1.d0
ROTNAME(2) = 'C3alfa'
ROTMAT(3,1,2) = -1.d0
ROTMAT(3,2,3) = -1.d0
ROTMAT(3,3,1) = 1.d0
ROTNAME(3) = 'C3beta '
ROTMAT(4,1,2) = -1.d0
ROTMAT(4,2,3) = 1.d0
ROTMAT(4,3,1) = -1.d0
ROTNAME(4) = 'C3gamma'
ROTMAT(5,1,2) = 1.d0
ROTMAT(5,2,3) = 1.d0
ROTMAT(5,3,1) = 1.d0
ROTNAME(5) = 'C3delta '
ROTMAT(6,1,3) = -1.d0
ROTMAT(6,2,1) = 1.d0
ROTMAT(6,3,2) = -1.d0
ROTNAME(6) = 'C3alfa-1'
ROTMAT(7,1,3) = 1.d0
ROTMAT(7,2,1) = -1.d0
ROTMAT(7,3,2) = -1.d0
ROTNAME(7) = 'C3beta-1 '
ROTMAT(8,1,3) = -1.d0
ROTMAT(8,2,1) = -1.d0
ROTMAT(8,3,2) = 1.d0
ROTNAME(8) = 'C3gamma-1'
ROTMAT(9,1,3) = 1.d0
ROTMAT(9,2,1) = 1.d0
ROTMAT(9,3,2) = 1.d0
ROTNAME(9) = 'C3delta-1'
ROTMAT(10,1,1) = 1.d0
ROTMAT(10,2,2) = -1.d0
ROTMAT(10,3,3) = -1.d0
ROTNAME(10) = 'C2x'
ROTMAT(11,1,1) = -1.d0
ROTMAT(11,2,2) = 1.d0
ROTMAT(11,3,3) = -1.d0
ROTNAME(11) = 'C2y'
ROTMAT(12,1,1) = -1.d0
ROTMAT(12,2,2) = -1.d0
ROTMAT(12,3,3) = 1.d0
ROTNAME(12) = 'C2z'
ROTMAT(13,1,1) = 1.d0
ROTMAT(13,2,3) = 1.d0
ROTMAT(13,3,2) = -1.d0
ROTNAME(13) = 'C4x'
ROTMAT(14,1,3) = -1.d0
ROTMAT(14,2,2) = 1.d0
ROTMAT(14,3,1) = 1.d0
ROTNAME(14) = 'C4y '
ROTMAT(15,1,2) = 1.d0
ROTMAT(15,2,1) = -1.d0
ROTMAT(15,3,3) = 1.d0
ROTNAME(15) = 'C4z'
ROTMAT(16,1,1) = 1.d0
ROTMAT(16,2,3) = -1.d0
ROTMAT(16,3,2) = 1.d0
ROTNAME(16) = 'C4x-1 '
ROTMAT(17,1,3) = 1.d0
ROTMAT(17,2,2) = 1.d0
ROTMAT(17,3,1) = -1.d0
ROTNAME(17) = 'C4y-1'
ROTMAT(18,1,2) = -1.d0
ROTMAT(18,2,1) = 1.d0
ROTMAT(18,3,3) = 1.d0
ROTNAME(18) = 'C4z-1'
ROTMAT(19,1,2) = 1.d0
ROTMAT(19,2,1) = 1.d0
ROTMAT(19,3,3) = -1.d0
ROTNAME(19) = 'C2a'
ROTMAT(20,1,2) = -1.d0
ROTMAT(20,2,1) = -1.d0
ROTMAT(20,3,3) = -1.d0
ROTNAME(20) = 'C2b'
ROTMAT(21,1,3) = 1.d0
ROTMAT(21,2,2) = -1.d0
ROTMAT(21,3,1) = 1.d0
ROTNAME(21) = 'C2c'
ROTMAT(22,1,3) = -1.d0
ROTMAT(22,2,2) = -1.d0
ROTMAT(22,3,1) = -1.d0
ROTNAME(22) = 'C2d'
ROTMAT(23,1,1) = -1.d0
ROTMAT(23,2,3) = 1.d0
ROTMAT(23,3,2) = 1.d0
ROTNAME(23) = 'C2e'
ROTMAT(24,1,1) = -1.d0
ROTMAT(24,2,3) = -1.d0
ROTMAT(24,3,2) = -1.d0
ROTNAME(24) = 'C2f'
do i1=1,24
do i=1,3
do j=1,3
ROTMAT(i1+24,i,j) = -ROTMAT(i1,i,j)
end do
end do
ROTNAME(i1+24) = 'I'//ROTNAME(i1)
end do
!*********************************************
! Trigonal and hexagonal groups
!*********************************************
ROTMAT(49,1,1) = -HALF
ROTMAT(49,1,2) = RTHREE
ROTMAT(49,2,1) = -RTHREE
ROTMAT(49,2,2) = -HALF
ROTMAT(49,3,3) = 1.d0
ROTNAME(49) = 'C3z'
ROTMAT(50,1,1) = -HALF
ROTMAT(50,1,2) = -RTHREE
ROTMAT(50,2,1) = RTHREE
ROTMAT(50,2,2) = -HALF
ROTMAT(50,3,3) = 1.d0
ROTNAME(50) = 'C3z-1'
ROTMAT(51,1,1) = HALF
ROTMAT(51,1,2) = RTHREE
ROTMAT(51,2,1) = -RTHREE
ROTMAT(51,2,2) = HALF
ROTMAT(51,3,3) = 1.d0
ROTNAME(51) = 'C6z'
ROTMAT(52,1,1) = HALF
ROTMAT(52,1,2) = -RTHREE
ROTMAT(52,2,1) = RTHREE
ROTMAT(52,2,2) = HALF
ROTMAT(52,3,3) = 1.d0
ROTNAME(52) = 'C6z-1'
ROTMAT(53,1,1) = -HALF
ROTMAT(53,1,2) = RTHREE
ROTMAT(53,2,1) = RTHREE
ROTMAT(53,2,2) = HALF
ROTMAT(53,3,3) = -1.d0
ROTNAME(53) = 'C2A'
ROTMAT(54,1,1) = -HALF
ROTMAT(54,1,2) = -RTHREE
ROTMAT(54,2,1) = -RTHREE
ROTMAT(54,2,2) = HALF
ROTMAT(54,3,3) = -1.d0
ROTNAME(54) = 'C2B'
ROTMAT(55,1,1) = HALF
ROTMAT(55,1,2) = -RTHREE
ROTMAT(55,2,1) = -RTHREE
ROTMAT(55,2,2) = -HALF
ROTMAT(55,3,3) = -1.d0
ROTNAME(55) = 'C2C'
ROTMAT(56,1,1) = HALF
ROTMAT(56,1,2) = RTHREE
ROTMAT(56,2,1) = RTHREE
ROTMAT(56,2,2) = -HALF
ROTMAT(56,3,3) = -1.d0
ROTNAME(56) = 'C2D'
do is=1,8
do i=1,3
do j=1,3
ROTMAT(56+is,i,j) = -ROTMAT(48+is,i,j)
end do
end do
ROTNAME(56+is) = 'I'//ROTNAME(48+is)
end do
if(myrank==master .and. writesymfile)then
open(unit=iou,file='sym.out',form='formatted',action='write')
write(iou,'(I0)') 64
do is=1,64
write(iou,'(A)') ROTNAME(is)
write(iou,'(3ES25.16)') ROTMAT(is,:,:)
end do
close(iou)
writesymfile = .false.
end if!myrank==master .and. writesymfile
end subroutine pointgrp
!-------------------------------------------------------------------------------
!> Summary: Checks if a set of vectors are lattice vectors
!> Author:
......
File moved
File moved
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment