LCOV - code coverage report
Current view: top level - wannier - wann_mmk0_od_vac.F (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 72 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_mmk0_od_vac
       8             :       use m_juDFT
       9             : c**************************************************************
      10             : c      Determines the overlap matrix Mmn(k) in the vacuum
      11             : c      for the wannier functions.
      12             : c      For more details see routine wannier.F 
      13             : c
      14             : c      Y. Mokrousov, F. Freimuth 
      15             : c*************************************************************** 
      16             : 
      17             :       CONTAINS
      18             : 
      19           0 :       SUBROUTINE wann_mmk0_od_vac(
      20             :      >     DIMENSION, oneD, vacuum, stars, cell,
      21             :      >     l_noco,nlotot,
      22             :      >     z1,nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n2d,n3d,
      23           0 :      >     ig,nmzxy,nmz,delz,ig2,n2d_1,
      24           0 :      >     bbmat,evac,bkpt,MM,vM,vz,odi,
      25           0 :      >     nslibd,jspin,k1,k2,k3,jspd,nvd,area,
      26           0 :      >     nbasfcn,neigd,zMat,nv,sk2,phi2,omtil,qss,
      27           0 :      <     mmn)
      28             : 
      29             :       use m_constants, only : pimach
      30             :       use m_types
      31             :       use m_od_abvac
      32             :       use m_cylbes
      33             :       use m_dcylbs
      34             :       USE m_types
      35             : 
      36             :       implicit none
      37             : 
      38             :       TYPE(t_mat), INTENT(IN) :: zMat
      39             : 
      40             :       TYPE(t_dimension),INTENT(IN)   :: DIMENSION
      41             :       TYPE(t_oneD),INTENT(IN)        :: oneD
      42             :       TYPE(t_vacuum),INTENT(IN)      :: vacuum
      43             :       TYPE(t_stars),INTENT(IN)       :: stars
      44             :       TYPE(t_cell),INTENT(IN)        :: cell
      45             : 
      46             : c     .. scalar Arguments..
      47             :       logical, intent (in) :: l_noco
      48             :       integer, intent (in) :: nlotot
      49             :       integer, intent (in) :: nmzxyd,nmzd,nv2d,k1d,k2d,k3d,n3d
      50             :       integer, intent (in) :: nmzxy,nmz,MM,n2d,vM,nslibd
      51             :       integer, intent (in) :: n2d_1,jspin,jspd,nvd
      52             :       integer, intent (in) :: nbasfcn,neigd
      53             :       real,    intent (in) :: delz,z1,evac,area,omtil
      54             :       type (od_inp), intent (in) :: odi
      55             : 
      56             : c     ..array arguments..
      57             :       real,    intent (in) :: bkpt(3),qss(3)
      58             :       real,    intent (in) :: sk2(:),phi2(:) !sk2(n2d),phi2(n2d)
      59             :       integer, intent (in) :: ig(-k1d:,-k2d:,-k3d:) !ig(-k1d:k1d,-k2d:k2d,-k3d:k3d)
      60             :       integer, intent (in) :: ig2(:),nv(:) !ig2(n3d),nv(jspd)
      61             :       real,    intent (in) :: vz(:),bbmat(3,3)!vz(nmzd),bbmat(3,3)
      62             :       integer, intent (in) :: k1(:,:),k2(:,:),k3(:,:)!k1(nvd,jspd),k2(nvd,jspd),k3(nvd,jspd)
      63             :       complex, intent (inout) :: mmn(:,:)!mmn(nslibd,nslibd)
      64             : 
      65             : c     ..basis wavefunctions in the vacuum
      66           0 :       real,    allocatable :: udz(:,:)
      67           0 :       real,    allocatable :: uz(:,:)
      68           0 :       real,    allocatable :: dudz(:,:)
      69           0 :       real,    allocatable :: duz(:,:)
      70           0 :       real,    allocatable :: u(:,:,:)
      71           0 :       real,    allocatable :: ud(:,:,:)
      72           0 :       real,    allocatable :: ddnv(:,:)
      73             : 
      74             : c     ..local scalars..
      75             :       real :: wronk,wronk1,arg,zks,tpi
      76             :       integer :: i,m,l,j,k,irec3,irec2,n,nv2,ispin,addnoco
      77             :       complex :: avac,bvac,ic
      78           0 :       complex, allocatable :: acof(:,:,:),bcof(:,:,:)
      79           0 :       integer, allocatable :: kvac3(:),map1(:)
      80           0 :       real, allocatable :: bess(:),dbss(:)
      81             :       real :: qssbti(3,2)
      82             : 
      83             : c     ..intrinsic functions..
      84             :       intrinsic aimag,cmplx,conjg,real,sqrt
      85             : 
      86             :       allocate ( udz(nv2d,-vM:vM),uz(nv2d,-vM:vM),
      87             :      +           dudz(nv2d,-vM:vM),
      88             :      +           duz(nv2d,-vM:vM),u(nmzd,nv2d,-vM:vM),
      89             :      +           ud(nmzd,nv2d,-vM:vM),
      90             :      +           ddnv(nv2d,-vM:vM),
      91             :      +           bess(-odi%mb:odi%mb),dbss(-odi%mb:odi%mb),
      92             :      +           acof(nv2d,-odi%mb:odi%mb,nslibd),
      93             :      +           bcof(nv2d,-odi%mb:odi%mb,nslibd),
      94           0 :      +           kvac3(nv2d),map1(nvd) )
      95             : 
      96           0 :       acof=cmplx(0.0,0.0)
      97           0 :       bcof=cmplx(0.0,0.0)
      98             : 
      99           0 :       tpi = 2 * pimach() ; ic = cmplx(0.,1.)
     100             : 
     101           0 :       nv2 = 0
     102             : 
     103           0 :       do 20 k = 1,nv(jspin)
     104           0 :          do 10 j = 1,nv2
     105           0 :             if (k3(k,jspin).eq.kvac3(j)) then
     106           0 :                map1(k) = j
     107           0 :                goto 20
     108             :             endif
     109           0 :  10      continuE
     110           0 :          nv2 = nv2 + 1
     111           0 :          IF (nv2>nv2d)  CALL juDFT_error("nv2d",calledby
     112           0 :      +        ="wann_mmk0_od_vac")
     113           0 :          kvac3(nv2) = k3(k,jspin)
     114           0 :          map1(k) = nv2
     115           0 :  20   continue
     116             : 
     117           0 :       wronk = 2.0
     118             : 
     119           0 :       qssbti(1,1) = - qss(1)/2.     ! noco (ss) case not
     120           0 :       qssbti(2,1) = - qss(2)/2.     ! implemented, just
     121           0 :       qssbti(1,2) = + qss(1)/2.     ! for compatibility
     122           0 :       qssbti(2,2) = + qss(2)/2.
     123           0 :       qssbti(3,1) = - qss(3)/2.
     124           0 :       qssbti(3,2) = + qss(3)/2.
     125           0 :       DO ispin = 1,1 ! jspins
     126             :       CALL od_abvac(
     127             :      >      cell,vacuum,DIMENSION,stars,oneD,
     128             :      >      qssbti(3,jspin),odi%n2d,
     129             :      >      wronk,evac,bkpt,odi%M,odi%mb,
     130             :      >      vz,kvac3(1),nv2,
     131             :      <      uz(1,-vM),duz(1,-vM),u(1,1,-vM),udz(1,-vM),
     132           0 :      <      dudz(1,-vM),ddnv(1,-vM),ud(1,1,-vM))
     133             :       ENDDO
     134             : 
     135           0 :       addnoco=0
     136           0 :       if(l_noco.and.(jspin.eq.2))then
     137           0 :          addnoco= nv(1)+nlotot
     138             :       endif
     139           0 :       do k = 1,nv(jspin)
     140           0 :          l = map1(k)
     141           0 :          irec3 = ig(k1(k,jspin),k2(k,jspin),k3(k,jspin))
     142           0 :          if (irec3.ne.0) then
     143           0 :             irec2 = ig2(irec3)
     144           0 :             zks = sk2(irec2)*z1
     145           0 :             arg = phi2(irec2)
     146           0 :             call cylbes(odi%mb,zks,bess)
     147           0 :             call dcylbs(odi%mb,zks,bess,dbss)
     148           0 :             do m = -odi%mb,odi%mb
     149             :                wronk1 = uz(l,m)*dudz(l,m) -
     150           0 :      -              udz(l,m)*duz(l,m)
     151             :                avac = exp(-cmplx(0.0,m*arg))*(ic**m)*
     152             :      *              cmplx(dudz(l,m)*bess(m) -
     153             :      +              udz(l,m)*sk2(irec2)*dbss(m),0.0)/
     154           0 :      /              ((wronk1)*sqrt(omtil))
     155             :                bvac = exp(-cmplx(0.0,m*arg))*(ic**m)*
     156             :      *              cmplx(-duz(l,m)*bess(m) +
     157             :      -              uz(l,m)*sk2(irec2)*dbss(m),0.0)/
     158           0 :      /              ((wronk1)*sqrt(omtil))
     159           0 :                IF(zMat%l_real) THEN
     160           0 :                   do n = 1,nslibd
     161             :                       acof(l,m,n) = acof(l,m,n) +
     162           0 :      +                   zMat%data_r(k+addnoco,n)*avac
     163             : c     +                    conjg(zMat%data_r(k,n))*avac
     164             :                       bcof(l,m,n) = bcof(l,m,n) +
     165           0 :      +                   zMat%data_r(k+addnoco,n)*bvac
     166             : c     +                    conjg(zMat%data_r(k,n))*bvac
     167             :                   enddo
     168             :                ELSE
     169           0 :                   do n = 1,nslibd
     170             :                       acof(l,m,n) = acof(l,m,n) +
     171           0 :      +                   zMat%data_c(k+addnoco,n)*avac
     172             : c     +                    conjg(zMat%data_c(k,n))*avac
     173             :                       bcof(l,m,n) = bcof(l,m,n) +
     174           0 :      +                   zMat%data_c(k+addnoco,n)*bvac
     175             : c     +                    conjg(zMat%data_c(k,n))*bvac
     176             :                   enddo
     177             :                END IF
     178             :             enddo      ! -mb:mb
     179             :          endif 
     180             :       enddo          ! k = 1,nv
     181             : 
     182             : c  now actually computing the Mmn matrix
     183             : 
     184           0 :       do l = 1,nv2
     185           0 :        do m = -odi%mb,odi%mb
     186           0 :          do i = 1,nslibd
     187           0 :            do j = 1,nslibd 
     188             :             mmn(i,j) = mmn(i,j) + 
     189             :      +                area*(acof(l,m,i)*conjg(acof(l,m,j))
     190           0 :      +              + ddnv(l,m)*bcof(l,m,i)*conjg(bcof(l,m,j)))  
     191             :            enddo 
     192             :          enddo
     193             :        enddo
     194             :       enddo
     195             : 
     196           0 :       deallocate ( udz,uz,dudz,duz,u,ud,ddnv,bess,dbss,acof,bcof )
     197             : 
     198           0 :       END SUBROUTINE wann_mmk0_od_vac
     199             :       END MODULE m_wann_mmk0_od_vac

Generated by: LCOV version 1.13