LCOV - code coverage report
Current view: top level - wannier - wann_mmk0_sph.f (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 45 66 68.2 %
Date: 2024-03-28 04:22:06 Functions: 1 1 100.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             :       use m_juDFT
      16             :       CONTAINS
      17           8 :       SUBROUTINE wann_mmk0_sph(
      18          16 :      >                  llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
      19           8 :      >                  ntype,neq,nlo,llo,acof,bcof,ccof,
      20           8 :      >                  ddn,uulon,dulon,uloulopn,
      21           8 :      =                  mmn)
      22             :       implicit none
      23             : c     .. scalar arguments ..
      24             :       integer, intent (in) :: llod,nlod,natd,ntypd,lmaxd,lmd
      25             :       integer, intent (in) :: ntype,noccbd
      26             : c     .. array arguments ..
      27             :       integer, intent (in)  :: lmax(:) !(ntypd)
      28             :       integer, intent (in)  :: neq(ntypd)
      29             :       integer, intent (in)  :: nlo(ntypd),llo(nlod,ntypd)
      30             :       real,    intent (in)  :: ddn(0:lmaxd,ntypd)
      31             :       real,    intent (in)  :: uloulopn(nlod,nlod,ntypd)
      32             :       real,    intent (in)  :: uulon(nlod,ntypd),dulon(nlod,ntypd)
      33             :       complex, intent (in)  :: ccof(-llod:llod,noccbd,nlod,natd)
      34             :       complex, intent (in)  :: acof(:,0:,:) !acof(noccbd,0:lmd,natd)
      35             :       complex, intent (in)  :: bcof(:,0:,:) !bcof(noccbd,0:lmd,natd)
      36             :       complex, intent (inout) :: mmn(:,:)
      37             : c     .. local scalars ..
      38             :       integer i,j,l,lo,lop,m,natom,nn,ntyp
      39             :       integer nt1,nt2,lm,n,ll1
      40             :       complex suma,sumb
      41             : C     ..
      42             : C     .. local arrays ..
      43           8 :       complex, allocatable :: qlo(:,:,:,:,:)
      44           8 :       complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
      45             : C     ..
      46             : C     .. intrinsic functions ..
      47             :       intrinsic conjg
      48             : 
      49           8 :       call timestart("wann_mmk0_sph")
      50             : 
      51             :       allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd), 
      52             :      +          qaclo(noccbd,noccbd,nlod,ntypd),
      53         128 :      +          qbclo(noccbd,noccbd,nlod,ntypd) )
      54             : c---> performs summations of the overlaps of the wavefunctions
      55          72 :       do 140 i = 1,noccbd            
      56         576 :        do 145 j = 1,noccbd
      57         512 :          nt1 = 1
      58        1024 :          do 130 n = 1,ntype
      59         512 :             nt2 = nt1 + neq(n) - 1
      60        4096 :             do 120 l = 0,lmax(n)
      61        3584 :                suma = cmplx(0.,0.)
      62        3584 :                sumb = cmplx(0.,0.)
      63        3584 :                ll1 = l* (l+1)
      64       28672 :                do 110 m = -l,l
      65       25088 :                   lm = ll1 + m
      66       75264 :                   do natom = nt1,nt2
      67             :                     suma = suma + acof(i,lm,natom)*
      68       50176 :      +                     conjg(acof(j,lm,natom))
      69             :                     sumb = sumb + bcof(i,lm,natom)*
      70       75264 :      +                     conjg(bcof(j,lm,natom))
      71             :                   enddo
      72        3584 :  110          continue
      73        3584 :                mmn(i,j) = mmn(i,j) + (suma+sumb*ddn(l,n))
      74         512 :   120       continue
      75         512 :             nt1 = nt1 + neq(n)
      76         512 :   130    continue
      77          64 :   145  continue   ! cycle by j-band
      78           8 :   140 continue  !  cycle by i-band
      79             : c---> initialize qlo arrays
      80          16 :       qlo(:,:,:,:,:) = 0.0
      81          16 :       qaclo(:,:,:,:) = 0.0
      82          16 :       qbclo(:,:,:,:) = 0.0
      83             : c---> prepare the coefficients
      84           8 :       natom = 0
      85          16 :       do ntyp = 1,ntype
      86          32 :          do nn = 1,neq(ntyp)
      87          16 :             natom = natom + 1
      88          24 :             do lo = 1,nlo(ntyp)
      89           0 :                l = llo(lo,ntyp)
      90           0 :                ll1 = l* (l+1)
      91           0 :                do m = -l,l
      92           0 :                   lm = ll1 + m
      93           0 :                   do i = 1,noccbd
      94           0 :                    do j = 1,noccbd
      95             :                      qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) + 
      96             :      +                      bcof(i,lm,natom)*conjg(ccof(m,j,lo,natom)) +
      97           0 :      +                      ccof(m,i,lo,natom)*conjg(bcof(j,lm,natom)) 
      98             :                      qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) + 
      99             :      +                      acof(i,lm,natom)*conjg(ccof(m,j,lo,natom)) +
     100           0 :      +                      ccof(m,i,lo,natom)*conjg(acof(j,lm,natom)) 
     101             :                    enddo
     102             :                   enddo
     103             :                enddo
     104          16 :                do lop = 1,nlo(ntyp)
     105           0 :                  if (llo(lop,ntyp).eq.l) then
     106           0 :                    do m = -l,l
     107           0 :                      do i = 1,noccbd
     108           0 :                       do j = 1,noccbd
     109             :                        qlo(i,j,lop,lo,ntyp) = qlo(i,j,lop,lo,ntyp) + 
     110             :      +                        conjg(ccof(m,j,lop,natom))
     111           0 :      *                                  *ccof(m,i,lo,natom)
     112             :                       enddo
     113             :                      enddo
     114             :                    enddo
     115             :                  endif
     116             :                enddo
     117             :             enddo
     118             :          enddo
     119             :       enddo
     120             : 
     121             : c---> perform summation of the coefficients with the integrals
     122             : c---> of the radial basis functions
     123          16 :       do ntyp = 1,ntype
     124          16 :          do lo = 1,nlo(ntyp)
     125           0 :             l = llo(lo,ntyp)
     126           0 :             do i = 1,noccbd
     127           0 :              do j = 1,noccbd
     128             :                mmn(i,j)= mmn(i,j)  + 
     129             :      +                      ( qaclo(i,j,lo,ntyp)*uulon(lo,ntyp)     +
     130           0 :      +                        qbclo(i,j,lo,ntyp)*dulon(lo,ntyp)     )
     131             :              enddo
     132             :             enddo 
     133           8 :             do lop = 1,nlo(ntyp)
     134           0 :                if (llo(lop,ntyp).eq.l) then
     135           0 :                do i = 1,noccbd
     136           0 :                 do j = 1,noccbd
     137             :                  mmn(i,j) = mmn(i,j)  + 
     138           0 :      +                      qlo(i,j,lop,lo,ntyp)*uloulopn(lop,lo,ntyp)
     139             :                 enddo
     140             :                enddo
     141             :                endif
     142             :             enddo
     143             :          enddo 
     144             :       enddo 
     145           8 :       deallocate ( qlo,qaclo,qbclo )
     146             : 
     147           8 :       call timestop("wann_mmk0_sph")
     148           8 :       END SUBROUTINE wann_mmk0_sph
     149             :       END MODULE m_wann_mmk0_sph

Generated by: LCOV version 1.14