!-------------------------------------------------------------------------------- ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany ! This file is part of FLEUR and available as free software under the conditions ! of the MIT license as expressed in the LICENSE file in more detail. !-------------------------------------------------------------------------------- MODULE m_wann_2dvacabcof use m_juDFT c******************************************************** c calculate a-, and b-coefficients of 2d-vacuum c Frank Freimuth, November 2006 c******************************************************** CONTAINS SUBROUTINE wann_2dvacabcof( >nv2d,nslibd,nvac,nmzd,nmz,omtil,vz,nv,bkpt,z1, >nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,zMat, nv2d) CALL juDFT_error("wann_plot: vac",calledby + ="wann_2dvacabcof") kvac1(n2) = k1(k) kvac2(n2) = k2(k) map2(k) = n2 40 continue nv2=n2 qss1=0.0 qss2=0.0 if(l_ss.and.jspin.eq.1)then qss1=-qss(1)/2.0 qss2=-qss(2)/2.0 elseif(l_ss.and.jspin.eq.2)then qss1=qss(1)/2.0 qss2=qss(2)/2.0 endif do ivac=1,nvac evacp=evac(ivac) sign=3-2*ivac do ik = 1,nv2 v(1) = bkpt(1) + kvac1(ik)+qss1 v(2) = bkpt(2) + kvac2(ik)+qss2 v(3) = 0. ev = evacp - 0.5*dot_product(matmul(v,bbmat),v) call vacuz(ev,vz(1,ivac),vz0(ivac),nmz,delz,t(ik), + dt(ik), + u(1,ik,ivac)) call vacudz(ev,vz(1,ivac),vz0(ivac),nmz,delz,te(ik), + dte(ik),tei(ik),ue(1,ik,ivac),dt(ik), + u(1,ik,ivac)) scale = wronk/ (te(ik)*dt(ik)- - dte(ik)*t(ik)) te(ik) = scale*te(ik) dte(ik) = scale*dte(ik) tei(ik) = scale*tei(ik) do j = 1,nmz ue(j,ik,ivac) = scale*ue(j,ik,ivac) enddo enddo c do l=1,nv2 c do j=1,nmz c if (abs(ue(j,l,ivac)).gt.10)then c print*,"l=",l c print*,"j=",j c print*,"ue(j,l,ivac)=",ue(j,l,ivac) c endif c enddo c enddo jvac=ivac symvacvac=1 if (nvac==1) symvacvac=2 do symvac=1,symvacvac if(symvac==2) then sign=-1.0 jvac=2 endif do i = 1,nv2d do n = 1,nslibd ac(i,n,jvac) = cmplx(0.0,0.0) bc(i,n,jvac) = cmplx(0.0,0.0) enddo enddo do k = 1,nv l = map2(k) zks = k3(k)*bmat(3,3)*sign arg = zks*z1 c_1 = cmplx(cos(arg),sin(arg)) * const av = -c_1 * cmplx( dte(l),zks*te(l) ) bv = c_1 * cmplx( dt(l),zks* t(l) ) c-----> loop over basis functions IF (zMat%l_real) THEN do n = 1,nslibd ac(l,n,jvac) = ac(l,n,jvac) + + zMat%data_r(k+addnoco,n)*av bc(l,n,jvac) = bc(l,n,jvac) + + zMat%data_r(k+addnoco,n)*bv enddo ELSE do n = 1,nslibd ac(l,n,jvac) = ac(l,n,jvac) + + zMat%data_c(k+addnoco,n)*av bc(l,n,jvac) = bc(l,n,jvac) + + zMat%data_c(k+addnoco,n)*bv enddo END IF enddo enddo !symvac enddo !loop over ivac deallocate (dt,dte,t,te,tei) END SUBROUTINE END MODULE m_wann_2dvacabcof