[table of contents] [master index] [comments] [modules] [programs] [variables] [types] [procedures]
MODULE
group_mod
PURPOSE
Define derived data types and basic operations
for space group symmetry operations and groups
SOURCE
module group_mod
use const_mod, only : dim, long
use version_mod, only : version_type, input_version, output_version
implicit none
private
! Derived types
public :: symmetry_type ! space group symmetry
public :: group_type ! space group
! Generic interfaces
public :: operator(.dot.) ! .dot. products for vectors,
! matrices and symmetry_type
public :: inverse ! inversion of 2D and 3D real
! matrices and symmetry_type
public :: equal ! equality with tolerance for variety
! of data types, including symmetries
! Public procedures
public :: read_group, output_group ! io for groups
public :: make_group ! complete and check space group
TYPE
symmetry_type
VARIABLE
character(9) basis = 'Cartesian' or 'Bravais '
real(long) m(3,3) = point group matrix
real(long) v(3) = translation vector
COMMENT
Conventions for symmetry_type and related derived types:
a) The effect of a symmetry on a position vector is to take
R -> m .dot. R + v
where m .dot. R represents contraction with first index of m
b) Point group matrix m operates on reciprocal G vectors by
contraction with first index of m: G -> G .dot. m
c) Symmetries can be expressed in either Cartesian or
Bravais basis, as indicated by value of the character
variable basis, which can have values equal to the string
constants Cartesian = 'Cartesian' or Bravais='Bravais '.
d) In the Bravais basis, position vectors are represented
as coefficients in expansion in Bravais basis vectors,
R_basis(:,i), i=1,..dim, and G vectors are represented
as (integer) coefficients in expansion in reciprocal
basis vectors, G_basis(:,j), j=1,..,dim .
e) In the Bravais representation, elements of a point
group matrix m should be integers (though they are
stored as reals), and elements of the translation
vector v should be low order fractions
SOURCE
type symmetry_type
character(9) :: basis ! must equal 'Cartesian' or 'Bravais '
real(long) :: m(3,3) ! point group matrix
real(long) :: v(3) ! translation vector
end type symmetry_type
TYPE
group_type
VARIABLE
order = # of symmetry elements in group
s(max_order) = array of symmetries
COMMENT
All symmetries in a group must have the same basis, i.e.,
they must all be either in Bravais or Cartesian basis
SOURCE
type group_type
integer :: order
type(symmetry_type) :: s(max_order)
end type group_type
COMMENT
a) In names of the specific realizations the types of
arguments are indicated with the shorthand:
integer ivec(:)
real(long) vec(:)
real(long) mat(:,:)
symmetry_type sym
b) When evaluating dot products, elements of the input
arguments with indices > dim are ignored, and elements
of any returned vector or matrix with indices > dim
are padded with zeros. Because the return value of
the operator cannot be adjustable, the operator returns
vectors and matrices (when appropriate) with dimension 3
SOURCE
interface operator(.dot.)
module procedure ivec_dot_ivec ! integer
module procedure vec_dot_vec ! real
module procedure ivec_dot_vec ! real
module procedure vec_dot_ivec ! real
module procedure mat_dot_vec ! real(3)
module procedure ivec_dot_mat ! real(3)
module procedure vec_dot_mat ! real(3)
module procedure mat_dot_mat ! real(3,3)
module procedure sym_dot_vec ! real(3) = sym%m.dot.vec + sym%v
module procedure vec_dot_sym ! real(3) = vec.dot.sym%m
module procedure ivec_dot_sym ! integer(3) = ivec.dot.sym%m
module procedure sym_dot_sym ! symmetry_type
end interface
FUNCTION
equal(a,b)
RETURN
true if a nd b are equal to within a tolerance epsilon
The arguments a and b may be objects of type:
real(long)
integer dimension(3)
real(long) dimension(3)
real(long) dimension(3,3)
symmetry_type
SOURCE
interface equal
module procedure real_equal
module procedure ivector_equal
module procedure r_vector_equal
module procedure matrix_equal
module procedure symmetry_equal
end interface
FUNCTION
inverse(a) - generic interface for inversion
RETURN
inverse of argument a
The argument a may be:
real(long) matrix_inverse(3,3)
symmetry_type symmetry_inverse
SOURCE
interface inverse
module procedure matrix_inverse ! (3,3) padded with zeros
module procedure symmetry_inverse ! symmetry_type
end interface
SUBROUTINE
output_symmetry(s,iunit)
PURPOSE
Write symmetry s to file iunit
SOURCE
subroutine output_symmetry(s,iunit) type(symmetry_type), intent(in):: s integer :: iunit
SUBROUTINE
output_group(g,iunit)
PURPOSE
Write group g to file iunit
SOURCE
subroutine output_group(g,iunit) type(group_type), intent(IN) :: g integer, intent(IN) :: iunit
SUBROUTINE
read_group(g,iunit)
PURPOSE
Read group g from file unit iunit
SOURCE
subroutine read_group(g,iunit) type(group_type), intent(OUT) :: g integer, intent(IN) :: iunit
SUBROUTINE
make_group(g,R_basis,G_basis)
PURPOSE
Construct complete group from incomplete proto-group, after
checking that all elements of proto-group have same basis
ARGUMENTS
group - group, incomplete on input, complete on output
R_basis - Bravais lattice basis vectors
G_basis - reciprocal lattice basis vectors
SOURCE
subroutine make_group(g,R_basis,G_basis) type(group_type), intent(INOUT) :: g real(long), intent(IN) :: R_basis(:,:), G_basis(:,:)