LCOV - code coverage report
Current view: top level - wannier - wann_mmk0_sph.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             : !--------------------------------------------------------------------------------
       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_sph
       8             : c***********************************************************************
       9             : c   computes the Mmn(K) matrix elements which are the overlaps
      10             : c   between the Bloch wavefunctions, in the spheres
      11             : c   a modification of the eparas.F routine, so go there
      12             : c   and to wannier.F for more information on variables
      13             : c                                Y.Mokrousov 15.6.06
      14             : c***********************************************************************
      15             :       CONTAINS
      16           0 :       SUBROUTINE wann_mmk0_sph(
      17           0 :      >                  llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
      18           0 :      >                  ntype,neq,nlo,llo,acof,bcof,ccof,
      19           0 :      >                  ddn,uulon,dulon,uloulopn,
      20           0 :      =                  mmn)
      21             :       implicit none
      22             : c     .. scalar arguments ..
      23             :       integer, intent (in) :: llod,nlod,natd,ntypd,lmaxd,lmd
      24             :       integer, intent (in) :: ntype,noccbd
      25             : c     .. array arguments ..
      26             :       integer, intent (in)  :: lmax(:) !(ntypd)
      27             :       integer, intent (in)  :: neq(ntypd)
      28             :       integer, intent (in)  :: nlo(ntypd),llo(nlod,ntypd)
      29             :       real,    intent (in)  :: ddn(0:lmaxd,ntypd)
      30             :       real,    intent (in)  :: uloulopn(nlod,nlod,ntypd)
      31             :       real,    intent (in)  :: uulon(nlod,ntypd),dulon(nlod,ntypd)
      32             :       complex, intent (in)  :: ccof(-llod:llod,noccbd,nlod,natd)
      33             :       complex, intent (in)  :: acof(:,0:,:) !acof(noccbd,0:lmd,natd)
      34             :       complex, intent (in)  :: bcof(:,0:,:) !bcof(noccbd,0:lmd,natd)
      35             :       complex, intent (inout) :: mmn(:,:)
      36             : c     .. local scalars ..
      37             :       integer i,j,l,lo,lop,m,natom,nn,ntyp
      38             :       integer nt1,nt2,lm,n,ll1
      39             :       complex suma,sumb
      40             : C     ..
      41             : C     .. local arrays ..
      42           0 :       complex, allocatable :: qlo(:,:,:,:,:)
      43           0 :       complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
      44             : C     ..
      45             : C     .. intrinsic functions ..
      46             :       intrinsic conjg
      47             :       allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd), 
      48             :      +          qaclo(noccbd,noccbd,nlod,ntypd),
      49           0 :      +          qbclo(noccbd,noccbd,nlod,ntypd) )
      50             : c---> performs summations of the overlaps of the wavefunctions
      51           0 :       do 140 i = 1,noccbd            
      52           0 :        do 145 j = 1,noccbd
      53           0 :          nt1 = 1
      54           0 :          do 130 n = 1,ntype
      55           0 :             nt2 = nt1 + neq(n) - 1
      56           0 :             do 120 l = 0,lmax(n)
      57           0 :                suma = cmplx(0.,0.)
      58           0 :                sumb = cmplx(0.,0.)
      59           0 :                ll1 = l* (l+1)
      60           0 :                do 110 m = -l,l
      61           0 :                   lm = ll1 + m
      62           0 :                   do natom = nt1,nt2
      63             :                     suma = suma + acof(i,lm,natom)*
      64           0 :      +                     conjg(acof(j,lm,natom))
      65             :                     sumb = sumb + bcof(i,lm,natom)*
      66           0 :      +                     conjg(bcof(j,lm,natom))
      67             :                   enddo
      68           0 :  110          continue
      69           0 :                mmn(i,j) = mmn(i,j) + (suma+sumb*ddn(l,n))
      70           0 :   120       continue
      71           0 :             nt1 = nt1 + neq(n)
      72           0 :   130    continue
      73           0 :   145  continue   ! cycle by j-band
      74           0 :   140 continue  !  cycle by i-band
      75             : c---> initialize qlo arrays
      76           0 :       qlo(:,:,:,:,:) = 0.0
      77           0 :       qaclo(:,:,:,:) = 0.0
      78           0 :       qbclo(:,:,:,:) = 0.0
      79             : c---> prepare the coefficients
      80           0 :       natom = 0
      81           0 :       do ntyp = 1,ntype
      82           0 :          do nn = 1,neq(ntyp)
      83           0 :             natom = natom + 1
      84           0 :             do lo = 1,nlo(ntyp)
      85           0 :                l = llo(lo,ntyp)
      86           0 :                ll1 = l* (l+1)
      87           0 :                do m = -l,l
      88           0 :                   lm = ll1 + m
      89           0 :                   do i = 1,noccbd
      90           0 :                    do j = 1,noccbd
      91             :                      qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) + 
      92             :      +                      bcof(i,lm,natom)*conjg(ccof(m,j,lo,natom)) +
      93           0 :      +                      ccof(m,i,lo,natom)*conjg(bcof(j,lm,natom)) 
      94             :                      qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) + 
      95             :      +                      acof(i,lm,natom)*conjg(ccof(m,j,lo,natom)) +
      96           0 :      +                      ccof(m,i,lo,natom)*conjg(acof(j,lm,natom)) 
      97             :                    enddo
      98             :                   enddo
      99             :                enddo
     100           0 :                do lop = 1,nlo(ntyp)
     101           0 :                  if (llo(lop,ntyp).eq.l) then
     102           0 :                    do m = -l,l
     103           0 :                      do i = 1,noccbd
     104           0 :                       do j = 1,noccbd
     105             :                        qlo(i,j,lop,lo,ntyp) = qlo(i,j,lop,lo,ntyp) + 
     106             :      +                        conjg(ccof(m,j,lop,natom))
     107           0 :      *                                  *ccof(m,i,lo,natom)
     108             :                       enddo
     109             :                      enddo
     110             :                    enddo
     111             :                  endif
     112             :                enddo
     113             :             enddo
     114             :          enddo
     115             :       enddo
     116             : 
     117             : c---> perform summation of the coefficients with the integrals
     118             : c---> of the radial basis functions
     119           0 :       do ntyp = 1,ntype
     120           0 :          do lo = 1,nlo(ntyp)
     121           0 :             l = llo(lo,ntyp)
     122           0 :             do i = 1,noccbd
     123           0 :              do j = 1,noccbd
     124             :                mmn(i,j)= mmn(i,j)  + 
     125             :      +                      ( qaclo(i,j,lo,ntyp)*uulon(lo,ntyp)     +
     126           0 :      +                        qbclo(i,j,lo,ntyp)*dulon(lo,ntyp)     )
     127             :              enddo
     128             :             enddo 
     129           0 :             do lop = 1,nlo(ntyp)
     130           0 :                if (llo(lop,ntyp).eq.l) then
     131           0 :                do i = 1,noccbd
     132           0 :                 do j = 1,noccbd
     133             :                  mmn(i,j) = mmn(i,j)  + 
     134           0 :      +                      qlo(i,j,lop,lo,ntyp)*uloulopn(lop,lo,ntyp)
     135             :                 enddo
     136             :                enddo
     137             :                endif
     138             :             enddo
     139             :          enddo 
     140             :       enddo 
     141           0 :       deallocate ( qlo,qaclo,qbclo )
     142             : 
     143           0 :       END SUBROUTINE wann_mmk0_sph
     144             :       END MODULE m_wann_mmk0_sph

Generated by: LCOV version 1.13