Adding Atm_SymmetryConstraints.f90 as a submodule of CFML_Atoms and changing...

Adding Atm_SymmetryConstraints.f90 as a submodule of CFML_Atoms and changing accordingly CFML_Atoms.f90
parent 7972789b
Pipeline #7398 failed with stages
in 6 minutes and 48 seconds
......@@ -56,7 +56,7 @@
!---- List of public procedures ----!
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
public :: Equiv_Atm, Wrt_Lab, Check_Symmetry_Constraints
!---- Parameters ----!
......@@ -289,6 +289,11 @@
integer, intent(in) :: d ! Number of k-vectors
End Subroutine Allocate_Atom_List
Module Subroutine Check_Symmetry_Constraints(SpG,Atm)
class(SpG_Type), intent(in) :: SpG
type(AtList_Type), intent(in out) :: Atm
End Subroutine Check_Symmetry_Constraints
Module Subroutine Read_Bin_Atom_List(filename, A, Type_Atm)
!---- Arguments ----!
character(len=*), intent(in) :: filename
......
Submodule (CFML_Atoms) Atm_Symmetry_Constraints
contains
Module Subroutine Check_Symmetry_Constraints(SpG,Atm)
class(SpG_Type), intent(in) :: SpG
type(AtList_Type), intent(in out) :: Atm
!--- Local variables ---!
integer :: i,codini
real(kind=cp), dimension(3) :: codes
real(kind=cp), dimension(6,8) :: codeT
codini=1
do i=1,Atm%natoms
if(Atm%Atom(i)%Magnetic) then
codes=1.0
call Get_moment_ctr(Atm%Atom(i)%x,Atm%Atom(i)%moment,SpG,codini,codes)
end if
end do
Select Type (SpG)
type is (SuperSpaceGroup_Type)
do i=1,Atm%natoms
Select Type(at => Atm%Atom(i))
class is (MAtm_Std_Type)
if(at%n_mc > 0) then
codeT=1.0
call Get_TFourier_ctr(at%x,at%Mcs(:,1:at%n_mc),codeT(:,1:at%n_mc),SpG,codini,"M")
end if
if(at%n_dc > 0) then
codeT=1.0
call Get_TFourier_ctr(at%x,at%Dcs(:,1:at%n_dc),codeT(:,1:at%n_dc),SpG,codini,"D")
end if
End Select
end do
End Select
Atm%symm_checked=.true.
End Subroutine Check_Symmetry_Constraints
End Submodule Atm_Symmetry_Constraints
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment