Skip to content

GitLab

C
CrysFML
Commit c995e253 authored by Nebil Ayape Katcho's avatar Nebil Ayape Katcho
Browse files
Options

Conflicts resolved

parents 4b994db0 0f131208
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 957 additions and 1387 deletions
Cmake_help.inf
View file @ c995e253
......@@ -79,7 +79,7 @@ Building CrysFML08
# Console Only for Ifort in debug mode
cmake -G "NMake Makefiles" -D ARCH32=OFF -D CMAKE_BUILD_TYPE=Debug -D CMAKE_Fortran_COMPILER=ifort -D CMAKE_INSTALL_PREFIX=%CRYSFML%\ifort64_debug -D CRYSFML_PREFIX=LibC08 -D CRYSFML08=ON ..\..\.
# Console Only for Ifort in release mode
cmake -G "NMake Makefiles" -D ARCH32=OFF -D CMAKE_BUILD_TYPE=Release -D CMAKE_Fortran_COMPILER=ifort -D CMAKE_INSTALL_PREFIX=%CRYSFML%\ifort64 -D CRYSFML_PREFIX=LibC08 -D CRYSFML08=ON ..\..\.
cmake -G "NMake Makefiles" -D ARCH32=OFF GUI=OFF -D CMAKE_BUILD_TYPE=Release -D CMAKE_Fortran_COMPILER=ifort -D CMAKE_INSTALL_PREFIX=%CRYSFML%\ifort64 -D CRYSFML_PREFIX=LibC08 -D CRYSFML08=ON ..\..\.
Building CrysFML for use with HDF5
......
Src08/CFML_Atoms.f90
View file @ c995e253
......@@ -39,11 +39,12 @@
!!---- Update: 06/03/2011
!!----
!!
Module CFML_Atoms
Module CFML_Atoms
!---- Use Modules ----!
Use CFML_GlobalDeps
Use CFML_Maths, only: modulo_lat, equal_vector
Use CFML_Metrics, only: Cell_G_Type
Use CFML_Strings, only: u_case,l_case
Use CFML_gSpaceGroups, only: spg_type, apply_op, SuperSpaceGroup_Type
......@@ -53,8 +54,10 @@ Module CFML_Atoms
private
!---- List of public procedures ----!
public :: Allocate_Atom_List, Extend_List, Init_Atom_Type, Read_Bin_Atom_List, &
public :: Allocate_Atom_List, Extend_Atom_List, Init_Atom_Type, Read_Bin_Atom_List, &
Write_Bin_atom_List, Write_Atom_List
public :: Equiv_Atm, Wrt_Lab
!---- Parameters ----!
real(kind=cp), parameter :: R_ATOM=1.1_cp ! Average atomic radius
......@@ -208,6 +211,34 @@ Module CFML_Atoms
character (len=20), dimension(:), allocatable :: ddlab ! Labels of atoms at ddist (nat*idp)
End Type Atm_Cell_Type
!!---- Type, Public :: Atom_Equiv_Type
!!---- integer :: mult
!!---- character(len=2) :: ChemSymb
!!---- character(len=10),allocatable, dimension(:) :: Lab
!!---- real(kind=sp), allocatable, dimension(:,:) :: x
!!---- End Type Atom_Equiv_Type
!!----
!!---- Updated: January 2014
!!
Type, Public :: Atom_Equiv_Type
integer :: mult
character(len=2) :: ChemSymb
character(len=20),allocatable, dimension(:) :: Lab
real(kind=cp), allocatable, dimension(:,:) :: x
End Type Atom_Equiv_Type
!!---- Type, Public :: Atom_Equiv_List_Type
!!---- integer :: nauas
!!---- type (Atom_Equiv_Type), allocatable, dimension(:) :: atm
!!---- End Type Atom_Equiv_List_Type
!!----
!!---- Updated: January 2014
!!
Type, Public :: Atom_Equiv_List_Type
integer :: nauas
type (Atom_Equiv_Type), allocatable, dimension(:) :: atm
End Type Atom_Equiv_List_Type
!!----
!!---- TYPE :: ALIST_TYPE
!!--..
......@@ -220,9 +251,30 @@ Module CFML_Atoms
class(Atm_Type), dimension(:), allocatable :: Atom ! Atoms
End type AtList_Type
!Overload
Interface Extend_Atom_List
Module Procedure Extend_List !Creating a new AtList_Type with all atoms in unit cell
Module Procedure Set_Atom_Equiv_List !Creating a an Atom_Equiv_List_Type from AtList_Type in asymmetric unit
End Interface Extend_Atom_List
!---- Interface Zone ----!
Interface
Pure Module Function Equiv_Atm(Nam1,Nam2,NameAt) Result(Equiv_Atom)
!---- Arguments ----!
character (len=*), intent (in) :: nam1,nam2
character (len=*), intent (in) :: NameAt
logical :: equiv_atom
End Function Equiv_Atm
Pure Module Function Wrt_Lab(Nam1,Nam2) Result(Bilabel)
!---- Arguments ----!
character (len=*), intent (in) :: nam1,nam2
character (len=8) :: bilabel
End Function Wrt_Lab
Module Subroutine Init_Atom_Type(Atm,d)
!---- Arguments ----!
class(Atm_Type), intent(in out) :: Atm
......@@ -266,6 +318,14 @@ Module CFML_Atoms
logical, optional, intent(in) :: Conven ! If present and .true. using the whole conventional unit cell
End Subroutine Extend_List
Module Subroutine Set_Atom_Equiv_List(SpG,cell,A,Ate,lun)
type(SpG_Type), intent(in) :: SpG
type(Cell_G_Type), intent(in) :: Cell
type(Atlist_Type), intent(in) :: A
type(Atom_Equiv_List_Type), intent(out):: Ate
integer, optional, intent(in) :: lun
End Subroutine Set_Atom_Equiv_List
End Interface
End Module CFML_Atoms
End Module CFML_Atoms
Src08/CFML_Atoms/Allocating_Atoms.f90
View file @ c995e253
......@@ -160,7 +160,7 @@ SubModule (CFML_Atoms) Init_Allocating_Atoms
integer, intent(in) :: d !Number of k-vectors
!---- Local Variables ----!
integer :: i
integer :: i,ier
! Types :: Atm_Type, Atm_Std_Type, MAtm_Std_Type, Atm_Ref_Type, MAtm_Ref_Type
type(Atm_Type) , dimension(n) :: Atm
type(Atm_Std_Type) , dimension(n) :: Atm_Std
......@@ -180,18 +180,24 @@ SubModule (CFML_Atoms) Init_Allocating_Atoms
!> Allocating variables
Select Case(trim(l_case(Type_Atm)))
Case("atm")
allocate (A%atom(n),source=Atm)
allocate (A%atom(n),source=Atm,stat=ier)
Case("atm_std")
allocate (A%atom(n),source=Atm_Std)
allocate (A%atom(n),source=Atm_Std,stat=ier)
Case("matm_std")
allocate (A%atom(n),source=MAtm_Std)
allocate (A%atom(n),source=MAtm_Std,stat=ier)
Case("atm_ref")
allocate (A%atom(n),source=Atm_Ref)
allocate (A%atom(n),source=Atm_Ref,stat=ier)
Case("matm_ref")
allocate (A%atom(n),source=MAtm_Ref)
allocate (A%atom(n),source=MAtm_Ref,stat=ier)
End Select
allocate (A%active(n))
allocate (A%active(n),stat=ier)
if(ier /= 0) then
Err_CFML%Ierr=1
write(unit=Err_CFML%Msg,fmt="(a,i6,a)") "Error allocating atom List for N =",N," atoms"
end if
A%active=.true.
A%mcomp="crystal"
......
Src08/CFML_Atoms/ExtendList.f90
View file @ c995e253
......@@ -130,4 +130,91 @@ SubModule (CFML_Atoms) Generating_Atoms_inCell
call allocate_atom_list(0,c_atm,Type_Atm,3)
End Subroutine Extend_List
!!----
!!---- Module Subroutine Set_Atom_Equiv_List(SpG,cell,A,Ate,lun)
!!---- type(SpG_Type), intent(in) :: SpG
!!---- type(Cell_G_Type), intent(in) :: Cell
!!---- type(Atlist_Type), intent(in) :: A
!!---- type(Atom_Equiv_List_Type), intent(out):: Ate
!!---- integer, optional, intent(in) :: lun
!!----
!!---- Subroutine constructing the list of all atoms in the unit cell.
!!---- The atoms are in a structure of type "Atom_Equiv_List_Type" containing
!!---- just the fractional coordinates of all the atoms in the cell.
!!---- This a simplified version of the Extend_List Subroutine useful for geometric
!!---- calculations, using the type Atom_Equiv_List_Type, without the burden of
!!---- all components of Aton_Type
!!----
!!---- Updated: May 2020
!!
Module Subroutine Set_Atom_Equiv_List(SpG,cell,A,Ate,lun)
type(SpG_Type), intent(in) :: SpG
type(Cell_G_Type), intent(in) :: Cell
type(Atlist_Type), intent(in) :: A
type(Atom_Equiv_List_Type), intent(out):: Ate
integer, optional, intent(in) :: lun
! local variables
real(kind=cp), dimension(3) :: xx,xo,v,xc
real(kind=cp), dimension(3,SpG%Multip) :: u
character(len=20),dimension(SpG%Multip) :: label
integer :: k,j,L,nt
character (len=6) :: fmm
character (len=20) :: nam
real(kind=cp), parameter :: epsi = 0.002
if (.not. allocated (Ate%atm)) allocate(Ate%atm(A%natoms))
ate%nauas=A%natoms
if (present(lun)) then
write(unit=lun,fmt="(/,a)") " LIST OF ATOMS INSIDE THE CONVENTIONAL UNIT CELL "
write(unit=lun,fmt="(a,/)") " =============================================== "
end if
do k=1,A%natoms
ate%atm(k)%ChemSymb = A%atom(k)%ChemSymb
xo(:) =Modulo_Lat(A%atom(k)%x(:))
L=1
u(:,L)=xo(:)
xc =matmul(cell%Cr_Orth_cel,xo)
if (present(lun))then
write(unit=lun,fmt="(/,a,a)") " => Equivalent positions of atom: ",A%atom(k)%lab
write(unit=lun,fmt="(a)") &
" x y z Xc Yc Zc"
end if
fmm="(a,i1)"
write(unit=label(L),fmt=fmm) trim(A%Atom(k)%lab)//"_",L
nam=label(L)
if (present(lun)) write(unit=lun,fmt="(3a,3f10.5,a,3f10.5)") " ",nam," ", xo," ", xc
do_eq:DO j=2,SpG%multip
xx=Apply_OP(SpG%Op(j),xo)
xx=modulo_lat(xx)
do nt=1,L
v=u(:,nt)-xx(:)
if (sum(abs((v))) < epsi ) cycle do_eq
end do
L=L+1
u(:,L)=xx(:)
if ( L > 9 .and. L < 100) fmm="(a,i2)"
if ( L >= 100 ) fmm="(a,i3)"
write(unit=label(L),fmt=fmm) trim(A%Atom(k)%lab)//"_",L
nam=Label(L)
xc=matmul(cell%Cr_Orth_cel,xx)
if (present(lun)) write(unit=lun,fmt="(3a,3f10.5,a,3f10.5)") " ",nam," ", xx," ", xc
end do do_eq
if(allocated(Ate%Atm(k)%Lab)) deallocate(Ate%Atm(k)%Lab)
allocate(Ate%Atm(k)%lab(L))
if(allocated(Ate%Atm(k)%x)) deallocate(Ate%Atm(k)%x)
allocate(Ate%Atm(k)%x(3,L))
Ate%Atm(k)%mult=L
do j=1,Ate%Atm(k)%mult
Ate%Atm(k)%lab(j)=Label(j)
Ate%Atm(k)%x(:,j)=u(:,j)
end do
end do
if (present(lun)) write(unit=lun,fmt="(/)")
End Subroutine Set_Atom_Equiv_List
End SubModule Generating_Atoms_inCell
\ No newline at end of file
Src08/CFML_Atoms/Write_AtmList.f90
View file @ c995e253
......@@ -2,8 +2,81 @@
!!----
!!----
SubModule (CFML_Atoms) Write_Atoms
implicit none
Contains
implicit none
Contains
!!----
!!---- Pure Module Function Function Equiv_Atm(Nam1,Nam2,NameAt) Result(Equiv_Atom)
!!---- character (len=*), intent (in) :: nam1 ! In -> Atom Nam1
!!---- character (len=*), intent (in) :: nam2 ! In -> Atom Nam2
!!---- character (len=*), intent (in) :: NameAt ! In -> String containing atom names
!!---- logical :: equiv_atom ! Result .true. or .false.
!!----
!!---- Determine whether the atoms of names "nam1" and "nam2" are included in
!!---- the longer string "name" (constructed by function "wrt_lab").
!!----
!!---- Update: February - 2005
!!
Pure Module Function Equiv_Atm(Nam1,Nam2,NameAt) Result(Equiv_Atom)
!---- Arguments ----!
character (len=*), intent (in) :: nam1,nam2
character (len=*), intent (in) :: NameAt
logical :: equiv_atom
!---- Local variables ----!
integer :: i1,i2
equiv_atom = .false.
i1=index(nam1,"_")-1
i2=index(nam2,"_")-1
if (i1 < 0 .or. i2 < 0 ) return
if (nam1(1:i1) == nameat(1:i1) .and. nam2(1:i2) == nameat(5:4+i2) ) then
equiv_atom = .true.
else if(nam1(1:i1) == nameat(5:4+i1) .and. nam2(1:i2) == nameat(1:i2) ) then
equiv_atom = .true.
end if
End Function Equiv_Atm
!!----
!!---- Pure Module Function Wrt_Lab(Nam1,Nam2) Result(Bilabel)
!!---- character (len=*), intent (in) :: nam1 ! In -> Atom name 1
!!---- character (len=*), intent (in) :: nam2 ! In -> Atom name 2
!!---- character (len=8) :: bilabel ! Result -> Composed string with underscores
!!----
!!---- Character function merging the main part of the labels
!!---- (before underscore "_") of the atoms "nam1" and "nam2" into
!!---- the string "bilabel"
!!----
!!---- Update: February - 2005
!!
Pure Module Function Wrt_Lab(Nam1,Nam2) Result(Bilabel)
!---- Arguments ----!
character (len=*), intent (in) :: nam1,nam2
character (len=8) :: bilabel
!---- Local variables ----!
integer :: i1,i2
bilabel=" "
i1=index(nam1,"_")-1
i2=index(nam2,"_")-1
if (i1 < 0 ) then
bilabel(1:4) = nam1(1:4)
else
bilabel(1:i1) = nam1(1:i1)
end if
if (i2 < 0 ) then
bilabel(5:8) = nam2(1:4)
else
bilabel(5:4+i2) = nam2(1:i2)
end if
End Function Wrt_Lab
!!----
!!---- WRITE_ATOM_LIST
!!---- Write the atoms in the asymmetric unit
......
Src08/CFML_IOForm.f90
View file @ c995e253
......@@ -46,7 +46,7 @@ Module CFML_IOForm
string_numstd, Number_Lines, Reading_Lines, FindFMT, &
Init_FindFMT, String_Array_Type, File_type
Use CFML_Atoms, only: Atm_Type, Atm_Std_Type, Matm_std_type, Atm_Ref_Type, &
AtList_Type, Allocate_Atom_List
AtList_Type, Allocate_Atom_List, Init_Atom_Type
Use CFML_Metrics, only: Cell_Type, Cell_G_Type, Set_Crystal_Cell, U_equiv, &
get_U_from_Betas, get_Betas_from_U, get_Betas_from_B
Use CFML_gSpaceGroups, only: SpG_Type, SuperSpaceGroup_Type, Kvect_Info_Type, &
......@@ -65,7 +65,7 @@ Module CFML_IOForm
!---- Public subroutines ----!
public :: Readn_Set_Xtal_Structure, Read_CFL_Cell, Read_CFL_SpG, Read_CFL_Atoms, &
Read_Kinfo, Check_Symmetry_Constraints
Read_Kinfo, Check_Symmetry_Constraints, Write_Cif_Template
real(kind=cp), parameter :: EPSV=0.0001_cp ! Small real value to be used for decisions
!---- Definitions ----!
......@@ -424,6 +424,16 @@ Module CFML_IOForm
! type(atlist_type), intent(in) :: at_List
!End Subroutine Write_Shx_Template
Module Subroutine Write_Cif_Template(filename, Cell, SpG, At_list, Type_data, Code)
!---- Arguments ----!
character(len=*), intent(in) :: filename ! Filename
class(Cell_G_Type), intent(in) :: Cell ! Cell parameters
class(SpG_Type), intent(in) :: SpG ! Space group information
Type (AtList_Type), intent(in) :: At_List ! Atoms
integer, intent(in) :: Type_data ! 0,2:Single crystal diffraction; 1:Powder
character(len=*), intent(in) :: Code ! Code or name of the structure
End Subroutine Write_Cif_Template
End Interface
Contains
......
Src08/CFML_IOForm/Format_CFL.f90
View file @ c995e253
......@@ -55,7 +55,7 @@ SubModule (CFML_IOForm) IOF_CFL
ip(ndata)=i
end if
end do
!write(*,"(a)") " => Reading Phase Information"
!---- Reading Phase Information ----!
iph=1
if (present(nphase)) iph=nphase
......@@ -65,6 +65,7 @@ SubModule (CFML_IOForm) IOF_CFL
call Get_Job_Info(file_dat,n_ini,n_end,Job_info)
end if
!write(*,"(a)") " => Reading Cell Parameters"
!---- Reading Cell Parameters ----!
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
......@@ -75,6 +76,7 @@ SubModule (CFML_IOForm) IOF_CFL
end if
if (err_CFML%Ierr /= 0) return
!write(*,"(a)") " => Reading Space Group Information"
!---- Reading Space Group Information ----!
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
......@@ -86,6 +88,7 @@ SubModule (CFML_IOForm) IOF_CFL
n_ini=ip(iph) !Updated values to handle non-conventional order
n_end=ip(iph+1)
!write(*,"(a)") " => Calculating number of Atoms in the Phase"
!---- Calculating number of Atoms in the Phase ----!
do i=n_ini,n_end
line=adjustl(file_dat(i))
......@@ -93,6 +96,7 @@ SubModule (CFML_IOForm) IOF_CFL
end do
if (nauas > 0) then
!write(*,"(a)") " => Reading Atoms"
call Read_CFL_Atoms(file_dat,n_ini,n_end,A,Type_Atm,SpG%D-1)
if (err_CFML%Ierr /= 0) return
if(allocated(vet)) deallocate(vet)
......@@ -345,7 +349,7 @@ SubModule (CFML_IOForm) IOF_CFL
call Cut_String(line,nlong1,label)
if((U_case(label(1:1)) == "M" .or. U_case(label(1:1)) == "J" ) & !Magnetic atom
.and. index(digpm(1:10),label(4:4)) /= 0) then
.and. index(digpm(1:10),label(4:4)) /= 0 .and. index(label,"+") == 0) then
atom%ChemSymb=U_case(label(2:2))//L_case(label(3:3))
atom%Magnetic=.true.
else
......
Src08/CFML_Maths.f90
View file @ c995e253
......@@ -55,7 +55,7 @@
Gcd, Get_EPS_Math, Get_Cart_from_Cylin, Get_Cart_from_Spher, &
Get_Cylin_from_Cart, Get_Cylin_from_Spher, Get_Spher_from_Cart, &
Get_Spher_from_Cylin, &
Inverse_Matrix, In_Limits, Is_Diagonal_Matrix, Is_Null_Vector, &
Inverse_Matrix, In_Limits, Is_Diagonal_Matrix, Is_Null_Vector, &
Integral_Slater_Bessel, &
Lcm, Linear_Dependent, Linear_Interpol, Locate, Lower_Triangular, &
Mat_Cross, Modulo_Lat, &
......
Src08/CFML_Maths/Determinant.f90
View file @ c995e253
......@@ -247,7 +247,7 @@ Submodule (CFML_Maths) Determinant
real(kind=cp), dimension(3,3), intent(in) :: A !! Matrix
real(kind=cp) :: Det !! Determinant
!> Calculate the inverse determinant of the matrix
!> Calculate the determinant of the matrix
det = A(1,1)*A(2,2)*A(3,3) - A(1,1)*A(2,3)*A(3,2) &
- A(1,2)*A(2,1)*A(3,3) + A(1,2)*A(2,3)*A(3,1) &
+ A(1,3)*A(2,1)*A(3,2) - A(1,3)*A(2,2)*A(3,1)
......@@ -266,7 +266,7 @@ Submodule (CFML_Maths) Determinant
complex(kind=cp), dimension(4,4), intent(in) :: A !! Matrix
complex(kind=cp) :: Det !! Determinant
!> Calculate the inverse determinant of the matrix
!> Calculate the determinant of the matrix
det = A(1,1)*(A(2,2)*(A(3,3)*A(4,4)-A(3,4)*A(4,3))+A(2,3)*(A(3,4)*A(4,2)-A(3,2)*A(4,4))+ &
A(2,4)*(A(3,2)*A(4,3)-A(3,3)*A(4,2))) &
- A(1,2)*(A(2,1)*(A(3,3)*A(4,4)-A(3,4)*A(4,3))+A(2,3)*(A(3,4)*A(4,1)-A(3,1)*A(4,4))+ &
......@@ -290,7 +290,7 @@ Submodule (CFML_Maths) Determinant
integer, dimension(4,4), intent(in) :: A !! Matrix
integer :: Det !! Determinant
!> Calculate the inverse determinant of the matrix
!> Calculate the determinant of the matrix
det = A(1,1)*(A(2,2)*(A(3,3)*A(4,4)-A(3,4)*A(4,3))+A(2,3)*(A(3,4)*A(4,2)-A(3,2)*A(4,4))+ &
A(2,4)*(A(3,2)*A(4,3)-A(3,3)*A(4,2))) &
- A(1,2)*(A(2,1)*(A(3,3)*A(4,4)-A(3,4)*A(4,3))+A(2,3)*(A(3,4)*A(4,1)-A(3,1)*A(4,4))+ &
......@@ -314,7 +314,7 @@ Submodule (CFML_Maths) Determinant
real(kind=cp), dimension(4,4), intent(in) :: A !! Matrix
real(kind=cp) :: Det !! Determinant
!> Calculate the inverse determinant of the matrix
!> Calculate the determinant of the matrix
det = A(1,1)*(A(2,2)*(A(3,3)*A(4,4)-A(3,4)*A(4,3))+A(2,3)*(A(3,4)*A(4,2)-A(3,2)*A(4,4))+ &
A(2,4)*(A(3,2)*A(4,3)-A(3,3)*A(4,2))) &
- A(1,2)*(A(2,1)*(A(3,3)*A(4,4)-A(3,4)*A(4,3))+A(2,3)*(A(3,4)*A(4,1)-A(3,1)*A(4,4))+ &
......
Src08/CFML_gSpaceGroups.f90
View file @ c995e253
......@@ -46,11 +46,11 @@
!!
Module CFML_gSpaceGroups
!---- Use Modules ----!
Use CFML_GlobalDeps, only: CP,DP, LI, EPS, err_cfml, clear_error, CFML_Debug,TPI
Use CFML_Rational
Use CFML_Symmetry_Tables
Use CFML_Magnetic_Database
Use CFML_SuperSpace_Database
Use CFML_GlobalDeps, only: CP,DP, LI, EPS, err_cfml, clear_error, CFML_Debug,TPI
Use CFML_Maths, only: Set_eps_math, modulo_lat, determ3D, Get_eps_math, Zbelong,EPSS,Diagonalize_RGEN, &
equal_vector,resolv_sist_3x3,trace
Use CFML_Strings, only: u_case, l_case, pack_string, get_separator_pos, get_num, &
......@@ -79,7 +79,7 @@ Module CFML_gSpaceGroups
Identify_Group, Init_SpaceGroup, Is_OP_Inversion_Centre, &
Set_Conditions_NumOP_EPS, Set_SpaceGroup,Is_OP_Lattice_Centring, &
Write_SpaceGroup_Info, Get_Multip_Pos, Is_Lattice_Vec,Is_OP_Anti_Lattice, &
Get_SubGroups_full
Get_SubGroups_full, SearchOp, Write_SymTrans_Code, Read_SymTrans_Code
!---- Types ----!
......@@ -137,11 +137,14 @@ Module CFML_gSpaceGroups
type(rational),dimension(:,:), allocatable :: aLat_tr ! Anti-translations
End Type SPG_Type
Type, public, extends(Spg_Type):: SuperSpaceGroup_Type
Type, public, extends(Spg_Type):: Spg_Oreal_Type
real(kind=cp), allocatable,dimension(:,:,:):: Om ! Operator matrices (3+d+1,3+d+1,Multip) in real form to accelerate calculations
End Type Spg_Oreal_Type
Type, public, extends(Spg_Oreal_Type) :: SuperSpaceGroup_Type
integer :: nk=0 ! (nk=1,2,3, ...) number of k-vectors
integer :: nq=0 ! number of effective set of Q_coeff >= nk
real, allocatable,dimension(:,:) :: kv ! k-vectors (3,nk)
real(kind=cp), allocatable,dimension(:,:,:):: Om ! Operator matrices (3+d+1,3+d+1,Multip) in real form to accelerate calculations
real(kind=cp), allocatable,dimension(:) :: sintlim ! sintheta/lambda limits (nk)
integer, allocatable,dimension(:) :: nharm ! number of harmonics along each k-vector
integer, allocatable,dimension(:,:) :: q_coeff ! Q_coeff(nk,nq)
......@@ -224,6 +227,7 @@ Module CFML_gSpaceGroups
Interface Is_Lattice_Vec
module procedure Is_Lattice_Vec_rat
module procedure Is_Lattice_Vec_real
module procedure Is_Vec_Lattice_Centring
End Interface Is_Lattice_Vec
Interface Set_SpaceGroup
......@@ -468,14 +472,16 @@ Module CFML_gSpaceGroups
integer, dimension(:,:), allocatable, optional, intent(out) :: table
End Subroutine Get_OPS_from_Generators
Module Subroutine Get_Orbit(x,mom,Spg,Mult,orb,morb,ptr,convl)
Module Subroutine Get_Orbit(x,Spg,Mult,orb,mom,morb,ptr,convl)
!---- Arguments ----!
real(kind=cp), dimension(:), intent (in) :: x,mom
class(SpG_Type), intent (in) :: spg
integer, intent(out) :: mult
real(kind=cp),dimension(:,:), allocatable, intent(out) :: orb,morb
integer, dimension(:),allocatable, optional,intent(out) :: ptr
logical, optional,intent(in) :: convl
real(kind=cp), dimension(:), intent(in) :: x
class(SpG_Type), intent(in) :: spg
integer, intent(out) :: mult
real(kind=cp),dimension(:,:), allocatable, intent(out) :: orb
real(kind=cp), dimension(:), optional, intent(in) :: mom
real(kind=cp),dimension(:,:), allocatable, optional, intent(out) :: morb
integer, dimension(:),allocatable, optional, intent(out) :: ptr
logical, optional, intent(in) :: convl
End Subroutine Get_Orbit
Module Subroutine Get_Origin_Shift(G, G_, ng, P_, origShift, shift)
......@@ -543,6 +549,13 @@ Module CFML_gSpaceGroups
type(rational), dimension(3,3) :: S
End Function Get_S_Matrix
Module Function SearchOp(Sim,I1,I2) Result(Isl)
!---- Arguments ----!
integer , dimension(3,3), Intent(in) :: sim
integer , Intent(in) :: i1,i2
integer :: Isl
End Function SearchOp
Module Subroutine Get_Stabilizer(X, Spg,Order,Ptr,Atr)
!---- Arguments ----!
real(kind=cp), dimension(3), intent (in) :: x
......@@ -561,13 +574,14 @@ Module CFML_gSpaceGroups
logical, dimension(:,:), optional,intent(out) :: point
End Subroutine Get_SubGroups
Module Subroutine Get_SubGroups_full(SpG, SubG, nsg, indexg, point)
Module Subroutine Get_SubGroups_full(SpG, SubG, nsg, indexg, point,printd)
!---- Arguments ----!
type(Spg_Type), intent( in) :: SpG
type(Spg_Type),dimension(:), intent(out) :: SubG
integer, intent(out) :: nsg
integer, optional,intent(in) :: indexg
logical, dimension(:,:), optional,intent(out) :: point
logical, optional,intent(in) :: printd
End Subroutine Get_SubGroups_full
Module Function Get_Symb_from_Mat_Tr(Mat, tr, oposite) Result(Str)
......@@ -739,6 +753,14 @@ Module CFML_gSpaceGroups
logical :: Lattice
End Function is_Lattice_vec_real
Pure Module Function Is_Vec_Lattice_Centring(vec,SpG,Prim) Result(Info)
!---- Arguments ----!
real(kind=cp), dimension(:), intent(in) :: Vec
Class(SpG_Type), optional, intent(in) :: SpG
logical, optional, intent(in) :: Prim
logical :: info
End Function Is_Vec_Lattice_Centring
Module Function Is_OP_Minus_1_Prime(Op) Result(Info)
!---- Arguments ----!
type(Symm_Oper_Type),intent(in) :: Op
......@@ -770,6 +792,20 @@ Module CFML_gSpaceGroups
logical :: positive
End Function Positive_SenseRot
Pure Module Function Write_SymTrans_Code(N,Tr) Result(Code)
!---- Arguments ----!
integer, intent(in) :: N
real(kind=cp),dimension(3), intent(in) :: Tr
character (len=:), allocatable :: Code
End Function Write_SymTrans_Code
Module Subroutine Read_SymTrans_Code(Code,N,Tr)
!---- Arguments ----!
character (len=*), intent( in) :: Code
integer, intent(out) :: N
real(kind=cp),dimension(3), intent(out) :: Tr
End Subroutine Read_SymTrans_Code