LCOV - code coverage report
Current view: top level - wannier - wann_1dvacabcof.F (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 64 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : c********************************************************
       2             : c     calculate a-, and b-coefficients of 1d-vacuum
       3             : c     Y. Mokrousov from Frank's routine, January 2007
       4             : c********************************************************
       5             :       module m_wann_1dvacabcof
       6             :       contains
       7           0 :       subroutine wann_1dvacabcof(
       8             :      >    DIMENSION,oneD,vacuum,stars,cell,
       9           0 :      >    nv2d,nslibd,nmzd,nmz,omtil,vz,
      10             :      >    nv,bkpt,z1,odi,ods,
      11           0 :      >    nvd,k1,k2,k3,evac,
      12             :      >    bbmat,delz,bmat,nbasfcn,neigd,zMat,
      13           0 :      >    n2d,n3d,ig,nmzxy,nmzxyd,ig2,sk2,
      14           0 :      >    phi2,k1d,k2d,k3d,
      15           0 :      <    ac,bc,u,ue,addnoco,l_ss,qss,jspin)
      16             : 
      17             :       use m_types
      18             :       use m_od_abvac
      19             :       use m_constants
      20             :       use m_cylbes
      21             :       use m_dcylbs
      22             :       implicit none
      23             : 
      24             :       TYPE(t_dimension),INTENT(IN)   :: DIMENSION
      25             :       TYPE(t_oneD),INTENT(IN)        :: oneD
      26             :       TYPE(t_vacuum),INTENT(IN)      :: vacuum
      27             :       TYPE(t_stars),INTENT(IN)       :: stars
      28             :       TYPE(t_cell),INTENT(IN)        :: cell
      29             :       TYPE(t_mat),INTENT(IN)         :: zMat
      30             : 
      31             :       integer,intent(in)::nv2d,n2d,n3d
      32             :       integer,intent(in)::nslibd
      33             :       integer,intent(in)::k1d,k2d,k3d
      34             :       integer,intent(in)::nmzd,nmzxyd
      35             :       integer,intent(in)::nmz,nmzxy
      36             :       integer,intent(in)::nbasfcn,neigd
      37             :       real,intent(in)::omtil
      38             :       real,intent(in)::vz(nmzd,2)
      39             :       real,intent(in)::evac(2)
      40             :       real,intent(in)::bbmat(3,3)
      41             :       real,intent(in)::delz
      42             :       real,intent(in)::bmat(3,3)
      43             :       real,intent(in)::z1
      44             :       integer,intent(in)::nv
      45             :       integer,intent(in)::nvd
      46             :       integer,intent(in)::k1(nvd)
      47             :       integer,intent(in)::k2(nvd)
      48             :       integer,intent(in)::k3(nvd)
      49             :       integer,intent(in)::ig(-k1d:k1d,-k2d:k2d,-k3d:k3d),ig2(n3d)
      50             :       integer,intent(in)::addnoco,jspin
      51             :       real,intent(in) :: sk2(n2d),phi2(n2d)
      52             :       real,intent(in)::bkpt(3),qss(3)
      53             :       logical,intent(in)::l_ss
      54             : 
      55             :       type (od_inp), intent (in) :: odi
      56             :       type (od_sym), intent (in) :: ods
      57             : 
      58             :       complex,intent(out)::ac(nv2d,-odi%mb:odi%mb,nslibd)
      59             :       complex,intent(out)::bc(nv2d,-odi%mb:odi%mb,nslibd)
      60             :       real,intent(out)::u(nmzd,nv2d,-odi%mb:odi%mb)
      61             :       real,intent(out)::ue(nmzd,nv2d,-odi%mb:odi%mb)
      62             : 
      63             :       real wronk,const,wronk_1
      64             :       complex av,bv,ic
      65           0 :       real,    allocatable :: dt(:,:),dte(:,:)
      66           0 :       real,    allocatable :: t(:,:),te(:,:),tei(:,:)
      67             :       integer n2,k,nv2,ik,n,l,ispin
      68             :       real vz0,evacp,ev,zks,arg,tpi
      69           0 :       integer kvac3(nv2d),map1(nvd),i,j,irec3,irec2,m,nvac
      70           0 :       real bess(-odi%mb:odi%mb),dbss(-odi%mb:odi%mb)
      71             :       real qssbti(3,2)
      72           0 :          ic = cmplx(0.,1.)
      73           0 :          tpi = 2.*pimach()
      74           0 :          wronk = 2.0
      75           0 :          const = 1.0 / ( sqrt(omtil)*wronk )
      76             :          allocate (dt(nv2d,-odi%mb:odi%mb),dte(nv2d,-odi%mb:odi%mb),
      77             :      &             t(nv2d,-odi%mb:odi%mb),te(nv2d,-odi%mb:odi%mb),
      78           0 :      &             tei(nv2d,-odi%mb:odi%mb))
      79             : 
      80           0 :          nvac = 1
      81           0 :          vz0 = vz(nmz,nvac)
      82             : 
      83           0 :          n2 = 0
      84           0 :          do 35 k = 1,nv
      85           0 :             do 45 j = 1,n2
      86           0 :                if (k3(k).eq.kvac3(j)) then
      87           0 :                   map1(k) = j
      88           0 :                   goto 35
      89             :                end if
      90           0 :  45         continue
      91           0 :             n2 = n2 + 1
      92           0 :             if (n2.gt.nv2d) stop 'wann_plot:vac'
      93           0 :             kvac3(n2) =  k3(k)
      94           0 :             map1(k) = n2
      95           0 :  35      continue
      96           0 :          nv2 = n2
      97             : 
      98           0 :          ac(:,:,:) = cmplx(0.,0.) ; bc (:,:,:) = cmplx(0.,0.)
      99             : 
     100           0 :          evacp = evac(1)
     101           0 :          if(l_ss) then
     102           0 :             qssbti(1,1)=-qss(1)/2.
     103           0 :             qssbti(2,1)=-qss(2)/2.
     104           0 :             qssbti(3,1)=-qss(3)/2.
     105           0 :             qssbti(1,2)=+qss(1)/2.
     106           0 :             qssbti(2,2)=+qss(2)/2.
     107           0 :             qssbti(3,2)=+qss(3)/2.
     108             :          else
     109           0 :             qssbti(:,:)=0.0
     110             :          endif
     111           0 :          ispin=1
     112             :          call od_abvac(
     113             :      >           cell,vacuum,DIMENSION,stars,oneD,
     114             :      >           qssbti(3,jspin),odi%n2d,wronk,evacp,bkpt,
     115             :      >           odi%M,odi%mb,vz(1,nvac),kvac3(1),nv2,
     116             :      >           t(1,-odi%mb),dt(1,-odi%mb),u(1,1,-odi%mb),
     117             :      <           te(1,-odi%mb),dte(1,-odi%mb),tei(1,-odi%mb),
     118           0 :      <           ue(1,1,-odi%mb))
     119             : 
     120           0 :          do k = 1,nv
     121           0 :             l = map1(k)
     122           0 :             irec3 = ig(k1(k),k2(k),k3(k))
     123           0 :             if (irec3.ne.0) then
     124           0 :                irec2 = ig2(irec3)
     125           0 :                zks = sk2(irec2)*z1
     126           0 :                arg = phi2(irec2)
     127           0 :                call cylbes(odi%mb,zks,bess)
     128           0 :                call dcylbs(odi%mb,zks,bess,dbss)
     129           0 :                do m = -odi%mb,odi%mb
     130           0 :                   wronk_1 = t(l,m)*dte(l,m) - te(l,m)*dt(l,m)
     131             :                   av = exp(-cmplx(0.0,m*arg))*(ic**m)*
     132             :      *                 cmplx(dte(l,m)*bess(m) -
     133             :      +                 te(l,m)*sk2(irec2)*dbss(m),0.0)/
     134           0 :      /                 ((wronk_1)*sqrt(omtil))
     135             :                   bv = exp(-cmplx(0.0,m*arg))*(ic**m)*
     136             :      *                 cmplx(-dt(l,m)*bess(m) +
     137             :      -                 t(l,m)*sk2(irec2)*dbss(m),0.0)/
     138           0 :      /                 ((wronk_1)*sqrt(omtil))
     139           0 :                   IF (zMat%l_real) THEN
     140           0 :                      do n = 1,nslibd
     141           0 :                         ac(l,m,n) = ac(l,m,n) + zMat%data_r(k+addnoco,n)*av
     142           0 :                         bc(l,m,n) = bc(l,m,n) + zMat%data_r(k+addnoco,n)*bv
     143             :                      end do
     144             :                   ELSE
     145           0 :                      do n = 1,nslibd
     146           0 :                         ac(l,m,n) = ac(l,m,n) + zMat%data_c(k+addnoco,n)*av
     147           0 :                         bc(l,m,n) = bc(l,m,n) + zMat%data_c(k+addnoco,n)*bv
     148             :                      end do
     149             :                   END IF
     150             :                end do      ! -mb:mb
     151             :             end if
     152             :          end do         ! k = 1,nv
     153             : 
     154           0 :          deallocate (dt,dte,t,te,tei)
     155             : 
     156           0 :       end subroutine
     157             :       end module m_wann_1dvacabcof
     158             : 
     159             : 
     160             : 

Generated by: LCOV version 1.13