Commit b785c270 authored by dalcorso's avatar dalcorso

Added the possibility to give as input coordinates the space group and the

inequivalent atomic positions in crystal coordinates. (Federico Zadra and 
A. Dal Corso)


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/[email protected] c92efa57-630b-4861-b058-cf58834340f0
parent b08e0d3a
......@@ -85,6 +85,7 @@ read_xml_fields.o \
recvec.o \
recvec_subs.o \
run_info.o \
space_group.o \
set_signal.o \
sic.o \
splinelib.o \
......
......@@ -521,6 +521,25 @@ MODULE input_parameters
! if esm_debug is .TRUE., calcualte v_hartree and v_local
! for abs(gp)<=esm_debug_gpmax (gp is integer and has tpiba unit)
INTEGER :: space_group = 0
! space group number for coordinates given in crystallographic form
!
LOGICAL :: uniqueb=.FALSE.
! if .TRUE. for monoclinic lattice choose the b unique primitive
! vectors
!
INTEGER :: origin_choice = 1
! for space groups that have more than one origin choice, choose
! the origin (can be 1 or 2)
!
LOGICAL :: rhombohedral = .TRUE.
!
! if .TRUE. for rhombohedral space groups give the coordinates
! in rhombohedral axes. If .FALSE. in hexagonal axes, that are
! converted internally in rhombohedral axes.
!
NAMELIST / system / ibrav, celldm, a, b, c, cosab, cosac, cosbc, nat, &
ntyp, nbnd, ecutwfc, ecutrho, nr1, nr2, nr3, nr1s, nr2s, &
nr3s, nr1b, nr2b, nr3b, nosym, nosym_evc, noinv, use_all_frac, &
......@@ -543,7 +562,8 @@ MODULE input_parameters
ts_vdw, ts_vdw_isolated, ts_vdw_econv_thr, &
xdm, xdm_a1, xdm_a2, &
step_pen, A_pen, sigma_pen, alpha_pen, no_t_rev, &
esm_bc, esm_efield, esm_w, esm_nfit, esm_debug, esm_debug_gpmax
esm_bc, esm_efield, esm_w, esm_nfit, esm_debug, esm_debug_gpmax, &
space_group, uniqueb, origin_choice, rhombohedral
!=----------------------------------------------------------------------------=!
! ELECTRONS Namelist Input Parameters
......@@ -1291,6 +1311,7 @@ MODULE input_parameters
INTEGER, ALLOCATABLE :: id_loc(:)
INTEGER, ALLOCATABLE :: na_inp(:)
LOGICAL :: tapos = .false.
LOGICAL :: lsg = .false.
CHARACTER(len=80) :: atomic_positions = 'crystal'
! atomic_positions = 'bohr' | 'angstrong' | 'crystal' | 'alat'
! select the units for the atomic positions being read from stdin
......@@ -1383,11 +1404,13 @@ MODULE input_parameters
!
TYPE (wannier_data) :: wan_data(nwanx,2)
! END manual
! ----------------------------------------------------------------------
LOGICAL :: xmloutput = .false.
! if .true. PW produce an xml output
CONTAINS
!
!----------------------------------------------------------------------------
......
......@@ -310,6 +310,7 @@ set_signal.o : mp.o
set_signal.o : mp_world.o
sic.o : io_global.o
sic.o : kind.o
space_group.o : kind.o
splinelib.o : kind.o
stick_base.o : io_global.o
stick_base.o : kind.o
......
......@@ -383,8 +383,12 @@ CONTAINS
sp_pos = 0
rd_pos = 0.0_DP
na_inp = 0
lsg=.FALSE.
!
IF ( matches( "CRYSTAL", input_line ) ) THEN
IF ( matches( "CRYSTAL_SG", input_line ) ) THEN
atomic_positions = 'crystal'
lsg=.TRUE.
ELSEIF ( matches( "CRYSTAL", input_line ) ) THEN
atomic_positions = 'crystal'
ELSEIF ( matches( "BOHR", input_line ) ) THEN
atomic_positions = 'bohr'
......
......@@ -261,6 +261,11 @@ MODULE read_namelists_module
esm_debug=.FALSE.
esm_debug_gpmax=0
!
space_group=0
uniqueb = .FALSE.
origin_choice = 1
rhombohedral = .TRUE.
!
RETURN
!
END SUBROUTINE
......@@ -817,6 +822,13 @@ MODULE read_namelists_module
CALL mp_bcast( esm_nfit, ionode_id, intra_image_comm )
CALL mp_bcast( esm_debug, ionode_id, intra_image_comm )
CALL mp_bcast( esm_debug_gpmax, ionode_id, intra_image_comm )
!
! ... space group information
!
CALL mp_bcast( space_group, ionode_id, intra_image_comm )
CALL mp_bcast( uniqueb, ionode_id, intra_image_comm )
CALL mp_bcast( origin_choice, ionode_id, intra_image_comm )
CALL mp_bcast( rhombohedral, ionode_id, intra_image_comm )
RETURN
!
......
......@@ -223,6 +223,7 @@ CONTAINS
CALL mp_bcast( sp_vel, ionode_id, intra_image_comm )
CALL mp_bcast( rd_vel, ionode_id, intra_image_comm )
CALL mp_bcast( tapos, ionode_id, intra_image_comm )
CALL mp_bcast( lsg, ionode_id, intra_image_comm )
!
CASE ( 'CONSTRAINTS' )
CALL mp_bcast( nconstr_inp, ionode_id, intra_image_comm )
......
This diff is collapsed.
......@@ -1389,6 +1389,49 @@ input_description -distribution {Quantum Espresso} -package PWscf -program pw.x
}
}
var space_group -type INTEGER {
default { 0 }
info { The number of the space group of the crystal, as given
in the International Tables of Crystallography A (ITA).
This allows to give in input only the inequivalent atomic
positions. The positions of all the symmetry equivalent atoms
are calculated by the code. Used only when the atomic positions
are of type crystal_sg.
}
}
var uniqueb -type LOGICAL {
default { .FALSE. }
info { Used only for monoclinic lattices. If .TRUE. the b
unique ibrav (-12 or -13) are used, and symmetry
equivalent positions are chosen assuming that the
two fold axis or the mirror normal is parallel to the
b axis. If .FALSE. it is parallel to the c axis.
}
}
var origin_choice -type INTEGER {
default { 1 }
info { Used only for space groups that in the ITA allow
the use of two different origins. origin_choice=1,
means the first origin, while origin_choice=2 is the
second origin.
}
}
var rhombohedral -type LOGICAL {
default { .TRUE. }
info { Used only for rhombohedral space groups.
When .TRUE. the coordinates of the inequivalent atoms are
given with respect to the rhombohedral axes, when .FALSE.
the coordinates of the inequivalent atoms are given with
respect to the hexagonal axes. They are converted internally
to the rhombohedral axes and ibrav=5 is used in both cases.
}
}
}
#
......@@ -2068,7 +2111,7 @@ input_description -distribution {Quantum Espresso} -package PWscf -program pw.x
card ATOMIC_POSITIONS {
flag atompos_unit -use optional {
enum { alat | bohr | angstrom | crystal }
enum { alat | bohr | angstrom | crystal | crystal_sg }
default { alat (DEPRECATED) }
info {
alat : atomic positions are in cartesian coordinates, in
......@@ -2087,6 +2130,17 @@ input_description -distribution {Quantum Espresso} -package PWscf -program pw.x
in relative coordinates of the primitive lattice
vectors as defined either in card CELL_PARAMETERS
or via the ibrav + celldm / a,b,c... variables
crystal_sg : atomic positions are in crystal coordinates, i.e.
in relative coordinates of the primitive lattice.
This option differs from the previous one because
in this case only the symmetry inequivalent atoms
are given. The variable space_group must indicate
the space group number used to find the symmetry
equivalent atoms. The other variables that control
this option are uniqueb, origin_choice, and
rhombohedral.
}
}
......
......@@ -243,7 +243,8 @@ wannier_init.o \
wannier_check.o \
wannier_clean.o \
wannier_occ.o \
wannier_enrg.o
wannier_enrg.o \
wyckoff.o
QEMODS=../../Modules/libqemod.a
......
......@@ -859,6 +859,7 @@ input.o : pwcom.o
input.o : realus.o
input.o : start_k.o
input.o : symm_base.o
input.o : wyckoff.o
input.o : xdm_dispersion.o
interpolate.o : ../../Modules/control_flags.o
interpolate.o : ../../Modules/fft_base.o
......@@ -2008,6 +2009,8 @@ write_ns.o : ldaU.o
write_ns.o : pwcom.o
write_ns.o : scf_mod.o
wsweight.o : ../../Modules/kind.o
wyckoff.o : ../../Modules/kind.o
wyckoff.o : ../../Modules/space_group.o
xdm_dispersion.o : ../../Modules/atom.o
xdm_dispersion.o : ../../Modules/cell_base.o
xdm_dispersion.o : ../../Modules/constants.o
......
MODULE wyckoff
USE kinds, ONLY : DP
USE space_group, ONLY : sym_brav, find_equivalent_tau
IMPLICIT NONE
INTEGER :: nattot
REAL(DP), ALLOCATABLE :: tautot(:,:)
INTEGER, ALLOCATABLE :: ityptot(:), extfortot(:,:)
SAVE
PRIVATE
PUBLIC sup_spacegroup, clean_spacegroup, nattot, tautot, ityptot, extfortot
CONTAINS
SUBROUTINE sup_spacegroup(tau,ityp,extfor,space_group_number,not_eq,uniqueb,&
rhombohedral,choice,ibrav)
INTEGER, INTENT(IN) :: space_group_number, choice
LOGICAL, INTENT (IN) :: uniqueb, rhombohedral
INTEGER, INTENT (INOUT) :: not_eq
INTEGER, INTENT(OUT) :: ibrav
REAL(DP), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: tau, extfor
INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(IN) :: ityp
INTEGER :: i,k,l,n,sym_n
INTEGER,DIMENSION(:),allocatable :: msym_n
character(LEN=1) :: unique
REAL(DP), DIMENSION(:,:), ALLOCATABLE :: inco
REAL(DP), DIMENSION(:,:,:), ALLOCATABLE :: outco
ALLOCATE(inco(not_eq,3))
ALLOCATE(msym_n(not_eq))
!conversione tra tau e inco
DO i=1,not_eq
inco(i,1)=tau(1,i)
inco(i,2)=tau(2,i)
inco(i,3)=tau(3,i)
END DO
!conv from uniqueb,rhombohedral,choice to unique
unique='1'
IF ((uniqueb).or.(.not.rhombohedral).or.(choice==2)) then
unique='2'
END IF
!select ibrav and number of symmetries
CALL sym_brav(space_group_number,sym_n,ibrav)
do i=1,not_eq
msym_n(i)=sym_n
end do
IF (((ibrav==12).or.(ibrav==13)).and.(unique=='2')) ibrav=-ibrav
ALLOCATE(outco(not_eq,sym_n,3))
!make symmetries, convert coordinates, esclusion
DO i=1,not_eq
CALL find_equivalent_tau(space_group_number, inco, outco,i,unique)
END DO
call ccord(outco,sym_n,not_eq,ibrav,unique)
do i=1,not_eq
call zerone(outco,sym_n,not_eq,i)
end do
call esclusion(outco,sym_n,msym_n,not_eq)
nattot=SUM(msym_n)
ALLOCATE(tautot(3,nattot))
ALLOCATE(ityptot(nattot))
ALLOCATE(extfortot(3,nattot))
!conversione tra outco e tau
l=0
DO i=1,not_eq
IF (i/=1) THEN
l=l+msym_n(i-1)
END IF
!
DO k=1,msym_n(i)
tautot(1,k+l)=outco(i,k,1)
tautot(2,k+l)=outco(i,k,2)
tautot(3,k+l)=outco(i,k,3)
ityptot(k+l) = ityp(i)
extfortot(:,k+l) = extfor(:,i)
END DO
END DO
DEALLOCATE(inco)
DEALLOCATE(outco)
DEALLOCATE(msym_n)
RETURN
END SUBROUTINE sup_spacegroup
SUBROUTINE clean_spacegroup
DEALLOCATE(tautot)
DEALLOCATE(ityptot)
DEALLOCATE(extfortot)
RETURN
END SUBROUTINE clean_spacegroup
SUBROUTINE ccord(outco,sym_n,not_eq,ibrav,unique)
IMPLICIT NONE
REAL(DP), DIMENSION(:,:,:), INTENT(INOUT) :: outco
INTEGER, INTENT(in) :: ibrav,sym_n,not_eq
CHARACTER, INTENT(in) :: unique
INTEGER :: i,k
REAL(DP) :: tmpx, tmpy, tmpz
Cambio: SELECT CASE (ibrav)
CASE (2) !fcc
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=-tmpx-tmpy+tmpz
outco(k,i,2)=tmpx+tmpy+tmpz
outco(k,i,3)=-tmpx-tmpz+tmpy
END DO
END DO
CASE (3) !bcc
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx+tmpz
outco(k,i,2)=tmpy-tmpx
outco(k,i,3)=tmpz-tmpy
END DO
END DO
CASE (5) !Only for trigonal
IF (unique=='2') THEN
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx-tmpy+tmpz
outco(k,i,2)=tmpy+tmpz
outco(k,i,3)=tmpz-tmpx
END DO
END DO
END IF
CASE (7) !Body Centred Tetragonal
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx-tmpy
outco(k,i,2)=tmpy+tmpz
outco(k,i,3)=tmpz-tmpx
END DO
END DO
CASE (9) !Base Centrata ORTHORHOMBIC C
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx+tmpy
outco(k,i,2)=tmpy-tmpx
outco(k,i,3)=tmpz
END DO
END DO
CASE (91) !Base Centrata ORTHORHOMBIC A
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx
outco(k,i,2)=tmpy+tmpz
outco(k,i,3)=tmpy-tmpz
END DO
END DO
CASE (10) !Tutte le faccie centrate ORTHORHOMBIC
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx-tmpy+tmpz
outco(k,i,2)=tmpx+tmpy-tmpz
outco(k,i,3)=-tmpx+tmpy+tmpz
END DO
END DO
CASE (11) !Corpo Centrato ORTHORHOMBIC
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx+tmpz
outco(k,i,2)=tmpy-tmpx
outco(k,i,3)=tmpz-tmpy
END DO
END DO
CASE (13) !Centrato C unique MONOCLINO
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpz=outco(k,i,3)
outco(k,i,1)=tmpx-tmpz
outco(k,i,3)=tmpz+tmpx
END DO
END DO
CASE (-13) !Centrato B unique MONOCLINO
DO k=1,not_eq
DO i=1,sym_n
tmpx=outco(k,i,1)
tmpy=outco(k,i,2)
outco(k,i,1)=tmpx-tmpy
outco(k,i,2)=tmpy+tmpx
END DO
END DO
END SELECT cambio
END SUBROUTINE ccord
!Translation in order to have 0<=x,y,z<=1
SUBROUTINE zerone(outco,sym_n, not_eq,k)
IMPLICIT NONE
REAL(DP), DIMENSION(:,:,:), INTENT(INOUT) :: outco
INTEGER, INTENT(in) :: sym_n,not_eq, k
INTEGER :: i
DO i=1, sym_n
DO
IF (outco(k,i,1)>=1.0_DP) THEN
outco(k,i,1)=outco(k,i,1)-1.0_DP
else
EXIT
END IF
END DO
DO
IF (outco(k,i,2)>=1.0_DP) THEN
outco(k,i,2)=outco(k,i,2)-1.0_DP
else
EXIT
END IF
END DO
DO
IF (outco(k,i,3)>=1.0_DP) THEN
outco(k,i,3)=outco(k,i,3)-1.0_DP
else
EXIT
END IF
END DO
DO
IF (outco(k,i,1)<0.0_DP) THEN
outco(k,i,1)=outco(k,i,1)+1.0_DP
else
EXIT
END IF
END DO
DO
IF (outco(k,i,2)<0.0_DP) THEN
outco(k,i,2)=outco(k,i,2)+1.0_DP
else
EXIT
END IF
END DO
DO
IF (outco(k,i,3)<0.0_DP) THEN
outco(k,i,3)=outco(k,i,3)+1.0_DP
else
EXIT
END IF
END DO
END DO
RETURN
END SUBROUTINE zerone
SUBROUTINE esclusion(outco,sym_n,msym_n,not_eq)
IMPLICIT NONE
REAL(DP), DIMENSION(:,:,:), INTENT(INOUT) :: outco
INTEGER, DIMENSION (:), INTENT(INOUT) :: msym_n
INTEGER, INTENT(in) :: not_eq, sym_n
INTEGER :: i,l,k,j
REAL(DP), DIMENSION(:,:,:),allocatable :: temp
LOGICAL :: bol
REAL :: eps
eps=1.D-6
ALLOCATE(temp(not_eq,sym_n,3))
DO k=1,not_eq
l=0
DO j=1,sym_n
bol=.false.
i=j+1
DO while (i<=sym_n)
IF ((abs(outco(k,j,1)-outco(k,i,1))<eps).and.&
(abs(outco(k,j,2)-outco(k,i,2))<eps).and.&
(abs(outco(k,j,3)-outco(k,i,3))<eps)) THEN
bol=.true.
END IF
i=i+1
END DO
IF (.not.bol) THEN
l=l+1
temp(k,l,1)=outco(k,j,1)
temp(k,l,2)=outco(k,j,2)
temp(k,l,3)=outco(k,j,3)
END IF
END DO
msym_n(k)=l
END DO
outco=temp
DEALLOCATE(temp)
RETURN
END SUBROUTINE esclusion
END MODULE wyckoff
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