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

          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 :          wronk = 2.0
      62           0 :          const = 1.0 / ( sqrt(omtil)*wronk )
      63           0 :          allocate (dt(nv2d),dte(nv2d),t(nv2d),te(nv2d),tei(nv2d))
      64             : 
      65           0 :          do ivac = 1,2
      66           0 :             vz0(ivac) = vz(nmz,ivac)
      67             :          enddo
      68             : 
      69             : 
      70           0 :          n2 = 0 
      71             : 
      72           0 :          do 40 k = 1,nv
      73           0 :             do 30 j = 1,n2
      74           0 :                if ( k1(k).eq.kvac1(j) .and.
      75             :      +          k2(k).eq.kvac2(j) ) then
      76           0 :                 map2(k) = j
      77           0 :                 goto 40
      78             :                endif 
      79           0 :  30         continue
      80           0 :             n2 = n2 + 1
      81           0 :             IF (n2>nv2d)  CALL juDFT_error("wann_plot: vac",calledby
      82           0 :      +           ="wann_2dvacabcof")
      83           0 :             kvac1(n2) = k1(k)
      84           0 :             kvac2(n2) = k2(k)
      85           0 :             map2(k) = n2
      86           0 :  40      continue
      87           0 :          nv2=n2
      88             : 
      89           0 :       qss1=0.0
      90           0 :       qss2=0.0
      91           0 :       if(l_ss.and.jspin.eq.1)then
      92           0 :         qss1=-qss(1)/2.0
      93           0 :         qss2=-qss(2)/2.0
      94           0 :       elseif(l_ss.and.jspin.eq.2)then
      95           0 :         qss1=qss(1)/2.0
      96           0 :         qss2=qss(2)/2.0
      97             :       endif
      98             : 
      99           0 :          do ivac=1,nvac  
     100           0 :             evacp=evac(ivac)
     101           0 :             sign=3-2*ivac
     102           0 :             do ik = 1,nv2
     103           0 :                v(1) = bkpt(1) + kvac1(ik)+qss1
     104           0 :                v(2) = bkpt(2) + kvac2(ik)+qss2
     105           0 :                v(3) = 0.
     106           0 :                ev = evacp - 0.5*dot_product(matmul(v,bbmat),v)
     107             :                call vacuz(ev,vz(1,ivac),vz0(ivac),nmz,delz,t(ik),
     108             :      +        dt(ik),
     109           0 :      +        u(1,ik,ivac))
     110             :                call vacudz(ev,vz(1,ivac),vz0(ivac),nmz,delz,te(ik),
     111             :      +        dte(ik),tei(ik),ue(1,ik,ivac),dt(ik),
     112           0 :      +        u(1,ik,ivac))
     113             :                scale = wronk/ (te(ik)*dt(ik)-
     114           0 :      -                dte(ik)*t(ik))
     115           0 :                te(ik) = scale*te(ik)
     116           0 :                dte(ik) = scale*dte(ik)
     117           0 :                tei(ik) = scale*tei(ik)
     118           0 :                do j = 1,nmz
     119           0 :                   ue(j,ik,ivac) = scale*ue(j,ik,ivac)
     120             :                enddo
     121             :             enddo
     122             : 
     123             : c            do l=1,nv2
     124             : c               do j=1,nmz
     125             : c                  if (abs(ue(j,l,ivac)).gt.10)then
     126             : c                     print*,"l=",l
     127             : c                     print*,"j=",j
     128             : c                     print*,"ue(j,l,ivac)=",ue(j,l,ivac)
     129             : c                  endif   
     130             : c               enddo   
     131             : c            enddo   
     132             :       
     133           0 :             jvac=ivac
     134           0 :             symvacvac=1
     135           0 :             if (nvac==1) symvacvac=2
     136           0 :             do symvac=1,symvacvac
     137           0 :                if(symvac==2) then
     138           0 :                   sign=-1.0
     139           0 :                   jvac=2
     140             :                endif   
     141             : 
     142           0 :                do i = 1,nv2d
     143           0 :                   do n = 1,nslibd
     144           0 :                      ac(i,n,jvac) = cmplx(0.0,0.0)
     145           0 :                      bc(i,n,jvac) = cmplx(0.0,0.0)
     146             :                   enddo   
     147             :                enddo   
     148             : 
     149           0 :                do k = 1,nv
     150           0 :                   l = map2(k)
     151           0 :                   zks = k3(k)*bmat(3,3)*sign
     152           0 :                   arg = zks*z1
     153           0 :                   c_1 = cmplx(cos(arg),sin(arg)) * const
     154           0 :                   av = -c_1 * cmplx( dte(l),zks*te(l) )
     155           0 :                   bv =  c_1 * cmplx(  dt(l),zks* t(l) )
     156             : c-----> loop over basis functions
     157           0 :                   IF (zMat%l_real) THEN
     158           0 :                      do n = 1,nslibd
     159             :                         ac(l,n,jvac) = ac(l,n,jvac) + 
     160           0 :      +                                 zMat%data_r(k+addnoco,n)*av
     161             :                         bc(l,n,jvac) = bc(l,n,jvac) + 
     162           0 :      +                                 zMat%data_r(k+addnoco,n)*bv
     163             :                      enddo
     164             :                   ELSE
     165           0 :                      do n = 1,nslibd
     166             :                         ac(l,n,jvac) = ac(l,n,jvac) + 
     167           0 :      +                                 zMat%data_c(k+addnoco,n)*av
     168             :                         bc(l,n,jvac) = bc(l,n,jvac) + 
     169           0 :      +                                 zMat%data_c(k+addnoco,n)*bv
     170             :                      enddo
     171             :                   END IF
     172             :                enddo
     173             :             enddo !symvac    
     174             :          enddo               !loop over ivac
     175           0 :       deallocate (dt,dte,t,te,tei)
     176           0 :       END SUBROUTINE
     177             :       END MODULE m_wann_2dvacabcof

Generated by: LCOV version 1.13