LCOV - code coverage report
Current view: top level - wannier - wann_mmk0_updown_sph.f (source / functions) Coverage Total Hit
Test: FLEUR test coverage Lines: 0.0 % 97 0
Test Date: 2025-06-14 04:34:23 Functions: 0.0 % 1 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_updown_sph
       8              :          use m_judft
       9              :       CONTAINS
      10            0 :       SUBROUTINE wann_mmk0_updown_sph(
      11            0 :      >               l_noco,alph,beta,
      12            0 :      >               llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
      13            0 :      >               ntype,neq,nlo,llo,
      14            0 :      >               radial1_ff,radial1_gg,
      15            0 :      >               radial1_fg,radial1_gf,
      16            0 :      >               radial1_flo,radial1_glo,
      17            0 :      >               radial1_lof,radial1_log, 
      18            0 :      >               radial1_lolo,
      19            0 :      >               acof,bcof,ccof,
      20              :      >               ddn,uulon,dulon,uloulopn,
      21            0 :      =               mmn)
      22              : c************************************************************
      23              : c     Overlaps of the spin-down parts of the Bloch functions
      24              : c     with the spin-up parts.
      25              : c                           Frank Freimuth
      26              : c************************************************************
      27              :       use m_constants
      28              :       implicit none
      29              :       logical, intent (in)  :: l_noco
      30              :       integer, intent (in)  :: llod,nlod,natd,ntypd,lmaxd,lmd
      31              :       integer, intent (in)  :: lmax(:) !(ntypd)
      32              :       integer, intent (in)  :: ntype,noccbd
      33              :       REAL,    INTENT (IN)  :: alph(ntypd),beta(ntypd)
      34              :       integer, intent (in)  :: neq(ntypd)
      35              :       integer, intent (in)  :: nlo(ntypd),llo(nlod,ntypd)
      36              :       real,    intent (in)  :: radial1_ff(:,:,0:,0:,:)
      37              :       real,    intent (in)  :: radial1_gg(:,:,0:,0:,:)      
      38              :       real,    intent (in)  :: radial1_fg(:,:,0:,0:,:)
      39              :       real,    intent (in)  :: radial1_gf(:,:,0:,0:,:)
      40              :       real,intent(in)       :: radial1_flo(:,:,0:,:,:)
      41              :       real,intent(in)       :: radial1_glo(:,:,0:,:,:)
      42              :       real,intent(in)       :: radial1_lof(:,:,:,0:,:)
      43              :       real,intent(in)       :: radial1_log(:,:,:,0:,:)
      44              :       real,intent(in)       :: radial1_lolo(:,:,:,:,:)
      45              :       real,    intent (in)  :: ddn(0:lmaxd,ntypd,2)
      46              :       real,    intent (in)  :: uloulopn(nlod,nlod,ntypd,2)
      47              :       real,    intent (in)  :: uulon(nlod,ntypd,2),dulon(nlod,ntypd,2)
      48              :       complex, intent (in)  :: ccof(-llod:llod,noccbd,nlod,natd,2)
      49              :       complex, intent (in)  :: acof(noccbd,0:lmd,natd,2)
      50              :       complex, intent (in)  :: bcof(noccbd,0:lmd,natd,2)
      51              :       complex, intent (inout) :: mmn(noccbd,noccbd)
      52              : 
      53              :       integer           :: i,j,l,lo,lop,m,natom,nn,ntyp
      54              :       integer           :: nt1,nt2,lm,n,ll1,i1spin,i2spin
      55              :       complex           :: suma,sumb,sumc,sumd
      56              :       complex           :: suma12(2,2),sumb12(2,2)
      57              :       complex           :: sumc12(2,2),sumd12(2,2)
      58            0 :       complex, allocatable :: qlo(:,:,:,:,:)
      59            0 :       complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
      60            0 :       complex, allocatable :: qcloa(:,:,:,:),qclob(:,:,:,:)
      61              :       COMPLEX           :: ccchi(2,2)
      62              : 
      63            0 :       call timestart("wann_mmk0_updown_sph")
      64              :       allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd), 
      65              :      +          qaclo(noccbd,noccbd,nlod,ntypd),
      66              :      +          qbclo(noccbd,noccbd,nlod,ntypd),
      67              :      +          qcloa(noccbd,noccbd,nlod,ntypd),
      68            0 :      +          qclob(noccbd,noccbd,nlod,ntypd))
      69              :  
      70              : c---> performs summations of the overlaps of the wavefunctions
      71            0 :       do i = 1,noccbd            
      72            0 :        do j = 1,noccbd
      73            0 :          nt1 = 1
      74            0 :          do n = 1,ntype
      75            0 :           if(l_noco)then
      76            0 :             ccchi(1,1) = conjg( exp( ImagUnit*alph(n)/2)*cos(beta(n)/2))
      77            0 :             ccchi(1,2) = conjg(-exp( ImagUnit*alph(n)/2)*sin(beta(n)/2))
      78            0 :             ccchi(2,1) = conjg( exp(-ImagUnit*alph(n)/2)*sin(beta(n)/2))
      79            0 :             ccchi(2,2) = conjg( exp(-ImagUnit*alph(n)/2)*cos(beta(n)/2))
      80              :             endif
      81            0 :             nt2 = nt1 + neq(n) - 1
      82            0 :             do l = 0,lmax(n)
      83            0 :              if(.not.l_noco)then  
      84            0 :                suma = cmplx(0.,0.)
      85            0 :                sumb = cmplx(0.,0.)
      86            0 :                sumc = cmplx(0.,0.)
      87            0 :                sumd = cmplx(0.,0.)
      88            0 :                ll1 = l* (l+1)
      89            0 :                do m = -l,l
      90            0 :                   lm = ll1 + m
      91            0 :                   do natom = nt1,nt2
      92              :                     suma = suma + acof(i,lm,natom,1)*
      93            0 :      +                      conjg(acof(j,lm,natom,2))
      94              :                     sumb = sumb + bcof(i,lm,natom,1)*
      95            0 :      +                      conjg(bcof(j,lm,natom,2))
      96              :                     sumc = sumc + acof(i,lm,natom,1)*
      97            0 :      +                      conjg(bcof(j,lm,natom,2))
      98              :                     sumd = sumd + bcof(i,lm,natom,1)*
      99            0 :      +                      conjg(acof(j,lm,natom,2))
     100              :                   enddo !natom
     101              :                enddo !m      
     102              :                mmn(i,j) = mmn(i,j) + ( suma*radial1_ff(1,2,l,l,n)+
     103              :      +                                 sumb*radial1_gg(1,2,l,l,n)+
     104              :      +                                 sumc*radial1_fg(1,2,l,l,n)+
     105            0 :      +                                 sumd*radial1_gf(1,2,l,l,n)  )      
     106              :              else
     107            0 :                suma12 = cmplx(0.,0.)
     108            0 :                sumb12 = cmplx(0.,0.)
     109            0 :                sumc12 = cmplx(0.,0.)
     110            0 :                sumd12 = cmplx(0.,0.)
     111            0 :                ll1 = l* (l+1)
     112            0 :                do i1spin=1,2
     113            0 :                 do i2spin=1,2
     114            0 :                  do m = -l,l
     115            0 :                   lm = ll1 + m
     116            0 :                   do natom = nt1,nt2
     117              :                     suma12(i1spin,i2spin) = suma12(i1spin,i2spin) 
     118              :      +                      + acof(i,lm,natom,i1spin)*
     119            0 :      +                      conjg(acof(j,lm,natom,i2spin))
     120              :                     sumb12(i1spin,i2spin) = sumb12(i1spin,i2spin) 
     121              :      +                      + bcof(i,lm,natom,i1spin)*
     122            0 :      +                      conjg(bcof(j,lm,natom,i2spin))
     123              :                     sumc12(i1spin,i2spin) = sumc12(i1spin,i2spin) 
     124              :      +                      + acof(i,lm,natom,i1spin)*
     125            0 :      +                      conjg(bcof(j,lm,natom,i2spin))
     126              :                     sumd12(i1spin,i2spin) = sumd12(i1spin,i2spin) 
     127              :      +                      + bcof(i,lm,natom,i1spin)*
     128            0 :      +                      conjg(acof(j,lm,natom,i2spin))
     129              :                   enddo !natom
     130              :                  enddo !m
     131              :                  mmn(i,j) =    mmn(i,j)
     132              :      &                           +
     133              :      &             suma12(i1spin,i2spin)*radial1_ff(i1spin,i2spin,l,l,n)
     134              :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     135              : 
     136              :      &                           +
     137              :      &             sumb12(i1spin,i2spin)*radial1_gg(i1spin,i2spin,l,l,n)
     138              :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     139              : 
     140              :      &                           +
     141              :      &             sumc12(i1spin,i2spin)*radial1_fg(i1spin,i2spin,l,l,n)
     142              :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     143              : 
     144              :      &                           +
     145              :      &             sumd12(i1spin,i2spin)*radial1_gf(i1spin,i2spin,l,l,n)
     146            0 :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     147              :                 enddo !i2spin
     148              :                enddo !i1spin 
     149              :              endif   
     150              : 
     151              :             enddo !l
     152            0 :             nt1 = nt1 + neq(n)
     153              :          enddo !n   
     154              :        enddo   ! cycle by j-band
     155              :       enddo  !  cycle by i-band
     156              : 
     157              : c---> initialize qlo arrays
     158            0 :       qlo(:,:,:,:,:) = 0.0
     159            0 :       qaclo(:,:,:,:) = 0.0
     160            0 :       qbclo(:,:,:,:) = 0.0
     161            0 :       qcloa(:,:,:,:) = 0.0
     162            0 :       qclob(:,:,:,:) = 0.0
     163              : 
     164              : c---> prepare the coefficients
     165            0 :       natom = 0
     166            0 :       do ntyp = 1,ntype
     167            0 :          do nn = 1,neq(ntyp)
     168            0 :             natom = natom + 1
     169            0 :             do lo = 1,nlo(ntyp)
     170            0 :                l = llo(lo,ntyp)
     171            0 :                ll1 = l* (l+1)
     172            0 :                do m = -l,l
     173            0 :                   lm = ll1 + m
     174            0 :                   do j = 1,noccbd
     175            0 :                    do i = 1,noccbd
     176              :                      qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) +
     177            0 :      +                  bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) 
     178              : c     +                +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2)) 
     179              :                      qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) +
     180            0 :      +                  acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) 
     181              : c     +                 +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
     182              : 
     183              :                      qclob(i,j,lo,ntyp) = qclob(i,j,lo,ntyp)
     184              : c     +                bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) 
     185            0 :      +                +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2)) 
     186              :                      qcloa(i,j,lo,ntyp) = qcloa(i,j,lo,ntyp) 
     187              : c     +                acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))+ 
     188            0 :      +                +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
     189              :                    enddo
     190              :                   enddo
     191              :                enddo
     192            0 :                do lop = 1,nlo(ntyp)
     193            0 :                  if (llo(lop,ntyp).eq.l) then
     194            0 :                    do m = -l,l
     195            0 :                      do i = 1,noccbd
     196            0 :                       do j = 1,noccbd
     197              :                        qlo(i,j,lo,lop,ntyp) = qlo(i,j,lo,lop,ntyp) + 
     198              :      +                        conjg(ccof(m,j,lop,natom,2))
     199            0 :      *                                  *ccof(m,i,lo,natom,1)
     200              :                       enddo
     201              :                      enddo
     202              :                    enddo
     203              :                  endif
     204              :                enddo
     205              :             enddo
     206              :          enddo
     207              :       enddo
     208              : c---> perform summation of the coefficients with the integrals
     209              : c---> of the radial basis functions
     210            0 :       do ntyp = 1,ntype
     211            0 :          do lo = 1,nlo(ntyp)
     212            0 :             l = llo(lo,ntyp)
     213            0 :             do j = 1,noccbd
     214            0 :              do i = 1,noccbd
     215              :                mmn(i,j)= mmn(i,j)  + 
     216              :      +    qaclo(i,j,lo,ntyp)*radial1_flo(1,2,l,lo,ntyp)     
     217              :      +                      +
     218              :      +    qbclo(i,j,lo,ntyp)*radial1_glo(1,2,l,lo,ntyp)
     219              :      +                      +
     220              :      +    qcloa(i,j,lo,ntyp)*radial1_lof(1,2,lo,l,ntyp)     
     221              :      +                      +
     222            0 :      +    qclob(i,j,lo,ntyp)*radial1_log(1,2,lo,l,ntyp)  
     223              :              enddo
     224              :             enddo 
     225            0 :             do lop = 1,nlo(ntyp)
     226            0 :                if (llo(lop,ntyp).eq.l) then
     227            0 :                do j = 1,noccbd
     228            0 :                 do i = 1,noccbd
     229              :                  mmn(i,j) = mmn(i,j)  + 
     230            0 :      +   qlo(i,j,lop,lo,ntyp)*radial1_lolo(1,2,lop,lo,ntyp)
     231              :                 enddo
     232              :                enddo
     233              :                endif
     234              :             enddo
     235              :          enddo 
     236              :       enddo 
     237            0 :       deallocate ( qlo,qaclo,qbclo,qcloa,qclob )
     238              : 
     239            0 :       call timestop("wann_mmk0_updown_sph")
     240            0 :       END SUBROUTINE wann_mmk0_updown_sph
     241              :       END MODULE m_wann_mmk0_updown_sph
     242              : 
        

Generated by: LCOV version 2.0-1