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_2dvacabcof
8 : use m_juDFT
9 : c********************************************************
10 : c calculate a-, and b-coefficients of 2d-vacuum
11 : c Frank Freimuth, November 2006
12 : c********************************************************
13 : CONTAINS
14 0 : SUBROUTINE wann_2dvacabcof(
15 0 : >nv2d,nslibd,nvac,nmzd,nmz,omtil,vz,nv,bkpt,z1,
16 0 : >nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,zMat,
17 0 : <ac,bc,u,ue,addnoco,l_ss,qss,jspin)
18 :
19 : USE m_types
20 : USE m_vacuz
21 : USE m_vacudz
22 :
23 : implicit none
24 :
25 : TYPE(t_mat),INTENT(IN) :: zMat
26 :
27 : logical,intent(in)::l_ss
28 : integer,intent(in)::nv2d,jspin,addnoco
29 : integer,intent(in)::nslibd
30 : integer,intent(in)::nvac
31 : integer,intent(in)::nmzd
32 : integer,intent(in)::nmz
33 : integer,intent(in)::nbasfcn,neigd
34 : real,intent(in)::omtil
35 : real,intent(in)::vz(nmzd,2)
36 : real,intent(in)::evac(2)
37 : real,intent(in)::bbmat(3,3)
38 : real,intent(in)::delz
39 : real,intent(in)::bmat(3,3)
40 : real,intent(in)::z1
41 : integer,intent(in)::nv
42 : integer,intent(in)::nvd
43 : integer,intent(in)::k1(nvd)
44 : integer,intent(in)::k2(nvd)
45 : integer,intent(in)::k3(nvd)
46 : real,intent(in)::bkpt(3),qss(3)
47 : complex,intent(out)::ac(nv2d,nslibd,2)
48 : complex,intent(out)::bc(nv2d,nslibd,2)
49 : real,intent(out)::u(nmzd,nv2d,nvac)
50 : real,intent(out)::ue(nmzd,nv2d,nvac)
51 :
52 : real wronk,const
53 : complex c_1,av,bv
54 0 : real, allocatable :: dt(:),dte(:)
55 0 : real, allocatable :: t(:),te(:),tei(:)
56 : integer ivac,n2,k,nv2,ik,jvac,symvac,symvacvac,n,l
57 : real vz0(2),evacp,sign,v(3),ev,scale,zks,arg
58 0 : integer kvac1(nv2d),kvac2(nv2d),map2(nvd),i,j
59 : real :: qss1,qss2
60 :
61 0 : call timestart("wann_2dvacabcof")
62 :
63 0 : wronk = 2.0
64 0 : const = 1.0 / ( sqrt(omtil)*wronk )
65 0 : allocate (dt(nv2d),dte(nv2d),t(nv2d),te(nv2d),tei(nv2d))
66 :
67 0 : do ivac = 1,2
68 0 : vz0(ivac) = vz(nmz,ivac)
69 : enddo
70 :
71 :
72 0 : n2 = 0
73 :
74 0 : do 40 k = 1,nv
75 0 : do 30 j = 1,n2
76 0 : if ( k1(k).eq.kvac1(j) .and.
77 : + k2(k).eq.kvac2(j) ) then
78 0 : map2(k) = j
79 0 : goto 40
80 : endif
81 0 : 30 continue
82 0 : n2 = n2 + 1
83 0 : IF (n2>nv2d) CALL juDFT_error("wann_plot: vac",calledby
84 0 : + ="wann_2dvacabcof")
85 0 : kvac1(n2) = k1(k)
86 0 : kvac2(n2) = k2(k)
87 0 : map2(k) = n2
88 0 : 40 continue
89 0 : nv2=n2
90 :
91 0 : qss1=0.0
92 0 : qss2=0.0
93 0 : if(l_ss.and.jspin.eq.1)then
94 0 : qss1=-qss(1)/2.0
95 0 : qss2=-qss(2)/2.0
96 0 : elseif(l_ss.and.jspin.eq.2)then
97 0 : qss1=qss(1)/2.0
98 0 : qss2=qss(2)/2.0
99 : endif
100 :
101 0 : do ivac=1,nvac
102 0 : evacp=evac(ivac)
103 0 : sign=3-2*ivac
104 0 : do ik = 1,nv2
105 0 : v(1) = bkpt(1) + kvac1(ik)+qss1
106 0 : v(2) = bkpt(2) + kvac2(ik)+qss2
107 0 : v(3) = 0.
108 0 : ev = evacp - 0.5*dot_product(matmul(v,bbmat),v)
109 : call vacuz(ev,vz(1,ivac),vz0(ivac),nmz,delz,t(ik),
110 : + dt(ik),
111 0 : + u(1,ik,ivac))
112 : call vacudz(ev,vz(1,ivac),vz0(ivac),nmz,delz,te(ik),
113 : + dte(ik),tei(ik),ue(1,ik,ivac),dt(ik),
114 0 : + u(1,ik,ivac))
115 : scale = wronk/ (te(ik)*dt(ik)-
116 0 : - dte(ik)*t(ik))
117 0 : te(ik) = scale*te(ik)
118 0 : dte(ik) = scale*dte(ik)
119 0 : tei(ik) = scale*tei(ik)
120 0 : do j = 1,nmz
121 0 : ue(j,ik,ivac) = scale*ue(j,ik,ivac)
122 : enddo
123 : enddo
124 :
125 : c do l=1,nv2
126 : c do j=1,nmz
127 : c if (abs(ue(j,l,ivac)).gt.10)then
128 : c print*,"l=",l
129 : c print*,"j=",j
130 : c print*,"ue(j,l,ivac)=",ue(j,l,ivac)
131 : c endif
132 : c enddo
133 : c enddo
134 :
135 0 : jvac=ivac
136 0 : symvacvac=1
137 0 : if (nvac==1) symvacvac=2
138 0 : do symvac=1,symvacvac
139 0 : if(symvac==2) then
140 0 : sign=-1.0
141 0 : jvac=2
142 : endif
143 :
144 0 : do i = 1,nv2d
145 0 : do n = 1,nslibd
146 0 : ac(i,n,jvac) = cmplx(0.0,0.0)
147 0 : bc(i,n,jvac) = cmplx(0.0,0.0)
148 : enddo
149 : enddo
150 :
151 0 : do k = 1,nv
152 0 : l = map2(k)
153 0 : zks = k3(k)*bmat(3,3)*sign
154 0 : arg = zks*z1
155 0 : c_1 = cmplx(cos(arg),sin(arg)) * const
156 0 : av = -c_1 * cmplx( dte(l),zks*te(l) )
157 0 : bv = c_1 * cmplx( dt(l),zks* t(l) )
158 : c-----> loop over basis functions
159 0 : IF (zMat%l_real) THEN
160 0 : do n = 1,nslibd
161 : ac(l,n,jvac) = ac(l,n,jvac) +
162 0 : + zMat%data_r(k+addnoco,n)*av
163 : bc(l,n,jvac) = bc(l,n,jvac) +
164 0 : + zMat%data_r(k+addnoco,n)*bv
165 : enddo
166 : ELSE
167 0 : do n = 1,nslibd
168 : ac(l,n,jvac) = ac(l,n,jvac) +
169 0 : + zMat%data_c(k+addnoco,n)*av
170 : bc(l,n,jvac) = bc(l,n,jvac) +
171 0 : + zMat%data_c(k+addnoco,n)*bv
172 : enddo
173 : END IF
174 : enddo
175 : enddo !symvac
176 : enddo !loop over ivac
177 0 : deallocate (dt,dte,t,te,tei)
178 :
179 0 : call timestop("wann_2dvacabcof")
180 0 : END SUBROUTINE
181 : END MODULE m_wann_2dvacabcof
|
