File: genhvec.f90

package info (click to toggle)
elkcode 5.4.24-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 12,840 kB
  • sloc: f90: 48,415; fortran: 22,457; perl: 965; makefile: 384; sh: 369; python: 105; ansic: 67
file content (134 lines) | stat: -rw-r--r-- 3,153 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

! Copyright (C) 2010 Alexey I. Baranov.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

subroutine genhvec
use modmain
use modpw
implicit none
! local variables
logical lsym(48)
integer ih,jh,kh,lh,k
integer i1,i2,i3,iv(3)
integer nsym,isym,sym(3,3,48)
real(8) v1(3),v2(3),v3(3)
! allocatable arrays
integer, allocatable :: idx(:),ivh0(:,:)
real(8), allocatable :: vhc0(:,:),hc0(:)
! find the H-vector grid sizes
call gridsize(avec,hmaxvr,ngridh,nhtot,inthv)
! allocate global H-vector arrays
if (allocated(ivh)) deallocate(ivh)
allocate(ivh(3,nhtot))
if (allocated(mulh)) deallocate(mulh)
allocate(mulh(nhtot))
if (allocated(vhc)) deallocate(vhc)
allocate(vhc(3,nhtot))
if (allocated(hc)) deallocate(hc)
allocate(hc(nhtot))
! allocate local arrays
allocate(idx(nhtot),ivh0(3,nhtot))
allocate(vhc0(3,nhtot),hc0(nhtot))
ih=0
do i1=inthv(1,1),inthv(2,1)
  v1(:)=dble(i1)*bvec(:,1)
  do i2=inthv(1,2),inthv(2,2)
    v2(:)=v1(:)+dble(i2)*bvec(:,2)
    do i3=inthv(1,3),inthv(2,3)
      v3(:)=v2(:)+dble(i3)*bvec(:,3)
      ih=ih+1
! map from H-vector to (i1,i2,i3) index
      ivh0(1,ih)=i1
      ivh0(2,ih)=i2
      ivh0(3,ih)=i3
! H-vector in Cartesian coordinates
      vhc0(:,ih)=v3(:)
! length of each H-vector
      hc0(ih)=sqrt(v3(1)**2+v3(2)**2+v3(3)**2)
    end do
  end do
end do
! sort by vector length
call sortidx(nhtot,hc0,idx)
! reorder arrays
do ih=1,nhtot
  jh=idx(ih)
  ivh(:,ih)=ivh0(:,jh)
  hc(ih)=hc0(jh)
  vhc(:,ih)=vhc0(:,jh)
end do
! find the number of vectors with H < hmaxvr
nhvec=1
do ih=nhtot,1,-1
  if (hc(ih).lt.hmaxvr) then
    nhvec=ih
    exit
  end if
end do
! find the subgroup of symmorphic, non-magnetic symmetries
lsym(:)=.false.
do isym=1,nsymcrys
  if (tv0symc(isym).and.(lspnsymc(isym).eq.1)) lsym(lsplsymc(isym))=.true.
end do
nsym=0
do isym=1,nsymlat
  if (lsym(isym)) then
    nsym=nsym+1
    sym(:,:,nsym)=symlat(:,:,isym)
  end if
end do
if (reduceh) then
! find the subgroup of symmorphic, non-magnetic symmetries
  lsym(:)=.false.
  do isym=1,nsymcrys
    if (tv0symc(isym).and.(lspnsymc(isym).eq.1)) lsym(lsplsymc(isym))=.true.
  end do
  nsym=0
  do isym=1,nsymlat
    if (lsym(isym)) then
      nsym=nsym+1
      sym(:,:,nsym)=symlat(:,:,isym)
    end if
  end do
else
! use only the identity element if no reduction is required
  nsym=1
end if
! reduce the H-vector set with the symmetries if required
if (nsym.gt.1) then
  ivh0(:,1:nhvec)=ivh(:,1:nhvec)
  hc0(1:nhvec)=hc(1:nhvec)
  vhc0(:,1:nhvec)=vhc(:,1:nhvec)
  kh=0
  lh=nhvec
  do ih=1,nhvec
    do isym=1,nsym
      call i3mtv(sym(:,:,isym),ivh0(:,ih),iv(:))
      do jh=1,kh
        k=abs(ivh(1,jh)-iv(1))+abs(ivh(2,jh)-iv(2))+abs(ivh(3,jh)-iv(3))
        if (k.eq.0) then
          ivh(:,lh)=ivh0(:,ih)
          hc(lh)=hc0(ih)
          vhc(:,lh)=vhc0(:,ih)
          lh=lh-1
          mulh(jh)=mulh(jh)+1
          goto 10
        end if
      end do
    end do
    kh=kh+1
    ivh(:,kh)=ivh0(:,ih)
    hc(kh)=hc0(ih)
    vhc(:,kh)=vhc0(:,ih)
    mulh(kh)=1
10 continue
  end do
  nhvec=kh
else
  mulh(:)=1
end if
deallocate(idx,ivh0,vhc0,hc0)
return
end subroutine