2003-01-20 05:58:50 +08:00
|
|
|
!
|
2003-01-28 20:28:11 +08:00
|
|
|
! Copyright (C) 2003 PWSCF group
|
|
|
|
|
! This file is distributed under the terms of the
|
|
|
|
|
! GNU General Public License. See the file `License'
|
|
|
|
|
! in the root directory of the present distribution,
|
|
|
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
|
|
|
!
|
|
|
|
|
!
|
2010-06-19 00:50:35 +08:00
|
|
|
SUBROUTINE find_equiv_sites (nat,nax,nsym,irt,has_equivalent, &
|
2003-01-20 05:58:50 +08:00
|
|
|
n_diff_sites,n_equiv_atoms,equiv_atoms)
|
|
|
|
|
!
|
2010-06-19 00:50:35 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
|
INTEGER :: nat, nax, nsym, na, nb, ns, n_diff_sites, irt(48,nat), &
|
2003-01-20 05:58:50 +08:00
|
|
|
equiv_atoms(nax,nat), n_equiv_atoms(nax), has_equivalent(nax)
|
|
|
|
|
!
|
|
|
|
|
n_diff_sites = 0
|
2010-06-19 00:50:35 +08:00
|
|
|
DO na = 1,nat
|
2003-01-20 05:58:50 +08:00
|
|
|
has_equivalent(na) = 0
|
2010-06-19 00:50:35 +08:00
|
|
|
ENDDO
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2010-06-19 00:50:35 +08:00
|
|
|
DO na = 1,nat
|
|
|
|
|
IF (has_equivalent(na)==0) THEN
|
2003-01-20 05:58:50 +08:00
|
|
|
n_diff_sites = n_diff_sites + 1
|
|
|
|
|
n_equiv_atoms (n_diff_sites) = 1
|
|
|
|
|
equiv_atoms(n_diff_sites,1) = na
|
|
|
|
|
!
|
2010-06-19 00:50:35 +08:00
|
|
|
DO nb = na+1,nat
|
|
|
|
|
DO ns = 1, nsym
|
|
|
|
|
IF ( irt(ns,nb) == na) THEN
|
2003-01-20 05:58:50 +08:00
|
|
|
has_equivalent(nb) = 1
|
|
|
|
|
n_equiv_atoms (n_diff_sites) = &
|
|
|
|
|
n_equiv_atoms (n_diff_sites) + 1
|
|
|
|
|
equiv_atoms(n_diff_sites, &
|
|
|
|
|
n_equiv_atoms(n_diff_sites)) = nb
|
2010-06-19 00:50:35 +08:00
|
|
|
GOTO 10
|
|
|
|
|
ENDIF
|
|
|
|
|
ENDDO
|
|
|
|
|
10 CONTINUE
|
|
|
|
|
ENDDO
|
|
|
|
|
ENDIF
|
|
|
|
|
ENDDO
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2010-06-19 00:50:35 +08:00
|
|
|
RETURN
|
|
|
|
|
END SUBROUTINE find_equiv_sites
|
