LCOV - code coverage report
Current view: top level - wannier - wann_mmk0_sph.f (source / functions) Coverage Total Hit
Test: FLEUR test coverage Lines: 68.2 % 66 45
Test Date: 2025-06-14 04:34:23 Functions: 100.0 % 1 1

            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           80 :      +          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 2.0-1