Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 :
7 : module m_wann_projgen
8 : use m_juDFT
9 : contains
10 1 : subroutine wann_projgen(
11 1 : > ntype,neq,natd,zatom,l_nocosoc,wann)
12 : c*****************************************
13 : c Generate the proj-file.
14 : c Frank Freimuth
15 : c*****************************************
16 :
17 : use m_types, only: t_wann
18 : USE m_constants
19 :
20 : implicit none
21 :
22 : integer, intent(in) :: ntype
23 : integer, intent(in) :: neq(ntype)
24 : integer, intent(in) :: natd
25 : real,intent(in) :: zatom(ntype)
26 : logical,intent(in) :: l_nocosoc
27 : type(t_wann), intent(in) :: wann
28 :
29 : integer :: j,nat,n,at,k,num_proj
30 : integer :: num_wann,kk
31 1 : character(len=2) :: symbol(100*ntype)
32 1 : character(len=2) :: symb(natd)
33 1 : integer :: lwf(100*ntype)
34 1 : integer :: mrwf(100*ntype)
35 1 : integer :: rwf(100*ntype)
36 1 : real :: alpha(100*ntype),beta(100*ntype)
37 1 : real :: gamma(100*ntype),zona(100*ntype)
38 1 : real :: regio(100*ntype)
39 : character*2 :: namat(0:103)
40 : integer :: projections(-5:5)
41 : integer :: projspin
42 :
43 1 : call timestart("wann_projgen")
44 :
45 : DATA namat/'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',
46 : + 'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',
47 : + ' V','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se',
48 : + 'Br','Kr','Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd',
49 : + 'Ag','Cd','In','Sn','Sb','Te',' I','Xe','Cs','Ba','La','Ce',
50 : + 'Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb',
51 : + 'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb',
52 : + 'Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',' U','Np','Pu',
53 : + 'Am','Cm','Bk','Cf','Es','Fm','Md','No','Lw'/
54 :
55 1 : projections(:)=0
56 1 : projections(-5)=6
57 1 : projections(-4)=5
58 1 : projections(-3)=4
59 1 : projections(-2)=3
60 1 : projections(-1)=2
61 1 : projections(0)=1
62 1 : projections(1)=3
63 1 : projections(2)=5
64 1 : projections(3)=7
65 :
66 :
67 1 : nat=0
68 2 : do n=1,ntype
69 4 : do at=1,neq(n)
70 2 : nat=nat+1
71 3 : symb(nat)=namat(nint(zatom(n)))
72 : enddo
73 : enddo
74 :
75 1 : open(200,file='projgen_inp',status='old')
76 1 : j=0
77 : do
78 2 : j=j+1
79 2 : read(200,*,end=299,err=299)symbol(j),lwf(j),mrwf(j),rwf(j)
80 1 : num_proj=j
81 : enddo
82 : 299 continue
83 1 : print*,"found ",num_proj,"projections"
84 1 : write(oUnit,*)"found ",num_proj,"projections"
85 1 : close(200)
86 :
87 1 : open(300,file='proj')
88 101 : alpha=0.0
89 101 : beta=0.0
90 101 : gamma=0.0
91 101 : zona=0.0
92 101 : regio=1.0
93 1 : num_wann=0
94 3 : do j=1,nat
95 5 : do k=1,num_proj
96 2 : print*,"symbols:",symbol(k)," ",symb(j)
97 2 : write(oUnit,*)"symbols:",symbol(k)," ",symb(j)
98 2 : if(trim(adjustl(symbol(k))).eq.
99 2 : & trim(adjustl(symb(j))))then
100 2 : if(mrwf(k).ne.0)then
101 0 : num_wann=num_wann+1
102 : else
103 2 : num_wann=num_wann+projections(lwf(k))
104 : endif
105 : endif
106 : enddo
107 : enddo
108 1 : if(l_nocosoc)num_wann=num_wann*2
109 1 : print*,num_wann," wannier functions have been defined"
110 1 : if(l_nocosoc)then
111 0 : write(300,*) num_wann,
112 0 : & MAX(wann%band_max(1)-wann%band_min(1)+1,num_wann),
113 0 : & " t "
114 : else
115 1 : write(300,*) num_wann,
116 2 : & MAX(wann%band_max(1)-wann%band_min(1)+1,num_wann)
117 : endif
118 1 : if(l_nocosoc)then
119 0 : do projspin=1,-1,-2
120 0 : do j=1,nat
121 0 : do k=1,num_proj
122 0 : if(
123 : & trim(adjustl(symbol(k)))
124 : & .eq.
125 : & trim(adjustl(symb(j)))
126 0 : & )then
127 0 : if(mrwf(k).ne.0)then
128 : write (300,'(i3,1x,i2,1x,i2,1x,i2,1x,i2)')
129 0 : & j,lwf(k),mrwf(k),rwf(k),projspin
130 : write (300,'(2x,4f10.6,1x,f4.2)')
131 0 : & alpha(k),beta(k),gamma(k),
132 0 : & zona(k),regio(k)
133 : else
134 0 : do kk=1,projections(lwf(k))
135 : write (300,'(i3,1x,i2,1x,i2,1x,i2,1x,i2)')
136 0 : & j,lwf(k),kk,rwf(k),projspin
137 : write (300,'(2x,4f10.6,1x,f4.2)')
138 0 : & alpha(k),beta(k),gamma(k),
139 0 : & zona(k),regio(k)
140 : enddo
141 : endif
142 : endif
143 : enddo
144 : enddo
145 : enddo
146 : else
147 3 : do j=1,nat
148 5 : do k=1,num_proj
149 2 : if(
150 : & trim(adjustl(symbol(k)))
151 : & .eq.
152 : & trim(adjustl(symb(j)))
153 2 : & )then
154 2 : if(mrwf(k).ne.0)then
155 : write (300,'(i3,1x,i2,1x,i2,1x,i2)')
156 0 : & j,lwf(k),mrwf(k),rwf(k)
157 : write (300,'(2x,4f10.6,1x,f4.2)')
158 0 : & alpha(k),beta(k),gamma(k),
159 0 : & zona(k),regio(k)
160 : else
161 10 : do kk=1,projections(lwf(k))
162 : write (300,'(i3,1x,i2,1x,i2,1x,i2)')
163 8 : & j,lwf(k),kk,rwf(k)
164 : write (300,'(3x,4f10.6,1x,f4.2)')
165 8 : & alpha(k),beta(k),gamma(k),
166 18 : & zona(k),regio(k)
167 : enddo
168 : endif
169 : endif
170 : enddo
171 : enddo
172 : endif
173 1 : close(300)
174 :
175 1 : call timestop("wann_projgen")
176 1 : end subroutine wann_projgen
177 : end module m_wann_projgen
|