1
2! Copyright (C) 2018 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6subroutine symrfmt(nr,nri,np,ld,rfmt)
7use modmain
8implicit none
9! arguments
10integer, intent(in) :: nr(nspecies),nri(nspecies),np(nspecies)
11integer, intent(in) :: ld
12real(8), intent(inout) :: rfmt(ld,natmtot)
13! local variables
14integer is,ia,ja,ias,jas
15integer isym,lspl
16real(8) t0
17! automatic arrays
18logical done(natmmax)
19! allocatable arrays
20real(8), allocatable :: rfmt1(:,:),rfmt2(:)
21allocate(rfmt1(ld,natmmax),rfmt2(ld))
22t0=1.d0/dble(nsymcrys)
23do is=1,nspecies
24! make a copy of the input function
25  do ia=1,natoms(is)
26    ias=idxas(ia,is)
27    call dcopy(np(is),rfmt(:,ias),1,rfmt1(:,ia),1)
28  end do
29  done(:)=.false.
30! loop over atoms
31  do ia=1,natoms(is)
32    if (done(ia)) cycle
33    ias=idxas(ia,is)
34    rfmt(1:np(is),ias)=0.d0
35! loop over crystal symmetries
36    do isym=1,nsymcrys
37! index to spatial rotation lattice symmetry
38      lspl=lsplsymc(isym)
39! equivalent atom index (symmetry rotates atom ja into atom ia)
40      ja=ieqatom(ia,is,isym)
41! apply the rotation to the muffin-tin function
42      call rotrfmt(symlatc(:,:,lspl),nr(is),nri(is),rfmt1(:,ja),rfmt2)
43! accumulate in original function array
44      rfmt(1:np(is),ias)=rfmt(1:np(is),ias)+rfmt2(1:np(is))
45    end do
46! normalise
47    call dscal(np(is),t0,rfmt(:,ias),1)
48    done(ia)=.true.
49! rotate into equivalent atoms
50    do isym=1,nsymcrys
51      ja=ieqatom(ia,is,isym)
52      if (done(ja)) cycle
53      jas=idxas(ja,is)
54! inverse symmetry (which rotates atom ia into atom ja)
55      lspl=isymlat(lsplsymc(isym))
56! rotate symmetrised function into equivalent muffin-tin
57      call rotrfmt(symlatc(:,:,lspl),nr(is),nri(is),rfmt(:,ias),rfmt(:,jas))
58      done(ja)=.true.
59    end do
60  end do
61end do
62deallocate(rfmt1,rfmt2)
63end subroutine
64
65